decodeCompact . encodeCompact /= pure

Question

decodeCompact . encodeCompact /= pure

brandon-leapyear opened this issue 3 years ago · 23 comments

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

Answer 1 · 2021-07-13T00:36:55.000Z

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

Answer 2 · 2021-07-13T00:39:25.000Z

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

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 (...)

Answer 3 · 2021-07-13T01:00:21.000Z

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

Answer 4 · 2021-07-13T01:01:29.000Z

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

Answer 5 · 2021-07-13T01:03:46.000Z

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

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=

Answer 6 · 2021-07-13T01:10:06.000Z

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

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)

Answer 7 · 2021-07-13T01:28:39.000Z

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

Answer 8 · 2021-07-13T01:30:47.000Z

✨ _**This is an old work account. Please reference @brandonchinn178 for all future communication**_ ✨

…

--- 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 <#102 (comment)>, or unsubscribe <https://github.com/notifications/unsubscribe-auth/AGUC75NIKVE5J4SEHJWTHHLTXOJFFANCNFSM5AH24P4A> .

Answer 9 · 2021-07-13T01:46:22.000Z

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

Answer 10 · 2021-07-13T02:10:53.000Z

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

Yeah, it's consistently e30

Answer 11 · 2021-07-13T02:36:40.000Z

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

Answer 12 · 2021-07-13T03:59:29.000Z

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

Got it repro'd here: 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.

Answer 13 · 2021-07-13T16:37:20.000Z

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

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 "{}"

Answer 14 · 2021-07-13T23:52:30.000Z

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

Answer 15 · 2021-07-13T23:58:50.000Z

@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","{}")

Answer 16 · 2021-07-14T00:04:19.000Z

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

Answer 17 · 2021-07-14T00:35:20.000Z

✨ _**This is an old work account. Please reference @brandonchinn178 for all future communication**_ ✨

…

--- 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 <#102 (comment)>, or unsubscribe <https://github.com/notifications/unsubscribe-auth/AGUC75NJF6WTRPGSPLNSUR3TXTIA5ANCNFSM5AH24P4A> .

Answer 18 · 2021-07-14T00:52:45.000Z

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

@brandon-leapyear I opened it: haskell/base64-bytestring#44

Answer 19 · 2021-07-14T01:17:21.000Z

@brandon-leapyear I think I have a fix: haskell/base64-bytestring#45

Answer 20 · 2021-07-14T01:34:17.000Z

I will leave this ticket open until:

I push the test improvements contributed by @brandon-leapyear
base64-bytestring merges a fix and cuts a new release
I bump jose deps to depend on fixed base64-bytestring and cut a new release.

Answer 21 · 2021-08-02T22:21:38.000Z

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

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

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 👍

Answer 22 · 2021-08-09T18:04:32.000Z

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

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.

Answer 23 · 2021-08-17T06:36:04.000Z

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

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