9a2ac6f · typeable/servant

git.iko.soy/typeable/servant

HasClient instance for Stream

commit9a2ac6f4dd7a28e56949980dbfddd467e7811712 authorGershom <gershom@awakesecurity.com> dateFri 20 Oct 2017, 15:09 (9 years ago) parent9132a5b

4 files changed+66−11

compare with master

unifiedsplit

servant-client-core/src/Servant/Client/Core/Internal/HasClient.hs+42 servant-server/src/Servant/Server/Internal.hs+1−1 servant/src/Servant/API.hs+4−3 servant/src/Servant/API/Stream.hs+19−7

servant-client-core/src/Servant/Client/Core/Internal/HasClient.hs+42

@@ -18,6 +18,7 @@ import Prelude ()

1818import Prelude.Compat

1919

2020import Data.Foldable (toList)

21+import qualified Data.ByteString.Lazy as BL

2122import Data.List (foldl')

2223import Data.Proxy (Proxy (Proxy))

2324import Data.Sequence (fromList)

@@ -29,8 +30,10 @@ import Servant.API ((:<|>) ((:<|>)), (:>),

2930 AuthProtect, BasicAuth,

3031 BasicAuthData,

3132 BuildHeadersTo (..),

33+ BuildFromStream (..),

3234 Capture, CaptureAll,

3335 Description, EmptyAPI,

36+ FramingUnrender (..),

3437 Header, Headers (..),

3538 HttpVersion, IsSecure,

3639 MimeRender (mimeRender),

@@ -40,6 +43,7 @@ import Servant.API ((:<|>) ((:<|>)), (:>),

4043 QueryParams, Raw,

4144 ReflectMethod (..),

4245 RemoteHost, ReqBody,

46+ Stream,

4347 Summary, ToHttpApiData,

4448 Vault, Verb,

4549 WithNamedContext,

@@ -244,6 +248,44 @@ instance OVERLAPPING_

244248 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response

245249 }

246250

251+instance OVERLAPPABLE_

252+ ( RunClient m, MimeUnrender ct a, ReflectMethod method,

253+ FramingUnrender framing a, BuildFromStream a (f a)

254+ ) => HasClient m (Stream method framing ct (f a)) where

255+ type Client m (Stream method framing ct (f a)) = m (f a)

256+ clientWithRoute _pm Proxy req = do

257+ response <- runRequest req

258+ { requestAccept = fromList [contentType (Proxy :: Proxy ct)]

259+ , requestMethod = reflectMethod (Proxy :: Proxy method)

260+ }

261+ return $ decodeFramed (Proxy :: Proxy framing) (Proxy :: Proxy ct) (Proxy :: Proxy a) response

262+

263+instance OVERLAPPING_

264+ ( RunClient m, BuildHeadersTo ls, MimeUnrender ct a, ReflectMethod method,

265+ FramingUnrender framing a, BuildFromStream a (f a)

266+ ) => HasClient m (Stream method framing ct (Headers ls (f a))) where

267+ type Client m (Stream method framing ct (Headers ls (f a))) = m (Headers ls (f a))

268+ clientWithRoute _pm Proxy req = do

269+ response <- runRequest req

270+ { requestAccept = fromList [contentType (Proxy :: Proxy ct)]

271+ , requestMethod = reflectMethod (Proxy :: Proxy method)

272+ }

273+ return Headers { getResponse = decodeFramed (Proxy :: Proxy framing) (Proxy :: Proxy ct) (Proxy :: Proxy a) response

274+ , getHeadersHList = buildHeadersTo . toList $ responseHeaders response

275+ }

276+

277+decodeFramed :: forall ctype strategy a b.

278+ (MimeUnrender ctype a, FramingUnrender strategy a, BuildFromStream a b) =>

279+ Proxy strategy -> Proxy ctype -> Proxy a -> Response -> b

280+decodeFramed framingproxy ctypeproxy typeproxy response =

281+ let (body, uncons) = unrenderFrames framingproxy typeproxy (responseBody response)

282+ loop b | BL.null b = []

283+ | otherwise = case uncons b of

284+ (Right x, r) -> case mimeUnrender ctypeproxy x :: Either String a of

285+ Left err -> Left err : loop r

286+ Right x' -> Right x' : loop r

287+ (Left err, r) -> Left err : loop r

288+ in buildFromStream $ loop body

247289

248290-- | If you use a 'Header' in one of your endpoints in your API,

249291-- the corresponding querying function will automatically take

servant-server/src/Servant/Server/Internal.hs+1−1

@@ -349,7 +349,7 @@ streamRouter splitHeaders method framingproxy ctypeproxy action = leafRouter $ \

349349 BoundaryStrategyGeneral f ->

350350 let go = (>> flush) . write . BB.lazyByteString . f . mimeRender ctypeproxy

351351 in k go go

352− write . BB.lazyByteString $ terminate framingproxy ctypeproxy

352+ write . BB.lazyByteString $ trailer framingproxy ctypeproxy

353353

354354-- | If you use 'Header' in one of the endpoints for your API,

355355-- this automatically requires your server-side handler to be a function

servant/src/Servant/API.hs+4−3

@@ -83,9 +83,10 @@ import Servant.API.IsSecure (IsSecure (..))

8383import Servant.API.QueryParam (QueryFlag, QueryParam,

8484 QueryParams)

8585import Servant.API.Raw (Raw)

86−import Servant.API.Stream (Stream, StreamGenerator(..), ToStreamGenerator(..),

87− FramingRender(..), BoundaryStrategy(..),

88− FramingUnrender(..),

86+import Servant.API.Stream (Stream, StreamGenerator (..),

87+ ToStreamGenerator (..), BuildFromStream (..),

88+ FramingRender (..), BoundaryStrategy (..),

89+ FramingUnrender (..),

8990 NewlineFraming)

9091import Servant.API.RemoteHost (RemoteHost)

9192import Servant.API.ReqBody (ReqBody)

servant/src/Servant/API/Stream.hs+19−7

@@ -1,3 +1,4 @@

1+{-# LANGUAGE DataKinds #-}

12{-# LANGUAGE DeriveDataTypeable #-}

23{-# LANGUAGE DeriveGeneric #-}

34{-# LANGUAGE FlexibleInstances #-}

@@ -17,11 +18,15 @@ import Data.Proxy (Proxy)

1718import Data.Typeable (Typeable)

1819import GHC.Generics (Generic)

1920import Text.Read (readMaybe)

21+import Network.HTTP.Types.Method (StdMethod (..))

2022

21−-- | A stream endpoint for a given method emits a stream of encoded values at a given Content-Type, delimited by a framing strategy.

23+-- | A Stream endpoint for a given method emits a stream of encoded values at a given Content-Type, delimited by a framing strategy. Steam endpoints always return response code 200 on success. Type synonyms are provided for standard methods.

2224data Stream (method :: k1) (framing :: *) (contentType :: *) a

2325 deriving (Typeable, Generic)

2426

27+type StreamGet = Stream 'GET

28+type StreamPost = Stream 'POST

29+

2530-- | Stream endpoints may be implemented as producing a @StreamGenerator@ -- a function that itself takes two emit functions -- the first to be used on the first value the stream emits, and the second to be used on all subsequent values (to allow interspersed framing strategies such as comma separation).

2631newtype StreamGenerator a = StreamGenerator {getStreamGenerator :: (a -> IO ()) -> (a -> IO ()) -> IO ()}

2732

@@ -32,11 +37,18 @@ class ToStreamGenerator f a where

3237instance ToStreamGenerator StreamGenerator a

3338 where toStreamGenerator x = x

3439

40+-- | BuildFromStream is intended to be implemented for types such as Conduit, Pipe, etc. By implementing this class, all such streaming abstractions can be used directly on the client side for talking to streaming endpoints. The streams we build from are represented as lazy lists of elements interspersed with possible errors.

41+class BuildFromStream a b where

42+ buildFromStream :: [Either String a] -> b

43+

44+instance BuildFromStream a [Either String a]

45+ where buildFromStream x = x

46+

3547-- | The FramingRender class provides the logic for emitting a framing strategy. The strategy emits a header, followed by boundary-delimited data, and finally a termination character. For many strategies, some of these will just be empty bytestrings.

3648class FramingRender strategy a where

37− header :: Proxy strategy -> Proxy a -> ByteString

38− boundary :: Proxy strategy -> Proxy a -> BoundaryStrategy

39− terminate :: Proxy strategy -> Proxy a -> ByteString

49+ header :: Proxy strategy -> Proxy a -> ByteString

50+ boundary :: Proxy strategy -> Proxy a -> BoundaryStrategy

51+ trailer :: Proxy strategy -> Proxy a -> ByteString

4052

4153-- | The bracketing strategy generates things to precede and follow the content, as with netstrings.

4254-- The intersperse strategy inserts seperators between things, as with newline framing.

@@ -45,7 +57,7 @@ data BoundaryStrategy = BoundaryStrategyBracket (ByteString -> (ByteString,ByteS

4557 | BoundaryStrategyIntersperse ByteString

4658 | BoundaryStrategyGeneral (ByteString -> ByteString)

4759

48−-- | The FramingUnrender class provides the logic for parsing a framing strategy. Given a ByteString, it strips the header, and returns a tuple of the remainder along with a step function that can progressively "uncons" elements from this remainder. The error state is presented per-frame so that protocols that can resume after errors are able to do so.

60+-- | The FramingUnrender class provides the logic for parsing a framing strategy. Given a ByteString, it strips the header, and returns a tuple of the remainder along with a step function that can progressively "uncons" elements from this remainder. The error state is presented per-frame so that protocols that can resume after errors are able to do so. Termination of the unrendering is indicated by return of an empty reminder.

4961

5062class FramingUnrender strategy a where

5163 unrenderFrames :: Proxy strategy -> Proxy a -> ByteString -> (ByteString, ByteString -> (Either String ByteString, ByteString))

@@ -57,7 +69,7 @@ data NewlineFraming

5769instance FramingRender NewlineFraming a where

5870 header _ _ = empty

5971 boundary _ _ = BoundaryStrategyIntersperse "\n"

60− terminate _ _ = empty

72+ trailer _ _ = empty

6173

6274instance FramingUnrender NewlineFraming a where

6375 unrenderFrames _ _ = (, (Right *** LB.drop 1) . LB.break (== '\n'))

@@ -68,7 +80,7 @@ data NetstringFraming

6880instance FramingRender NetstringFraming a where

6981 header _ _ = empty

7082 boundary _ _ = BoundaryStrategyBracket $ \b -> (LB.pack . show . LB.length $ b, "")

71− terminate _ _ = empty

83+ trailer _ _ = empty

7284

7385instance FramingUnrender NetstringFraming a where

7486 unrenderFrames _ _ = (, \b -> let (i,r) = LB.break (==':') b