adjust connection settings and lessen indentation un user cotrols
This commit is contained in:
parent
9ba10a1d7a
commit
e8bb9c83c4
2 changed files with 41 additions and 49 deletions
|
@ -138,7 +138,11 @@ main = do
|
|||
, rsSoftwareVersion = T.pack (showVersion version)
|
||||
}
|
||||
expirationSpec = TimeSpec 5 0 -- five seconds
|
||||
th <- initCustomThrottler (defaultThrottleSettings expirationSpec)
|
||||
throttleSettings = (defaultThrottleSettings expirationSpec)
|
||||
{ throttleSettingsRate = 10
|
||||
, throttleSettingsPeriod = 1000
|
||||
}
|
||||
th <- initCustomThrottler throttleSettings
|
||||
(\req ->
|
||||
let headers = requestHeaders req
|
||||
in case lookup "x-forwarded-for" headers of
|
||||
|
|
|
@ -3,7 +3,7 @@ module Control.User where
|
|||
|
||||
import Servant
|
||||
|
||||
import Control.Monad (void)
|
||||
import Control.Monad (void, when)
|
||||
|
||||
import Control.Monad.Reader (asks)
|
||||
|
||||
|
@ -83,23 +83,21 @@ userRecharge
|
|||
:: Maybe (Int, AuthMethod)
|
||||
-> UserRecharge
|
||||
-> MateHandler ()
|
||||
userRecharge (Just (auid, _)) (UserRecharge amount) =
|
||||
if amount >= 0
|
||||
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
|
||||
userRecharge (Just (auid, _)) (UserRecharge amount) = do
|
||||
when (amount < 0) $ do
|
||||
throwError $ err400
|
||||
{ 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 _ =
|
||||
throwError $ err401
|
||||
{ errBody = "No Authentication present."
|
||||
|
@ -109,42 +107,32 @@ userTransfer
|
|||
:: Maybe (Int, AuthMethod)
|
||||
-> UserTransfer
|
||||
-> MateHandler ()
|
||||
userTransfer (Just (auid, method)) (UserTransfer target amount) =
|
||||
if amount >= 0
|
||||
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
|
||||
userTransfer (Just (auid, method)) (UserTransfer target amount) = do
|
||||
when (amount < 0) $ do
|
||||
throwError $ err400
|
||||
{ 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 _ =
|
||||
throwError $ err401
|
||||
{ errBody = "No Authentication present."
|
||||
|
|
Loading…
Reference in a new issue