building confirmation page

src/API.hs

@@ -32,7 +32,10 @@ type UserAPI =
     :> Get '[HTML] UserOverviewPage
   :<|> "user" :> Capture "id" Int :> "buy"
     :> ReqBody '[FormUrlEncoded] [MT.PurchaseDetail]
-    :> Post '[HTML] UserManagePage
+    :> Post '[HTML] BuyConfirmPage
+  :<|> "purchasecomplete"
+    :> ReqBody '[FormUrlEncoded] [MT.PurchaseDetail]
+    :> Post '[HTML] UserSelectPage
   :<|> "user" :> Capture "id" Int :> "manage" :> Get '[HTML] UserManagePage
   :<|> "user" :> Capture "id" Int :> "manage"
     :> ReqBody '[FormUrlEncoded] MT.UserDetailsSubmit
@@ -64,6 +67,7 @@ type UserAPI =
 ( userSelectLink :<|>
   userOverviewLink :<|>
   buyLink :<|>
+  purchaseCompleteLink :<|>
   userManageLink :<|>
   userManageDetailsSubmitLink :<|>
   userManageAuthCreateLink :<|>

src/Control/Buy.hs

@@ -40,20 +40,34 @@ buyControl
   -> Int
   -> [MT.PurchaseDetail]
   -> UserHandler BuyConfirmPage
-buyControl mcookie uid pds = do
+buyControl mcookie uid pds =
-  (ReadState l10n backend _) <- ask
+  if not (null pds)
-  let (token, _) = parseTokenAndUser mcookie
+  then do
-      loc = Locale
+    (ReadState l10n backend _) <- ask
-        (fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
+    let (token, _) = parseTokenAndUser mcookie
-      pids = map MT.purchaseDetailProduct pds
+        loc = Locale
-  epsovs <- liftIO $ runClientM
+          (fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
-    (productShortList (Just MT.AllProducts))
+        pids = map MT.purchaseDetailProduct pds
-    backend
+    epsovs <- liftIO $ runClientM
-  case epsovs of
+      (productShortList (Just MT.AllProducts))
-    Right psovs -> do
+      backend
-      let currentPsovs = filter ((`elem` pids) . MT.productShortOverviewId) psovs
+    case epsovs of
-          ziptup = sortOn (MT.productShortOverviewIdent . snd) (zip
+      Right psovs -> do
-            (sortOn MT.purchaseDetailProduct pds)
+        let currentPsovs = filter
-            (sortOn MT.productShortOverviewId currentPsovs)
+              ((`elem` pids) . MT.productShortOverviewId)
-            )
+              psovs
-      return (buyConfirmPage l10n loc ziptup)
+            ziptup = sortOn (MT.productShortOverviewIdent . snd) (zip
+              (sortOn MT.purchaseDetailProduct pds)
+              (sortOn MT.productShortOverviewId currentPsovs)
+              )
+            total = foldl
+              (\acc
+                ( MT.PurchaseDetail _ amount
+                , MT.ProductShortOverview _ _ price _ _ _) ->
+                  acc + (max 0 amount) * price
+                )
+              0
+              ziptup
+        return (buyConfirmPage l10n loc ziptup total)
+  else
+    throwError (redirect303 $ userOverviewLink uid Nothing)

src/View/Buy.hs

@@ -30,8 +30,9 @@ buyConfirmPage
   :: L10n
   -> Locale
   -> [(MT.PurchaseDetail, MT.ProductShortOverview)]
+  -> Int
   -> H.Html
-buyConfirmPage l10n locale ziptups = scaffold l10n locale (initPage $
+buyConfirmPage l10n locale ziptups total = scaffold l10n locale (initPage $
   translate "Matebeamter" <>
   " - " <>
   translate "Home"
@@ -48,16 +49,24 @@ buyConfirmPage l10n locale ziptups = scaffold l10n locale (initPage $
                   , HA.src (fromString $ show $ fromJust mava) -- TODO: ask for avatar
                   )
               H.toHtml
-                (fromString (show amount)
+                (fromString (show $ max 0 amount)
                   <> " "
                   <> ident
                   <> " @ "
                   <> formatMoney price
                   <> " "
                   -- <> "€" -- TODO: ask for currency symbol
+                  <> " : "
+                  <> formatMoney ((max 0 amount) * price)
                   )
           )
         ziptups
+    H.p $ H.toHtml $
+      (translate "Total price")
+      <> ": "
+      <> formatMoney total
+      -- <> "€" -- TODO: ask for currency symbol
+    H.form
   where
     translate = localize l10n locale . gettext
 
@@ -105,6 +114,6 @@ buyProductsForm l10n locale prods = do
     H.button
       H.! HA.class_ "btn btn-default"
       H.! HA.type_ "submit"
-      $ H.toHtml $ translate "Buy"
+      $ H.toHtml $ translate "Proceed"
   where
     translate = localize l10n locale . gettext