linted and hunted down warnings

app/Main.hs

@@ -107,9 +107,8 @@ authHandler conn = mkAuthHandler handler
     handler :: Request -> Handler (Maybe (Int, AuthMethod))
     handler req = do
       let headers = requestHeaders req
-      res <- case lookup "Authentication" headers of
+      case lookup "Authentication" headers of
-        Just hh -> do
+        Just hh ->
           validateToken hh conn
         _       ->
           return Nothing
-      return res

src/API.hs

@@ -1,10 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
@@ -68,34 +65,65 @@ type MateAPI =
   :<|> "avatar" :> "list" :> Get '[JSON] [Avatar]
 
 
-( authGetLink :<|>
+authGetLink :: Link
-  authSendLink :<|>
+authSendLink :: Link
-  authLogoutLink :<|>
+authLogoutLink :: Link
 
-  authManageListLink :<|>
+authManageListLink :: Link
-  authManageNewAuthLink :<|>
+authManageNewAuthLink :: Link
-  authManageDeleteAuthLink :<|>
+authManageDeleteAuthLink :: Link
 
-  userNewLink :<|>
+userNewLink :: Link
-  userGetLink :<|>
+userGetLink :: Link
-  userUpdateLink :<|>
+userUpdateLink :: Link
-  userListLink :<|>
+userListLink :: Maybe UserRefine -> Link
-  userRechargeLink :<|>
+userRechargeLink :: Link
-  userTransferLink :<|>
+userTransferLink :: Link
 
-  productNewLink :<|>
+productNewLink :: Link
-  productOverviewLink :<|>
+productOverviewLink :: Int -> Link
-  productStockRefillLink :<|>
+productStockRefillLink :: Link
-  productStockUpdateLink :<|>
+productStockUpdateLink :: Link
-  productListLink :<|>
+productListLink :: Maybe ProductRefine -> Link
-  productShortListLink :<|>
+productShortListLink :: Maybe ProductRefine -> Link
 
-  buyLink :<|>
+buyLink :: Link
 
-  journalShowLink :<|>
+journalShowLink :: Maybe Int -> Maybe Int -> Link
 
-  avatarGetLink :<|>
+avatarGetLink :: Int -> Link
-  avaterInsertLink :<|>
+avaterInsertLink :: Link
-  avatarUpdateLink :<|>
+avatarUpdateLink :: Int -> Link
-  avatarListLink
+avatarListLink :: Link
+
+( (authGetLink :: Link) :<|>
+  (authSendLink :: Link) :<|>
+  (authLogoutLink :: Link) :<|>
+
+  (authManageListLink :: Link) :<|>
+  (authManageNewAuthLink :: Link) :<|>
+  (authManageDeleteAuthLink :: Link) :<|>
+
+  (userNewLink :: Link) :<|>
+  (userGetLink :: Link) :<|>
+  (userUpdateLink :: Link) :<|>
+  (userListLink :: Maybe UserRefine -> Link) :<|>
+  (userRechargeLink :: Link) :<|>
+  (userTransferLink :: Link) :<|>
+
+  (productNewLink :: Link) :<|>
+  (productOverviewLink :: Int -> Link) :<|>
+  (productStockRefillLink :: Link) :<|>
+  (productStockUpdateLink :: Link) :<|>
+  (productListLink :: Maybe ProductRefine -> Link) :<|>
+  (productShortListLink :: Maybe ProductRefine -> Link) :<|>
+
+  (buyLink :: Link) :<|>
+
+  (journalShowLink :: Maybe Int -> Maybe Int -> Link) :<|>
+
+  (avatarGetLink :: Int -> Link) :<|>
+  (avaterInsertLink :: Link) :<|>
+  (avatarUpdateLink :: Int -> Link) :<|>
+  (avatarListLink :: Link)
   ) = allLinks (Proxy :: Proxy MateAPI)

src/Control/Auth.hs

@@ -5,7 +5,7 @@ import Servant
 
 import Control.Monad (void)
 
-import Control.Monad.Reader (ask)
+import Control.Monad.Reader (asks, ask)
 import Control.Monad.IO.Class (liftIO)
 
 import Control.Concurrent.STM (readTVarIO)
@@ -18,23 +18,23 @@ import Model
 authGet
   :: TicketRequest
   -> MateHandler AuthInfo
-authGet (TicketRequest uid method) = do
+authGet (TicketRequest uid method) =
-  getUserAuthInfo uid method =<< (rsConnection <$> ask)
+  getUserAuthInfo uid method =<< (asks rsConnection)
 
 authSend
   :: AuthRequest
   -> MateHandler AuthResult
 authSend req = uncurry (processAuthRequest req) =<< ((,) <$>
   (liftIO . readTVarIO =<< rsTicketStore <$> ask) <*>
-  (rsConnection <$> ask)
+  (asks rsConnection)
   )
 
 authLogout
   :: Maybe (Int, AuthMethod)
   -> MateHandler ()
-authLogout (Just (muid, method)) = do
+authLogout (Just (muid, _)) =
-  processLogout muid =<< (rsConnection <$> ask)
+  processLogout muid =<< (asks rsConnection)
-authLogout Nothing = do
+authLogout Nothing =
   throwError $ err401
     { errBody = "Unauthorized access"
     }
@@ -43,9 +43,9 @@ authManageList
   :: Maybe (Int, AuthMethod)
   -> MateHandler [AuthOverview]
 authManageList (Just (uid, method)) =
-  if any (== method) [PrimaryPass, ChallengeResponse]
+  if elem method [PrimaryPass, ChallengeResponse]
   then do
-    conn <- rsConnection <$> ask
+    conn <- asks rsConnection
     selectAuthOverviews uid conn
   else
     throwError $ err401
@@ -60,10 +60,10 @@ authManageNewAuth
   :: Maybe (Int, AuthMethod)
   -> AuthSubmit
   -> MateHandler Int
-authManageNewAuth (Just (uid, method)) (AuthSubmit asmethod ascomment aspayload) = do
+authManageNewAuth (Just (uid, method)) (AuthSubmit asmethod ascomment aspayload) =
-  if any (== method) [PrimaryPass, ChallengeResponse]
+  if elem method [PrimaryPass, ChallengeResponse]
   then do
-    conn <- rsConnection <$> ask
+    conn <- asks rsConnection
     putUserAuthInfo uid asmethod ascomment aspayload conn
   else
     throwError $ err401
@@ -78,10 +78,10 @@ authManageDeleteAuth
   :: Maybe (Int, AuthMethod)
   -> Int
   -> MateHandler ()
-authManageDeleteAuth (Just (uid, method)) adid = do
+authManageDeleteAuth (Just (uid, method)) adid =
-  if any (== method) [PrimaryPass, ChallengeResponse]
+  if elem method [PrimaryPass, ChallengeResponse]
   then do
-    conn <- rsConnection <$> ask
+    conn <- asks rsConnection
     ads <- selectAuthOverviews uid conn
     let currentad = head (filter (\ad -> authOverviewId ad == adid) ads)
     case authOverviewMethod currentad of
@@ -107,7 +107,7 @@ authManageDeleteAuth (Just (uid, method)) adid = do
       throwError $ err406
         { errBody = "You need at least one primary password or challenge response authentication"
         }
-authManageDeleteAuth Nothing _ = do
+authManageDeleteAuth Nothing _ =
   throwError $ err401
     { errBody = "Unauthorized access"
     }

src/Control/Avatar.hs

@@ -3,7 +3,7 @@ module Control.Avatar where
 
 import Control.Monad (void)
 
-import Control.Monad.Reader (ask)
+import Control.Monad.Reader (asks)
 
 import Control.Monad.Trans (liftIO)
 
@@ -26,7 +26,7 @@ avatarGet
   :: Int
   -> MateHandler Application
 avatarGet aid = do
-  conn <- rsConnection <$> ask
+  conn <- asks rsConnection
   as <- liftIO $ avatarSelectById aid conn
   if null as
   then
@@ -47,7 +47,7 @@ avatarInsert
   -> AvatarData
   -> MateHandler Int
 avatarInsert (Just _) ad = do
-  conn <- rsConnection <$> ask
+  conn <- asks rsConnection
   insertAvatar ad conn
 avatarInsert Nothing _ =
   throwError $ err401
@@ -60,9 +60,9 @@ avatarUpdate
   -> AvatarData
   -> MateHandler ()
 avatarUpdate (Just _) aid ad = do
-  conn <- rsConnection <$> ask
+  conn <- asks rsConnection
   void $ updateAvatar aid ad conn
-avatarUpdate Nothing _ _ = do
+avatarUpdate Nothing _ _ =
   throwError $ err401
     { errBody = "No Authentication present."
     }
@@ -70,5 +70,5 @@ avatarUpdate Nothing _ _ = do
 avatarList
   :: MateHandler [Avatar]
 avatarList = do
-  conn <- rsConnection <$> ask
+  conn <- asks rsConnection
   liftIO $ avatarSelect conn

src/Control/Buy.hs

@@ -3,7 +3,7 @@ module Control.Buy where
 
 import Control.Monad (void, foldM)
 
-import Control.Monad.Reader (ask)
+import Control.Monad.Reader (asks)
 
 -- internal imports
 
@@ -15,13 +15,13 @@ buy
   -> [PurchaseDetail]
   -> MateHandler PurchaseResult
 buy (Just (auid, _)) pds = do
-  conn <- rsConnection <$> ask
+  conn <- asks rsConnection
   (missing, real) <- foldM (\(ms, rs) pd -> do
     mmiss <- checkProductAvailability pd conn
     case mmiss of
       Just miss -> return
         ( (pd {purchaseDetailAmount = miss}):ms
-        , (pd {purchaseDetailAmount = max 0 (purchaseDetailAmount pd - miss)}:rs)
+        , pd {purchaseDetailAmount = max 0 (purchaseDetailAmount pd - miss)}:rs
         )
       Nothing -> return
         ( ms
@@ -30,7 +30,7 @@ buy (Just (auid, _)) pds = do
     )
     ([], [])
     pds
-  void $ mapM_ (\pd -> postBuyProductAmountUpdate pd conn) real
+  mapM_ (`postBuyProductAmountUpdate` conn) real
   price <- foldM
     (\total pd ->
       fmap (+ total) (getLatestTotalPrice pd conn)
@@ -46,13 +46,13 @@ buy (Just (auid, _)) pds = do
     )
     missing
 buy Nothing pds = do
-  conn <- rsConnection <$> ask
+  conn <- asks rsConnection
   (missing, real) <- foldM (\(ms, rs) pd -> do
     mmiss <- checkProductAvailability pd conn
     case mmiss of
       Just miss -> return
         ( (pd {purchaseDetailAmount = miss}):ms
-        , (pd {purchaseDetailAmount = max 0 (purchaseDetailAmount pd - miss)}:rs)
+        , pd {purchaseDetailAmount = max 0 (purchaseDetailAmount pd - miss)}:rs
         )
       Nothing -> return
         ( ms
@@ -61,8 +61,8 @@ buy Nothing pds = do
     )
     ([], [])
     pds
-  void $ mapM_
+  mapM_
-    (\pd -> postBuyProductAmountUpdate pd conn)
+    (`postBuyProductAmountUpdate` conn)
     real
   price <- foldM
     (\total pd ->

src/Control/Journal.hs

@@ -3,7 +3,7 @@ module Control.Journal where
 
 import Servant
 
-import Control.Monad.Reader (ask)
+import Control.Monad.Reader (asks)
 
 -- internal imports
 
@@ -16,7 +16,7 @@ journalShow
   -> Maybe Int
   -> MateHandler [JournalEntry]
 journalShow (Just _) mlimit moffset = do
-  conn <- rsConnection <$> ask
+  conn <- asks rsConnection
   selectJournalEntries mlimit moffset conn
 journalShow Nothing _ _ =
   throwError $ err401

src/Control/Product.hs

@@ -5,7 +5,7 @@ import Servant
 
 import Control.Monad (void)
 
-import Control.Monad.Reader (ask)
+import Control.Monad.Reader (asks)
 
 import Data.Maybe (fromMaybe)
 
@@ -19,28 +19,28 @@ productNew
   -> ProductSubmit
   -> MateHandler Int
 productNew (Just _) bevsub = do
-  conn <- rsConnection <$> ask
+  conn <- asks rsConnection
   bevid <- insertProduct bevsub conn
   void $ insertNewEmptyAmount bevid bevsub conn
   return bevid
 productNew Nothing _ =
-  throwError $ err401
+  throwError err401
 
 productOverview
   :: Int
   -> MateHandler ProductOverview
 productOverview pid = do
-  conn <- rsConnection <$> ask
+  conn <- asks rsConnection
   productOverviewSelectSingle pid conn
 
 productStockRefill
   :: Maybe (Int, AuthMethod)
   -> [AmountRefill]
   -> MateHandler ()
-productStockRefill (Just _) amorefs = do
+productStockRefill (Just _) amorefs =
   if all ((>= 0) . amountRefillAmount) amorefs
   then do
-    conn <- rsConnection <$> ask
+    conn <- asks rsConnection
     void $ manualProductAmountRefill amorefs conn
   else
     throwError $ err400
@@ -55,10 +55,10 @@ productStockUpdate
   :: Maybe (Int, AuthMethod)
   -> [AmountUpdate]
   -> MateHandler ()
-productStockUpdate (Just _) amoups = do
+productStockUpdate (Just _) amoups =
   if all ((>= 0) . amountUpdateRealAmount) amoups
   then do
-    conn <- rsConnection <$> ask
+    conn <- asks rsConnection
     void $ manualProductAmountUpdate amoups conn
   else
     throwError $ err400
@@ -73,12 +73,12 @@ productList
   :: Maybe ProductRefine
   -> MateHandler [ProductOverview]
 productList mrefine = do
-  conn <- rsConnection <$> ask
+  conn <- asks rsConnection
   productOverviewSelect (fromMaybe AvailableProducts mrefine) conn
 
 productShortList
   :: Maybe ProductRefine
   -> MateHandler [ProductShortOverview]
 productShortList mrefine = do
-  conn <- rsConnection <$> ask
+  conn <- asks rsConnection
   productShortOverviewSelect (fromMaybe AvailableProducts mrefine) conn

src/Control/User.hs

@@ -5,7 +5,7 @@ import Servant
 
 import Control.Monad (void)
 
-import Control.Monad.Reader (ask)
+import Control.Monad.Reader (asks)
 
 import Control.Monad.IO.Class (liftIO)
 
@@ -24,8 +24,8 @@ userNew
   :: UserSubmit
   -> MateHandler Int
 userNew (UserSubmit ident email passhash) = do
-  now <- liftIO $ getCurrentTime
+  now <- liftIO getCurrentTime
-  conn <- rsConnection <$> ask
+  conn <- asks rsConnection
   uid <- insertUser ident email (utctDay now) conn
   void $ putUserAuthInfo uid PrimaryPass "Initial password" passhash conn
   return uid
@@ -38,7 +38,7 @@ userGet Nothing =
     { errBody = "No Authentication present."
     }
 userGet (Just (uid, _)) = do
-  conn <- rsConnection <$> ask
+  conn <- asks rsConnection
   userDetailsSelect uid conn
 
 userUpdate
@@ -50,10 +50,10 @@ userUpdate Nothing _ =
     { errBody = "No Authentication present."
     }
 userUpdate (Just (aid, method)) uds =
-  if any (== method) [PrimaryPass, ChallengeResponse]
+  if elem method [PrimaryPass, ChallengeResponse]
   then do
-    now <- liftIO $ getCurrentTime
+    now <- liftIO getCurrentTime
-    conn <- rsConnection <$> ask
+    conn <- asks rsConnection
     void $ updateUserDetails aid uds (utctDay now) conn
   else
     throwError $ err401
@@ -64,7 +64,7 @@ userList
   :: Maybe UserRefine
   -> MateHandler [UserSummary]
 userList ref = do
-  conn <- rsConnection <$> ask
+  conn <- asks rsConnection
   userSelect (fromMaybe ActiveUsers ref) conn
 
 userRecharge
@@ -74,7 +74,7 @@ userRecharge
 userRecharge (Just (auid, _)) (UserRecharge amount) =
   if amount >= 0
   then do
-    conn <- rsConnection <$> ask
+    conn <- asks rsConnection
     ud <- userDetailsSelect auid conn
     void $ insertNewJournalEntry
       (JournalSubmit
@@ -102,9 +102,9 @@ userTransfer (Just (auid, method)) (UserTransfer target amount) =
   then
     if auid /= target
     then
-      if any (== method) [PrimaryPass, ChallengeResponse]
+      if elem method [PrimaryPass, ChallengeResponse]
       then do
-        conn <- rsConnection <$> ask
+        conn <- asks rsConnection
         user <- userDetailsSelect auid conn
         if amount < userDetailsBalance user
         then do

src/Model/Amount.hs

@@ -135,7 +135,7 @@ getLatestTotalPrice (PurchaseDetail pid amount) conn = do
         , Bool
         )
       ]
-  (amount *) <$> head <$> return (map
+  (amount *) . head <$> return (map
     (\(_, _, _, price, _) -> price)
     amounts
     )
@@ -145,7 +145,7 @@ checkProductAvailability
   -> PGS.Connection
   -> MateHandler (Maybe Int) -- | Returns maybe missing amount
 checkProductAvailability (PurchaseDetail pid amount) conn = do
-  realamount <- (\(_, _, ramount, _, _) -> ramount) <$> head <$>
+  realamount <- (\(_, _, ramount, _, _) -> ramount) . head <$>
     (liftIO $ runSelect conn $ limit 1 $
       orderBy (desc (\(_, ts, _, _, _) -> ts)) $
         keepWhen (\(id_, _, _, _, _) -> id_ .== C.constant pid) <<<
@@ -172,7 +172,7 @@ manualProductAmountUpdate aups conn =
   mapM
     (\(AmountUpdate pid amount) -> do
       oldprice <- getLatestPriceByProductId pid conn
-      head <$> (liftIO $ do
+      head <$> liftIO (do
         now <- getCurrentTime
         runInsert_ conn $ Insert
           { iTable = amountTable
@@ -202,7 +202,7 @@ manualProductAmountRefill aups conn =
     (\(AmountRefill pid amount) -> do
       oldamount <- getLatestAmountByProductId pid conn
       oldprice <- getLatestPriceByProductId pid conn
-      head <$> (liftIO $ do
+      head <$> liftIO (do
         now <- getCurrentTime
         runInsert_ conn $ Insert
           { iTable = amountTable
@@ -228,8 +228,8 @@ postBuyProductAmountUpdate
   -> PGS.Connection
   -> MateHandler Int
 postBuyProductAmountUpdate (PurchaseDetail pid pdamount) conn = do
-  now <- liftIO $ getCurrentTime
+  now <- liftIO getCurrentTime
-  (amount, oldprice) <- (\(_, _, am, op, _) -> (am, op)) <$> head <$> (
+  (amount, oldprice) <- (\(_, _, am, op, _) -> (am, op)) . head <$> (
     liftIO $ runSelect conn $ limit 1 $
       orderBy (desc (\(_, ts, _, _, _) -> ts)) $
         keepWhen (\(id_, _, _, _, _) -> id_ .== C.constant pid) <<<

src/Model/Auth.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE Arrows #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -29,10 +28,9 @@ import qualified Data.Set as S
 
 import Data.Time.Clock
 
-import Data.ByteString as B (ByteString, drop)
+import Data.ByteString as B (ByteString)
 import Data.ByteString.Random
 import qualified Data.ByteString.Base64 as B64
-import qualified Data.ByteString.Base16 as B16
 
 import Opaleye hiding (null)
 import qualified Opaleye.Constant as C
@@ -114,7 +112,7 @@ delayTime = 1 * 10 ^ (6 :: Int)
 
 
 generateRandomText :: IO T.Text
-generateRandomText = decodeUtf8 <$> B64.encode <$> random 23
+generateRandomText = decodeUtf8 . B64.encode <$> random 23
 
 
 selectAuthOverviews
@@ -123,7 +121,7 @@ selectAuthOverviews
   -> MateHandler [AuthOverview]
 selectAuthOverviews uid conn = do
   authData <- liftIO $ runSelect conn (proc () -> do
-    (adid, aduid, admethod, adcomment, adpayload) <-
+    (adid, aduid, admethod, adcomment, _) <-
       queryTable authDataTable -< ()
     restrict -< aduid .== C.constant uid
     returnA -< (adid, adcomment, admethod)
@@ -147,8 +145,8 @@ getUserAuthInfo
   -> MateHandler AuthInfo
 getUserAuthInfo uid method conn = do
   authdata <- map (\(aid, auid, amethod, acomment, apayload) ->
-    (aid, auid, amethod, acomment, (decodeUtf8 $ B64.encode apayload))) <$>
+    (aid, auid, amethod, acomment, decodeUtf8 $ B64.encode apayload)) <$>
-    (liftIO $ do
+    liftIO (do
       void $ threadDelay delayTime
       runSelect conn (proc () -> do
         (aid, auid, amethod, acomment, apayload) <-
@@ -207,7 +205,7 @@ deleteAuthDataById
   -> MateHandler Int64
 deleteAuthDataById adid conn = liftIO $ runDelete_ conn $ Delete
   { dTable     = authDataTable
-  , dWhere     = (\(aid, _, _, _, _) -> aid .== C.constant adid)
+  , dWhere     = \(aid, _, _, _, _) -> aid .== C.constant adid
   , dReturning = rCount
   }
 
@@ -229,7 +227,7 @@ validateToken header conn = do
         ]
   case tokens of
     [(_, uid, stamp, method)] -> do
-      now <- liftIO $ getCurrentTime
+      now <- liftIO getCurrentTime
       if diffUTCTime stamp now > 0
       then return $ Just (uid, toEnum method)
       else do
@@ -250,7 +248,7 @@ generateToken
   -> AuthResponse
   -> PGS.Connection
   -> MateHandler AuthResult
-generateToken (Ticket _ tuid _ (method, pl)) (AuthResponse response) conn = do
+generateToken (Ticket _ tuid _ (method, _)) (AuthResponse response) conn = do
   authData <- liftIO $ runSelect conn (
     keepWhen (\(_, auid, amethod, _, _) ->
       auid .== C.constant tuid .&& amethod .== C.constant (fromEnum method))
@@ -263,8 +261,11 @@ generateToken (Ticket _ tuid _ (method, pl)) (AuthResponse response) conn = do
           , ByteString
           )
         ]
-  let userPayloads = map (\(_, _, _, _, payload) ->
+  let userPayloads = map
-        (decodeUtf8 payload)) authData
+        (\(_, _, _, _, payload) ->
+          decodeUtf8 payload
+          )
+        authData
       authResult = case method of
         PrimaryPass       -> validatePass response userPayloads
         SecondaryPass     -> validatePass response userPayloads
@@ -282,9 +283,9 @@ generateToken (Ticket _ tuid _ (method, pl)) (AuthResponse response) conn = do
   else
     return Denied
   where
-    validatePass provided presents =
+    validatePass provided =
-      any (\present -> provided == present) presents
+      any (provided ==)
-    validateChallengeResponse provided presents =
+    validateChallengeResponse _ _ =
       error "Validation of challenge response authentication not yet implemented"
 
 
@@ -315,7 +316,7 @@ deleteToken
 deleteToken tstr conn =
   liftIO $ runDelete_ conn $ Delete
     { dTable     = tokenTable
-    , dWhere     = (\(rtstr, _, _, _) -> rtstr .== C.constant tstr)
+    , dWhere     = \(rtstr, _, _, _) -> rtstr .== C.constant tstr
     , dReturning = rCount
     }
 
@@ -326,7 +327,7 @@ deleteTokenByUserId
   -> MateHandler Int64
 deleteTokenByUserId uid conn = liftIO $ runDelete_ conn $ Delete
   { dTable     = tokenTable
-  , dWhere     = (\(_, rid, _, _) -> rid .== C.constant uid)
+  , dWhere     = \(_, rid, _, _) -> rid .== C.constant uid
   , dReturning = rCount
   }
 
@@ -334,18 +335,18 @@ deleteTokenByUserId uid conn = liftIO $ runDelete_ conn $ Delete
 newTicket :: Int -> AuthMethod -> MateHandler (Maybe T.Text, AuthTicket)
 newTicket ident method = do
   store <- rsTicketStore <$> ask
-  rand1 <- liftIO $ generateRandomText
+  rand1 <- liftIO generateRandomText
   rand2 <- liftIO $ case method of
     ChallengeResponse -> Just <$> generateRandomText
     _                 -> return Nothing
-  later <- liftIO $ (addUTCTime 23 <$> getCurrentTime)
+  later <- liftIO (addUTCTime 23 <$> getCurrentTime)
   let ticket = Ticket
         { ticketId     = AuthTicket rand1
         , ticketUser   = ident
         , ticketExpiry = later
         , ticketMethod = (method, rand2)
         }
-  liftIO $ atomically $ modifyTVar store (\s -> S.insert ticket s)
+  liftIO $ atomically $ modifyTVar store (S.insert ticket)
   return (rand2, AuthTicket rand1)
 
 
@@ -359,7 +360,7 @@ processAuthRequest (AuthRequest aticket hash) store conn = do
   case S.toList mticket of
     [ticket] -> do
       -- liftIO $ putStrLn "there is a ticket..."
-      now <- liftIO $ getCurrentTime
+      now <- liftIO getCurrentTime
       liftIO $ threadDelay delayTime
       if now > ticketExpiry ticket
       then
@@ -374,7 +375,7 @@ processAuthRequest (AuthRequest aticket hash) store conn = do
 #else
         return Denied
 #endif
-      else do
+      else
         -- liftIO $ putStrLn "...and it is valid"
         generateToken ticket hash conn
     _        -> do
@@ -395,5 +396,5 @@ processLogout
   :: Int
   -> PGS.Connection
   -> MateHandler ()
-processLogout uid conn = do
+processLogout uid conn =
   void $ deleteTokenByUserId uid conn

src/Model/Avatar.hs

@@ -137,6 +137,6 @@ updateAvatar aid (AvatarData name dat) conn = liftIO $ do
         , C.constant (encodeUtf8 dat)
         )
       )
-    , uWhere      = (\(did, _, _, _) -> did .== C.constant aid)
+    , uWhere      = \(did, _, _, _) -> did .== C.constant aid
     , uReturning  = rCount
     }

src/Model/Journal.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE Arrows #-}
 module Model.Journal where
 
@@ -130,7 +131,7 @@ insertNewJournalEntry
   -> PGS.Connection
   -> MateHandler Int
 insertNewJournalEntry (JournalSubmit descr amount) conn = do
-  lastTotal <- (\x -> case x of
+  lastTotal <- (\case
     Just j  -> journalEntryTotalAmount j 
     Nothing -> 0
     ) <$> selectLatestJournalEntry conn

src/Model/Product.hs

@@ -105,7 +105,7 @@ productOverviewSelect refine conn = do
   prods <- liftIO $ runSelect conn
     ( proc () -> do
         (pid, i2, i6, i7, i8, i9, i11, i12, i13) <- queryTable productTable -< ()
-        (a1, a2, a3, a4, a5) <-
+        (a1, _, a3, _, _) <-
           limit 1 (
             orderBy (desc (\(_, ts, _, _, _) -> ts)) (queryTable amountTable))
               -< ()
@@ -144,7 +144,7 @@ productOverviewSelect refine conn = do
                 )
               ]
       (ii3, ii4) <- return $ (\(_, _, y, x, _) -> (x, y)) $ head amounts
-      ii5 <- return $ (\(_, x) -> x) $
+      let ii5 = snd $
             foldl
               (\(bef, van) (_, _, amo, _, ver) ->
                 if ver
@@ -153,7 +153,7 @@ productOverviewSelect refine conn = do
                 )
               (0, 0)
               (Prelude.reverse amounts)
-      ii10 <- return $ snd $ foldl (\(bef, tot) (_, _, amo, _, ver) ->
+          ii10 = snd $ foldl (\(bef, tot) (_, _, amo, _, ver) ->
             if ver
             then (amo, tot)
             else (amo, tot + max 0 (bef - amo))
@@ -205,7 +205,7 @@ productOverviewSelectSingle pid conn = do
                 )
               ]
       (ii3, ii4) <- return $ (\(_, _, y, x, _) -> (x, y)) $ head amounts
-      ii5 <- return $ (\(_, x) -> x) $
+      let ii5 = snd $
             foldl
               (\(bef, van) (_, _, amo, _, ver) ->
                 if ver
@@ -214,7 +214,7 @@ productOverviewSelectSingle pid conn = do
                 )
               (0, 0)
               (Prelude.reverse amounts)
-      ii10 <- return $ snd $ foldl (\(bef, tot) (_, _, amo, _, ver) ->
+          ii10 = snd $ foldl (\(bef, tot) (_, _, amo, _, ver) ->
             if ver
             then (amo, tot)
             else (amo, tot + max 0 (bef - amo))
@@ -235,7 +235,7 @@ productShortOverviewSelect refine conn = do
   prods <- liftIO $ runSelect conn
     ( proc () -> do
         (i1, i2, i6, i7, i8, i9, i11, i12, i13) <- queryTable productTable -< ()
-        (a1, a2, a3, a4, a5) <-
+        (a1, _, a3, _, _) <-
           limit 1 (
             orderBy (desc (\(_, ts, _, _, _) -> ts)) (queryTable amountTable))
               -< ()

src/Model/User.hs

@@ -70,7 +70,7 @@ userSelect
   -> PGS.Connection
   -> MateHandler [UserSummary]
 userSelect ref conn = do
-  today <- utctDay <$> (liftIO $ getCurrentTime)
+  today <- utctDay <$> (liftIO getCurrentTime)
   users <- liftIO $ runSelect conn (case ref of
       AllUsers -> selectTable userTable
       ActiveUsers -> keepWhen (\(_, _, _, ts, _, _) ->
@@ -138,9 +138,7 @@ userBalanceSelect conn uid = do
             )
           ]
   head <$> mapM
-    (\(_, _, i3, _, _, _) -> return $
+    (\(_, _, i3, _, _, _) -> return i3)
-      i3
-      )
     users
 
 
@@ -183,7 +181,7 @@ updateUserDetails uid uds now conn = liftIO $ runUpdate_ conn $ Update
       , C.constant (userDetailsSubmitAvatar uds)
       )
     )
-  , uWhere      = (\(i1, _, _, _, _, _) -> i1 .== C.constant uid)
+  , uWhere      = \(i1, _, _, _, _, _) -> i1 .== C.constant uid
   , uReturning  = rCount
   }
 
@@ -203,6 +201,6 @@ addToUserBalance uid amount conn = liftIO $ runUpdate_ conn $ Update
       , i6
       )
     )
-  , uWhere      = (\(i1, _, _, _, _, _) -> i1 .== C.constant uid)
+  , uWhere      = \(i1, _, _, _, _, _) -> i1 .== C.constant uid
   , uReturning  = rCount
   }

src/Types/Auth.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 module Types.Auth where
 

src/Types/Journal.hs

@@ -38,7 +38,7 @@ instance ToJSON JournalSubmit where
 instance FromJSON JournalSubmit
 
 
-data JournalCashCheck = JournalCashCheck
+newtype JournalCashCheck = JournalCashCheck
   { journalCashCheckTotalAmount :: Int
   }
   deriving (Generic, Show)

src/Types/User.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE OverloadedStrings #-}
 module Types.User where
 
 import GHC.Generics
@@ -85,7 +84,7 @@ instance ToJSON UserDetailsSubmit where
 instance FromJSON UserDetailsSubmit
 
 
-data UserRecharge = UserRecharge
+newtype UserRecharge = UserRecharge
   { userRechargeAmount :: Int
   }
   deriving (Generic, Show)