packages feed

servant-streaming-client (empty) → 0.2.0.0

raw patch · 7 files changed

+298/−0 lines, 7 filesdep +QuickCheckdep +basedep +bytestringsetup-changed

Dependencies added: QuickCheck, base, bytestring, hspec, http-client, http-media, http-types, resourcet, servant, servant-client, servant-client-core, servant-server, servant-streaming, servant-streaming-client, servant-streaming-server, streaming, warp

Files

+ LICENSE view
@@ -0,0 +1,31 @@+Copyright Julian K. Arni (c) 2015++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Julian K. Arni nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ servant-streaming-client.cabal view
@@ -0,0 +1,74 @@+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: b71d6f6ded7bd45e1d8a989dd9f3daf9f47ad37ac900c89e408f13b55770fa3b++name:           servant-streaming-client+version:        0.2.0.0+synopsis:       Client instances for the 'servant-streaming' package.+description:    This package defines instances that allow using the 'StreamBody' and 'StreamResponse' combinators in 'servant' clients.+homepage:       http://github.com/plow-technologies/servant-streaming#readme+bug-reports:    https://github.com/plow-technologies/servant-streaming/issues+author:         Julian K. Arni+maintainer:     jkarni@gmail.com+copyright:      (c) Julian K. Arni+license:        BSD3+license-file:   LICENSE+tested-with:    GHC == 8.2.2+build-type:     Simple+cabal-version:  >= 1.10++source-repository head+  type: git+  location: https://github.com/plow-technologies/servant-streaming++library+  hs-source-dirs:+      src+  default-extensions: AutoDeriveTypeable ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators+  ghc-options: -Wall+  build-depends:+      base >=4.7 && <4.11+    , bytestring+    , http-media >=0.6 && <0.8+    , http-types >=0.9 && <0.13+    , resourcet >=1.1 && <1.3+    , servant >=0.10 && <0.15+    , servant-client-core >=0.10 && <0.15+    , servant-streaming >=0.2 && <0.3+    , streaming >=0.1 && <0.3+  exposed-modules:+      Servant.Streaming.Client+      Servant.Streaming.Client.Internal+  default-language: Haskell2010++test-suite spec+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  default-extensions: AutoDeriveTypeable ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators+  ghc-options: -Wall -Wall -with-rtsopts=-T+  build-depends:+      QuickCheck >=2.8 && <2.11+    , base >=4.7 && <4.11+    , bytestring+    , hspec >2 && <3+    , http-client+    , http-media >=0.6 && <0.8+    , http-types >=0.9 && <0.13+    , resourcet >=1.1 && <1.3+    , servant >=0.10 && <0.15+    , servant-client+    , servant-client-core >=0.10 && <0.15+    , servant-server+    , servant-streaming >=0.2 && <0.3+    , servant-streaming-client+    , servant-streaming-server+    , streaming >=0.1 && <0.3+    , warp+  other-modules:+      Servant.Streaming.ClientSpec+      Paths_servant_streaming_client+  default-language: Haskell2010
+ src/Servant/Streaming/Client.hs view
@@ -0,0 +1,16 @@+-- | This module provides an instance for HasClient for 'servant-streaming'+-- combinators, so that client functions can be generated for APIs that have+-- streaming request or response bodies.+--+-- As as convenience, it also re-exports the combinators themselves.+module Servant.Streaming.Client+  ( StreamResponse+  , StreamBody+  , StreamResponseGet+  , StreamResponsePost+  , StreamResponsePut+  , StreamResponsePatch+  ) where++import Servant.Streaming+import Servant.Streaming.Client.Internal ()
+ src/Servant/Streaming/Client/Internal.hs view
@@ -0,0 +1,66 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE CPP #-}+module Servant.Streaming.Client.Internal where++import           Control.Monad+import           Control.Monad.Trans.Resource (ResourceT, getInternalState,+                                               runInternalState, runResourceT)+import qualified Data.ByteString              as BS+import           Data.IORef+import           Data.Proxy                   (Proxy (Proxy))+import qualified Network.HTTP.Media           as M+import           Servant.API                  hiding (Stream)+import           Servant.Client.Core+import           Servant.Streaming+import           Streaming+import qualified Streaming.Prelude            as S++instance (HasClient m subapi, RunClient m)+    => HasClient m (StreamBodyMonad contentTypes n :> subapi) where+  type Client m (StreamBodyMonad contentTypes n :> subapi)+    = (M.MediaType, Stream (Of BS.ByteString) (ResourceT IO) ())+      -> Client m subapi+  clientWithRoute pm _ req (mtype, body)+    = clientWithRoute+        pm+        (Proxy :: Proxy subapi)+        req { requestBody = Just (RequestBodyStreamChunked body', mtype) }+    where+      body' :: (IO BS.ByteString -> IO ()) -> IO ()+      body' write = runResourceT $ do+        ref <- liftIO $ newIORef body+        is <- getInternalState+        let popper :: IO BS.ByteString+            popper = do+              rsrc <- readIORef ref+              mres <- runInternalState (S.uncons rsrc) is+              case mres of+                Nothing -> return BS.empty+                Just (bs, str)+                  | BS.null bs -> writeIORef ref str >> popper+                  | otherwise -> writeIORef ref str >> return bs+        liftIO $ write popper+#if MIN_VERSION_servant_client_core(0,13,0)+  hoistClientMonad pm _ f cl = \a ->+    hoistClientMonad pm (Proxy :: Proxy subapi) f (cl a)+#endif++instance (RunClient m )+    => HasClient m (StreamResponse verb status contentTypes) where+  type Client m (StreamResponse verb status contentTypes)+    = m (Stream (Of BS.ByteString) (ResourceT IO) ())+  clientWithRoute _ _ req = do+    respStream <- runStreamingResponse <$> streamingRequest req+    let stream' = respStream responseBody+    return $ toStream stream'+    where+      toStream :: IO BS.ByteString -> Stream (Of BS.ByteString) (ResourceT IO) ()+      toStream read' = do+        bs <- liftIO read'+        liftIO $ print bs+        unless (BS.null bs) $ do+          S.yield bs+          toStream read'+#if MIN_VERSION_servant_client_core(0,13,0)+  hoistClientMonad _m _ f cl = f cl+#endif
+ test/Servant/Streaming/ClientSpec.hs view
@@ -0,0 +1,108 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Servant.Streaming.ClientSpec (spec) where++import           Control.Monad.Trans.Resource (ResourceT, runResourceT)+import qualified Data.ByteString              as BS+import qualified Data.ByteString.Char8        as BSC+import qualified Data.ByteString.Lazy.Char8   as BSCL+import           GHC.Stats+import           Network.HTTP.Client          (defaultManagerSettings,+                                               newManager)+import qualified Network.HTTP.Media           as M+import           Network.Wai.Handler.Warp+import           Servant                      ((:<|>) ((:<|>)), (:>), JSON,+                                               MimeRender (..),+                                               MimeUnrender (..), PlainText,+                                               Post, Proxy (..), Server, serve)+import           Servant.Client+import           Servant.Streaming.Client+import           Servant.Streaming.Server     ()+import           Streaming+import qualified Streaming.Prelude            as S+import           Test.Hspec++spec :: Spec+spec = do+  streamBodySpec+  {-streamResponseSpec-}++streamBodySpec :: Spec+streamBodySpec = describe "StreamBody instance" $ around withServer $ do++  it "streams the request body" $ \port' -> do+    runClient port' (lengthC ("application" M.// "json", S.each ["h","i"]))+      `shouldReturn` Right 2++  it "does not keep the request in memory" $ \port' -> do+    let bd = S.replicate 1000 (BSC.replicate megabyte 'a') -- 1000 MB total+    runClient port' (lengthC ("application" M.// "json", bd))+      `shouldReturn` Right (1000 * megabyte)+    bytes <- max_live_bytes <$> getRTSStats+    bytes < 100 * megabyte `shouldBe` True++------------------------------------------------------------------------------+-- API++type API+  =    "length" :> StreamBody '[JSON] :> Post '[JSON] Int+  :<|> "contentType" :> StreamBody '[JSON, PlainText] :> Post '[PlainText] M.MediaType+  :<|> "echo" :> StreamBody '[JSON] :> StreamResponsePost '[JSON]++api :: Proxy API+api = Proxy++server :: Server API+server = lengthH :<|> contentTypeH :<|> echoH+  where+    lengthH      (_contentType, stream')+      = liftIO . runResourceT $ S.sum_ $ S.subst (\x -> BS.length x :> ()) stream'+    contentTypeH (contentType, _stream')+      = return contentType+    echoH        (_contentType, stream')+      = return stream'++withServer :: (Port -> IO ()) -> IO ()+withServer = testWithApplicationSettings settings (return $ serve api server)+  where+    settings = setTimeout 1000 defaultSettings++lengthC+  :: (M.MediaType, Stream (Of BS.ByteString) (ResourceT IO) ())+  -> ClientM Int+_contentTypeC+  :: (M.MediaType, Stream (Of BS.ByteString) (ResourceT IO) ())+  -> ClientM M.MediaType+_echoC+  :: (M.MediaType, Stream (Of BS.ByteString) (ResourceT IO) ())+  -> ClientM (Stream (Of BS.ByteString) (ResourceT IO) ())+lengthC :<|> _contentTypeC :<|> _echoC+  = client api++------------------------------------------------------------------------------+-- Utils++runClient  :: Port -> ClientM a -> IO (Either ServantError a)+runClient p action = do+  mgr <- newManager defaultManagerSettings+  let env = ClientEnv+        { manager = mgr+        , baseUrl = BaseUrl Http "localhost" p ""+        , cookieJar = Nothing+        }+  runClientM action env++megabyte :: Num a => a+megabyte = 1000 ^ (2 :: Int)++------------------------------------------------------------------------------+-- Orphans++instance Show a => MimeRender PlainText a where+  mimeRender _ = BSCL.pack . show+instance Read a => MimeUnrender PlainText a where+  mimeUnrender _ = error . BSCL.unpack++instance Read M.MediaType where+  readsPrec _ x = case M.parseAccept (BSC.pack x) of+    Nothing -> error $ show x+    Just y -> [(y, "")]
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}