<commit_before>{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables, TemplateHaskell #-}
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
module Web.JWTTests
  (
    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           Data.Time


import           Web.JWT

defaultTestGroup :: TestTree
defaultTestGroup = $(testGroupGenerator)

main :: IO ()
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_intDateDeriveOrd = do
    let i1 = intDate 1231231231 -- Tue  6 Jan 2009 19:40:31 AEDT
        i2 = intDate 1231232231 -- Tue  6 Jan 2009 19:57:11 AEDT
    LT @=? i1 `compare` i2


case_decodeJWT = do
    -- Generated with ruby-jwt
    let input = "<KEY>"
        mJwt = decode input
    True @=? isJust mJwt
    True @=? isJust (fmap signature mJwt)
    let (Just unverified) = mJwt
    Just HS256 @=? alg (header unverified)
    Just "payload" @=? Map.lookup "some" (unregisteredClaims $ claims unverified)

case_verify = do
    -- Generated with ruby-jwt
    let input = "<KEY>"
        mVerified = verify (secret "secret") =<< decode input
    True @=? isJust mVerified

case_decodeAndVerifyJWT = do
    -- Generated with ruby-jwt
    let input = "<KEY>"
        mJwt = decodeAndVerifySignature (secret "secret") input
    True @=? isJust mJwt
    let (Just verified) = mJwt
    Just HS256 @=? alg (header verified)
    Just "payload" @=? Map.lookup "some" (unregisteredClaims $ claims verified)

case_decodeAndVerifyJWTFailing = do
    -- Generated with ruby-jwt, modified to be invalid
    let input = "<KEY>"
        mJwt = decodeAndVerifySignature (secret "secret") input
    False @=? isJust mJwt

case_decodeInvalidInput = do
    let inputs = ["", "a.", "a.b"]
        result = map decode inputs
    True @=? all isNothing result

case_decodeAndVerifySignatureInvalidInput = do
    let inputs = ["", "a.", "a.b"]
        result = map (decodeAndVerifySignature (secret "secret")) inputs
    True @=? all isNothing result

case_encodeJWTNoMac = do
    let cs = def {
        iss = stringOrURI "Foo"
      , unregisteredClaims = Map.fromList [("http://example.com/is_root", Bool True)]
    }
        jwt = encodeUnsigned cs
    -- Verify the shape of the JWT, ensure the shape of the triple of
    -- <header>.<claims>.<signature>
    let (h:c:s:_) = T.splitOn "." jwt
    False @=? T.null h
    False @=? T.null c
    True  @=? T.null s


case_encodeDecodeJWTNoMac = do
    let cs = def {
        iss = stringOrURI "Foo"
      , unregisteredClaims = Map.fromList [("http://example.com/is_root", Bool True)]
    }
        mJwt = decode $ encodeUnsigned cs
    True @=? isJust mJwt
    let (Just unverified) = mJwt
    cs @=? claims unverified

case_encodeDecodeJWT = do
    let now = 1394573404
        cs = def {
        iss = stringOrURI "Foo"
      , iat = intDate now
      , unregisteredClaims = Map.fromList [("http://example.com/is_root", Bool True)]
    }
        key = secret "secret-key"
        mJwt = decode $ encodeSigned HS256 key cs
    let (Just unverified) = mJwt
    cs @=? claims unverified
    Just now @=? fmap secondsSinceEpoch (iat (claims unverified))

case_tokenIssuer = do
    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
    iss' @=? tokenIssuer t

case_encodeDecodeJWTClaimsSetCustomClaims = do
    let now = 1234
        cs = def {
        iss = stringOrURI "Foo"
      , iat = intDate now
      , unregisteredClaims = Map.fromList [("http://example.com/is_root", Bool True)]
    }
    let secret' = secret "secret"
        jwt = decodeAndVerifySignature secret' $ encodeSigned HS256 secret' cs
    Just cs @=? fmap claims jwt


prop_stringOrURIProp = f
    where f :: StringOrURI -> Bool<commit_msg>Minor refactoring in the case_encodeDecodeJWT test<commit_after>{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables, TemplateHaskell #-}
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
module Web.JWTTests
  (
    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           Data.Time


import           Web.JWT

defaultTestGroup :: TestTree
defaultTestGroup = $(testGroupGenerator)

main :: IO ()
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_intDateDeriveOrd = do
    let i1 = intDate 1231231231 -- Tue  6 Jan 2009 19:40:31 AEDT
        i2 = intDate 1231232231 -- Tue  6 Jan 2009 19:57:11 AEDT
    LT @=? i1 `compare` i2


case_decodeJWT = do
    -- Generated with ruby-jwt
    let input = "<KEY>"
        mJwt = decode input
    True @=? isJust mJwt
    True @=? isJust (fmap signature mJwt)
    let (Just unverified) = mJwt
    Just HS256 @=? alg (header unverified)
    Just "payload" @=? Map.lookup "some" (unregisteredClaims $ claims unverified)

case_verify = do
    -- Generated with ruby-jwt
    let input = "<KEY>"
        mVerified = verify (secret "secret") =<< decode input
    True @=? isJust mVerified

case_decodeAndVerifyJWT = do
    -- Generated with ruby-jwt
    let input = "<KEY>"
        mJwt = decodeAndVerifySignature (secret "secret") input
    True @=? isJust mJwt
    let (Just verified) = mJwt
    Just HS256 @=? alg (header verified)
    Just "payload" @=? Map.lookup "some" (unregisteredClaims $ claims verified)

case_decodeAndVerifyJWTFailing = do
    -- Generated with ruby-jwt, modified to be invalid
    let input = "<KEY>8Gi4ShZqbhK2gxcs2u"
        mJwt = decodeAndVerifySignature (secret "secret") input
    False @=? isJust mJwt

case_decodeInvalidInput = do
    let inputs = ["", "a.", "a.b"]
        result = map decode inputs
    True @=? all isNothing result

case_decodeAndVerifySignatureInvalidInput = do
    let inputs = ["", "a.", "a.b"]
        result = map (decodeAndVerifySignature (secret "secret")) inputs
    True @=? all isNothing result

case_encodeJWTNoMac = do
    let cs = def {
        iss = stringOrURI "Foo"
      , unregisteredClaims = Map.fromList [("http://example.com/is_root", Bool True)]
    }
        jwt = encodeUnsigned cs
    -- Verify the shape of the JWT, ensure the shape of the triple of
    -- <header>.<claims>.<signature>
    let (h:c:s:_) = T.splitOn "." jwt
    False @=? T.null h
    False @=? T.null c
    True  @=? T.null s


case_encodeDecodeJWTNoMac = do
    let cs = def {
        iss = stringOrURI "Foo"
      , unregisteredClaims = Map.fromList [("http://example.com/is_root", Bool True)]
    }
        mJwt = decode $ encodeUnsigned cs
    True @=? isJust mJwt
    let (Just unverified) = mJwt
    cs @=? claims unverified

case_encodeDecodeJWT = do
    let now = 1394573404
        cs = def {
        iss = stringOrURI "Foo"
      , iat = intDate now
      , unregisteredClaims = Map.fromList [("http://example.com/is_root", Bool True)]
    }
        key = secret "secret-key"
        mJwt = decode $ encodeSigned HS256 key cs
    let (Just claims') = fmap claims mJwt
    cs @=? claims'
    Just now @=? fmap secondsSinceEpoch (iat claims')

case_tokenIssuer = do
    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
    iss' @=? tokenIssuer t

case_encodeDecodeJWTClaimsSetCustomClaims = do
    let now = 1234
        cs = def {
        iss = stringOrURI "Foo"
      , iat = intDate now
      , unregisteredClaims = Map.fromList [("http://example.com/is_root", Bool True)]
    }
    let secret' = secret "secret"
        jwt = decodeAndVerifySignature secret' $ encodeSigned HS256 secret' cs
    Just cs @=? fmap claims jwt


prop_stringOrURIProp = f
    where f :: StringOrURI -> Bool
{'fraction_non_alphanumeric': 0.1044695161640269, 'fraction_numerical': 0.018442178346712954, 'mean_word_length': 2.5732558139534882, 'pattern_counts': {'":': 0, '<': 21, '<?xml version=': 0, '>': 19, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 2, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4521968', 'n_tokens_mistral': 3192, 'n_tokens_neox': 3007, 'n_words': 868}