I did way too much here. Polishing, fixing redirection etc.

matebeamter.cabal

@@ -46,6 +46,7 @@ executable matebeamter
                      , View.Buy
                      , View.Journal
                      , View.Product
+                     , Paths_matebeamter
   -- other-extensions:
   build-depends:       base ^>=4.12.0.0
                      , mateamt

src/API.hs

@@ -27,7 +27,8 @@ import qualified "mateamt" Types as MT
 import Types
 
 type UserAPI =
-  Header "Cookie" T.Text :> (Get '[HTML] UserSelectPage
+  Header "Cookie" T.Text :> (
+  QueryParam "refine" MT.UserRefine :> Get '[HTML] UserSelectPage
   :<|> "user" :> Capture "id" Int :> QueryParam "refine" MT.ProductRefine
     :> Get '[HTML] UserOverviewPage
   :<|> "user" :> Capture "id" Int :> "buy"

src/Control/Auth.hs

@@ -117,9 +117,10 @@ authPostControl
   -> Maybe T.Text
   -> AuthReturn
   -> UserHandler UserSelectPage
-authPostControl (Just cookies) mDestination (AuthReturn pass method) = do
+authPostControl mcookies@(Just cookies) mDestination (AuthReturn pass method) = do
   let mticket = lookup ("x-ticket-" <> fromString (show method)) $
         parseCookieText cookies
+  (_, _, loc, l10n, _, _, _) <- controlInit mcookies
   case mticket of
     Just ticket -> do
       (ReadState _ backend _ _ _) <- ask
@@ -145,7 +146,7 @@ authPostControl (Just cookies) mDestination (AuthReturn pass method) = do
                       (read $ T.unpack user)
                       Nothing
                       )
-                _ -> errHeaders $ redirect303 userSelectLink
+                _ -> errHeaders $ redirect303 (userSelectLink Nothing)
           throwError $ err303
             { errHeaders = headers ++
               [ ( "Set-Cookie"
@@ -158,15 +159,18 @@ authPostControl (Just cookies) mDestination (AuthReturn pass method) = do
                 , "x-method=" <> fromString (show $ fromEnum method) <>";Path=/")
               ]
             }
-        Right MT.Denied -> throwError $ err401
+        Right MT.Denied -> throwError (
-          { errBody = "Authentication failed!"
+          addMessage (translate l10n loc "Authentication failed!") $
-          }
+          redirect303 (userSelectLink Nothing)
+          )
         Left err -> throwError $ err500
           { errBody = fromString $ show err
           }
     Nothing -> throwError $ err400
       { errBody = "No ticket cookie present."
       }
+  where
+    translate l10n locale = localize l10n locale . gettext
 authPostControl Nothing _ _ = throwError $ err400
   { errBody = "No ticket cookie present."
   }
@@ -184,7 +188,7 @@ authLogoutControl mcookie = do
     backend
   case eReturn of
     Right _ -> do
-      let redirectHeaders = errHeaders (redirect303 userSelectLink)
+      let redirectHeaders = errHeaders (redirect303 $ userSelectLink Nothing)
           unsetCookiesHeaders = map
             (\c ->
               ( "Set-Cookie"

src/Control/Buy.hs

@@ -42,14 +42,14 @@ buyControl
   -> [MT.PurchaseDetail]
   -> Bool
   -> UserHandler BuyConfirmPage
-buyControl mcookie uid pds forceBuy =
+buyControl mcookie uid pds forceBuy = do
+  (ReadState l10n backend _ symbol version) <- ask
+  let (token, _) = parseTokenAndUser mcookie
+      loc = Locale
+        (fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
   if not (null pds)
   then do
-    (ReadState l10n backend _ symbol version) <- ask
+    let pids = map MT.purchaseDetailProduct pds
-    let (token, _) = parseTokenAndUser mcookie
-        loc = Locale
-          (fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
-        pids = map MT.purchaseDetailProduct pds
     epsovs <- liftIO $ runClientM
       (productShortList (Just MT.AllProducts))
       backend
@@ -85,9 +85,14 @@ buyControl mcookie uid pds forceBuy =
       Left err ->
         throwError $
           addMessage (fromString $ show err) $
-          redirect303 userSelectLink
+          redirect303 (userSelectLink Nothing)
   else
-    throwError (redirect303 $ userOverviewLink uid Nothing)
+    throwError (
+      addMessage (translate l10n loc "Please select items for purchase") $
+      redirect303 (userOverviewLink uid Nothing)
+      )
+  where
+    translate l10n locale = localize l10n locale . gettext
 
 purchaseControl
   :: Maybe T.Text
@@ -179,7 +184,7 @@ purchaseControl mcookie uid pds forceBuy = do
         backend
       throwError
         $ addMessage message
-        $ redirect303 userSelectLink
+        $ redirect303 (userSelectLink Nothing)
     translate l10n locale = localize l10n locale . gettext
 
 cashBuyOverviewControl
@@ -240,7 +245,7 @@ cashBuyPurchaseControl mcookie {-forceBuy-} pds = do
             addMessage
               (translate l10n loc "Please Pay" <>
                 ": " <> formatMoney price <> symbol) $
-              redirect303 userSelectLink
+              redirect303 (userSelectLink Nothing)
         (MT.PurchaseResult (MT.PayAmount price) miss) -> do
           eproducts <- liftIO $ runClientM
             (productShortList
@@ -268,13 +273,13 @@ cashBuyPurchaseControl mcookie {-forceBuy-} pds = do
                     []
                     prods
                   ))
-                $ redirect303 userSelectLink
+                $ redirect303 (userSelectLink Nothing)
             Left err ->
               throwError $ err500
                 { errBody = fromString (show err)
                 }
       Left err ->
-        handleClientErr err Nothing (Just userSelectLink)
+        handleClientErr err Nothing (Just (userSelectLink Nothing))
   else
     throwError
       $ addMessage (translate l10n loc "Please choose your product(s)")

src/Control/Journal.hs

@@ -59,11 +59,11 @@ journalControl mcookie mpage = do
               else
                 throwError $
                   addMessage (fromString $ show err) $
-                  redirect303 userSelectLink
+                  redirect303 (userSelectLink Nothing)
             othererr -> 
               throwError $
                 addMessage (fromString $ show othererr) $
-                redirect303 userSelectLink
+                redirect303 (userSelectLink Nothing)
     Nothing ->
       redirectOverAuth Nothing (Just $ journalLink mpage) Nothing
 

src/Control/Product.hs

@@ -45,7 +45,7 @@ productGetPriceList mcookie mrefine = do
     Left err ->
       throwError $
         addMessage (fromString $ show err) $
-        redirect303 userSelectLink
+        redirect303 (userSelectLink Nothing)
 
 productGetRefill
   :: Maybe T.Text
@@ -63,7 +63,7 @@ productGetRefill mcookie = do
         Left err ->
           throwError $
             addMessage (fromString $ show err) $
-            redirect303 userSelectLink
+            redirect303 (userSelectLink Nothing)
     Nothing ->
       redirectOverAuth Nothing (Just productGetRefillLink) Nothing
 

src/Control/User.hs

@@ -36,13 +36,16 @@ import Hash
 import API
 import Util
 
-userSelectControl :: Maybe T.Text -> UserHandler UserSelectPage
+userSelectControl
-userSelectControl mcookie = do
+  :: Maybe T.Text
+  -> Maybe MT.UserRefine
+  -> UserHandler UserSelectPage
+userSelectControl mcookie mrefine = do
   (ReadState l10n backend _ symbol version) <- ask
   let loc = Locale
         (fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
   euser <- liftIO $ runClientM
-    (userList Nothing)
+    (userList mrefine)
     backend
   case euser of
     Right uss ->
@@ -69,7 +72,7 @@ userNewPostControl _ us@(MT.UserSubmit _ _ pass) = do
       { MT.userSubmitPassHash = hashedPass
       })
     backend
-  throwError $ redirect303 userSelectLink
+  throwError $ redirect303 (userSelectLink Nothing)
 
 userOverviewControl
   :: Maybe T.Text
@@ -266,4 +269,5 @@ userManageAuthDeleteControl mcookie uid (AuthDetailId adid) = do
           throwError (redirect303 $ userManageLink uid)
         else
           handleErrors (fmap read mAuthUser) Nothing [Just err]
-      _ -> handleErrors (fmap read mAuthUser) (Just userSelectLink) [Just err]
+      _ -> handleErrors (fmap read mAuthUser) (Just $ userSelectLink Nothing)
+        [Just err]

src/Types/Page.hs

@@ -39,7 +39,12 @@ initPage title = Page
   (H.link
     H.! HA.rel "stylesheet"
     H.! HA.type_ "text/css"
-    H.! HA.href "/static/css/style.css"
+    H.! HA.href "/static/css/bootstrap.min.css"
+  <>
+    H.link
+      H.! HA.rel "stylesheet"
+      H.! HA.type_ "text/css"
+      H.! HA.href "/static/css/style.css"
     )
 
 template

src/Util.hs

@@ -152,7 +152,7 @@ redirectOverAuth muid mLink mRefine = do
           fromString (show $ linkURI (case (mLink, muid) of
             (Just link, _) -> link
             (Nothing, Just uid) -> userOverviewLink uid mRefine
-            _ -> userSelectLink
+            _ -> userSelectLink Nothing
             ))))
   throwError
     (err303
@@ -205,8 +205,8 @@ handleClientErr err muid authTargetLink =
       else
         throwError $
           addMessage (fromString $ show err) $
-          redirect303 userSelectLink
+          redirect303 (userSelectLink Nothing)
     othererr ->
       throwError $
         addMessage (fromString $ show othererr) $
-        redirect303 userSelectLink
+        redirect303 (userSelectLink Nothing)

src/View/Auth.hs

@@ -72,7 +72,7 @@ authPage l10n locale mDestination version mcookie = scaffold
             H.! HA.value ""
         H.div H.! HA.class_ "form-group optional" $
           H.button
-            H.! HA.class_ "btn btn-default"
+            H.! HA.class_ "btn btn-primary"
             H.! HA.type_ "submit"
             $ H.toHtml $ translate "Submit"
   where

src/View/Buy.hs

@@ -116,13 +116,14 @@ buyConfirmPage l10n locale uid ziptups total forceBuy version mcookie symbol =
             H.toHtml symbol
           H.div H.! HA.class_ "form-group optional" $
             H.button
-              H.! HA.class_ "btn btn-default"
+              H.! HA.class_ "btn btn-primary"
               H.! HA.type_ "submit"
               $ H.toHtml $ if forceBuy
                 then translate "Buy anyway"
                 else translate "Buy"
           when forceBuy $
             H.button
+              H.! HA.class_ "btn btn-primary"
               H.! HA.formnovalidate "formnovalidate"
               H.! HA.formmethod "get"
               H.! HA.formaction
@@ -143,25 +144,23 @@ buyProductsForm l10n locale prods = do
     mapM_ (\(MT.ProductShortOverview pid ident price amount ml maid) ->
       H.div
         H.! HA.class_ "tile"
+        H.!?
+          ( isJust maid
+          , productBgStyle (fromString $ show $ fromJust maid)
+          )
           $ do
-            H.div
+            H.label
+              H.! HA.for ("product-select-" <> fromString (show pid)) $
+                H.toHtml ident
               H.! HA.class_ "tile-content form-group optional"
-              H.!?
+            H.input
-                ( isJust maid
+              H.! HA.id ("product-select-" <> fromString (show pid))
-                , productBgStyle (fromString $ show $ fromJust maid)
+              H.! HA.class_ "form-control product-select"
-                )
-              $ do
-                H.label
-                  H.! HA.for ("product-select-" <> fromString (show pid)) $
-                    H.toHtml ident
-                H.input
-                  H.! HA.id ("product-select-" <> fromString (show pid))
-                  H.! HA.class_ "form-control product-select"
-                  H.! HA.name ("productSelect-" <> fromString (show pid))
-                  H.! HA.type_ "checkbox"
-                  H.! HA.value "true"
-            H.div
               H.! HA.class_ "tile-content form-group optional"
+              H.! HA.name ("productSelect-" <> fromString (show pid))
+              H.! HA.type_ "checkbox"
+              -- H.! HA.value "true"
+            H.div
               $ do
                 H.label
                   H.! HA.for ("product-amount-" <> fromString (show pid)) $
@@ -178,7 +177,7 @@ buyProductsForm l10n locale prods = do
       prods
   H.div H.! HA.class_ "form-group optional" $
     H.button
-      H.! HA.class_ "btn btn-default"
+      H.! HA.class_ "btn btn-primary"
       H.! HA.type_ "submit"
       $ H.toHtml $ translate "Proceed"
   where

src/View/Journal.hs

@@ -80,6 +80,7 @@ journalPage l10n loc version mcookie mpage entries =
             $ H.toHtml $ translate "Next Page"
       H.form $
         H.button
+          H.! HA.class_ "btn btn-primary"
           H.! HA.type_ "submit"
           H.! HA.formmethod "get"
           H.! HA.formaction
@@ -124,7 +125,7 @@ journalCheckPage l10n loc version mcookie =
               H.! HA.value "0"
           H.div H.! HA.class_ "form-group optional" $
             H.button
-              H.! HA.class_ "btn btn-default"
+              H.! HA.class_ "btn btn-primary"
               H.! HA.type_ "submit"
               $ H.toHtml $ translate "Submit"
   where

src/View/Product.hs

@@ -154,7 +154,7 @@ productRefillPage l10n loc version mcookie prodList =
               prodList
             H.div H.! HA.class_ "form-group optional" $
               H.button
-                H.! HA.class_ "btn btn-default"
+                H.! HA.class_ "btn btn-primary"
                 H.! HA.type_ "submit"
                 $ H.toHtml $ translate "Submit"
   where
@@ -288,7 +288,7 @@ productNewPage l10n loc version mcookie symbol =
             -}
             H.div H.! HA.class_ "form-group optional" $
               H.button
-                H.! HA.class_ "btn btn-default"
+                H.! HA.class_ "btn btn-primary"
                 H.! HA.type_ "submit"
                 $ H.toHtml $ translate "Submit"
   where

src/View/Scaffold.hs

@@ -14,8 +14,12 @@ import Data.Text.I18n
 
 import Data.Maybe (fromJust, isJust)
 
+import Data.Version (showVersion)
+
 import Control.Monad (when)
 
+import qualified Paths_matebeamter as MyPath (version)
+
 -- internal imports
 
 import Types.Page
@@ -32,7 +36,7 @@ scaffold
   -> H.Html
 scaffold l10n locale version mcookie page content = template page $ do
   H.header $ H.nav $ H.ul $ do
-    H.li $ H.a H.! HA.href ("/" <> fromString (show $ linkURI userSelectLink)) $
+    H.li $ H.a H.! HA.href ("/" <> fromString (show $ linkURI (userSelectLink Nothing))) $
       H.toHtml $ translate "Home"
     maybe
       (return ())
@@ -52,6 +56,7 @@ scaffold l10n locale version mcookie page content = template page $ do
   H.hr
   H.footer $ H.form $ do
     H.button
+      H.! HA.class_ "btn btn-primary"
       H.! HA.formmethod "get"
       H.! HA.formaction ("/" <>
         (fromString $ show $ linkURI $ productGetPriceListLink Nothing))
@@ -60,6 +65,7 @@ scaffold l10n locale version mcookie page content = template page $ do
       (return ())
       (\_ ->
         H.button
+          H.! HA.class_ "btn btn-primary"
           H.! HA.formmethod "get"
           H.! HA.formaction ("/" <>
             (fromString $ show $ linkURI $ productGetRefillLink))
@@ -68,7 +74,11 @@ scaffold l10n locale version mcookie page content = template page $ do
       (getLogin mcookie)
     H.div
       H.! HA.class_ "backend-version"
-      $ H.toHtml $ (translate "Powered by mateamt version") <> " " <> version
+      $ H.toHtml $
+        (translate "Powered by ") <> "matebeamter " <>
+        (fromString $ showVersion MyPath.version) <> " " <>
+        (translate "connected to ") <> "mateamt " <>
+        version
   where
     message = lookup "message" =<< fmap parseCookieText mcookie
     translate = localize l10n locale . gettext

src/View/User.hs

@@ -42,8 +42,8 @@ userSelectPage l10n locale uss version mcookie =
     ) $ H.ul
           H.! HA.class_ "tile-list"
       $ do
-        H.li H.! HA.class_ "tile" $ H.a
+        H.li H.! HA.class_ "tile function" $ H.a
-          H.! HA.class_ "tile-content function"
+          H.! HA.class_ "tile-content"
           H.! HA.href ("/" <> fromString
             (show $ linkURI $ cashBuyLink Nothing)
             ) $
@@ -55,8 +55,13 @@ userSelectPage l10n locale uss version mcookie =
               userOverviewLink uid Nothing)) $
                 H.toHtml ident
           ) uss
-        H.li H.! HA.class_ "tile" $ H.a
+        H.li H.! HA.class_ "tile function" $ H.a
-          H.! HA.class_ "tile-content function"
+          H.! HA.class_ "tile-content"
+          H.! HA.href ("/" <> fromString
+            (show $ linkURI $ userSelectLink (Just MT.OldUsers))) $
+              H.toHtml $ translate "Show inactive users"
+        H.li H.! HA.class_ "tile function" $ H.a
+          H.! HA.class_ "tile-content"
           H.! HA.href ("/" <> fromString (show $ linkURI userNewLink)) $
             H.toHtml $ translate "New user"
   where
@@ -91,7 +96,7 @@ userOverviewPage l10n locale method ud pos version mcookie symbol =
         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.class_ "btn btn-primary"
               H.! HA.type_ "submit"
               $ H.toHtml $ translate "Logout"
       case method of
@@ -107,6 +112,7 @@ userOverviewPage l10n locale method ud pos version mcookie symbol =
     buyForm = do
       H.div $ H.form $
         H.button
+          H.! HA.class_ "btn btn-primary"
           H.! HA.type_ "submit"
           H.! HA.formmethod "get"
           H.! HA.formaction ("/" <>
@@ -129,18 +135,21 @@ userSettingsPointer
 userSettingsPointer l10n locale uid =
   H.form $ do
     H.button
+      H.! HA.class_ "btn btn-primary"
       H.! HA.type_ "submit"
       H.! HA.formmethod "get"
       H.! HA.formaction
         ("/" <> fromString (show $ linkURI $ userManageLink uid))
       $ H.toHtml $ translate "Manage user settings"
     H.button
+      H.! HA.class_ "btn btn-primary"
       H.! HA.type_ "submit"
       H.! HA.formmethod "get"
       H.! HA.formaction
         ("/" <> fromString (show $ linkURI $ journalLink Nothing))
       $ H.toHtml $ translate "View Journal"
     H.button
+      H.! HA.class_ "btn btn-primary"
       H.! HA.type_ "submit"
       H.! HA.formmethod "get"
       H.! HA.formaction
@@ -214,7 +223,7 @@ userNewPage l10n locale version mcookie =
             H.! HA.value ""
         H.div H.! HA.class_ "form-group optional" $
           H.button
-            H.! HA.class_ "btn btn-default"
+            H.! HA.class_ "btn btn-primary"
             H.! HA.type_ "submit"
             $ H.toHtml $ translate "Submit"
     where
@@ -251,7 +260,7 @@ userRechargePage l10n locale version mcookie uid symbol =
           H.toHtml symbol
         H.div H.! HA.class_ "form-group optional" $
           H.button
-            H.! HA.class_ "btn btn-default"
+            H.! HA.class_ "btn btn-primary"
             H.! HA.type_ "submit"
             $ H.toHtml $ translate "Recharge"
   where
@@ -301,7 +310,7 @@ userManagePage l10n locale userDetails authOverviews version mcookie =
                   (MT.userDetailsEmail userDetails))
           H.div H.! HA.class_ "form-group optional" $
             H.button
-              H.! HA.class_ "btn btn-default"
+              H.! HA.class_ "btn btn-primary"
               H.! HA.type_ "submit"
               $ H.toHtml $ translate "Submit"
       H.p $ do
@@ -330,7 +339,7 @@ userManagePage l10n locale userDetails authOverviews version mcookie =
                   H.! HA.value (fromString $ show aoid)
               H.div H.! HA.class_ "form-group optional" $
                 H.button
-                  H.! HA.class_ "btn btn-default"
+                  H.! HA.class_ "btn btn-primary"
                   H.! HA.type_ "submit"
                   $ H.toHtml $ translate "Delete"
             )
@@ -379,7 +388,7 @@ userManagePage l10n locale userDetails authOverviews version mcookie =
                       H.toHtml $ translate "Primary password"
             H.div H.! HA.class_ "form-group optional" $
               H.button
-                H.! HA.class_ "btn btn-default"
+                H.! HA.class_ "btn btn-primary"
                 H.! HA.type_ "submit"
                 $ H.toHtml $ translate "Submit"
   where

static/css/style.css

@@ -1,16 +1,26 @@
-.tile-content {
+:root {
-  flex: 1 1 auto;
+  --tile-color: #36c30023;
-  background-color: #36c30023;
+  --function-tile-color: #c300d223;
-  display: flex;
-  justify-content: center;
-  flex-direction: column;
 }
 
-.tile-content * {
+body {
+  margin: 30px;
 }
 
-.tile-content label, .tile-content div {
+form button, nav ul > li {
-  width: 100%;
+  margin: 5px;
+}
+
+.tile-list, nav ul {
+  list-style: none;
+  padding: 0;
+}
+
+nav ul > li {
+  display: inline-block;
+  border-radius: 6px;
+  background-color: var(--function-tile-color);
+  padding : 10px;
 }
 
 .tile {
@@ -18,21 +28,63 @@
   flex-direction: column;
   align-content: stretch;
   align-items: stretch;
-  justify-content: stretch;
+  justify-content: center;
   border-radius: 6px;
+  background-color: var(--tile-color);
   box-shadow: 0 0 3px #c3c3c3;
-  margin: 30px 15px 0;
+  margin: 30px 30px 0 5px;
   width: 200px;
   height: 200px;
   text-align: center;
 }
 
-.function {
+.tile > label, .tile > * {
-  background-color: #c300d223
+  flex: 1 1 auto;
 }
 
-.tile-list {
+.tile-content {
-  list-style: none;
+  flex: 1 1 auto;
+  display: flex;
+  justify-content: center;
+  flex-direction: column;
+  align-content: stretch;
+  align-items: stretch;
+}
+
+.tile-content * {
+  flex: 1 1 auto;
+  display: inline-block;
+  width: 100%;
+  justify-content: center;
+  flex-direction: column;
+  align-content: stretch;
+  align-items: stretch;
+  margin: 0;
+  padding: 0;
+}
+
+.tile input[type="checkbox"] {
+  display: none;
+}
+
+.tile input[type="checkbox"] + * {
+  display: none;
+  opacity: 0;
+  transition: opacity 0.5s;
+}
+
+.tile input[type="checkbox"]:checked + * {
+  display: inline-block;
+  opacity: 1;
+  transition: opacity 0.5s;
+}
+
+.function {
+  background-color: var(--function-tile-color);
+}
+
+.tile-list + * {
+  margin-top: 30px;
 }
 
 hr {