From 546adc391a2699063d76f2e5f5b18498f1415e85 Mon Sep 17 00:00:00 2001 From: aaron levin Date: Tue, 8 Mar 2016 23:28:27 +0100 Subject: [PATCH] basic-auth: config -> context --- servant-client/test/Servant/ClientSpec.hs | 6 +++--- servant-examples/basic-auth/basic-auth.hs | 16 ++++++++-------- servant-server/src/Servant/Server/Internal.hs | 14 +++++++------- servant-server/test/Servant/Server/ErrorSpec.hs | 8 ++++---- servant-server/test/Servant/ServerSpec.hs | 2 +- 5 files changed, 23 insertions(+), 23 deletions(-) diff --git a/servant-client/test/Servant/ClientSpec.hs b/servant-client/test/Servant/ClientSpec.hs index b6237b0e..4b6ccbb9 100644 --- a/servant-client/test/Servant/ClientSpec.hs +++ b/servant-client/test/Servant/ClientSpec.hs @@ -166,11 +166,11 @@ basicAuthHandler = else return Unauthorized in BasicAuthCheck check -serverConfig :: Config '[ BasicAuthCheck () ] -serverConfig = basicAuthHandler :. EmptyConfig +serverContext :: Context '[ BasicAuthCheck () ] +serverContext = basicAuthHandler :. EmptyContext basicAuthServer :: Application -basicAuthServer = serveWithConfig basicAuthAPI serverConfig (const (return alice)) +basicAuthServer = serveWithContext basicAuthAPI serverContext (const (return alice)) {-# NOINLINE manager #-} manager :: C.Manager diff --git a/servant-examples/basic-auth/basic-auth.hs b/servant-examples/basic-auth/basic-auth.hs index 208edbb1..cedd4694 100644 --- a/servant-examples/basic-auth/basic-auth.hs +++ b/servant-examples/basic-auth/basic-auth.hs @@ -18,8 +18,8 @@ import Servant.Server (BasicAuthCheck (BasicAuthCheck), BasicAuthResult( Authorized , Unauthorized ), - Config ((:.), EmptyConfig), Server, - serveWithConfig) + Context ((:.), EmptyContext), Server, + serveWithContext) -- | let's define some types that our API returns. @@ -62,12 +62,12 @@ authCheck = else return Unauthorized in BasicAuthCheck check --- | We need to supply our handlers with the right configuration. In this case, --- Basic Authentication requires a Config Entry with the 'BasicAuthCheck' value --- tagged with "foo-tag" This config is then supplied to 'server' and threaded +-- | We need to supply our handlers with the right Context. In this case, +-- Basic Authentication requires a Context Entry with the 'BasicAuthCheck' value +-- tagged with "foo-tag" This context is then supplied to 'server' and threaded -- to the BasicAuth HasServer handlers. -serverConfig :: Config (BasicAuthCheck User ': '[]) -serverConfig = authCheck :. EmptyConfig +serverContext :: Context (BasicAuthCheck User ': '[]) +serverContext = authCheck :. EmptyContext -- | an implementation of our server. Here is where we pass all the handlers to our endpoints. -- In particular, for the BasicAuth protected handler, we need to supply a function @@ -80,7 +80,7 @@ server = -- | hello, server! main :: IO () -main = run 8080 (serveWithConfig api serverConfig server) +main = run 8080 (serveWithContext api serverContext server) {- Sample session diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs index bdf7451f..ea89b0a0 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/servant-server/src/Servant/Server/Internal.hs @@ -457,19 +457,19 @@ instance HasServer api context => HasServer (HttpVersion :> api) context where -- | Basic Authentication instance ( KnownSymbol realm - , HasServer api config - , HasConfigEntry config (BasicAuthCheck usr) + , HasServer api context + , HasContextEntry context (BasicAuthCheck usr) ) - => HasServer (BasicAuth realm usr :> api) config where + => HasServer (BasicAuth realm usr :> api) context where type ServerT (BasicAuth realm usr :> api) m = usr -> ServerT api m - route Proxy config subserver = WithRequest $ \ request -> - route (Proxy :: Proxy api) config (subserver `addAuthCheck` authCheck request) + route Proxy context subserver = WithRequest $ \ request -> + route (Proxy :: Proxy api) context (subserver `addAuthCheck` authCheck request) where realm = BC8.pack $ symbolVal (Proxy :: Proxy realm) - basicAuthConfig = getConfigEntry config - authCheck req = runBasicAuth req realm basicAuthConfig + basicAuthContext = getContextEntry context + authCheck req = runBasicAuth req realm basicAuthContext -- * helpers diff --git a/servant-server/test/Servant/Server/ErrorSpec.hs b/servant-server/test/Servant/Server/ErrorSpec.hs index 3dce641d..96d2df6f 100644 --- a/servant-server/test/Servant/Server/ErrorSpec.hs +++ b/servant-server/test/Servant/Server/ErrorSpec.hs @@ -56,8 +56,8 @@ errorOrderServer = \_ _ _ -> throwE err402 errorOrderSpec :: Spec errorOrderSpec = describe "HTTP error order" $ - with (return $ serveWithConfig errorOrderApi - (errorOrderAuthCheck :. EmptyConfig) + with (return $ serveWithContext errorOrderApi + (errorOrderAuthCheck :. EmptyContext) errorOrderServer ) $ do let badContentType = (hContentType, "text/plain") @@ -183,8 +183,8 @@ errorRetryServer errorRetrySpec :: Spec errorRetrySpec = describe "Handler search" $ - with (return $ serveWithConfig errorRetryApi - (errorOrderAuthCheck :. EmptyConfig) + with (return $ serveWithContext errorRetryApi + (errorOrderAuthCheck :. EmptyContext) errorRetryServer ) $ do diff --git a/servant-server/test/Servant/ServerSpec.hs b/servant-server/test/Servant/ServerSpec.hs index 763a16e2..0524a11a 100644 --- a/servant-server/test/Servant/ServerSpec.hs +++ b/servant-server/test/Servant/ServerSpec.hs @@ -65,7 +65,7 @@ import Servant.Server.Internal.Router (tweakResponse, runRouter, Router, Router'(LeafRouter)) import Servant.Server.Internal.Context - (Context(..), NamedContext(..)) + (NamedContext(..)) -- * comprehensive api test