Using StreamBody I'd like to use ResourceT AWS so that I can call amazonka when processing the stream on server side. On the other hand, client side should still use IO.
I have tried below naive approach, but that requires client and server side to use the same monad.
diff --git a/servant-streaming-client/src/Servant/Streaming/Client/Internal.hs b/servant-streaming-client/src/Servant/Streaming/Client/Internal.hs
index d04c3c2..93e327b 100644
--- a/servant-streaming-client/src/Servant/Streaming/Client/Internal.hs
+++ b/servant-streaming-client/src/Servant/Streaming/Client/Internal.hs
@@ -15,9 +15,9 @@ import Servant.Streaming
import Streaming
import qualified Streaming.Prelude as S
-instance (HasClient m subapi, RunClient m )
- => HasClient m (StreamBody contentTypes :> subapi) where
- type Client m (StreamBody contentTypes :> subapi)
+instance (HasClient m subapi, RunClient m, MonadIO n)
+ => HasClient m (StreamBody contentTypes n :> subapi) where
+ type Client m (StreamBody contentTypes n :> subapi)
= (M.MediaType, Stream (Of BS.ByteString) (ResourceT IO) ())
-> Client m subapi
clientWithRoute pm _ req (mtype, body)
diff --git a/servant-streaming-client/test/Servant/Streaming/ClientSpec.hs b/servant-streaming-client/test/Servant/Streaming/ClientSpec.hs
index 4eebc30..5b4d752 100644
--- a/servant-streaming-client/test/Servant/Streaming/ClientSpec.hs
+++ b/servant-streaming-client/test/Servant/Streaming/ClientSpec.hs
@@ -44,9 +44,9 @@ streamBodySpec = describe "StreamBody instance" $ around withServer $ do
-- API
type API
- = "length" :> StreamBody '[JSON] :> Post '[JSON] Int
- :<|> "contentType" :> StreamBody '[JSON, PlainText] :> Post '[PlainText] M.MediaType
- :<|> "echo" :> StreamBody '[JSON] :> StreamResponsePost '[JSON]
+ = "length" :> StreamBody '[JSON] IO :> Post '[JSON] Int
+ :<|> "contentType" :> StreamBody '[JSON, PlainText] IO :> Post '[PlainText] M.MediaType
+ :<|> "echo" :> StreamBody '[JSON] IO :> StreamResponsePost '[JSON]
api :: Proxy API
api = Proxy
diff --git a/servant-streaming-server/src/Servant/Streaming/Server/Internal.hs b/servant-streaming-server/src/Servant/Streaming/Server/Internal.hs
index 6e0e879..5b75b49 100644
--- a/servant-streaming-server/src/Servant/Streaming/Server/Internal.hs
+++ b/servant-streaming-server/src/Servant/Streaming/Server/Internal.hs
@@ -37,10 +37,10 @@ import Servant.Server.Internal.RoutingApplication (DelayedIO,
import Servant.Streaming
import Streaming
-instance ( AllMime contentTypes, HasServer subapi ctx
- ) => HasServer (StreamBody contentTypes :> subapi) ctx where
- type ServerT (StreamBody contentTypes :> subapi) m
- = (M.MediaType, Stream (Of BS.ByteString) (ResourceT IO) ())
+instance ( AllMime contentTypes, HasServer subapi ctx, MonadIO n
+ ) => HasServer (StreamBody contentTypes n :> subapi) ctx where
+ type ServerT (StreamBody contentTypes n :> subapi) m
+ = (M.MediaType, Stream (Of BS.ByteString) (ResourceT n) ())
-> ServerT subapi m
route _ ctxt subapi =
diff --git a/servant-streaming-server/test/Servant/Streaming/ServerSpec.hs b/servant-streaming-server/test/Servant/Streaming/ServerSpec.hs
index 7f13d1a..fb3557e 100644
--- a/servant-streaming-server/test/Servant/Streaming/ServerSpec.hs
+++ b/servant-streaming-server/test/Servant/Streaming/ServerSpec.hs
@@ -109,9 +109,9 @@ streamResponseSpec = describe "StreamResponse instance" $ around withServer $ do
-- API
type API
- = "length" :> StreamBody '[JSON] :> Post '[PlainText] Int
- :<|> "contentType" :> StreamBody '[JSON, PlainText] :> Post '[PlainText] M.MediaType
- :<|> "echo" :> StreamBody '[JSON] :> StreamResponsePost '[JSON]
+ = "length" :> StreamBody '[JSON] IO :> Post '[PlainText] Int
+ :<|> "contentType" :> StreamBody '[JSON, PlainText] IO :> Post '[PlainText] M.MediaType
+ :<|> "echo" :> StreamBody '[JSON] IO :> StreamResponsePost '[JSON]
:<|> "getfile" :> StreamResponsePost '[PlainText]
api :: Proxy API
diff --git a/servant-streaming/src/Servant/Streaming.hs b/servant-streaming/src/Servant/Streaming.hs
index 1f24871..37a858f 100644
--- a/servant-streaming/src/Servant/Streaming.hs
+++ b/servant-streaming/src/Servant/Streaming.hs
@@ -4,7 +4,7 @@ import GHC.TypeLits (Nat)
import Network.HTTP.Types
-- | A request body that should be streamed.
-data StreamBody (contentTypes :: [*])
+data StreamBody (contentTypes :: [*]) (m :: * -> *)
-- | A response body that should be streamed, with specified method, status,
-- and content-type.
Using
StreamBody
I'd like to useResourceT AWS
so that I can call amazonka when processing the stream on server side. On the other hand, client side should still useIO
.I have tried below naive approach, but that requires client and server side to use the same monad.