diff --git a/servant-client/src/Servant/Client.hs b/servant-client/src/Servant/Client.hs index ba5f7963..473ee2be 100644 --- a/servant-client/src/Servant/Client.hs +++ b/servant-client/src/Servant/Client.hs @@ -411,8 +411,8 @@ instance HasClient api => HasClient (IsSecure :> api) where clientWithRoute Proxy req baseurl manager = clientWithRoute (Proxy :: Proxy api) req baseurl manager -instance HasClient api => HasClient (BasicAuth tag realm usr :> api) where - type Client (BasicAuth tag realm usr :> api) = BasicAuthData -> Client api +instance HasClient api => HasClient (BasicAuth realm :> api) where + type Client (BasicAuth realm :> api) = BasicAuthData -> Client api clientWithRoute Proxy req baseurl manager val = clientWithRoute (Proxy :: Proxy api) (basicAuthReq val req) baseurl manager diff --git a/servant-client/test/Servant/ClientSpec.hs b/servant-client/test/Servant/ClientSpec.hs index b55d4a66..b517b6c3 100644 --- a/servant-client/test/Servant/ClientSpec.hs +++ b/servant-client/test/Servant/ClientSpec.hs @@ -150,12 +150,13 @@ failServer = serve failApi EmptyConfig ( -- auth stuff type AuthAPI = - BasicAuth "basic-tag" "foo-realm" () :> "private" :> "basic" :> Get '[JSON] Person + BasicAuth "foo-realm" :> "private" :> "basic" :> Get '[JSON] Person :<|> AuthProtect "auth-tag" :> "private" :> "auth" :> Get '[JSON] Person authAPI :: Proxy AuthAPI authAPI = Proxy +type instance AuthReturnType (BasicAuth "foo-realm") = () type instance AuthReturnType (AuthProtect "auth-tag") = () type instance AuthClientData (AuthProtect "auth-tag") = () @@ -176,10 +177,10 @@ authHandler = Just _ -> return () in mkAuthHandler handler -serverConfig :: Config '[ ConfigEntry "basic-tag" (BasicAuthCheck ()) - , ConfigEntry "auth-tag" (AuthHandler Request ()) +serverConfig :: Config '[ BasicAuthCheck () + , AuthHandler Request () ] -serverConfig = basicAuthHandler .:. authHandler .:. EmptyConfig +serverConfig = basicAuthHandler :. authHandler :. EmptyConfig authServer :: Application authServer = serve authAPI serverConfig (const (return alice) :<|> const (return alice)) @@ -358,7 +359,7 @@ authSpec = beforeAll (startWaiApp authServer) $ afterAll endWaiApp $ do data WrappedApi where WrappedApi :: (HasServer (api :: *), Server api ~ ExceptT ServantErr IO a - , HasCfg api '[], HasClient api + , HasConfig api '[], HasClient api , Client api ~ ExceptT ServantError IO ()) => Proxy api -> WrappedApi diff --git a/servant-docs/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs index 4703b0ec..199db9df 100644 --- a/servant-docs/src/Servant/Docs/Internal.hs +++ b/servant-docs/src/Servant/Docs/Internal.hs @@ -821,11 +821,11 @@ instance HasDocs sublayout => HasDocs (Vault :> sublayout) where docsFor Proxy ep = docsFor (Proxy :: Proxy sublayout) ep -instance (ToAuthInfo (BasicAuth tag realm usr), HasDocs sublayout) => HasDocs (BasicAuth tag realm usr :> sublayout) where +instance (ToAuthInfo (BasicAuth realm), HasDocs sublayout) => HasDocs (BasicAuth realm :> sublayout) where docsFor Proxy (endpoint, action) = docsFor (Proxy :: Proxy sublayout) (endpoint, action') where - authProxy = Proxy :: Proxy (BasicAuth tag realm usr) + authProxy = Proxy :: Proxy (BasicAuth realm) action' = over authInfo (|> toAuthInfo authProxy) action instance (ToAuthInfo (AuthProtect tag), HasDocs sublayout) => HasDocs (AuthProtect tag :> sublayout) where diff --git a/servant-examples/auth-combinator/auth-combinator.hs b/servant-examples/auth-combinator/auth-combinator.hs index d8531805..a882caa4 100644 --- a/servant-examples/auth-combinator/auth-combinator.hs +++ b/servant-examples/auth-combinator/auth-combinator.hs @@ -69,8 +69,8 @@ type instance AuthReturnType (AuthProtect "cookie-auth") = User -- | The configuration that will be made available to request handlers. We supply the -- "cookie-auth"-tagged request handler defined above, so that the 'HasServer' instance -- of 'AuthProtect' can extract the handler and run it on the request. -serverConfig :: Config (ConfigEntry "cookie-auth" (AuthHandler Request User) ': '[]) -serverConfig = authHandler .:. EmptyConfig +serverConfig :: Config (AuthHandler Request User ': '[]) +serverConfig = authHandler :. EmptyConfig -- | Our API, where we provide all the author-supplied handlers for each end point. -- note that 'prvdata' is a function that takes 'User' as an argument. We dont' worry diff --git a/servant-examples/basic-auth/basic-auth.hs b/servant-examples/basic-auth/basic-auth.hs index 4f3e6061..c409f6ca 100644 --- a/servant-examples/basic-auth/basic-auth.hs +++ b/servant-examples/basic-auth/basic-auth.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} module Main where @@ -13,8 +14,8 @@ import GHC.Generics (Generic) import Network.Wai.Handler.Warp (run) import Servant.API ((:<|>) ((:<|>)), (:>), BasicAuth, Get, JSON) -import Servant.Server (BasicAuthResult (Authorized, Unauthorized), Config (EmptyConfig), - ConfigEntry, Server, serve, (.:.), BasicAuthCheck(BasicAuthCheck)) +import Servant.Server (AuthReturnType, BasicAuthResult (Authorized, Unauthorized), Config ((:.), EmptyConfig), + Server, serve, BasicAuthCheck(BasicAuthCheck)) -- | let's define some types that our API returns. @@ -42,7 +43,7 @@ type PrivateAPI = Get '[JSON] PrivateData -- | our API type API = "public" :> PublicAPI - :<|> "private" :> BasicAuth "foo-tag" "foo-realm" User :> PrivateAPI + :<|> "private" :> BasicAuth "foo-realm" :> PrivateAPI -- | a value holding a proxy of our API type api :: Proxy API @@ -52,6 +53,9 @@ api = Proxy authRealm :: Proxy "foo-realm" authRealm = Proxy +-- | Specify the data type returned after performing basic authentication +type instance AuthReturnType (BasicAuth "foo-realm") = User + -- | 'BasicAuthCheck' holds the handler we'll use to verify a username and password. authCheck :: BasicAuthCheck User authCheck = @@ -65,8 +69,8 @@ authCheck = -- Basic Authentication requires a Config Entry with the 'BasicAuthCheck' value -- tagged with "foo-tag" This config is then supplied to 'server' and threaded -- to the BasicAuth HasServer handlers. -serverConfig :: Config (ConfigEntry "foo-tag" (BasicAuthCheck User) ': '[]) -serverConfig = authCheck .:. EmptyConfig +serverConfig :: Config (BasicAuthCheck User ': '[]) +serverConfig = authCheck :. EmptyConfig -- | 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 diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs index d712e783..3116b734 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/servant-server/src/Servant/Server/Internal.hs @@ -471,10 +471,10 @@ instance HasServer api => HasServer (HttpVersion :> api) where -- | Basic Authentication instance (KnownSymbol realm, HasServer api) - => HasServer (BasicAuth realm usr :> api) where - type ServerT (BasicAuth realm usr :> api) m = usr -> ServerT api m - type HasConfig (BasicAuth realm usr :> api) c - = (HasConfigEntry c (BasicAuthCheck usr), HasConfig api c) + => HasServer (BasicAuth realm :> api) where + type ServerT (BasicAuth realm :> api) m = AuthReturnType (BasicAuth realm) -> ServerT api m + type HasConfig (BasicAuth realm :> api) c + = (HasConfigEntry c (BasicAuthCheck (AuthReturnType (BasicAuth realm))), HasConfig api c) route Proxy config subserver = WithRequest $ \ request -> route (Proxy :: Proxy api) config (subserver `addAuthCheck` authCheck request) diff --git a/servant-server/test/Servant/ServerSpec.hs b/servant-server/test/Servant/ServerSpec.hs index a8794810..08748bb9 100644 --- a/servant-server/test/Servant/ServerSpec.hs +++ b/servant-server/test/Servant/ServerSpec.hs @@ -528,13 +528,14 @@ miscCombinatorSpec = with (return $ serve miscApi EmptyConfig miscServ) $ ------------------------------------------------------------------------------ -- * authspec {{{ ------------------------------------------------------------------------------ -type AuthAPI = BasicAuth "foo" () :> "basic" :> Get '[JSON] Animal +type AuthAPI = BasicAuth "foo" :> "basic" :> Get '[JSON] Animal :<|> AuthProtect "auth" :> "auth" :> Get '[JSON] Animal authApi :: Proxy AuthAPI authApi = Proxy authServer :: Server AuthAPI authServer = const (return jerry) :<|> const (return tweety) +type instance AuthReturnType (BasicAuth "foo") = () type instance AuthReturnType (AuthProtect "auth") = () authConfig :: Config '[ BasicAuthCheck ()