refill kinda does things

This commit is contained in:
nek0 2019-12-15 00:05:12 +01:00
parent 2708f14ce4
commit 9cbc638a62
9 changed files with 186 additions and 14 deletions

View file

@ -72,6 +72,11 @@ type UserAPI =
:> Post '[HTML] JournalPage :> Post '[HTML] JournalPage
:<|> "product" :> "list" :<|> "product" :> "list"
:> Get '[HTML] ProductPriceListPage :> Get '[HTML] ProductPriceListPage
:<|> "product" :> "refill"
:> Get '[HTML] ProductRefillPage
:<|> "product" :> "refill"
:> ReqBody '[FormUrlEncoded] [MT.AmountRefill]
:> Post '[HTML] ProductRefillPage
:<|> "auth" :<|> "auth"
:> QueryParam "destination" T.Text :> QueryParam "destination" T.Text
:> Get '[HTML] :> Get '[HTML]
@ -105,6 +110,8 @@ type UserAPI =
journalGetCheckLink :<|> journalGetCheckLink :<|>
journalPostCheckLink :<|> journalPostCheckLink :<|>
productGetPriceListLink :<|> productGetPriceListLink :<|>
productGetRefillLink :<|>
productPostRefillLink :<|>
authLink :<|> authLink :<|>
authPostLink :<|> authPostLink :<|>
authLogoutLink authLogoutLink

View file

@ -71,6 +71,10 @@ buyControl mcookie uid pds forceBuy =
0 0
ziptup ziptup
return (buyConfirmPage l10n loc uid ziptup total forceBuy mcookie) return (buyConfirmPage l10n loc uid ziptup total forceBuy mcookie)
Left err ->
throwError $
addMessage (fromString $ show err) $
redirect303 userSelectLink
else else
throwError (redirect303 $ userOverviewLink uid Nothing) throwError (redirect303 $ userOverviewLink uid Nothing)
@ -91,7 +95,7 @@ purchaseControl mcookie uid pds forceBuy = do
erefres <- if 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 0)
pds pds
liftIO $ runClientM liftIO $ runClientM
(productStockRefill (productStockRefill
@ -256,6 +260,8 @@ cashBuyPurchaseControl mcookie {-forceBuy-} pds = do
throwError $ err500 throwError $ err500
{ errBody = fromString (show err) { errBody = fromString (show err)
} }
Left err ->
handleClientErr err (Just userSelectLink)
else else
throwError throwError
$ addMessage (translate l10n loc "Please choose your product(s)") $ addMessage (translate l10n loc "Please choose your product(s)")

View file

@ -93,19 +93,20 @@ journalPostCheckControl mcookie (CashCheck floatAmount) = do
addMessage (translate l10n loc "Cash check received and processed") $ addMessage (translate l10n loc "Cash check received and processed") $
redirect303 (journalLink Nothing) redirect303 (journalLink Nothing)
Left err -> Left err ->
case err of handleClientErr err (Just journalGetCheckLink)
FailureResponse _ resp -> -- case err of
if statusCode (responseStatusCode resp) == 401 -- FailureResponse _ resp ->
then -- if statusCode (responseStatusCode resp) == 401
redirectOverAuth Nothing (Just journalGetCheckLink) Nothing -- then
else -- redirectOverAuth Nothing (Just journalGetCheckLink) Nothing
throwError $ -- else
addMessage (fromString $ show err) $ -- throwError $
redirect303 userSelectLink -- addMessage (fromString $ show err) $
otherErr -> -- redirect303 userSelectLink
throwError $ -- otherErr ->
addMessage (fromString $ show otherErr) $ -- throwError $
redirect303 userSelectLink -- addMessage (fromString $ show otherErr) $
-- redirect303 userSelectLink
Nothing -> Nothing ->
redirectOverAuth Nothing (Just $ journalLink Nothing) Nothing redirectOverAuth Nothing (Just $ journalLink Nothing) Nothing
where where

View file

@ -42,3 +42,23 @@ productGetPriceList mcookie = do
throwError $ throwError $
addMessage (fromString $ show err) $ addMessage (fromString $ show err) $
redirect303 userSelectLink redirect303 userSelectLink
productGetRefill
:: Maybe T.Text
-> UserHandler ProductRefillPage
productGetRefill mcookie = do
(token, muser, loc, l10n, backend) <- controlInit mcookie
case muser of
Just _ -> do
elist <- liftIO $ runClientM
(productShortList (Just MT.AllProducts))
backend
case elist of
Right list -> do
return $ productRefillPage l10n loc mcookie list
Left err ->
throwError $
addMessage (fromString $ show err) $
redirect303 userSelectLink
Nothing ->
redirectOverAuth Nothing (Just productGetRefillLink) Nothing

View file

@ -86,6 +86,8 @@ userApp initState = serveWithContext userApi EmptyContext $
:<|> journalGetCheckControl mcookie :<|> journalGetCheckControl mcookie
:<|> journalPostCheckControl mcookie :<|> journalPostCheckControl mcookie
:<|> productGetPriceList mcookie :<|> productGetPriceList mcookie
:<|> productGetRefill mcookie
:<|> (\_ _ -> error "not yet implemented") mcookie
:<|> authControl mcookie :<|> authControl mcookie
:<|> authPostControl mcookie :<|> authPostControl mcookie
:<|> authLogoutControl mcookie :<|> authLogoutControl mcookie

View file

@ -39,3 +39,24 @@ instance FromForm [MT.PurchaseDetail] where
res = map digestForm kpids res = map digestForm kpids
in in
Right res Right res
instance MimeUnrender HTML [MT.AmountRefill]
instance FromForm [MT.AmountRefill] where
fromForm form =
let kvs = toListStable form
ks = map fst kvs
kpids = filter ("amountRefillproductId" `T.isPrefixOf`) ks
prods = filter ((`notElem` kpids) . fst) kvs
stripPid = snd . T.breakOnEnd "-"
digestForm key =
let pid = read (T.unpack $ stripPid key)
amountSingles = read
(T.unpack . fromJust $
lookup ("amountRefillAmountSingles-" <> stripPid key) prods)
amountCrates = read
(T.unpack . fromJust $
lookup ("amountRefillAmountCrates-" <> stripPid key) prods)
in MT.AmountRefill pid amountSingles amountCrates
res = map digestForm kpids
in
Right res

View file

@ -27,3 +27,5 @@ type CashBuyOverviewPage = H.Html
type CashBuyConfirmPage = H.Html type CashBuyConfirmPage = H.Html
type ProductPriceListPage = H.Html type ProductPriceListPage = H.Html
type ProductRefillPage = H.Html

View file

@ -147,6 +147,7 @@ redirectOverAuth
-> UserHandler UserOverviewPage -> UserHandler UserOverviewPage
redirectOverAuth muid mLink mRefine = do redirectOverAuth muid mLink mRefine = do
let redirectHeaders = errHeaders $ let redirectHeaders = errHeaders $
-- redirect303 authLink
redirect303 (authLink (Just $ "/" <> redirect303 (authLink (Just $ "/" <>
fromString (show $ linkURI (case (mLink, muid) of fromString (show $ linkURI (case (mLink, muid) of
(Just link, _) -> link (Just link, _) -> link
@ -195,3 +196,18 @@ controlInit mcookie = do
l10n <- asks rsL10n l10n <- asks rsL10n
backend <- asks rsBackend backend <- asks rsBackend
return (token, muser, loc, l10n, backend) return (token, muser, loc, l10n, backend)
handleClientErr err authTargetLink =
case err of
FailureResponse _ resp ->
if statusCode (responseStatusCode resp) == 401
then
redirectOverAuth Nothing authTargetLink Nothing
else
throwError $
addMessage (fromString $ show err) $
redirect303 userSelectLink
othererr ->
throwError $
addMessage (fromString $ show othererr) $
redirect303 userSelectLink

View file

@ -2,11 +2,15 @@
{-# LANGUAGE PackageImports #-} {-# LANGUAGE PackageImports #-}
module View.Product where module View.Product where
import Servant.Links
import Data.String (fromString) import Data.String (fromString)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Text.I18n import Data.Text.I18n
import Data.Maybe (fromJust, isJust)
import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as HA import qualified Text.Blaze.Html5.Attributes as HA
@ -53,3 +57,96 @@ productPriceListPage l10n loc mcookie list =
list list
where where
translate = localize l10n loc . gettext translate = localize l10n loc . gettext
productRefillPage
:: L10n
-> Locale
-> Maybe T.Text
-> [MT.ProductShortOverview]
-> ProductRefillPage
productRefillPage l10n loc mcookie prodList =
scaffold l10n loc mcookie (initPage $
translate "Matebeamter" <>
" - " <>
translate "Refill stock"
) $ do
H.form
H.! HA.method "post"
H.! HA.action ("/" <> fromString
(show $ linkURI productPostRefillLink)
)
H.! HA.enctype "application/x-www-form-urlencoded"
$ do
mapM_
(\(MT.ProductShortOverview pid ident price amount ml maid) -> do
H.div
H.! HA.class_ "form-group optional"
H.!?
( isJust maid
, productBgStyle (fromString $ show $ fromJust maid)
)
$ do
H.label
H.! HA.for (
"amount-refill-product-id-" <>
fromString (show pid)
)
$ H.toHtml ident
H.input
H.! HA.id (
"amount-refill-product-id-" <>
fromString (show pid)
)
H.! HA.class_ "form-control product-select"
H.! HA.name (
"amountRefillProductId-" <>
fromString (show pid)
)
H.! HA.type_ "checkbox"
H.! HA.value "true"
H.div
H.! HA.class_ "form-group optional"
$ do
H.label
H.! HA.for (
"amount-refill-amount-singeles-" <>
fromString (show pid)
)
$ H.toHtml (translate "Amount")
H.input
H.! HA.id (
"amount-refill-amount-singles-" <>
fromString (show pid)
)
H.! HA.class_ "form-control product-amount"
H.! HA.name (
"amountRefillAmountSingles- " <>
fromString (show pid)
)
H.! HA.type_ "number"
H.! HA.min "0"
H.! HA.step "1"
H.! HA.value "0"
H.input
H.! HA.id (
"amount-refill-amount-crates-" <>
fromString (show pid)
)
H.! HA.class_ "form-control product-amount"
H.! HA.name (
"amountRefillAmountCrates- " <>
fromString (show pid)
)
H.! HA.type_ "number"
H.! HA.min "0"
H.! HA.step "1"
H.! HA.value "0"
)
prodList
H.div H.! HA.class_ "form-group optional" $
H.button
H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit"
$ H.toHtml $ translate "Submit"
where
translate = localize l10n loc . gettext