Remove servant-server specific type from AuthProtect

the 'user' type is valid only for servant-server, so lets move it out of
the combinator. This means we need to use type families when
implementing the server.

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

@@ -20,6 +20,7 @@ import           Servant
 -- performing authentication
 newtype User = User { unUser :: Text }
 
+
 -- | A method that, when given a password, will return a User.
 -- This is our bespoke (and bad) authentication logic.
 lookupUser :: ByteString -> ExceptT ServantErr IO User
@@ -55,13 +56,16 @@ type PrivateAPI = Get '[JSON] [PrivateData]
 type PublicAPI = Get '[JSON] [PublicData]
 
 -- | Our API, with auth-protection
-type API = "private" :> AuthProtect "cookie-auth" User :> PrivateAPI
+type API = "private" :> AuthProtect "cookie-auth" :> PrivateAPI
       :<|> "public"  :> PublicAPI
 
 -- | A value holding our type-level API
 api :: Proxy API
 api = Proxy
 
+-- | We need to specify the data returned after authentication
+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.

servant-server/src/Servant/Server.hs

@@ -42,6 +42,7 @@ module Servant.Server
 
   -- * General Authentication
   , AuthHandler(unAuthHandler)
+  , AuthReturnType
   , mkAuthHandler
 
   -- * Basic Authentication

servant-server/src/Servant/Server/Internal.hs

@@ -497,10 +497,10 @@ instance (KnownSymbol realm, HasServer api)
        authCheck req = runBasicAuth req realm baCfg
 
 -- | General Authentication
-instance HasServer api => HasServer (AuthProtect tag usr :> api) where
-  type ServerT (AuthProtect tag usr :> api) m = usr -> ServerT api m
-  type HasCfg (AuthProtect tag usr :> api) c
-    = (HasConfigEntry c tag (AuthHandler Request usr), HasCfg api c)
+instance HasServer api => HasServer (AuthProtect tag :> api) where
+  type ServerT (AuthProtect tag :> api) m = AuthReturnType (AuthProtect tag) -> ServerT api m
+  type HasCfg (AuthProtect tag :> api) c
+    = (HasConfigEntry c tag (AuthHandler Request (AuthReturnType (AuthProtect tag))), HasCfg api c)
 
   route Proxy cfg subserver = WithRequest $ \ request ->
     route (Proxy :: Proxy api) cfg (subserver `addAuthCheck` authCheck request)

servant-server/src/Servant/Server/Internal/Auth.hs

@@ -1,6 +1,8 @@
 {-# LANGUAGE DeriveFunctor     #-}
 {-# LANGUAGE DeriveGeneric     #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies      #-}
+
 module Servant.Server.Internal.Auth where
 
 import           Control.Monad          (guard)
@@ -19,6 +21,10 @@ import Servant.Server.Internal.ServantErr
 
 -- * General Auth
 
+-- | Specify the type of data returned after we've authenticated a request.
+-- quite often this is some `User` datatype.
+type family AuthReturnType a :: *
+
 -- | Handlers for AuthProtected resources
 newtype AuthHandler r usr = AuthHandler
   { unAuthHandler :: r -> ExceptT ServantErr IO usr }

servant/src/Servant/API/Auth.hs

@@ -21,5 +21,5 @@ data BasicAuth (tag :: k) (realm :: Symbol) (usr :: *)
   deriving (Typeable)
 
 -- | A generalized Authentication combinator.
-data AuthProtect (tag :: k) (usr :: *)
+data AuthProtect (tag :: k)
   deriving (Typeable)