From 745780486bed2ea512af8ef4521fa1bfc9aaee1b Mon Sep 17 00:00:00 2001 From: nek0 Date: Wed, 14 Aug 2019 18:03:17 +0200 Subject: [PATCH] controlified --- mateamt.cabal | 3 ++ src/Control.hs | 3 ++ src/Main.hs | 118 ------------------------------------------------- 3 files changed, 6 insertions(+), 118 deletions(-) diff --git a/mateamt.cabal b/mateamt.cabal index ae02135..a14eb3e 100644 --- a/mateamt.cabal +++ b/mateamt.cabal @@ -26,6 +26,9 @@ executable mateamt , Control , Control.Buy , Control.Journal + , Control.User + , Control.Product + , Control.Auth , Model , Model.User , Model.Product diff --git a/src/Control.hs b/src/Control.hs index 5891a47..37325d6 100644 --- a/src/Control.hs +++ b/src/Control.hs @@ -4,3 +4,6 @@ module Control import Control.Buy as C import Control.Journal as C +import Control.User as C +import Control.Auth as C +import Control.Product as C diff --git a/src/Main.hs b/src/Main.hs index 2e39d95..30cbaab 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -112,121 +112,3 @@ authHandler conn = mkAuthHandler handler _ -> return Nothing return res - - -authGet :: Int -> MateHandler AuthInfo -authGet id = - getUserAuthInfo id - -authSend :: AuthRequest -> MateHandler AuthResult -authSend = processAuthRequest - -authLogout :: Maybe Int -> Int -> MateHandler () -authLogout (Just muid) luid = do - if muid == luid - then - processLogout luid - else - throwError $ err403 - { errBody = "Forbidden" - } -authLogout Nothing _ = do - throwError $ err403 - { errBody = "Forbidden" - } - - -userNew :: UserSubmit -> MateHandler Int -userNew us = do - now <- liftIO $ getCurrentTime - randSalt <- liftIO $ random 8 - conn <- rsConnection <$> ask - insertUser us (utctDay now) randSalt conn - -userGet :: Maybe Int -> Int -> MateHandler UserDetails -userGet Nothing _ = - throwError $ err403 - { errBody = "No Authentication present" - } -userGet (Just aid) id = - if aid == id - then do - now <- liftIO $ getCurrentTime - conn <- rsConnection <$> ask - -- void $ liftIO $ runUpdate_ conn (updateUser id us (utctDay now)) - userDetailsSelect conn id - else - throwError $ err403 - { errBody = "Wrong Authentication present" - } - -userUpdate :: Maybe Int -> Int -> UserDetailsSubmit -> MateHandler () -userUpdate Nothing _ _ = - throwError $ err403 - { errBody = "No Authentication present" - } -userUpdate (Just aid) id uds = - if aid == id - then do - now <- liftIO $ getCurrentTime - conn <- rsConnection <$> ask - void $ updateUserDetails id uds (utctDay now) conn - else - throwError $ err403 - { errBody = "Wrong Authentication present" - } - -userList :: Maybe Int -> Maybe Refine -> MateHandler [User] -userList muid ref = do - conn <- rsConnection <$> ask - userSelect conn ref - - -productNew :: Maybe Int -> ProductSubmit -> MateHandler Int -productNew (Just _) bevsub = do - conn <- rsConnection <$> ask - bevid <- insertProduct bevsub conn - void $ insertNewEmptyAmount bevid bevsub conn - return bevid -productNew Nothing _ = - throwError $ err403 - -productOverview :: Int -> MateHandler ProductOverview -productOverview pid = do - conn <- rsConnection <$> ask - productOverviewSelectSingle pid conn - -productStockRefill :: Maybe Int -> [AmountRefill] -> MateHandler () -productStockRefill (Just _) amorefs = do - if all ((>= 0) . amountRefillAmount) amorefs - then do - conn <- rsConnection <$> ask - void $ manualProductAmountRefill amorefs conn - else - throwError $ err406 - { errBody = "Amounts less than 0 are not acceptable" - } -productStockRefill Nothing _ = - throwError $ err403 - { errBody = "No Authentication present" - } - -productStockUpdate :: Maybe Int -> [AmountUpdate] -> MateHandler () -productStockUpdate (Just _) amoups = do - if all ((>= 0) . amountUpdateRealAmount) amoups - then do - conn <- rsConnection <$> ask - void $ manualProductAmountUpdate amoups conn - else - throwError $ err406 - { errBody = "Amounts less than 0 are not acceptable" - } -productStockUpdate Nothing _ = - throwError $ err403 - { errBody = "No Authentication present" - } - -productList :: MateHandler [ProductOverview] -productList = do - conn <- rsConnection <$> ask - productOverviewSelect conn