9a2ac6f · servant · git.iko.soy

git.iko.soy/servant

on master help sign in

HasClient instance for Stream

9a2ac6fGershom9 years ago

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

compare with master

unifiedsplit

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

18import Prelude.Compat

20import Data.Foldable (toList)

21+import qualified Data.ByteString.Lazy as BL

21import Data.List (foldl')

22import Data.List (foldl')

22import Data.Proxy (Proxy (Proxy))

23import Data.Proxy (Proxy (Proxy))

23import Data.Sequence (fromList)

24import Data.Sequence (fromList)

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

29 AuthProtect, BasicAuth,

30 AuthProtect, BasicAuth,

30 BasicAuthData,

31 BasicAuthData,

31 BuildHeadersTo (..),

32 BuildHeadersTo (..),

33+ BuildFromStream (..),

32 Capture, CaptureAll,

34 Capture, CaptureAll,

33 Description, EmptyAPI,

35 Description, EmptyAPI,

36+ FramingUnrender (..),

34 Header, Headers (..),

37 Header, Headers (..),

35 HttpVersion, IsSecure,

38 HttpVersion, IsSecure,

36 MimeRender (mimeRender),

39 MimeRender (mimeRender),

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

40 QueryParams, Raw,

43 QueryParams, Raw,

41 ReflectMethod (..),

44 ReflectMethod (..),

42 RemoteHost, ReqBody,

45 RemoteHost, ReqBody,

46+ Stream,

43 Summary, ToHttpApiData,

47 Summary, ToHttpApiData,

44 Vault, Verb,

48 Vault, Verb,

45 WithNamedContext,

49 WithNamedContext,

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

244 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response

248 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response

245 }

249 }

246

250

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

247

289

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

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

249-- the corresponding querying function will automatically take

291-- 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 $ \

349 BoundaryStrategyGeneral f ->

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

351 in k go go

352− write . BB.lazyByteString $ terminate framingproxy ctypeproxy

352+ write . BB.lazyByteString $ trailer framingproxy ctypeproxy

353

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

355-- 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 (..))

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

84 QueryParams)

85import Servant.API.Raw (Raw)

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

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

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

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

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

88− FramingUnrender(..),

89+ FramingUnrender (..),

89 NewlineFraming)

90 NewlineFraming)

90import Servant.API.RemoteHost (RemoteHost)

91import Servant.API.RemoteHost (RemoteHost)

91import Servant.API.ReqBody (ReqBody)

92import Servant.API.ReqBody (ReqBody)

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

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

1+{-# LANGUAGE DataKinds #-}

1{-# LANGUAGE DeriveDataTypeable #-}

2{-# LANGUAGE DeriveDataTypeable #-}

2{-# LANGUAGE DeriveGeneric #-}

3{-# LANGUAGE DeriveGeneric #-}

3{-# LANGUAGE FlexibleInstances #-}

4{-# LANGUAGE FlexibleInstances #-}

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

17import Data.Typeable (Typeable)

18import Data.Typeable (Typeable)

18import GHC.Generics (Generic)

19import GHC.Generics (Generic)

19import Text.Read (readMaybe)

20import Text.Read (readMaybe)

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

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.

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

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

23 deriving (Typeable, Generic)

25 deriving (Typeable, Generic)

27+type StreamGet = Stream 'GET

28+type StreamPost = Stream 'POST

29+

25-- | 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).

30-- | 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).

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

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

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

32instance ToStreamGenerator StreamGenerator a

37instance ToStreamGenerator StreamGenerator a

33 where toStreamGenerator x = x

38 where toStreamGenerator x = x

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+

35-- | 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.

47-- | 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.

36class FramingRender strategy a where

48class FramingRender strategy a where

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

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

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

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

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

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

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

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

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

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

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

45 | BoundaryStrategyIntersperse ByteString

57 | BoundaryStrategyIntersperse ByteString

46 | BoundaryStrategyGeneral (ByteString -> ByteString)

58 | BoundaryStrategyGeneral (ByteString -> ByteString)

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.

50class FramingUnrender strategy a where

62class FramingUnrender strategy a where

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

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

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

57instance FramingRender NewlineFraming a where

69instance FramingRender NewlineFraming a where

58 header _ _ = empty

70 header _ _ = empty

59 boundary _ _ = BoundaryStrategyIntersperse "\n"

71 boundary _ _ = BoundaryStrategyIntersperse "\n"

60− terminate _ _ = empty

72+ trailer _ _ = empty

62instance FramingUnrender NewlineFraming a where

74instance FramingUnrender NewlineFraming a where

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

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

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

68instance FramingRender NetstringFraming a where

80instance FramingRender NetstringFraming a where

69 header _ _ = empty

81 header _ _ = empty

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

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

71− terminate _ _ = empty

83+ trailer _ _ = empty

73instance FramingUnrender NetstringFraming a where

85instance FramingUnrender NetstringFraming a where

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

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