jwt 0.1.1 → 0.2.0
raw patch · 8 files changed
+256/−74 lines, 8 filesdep +timedep ~network
Dependencies added: time
Dependency ranges changed: network
Files
- README.md +15/−0
- changelog +14/−0
- jwt.cabal +10/−2
- src/Web/Base64.hs +30/−0
- src/Web/JWT.hs +87/−43
- tests/src/TestRunner.hs +2/−0
- tests/src/Web/Base64Tests.hs +56/−0
- tests/src/Web/JWTTests.hs +42/−29
+ README.md view
@@ -0,0 +1,15 @@+# Haskell JSON Web Token (JWT)++JSON Web Token (JWT) is a compact URL-safe means of representing claims to be transferred between two parties.++From http://self-issued.info/docs/draft-ietf-oauth-json-web-token.html++> JSON Web Token (JWT) is a compact URL-safe means of representing claims to be transferred +> between two parties. The claims in a JWT are encoded as a JavaScript Object Notation (JSON) +> object that is used as the payload of a JSON Web Signature (JWS) structure or as the plaintext +> of a JSON Web Encryption (JWE) structure, enabling the claims to be digitally signed or MACed +> and/or encrypted.++See the [Web.JWT module](http://hackage.haskell.org/package/jwt/docs/Web-JWT.html) documentation to get started.++
+ changelog view
@@ -0,0 +1,14 @@+2014-03-10 0.2.0+=================++ * Export the IntDate and StringOrURI types #5a1137b++2014-03-03 0.1.1+=================++ * Verify that invalid input to the decode* functions fails as expected++2014-03-03 0.1.0+=================++ * Initial release
jwt.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: jwt-version: 0.1.1+version: 0.2.0 synopsis: JSON Web Token (JWT) decoding and encoding license: MIT license-file: LICENSE@@ -19,12 +19,18 @@ . To get started, see the documentation for the "Web.JWT" module. +extra-source-files:+ changelog+ README.md+ source-repository head type: git location: https://ssaasen@bitbucket.org/ssaasen/haskell-jwt.git + library exposed-modules: Web.JWT+ other-modules: Web.Base64 build-depends: base >= 4.6 && < 4.7 , cryptohash >= 0.11 , base64-bytestring >= 1.0@@ -37,6 +43,7 @@ , data-default >= 0.5 , http-types >= 0.8 , network >= 2.4+ , time >= 1.1 hs-source-dirs: src default-language: Haskell2010@@ -50,7 +57,7 @@ default-language: Haskell2010 type: exitcode-stdio-1.0 main-is: TestRunner.hs- other-modules: Web.JWTTests+ other-modules: Web.JWTTests, Web.Base64Tests hs-source-dirs: tests/src, src build-depends: base < 5 && >= 4.4 , tasty >= 0.7@@ -71,5 +78,6 @@ , data-default , http-types , network+ , time >= 1.1 cpp-options: -DTEST
+ src/Web/Base64.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings #-}++module Web.Base64 (+ base64Encode+ , base64Encode'+ , base64Decode+ , removePaddingBase64Encoding+) where+++import qualified Data.ByteString.Char8 as B+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.ByteString.Base64.URL as BASE64++base64Decode :: T.Text -> T.Text+base64Decode = operateOnText BASE64.decodeLenient++base64Encode :: T.Text -> T.Text+base64Encode = removePaddingBase64Encoding . operateOnText BASE64.encode++base64Encode' :: B.ByteString -> T.Text+base64Encode' = removePaddingBase64Encoding . TE.decodeUtf8 . BASE64.encode++removePaddingBase64Encoding :: T.Text -> T.Text+removePaddingBase64Encoding = T.dropWhileEnd (=='=')+++operateOnText :: (B.ByteString -> B.ByteString) -> T.Text -> T.Text+operateOnText f = TE.decodeUtf8 . f . TE.encodeUtf8
src/Web/JWT.hs view
@@ -1,12 +1,10 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE EmptyDataDecls #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE StandaloneDeriving #-}---- TODO:--- * StringOrUri is not valdiated+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StandaloneDeriving #-} {-| Module: Web.JWT@@ -35,12 +33,20 @@ , encodeUnsigned -- * Utility functions+ -- ** Common , tokenIssuer , secret+ -- ** JWT structure , claims , header , signature- , module Data.Default+ -- ** JWT claims set+ , intDate+ , stringOrURI+ -- ** JWT header+ , typ+ , cty+ , alg -- * Types , UnverifiedJWT@@ -51,16 +57,13 @@ , JSON , Algorithm(..) , JWTClaimsSet(..)+ , IntDate+ , StringOrURI+ , JWTHeader -#ifdef TEST- , IntDate(..)- , JWTHeader(..)- , base64Encode- , base64Decode-#endif+ , module Data.Default ) where -import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as BL (fromStrict, toStrict) import qualified Data.Text as T import qualified Data.Text.Encoding as TE@@ -71,12 +74,14 @@ import qualified Crypto.MAC.HMAC as HMAC import Data.Aeson hiding (decode, encode) import qualified Data.Aeson as JSON-import qualified Data.ByteString.Base64.URL as BASE64 import Data.Default import qualified Data.HashMap.Strict as StrictMap import qualified Data.Map as Map import Data.Maybe import Data.Scientific+import Data.Time.Clock (NominalDiffTime)+import qualified Network.URI as URI+import Web.Base64 import Prelude hiding (exp) @@ -118,15 +123,39 @@ -- | A JSON numeric value representing the number of seconds from -- 1970-01-01T0:0:0Z UTC until the specified UTC date/time.-newtype IntDate = IntDate Integer deriving (Eq, Show)+newtype IntDate = IntDate Integer deriving (Show, Eq) ++-- | A JSON string value, with the additional requirement that while+-- arbitrary string values MAY be used, any value containing a ":"+-- character MUST be a URI [RFC3986]. StringOrURI values are+-- compared as case-sensitive strings with no transformations or+-- canonicalizations applied.+data StringOrURI = S T.Text | U URI.URI deriving (Eq)++instance Show StringOrURI where+ show (S s) = T.unpack s+ show (U u) = show u++ data Algorithm = HS256 -- ^ HMAC using SHA-256 hash algorithm deriving (Eq, Show) -- | JWT Header, describes the cryptographic operations applied to the JWT data JWTHeader = JWTHeader {+ -- | The typ (type) Header Parameter defined by [JWS] and [JWE] is used to+ -- declare the MIME Media Type [IANA.MediaTypes] of this complete JWT in+ -- contexts where this is useful to the application.+ -- This parameter has no effect upon the JWT processing. typ :: Maybe T.Text+ -- | The cty (content type) Header Parameter defined by [JWS] and [JWE] is+ -- used by this specification to convey structural information about the JWT. , cty :: Maybe T.Text+ -- | The alg (algorithm) used for signing the JWT. The HS256 (HMAC using SHA-256)+ -- is the only required algorithm and the only one supported in this implementation+ -- in addition to "none" which means that no signature will be used.+ --+ -- See <http://tools.ietf.org/html/draft-ietf-jose-json-web-algorithms-23#page-6> , alg :: Maybe Algorithm } deriving (Eq, Show) @@ -139,13 +168,13 @@ -- http://self-issued.info/docs/draft-ietf-oauth-json-web-token.html#ClaimsContents -- | The iss (issuer) claim identifies the principal that issued the JWT.- iss :: Maybe T.Text+ iss :: Maybe StringOrURI -- | The sub (subject) claim identifies the principal that is the subject of the JWT.- , sub :: Maybe T.Text+ , sub :: Maybe StringOrURI -- | The aud (audience) claim identifies the audiences that the JWT is intended for- , aud :: Maybe T.Text+ , aud :: Maybe StringOrURI -- | The exp (expiration time) claim identifies the expiration time on or after which the JWT MUST NOT be accepted for processing. Its value MUST be a number containing an IntDate value. , exp :: Maybe IntDate@@ -157,11 +186,11 @@ , iat :: Maybe IntDate -- | The jti (JWT ID) claim provides a unique identifier for the JWT.- , jti :: Maybe T.Text+ , jti :: Maybe StringOrURI , unregisteredClaims :: ClaimsMap -} deriving (Eq, Show)+} deriving (Show, Eq) instance Default JWTClaimsSet where@@ -171,9 +200,11 @@ -- | Encode a claims set using the given secret -- -- > {-# LANGUAGE OverloadedStrings #-}+-- > import Data.Aeson+-- > import qualified Data.Map as Map -- > -- > let cs = def { -- def returns a default JWTClaimsSet--- > iss = Just "Foo"+-- > iss = stringOrURI "Foo" -- > , unregisteredClaims = Map.fromList [("http://example.com/is_root", (Bool True))] -- > } -- > key = secret "secret-key"@@ -195,9 +226,11 @@ -- | Encode a claims set without signing it -- -- > {-# LANGUAGE OverloadedStrings #-}+-- > import Data.Aeson+-- > import qualified Data.Map as Map -- > -- > let cs = def { -- def returns a default JWTClaimsSet--- > iss = Just "Foo"+-- > iss = stringOrURI "Foo" -- > , unregisteredClaims = Map.fromList [("http://example.com/is_root", (Bool True))] -- > } -- > jwt = encodeUnsigned cs@@ -255,7 +288,7 @@ -- | Decode a claims set and verify that the signature matches by using the supplied secret.--- The algorithm is based on the supplied header value. +-- The algorithm is based on the supplied header value. -- -- This will return a VerifiedJWT if and only if the signature can be verified -- using the given secret.@@ -293,7 +326,7 @@ extractElems _ = Nothing -- | Try to extract the value for the issue claim field 'iss' from the web token in JSON form-tokenIssuer :: JSON -> Maybe T.Text+tokenIssuer :: JSON -> Maybe StringOrURI tokenIssuer = decode >=> fmap pure claims >=> iss -- | Create a Secret using the given key@@ -303,6 +336,20 @@ secret :: T.Text -> Secret secret = Secret +-- | Convert the `NominalDiffTime` into an IntDate. Returns a Nothing if the+-- argument is invalid (e.g. the NominalDiffTime must be convertible into a+-- positive Integer representing the seconds since epoch).+intDate :: NominalDiffTime -> Maybe IntDate+intDate i | i < 0 = Nothing+intDate i = Just $ IntDate $ round i++-- | Convert a `T.Text` into a 'StringOrURI`. Returns a Nothing if the+-- String cannot be converted (e.g. if the String contains a ':' but is+-- *not* a valid URI).+stringOrURI :: T.Text -> Maybe StringOrURI+stringOrURI t | URI.isURI $ T.unpack t = U <$> (URI.parseURI $ T.unpack t)+stringOrURI t = Just (S t)+ -- ================================================================================= encodeJWT :: ToJSON a => a -> T.Text@@ -317,23 +364,9 @@ -- ================================================================================= --base64Decode :: T.Text -> T.Text-base64Decode = operateOnText BASE64.decodeLenient--base64Encode :: T.Text -> T.Text-base64Encode = removePaddingBase64Encoding . operateOnText BASE64.encode--operateOnText :: (B.ByteString -> B.ByteString) -> T.Text -> T.Text-operateOnText f = TE.decodeUtf8 . f . TE.encodeUtf8--removePaddingBase64Encoding :: T.Text -> T.Text-removePaddingBase64Encoding = T.dropWhileEnd (=='=')- calculateDigest :: Algorithm -> Secret -> T.Text -> T.Text calculateDigest _ (Secret key) msg = base64Encode' $ HMAC.hmac SHA.hash 64 (bs key) (bs msg) where bs = TE.encodeUtf8- base64Encode' = removePaddingBase64Encoding . TE.decodeUtf8 . BASE64.encode -- ================================================================================= @@ -387,7 +420,7 @@ ] instance ToJSON IntDate where- toJSON (IntDate ts) = Number $ scientific (fromIntegral ts) 0+ toJSON (IntDate i) = Number $ scientific (fromIntegral i) 0 instance FromJSON IntDate where parseJSON (Number x) = return $ IntDate $ coefficient x@@ -399,3 +432,14 @@ instance FromJSON Algorithm where parseJSON (String "HS256") = return HS256 parseJSON _ = mzero++instance ToJSON StringOrURI where+ toJSON (S s) = String s+ toJSON (U uri) = String $ T.pack $ URI.uriToString id uri ""++instance FromJSON StringOrURI where+ parseJSON (String s) | URI.isURI $ T.unpack s = return $ U $ fromMaybe URI.nullURI $ URI.parseURI $ T.unpack s+ parseJSON (String s) = return $ S s+ parseJSON _ = mzero++
tests/src/TestRunner.hs view
@@ -1,6 +1,7 @@ module Main where import qualified Web.JWTTests+import qualified Web.Base64Tests import Test.Tasty main :: IO ()@@ -9,5 +10,6 @@ tests :: TestTree tests = testGroup "JWT Tests" [ Web.JWTTests.defaultTestGroup+ , Web.Base64Tests.defaultTestGroup ]
+ tests/src/Web/Base64Tests.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables, TemplateHaskell #-}+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}+module Web.Base64Tests+ (+ main+ , defaultTestGroup+) where++import Control.Applicative+import Test.Tasty+import Test.Tasty.TH+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+import qualified Test.QuickCheck as QC+import qualified Data.Map as Map+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import Data.Aeson.Types+import Data.Maybe+import Data.String (fromString, IsString)+import Web.Base64++defaultTestGroup :: TestTree+defaultTestGroup = $(testGroupGenerator)++main :: IO ()+main = defaultMain defaultTestGroup++++case_base64EncodeString = do+ let header = "{\"typ\":\"JWT\",\r\n \"alg\":\"HS256\"}"+ "eyJ0eXAiOiJKV1QiLA0KICJhbGciOiJIUzI1NiJ9" @=? base64Encode header++case_base64EncodeStringNoPadding = do+ let header = "sdjkfhaks jdhfak sjldhfa lkjsdf"+ "c2Rqa2ZoYWtzIGpkaGZhayBzamxkaGZhIGxranNkZg" @=? base64Encode header++case_base64EncodeDecodeStringNoPadding = do+ let header = "sdjkfhaks jdhfak sjldhfa lkjsdf"+ header @=? (base64Decode $ base64Encode header)++case_base64DecodeString = do+ let str = "eyJ0eXAiOiJKV1QiLA0KICJhbGciOiJIUzI1NiJ9"+ "{\"typ\":\"JWT\",\r\n \"alg\":\"HS256\"}" @=? base64Decode str++prop_base64_encode_decode = f+ where f :: T.Text -> Bool+ f input = (base64Decode $ base64Encode input) == input+++instance Arbitrary T.Text where+ arbitrary = fromString <$> (arbitrary :: QC.Gen String)++instance Arbitrary TL.Text where+ arbitrary = fromString <$> (arbitrary :: QC.Gen String)
tests/src/Web/JWTTests.hs view
@@ -16,8 +16,11 @@ import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Data.Aeson.Types+import qualified Data.Aeson as JSON import Data.Maybe import Data.String (fromString, IsString)+import Data.Time+ import Web.JWT defaultTestGroup :: TestTree@@ -27,6 +30,17 @@ main = defaultMain defaultTestGroup ++case_stringOrURIString = do+ let str = "foo bar baz 2312j!@&^#^*!(*@"+ sou = stringOrURI str+ (Just str) @=? (fmap (T.pack . show) sou)++case_stringOrURI= do+ let str = "http://user@example.com:8900/foo/bar?baz=t;"+ sou = stringOrURI str+ (Just str) @=? (fmap (T.pack . show) sou)+ case_decodeJWT = do -- Generated with ruby-jwt let input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U"@@ -64,7 +78,7 @@ case_encodeJWTNoMac = do let cs = def {- iss = Just "Foo"+ iss = stringOrURI "Foo" , unregisteredClaims = Map.fromList [("http://example.com/is_root", (Bool True))] } jwt = encodeUnsigned cs@@ -73,7 +87,7 @@ case_encodeDecodeJWTNoMac = do let cs = def {- iss = Just "Foo"+ iss = stringOrURI "Foo" , unregisteredClaims = Map.fromList [("http://example.com/is_root", (Bool True))] } mJwt = decode $ encodeUnsigned cs@@ -83,7 +97,7 @@ case_encodeDecodeJWT = do let cs = def {- iss = Just "Foo"+ iss = stringOrURI "Foo" , unregisteredClaims = Map.fromList [("http://example.com/is_root", (Bool True))] } key = secret "secret-key"@@ -93,49 +107,38 @@ cs @=? claims unverified case_tokenIssuer = do- let cs = def {- iss = Just "Foo"+ let iss' = stringOrURI "Foo"+ cs = def {+ iss = iss' , unregisteredClaims = Map.fromList [("http://example.com/is_root", (Bool True))] } key = secret "secret-key" t = encodeSigned HS256 key cs- Just "Foo" @=? tokenIssuer t+ iss' @=? tokenIssuer t case_encodeJWTClaimsSet = do let cs = def {- iss = Just "Foo"+ iss = stringOrURI "Foo" } -- This is a valid JWT string that can be decoded with the given secret using the ruby JWT library "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJpc3MiOiJGb28ifQ.dfhkuexBONtkewFjLNz9mZlFc82GvRkaZKD8Pd53zJ8" @=? encodeSigned HS256 (secret "secret") cs case_encodeJWTClaimsSetCustomClaims = do- let cs = def {- iss = Just "Foo"+ let now = 1234+ cs = def {+ iss = stringOrURI "Foo"+ , iat = intDate now , unregisteredClaims = Map.fromList [("http://example.com/is_root", (Bool True))] } -- The expected string can be decoded using the ruby-jwt library- "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJodHRwOi8vZXhhbXBsZS5jb20vaXNfcm9vdCI6dHJ1ZSwiaXNzIjoiRm9vIn0.UVp4TIg8-OmY_vNHbyxMPx7v0P6jCY4rqYVWVcjdXQk" @=? encodeSigned HS256 (secret "secret") cs+ "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJpYXQiOjEyMzQsImh0dHA6Ly9leGFtcGxlLmNvbS9pc19yb290Ijp0cnVlLCJpc3MiOiJGb28ifQ.F3VCSxBBnY2caX4AH4GvIHyTVUhOnJF9Av_G_N4m710" @=? encodeSigned HS256 (secret "secret") cs -case_base64EncodeString = do- let header = "{\"typ\":\"JWT\",\r\n \"alg\":\"HS256\"}"- "eyJ0eXAiOiJKV1QiLA0KICJhbGciOiJIUzI1NiJ9" @=? base64Encode header -case_base64EncodeStringNoPadding = do- let header = "sdjkfhaks jdhfak sjldhfa lkjsdf"- "c2Rqa2ZoYWtzIGpkaGZhayBzamxkaGZhIGxranNkZg" @=? base64Encode header--case_base64EncodeDecodeStringNoPadding = do- let header = "sdjkfhaks jdhfak sjldhfa lkjsdf"- header @=? (base64Decode $ base64Encode header)--case_base64DecodeString = do- let str = "eyJ0eXAiOiJKV1QiLA0KICJhbGciOiJIUzI1NiJ9"- "{\"typ\":\"JWT\",\r\n \"alg\":\"HS256\"}" @=? base64Decode str--prop_base64_encode_decode = f- where f :: T.Text -> Bool- f input = (base64Decode $ base64Encode input) == input+prop_stringOrURIProp = f+ where f :: StringOrURI -> Bool+ f sou = let s = stringOrURI $ T.pack $ show sou+ in (Just sou) == s prop_encode_decode_prop = f where f :: JWTClaimsSet -> Bool@@ -164,7 +167,17 @@ arbitrary = return Map.empty instance Arbitrary IntDate where- arbitrary = IntDate <$> (arbitrary :: QC.Gen Integer)+ arbitrary = fmap (f . intDate) (arbitrary :: QC.Gen NominalDiffTime)+ where f mIntDate = fromMaybe (fromJust $ intDate 1) mIntDate++instance Arbitrary NominalDiffTime where+ arbitrary = arbitrarySizedFractional+ shrink = shrinkRealFrac++instance Arbitrary StringOrURI where+ arbitrary = fmap (f . stringOrURI) (arbitrary :: QC.Gen T.Text)+ where+ f mSou = fromMaybe (fromJust $ stringOrURI "http://example.com") mSou instance Arbitrary T.Text where arbitrary = fromString <$> (arbitrary :: QC.Gen String)