{-# 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, fromMaybe) -- imports from mateamt import qualified "mateamt" Types as MT -- internal imports import Util import Types import View.Scaffold 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 _) -> do 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" $ do H.div H.! HA.class_ "form-group optional" $ do 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 -> productList pos MT.ChallengeResponse -> do userSettingsPointer l10n locale (MT.userDetailsId ud) productList 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) -> do 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 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 -> Locale -> UserNewPage userNewPage l10n locale = scaffold l10n locale (initPage $ (translate "Matebeamter") <> " - " <> (translate "Create new user") ) $ do 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" $ do 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") ) $ do 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 (fromMaybe "" $ fromString <$> T.unpack <$> MT.userDetailsEmail userDetails) H.div H.! HA.class_ "form-group optional" $ do 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" $ do 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" $ do 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 "Authentication details" 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" $ do H.button H.! HA.class_ "btn btn-default" H.! HA.type_ "submit" $ H.toHtml $ translate "Submit" where translate = localize l10n locale . gettext