matebeamter/src/View/User.hs

{-# 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
    case method of
      MT.PrimaryPass ->
        userSettingsPointer
      MT.SecondaryPass ->
        productList
      MT.ChallengeResponse -> do
        userSettingsPointer
        productList
  where
    translate = localize l10n locale . gettext
    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;"
      ]
    userSettingsPointer =
      H.a H.! HA.href ("/" <> (fromString $ show $ linkURI $ userManageLink)) $
        H.toHtml $ translate "Manage user settings"
    productList =
      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

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))
        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))
            H.! HA.enctype "application/x-www-form-urlencoded" $ H.fieldset $ do
              H.legend $ H.toHtml $ comment
              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))
          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