diff --git a/src/API.hs b/src/API.hs index 3aa2484..0a8c3f6 100644 --- a/src/API.hs +++ b/src/API.hs @@ -56,6 +56,13 @@ type UserAPI = :<|> "user" :> "create" :> Get '[HTML] UserNewPage :<|> "user" :> "create" :> ReqBody '[FormUrlEncoded] MT.UserSubmit :> Post '[HTML] UserSelectPage + :<|> "buy" + :> QueryParam "refine" MT.ProductRefine + :> Get '[HTML] CashBuyOverviewPage + :<|> "buy" + :> QueryParam "force" Bool + :> ReqBody '[FormUrlEncoded] [MT.PurchaseDetail] + :> Post '[HTML] CashBuyConfirmPage :<|> "journal" :> QueryParam "page" Word :> Get '[HTML] JournalPage :<|> "auth" @@ -85,6 +92,8 @@ type UserAPI = userManageAuthDeleteLink :<|> userNewLink :<|> userNewPostLink :<|> + cashBuyLink :<|> + cashBuyPostLink :<|> journalLink :<|> authLink :<|> authPostLink :<|> diff --git a/src/Control/Buy.hs b/src/Control/Buy.hs index 929bbb8..b89e079 100644 --- a/src/Control/Buy.hs +++ b/src/Control/Buy.hs @@ -74,6 +74,22 @@ buyControl mcookie uid pds forceBuy = else throwError (redirect303 $ userOverviewLink uid Nothing) +cashBuyOverviewControl + :: Maybe T.Text + -> Maybe MT.ProductRefine + -> UserHandler CashBuyOverviewPage +cashBuyOverviewControl mcookie mrefine = do + (ReadState l10n backend _) <- ask + let loc = localeFromCookie mcookie + eproducts <- liftIO $ runClientM + (productShortList + mrefine + ) + backend + case eproducts of + Right prods -> + return $ cashBuyOverviewPage l10n loc mcookie prods + purchaseControl :: Maybe T.Text -> Int diff --git a/src/Main.hs b/src/Main.hs index 29f40c4..0568bec 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -80,6 +80,8 @@ userApp initState = serveWithContext userApi EmptyContext $ :<|> userManageAuthDeleteControl mcookie :<|> userNewControl mcookie :<|> userNewPostControl mcookie + :<|> cashBuyOverviewControl mcookie + :<|> const (error "not yet implemented") :<|> journalControl mcookie :<|> authControl mcookie :<|> authPostControl mcookie diff --git a/src/Types/Views.hs b/src/Types/Views.hs index eaa614f..2afa8ba 100644 --- a/src/Types/Views.hs +++ b/src/Types/Views.hs @@ -19,3 +19,7 @@ type AuthPage = H.Html type BuyConfirmPage = H.Html type JournalPage = H.Html + +type CashBuyOverviewPage = H.Html + +type CashBuyConfirmPage = H.Html diff --git a/src/View/Buy.hs b/src/View/Buy.hs index b6aa82e..69c0317 100644 --- a/src/View/Buy.hs +++ b/src/View/Buy.hs @@ -178,3 +178,25 @@ buyProductsForm l10n locale prods = do $ H.toHtml $ translate "Proceed" where translate = localize l10n locale . gettext + +cashBuyOverviewPage + :: L10n + -> Locale + -> Maybe T.Text + -> [MT.ProductShortOverview] + -> CashBuyOverviewPage +cashBuyOverviewPage l10n loc mcookie psos = + scaffold l10n loc mcookie (initPage $ + translate "Matebeamter" <> + " - " <> + translate "Buy with Cash" + ) $ + H.form + H.! HA.method "post" + H.! HA.action ("/" <> fromString ( + show $ linkURI $ cashBuyPostLink (Just False) + )) + H.! HA.enctype "application/x-www-form-urlencoded" + $ buyProductsForm l10n loc psos + where + translate = localize l10n loc . gettext diff --git a/src/View/User.hs b/src/View/User.hs index c5a1db2..be9d0a5 100644 --- a/src/View/User.hs +++ b/src/View/User.hs @@ -39,6 +39,10 @@ userSelectPage l10n locale uss mcookie = " - " <> translate "Home" ) $ do + H.a H.! HA.href ("/" <> fromString + (show $ linkURI $ cashBuyLink Nothing) + ) $ + H.toHtml $ translate "Buy with cash" mapM_ (\(MT.UserSummary uid ident _) -> H.a H.! HA.href ("/" <> fromString (show $ linkURI $ userOverviewLink uid Nothing)) $