{-# 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] -> UserSelectPage userSelectPage l10n locale uss = scaffold l10n locale (initPage $ translate "Matebeamter" <> " - " <> translate "Home" ) $ do mapM_ (\(MT.UserSummary uid ident _) -> H.a H.! HA.href ("/" <> fromString (show $ linkURI $ userOverviewLink uid Nothing)) $ H.toHtml ident ) uss H.a 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] -> UserOverviewPage userOverviewPage l10n locale method ud pos = scaffold l10n locale (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) -- TODO: Add currency 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 -> 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 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 where translate = localize l10n locale . gettext userSettingsPointer :: L10n -> Locale -> Int -> H.Html userSettingsPointer l10n locale uid = H.a H.! HA.href ("/" <> fromString (show $ linkURI $ userManageLink uid)) $ 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_ (\(MT.ProductShortOverview pid ident _ _ _ avatarid) -> 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 userNewPage :: L10n -> Locale -> UserNewPage userNewPage l10n locale = scaffold l10n locale (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 userManagePage :: L10n -> Locale -> MT.UserDetails -> [MT.AuthOverview] -> UserManagePage userManagePage l10n locale userDetails authOverviews = scaffold l10n locale (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