Minor adjustments to AuthProtected to use with Delayed

servant/src/Servant/API/Authentication.hs

@@ -13,6 +13,7 @@ module Servant.API.Authentication
 , JWTAuth (..)
 , OnMissing (..)
 , OnUnauthenticated (..)
+, SAuthPolicy (..)
 ) where
 
 
@@ -28,6 +29,11 @@ import           Data.Text       (Text)
 --      when auth fails, we call the handlers with 'Nothing'.
 data AuthPolicy = Strict | Lax
 
+-- | Singleton types for AuthPolicy
+data SAuthPolicy (p :: AuthPolicy) where
+    SStrict :: SAuthPolicy 'Strict
+    SLax    :: SAuthPolicy 'Lax
+
 -- | the combinator to be used in API types
 data AuthProtect authdata usr (policy :: AuthPolicy)
 
@@ -40,40 +46,44 @@ data AuthProtect authdata usr (policy :: AuthPolicy)
 -- it is Strict, then api authors can specify how to handle the response.
 -- About the type parameters:
 -- m: the monad errors are retrned in. For now just IO.
--- e: an error type. For now just ServantErr.
+-- responseError: an error response type. For now just ServantErr.
 -- policy: the policy to handle OnMissing.
-data OnMissing m e (policy :: AuthPolicy) where
-    LaxMissing :: OnMissing m e 'Lax
-    StrictMissing :: m e -> OnMissing m e 'Strict
+-- errorIndex: an ADT representing possible errors encountered while extracting
+-- authentication data from a request.
+data OnMissing m responseError (policy :: AuthPolicy) errorIndex where
+    LaxMissing :: OnMissing m responseError 'Lax errorIndex
+    StrictMissing :: (errorIndex -> m responseError) -> OnMissing m responseError 'Strict errorIndex
 
 -- | A GADT indexed by policy strictness that encompasses the ways
 -- users will handle the case where the authentication data provided is
 -- rejected. I.e. a username and password do not match in the database.
 -- About the type parameters:
 -- m: the monad errors are returned in. For now just IO.
--- e: an error type. For now just ServantErr.
+-- responseError: an error response type. For now just ServantErr.
 -- authData: the authentication data extracted from the request
 -- errorIndex: an index of error to give a user-provided, semantic meaning to the authentication failure.
 -- policy: the policy to handle OnUnauthenticated actions.
-data OnUnauthenticated m e (policy :: AuthPolicy) errorIndex authData where
+data OnUnauthenticated m responseError (policy :: AuthPolicy) errorIndex authData where
     LaxUnauthenticated :: OnUnauthenticated m e 'Lax errorIndex authData
-    StrictUnauthenticated :: (errorIndex -> authData -> m e) -> OnUnauthenticated m e 'Strict errorIndex authData
+    StrictUnauthenticated :: (errorIndex -> authData -> m responseError)
+                          -> OnUnauthenticated m responseError 'Strict errorIndex authData
 
 -- | A GADT representing the data and functions required to protect a reasource for authentication.
 -- For an authenticated resource, we need to handle the scenario where authentication data is missing
 -- and where authentication data is present but not valid (e.g. uesrname + password not valid).
 -- m: the monad errors are retrned in. For now just IO.
--- e: an error type. For now just ServantErr.
--- missingPolicy: the policy to handle missing authentication data actions.
--- unauthPolicy: the policy to handle rejected authentication attempts.
+-- rError: an error response type. For now just ServantErr.
+-- mPolicy: Missing Auth: the policy to handle missing authentication data actions.
+-- mError: Missing Auth: ADT error index for possible missing auth failures
+-- uPolicy: Unauthenticated: the policy to handle rejected authentication attempts.
+-- uError: Unauthenticated: ADT error index for possible unauthentication failures
 -- authData: the type of authData present in a request (e.g. JWT token)
--- errorIndex: an index of error to give a user-provided, semantic meaning to the authentication failure.
 -- usr: a data type extracted from the authenticated data. This data is likely fetched from a database.
 -- subserver: the rest of the servant API.
-data AuthProtected m e (missingPolicy :: AuthPolicy) (unauthPolicy :: AuthPolicy) errorIndex authData usr subserver =
-    AuthProtected { onMissing :: OnMissing m e missingPolicy
-                  , onUnathenticated :: OnUnauthenticated m e unauthPolicy errorIndex authData
-                  , checkAuth :: authData -> m (Either errorIndex usr)
+data AuthProtected m rError (mPolicy :: AuthPolicy) mError (uPolicy :: AuthPolicy) uError authData usr subserver =
+    AuthProtected { onMissing :: OnMissing m rError mPolicy mError
+                  , onUnauthenticated :: OnUnauthenticated m rError uPolicy uError authData
+                  , checkAuth :: authData -> m (Either uError usr)
                   , subserver :: subserver
                   }