bd9151b · servant · git.iko.soy

git.iko.soy/servant

on master help sign in

servant-auth-server: Support NamedRoutes

bd9151bGaël Deest5 years ago

servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/AddSetCookie.hs+12

compare with master

unifiedsplit

@@ -11,6 +11,8 @@ import Data.Tagged (Tagged (..))

11import qualified Network.HTTP.Types as HTTP

12import Network.Wai (mapResponseHeaders)

13import Servant

14+import Servant.API.Generic

15+import Servant.Server.Generic

14import Web.Cookie

16import Web.Cookie

16-- What are we doing here? Well, the idea is to add headers to the response,

18-- What are we doing here? Well, the idea is to add headers to the response,

@@ -34,6 +36,7 @@ type family AddSetCookieApiVerb a where

34type family AddSetCookieApi a :: *

36type family AddSetCookieApi a :: *

35type instance AddSetCookieApi (a :> b) = a :> AddSetCookieApi b

37type instance AddSetCookieApi (a :> b) = a :> AddSetCookieApi b

36type instance AddSetCookieApi (a :<|> b) = AddSetCookieApi a :<|> AddSetCookieApi b

38type instance AddSetCookieApi (a :<|> b) = AddSetCookieApi a :<|> AddSetCookieApi b

39+type instance AddSetCookieApi (NamedRoutes api) = AddSetCookieApi (ToServantApi api)

37type instance AddSetCookieApi (Verb method stat ctyps a)

40type instance AddSetCookieApi (Verb method stat ctyps a)

38 = Verb method stat ctyps (AddSetCookieApiVerb a)

41 = Verb method stat ctyps (AddSetCookieApiVerb a)

39type instance AddSetCookieApi Raw = Raw

42type instance AddSetCookieApi Raw = Raw

@@ -72,6 +75,15 @@ instance {-# OVERLAPS #-}

72 => AddSetCookies ('S n) (a :<|> b) (a' :<|> b') where

75 => AddSetCookies ('S n) (a :<|> b) (a' :<|> b') where

73 addSetCookies cookies (a :<|> b) = addSetCookies cookies a :<|> addSetCookies cookies b

76 addSetCookies cookies (a :<|> b) = addSetCookies cookies a :<|> addSetCookies cookies b

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+

75-- | for @servant <0.11@

87-- | for @servant <0.11@

76instance

88instance

77 AddSetCookies ('S n) Application Application where

89 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

9import Control.Monad.Error.Class

10import 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

12import Network.HTTP.Types

15import Network.HTTP.Types

13import Network.Wai

16import Network.Wai

@@ -26,6 +29,12 @@ class ThrowAll a where

26instance (ThrowAll a, ThrowAll b) => ThrowAll (a :<|> b) where

29instance (ThrowAll a, ThrowAll b) => ThrowAll (a :<|> b) where

27 throwAll e = throwAll e :<|> throwAll e

30 throwAll e = throwAll e :<|> throwAll e

32+instance

33+ ( ThrowAll (ToServant api (AsServerT m)) , GenericServant api (AsServerT m)) =>

34+ ThrowAll (api (AsServerT m)) where

35+

36+ throwAll = fromServant . throwAll

37+

29-- Really this shouldn't be necessary - ((->) a) should be an instance of

38-- Really this shouldn't be necessary - ((->) a) should be an instance of

30-- MonadError, no?

39-- MonadError, no?

31instance {-# OVERLAPPING #-} ThrowAll b => ThrowAll (a -> b) where

40instance {-# 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,

50import Network.Wreq.Types (Postable(..))

51import Servant hiding (BasicAuth,

52 IsSecure (..), header)

53+import Servant.API.Generic ((:-))

53import Servant.Auth.Server

54import Servant.Auth.Server

54import Servant.Auth.Server.Internal.Cookie (expireTime)

55import Servant.Auth.Server.Internal.Cookie (expireTime)

55import Servant.Auth.Server.SetCookieOrphan ()

56import Servant.Auth.Server.SetCookieOrphan ()

@@ -405,6 +406,7 @@ type API auths

405 = Auth auths User :>

406 = Auth auths User :>

406 ( Get '[JSON] Int

407 ( Get '[JSON] Int

407 :<|> ReqBody '[JSON] Int :> Post '[JSON] Int

408 :<|> ReqBody '[JSON] Int :> Post '[JSON] Int

409+ :<|> NamedRoutes DummyRoutes

408 :<|> "header" :> Get '[JSON] (Headers '[Header "Blah" Int] Int)

410 :<|> "header" :> Get '[JSON] (Headers '[Header "Blah" Int] Int)

409#if MIN_VERSION_servant_server(0,15,0)

411#if MIN_VERSION_servant_server(0,15,0)

410 :<|> "stream" :> StreamGet NoFraming OctetStream (SourceIO BS.ByteString)

412 :<|> "stream" :> StreamGet NoFraming OctetStream (SourceIO BS.ByteString)

@@ -416,6 +418,10 @@ type API auths

416 :<|> "logout" :> Get '[JSON] (Headers '[ Header "Set-Cookie" SetCookie

418 :<|> "logout" :> Get '[JSON] (Headers '[ Header "Set-Cookie" SetCookie

417 , Header "Set-Cookie" SetCookie ] NoContent)

419 , Header "Set-Cookie" SetCookie ] NoContent)

418

420

421+data DummyRoutes mode = DummyRoutes

422+ { dummyInt :: mode :- "dummy" :> Get '[JSON] Int

423+ } deriving Generic

424+

419jwtOnlyApi :: Proxy (API '[Servant.Auth.Server.JWT])

425jwtOnlyApi :: Proxy (API '[Servant.Auth.Server.JWT])

420jwtOnlyApi = Proxy

426jwtOnlyApi = Proxy

421

427

@@ -476,6 +482,7 @@ server ccfg =

476 (\authResult -> case authResult of

482 (\authResult -> case authResult of

477 Authenticated usr -> getInt usr

483 Authenticated usr -> getInt usr

478 :<|> postInt usr

484 :<|> postInt usr

485+ :<|> DummyRoutes { dummyInt = getInt usr }

479 :<|> getHeaderInt

486 :<|> getHeaderInt

480#if MIN_VERSION_servant_server(0,15,0)

487#if MIN_VERSION_servant_server(0,15,0)

481 :<|> return (S.source ["bytestring"])

488 :<|> return (S.source ["bytestring"])