From 297f5743ec8791d417e82fa22f16559cd2ff55c6 Mon Sep 17 00:00:00 2001
From: Arian van Putten <aeroboy94@gmail.com>
Date: Thu, 1 Oct 2015 14:36:11 +0200
Subject: [PATCH] Change JSON to be the bearing type of JWT auth.

This way both client and server can be the same API type.
---
 servant-client/src/Servant/Client/Authentication.hs |  7 +++++++
 .../src/Servant/Server/Internal/Authentication.hs   | 13 +++++++------
 2 files changed, 14 insertions(+), 6 deletions(-)

diff --git a/servant-client/src/Servant/Client/Authentication.hs b/servant-client/src/Servant/Client/Authentication.hs
index 083fb0ed..9a9994bb 100644
--- a/servant-client/src/Servant/Client/Authentication.hs
+++ b/servant-client/src/Servant/Client/Authentication.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeSynonymInstances #-}
 
 -- | Authentication for clients
 
@@ -8,6 +9,7 @@ module Servant.Client.Authentication (
 
 import Data.ByteString.Base64  (encode)
 import Data.Monoid ((<>))
+import Data.Text (Text)
 import Data.Text.Encoding (decodeUtf8)
 import Servant.API.Authentication (BasicAuth(BasicAuth))
 import Servant.Common.Req (addHeader, Req)
@@ -23,3 +25,8 @@ instance AuthenticateRequest (BasicAuth realm) where
         let authText = decodeUtf8 ("Basic " <> encode (user <> ":" <> pass)) in
             addHeader "Authorization" authText req
 
+type JSON = Text
+instance AuthenticateRequest JSON where
+  authReq token req =
+    let authText = ("Bearer " <> token)
+    in addHeader "Authorization" authText req
diff --git a/servant-server/src/Servant/Server/Internal/Authentication.hs b/servant-server/src/Servant/Server/Internal/Authentication.hs
index 073b086a..e14d3625 100644
--- a/servant-server/src/Servant/Server/Internal/Authentication.hs
+++ b/servant-server/src/Servant/Server/Internal/Authentication.hs
@@ -38,7 +38,7 @@ import           Servant.API.Authentication (AuthPolicy (Strict, Lax),
                                              AuthProtected,
                                              BasicAuth (BasicAuth))
 
-import            Web.JWT                    (JWT, UnverifiedJWT, VerifiedJWT, Secret)
+import            Web.JWT                    (JWT, UnverifiedJWT, VerifiedJWT, Secret, JSON)
 import qualified  Web.JWT as JWT             (decode, verify)
 
 -- | Class to represent the ability to extract authentication-related
@@ -116,15 +116,16 @@ basicAuthLax = laxProtect
 
 
 
-instance AuthData (JWT UnverifiedJWT) where
+instance AuthData JSON where
   authData req = do
     -- We might want to write a proper parser for this? but split works fine...
     hdr <- lookup "Authorization" . requestHeaders $ req
     ["Bearer", token] <- return . splitOn " " . decodeUtf8 $ hdr
-    JWT.decode token
+    _ <- JWT.decode token -- try decode it. otherwise it's not a proper token
+    return token
 
 
-jwtAuthHandlers :: AuthHandlers (JWT UnverifiedJWT)
+jwtAuthHandlers :: AuthHandlers JSON
 jwtAuthHandlers =
   let authFailure = responseBuilder status401 [] mempty
   in AuthHandlers (return authFailure) ((const . return) authFailure)
@@ -134,6 +135,6 @@ jwtAuthHandlers =
 -- Use this to quickly add jwt authentication to your project.
 -- One can use  strictProtect and laxProtect to make more complex authentication
 -- and authorization schemes.  For an example of that, see our tutorial: @placeholder@
-jwtAuth :: Secret -> subserver -> AuthProtected (JWT UnverifiedJWT) (JWT VerifiedJWT) subserver 'Strict
-jwtAuth secret subserver = strictProtect (return . JWT.verify secret) jwtAuthHandlers subserver
+jwtAuth :: Secret -> subserver -> AuthProtected JSON (JWT VerifiedJWT) subserver 'Strict
+jwtAuth secret subserver = strictProtect (return . (JWT.verify secret <=< JWT.decode)) jwtAuthHandlers subserver