controlified

This commit is contained in:
nek0 2019-08-14 18:03:17 +02:00
parent 009111ced8
commit 745780486b
3 changed files with 6 additions and 118 deletions

View File

@ -26,6 +26,9 @@ executable mateamt
, Control
, Control.Buy
, Control.Journal
, Control.User
, Control.Product
, Control.Auth
, Model
, Model.User
, Model.Product

View File

@ -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

View File

@ -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