servant
servant copied to clipboard
haskell-servant
Add RawM combinator
The 'RawM' combinator is a variant of 'Raw' that lets users access the monadic context of the server.
The handler must produce a WAI Response, like Raw.
Closes #1544 .
@hasufell may I have your input on this PR ?
I don't see how to use this with my use case. E.g.:
newtype AppM a = AppM { runAppM :: ReaderT AppState Handler a }
streamEvent :: Request -> (Response -> IO ResponseReceived) -> AppM ResponseReceived
streamEvent req resp = do
AppState{..} <- ask
chan <- liftIO getChanListener
liftIO $ eventSourceAppChan chan req resp
I need access to the resp :: Response -> IO ResponseReceived, because eventSourceAppChan is a library function and needs it: https://hackage.haskell.org/package/wai-extra-3.1.8/docs/Network-Wai-EventSource.html#v:eventSourceAppChan
Ok, it's easier to understand what you need with this example. Easy enough, I'll update the PR.
Just FTR as they don't seem to have been mentioned here and in the linked issue: There is another PR adding this (#1349), and also an existing package: https://github.com/cdepillabout/servant-rawm
Indeed¸I totally missed it. The cabal files do not mention any upper-bound on servant package, so with some luck servant-rawm is already compatible with servant 0.19 and we can just close this PR.
Indeed¸I totally missed it. The cabal files do not mention any upper-bound on servant package, so with some luck
servant-rawmis already compatible with servant 0.19 and we can just close this PR.
Wouldn't it be better to add it to servant? I feel another library will not integrate as well and may lag behind releases.
Wouldn't it be better to add it to servant? I feel another library will not integrate as well and may lag behind releases.
Seconding this, another reason from https://github.com/haskell-servant/servant/pull/1349#issuecomment-713175218
In particular, it will make it easier to close https://github.com/cdepillabout/servant-rawm/issues/7, as servant-auth can provide the required instance out of the box (without having to write a servant-auth-rawm compat package).
That seems reasonable to me. We'll just want to make sure the docs are crystal clear about when a user should consider Raw vs RawM etc.
I have opened an issue on the servant-rawm repository to discuss a potential merge.
@gdeest I'm having trouble using this with servant-auth-server:
• No instance for (Servant.Auth.Server.Internal.AddSetCookie.AddSetCookies
('Servant.Auth.Server.Internal.AddSetCookie.S
('Servant.Auth.Server.Internal.AddSetCookie.S
'Servant.Auth.Server.Internal.AddSetCookie.Z))
(Network.Wai.Internal.Request
-> (Network.Wai.Internal.Response
-> IO Network.Wai.Internal.ResponseReceived)
-> Handler Network.Wai.Internal.ResponseReceived)
(ServerT
(Servant.Auth.Server.Internal.AddSetCookie.AddSetCookieApi
(Servant.Auth.Server.Internal.AddSetCookie.AddSetCookieApi
Servant.API.Raw.RawM))
Handler))
arising from a use of ‘serveWithContext’
Although this patch is already applied https://github.com/haskell-servant/servant/pull/1531
@hasufell That is the same issue as in https://github.com/cdepillabout/servant-rawm/issues/7, see the penultimate comment for a solution. Actually, it is one of the motivations I mentioned above to merge this PR:
In particular, it will make it easier to close https://github.com/cdepillabout/servant-rawm/issues/7, as servant-auth can provide the required instance out of the box (without having to write a servant-auth-rawm compat package).
@hasufell That is the same issue as in cdepillabout/servant-rawm#7, see the penultimate comment for a solution. Actually, it is one of the motivations I mentioned above to merge this PR:
In particular, it will make it easier to close cdepillabout/servant-rawm#7, as servant-auth can provide the required instance out of the box (without having to write a servant-auth-rawm compat package).
I tried something along the suggestions: https://github.com/cdepillabout/servant-rawm/issues/7#issuecomment-419611219
More specifically:
type instance AddSetCookieApi RawM = RawM
type ApplicationM m = Request -> (Response -> IO ResponseReceived) -> m ResponseReceived
instance
AddSetCookies ('S n) (Tagged m (ApplicationM m)) (Tagged m (ApplicationM m)) where
addSetCookies cookies r = Tagged $ \request respond ->
unTagged r request $ respond . mapResponseHeaders (++ mkHeaders cookies)
-- there doesn't seem to be a valid implementation here
instance
(Functor m) =>
AddSetCookies ('S n) (m (ApplicationM m)) (m (ApplicationM m)) where
addSetCookies cookies = undefined
instance
(Functor m) =>
AddSetCookies ('S n) (m Application) (m Application) where
addSetCookies cookies = (fmap $ addSetCookies cookies)
But it didn't work:
• Couldn't match type ‘Network.Wai.Internal.ResponseReceived’
with ‘Servant.API.ResponseHeaders.Headers
'[Servant.API.Header.Header "Set-Cookie" SetCookie] cookied0’
arising from a use of ‘serveWithContext’
This seemed to work, although I have no idea what it does:
type instance AddSetCookieApi RawM = RawM
type ApplicationM m = Request -> (Response -> IO ResponseReceived) -> m ResponseReceived
instance
AddSetCookies ('S n) (Tagged m (ApplicationM m)) (Tagged m (ApplicationM m)) where
addSetCookies cookies r = Tagged $ \request respond ->
unTagged r request $ respond . mapResponseHeaders (++ mkHeaders cookies)
instance (Functor m)
=> AddSetCookies ('S n) (m (ApplicationM m)) (m (ApplicationM m)) where
addSetCookies cookies = fmap $ addSetCookies cookies
instance AddSetCookies ('S n) (ApplicationM m) (ApplicationM m) where
addSetCookies cookies r request respond
= r request $ respond . mapResponseHeaders (++ mkHeaders cookies)
Going further, I tried to move the Auth foo bar to the outer part of the API (with named routes), so I can match on it before the handlers, like it's done in this spec: https://github.com/haskell-servant/servant/blob/bd9151b9de579e98d14add3328933d155df25fc9/servant-auth/servant-auth-server/test/Servant/Auth/ServerSpec.hs#L405-L419
However, that presents me with overlapping instances errors:
Error output
• Overlapping instances for Servant.Auth.Server.Internal.AddSetCookie.AddSetCookies
('Servant.Auth.Server.Internal.AddSetCookie.S
('Servant.Auth.Server.Internal.AddSetCookie.S
'Servant.Auth.Server.Internal.AddSetCookie.Z))
((Network.Wai.Internal.Request
-> (Network.Wai.Internal.Response
-> IO Network.Wai.Internal.ResponseReceived)
-> Handler Network.Wai.Internal.ResponseReceived)
Servant.API.Alternative.:<|> (Text
-> Maybe Int
-> Network.Wai.Internal.Request
-> (Network.Wai.Internal.Response
-> IO
Network.Wai.Internal.ResponseReceived)
-> Handler
Network.Wai.Internal.ResponseReceived))
((Network.Wai.Internal.Request
-> (Network.Wai.Internal.Response
-> IO Network.Wai.Internal.ResponseReceived)
-> Handler Network.Wai.Internal.ResponseReceived)
Servant.API.Alternative.:<|> (Text
-> Maybe Int
-> Network.Wai.Internal.Request
-> (Network.Wai.Internal.Response
-> IO
Network.Wai.Internal.ResponseReceived)
-> Handler
Network.Wai.Internal.ResponseReceived))
arising from a use of ‘serveWithContext’
Matching instances:
two instances involving out-of-scope types
instance [overlappable] (Functor m,
Servant.Auth.Server.Internal.AddSetCookie.AddSetCookies
n (m old) (m cookied),
Servant.API.ResponseHeaders.AddHeader
"Set-Cookie" SetCookie cookied new) =>
Servant.Auth.Server.Internal.AddSetCookie.AddSetCookies
('Servant.Auth.Server.Internal.AddSetCookie.S n) (m old) (m new)
-- Defined in ‘Servant.Auth.Server.Internal.AddSetCookie’
instance [overlap ok] (Servant.Auth.Server.Internal.AddSetCookie.AddSetCookies
('Servant.Auth.Server.Internal.AddSetCookie.S n) a a',
Servant.Auth.Server.Internal.AddSetCookie.AddSetCookies
('Servant.Auth.Server.Internal.AddSetCookie.S n) b b') =>
Servant.Auth.Server.Internal.AddSetCookie.AddSetCookies
('Servant.Auth.Server.Internal.AddSetCookie.S n)
(a Servant.API.Alternative.:<|> b)
(a' Servant.API.Alternative.:<|> b')
-- Defined in ‘Servant.Auth.Server.Internal.AddSetCookie’
I have a repro for the overlapping instances issue: https://github.com/hasufell/servant-rawm-repro/blob/c889dd8330b42f36aef605dde4a4cbf47eb7ee59/app/Main.hs#L86-L90
It seems it's because we have two named endpoints that end in RawM. If you switch out one of them with Get '[JSON] Int it compiles. If you switch out both of them with Get '[JSON] Int it also compiles...
It seems the culprit is: https://github.com/haskell-servant/servant/blob/1fba9dc6048cea6184964032b861b052cd54878c/servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/AddSetCookie.hs#L73-L76
I managed to make it compile by adding another very similar instance:
instance {-# OVERLAPS #-}
(AddSetCookies ('S n) a a, AddSetCookies ('S n) b b)
=> AddSetCookies ('S n) (a :<|> b) (a :<|> b) where
addSetCookies cookies (a :<|> b) = addSetCookies cookies a :<|> addSetCookies cookies b
The diff of both instances is:
@@ -71,8 +71,8 @@ instance {-# OVERLAPPABLE #-}
Just cookie -> addHeader cookie <$> addSetCookies rest oldVal
instance {-# OVERLAPS #-}
- (AddSetCookies ('S n) a a', AddSetCookies ('S n) b b')
- => AddSetCookies ('S n) (a :<|> b) (a' :<|> b') where
+ (AddSetCookies ('S n) a a, AddSetCookies ('S n) b b)
+ => AddSetCookies ('S n) (a :<|> b) (a :<|> b) where
addSetCookies cookies (a :<|> b) = addSetCookies cookies a :<|> addSetCookies cookies b
I'm not sure if this is a correct fix though.
Any progress towards get RawM or another way to get better monad hoisting?
Or are we going to stay with bespoke solutions for now?
#migamake
meanwhile i'll just copy&paste this until it's released, thanks a lot!
also, do we want to provide type ApplicationM m = Request -> (Response -> IO ResponseReceived) -> m ResponseReceived? not sure it belongs here, but it'd certainly be helfpul.
@tchoutri did you see the conversation about servant-auth-server and the mentioned issues?
Not sure if this is the right place for my question but I am currently experimenting with the new RawM that was introduced with this PR. I want to use waiProxyTo (from https://github.com/parsonsmatt/incremental-servant/blob/cat-takeover/src/Api.hs) as raw application and I am having some trouble.
Minimal reproducer:
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
module MinimalRepro where
import Control.Monad.Reader
import Network.HTTP.Client (Manager, defaultManagerSettings, newManager)
import Network.HTTP.ReverseProxy
import Network.Wai
import Network.Wai.Handler.Warp
import Servant
import Servant.API.Generic
import Servant.Server.Generic
type AppM = ReaderT Manager Handler
newtype MyApi as = MyApi
{ rawEndpoint :: as :- RawM
}
deriving (Generic)
forwardRequest :: Request -> IO WaiProxyResponse
forwardRequest _ =
pure . WPRProxyDest . ProxyDest "127.0.0.1" $ 4567
servedApi :: MyApi (AsServerT AppM)
servedApi =
MyApi
{ rawEndpoint = do
manager <- ask
pure $ waiProxyTo forwardRequest defaultOnExc manager
}
main :: IO ()
main = do
let port = 1234
manager <- newManager defaultManagerSettings
run port $ genericServeT (`runReaderT` manager) servedApi
Leading to this error:
src/MinimalRepro.hs:31:9: error:
• Couldn't match type: (Response -> IO ResponseReceived)
-> IO ResponseReceived
with: ReaderT Manager Handler ResponseReceived
Expected: AsServerT AppM :- RawM
Actual: Request -> Application
• In a stmt of a 'do' block: manager <- ask
In the ‘rawEndpoint’ field of a record
In the expression:
MyApi
{rawEndpoint = do manager <- ask
pure $ waiProxyTo forwardRequest defaultOnExc manager}
|
31 | manager <- ask
| ^^^^^^^^^^^^^^
src/MinimalRepro.hs:31:20: error:
• Couldn't match type ‘Request’ with ‘Manager’
arising from a functional dependency between:
constraint ‘MonadReader Manager ((->) Request)’
arising from a use of ‘ask’
instance ‘MonadReader r ((->) r)’ at <no location info>
• In a stmt of a 'do' block: manager <- ask
In the ‘rawEndpoint’ field of a record
In the expression:
MyApi
{rawEndpoint = do manager <- ask
pure $ waiProxyTo forwardRequest defaultOnExc manager}
|
31 | manager <- ask
| ^^^
Can anyone enlighten me what I am doing wrong?
I haven't implemented this feature (just chiming in as observer) so don't take my word for it, but check what ServerT type family tells you should be the type of the handler you provide. It should be a function taking Request and "reponder" continuation and should return ResponseReceived wrapped within your handler monad (AppM in your case):
https://github.com/haskell-servant/servant/blob/c05a9e2c9947c77eb8d600954d4cb5e8c4e35e7c/servant-server/src/Servant/Server/Internal.hs#L665
Changing your example in this way makes it compile (though didn't check if it actually works).
rawEndpoint = \req respond -> do
manager <- ask
let application = waiProxyTo forwardRequest defaultOnExc manager
-- here I'm lifting `IO ResponseReceived` to `AppM ResponseReceived`
liftIO $ application req respond
Note that this is quite different from what e.g. servant-rawm package provides, which allows you to return the entire Application from within your custom monad (if you were to use RawM from that package I think your example would compile):
https://github.com/cdepillabout/servant-rawm/blob/512c81dd3ee7b9b0b15476345dbb2fa52d5b3584/servant-rawm-server/src/Servant/RawM/Server.hs#L66
