Add servant-io-streams

Author: shlevy

.github/workflows/master.yml

@@ -75,6 +75,7 @@ jobs:
         (cd servant-machines && eval $DOCTEST)
         (cd servant-conduit && eval $DOCTEST)
         (cd servant-pipes && eval $DOCTEST)
+        (cd servant-io-streams && eval $DOCTEST)
 
   # stack:
   #   name: stack / ghc ${{ matrix.ghc }}

cabal.project

@@ -20,6 +20,7 @@ packages:
   servant-machines/
   servant-conduit/
   servant-pipes/
+  servant-io-streams/
 
 -- servant GHCJS
 -- packages:

default.nix

@@ -16,6 +16,7 @@ let
     servant-foreign      = self.callCabal2nix "servant-foreign"      ./servant-foreign      {};
     servant-conduit      = self.callCabal2nix "servant-conduit"      ./servant-conduit      {};
     servant-machines     = self.callCabal2nix "servant-machines"     ./servant-machines     {};
+    servant-io-streams   = self.callCabal2nix "servant-io-streams"   ./servant-io-streams   {};
     servant-client-core  = self.callCabal2nix "servant-client-core"  ./servant-client-core  {};
     servant-http-streams = self.callCabal2nix "servant-http-streams" ./servant-http-streams {};
   };
@@ -33,6 +34,7 @@ in
       servant-http-streams
       servant-machines
       servant-pipes
+      servant-io-streams
       servant-server;
   }
 

doc/cookbook/basic-streaming/Streaming.lhs

@@ -10,8 +10,9 @@ In other words, without streaming libraries.
   We have bindings for them though.
 - Similar example is bundled with each of our streaming library interop packages (see 
 [servant-pipes](https://github.com/haskell-servant/servant/blob/master/servant-pipes/example/Main.hs),
-[servant-conduit](https://github.com/haskell-servant/servant/blob/master/servant-conduit/example/Main.hs) and
-[servant-machines](https://github.com/haskell-servant/servant/blob/master/servant-machines/example/Main.hs))
+[servant-conduit](https://github.com/haskell-servant/servant/blob/master/servant-conduit/example/Main.hs),
+[servant-machines](https://github.com/haskell-servant/servant/blob/master/servant-machines/example/Main.hs) and
+[servant-io-streams](https://github.com/haskell-servant/servant/blob/master/servant-io-streams/example/Main.hs))
 - `SourceT` doesn't have *Prelude* with handy combinators, so we have to write
   things ourselves. (Note to self: `mapM` and `foldM` would be handy to have). 
 

servant-io-streams/CHANGELOG.md

@@ -0,0 +1,4 @@
+0.1
+----
+
+- First release

servant-io-streams/LICENSE

@@ -0,0 +1,30 @@
+Copyright (c) 2023, Servant Contributors
+
+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 Servant Contributors 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.

servant-io-streams/README.md

@@ -0,0 +1,3 @@
+# servant-io-streams - Servant Stream support for io-streams
+
+![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png)

servant-io-streams/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

servant-io-streams/example/Main.hs

@@ -0,0 +1,105 @@
+{-# LANGUAGE DataKinds     #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TypeOperators #-}
+module Main (main) where
+
+import           Prelude ()
+import           Prelude.Compat
+
+import           Control.Concurrent
+                 (threadDelay)
+import           Control.Monad.IO.Class
+                 (MonadIO (..))
+import qualified Data.ByteString          as BS
+import           Data.Maybe
+                 (fromMaybe)
+import           Network.HTTP.Client
+                 (defaultManagerSettings, newManager)
+import           System.Environment
+                 (getArgs, lookupEnv)
+import           System.IO
+                 (IOMode (..), openFile, hClose)
+import           Text.Read
+                 (readMaybe)
+
+import qualified System.IO.Streams        as IOS
+import           System.IO.Streams.Combinators
+                 (atEndOfInput)
+import           System.IO.Streams.Handle
+                 (handleToInputStream)
+import           Servant
+import           Servant.Client.Streaming
+import           Servant.IO.Streams ()
+
+import qualified Network.Wai.Handler.Warp as Warp
+
+type FastAPI = "get" :> Capture "num" Int :> StreamGet NewlineFraming JSON (IOS.InputStream Int)
+
+type API = FastAPI
+    :<|> "slow" :> Capture "num" Int :> StreamGet NewlineFraming JSON (IOS.InputStream Int)
+    :<|> "readme" :> StreamGet NoFraming OctetStream (IOS.InputStream BS.ByteString)
+    -- we can have streaming request body
+    :<|> "proxy"
+        :> StreamBody NoFraming OctetStream (IOS.InputStream BS.ByteString)
+        :> StreamPost NoFraming OctetStream (IOS.InputStream BS.ByteString)
+
+api :: Proxy API
+api = Proxy
+
+server :: Server API
+server = fast :<|> slow :<|> readme :<|> proxy
+  where
+    fast n = liftIO $ do
+        putStrLn ("/get/" ++ show n)
+        IOS.fromGenerator $ fastGenerator n
+
+    slow n = liftIO $ do
+        putStrLn ("/slow/" ++ show n)
+        IOS.fromGenerator $ slowGenerator n
+
+    readme = liftIO $ do
+        putStrLn "/readme"
+        h <- openFile "README.md" ReadMode
+        is <- handleToInputStream h
+        atEndOfInput (hClose h) is
+
+    proxy c = liftIO $ do
+        putStrLn "/proxy"
+        return c
+
+    fastGenerator n
+        | n < 0     = return ()
+        | otherwise = IOS.yield n >> fastGenerator (n - 1)
+
+    slowGenerator n
+        | n < 0     = return ()
+        | otherwise = IOS.yield n >> liftIO (threadDelay 1000000) >> slowGenerator (n - 1)
+
+app :: Application
+app = serve api server
+
+cli :: Client ClientM FastAPI
+cli :<|> _ :<|> _ :<|> _ = client api
+
+main :: IO ()
+main = do
+    args <- getArgs
+    case args of
+        ("server":_) -> do
+            putStrLn "Starting servant-io-streams:example at http://localhost:8000"
+            port <- fromMaybe 8000 . (>>= readMaybe) <$> lookupEnv "PORT"
+            Warp.run port app
+        ("client":ns:_) -> do
+            n <- maybe (fail $ "not a number: " ++ ns) pure $ readMaybe ns
+            mgr <- newManager defaultManagerSettings
+            burl <- parseBaseUrl "http://localhost:8000/"
+            withClientM (cli n) (mkClientEnv mgr burl) $ \me -> case me of
+                Left err -> print err
+                Right s  -> do
+                    x <- IOS.fold (\c _ -> c + 1) (0 :: Int) s
+                    print x
+        _ -> do
+            putStrLn "Try:"
+            putStrLn "cabal new-run servant-io-streams:example server"
+            putStrLn "cabal new-run servant-io-streams:example client 10"
+            putStrLn "time curl -H 'Accept: application/json' localhost:8000/slow/5"

servant-io-streams/servant-io-streams.cabal

@@ -0,0 +1,57 @@
+cabal-version:       2.2
+name:                servant-io-streams
+version:             0.1
+
+synopsis:            Servant Stream support for io-streams
+category:            Servant, Web, io-streams
+description:         Servant Stream support for io-streams.
+  .
+  Provides 'ToSourceIO' and 'FromSourceIO' instances for 'InputStream'.
+
+homepage:            http://docs.servant.dev/
+bug-reports:         http://github.com/haskell-servant/servant/issues
+license:             BSD-3-Clause
+license-file:        LICENSE
+author:              Servant Contributors
+maintainer:          [email protected]
+copyright:           2023 Servant Contributors
+build-type:          Simple
+tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.2
+
+extra-source-files:
+  CHANGELOG.md
+
+source-repository head
+  type: git
+  location: http://github.com/haskell-servant/servant.git
+
+library
+  exposed-modules:     Servant.IO.Streams
+  build-depends:
+      base        >=4.9  && <5
+    , io-streams ^>=1.5
+    , servant     >=0.15 && <0.20
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+  ghc-options: -Wall
+
+test-suite example
+  type: exitcode-stdio-1.0
+  main-is: Main.hs
+  hs-source-dirs:
+    example
+  ghc-options: -Wall -rtsopts -threaded
+  build-depends:
+      base
+    , base-compat
+    , bytestring
+    , http-media
+    , servant
+    , servant-io-streams
+    , io-streams     ^>= 1.5
+    , servant-server >=0.15     && <0.20
+    , servant-client >=0.15     && <0.20
+    , wai            >=3.2.1.2  && <3.3
+    , warp           >=3.2.25   && <3.4
+    , http-client
+  default-language: Haskell2010