linted

src/API.hs

@@ -1,10 +1,8 @@
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE PackageImports #-}
@@ -13,7 +11,7 @@ module API where
 
 import Servant.API
 import Servant.Links
-import Servant.RawM
+-- import Servant.RawM
 import Servant.HTML.Blaze
 
 import Data.Proxy
@@ -57,7 +55,6 @@ type UserAPI =
     :> ReqBody '[FormUrlEncoded] AuthReturn
     :> Post '[HTML] UserSelectPage
   :<|> "auth" :> "logout"
-    -- :> ReqBody '[FormUrlEncoded] ()
     :> Post '[HTML] UserOverviewPage
   )
 

src/Client.hs

@@ -1,35 +1,101 @@
-{-# LANGUAGE DataKinds             #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
-{-# LANGUAGE DeriveGeneric         #-}
+{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE UndecidableInstances  #-}
+{-# LANGUAGE PackageImports #-}
-{-# LANGUAGE PackageImports        #-}
 module Client where
 
 import Servant
 import Servant.Client
-
+import Servant.Client.Core.Auth
-import Network.HTTP.Client hiding (Proxy)
+import Servant.Client.Core.Request
-
-import Control.Monad.IO.Class (liftIO)
 
 -- imports from mateamt
 
-import qualified "mateamt" API as MT 
+import qualified "mateamt" API as MA
 import qualified "mateamt" Types as MT
 
 -- internal imports
 
-import Types
+mateApi :: Proxy MA.MateAPI
-
-mateApi :: Proxy MT.MateAPI
 mateApi = Proxy
 
+authGet :: MT.TicketRequest -> ClientM MT.AuthInfo
+authSend :: MT.AuthRequest -> ClientM MT.AuthResult
+authLogout :: AuthenticatedRequest (AuthProtect "header-auth") -> ClientM ()
+authManageList
+  :: AuthenticatedRequest (AuthProtect "header-auth")
+  -> ClientM [MT.AuthOverview]
+authManageNewAuth
+  :: AuthenticatedRequest (AuthProtect "header-auth")
+  -> MT.AuthSubmit
+  -> ClientM Int
+authManageDeleteAuth
+  :: AuthenticatedRequest (AuthProtect "header-auth")
+  -> Int
+  -> ClientM ()
+userNew :: MT.UserSubmit -> ClientM Int
+userGet
+  :: AuthenticatedRequest (AuthProtect "header-auth")
+  -> ClientM MT.UserDetails
+userUpdate
+  :: AuthenticatedRequest (AuthProtect "header-auth")
+  -> MT.UserDetailsSubmit
+  -> ClientM ()
+userList :: Maybe MT.UserRefine -> ClientM [MT.UserSummary]
+userRecharge
+  :: AuthenticatedRequest (AuthProtect "header-auth")
+  -> MT.UserRecharge
+  -> ClientM ()
+userTransfer
+  :: AuthenticatedRequest (AuthProtect "header-auth")
+  -> MT.UserTransfer
+  -> ClientM ()
+productNew
+  :: AuthenticatedRequest (AuthProtect "header-auth")
+  -> MT.ProductSubmit
+  -> ClientM Int
+productOverview :: Int -> ClientM MT.ProductOverview
+productStockRefill
+  :: AuthenticatedRequest (AuthProtect "header-auth")
+  -> [MT.AmountRefill]
+  -> ClientM ()
+productStockUpdate
+  :: AuthenticatedRequest (AuthProtect "header-auth")
+  -> [MT.AmountUpdate]
+  -> ClientM ()
+productList :: Maybe MT.ProductRefine -> ClientM [MT.ProductOverview]
+productShortList :: Maybe MT.ProductRefine -> ClientM [MT.ProductShortOverview]
+buy
+  :: AuthenticatedRequest (AuthProtect "header-auth")
+  -> [MT.PurchaseDetail]
+  -> ClientM MT.PurchaseResult
+journalShow
+  :: AuthenticatedRequest (AuthProtect "header-auth")
+  -> Maybe Int
+  -> Maybe Int
+  -> ClientM [MT.JournalEntry]
+avatarGet
+  :: Int
+  -> (Servant.Client.Core.Request.Request
+    -> Servant.Client.Core.Request.Request)
+  -> ClientM Response
+avatarInsert
+  :: AuthenticatedRequest (AuthProtect "header-auth")
+  -> MT.AvatarData
+  -> ClientM Int
+avatarUpdate
+  :: AuthenticatedRequest (AuthProtect "header-auth")
+  -> Int
+  -> MT.AvatarData
+  -> ClientM ()
+avatarList :: ClientM [MT.Avatar]
+
 ( authGet :<|>
   authSend :<|>
   authLogout :<|>

src/ClientAuth.hs

@@ -9,4 +9,4 @@ import Servant.Client.Core
 type instance AuthClientData (AuthProtect "header-auth") = String
 
 authenticateReq :: String -> Request -> Request
-authenticateReq s req = addHeader "Authentication" s req
+authenticateReq = addHeader "Authentication"

src/Control/Auth.hs

@@ -49,7 +49,7 @@ authControl mcookie mDestination = do
       mAuthUser = lookup "x-auth-user" =<< mParsedCookie
       mToken = lookup "x-token" =<< mParsedCookie
   case (mAuthUser, mToken) of
-    (Just authUser, Just _) -> do
+    (Just authUser, Just _) ->
       throwError $ case mDestination of
         Just destination ->
           err303
@@ -74,7 +74,7 @@ authControl mcookie mDestination = do
             , MT.SecondaryPass
             ]
       eAuthInfos <- zip passes <$>
-        (liftIO $ mapM
+        liftIO (mapM
           (\req -> runClientM
             (authGet req)
             backend
@@ -85,7 +85,7 @@ authControl mcookie mDestination = do
       then digestAuthInfo (uncurry zip $ (\(as, bs) -> (as, rights bs)) $
         unzip eAuthInfos)
       else throwError $ err400
-        { errBody = fromString $ show $ lefts $ snd $ unzip eAuthInfos
+        { errBody = fromString $ show $ lefts $ map snd eAuthInfos
         }
     (Nothing, _) ->
       error "Error handling not yet implemented properly."
@@ -105,10 +105,10 @@ authControl mcookie mDestination = do
           ticketHeaders = map
             (\(method, MT.AuthInfo _ (MT.AuthTicket ticket)) ->
               "x-ticket-"<> fromString (show $ fromEnum method) <>"=" <>
-                (fromString $ T.unpack ticket) <> ";Path=/")
+                fromString (T.unpack ticket) <> ";Path=/")
             tupAuthInfos
       return $
-        addHeader (ticketHeaders !! 0) $
+        addHeader (head ticketHeaders) $
           addHeader (ticketHeaders !! 1) $
             authPage l10n loc mDestination
 
@@ -177,8 +177,8 @@ authLogoutControl
 authLogoutControl mcookie = do
   (ReadState _ backend _) <- ask
   let mParsedCookie = fmap parseCookieText mcookie
-      token = T.unpack $ fromMaybe "secret" $
+      token = T.unpack $ fromMaybe "secret"
-        ((lookup "x-token") =<< mParsedCookie)
+        (lookup "x-token" =<< mParsedCookie)
   eReturn <- liftIO $ runClientM
     (authLogout (mkAuthenticatedRequest token authenticateReq))
     backend

src/Control/User.hs

@@ -7,7 +7,6 @@ module Control.User where
 import Servant
 import Servant.Client
 import Servant.Client.Core.Auth
-import Servant.Server
 
 import Data.String (fromString)
 
@@ -17,15 +16,14 @@ import Data.Text.I18n
 import Data.Maybe (fromMaybe)
 import Data.Either.Combinators (leftToMaybe)
 
-import Control.Monad (void, when)
+import Control.Monad (void)
-import Control.Monad.Reader (ask)
+import Control.Monad.Reader (ask, asks)
 import Control.Monad.IO.Class (liftIO)
 
 import Network.HTTP.Types.Status
 
 -- imports from "mateamt"
 
-import qualified "mateamt" API as MA
 import qualified "mateamt" Types as MT
 
 -- internal imports
@@ -44,7 +42,7 @@ userSelectControl mcookie = do
   let loc = Locale
         (fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
   euser <- liftIO $ runClientM
-    (userList (Nothing))
+    (userList Nothing)
     backend
   case euser of
     Right uss ->
@@ -54,7 +52,7 @@ userSelectControl mcookie = do
 
 userNewControl :: Maybe T.Text -> UserHandler UserNewPage
 userNewControl mcookie = do
-  (ReadState l10n backend _) <- ask
+  (ReadState l10n _ _) <- ask
   let loc = Locale
         (fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
   return $ userNewPage l10n loc
@@ -63,8 +61,8 @@ userNewPostControl
   :: Maybe T.Text
   -> MT.UserSubmit
   -> UserHandler UserSelectPage
-userNewPostControl _ us@(MT.UserSubmit ident email pass) = do
+userNewPostControl _ us@(MT.UserSubmit _ _ pass) = do
-  backend <- rsBackend <$> ask
+  backend <- asks rsBackend
   hashedPass <- hashPassword pass
   void $ liftIO $ runClientM
     (userNew $us
@@ -89,7 +87,7 @@ userOverviewControl mcookie uid mRefine = do
         (lookup "x-auth-user" =<< mParsedCookie)
       mMethod = T.unpack <$>
         (lookup "x-method" =<< mParsedCookie)
-  euser <- liftIO $ do
+  euser <- liftIO $
     runClientM
       (userGet (mkAuthenticatedRequest token authenticateReq))
       backend
@@ -129,7 +127,7 @@ userOverviewControl mcookie uid mRefine = do
         }
     (Left uerr, Left perr) ->
       throwError $ err500
-        { errBody = (fromString $ show uerr) <> " " <> (fromString $ show perr)
+        { errBody = fromString (show uerr) <> " " <> fromString (show perr)
         }
 
 userManageControl
@@ -141,15 +139,15 @@ userManageControl mcookie uid = do
   let loc = Locale
         (fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
       mParsedCookie = fmap parseCookieText mcookie
-      token = T.unpack $ fromMaybe "secret" $
+      token = T.unpack $ fromMaybe "secret"
-        ((lookup "x-token") =<< mParsedCookie)
+        (lookup "x-token" =<< mParsedCookie)
       mAuthUser = T.unpack <$>
-        ((lookup "x-auth-user") =<< mParsedCookie)
+        (lookup "x-auth-user" =<< mParsedCookie)
-  eUserDetails <- liftIO $ do
+  eUserDetails <- liftIO $
     runClientM
       (userGet (mkAuthenticatedRequest token authenticateReq))
       backend
-  eAuthOverviews <- liftIO $ do
+  eAuthOverviews <- liftIO $
     runClientM
       (authManageList (mkAuthenticatedRequest token authenticateReq))
       backend
@@ -165,15 +163,18 @@ userManageControl mcookie uid = do
       (Just $ userManageLink uid)
       [leftToMaybe (fst err), leftToMaybe (snd err)]
 
+userManageDetailsSubmitControl
+  :: Maybe T.Text
+  -> Int
+  -> MT.UserDetailsSubmit
+  -> UserHandler UserOverviewPage
 userManageDetailsSubmitControl mcookie uid uds = do
-  (ReadState l10n backend _) <- ask
+  (ReadState _ backend _) <- ask
-  let loc = Locale
+  let mParsedCookie = fmap parseCookieText mcookie
-        (fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
+      token = T.unpack $ fromMaybe "secret"
-      mParsedCookie = fmap parseCookieText mcookie
+        (lookup "x-token" =<< mParsedCookie)
-      token = T.unpack $ fromMaybe "secret" $
-        ((lookup "x-token") =<< mParsedCookie)
       mAuthUser = T.unpack <$>
-        ((lookup "x-auth-user") =<< mParsedCookie)
+        (lookup "x-auth-user" =<< mParsedCookie)
   eReturn <- liftIO $ runClientM
     (userUpdate (mkAuthenticatedRequest token authenticateReq) uds)
     backend
@@ -182,15 +183,18 @@ userManageDetailsSubmitControl mcookie uid uds = do
     Left err ->
       handleErrors (fmap read mAuthUser) (Just $ userManageLink uid) [Just err]
 
+userManageAuthCreateControl
+  :: Maybe T.Text
+  -> Int
+  -> AuthSubmitReturn
+  -> UserHandler UserOverviewPage
 userManageAuthCreateControl mcookie uid (AuthSubmitReturn comment pass method) = do
-  (ReadState l10n backend _) <- ask
+  (ReadState _ backend _) <- ask
-  let loc = Locale
+  let mParsedCookie = fmap parseCookieText mcookie
-        (fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
+      token = T.unpack $ fromMaybe "secret"
-      mParsedCookie = fmap parseCookieText mcookie
+        (lookup "x-token" =<< mParsedCookie)
-      token = T.unpack $ fromMaybe "secret" $
-        ((lookup "x-token") =<< mParsedCookie)
       mAuthUser = T.unpack <$>
-        ((lookup "x-auth-user") =<< mParsedCookie)
+        (lookup "x-auth-user" =<< mParsedCookie)
   hashedPass <- hashPassword pass
   eReturn <- liftIO $ runClientM
     (authManageNewAuth
@@ -203,15 +207,18 @@ userManageAuthCreateControl mcookie uid (AuthSubmitReturn comment pass method) =
     Left err ->
       handleErrors (fmap read mAuthUser) (Just $ userManageLink uid) [Just err]
 
+userManageAuthDeleteControl
+  :: Maybe T.Text
+  -> Int
+  -> AuthDetailId
+  -> UserHandler UserOverviewPage
 userManageAuthDeleteControl mcookie uid (AuthDetailId adid) = do
-  (ReadState l10n backend _) <- ask
+  (ReadState _ backend _) <- ask
-  let loc = Locale
+  let mParsedCookie = fmap parseCookieText mcookie
-        (fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
+      token = T.unpack $ fromMaybe "secret"
-      mParsedCookie = fmap parseCookieText mcookie
+        (lookup "x-token" =<< mParsedCookie)
-      token = T.unpack $ fromMaybe "secret" $
-        ((lookup "x-token") =<< mParsedCookie)
       mAuthUser = T.unpack <$>
-        ((lookup "x-auth-user") =<< mParsedCookie)
+        (lookup "x-auth-user" =<< mParsedCookie)
   eReturn <- liftIO $ runClientM
     (authManageDeleteAuth (mkAuthenticatedRequest token authenticateReq) adid)
     backend

src/Hash.hs

@@ -10,7 +10,7 @@ import Data.ByteString
 import Data.ByteString.Random (random)
 import qualified Data.ByteString.Base64 as B64
 
-import Control.Monad.Reader (ask)
+import Control.Monad.Reader (asks)
 import Control.Monad.IO.Class (liftIO)
 
 -- internal imports
@@ -21,8 +21,8 @@ hashPassword
   :: T.Text
   -> UserHandler T.Text
 hashPassword passwd = do
-  (HashParams iter _ outputl) <- rsHashParams <$> ask
+  (HashParams iter _ outputl) <- asks rsHashParams
-  let saltl = 0
+  let saltl = 0 :: Int
   salt <- liftIO $ random (fromIntegral saltl)
   let hash = generate (prfHMAC SHA3_512) (Parameters iter outputl) (encodeUtf8 passwd) salt :: ByteString
   return $ decodeUtf8 $ B64.encode hash

src/Main.hs

@@ -3,7 +3,6 @@
 module Main where
 
 import Servant
-import Servant.Server
 import Servant.Client
 
 import Network.Wai.Handler.Warp
@@ -13,32 +12,31 @@ import Network.HTTP.Client hiding (Proxy)
 
 import Control.Monad.Reader
 
-import Data.Text.I18n
 import Data.Text.I18n.Po
 
 -- internal imports
 
 import API
 import Types
-import View
 import Control
 
 main :: IO ()
 main = do
-  manager <- newManager defaultManagerSettings
+  mngr <- newManager defaultManagerSettings
   (l10n, _) <- getL10n "./locales"
   withStdoutLogger $ \ilog -> do
     let settings = setPort 3000 $ setLogger ilog defaultSettings
         initState = ReadState
           -- { rsManager = manager
           { rsL10n       = l10n
-          , rsBackend    = mkClientEnv manager (BaseUrl Http "localhost" 8000 "")
+          , rsBackend    = mkClientEnv mngr (BaseUrl Http "localhost" 8000 "")
           , rsHashParams = recommendedHashParams
           }
           
     runSettings settings (userApp initState)
 
-userApp initState = serveWithContext userApi (EmptyContext) $
+userApp :: ReadState -> Application
+userApp initState = serveWithContext userApi EmptyContext $
   hoistServerWithContext
     userApi
     Proxy

src/Model/Auth.hs

@@ -1,3 +0,0 @@
-module Model.Auth where
-
-

src/Model/User.hs

@@ -1,7 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PackageImports #-}
-module Model.User where
-
-import qualified "mateamt" Types as MT
-
-

src/Types/Orphans.hs

@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -fno-warn-missing-methods #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE PackageImports #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 
@@ -5,14 +7,6 @@ module Types.Orphans where
 
 import qualified "mateamt" Types as MT
 
-import GHC.Generics
-
-import Text.Blaze
-
-import Text.Read (readEither)
-
-import qualified Data.Text as T
-
 import Servant.API
 import Servant.HTML.Blaze
 import Web.Internal.FormUrlEncoded

src/Types/Page.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
 module Types.Page where
 
 import qualified Data.Text as T
@@ -44,9 +43,9 @@ template
 template (Page title favicon meta style) content =
   H.docTypeHtml $ do
     H.head $ do
-      H.title $ H.toHtml $ title
+      H.title $ H.toHtml title
       meta
       favicon
       style
-    H.body $
+    H.body
       content

src/Util.hs

@@ -3,12 +3,12 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE PackageImports #-}
+{-# LANGUAGE LambdaCase #-}
 module Util where
 
 import Servant hiding (addHeader)
 import Servant.Client
 import Servant.Client.Core.Request
-import Servant.Client.Core.Request (addHeader)
 
 import qualified Data.Text as T
 import Data.Text.Lazy.Encoding
@@ -58,7 +58,7 @@ redirect303
 redirect303 link =
   err303
     { errHeaders =
-      [ ("Location", "/" <> (fromString $ show $ linkURI link))
+      [ ("Location", "/" <> fromString (show $ linkURI link))
       ]
     }
 
@@ -77,7 +77,7 @@ handleErrors
   -> UserHandler UserOverviewPage
 handleErrors mAuthUser mLink merrs = do
   codes <- mapM
-    (\eerr -> case eerr of
+    (\case
       Just (FailureResponse _ resp) ->
         return $ statusCode (responseStatusCode resp)
       Just err ->
@@ -88,7 +88,7 @@ handleErrors mAuthUser mLink merrs = do
         return 200
       )
     merrs
-  if (any (== 401) codes)
+  if 401 `elem` codes
   then
     redirectOverAuth mAuthUser mLink Nothing
   else
@@ -99,14 +99,14 @@ handleErrors mAuthUser mLink merrs = do
 redirectOverAuth
   :: Maybe Int
   -> Maybe Link
-  -> Maybe (MT.ProductRefine)
+  -> Maybe MT.ProductRefine
   -> UserHandler UserOverviewPage
 redirectOverAuth muid mLink mRefine = do
   let redirectHeaders = errHeaders $
         redirect303 (authLink (Just $ "/" <>
           fromString (show $ linkURI (case (mLink, muid) of
             (Just link, _) -> link
-            (Nothing, Just uid) -> userOverviewLink uid Nothing
+            (Nothing, Just uid) -> userOverviewLink uid mRefine
             _ -> userSelectLink
             ))))
   throwError
@@ -114,7 +114,7 @@ redirectOverAuth muid mLink mRefine = do
       { errHeaders = redirectHeaders ++ (case muid of
           Just uid ->
             [ ( "Set-Cookie"
-              , "x-auth-user=" <> (fromString $ show uid) <> "; Path=/"
+              , "x-auth-user=" <> fromString (show uid) <> "; Path=/"
               )
             ]
           Nothing ->

src/View/Auth.hs

@@ -36,10 +36,9 @@ authPage l10n locale mDestination = scaffold
     " - " <>
     translate "Authentication"
     )
-  $ do
+  $ H.p $ H.form
-    H.p $ H.form
       H.! HA.method "post"
-      H.! HA.action ("/" <> (fromString $ show $ linkURI $
+      H.! HA.action ("/" <> fromString (show $ linkURI $
         authPostLink mDestination))
       H.! HA.enctype "application/x-www-form-urlencoded" $ do
         H.div H.! HA.class_ "form-group required" $ do
@@ -67,7 +66,7 @@ authPage l10n locale mDestination = scaffold
             H.! HA.type_ "password"
             H.! HA.required ""
             H.! HA.value ""
-        H.div H.! HA.class_ "form-group optional" $ do
+        H.div H.! HA.class_ "form-group optional" $
           H.button
             H.! HA.class_ "btn btn-default"
             H.! HA.type_ "submit"

src/View/Scaffold.hs

@@ -24,9 +24,9 @@ scaffold
   -> H.Html
   -> H.Html
 scaffold l10n locale page content = template page $ do
-  H.header $ H.nav $ H.ul $ do
+  H.header $ H.nav $ H.ul $
-    H.li $ H.a H.! H.href ("/" <> (fromString $ show $ linkURI $ userSelectLink)) $
+    H.li $ H.a H.! H.href ("/" <> fromString (show $ linkURI userSelectLink)) $
       H.toHtml $ localize l10n locale $ gettext "Home"
   H.hr
-  H.div H.! H.id "main" H.! H.role "main" $ do
+  H.div H.! H.id "main" H.! H.role "main" $
     content

src/View/User.hs

@@ -13,7 +13,7 @@ import Data.Text.I18n
 
 import Data.String (fromString)
 
-import Data.Maybe (isJust, fromJust, fromMaybe)
+import Data.Maybe (isJust, fromJust)
 
 -- imports from mateamt
 
@@ -32,16 +32,16 @@ userSelectPage
   -> [MT.UserSummary]
   -> UserSelectPage
 userSelectPage l10n locale uss = scaffold l10n locale (initPage $
-  (translate "Matebeamter") <>
+  translate "Matebeamter" <>
   " - " <>
-  (translate "Home")
+  translate "Home"
   ) $ do
-    mapM_ (\(MT.UserSummary uid ident _) -> do
+    mapM_ (\(MT.UserSummary uid ident _) ->
-      H.a H.! HA.href ("/" <> (fromString $ show $ linkURI $
+      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.a H.! HA.href ("/" <> fromString (show $ linkURI userNewLink)) $
       H.toHtml $ translate "New user"
   where
     translate = localize l10n locale . gettext
@@ -54,23 +54,23 @@ userOverviewPage
   -> [MT.ProductShortOverview]
   -> UserOverviewPage
 userOverviewPage l10n locale method ud pos = scaffold l10n locale (initPage $
-  (localize l10n locale $ gettext "Matebeamter") <>
+  localize l10n locale (gettext "Matebeamter") <>
   " - " <>
-  (localize l10n locale $ gettext "User Menu for ") <>
+  localize l10n locale (gettext "User Menu for ") <>
-  (MT.userDetailsIdent ud)
+  MT.userDetailsIdent ud
   ) $ do
-    H.p $ H.toHtml $ (translate "Welcome back, ") <> (MT.userDetailsIdent ud)
+    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") <>
+      translate "Your current balance is" <>
       ": " <>
-      (formatMoney $ MT.userDetailsBalance ud)
+      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.action ("/" <> fromString (show $ linkURI authLogoutLink))
-      H.! HA.enctype "application/x-www-form-urlencoded" $ do
+      H.! HA.enctype "application/x-www-form-urlencoded" $
-        H.div H.! HA.class_ "form-group optional" $ do
+        H.div H.! HA.class_ "form-group optional" $
           H.button
             H.! HA.class_ "btn btn-default"
             H.! HA.type_ "submit"
@@ -92,7 +92,7 @@ userSettingsPointer
   -> Int
   -> H.Html
 userSettingsPointer l10n locale uid =
-  H.a H.! HA.href ("/" <> (fromString $ show $ linkURI $ userManageLink uid)) $
+  H.a H.! HA.href ("/" <> fromString (show $ linkURI $ userManageLink uid)) $
     H.toHtml $ translate "Manage user settings"
   where
     translate = localize l10n locale . gettext
@@ -104,7 +104,7 @@ productList pos =
   H.p $
     H.ul H.! HA.class_ "product_list" $
       mapM_
-        (\(MT.ProductShortOverview pid ident _ _ _ avatarid) -> do
+        (\(MT.ProductShortOverview pid ident _ _ _ avatarid) ->
           H.li H.! HA.class_ "product" H.!?
             (isJust avatarid
             , productBgStyle (fromString $ show $ fromJust avatarid)
@@ -129,46 +129,45 @@ userNewPage
   -> Locale
   -> UserNewPage
 userNewPage l10n locale = scaffold l10n locale (initPage $
-  (translate "Matebeamter") <>
+  translate "Matebeamter" <>
   " - " <>
-  (translate "Create new user")
+  translate "Create new user"
-  ) $ do
+  ) $ H.p $ H.form
-    H.p $ H.form
+    H.! HA.method "post"
-      H.! HA.method "post"
+    H.! HA.action ("/" <> fromString (show $ linkURI userNewPostLink))
-      H.! HA.action ("/" <> (fromString $ show $ linkURI $ userNewPostLink))
+    H.! HA.enctype "application/x-www-form-urlencoded" $ do
-      H.! HA.enctype "application/x-www-form-urlencoded" $ do
+      H.div H.! HA.class_ "form-group required" $ do
-        H.div H.! HA.class_ "form-group required" $ do
+        H.label H.! HA.for "username" $ H.toHtml $ translate "Username"
-          H.label H.! HA.for "username" $ H.toHtml $ translate "Username"
+        H.input
-          H.input
+          H.! HA.id "username"
-            H.! HA.id "username"
+          H.! HA.class_ "form-control"
-            H.! HA.class_ "form-control"
+          H.! HA.name "userSubmitIdent"
-            H.! HA.name "userSubmitIdent"
+          H.! HA.type_ "text"
-            H.! HA.type_ "text"
+          H.! HA.required ""
-            H.! HA.required ""
+          H.! HA.value ""
-            H.! HA.value ""
+      H.div H.! HA.class_ "form-group optional" $ do
-        H.div H.! HA.class_ "form-group optional" $ do
+        H.label H.! HA.for "useremail" $ H.toHtml $ translate "Email"
-          H.label H.! HA.for "useremail" $ H.toHtml $ translate "Email"
+        H.input
-          H.input
+          H.! HA.id "useremail"
-            H.! HA.id "useremail"
+          H.! HA.class_ "form-control"
-            H.! HA.class_ "form-control"
+          H.! HA.name "userSubmitEmail"
-            H.! HA.name "userSubmitEmail"
+          H.! HA.type_ "email"
-            H.! HA.type_ "email"
+          H.! HA.required ""
-            H.! HA.required ""
+          H.! HA.value ""
-            H.! HA.value ""
+      H.div H.! HA.class_ "form-group required" $ do
-        H.div H.! HA.class_ "form-group required" $ do
+        H.label H.! HA.for "userpass" $ H.toHtml $ translate "Password"
-          H.label H.! HA.for "userpass" $ H.toHtml $ translate "Password"
+        H.input
-          H.input
+          H.! HA.id "userpass"
-            H.! HA.id "userpass"
+          H.! HA.class_ "form-control"
-            H.! HA.class_ "form-control"
+          H.! HA.name "userSubmitPassHash"
-            H.! HA.name "userSubmitPassHash"
+          H.! HA.type_ "password"
-            H.! HA.type_ "password"
+          H.! HA.required ""
-            H.! HA.required ""
+          H.! HA.value ""
-            H.! HA.value ""
+      H.div H.! HA.class_ "form-group optional" $
-        H.div H.! HA.class_ "form-group optional" $ do
+        H.button
-          H.button
+          H.! HA.class_ "btn btn-default"
-            H.! HA.class_ "btn btn-default"
+          H.! HA.type_ "submit"
-            H.! HA.type_ "submit"
+          $ H.toHtml $ translate "Submit"
-            $ H.toHtml $ translate "Submit"
   where
     translate = localize l10n locale . gettext
 
@@ -180,118 +179,118 @@ userManagePage
   -> UserManagePage
 userManagePage l10n locale userDetails authOverviews =
   scaffold l10n locale (initPage $
-    (translate "Matebeamter") <>
+    translate "Matebeamter" <>
     " - " <>
-    (translate "Manage user data")
+    translate "Manage user data"
-    ) $ do
+    ) $ H.p $ H.form
-      H.p $ H.form
+      H.! HA.method "post"
-        H.! HA.method "post"
+      H.! HA.action ("/" <>
-        H.! HA.action ("/" <>
+        fromString (show $ linkURI $
-          (fromString $ show $ linkURI $
+          userManageDetailsSubmitLink (MT.userDetailsId userDetails)))
-            userManageDetailsSubmitLink (MT.userDetailsId userDetails)))
+      H.! HA.enctype "application/x-www-form-urlencoded" $ H.fieldset $ do
-        H.! HA.enctype "application/x-www-form-urlencoded" $ H.fieldset $ do
+        H.legend $ H.toHtml $ translate "User details"
-          H.legend $ H.toHtml $ translate "User details"
+        H.div H.! HA.class_ "form-group required" $ do
-          H.div H.! HA.class_ "form-group required" $ do
+          H.label H.! HA.for "username" $ H.toHtml $ translate "Username"
-            H.label H.! HA.for "username" $ H.toHtml $ translate "Username"
+          H.input
-            H.input
+            H.! HA.id "username"
-              H.! HA.id "username"
+            H.! HA.class_ "form-control"
-              H.! HA.class_ "form-control"
+            H.! HA.name "userDetailsSubmitIdent"
-              H.! HA.name "userDetailsSubmitIdent"
+            H.! HA.type_ "text"
-              H.! HA.type_ "text"
+            H.! HA.required ""
-              H.! HA.required ""
+            H.! HA.value
-              H.! HA.value
+              (fromString $ T.unpack $ MT.userDetailsIdent userDetails)
-                (fromString $ T.unpack $ MT.userDetailsIdent userDetails)
+        H.div H.! HA.class_ "form-group optional" $ do
-          H.div H.! HA.class_ "form-group optional" $ do
+          H.label H.! HA.for "useremail" $ H.toHtml $ translate "Email"
-            H.label H.! HA.for "useremail" $ H.toHtml $ translate "Email"
+          H.input
-            H.input
+            H.! HA.id "useremail"
-              H.! HA.id "useremail"
+            H.! HA.class_ "form-control"
-              H.! HA.class_ "form-control"
+            H.! HA.name "userDetailsSubmitEmail"
-              H.! HA.name "userDetailsSubmitEmail"
+            H.! HA.type_ "email"
-              H.! HA.type_ "email"
+            H.! HA.required ""
-              H.! HA.required ""
+            H.! HA.value
-              H.! HA.value
+              (maybe "" (fromString . T.unpack)
-                (fromMaybe "" $ fromString <$> T.unpack <$>
+                (MT.userDetailsEmail userDetails))
-                  MT.userDetailsEmail userDetails)
+        H.div H.! HA.class_ "form-group optional" $
-          H.div H.! HA.class_ "form-group optional" $ do
+          H.button
-            H.button
+            H.! HA.class_ "btn btn-default"
-              H.! HA.class_ "btn btn-default"
+            H.! HA.type_ "submit"
-              H.! HA.type_ "submit"
+            $ H.toHtml $ translate "Submit"
-              $ H.toHtml $ translate "Submit"
+        H.p $ do
-      H.p $ do
+          mapM_
-        mapM_
+            (\(MT.AuthOverview aoid comment method) -> H.form
-          (\(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 $
+              fromString (show $ linkURI $
-                userManageAuthDeleteLink (MT.userDetailsId userDetails)))
+                userManageAuthCreateLink (MT.userDetailsId userDetails)))
             H.! HA.enctype "application/x-www-form-urlencoded" $ H.fieldset $ do
-              H.legend $ H.toHtml $ comment <> " - " <> case method of
+              H.legend $ H.toHtml $ translate "Authentication details"
-                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.label H.! HA.for "comment" $ H.toHtml $
+                  translate "Comment"
                 H.input
-                  H.! HA.class_ "form-control"
+                  H.! HA.id "comment"
-                  H.! HA.name "unId"
+                  H.! HA.class_ "form_control"
-                  H.! HA.type_ "hidden"
+                  H.! HA.name "authSubmitReturnComment"
+                  H.! HA.type_ "text"
                   H.! HA.required ""
-                  H.! HA.value (fromString $ show aoid)
+                  H.! HA.value ""
-              H.div H.! HA.class_ "form-group optional" $ do
+              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 "Delete"
+                  $ H.toHtml $ translate "Submit"
-            )
-          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