packages feed

webauthn 0.4.0.0 → 0.4.1.0

raw patch · 13 files changed

+148/−56 lines, 13 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Crypto.WebAuthn.Encoding.WebAuthnJson: data WJCredentialAuthentication
- Crypto.WebAuthn.Encoding.WebAuthnJson: data WJCredentialOptionsAuthentication
- Crypto.WebAuthn.Encoding.WebAuthnJson: data WJCredentialOptionsRegistration
- Crypto.WebAuthn.Encoding.WebAuthnJson: data WJCredentialRegistration
+ Crypto.WebAuthn.Encoding.WebAuthnJson: WJCredentialAuthentication :: PublicKeyCredential AuthenticatorAssertionResponse -> WJCredentialAuthentication
+ Crypto.WebAuthn.Encoding.WebAuthnJson: WJCredentialOptionsAuthentication :: PublicKeyCredentialRequestOptions -> WJCredentialOptionsAuthentication
+ Crypto.WebAuthn.Encoding.WebAuthnJson: WJCredentialOptionsRegistration :: PublicKeyCredentialCreationOptions -> WJCredentialOptionsRegistration
+ Crypto.WebAuthn.Encoding.WebAuthnJson: WJCredentialRegistration :: PublicKeyCredential AuthenticatorAttestationResponse -> WJCredentialRegistration
+ Crypto.WebAuthn.Encoding.WebAuthnJson: [_unWJCredentialOptionsAuthentication] :: WJCredentialOptionsAuthentication -> PublicKeyCredentialRequestOptions
+ Crypto.WebAuthn.Encoding.WebAuthnJson: [_unWJCredentialOptionsRegistration] :: WJCredentialOptionsRegistration -> PublicKeyCredentialCreationOptions
+ Crypto.WebAuthn.Encoding.WebAuthnJson: [unWJCredentialAuthentication] :: WJCredentialAuthentication -> PublicKeyCredential AuthenticatorAssertionResponse
+ Crypto.WebAuthn.Encoding.WebAuthnJson: [unWJCredentialRegistration] :: WJCredentialRegistration -> PublicKeyCredential AuthenticatorAttestationResponse
+ Crypto.WebAuthn.Encoding.WebAuthnJson: instance Data.Aeson.Types.FromJSON.FromJSON Crypto.WebAuthn.Encoding.WebAuthnJson.WJCredentialOptionsAuthentication
+ Crypto.WebAuthn.Encoding.WebAuthnJson: instance Data.Aeson.Types.FromJSON.FromJSON Crypto.WebAuthn.Encoding.WebAuthnJson.WJCredentialOptionsRegistration
+ Crypto.WebAuthn.Encoding.WebAuthnJson: newtype WJCredentialAuthentication
+ Crypto.WebAuthn.Encoding.WebAuthnJson: newtype WJCredentialOptionsAuthentication
+ Crypto.WebAuthn.Encoding.WebAuthnJson: newtype WJCredentialOptionsRegistration
+ Crypto.WebAuthn.Encoding.WebAuthnJson: newtype WJCredentialRegistration

Files

changelog.md view
@@ -1,3 +1,9 @@+### 0.4.1.0++* [#148](https://github.com/tweag/webauthn/pull/148) Allow authentication on Safari even though it violates the specification with an empty user handle+* [#149](https://github.com/tweag/webauthn/pull/149) Export constructors for `Crypto.WebAuthn.Encoding.WebAuthnJson` types and derive `FromJSON` for all of them+* [#151](https://github.com/tweag/webauthn/pull/151) Fix decoding of packed attestations without a `x5c` CBOR key. This fixes attestation on MacBook Pros with Chrome and TouchID.+ ### 0.4.0.0  * [#129](https://github.com/tweag/webauthn/pull/129) Rename and expand
− root-certs/tpm/AMD/AMD-fTPM-ECC-RootCA.crt

binary file changed (774 → absent bytes)

− root-certs/tpm/AMD/AMD-fTPM-RSA-RootCA.crt

binary file changed (1164 → absent bytes)

src/Crypto/WebAuthn/AttestationStatementFormat/Packed.hs view
@@ -97,35 +97,41 @@    asfDecode _ xs =     case (xs !? "alg", xs !? "sig", xs !? "x5c") of-      (Just (CBOR.TInt algId), Just (CBOR.TBytes sig), Just (CBOR.TList x5cRaw)) -> do+      (Just (CBOR.TInt algId), Just (CBOR.TBytes sig), mx5c) -> do         alg <- Cose.toCoseSignAlg algId-        x5c <- case NE.nonEmpty x5cRaw of+        x5c <- case mx5c of           Nothing -> pure Nothing-          Just x5cBytes -> do-            x5c@(signedCert :| _) <- forM x5cBytes $ \case-              CBOR.TBytes certBytes ->-                first (("Failed to decode signed certificate: " <>) . Text.pack) (X509.decodeSignedCertificate certBytes)-              cert ->-                Left $ "Certificate CBOR value is not bytes: " <> Text.pack (show cert)+          Just (CBOR.TList x5cRaw) -> case NE.nonEmpty x5cRaw of+            Nothing -> pure Nothing+            Just x5cBytes -> do+              x5c@(signedCert :| _) <- forM x5cBytes $ \case+                CBOR.TBytes certBytes ->+                  first (("Failed to decode signed certificate: " <>) . Text.pack) (X509.decodeSignedCertificate certBytes)+                cert ->+                  Left $ "Certificate CBOR value is not bytes: " <> Text.pack (show cert) -            let cert = X509.getCertificate signedCert-            aaguidExt <- case X509.extensionGetE (X509.certExtensions cert) of-              Just (Right ext) -> pure ext-              Just (Left err) -> Left $ "Failed to decode certificate aaguid extension: " <> Text.pack err-              Nothing -> Left "Certificate aaguid extension is missing"-            pure $ Just (x5c, aaguidExt)+              let cert = X509.getCertificate signedCert+              aaguidExt <- case X509.extensionGetE (X509.certExtensions cert) of+                Just (Right ext) -> pure ext+                Just (Left err) -> Left $ "Failed to decode certificate aaguid extension: " <> Text.pack err+                Nothing -> Left "Certificate aaguid extension is missing"+              pure $ Just (x5c, aaguidExt)+          Just _ -> Left $ "CBOR map didn't have expected value types (alg: int, sig: bytes, [optional] x5c: non-empty list): " <> Text.pack (show xs)         pure $ Statement {..}-      _ -> Left $ "CBOR map didn't have expected value types (alg: int, sig: bytes, x5c: list): " <> Text.pack (show xs)+      _ -> Left $ "CBOR map didn't have expected value types (alg: int, sig: bytes, [optional] x5c: non-empty list): " <> Text.pack (show xs)    asfEncode _ Statement {..} =-    let encodedx5c = case x5c of-          Nothing -> []-          Just (certChain, _) -> map (CBOR.TBytes . X509.encodeSignedObject) $ toList certChain-     in CBOR.TMap-          [ (CBOR.TString "sig", CBOR.TBytes sig),-            (CBOR.TString "alg", CBOR.TInt $ Cose.fromCoseSignAlg alg),-            (CBOR.TString "x5c", CBOR.TList encodedx5c)-          ]+    CBOR.TMap+      ( [ (CBOR.TString "sig", CBOR.TBytes sig),+          (CBOR.TString "alg", CBOR.TInt $ Cose.fromCoseSignAlg alg)+        ]+          ++ case x5c of+            Nothing -> []+            Just (certChain, _) ->+              let encodedx5c = map (CBOR.TBytes . X509.encodeSignedObject) $ toList certChain+               in [ (CBOR.TString "x5c", CBOR.TList encodedx5c)+                  ]+      )    type AttStmtVerificationError Format = VerificationError 
src/Crypto/WebAuthn/Encoding/WebAuthnJson.hs view
@@ -8,15 +8,15 @@ module Crypto.WebAuthn.Encoding.WebAuthnJson   ( -- * Registration     wjEncodeCredentialOptionsRegistration,-    WJCredentialOptionsRegistration,-    WJCredentialRegistration,+    WJCredentialOptionsRegistration (..),+    WJCredentialRegistration (..),     wjDecodeCredentialRegistration',     wjDecodeCredentialRegistration,      -- * Authentication     wjEncodeCredentialOptionsAuthentication,-    WJCredentialOptionsAuthentication,-    WJCredentialAuthentication,+    WJCredentialOptionsAuthentication (..),+    WJCredentialAuthentication (..),     wjDecodeCredentialAuthentication,   ) where@@ -46,7 +46,7 @@ newtype WJCredentialOptionsRegistration = WJCredentialOptionsRegistration   { _unWJCredentialOptionsRegistration :: WJ.PublicKeyCredentialCreationOptions   }-  deriving newtype (Show, Eq, ToJSON)+  deriving newtype (Show, Eq, FromJSON, ToJSON)  -- | The intermediate type as an input to 'wjDecodeCredentialRegistration', -- equivalent to the [PublicKeyCredential](https://www.w3.org/TR/webauthn-2/#iface-pkcredential)@@ -96,7 +96,7 @@ newtype WJCredentialOptionsAuthentication = WJCredentialOptionsAuthentication   { _unWJCredentialOptionsAuthentication :: WJ.PublicKeyCredentialRequestOptions   }-  deriving newtype (Show, Eq, ToJSON)+  deriving newtype (Show, Eq, FromJSON, ToJSON)  -- | The intermediate type as an input to 'wjDecodeCredentialAuthentication', -- equivalent to the [PublicKeyCredential](https://www.w3.org/TR/webauthn-2/#iface-pkcredential)
src/Crypto/WebAuthn/Operation/Authentication.hs view
@@ -232,7 +232,17 @@   -- initiated, verify that response.userHandle is present, and that the user   -- identified by this value is the owner of credentialSource.   let owner = ceUserHandle entry-  case (midentifiedUser, M.araUserHandle response) of+  +  -- According to the [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialuserentity-id)+  -- The user handle MUST NOT be empty, though it MAY be null.+  -- For clarification see https://github.com/w3c/webauthn/issues/1722+  -- However, Safari returns an empty string instead of null, see the bug report:+  -- https://bugs.webkit.org/show_bug.cgi?id=239737+  let mUserHandler = case M.araUserHandle response of+        Just (M.UserHandle "") -> Nothing+        userHandle -> userHandle++  case (midentifiedUser, mUserHandler) of     (Just identifiedUser, Just userHandle)       | identifiedUser /= owner ->         failure $ AuthenticationIdentifiedUserHandleMismatch identifiedUser owner
tests/Emulation.hs view
@@ -34,7 +34,7 @@     clientAttestation,   ) import Emulation.Client.Arbitrary ()-import System.Hourglass (dateCurrent)+import Spec.Util (predeterminedDateTime) import Test.Hspec (SpecWith, describe, it, shouldSatisfy) import Test.QuickCheck (property) @@ -127,12 +127,10 @@                 }         -- Since our emulator only supports None attestation the registry can be left empty.         let registry = mempty-        -- The time could also be empty, but since we're in IO anyway, might as well just fetch it.-        now <- dateCurrent         -- We are not currently interested in client or authenticator fails, we         -- only wish to test our relying party implementation and are thus only         -- interested in its errors.-        let Right (registerResult, authenticator', options) = runApp seed (register annotatedOrigin userAgentConformance authenticator registry now)+        let Right (registerResult, authenticator', options) = runApp seed (register annotatedOrigin userAgentConformance authenticator registry predeterminedDateTime)         -- Since we only do None attestation, we only care about the resulting entry         let registerResult' = second O.rrEntry registerResult         registerResult' `shouldSatisfy` validAttestationResult authenticator userAgentConformance options
tests/Main.hs view
@@ -33,23 +33,13 @@ import GHC.Stack (HasCallStack) import qualified MetadataSpec import qualified PublicKeySpec-import Spec.Util (decodeFile)+import Spec.Util (decodeFile, predeterminedDateTime, timeZero) import qualified System.Directory as Directory import System.FilePath ((</>))-import System.Hourglass (dateCurrent) import Test.Hspec (Spec, describe, it, shouldSatisfy) import qualified Test.Hspec as Hspec import Test.QuickCheck.Instances.Text () --- | Attestation requires a specific time to be passed for the verification of the certificate chain.--- For sake of reproducability we hardcode a time.-predeterminedDateTime :: HG.DateTime-predeterminedDateTime = HG.DateTime {dtDate = HG.Date {dateYear = 2021, dateMonth = HG.December, dateDay = 22}, dtTime = timeZero}---- | For most uses of DateTime in these tests, the time of day isn't relevant. This definition allows easier construction of these DateTimes.-timeZero :: HG.TimeOfDay-timeZero = HG.TimeOfDay {todHour = HG.Hours 0, todMin = HG.Minutes 0, todSec = HG.Seconds 0, todNSec = HG.NanoSeconds 0}- -- | Load all files in the given directory, and ensure that all of them can be -- decoded. The caller can pass in a function to run further checks on the -- decoded value, but this is mainly there to ensure that `a` occurs after the@@ -69,8 +59,7 @@ registryFromBlobFile :: IO Service.MetadataServiceRegistry registryFromBlobFile = do   blobBytes <- BS.readFile "tests/golden-metadata/big/blob.jwt"-  now <- dateCurrent-  case Meta.metadataBlobToRegistry blobBytes now of+  case Meta.metadataBlobToRegistry blobBytes predeterminedDateTime of     Left err -> error $ Text.unpack err     Right res -> pure res @@ -120,7 +109,7 @@     "Encoding"     Encoding.spec   -- We test assertion only for none attestation, this is because the type of attestation has no influence on assertion.-  describe "RegisterAndLogin" $+  describe "RegisterAndLogin" $ do     it "tests whether the fixed register and login responses are matching" $       do         pkCredential <-@@ -159,6 +148,44 @@                       M.cClientExtensionResults = M.AuthenticationExtensionsClientOutputs {}                     }         signInResult `shouldSatisfy` isRight+    it "tests whether the fixed register and login responses are matching with empty user handle" $+      do+        pkCredential <-+          either (error . show) id . WJ.wjDecodeCredentialRegistration+            <$> decodeFile+              "tests/responses/attestation/01-none.json"+        let options = defaultPublicKeyCredentialCreationOptions pkCredential+            registerResult =+              toEither $+                O.verifyRegistrationResponse+                  (M.Origin "http://localhost:8080")+                  (M.RpIdHash . hash $ ("localhost" :: ByteString.ByteString))+                  registry+                  predeterminedDateTime+                  options+                  pkCredential+        registerResult `shouldSatisfy` isExpectedAttestationResponse pkCredential options False+        let Right O.RegistrationResult {O.rrEntry = credentialEntry} = registerResult+        loginReq <-+          either (error . show) id . WJ.wjDecodeCredentialAuthentication+            <$> decodeFile+              @WJ.WJCredentialAuthentication+              "tests/responses/assertion/01-none-empty-user-handle.json"+        let M.Credential {M.cResponse = cResponse} = loginReq+            signInResult =+              toEither $+                O.verifyAuthenticationResponse+                  (M.Origin "http://localhost:8080")+                  (M.RpIdHash . hash $ ("localhost" :: ByteString.ByteString))+                  (Just (M.UserHandle "UserId"))+                  credentialEntry+                  (defaultPublicKeyCredentialRequestOptions loginReq)+                  M.Credential+                    { M.cIdentifier = O.ceCredentialId credentialEntry,+                      M.cResponse = cResponse,+                      M.cClientExtensionResults = M.AuthenticationExtensionsClientOutputs {}+                    }+        signInResult `shouldSatisfy` isRight   describe "Packed register" $ do     it "tests whether the fixed packed register has a valid attestation" $       registerTestFromFile@@ -185,12 +212,20 @@         predeterminedDateTime     it "tests whether the fixed packed register has a valid attestation" $       registerTestFromFile-        "tests/responses/attestation/packed-02.json"+        "tests/responses/attestation/packed-03.json"         "http://localhost:5000"         "localhost"         True         registry         predeterminedDateTime+    it "regression test for #150" $+      registerTestFromFile+        "tests/responses/attestation/regression-150.json"+        "https://webauthn.dev.tweag.io"+        "webauthn.dev.tweag.io"+        False+        registry+        predeterminedDateTime     it "the response with transports information works" $       registerTestFromFile         "tests/responses/attestation/with-transports.json"@@ -353,6 +388,10 @@           M.CredentialParameters             { M.cpTyp = M.CredentialTypePublicKey,               M.cpAlg = Cose.CoseAlgorithmRS256+            },+          M.CredentialParameters+            { cpTyp = M.CredentialTypePublicKey,+              cpAlg = Cose.CoseAlgorithmEdDSA             }         ],       M.corTimeout = Nothing,
tests/MetadataSpec.hs view
@@ -15,7 +15,7 @@ import Data.Text.Encoding (decodeUtf8) import qualified Data.X509 as X509 import qualified Data.X509.CertificateStore as X509-import System.Hourglass (dateCurrent)+import Spec.Util (predeterminedDateTime) import Test.Hspec (SpecWith, describe, it, shouldBe, shouldSatisfy) import Test.Hspec.Expectations.Json (shouldBeUnorderedJson) @@ -30,8 +30,7 @@         store = X509.makeCertificateStore [cert]      blobBytes <- BS.readFile $ "tests/golden-metadata/" <> subdir <> "/blob.jwt"-    now <- dateCurrent-    let Right result = jwtToJson blobBytes (RootCertificate store origin) now+    let Right result = jwtToJson blobBytes (RootCertificate store origin) predeterminedDateTime      Just expectedPayload <- decodeFileStrict $ "tests/golden-metadata/" <> subdir <> "/payload.json" @@ -61,5 +60,4 @@   describe "fidoAllianceRootCertificate" $ do     it "can validate the payload" $ do       blobBytes <- BS.readFile "tests/golden-metadata/big/blob.jwt"-      now <- dateCurrent-      jwtToJson blobBytes fidoAllianceRootCertificate now `shouldSatisfy` isRight+      jwtToJson blobBytes fidoAllianceRootCertificate predeterminedDateTime `shouldSatisfy` isRight
tests/Spec/Util.hs view
@@ -1,9 +1,10 @@-module Spec.Util (decodeFile, runSeededMonadRandom) where+module Spec.Util (decodeFile, runSeededMonadRandom, timeZero, predeterminedDateTime) where  import qualified Crypto.Random as Random import Data.Aeson (FromJSON) import qualified Data.Aeson as Aeson import qualified Data.ByteString.Lazy as ByteString+import qualified Data.Hourglass as HG  decodeFile :: (FromJSON a, Show a) => FilePath -> IO a decodeFile filePath = do@@ -16,3 +17,12 @@ runSeededMonadRandom seed f = do   let rng = Random.drgNewSeed $ Random.seedFromInteger seed    in fst $ Random.withDRG rng f++-- | Attestation requires a specific time to be passed for the verification of the certificate chain.+-- For sake of reproducability we hardcode a time.+predeterminedDateTime :: HG.DateTime+predeterminedDateTime = HG.DateTime {HG.dtDate = HG.Date {HG.dateYear = 2021, HG.dateMonth = HG.December, HG.dateDay = 22}, HG.dtTime = timeZero}++-- | For most uses of DateTime in these tests, the time of day isn't relevant. This definition allows easier construction of these DateTimes.+timeZero :: HG.TimeOfDay+timeZero = HG.TimeOfDay {HG.todHour = HG.Hours 0, HG.todMin = HG.Minutes 0, HG.todSec = HG.Seconds 0, HG.todNSec = HG.NanoSeconds 0}
+ tests/responses/assertion/01-none-empty-user-handle.json view
@@ -0,0 +1,12 @@+{+  "type": "public-key",+  "id": "KbeXjEj6HgsT_opADhRF46CXsWRR7Y8UndF03-f2sF8XRaimojYz950Mi2fN2S3DSDGyI5I3S_IZyGJbT85E6w",+  "rawId": "KbeXjEj6HgsT_opADhRF46CXsWRR7Y8UndF03-f2sF8XRaimojYz950Mi2fN2S3DSDGyI5I3S_IZyGJbT85E6w",+  "response": {+    "clientDataJSON": "eyJ0eXBlIjoid2ViYXV0aG4uZ2V0IiwiY2hhbGxlbmdlIjoiTDVtQWl0MEhqdFFlQkRPVE9xTTdjUSIsIm9yaWdpbiI6Imh0dHA6Ly9sb2NhbGhvc3Q6ODA4MCIsImNyb3NzT3JpZ2luIjpmYWxzZX0",+    "authenticatorData": "SZYN5YgOjGh0NBcPZHZgW4_krrmihjLHmVzzuoMdl2MFAAAABQ",+    "signature": "MEQCIAZn3HxWTEEJrpbxG2TT7eIg2ue2AmIj1cwiMEA5a0Z1AiBUkDUkOh0B8PGYKStIaJJS2xKC9LwBfOCtoLbSOldYkg",+    "userHandle": ""+  },+  "clientExtensionResults": {}+}
+ tests/responses/attestation/regression-150.json view
@@ -0,0 +1,13 @@+{+  "type": "public-key",+  "id": "AdW2Vc7uD2urgMT9OMkyELoYSIxWvKoBY1gD5EQF9MlcOvHZUqqclf_Na5wTdzPneS0ms8bb3D9wu8QzelzRTjEqN4TazZKdKRxzGbozvBGawsNwjowK",+  "rawId": "AdW2Vc7uD2urgMT9OMkyELoYSIxWvKoBY1gD5EQF9MlcOvHZUqqclf_Na5wTdzPneS0ms8bb3D9wu8QzelzRTjEqN4TazZKdKRxzGbozvBGawsNwjowK",+  "response": {+    "clientDataJSON": "eyJ0eXBlIjoid2ViYXV0aG4uY3JlYXRlIiwiY2hhbGxlbmdlIjoiRk5MUFlnQUFBQUJOQTMzX253ZEIwbjJaWmZTNGEtRFYiLCJvcmlnaW4iOiJodHRwczovL3dlYmF1dGhuLmRldi50d2VhZy5pbyIsImNyb3NzT3JpZ2luIjpmYWxzZSwib3RoZXJfa2V5c19jYW5fYmVfYWRkZWRfaGVyZSI6ImRvIG5vdCBjb21wYXJlIGNsaWVudERhdGFKU09OIGFnYWluc3QgYSB0ZW1wbGF0ZS4gU2VlIGh0dHBzOi8vZ29vLmdsL3lhYlBleCJ9",+    "attestationObject": "o2NmbXRmcGFja2VkZ2F0dFN0bXSiY2FsZyZjc2lnWEcwRQIhAIATxHdZC9pJA-RXLR-Gf0Kqnk8wk8YrmpEhff5D4dXuAiAH8rhgVstTbBNWSClMV7KZwtwTK9nmWPRAHOljZWH0gWhhdXRoRGF0YVjbz99AFunehK-NCfKrLtwZLiTxIgpzhkn0sc0Ib1Am45hFYs_Q663OAAI1vMYKZIsLJfHwVQMAVwHVtlXO7g9rq4DE_TjJMhC6GEiMVryqAWNYA-REBfTJXDrx2VKqnJX_zWucE3cz53ktJrPG29w_cLvEM3pc0U4xKjeE2s2SnSkccxm6M7wRmsLDcI6MCqUBAgMmIAEhWCC1PYYJ_C4KKBQ-10uWb8opsm9k7EfYnoETrdfsecI08iJYIPjQb8M6os-2zSb25VFANzAvniX1n5hiU_T7dyOhNS2a",+    "transports": [+      "internal"+    ]+  },+  "clientExtensionResults": {}+}
webauthn.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: webauthn-version: 0.4.0.0+version: 0.4.1.0 license: Apache-2.0 license-file: LICENSE copyright: