adjust connection settings and lessen indentation un user cotrols

This commit is contained in:
nek0 2020-05-10 08:36:43 +02:00
parent f1a81acb2b
commit 8971fcce4d
2 changed files with 41 additions and 49 deletions

View file

@ -103,7 +103,11 @@ main = do
, rsSoftwareVersion = T.pack (showVersion version) , rsSoftwareVersion = T.pack (showVersion version)
} }
expirationSpec = TimeSpec 5 0 -- five seconds expirationSpec = TimeSpec 5 0 -- five seconds
th <- initCustomThrottler (defaultThrottleSettings expirationSpec) throttleSettings = (defaultThrottleSettings expirationSpec)
{ throttleSettingsRate = 10
, throttleSettingsPeriod = 1000
}
th <- initCustomThrottler throttleSettings
(\req -> (\req ->
let headers = requestHeaders req let headers = requestHeaders req
in case lookup "x-forwarded-for" headers of in case lookup "x-forwarded-for" headers of

View file

@ -3,7 +3,7 @@ module Control.User where
import Servant import Servant
import Control.Monad (void) import Control.Monad (void, when)
import Control.Monad.Reader (asks) import Control.Monad.Reader (asks)
@ -83,23 +83,21 @@ userRecharge
:: Maybe (Int, AuthMethod) :: Maybe (Int, AuthMethod)
-> UserRecharge -> UserRecharge
-> MateHandler () -> MateHandler ()
userRecharge (Just (auid, _)) (UserRecharge amount) = userRecharge (Just (auid, _)) (UserRecharge amount) = do
if amount >= 0 when (amount < 0) $ do
then do
conn <- asks rsConnection
ud <- userDetailsSelect auid conn
void $ insertNewJournalEntry
(JournalSubmit
("User \"" <> userDetailsIdent ud <> "\" recharged " <>
T.pack (show (fromIntegral amount / 100 :: Double)))
amount
)
conn
void $ addToUserBalance auid amount conn
else
throwError $ err400 throwError $ err400
{ errBody = "Amounts less or equal zero are not acceptable." { errBody = "Amounts less or equal zero are not acceptable."
} }
conn <- asks rsConnection
ud <- userDetailsSelect auid conn
void $ insertNewJournalEntry
(JournalSubmit
("User \"" <> userDetailsIdent ud <> "\" recharged " <>
T.pack (show (fromIntegral amount / 100 :: Double)))
amount
)
conn
void $ addToUserBalance auid amount conn
userRecharge Nothing _ = userRecharge Nothing _ =
throwError $ err401 throwError $ err401
{ errBody = "No Authentication present." { errBody = "No Authentication present."
@ -109,42 +107,32 @@ userTransfer
:: Maybe (Int, AuthMethod) :: Maybe (Int, AuthMethod)
-> UserTransfer -> UserTransfer
-> MateHandler () -> MateHandler ()
userTransfer (Just (auid, method)) (UserTransfer target amount) = userTransfer (Just (auid, method)) (UserTransfer target amount) = do
if amount >= 0 when (amount < 0) $ do
then
if auid /= target
then
if method `elem` [PrimaryPass, ChallengeResponse]
then do
conn <- asks rsConnection
user <- userDetailsSelect auid conn
if amount < userDetailsBalance user
then do
mtarget <- filter (\u -> userSummaryId u == target) <$> userSelect AllUsers conn
if not (null mtarget)
then do
void $ addToUserBalance auid (-amount) conn
void $ addToUserBalance target amount conn
else
throwError $ err400
{ errBody = "Target user not found."
}
else
throwError $ err400
{ errBody = "Not enough credit balance."
}
else
throwError $ err400
{ errBody = "You can not transfer yourself money."
}
else
throwError $ err401
{ errBody = "No Authentication present."
}
else
throwError $ err400 throwError $ err400
{ errBody = "Amounts less or equal zero are not acceptable." { errBody = "Amounts less or equal zero are not acceptable."
} }
when (auid == target) $ do
throwError $ err400
{ errBody = "You can not transfer yourself money."
}
when (method `notElem` [PrimaryPass, ChallengeResponse]) $ do
throwError $ err401
{ errBody = "No Authentication present."
}
conn <- asks rsConnection
user <- userDetailsSelect auid conn
when (amount > userDetailsBalance user) $ do
throwError $ err400
{ errBody = "Not enough credit balance."
}
mtarget <- filter (\u -> userSummaryId u == target) <$> userSelect AllUsers conn
when (null mtarget) $ do
throwError $ err400
{ errBody = "Target user not found."
}
void $ addToUserBalance auid (-amount) conn
void $ addToUserBalance target amount conn
userTransfer Nothing _ = userTransfer Nothing _ =
throwError $ err401 throwError $ err401
{ errBody = "No Authentication present." { errBody = "No Authentication present."