From e53a67ae02ecda9a01151122b330b5925b77cb23 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 7 Sep 2019 02:48:16 +0200 Subject: [PATCH] reducing warnings to 0 --- src/API.hs | 5 ----- src/Control/Auth.hs | 8 ++------ src/Control/Buy.hs | 8 +++----- src/Control/User.hs | 16 +++++++--------- src/Model/Auth.hs | 22 +++++++++++----------- src/Model/Journal.hs | 12 ++++++------ src/Model/Product.hs | 35 +++-------------------------------- src/Model/User.hs | 30 +++++++++++------------------- src/Types/Auth.hs | 4 ---- src/Types/Purchase.hs | 2 -- src/Types/Refine.hs | 2 -- src/Types/User.hs | 7 ++++--- 12 files changed, 47 insertions(+), 104 deletions(-) diff --git a/src/API.hs b/src/API.hs index aa23530..b3707a5 100644 --- a/src/API.hs +++ b/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 = diff --git a/src/Control/Auth.hs b/src/Control/Auth.hs index ae69f02..ef0327e 100644 --- a/src/Control/Auth.hs +++ b/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 diff --git a/src/Control/Buy.hs b/src/Control/Buy.hs index 816499f..a89fa54 100644 --- a/src/Control/Buy.hs +++ b/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 diff --git a/src/Control/User.hs b/src/Control/User.hs index b0b1a84..41969d3 100644 --- a/src/Control/User.hs +++ b/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 diff --git a/src/Model/Auth.hs b/src/Model/Auth.hs index 8846f65..5d29abf 100644 --- a/src/Model/Auth.hs +++ b/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 diff --git a/src/Model/Journal.hs b/src/Model/Journal.hs index 35e3c26..2323ca8 100644 --- a/src/Model/Journal.hs +++ b/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 ) diff --git a/src/Model/Product.hs b/src/Model/Product.hs index b6090aa..a724ee6 100644 --- a/src/Model/Product.hs +++ b/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 diff --git a/src/Model/User.hs b/src/Model/User.hs index bf83c1c..315c06f 100644 --- a/src/Model/User.hs +++ b/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 diff --git a/src/Types/Auth.hs b/src/Types/Auth.hs index 2e5017a..5e34cf5 100644 --- a/src/Types/Auth.hs +++ b/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 diff --git a/src/Types/Purchase.hs b/src/Types/Purchase.hs index 6d888ba..2917a41 100644 --- a/src/Types/Purchase.hs +++ b/src/Types/Purchase.hs @@ -2,8 +2,6 @@ module Types.Purchase where -import Data.Text - import Data.Aeson import GHC.Generics diff --git a/src/Types/Refine.hs b/src/Types/Refine.hs index c88deb3..3c68da2 100644 --- a/src/Types/Refine.hs +++ b/src/Types/Refine.hs @@ -3,8 +3,6 @@ module Types.Refine where -import Data.Text - import GHC.Generics import Web.HttpApiData diff --git a/src/Types/User.hs b/src/Types/User.hs index ce7d975..82fe843 100644 --- a/src/Types/User.hs +++ b/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