matebeamter/src/View/User.hs

387 lines
13 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
module View.User where
import Servant.Links
import qualified Text.Blaze.Html5 as H hiding (style)
import qualified Text.Blaze.Html5.Attributes as HA
import qualified Data.Text as T
import Data.Text.I18n
import Data.String (fromString)
import Data.Maybe (isJust, fromJust)
-- imports from mateamt
import qualified "mateamt" Types as MT
-- internal imports
import Util
import Types
import View.Scaffold
import View.Buy
import API
userSelectPage
:: L10n
-> Locale
-> [MT.UserSummary]
-> T.Text
-> Maybe T.Text
-> UserSelectPage
userSelectPage l10n locale uss version mcookie =
scaffold l10n locale version mcookie (initPage $
translate "Matebeamter" <>
" - " <>
translate "Home"
) $ H.ul
H.! HA.class_ "tile-list"
$ do
H.li H.! HA.class_ "tile" $ H.a
H.! HA.class_ "tile-content function"
H.! HA.href ("/" <> fromString
(show $ linkURI $ cashBuyLink Nothing)
) $
H.toHtml $ translate "Buy with cash"
mapM_ (\(MT.UserSummary uid ident _) ->
H.li H.! HA.class_ "tile" $ H.a
H.! HA.class_ "tile-content"
H.! HA.href ("/" <> fromString (show $ linkURI $
userOverviewLink uid Nothing)) $
H.toHtml ident
) uss
H.li H.! HA.class_ "tile" $ H.a
H.! HA.class_ "tile-content function"
H.! HA.href ("/" <> fromString (show $ linkURI userNewLink)) $
H.toHtml $ translate "New user"
where
translate = localize l10n locale . gettext
userOverviewPage
:: L10n
-> Locale
-> MT.AuthMethod
-> MT.UserDetails
-> [MT.ProductShortOverview]
-> T.Text
-> Maybe T.Text
-> T.Text
-> UserOverviewPage
userOverviewPage l10n locale method ud pos version mcookie symbol =
scaffold l10n locale version mcookie (initPage $
localize l10n locale (gettext "Matebeamter") <>
" - " <>
localize l10n locale (gettext "User Menu for ") <>
MT.userDetailsIdent ud
) $ do
H.p $ H.toHtml $ translate "Welcome back, " <> MT.userDetailsIdent ud
<> "!"
H.p H.!? (MT.userDetailsBalance ud < 0, HA.class_ "debt") $ H.toHtml $
translate "Your current balance is" <>
": " <>
formatMoney (MT.userDetailsBalance ud) <> symbol
H.p $ H.form
H.! HA.method "post"
H.! HA.action ("/" <> fromString (show $ linkURI authLogoutLink))
H.! HA.enctype "application/x-www-form-urlencoded" $
H.div H.! HA.class_ "form-group optional" $
H.button
H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit"
$ H.toHtml $ translate "Logout"
case method of
MT.PrimaryPass ->
userSettingsPointer l10n locale (MT.userDetailsId ud)
MT.SecondaryPass ->
buyForm
MT.ChallengeResponse -> do
userSettingsPointer l10n locale (MT.userDetailsId ud)
buyForm
where
translate = localize l10n locale . gettext
buyForm = do
H.div $ H.form $
H.button
H.! HA.type_ "submit"
H.! HA.formmethod "get"
H.! HA.formaction ("/" <>
fromString
(show $ linkURI $ userRechargeLink $ MT.userDetailsId ud))
$ H.toHtml $ translate "Recharge Credit"
H.form
H.! HA.method "post"
H.! HA.action ("/" <> fromString (show $ linkURI $
buyLink (MT.userDetailsId ud) False)
)
H.! HA.enctype "application/x-www-form-urlencoded" $
buyProductsForm l10n locale pos
userSettingsPointer
:: L10n
-> Locale
-> Int
-> H.Html
userSettingsPointer l10n locale uid =
H.form $ do
H.button
H.! HA.type_ "submit"
H.! HA.formmethod "get"
H.! HA.formaction
("/" <> fromString (show $ linkURI $ userManageLink uid))
$ H.toHtml $ translate "Manage user settings"
H.button
H.! HA.type_ "submit"
H.! HA.formmethod "get"
H.! HA.formaction
("/" <> fromString (show $ linkURI $ journalLink Nothing))
$ H.toHtml $ translate "View Journal"
H.button
H.! HA.type_ "submit"
H.! HA.formmethod "get"
H.! HA.formaction
("/" <> fromString (show $ linkURI productGetNewLink))
$ H.toHtml $ translate "Add new product"
where
translate = localize l10n locale . gettext
productList
:: [MT.ProductShortOverview]
-> H.Html
productList pos =
H.p $
H.ul H.! HA.class_ "tile-list" $
mapM_
(\(MT.ProductShortOverview pid ident _ _ _ avatarid) ->
H.li
H.! HA.class_ "tile"
H.!?
(isJust avatarid
, productBgStyle (fromString $ show $ fromJust avatarid)
) $
H.a
H.! HA.class_ "tile-content"
H.! HA.href ("#" <> fromString (show pid)) $
H.toHtml ident
)
pos
userNewPage
:: L10n
-> Locale
-> T.Text
-> Maybe T.Text
-> UserNewPage
userNewPage l10n locale version mcookie =
scaffold l10n locale version mcookie (initPage $
translate "Matebeamter" <>
" - " <>
translate "Create new user"
) $ H.p $ H.form
H.! HA.method "post"
H.! HA.action ("/" <> fromString (show $ linkURI userNewPostLink))
H.! HA.enctype "application/x-www-form-urlencoded" $ do
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 "userSubmitIdent"
H.! HA.type_ "text"
H.! HA.required ""
H.! HA.value ""
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 "userSubmitEmail"
H.! HA.type_ "email"
H.! HA.required ""
H.! HA.value ""
H.div H.! HA.class_ "form-group required" $ do
H.label H.! HA.for "userpass" $ H.toHtml $ translate "Password"
H.input
H.! HA.id "userpass"
H.! HA.class_ "form-control"
H.! HA.name "userSubmitPassHash"
H.! HA.type_ "password"
H.! HA.required ""
H.! HA.value ""
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
userRechargePage
:: L10n
-> Locale
-> T.Text
-> Maybe T.Text
-> Int
-> T.Text
-> UserRechargePage
userRechargePage l10n locale version mcookie uid symbol =
scaffold l10n locale version mcookie (initPage $
translate "Matebeamter" <>
" - " <>
translate "Recharge account"
) $ H.p $ H.form
H.! HA.method "post"
H.! HA.action ("/" <>
fromString (show $ linkURI $ userPostRechargeLink uid))
H.! HA.enctype "aplication/x-www-form-urlencoded" $ do
H.div H.! HA.class_ "form-group required" $ do
H.label H.! HA.for "recharge-amount" $ H.toHtml $ translate "Amount"
H.input
H.! HA.id "recharde-amount"
H.! HA.class_ "form-control"
H.! HA.name "userRechargeAmount"
H.! HA.type_ "number"
H.! HA.min "0"
H.! HA.step "0.01"
H.! HA.value "0"
H.toHtml symbol
H.div H.! HA.class_ "form-group optional" $
H.button
H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit"
$ H.toHtml $ translate "Recharge"
where
translate = localize l10n locale . gettext
userManagePage
:: L10n
-> Locale
-> MT.UserDetails
-> [MT.AuthOverview]
-> T.Text
-> Maybe T.Text
-> UserManagePage
userManagePage l10n locale userDetails authOverviews version mcookie =
scaffold l10n locale version mcookie (initPage $
translate "Matebeamter" <>
" - " <>
translate "Manage user data"
) $ 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 $
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.! 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