This commit is contained in:
nek0 2020-08-24 09:43:22 +02:00
parent fade6374fa
commit 69aa5b4e09
8 changed files with 27 additions and 30 deletions

View file

@ -88,7 +88,7 @@ main = do
store <- newTVarIO S.empty
-- tracker <- newTVarIO M.empty
migrationsExist <- existsTable conn "schema_migrations"
when (not migrationsExist) $ do
unless migrationsExist $ do
withTransaction conn $
void $ do
runMigration $
@ -110,7 +110,7 @@ main = do
case ok of
MigrationError err -> do
putStrLn ("Migration validation error: " ++ err)
putStrLn ("Running Migrations!")
putStrLn "Running Migrations!"
void $ withTransaction conn $ runMigration $
MigrationContext (MigrationDirectory migLoc) True conn
MigrationSuccess -> return ()
@ -119,11 +119,11 @@ main = do
case ok2 of
MigrationError err -> do
putStrLn ("Migration validation error: " ++ err)
putStrLn ("MIgration failure! exiting...")
putStrLn "MIgration failure! exiting..."
exitWith (ExitFailure 3)
MigrationSuccess -> do
putStrLn ("Migration validation success!")
putStrLn ("starting up...")
putStrLn "Migration validation success!"
putStrLn "starting up..."
forkCleanProcess conn store
withStdoutLogger $ \ilog -> do
let settings = setPort (fromIntegral lport) $

View file

@ -22,7 +22,7 @@ journalShow (Just (uid, method)) mlimit moffset = do
maySeeJournal <- anyM
(checkCapability uid)
[roleCanViewJournal, roleCanManageJournal]
if (method `elem` [PrimaryPass, ChallengeResponse] && maySeeJournal)
if method `elem` [PrimaryPass, ChallengeResponse] && maySeeJournal
then do
conn <- asks rsConnection
selectJournalEntries mlimit moffset conn
@ -41,7 +41,7 @@ journalCheck
-> MateHandler ()
journalCheck (Just (uid, method)) check = do
mayCheckJournal <- checkCapability uid roleCanManageJournal
if (method `elem` [PrimaryPass, ChallengeResponse] && mayCheckJournal)
if method `elem` [PrimaryPass, ChallengeResponse] && mayCheckJournal
then do
conn <- asks rsConnection
void $ insertNewCashCheck check conn

View file

@ -23,7 +23,7 @@ productNew
-> MateHandler Int
productNew (Just (uid, auth)) bevsub = do
mayAddProduct <- checkCapability uid roleCanManageProducts
if (auth `elem` [PrimaryPass, ChallengeResponse] && mayAddProduct)
if auth `elem` [PrimaryPass, ChallengeResponse] && mayAddProduct
then do
conn <- asks rsConnection
bevid <- insertProduct bevsub conn
@ -53,13 +53,13 @@ productStockRefill (Just (uid, auth)) amorefs = do
mayRefill <- anyM
(checkCapability uid)
[ roleCanRefillStock, roleCanManageProducts ]
if (auth `elem` [PrimaryPass, ChallengeResponse] && mayRefill)
if auth `elem` [PrimaryPass, ChallengeResponse] && mayRefill
then do
conn <- asks rsConnection
prods <- mapM
(\refill -> productSelectSingle (amountRefillProductId refill) conn)
amorefs
if all (not . null) prods
if not (any null prods)
then
if
all
@ -93,7 +93,7 @@ productStockUpdate
-> MateHandler ()
productStockUpdate (Just (uid, method)) amoups = do
mayUpdateStock <- checkCapability uid roleCanManageProducts
if (method `elem` [PrimaryPass, ChallengeResponse] && mayUpdateStock)
if method `elem` [PrimaryPass, ChallengeResponse] && mayUpdateStock
then
if all ((>= 0) . amountUpdateRealAmount) amoups
then do

View file

@ -28,7 +28,7 @@ roleNew
roleNew (Just (uid, auth)) (RoleSubmit name c1 c2 c3 c4 c5 c6 c7 c8 c9) =
do
isRoleManager <- checkCapability uid roleCanManageRoles
if (auth `elem` [PrimaryPass, ChallengeResponse] && isRoleManager)
if auth `elem` [PrimaryPass, ChallengeResponse] && isRoleManager
then
insertRole name c1 c2 c3 c4 c5 c6 c7 c8 c9 =<< asks rsConnection
else
@ -47,7 +47,7 @@ roleUpdate
-> MateHandler ()
roleUpdate (Just (uid, auth)) id_ roleSubmit = do
isRoleManager <- checkCapability uid roleCanManageRoles
if (auth `elem` [PrimaryPass, ChallengeResponse] && isRoleManager)
if auth `elem` [PrimaryPass, ChallengeResponse] && isRoleManager
then
void $ updateRole id_ roleSubmit =<< asks rsConnection
else
@ -65,7 +65,7 @@ roleDelete
-> MateHandler ()
roleDelete (Just (uid, auth)) id_ = do
isRoleManager <- checkCapability uid roleCanManageRoles
if (auth `elem` [PrimaryPass, ChallengeResponse] && isRoleManager)
if auth `elem` [PrimaryPass, ChallengeResponse] && isRoleManager
then
void $ deleteRole id_ =<< asks rsConnection
else
@ -88,7 +88,7 @@ roleAssociationSubmit
-> MateHandler ()
roleAssociationSubmit (Just (uid, auth)) (RoleAssociationSubmit auid arid) = do
isRoleManager <- checkCapability uid roleCanManageRoles
if (auth `elem` [PrimaryPass, ChallengeResponse] && isRoleManager)
if auth `elem` [PrimaryPass, ChallengeResponse] && isRoleManager
then
associateUserToRole auid arid =<< asks rsConnection
else
@ -106,7 +106,7 @@ roleAssociationDelete
-> MateHandler ()
roleAssociationDelete (Just (uid, auth)) (RoleAssociation auid arid) = do
isRoleManager <- checkCapability uid roleCanManageRoles
if (auth `elem` [PrimaryPass, ChallengeResponse] && isRoleManager)
if auth `elem` [PrimaryPass, ChallengeResponse] && isRoleManager
then
void $ deleteAssociation auid arid =<< asks rsConnection
else

View file

@ -113,7 +113,7 @@ getLatestAmountByProductId pid conn = do
, Bool
)
]
head <$> return ( map
return (head $ map
(\(_, _, amount, _, _) -> amount)
amounts
)
@ -135,7 +135,7 @@ getLatestTotalPrice (PurchaseDetail pid amount) conn = do
, Bool
)
]
(amount *) . head <$> return (map
return $ ((amount *) . head) (map
(\(_, _, _, price, _) -> price)
amounts
)

View file

@ -3,7 +3,7 @@
{-# LANGUAGE Arrows #-}
module Model.Journal where
import Data.Maybe (isJust, fromJust)
import Data.Maybe
import Data.Time (UTCTime)
import Data.Time.Clock
@ -74,9 +74,7 @@ selectJournalEntries mlimit moffset conn = liftIO $ do
let lim = case mlimit of
Just l -> limit (l + 1)
Nothing -> id
off = case moffset of
Just o -> offset o
Nothing -> id
off = maybe id offset moffset
entries <- runSelect conn
( proc () -> do
ret <- lim $ off $ orderBy (desc (\(id_, _, _, _, _) -> id_))

View file

@ -321,7 +321,7 @@ manualProductAmountRefill aups conn =
(\(AmountRefill pid amountSingles amountCrates) -> do
oldamount <- getLatestAmountByProductId pid conn
oldprice <- getLatestPriceByProductId pid conn
perCrate <- (productAmountPerCrate . head) <$>
perCrate <- productAmountPerCrate . head <$>
productSelectSingle pid conn
head <$> liftIO (do
now <- getCurrentTime

View file

@ -1,6 +1,5 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Model.Role where
@ -202,8 +201,8 @@ selectRoleList
-> MateHandler [Role]
selectRoleList ids conn = do
rawRoles <- liftIO $ runSelect conn (
(keepWhen (\(id_, _, _, _, _, _, _, _, _, _, _) ->
in_ (map C.constant ids) id_))
keepWhen (\(id_, _, _, _, _, _, _, _, _, _, _) ->
in_ (map C.constant ids) id_)
<<< queryTable roleTable
) :: MateHandler
[
@ -341,7 +340,7 @@ selectAllRoleAssociations conn = do
)
]
return $ map
(\(uid, rid) -> RoleAssociation uid rid)
(uncurry RoleAssociation)
rawRoleAssocs
@ -359,7 +358,7 @@ selectUserAssociations uid conn = do
, Int
)
]
return $ map (\(auid, arid) -> RoleAssociation auid arid) rawAssocs
return $ map (uncurry RoleAssociation) rawAssocs
associateUserToRole
@ -390,7 +389,7 @@ deleteAssociation uid rid conn =
liftIO $ runDelete_ conn $ Delete
{ dTable = userToRoleTable
, dWhere =
(\(auid, arid) -> auid .== C.constant uid .&& arid .== C.constant rid)
\(auid, arid) -> auid .== C.constant uid .&& arid .== C.constant rid
, dReturning = rCount
}
@ -430,6 +429,6 @@ deleteRole rid conn =
liftIO $ runDelete_ conn $ Delete
{ dTable = roleTable
, dWhere =
(\(id_, _, _, _, _, _, _, _, _, _, _) -> id_ .== C.constant rid)
\(id_, _, _, _, _, _, _, _, _, _, _) -> id_ .== C.constant rid
, dReturning = rCount
}