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
    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