diff --git a/servant-client/src/Servant/Client/Authentication.hs b/servant-client/src/Servant/Client/Authentication.hs index 9a9994bb..ece2654c 100644 --- a/servant-client/src/Servant/Client/Authentication.hs +++ b/servant-client/src/Servant/Client/Authentication.hs @@ -11,7 +11,7 @@ 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.API.Authentication (BasicAuth(BasicAuth), JWTAuth(..)) import Servant.Common.Req (addHeader, Req) -- | Class to represent the ability to authenticate a 'Request' @@ -25,8 +25,7 @@ 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 = +instance AuthenticateRequest JWTAuth where + authReq (JWTAuth token) req = let authText = ("Bearer " <> token) in addHeader "Authorization" authText req diff --git a/servant-examples/tutorial/T3.hs b/servant-examples/tutorial/T3.hs index 7b5bdeb3..aacceacd 100644 --- a/servant-examples/tutorial/T3.hs +++ b/servant-examples/tutorial/T3.hs @@ -10,6 +10,8 @@ import Data.List import GHC.Generics import Network.Wai import Servant +import Servant.Server.Internal.Authentication + data Position = Position { x :: Int diff --git a/servant-mock/servant-mock.cabal b/servant-mock/servant-mock.cabal index 0bb605db..70849722 100644 --- a/servant-mock/servant-mock.cabal +++ b/servant-mock/servant-mock.cabal @@ -31,7 +31,8 @@ library servant-server >= 0.4, transformers >= 0.3 && <0.5, QuickCheck >= 2.7 && <2.9, - wai >= 3.0 && <3.1 + wai >= 3.0 && <3.1, + jwt hs-source-dirs: src default-language: Haskell2010 diff --git a/servant-mock/src/Servant/Mock.hs b/servant-mock/src/Servant/Mock.hs index a6b16193..b2f7804e 100644 --- a/servant-mock/src/Servant/Mock.hs +++ b/servant-mock/src/Servant/Mock.hs @@ -64,7 +64,7 @@ import Network.Wai import Servant import Servant.API.Authentication import Servant.API.ContentTypes -import Servant.Server.Internal.Authentication +import Web.JWT import Test.QuickCheck.Arbitrary (Arbitrary (..), vector) import Test.QuickCheck.Gen (Gen, generate) @@ -156,9 +156,8 @@ instance (HasMock rest, Arbitrary usr, KnownSymbol realm) instance (HasMock rest, Arbitrary usr) => HasMock (AuthProtect JWTAuth (usr :: *) 'Strict :> rest) where mock _ = strictProtect (\_ -> do { a <- generate arbitrary; return (Just a)}) - (AuthHandlers (return authFailure) ((const . return) authFailure)) + jwtAuthHandlers (\_ -> mock (Proxy :: Proxy rest)) - where authFailure = responseBuilder status401 [] mempty instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Delete ctypes a) where mock _ = mockArbitrary diff --git a/servant-server/src/Servant/Server.hs b/servant-server/src/Servant/Server.hs index a26941ea..cfa10088 100644 --- a/servant-server/src/Servant/Server.hs +++ b/servant-server/src/Servant/Server.hs @@ -71,12 +71,14 @@ module Servant.Server , err504 , err505 + , module Servant.Server.Internal.Authentication ) where import Data.Proxy (Proxy) import Network.Wai (Application) import Servant.Server.Internal import Servant.Server.Internal.Enter +import Servant.Server.Internal.Authentication -- * Implementing Servers diff --git a/servant-server/src/Servant/Server/Internal/Authentication.hs b/servant-server/src/Servant/Server/Internal/Authentication.hs index 2c0d16e6..216403e4 100644 --- a/servant-server/src/Servant/Server/Internal/Authentication.hs +++ b/servant-server/src/Servant/Server/Internal/Authentication.hs @@ -14,7 +14,7 @@ module Servant.Server.Internal.Authentication , laxProtect , strictProtect , jwtAuthHandlers -, jwtAuth +, jwtAuthStrict ) where import Control.Monad (guard, (<=<)) @@ -37,10 +37,10 @@ import Network.Wai (Request, Response, requestHeaders, import Servant.API.Authentication (AuthPolicy (Strict, Lax), AuthProtected, BasicAuth (BasicAuth), - JWTAuth) + JWTAuth (..)) import Web.JWT (JWT, UnverifiedJWT, VerifiedJWT, Secret, JSON) -import qualified Web.JWT as JWT (decode, verify, secret) +import qualified Web.JWT as JWT (decode, decodeAndVerifySignature, secret) -- | Class to represent the ability to extract authentication-related -- data from a 'Request' object. @@ -122,21 +122,23 @@ instance AuthData JWTAuth where -- 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 -- try decode it. otherwise it's not a proper token - return token + JWT.decode token -- try decode it. otherwise it's not a proper token + return . JWTAuth $ token -jwtAuthHandlers :: AuthHandlers JSON -jwtAuthHandlers = - let authFailure = responseBuilder status401 [] mempty - in AuthHandlers (return authFailure) ((const . return) authFailure) +jwtAuthHandlers :: AuthHandlers JWTAuth +jwtAuthHandlers = AuthHandlers (return missingData) ((const . return) authFailure) + where + withError e = + responseBuilder status401 [("WWW-Authenticate", "Bearer error=\""<>e<>"\"")] mempty + missingData = withError "invalid_request" + authFailure = withError "invalid_token" -- | A default implementation of an AuthProtected for JWT. -- 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@ --- TODO more advanced one -jwtAuth :: Text -> subserver -> AuthProtected JSON (JWT VerifiedJWT) subserver 'Strict -jwtAuth secret subserver = strictProtect (return . (JWT.verify (JWT.secret secret) <=< JWT.decode)) jwtAuthHandlers subserver +-- and authorization schemes. +jwtAuthStrict :: Secret -> subserver -> AuthProtected JWTAuth (JWT VerifiedJWT) subserver 'Strict +jwtAuthStrict secret subserver = strictProtect (return . JWT.decodeAndVerifySignature secret . unJWTAuth) jwtAuthHandlers subserver diff --git a/servant/src/Servant/API/Authentication.hs b/servant/src/Servant/API/Authentication.hs index 207662b3..6262350e 100644 --- a/servant/src/Servant/API/Authentication.hs +++ b/servant/src/Servant/API/Authentication.hs @@ -9,7 +9,7 @@ module Servant.API.Authentication , AuthProtect (..) , AuthProtected (..) , BasicAuth (..) -, JWTAuth +, JWTAuth (..) ) where @@ -38,4 +38,4 @@ data BasicAuth (realm :: Symbol) = BasicAuth { baUser :: ByteString , baPass :: ByteString } deriving (Eq, Show, Typeable) -type JWTAuth = Text +newtype JWTAuth = JWTAuth { unJWTAuth :: Text } diff --git a/stack.yaml b/stack.yaml index f370da09..19db679a 100644 --- a/stack.yaml +++ b/stack.yaml @@ -16,4 +16,5 @@ packages: extra-deps: - engine-io-wai-1.0.2 - control-monad-omega-0.3.1 +- jwt-0.6.0 resolver: nightly-2015-10-08