diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -13,3 +13,7 @@ See the [Web.JWT module](http://hackage.haskell.org/package/jwt/docs/Web-JWT.html) documentation to get started. +[![Build +Status](https://travis-ci.org/juretta/haskell-jwt.svg?branch=master)](https://travis-ci.org/juretta/haskell-jwt) + + diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,3 +1,13 @@ +2015-04-22 0.6.0 +================ + + * Execute doctests in addition to the testsuite when using 'make test'. + * Export `ClaimsMap` type alias (fixes #12) + * Allow base 4.8 + * Lowered required cabal library version (to 1.16) to workaround build + issues in a consumer project. + * Add 7.10.1 to the travis config + 2015-01-19 0.5.3 ================ diff --git a/doctests.hs b/doctests.hs new file mode 100644 --- /dev/null +++ b/doctests.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF doctest-discover #-} diff --git a/jwt.cabal b/jwt.cabal --- a/jwt.cabal +++ b/jwt.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: jwt -version: 0.5.3 +version: 0.6.0 synopsis: JSON Web Token (JWT) decoding and encoding license: MIT license-file: LICENSE @@ -12,7 +12,7 @@ bug-reports: https://bitbucket.org/ssaasen/haskell-jwt/issues category: Web build-type: Simple -cabal-version: >=1.18 +cabal-version: >=1.16 description: JSON Web Token (JWT) is a compact URL-safe means of representing claims to be transferred between two parties. @@ -31,10 +31,14 @@ description: Get Network.URI from the network-uri package default: True +flag doctests + description: Run the doctests tests when executing 'cabal test' + default: False + library exposed-modules: Web.JWT - other-modules: Web.Base64, Data.Text.Additions - build-depends: base >= 4.6 && < 4.8 + other-modules: Web.Base64, Data.Text.Extended + build-depends: base >= 4.6 && < 4.9 , cryptohash >= 0.11 , base64-bytestring >= 1.0 , bytestring >= 0.10 @@ -69,7 +73,7 @@ type: exitcode-stdio-1.0 main-is: TestRunner.hs -- Make sure the tests are listed here so that they will be part of the source distribution - other-modules: Web.Base64Tests, Web.JWTInteropTests, Web.JWTTests, Data.Text.AdditionsTests + other-modules: Web.Base64Tests, Web.JWTInteropTests, Web.JWTTests, Data.Text.ExtendedTests hs-source-dirs: tests/src, src build-depends: base < 5 && >= 4.4 , tasty >= 0.7 @@ -101,3 +105,16 @@ build-depends: network-uri >= 2.4 && < 2.6 , network >= 2.4 && < 2.6 cpp-options: -DTEST + +test-suite doctests + default-language: Haskell2010 + type: exitcode-stdio-1.0 + main-is: doctests.hs + if flag(doctests) + buildable: True + build-depends: base < 5 && >= 4.4 + , jwt + , doctest >= 0.9.11 + , doctest-discover + else + buildable: False diff --git a/src/Data/Text/Additions.hs b/src/Data/Text/Additions.hs deleted file mode 100644 --- a/src/Data/Text/Additions.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Data.Text.Additions ( - constTimeCompare -) where - -import Control.Applicative ((<$>)) -import Data.Bits -import Data.Char -import Data.Function (on) -import Data.List (foldl') -import qualified Data.Text as T - -constTimeCompare :: T.Text -> T.Text -> Bool -constTimeCompare l r = T.length l == T.length r && comp' l r - where - comp' a b = 0 == foldl' (.|.) 0 (uncurry (on xor ord) <$> T.zip a b) diff --git a/src/Data/Text/Extended.hs b/src/Data/Text/Extended.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Extended.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Text.Extended ( + module Data.Text + , constTimeCompare +) where + +import Control.Applicative ((<$>)) +import Data.Bits +import Data.Char +import Data.Function (on) +import qualified Data.List as L +import Data.Text +import Prelude hiding (length, zip) + +constTimeCompare :: Text -> Text -> Bool +constTimeCompare l r = length l == length r && comp' l r + where + comp' a b = 0 == L.foldl' (.|.) 0 (uncurry (on xor ord) <$> zip a b) diff --git a/src/Web/JWT.hs b/src/Web/JWT.hs --- a/src/Web/JWT.hs +++ b/src/Web/JWT.hs @@ -67,6 +67,7 @@ , JSON , Algorithm(..) , JWTClaimsSet(..) + , ClaimsMap , IntDate , StringOrURI , JWTHeader @@ -75,9 +76,8 @@ ) where import qualified Data.ByteString.Lazy.Char8 as BL (fromStrict, toStrict) -import qualified Data.Text as T +import qualified Data.Text.Extended as T import qualified Data.Text.Encoding as TE -import qualified Data.Text.Additions as TA import Control.Applicative import Control.Monad @@ -102,7 +102,7 @@ newtype Secret = Secret T.Text instance Eq Secret where - (Secret s1) == (Secret s2) = s1 `TA.constTimeCompare` s2 + (Secret s1) == (Secret s2) = s1 `T.constTimeCompare` s2 instance Show Secret where show _ = "" @@ -110,7 +110,7 @@ newtype Signature = Signature T.Text deriving (Show) instance Eq Signature where - (Signature s1) == (Signature s2) = s1 `TA.constTimeCompare` s2 + (Signature s1) == (Signature s2) = s1 `T.constTimeCompare` s2 -- | JSON Web Token without signature verification data UnverifiedJWT @@ -394,7 +394,7 @@ -- ================================================================================= calculateDigest :: Algorithm -> Secret -> T.Text -> T.Text -calculateDigest _ (Secret key) msg = base64Encode' $ HMAC.hmac SHA.hash 64 (bs key) (bs msg) +calculateDigest HS256 (Secret key) msg = base64Encode' $ HMAC.hmac SHA.hash 64 (bs key) (bs msg) where bs = TE.encodeUtf8 -- ================================================================================= diff --git a/tests/src/Data/Text/AdditionsTests.hs b/tests/src/Data/Text/AdditionsTests.hs deleted file mode 100644 --- a/tests/src/Data/Text/AdditionsTests.hs +++ /dev/null @@ -1,30 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} -module Data.Text.AdditionsTests - ( - main - , defaultTestGroup -) where - -import Control.Applicative -import Data.String (fromString) -import qualified Data.Text as T -import Data.Text.Additions -import qualified Test.QuickCheck as QC -import Test.Tasty -import Test.Tasty.QuickCheck -import Test.Tasty.TH - -defaultTestGroup :: TestTree -defaultTestGroup = $(testGroupGenerator) - -main :: IO () -main = defaultMain defaultTestGroup - -prop_constTimeCompare :: T.Text -> T.Text -> Bool -prop_constTimeCompare a b = (a == b) == (a `constTimeCompare` b) - -instance Arbitrary T.Text where - arbitrary = fromString <$> (arbitrary :: QC.Gen String) - diff --git a/tests/src/Data/Text/ExtendedTests.hs b/tests/src/Data/Text/ExtendedTests.hs new file mode 100644 --- /dev/null +++ b/tests/src/Data/Text/ExtendedTests.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +module Data.Text.ExtendedTests + ( + main + , defaultTestGroup +) where + +import Control.Applicative +import Data.String (fromString) +import qualified Data.Text.Extended as T +import qualified Test.QuickCheck as QC +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.TH + +defaultTestGroup :: TestTree +defaultTestGroup = $(testGroupGenerator) + +main :: IO () +main = defaultMain defaultTestGroup + +prop_constTimeCompare :: T.Text -> T.Text -> Bool +prop_constTimeCompare a b = (a == b) == (a `T.constTimeCompare` b) + +instance Arbitrary T.Text where + arbitrary = fromString <$> (arbitrary :: QC.Gen String) + diff --git a/tests/src/TestRunner.hs b/tests/src/TestRunner.hs --- a/tests/src/TestRunner.hs +++ b/tests/src/TestRunner.hs @@ -3,7 +3,7 @@ import qualified Web.JWTTests import qualified Web.JWTInteropTests import qualified Web.Base64Tests -import qualified Data.Text.AdditionsTests +import qualified Data.Text.ExtendedTests import Test.Tasty main :: IO () @@ -14,6 +14,6 @@ Web.JWTTests.defaultTestGroup , Web.JWTInteropTests.defaultTestGroup , Web.Base64Tests.defaultTestGroup - , Data.Text.AdditionsTests.defaultTestGroup + , Data.Text.ExtendedTests.defaultTestGroup ] diff --git a/tests/src/Web/JWTInteropTests.hs b/tests/src/Web/JWTInteropTests.hs --- a/tests/src/Web/JWTInteropTests.hs +++ b/tests/src/Web/JWTInteropTests.hs @@ -78,7 +78,6 @@ <*> arbitrary <*> arbitrary -type ClaimsMap = Map.Map T.Text Value instance Arbitrary ClaimsMap where arbitrary = return Map.empty diff --git a/tests/src/Web/JWTTests.hs b/tests/src/Web/JWTTests.hs --- a/tests/src/Web/JWTTests.hs +++ b/tests/src/Web/JWTTests.hs @@ -69,6 +69,29 @@ Just HS256 @=? alg (header verified) Just "payload" @=? Map.lookup "some" (unregisteredClaims $ claims verified) +-- It must be impossible to get a VerifiedJWT if alg is "none" +case_decodeAndVerifyJWTAlgoNone = do + {- + - Header: + { + "alg": "none", + "typ": "JWT" + } + Payload: + { + "iss": "https://jwt-idp.example.com", + "sub": "mailto:mike@example.com", + "nbf": 1425980755, + "exp": 1425984355, + "iat": 1425980755, + "jti": "id123456", + "typ": "https://example.com/register" + } + -} + let input = "eyJhbGciOiJub25lIiwidHlwIjoiSldUIn0.eyJpc3MiOiJodHRwczovL2p3dC1pZHAuZXhhbXBsZS5jb20iLCJzdWIiOiJtYWlsdG86bWlrZUBleGFtcGxlLmNvbSIsIm5iZiI6MTQyNTk4MDc1NSwiZXhwIjoxNDI1OTg0MzU1LCJpYXQiOjE0MjU5ODA3NTUsImp0aSI6ImlkMTIzNDU2IiwidHlwIjoiaHR0cHM6Ly9leGFtcGxlLmNvbS9yZWdpc3RlciJ9." + mJwt = decodeAndVerifySignature (secret "secretkey") input + False @=? isJust mJwt + case_decodeAndVerifyJWTFailing = do -- Generated with ruby-jwt, modified to be invalid let input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2u" @@ -199,7 +222,6 @@ <*> arbitrary <*> arbitrary -type ClaimsMap = Map.Map T.Text Value instance Arbitrary ClaimsMap where arbitrary = return Map.empty