Merge pull request #959 from jvanbruegge/fix-stream

Change definition of StreamGenerator

doc/tutorial/ApiType.lhs

@@ -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`

servant-client/test/Servant/StreamSpec.hs

@@ -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)

servant-server/src/Servant/Server/Internal.hs

@@ -284,10 +284,10 @@ instance OVERLAPPING_
 
 instance OVERLAPPABLE_
          ( MimeRender ctype a, ReflectMethod method,
-           FramingRender framing ctype, ToStreamGenerator f a
+           FramingRender framing ctype, ToStreamGenerator b a
-         ) => HasServer (Stream method framing ctype (f a)) context where
+         ) => 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,
+           FramingRender framing ctype, ToStreamGenerator b a,
-           GetHeaders (Headers h (f a))
+           GetHeaders (Headers h b)
-         ) => HasServer (Stream method framing ctype (Headers h (f a))) context where
+         ) => 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) =>
+streamRouter :: (MimeRender ctype a, FramingRender framing ctype, ToStreamGenerator b a) =>
-                (b -> ([(HeaderName, B.ByteString)], f 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

servant/src/Servant/API.hs

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

servant/src/Servant/API/Stream.hs

@@ -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
+class ToStreamGenerator a b | a -> b where
-   toStreamGenerator :: f a -> StreamGenerator a
+   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).