diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,7 @@ +### 0.5.0.1 + +* [#159](https://github.com/tweag/webauthn/pull/159) Allow mtl-2.3.1 and support GHC 9.4 + ### 0.5.0.0 * [#157](https://github.com/tweag/webauthn/pull/157) Add support for the [credProps](https://www.w3.org/TR/webauthn-2/#sctn-authenticator-credential-properties-extension) extension diff --git a/src/Crypto/WebAuthn/AttestationStatementFormat/AndroidKey.hs b/src/Crypto/WebAuthn/AttestationStatementFormat/AndroidKey.hs --- a/src/Crypto/WebAuthn/AttestationStatementFormat/AndroidKey.hs +++ b/src/Crypto/WebAuthn/AttestationStatementFormat/AndroidKey.hs @@ -264,7 +264,8 @@ (CBOR.TString "alg", CBOR.TInt $ Cose.fromCoseSignAlg $ Cose.signAlg pubKeyAndAlg), ( CBOR.TString "x5c", CBOR.TList $ - map (CBOR.TBytes . X509.encodeSignedObject) $ toList x5c + map (CBOR.TBytes . X509.encodeSignedObject) $ + toList x5c ) ] diff --git a/src/Crypto/WebAuthn/AttestationStatementFormat/AndroidSafetyNet.hs b/src/Crypto/WebAuthn/AttestationStatementFormat/AndroidSafetyNet.hs --- a/src/Crypto/WebAuthn/AttestationStatementFormat/AndroidSafetyNet.hs +++ b/src/Crypto/WebAuthn/AttestationStatementFormat/AndroidSafetyNet.hs @@ -94,7 +94,7 @@ } deriving (Eq, Show, Generic, Aeson.FromJSON, Aeson.ToJSON) --- | Milliseconds represented as an 'Integer', used for 'timestampMs' +-- | Milliseconds represented as an 'Integer', used for @timestampMs@ newtype Milliseconds = Milliseconds Integer deriving (Eq, Show) deriving newtype (Aeson.FromJSON, Aeson.ToJSON) @@ -180,7 +180,8 @@ (Just (TString ver), Just (TBytes responseRaw)) -> do jws <- first (("Failed to decode compact JWT response blob: " <>) . Text.pack . show) $ - runExcept @JOSE.Error $ JOSE.decodeCompact (LBS.fromStrict responseRaw) + runExcept @JOSE.Error $ + JOSE.decodeCompact (LBS.fromStrict responseRaw) response <- first (("Failed to verify/decode JWT payload: " <>) . Text.pack . show) $ JOSE.verifyJWSWithPayload @@ -256,7 +257,8 @@ (True, False) -> BasicIntegrity (False, False) -> NoIntegrity unless (integrity >= requiredIntegrity) $ - failure $ IntegrityCheckFailed integrity + failure $ + IntegrityCheckFailed integrity -- 5. If successful, return implementation-specific values representing attestation type Basic and attestation trust -- path x5c. diff --git a/src/Crypto/WebAuthn/AttestationStatementFormat/Apple.hs b/src/Crypto/WebAuthn/AttestationStatementFormat/Apple.hs --- a/src/Crypto/WebAuthn/AttestationStatementFormat/Apple.hs +++ b/src/Crypto/WebAuthn/AttestationStatementFormat/Apple.hs @@ -18,8 +18,7 @@ import qualified Codec.CBOR.Term as CBOR import Control.Exception (Exception) -import Control.Monad (forM) -import Control.Monad.Cont (unless) +import Control.Monad (forM, unless) import Crypto.Hash (Digest, SHA256, digestFromByteString, hash) import qualified Crypto.WebAuthn.Cose.Internal.Verify as Cose import qualified Crypto.WebAuthn.Cose.PublicKey as Cose diff --git a/src/Crypto/WebAuthn/AttestationStatementFormat/FidoU2F.hs b/src/Crypto/WebAuthn/AttestationStatementFormat/FidoU2F.hs --- a/src/Crypto/WebAuthn/AttestationStatementFormat/FidoU2F.hs +++ b/src/Crypto/WebAuthn/AttestationStatementFormat/FidoU2F.hs @@ -136,7 +136,8 @@ Just (xb, yb) -> do -- We decode the x and y values in an earlier stage of the process. In order to construct the publicKeyU2F, we have to reencode the value. unless (BS.length xb == 32 && BS.length yb == 32) $ - failure $ CoordinateSizeInvalid (BS.length xb) (BS.length yb) + failure $ + CoordinateSizeInvalid (BS.length xb) (BS.length yb) -- 4.c Let publicKeyU2F be the concatenation 0x04 || x || y. let publicKeyU2F = BS.singleton 0x04 <> xb <> yb diff --git a/src/Crypto/WebAuthn/Cose/Internal/Verify.hs b/src/Crypto/WebAuthn/Cose/Internal/Verify.hs --- a/src/Crypto/WebAuthn/Cose/Internal/Verify.hs +++ b/src/Crypto/WebAuthn/Cose/Internal/Verify.hs @@ -116,7 +116,7 @@ public_q = ECC.Point ecdsaX ecdsaY -- This check is already done in checkPublicKey - --unless (ECC.isPointValid public_curve public_q) $ + -- unless (ECC.isPointValid public_curve public_q) $ -- Left $ "ECDSA point is not valid for curve " <> Text.pack (show curveName) <> ": " <> Text.pack (show public_q) let key = ECDSA.PublicKey {..} diff --git a/src/Crypto/WebAuthn/Cose/PublicKey.hs b/src/Crypto/WebAuthn/Cose/PublicKey.hs --- a/src/Crypto/WebAuthn/Cose/PublicKey.hs +++ b/src/Crypto/WebAuthn/Cose/PublicKey.hs @@ -131,26 +131,26 @@ checkPublicKey key@PublicKeyEdDSA {..} | actualSize == expectedSize = Right $ CheckedPublicKey key | otherwise = - Left $ - "EdDSA public key for curve " - <> Text.pack (show eddsaCurve) - <> " didn't have the expected size of " - <> Text.pack (show expectedSize) - <> " bytes, it has " - <> Text.pack (show actualSize) - <> " bytes instead: " - <> Text.decodeUtf8 (Base16.encode eddsaX) + Left $ + "EdDSA public key for curve " + <> Text.pack (show eddsaCurve) + <> " didn't have the expected size of " + <> Text.pack (show expectedSize) + <> " bytes, it has " + <> Text.pack (show actualSize) + <> " bytes instead: " + <> Text.decodeUtf8 (Base16.encode eddsaX) where actualSize = BS.length eddsaX expectedSize = coordinateSizeEdDSA eddsaCurve checkPublicKey key@PublicKeyECDSA {..} | ECC.isPointValid curve point = Right $ CheckedPublicKey key | otherwise = - Left $ - "ECDSA public key point is not valid for curve " - <> Text.pack (show ecdsaCurve) - <> ": " - <> Text.pack (show point) + Left $ + "ECDSA public key point is not valid for curve " + <> Text.pack (show ecdsaCurve) + <> ": " + <> Text.pack (show point) where curve = ECC.getCurveByName (toCryptCurveECDSA ecdsaCurve) point = ECC.Point ecdsaX ecdsaY diff --git a/src/Crypto/WebAuthn/Cose/PublicKeyWithSignAlg.hs b/src/Crypto/WebAuthn/Cose/PublicKeyWithSignAlg.hs --- a/src/Crypto/WebAuthn/Cose/PublicKeyWithSignAlg.hs +++ b/src/Crypto/WebAuthn/Cose/PublicKeyWithSignAlg.hs @@ -237,23 +237,24 @@ os2ipWithSize size bytes | BS.length bytes == size = pure $ os2ip bytes | otherwise = - fail $ - "bytes have length " <> show (BS.length bytes) - <> " when length " - <> show size - <> " was expected" + fail $ + "bytes have length " + <> show (BS.length bytes) + <> " when length " + <> show size + <> " was expected" -- | Same as 'os2ip', but throws an error if there are leading zero bytes. Thus any successful result of this function will give the same 'BS.ByteString' back if encoded with 'i2osp'. os2ipNoLeading :: MonadFail m => BS.ByteString -> m Integer os2ipNoLeading bytes | leadingZeroCount == 0 = pure $ os2ip bytes | otherwise = - fail $ - "bytes of length " - <> show (BS.length bytes) - <> " has " - <> show leadingZeroCount - <> " leading zero bytes when none were expected" + fail $ + "bytes of length " + <> show (BS.length bytes) + <> " has " + <> show leadingZeroCount + <> " leading zero bytes when none were expected" where leadingZeroCount = BS.length (BS.takeWhile (== 0) bytes) @@ -262,7 +263,8 @@ decodeExpected expected = do actual <- decode unless (expected == actual) $ - fail $ "Expected " <> show expected <> " but got " <> show actual + fail $ + "Expected " <> show expected <> " but got " <> show actual fromCurveEdDSA :: P.CoseCurveEdDSA -> R.CoseEllipticCurveOKP fromCurveEdDSA P.CoseCurveEd25519 = R.CoseEllipticCurveEd25519 diff --git a/src/Crypto/WebAuthn/Encoding/Binary.hs b/src/Crypto/WebAuthn/Encoding/Binary.hs --- a/src/Crypto/WebAuthn/Encoding/Binary.hs +++ b/src/Crypto/WebAuthn/Encoding/Binary.hs @@ -77,9 +77,9 @@ The functions in this module are grouped and named according to the following conventions: -* If the type is parametrized by @raw@, there should be @stripRaw@ and + * If the type is parametrized by @raw@, there should be @stripRaw@ and @encodeRaw@ functions -* If the type is serializable there should be a @decode@ + * If the type is serializable there should be a @decode@ * In addition, if the type has a raw field for its own encoding (implying that it's parametrized by @raw@), no other function needs to be provided * Alternatively, there should be an @encode@ that encodes the type, using @@ -88,9 +88,9 @@ If the type is parametrized by @raw@, this module should guarantee these invariants for any @value :: TheType (raw ~ False)@: -* @stripRaw@ doesn't change any fields: @stripRaw value = value@ -* @encodeRaw@ doesn't change any fields: @stripRaw (encodeRaw value) = value@ -* If the type is also serializable: + * @stripRaw@ doesn't change any fields: @stripRaw value = value@ + * @encodeRaw@ doesn't change any fields: @stripRaw (encodeRaw value) = value@ + * If the type is also serializable: * If the type has a raw field, @decode@ inverses @encodeRaw@ and @getEncoded@: @stripRaw (decode (getEncoded (encodeRaw value))) = value@ * Alternatively, @decode@ inverses @encodeRaw@ and @encode@: @@ -99,7 +99,7 @@ If the type is only serializable then this invariant should hold for any @value :: TheType@ -* @decode@ inverses @encode@: @decode (encode value) = value@ + * @decode@ inverses @encode@: @decode (encode value) = value@ If any such functions are expected to be used only internally, they may not be exported @@ -111,13 +111,13 @@ -- custom binary format the -- [binary](https://hackage.haskell.org/package/binary) library. However these -- two libraries don't interact nicely with each other. Because of this we are --- specifying decoders that don't consume all input as a 'PartialBinaryDecoder --- DecodingError', which is just a function that can partially consume a --- 'LBS.ByteString'. Using this we can somewhat easily flip between the two +-- specifying decoders that don't consume all input as a @PartialBinaryDecoder@, +-- which is just a state monad transformer over an 'LBS.ByteString'. +-- Using this we can somewhat easily flip between the two -- libraries while decoding without too much nastiness. type PartialBinaryDecoder a = StateT LBS.ByteString (Either Text) a --- | Runs a 'PartialBinaryDecoder' using a strict bytestring. Afterwards it +-- | Runs a @PartialBinaryDecoder@ using a strict bytestring. Afterwards it -- makes sure that no bytes are left, otherwise returns an error. runPartialBinaryDecoder :: BS.ByteString -> @@ -129,11 +129,11 @@ Right (result, rest) | LBS.null rest -> return result | otherwise -> - Left $ - "Not all binary input used, rest in base64 format is: " - <> decodeUtf8 (Base64.encode $ LBS.toStrict rest) + Left $ + "Not all binary input used, rest in base64 format is: " + <> decodeUtf8 (Base64.encode $ LBS.toStrict rest) --- | A 'PartialBinaryDecoder' for a binary encoding specified using +-- | A @PartialBinaryDecoder@ for a binary encoding specified using -- 'Binary.Get'. runBinary :: Binary.Get a -> @@ -147,7 +147,7 @@ put rest pure result --- | A 'PartialBinaryDecoder' for a CBOR encoding specified using the given +-- | A @PartialBinaryDecoder@ for a CBOR encoding specified using the given -- 'CBOR.Decoder'. runCBOR :: (forall s. CBOR.Decoder s a) -> diff --git a/src/Crypto/WebAuthn/Encoding/Internal/WebAuthnJson.hs b/src/Crypto/WebAuthn/Encoding/Internal/WebAuthnJson.hs --- a/src/Crypto/WebAuthn/Encoding/Internal/WebAuthnJson.hs +++ b/src/Crypto/WebAuthn/Encoding/Internal/WebAuthnJson.hs @@ -23,6 +23,9 @@ PublicKeyCredentialRpEntity (..), PublicKeyCredentialUserEntity (..), PublicKeyCredentialParameters (..), + AuthenticationExtensionsClientInputs (..), + AuthenticationExtensionsClientOutputs (..), + CredentialPropertiesOutput (..), COSEAlgorithmIdentifier, PublicKeyCredentialDescriptor (..), AuthenticatorSelectionCriteria (..), diff --git a/src/Crypto/WebAuthn/Operation/Authentication.hs b/src/Crypto/WebAuthn/Operation/Authentication.hs --- a/src/Crypto/WebAuthn/Operation/Authentication.hs +++ b/src/Crypto/WebAuthn/Operation/Authentication.hs @@ -245,17 +245,17 @@ case (midentifiedUser, mUserHandler) of (Just identifiedUser, Just userHandle) | identifiedUser /= owner -> - failure $ AuthenticationIdentifiedUserHandleMismatch identifiedUser owner + failure $ AuthenticationIdentifiedUserHandleMismatch identifiedUser owner | userHandle /= owner -> - failure $ AuthenticationCredentialUserHandleMismatch userHandle owner + failure $ AuthenticationCredentialUserHandleMismatch userHandle owner | otherwise -> pure () (Just identifiedUser, Nothing) | identifiedUser /= owner -> - failure $ AuthenticationIdentifiedUserHandleMismatch identifiedUser owner + failure $ AuthenticationIdentifiedUserHandleMismatch identifiedUser owner | otherwise -> pure () (Nothing, Just userHandle) | userHandle /= owner -> - failure $ AuthenticationCredentialUserHandleMismatch userHandle owner + failure $ AuthenticationCredentialUserHandleMismatch userHandle owner | otherwise -> pure () (Nothing, Nothing) -> failure AuthenticationCannotVerifyUserHandle @@ -286,11 +286,13 @@ -- 12. Verify that the value of C.challenge equals the base64url encoding of options.challenge. unless (M.ccdChallenge c == M.coaChallenge options) $ - failure $ AuthenticationChallengeMismatch (M.coaChallenge options) (M.ccdChallenge c) + failure $ + AuthenticationChallengeMismatch (M.coaChallenge options) (M.ccdChallenge c) -- 13. Verify that the value of C.origin matches the Relying Party's origin. unless (M.ccdOrigin c == origin) $ - failure $ AuthenticationOriginMismatch origin (M.ccdOrigin c) + failure $ + AuthenticationOriginMismatch origin (M.ccdOrigin c) -- 14. Verify that the value of C.tokenBinding.status matches the state of -- Token Binding for the TLS connection over which the attestation was @@ -305,7 +307,8 @@ -- Note: If using the appid extension, this step needs some special logic. -- See ยง 10.1 FIDO AppID Extension (appid) for details. unless (M.adRpIdHash authData == rpIdHash) $ - failure $ AuthenticationRpIdHashMismatch rpIdHash (M.adRpIdHash authData) + failure $ + AuthenticationRpIdHashMismatch rpIdHash (M.adRpIdHash authData) -- 16. Verify that the User Present bit of the flags in authData is set. unless (M.adfUserPresent (M.adFlags authData)) $ diff --git a/src/Crypto/WebAuthn/Operation/Registration.hs b/src/Crypto/WebAuthn/Operation/Registration.hs --- a/src/Crypto/WebAuthn/Operation/Registration.hs +++ b/src/Crypto/WebAuthn/Operation/Registration.hs @@ -334,11 +334,13 @@ -- 8. Verify that the value of C.challenge equals the base64url encoding of -- options.challenge. unless (corChallenge == M.ccdChallenge c) $ - failure $ RegistrationChallengeMismatch corChallenge (M.ccdChallenge c) + failure $ + RegistrationChallengeMismatch corChallenge (M.ccdChallenge c) -- 9. Verify that the value of C.origin matches the Relying Party's origin. unless (rpOrigin == M.ccdOrigin c) $ - failure $ RegistrationOriginMismatch rpOrigin (M.ccdOrigin c) + failure $ + RegistrationOriginMismatch rpOrigin (M.ccdOrigin c) -- 10. Verify that the value of C.tokenBinding.status matches the state of -- Token Binding for the TLS connection over which the assertion was @@ -363,7 +365,8 @@ -- 13. Verify that the rpIdHash in authData is the SHA-256 hash of the RP -- ID expected by the Relying Party. unless (rpIdHash == M.adRpIdHash authData) $ - failure $ RegistrationRpIdHashMismatch rpIdHash (M.adRpIdHash authData) + failure $ + RegistrationRpIdHashMismatch rpIdHash (M.adRpIdHash authData) -- 14. Verify that the User Present bit of the flags in authData is set. unless (M.adfUserPresent (M.adFlags authData)) $ @@ -391,7 +394,8 @@ let acdAlg = Cose.signAlg acdCredentialPublicKey desiredAlgs = map M.cpAlg corPubKeyCredParams unless (acdAlg `elem` desiredAlgs) $ - failure $ RegistrationPublicKeyAlgorithmDisallowed desiredAlgs acdAlg + failure $ + RegistrationPublicKeyAlgorithmDisallowed desiredAlgs acdAlg -- 17. Verify that the values of the client extension outputs in -- clientExtensionResults and the authenticator extension outputs in the diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -345,10 +345,10 @@ isExpectedAttestationResponse M.Credential {..} M.CredentialOptionsRegistration {..} verifiable (Right O.RegistrationResult {..}) = rrEntry == expectedCredentialEntry && not verifiable - || ( case rrAttestationStatement of - O.SomeAttestationStatement _ O.VerifiedAuthenticator {} -> True - _ -> False - ) + || ( case rrAttestationStatement of + O.SomeAttestationStatement _ O.VerifiedAuthenticator {} -> True + _ -> False + ) where expectedCredentialEntry :: O.CredentialEntry expectedCredentialEntry = @@ -356,7 +356,8 @@ { ceCredentialId = cIdentifier, ceUserHandle = M.cueId corUser, cePublicKeyBytes = - M.PublicKeyBytes . M.unRaw + M.PublicKeyBytes + . M.unRaw . M.acdCredentialPublicKeyBytes . M.adAttestedCredentialData . M.aoAuthData diff --git a/tests/Spec/Types.hs b/tests/Spec/Types.hs --- a/tests/Spec/Types.hs +++ b/tests/Spec/Types.hs @@ -119,11 +119,11 @@ arbitrary = M.CollectedClientData <$> arbitrary - <*> arbitrary - -- The crossOrigin value can't be roundtripped with Nothing values, - -- so let's just not generate Nothing values here - <*> (Just <$> arbitrary) - <*> arbitrary + <*> arbitrary + -- The crossOrigin value can't be roundtripped with Nothing values, + -- so let's just not generate Nothing values here + <*> (Just <$> arbitrary) + <*> arbitrary instance Arbitrary (M.AttestationObject 'False) where arbitrary = do @@ -142,9 +142,9 @@ arbitrary = elements [ ArbitraryAttestationStatementFormat None.Format - --ArbitraryAttestationStatementFormat Packed.Format, - --ArbitraryAttestationStatementFormat FidoU2F.Format, - --ArbitraryAttestationStatementFormat AndroidKey.Format + -- ArbitraryAttestationStatementFormat Packed.Format, + -- ArbitraryAttestationStatementFormat FidoU2F.Format, + -- ArbitraryAttestationStatementFormat AndroidKey.Format ] instance Arbitrary M.SignatureCounter where diff --git a/webauthn.cabal b/webauthn.cabal --- a/webauthn.cabal +++ b/webauthn.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: webauthn -version: 0.5.0.0 +version: 0.5.0.1 license: Apache-2.0 license-file: LICENSE copyright: @@ -35,7 +35,7 @@ however follow the [PVP](https://pvp.haskell.org/) and properly label changes with the appropriate version increase. category: Web, Authentication -tested-with: GHC == 8.10.7 +tested-with: GHC == 9.2.4 extra-source-files: README.md, changelog.md, @@ -73,7 +73,7 @@ import: sanity hs-source-dirs: src build-depends: - base >= 4.13.0 && < 4.17, + base >= 4.13.0 && < 4.18, aeson >= 1.4.7 && < 2.2, asn1-encoding >= 0.9.6 && < 0.10, asn1-parse >= 0.9.5 && < 0.10, @@ -88,14 +88,14 @@ file-embed >= 0.0.11 && < 0.1, hashable >= 1.3.0 && < 1.5, hourglass >= 0.2.12 && < 0.3, - jose >= 0.8.5 && < 0.10, - lens >= 4.18.1 && < 5.2, - memory >= 0.15.0 && < 0.18, + jose >= 0.8.5 && < 0.11, + lens >= 4.18.1 && < 5.3, + memory >= 0.15.0 && < 0.19, monad-time >= 0.3.1 && < 0.5, - mtl >= 2.2.2 && < 2.3, + mtl >= 2.2.2 && < 2.4, serialise >= 0.2.3 && < 0.3, singletons >= 2.6 && < 3.2, - text >= 1.2.4 && < 1.3, + text >= 1.2.4 && < 2.1, time >= 1.9.3 && < 1.12, unordered-containers >= 0.2.11 && < 0.3, uuid >= 1.3.13 && < 1.4,