diff --git a/src/API.hs b/src/API.hs index f99e09b..900d4fc 100644 --- a/src/API.hs +++ b/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 :<|> diff --git a/src/Control/Buy.hs b/src/Control/Buy.hs index 5198347..699bb9c 100644 --- a/src/Control/Buy.hs +++ b/src/Control/Buy.hs @@ -40,20 +40,34 @@ buyControl -> Int -> [MT.PurchaseDetail] -> UserHandler BuyConfirmPage -buyControl mcookie uid pds = do - (ReadState l10n backend _) <- ask - let (token, _) = parseTokenAndUser mcookie - loc = Locale - (fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie) - pids = map MT.purchaseDetailProduct pds - epsovs <- liftIO $ runClientM - (productShortList (Just MT.AllProducts)) - backend - case epsovs of - Right psovs -> do - let currentPsovs = filter ((`elem` pids) . MT.productShortOverviewId) psovs - ziptup = sortOn (MT.productShortOverviewIdent . snd) (zip - (sortOn MT.purchaseDetailProduct pds) - (sortOn MT.productShortOverviewId currentPsovs) - ) - return (buyConfirmPage l10n loc ziptup) +buyControl mcookie uid pds = + if not (null pds) + then do + (ReadState l10n backend _) <- ask + let (token, _) = parseTokenAndUser mcookie + loc = Locale + (fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie) + pids = map MT.purchaseDetailProduct pds + epsovs <- liftIO $ runClientM + (productShortList (Just MT.AllProducts)) + backend + case epsovs of + Right psovs -> do + let currentPsovs = filter + ((`elem` pids) . MT.productShortOverviewId) + psovs + 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) diff --git a/src/View/Buy.hs b/src/View/Buy.hs index 115d01f..5821eec 100644 --- a/src/View/Buy.hs +++ b/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