b3af5a8 · typeable/servant

servant-client/servant-client.cabal+1−1

compare with master

unifiedsplit

@@ -27,7 +27,7 @@ source-repository head

27library

28 exposed-modules:

29 Servant.Client

30− Servant.Common.Auth

30+ Servant.Client.Experimental.Auth

31 Servant.Common.BaseUrl

32 Servant.Common.BasicAuth

33 Servant.Common.Req

servant-client/src/Servant/Client.hs+1−1

@@ -39,7 +39,7 @@ import Network.HTTP.Media

39import qualified Network.HTTP.Types as H

40import qualified Network.HTTP.Types.Header as HTTP

41import Servant.API

42−import Servant.Common.Auth

42+import Servant.Client.Experimental.Auth

43import Servant.Common.BaseUrl

44import Servant.Common.BasicAuth

45import Servant.Common.Req

servant-client/src/Servant/Common/Auth.hs → servant-client/src/Servant/Client/Experimental/Auth.hsrenamed+1−1

@@ -4,7 +4,7 @@

4

5-- | Authentication for clients

6

7−module Servant.Common.Auth (

7+module Servant.Client.Experimental.Auth (

8 AuthenticateReq(AuthenticateReq, unAuthReq)

9 , AuthClientData

10 , mkAuthenticateReq

servant-client/test/Servant/ClientSpec.hs+7−6

@@ -55,6 +55,7 @@ import Servant.API

55import Servant.API.Internal.Test.ComprehensiveAPI

56import Servant.Client

57import Servant.Server

58+import Servant.Server.Experimental.Auth

58import qualified Servant.Common.Req as SCR

59import qualified Servant.Common.Req as SCR

59

60

60-- This declaration simply checks that all instances are in place.

61-- This declaration simply checks that all instances are in place.

@@ -169,11 +170,11 @@ basicAuthHandler =

169 else return Unauthorized

170 else return Unauthorized

170 in BasicAuthCheck check

171 in BasicAuthCheck check

171

172

172−serverContext :: Context '[ BasicAuthCheck () ]

173+basicServerContext :: Context '[ BasicAuthCheck () ]

173−serverContext = basicAuthHandler :. EmptyContext

174+basicServerContext = basicAuthHandler :. EmptyContext

174

175

175basicAuthServer :: Application

176basicAuthServer :: Application

176−basicAuthServer = serveWithContext basicAuthAPI serverContext (const (return alice))

177+basicAuthServer = serveWithContext basicAuthAPI basicServerContext (const (return alice))

177

178

178-- * general auth stuff

179-- * general auth stuff

179

180

@@ -193,11 +194,11 @@ genAuthHandler =

193 Just _ -> return ()

194 Just _ -> return ()

194 in mkAuthHandler handler

195 in mkAuthHandler handler

195

196

196−serverConfig :: Config '[ AuthHandler Request () ]

197+genAuthServerContext :: Context '[ AuthHandler Request () ]

197−serverConfig = genAuthHandler :. EmptyConfig

198+genAuthServerContext = genAuthHandler :. EmptyContext

198

199

199genAuthServer :: Application

200genAuthServer :: Application

200−genAuthServer = serve genAuthAPI serverConfig (const (return alice))

201+genAuthServer = serveWithContext genAuthAPI genAuthServerContext (const (return alice))

201

202

202{-# NOINLINE manager #-}

203{-# NOINLINE manager #-}

203manager :: C.Manager

204manager :: C.Manager

servant-examples/auth-combinator/auth-combinator.hs+1

@@ -20,6 +20,7 @@ import GHC.Generics

20import Network.Wai

21import Network.Wai.Handler.Warp

22import Servant

23+import Servant.Server.Experimental.Auth

23

24

24-- | This file contains an authenticated server using servant's generalized

25-- | This file contains an authenticated server using servant's generalized

25-- authentication support. Our basic authentication scheme is trivial: we

26-- authentication support. Our basic authentication scheme is trivial: we

servant-server/servant-server.cabal+2−2

@@ -36,10 +36,10 @@ library

36 exposed-modules:

37 Servant

38 Servant.Server

39+ Servant.Server.Experimental.Auth

39 Servant.Server.Internal

40 Servant.Server.Internal

40− Servant.Server.Internal.Context

41− Servant.Server.Internal.Auth

42 Servant.Server.Internal.BasicAuth

41 Servant.Server.Internal.BasicAuth

42+ Servant.Server.Internal.Context

43 Servant.Server.Internal.Enter

44 Servant.Server.Internal.Router

45 Servant.Server.Internal.RoutingApplication

servant-server/src/Servant/Server.hs+3−3

@@ -50,9 +50,9 @@ module Servant.Server

50 , BasicAuthResult(..)

51

52 -- * General Authentication

53− , AuthHandler(unAuthHandler)

53+ -- , AuthHandler(unAuthHandler)

54− , AuthServerData

54+ -- , AuthServerData

55− , mkAuthHandler

55+ -- , mkAuthHandler

56

57 -- * Default error type

58 , ServantErr(..)

servant-server/src/Servant/Server/Experimental/Auth.hsnew file+66

@@ -0,0 +1,66 @@

1+{-# OPTIONS_GHC -fno-warn-orphans #-}

2+{-# LANGUAGE DeriveGeneric #-}

3+{-# LANGUAGE DeriveDataTypeable #-}

4+{-# LANGUAGE FlexibleContexts #-}

5+{-# LANGUAGE FlexibleInstances #-}

6+{-# LANGUAGE MultiParamTypeClasses #-}

7+{-# LANGUAGE PolyKinds #-}

8+{-# LANGUAGE ScopedTypeVariables #-}

9+{-# LANGUAGE TypeFamilies #-}

10+{-# LANGUAGE TypeOperators #-}

11+{-# LANGUAGE UndecidableInstances #-}

12+

13+module Servant.Server.Experimental.Auth where

14+

15+import Control.Monad.Trans.Except (ExceptT,

16+ runExceptT)

17+import Data.Proxy (Proxy (Proxy))

18+import Data.Typeable (Typeable)

19+import GHC.Generics (Generic)

20+import Network.Wai (Request)

21+

22+import Servant ((:>))

23+import Servant.API.Experimental.Auth

24+import Servant.Server.Internal (HasContextEntry,

25+ HasServer, ServerT,

26+ getContextEntry,

27+ route)

28+import Servant.Server.Internal.Router (Router' (WithRequest))

29+import Servant.Server.Internal.RoutingApplication (RouteResult (FailFatal, Route),

30+ addAuthCheck)

31+import Servant.Server.Internal.ServantErr (ServantErr)

32+

33+-- * General Auth

34+

35+-- | Specify the type of data returned after we've authenticated a request.

36+-- quite often this is some `User` datatype.

37+--

38+-- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE

39+type family AuthServerData a :: *

40+

41+-- | Handlers for AuthProtected resources

42+--

43+-- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE

44+newtype AuthHandler r usr = AuthHandler

45+ { unAuthHandler :: r -> ExceptT ServantErr IO usr }

46+ deriving (Generic, Typeable)

47+

48+-- | NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE

49+mkAuthHandler :: (r -> ExceptT ServantErr IO usr) -> AuthHandler r usr

50+mkAuthHandler = AuthHandler

51+

52+-- | Known orphan instance.

53+instance ( HasServer api context

54+ , HasContextEntry context (AuthHandler Request (AuthServerData (AuthProtect tag)))

55+ )

56+ => HasServer (AuthProtect tag :> api) context where

57+

58+ type ServerT (AuthProtect tag :> api) m =

59+ AuthServerData (AuthProtect tag) -> ServerT api m

60+

61+ route Proxy context subserver = WithRequest $ \ request ->

62+ route (Proxy :: Proxy api) context (subserver `addAuthCheck` authCheck request)

63+ where

64+ authHandler = unAuthHandler (getContextEntry context)

65+ authCheck = fmap (either FailFatal Route) . runExceptT . authHandler

66+

servant-server/src/Servant/Server/Internal.hs+2−20

@@ -10,13 +10,11 @@

10{-# LANGUAGE ScopedTypeVariables #-}

11{-# LANGUAGE TypeFamilies #-}

12{-# LANGUAGE TypeOperators #-}

13−{-# LANGUAGE UndecidableInstances #-}

14

13

15#include "overlapping-compat.h"

14#include "overlapping-compat.h"

16

15

17module Servant.Server.Internal

16module Servant.Server.Internal

18 ( module Servant.Server.Internal

17 ( module Servant.Server.Internal

19− , module Servant.Server.Internal.Auth

20 , module Servant.Server.Internal.Context

18 , module Servant.Server.Internal.Context

21 , module Servant.Server.Internal.BasicAuth

19 , module Servant.Server.Internal.BasicAuth

22 , module Servant.Server.Internal.Router

20 , module Servant.Server.Internal.Router

@@ -27,7 +25,7 @@ module Servant.Server.Internal

27#if !MIN_VERSION_base(4,8,0)

25#if !MIN_VERSION_base(4,8,0)

28import Control.Applicative ((<$>))

26import Control.Applicative ((<$>))

29#endif

27#endif

30−import Control.Monad.Trans.Except (ExceptT, runExceptT)

28+import Control.Monad.Trans.Except (ExceptT)

31import qualified Data.ByteString as B

29import qualified Data.ByteString as B

32import qualified Data.ByteString.Char8 as BC8

30import qualified Data.ByteString.Char8 as BC8

33import qualified Data.ByteString.Lazy as BL

31import qualified Data.ByteString.Lazy as BL

@@ -52,7 +50,7 @@ import Web.HttpApiData.Internal (parseHeaderMaybe,

52 parseQueryParamMaybe,

50 parseQueryParamMaybe,

53 parseUrlPieceMaybe)

51 parseUrlPieceMaybe)

54

52

55−import Servant.API ((:<|>) (..), (:>), AuthProtect, BasicAuth, Capture,

53+import Servant.API ((:<|>) (..), (:>), BasicAuth, Capture,

56 Verb, ReflectMethod(reflectMethod),

54 Verb, ReflectMethod(reflectMethod),

57 IsSecure(..), Header,

55 IsSecure(..), Header,

58 QueryFlag, QueryParam, QueryParams,

56 QueryFlag, QueryParam, QueryParams,

@@ -66,7 +64,6 @@ import Servant.API.ContentTypes (AcceptHeader (..),

66import Servant.API.ResponseHeaders (GetHeaders, Headers, getHeaders,

64import Servant.API.ResponseHeaders (GetHeaders, Headers, getHeaders,

67 getResponse)

65 getResponse)

68

66

69−import Servant.Server.Internal.Auth

70import Servant.Server.Internal.Context

67import Servant.Server.Internal.Context

71import Servant.Server.Internal.BasicAuth

68import Servant.Server.Internal.BasicAuth

72import Servant.Server.Internal.Router

69import Servant.Server.Internal.Router

@@ -456,8 +453,6 @@ instance HasServer api context => HasServer (HttpVersion :> api) context where

456 route Proxy context subserver = WithRequest $ \req ->

453 route Proxy context subserver = WithRequest $ \req ->

457 route (Proxy :: Proxy api) context (passToServer subserver $ httpVersion req)

454 route (Proxy :: Proxy api) context (passToServer subserver $ httpVersion req)

458

455

459−-- * Basic Authentication

460−

461-- | Basic Authentication

456-- | Basic Authentication

462instance ( KnownSymbol realm

457instance ( KnownSymbol realm

463 , HasServer api context

458 , HasServer api context

@@ -487,19 +482,6 @@ ct_wildcard = "*" <> "/" <> "*" -- Because CPP

487

482

488-- * General Authentication

483-- * General Authentication

489

484

490−instance ( HasServer api context

491− , HasContextEntry context (AuthHandler Request (AuthServerData (AuthProtect tag)))

492− )

493− => HasServer (AuthProtect tag :> api) context where

494−

495− type ServerT (AuthProtect tag :> api) m =

496− AuthServerData (AuthProtect tag) -> ServerT api m

497−

498− route Proxy context subserver = WithRequest $ \ request ->

499− route (Proxy :: Proxy api) context (subserver `addAuthCheck` authCheck request)

500− where

501− authHandler = unAuthHandler (getContextEntry context)

502− authCheck = fmap (either FailFatal Route) . runExceptT . authHandler

503

485

504-- * contexts

486-- * contexts

505

487

servant-server/src/Servant/Server/Internal/Auth.hsdeleted−32

@@ -1,32 +0,0 @@

1−{-# LANGUAGE DeriveDataTypeable #-}

2−{-# LANGUAGE DeriveFunctor #-}

3−{-# LANGUAGE DeriveGeneric #-}

4−{-# LANGUAGE OverloadedStrings #-}

5−{-# LANGUAGE TypeFamilies #-}

6−

7−module Servant.Server.Internal.Auth where

8−

9−import Control.Monad.Trans.Except (ExceptT)

10−import Data.Typeable (Typeable)

11−import GHC.Generics (Generic)

12−

13−import Servant.Server.Internal.ServantErr (ServantErr)

14−

15−-- * General Auth

16−

17−-- | Specify the type of data returned after we've authenticated a request.

18−-- quite often this is some `User` datatype.

19−--

20−-- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE

21−type family AuthServerData a :: *

22−

23−-- | Handlers for AuthProtected resources

24−--

25−-- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE

26−newtype AuthHandler r usr = AuthHandler

27− { unAuthHandler :: r -> ExceptT ServantErr IO usr }

28− deriving (Generic, Typeable)

29−

30−-- | NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE

31−mkAuthHandler :: (r -> ExceptT ServantErr IO usr) -> AuthHandler r usr

32−mkAuthHandler = AuthHandler

servant-server/test/Servant/ServerSpec.hs+2−2

@@ -49,7 +49,7 @@ import Servant.API ((:<|>) (..), (:>), AuthProtect,

49 Raw, RemoteHost, ReqBody,

50 StdMethod (..), Verb, addHeader)

51import Servant.API.Internal.Test.ComprehensiveAPI

52−import Servant.Server (ServantErr (..), Server, err404,

52+import Servant.Server (ServantErr (..), Server, err401, err404,

53 serve, serveWithContext, Context((:.), EmptyContext))

54import Test.Hspec (Spec, context, describe, it,

55 shouldBe, shouldContain)

@@ -60,7 +60,7 @@ import Test.Hspec.Wai (get, liftIO, matchHeaders,

60

61import Servant.Server.Internal.BasicAuth (BasicAuthCheck(BasicAuthCheck),

62 BasicAuthResult(Authorized,Unauthorized))

63−import Servant.Server.Internal.Auth

63+import Servant.Server.Experimental.Auth

64 (AuthHandler, AuthServerData,

65 mkAuthHandler)

66import Servant.Server.Internal.RoutingApplication

servant/servant.cabal+1−1

@@ -30,6 +30,7 @@ library

30 Servant.API.BasicAuth

31 Servant.API.Capture

32 Servant.API.ContentTypes

33+ Servant.API.Experimental.Auth

33 Servant.API.Header

34 Servant.API.Header

34 Servant.API.HttpVersion

35 Servant.API.HttpVersion

35 Servant.API.Internal.Test.ComprehensiveAPI

36 Servant.API.Internal.Test.ComprehensiveAPI

@@ -43,7 +44,6 @@ library

43 Servant.API.Vault

44 Servant.API.Vault

44 Servant.API.Verbs

45 Servant.API.Verbs

45 Servant.API.WithNamedContext

46 Servant.API.WithNamedContext

46− Servant.API.Experimental.Auth

47 Servant.Utils.Links

48 build-depends:

49 base >=4.7 && <5

servant/src/Servant/API.hs+6−4

@@ -40,9 +40,6 @@ module Servant.API (

40 -- * Response Headers

41 module Servant.API.ResponseHeaders,

42

43− -- * General Authentication

44− module Servant.API.Auth,

45−

46 -- * Untyped endpoints

43 -- * Untyped endpoints

47 module Servant.API.Raw,

44 module Servant.API.Raw,

48 -- | Plugging in a wai 'Network.Wai.Application', serving directories

45 -- | Plugging in a wai 'Network.Wai.Application', serving directories

@@ -51,6 +48,11 @@ module Servant.API (

51 module Web.HttpApiData,

48 module Web.HttpApiData,

52 -- | Classes and instances for types that can be converted to and from HTTP API data.

49 -- | Classes and instances for types that can be converted to and from HTTP API data.

53

50

51+

52+ -- * Experimental modules

53+ module Servant.API.Experimental.Auth,

54+ -- | General Authentication

55+

54 -- * Utilities

56 -- * Utilities

55 module Servant.Utils.Links,

57 module Servant.Utils.Links,

56 -- | Type-safe internal URIs

58 -- | Type-safe internal URIs

@@ -58,13 +60,13 @@ module Servant.API (

58

60

59import Servant.API.Alternative ((:<|>) (..))

61import Servant.API.Alternative ((:<|>) (..))

60import Servant.API.BasicAuth (BasicAuth,BasicAuthData(..))

62import Servant.API.BasicAuth (BasicAuth,BasicAuthData(..))

61−import Servant.API.Auth (AuthProtect)

62import Servant.API.Capture (Capture)

63import Servant.API.Capture (Capture)

63import Servant.API.ContentTypes (Accept (..), FormUrlEncoded,

64import Servant.API.ContentTypes (Accept (..), FormUrlEncoded,

64 FromFormUrlEncoded (..), JSON,

65 FromFormUrlEncoded (..), JSON,

65 MimeRender (..), NoContent (NoContent),

66 MimeRender (..), NoContent (NoContent),

66 MimeUnrender (..), OctetStream,

67 MimeUnrender (..), OctetStream,

67 PlainText, ToFormUrlEncoded (..))

68 PlainText, ToFormUrlEncoded (..))

69+import Servant.API.Experimental.Auth (AuthProtect)

68import Servant.API.Header (Header (..))

70import Servant.API.Header (Header (..))

69import Servant.API.HttpVersion (HttpVersion (..))

71import Servant.API.HttpVersion (HttpVersion (..))

70import Servant.API.IsSecure (IsSecure (..))

72import Servant.API.IsSecure (IsSecure (..))

servant/src/Servant/Experimental/API/Auth.hs → servant/src/Servant/API/Experimental/Auth.hsrenamed+1−1

@@ -2,7 +2,7 @@

2{-# LANGUAGE DeriveDataTypeable #-}

3{-# LANGUAGE KindSignatures #-}

4{-# LANGUAGE PolyKinds #-}

5−module Servant.API.Auth where

5+module Servant.API.Experimental.Auth where

6

7import Data.Typeable (Typeable)

8