spew only user summaries

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

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 AllUsers -> selectTable userTable
-      Just Old -> keepWhen (\(_, _, _, ts, _, _, _, _, _) ->
+      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
 

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