finished buyCash
This commit is contained in:
parent
a39c83d5f7
commit
fdc7beda60
6 changed files with 130 additions and 43 deletions
|
|
@ -32,11 +32,11 @@ type UserAPI =
|
|||
:> Get '[HTML] UserOverviewPage
|
||||
:<|> "user" :> Capture "id" Int :> "buy"
|
||||
:> ReqBody '[FormUrlEncoded] [MT.PurchaseDetail]
|
||||
:> QueryParam "force" Bool
|
||||
:> QueryFlag "force"
|
||||
:> Post '[HTML] BuyConfirmPage
|
||||
:<|> "user" :> Capture "id" Int :> "purchasecomplete"
|
||||
:> ReqBody '[FormUrlEncoded] [MT.PurchaseDetail]
|
||||
:> QueryParam "force" Bool
|
||||
:> QueryFlag "force"
|
||||
:> Post '[HTML] UserSelectPage
|
||||
:<|> "user" :> Capture "id" Int :> "recharge"
|
||||
:> Get '[HTML] UserRechargePage
|
||||
|
|
@ -60,7 +60,7 @@ type UserAPI =
|
|||
:> QueryParam "refine" MT.ProductRefine
|
||||
:> Get '[HTML] CashBuyOverviewPage
|
||||
:<|> "buy"
|
||||
:> QueryParam "force" Bool
|
||||
-- :> QueryFlag "force"
|
||||
:> ReqBody '[FormUrlEncoded] [MT.PurchaseDetail]
|
||||
:> Post '[HTML] CashBuyConfirmPage
|
||||
:<|> "journal" :> QueryParam "page" Word
|
||||
|
|
|
|||
|
|
@ -10,3 +10,6 @@ type instance AuthClientData (AuthProtect "header-auth") = String
|
|||
|
||||
authenticateReq :: String -> Request -> Request
|
||||
authenticateReq = addHeader "Authentication"
|
||||
|
||||
nonAuthenticateRequest :: String -> Request -> Request
|
||||
nonAuthenticateRequest _ = id
|
||||
|
|
|
|||
|
|
@ -40,7 +40,7 @@ buyControl
|
|||
:: Maybe T.Text
|
||||
-> Int
|
||||
-> [MT.PurchaseDetail]
|
||||
-> Maybe Bool
|
||||
-> Bool
|
||||
-> UserHandler BuyConfirmPage
|
||||
buyControl mcookie uid pds forceBuy =
|
||||
if not (null pds)
|
||||
|
|
@ -74,27 +74,11 @@ 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
|
||||
-> [MT.PurchaseDetail]
|
||||
-> Maybe Bool
|
||||
-> Bool
|
||||
-> UserHandler UserSelectPage
|
||||
purchaseControl mcookie uid pds forceBuy = do
|
||||
l10n <- asks rsL10n
|
||||
|
|
@ -104,7 +88,7 @@ purchaseControl mcookie uid pds forceBuy = do
|
|||
then do
|
||||
backend <- asks rsBackend
|
||||
let (token, _) = parseTokenAndUser mcookie
|
||||
erefres <- if (isJust forceBuy && fromJust forceBuy)
|
||||
erefres <- if forceBuy
|
||||
then do
|
||||
let refills = map
|
||||
(\(MT.PurchaseDetail pid amount) -> MT.AmountRefill pid amount)
|
||||
|
|
@ -142,23 +126,27 @@ purchaseControl mcookie uid pds forceBuy = do
|
|||
(translate l10n loc "Purchase successful")
|
||||
backend
|
||||
token
|
||||
(MT.PurchaseResult (MT.PayAmount price) []) ->
|
||||
logoutAndRedirectHome
|
||||
(translate l10n loc "Please Pay" <> ": " <> formatMoney price)
|
||||
backend
|
||||
token
|
||||
(MT.PurchaseResult (MT.PayAmount price) miss) ->
|
||||
throwError
|
||||
$ addMessage (translate l10n loc "Please Pay" <> ": "
|
||||
<> formatMoney price
|
||||
<> "\n"
|
||||
<> translate l10n loc ("But there seems to be something missing.")
|
||||
)
|
||||
$ redirect307 (buyLink uid (Just True))
|
||||
(MT.PurchaseResult (MT.PayAmount _) _) ->
|
||||
throwError $ err500
|
||||
{ errBody = "You can't buy with cash while logged in"
|
||||
}
|
||||
-- (MT.PurchaseResult (MT.PayAmount price) []) ->
|
||||
-- logoutAndRedirectHome
|
||||
-- (translate l10n loc "Please Pay" <> ": " <> formatMoney price)
|
||||
-- backend
|
||||
-- token
|
||||
-- (MT.PurchaseResult (MT.PayAmount price) miss) ->
|
||||
-- throwError
|
||||
-- $ addMessage (translate l10n loc "Please Pay" <> ": "
|
||||
-- <> formatMoney price
|
||||
-- <> "\n"
|
||||
-- <> translate l10n loc ("But there seems to be something missing:")
|
||||
-- )
|
||||
-- $ redirect307 (buyLink uid True)
|
||||
(MT.PurchaseResult _ miss) ->
|
||||
throwError
|
||||
$ addMessage (translate l10n loc "Purchase partly successful.")
|
||||
$ redirect307 (buyLink uid (Just True))
|
||||
$ redirect307 (buyLink uid True)
|
||||
Left err ->
|
||||
throwError
|
||||
$ addMessage (fromString (show err))
|
||||
|
|
@ -178,3 +166,99 @@ purchaseControl mcookie uid pds forceBuy = do
|
|||
$ addMessage message
|
||||
$ redirect303 userSelectLink
|
||||
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
|
||||
|
|
|
|||
|
|
@ -81,7 +81,7 @@ userApp initState = serveWithContext userApi EmptyContext $
|
|||
:<|> userNewControl mcookie
|
||||
:<|> userNewPostControl mcookie
|
||||
:<|> cashBuyOverviewControl mcookie
|
||||
:<|> const (error "not yet implemented")
|
||||
:<|> cashBuyPurchaseControl mcookie
|
||||
:<|> journalControl mcookie
|
||||
:<|> authControl mcookie
|
||||
:<|> authPostControl mcookie
|
||||
|
|
|
|||
|
|
@ -34,7 +34,7 @@ buyConfirmPage
|
|||
-> Int
|
||||
-> [(MT.PurchaseDetail, MT.ProductShortOverview)]
|
||||
-> Int
|
||||
-> Maybe Bool
|
||||
-> Bool
|
||||
-> Maybe T.Text
|
||||
-> H.Html
|
||||
buyConfirmPage l10n locale uid ziptups total forceBuy mcookie =
|
||||
|
|
@ -43,7 +43,7 @@ buyConfirmPage l10n locale uid ziptups total forceBuy mcookie =
|
|||
" - " <>
|
||||
translate "Home"
|
||||
) $ do
|
||||
if not (fromMaybe False forceBuy)
|
||||
if not forceBuy
|
||||
then
|
||||
H.p $ H.toHtml $ translate "You are about to buy the following items:"
|
||||
else
|
||||
|
|
@ -116,10 +116,10 @@ buyConfirmPage l10n locale uid ziptups total forceBuy mcookie =
|
|||
H.button
|
||||
H.! HA.class_ "btn btn-default"
|
||||
H.! HA.type_ "submit"
|
||||
$ H.toHtml $ if (fromMaybe False forceBuy)
|
||||
$ H.toHtml $ if forceBuy
|
||||
then translate "Buy anyway"
|
||||
else translate "Buy"
|
||||
when (fromMaybe False forceBuy) $
|
||||
when forceBuy $
|
||||
H.button
|
||||
H.! HA.formnovalidate "formnovalidate"
|
||||
H.! HA.formmethod "get"
|
||||
|
|
@ -194,7 +194,7 @@ cashBuyOverviewPage l10n loc mcookie psos =
|
|||
H.form
|
||||
H.! HA.method "post"
|
||||
H.! HA.action ("/" <> fromString (
|
||||
show $ linkURI $ cashBuyPostLink (Just False)
|
||||
show $ linkURI cashBuyPostLink
|
||||
))
|
||||
H.! HA.enctype "application/x-www-form-urlencoded"
|
||||
$ buyProductsForm l10n loc psos
|
||||
|
|
|
|||
|
|
@ -106,7 +106,7 @@ userOverviewPage l10n locale method ud pos mcookie =
|
|||
H.form
|
||||
H.! HA.method "post"
|
||||
H.! HA.action ("/" <> (fromString $ show $ linkURI $
|
||||
buyLink (MT.userDetailsId ud) Nothing)
|
||||
buyLink (MT.userDetailsId ud) False)
|
||||
)
|
||||
H.! HA.enctype "application/x-www-form-urlencoded" $
|
||||
buyProductsForm l10n locale pos
|
||||
|
|
|
|||
Loading…
Reference in a new issue