search

frasertweedale / hs-jose

Haskell JOSE and JWT library
http://hackage.haskell.org/package/jose
Apache License 2.0
122 stars 46 forks source link

decodeCompact . encodeCompact /= pure #102

Closed brandon-leapyear closed 2 years ago

brandon-leapyear commented 2 years ago

GHCi Repro:

import Control.Monad.Except
import Crypto.JWT
jwk <- genJWK $ RSAGenParam 256
let header = newJWSHeader ((), RS512)
:{
runExceptT $ do
  token <- signClaims jwk header emptyClaimsSet
  token' <- decodeCompact . encodeCompact $ token
  return $ token == token'
  :: IO (Either JWTError Bool)
:}

The above returns Right True in lts-18.0 and Right False in nightly-2021-07-12

frasertweedale commented 2 years ago

Thank you for the report. Can you please also print the encoded tokens?

brandon-leapyear commented 2 years ago

:sparkles: This is an old work account. Please reference @brandonchinn178 for all future communication :sparkles:

By virtue of genJWK, it'll be different each time, but here's an example from a run:

eyJhbGciOiJSUzUxMiJ9.e30.bzEhwbJwcrrsFeBU_3TXZfRChZKWyG2vYDbwbAlx6LD4EnSw-lU1zWalOJGVAIWNAWia4JMBSSSkfGO5FXTYvjdYlExo_ikx7XU4cDytWxhoE8yrtId0Eo2y_snPfR0zb9FD7oddTAygwRyeOPMCMUoZ9icvYhFFtZCZP7OKCnsDm4R45UOReyh_zJbgEO2MWGVIQK0vgOpT9fpM96SPVVUKisVa_HcqFNciHkFhdoddQMvXVb53alNaaeijE6S0PWmrOLh-dhX43xAYqozQyFSUi38lfCb-vMQFOGucz9l1WePWZ_sAxve1Q2wiwTWCoIbYNggoa7nR1UieS-jmPA

Notably, when decoding it, I get the following in the nightly snapshot

Right JWS Base64Octets "\160)" Identity (...)

as opposed to lts-18:

Right JWS Base64Octets "{}" Identity (...)
frasertweedale commented 2 years ago

Very strange. I probably won't get around to investigating it until the weekend.

frasertweedale commented 2 years ago

Can you please advise the platform, default character set, etc?

brandon-leapyear commented 2 years ago

:sparkles: This is an old work account. Please reference @brandonchinn178 for all future communication :sparkles:

Weirdly, it might be some race condition in the applicative FromJSON (JWS Identity p a) implementation.

let Object obj = object [("payload", "e30"), ("protected", "eyJhbGciOiJSUzUxMiJ9"), ("signature", "bzEhwbJwcrrsFeBU_3TXZfRChZKWyG2vYDbwbAlx6LD4EnSw-lU1zWalOJGVAIWNAWia4JMBSSSkfGO5FXTYvjdYlExo_ikx7XU4cDytWxhoE8yrtId0Eo2y_snPfR0zb9FD7oddTAygwRyeOPMCMUoZ9icvYhFFtZCZP7OKCnsDm4R45UOReyh_zJbgEO2MWGVIQK0vgOpT9fpM96SPVVUKisVa_HcqFNciHkFhdoddQMvXVb53alNaaeijE6S0PWmrOLh-dhX43xAYqozQyFSUi38lfCb-vMQFOGucz9l1WePWZ_sAxve1Q2wiwTWCoIbYNggoa7nR1UieS-jmPA")]
parse (\o -> (,) <$> o .: "payload" <*> parseJSON (Object o)) obj :: Result (Base64Octets, Signature () JWSHeader)

Running the second line repeatedly sometimes shows Base64Octets "{}" and sometimes shows Base64Octets "\160)", whereas repeatedly running

parse (\o -> (,) <$> o .: "payload" <*> pure ()) obj' :: Result (Base64Octets, ())

consistently shows Base64Octets "{}".

It's strange; it seems like somehow the parseJSON instance of Signature is affecting how o .: "payload" is parsed?

Can you please advise the platform, default character set, etc?

I'm on Mac OS, using stack ghci. I should be using en_US.UTF-8, but I'm not sure how to verify that

Update: verified my locale:

$ locale
LANG="en_US.UTF-8"
LC_COLLATE="en_US.UTF-8"
LC_CTYPE="en_US.UTF-8"
LC_MESSAGES="en_US.UTF-8"
LC_MONETARY="en_US.UTF-8"
LC_NUMERIC="en_US.UTF-8"
LC_TIME="en_US.UTF-8"
LC_ALL=
brandon-leapyear commented 2 years ago

:sparkles: This is an old work account. Please reference @brandonchinn178 for all future communication :sparkles:

More data points: Rewriting with monadic actions doesn't help, still flakily showing both {} and \160):

parse (\o -> (,) <$> o .: "payload" <*> parseJSON (Object o) ) obj :: Result (Base64Octets, Signature () JWSHeader)
parse (\o -> o .: "payload" >>= \p -> parseJSON (Object o) >>= \s -> pure (p, s)) obj :: Result (Base64Octets, Signature () JWSHeader)

But doing the parseJSON first (either applicative or monadic) consistently shows {}:

parse (\o -> (,) <$> parseJSON (Object o) <*> o .: "payload") obj :: Result (Signature () JWSHeader, Base64Octets)
parse (\o -> parseJSON (Object o) >>= \s -> o .: "payload" >>= \p -> pure (p, s)) obj :: Result (Base64Octets, Signature () JWSHeader)
frasertweedale commented 2 years ago

MacOS... what architecture? Is it one of those new ARM CPUs?

brandon-leapyear commented 2 years ago

:sparkles: This is an old work account. Please reference @brandonchinn178 for all future communication :sparkles:

No, it's the normal one, before they switched to ARM

On Mon, Jul 12, 2021, 6:28 PM Fraser Tweedale @.***> wrote:

MacOS... what architecture? Is it one of those new ARM CPUs?

— You are receiving this because you authored the thread. Reply to this email directly, view it on GitHub https://github.com/frasertweedale/hs-jose/issues/102#issuecomment-878706672, or unsubscribe https://github.com/notifications/unsubscribe-auth/AGUC75NIKVE5J4SEHJWTHHLTXOJFFANCNFSM5AH24P4A .

frasertweedale commented 2 years ago

@brandon-leapyear what happens if you try:

parse (\o -> (,) <$> o .: "payload" <*> parseJSON (Object o) ) obj
  :: Result (T.Text, Signature () JWSHeader)

Does it give consistent results?

brandon-leapyear commented 2 years ago

:sparkles: This is an old work account. Please reference @brandonchinn178 for all future communication :sparkles:

Yeah, it's consistently e30

frasertweedale commented 2 years ago

Baffling. I'll try and find time to set up an environment and repro later this week.

brandon-leapyear commented 2 years ago

:sparkles: This is an old work account. Please reference @brandonchinn178 for all future communication :sparkles:

Got it repro'd here: https://github.com/frasertweedale/hs-jose/compare/master...brandon-leapyear:chinn/decode-encode

All the existing tests + the new test passes until switching the compiler to GHC 9. Then it gets two test failures: "JWK round-trip" and the new "JWT compact round-trip" test I wrote. (Not sure where to put the new "JWT compact round-trip" test, or if it should be broken down even more. In any case, none of the existing tests seem to be catching it, so there's some test coverage lacking somewhere). Frustratingly, it seems that the new "JWT compact round-trip" test only fails when run in parallel; it passes when it's the only test running.

It probably has to do with parseB64Url, as I'm noticing the breakages happening around Base64Octets and Base64Integer. The failing test case for JWK seems to decode all the Base64Integer values as 128. Switching from base64-bytestring-1.1.0.0 to base64-bytestring-1.2.0.1 decodes all the Base64Integer values as 64.

brandon-leapyear commented 2 years ago

:sparkles: This is an old work account. Please reference @brandonchinn178 for all future communication :sparkles:

Ah yes, it's probably parseB64Url. The following results are consistent:

ghci> parse (parseB64Url pure) "e30"
Success "{}"
ghci> (,) <$> parse (parseB64Url pure) "e30" <*> parse (parseB64Url pure) "e30"
Success ("\160I","\160I")

Specifically, base64url:

ghci> preview base64url ("e30" :: ByteString) :: Maybe ByteString 
Just "{}"
ghci> (,) <$> preview base64url ("e30" :: ByteString) <*> preview base64url ("e30" :: ByteString) :: Maybe (ByteString, ByteString)
Just ("\160\137","\160\137")

oddly enough, it changes between lazy and strict bytestring, although i don't think it's relevant here

ghci> preview base64url ("e30" :: ByteString) :: Maybe Lazy.ByteString 
Just "\160\137"
ghci> preview base64url ("e30" :: ByteString) :: Maybe ByteString 
Just "{}"
frasertweedale commented 2 years ago

@brandon-leapyear I am able to reproduce it on Linux with GHC 9.0.1. Still, I don't have much time to devote to analysing this right now. It might take a little while.

frasertweedale commented 2 years ago

@brandon-leapyear it seems the issue is in the base64-bytestring library itself:

ghci> import qualified Data.ByteString.Base64.URL as B64U
ghci> :set -XOverloadedStrings
ghci> emptyObj = "e30" :: B.ByteString
ghci> (,) <$> B64U.decodeUnpadded emptyObj <*> B64U.decodeUnpadded emptyObj :: Either String (B.ByteString, B.ByteString)
Right (" \161","{}")
frasertweedale commented 2 years ago

@brandon-leapyear are you happy for me to push your improvements to the jose test suite?

brandon-leapyear commented 2 years ago

:sparkles: This is an old work account. Please reference @brandonchinn178 for all future communication :sparkles:

Oh interesting. Yeah, feel free to merge/cherry-pick any of my changes. Did you open an issue in base64-bytestring, or shall I?

On Tue, Jul 13, 2021, 5:04 PM Fraser Tweedale @.***> wrote:

@brandon-leapyear https://github.com/brandon-leapyear are you happy for me to push your improvements to the jose test suite?

— You are receiving this because you were mentioned. Reply to this email directly, view it on GitHub https://github.com/frasertweedale/hs-jose/issues/102#issuecomment-879482441, or unsubscribe https://github.com/notifications/unsubscribe-auth/AGUC75NJF6WTRPGSPLNSUR3TXTIA5ANCNFSM5AH24P4A .

frasertweedale commented 2 years ago

Did you open an issue in base64-bytestring, or shall I?

@brandon-leapyear I opened it: https://github.com/haskell/base64-bytestring/issues/44

frasertweedale commented 2 years ago

@brandon-leapyear I think I have a fix: https://github.com/haskell/base64-bytestring/pull/45

frasertweedale commented 2 years ago

I will leave this ticket open until:

emilypi commented 2 years ago

I've provided a PR in base64-bytestring#46 that I think fixes this. Could you folks confirm that this works on your end?

  1. Add a cabal.project (or stack equivalent) pinning base64-bytestring to 4114eabcc61a44d406583d90fd4bff7bc28aed40: 
packages: .

source-repository-package
    type: git
    location: https://github.com/haskell/base64-bytestring.git
    tag: 4114eabcc61a44d406583d90fd4bff7bc28aed40
  1. build the project and confirm the fix works: 
...
[18 of 18] Compiling Crypto.JWT       ( src/Crypto/JWT.hs, interpreted )
Ok, 18 modules loaded.
П> import Control.Monad.Except
П> import Crypto.JWT
П> jwk <- genJWK $ RSAGenParam 256

<interactive>:3:1: warning: [-Wname-shadowing]
    This binding for ‘jwk’ shadows the existing binding
      imported from ‘Crypto.JWT’
      (and originally defined in ‘Crypto.JOSE.Header’
         at src/Crypto/JOSE/Header.hs:322:3-48)
П> let header = newJWSHeader ((), RS512)

<interactive>:4:5: warning: [-Wname-shadowing]
    This binding for ‘header’ shadows the existing binding
      imported from ‘Crypto.JWT’
      (and originally defined in ‘Crypto.JOSE.JWS’
         at src/Crypto/JOSE/JWS.hs:290:1-6)
П> :{
*Crypto.JOSE Control.Monad.Except Crypto.JWT| runExceptT $ do
*Crypto.JOSE Control.Monad.Except Crypto.JWT|   token <- signClaims jwk header emptyClaimsSet
*Crypto.JOSE Control.Monad.Except Crypto.JWT|   token' <- decodeCompact . encodeCompact $ token
*Crypto.JOSE Control.Monad.Except Crypto.JWT|   return $ token == token'
*Crypto.JOSE Control.Monad.Except Crypto.JWT|   :: IO (Either JWTError Bool)
*Crypto.JOSE Control.Monad.Except Crypto.JWT| :}
Right True

If you tell me it's good, I'll have a fix out within 24 hours of you giving the :+1:

brandon-leapyear commented 2 years ago

:sparkles: This is an old work account. Please reference @brandonchinn178 for all future communication :sparkles:

I've been using the fix in haskell/base64-bytestring#45, which works. Just verified that the fix in haskell/base64-bytestring#46 also seems to work.

frasertweedale commented 2 years ago

New release: https://hackage.haskell.org/package/jose-0.8.4.1

Thanks @brandon-leapyear for all your assistance with this issue!