From 58ed6d094368760712cdb217121a3d7822eb4f35 Mon Sep 17 00:00:00 2001
From: aaron levin <aaron.levin@soundcloud.com>
Date: Wed, 23 Dec 2015 23:32:34 +0100
Subject: [PATCH] Revert to GADT-based AuthProtect data type

---
 servant/src/Servant/API/Authentication.hs | 48 ++++++++++++++++++++++-
 1 file changed, 46 insertions(+), 2 deletions(-)

diff --git a/servant/src/Servant/API/Authentication.hs b/servant/src/Servant/API/Authentication.hs
index 6262350e..8efd6d97 100644
--- a/servant/src/Servant/API/Authentication.hs
+++ b/servant/src/Servant/API/Authentication.hs
@@ -1,15 +1,18 @@
 {-# LANGUAGE DataKinds          #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE GADTs              #-}
 {-# LANGUAGE KindSignatures     #-}
 {-# LANGUAGE PolyKinds          #-}
 {-# LANGUAGE TypeFamilies       #-}
 {-# OPTIONS_HADDOCK not-home    #-}
 module Servant.API.Authentication
 ( AuthPolicy (..)
-, AuthProtect (..)
+, AuthProtect
 , AuthProtected (..)
 , BasicAuth (..)
 , JWTAuth (..)
+, OnMissing (..)
+, OnUnauthenticated (..)
 ) where
 
 
@@ -30,7 +33,48 @@ data AuthProtect authdata usr (policy :: AuthPolicy)
 
 -- | what we'll ask user to provide at the server-level when we see a
 -- 'AuthProtect' combinator in an API type
-data family AuthProtected authdata usr subserver :: AuthPolicy -> *
+-- data family AuthProtected authdata usr subserver :: AuthPolicy -> *
+
+-- | A GADT indexed by policy strictness that encompasses the ways
+-- users will handle the case where authentication data is missing
+-- from a request. For example, suppose we have a Basic-Auth-protected
+-- resource and no appropriate headers are present in the request. Then
+-- the specified 'OnMissing' will be used. In the case it is Lax, then
+-- the servant framework will issue a generalized response. In the case
+-- 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.
+-- 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
+
+-- | 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.
+-- policy: the policy to handle OnUnauthenticated actions.
+data OnUnauthenticated m e authData (policy :: AuthPolicy) where
+    LaxUnauthenticated :: OnUnauthenticated m e authData 'Lax
+    StrictUnauthenticated :: (authData -> m e) -> OnUnauthenticated m e authData 'Strict
+
+-- | 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.
+-- authData: the type of authData present in a request (e.g. JWT token)
+-- subserver: the rest of the servant API.
+data AuthProtected m e (missingPolicy :: AuthPolicy) (unauthPolicy :: AuthPolicy) authData subserver =
+    AuthProtected { onMissing :: OnMissing m e missingPolicy
+                  , onUnathenticated :: OnUnauthenticated m e authData unauthPolicy
+                  , subserver :: subserver
+                  }
 
 -- | Basic Authentication with respect to a specified @realm@ and a @lookup@
 -- type to encapsulate authentication logic.