on master help sign in
Resolved #41.
commit48f5f5783f67a8d5471ddcb5b623fc67dd5f979b authoriko <ilyakooo0@gmail.com> dateThu 14 Mar 2019, 14:56 (8 years ago) parent71e6f33
3 files changed+35−7
denis/src/Data/Channel/AnonymousChannel.hs+6−1 denis/src/Data/Channel/NamedChannel.hs+10−3 denis/src/Data/Query.hs+19−3
denis/src/Data/Channel/AnonymousChannel.hs+6−1
@@ -24,6 +24,7 @@ import Data.Time.Clock
2424import Data.Time.Calendar
2525import qualified Data.Vector as V
2626import Data.User
27+import qualified Data.Set as Set
2728
2829
2930-- MARK: Documentation
@@ -50,5 +51,9 @@ instance ToJSON AnonymousChannel where
5051
5152instance FromJSON AnonymousChannel where
5253 parseJSON = withObject "anonymous channel" $ \e ->
53− AnonymousChannel <$> e .: "tags" <*> e .: "people"
54+ AnonymousChannel <$> fmap (V.fromList . removeDuplicates) (e .: "tags") <*> fmap removeDuplicates (e .: "people")
55+ where
56+ removeDuplicates :: Ord a => [a] -> [a]
57+ removeDuplicates = Set.toList . Set.fromList
58+
5459
denis/src/Data/Channel/NamedChannel.hs+10−3
@@ -25,6 +25,7 @@ import Data.Time.Clock
2525import Data.Time.Calendar
2626import qualified Data.Vector as V
2727import Data.User
28+import qualified Data.Set as Set
2829
2930-- MARK: Documentation
3031
@@ -54,9 +55,12 @@ instance (ToJSON u) => ToJSON (NamedChannel u) where
5455 "tags" .= cTags,
5556 "people" .= cPeople ]
5657
57−instance (FromJSON u) => FromJSON (NamedChannel u) where
58+instance (FromJSON u, Ord u) => FromJSON (NamedChannel u) where
5859 parseJSON = withObject "named channel" $ \e ->
59− NamedChannel <$> e .: "id" <*> e .: "name" <*> e .: "tags" <*> e .: "people"
60+ NamedChannel <$> e .: "id" <*> e .: "name" <*> fmap removeDuplicates (e .: "tags") <*> fmap removeDuplicates (e .: "people")
61+ where
62+ removeDuplicates :: Ord a => [a] -> V.Vector a
63+ removeDuplicates = V.fromList . Set.toList . Set.fromList
6064
6165-- MARK: NamedChannelCreationRequest
6266
@@ -77,4 +81,7 @@ instance ToJSON NamedChannelCreationRequest where
7781
7882instance FromJSON NamedChannelCreationRequest where
7983 parseJSON = withObject "named channel" $ \e ->
80− NamedChannelCreationRequest <$> e .: "name" <*> e .: "tags" <*> e .: "people"
84+ NamedChannelCreationRequest <$> e .: "name" <*> fmap removeDuplicates (e .: "tags") <*> fmap removeDuplicates (e .: "people")
85+ where
86+ removeDuplicates :: Ord a => [a] -> V.Vector a
87+ removeDuplicates = V.fromList . Set.toList . Set.fromList
denis/src/Data/Query.hs+19−3
@@ -52,7 +52,7 @@ import GHC.Generics (Generic)
5252import Data.Aeson
5353import Servant.Docs
5454import Data.Proxy
55−import Data.Vector (Vector, toList)
55+import Data.Vector (Vector, toList, fromList)
5656import Data.Text (Text)
5757import Data.Channel.NamedChannel
5858import Data.Channel.AnonymousChannel
@@ -118,6 +118,14 @@ getPostQ oTe te = select (
118118getUserQ :: Query Schema (TuplePG (Only UserId)) (RowPG User)
119119getUserQ = selectStar $ from (table #users) & where_ (#userId .== param @1)
120120
121+verifiedUserIdsQ :: [UserId] -> Maybe (Query Schema '[] (RowPG (Only UserId)))
122+verifiedUserIdsQ uIds = case idsToColumn uIds of
123+ Just idQ -> Just $ select (#users ! #userId `as` #fromOnly) $ from (subquery (idQ `As` #ids) &
124+ innerJoin (table #users)
125+ (#ids ! #id .== #users ! #userId))
126+ Nothing -> Nothing
127+
128+
121129getUsersQ :: [UserId] -> Maybe (Query Schema '[] (RowPG User))
122130getUsersQ uIds = case idsToColumn uIds of
123131 Just idQ -> Just $ selectDotStar #users $ from (subquery (idQ `As` #ids) &
@@ -264,6 +272,12 @@ getChannelForUser uId cId = do
264272 (Just c) -> return c
265273 Nothing -> lift $ S.throwError S.err404
266274
275+-- TODO: Reject bad requests. Should be binary.
276+verifiedUsers :: [UserId] -> StaticPQ [UserId]
277+verifiedUsers uIds =
278+ case verifiedUserIdsQ uIds of
279+ Just uIdsQ -> fmap fromOnly <$> (runQuery uIdsQ >>= getRows)
280+ Nothing -> return []
267281
268282-- MARK: FrontEnd functions
269283
@@ -305,13 +319,15 @@ publishPost uId pc = transactionally_ $ do
305319
306320createNewChannel :: UserId -> NamedChannelCreationRequest -> StaticPQ (Maybe NamedChannelId)
307321createNewChannel uId req = transactionally_ $ do
308− cId <- manipulateParams createNamedChannelQ (addUserToChannelCreate uId req) >>= firstRow
322+ uIds <- verifiedUsers . toList $ namedChannelCreationRequestPeopleIds req
323+ cId <- manipulateParams createNamedChannelQ (addUserToChannelCreate uId (req {namedChannelCreationRequestPeopleIds = fromList uIds})) >>= firstRow
309324 return $ fmap fromOnly cId
310325
311326updateChannel :: UserId -> NamedChannel UserId -> StaticPQ ()
312327updateChannel uId req = transactionally_ $ do
328+ uIds <- fmap fromList . verifiedUsers . toList $ namedChannelPeopleIds req
313329 _ <- getChannelForUser uId $ namedChannelId req
314− _ <- manipulateParams updateNamedChannelQ $ addUserToChannelUpdate uId req
330+ _ <- manipulateParams updateNamedChannelQ $ addUserToChannelUpdate uId (req {namedChannelPeopleIds = uIds})
315331 return ()
316332
317333getChannelPosts :: UserId -> Limit -> NamedChannelId -> StaticPQ PostResponse