diff --git a/src/API.hs b/src/API.hs index 410243e..44d50b7 100644 --- a/src/API.hs +++ b/src/API.hs @@ -65,6 +65,8 @@ type UserAPI = :> Post '[HTML] CashBuyConfirmPage :<|> "journal" :> QueryParam "page" Word :> Get '[HTML] JournalPage + :<|> "journal" :> "check" + :> Get '[HTML] JournalCheckPage :<|> "auth" :> QueryParam "destination" T.Text :> Get '[HTML] @@ -95,6 +97,7 @@ type UserAPI = cashBuyLink :<|> cashBuyPostLink :<|> journalLink :<|> + journalCheckLink :<|> authLink :<|> authPostLink :<|> authLogoutLink diff --git a/src/Control/Journal.hs b/src/Control/Journal.hs index 2e4da1c..1df485f 100644 --- a/src/Control/Journal.hs +++ b/src/Control/Journal.hs @@ -66,3 +66,8 @@ journalControl mcookie mpage = do throwError $ addMessage (fromString $ show othererr) $ redirect303 userSelectLink + +journalCheckControl + :: Maybe T.Text + -> UserHandler JournalCheckPage +ournalCheckControl diff --git a/src/Main.hs b/src/Main.hs index 5c54c58..8e17d1b 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -83,6 +83,7 @@ userApp initState = serveWithContext userApi EmptyContext $ :<|> cashBuyOverviewControl mcookie :<|> cashBuyPurchaseControl mcookie :<|> journalControl mcookie + :<|> journalCheckControl mcookie :<|> authControl mcookie :<|> authPostControl mcookie :<|> authLogoutControl mcookie diff --git a/src/Types/Views.hs b/src/Types/Views.hs index 2afa8ba..3edd6ba 100644 --- a/src/Types/Views.hs +++ b/src/Types/Views.hs @@ -20,6 +20,8 @@ type BuyConfirmPage = H.Html type JournalPage = H.Html +type JournalCheckPage = H.Html + type CashBuyOverviewPage = H.Html type CashBuyConfirmPage = H.Html diff --git a/src/View/Journal.hs b/src/View/Journal.hs index b20ad90..adaf230 100644 --- a/src/View/Journal.hs +++ b/src/View/Journal.hs @@ -77,5 +77,11 @@ 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" where translate = localize l10n loc . gettext