From 3167a638dfce87c0148f918dc496459b8e0357db Mon Sep 17 00:00:00 2001 From: nek0 Date: Mon, 9 Sep 2019 12:54:56 +0200 Subject: [PATCH] spew only user summaries --- src/Control/User.hs | 2 +- src/Model/User.hs | 11 ++++++----- src/Types/User.hs | 13 +++++++++++++ 3 files changed, 20 insertions(+), 6 deletions(-) diff --git a/src/Control/User.hs b/src/Control/User.hs index a125975..d4133b4 100644 --- a/src/Control/User.hs +++ b/src/Control/User.hs @@ -96,7 +96,7 @@ userTransfer (Just auid) (UserTransfer target amount) = user <- userDetailsSelect auid conn if amount < userDetailsBalance user then do - mtarget <- filter (\u -> userId u == target) <$> userSelect (Just All) conn + mtarget <- filter (\u -> userSummaryId u == target) <$> userSelect (Just All) conn if not (null mtarget) then do void $ addToUserBalance auid (-amount) conn diff --git a/src/Model/User.hs b/src/Model/User.hs index 719adcf..74f9a92 100644 --- a/src/Model/User.hs +++ b/src/Model/User.hs @@ -78,17 +78,17 @@ userTable = table "user" ( ) userSelect - :: Maybe Refine + :: Maybe UserRefine -> PGS.Connection - -> MateHandler [User] + -> MateHandler [UserSummary] userSelect ref conn = do today <- utctDay <$> (liftIO $ getCurrentTime) users <- liftIO $ runSelect conn (case ref of Nothing -> keepWhen (\(_, _, _, ts, _, _, _, _, _) -> ts .>= C.constant (addDays (-30) today) ) <<< queryTable userTable - Just All -> selectTable userTable - Just Old -> keepWhen (\(_, _, _, ts, _, _, _, _, _) -> + Just AllUsers -> selectTable userTable + Just OldUsers -> keepWhen (\(_, _, _, ts, _, _, _, _, _) -> ts .<= C.constant (addDays (-30) today) ) <<< queryTable userTable ) :: MateHandler @@ -105,7 +105,8 @@ userSelect ref conn = do ] mapM (\(i1, i2, i3, i4, i5, i6, i7, i8, i9) -> return $ - User i1 i2 i3 i4 i5 i6 (AuthSalt i7) (AuthHash <$> i8) (toEnum <$> i9) + -- User i1 i2 i3 i4 i5 i6 (AuthSalt i7) (AuthHash <$> i8) (toEnum <$> i9) + UserSummary i1 i2 i6 ) users diff --git a/src/Types/User.hs b/src/Types/User.hs index 82fe843..eefa400 100644 --- a/src/Types/User.hs +++ b/src/Types/User.hs @@ -39,6 +39,19 @@ instance ToJSON User where instance FromJSON User +data UserSummary = UserSummary + { userSummaryId :: Int + , userSummaryIdent :: T.Text + , userSummaryAvatar :: Maybe Int + } + deriving (Generic, Show) + +instance ToJSON UserSummary where + toEncoding = genericToEncoding defaultOptions + +instance FromJSON UserSummary + + data UserSubmit = UserSubmit { userSubmitIdent :: T.Text , userSubmitEmail :: Maybe T.Text