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