eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Refine the jwt api

Browse source
This commit is contained in:
Arian van Putten 2015-10-18 22:35:26 +02:00 committed by aaron levin
parent 2b3df72fa2
commit dc699a93e0
8 changed files with 29 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
servant-client/src/Servant/Client/Authentication.hs
View file

@ -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

2
servant-examples/tutorial/T3.hs
View file

@ -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

3
servant-mock/servant-mock.cabal
View file

@ -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

5
servant-mock/src/Servant/Mock.hs
View file

@ -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

2
servant-server/src/Servant/Server.hs
View file

@ -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

28
servant-server/src/Servant/Server/Internal/Authentication.hs
View file

@ -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

4
servant/src/Servant/API/Authentication.hs
View file

@ -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 }

1
stack.yaml
View file

@ -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