@@ -9,7 +9,8 @@
99 TypeFamilies,
1010 LambdaCase,
1111 PartialTypeSignatures,
12− TupleSections #-}
12+ TupleSections,
13+ DeriveGeneric #-}
1314
1415{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
1516{-# OPTIONS_GHC -Wno-orphans #-}
@@ -37,28 +38,39 @@ import Control.Monad
3738import Control.Monad.Error.Class
3839import Servant.Docs hiding (Response)
3940import qualified Data.Map as M
41+import Data.Text.Encoding (decodeUtf8)
42+import Data.Aeson
43+import GHC.Generics
4044
4145-- MARK: Documentation
4246
4347instance (HasDocs api) => HasDocs (ComplexQuery :> api) where
4448 docsFor _ = docsFor (Proxy :: Proxy (ComplexApi :<|> api))
4549
46−instance {-# Overlapping #-} ToSample (ComplexQueryRequest) where
47− toSamples _ = samples $ [
48− M.fromList [("posts/last", "8"), ("channels/", "")],
49− M.fromList [("channels/","[{\"people\":[1],\"name\":\"newChannelName\",\"id\":7,\"tags\":[]},{\"people\":[1],\"name\":\"newChannelName\",\"id\":6,\"tags\":[]},{\"people\":[1],\"name\":\"newChannelName\",\"id\":5,\"tags\":[]},{\"people\":[1,1,2,2,2],\"name\":\"sssss\",\"id\":4,\"tags\":[\"thisIsHashTag\",\"thisIsHashTag\",\"thisIsHashTag\",\"thisIsHashTag\",\"thisIsAlsoHashTag\",\"cs\"]},{\"people\":[1,7,2,19],\"name\":\"ChannelName\",\"id\":1,\"tags\":[\"sos\"]}]"),("posts/last", "{\"users\":{\"1\":{\"middleName\":\"FirstUser\",\"lastName\":\"FirstUser\",\"firstName\":\"FirstUser\",\"id\":1}},\"response\":[{\"body\":[{\"markdown\":\"hello\"}],\"authorId\":1,\"id\":28,\"updated\":\"2019-04-13T16:14:38.495832Z\",\"tags\":[]}]}")]]
50+instance {-# Overlapping #-} ToSample [ComplexQueryRequest] where
51+ toSamples _ = singleSample $ [ComplexQueryRequest "channels/" "", ComplexQueryRequest "posts/last" "3"]
52+
53+instance {-# Overlapping #-} ToSample [T.Text] where
54+ toSamples _ = singleSample ["[{\"people\":[1],\"name\":\"newChannelName\",\"id\":7,\"tags\":[]},{\"people\":[1],\"name\":\"newChannelName\",\"id\":6,\"tags\":[]},{\"people\":[1],\"name\":\"newChannelName\",\"id\":5,\"tags\":[]},{\"people\":[1,1,2,2,2],\"name\":\"sssss\",\"id\":4,\"tags\":[\"thisIsHashTag\",\"thisIsHashTag\",\"thisIsHashTag\",\"thisIsHashTag\",\"thisIsAlsoHashTag\",\"cs\"]},{\"people\":[1,7,2,19],\"name\":\"соытвототтоциология\",\"id\":1,\"tags\":[\"sos\"]}]","{\"users\":{\"1\":{\"middleName\":\"FirstUser\",\"lastName\":\"FirstUser\",\"firstName\":\"FirstUser\",\"id\":1}},\"response\":[{\"body\":[{\"markdown\":\"hello\"}],\"authorId\":1,\"id\":28,\"updated\":\"2019-04-13T16:14:38.495832Z\",\"tags\":[]},{\"body\":[{\"markdown\":\"Hello, blyat\"}],\"authorId\":1,\"id\":27,\"updated\":\"2005-01-03T12:34:56Z\",\"tags\":[]}]}"]
5055
5156-- MARK: Implementation
5257
5358data ComplexQuery
5459
5560
56−type ComplexQueryRequest = M.Map T.Text String
57−type ComplexQueryRepsonse = M.Map T.Text String
61+data ComplexQueryRequest = ComplexQueryRequest {
62+ url :: T.Text,
63+ body :: String
64+} deriving (Generic)
65+
66+instance ToJSON ComplexQueryRequest
67+instance FromJSON ComplexQueryRequest
68+
69+type ComplexQueryRepsonse = T.Text
5870
59−type ComplexQueryDescription = Description "Complex query\nNOTE: both request and response samples are the same. The first one is the request, the second one is the response.\nAllows you to query several endpoints within one request.\nThe order of queries (both execution and response) is not determined. If one of the queries returns a non-2XX response, the first such response is returned.\n## Do not perform modifications in this query. You will have no way of telling whether it succeeded."
71+type ComplexQueryDescription = Description "Complex query\n\nAllows you to query several endpoints within one request.\n\nResponses are returned in the same order as the requests are sent.\n\nThe order of query execution is not determined. If one of the queries returns a non-2XX response, the first such response is returned.\n\n## Do not perform modifications in this query. You will have no way of telling whether it succeeded."
6072
61−type ComplexApi = "complex" :> ComplexQueryDescription :> ReqBody '[JSON] (ComplexQueryRequest) :> Post '[JSON] (ComplexQueryRepsonse)
73+type ComplexApi = "complex" :> ComplexQueryDescription :> ReqBody '[JSON] ([ComplexQueryRequest]) :> Post '[JSON] [ComplexQueryRepsonse]
6274
6375instance HasServer api context => HasServer (ComplexQuery :> api :: *) context where
6476
@@ -70,35 +82,38 @@ instance HasServer api context => HasServer (ComplexQuery :> api :: *) context w
7082 where
7183 rest = route (Proxy :: Proxy api) context subserver
7284 complexProxy = Proxy :: Proxy (ComplexApi)
73− complexServer :: _ -> Request -> ComplexQueryRequest -> Handler (ComplexQueryRepsonse)
85+ complexServer :: _ -> Request -> [ComplexQueryRequest] -> Handler [ComplexQueryRepsonse]
7486 complexServer env req query = do
7587 responses <- liftIO . newTVarIO $ Right M.empty
76− recieved <- liftIO $ forM (M.toList query) $ uncurry $ \queryPath body -> do
77− newReq <- replaceBody (BSC.pack body) req
78− serverRest (replacePath queryPath newReq) $ respond responses queryPath
88+ recieved <- liftIO $ forM (zip [0..] query) $ uncurry $ \queryIndex (ComplexQueryRequest queryPath queryBody) -> do
89+ newReq <- replaceBody (BSC.pack queryBody) req
90+ serverRest (replacePath queryPath newReq) $ respond responses queryIndex
7991 recieved `seq` do
8092 result <- liftIO $ readTVarIO responses
8193 case result of
8294 Left err -> throwError err
83− Right resp -> return resp
95+ Right resp -> sequence . map (throwMaybe . flip M.lookup resp) $ [0..((length query) - 1)]
8496 where
8597 serverRest = runRouterEnv (route (Proxy :: Proxy api) context subserver) env
86− respond :: TVar (Either ServantErr (M.Map T.Text String)) -> T.Text -> RouteResult Response -> IO ResponseReceived
87− respond responses queryPath = (>> return ResponseReceived) .
98+ respond :: TVar (Either ServantErr (M.Map Int T.Text)) -> Int -> RouteResult Response -> IO ResponseReceived
99+ respond responses queryIndex = (>> return ResponseReceived) .
88100 \case
89101 (Fail err) -> atomically . writeTVar responses $ Left err
90102 (FailFatal err) -> atomically . writeTVar responses $ Left err
91103 (Route r) -> do
92− body <- BSC.unpack <$> responseBody r
93− atomically . modifyTVar responses $ fmap (M.insert queryPath body)
104+ rBody <- decodeUtf8 . BSC.toStrict <$> responseBody r
105+ atomically . modifyTVar responses $ fmap (M.insert queryIndex rBody)
106+ throwMaybe :: Maybe a -> Handler a
107+ throwMaybe Nothing = throwError err500
108+ throwMaybe (Just a) = return a
94109 complex = RawRouter $ \env req ->
95110 (flip runRouterEnv env $ route complexProxy context (emptyDelayed (Route $ complexServer env req))) req
96111
97112-- ref: https://stackoverflow.com/questions/45467648/how-to-read-response-body-in-wai-middleware
98113responseBody :: Response -> IO ByteString
99114responseBody res =
100− let (_,_,body) = responseToStream res in
101− body $ \f -> do
115+ let (_,_,rBody) = responseToStream res in
116+ rBody $ \f -> do
102117 content <- newIORef mempty
103118 f (\chunk -> modifyIORef' content (<> chunk)) (return ())
104119 toLazyByteString <$> readIORef content