implement cash check functionality

This commit is contained in:
nek0 2019-12-12 00:45:22 +01:00
parent 096f287ce1
commit 28b98a6f9b
8 changed files with 126 additions and 11 deletions

View File

@ -29,6 +29,7 @@ executable matebeamter
, Types.Reader
, Types.Views
, Types.User
, Types.Journal
, Types.Orphans
, Types.Configuration
, Control

View File

@ -67,6 +67,9 @@ type UserAPI =
:> Get '[HTML] JournalPage
:<|> "journal" :> "check"
:> Get '[HTML] JournalCheckPage
:<|> "journal" :> "check"
:> ReqBody '[FormUrlEncoded] CashCheck
:> Post '[HTML] JournalPage
:<|> "auth"
:> QueryParam "destination" T.Text
:> Get '[HTML]
@ -97,7 +100,8 @@ type UserAPI =
cashBuyLink :<|>
cashBuyPostLink :<|>
journalLink :<|>
journalCheckLink :<|>
journalGetCheckLink :<|>
journalPostCheckLink :<|>
authLink :<|>
authPostLink :<|>
authLogoutLink

View File

@ -121,6 +121,7 @@ avatarList :: ClientM [MT.Avatar]
buy :<|>
journalShow :<|>
journalPostCashCheck :<|>
avatarGet :<|>
avatarInsert :<|>

View File

@ -13,6 +13,7 @@ import Control.Monad.IO.Class (liftIO)
import Data.String
import qualified Data.Text as T
import Data.Text.I18n
import Data.Maybe (fromMaybe)
@ -66,8 +67,54 @@ journalControl mcookie mpage = do
throwError $
addMessage (fromString $ show othererr) $
redirect303 userSelectLink
Nothing ->
redirectOverAuth Nothing (Just $ journalLink mpage) Nothing
journalCheckControl
journalGetCheckControl
:: Maybe T.Text
-> UserHandler JournalCheckPage
ournalCheckControl
journalGetCheckControl mcookie = do
let (token, muser) = parseTokenAndUser mcookie
loc = localeFromCookie mcookie
l10n <- asks rsL10n
return $ journalCheckPage l10n loc mcookie
journalPostCheckControl
:: Maybe T.Text
-> CashCheck
-> UserHandler JournalPage
journalPostCheckControl mcookie (CashCheck floatAmount) = do
let (token, muser) = parseTokenAndUser mcookie
loc = localeFromCookie mcookie
l10n <- asks rsL10n
backend <- asks rsBackend
case muser of
Just user -> do
eresult <- liftIO $ runClientM
(journalPostCashCheck
(mkAuthenticatedRequest token authenticateReq)
(MT.JournalCashCheck $ floor $ floatAmount * 100)
)
backend
case eresult of
Right _ -> throwError $
addMessage (translate l10n loc "Cash check received and processed") $
redirect303 (journalLink Nothing)
Left err ->
case err of
FailureResponse _ resp ->
if statusCode (responseStatusCode resp) == 401
then
redirectOverAuth Nothing (Just $ journalGetCheckLink) Nothing
else
throwError $
addMessage (fromString $ show err) $
redirect303 userSelectLink
otherErr ->
throwError $
addMessage (fromString $ show otherErr) $
redirect303 userSelectLink
Nothing ->
redirectOverAuth Nothing (Just $ journalLink Nothing) Nothing
where
translate l10n locale = localize l10n locale . gettext

View File

@ -83,7 +83,8 @@ userApp initState = serveWithContext userApi EmptyContext $
:<|> cashBuyOverviewControl mcookie
:<|> cashBuyPurchaseControl mcookie
:<|> journalControl mcookie
:<|> journalCheckControl mcookie
:<|> journalGetCheckControl mcookie
:<|> journalPostCheckControl mcookie
:<|> authControl mcookie
:<|> authPostControl mcookie
:<|> authLogoutControl mcookie

View File

@ -7,5 +7,6 @@ import Types.Page as T
import Types.Reader as T
import Types.Views as T
import Types.User as T
import Types.Journal as T
import Types.Orphans as T
import Types.Configuration as T

18
src/Types/Journal.hs Normal file
View File

@ -0,0 +1,18 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Types.Journal where
import Servant.API
import Servant.HTML.Blaze
import Web.Internal.FormUrlEncoded
import GHC.Generics
newtype CashCheck = CashCheck
{ cashCheckAmount :: Float
}
deriving (Show, Generic)
instance MimeUnrender HTML CashCheck
instance FromForm CashCheck

View File

@ -34,7 +34,7 @@ journalPage
-> Maybe T.Text
-> Maybe Word
-> [MT.JournalEntry]
-> H.Html
-> JournalPage
journalPage l10n loc mcookie mpage entries =
scaffold l10n loc mcookie (initPage $
translate "Matebeamter" <>
@ -77,11 +77,53 @@ journalPage l10n loc mcookie mpage entries =
(show $ linkURI (journalLink (Just $ page + 1)))
)
$ H.toHtml $ translate "Next Page"
H.button
H.! HA.type_ "submit"
H.! HA.formmethod "get"
H.! HA.formaction
("/" <> fromString (show $ linkURI $ journalCheckLink)
$ H.toHtml $ translate "Perform cash check"
H.form $
H.button
H.! HA.type_ "submit"
H.! HA.formmethod "get"
H.! HA.formaction
("/" <> fromString (show $ linkURI $ journalGetCheckLink))
$ H.toHtml $ translate "Perform cash check"
where
translate = localize l10n loc . gettext
journalCheckPage
:: L10n
-> Locale
-> Maybe T.Text
-> JournalCheckPage
journalCheckPage l10n loc mcookie =
scaffold l10n loc mcookie (initPage $
translate "Matebeamter" <>
" - " <>
translate "Cash check"
) $ do
H.div $ do
H.p $
H.toHtml $ translate $ mconcat
[ "Please count all the cash in stock thoroughly and diligently, "
, "then submit the total amount in the field below."
]
H.p $
H.toHtml $ translate "Thank you for your cooperation."
H.div $ H.p $ H.form
H.! HA.method "post"
H.! HA.action ("/" <> fromString (show $ linkURI journalPostCheckLink))
H.! HA.enctype "application/x-www-form-urlencoded" $ do
H.div H.! HA.class_ "form-group required" $ do
H.label H.! HA.for "total" $ H.toHtml $ translate "Total amount"
H.input
H.! HA.id "total"
H.! HA.class_ "form-control"
H.! HA.name "cashCheckAmount"
H.! HA.type_ "number"
H.! HA.min "0"
H.! HA.step "0.01"
H.! HA.value "0"
H.div H.! HA.class_ "form-group optional" $
H.button
H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit"
$ H.toHtml $ translate "Submit"
where
translate = localize l10n loc . gettext