Add RawM combinator #1551
Add RawM combinator #1551
Conversation
|
Thanks, I'll test this version with my code in a while. |
|
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 respI need access to the |
|
Ok, it's easier to understand what you need with this example. Easy enough, I'll update the PR. |
The 'RawM' combinator is a variant of 'Raw' that lets users access the monadic context of the server.
|
@hasufell PTAL. |
This is usable for my purpose |
|
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 |
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 #1349 (comment)
|
|
That seems reasonable to me. We'll just want to make sure the docs are crystal clear about when a user should consider |
|
I have opened an issue on the |
|
@gdeest I'm having trouble using this with servant-auth-server: Although this patch is already applied #1531 |
|
@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:
|
I tried something along the suggestions: cdepillabout/servant-rawm#7 (comment) 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 servant/servant-auth/servant-auth-server/test/Servant/Auth/ServerSpec.hs Lines 405 to 419 in bd9151b However, that presents me with overlapping instances errors: Error output |
|
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 |
|
It seems the culprit is: 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 bThe 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 bI'm not sure if this is a correct fix though. |
|
Any progress towards get |
|
meanwhile i'll just copy&paste this until it's released, thanks a lot! also, do we want to provide |
|
@tchoutri did you see the conversation about servant-auth-server and the mentioned issues? |
|
Yes and we have to bump the priority of thinking about resolving this. :) |
|
Not sure if this is the right place for my question but I am currently experimenting with the new 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) servedApiLeading to this error: 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): 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 respondNote 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): |
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 ?