add tests, fix to make tests work

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

@@ -267,7 +267,7 @@ instance OVERLAPPABLE_
       }
    return . buildFromStream $ ResultStream $ \k ->
      runStreamingResponse sresp $ \(status,_headers,_httpversion,reader) -> do
-      when (H.statusCode status /= 200) $ error "bad status" --fixme
+      when (H.statusCode status /= 200) $ error "bad status" -- TODO fixme
       let  unrender = unrenderFrames (Proxy :: Proxy framing) (Proxy :: Proxy a)
            loop bs = do
              res <- BL.fromStrict <$> reader
@@ -283,9 +283,11 @@ instance OVERLAPPABLE_
               res <- BL.fromStrict <$> reader
               let addIsEmptyInfo (a, r) = (r, (a, BL.null r && BL.null res))
               if BL.null res
-                   then return . addIsEmptyInfo $ parseEOF frameParser res
+                   then if BL.null bs
+                           then return ("", (Right "", True))
+                           else return . addIsEmptyInfo $ parseEOF frameParser bs
                    else let sofar = (bs <> res)
-                        in case parseIncremental frameParser res of
+                        in case parseIncremental frameParser sofar of
                           Just x ->  return $ addIsEmptyInfo x
                           Nothing -> frameLoop sofar
 

servant-client/servant-client.cabal

@@ -66,6 +66,7 @@ test-suite spec
   main-is: Spec.hs
   other-modules:
       Servant.ClientSpec
+      Servant.StreamSpec
   build-depends:
       base == 4.*
     , aeson

servant-client/test/Servant/ClientSpec.hs

@@ -24,7 +24,7 @@
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 
 #include "overlapping-compat.h"
-module Servant.ClientSpec (spec) where
+module Servant.ClientSpec (spec, Person(..), startWaiApp, endWaiApp) where
 
 import           Prelude                                    ()
 import           Prelude.Compat

servant-client/test/Servant/StreamSpec.hs

@@ -0,0 +1,113 @@
+{-# LANGUAGE CPP                    #-}
+{-# LANGUAGE ConstraintKinds        #-}
+{-# LANGUAGE DataKinds              #-}
+{-# LANGUAGE DeriveGeneric          #-}
+{-# LANGUAGE FlexibleContexts       #-}
+{-# LANGUAGE FlexibleInstances      #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GADTs                  #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE OverloadedStrings      #-}
+{-# LANGUAGE PolyKinds              #-}
+{-# LANGUAGE RecordWildCards        #-}
+{-# LANGUAGE ScopedTypeVariables    #-}
+{-# LANGUAGE StandaloneDeriving     #-}
+{-# LANGUAGE TypeFamilies           #-}
+{-# LANGUAGE TypeOperators          #-}
+{-# LANGUAGE UndecidableInstances   #-}
+#if __GLASGOW_HASKELL__ >= 800
+{-# OPTIONS_GHC -freduction-depth=100 #-}
+#else
+{-# OPTIONS_GHC -fcontext-stack=100 #-}
+#endif
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+
+#include "overlapping-compat.h"
+module Servant.StreamSpec (spec) where
+
+import           Prelude                                    ()
+import           Prelude.Compat
+import           Data.Proxy
+import qualified Network.HTTP.Client                        as C
+import           System.IO.Unsafe                           (unsafePerformIO)
+import           Test.Hspec
+
+import           Servant.API                                ((:<|>) ((:<|>)),
+                                                             (:>),
+                                                             EmptyAPI, JSON,
+                                                             StreamGet,
+                                                             NewlineFraming,
+                                                             NetstringFraming,
+                                                             ResultStream(..),
+                                                             StreamGenerator(..))
+import           Servant.Client
+import           Servant.Server
+import qualified Servant.ClientSpec                          as CS
+import           Servant.ClientSpec                          (Person(..))
+
+
+spec :: Spec
+spec = describe "Servant.Stream" $ do
+    streamSpec
+
+type StreamApi f =
+       "streamGetNewline" :> StreamGet NewlineFraming JSON (f Person)
+  :<|> "streamGetNetstring" :> StreamGet  NetstringFraming JSON (f Person)
+  :<|> EmptyAPI
+
+
+capi :: Proxy (StreamApi ResultStream)
+capi = Proxy
+
+sapi :: Proxy (StreamApi StreamGenerator)
+sapi = Proxy
+
+
+getGetNL :<|> getGetNS :<|> EmptyClient = client capi
+
+
+getGetNL :: ClientM (ResultStream Person)
+getGetNS :: ClientM (ResultStream Person)
+
+alice :: Person
+alice = Person "Alice" 42
+
+bob :: Person
+bob = Person "Bob" 25
+
+server :: Application
+server = serve sapi (
+       (return (StreamGenerator (\f r -> f alice >> r bob >> r alice))
+       :: Handler (StreamGenerator Person))
+       :<|>
+       (return (StreamGenerator (\f r -> f alice >> r bob >> r alice))
+       :: Handler (StreamGenerator Person))
+       :<|>
+       emptyServer)
+
+
+{-# NOINLINE manager' #-}
+manager' :: C.Manager
+manager' = unsafePerformIO $ C.newManager C.defaultManagerSettings
+
+runClient :: ClientM a -> BaseUrl -> IO (Either ServantError a)
+runClient x baseUrl' = runClientM x (ClientEnv manager' baseUrl')
+
+runResultStream :: ResultStream a -> IO (Maybe (Either String a), Maybe (Either String a), Maybe (Either String a), Maybe (Either String a))
+runResultStream (ResultStream k) = k $ \act -> (,,,) <$> act <*> act <*> act <*> act
+
+streamSpec :: Spec
+streamSpec = beforeAll (CS.startWaiApp server) $ afterAll CS.endWaiApp $ do
+
+    it "Servant.API.StreamGet.Newline" $ \(_, baseUrl) -> do
+       Right res <- runClient getGetNL baseUrl
+       let jra = Just (Right alice)
+           jrb = Just (Right bob)
+       runResultStream res `shouldReturn` (jra, jrb, jra, Nothing)
+
+    it "Servant.API.StreamGet.Netstring" $ \(_, baseUrl) -> do
+       Right res <- runClient getGetNS baseUrl
+       let jra = Just (Right alice)
+           jrb = Just (Right bob)
+       runResultStream res `shouldReturn` (jra, jrb, jra, Nothing)

servant/src/Servant/API.hs

@@ -83,13 +83,15 @@ import           Servant.API.IsSecure        (IsSecure (..))
 import           Servant.API.QueryParam      (QueryFlag, QueryParam,
                                               QueryParams)
 import           Servant.API.Raw             (Raw)
-import           Servant.API.Stream          (Stream, StreamGenerator (..),
+import           Servant.API.Stream          (Stream, StreamGet, StreamPost,
+                                              StreamGenerator (..),
                                               ToStreamGenerator (..),
                                               ResultStream(..), BuildFromStream (..),
                                               ByteStringParser (..),
                                               FramingRender (..), BoundaryStrategy (..),
                                               FramingUnrender (..),
-                                              NewlineFraming)
+                                              NewlineFraming,
+                                              NetstringFraming)
 import           Servant.API.RemoteHost      (RemoteHost)
 import           Servant.API.ReqBody         (ReqBody)
 import           Servant.API.ResponseHeaders (AddHeader, addHeader, noHeader,

servant/src/Servant/API/Stream.hs

@@ -14,9 +14,12 @@ module Servant.API.Stream where
 
 import           Data.ByteString.Lazy        (ByteString, empty)
 import qualified Data.ByteString.Lazy.Char8  as LB
+import           Data.Monoid                 ((<>))
 import           Data.Proxy                  (Proxy)
 import           Data.Typeable               (Typeable)
 import           GHC.Generics                (Generic)
+import           Text.Read                   (readMaybe)
+import           Data.Bifunctor              (first)
 import           Network.HTTP.Types.Method   (StdMethod (..))
 
 -- | 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.
@@ -93,15 +96,22 @@ data NetstringFraming
 
 instance FramingRender NetstringFraming a where
    header    _ _ = empty
-   boundary  _ _ = BoundaryStrategyBracket $ \b -> (LB.pack . show . LB.length $ b, "")
+   boundary  _ _ = BoundaryStrategyBracket $ \b -> ((<> ":") . LB.pack . show . LB.length $ b, ",")
    trailer   _ _ = empty
 
-{-
 
 instance FramingUnrender NetstringFraming a where
-   unrenderFrames _ _ = (, \b -> let (i,r) = LB.break (==':') b
+   unrenderFrames _ _ = ByteStringParser (Just . (go,)) (go,)
+       where go = ByteStringParser
+                 (\b -> let (i,r) = LB.break (==':') b
                         in case readMaybe (LB.unpack i) of
-                                    Just len -> first Right $ LB.splitAt len . LB.drop 1 $ r
+                             Just len -> if LB.length r > len
-                                    Nothing -> (Left ("Bad netstring frame, couldn't parse value as integer value: " ++ LB.unpack i), LB.drop 1 . LB.dropWhile (/= ',') $ r)
+                                         then Just . first Right . fmap (LB.drop 1) $ LB.splitAt len . LB.drop 1 $ r
-                        )
+                                         else Nothing
--}
+                             Nothing -> Just (Left ("Bad netstring frame, couldn't parse value as integer value: " ++ LB.unpack i), LB.drop 1 . LB.dropWhile (/= ',') $ r))
+                 (\b -> let (i,r) = LB.break (==':') b
+                        in case readMaybe (LB.unpack i) of
+                             Just len -> if LB.length r > len
+                                         then first Right . fmap (LB.drop 1) $ LB.splitAt len . LB.drop 1 $ r
+                                         else (Right $ LB.take len r, LB.empty)
+                             Nothing -> (Left ("Bad netstring frame, couldn't parse value as integer value: " ++ LB.unpack i), LB.drop 1 . LB.dropWhile (/= ',') $ r))