From 142d5da6b213c2bae3ed097d9716d2203c2cab95 Mon Sep 17 00:00:00 2001 From: nek0 Date: Thu, 12 Dec 2019 00:47:46 +0100 Subject: [PATCH] implement cash checks --- app/Main.hs | 1 + src/API.hs | 8 +++++++- src/Control/Journal.hs | 19 +++++++++++++++++++ src/Model/Journal.hs | 26 ++++++++++++++++++++++++++ 4 files changed, 53 insertions(+), 1 deletion(-) diff --git a/app/Main.hs b/app/Main.hs index 8d7060f..bb3b938 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -179,6 +179,7 @@ app initState = buy :<|> journalShow :<|> + journalCheck :<|> avatarGet :<|> avatarInsert :<|> diff --git a/src/API.hs b/src/API.hs index ef4367e..c57c309 100644 --- a/src/API.hs +++ b/src/API.hs @@ -55,7 +55,11 @@ type MateAPI = :> Post '[JSON] PurchaseResult :<|> "journal" :> AuthProtect "header-auth" :> QueryParam "limit" Int - :> QueryParam "offset" Int :> Get '[JSON] [JournalEntry] + :> QueryParam "offset" Int + :> Get '[JSON] [JournalEntry] + :<|> "journal" :> AuthProtect "header-auth" + :> ReqBody '[JSON] JournalCashCheck + :> Post '[JSON] () :<|> "avatar" :> Capture "id" Int :> RawM :<|> "avatar" :> AuthProtect "header-auth" :> ReqBody '[JSON] AvatarData @@ -90,6 +94,7 @@ productShortListLink :: Maybe ProductRefine -> Link buyLink :: Link journalShowLink :: Maybe Int -> Maybe Int -> Link +journalPostCheck :: Link -- avatarGetLink :: Int -> Link avaterInsertLink :: Link @@ -121,6 +126,7 @@ avatarListLink :: Link buyLink :<|> journalShowLink :<|> + journalPostCheck :<|> avatarGetLink :<|> avaterInsertLink :<|> diff --git a/src/Control/Journal.hs b/src/Control/Journal.hs index 72dc380..4f83a11 100644 --- a/src/Control/Journal.hs +++ b/src/Control/Journal.hs @@ -3,6 +3,7 @@ module Control.Journal where import Servant +import Control.Monad (void) import Control.Monad.Reader (asks) -- internal imports @@ -28,3 +29,21 @@ journalShow Nothing _ _ = throwError $ err401 { errBody = "No Authentication present" } + +journalCheck + :: Maybe (Int, AuthMethod) + -> JournalCashCheck + -> MateHandler () +journalCheck (Just (_, method)) check = do + if method `elem` [PrimaryPass, ChallengeResponse] + then do + conn <- asks rsConnection + void $ insertNewCashCheck check conn + else + throwError $ err401 + { errBody = "Wrong Authentication present" + } +journalCheck Nothing _ = + throwError $ err401 + { errBody = "No Authentication present" + } diff --git a/src/Model/Journal.hs b/src/Model/Journal.hs index 38f9b28..a3a91af 100644 --- a/src/Model/Journal.hs +++ b/src/Model/Journal.hs @@ -151,3 +151,29 @@ insertNewJournalEntry (JournalSubmit descr amount) conn = do , iReturning = rReturning (\(id_, _, _, _, _) -> id_) , iOnConflict = Nothing } + +insertNewCashCheck + :: JournalCashCheck + -> PGS.Connection + -> MateHandler Int +insertNewCashCheck (JournalCashCheck amount) conn = do + -- lastTotal <- (\case + -- Just j -> journalEntryTotalAmount j + -- Nothing -> 0 + -- ) <$> selectLatestJournalEntry conn + liftIO $ do + now <- getCurrentTime + fmap head $ runInsert_ conn $ Insert + { iTable = journalTable + , iRows = + [ + ( C.constant (Nothing :: Maybe Int) + , C.constant now + , C.constant ("Cash check" :: String) + , C.constant amount + , C.constant True + ) + ] + , iReturning = rReturning (\(id_, _, _, _, _) -> id_) + , iOnConflict = Nothing + }