Allow other monads than IO for server

[domenkozar]

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.

[domenkozar]

cc @jkarni if you have some thoughts :)

[domenkozar]

Actually this does compile and monad for StreamBody is ignored for client side.