Add refinement option for active users (which is default)

This commit is contained in:
nek0 2019-09-11 04:04:06 +02:00
parent 5ba35c5648
commit b7c4215e27
3 changed files with 16 additions and 12 deletions

View file

@ -13,6 +13,8 @@ import Data.Time (getCurrentTime, utctDay)
import Data.ByteString.Random (random) import Data.ByteString.Random (random)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T import qualified Data.Text as T
-- internal imports -- internal imports
@ -61,7 +63,7 @@ userUpdate (Just aid) uid uds =
userList :: Maybe UserRefine -> MateHandler [UserSummary] userList :: Maybe UserRefine -> MateHandler [UserSummary]
userList ref = do userList ref = do
conn <- rsConnection <$> ask conn <- rsConnection <$> ask
userSelect ref conn userSelect (fromMaybe ActiveUsers ref) conn
userRecharge :: Maybe Int -> UserRecharge -> MateHandler () userRecharge :: Maybe Int -> UserRecharge -> MateHandler ()
userRecharge (Just auid) (UserRecharge amount) = userRecharge (Just auid) (UserRecharge amount) =
@ -96,7 +98,7 @@ userTransfer (Just auid) (UserTransfer target amount) =
user <- userDetailsSelect auid conn user <- userDetailsSelect auid conn
if amount < userDetailsBalance user if amount < userDetailsBalance user
then do then do
mtarget <- filter (\u -> userSummaryId u == target) <$> userSelect (Just AllUsers) conn mtarget <- filter (\u -> userSummaryId u == target) <$> userSelect AllUsers conn
if not (null mtarget) if not (null mtarget)
then do then do
void $ addToUserBalance auid (-amount) conn void $ addToUserBalance auid (-amount) conn

View file

@ -78,17 +78,17 @@ userTable = table "user" (
) )
userSelect userSelect
:: Maybe UserRefine :: UserRefine
-> PGS.Connection -> PGS.Connection
-> MateHandler [UserSummary] -> MateHandler [UserSummary]
userSelect ref conn = do userSelect ref conn = do
today <- utctDay <$> (liftIO $ getCurrentTime) today <- utctDay <$> (liftIO $ getCurrentTime)
users <- liftIO $ runSelect conn (case ref of users <- liftIO $ runSelect conn (case ref of
Nothing -> keepWhen (\(_, _, _, ts, _, _, _, _, _) -> AllUsers -> selectTable userTable
ActiveUsers -> keepWhen (\(_, _, _, ts, _, _, _, _, _) ->
ts .>= C.constant (addDays (-30) today) ts .>= C.constant (addDays (-30) today)
) <<< queryTable userTable ) <<< queryTable userTable
Just AllUsers -> selectTable userTable OldUsers -> keepWhen (\(_, _, _, ts, _, _, _, _, _) ->
Just OldUsers -> keepWhen (\(_, _, _, ts, _, _, _, _, _) ->
ts .<= C.constant (addDays (-30) today) ts .<= C.constant (addDays (-30) today)
) <<< queryTable userTable ) <<< queryTable userTable
) :: MateHandler ) :: MateHandler

View file

@ -7,19 +7,21 @@ import GHC.Generics
import Web.HttpApiData import Web.HttpApiData
data UserRefine = AllUsers | OldUsers data UserRefine = AllUsers | ActiveUsers | OldUsers
deriving (Generic, Show, Enum) deriving (Generic, Show, Enum)
instance FromHttpApiData UserRefine where instance FromHttpApiData UserRefine where
parseQueryParam t = parseQueryParam t =
case t of case t of
"all" -> Right AllUsers "all" -> Right AllUsers
"active" -> Right ActiveUsers
"old" -> Right OldUsers "old" -> Right OldUsers
x -> Left ("Error: Unknown refine " <> x) x -> Left ("Error: Unknown refine " <> x)
instance ToHttpApiData UserRefine where instance ToHttpApiData UserRefine where
toUrlPiece x = case x of toUrlPiece x = case x of
AllUsers -> "all" AllUsers -> "all"
ActiveUsers -> "active"
OldUsers -> "old" OldUsers -> "old"