git.iko.soy/servant
on master help sign in
Merge pull request #1531 from gdeest/servant-auth-named-routes

servant-auth-server: Support NamedRoutes

commit002fa2107ad598315d8a963813674f996aa1de60 authorGaël Deest <gael.deest@tweag.io> dateMon 14 Feb 2022, 14:57 (5 years ago) parentcdd7c34bd9151b
3 files changed+29−1
compare with master
unifiedsplit
servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/AddSetCookie.hs+12 servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/ThrowAll.hs+10−1 servant-auth/servant-auth-server/test/Servant/Auth/ServerSpec.hs+7
servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/AddSetCookie.hs+12
@@ -11,6 +11,8 @@ import Data.Tagged (Tagged (..))
1111import qualified Network.HTTP.Types as HTTP
1212import Network.Wai (mapResponseHeaders)
1313import Servant
14+import Servant.API.Generic
15+import Servant.Server.Generic
1416import Web.Cookie
1517
1618-- What are we doing here? Well, the idea is to add headers to the response,
@@ -34,6 +36,7 @@ type family AddSetCookieApiVerb a where
3436type family AddSetCookieApi a :: *
3537type instance AddSetCookieApi (a :> b) = a :> AddSetCookieApi b
3638type instance AddSetCookieApi (a :<|> b) = AddSetCookieApi a :<|> AddSetCookieApi b
39+type instance AddSetCookieApi (NamedRoutes api) = AddSetCookieApi (ToServantApi api)
3740type instance AddSetCookieApi (Verb method stat ctyps a)
3841 = Verb method stat ctyps (AddSetCookieApiVerb a)
3942type instance AddSetCookieApi Raw = Raw
@@ -72,6 +75,15 @@ instance {-# OVERLAPS #-}
7275 => AddSetCookies ('S n) (a :<|> b) (a' :<|> b') where
7376 addSetCookies cookies (a :<|> b) = addSetCookies cookies a :<|> addSetCookies cookies b
7477
78+instance {-# OVERLAPS #-}
79+ ( AddSetCookies ('S n) (ServerT (ToServantApi api) m) cookiedApi
80+ , Generic (api (AsServerT m))
81+ , GServantProduct (Rep (api (AsServerT m)))
82+ , ToServant api (AsServerT m) ~ ServerT (ToServantApi api) m
83+ )
84+ => AddSetCookies ('S n) (api (AsServerT m)) cookiedApi where
85+ addSetCookies cookies = addSetCookies cookies . toServant
86+
7587-- | for @servant <0.11@
7688instance
7789 AddSetCookies ('S n) Application Application where
servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/ThrowAll.hs+10−1
@@ -8,7 +8,10 @@ module Servant.Auth.Server.Internal.ThrowAll where
88
99import Control.Monad.Error.Class
1010import Data.Tagged (Tagged (..))
11−import Servant ((:<|>) (..), ServerError(..))
11+import Servant ((:<|>) (..), ServerError(..), NamedRoutes(..))
12+import Servant.API.Generic
13+import Servant.Server.Generic
14+import Servant.Server
1215import Network.HTTP.Types
1316import Network.Wai
1417
@@ -26,6 +29,12 @@ class ThrowAll a where
2629instance (ThrowAll a, ThrowAll b) => ThrowAll (a :<|> b) where
2730 throwAll e = throwAll e :<|> throwAll e
2831
32+instance
33+ ( ThrowAll (ToServant api (AsServerT m)) , GenericServant api (AsServerT m)) =>
34+ ThrowAll (api (AsServerT m)) where
35+
36+ throwAll = fromServant . throwAll
37+
2938-- Really this shouldn't be necessary - ((->) a) should be an instance of
3039-- MonadError, no?
3140instance {-# OVERLAPPING #-} ThrowAll b => ThrowAll (a -> b) where
servant-auth/servant-auth-server/test/Servant/Auth/ServerSpec.hs+7
@@ -50,6 +50,7 @@ import Network.Wreq (Options, auth, basicAuth,
5050import Network.Wreq.Types (Postable(..))
5151import Servant hiding (BasicAuth,
5252 IsSecure (..), header)
53+import Servant.API.Generic ((:-))
5354import Servant.Auth.Server
5455import Servant.Auth.Server.Internal.Cookie (expireTime)
5556import Servant.Auth.Server.SetCookieOrphan ()
@@ -405,6 +406,7 @@ type API auths
405406 = Auth auths User :>
406407 ( Get '[JSON] Int
407408 :<|> ReqBody '[JSON] Int :> Post '[JSON] Int
409+ :<|> NamedRoutes DummyRoutes
408410 :<|> "header" :> Get '[JSON] (Headers '[Header "Blah" Int] Int)
409411#if MIN_VERSION_servant_server(0,15,0)
410412 :<|> "stream" :> StreamGet NoFraming OctetStream (SourceIO BS.ByteString)
@@ -416,6 +418,10 @@ type API auths
416418 :<|> "logout" :> Get '[JSON] (Headers '[ Header "Set-Cookie" SetCookie
417419 , Header "Set-Cookie" SetCookie ] NoContent)
418420
421+data DummyRoutes mode = DummyRoutes
422+ { dummyInt :: mode :- "dummy" :> Get '[JSON] Int
423+ } deriving Generic
424+
419425jwtOnlyApi :: Proxy (API '[Servant.Auth.Server.JWT])
420426jwtOnlyApi = Proxy
421427
@@ -476,6 +482,7 @@ server ccfg =
476482 (\authResult -> case authResult of
477483 Authenticated usr -> getInt usr
478484 :<|> postInt usr
485+ :<|> DummyRoutes { dummyInt = getInt usr }
479486 :<|> getHeaderInt
480487#if MIN_VERSION_servant_server(0,15,0)
481488 :<|> return (S.source ["bytestring"])