prepare cash buy

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 :<|>

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

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

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

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

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)) $