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.Maybe (fromMaybe)
import qualified Data.Text as T
-- internal imports
@ -61,7 +63,7 @@ userUpdate (Just aid) uid uds =
userList :: Maybe UserRefine -> MateHandler [UserSummary]
userList ref = do
conn <- rsConnection <$> ask
userSelect ref conn
userSelect (fromMaybe ActiveUsers ref) conn
userRecharge :: Maybe Int -> UserRecharge -> MateHandler ()
userRecharge (Just auid) (UserRecharge amount) =
@ -96,7 +98,7 @@ userTransfer (Just auid) (UserTransfer target amount) =
user <- userDetailsSelect auid conn
if amount < userDetailsBalance user
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)
then do
void $ addToUserBalance auid (-amount) conn

View file

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

View file

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