reducing warnings to 0

src/API.hs

@@ -10,15 +10,10 @@
 
 module API where
 
-import Data.Text
-import Data.Time (UTCTime)
-
 import Servant.API
 
 -- internal imports
 
-import Model as M
-
 import Types
 
 type UserAPI =

src/Control/Auth.hs

@@ -3,18 +3,14 @@ module Control.Auth where
 
 import Servant
 
-import Control.Monad (void)
-
-import Control.Monad.Reader (ask)
-
 -- internal imports
 
 import Types
 import Model
 
 authGet :: Int -> MateHandler AuthInfo
-authGet id =
-  getUserAuthInfo id
+authGet uid =
+  getUserAuthInfo uid
 
 authSend :: AuthRequest -> MateHandler AuthResult
 authSend = processAuthRequest

src/Control/Buy.hs

@@ -1,8 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Control.Buy where
 
-import Servant
-
 import Control.Monad (void, foldM)
 
 import Control.Monad.Reader (ask)
@@ -18,7 +16,7 @@ buy
   -> MateHandler PurchaseResult
 buy (Just auid) pds = do
   conn <- rsConnection <$> ask
-  (missing, real) <- foldM (\acc@(ms, rs) pd -> do
+  (missing, real) <- foldM (\(ms, rs) pd -> do
     mmiss <- checkProductAvailability pd conn
     case mmiss of
       Just miss -> return
@@ -39,7 +37,7 @@ buy (Just auid) pds = do
     )
     0
     real
-  addToUserBalance auid (-price) conn
+  void $ addToUserBalance auid (-price) conn
   newBalance <- userBalanceSelect conn auid
   return $ PurchaseResult
     ( if newBalance < 0
@@ -49,7 +47,7 @@ buy (Just auid) pds = do
     missing
 buy Nothing pds = do
   conn <- rsConnection <$> ask
-  (missing, real) <- foldM (\acc@(ms, rs) pd -> do
+  (missing, real) <- foldM (\(ms, rs) pd -> do
     mmiss <- checkProductAvailability pd conn
     case mmiss of
       Just miss -> return

src/Control/User.hs

@@ -32,13 +32,11 @@ userGet Nothing _ =
   throwError $ err403
     { errBody = "No Authentication present."
     }
-userGet (Just aid) id =
-  if aid == id
+userGet (Just aid) uid =
+  if aid == uid
   then do
-    now <- liftIO $ getCurrentTime
     conn <- rsConnection <$> ask
-    -- void $ liftIO $ runUpdate_ conn (updateUser id us (utctDay now))
-    userDetailsSelect id conn
+    userDetailsSelect uid conn
   else
     throwError $ err403
       { errBody = "Wrong Authentication present."
@@ -49,19 +47,19 @@ userUpdate Nothing _ _ =
   throwError $ err403
     { errBody = "No Authentication present."
     }
-userUpdate (Just aid) id uds =
-  if aid == id
+userUpdate (Just aid) uid uds =
+  if aid == uid
   then do
     now <- liftIO $ getCurrentTime
     conn <- rsConnection <$> ask
-    void $ updateUserDetails id uds (utctDay now) conn
+    void $ updateUserDetails uid uds (utctDay now) conn
   else
     throwError $ err403
       { errBody = "Wrong Authentication present."
       }
 
 userList :: Maybe Int -> Maybe Refine -> MateHandler [User]
-userList muid ref = do
+userList _ ref = do
   conn <- rsConnection <$> ask
   userSelect ref conn
 

src/Model/Auth.hs

@@ -5,8 +5,6 @@ module Model.Auth where
 
 import Servant
 
-import GHC.Generics
-
 import Control.Arrow ((<<<))
 
 import Control.Monad (void)
@@ -15,7 +13,7 @@ import Control.Monad.IO.Class (liftIO)
 
 import Control.Monad.Reader (ask)
 
-import Control.Concurrent (threadDelay, forkIO)
+import Control.Concurrent (threadDelay)
 
 import Control.Concurrent.STM
 
@@ -74,6 +72,8 @@ tokenTable = table "token" (
       )
     )
 
+delayTime :: Int
+delayTime = 1 * 10 ^ (6 :: Int)
 
 getUserAuthInfo
   :: Int
@@ -81,7 +81,7 @@ getUserAuthInfo
 getUserAuthInfo ident = do
   conn <- rsConnection <$> ask
   users <- liftIO $ do
-    void $ threadDelay $ 1 * 10 ^ 6
+    void $ threadDelay delayTime
     runSelect conn (
       keepWhen (\(uid, _, _, _, _, _, _, _, _) ->
         uid .== C.constant ident) <<< queryTable userTable
@@ -102,7 +102,7 @@ getUserAuthInfo ident = do
     { errBody = "No such user"
     }
   else
-    head <$> mapM (\(i1, i2, i3, i4, i5, i6, i7, i8, i9) ->
+    head <$> mapM (\(_, _, _, _, _, _, i7, _, i9) ->
         AuthInfo (AuthSalt i7) (toEnum $ fromMaybe 0 i9) <$> newTicket ident
         )
       users
@@ -129,12 +129,12 @@ validateToken conn header = do
       then return $ Just uid
       else do
         void $ deleteToken header conn
-        liftIO $ threadDelay $ 1 * 10 ^ 6
+        liftIO $ threadDelay delayTime
         throwError $ err401
           { errBody = "Your token expired!"
           }
     _ -> do
-      liftIO $ threadDelay $ 1 * 10 ^ 6
+      liftIO $ threadDelay delayTime
       throwError $ err401
         { errBody = "No valid token found!"
         }
@@ -144,7 +144,7 @@ generateToken
   :: Ticket
   -> AuthHash
   -> MateHandler AuthResult
-generateToken (Ticket _ ident exp) (AuthHash hash) = do
+generateToken (Ticket _ ident _) (AuthHash hash) = do
   conn <- rsConnection <$> ask
   users <- liftIO $ runSelect conn (
     keepWhen (\(uid, _, _, _, _, _, _, _, _) ->
@@ -161,7 +161,7 @@ generateToken (Ticket _ ident exp) (AuthHash hash) = do
           , Maybe Int
           )
         ]
-  let userHash = head $ map (\(i1, i2, i3, i4, i5, i6, i7, i8, i9) -> i8) users
+  let userHash = head $ map (\(_, _, _, _, _, _, _, i8, _) -> i8) users
   if userHash == Nothing || userHash == Just hash
   then do
     token <- liftIO $ Token
@@ -239,7 +239,7 @@ processAuthRequest (AuthRequest aticket hash) = do
   case S.toList mticket of
     [ticket] -> do
       now <- liftIO $ getCurrentTime
-      liftIO $ threadDelay $ 1 * 10 ^ 6
+      liftIO $ threadDelay delayTime
       if now > ticketExpiry ticket
       then
 #if defined(DEVELOP)
@@ -252,7 +252,7 @@ processAuthRequest (AuthRequest aticket hash) = do
       else
         generateToken ticket hash
     _        -> do
-      liftIO $ threadDelay $ 1 * 10 ^ 6
+      liftIO $ threadDelay delayTime
 #if defined(DEVELOP)
       do
         mockticket <- Ticket <$> pure aticket <*> pure 1 <*> liftIO getCurrentTime

src/Model/Journal.hs

@@ -86,8 +86,8 @@ selectJournalEntries mlimit moffset conn = liftIO $ do
           )
         ]
   return $ fst $ foldr
-    (\(id_, ts, desc, tot, check) (fin, last)->
-      (JournalEntry id_ desc ts (tot - last) tot check : fin, tot)
+    (\(id_, ts, descr, tot, check) (fin, before)->
+      (JournalEntry id_ descr ts (tot - before) tot check : fin, tot)
       )
     ( []
     , if isJust mlimit && not (null entries)
@@ -119,8 +119,8 @@ selectLatestJournalEntry conn = liftIO $ do
   if not (null lastTwoEntries)
   then do
     let diff = foldl (\acc (_, _, _, tot, _) -> tot - acc) 0 lastTwoEntries
-        (id, ts, desc, total, check) = head lastTwoEntries
-    return $ Just $ JournalEntry id desc ts diff total check
+        (jid, ts, descr, total, check) = head lastTwoEntries
+    return $ Just $ JournalEntry jid descr ts diff total check
   else
     return Nothing
 
@@ -129,7 +129,7 @@ insertNewJournalEntry
   :: JournalSubmit
   -> PGS.Connection
   -> MateHandler Int
-insertNewJournalEntry (JournalSubmit desc amount) conn = do
+insertNewJournalEntry (JournalSubmit descr amount) conn = do
   lastTotal <- (\x -> case x of
     Just j  -> journalEntryTotalAmount j 
     Nothing -> 0
@@ -142,7 +142,7 @@ insertNewJournalEntry (JournalSubmit desc amount) conn = do
         [
         ( C.constant (Nothing :: Maybe Int)
         , C.constant now
-        , C.constant desc
+        , C.constant descr
         , C.constant (lastTotal + amount)
         , C.constant False
         )

src/Model/Product.hs

@@ -1,31 +1,18 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE Arrows #-}
 module Model.Product where
 
-import Servant.Server
-
 import Data.Text as T hiding (head, foldl)
-import Data.Time.Calendar (Day)
 import Data.Time.Clock (UTCTime)
 import Data.Profunctor.Product (p9)
 
-import Data.Aeson
-import Data.Aeson.Types
-
-import Data.Int (Int64)
-
-import Control.Monad (when)
 import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Error.Class (throwError)
 
 import Control.Arrow ((<<<), returnA)
 
 import qualified Database.PostgreSQL.Simple as PGS
 
-import GHC.Generics
-
 import Opaleye as O hiding (max)
 import Opaleye.Constant as C
 
@@ -251,7 +238,7 @@ productShortOverviewSelect conn = do
           )
         ]
   mapM
-    (\(i1, i2, i3, i4, i5, i6, i7, i8, i9) -> do
+    (\(i1, i2, i3, i4, _, _, _, _, _) -> do
       amounts <- liftIO $ runSelect conn
         ( proc () -> do
           stuff@(a1, _, _, _, _) <- orderBy (desc (\(_, ts, _, _, _) -> ts))
@@ -267,22 +254,6 @@ productShortOverviewSelect conn = do
                 )
               ]
       (ii3, ii4) <- return $ (\(_, _, y, x, _) -> (x, y)) $ head amounts
-      ii5 <- return $ (\(_, x) -> x) $
-        foldl
-          (\(bef, van) (_, _, amo, _, ver) ->
-            if ver
-            then (amo, if amo < bef then van + (bef - amo) else van)
-            else (amo, van)
-            )
-          (0, 0)
-          (Prelude.reverse amounts)
-      ii10 <- return $ snd $ foldl (\(bef, tot) (_, _, amo, _, ver) ->
-        if ver
-        then (amo, tot)
-        else (amo, tot + (bef - amo))
-        )
-        (0, 0)
-        (Prelude.reverse amounts)
       return $ ProductShortOverview
         i1 i2 ii3 ii4 i3 i4
       )
@@ -293,7 +264,7 @@ insertProduct
   :: ProductSubmit
   -> PGS.Connection
   -> MateHandler Int
-insertProduct (ProductSubmit ident price ml ava sup max apc ppc artnr) conn =
+insertProduct (ProductSubmit ident _ ml ava sup maxi apc ppc artnr) conn =
   fmap head $ liftIO $ runInsert_ conn $ Insert
     { iTable = productTable
     , iRows  =
@@ -303,7 +274,7 @@ insertProduct (ProductSubmit ident price ml ava sup max apc ppc artnr) conn =
       , C.constant ml
       , C.constant ava
       , C.constant sup
-      , C.constant max
+      , C.constant maxi
       , C.constant apc
       , C.constant ppc
       , C.constant artnr

src/Model/User.hs

@@ -1,6 +1,4 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE DuplicateRecordFields #-}
 module Model.User where
 
 import Data.Text as T hiding (head, foldl)
@@ -9,16 +7,12 @@ import Data.Time.Clock
 
 import Data.Profunctor.Product (p9)
 
-import Data.Maybe (fromJust, isJust, fromMaybe)
-
 import Data.ByteString hiding (head, foldl)
 
 import Data.Int (Int64)
 
 import qualified Database.PostgreSQL.Simple as PGS
 
-import GHC.Generics
-
 import Control.Arrow ((<<<))
 
 import Control.Monad.IO.Class (liftIO)
@@ -119,11 +113,10 @@ userDetailsSelect
   :: Int
   -> PGS.Connection
   -> MateHandler UserDetails
-userDetailsSelect id conn = do
-  today <- utctDay <$> (liftIO $ getCurrentTime)
+userDetailsSelect uid conn = do
   users <- liftIO $ runSelect conn (
-      keepWhen (\(uid, _, _, _, _, _, _, _, _) ->
-        uid .== C.constant id
+      keepWhen (\(uuid, _, _, _, _, _, _, _, _) ->
+        uuid .== C.constant uid
         ) <<< queryTable userTable
       ) :: MateHandler
           [ ( Int
@@ -138,8 +131,8 @@ userDetailsSelect id conn = do
             )
           ]
   head <$> mapM
-    (\(i1, i2, i3, i4, i5, i6, i7, i8, i9) -> return $
-      UserDetails i2 i3 i5 i6 (AuthSalt i7) (toEnum <$> i9)
+    (\(i1, i2, i3, _, i5, i6, i7, _, i9) -> return $
+      UserDetails i1 i2 i3 i5 i6 (AuthSalt i7) (toEnum <$> i9)
       )
     users
 
@@ -148,11 +141,10 @@ userBalanceSelect
   :: PGS.Connection
   -> Int
   -> MateHandler Int
-userBalanceSelect conn id = do
-  today <- utctDay <$> (liftIO $ getCurrentTime)
+userBalanceSelect conn uid = do
   users <- liftIO $ runSelect conn (
-      keepWhen (\(uid, _, _, _, _, _, _, _, _) ->
-        uid .== C.constant id
+      keepWhen (\(uuid, _, _, _, _, _, _, _, _) ->
+        uuid .== C.constant uid
         ) <<< queryTable userTable
       ) :: MateHandler
           [ ( Int
@@ -167,7 +159,7 @@ userBalanceSelect conn id = do
             )
           ]
   head <$> mapM
-    (\(i1, i2, i3, i4, i5, i6, i7, i8, i9) -> return $
+    (\(_, _, i3, _, _, _, _, _, _) -> return $
       i3
       )
     users
@@ -194,7 +186,7 @@ insertUser us now randSalt conn = fmap head $ liftIO $ runInsert_ conn $ Insert
     , C.constant (Nothing :: Maybe Int)
     )
     ]
-  , iReturning = rReturning (\(id, _, _, _, _, _, _, _, _) -> id)
+  , iReturning = rReturning (\(uid, _, _, _, _, _, _, _, _) -> uid)
   , iOnConflict = Nothing
   }
 
@@ -206,7 +198,7 @@ updateUserDetails
   -> MateHandler Int64
 updateUserDetails uid uds now conn = liftIO $ runUpdate_ conn $ Update
   { uTable      = userTable
-  , uUpdateWith = updateEasy (\(id_, _, i3, _, _, _, i7, i8, _) ->
+  , uUpdateWith = updateEasy (\(id_, _, i3, _, _, _, i7, _, _) ->
       ( id_
       , C.constant (userDetailsSubmitIdent uds)
       , i3

src/Types/Auth.hs

@@ -16,10 +16,6 @@ import Data.Time.Clock (UTCTime)
 
 import Data.Text.Encoding (encodeUtf8, decodeUtf8)
 
-import Data.IORef
-
-import Control.Monad.IO.Class (liftIO)
-
 import Control.Concurrent.STM.TVar (TVar)
 
 -- internal imports

src/Types/Purchase.hs

@@ -2,8 +2,6 @@
 
 module Types.Purchase where
 
-import Data.Text
-
 import Data.Aeson
 
 import GHC.Generics

src/Types/Refine.hs

@@ -3,8 +3,6 @@
 
 module Types.Refine where
 
-import Data.Text
-
 import GHC.Generics
 
 import Web.HttpApiData

src/Types/User.hs

@@ -29,9 +29,9 @@ data User
   deriving (Generic, Show)
 
 instance ToJSON User where
-  toEncoding (User id ident balance ts email avatar _ _ _) =
+  toEncoding (User uid ident _ _ _ avatar _ _ _) =
     pairs
-      (  "userId" .= id
+      (  "userId" .= uid
       <> "userIdent" .= ident
       <> "userAvatar" .= avatar
       )
@@ -53,7 +53,8 @@ instance FromJSON UserSubmit
 
 
 data UserDetails = UserDetails
-  { userDetailsIdent   :: T.Text
+  { userDetailsId      :: Int
+  , userDetailsIdent   :: T.Text
   , userDetailsBalance :: Int
   , userDetailsEmail   :: Maybe T.Text
   , userDetailsAvatar  :: Maybe Int