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)

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