eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Merge pull request #959 from jvanbruegge/fix-stream

Browse source 
Change definition of StreamGenerator
This commit is contained in:
Oleg Grenrus 2018-05-28 09:26:53 +03:00 committed by GitHub
commit a66aa8a981
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
5 changed files with 33 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
doc/tutorial/ApiType.lhs
View file

@ -137,7 +137,7 @@ type StreamGet = Stream 'GET
type StreamPost = Stream 'POST
```
These describe endpoints that return a stream of values rather than just a single value. They not only take a single content type as a parameter, but also a framing strategy -- this specifies how the individual results are delineated from one another in the stream. The two standard strategies given with Servant are `NewlineFraming` and `NetstringFraming`, but others can be written to match other protocols.
These describe endpoints that return a stream of values rather than just a single value. They not only take a single content type as a parameter, but also a framing strategy -- this specifies how the individual results are delineated from one another in the stream. The three standard strategies given with Servant are `NewlineFraming`, `NetstringFraming` and `NoFraming`, but others can be written to match other protocols.
### `Capture`

5
servant-client/test/Servant/StreamSpec.hs
View file

@ -40,7 +40,8 @@ import Test.QuickCheck
import Servant.API ((:<|>) ((:<|>)), (:>), JSON,
NetstringFraming, NewlineFraming,
OctetStream, ResultStream (..),
StreamGenerator (..), StreamGet)
StreamGenerator (..), StreamGet,
NoFraming)
import Servant.Client
import Servant.ClientSpec (Person (..))
import qualified Servant.ClientSpec as CS
@ -59,7 +60,7 @@ spec = describe "Servant.Stream" $ do
type StreamApi f =
"streamGetNewline" :> StreamGet NewlineFraming JSON (f Person)
:<|> "streamGetNetstring" :> StreamGet NetstringFraming JSON (f Person)
:<|> "streamALot" :> StreamGet NewlineFraming OctetStream (f BS.ByteString)
:<|> "streamALot" :> StreamGet NoFraming OctetStream (f BS.ByteString)
capi :: Proxy (StreamApi ResultStream)

20
servant-server/src/Servant/Server/Internal.hs
View file

@ -284,10 +284,10 @@ instance OVERLAPPING_
instance OVERLAPPABLE_
( MimeRender ctype a, ReflectMethod method,
FramingRender framing ctype, ToStreamGenerator f a
) => HasServer (Stream method framing ctype (f a)) context where
FramingRender framing ctype, ToStreamGenerator b a
) => HasServer (Stream method framing ctype b) context where
type ServerT (Stream method framing ctype (f a)) m = m (f a)
type ServerT (Stream method framing ctype b) m = m b
hoistServerWithContext _ _ nt s = nt s
route Proxy _ = streamRouter ([],) method (Proxy :: Proxy framing) (Proxy :: Proxy ctype)
@ -295,23 +295,23 @@ instance OVERLAPPABLE_
instance OVERLAPPING_
( MimeRender ctype a, ReflectMethod method,
FramingRender framing ctype, ToStreamGenerator f a,
GetHeaders (Headers h (f a))
) => HasServer (Stream method framing ctype (Headers h (f a))) context where
FramingRender framing ctype, ToStreamGenerator b a,
GetHeaders (Headers h b)
) => HasServer (Stream method framing ctype (Headers h b)) context where
type ServerT (Stream method framing ctype (Headers h (f a))) m = m (Headers h (f a))
type ServerT (Stream method framing ctype (Headers h b)) m = m (Headers h b)
hoistServerWithContext _ _ nt s = nt s
route Proxy _ = streamRouter (\x -> (getHeaders x, getResponse x)) method (Proxy :: Proxy framing) (Proxy :: Proxy ctype)
where method = reflectMethod (Proxy :: Proxy method)
streamRouter :: (MimeRender ctype a, FramingRender framing ctype, ToStreamGenerator f a) =>
(b -> ([(HeaderName, B.ByteString)], f a))
streamRouter :: (MimeRender ctype a, FramingRender framing ctype, ToStreamGenerator b a) =>
(c -> ([(HeaderName, B.ByteString)], b))
-> Method
-> Proxy framing
-> Proxy ctype
-> Delayed env (Handler b)
-> Delayed env (Handler c)
-> Router env
streamRouter splitHeaders method framingproxy ctypeproxy action = leafRouter $ \env request respond ->
let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request

4
servant/src/Servant/API.hs
View file

@ -117,8 +117,8 @@ import Servant.API.Stream
(BoundaryStrategy (..), BuildFromStream (..),
ByteStringParser (..), FramingRender (..),
FramingUnrender (..), NetstringFraming, NewlineFraming,
ResultStream (..), Stream, StreamGenerator (..), StreamGet,
StreamPost, ToStreamGenerator (..))
NoFraming, ResultStream (..), Stream, StreamGenerator (..),
StreamGet, StreamPost, ToStreamGenerator (..))
import Servant.API.Sub
((:>))
import Servant.API.Vault

19
servant/src/Servant/API/Stream.hs
View file

@ -2,6 +2,7 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
@ -41,10 +42,10 @@ type StreamPost = Stream 'POST
newtype StreamGenerator a = StreamGenerator {getStreamGenerator :: (a -> IO ()) -> (a -> IO ()) -> IO ()}
-- | ToStreamGenerator is intended to be implemented for types such as Conduit, Pipe, etc. By implementing this class, all such streaming abstractions can be used directly as endpoints.
class ToStreamGenerator f a where
toStreamGenerator :: f a -> StreamGenerator a
class ToStreamGenerator a b | a -> b where
toStreamGenerator :: a -> StreamGenerator b
instance ToStreamGenerator StreamGenerator a
instance ToStreamGenerator (StreamGenerator a) a
where toStreamGenerator x = x
-- | Clients reading from streaming endpoints can be implemented as producing a @ResultStream@ that captures the setup, takedown, and incremental logic for a read, being an IO continuation that takes a producer of Just either values or errors that terminates with a Nothing.
@ -80,6 +81,18 @@ data ByteStringParser a = ByteStringParser {
class FramingUnrender strategy a where
unrenderFrames :: Proxy strategy -> Proxy a -> ByteStringParser (ByteStringParser (Either String ByteString))
-- | A framing strategy that does not do any framing at all, it just passes the input data
-- This will be used most of the time with binary data, such as files
data NoFraming
instance FramingRender NoFraming a where
header _ _ = empty
boundary _ _ = BoundaryStrategyGeneral id
trailer _ _ = empty
instance FramingUnrender NoFraming a where
unrenderFrames _ _ = ByteStringParser (Just . (go,)) (go,)
where go = ByteStringParser (Just . (, empty) . Right) ((, empty) . Right)
-- | A simple framing strategy that has no header or termination, and inserts a newline character between each frame.
-- This assumes that it is used with a Content-Type that encodes without newlines (e.g. JSON).