preapre buy page(s)

This commit is contained in:
nek0 2019-10-21 20:41:58 +02:00
parent 18571fa201
commit 6ba45b564e
4 changed files with 127 additions and 116 deletions

View File

@ -36,6 +36,7 @@ executable matebeamter
, View.Scaffold
, View.Auth
, View.User
, View.Buy
-- other-extensions:
build-depends: base ^>=4.12.0.0
, mateamt

View File

@ -96,13 +96,18 @@ userOverviewControl mcookie uid mRefine = do
(token, mAuthUser) = parseTokenAndUser mcookie
mMethod = T.unpack <$>
(lookup "x-method" =<< mParsedCookie)
getProducts = liftIO $ runClientM
(productShortList mRefine)
backend
euser <- liftIO $
runClientM
(userGet (mkAuthenticatedRequest token authenticateReq))
backend
eproducts <- liftIO $ runClientM
(productShortList mRefine)
backend
eproducts <- case fmap toEnum (fmap read mMethod) of
Just MT.PrimaryPass -> return (Right [])
Just MT.SecondaryPass -> getProducts
Just MT.ChallengeResponse -> getProducts
_ -> return (Right [])
case (euser, eproducts) of
(Right ud, Right prods) ->
case mMethod of
@ -210,7 +215,7 @@ userManageAuthDeleteControl
-> AuthDetailId
-> UserHandler UserOverviewPage
userManageAuthDeleteControl mcookie uid (AuthDetailId adid) = do
(ReadState _ backend _) <- ask
backend <- asks rsBackend
let (token, mAuthUser) = parseTokenAndUser mcookie
eReturn <- liftIO $ runClientM
(authManageDeleteAuth (mkAuthenticatedRequest token authenticateReq) adid)
@ -221,7 +226,7 @@ userManageAuthDeleteControl mcookie uid (AuthDetailId adid) = do
FailureResponse _ resp ->
if statusCode (responseStatusCode resp) == 406
then
throwError $ redirect303 $ userManageLink uid
throwError (redirect303 $ userManageLink uid)
else
handleErrors (fmap read mAuthUser) Nothing [Just err]
_ -> handleErrors (fmap read mAuthUser) (Just userSelectLink) [Just err]

View File

@ -10,6 +10,8 @@ import Servant hiding (addHeader)
import Servant.Client
import Servant.Client.Core.Request
import qualified Text.Blaze.Html5.Attributes as HA
import qualified Data.Text as T
import Data.Text.Lazy.Encoding
@ -131,3 +133,13 @@ redirectOverAuth muid mLink mRefine = do
]
}
)
productBgStyle aid = HA.style $ mconcat
[ "background-image: url(#" <> aid <> ");" -- FILLME
, "backgronud-color: blue;"
, "text-shadow:"
, " -1px 0 1px black,"
, " 0 1px 1px black,"
, " 1px 0 1px black,"
, " 0 -1px 1px black;"
]

View File

@ -24,6 +24,7 @@ import qualified "mateamt" Types as MT
import Util
import Types
import View.Scaffold
import View.Buy
import API
userSelectPage
@ -79,10 +80,10 @@ userOverviewPage l10n locale method ud pos = scaffold l10n locale (initPage $
MT.PrimaryPass ->
userSettingsPointer l10n locale (MT.userDetailsId ud)
MT.SecondaryPass ->
productList pos
buyProductsForm l10n locale pos
MT.ChallengeResponse -> do
userSettingsPointer l10n locale (MT.userDetailsId ud)
productList pos
buyProductsForm l10n locale pos
where
translate = localize l10n locale . gettext
@ -113,16 +114,6 @@ productList pos =
H.toHtml ident
)
pos
where
productBgStyle aid = HA.style $ mconcat
[ "background-image: url(#" <> aid <> ");" -- FILLME
, "backgronud-color: blue;"
, "text-shadow:"
, " -1px 0 1px black,"
, " 0 1px 1px black,"
, " 1px 0 1px black,"
, " 0 -1px 1px black;"
]
userNewPage
:: L10n
@ -182,115 +173,117 @@ userManagePage l10n locale userDetails authOverviews =
translate "Matebeamter" <>
" - " <>
translate "Manage user data"
) $ H.p $ H.form
H.! HA.method "post"
H.! HA.action ("/" <>
fromString (show $ linkURI $
userManageDetailsSubmitLink (MT.userDetailsId userDetails)))
H.! HA.enctype "application/x-www-form-urlencoded" $ H.fieldset $ do
H.legend $ H.toHtml $ translate "User details"
H.div H.! HA.class_ "form-group required" $ do
H.label H.! HA.for "username" $ H.toHtml $ translate "Username"
H.input
H.! HA.id "username"
H.! HA.class_ "form-control"
H.! HA.name "userDetailsSubmitIdent"
H.! HA.type_ "text"
H.! HA.required ""
H.! HA.value
(fromString $ T.unpack $ MT.userDetailsIdent userDetails)
H.div H.! HA.class_ "form-group optional" $ do
H.label H.! HA.for "useremail" $ H.toHtml $ translate "Email"
H.input
H.! HA.id "useremail"
H.! HA.class_ "form-control"
H.! HA.name "userDetailsSubmitEmail"
H.! HA.type_ "email"
H.! HA.required ""
H.! HA.value
(maybe "" (fromString . T.unpack)
(MT.userDetailsEmail userDetails))
H.div H.! HA.class_ "form-group optional" $
H.button
H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit"
$ H.toHtml $ translate "Submit"
H.p $ do
mapM_
(\(MT.AuthOverview aoid comment method) -> H.form
H.! HA.method "post"
H.! HA.action ("/" <>
fromString (show $ linkURI $
userManageAuthDeleteLink (MT.userDetailsId userDetails)))
H.! HA.enctype "application/x-www-form-urlencoded" $ H.fieldset $ do
H.legend $ H.toHtml (comment <> " - " <> case method of
MT.PrimaryPass ->
translate "Primary password"
MT.SecondaryPass ->
translate "Secondary password"
MT.ChallengeResponse ->
translate "Challenge response authentication"
)
H.div H.! HA.class_ "form-group required" $
H.input
H.! HA.class_ "form-control"
H.! HA.name "unId"
H.! HA.type_ "hidden"
H.! HA.required ""
H.! HA.value (fromString $ show aoid)
H.div H.! HA.class_ "form-group optional" $
H.button
H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit"
$ H.toHtml $ translate "Delete"
)
authOverviews
H.form
) $ H.p $ do
H.form
H.! HA.method "post"
H.! HA.action ("/" <>
fromString (show $ linkURI $
userManageDetailsSubmitLink (MT.userDetailsId userDetails)))
H.! HA.enctype "application/x-www-form-urlencoded" $ H.fieldset $ do
H.legend $ H.toHtml $ translate "User details"
H.div H.! HA.class_ "form-group required" $ do
H.label H.! HA.for "username" $ H.toHtml $ translate "Username"
H.input
H.! HA.id "username"
H.! HA.class_ "form-control"
H.! HA.name "userDetailsSubmitIdent"
H.! HA.type_ "text"
H.! HA.required ""
H.! HA.value
(fromString $ T.unpack $ MT.userDetailsIdent userDetails)
H.div H.! HA.class_ "form-group optional" $ do
H.label H.! HA.for "useremail" $ H.toHtml $ translate "Email"
H.input
H.! HA.id "useremail"
H.! HA.class_ "form-control"
H.! HA.name "userDetailsSubmitEmail"
H.! HA.type_ "email"
H.! HA.required ""
H.! HA.value
(maybe "" (fromString . T.unpack)
(MT.userDetailsEmail userDetails))
H.div H.! HA.class_ "form-group optional" $
H.button
H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit"
$ H.toHtml $ translate "Submit"
H.p $ do
H.toHtml $ translate "Authentication details"
mapM_
(\(MT.AuthOverview aoid comment method) -> H.form
H.! HA.method "post"
H.! HA.action ("/" <>
fromString (show $ linkURI $
userManageAuthCreateLink (MT.userDetailsId userDetails)))
userManageAuthDeleteLink (MT.userDetailsId userDetails)))
H.! HA.enctype "application/x-www-form-urlencoded" $ H.fieldset $ do
H.legend $ H.toHtml $ translate "Authentication details"
H.div H.! HA.class_ "form-group required" $ do
H.label H.! HA.for "comment" $ H.toHtml $
translate "Comment"
H.legend $ H.toHtml (comment <> " - " <> case method of
MT.PrimaryPass ->
translate "Primary password"
MT.SecondaryPass ->
translate "Secondary password"
MT.ChallengeResponse ->
translate "Challenge response authentication"
)
H.div H.! HA.class_ "form-group required" $
H.input
H.! HA.id "comment"
H.! HA.class_ "form_control"
H.! HA.name "authSubmitReturnComment"
H.! HA.type_ "text"
H.! HA.required ""
H.! HA.value ""
H.div H.! HA.class_ "form-group required" $ do
H.label H.! HA.for "password" $ H.toHtml $
translate "Password"
H.input
H.! HA.id "password"
H.! HA.class_ "form_control"
H.! HA.name "authSubmitReturnPass"
H.! HA.type_ "password"
H.! HA.required ""
H.! HA.value ""
H.div H.! HA.class_ "form-group required" $ do
H.label H.! HA.for "method" $ H.toHtml $
translate "Authentication Method"
H.select
H.! HA.id "method"
H.! HA.class_ "form-control"
H.! HA.name "authSubmitReturnMethod"
H.! HA.name "unId"
H.! HA.type_ "hidden"
H.! HA.required ""
H.! HA.value (fromString $ show $ fromEnum MT.SecondaryPass) $ do
H.option H.!
HA.value (fromString $ show $ fromEnum MT.SecondaryPass) $
H.toHtml $ translate "Secondary password"
H.option H.!
HA.value (fromString $ show $ fromEnum MT.PrimaryPass) $
H.toHtml $ translate "Primary password"
H.! HA.value (fromString $ show aoid)
H.div H.! HA.class_ "form-group optional" $
H.button
H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit"
$ H.toHtml $ translate "Submit"
$ H.toHtml $ translate "Delete"
)
authOverviews
H.form
H.! HA.method "post"
H.! HA.action ("/" <>
fromString (show $ linkURI $
userManageAuthCreateLink (MT.userDetailsId userDetails)))
H.! HA.enctype "application/x-www-form-urlencoded" $ H.fieldset $ do
H.legend $ H.toHtml $ translate "New authentication"
H.div H.! HA.class_ "form-group required" $ do
H.label H.! HA.for "comment" $ H.toHtml $
translate "Comment"
H.input
H.! HA.id "comment"
H.! HA.class_ "form_control"
H.! HA.name "authSubmitReturnComment"
H.! HA.type_ "text"
H.! HA.required ""
H.! HA.value ""
H.div H.! HA.class_ "form-group required" $ do
H.label H.! HA.for "password" $ H.toHtml $
translate "Password"
H.input
H.! HA.id "password"
H.! HA.class_ "form_control"
H.! HA.name "authSubmitReturnPass"
H.! HA.type_ "password"
H.! HA.required ""
H.! HA.value ""
H.div H.! HA.class_ "form-group required" $ do
H.label H.! HA.for "method" $ H.toHtml $
translate "Authentication Method"
H.select
H.! HA.id "method"
H.! HA.class_ "form-control"
H.! HA.name "authSubmitReturnMethod"
H.! HA.required ""
H.! HA.value (fromString $ show $ fromEnum MT.SecondaryPass) $ do
H.option H.!
HA.value (fromString $ show $ fromEnum MT.SecondaryPass) $
H.toHtml $ translate "Secondary password"
H.option H.!
HA.value (fromString $ show $ fromEnum MT.PrimaryPass) $
H.toHtml $ translate "Primary password"
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 locale . gettext