git.iko.soy/denis
on master help sign in
resolved #15.
ee6c448iko
.gitignore+2−1
compare with master
unifiedsplit
@@ -21,4 +21,5 @@ cabal.project.local~
21.HTF/
21.HTF/
22.ghc.environment.*
22.ghc.environment.*
23/backup/
23/backup/
24−.DS_Store
24+.DS_Store
25+/docs/
denis/src/Data/Connection.hs+7−1
@@ -12,7 +12,8 @@ module Data.Connection (
12 runQ,
12 runQ,
13 runQ',
13 runQ',
14 runQnotFound,
14 runQnotFound,
15− runQerror
15+ runQerror,
16+ maybeNotFound
16) where
17) where
17
18
18import Squeal.PostgreSQL
19import Squeal.PostgreSQL
@@ -37,3 +38,8 @@ runQnotFound = runQ err404
37
38
38runQerror :: StaticPQ a -> App a
39runQerror :: StaticPQ a -> App a
39runQerror = runQ err500
40runQerror = runQ err500
41+
42+maybeNotFound :: App (Maybe a) -> App a
43+maybeNotFound = (>>= (\t -> case t of
44+ Just y -> return y
45+ Nothing -> throwError err404))
denis/src/Data/Query.hs+89−15
@@ -13,12 +13,14 @@
13module Data.Query (
13module Data.Query (
14 Schema,
14 Schema,
15 createTables,
15 createTables,
16− getPost,
16+ getPosts,
17 getUser,
17 getUser,
18+ getUsers,
18 getLastPosts,
19 getLastPosts,
19 getPostsForUser,
20 getPostsForUser,
20 Limit,
21 Limit,
21− publishPost
22+ publishPost,
23+ PostResponse(..)
22) where
24) where
23
25
24import Squeal.PostgreSQL
26import Squeal.PostgreSQL
@@ -29,9 +31,23 @@ import Data.Function (on)
29import Data.Connection
31import Data.Connection
30import Data.PostElement
32import Data.PostElement
31import qualified Servant as S
33import qualified Servant as S
34+import Control.Monad
32import Control.Monad.Morph
35import Control.Monad.Morph
33import Data.Word (Word64)
36import Data.Word (Word64)
34import qualified Data.List as L
37import qualified Data.List as L
38+import qualified Data.Map.Strict as M
39+import qualified Data.Set as Set
40+import Data.Int (Int64)
41+import Data.ByteString.Char8 (pack)
42+import GHC.Generics (Generic)
43+import Data.Aeson
44+import Servant.Docs
45+import Data.Proxy
46+
47+-- MARK: Documentation
48+
49+instance ToSample PostResponse where
50+ toSamples _ = samples $ PostResponse <$> (map snd $ toSamples Proxy) <*> [M.fromList $ map (tupleFirst userId . snd) (toSamples Proxy)]
35
51
36
52
37-- MARK: Generalized Post Queries
53-- MARK: Generalized Post Queries
@@ -86,8 +102,20 @@ getPostQ oTe te = select (
86getUserQ :: Query Schema (TuplePG (Only UserId)) (RowPG User)
102getUserQ :: Query Schema (TuplePG (Only UserId)) (RowPG User)
87getUserQ = selectStar $ from (table #users) & where_ (#userId .== param @1)
103getUserQ = selectStar $ from (table #users) & where_ (#userId .== param @1)
88
104
105+getUsersQ :: [UserId] -> Maybe (Query Schema '[] (RowPG User))
106+getUsersQ uIds = case idsToColumn uIds of
107+ Just idQ -> Just $ selectDotStar #users $ from (subquery (idQ `As` #ids) &
108+ innerJoin (table #users)
109+ (#ids ! #id .== #users ! #userId))
110+ Nothing -> Nothing
111+
89−getPostByIdQ :: Query Schema (TuplePG (Only PostId)) (RowPG PostRowResponse)
112+getPostsByIdQ :: [PostId] -> Maybe (Query Schema '[] (RowPG PostRowResponse))
90−getPostByIdQ = getPostQ id $ where_ $ #postRowId .== param @1
113+getPostsByIdQ pIds = case idsToColumn pIds of
114+ Just idQ -> Just $ selectDotStar #posts $ from (subquery (idQ `As` #ids) &
115+ innerJoin (subquery $ getPostQ id id `As` #posts)
116+ (#ids ! #id .== #posts ! #postRowId))
117+ Nothing -> Nothing
118+
91
119
92type Limit = Word64
120type Limit = Word64
93
121
@@ -118,26 +146,43 @@ createPostElementRowsQ = insertRow_ #postElements
118 Set (param @6) `as` #rowElementQuote :*
146 Set (param @6) `as` #rowElementQuote :*
119 Set (param @7) `as` #rowElementAttachment)
147 Set (param @7) `as` #rowElementAttachment)
120
148
149+
150+-- MARK: FrontEnd Data Structures
151+
152+data PostResponse = PostResponse {
153+ posts :: [Post],
154+ users :: M.Map UserId User
155+} deriving (Generic)
156+
157+instance ToJSON PostResponse
158+
159+
121-- MARK: FrontEnd functions
160-- MARK: FrontEnd functions
122
161
123−getPostsForUser :: Word64 -> UserId -> StaticPQ (Maybe [Post])
162+getPostsForUser :: Word64 -> UserId -> StaticPQ (Maybe PostResponse)
124getPostsForUser lim uId = do
163getPostsForUser lim uId = do
125 postRows <- runQueryParams (getLastNPostsForUserQ lim) (Only uId) >>= getRows
164 postRows <- runQueryParams (getLastNPostsForUserQ lim) (Only uId) >>= getRows
126− return . foldMaybe . map rowsToPost . L.groupBy ((==) `on` postRowId) $ postRows
165+ rowsToPosts postRows `liftMaybe` wrapIntoPostResponse
127
166
128−getPost :: PostId -> StaticPQ (Maybe Post)
167+getPosts :: [PostId] -> StaticPQ (Maybe PostResponse)
129−getPost pId = do
168+getPosts pId =
130− postRow <- runQueryParams getPostByIdQ (Only pId) >>= getRows
169+ case getPostsByIdQ pId of
131− return $ rowsToPost postRow
170+ Just psQ -> do
171+ postRows <- runQuery psQ >>= getRows
172+ rowsToPosts postRows `liftMaybe` wrapIntoPostResponse
173+ Nothing -> return Nothing
132
174
133−getLastPosts :: Word64 -> StaticPQ (Maybe [Post])
175+getLastPosts :: Word64 -> StaticPQ (Maybe PostResponse)
134getLastPosts n = do
176getLastPosts n = do
135 postRows <- runQuery (getLastNPostsQ n) >>= getRows
177 postRows <- runQuery (getLastNPostsQ n) >>= getRows
136− return . foldMaybe . map rowsToPost . L.groupBy ((==) `on` postRowId) $ postRows
178+ rowsToPosts postRows `liftMaybe` wrapIntoPostResponse
137−
179+
138getUser :: UserId -> StaticPQ User
180getUser :: UserId -> StaticPQ User
139getUser uId = runQueryParams getUserQ (Only uId) >>= getRow 0
181getUser uId = runQueryParams getUserQ (Only uId) >>= getRow 0
140−
182+
183+getUsers :: [UserId] -> StaticPQ (Maybe [User])
184+getUsers ids = getUsersQ ids `liftMaybe` (fmap Just . (runQuery >=> getRows))
185+
141publishPost :: UserId -> [PostElement Post] -> StaticPQ PostId
186publishPost :: UserId -> [PostElement Post] -> StaticPQ PostId
142publishPost uId els = transactionally_ $ do
187publishPost uId els = transactionally_ $ do
143 pId' <- manipulateParams createPostRowQ (Only uId) >>= firstRow
188 pId' <- manipulateParams createPostRowQ (Only uId) >>= firstRow
@@ -147,9 +192,38 @@ publishPost uId els = transactionally_ $ do
147 return pId
192 return pId
148 _ -> lift $ S.throwError S.err404
193 _ -> lift $ S.throwError S.err404
149
194
195+
150-- MARK: Utils
196-- MARK: Utils
151
197
152foldMaybe :: [Maybe a] -> Maybe [a]
198foldMaybe :: [Maybe a] -> Maybe [a]
153foldMaybe [] = Just []
199foldMaybe [] = Just []
154foldMaybe (Nothing : _) = Nothing
200foldMaybe (Nothing : _) = Nothing
155−foldMaybe (Just x : xs) = (x :) <$> foldMaybe xs
201+foldMaybe (Just x : xs) = (x :) <$> foldMaybe xs
202+
203+userIdsFromPostResponse :: [Post] -> [UserId]
204+userIdsFromPostResponse = Set.toList . Set.fromList . map postAuthorId
205+
206+rowsToPosts :: [PostRowResponse] -> Maybe [Post]
207+rowsToPosts = foldMaybe . map rowsToPost . L.groupBy ((==) `on` postRowId)
208+
209+tupleFirst :: (a -> b) -> a -> (b, a)
210+tupleFirst f a = (f a, a)
211+
212+mapFirstBy :: (a -> b) -> [a] -> [(b, a)]
213+mapFirstBy f = map $ tupleFirst f
214+
215+idsToColumn :: [Int64] -> Maybe (Query schema params '["id" ::: 'NotNull 'PGint8])
216+idsToColumn [] = Nothing
217+idsToColumn (i:ii) = Just $ values (unsafeIntToExpr i `as` #id) $ map ((`as` #id) . unsafeIntToExpr) ii
218+
219+unsafeIntToExpr :: Int64 -> Expression schema from grouping params ty
220+unsafeIntToExpr = UnsafeExpression . pack . show
221+
222+wrapIntoPostResponse :: [Post] -> StaticPQ (Maybe PostResponse)
223+wrapIntoPostResponse ps = do
224+ pUsers <- getUsers $ userIdsFromPostResponse ps
225+ return $ PostResponse ps . M.fromList . mapFirstBy userId <$> pUsers
226+
227+liftMaybe :: Applicative f => Maybe a -> (a -> f (Maybe b)) -> f (Maybe b)
228+liftMaybe Nothing _ = pure Nothing
229+liftMaybe (Just a) f = f a
denis/src/Server/API.hs+2−1
@@ -25,6 +25,7 @@ import Server.Logger
25import Servant.Docs (HasDocs, docsFor, notes, DocNote(DocNote))
25import Servant.Docs (HasDocs, docsFor, notes, DocNote(DocNote))
26import Control.Lens
26import Control.Lens
27
27
28+
28-- MARK: Documentation
29-- MARK: Documentation
29
30
30instance HasDocs api => HasDocs (Authentication :> api) where
31instance HasDocs api => HasDocs (Authentication :> api) where
@@ -51,6 +52,6 @@ mkServerAPI :: Logger -> ServerT API App
51mkServerAPI l =
52mkServerAPI l =
52 l :<|>
53 l :<|>
53 authenticate :<|> (\uId ->
54 authenticate :<|> (\uId ->
54− mapM (runQnotFound . getUser) :<|>
55+ maybeNotFound . runQnotFound . getUsers :<|>
55 postApi uId
56 postApi uId
56 )
57 )
denis/src/Server/API/Posts.hs+9−15
@@ -42,27 +42,21 @@ instance FromJSON UserPostsRequest where
42 parseJSON = withObject "User posts request" $ \e ->
42 parseJSON = withObject "User posts request" $ \e ->
43 UserPostsRequest <$> e .: "userId" <*> e.: "limit"
43 UserPostsRequest <$> e .: "userId" <*> e.: "limit"
44
44
45−type PostApi = ReqBody '[JSON] [P.PostId] :> Post '[JSON] [P.Post] :<|>
45+type PostApi = ReqBody '[JSON] [P.PostId] :> Post '[JSON] PostResponse :<|>
46− "last" :> ReqBody '[JSON] Word64 :> Post '[JSON] [P.Post] :<|>
46+ "last" :> ReqBody '[JSON] Word64 :> Post '[JSON] PostResponse :<|>
47− "forUser" :> ReqBody '[JSON] UserPostsRequest :> Post '[JSON] [P.Post] :<|>
47+ "forUser" :> ReqBody '[JSON] UserPostsRequest :> Post '[JSON] PostResponse :<|>
48− "publish" :> ReqBody '[JSON] [P.PostElement P.Post] :> Post '[JSON] P.PostId
48+ "publish" :> ReqBody '[JSON] [P.PostElement P.Post] :> Post '[JSON] P.PostId
49−
50−maybeNotFound :: App (Maybe a) -> App a
51−maybeNotFound = (>>= (\t -> case t of
52− Just y -> return y
53− Nothing -> throwError err404))
54−
55
49
56postApi :: UserId -> ServerT PostApi App
50postApi :: UserId -> ServerT PostApi App
57−postApi uId = getPosts :<|> lastPosts :<|> getPostsForUserApi :<|> publishPostApi uId
51+postApi uId = getPostsApi :<|> lastPosts :<|> getPostsForUserApi :<|> publishPostApi uId
58
52
59−getPosts :: [P.PostId] -> App [P.Post]
53+getPostsApi :: [P.PostId] -> App PostResponse
60−getPosts = mapM (maybeNotFound . runQnotFound . getPost)
54+getPostsApi = maybeNotFound . runQnotFound . getPosts
61
55
62−lastPosts :: Word64 -> App [P.Post]
56+lastPosts :: Word64 -> App PostResponse
63lastPosts = maybeNotFound . runQnotFound . getLastPosts
57lastPosts = maybeNotFound . runQnotFound . getLastPosts
64
58
65−getPostsForUserApi :: UserPostsRequest -> App [P.Post]
59+getPostsForUserApi :: UserPostsRequest -> App PostResponse
66getPostsForUserApi (UserPostsRequest uId lim) = maybeNotFound . runQnotFound $ getPostsForUser lim uId
60getPostsForUserApi (UserPostsRequest uId lim) = maybeNotFound . runQnotFound $ getPostsForUser lim uId
67
61
68publishPostApi :: UserId -> [P.PostElement P.Post] -> App P.PostId
62publishPostApi :: UserId -> [P.PostElement P.Post] -> App P.PostId