finished buyCash

This commit is contained in:
nek0 2019-11-09 12:29:29 +01:00
parent a39c83d5f7
commit fdc7beda60
6 changed files with 130 additions and 43 deletions

View file

@ -32,11 +32,11 @@ type UserAPI =
:> Get '[HTML] UserOverviewPage :> Get '[HTML] UserOverviewPage
:<|> "user" :> Capture "id" Int :> "buy" :<|> "user" :> Capture "id" Int :> "buy"
:> ReqBody '[FormUrlEncoded] [MT.PurchaseDetail] :> ReqBody '[FormUrlEncoded] [MT.PurchaseDetail]
:> QueryParam "force" Bool :> QueryFlag "force"
:> Post '[HTML] BuyConfirmPage :> Post '[HTML] BuyConfirmPage
:<|> "user" :> Capture "id" Int :> "purchasecomplete" :<|> "user" :> Capture "id" Int :> "purchasecomplete"
:> ReqBody '[FormUrlEncoded] [MT.PurchaseDetail] :> ReqBody '[FormUrlEncoded] [MT.PurchaseDetail]
:> QueryParam "force" Bool :> QueryFlag "force"
:> Post '[HTML] UserSelectPage :> Post '[HTML] UserSelectPage
:<|> "user" :> Capture "id" Int :> "recharge" :<|> "user" :> Capture "id" Int :> "recharge"
:> Get '[HTML] UserRechargePage :> Get '[HTML] UserRechargePage
@ -60,7 +60,7 @@ type UserAPI =
:> QueryParam "refine" MT.ProductRefine :> QueryParam "refine" MT.ProductRefine
:> Get '[HTML] CashBuyOverviewPage :> Get '[HTML] CashBuyOverviewPage
:<|> "buy" :<|> "buy"
:> QueryParam "force" Bool -- :> QueryFlag "force"
:> ReqBody '[FormUrlEncoded] [MT.PurchaseDetail] :> ReqBody '[FormUrlEncoded] [MT.PurchaseDetail]
:> Post '[HTML] CashBuyConfirmPage :> Post '[HTML] CashBuyConfirmPage
:<|> "journal" :> QueryParam "page" Word :<|> "journal" :> QueryParam "page" Word

View file

@ -10,3 +10,6 @@ type instance AuthClientData (AuthProtect "header-auth") = String
authenticateReq :: String -> Request -> Request authenticateReq :: String -> Request -> Request
authenticateReq = addHeader "Authentication" authenticateReq = addHeader "Authentication"
nonAuthenticateRequest :: String -> Request -> Request
nonAuthenticateRequest _ = id

View file

@ -40,7 +40,7 @@ buyControl
:: Maybe T.Text :: Maybe T.Text
-> Int -> Int
-> [MT.PurchaseDetail] -> [MT.PurchaseDetail]
-> Maybe Bool -> Bool
-> UserHandler BuyConfirmPage -> UserHandler BuyConfirmPage
buyControl mcookie uid pds forceBuy = buyControl mcookie uid pds forceBuy =
if not (null pds) if not (null pds)
@ -74,27 +74,11 @@ buyControl mcookie uid pds forceBuy =
else else
throwError (redirect303 $ userOverviewLink uid Nothing) 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 purchaseControl
:: Maybe T.Text :: Maybe T.Text
-> Int -> Int
-> [MT.PurchaseDetail] -> [MT.PurchaseDetail]
-> Maybe Bool -> Bool
-> UserHandler UserSelectPage -> UserHandler UserSelectPage
purchaseControl mcookie uid pds forceBuy = do purchaseControl mcookie uid pds forceBuy = do
l10n <- asks rsL10n l10n <- asks rsL10n
@ -104,7 +88,7 @@ purchaseControl mcookie uid pds forceBuy = do
then do then do
backend <- asks rsBackend backend <- asks rsBackend
let (token, _) = parseTokenAndUser mcookie let (token, _) = parseTokenAndUser mcookie
erefres <- if (isJust forceBuy && fromJust forceBuy) erefres <- if forceBuy
then do then do
let refills = map let refills = map
(\(MT.PurchaseDetail pid amount) -> MT.AmountRefill pid amount) (\(MT.PurchaseDetail pid amount) -> MT.AmountRefill pid amount)
@ -142,23 +126,27 @@ purchaseControl mcookie uid pds forceBuy = do
(translate l10n loc "Purchase successful") (translate l10n loc "Purchase successful")
backend backend
token token
(MT.PurchaseResult (MT.PayAmount price) []) -> (MT.PurchaseResult (MT.PayAmount _) _) ->
logoutAndRedirectHome throwError $ err500
(translate l10n loc "Please Pay" <> ": " <> formatMoney price) { errBody = "You can't buy with cash while logged in"
backend }
token -- (MT.PurchaseResult (MT.PayAmount price) []) ->
(MT.PurchaseResult (MT.PayAmount price) miss) -> -- logoutAndRedirectHome
throwError -- (translate l10n loc "Please Pay" <> ": " <> formatMoney price)
$ addMessage (translate l10n loc "Please Pay" <> ": " -- backend
<> formatMoney price -- token
<> "\n" -- (MT.PurchaseResult (MT.PayAmount price) miss) ->
<> translate l10n loc ("But there seems to be something missing.") -- throwError
) -- $ addMessage (translate l10n loc "Please Pay" <> ": "
$ redirect307 (buyLink uid (Just True)) -- <> formatMoney price
-- <> "\n"
-- <> translate l10n loc ("But there seems to be something missing:")
-- )
-- $ redirect307 (buyLink uid True)
(MT.PurchaseResult _ miss) -> (MT.PurchaseResult _ miss) ->
throwError throwError
$ addMessage (translate l10n loc "Purchase partly successful.") $ addMessage (translate l10n loc "Purchase partly successful.")
$ redirect307 (buyLink uid (Just True)) $ redirect307 (buyLink uid True)
Left err -> Left err ->
throwError throwError
$ addMessage (fromString (show err)) $ addMessage (fromString (show err))
@ -178,3 +166,99 @@ purchaseControl mcookie uid pds forceBuy = do
$ addMessage message $ addMessage message
$ redirect303 userSelectLink $ redirect303 userSelectLink
translate l10n locale = localize l10n locale . gettext translate l10n locale = localize l10n locale . gettext
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
Left err ->
throwError $ err500
{ errBody = fromString (show err)
}
cashBuyPurchaseControl
:: Maybe T.Text
-- -> Bool
-> [MT.PurchaseDetail]
-> UserHandler UserSelectPage
cashBuyPurchaseControl mcookie {-forceBuy-} pds = do
l10n <- asks rsL10n
let loc = localeFromCookie mcookie
if not (null pds)
then do
backend <- asks rsBackend
-- erefres <- if forceBuy
-- then do
-- let refills = map
-- (\(MT.PurchaseDetail pid amount) -> MT.AmountRefill pid amount)
-- pds
-- liftIO $ runClientM
-- (productStockRefill
-- (mkAuthenticatedRequest token authenticateReq)
-- refills
-- )
-- backend
-- else
-- return $ Right ()
eresult <- liftIO $ runClientM
(buy
(mkAuthenticatedRequest "secret" nonAuthenticateRequest)
pds
)
backend
case eresult of
Right result -> case result of
(MT.PurchaseResult (MT.PayAmount price) []) ->
throwError $
addMessage
(translate l10n loc "Please Pay" <> ": " <> formatMoney price) $
redirect303 userSelectLink
(MT.PurchaseResult (MT.PayAmount price) miss) -> do
eproducts <- liftIO $ runClientM
(productShortList
(Just MT.AllProducts)
)
backend
let missIds = map (\(MT.PurchaseDetail pid amount) -> (pid, amount)) miss
case eproducts of
Right prods ->
throwError
$ addMessage (translate l10n loc "Please Pay" <> ": "
<> formatMoney price
<> ". "
<> translate l10n loc
("But there seems to be something missing: ")
<> mconcat (reverse $ foldl
(\acc (MT.ProductShortOverview psoid ident _ _ _ _) ->
if psoid `elem` fst (unzip missIds)
then
(fromString (show $ fromJust $ lookup psoid missIds)
<> " x "
<> fromString (T.unpack ident)) : acc
else acc
)
[]
prods
))
$ redirect303 userSelectLink
Left err ->
throwError $ err500
{ errBody = fromString (show err)
}
else
throwError
$ addMessage (translate l10n loc "Please choose your product(s)")
$ (redirect303 $ cashBuyLink Nothing)
where
translate l10n locale = localize l10n locale . gettext

View file

@ -81,7 +81,7 @@ userApp initState = serveWithContext userApi EmptyContext $
:<|> userNewControl mcookie :<|> userNewControl mcookie
:<|> userNewPostControl mcookie :<|> userNewPostControl mcookie
:<|> cashBuyOverviewControl mcookie :<|> cashBuyOverviewControl mcookie
:<|> const (error "not yet implemented") :<|> cashBuyPurchaseControl mcookie
:<|> journalControl mcookie :<|> journalControl mcookie
:<|> authControl mcookie :<|> authControl mcookie
:<|> authPostControl mcookie :<|> authPostControl mcookie

View file

@ -34,7 +34,7 @@ buyConfirmPage
-> Int -> Int
-> [(MT.PurchaseDetail, MT.ProductShortOverview)] -> [(MT.PurchaseDetail, MT.ProductShortOverview)]
-> Int -> Int
-> Maybe Bool -> Bool
-> Maybe T.Text -> Maybe T.Text
-> H.Html -> H.Html
buyConfirmPage l10n locale uid ziptups total forceBuy mcookie = buyConfirmPage l10n locale uid ziptups total forceBuy mcookie =
@ -43,7 +43,7 @@ buyConfirmPage l10n locale uid ziptups total forceBuy mcookie =
" - " <> " - " <>
translate "Home" translate "Home"
) $ do ) $ do
if not (fromMaybe False forceBuy) if not forceBuy
then then
H.p $ H.toHtml $ translate "You are about to buy the following items:" H.p $ H.toHtml $ translate "You are about to buy the following items:"
else else
@ -116,10 +116,10 @@ buyConfirmPage l10n locale uid ziptups total forceBuy mcookie =
H.button H.button
H.! HA.class_ "btn btn-default" H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit" H.! HA.type_ "submit"
$ H.toHtml $ if (fromMaybe False forceBuy) $ H.toHtml $ if forceBuy
then translate "Buy anyway" then translate "Buy anyway"
else translate "Buy" else translate "Buy"
when (fromMaybe False forceBuy) $ when forceBuy $
H.button H.button
H.! HA.formnovalidate "formnovalidate" H.! HA.formnovalidate "formnovalidate"
H.! HA.formmethod "get" H.! HA.formmethod "get"
@ -194,7 +194,7 @@ cashBuyOverviewPage l10n loc mcookie psos =
H.form H.form
H.! HA.method "post" H.! HA.method "post"
H.! HA.action ("/" <> fromString ( H.! HA.action ("/" <> fromString (
show $ linkURI $ cashBuyPostLink (Just False) show $ linkURI cashBuyPostLink
)) ))
H.! HA.enctype "application/x-www-form-urlencoded" H.! HA.enctype "application/x-www-form-urlencoded"
$ buyProductsForm l10n loc psos $ buyProductsForm l10n loc psos

View file

@ -106,7 +106,7 @@ userOverviewPage l10n locale method ud pos mcookie =
H.form H.form
H.! HA.method "post" H.! HA.method "post"
H.! HA.action ("/" <> (fromString $ show $ linkURI $ H.! HA.action ("/" <> (fromString $ show $ linkURI $
buyLink (MT.userDetailsId ud) Nothing) buyLink (MT.userDetailsId ud) False)
) )
H.! HA.enctype "application/x-www-form-urlencoded" $ H.! HA.enctype "application/x-www-form-urlencoded" $
buyProductsForm l10n locale pos buyProductsForm l10n locale pos