matebeamter/src/View/User.hs

300 lines
10 KiB
Haskell
Raw Normal View History

2019-09-08 10:48:57 +00:00
{-# LANGUAGE OverloadedStrings #-}
2019-09-08 15:27:38 +00:00
{-# LANGUAGE PackageImports #-}
2019-09-08 10:48:57 +00:00
module View.User where
2019-09-16 07:44:46 +00:00
import Servant.Links
2019-09-11 04:27:54 +00:00
import qualified Text.Blaze.Html5 as H hiding (style)
2019-09-17 19:29:56 +00:00
import qualified Text.Blaze.Html5.Attributes as HA
2019-09-08 15:27:38 +00:00
import qualified Data.Text as T
2019-09-08 15:27:38 +00:00
import Data.Text.I18n
import Data.String (fromString)
2019-10-16 16:07:12 +00:00
import Data.Maybe (isJust, fromJust)
2019-09-11 04:27:54 +00:00
2019-09-08 15:27:38 +00:00
-- imports from mateamt
import qualified "mateamt" Types as MT
-- internal imports
2019-09-08 10:48:57 +00:00
2019-09-11 04:27:54 +00:00
import Util
2019-09-08 10:48:57 +00:00
import Types
2019-09-08 15:27:38 +00:00
import View.Scaffold
2019-10-21 18:41:58 +00:00
import View.Buy
2019-09-16 07:44:46 +00:00
import API
2019-09-08 10:48:57 +00:00
2019-09-11 04:27:54 +00:00
userSelectPage
2019-09-08 15:27:38 +00:00
:: L10n
-> Locale
-> [MT.UserSummary]
2019-09-11 04:27:54 +00:00
-> UserSelectPage
userSelectPage l10n locale uss = scaffold l10n locale (initPage $
2019-10-16 16:07:12 +00:00
translate "Matebeamter" <>
2019-09-11 04:27:54 +00:00
" - " <>
2019-10-16 16:07:12 +00:00
translate "Home"
2019-09-16 07:44:46 +00:00
) $ do
2019-10-16 16:07:12 +00:00
mapM_ (\(MT.UserSummary uid ident _) ->
H.a H.! HA.href ("/" <> fromString (show $ linkURI $
userOverviewLink uid Nothing)) $
H.toHtml ident
2019-09-16 07:44:46 +00:00
) uss
2019-10-16 16:07:12 +00:00
H.a H.! HA.href ("/" <> fromString (show $ linkURI userNewLink)) $
2019-09-17 19:29:56 +00:00
H.toHtml $ translate "New user"
2019-09-16 07:44:46 +00:00
where
translate = localize l10n locale . gettext
2019-09-11 04:27:54 +00:00
userOverviewPage
:: L10n
-> Locale
-> MT.AuthMethod
2019-09-11 04:27:54 +00:00
-> MT.UserDetails
-> [MT.ProductShortOverview]
-> UserOverviewPage
userOverviewPage l10n locale method ud pos = scaffold l10n locale (initPage $
2019-10-16 16:07:12 +00:00
localize l10n locale (gettext "Matebeamter") <>
2019-09-11 04:27:54 +00:00
" - " <>
2019-10-16 16:07:12 +00:00
localize l10n locale (gettext "User Menu for ") <>
MT.userDetailsIdent ud
2019-09-11 04:27:54 +00:00
) $ do
2019-10-16 16:07:12 +00:00
H.p $ H.toHtml $ translate "Welcome back, " <> MT.userDetailsIdent ud
2019-09-11 04:27:54 +00:00
<> "!"
2019-09-17 19:29:56 +00:00
H.p H.!? (MT.userDetailsBalance ud < 0, HA.class_ "debt") $ H.toHtml $
2019-10-16 16:07:12 +00:00
translate "Your current balance is" <>
2019-09-11 04:27:54 +00:00
": " <>
2019-10-16 16:07:12 +00:00
formatMoney (MT.userDetailsBalance ud)
2019-09-11 04:27:54 +00:00
-- TODO: Add currency symbol
2019-10-14 18:10:30 +00:00
H.p $ H.form
H.! HA.method "post"
2019-10-16 16:07:12 +00:00
H.! HA.action ("/" <> fromString (show $ linkURI authLogoutLink))
H.! HA.enctype "application/x-www-form-urlencoded" $
H.div H.! HA.class_ "form-group optional" $
2019-10-14 18:10:30 +00:00
H.button
H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit"
$ H.toHtml $ translate "Logout"
case method of
MT.PrimaryPass ->
2019-10-15 06:38:32 +00:00
userSettingsPointer l10n locale (MT.userDetailsId ud)
MT.SecondaryPass ->
H.form
H.! HA.method "post"
H.! HA.action ("/" <> (fromString $ show $ linkURI $
buyLink (MT.userDetailsId ud)))
H.! HA.enctype "application/x-www-form-urlencoded" $
buyProductsForm l10n locale pos
MT.ChallengeResponse -> do
2019-10-15 06:38:32 +00:00
userSettingsPointer l10n locale (MT.userDetailsId ud)
H.form
H.! HA.method "post"
H.! HA.action ("/" <> (fromString $ show $ linkURI $
buyLink (MT.userDetailsId ud)))
H.! HA.enctype "application/x-www-form-urlencoded" $
buyProductsForm l10n locale pos
2019-09-11 04:27:54 +00:00
where
translate = localize l10n locale . gettext
2019-10-14 18:11:45 +00:00
userSettingsPointer
:: L10n
-> Locale
2019-10-15 06:38:32 +00:00
-> Int
2019-10-14 18:11:45 +00:00
-> H.Html
2019-10-15 06:38:32 +00:00
userSettingsPointer l10n locale uid =
2019-10-16 16:07:12 +00:00
H.a H.! HA.href ("/" <> fromString (show $ linkURI $ userManageLink uid)) $
2019-10-14 18:11:45 +00:00
H.toHtml $ translate "Manage user settings"
where
translate = localize l10n locale . gettext
productList
:: [MT.ProductShortOverview]
-> H.Html
productList pos =
H.p $
H.ul H.! HA.class_ "product_list" $
mapM_
2019-10-16 16:07:12 +00:00
(\(MT.ProductShortOverview pid ident _ _ _ avatarid) ->
2019-10-14 18:11:45 +00:00
H.li H.! HA.class_ "product" H.!?
(isJust avatarid
, productBgStyle (fromString $ show $ fromJust avatarid)
) $
H.a H.! HA.href ("#" <> fromString (show pid)) $
H.toHtml ident
)
pos
2019-09-17 19:29:56 +00:00
userNewPage
:: L10n
-> Locale
-> UserNewPage
userNewPage l10n locale = scaffold l10n locale (initPage $
2019-10-16 16:07:12 +00:00
translate "Matebeamter" <>
2019-09-17 19:29:56 +00:00
" - " <>
2019-10-16 16:07:12 +00:00
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
userManagePage
:: L10n
-> Locale
-> MT.UserDetails
-> [MT.AuthOverview]
-> UserManagePage
userManagePage l10n locale userDetails authOverviews =
scaffold l10n locale (initPage $
translate "Matebeamter" <>
" - " <>
translate "Manage user data"
2019-10-21 18:41:58 +00:00
) $ 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 ("/" <>
2019-10-16 16:07:12 +00:00
fromString (show $ linkURI $
2019-10-21 18:41:58 +00:00
userManageAuthDeleteLink (MT.userDetailsId userDetails)))
H.! HA.enctype "application/x-www-form-urlencoded" $ H.fieldset $ do
2019-10-21 18:41:58 +00:00
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" $
2019-10-16 16:07:12 +00:00
H.input
H.! HA.class_ "form-control"
2019-10-21 18:41:58 +00:00
H.! HA.name "unId"
H.! HA.type_ "hidden"
H.! HA.required ""
2019-10-21 18:41:58 +00:00
H.! HA.value (fromString $ show aoid)
2019-10-16 16:07:12 +00:00
H.div H.! HA.class_ "form-group optional" $
H.button
H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit"
2019-10-21 18:41:58 +00:00
$ 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