webauthn 0 → 0.1.0.0

raw patch · 128 files changed

+20475/−703 lines, 128 filesdep +QuickCheckdep +asn1-parsedep +binarydep −cerealdep ~aesondep ~asn1-encodingdep ~asn1-typessetup-changednew-uploaderbinary-added

Dependencies added: QuickCheck, asn1-parse, binary, deriving-aeson, directory, file-embed, filepath, hourglass, hspec, hspec-expectations-json, jose, lens, monad-time, mtl, pem, quickcheck-instances, singletons, time, unordered-containers, uuid, validation, webauthn, x509-store

Dependencies removed: cereal

Dependency ranges changed: aeson, asn1-encoding, asn1-types, base, base16-bytestring, base64-bytestring, bytestring, cborg, containers, cryptonite, hashable, memory, serialise, text, x509, x509-validation

Files

• CHANGELOG.md +0/−5
• LICENSE +170/−24
• README.md +110/−0
• Setup.hs +0/−2
• root-certs/apple/Apple_WebAuthn_Root_CA.crt binary
• root-certs/metadata/root.crt binary
• root-certs/tpm/AMD/AMD-fTPM-ECC-RootCA.crt binary
• root-certs/tpm/AMD/AMD-fTPM-RSA-RootCA.crt binary
• root-certs/tpm/AMD/Microsoft Pluton Root CA 2021.crt binary
• root-certs/tpm/Atmel/Atmel TPM Root Signing Module.crt binary
• root-certs/tpm/Infineon/IFX TPM EK Root CA.crt binary
• root-certs/tpm/Infineon/IFX-RootCA.crt binary
• root-certs/tpm/Infineon/IFX_TPM_RootCert_008.crt binary
• root-certs/tpm/Infineon/Infineon OPTIGA(TM) ECC Root CA.crt binary
• root-certs/tpm/Infineon/Infineon OPTIGA(TM) RSA Root CA.crt binary
• root-certs/tpm/Infineon/Infineon_OPTIGA(TM)_ECC_Root_CA_2.crt binary
• root-certs/tpm/Infineon/Infineon_OPTIGA(TM)_RSA_Root_CA_2.crt binary
• root-certs/tpm/Infineon/OptigaEccRootCA3.crt binary
• root-certs/tpm/Infineon/OptigaRsaRootCA3.crt binary
• root-certs/tpm/Intel/EKRootPublicKey.crt binary
• root-certs/tpm/Intel/OnDie_CA_RootCA_Certificate.crt binary
• root-certs/tpm/Microsoft/Microsoft TPM Root Certificate Authority 2014.crt binary
• root-certs/tpm/NationZ/EkRootCA.crt binary
• root-certs/tpm/Nuvoton/NTC TPM EK Root CA 01.crt binary
• root-certs/tpm/Nuvoton/NTC TPM EK Root CA 02.crt binary
• root-certs/tpm/Nuvoton/NTC TPM EK Root CA ARSUF 01.crt binary
• root-certs/tpm/Nuvoton/Nuvoton TPM Root CA 1013.crt binary
• root-certs/tpm/Nuvoton/Nuvoton TPM Root CA 1014.crt binary
• root-certs/tpm/Nuvoton/Nuvoton TPM Root CA 1110.crt binary
• root-certs/tpm/Nuvoton/Nuvoton TPM Root CA 1111.crt binary
• root-certs/tpm/Nuvoton/Nuvoton TPM Root CA 1210.crt binary
• root-certs/tpm/Nuvoton/Nuvoton TPM Root CA 2010.crt binary
• root-certs/tpm/Nuvoton/Nuvoton TPM Root CA 2011.crt binary
• root-certs/tpm/Nuvoton/Nuvoton TPM Root CA 2012.crt binary
• root-certs/tpm/Nuvoton/Nuvoton TPM Root CA 2110.crt binary
• root-certs/tpm/Nuvoton/Nuvoton TPM Root CA 2111.crt binary
• root-certs/tpm/Nuvoton/Nuvoton TPM Root CA 2112.crt binary
• root-certs/tpm/QC/Microsoft TPM Root Certificate Authority 2014.crt binary
• root-certs/tpm/STMicro/GlobalSign Trusted Computing CA.crt binary
• root-certs/tpm/STMicro/GlobalSign Trusted Platform Module ECC Root CA.crt binary
• root-certs/tpm/STMicro/ST TPM Root Certificate.crt binary
• root-certs/tpm/STMicro/STM TPM ECC Root CA 01.crt binary
• src/Crypto/WebAuthn.hs +156/−0
• src/Crypto/WebAuthn/AttestationStatementFormat.hs +28/−0
• src/Crypto/WebAuthn/AttestationStatementFormat/AndroidKey.hs +298/−0
• src/Crypto/WebAuthn/AttestationStatementFormat/AndroidSafetyNet.hs +267/−0
• src/Crypto/WebAuthn/AttestationStatementFormat/Apple.hs +177/−0
• src/Crypto/WebAuthn/AttestationStatementFormat/FidoU2F.hs +176/−0
• src/Crypto/WebAuthn/AttestationStatementFormat/None.hs +41/−0
• src/Crypto/WebAuthn/AttestationStatementFormat/Packed.hs +190/−0
• src/Crypto/WebAuthn/AttestationStatementFormat/TPM.hs +644/−0
• src/Crypto/WebAuthn/Cose/Algorithm.hs +240/−0
• src/Crypto/WebAuthn/Cose/Internal/Registry.hs +295/−0
• src/Crypto/WebAuthn/Cose/Internal/Verify.hs +238/−0
• src/Crypto/WebAuthn/Cose/Key.hs +297/−0
• src/Crypto/WebAuthn/Internal/DateOrphans.hs +47/−0
• src/Crypto/WebAuthn/Internal/ToJSONOrphans.hs +91/−0
• src/Crypto/WebAuthn/Internal/Utils.hs +106/−0
• src/Crypto/WebAuthn/Metadata.hs +34/−0
• src/Crypto/WebAuthn/Metadata/FidoRegistry.hs +123/−0
• src/Crypto/WebAuthn/Metadata/Service/Decode.hs +92/−0
• src/Crypto/WebAuthn/Metadata/Service/Processing.hs +243/−0
• src/Crypto/WebAuthn/Metadata/Service/Types.hs +115/−0
• src/Crypto/WebAuthn/Metadata/Service/WebIDL.hs +127/−0
• src/Crypto/WebAuthn/Metadata/Statement/Decode.hs +145/−0
• src/Crypto/WebAuthn/Metadata/Statement/Types.hs +113/−0
• src/Crypto/WebAuthn/Metadata/Statement/WebIDL.hs +264/−0
• src/Crypto/WebAuthn/Metadata/UAF.hs +38/−0
• src/Crypto/WebAuthn/Model.hs +37/−0
• src/Crypto/WebAuthn/Model/Identifier.hs +77/−0
• src/Crypto/WebAuthn/Model/Kinds.hs +141/−0
• src/Crypto/WebAuthn/Model/Types.hs +1350/−0
• src/Crypto/WebAuthn/Model/WebIDL.hs +112/−0
• src/Crypto/WebAuthn/Model/WebIDL/Internal/Binary/Decoding.hs +257/−0
• src/Crypto/WebAuthn/Model/WebIDL/Internal/Binary/Encoding.hs +199/−0
• src/Crypto/WebAuthn/Model/WebIDL/Internal/Convert.hs +129/−0
• src/Crypto/WebAuthn/Model/WebIDL/Internal/Decoding.hs +242/−0
• src/Crypto/WebAuthn/Model/WebIDL/Internal/Encoding.hs +220/−0
• src/Crypto/WebAuthn/Model/WebIDL/Types.hs +200/−0
• src/Crypto/WebAuthn/Operation.hs +17/−0
• src/Crypto/WebAuthn/Operation/Authentication.hs +342/−0
• src/Crypto/WebAuthn/Operation/CredentialEntry.hs +21/−0
• src/Crypto/WebAuthn/Operation/Registration.hs +521/−0
• src/Crypto/WebAuthn/WebIDL.hs +80/−0
• src/WebAuthn.hs +0/−193
• src/WebAuthn/FIDOU2F.hs +0/−50
• src/WebAuthn/Packed.hs +0/−50
• src/WebAuthn/Signature.hs +0/−89
• src/WebAuthn/TPM.hs +0/−45
• src/WebAuthn/Types.hs +0/−203
• tests/Emulation.hs +270/−0
• tests/Emulation/Authenticator.hs +451/−0
• tests/Emulation/Authenticator/Arbitrary.hs +44/−0
• tests/Emulation/Client.hs +149/−0
• tests/Emulation/Client/Arbitrary.hs +15/−0
• tests/Encoding.hs +55/−0
• tests/Main.hs +365/−0
• tests/MetadataSpec.hs +61/−0
• tests/PublicKeySpec.hs +45/−0
• tests/Spec/Key.hs +170/−0
• tests/Spec/Types.hs +296/−0
• tests/Spec/Util.hs +18/−0
• tests/golden-metadata/big/blob.jwt +1/−0
• tests/golden-metadata/big/origin +1/−0
• tests/golden-metadata/big/payload.json +9064/−0
• tests/golden-metadata/big/root.crt +21/−0
• tests/golden-metadata/small/blob.jwt +1/−0
• tests/golden-metadata/small/origin +1/−0
• tests/golden-metadata/small/payload.json +245/−0
• tests/golden-metadata/small/root.crt +35/−0
• tests/responses/assertion/01-none.json +12/−0
• tests/responses/attestation/01-none.json +10/−0
• tests/responses/attestation/android-key-01.json +10/−0
• tests/responses/attestation/android-key-02.json +10/−0
• tests/responses/attestation/android-safetynet-01.json +10/−0
• tests/responses/attestation/apple-01.json +10/−0
• tests/responses/attestation/apple-02.json +10/−0
• tests/responses/attestation/packed-01.json +10/−0
• tests/responses/attestation/packed-02.json +14/−0
• tests/responses/attestation/packed-03.json +13/−0
• tests/responses/attestation/tpm-es256-01.json +10/−0
• tests/responses/attestation/tpm-rs1-01.json +10/−0
• tests/responses/attestation/u2f-01.json +10/−0
• tests/responses/attestation/u2f-02.json +10/−0
• tests/responses/attestation/u2f-03.json +10/−0
• tests/responses/attestation/u2f-04.json +10/−0
• tests/responses/attestation/u2f-05.json +10/−0
• webauthn.cabal +178/−42

@@ -1,5 +0,0 @@-# Revision history for webauthn--## 0 -- YYYY-mm-dd--* First version. Released on an unsuspecting world.

@@ -1,30 +1,176 @@-Copyright (c) 2019, Fumiaki Kinoshita+                                 Apache License+                           Version 2.0, January 2004+                        http://www.apache.org/licenses/ -All rights reserved.+   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION -Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:+   1. Definitions. -    * Redistributions of source code must retain the above copyright-      notice, this list of conditions and the following disclaimer.+      "License" shall mean the terms and conditions for use, reproduction,+      and distribution as defined by Sections 1 through 9 of this document. -    * Redistributions in binary form must reproduce the above-      copyright notice, this list of conditions and the following-      disclaimer in the documentation and/or other materials provided-      with the distribution.+      "Licensor" shall mean the copyright owner or entity authorized by+      the copyright owner that is granting the License. -    * Neither the name of Fumiaki Kinoshita nor the names of other-      contributors may be used to endorse or promote products derived-      from this software without specific prior written permission.+      "Legal Entity" shall mean the union of the acting entity and all+      other entities that control, are controlled by, or are under common+      control with that entity. For the purposes of this definition,+      "control" means (i) the power, direct or indirect, to cause the+      direction or management of such entity, whether by contract or+      otherwise, or (ii) ownership of fifty percent (50%) or more of the+      outstanding shares, or (iii) beneficial ownership of such entity. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+      "You" (or "Your") shall mean an individual or Legal Entity+      exercising permissions granted by this License.++      "Source" form shall mean the preferred form for making modifications,+      including but not limited to software source code, documentation+      source, and configuration files.++      "Object" form shall mean any form resulting from mechanical+      transformation or translation of a Source form, including but+      not limited to compiled object code, generated documentation,+      and conversions to other media types.++      "Work" shall mean the work of authorship, whether in Source or+      Object form, made available under the License, as indicated by a+      copyright notice that is included in or attached to the work+      (an example is provided in the Appendix below).++      "Derivative Works" shall mean any work, whether in Source or Object+      form, that is based on (or derived from) the Work and for which the+      editorial revisions, annotations, elaborations, or other modifications+      represent, as a whole, an original work of authorship. For the purposes+      of this License, Derivative Works shall not include works that remain+      separable from, or merely link (or bind by name) to the interfaces of,+      the Work and Derivative Works thereof.++      "Contribution" shall mean any work of authorship, including+      the original version of the Work and any modifications or additions+      to that Work or Derivative Works thereof, that is intentionally+      submitted to Licensor for inclusion in the Work by the copyright owner+      or by an individual or Legal Entity authorized to submit on behalf of+      the copyright owner. For the purposes of this definition, "submitted"+      means any form of electronic, verbal, or written communication sent+      to the Licensor or its representatives, including but not limited to+      communication on electronic mailing lists, source code control systems,+      and issue tracking systems that are managed by, or on behalf of, the+      Licensor for the purpose of discussing and improving the Work, but+      excluding communication that is conspicuously marked or otherwise+      designated in writing by the copyright owner as "Not a Contribution."++      "Contributor" shall mean Licensor and any individual or Legal Entity+      on behalf of whom a Contribution has been received by Licensor and+      subsequently incorporated within the Work.++   2. Grant of Copyright License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      copyright license to reproduce, prepare Derivative Works of,+      publicly display, publicly perform, sublicense, and distribute the+      Work and such Derivative Works in Source or Object form.++   3. Grant of Patent License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      (except as stated in this section) patent license to make, have made,+      use, offer to sell, sell, import, and otherwise transfer the Work,+      where such license applies only to those patent claims licensable+      by such Contributor that are necessarily infringed by their+      Contribution(s) alone or by combination of their Contribution(s)+      with the Work to which such Contribution(s) was submitted. If You+      institute patent litigation against any entity (including a+      cross-claim or counterclaim in a lawsuit) alleging that the Work+      or a Contribution incorporated within the Work constitutes direct+      or contributory patent infringement, then any patent licenses+      granted to You under this License for that Work shall terminate+      as of the date such litigation is filed.++   4. Redistribution. You may reproduce and distribute copies of the+      Work or Derivative Works thereof in any medium, with or without+      modifications, and in Source or Object form, provided that You+      meet the following conditions:++      (a) You must give any other recipients of the Work or+          Derivative Works a copy of this License; and++      (b) You must cause any modified files to carry prominent notices+          stating that You changed the files; and++      (c) You must retain, in the Source form of any Derivative Works+          that You distribute, all copyright, patent, trademark, and+          attribution notices from the Source form of the Work,+          excluding those notices that do not pertain to any part of+          the Derivative Works; and++      (d) If the Work includes a "NOTICE" text file as part of its+          distribution, then any Derivative Works that You distribute must+          include a readable copy of the attribution notices contained+          within such NOTICE file, excluding those notices that do not+          pertain to any part of the Derivative Works, in at least one+          of the following places: within a NOTICE text file distributed+          as part of the Derivative Works; within the Source form or+          documentation, if provided along with the Derivative Works; or,+          within a display generated by the Derivative Works, if and+          wherever such third-party notices normally appear. The contents+          of the NOTICE file are for informational purposes only and+          do not modify the License. You may add Your own attribution+          notices within Derivative Works that You distribute, alongside+          or as an addendum to the NOTICE text from the Work, provided+          that such additional attribution notices cannot be construed+          as modifying the License.++      You may add Your own copyright statement to Your modifications and+      may provide additional or different license terms and conditions+      for use, reproduction, or distribution of Your modifications, or+      for any such Derivative Works as a whole, provided Your use,+      reproduction, and distribution of the Work otherwise complies with+      the conditions stated in this License.++   5. Submission of Contributions. Unless You explicitly state otherwise,+      any Contribution intentionally submitted for inclusion in the Work+      by You to the Licensor shall be under the terms and conditions of+      this License, without any additional terms or conditions.+      Notwithstanding the above, nothing herein shall supersede or modify+      the terms of any separate license agreement you may have executed+      with Licensor regarding such Contributions.++   6. Trademarks. This License does not grant permission to use the trade+      names, trademarks, service marks, or product names of the Licensor,+      except as required for reasonable and customary use in describing the+      origin of the Work and reproducing the content of the NOTICE file.++   7. Disclaimer of Warranty. Unless required by applicable law or+      agreed to in writing, Licensor provides the Work (and each+      Contributor provides its Contributions) on an "AS IS" BASIS,+      WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+      implied, including, without limitation, any warranties or conditions+      of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+      PARTICULAR PURPOSE. You are solely responsible for determining the+      appropriateness of using or redistributing the Work and assume any+      risks associated with Your exercise of permissions under this License.++   8. Limitation of Liability. In no event and under no legal theory,+      whether in tort (including negligence), contract, or otherwise,+      unless required by applicable law (such as deliberate and grossly+      negligent acts) or agreed to in writing, shall any Contributor be+      liable to You for damages, including any direct, indirect, special,+      incidental, or consequential damages of any character arising as a+      result of this License or out of the use or inability to use the+      Work (including but not limited to damages for loss of goodwill,+      work stoppage, computer failure or malfunction, or any and all+      other commercial damages or losses), even if such Contributor+      has been advised of the possibility of such damages.++   9. Accepting Warranty or Additional Liability. While redistributing+      the Work or Derivative Works thereof, You may choose to offer,+      and charge a fee for, acceptance of support, warranty, indemnity,+      or other liability obligations and/or rights consistent with this+      License. However, in accepting such obligations, You may act only+      on Your own behalf and on Your sole responsibility, not on behalf+      of any other Contributor, and only if You agree to indemnify,+      defend, and hold each Contributor harmless for any liability+      incurred by, or claims asserted against, such Contributor by reason+      of your accepting any such warranty or additional liability.++   END OF TERMS AND CONDITIONS

@@ -0,0 +1,110 @@+# Haskell WebAuthn Library++This library implements the server-side+[Web Authentication Relying Party specification Level 2][spec]. The goal of Web+Authentication (WebAuthn) is to bring passwordless login/second factor+authentication to the web, logging in using a FIDO U2F Security Key, finger+print scanner and some other authenticator.++This project was originally developed in 2020 as a Zurihac project by+[@arianvp](https://github.com/arianvp/) and [@duijf](https://github.com/duijf).+Starting September 2021 a team at [Tweag](https://www.tweag.io/) was sponsored+by [Mercury](https://mercury.com/) to create a production-ready open-source+implementation of this standard, which was done by+[@infinisil](https://github.com/infinisil/) and+[@ErinvanderVeen](https://github.com/ErinvanderVeen/).++## Setting up the environment+We assume Nix is used for the development of this library. If not using Nix,+take a look at `default.nix` for the dependencies and GHC version. All+instructions below assume the use of Nix.++### Nix Caches+Tweag provides a Cachix cache for the library itself and all+non-Haskell dependencies, setting up the `tweag-haskell-fido2` cache can be+done using the [instructions][cachix] provided by Cachix.++### Nix Shell+The Nix shell provides all libraries and tools required to build the library,+tests, and example server. Simply call `nix-shell` to enter a shell. If the+binary caches have been configured properly, this should take little time. If+they have not been properly configured, entering the Nix shell will take+multiple hours.++All further instructions in this README assume that you are in a Nix shell.++## Developing the Library+The [Haskell Language Server (hls)][hls] and [Ormolu][ormolu] are highly+recommended for the development of this library. The hls+[documentation][hls-editor] describes how to configure your editor to use it.+We also recommend enabling auto-format using Ormolu for your editor. We do,+however, also provide a bash script in `bin/autoformat.sh` that uses Ormolu to+format all Haskell source files in the repository.++Code not formatted using Ormolu will be rejected in CI.++## Running the tests+Tests are provided in the `tests` directory. Running these tests is done via+cabal:+```bash+cabal run test-suite:tests+```++## Running the demo+The library comes with an example implementation for a server that makes use of+it, which can be found in the `server` directory. All dependencies required to+build the example server are included in the Nix shell.+```bash+cd server+./run.sh+```++Changes to the server's source files automatically trigger a rebuild of the+server.++## Testing with an Authenticator+The easiest way to test the server, or your own application, is to use the+Chrome WebAuthn development tool. Simply open the Chrome DevTools, click on the+three dots in the top right, select "More tools -> WebAuthn", and then enable+the virtual environment.++Testing with a physical authenticator is easiest using an Android or iOS phone+supporting it, or a dedicated token like a [YubiKey][yubikey] or the+open-source [SoloKey][solokey]. Testing with a phone requires setting up a+certificate for the domain of the relying party as WebAuthn only works via+https, with an exception being made for `localhost`.++## Acknowledgements+The test files in `tests/responses/` were not created by Tweag, but+were instead copied from existing WebAuthn libraries. Notably the+[.NET][dotnet] and [python][python] libraries by the .NET foundation and Duo+Labs respectively.++## LICENSES+```text+Copyright+  2020 - 2021 Arian van Putten+  2021 -      Tweag I/O++Licensed under the Apache License, Version 2.0 (the "License"); you may not use+this file except in compliance with the License. You may obtain a copy of the+License at++  http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software distributed+under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR+CONDITIONS OF ANY KIND, either express or implied. See the License for the+specific language governing permissions and limitations under the License.+```++[cache]: https://input-output-hk.github.io/haskell.nix/tutorials/getting-started.html#setting-up-the-binary-cache+[cachix]: https://app.cachix.org/cache/tweag-haskell-fido2+[dotnet]: https://github.com/passwordless-lib/fido2-net-lib+[hls-editor]: https://haskell-language-server.readthedocs.io/en/latest/configuration.html#configuring-your-editor+[hls]: https://github.com/haskell/haskell-language-server+[ormolu]: https://github.com/tweag/ormolu+[python]: https://github.com/duo-labs/py_webauthn+[solokey]: https://solokeys.com/+[spec]: https://www.w3.org/TR/webauthn-2/+[yubikey]: https://www.yubico.com/

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

binary file changed (absent → 534 bytes)

binary file changed (absent → 867 bytes)

binary file changed (absent → 774 bytes)

binary file changed (absent → 1164 bytes)

binary file changed (absent → 661 bytes)

binary file changed (absent → 559 bytes)

binary file changed (absent → 1108 bytes)

binary file changed (absent → 1019 bytes)

binary file changed (absent → 1295 bytes)

binary file changed (absent → 607 bytes)

binary file changed (absent → 1455 bytes)

binary file changed (absent → 689 bytes)

binary file changed (absent → 1461 bytes)

binary file changed (absent → 689 bytes)

binary file changed (absent → 1461 bytes)

binary file changed (absent → 635 bytes)

binary file changed (absent → 702 bytes)

binary file changed (absent → 1529 bytes)

binary file changed (absent → 584 bytes)

binary file changed (absent → 846 bytes)

binary file changed (absent → 846 bytes)

binary file changed (absent → 861 bytes)

binary file changed (absent → 918 bytes)

binary file changed (absent → 918 bytes)

binary file changed (absent → 522 bytes)

binary file changed (absent → 523 bytes)

binary file changed (absent → 545 bytes)

binary file changed (absent → 918 bytes)

binary file changed (absent → 918 bytes)

binary file changed (absent → 918 bytes)

binary file changed (absent → 522 bytes)

binary file changed (absent → 523 bytes)

binary file changed (absent → 522 bytes)

binary file changed (absent → 1529 bytes)

binary file changed (absent → 987 bytes)

binary file changed (absent → 695 bytes)

binary file changed (absent → 1040 bytes)

binary file changed (absent → 716 bytes)

@@ -0,0 +1,156 @@+{-# OPTIONS_GHC -Wno-missing-import-lists #-}++-- | Stability: provisional+--+-- This is the main module of the library. It re-exports the most commonly+-- needed modules and should be the only module considered stable. The+-- following sections give an overview of how a web application can use the+-- exported symbols to make use of the WebAuthn standard.+--+-- == WebAuthn basics+--+-- For a web application the [WebAuthn standard](https://www.w3.org/TR/webauthn-2/)+-- allows the creation and use of public key-based credentials for the purpose+-- of strongly authenticating users.+--+-- The WebAuthn standard usually involves three different devices, each of which+-- can be [WebAuthn conformant](https://www.w3.org/TR/webauthn-2/#sctn-conformance):+--+-- * A [Relying Party](https://www.w3.org/TR/webauthn-2/#webauthn-relying-party),+--   aka a __website__ like @github.com@ or @google.com@+-- * A [User Agent](https://www.w3.org/TR/webauthn-2/#conforming-user-agent),+--   aka usually a __browser__ like Firefox or Chrome+-- * A [Authenticator](https://www.w3.org/TR/webauthn-2/#authenticator),+--   aka something like a __security key__ like a Yubikey or a fingerprint sensor+--+-- This library implements the server side of [Relying Party conformance](https://www.w3.org/TR/webauthn-2/#sctn-conforming-relying-parties)+-- and is therefore intended to be used by a website's server.+--+-- == Ceremonies+-- In order for a Relying Party to be conformant, it needs to implement two+-- [Relying Party Operations](https://www.w3.org/TR/webauthn-2/#sctn-rp-operations),+-- aka [ceremonies](https://www.w3.org/TR/webauthn-2/#ceremony):+--+-- * The [Registration Ceremony](https://www.w3.org/TR/webauthn-2/#registration-ceremony),+--   where a [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential)+--   is created and associated with the user's account. The public key credential+--   may be [attested](https://www.w3.org/TR/webauthn-2/#sctn-attestation) via+--   one of the supported+--   [attestation statement formats](https://www.w3.org/TR/webauthn-2/#attestation-statement-format).+--   Afterwards the user can be authenticated by an Authentication Ceremony.+-- * The [Authentication Ceremony](https://www.w3.org/TR/webauthn-2/#authentication-ceremony),+--   where it is [asserted](https://www.w3.org/TR/webauthn-2/#assertion) that+--   the user controls the [credential private key](https://www.w3.org/TR/webauthn-2/#credential-private-key)+--   of a previously-registered [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential).+--+-- Both Ceremonies have the same general flow:+--+-- 1. The user interacts with the website, triggering a registration or authentication+--   ceremony via some Relying Party website script, which sends a request to the Relying+--   Party server to request the credential creation/request options. Depending+--   on the scenario this request may include a username and more.+-- #step-2#+-- 2. The Relying Party creates an [PublicKeyCredentialCreationOptions](https://www.w3.org/TR/webauthn-2/#dictdef-publickeycredentialcreationoptions)+--   or [PublicKeyCredentialRequestOptions](https://www.w3.org/TR/webauthn-2/#dictdef-publickeycredentialrequestoptions) object respectively,+--   which encodes the parameters for the [ceremony](https://www.w3.org/TR/webauthn-2/#ceremony),+--   and sends it back as the response. This notably includes a+--   [Cryptographic Challenge](https://www.w3.org/TR/webauthn-2/#sctn-cryptographic-challenges),+--   generated by the server.+-- 3. Using the response as an argument, the script calls the+--   [@navigator.credentials.create()@](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-create)+--   or [@navigator.credentials.get()@](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get)+--   functions of the browser respectively. This typically causes the browser+--   to request some gesture by the user. The result of these functions is+--   then sent to the Relying Party server with another request.+-- #step-4#+-- 4. The Relying Party verifies the request according to+--   [§ 7.1 Registering a New Credential](https://www.w3.org/TR/webauthn-2/#sctn-registering-a-new-credential) or+--   [§ 7.2 Verifying an Authentication Assertion](https://www.w3.org/TR/webauthn-2/#sctn-verifying-assertion) respectively.+--   The response indicates the result of this verification. For successful+--   registration ceremonies, the server stores the resulting public key and+--   some additional information in its database. For successful authentication+--   ceremonies, the server may want to update the relevant database entry.+-- 5. The script handles the received response accordingly, displaying errors+--   as needed.+--+-- This library only implements the server side of these steps, since the browser+-- script is usually very specific to the website and use case, but also fairly simple.+-- The example server in the source of this implementation shows how+-- [a potential implementation](https://github.com/tweag/webauthn/blob/master/server/www/unauthenticated.js).+-- See also these [Sample API Usage Scenarios](https://www.w3.org/TR/webauthn-2/#sctn-sample-scenarios).+--+-- == Library+--+-- The two ceremonies described above are very similar in many ways. Because of+-- this, the library has many functions and types that are parametrized by+-- 'CeremonyKind', which allows improved type safety.+--+-- The library consists of the following main parts+module Crypto.WebAuthn+  ( -- * Model Types++    -- | A set of types representing credential options ('CredentialOptions')+    -- and their resulting credentials responses ('Credential'), used in+    -- [step 2](#step-2) and [step 4](#step-4#) respectively.+    --+    -- Also includes a set of functions for indirectly encoding credential+    -- options to JSON ('encodeCredentialOptionsRegistration',+    -- 'encodeCredentialOptionsAuthentication') and indirectly decoding+    -- credential responses from JSON ('decodeCredentialRegistration',+    -- 'decodeCredentialAuthentication'), using the same encoding as+    -- [webauthn-json](https://github.com/github/webauthn-json) which can be+    -- used on the JavaScript side. This is needed to construct the response+    -- for [step 2](#step-2) and to deconstruct the request in+    -- [step 4](#step-4) respectively.+    module Crypto.WebAuthn.Model,++    -- * Attestation Statement Formats++    -- | In case of a [registration ceremony](https://www.w3.org/TR/webauthn-2/#registration),+    -- there is the possibility for the Relying Party to request an+    -- [attestation](https://www.w3.org/TR/webauthn-2/#sctn-attestation),+    -- which if returned may allow the Relying Party to make a trust decision+    -- ('rrAttestationStatement') with the authenticator model used.+    --+    -- This module contains the 'allSupportedFormats' value, which contains+    -- implementations of all standard attestation statement formats supported+    -- by this library. It can be passed to the 'decodeCredentialRegistration'+    -- to enable all these formats.+    module Crypto.WebAuthn.AttestationStatementFormat,++    -- * Operations++    -- | Functions for verifying resulting credential responses, needed in [step 4](#step-4).+    -- This is the main functionality implemented by the library. This module+    -- exports these two main symbols:+    --+    -- * 'verifyRegistrationResponse': Verifies a 'Credential' response for+    --   registration.+    -- * 'verifyAuthenticationResponse': Verifies a 'Credential' response for+    --   authentication.+    module Crypto.WebAuthn.Operation,++    -- * Metadata++    -- | A function for decoding a [FIDO Alliance Metadata Service](https://fidoalliance.org/metadata/)+    -- BLOB in order to be able to enforce a set of requirements on the authenticator+    -- used, e.g. to only allow authenticators that have been+    -- [FIDO certified](https://fidoalliance.org/certification/functional-certification/).+    --+    -- Notably this library does not define any functions for fetching the+    -- metadata, which is left to the user of the library. See the+    -- [@MetadataFetch@](https://github.com/tweag/webauthn/blob/master/server/src/MetadataFetch.hs)+    -- module in the example server for a potential implementation.+    --+    -- Currently the only function exported from this module is+    --+    -- * 'metadataBlobToRegistry': Decodes and verifies a Metadata BLOB to a+    --   'MetadataServiceRegistry', which can be passed to 'verifyRegistrationResponse'+    module Crypto.WebAuthn.Metadata,+  )+where++import Crypto.WebAuthn.AttestationStatementFormat+import Crypto.WebAuthn.Metadata+import Crypto.WebAuthn.Model+import Crypto.WebAuthn.Operation

@@ -0,0 +1,28 @@+-- | Stability: experimental+-- This module exports all supported [attestation statement format](https://www.w3.org/TR/webauthn-2/#attestation-statement-format)s by this library.+module Crypto.WebAuthn.AttestationStatementFormat (allSupportedFormats) where++import qualified Crypto.WebAuthn.AttestationStatementFormat.AndroidKey as AndroidKey+import qualified Crypto.WebAuthn.AttestationStatementFormat.AndroidSafetyNet as AndroidSafetyNet+import qualified Crypto.WebAuthn.AttestationStatementFormat.Apple as Apple+import qualified Crypto.WebAuthn.AttestationStatementFormat.FidoU2F as FidoU2F+import qualified Crypto.WebAuthn.AttestationStatementFormat.None as None+import qualified Crypto.WebAuthn.AttestationStatementFormat.Packed as Packed+import qualified Crypto.WebAuthn.AttestationStatementFormat.TPM as TPM+import qualified Crypto.WebAuthn.Model.Types as M++-- | All supported [attestation statement formats](https://www.w3.org/TR/webauthn-2/#sctn-attestation-formats)+-- of this library. This value can be passed to 'Crypto.WebAuthn.Model.WebIDL.Decoding.decodeCreatedPublicKeyCredential'.+-- Since 'M.SupportedAttestationStatementFormats' is a 'Semigroup' the '<>' operator can be used to add additional formats if needed.+allSupportedFormats :: M.SupportedAttestationStatementFormats+allSupportedFormats =+  foldMap+    M.singletonAttestationStatementFormat+    [ None.format,+      Packed.format,+      AndroidKey.format,+      AndroidSafetyNet.format,+      FidoU2F.format,+      Apple.format,+      TPM.format+    ]

@@ -0,0 +1,298 @@+{-# LANGUAGE ApplicativeDo #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ViewPatterns #-}++-- | Stability: experimental+-- This module implements the+-- [Android Key Attestation Statement Format](https://www.w3.org/TR/webauthn-2/#sctn-android-key-attestation).+module Crypto.WebAuthn.AttestationStatementFormat.AndroidKey+  ( format,+    Format (..),+    TrustLevel (..),+    VerificationError (..),+  )+where++import qualified Codec.CBOR.Term as CBOR+import Control.Exception (Exception)+import Control.Monad (forM, unless, void, when)+import Crypto.Hash (Digest, SHA256, digestFromByteString)+import qualified Crypto.WebAuthn.Cose.Algorithm as Cose+import qualified Crypto.WebAuthn.Cose.Internal.Verify as Cose+import Crypto.WebAuthn.Internal.Utils (failure)+import qualified Crypto.WebAuthn.Model.Types as M+import Data.ASN1.Parse (ParseASN1, getNext, getNextContainerMaybe, hasNext, onNextContainer, onNextContainerMaybe, runParseASN1)+import Data.ASN1.Types (ASN1 (IntVal, OctetString), ASN1Class (Context), ASN1ConstructionType (Container, Sequence, Set))+import Data.Aeson (ToJSON, object, toJSON, (.=))+import Data.Bifunctor (first)+import Data.ByteArray (convert)+import Data.ByteString (ByteString)+import Data.HashMap.Strict ((!?))+import Data.List.NonEmpty (NonEmpty ((:|)), toList)+import qualified Data.List.NonEmpty as NE+import Data.Maybe (isJust)+import Data.Set (Set)+import qualified Data.Set as Set+import Data.Text (Text)+import qualified Data.Text as Text+import Data.X509 (Extension (extDecode, extEncode, extHasNestedASN1, extOID))+import qualified Data.X509 as X509++-- | [(spec)](https://source.android.com/security/keystore/attestation#attestation-extension)+-- The X509 extension android uses for attestation information+data ExtAttestation = ExtAttestation+  { attestationChallenge :: Digest SHA256,+    softwareEnforced :: AuthorizationList,+    teeEnforced :: AuthorizationList+  }+  deriving (Eq, Show)++-- | [(spec)](https://source.android.com/security/keystore/attestation#schema)+-- A partial @AuthorizationList@ structure+data AuthorizationList = AuthorizationList+  { purpose :: Maybe (Set Integer),+    allApplications :: Maybe (),+    origin :: Maybe Integer+  }+  deriving (Eq, Show)++instance Extension ExtAttestation where+  extOID = const [1, 3, 6, 1, 4, 1, 11129, 2, 1, 17]+  extHasNestedASN1 = const True+  extEncode = error "Can not encode the parsed ExtAttestation to a valid [ASN1] because most fields are dropped during parsing."+  extDecode asn1 =+    first ("Could not decode ASN1 attestation extension: " ++) $+      runParseASN1 decodeExtAttestation asn1+    where+      decodeExtAttestation :: ParseASN1 ExtAttestation+      decodeExtAttestation = onNextContainer Sequence $ do+        -- Discard the version as the different attestation versions do not differ in a way that is significant to our purpose.+        _attestationVersion <- getNext+        _attestationSecurityLevel <- getNext+        _keyMasterVersion <- getNext+        _keymmasterSecurityLevel <- getNext+        (OctetString attestationChallenge) <- getNext+        _uniqueId <- getNext+        softwareEnforced <- onNextContainer Sequence decodeAttestationList+        teeEnforced <- onNextContainer Sequence decodeAttestationList+        attestationChallengeHash <- maybe (fail "Could not create hash from AttestationChallenge: ") pure $ digestFromByteString attestationChallenge+        pure $ ExtAttestation attestationChallengeHash softwareEnforced teeEnforced++      decodeAttestationList :: ParseASN1 AuthorizationList+      decodeAttestationList = do+        purpose <- onNextContainerMaybe (Container Context 1) (onNextContainer Set $ decodeIntSet Set.empty)+        _algorithm <- getNextContainerMaybe (Container Context 2)+        _keySize <- getNextContainerMaybe (Container Context 3)+        _digest <- getNextContainerMaybe (Container Context 5)+        _padding <- getNextContainerMaybe (Container Context 6)+        _ecCurve <- getNextContainerMaybe (Container Context 10)+        _rsaPublicExponent <- getNextContainerMaybe (Container Context 200)+        _rollbackResistance <- getNextContainerMaybe (Container Context 303)+        _activeDateTime <- getNextContainerMaybe (Container Context 400)+        _originationExpireDateTime <- getNextContainerMaybe (Container Context 401)+        _usageExpireDateTime <- getNextContainerMaybe (Container Context 402)+        _noAuthRequired <- getNextContainerMaybe (Container Context 503)+        _userAuthType <- getNextContainerMaybe (Container Context 504)+        _authTimeout <- getNextContainerMaybe (Container Context 505)+        _allowWhileOnBody <- getNextContainerMaybe (Container Context 506)+        _trustedUserPresenceRequired <- getNextContainerMaybe (Container Context 507)+        _trustedConfirmationRequired <- getNextContainerMaybe (Container Context 508)+        _unlockedDeviceRequired <- getNextContainerMaybe (Container Context 509)+        allApplications <- void <$> getNextContainerMaybe (Container Context 600)+        _applicationId <- getNextContainerMaybe (Container Context 601)+        _creationDateTime <- getNextContainerMaybe (Container Context 701)+        origin <-+          onNextContainerMaybe (Container Context 702) $+            getNext >>= \case+              IntVal i -> pure i+              _ -> fail "Unexpected non-IntVal"+        _rollbackResistant <- getNextContainerMaybe (Container Context 703)+        _rootOfTrust <- getNextContainerMaybe (Container Context 704)+        _osVersion <- getNextContainerMaybe (Container Context 705)+        _osPatchLevel <- getNextContainerMaybe (Container Context 706)+        _attestationApplicationId <- getNextContainerMaybe (Container Context 709)+        _attestationIdBrand <- getNextContainerMaybe (Container Context 710)+        _attestationIdDevice <- getNextContainerMaybe (Container Context 711)+        _attestationIdProduct <- getNextContainerMaybe (Container Context 712)+        _attestationIdSerial <- getNextContainerMaybe (Container Context 713)+        _attestationIdImei <- getNextContainerMaybe (Container Context 714)+        _attestationIdMeid <- getNextContainerMaybe (Container Context 715)+        _attestationIdManufacturer <- getNextContainerMaybe (Container Context 716)+        _attestationIdModel <- getNextContainerMaybe (Container Context 717)+        _vendorPatchLevel <- getNextContainerMaybe (Container Context 718)+        _bootPatchLevel <- getNextContainerMaybe (Container Context 719)+        pure $ AuthorizationList purpose allApplications origin++      decodeIntSet :: Set Integer -> ParseASN1 (Set Integer)+      decodeIntSet set = do+        next <- hasNext+        if next+          then do+            IntVal elem <- getNext+            decodeIntSet (Set.insert elem set)+          else pure set++-- | The required Trust level for Android Key attestation.+data TrustLevel+  = -- | Trust has to be ensured on the software level. This is weaker than TEE+    -- enforced trust.+    SoftwareEnforced+  | -- | Hardware backed attestation, this requires that the Trusted Executing+    -- Environment enforced the attestation.+    TeeEnforced++-- | The Android Key Format. Allow configuration of the required level of+-- trust.+newtype Format = Format+  { requiredTrustLevel :: TrustLevel+  }++instance Show Format where+  show = Text.unpack . M.asfIdentifier++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-android-key-attestation)+data Statement = Statement+  { sig :: ByteString,+    x5c :: NonEmpty X509.SignedCertificate,+    alg :: Cose.CoseSignAlg,+    -- | Holds the parsed attestation extension of the above X509 certificate+    -- Not part of the spec, but prevents parsing in the AndroidKey.verify function+    pubKey :: Cose.PublicKey,+    attExt :: ExtAttestation+  }+  deriving (Eq, Show)++instance ToJSON Statement where+  toJSON Statement {..} =+    object+      [ "alg" .= alg,+        "sig" .= sig,+        "x5c" .= x5c+      ]++-- | Verification errors specific to Android Key attestation+data VerificationError+  = -- | The public key in the certificate is different from the on in the+    -- attested credential data+    VerificationErrorCredentialKeyMismatch+  | -- | The challenge field of the certificate extension does not match the+    -- clientDataHash+    VerificationErrorClientDataHashMismatch+  | -- | The "attestation" extension is scoped to all applications instead of just the RpId+    VerificationErrorAndroidKeyAllApplicationsFieldFound+  | -- | The origin field(s) were not equal to KM_ORIGIN_GENERATED+    VerificationErrorAndroidKeyOriginFieldInvalid+  | -- | The purpose field(s) were not equal to the singleton set containing+    -- KM_PURPOSE_SIGN+    VerificationErrorAndroidKeyPurposeFieldInvalid+  | -- | The Public key cannot verify the signature over the authenticatorData+    -- and the clientDataHash.+    VerificationErrorVerificationFailure Text+  deriving (Show, Exception)++-- | [(spec)](https://android.googlesource.com/platform/hardware/libhardware/+/master/include/hardware/keymaster_defs.h)+kmOriginGenerated :: Integer+kmOriginGenerated = 0++-- | [(spec)](https://android.googlesource.com/platform/hardware/libhardware/+/master/include/hardware/keymaster_defs.h)+kmPurposeSign :: Integer+kmPurposeSign = 2++instance M.AttestationStatementFormat Format where+  type AttStmt Format = Statement++  asfIdentifier _ = "android-key"++  asfDecode _ xs = do+    case (xs !? "alg", xs !? "sig", xs !? "x5c") of+      (Just (CBOR.TInt algId), Just (CBOR.TBytes sig), Just (CBOR.TList (NE.nonEmpty -> Just x5cRaw))) -> do+        alg <- Cose.toCoseSignAlg algId+        x5c@(credCert :| _) <- forM x5cRaw $ \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 credCert+        attExt <- case X509.extensionGetE (X509.certExtensions cert) of+          Just (Right ext) -> pure ext+          Just (Left err) -> Left $ "Failed to decode certificate attestation extension: " <> Text.pack err+          Nothing -> Left "Certificate attestation extension is missing"++        pubKey <- Cose.fromX509 $ X509.certPubKey cert++        pure Statement {..}+      _ -> Left $ "CBOR map didn't have expected value types (alg: int, sig: bytes, x5c: nonempty list): " <> Text.pack (show xs)++  asfEncode _ Statement {..} =+    CBOR.TMap+      [ (CBOR.TString "sig", CBOR.TBytes sig),+        (CBOR.TString "alg", CBOR.TInt $ Cose.fromCoseSignAlg alg),+        ( CBOR.TString "x5c",+          CBOR.TList $+            map (CBOR.TBytes . X509.encodeSignedObject) $ toList x5c+        )+      ]++  type AttStmtVerificationError Format = VerificationError++  asfVerify Format {..} _ Statement {..} M.AuthenticatorData {adRawData = M.WithRaw rawData, ..} clientDataHash = do+    -- 1. Verify that attStmt is valid CBOR conforming to the syntax defined above and perform CBOR decoding on it to+    -- extract the contained fields.+    -- NOTE: The validity of the data is already checked during decoding.++    -- 2. Verify that sig is a valid signature over the concatenation of authenticatorData and clientDataHash using the+    -- public key in the first certificate in x5c with the algorithm specified in alg.+    let signedData = rawData <> convert (M.unClientDataHash clientDataHash)+    case Cose.verify alg pubKey signedData sig of+      Right () -> pure ()+      Left err -> failure $ VerificationErrorVerificationFailure err++    -- 3. Verify that the public key in the first certificate in x5c matches the credentialPublicKey in the+    -- attestedCredentialData in authenticatorData.+    unless (Cose.fromCose (M.acdCredentialPublicKey adAttestedCredentialData) == pubKey) $ failure VerificationErrorCredentialKeyMismatch++    -- 4. Verify that the attestationChallenge field in the attestation certificate extension data is identical to+    -- clientDataHash.+    -- See https://source.android.com/security/keystore/attestation for the ASN1 description+    unless (attestationChallenge attExt == M.unClientDataHash clientDataHash) $ failure VerificationErrorClientDataHashMismatch++    -- 5. Verify the following using the appropriate authorization list from the attestation certificate extension data:++    -- 5.a The AuthorizationList.allApplications field is not present on either+    -- authorization list (softwareEnforced nor teeEnforced), since+    -- PublicKeyCredential MUST be scoped to the RP ID.+    let software = softwareEnforced attExt+        tee = teeEnforced attExt+    when (isJust (allApplications software) || isJust (allApplications tee)) $ failure VerificationErrorAndroidKeyAllApplicationsFieldFound++    -- 5.b For the following, use only the teeEnforced authorization list if the+    -- RP wants to accept only keys from a trusted execution environment,+    -- otherwise use the union of teeEnforced and softwareEnforced.+    -- 5.b.1 The value in the AuthorizationList.origin field is equal to KM_ORIGIN_GENERATED.+    -- 5.b.2 The value in the AuthorizationList.purpose field is equal to KM_PURPOSE_SIGN.+    -- NOTE: This statement is ambiguous as the purpose field is a set. Existing libraries take the same approach, checking if KM_PURPOSE_SIGN is the only member.+    let targetSet = Just $ Set.singleton kmPurposeSign+    case requiredTrustLevel of+      SoftwareEnforced -> do+        unless (origin software == Just kmOriginGenerated || origin tee == Just kmOriginGenerated) $ failure VerificationErrorAndroidKeyOriginFieldInvalid+        unless (targetSet == purpose software || targetSet == purpose tee) $ failure VerificationErrorAndroidKeyPurposeFieldInvalid+        pure ()+      TeeEnforced -> do+        unless (origin tee == Just kmOriginGenerated) $ failure VerificationErrorAndroidKeyOriginFieldInvalid+        unless (targetSet == purpose tee) $ failure VerificationErrorAndroidKeyPurposeFieldInvalid+        pure ()++    -- 6. If successful, return implementation-specific values representing attestation type Basic and attestation trust+    -- path x5c.+    pure $+      M.SomeAttestationType $+        M.AttestationTypeVerifiable M.VerifiableAttestationTypeBasic (M.Fido2Chain x5c)++  asfTrustAnchors _ _ = mempty++-- | The default Android Key format configuration. Requires the attestation to+-- be backed by a Trusted Executing Environment (TEE).+format :: M.SomeAttestationStatementFormat+format = M.SomeAttestationStatementFormat $ Format TeeEnforced

@@ -0,0 +1,267 @@+{-# LANGUAGE ApplicativeDo #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}++-- | Stability: experimental+-- This module implements the+-- [Android SafetyNet Attestation Statement Format](https://www.w3.org/TR/webauthn-2/#sctn-android-safetynet-attestation).+module Crypto.WebAuthn.AttestationStatementFormat.AndroidSafetyNet+  ( format,+    Format (..),+    Integrity (..),+    VerificationError (..),+  )+where++import Codec.CBOR.Term (Term (TBytes, TString))+import qualified Codec.CBOR.Term as CBOR+import Control.Lens ((^.), (^?))+import Control.Lens.Combinators (_Just)+import Control.Monad (unless, when)+import Control.Monad.Except (MonadError, runExcept, throwError)+import qualified Crypto.Hash as Hash+import qualified Crypto.JOSE as JOSE+import qualified Crypto.JWT as JOSE+import Crypto.WebAuthn.Internal.DateOrphans ()+import Crypto.WebAuthn.Internal.Utils (failure)+import qualified Crypto.WebAuthn.Model.Types as M+import qualified Data.ASN1.Types.String as X509+import Data.Aeson ((.=))+import qualified Data.Aeson as Aeson+import Data.Bifunctor (Bifunctor (first))+import qualified Data.ByteArray as BA+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base64 as Base64+import qualified Data.ByteString.Lazy as LBS+import Data.Fixed (Fixed (MkFixed), Milli)+import Data.HashMap.Lazy ((!?))+import qualified Data.Hourglass as HG+import qualified Data.List.NonEmpty as NE+import Data.String (IsString)+import Data.Text (Text)+import qualified Data.Text as Text+import Data.Text.Encoding (decodeUtf8)+import qualified Data.X509 as X509+import qualified Data.X509.Validation as X509+import GHC.Exception (Exception)+import GHC.Generics (Generic)++-- | [(spec)](https://developer.android.com/training/safetynet/attestation#potential-integrity-verdicts)+-- The integrity of an android device from which a SafetyNet message+-- originated.+data Integrity+  = -- | The device has no integrity, which is the case for an emulator, or it+    -- could be the case for a compromised device+    NoIntegrity+  | -- | The device must have passed the basic integrity check, which is e.g.+    -- the case for a device with a custom ROM but not rooted, or a certified+    -- device with an unlocked bootloader+    BasicIntegrity+  | -- | The device passed the [CTS](https://source.android.com/compatibility/cts/),+    -- it is genuine and verified+    CTSProfileIntegrity+  deriving (Enum, Bounded, Eq, Ord, Show)++-- | The Android SafetyKey Format. Allows configuration of the required level of+-- trust.+data Format = Format+  { -- | What level the integrity check of the originating Android device must+    -- have passed.+    requiredIntegrity :: Integrity,+    -- | The maximum time the received message may be old for it to still be+    -- considered valid.+    driftBackwardsTolerance :: HG.Duration,+    -- | The maximum time difference the received message may report being from+    -- the future for it to still be considered valid.+    driftForwardsTolerance :: HG.Duration+  }++instance Show Format where+  show = Text.unpack . M.asfIdentifier++-- | [(spec)](https://developer.android.com/training/safetynet/attestation.html#compat-check-response)+data Response = Response+  { timestampMs :: Milliseconds,+    nonce :: Text,+    apkPackageName :: Text,+    apkCertificateDigestSha256 :: [Text], -- [Base 64 encoded SHA256 hash]+    ctsProfileMatch :: Bool,+    basicIntegrity :: Bool,+    evaluationType :: Text+  }+  deriving (Eq, Show, Generic, Aeson.FromJSON, Aeson.ToJSON)++-- | Milliseconds represented as an 'Integer', used for 'timestampMs'+newtype Milliseconds = Milliseconds Integer+  deriving (Eq, Show)+  deriving newtype (Aeson.FromJSON, Aeson.ToJSON)+  deriving (HG.Timeable) via Milli++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-android-safetynet-attestation)+data Statement = Statement+  { ver :: Text.Text,+    x5c :: NE.NonEmpty X509.SignedCertificate,+    response :: Response,+    responseRaw :: BS.ByteString+  }+  deriving (Eq, Show)++instance Aeson.ToJSON Statement where+  toJSON Statement {..} =+    Aeson.object+      [ "ver" .= ver,+        "x5c" .= x5c,+        "response" .= response+      ]++-- | Verification errors specific to Android SafetyNet+data VerificationError+  = -- | The receiced nonce was not set to the concatenation of the+    -- authenticator data and client data hash+    VerificationErrorInvalidNonce+  | -- | The response was created to far in the past+    -- (first: now, second: generated time)+    VerificationErrorResponseTooOld HG.DateTime HG.DateTime+  | -- | The response was created to far in the future+    -- (first: now, second: generated time)+    VerificationErrorResponseInFuture HG.DateTime HG.DateTime+  | -- | The integrity check failed based on the required integrity from the+    -- format+    VerificationErrorFailedIntegrityCheck Integrity+  deriving (Show, Exception)++androidHostName :: VerificationHostName+androidHostName = "attest.android.com"++newtype VerificationHostName = VerificationHostName {unVerificationHostName :: X509.HostName}+  deriving newtype (IsString)++-- | This instance doesn't actually perform any validation+instance MonadError JOSE.Error m => JOSE.VerificationKeyStore m (JOSE.JWSHeader ()) p VerificationHostName where+  getVerificationKeys header _ hostName = do+    chain <- case header ^? JOSE.x5c . _Just . JOSE.param of+      Nothing -> throwError JOSE.JWSInvalidSignature+      Just chain -> pure chain++    let leaf = NE.head chain+    case X509.asn1CharacterToString+      =<< ( X509.getDnElement X509.DnCommonName+              . X509.certSubjectDN+              . X509.getCertificate+              $ leaf+          ) of+      Nothing -> pure ()+      Just commonName ->+        unless (commonName == unVerificationHostName hostName)+          . throwError+          $ JOSE.JWSInvalidSignature++    -- Create a JWK from the leaf certificate, which is used to sign the payload+    pure <$> JOSE.fromX509Certificate leaf++instance M.AttestationStatementFormat Format where+  type AttStmt Format = Statement+  asfIdentifier _ = "android-safetynet"++  asfDecode _ xs =+    case (xs !? "ver", xs !? "response") of+      (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)+        response <-+          first (("Failed to verify/decode JWT payload: " <>) . Text.pack . show) $+            JOSE.verifyJWSWithPayload+              (first JOSE.JSONDecodeError . Aeson.eitherDecode)+              (JOSE.defaultJWTValidationSettings (const True))+              androidHostName+              jws+        x5c <- extractX5C jws+        pure $ Statement {..}+      _ -> Left $ "CBOR map didn't have expected types (ver: string, response: bytes): " <> Text.pack (show xs)+    where+      extractX5C :: JOSE.CompactJWS JOSE.JWSHeader -> Either Text (NE.NonEmpty X509.SignedCertificate)+      extractX5C jws = do+        sig <- case jws ^? JOSE.signatures of+          Nothing -> Left "Can't extract x5c because the JWT contains no signatures"+          Just res -> pure res+        JOSE.HeaderParam () x5c <- case sig ^. JOSE.header . JOSE.x5c of+          Nothing -> Left "No x5c in the header of the first JWT signature"+          Just res -> pure res+        pure x5c++  asfEncode _ Statement {..} =+    CBOR.TMap+      [ (TString "ver", TString ver),+        (TString "response", TBytes responseRaw)+      ]++  type AttStmtVerificationError Format = VerificationError+  asfVerify Format {..} now Statement {..} M.AuthenticatorData {adRawData = M.WithRaw rawData} clientDataHash = do+    -- 1. Verify that attStmt is valid CBOR conforming to the syntax defined above and perform CBOR decoding on it to+    -- extract the contained fields.+    -- NOTE: Done in decoding++    -- 2. Verify that response is a valid SafetyNet response of version ver by following the steps indicated by the+    -- SafetyNet online documentation. As of this writing, there is only one format of the SafetyNet response and ver+    -- is reserved for future use.+    -- NOTE: As stated above, only one version exists, which we assume during decoding++    -- 3. Verify that the nonce attribute in the payload of response is identical to the Base64 encoding of the SHA-256+    -- hash of the concatenation of authenticatorData and clientDataHash.+    let signedData = rawData <> BA.convert (M.unClientDataHash clientDataHash)+    let hashedData = Hash.hashWith Hash.SHA256 signedData+    let encodedData = decodeUtf8 . Base64.encode $ BA.convert hashedData+    unless (nonce response == encodedData) . failure $ VerificationErrorInvalidNonce++    -- 4. Verify that the SafetyNet response actually came from the SafetyNet service by following the steps in the+    -- SafetyNet online documentation.+    -- 4.1. Extract the SSL certificate chain from the JWS message.+    -- NOTE: Done during decoding++    -- 4.2. Validate the SSL certificate chain and use SSL hostname matching to verify that the leaf certificate was+    -- issued to the hostname attest.android.com.+    -- NOTE: Done during decoding++    -- 4.3. Use the certificate to verify the signature of the JWS message.+    -- NOTE: Done during decoding. The jose library forces us to do verification before we access the payload. Since we+    -- would like to decode the payload during decoding, this step is also done during decoding.++    -- 4.4. Check the data of the JWS message to make sure it matches the data within your original request. In particular,+    -- make sure that the timestamp has been validated and that the nonce, package name, and hashes of the app's+    -- signing certificate(s) match the expected values.+    -- NOTE: For WebAuthn, we need not care about the package name or the app's signing certificate. The Nonce as+    -- has already been dealt with.+    let generatedTime = HG.timeConvert $ timestampMs response+    when ((generatedTime `HG.timeAdd` driftBackwardsTolerance) < now) $ failure $ VerificationErrorResponseTooOld now generatedTime+    when (generatedTime > (now `HG.timeAdd` driftForwardsTolerance)) $ failure $ VerificationErrorResponseInFuture now generatedTime++    let integrity = case (basicIntegrity response, ctsProfileMatch response) of+          (_, True) -> CTSProfileIntegrity+          (True, False) -> BasicIntegrity+          (False, False) -> NoIntegrity+    unless (integrity >= requiredIntegrity) $+      failure $ VerificationErrorFailedIntegrityCheck integrity++    -- 5. If successful, return implementation-specific values representing attestation type Basic and attestation trust+    -- path x5c.+    pure $+      M.SomeAttestationType $+        M.AttestationTypeVerifiable M.VerifiableAttestationTypeBasic (M.Fido2Chain x5c)++  asfTrustAnchors _ _ = mempty++-- | The default SafetyNet format configuration. Requires full+-- CTSProfileIntegrity and allows for the SafetyNet message to be at most 60+-- seconds old. Does not allow any timedrift into the future.+format :: M.SomeAttestationStatementFormat+format =+  M.SomeAttestationStatementFormat $+    Format+      { requiredIntegrity = CTSProfileIntegrity,+        driftBackwardsTolerance = mempty {HG.durationSeconds = 60},+        driftForwardsTolerance = mempty+      }

@@ -0,0 +1,177 @@+{-# LANGUAGE ApplicativeDo #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ViewPatterns #-}++-- | Stability: experimental+-- This module implements the+-- [Apple Anonymous Attestation Statement Format](https://www.w3.org/TR/webauthn-2/#sctn-apple-anonymous-attestation).+-- Note that this attestation statement format is currently not registered in the+-- [WebAuthn Attestation Statement Format Identifiers IANA registry](https://www.iana.org/assignments/webauthn/webauthn.xhtml#webauthn-attestation-statement-format-ids).+module Crypto.WebAuthn.AttestationStatementFormat.Apple+  ( format,+    Format (..),+    VerificationError (..),+  )+where++import qualified Codec.CBOR.Term as CBOR+import Control.Exception (Exception)+import Control.Monad (forM)+import Control.Monad.Cont (unless)+import Crypto.Hash (Digest, SHA256, digestFromByteString, hash)+import qualified Crypto.WebAuthn.Cose.Internal.Verify as Cose+import Crypto.WebAuthn.Internal.Utils (failure)+import qualified Crypto.WebAuthn.Model.Types as M+import qualified Data.ASN1.Parse as ASN1+import qualified Data.ASN1.Types as ASN1+import Data.Aeson (ToJSON, object, toJSON, (.=))+import Data.Bifunctor (first)+import qualified Data.ByteArray as BA+import Data.FileEmbed (embedFile)+import Data.HashMap.Strict ((!?))+import Data.List.NonEmpty (NonEmpty ((:|)), toList)+import qualified Data.List.NonEmpty as NE+import qualified Data.Text as Text+import qualified Data.X509 as X509+import qualified Data.X509.CertificateStore as X509++-- | The Apple format. The sole purpose of this type is to instantiate the+-- AttestationStatementFormat typeclass below.+data Format = Format++instance Show Format where+  show = Text.unpack . M.asfIdentifier++-- | Verification errors specific to Apple attestation+data VerificationError+  = -- | The nonce found in the certificate extension does not match the+    -- expected nonce+    -- (first: expected, second: received)+    NonceMismatch (Digest SHA256) (Digest SHA256)+  | -- | The public Key found in the certificate does not match the+    -- credential's public key.+    -- (first: credential, second: certificate)+    PublickeyMismatch Cose.PublicKey Cose.PublicKey+  deriving (Show, Exception)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-apple-anonymous-attestation)+-- We extend the statement to include values we would further have to decode+-- during the verification procedure.+data Statement = Statement+  { x5c :: NE.NonEmpty X509.SignedCertificate,+    sNonce :: Digest SHA256,+    pubKey :: Cose.PublicKey+  }+  deriving (Eq, Show)++instance ToJSON Statement where+  toJSON Statement {..} =+    object+      [ "x5c" .= x5c+      ]++-- | Undocumented, but the Apple Nonce Extension should only contain the nonce+newtype AppleNonceExtension = AppleNonceExtension+  { nonce :: Digest SHA256+  }+  deriving (Eq, Show)++instance X509.Extension AppleNonceExtension where+  extOID = const [1, 2, 840, 113635, 100, 8, 2]+  extHasNestedASN1 = const False+  extEncode = error "extEncode for AppleNonceExtension is unimplemented"+  extDecode = ASN1.runParseASN1 decode+    where+      decode :: ASN1.ParseASN1 AppleNonceExtension+      decode = do+        ASN1.OctetString nonce <-+          ASN1.onNextContainer ASN1.Sequence $+            ASN1.onNextContainer (ASN1.Container ASN1.Context 1) ASN1.getNext+        maybe+          (fail "The nonce in the Extention was not a valid SHA256 hash")+          (pure . AppleNonceExtension)+          (digestFromByteString nonce)++instance M.AttestationStatementFormat Format where+  type AttStmt Format = Statement+  asfIdentifier _ = "apple"++  asfDecode _ xs = case xs !? "x5c" of+    Just (CBOR.TList (NE.nonEmpty -> Just x5cRaw)) -> do+      x5c@(credCert :| _) <- forM x5cRaw $ \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 credCert++      pubKey <- Cose.fromX509 $ X509.certPubKey cert++      AppleNonceExtension {..} <- case X509.extensionGetE $ X509.certExtensions cert of+        Just (Right ext) -> pure ext+        Just (Left err) -> Left $ "Failed to decode certificate apple nonce extension: " <> Text.pack err+        Nothing -> Left "Certificate apple nonce extension is missing"++      pure $ Statement x5c nonce pubKey+    _ -> Left $ "CBOR map didn't have expected value types (x5c: nonempty list): " <> Text.pack (show xs)++  asfEncode _ Statement {..} =+    let encodedx5c = map (CBOR.TBytes . X509.encodeSignedObject) $ toList x5c+     in CBOR.TMap+          [ (CBOR.TString "x5c", CBOR.TList encodedx5c)+          ]++  type AttStmtVerificationError Format = VerificationError++  -- https://www.w3.org/TR/webauthn-2/#sctn-apple-anonymous-attestation+  asfVerify+    _+    _+    Statement {..}+    M.AuthenticatorData {adAttestedCredentialData = credData, ..}+    clientDataHash = do+      -- 1. Let authenticatorData denote the authenticator data for the+      -- attestation, and let clientDataHash denote the hash of the serialized+      -- client data.+      -- NOTE: Done in decoding++      -- 2. Concatenate authenticatorData and clientDataHash to form+      -- nonceToHash.+      let nonceToHash = M.unRaw adRawData <> BA.convert (M.unClientDataHash clientDataHash)++      -- 3. Perform SHA-256 hash of nonceToHash to produce nonce.+      let nonce = hash nonceToHash++      -- 4. Verify that nonce equals the value of the extension with OID+      -- 1.2.840.113635.100.8.2 in credCert.+      unless (nonce == sNonce) . failure $ NonceMismatch nonce sNonce++      -- 5. Verify that the credential public key equals the Subject Public Key+      -- of credCert.+      let credentialPublicKey = Cose.fromCose $ M.acdCredentialPublicKey credData+      unless (credentialPublicKey == pubKey) . failure $ PublickeyMismatch credentialPublicKey pubKey++      -- 6. If successful, return implementation-specific values representing+      -- attestation type Anonymization CA and attestation trust path x5c.+      pure $+        M.SomeAttestationType $+          M.AttestationTypeVerifiable M.VerifiableAttestationTypeAnonCA (M.Fido2Chain x5c)++  asfTrustAnchors _ _ = rootCertificateStore++rootCertificateStore :: X509.CertificateStore+rootCertificateStore = X509.makeCertificateStore [rootCertificate]++-- | The root certificate used for apple attestation formats+rootCertificate :: X509.SignedCertificate+rootCertificate = case X509.decodeSignedCertificate $(embedFile "root-certs/apple/Apple_WebAuthn_Root_CA.crt") of+  Left err -> error $ "Error while decoding Apple root certificate: " <> err+  Right cert -> cert++-- | Helper function that wraps the Apple format into the general+-- SomeAttestationStatementFormat type.+format :: M.SomeAttestationStatementFormat+format = M.SomeAttestationStatementFormat Format

@@ -0,0 +1,176 @@+{-# LANGUAGE ApplicativeDo #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}++-- | Stability: experimental+-- This module implements the+-- [FIDO U2F Attestation Statement Format](https://www.w3.org/TR/webauthn-2/#sctn-fido-u2f-attestation).+module Crypto.WebAuthn.AttestationStatementFormat.FidoU2F+  ( format,+    Format (..),+    VerificationError (..),+  )+where++import qualified Codec.CBOR.Term as CBOR+import Control.Exception (Exception)+import Control.Monad (unless)+import Crypto.PubKey.ECC.Types (CurveName (SEC_p256r1))+import qualified Crypto.WebAuthn.Cose.Internal.Verify as Cose+import Crypto.WebAuthn.Internal.Utils (failure)+import qualified Crypto.WebAuthn.Model.Types as M+import Data.Aeson (ToJSON, object, toJSON, (.=))+import Data.Bifunctor (first)+import qualified Data.ByteArray as BA+import qualified Data.ByteString as BS+import Data.HashMap.Strict ((!?))+import qualified Data.Text as Text+import qualified Data.X509 as X509+import qualified Data.X509.EC as X509+import qualified Data.X509.Validation as X509++-- | The Fido U2F format. The sole purpose of this type is to instantiate the+-- AttestationStatementFormat typeclass below.+data Format = Format++instance Show Format where+  show = Text.unpack . M.asfIdentifier++-- | Decoding errors specific to Fido U2F attestation+data DecodingError+  = -- | No Signature field was present+    NoSig+  | -- | No x5c certificate was present+    NoX5C+  | -- | Multiple x5c certificates were found where only one was expected+    MultipleX5C+  | -- | There was an error decoding the x5c certificate, string is the error resulted by the `Data.X509.decodeSignedCertificate` function+    DecodingErrorX5C String+  deriving (Show, Exception)++-- | Verification errors specific to Fido U2F attestation+data VerificationError+  = -- | The public key in the certificate was not an EC Key or the curve was not the p256 curve+    InvalidCertificatePublicKey X509.PubKey+  | -- | The credential public key is not an ECDSA key+    NonECDSACredentialPublicKey Cose.PublicKey+  | -- | The x and/or y coordinates of the credential public key don't have a length of 32 bytes+    WrongCoordinateSize Int Int+  | -- | The provided public key cannot validate the signature over the verification data+    InvalidSignature X509.SignatureFailure+  deriving (Show, Exception)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-fido-u2f-attestation)+data Statement = Statement+  { sig :: BS.ByteString,+    attCert :: X509.SignedCertificate+  }+  deriving (Show, Eq)++instance ToJSON Statement where+  toJSON Statement {..} =+    object+      [ "attestnCert" .= attCert,+        "sig" .= sig+      ]++instance M.AttestationStatementFormat Format where+  type AttStmt Format = Statement+  asfIdentifier _ = "fido-u2f"++  asfDecode _ xs = case (xs !? "sig", xs !? "x5c") of+    (Just (CBOR.TBytes sig), Just (CBOR.TList [CBOR.TBytes certBytes])) -> do+      attCert <- first (("Failed to decode signed certificate: " <>) . Text.pack) (X509.decodeSignedCertificate certBytes)+      pure $ Statement sig attCert+    _ -> Left $ "CBOR map didn't have expected value types (sig: bytes, x5c: one-element list): " <> Text.pack (show xs)++  asfEncode _ Statement {..} =+    CBOR.TMap+      [ (CBOR.TString "sig", CBOR.TBytes sig),+        (CBOR.TString "x5c", CBOR.TList [CBOR.TBytes $ X509.encodeSignedObject attCert])+      ]++  type AttStmtVerificationError Format = VerificationError++  asfVerify+    _+    _+    Statement {..}+    M.AuthenticatorData+      { M.adAttestedCredentialData = M.AttestedCredentialData {..},+        ..+      }+    clientDataHash = do+      -- 1. Verify that attStmt is valid CBOR conforming to the syntax defined above+      -- and perform CBOR decoding on it to extract the contained fields.+      -- NOTE: The validity of the data is already checked during decoding.++      -- 2.a Check that x5c has exactly one element and let attCert be that element.+      -- NOTE: This has already been done during decoding++      -- 2.b Let certificate public key be the public key conveyed by attCert. If+      -- certificate public key is not an Elliptic Curve (EC) public key over the+      -- P-256 curve, terminate this algorithm and return an appropriate error.+      let certPubKey = X509.certPubKey $ X509.getCertificate attCert+      case certPubKey of+        X509.PubKeyEC pk ->+          case X509.ecPubKeyCurveName pk of+            Just SEC_p256r1 -> pure ()+            _ -> failure $ InvalidCertificatePublicKey certPubKey+        _ -> failure $ InvalidCertificatePublicKey certPubKey++      -- 3. Extract the claimed rpIdHash from authenticatorData, and the claimed+      -- credentialId and credentialPublicKey from authenticatorData.attestedCredentialData.+      -- NOTE: Done in patternmatch++      -- 4. Convert the COSE_KEY formatted credentialPublicKey (see Section 7 of+      -- [RFC8152]) to Raw ANSI X9.62 public key format (see ALG_KEY_ECC_X962_RAW in+      -- Section 3.6.2 Public Key Representation Formats of [FIDO-Registry]).++      -- 4.a Let x be the value corresponding to the "-2" key (representing x+      -- coordinate) in credentialPublicKey, and confirm its size to be of 32 bytes.+      -- If size differs or "-2" key is not found, terminate this algorithm and+      -- return an appropriate error.+      -- 4.b Let y be the value corresponding to the "-3" key (representing y+      -- coordinate) in credentialPublicKey, and confirm its size to be of 32 bytes.+      -- If size differs or "-3" key is not found, terminate this algorithm and+      -- return an appropriate error.+      -- NOTE: Already done during decoding of the COSE public key+      case Cose.fromCose acdCredentialPublicKey of+        Cose.PublicKeyECDSA {ecdsaX = xb, ecdsaY = yb} -> do+          let xlen = BS.length xb+              ylen = BS.length yb+          unless (xlen == 32 && ylen == 32) $ failure $ WrongCoordinateSize xlen ylen++          -- 4.c Let publicKeyU2F be the concatenation 0x04 || x || y.+          let publicKeyU2F = BS.singleton 0x04 <> xb <> yb++          -- 5. Let verificationData be the concatenation of (0x00 || rpIdHash ||+          -- clientDataHash || credentialId || publicKeyU2F) (see Section 4.3 of+          -- [FIDO-U2F-Message-Formats]).+          let credId = M.unCredentialId acdCredentialId+              verificationData = BS.singleton 0x00 <> BA.convert (M.unRpIdHash adRpIdHash) <> BA.convert (M.unClientDataHash clientDataHash) <> credId <> publicKeyU2F++          -- 6. Verify the sig using verificationData and the certificate public key per+          -- section 4.1.4 of [SEC1] with SHA-256 as the hash function used in step two.+          case X509.verifySignature (X509.SignatureALG X509.HashSHA256 X509.PubKeyALG_EC) certPubKey verificationData sig of+            X509.SignaturePass -> pure ()+            X509.SignatureFailed e -> failure $ InvalidSignature e+          pure ()+        key -> failure $ NonECDSACredentialPublicKey key++      -- 7. Optionally, inspect x5c and consult externally provided knowledge to+      -- determine whether attStmt conveys a Basic or AttCA attestation.+      -- 8. If successful, return implementation-specific values representing+      -- attestation type Basic, AttCA or uncertainty, and attestation trust path+      -- x5c.+      pure $+        M.SomeAttestationType $+          M.AttestationTypeVerifiable M.VerifiableAttestationTypeUncertain (M.FidoU2FCert attCert)++  asfTrustAnchors _ _ = mempty++-- | Helper function that wraps the Fido U2F format into the general+-- SomeAttestationStatementFormat type.+format :: M.SomeAttestationStatementFormat+format = M.SomeAttestationStatementFormat Format

@@ -0,0 +1,41 @@+{-# LANGUAGE TypeFamilies #-}++-- | Stability: experimental+-- This module implements the+-- [None Attestation Statement Format](https://www.w3.org/TR/webauthn-2/#sctn-none-attestation).+-- Note that this attestation statement format is currently not registered in the+-- [WebAuthn Attestation Statement Format Identifiers IANA registry](https://www.iana.org/assignments/webauthn/webauthn.xhtml#webauthn-attestation-statement-format-ids).+module Crypto.WebAuthn.AttestationStatementFormat.None+  ( format,+    Format (..),+  )+where++import qualified Codec.CBOR.Term as CBOR+import qualified Crypto.WebAuthn.Model.Types as M+import qualified Data.Text as Text+import Data.Void (Void)++-- | The None format. The sole purpose of this type is to instantiate the+-- AttestationStatementFormat typeclass below.+data Format = Format++instance Show Format where+  show = Text.unpack . M.asfIdentifier++instance M.AttestationStatementFormat Format where+  type AttStmt Format = ()+  asfIdentifier _ = "none"++  asfDecode _ _ = Right ()+  asfEncode _ _ = CBOR.TMap []++  type AttStmtVerificationError Format = Void+  asfVerify _ _ _ _ _ = pure $ M.SomeAttestationType M.AttestationTypeNone++  asfTrustAnchors _ _ = mempty++-- | Helper function that wraps the None format into the general+-- SomeAttestationStatementFormat type.+format :: M.SomeAttestationStatementFormat+format = M.SomeAttestationStatementFormat Format

@@ -0,0 +1,190 @@+{-# LANGUAGE ApplicativeDo #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}++-- | Stability: experimental+-- This module implements the+-- [Packed Attestation Statement Format](https://www.w3.org/TR/webauthn-2/#sctn-packed-attestation).+module Crypto.WebAuthn.AttestationStatementFormat.Packed+  ( format,+    Format (..),+    VerificationError (..),+  )+where++import qualified Codec.CBOR.Term as CBOR+import Control.Exception (Exception)+import Control.Monad (forM, unless, when)+import qualified Crypto.WebAuthn.Cose.Algorithm as Cose+import qualified Crypto.WebAuthn.Cose.Internal.Verify as Cose+import qualified Crypto.WebAuthn.Cose.Key as Cose+import Crypto.WebAuthn.Internal.Utils (IdFidoGenCeAAGUID (IdFidoGenCeAAGUID), failure)+import qualified Crypto.WebAuthn.Model.Types as M+import Data.ASN1.Error (ASN1Error)+import qualified Data.ASN1.OID as OID+import Data.Aeson (ToJSON, object, toJSON, (.=))+import Data.Bifunctor (first)+import Data.ByteArray (convert)+import qualified Data.ByteString as BS+import Data.HashMap.Strict ((!?))+import Data.List.NonEmpty (NonEmpty ((:|)), toList)+import qualified Data.List.NonEmpty as NE+import Data.Maybe (isJust)+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.X509 as X509+import qualified Data.X509.Validation as X509++-- | The Packed format. The sole purpose of this type is to instantiate the+-- AttestationStatementFormat typeclass below.+data Format = Format++instance Show Format where+  show = Text.unpack . M.asfIdentifier++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-packed-attestation)+data Statement = Statement+  { alg :: Cose.CoseSignAlg,+    sig :: BS.ByteString,+    x5c :: Maybe (NE.NonEmpty X509.SignedCertificate, IdFidoGenCeAAGUID)+  }+  deriving (Eq, Show)++instance ToJSON Statement where+  toJSON Statement {..} =+    object+      ( [ "alg" .= alg,+          "sig" .= sig+        ]+          ++ maybe [] (\(x5c', _) -> ["x5c" .= x5c']) x5c+      )++-- | Verification errors specific to Packed attestation+data VerificationError+  = -- | The Algorithm from the attestation format does not match the algorithm+    -- of the key in the credential data+    VerificationErrorAlgorithmMismatch+  | -- | The statement key cannot verify the signature over the attested+    -- credential data and client data for self attestation+    VerificationErrorInvalidSignature Text+  | -- | The statement certificate cannot verify the signature over the attested+    -- credential data and client data for nonself attestation+    VerificationErrorVerificationFailure X509.SignatureFailure+  | -- | The certificate does not meet the requirements layed out in the+    -- webauthn specification+    -- https://www.w3.org/TR/webauthn-2/#sctn-packed-attestation-cert-requirements+    VerificationErrorCertificateRequirementsUnmet+  | -- | The (supposedly) ASN1 encoded certificate extension could not be+    -- decoded+    VerificationErrorASN1Error ASN1Error+  | -- | The certificate extension does not contain a AAGUID+    VerificationErrorCredentialAAGUIDMissing+  | -- | The AAGUID in the certificate extension does not match the AAGUID in+    -- the authenticator data+    VerificationErrorCertificateAAGUIDMismatch+  deriving (Show, Exception)++instance M.AttestationStatementFormat Format where+  type AttStmt Format = Statement++  asfIdentifier _ = "packed"++  asfDecode _ xs =+    case (xs !? "alg", xs !? "sig", xs !? "x5c") of+      (Just (CBOR.TInt algId), Just (CBOR.TBytes sig), Just (CBOR.TList x5cRaw)) -> do+        alg <- Cose.toCoseSignAlg algId+        x5c <- 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)+        pure $ Statement {..}+      _ -> Left $ "CBOR map didn't have expected value types (alg: int, sig: bytes, x5c: 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)+          ]++  type AttStmtVerificationError Format = VerificationError++  asfVerify+    _+    _+    Statement {alg = stmtAlg, sig = stmtSig, x5c = stmtx5c}+    M.AuthenticatorData {M.adRawData = M.WithRaw rawData, M.adAttestedCredentialData = credData}+    clientDataHash = do+      let signedData = rawData <> convert (M.unClientDataHash clientDataHash)+      case stmtx5c of+        -- Self attestation+        Nothing -> do+          -- Validate that alg matches the algorithm of the credentialPublicKey in authenticatorData.+          let key = M.acdCredentialPublicKey credData+              signAlg = Cose.keySignAlg key+          when (stmtAlg /= signAlg) $ failure VerificationErrorAlgorithmMismatch++          -- Verify that sig is a valid signature over the concatenation of+          -- authenticatorData and clientDataHash using the credential public key with alg.+          case Cose.verify signAlg (Cose.fromCose key) signedData stmtSig of+            Right () -> pure ()+            Left err -> failure $ VerificationErrorInvalidSignature err++          pure $ M.SomeAttestationType M.AttestationTypeSelf++        -- Basic, AttCA+        Just (x5c@(certCred :| _), IdFidoGenCeAAGUID credAAGUID) -> do+          let cert = X509.getCertificate certCred+              pubKey = X509.certPubKey cert+          -- Verify that sig is a valid signature over the concatenation of authenticatorData and clientDataHash using+          -- the attestation public key in attestnCert with the algorithm specified in alg.+          case X509.verifySignature (X509.SignatureALG X509.HashSHA256 X509.PubKeyALG_EC) pubKey signedData stmtSig of+            X509.SignaturePass -> pure ()+            X509.SignatureFailed err -> failure $ VerificationErrorVerificationFailure err++          -- Verify that attestnCert meets the requirements in § 8.2.1 Packed Attestation Statement Certificate+          -- Requirements.+          let dnElements = X509.getDistinguishedElements $ X509.certSubjectDN cert+          unless+            ( hasDnElement X509.DnCountry dnElements+                && hasDnElement X509.DnOrganization dnElements+                && hasDnElement X509.DnCommonName dnElements+                && findDnElement X509.DnOrganizationUnit dnElements == Just "Authenticator Attestation"+            )+            $ failure VerificationErrorCertificateRequirementsUnmet++          -- If attestnCert contains an extension with OID 1.3.6.1.4.1.45724.1.1.4 (id-fido-gen-ce-aaguid) verify that+          -- the value of this extension matches the aaguid in authenticatorData.+          let aaguid = M.acdAaguid credData+          unless (aaguid == credAAGUID) $ failure VerificationErrorCertificateAAGUIDMismatch++          pure $+            M.SomeAttestationType $+              M.AttestationTypeVerifiable M.VerifiableAttestationTypeUncertain (M.Fido2Chain x5c)+      where+        hasDnElement :: X509.DnElement -> [(OID.OID, X509.ASN1CharacterString)] -> Bool+        hasDnElement el = isJust . findDnElement el++        findDnElement :: X509.DnElement -> [(OID.OID, X509.ASN1CharacterString)] -> Maybe X509.ASN1CharacterString+        findDnElement dnElementName = lookup (OID.getObjectID dnElementName)++  asfTrustAnchors _ _ = mempty++-- | Helper function that wraps the Packed format into the general+-- SomeAttestationStatementFormat type.+format :: M.SomeAttestationStatementFormat+format = M.SomeAttestationStatementFormat Format

@@ -0,0 +1,644 @@+{-# LANGUAGE ApplicativeDo #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ViewPatterns #-}++-- | Stability: experimental+-- This module implements the+-- [TPM Attestation Statement Format](https://www.w3.org/TR/webauthn-2/#sctn-tpm-attestation).+module Crypto.WebAuthn.AttestationStatementFormat.TPM+  ( format,+    Format (..),+    VerificationError (..),+  )+where++import qualified Codec.CBOR.Term as CBOR+import Control.Exception (Exception)+import Control.Monad (forM, unless, when)+import Crypto.Hash (SHA1 (SHA1), SHA256 (SHA256), hashWith)+import qualified Crypto.Hash as Hash+import Crypto.Number.Serialize (os2ip)+import qualified Crypto.WebAuthn.Cose.Algorithm as Cose+import qualified Crypto.WebAuthn.Cose.Internal.Verify as Cose+import qualified Crypto.WebAuthn.Cose.Key as Cose+import Crypto.WebAuthn.Internal.Utils (IdFidoGenCeAAGUID (IdFidoGenCeAAGUID), failure)+import qualified Crypto.WebAuthn.Model.Types as M+import Data.ASN1.Error (ASN1Error)+import Data.ASN1.OID (OID)+import Data.ASN1.Parse (ParseASN1, getNext, hasNext, runParseASN1)+import Data.ASN1.Prim (ASN1 (ASN1String, OID))+import Data.Aeson (ToJSON, Value (String), object, toJSON, (.=))+import Data.Bifunctor (Bifunctor (first))+import Data.Binary (Word16, Word32, Word64)+import qualified Data.Binary.Get as Get+import qualified Data.Binary.Put as Put+import qualified Data.ByteArray as BA+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import Data.FileEmbed (embedDir)+import Data.HashMap.Strict ((!?))+import Data.List.NonEmpty (NonEmpty ((:|)))+import qualified Data.List.NonEmpty as NE+import qualified Data.Map as Map+import qualified Data.Set as Set+import Data.Text (Text)+import qualified Data.Text as Text+import Data.Text.Encoding (decodeUtf8)+import qualified Data.X509 as X509+import qualified Data.X509.CertificateStore as X509+import GHC.Generics (Generic)++tpmManufacturers :: Set.Set Text+tpmManufacturers =+  Set.fromList+    [ "id:FFFFF1D0", -- FIDO testing TPM+    -- From https://trustedcomputinggroup.org/wp-content/uploads/TCG-TPM-Vendor-ID-Registry-Version-1.02-Revision-1.00.pdf+      "id:414D4400", -- 'AMD'  AMD+      "id:41544D4C", -- 'ATML' Atmel+      "id:4252434D", -- 'BRCM' Broadcom+      "id:4353434F", -- 'CSCO' Cisco+      "id:464C5953", -- 'FLYS' Flyslice Technologies+      "id:48504500", -- 'HPE'  HPE+      "id:49424d00", -- 'IBM'  IBM+      "id:49465800", -- 'IFX'  Infineon+      "id:494E5443", -- 'INTC' Intel+      "id:4C454E00", -- 'LEN'  Lenovo+      "id:4D534654", -- 'MSFT' Microsoft+      "id:4E534D20", -- 'NSM'  National Semiconductor+      "id:4E545A00", -- 'NTZ'  Nationz+      "id:4E544300", -- 'NTC'  Nuvoton Technology+      "id:51434F4D", -- 'QCOM' Qualcomm+      "id:534D5343", -- 'SMSC' SMSC+      "id:53544D20", -- 'STM ' ST Microelectronics+      "id:534D534E", -- 'SMSN' Samsung+      "id:534E5300", -- 'SNS'  Sinosun+      "id:54584E00", -- 'TXN'  Texas Instruments+      "id:57454300", -- 'WEC'  Winbond+      "id:524F4343", -- 'ROCC' Fuzhou Rockchip+      "id:474F4F47" -- 'GOOG'  Google+    ]++-- | [(spec)](https://trustedcomputinggroup.org/wp-content/uploads/TCG-_Algorithm_Registry_r1p32_pub.pdf)+data TPMAlgId = TPMAlgRSA | TPMAlgSHA1 | TPMAlgSHA256 | TPMAlgECC+  deriving (Show, Eq, Generic, ToJSON)++-- | [(spec)](https://trustedcomputinggroup.org/wp-content/uploads/TCG-_Algorithm_Registry_r1p32_pub.pdf)+toTPMAlgId :: MonadFail m => Word16 -> m TPMAlgId+toTPMAlgId 0x0001 = pure TPMAlgRSA+toTPMAlgId 0x0004 = pure TPMAlgSHA1+toTPMAlgId 0x000B = pure TPMAlgSHA256+toTPMAlgId 0x0023 = pure TPMAlgECC+toTPMAlgId _ = fail "Unsupported or invalid TPM_ALD_IG"++-- | [(spec)](https://trustedcomputinggroup.org/wp-content/uploads/TCG-_Algorithm_Registry_r1p32_pub.pdf)+toCurveId :: MonadFail m => Word16 -> m Cose.CoseCurveECDSA+toCurveId 0x0003 = pure Cose.CoseCurveP256+toCurveId 0x0004 = pure Cose.CoseCurveP384+toCurveId 0x0005 = pure Cose.CoseCurveP521+toCurveId _ = fail "Unsupported Curve ID"++-- | [(spec)](https://trustedcomputinggroup.org/wp-content/uploads/TCG_TPM2_r1p59_Part2_Structures_pub.pdf)+tpmGeneratedValue :: Word32+tpmGeneratedValue = 0xff544347++-- | [(spec)](https://trustedcomputinggroup.org/wp-content/uploads/TCG_TPM2_r1p59_Part2_Structures_pub.pdf)+tpmStAttestCertify :: Word16+tpmStAttestCertify = 0x8017++-- | The TPMS_CLOCK_INFO structure as specified in [TPMv2-Part2](https://www.trustedcomputinggroup.org/wp-content/uploads/TPM-Rev-2.0-Part-2-Structures-01.38.pdf)+-- section 10.11.1.+data TPMSClockInfo = TPMSClockInfo+  { tpmsciClock :: Word64,+    tpmsciResetCount :: Word32,+    tpmsciRestartCount :: Word32,+    tpmsciSafe :: Bool+  }+  deriving (Eq, Show, Generic, ToJSON)++-- | The TPMS_CERTIFY_INFO structure as specified in [TPMv2-Part2](https://www.trustedcomputinggroup.org/wp-content/uploads/TPM-Rev-2.0-Part-2-Structures-01.38.pdf)+-- section 10.12.3.+data TPMSCertifyInfo = TPMSCertifyInfo+  { tpmsciName :: BS.ByteString,+    tpmsciQualifiedName :: BS.ByteString+  }+  deriving (Eq, Show, Generic, ToJSON)++-- | The TPMS_ATTEST structure as specified in+-- [TPMv2-Part2](https://www.trustedcomputinggroup.org/wp-content/uploads/TPM-Rev-2.0-Part-2-Structures-01.38.pdf)+-- section 10.12.8.+data TPMSAttest = TPMSAttest+  { tpmsaMagic :: Word32,+    tpmsaType :: Word16,+    tpmsaQualifiedSigner :: BS.ByteString,+    tpmsaExtraData :: BS.ByteString,+    tpmsaClockInfo :: TPMSClockInfo,+    tpmsaFirmwareVersion :: Word64,+    tpmsaAttested :: TPMSCertifyInfo+  }+  deriving (Eq, Show, Generic, ToJSON)++-- | The TPMA_OBJECT structure as specified in+-- [TPMv2-Part2](https://www.trustedcomputinggroup.org/wp-content/uploads/TPM-Rev-2.0-Part-2-Structures-01.38.pdf)+-- section 8.3+type TPMAObject = Word32++-- | The TPMU_PUBLIC_PARMS structure as specified in+-- [TPMv2-Part2](https://www.trustedcomputinggroup.org/wp-content/uploads/TPM-Rev-2.0-Part-2-Structures-01.38.pdf)+-- section 12.2.3.7.+data TPMUPublicParms+  = TPMSRSAParms+      { tpmsrpSymmetric :: Word16,+        tpmsrpScheme :: Word16,+        tpmsrpKeyBits :: Word16,+        tpmsrpExponent :: Word32+      }+  | TPMSECCParms+      { tpmsepSymmetric :: Word16,+        tpmsepScheme :: Word16,+        tpmsepCurveId :: Cose.CoseCurveECDSA,+        tpmsepkdf :: Word16+      }+  deriving (Eq, Show, Generic, ToJSON)++-- | The TPMU_PUBLIC_ID structure as specified in+-- [TPMv2-Part2](https://www.trustedcomputinggroup.org/wp-content/uploads/TPM-Rev-2.0-Part-2-Structures-01.38.pdf)+-- section 12.2.3.2.+data TPMUPublicId+  = TPM2BPublicKeyRSA BS.ByteString+  | TPMSECCPoint+      { tpmseX :: BS.ByteString,+        tpmseY :: BS.ByteString+      }+  deriving (Eq, Show, Generic, ToJSON)++-- | The TPMT_PUBLIC structure (see [TPMv2-Part2](https://www.trustedcomputinggroup.org/wp-content/uploads/TPM-Rev-2.0-Part-2-Structures-01.38.pdf) section 12.2.4) used by the TPM to represent the credential public key.+data TPMTPublic = TPMTPublic+  { tpmtpType :: TPMAlgId,+    tpmtpNameAlg :: TPMAlgId,+    tpmtpNameAlgRaw :: Word16,+    tpmtpObjectAttributes :: TPMAObject,+    tpmtpAuthPolicy :: BS.ByteString,+    tpmtpParameters :: TPMUPublicParms,+    tpmtpUnique :: TPMUPublicId+  }+  deriving (Eq, Show, Generic, ToJSON)++-- | The TPM format. The sole purpose of this type is to instantiate the+-- AttestationStatementFormat typeclass below.+data Format = Format++instance Show Format where+  show = Text.unpack . M.asfIdentifier++-- | TPM Subject Alternative Name as described in section 3.2.9 [here](https://www.trustedcomputinggroup.org/wp-content/uploads/Credential_Profile_EK_V2.0_R14_published.pdf)+data SubjectAlternativeName = SubjectAlternativeName+  { tpmManufacturer :: Text,+    tpmModel :: Text,+    tpmVersion :: Text+  }+  deriving (Eq, Show)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-tpm-attestation)+data Statement = Statement+  { alg :: Cose.CoseSignAlg,+    x5c :: NE.NonEmpty X509.SignedCertificate,+    aikCert :: X509.SignedCertificate,+    subjectAlternativeName :: SubjectAlternativeName,+    aaguidExt :: Maybe IdFidoGenCeAAGUID,+    extendedKeyUsage :: [X509.ExtKeyUsagePurpose],+    basicConstraintsCA :: Bool,+    sig :: BS.ByteString,+    certInfo :: TPMSAttest,+    certInfoRaw :: BS.ByteString,+    pubArea :: TPMTPublic,+    pubAreaRaw :: BS.ByteString,+    pubAreaKey :: Cose.PublicKey+  }+  deriving (Eq, Show)++instance ToJSON Statement where+  toJSON Statement {..} =+    object+      [ "ver" .= String "2.0",+        "alg" .= alg,+        "x5c" .= x5c,+        "sig" .= sig,+        "certInfo" .= certInfo,+        "pubArea" .= pubArea+      ]++-- | Verification errors specific to TPM attestation+data VerificationError+  = -- | The public key in the certificate is different from the on in the+    -- attested credential data+    VerificationErrorCredentialKeyMismatch+  | -- | The magic number in certInfo was not set to TPM_GENERATED_VALUE+    VerificationErrorInvalidMagicNumber Word32+  | -- | The type in certInfo was not set to TPM_ST_ATTEST_CERTIFY+    VerificationErrorInvalidType Word16+  | -- | The algorithm specified in the nameAlg field is unsupported or is not+    -- a valid name algorithm+    VerificationErrorInvalidNameAlgorithm+  | -- | The calulated name does not match the provided name.+    -- (first: expected, second: received)+    VerificationErrorInvalidName BS.ByteString BS.ByteString+  | -- | The public key in the certificate was invalid, either because the it+    -- had an unexpected algorithm, or because it was otherwise malformed+    VerificationErrorInvalidPublicKey Text+  | -- | The certificate didn't have the expected version-value+    -- (first: expected, second: received)+    VerificationErrorCertificateVersion Int Int+  | -- | The Public key cannot verify the signature over the authenticatorData+    -- and the clientDataHash.+    VerificationErrorVerificationFailure Text+  | -- | The subject field was not empty+    VerificationErrorNonEmptySubjectField+  | -- | The vendor was unknown+    VerificationErrorUnknownVendor+  | -- | The Extended Key Usage did not contain the 2.23.133.8.3 OID+    VerificationErrorExtKeyOIDMissing+  | -- | The CA component of the basic constraints extension was set to True+    VerificationErrorBasicConstraintsTrue+  | -- | The AAGUID in the certificate extension does not match the AAGUID in+    -- the authenticator data+    VerificationErrorCertificateAAGUIDMismatch+  | -- | The (supposedly) ASN1 encoded certificate extension could not be+    -- decoded+    VerificationErrorASN1Error ASN1Error+  | -- | The certificate extension does not contain a AAGUID+    VerificationErrorCredentialAAGUIDMissing+  | -- | The desired algorithm does not have a known associated hash function+    VerificationErrorUnknownHashFunction+  | -- | The calculated hash over the attToBeSigned does not match the received+    -- hash+    -- (first: calculated, second: received)+    VerificationErrorHashMismatch BS.ByteString BS.ByteString+  deriving (Show, Exception)++-- [(spec)](https://www.trustedcomputinggroup.org/wp-content/uploads/Credential_Profile_EK_V2.0_R14_published.pdf)+-- The specifications specifies that the inner most objects of the ASN.1+-- encoding are individual sets of sequences. See notably page 35 of the spec.+-- However, in practice, we found that some TPM implementions interpreted this+-- as being a single set of individual sequences. We could attempt to parse+-- both, relying on the Alternative typeclass, or we could write our parser in+-- such a way that it is agnostic to whatever structure is chosen by searching+-- through the ASN.1 encoding for the desired OIDs.+--+-- We chose the second, since it can possibly also handle other interpretations+-- of the spec.+instance X509.Extension SubjectAlternativeName where+  extOID = const [2, 5, 29, 17]+  extHasNestedASN1 = const True+  extEncode = error "Unimplemented: This library does not implement encoding the SubjectAlternativeName extension"+  extDecode asn1 =+    first ("Could not decode ASN1 subject-alternative-name extension: " ++) $+      runParseASN1 decodeSubjectAlternativeName asn1+    where+      decodeSubjectAlternativeName :: ParseASN1 SubjectAlternativeName+      decodeSubjectAlternativeName =+        do+          map <- Map.fromList <$> decodeFields+          -- https://www.trustedcomputinggroup.org/wp-content/uploads/Credential_Profile_EK_V2.0_R14_published.pdf+          tpmManufacturer <- maybe (fail "manufacturer field not found in subject alternative name") pure $ Map.lookup [2, 23, 133, 2, 1] map+          tpmModel <- maybe (fail "model field not found in subject alternative name") pure $ Map.lookup [2, 23, 133, 2, 2] map+          tpmVersion <- maybe (fail "version field not found in subject alternative name") pure $ Map.lookup [2, 23, 133, 2, 3] map+          pure SubjectAlternativeName {..}++      decodeFields :: ParseASN1 [(OID, Text)]+      decodeFields = do+        next <- hasNext+        if next+          then do+            n <- getNext+            case n of+              OID oid -> do+                m <- getNext+                case m of+                  ASN1String asnString -> do+                    let text = decodeUtf8 $ X509.getCharacterStringRawData asnString+                    fields <- decodeFields+                    pure ((oid, text) : fields)+                  _ -> decodeFields+              _ -> decodeFields+          else pure []++instance M.AttestationStatementFormat Format where+  type AttStmt Format = Statement++  asfIdentifier _ = "tpm"++  asfDecode _ xs =+    case (xs !? "ver", xs !? "alg", xs !? "x5c", xs !? "sig", xs !? "certInfo", xs !? "pubArea") of+      (Just (CBOR.TString "2.0"), Just (CBOR.TInt algId), Just (CBOR.TList (NE.nonEmpty -> Just x5cRaw)), Just (CBOR.TBytes sig), Just (CBOR.TBytes certInfoRaw), Just (CBOR.TBytes pubAreaRaw)) ->+        do+          x5c@(aikCert :| _) <- forM x5cRaw $ \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)+          alg <- Cose.toCoseSignAlg algId+          -- The get interface requires lazy bytestrings but we typically use+          -- strict bytestrings in the library, so we have to convert between+          -- them+          certInfo <- case Get.runGetOrFail getTPMAttest (LBS.fromStrict certInfoRaw) of+            Left (_, _, err) -> Left $ "Failed to decode certInfo: " <> Text.pack (show err)+            Right (_, _, res) -> pure res+          pubArea <- case Get.runGetOrFail getTPMTPublic (LBS.fromStrict pubAreaRaw) of+            Left (_, _, err) -> Left $ "Failed to decode pubArea: " <> Text.pack (show err)+            Right (_, _, res) -> pure res+          pubAreaKey <- extractPublicKey pubArea++          let cert = X509.getCertificate aikCert++          subjectAlternativeName <- case X509.extensionGetE (X509.certExtensions cert) of+            Just (Right ext) -> pure ext+            Just (Left err) -> Left $ "Failed to decode certificate subject alternative name extension: " <> Text.pack err+            Nothing -> Left "Certificate subject alternative name extension is missing"+          aaguidExt <- case X509.extensionGetE (X509.certExtensions cert) of+            Just (Right ext) -> pure $ Just ext+            Just (Left err) -> Left $ "Failed to decode certificate aaguid extension: " <> Text.pack err+            Nothing -> pure Nothing+          X509.ExtExtendedKeyUsage extendedKeyUsage <- case X509.extensionGetE (X509.certExtensions cert) of+            Just (Right ext) -> pure ext+            Just (Left err) -> Left $ "Failed to decode certificate extended key usage extension: " <> Text.pack err+            Nothing -> Left "Certificate extended key usage extension is missing"+          X509.ExtBasicConstraints basicConstraintsCA _ <- case X509.extensionGetE (X509.certExtensions cert) of+            Just (Right ext) -> pure ext+            Just (Left err) -> Left $ "Failed to decode certificate basic constraints extension: " <> Text.pack err+            Nothing -> Left "Certificate basic constraints extension is missing"+          Right $ Statement {..}+      _ -> Left $ "CBOR map didn't have expected value types (ver: \"2.0\", alg: int, x5c: non-empty list, sig: bytes, certInfo: bytes, pubArea: bytes): " <> Text.pack (show xs)+    where+      getTPMAttest :: Get.Get TPMSAttest+      getTPMAttest = do+        tpmsaMagic <- Get.getWord32be+        unless (tpmsaMagic == tpmGeneratedValue) $ fail "Invalid magic number"+        tpmsaType <- Get.getWord16be+        tpmsaQualifiedSigner <- getTPMByteString+        tpmsaExtraData <- getTPMByteString+        tpmsaClockInfo <- getClockInfo+        tpmsaFirmwareVersion <- Get.getWord64be+        tpmsaAttested <- getCertifyInfo+        True <- Get.isEmpty+        pure TPMSAttest {..}++      getClockInfo :: Get.Get TPMSClockInfo+      getClockInfo = do+        tpmsciClock <- Get.getWord64be+        tpmsciResetCount <- Get.getWord32be+        tpmsciRestartCount <- Get.getWord32be+        tpmsciSafe <- (== 1) <$> Get.getWord8+        pure TPMSClockInfo {..}++      getCertifyInfo :: Get.Get TPMSCertifyInfo+      getCertifyInfo = do+        tpmsciName <- getTPMByteString+        tpmsciQualifiedName <- getTPMByteString+        pure TPMSCertifyInfo {..}++      getTPMByteString :: Get.Get BS.ByteString+      getTPMByteString = do+        size <- Get.getWord16be+        Get.getByteString (fromIntegral size)++      getTPMTPublic :: Get.Get TPMTPublic+      getTPMTPublic = do+        tpmtpType <- toTPMAlgId =<< Get.getWord16be+        tpmtpNameAlgRaw <- Get.getWord16be+        tpmtpNameAlg <- toTPMAlgId tpmtpNameAlgRaw+        tpmtpObjectAttributes <- getTPMAObject+        tpmtpAuthPolicy <- getTPMByteString+        tpmtpParameters <- getTPMUPublicParms tpmtpType+        tpmtpUnique <- getTPMUPublicId tpmtpType+        True <- Get.isEmpty+        pure TPMTPublic {..}++      -- We don't need to inspect the bits in the object, so we skip parsing it+      getTPMAObject :: Get.Get TPMAObject+      getTPMAObject = Get.getWord32be++      getTPMUPublicParms :: TPMAlgId -> Get.Get TPMUPublicParms+      getTPMUPublicParms TPMAlgRSA = do+        tpmsrpSymmetric <- Get.getWord16be+        tpmsrpScheme <- Get.getWord16be+        tpmsrpKeyBits <- Get.getWord16be+        -- An exponent of zero indicates that the exponent is the default of 2^16 + 1+        tpmsrpExponent <- (\e -> if e == 0 then 65537 else e) <$> Get.getWord32be+        pure TPMSRSAParms {..}+      getTPMUPublicParms TPMAlgSHA1 = fail "SHA1 does not have public key parameters"+      getTPMUPublicParms TPMAlgSHA256 = fail "SHA256 does not have public key parameters"+      getTPMUPublicParms TPMAlgECC = do+        tpmsepSymmetric <- Get.getWord16be+        tpmsepScheme <- Get.getWord16be+        tpmsepCurveId <- toCurveId =<< Get.getWord16be+        tpmsepkdf <- Get.getWord16be+        pure TPMSECCParms {..}++      getTPMUPublicId :: TPMAlgId -> Get.Get TPMUPublicId+      getTPMUPublicId TPMAlgRSA = TPM2BPublicKeyRSA <$> getTPMByteString+      getTPMUPublicId TPMAlgSHA1 = fail "SHA1 does not have a public id"+      getTPMUPublicId TPMAlgSHA256 = fail "SHA256 does not have a public id"+      getTPMUPublicId TPMAlgECC = do+        tpmseX <- getTPMByteString+        tpmseY <- getTPMByteString+        pure TPMSECCPoint {..}++      extractPublicKey :: TPMTPublic -> Either Text Cose.PublicKey+      extractPublicKey+        TPMTPublic+          { tpmtpType = TPMAlgRSA,+            tpmtpParameters = TPMSRSAParms {..},+            tpmtpUnique = TPM2BPublicKeyRSA nb+          } =+          pure+            Cose.PublicKeyRSA+              { rsaN = os2ip nb,+                rsaE = toInteger tpmsrpExponent+              }+      extractPublicKey+        TPMTPublic+          { tpmtpType = TPMAlgECC,+            tpmtpParameters = TPMSECCParms {..},+            tpmtpUnique = TPMSECCPoint {..}+          } =+          pure+            Cose.PublicKeyECDSA+              { ecdsaCurve = tpmsepCurveId,+                ecdsaX = tpmseX,+                ecdsaY = tpmseY+              }+      extractPublicKey key = Left $ "Unsupported TPM public key: " <> Text.pack (show key)++  asfEncode _ Statement {..} =+    CBOR.TMap+      [ (CBOR.TString "ver", CBOR.TString "2.0"),+        (CBOR.TString "alg", CBOR.TInt $ Cose.fromCoseSignAlg alg),+        ( CBOR.TString "x5c",+          CBOR.TList $ map (CBOR.TBytes . X509.encodeSignedObject) $ NE.toList x5c+        ),+        (CBOR.TString "sig", CBOR.TBytes sig),+        (CBOR.TString "certInfo", CBOR.TBytes certInfoRaw),+        (CBOR.TString "pubArea", CBOR.TBytes pubAreaRaw)+      ]++  type AttStmtVerificationError Format = VerificationError++  asfVerify+    _+    _+    Statement {..}+    M.AuthenticatorData {adRawData = M.WithRaw adRawData, ..}+    clientDataHash = do+      -- 1. Verify that attStmt is valid CBOR conforming to the syntax defined+      -- above and perform CBOR decoding on it to extract the contained fields.+      -- NOTE: This is done during decoding++      -- 2. Verify that the public key specified by the parameters and unique+      -- fields of pubArea is identical to the credentialPublicKey in the+      -- attestedCredentialData in authenticatorData.+      let pubKey = Cose.fromCose $ M.acdCredentialPublicKey adAttestedCredentialData+      unless (pubKey == pubAreaKey) $ failure VerificationErrorCredentialKeyMismatch++      -- 3. Concatenate authenticatorData and clientDataHash to form attToBeSigned.+      let attToBeSigned = adRawData <> BA.convert (M.unClientDataHash clientDataHash)++      -- 4. Validate that certInfo is valid:+      -- 4.1 Verify that magic is set to TPM_GENERATED_VALUE.+      let magic = tpmsaMagic certInfo+      unless (magic == tpmGeneratedValue) . failure $ VerificationErrorInvalidMagicNumber magic++      -- 4.2 Verify that type is set to TPM_ST_ATTEST_CERTIFY.+      let typ = tpmsaType certInfo+      unless (typ == tpmStAttestCertify) . failure $ VerificationErrorInvalidType typ++      -- 4.3 Verify that extraData is set to the hash of attToBeSigned using+      -- the hash algorithm employed in "alg".+      case hashWithCorrectAlgorithm alg attToBeSigned of+        Just attHash -> do+          let extraData = tpmsaExtraData certInfo+          unless (attHash == extraData) . failure $ VerificationErrorHashMismatch attHash extraData+          pure ()+        Nothing -> failure VerificationErrorUnknownHashFunction++      -- 4.5 Verify that attested contains a TPMS_CERTIFY_INFO structure as+      -- specified in [TPMv2-Part2] section 10.12.3, whose name field contains+      -- a valid Name for pubArea, as computed using the algorithm in the+      -- nameAlg field of pubArea using the procedure specified in+      -- [TPMv2-Part1] section 16.+      let mPubAreaHash = case tpmtpNameAlg pubArea of+            TPMAlgSHA1 -> Just $ BA.convert $ hashWith SHA1 pubAreaRaw+            TPMAlgSHA256 -> Just $ BA.convert $ hashWith SHA256 pubAreaRaw+            TPMAlgECC -> Nothing+            TPMAlgRSA -> Nothing++      case mPubAreaHash of+        Just pubAreaHash -> do+          let pubName = LBS.toStrict $+                Put.runPut $ do+                  Put.putWord16be (tpmtpNameAlgRaw pubArea)+                  Put.putByteString pubAreaHash++          let name = tpmsciName (tpmsaAttested certInfo)+          unless (name == pubName) . failure $ VerificationErrorInvalidName pubName name+          pure ()+        Nothing -> failure VerificationErrorInvalidNameAlgorithm++      -- 4.6 Verify that x5c is present+      -- NOTE: Done in decoding++      -- 4.7 Note that the remaining fields in the "Standard Attestation Structure"+      -- [TPMv2-Part1] section 31.2, i.e., qualifiedSigner, clockInfo and+      -- firmwareVersion are ignored. These fields MAY be used as an input to+      -- risk engines.+      -- NOTE: We don't implement a risk engine++      -- 4.8 Verify the sig is a valid signature over certInfo using the+      -- attestation public key in aikCert with the algorithm specified in alg.+      let unsignedAikCert = X509.getCertificate aikCert+      case Cose.fromX509 $ X509.certPubKey unsignedAikCert of+        Right certPubKey -> case Cose.verify alg certPubKey certInfoRaw sig of+          Right () -> pure ()+          Left err -> failure $ VerificationErrorVerificationFailure err+        Left err -> failure $ VerificationErrorInvalidPublicKey err++      -- 4.9 Verify that aikCert meets the requirements in § 8.3.1 TPM Attestation+      -- Statement Certificate Requirements.++      -- 4.9.1 Version MUST be set to 3.+      -- Version ::= INTEGER { v1(0), v2(1), v3(2) }, see https://datatracker.ietf.org/doc/html/rfc5280.html#section-4.1+      let version = X509.certVersion unsignedAikCert+      unless (version == 2) . failure $ VerificationErrorCertificateVersion 2 version+      -- 4.9.2. Subject field MUST be set to empty.+      unless (null . X509.getDistinguishedElements $ X509.certSubjectDN unsignedAikCert) $ failure VerificationErrorNonEmptySubjectField+      -- 4.9.3 The Subject Alternative Name extension MUST be set as defined in+      -- [TPMv2-EK-Profile] section 3.2.9.+      -- 4.9.3.1 The TPM manufacturer identifies the manufacturer of the TPM. This value MUST be the+      -- vendor ID defined in the TCG Vendor ID Registry[3]+      unless (Set.member (tpmManufacturer subjectAlternativeName) tpmManufacturers) $ failure VerificationErrorUnknownVendor++      -- 4.9.4 The Extended Key Usage extension MUST contain the OID+      -- 2.23.133.8.3 ("joint-iso-itu-t(2) internationalorganizations(23) 133+      -- tcg-kp(8) tcg-kp-AIKCertificate(3)").+      unless (X509.KeyUsagePurpose_Unknown [2, 23, 133, 8, 3] `elem` extendedKeyUsage) $ failure VerificationErrorExtKeyOIDMissing++      -- 4.9.5 The Basic Constraints extension MUST have the CA component set+      -- to false.+      when basicConstraintsCA $ failure VerificationErrorBasicConstraintsTrue++      -- 4.9.6 An Authority Information Access (AIA) extension with entry+      -- id-ad-ocsp and a CRL Distribution Point extension [RFC5280] are both+      -- OPTIONAL as the status of many attestation certificates is available+      -- through metadata services. See, for example, the FIDO Metadata Service+      -- [FIDOMetadataService].+      -- NOTE: CRL checking and AIA can be done in a more general way after+      -- this function. See also <https://github.com/tweag/webauthn/issues/23>++      -- If aikCert contains an extension with OID 1.3.6.1.4.1.45724.1.1.4+      -- (id-fido-gen-ce-aaguid) verify that the value of this extension+      -- matches the aaguid in authenticatorData.+      case aaguidExt of+        Just (IdFidoGenCeAAGUID aaguid) -> unless (M.acdAaguid adAttestedCredentialData == aaguid) $ failure VerificationErrorCertificateAAGUIDMismatch+        Nothing -> pure ()++      pure $+        M.SomeAttestationType $+          M.AttestationTypeVerifiable M.VerifiableAttestationTypeUncertain (M.Fido2Chain x5c)+      where+        hashWithCorrectAlgorithm :: (BA.ByteArrayAccess ba, BA.ByteArray bout) => Cose.CoseSignAlg -> ba -> Maybe bout+        hashWithCorrectAlgorithm Cose.CoseSignAlgEdDSA _ =+          Nothing+        hashWithCorrectAlgorithm (Cose.CoseSignAlgECDSA Cose.CoseHashAlgECDSASHA256) bytes =+          pure $ BA.convert (Hash.hashWith Hash.SHA256 bytes)+        hashWithCorrectAlgorithm (Cose.CoseSignAlgECDSA Cose.CoseHashAlgECDSASHA384) bytes =+          pure $ BA.convert (Hash.hashWith Hash.SHA384 bytes)+        hashWithCorrectAlgorithm (Cose.CoseSignAlgECDSA Cose.CoseHashAlgECDSASHA512) bytes =+          pure $ BA.convert (Hash.hashWith Hash.SHA512 bytes)+        hashWithCorrectAlgorithm (Cose.CoseSignAlgRSA Cose.CoseHashAlgRSASHA1) bytes =+          pure $ BA.convert (Hash.hashWith Hash.SHA1 bytes)+        hashWithCorrectAlgorithm (Cose.CoseSignAlgRSA Cose.CoseHashAlgRSASHA256) bytes =+          pure $ BA.convert (Hash.hashWith Hash.SHA256 bytes)+        hashWithCorrectAlgorithm (Cose.CoseSignAlgRSA Cose.CoseHashAlgRSASHA384) bytes =+          pure $ BA.convert (Hash.hashWith Hash.SHA384 bytes)+        hashWithCorrectAlgorithm (Cose.CoseSignAlgRSA Cose.CoseHashAlgRSASHA512) bytes =+          pure $ BA.convert (Hash.hashWith Hash.SHA512 bytes)++  asfTrustAnchors _ _ = rootCertificateStore++rootCertificateStore :: X509.CertificateStore+rootCertificateStore = X509.makeCertificateStore $ map snd rootCertificates++-- | All known TPM root certificates along with their vendors+rootCertificates :: [(Text, X509.SignedCertificate)]+rootCertificates = processEntry <$> $(embedDir "root-certs/tpm")+  where+    processEntry :: (FilePath, BS.ByteString) -> (Text, X509.SignedCertificate)+    processEntry (path, bytes) = case X509.decodeSignedCertificate bytes of+      Right cert -> (Text.takeWhile (/= '/') (Text.pack path), cert)+      Left err -> error $ "Error while decoding certificate " <> path <> ": " <> err++-- | Helper function that wraps the TPM format into the general+-- SomeAttestationStatementFormat type.+format :: M.SomeAttestationStatementFormat+format = M.SomeAttestationStatementFormat Format

@@ -0,0 +1,240 @@+{-# LANGUAGE PatternSynonyms #-}++-- | Stability: experimental+-- This module contains definitions for [COSE registry](https://www.iana.org/assignments/cose/cose.xhtml)+-- entries that are relevant for Webauthn COSE public keys. All the types in+-- this module implement the 'Serialise' class, mapping them to the respective+-- CBOR values/labels.+--+-- This modules sometimes uses this+-- [CBOR Grammar](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-struct-13#section-1.4)+-- to describe CBOR value types corresponding to CBOR parameters+module Crypto.WebAuthn.Cose.Algorithm+  ( -- * COSE Algorithms+    CoseSignAlg+      ( ..,+        CoseAlgorithmEdDSA,+        CoseAlgorithmES256,+        CoseAlgorithmES384,+        CoseAlgorithmES512,+        CoseAlgorithmRS256,+        CoseAlgorithmRS384,+        CoseAlgorithmRS512,+        CoseAlgorithmRS1+      ),+    fromCoseSignAlg,+    toCoseSignAlg,++    -- * Hash Algorithms+    CoseHashAlgECDSA (..),+    CoseHashAlgRSA (..),+  )+where++import Codec.CBOR.Decoding (decodeIntCanonical)+import Codec.CBOR.Encoding (encodeInt)+import Codec.Serialise (Serialise)+import Codec.Serialise.Class (decode, encode)+import Data.Aeson (ToJSON)+import Data.Text (Text)+import qualified Data.Text as Text+import GHC.Generics (Generic)++-- | [(spec)](https://www.iana.org/assignments/cose/cose.xhtml#algorithms)+-- All the entries from the [COSE Algorithms registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms)+-- limited to the ones that are currently needed for Webauthn. Notably we only+-- care about asymmetric signature algorithms+data CoseSignAlg+  = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.2)+    -- EdDSA+    --+    -- [RFC8032](https://datatracker.ietf.org/doc/html/rfc8032) describes the elliptic curve signature scheme Edwards-curve+    -- Digital Signature Algorithm (EdDSA).  In that document, the signature+    -- algorithm is instantiated using parameters for edwards25519 and+    -- edwards448 curves.  The document additionally describes two variants+    -- of the EdDSA algorithm: Pure EdDSA, where no hash function is applied+    -- to the content before signing, and HashEdDSA, where a hash function+    -- is applied to the content before signing and the result of that hash+    -- function is signed.  For EdDSA, the content to be signed (either the+    -- message or the pre-hash value) is processed twice inside of the+    -- signature algorithm.  For use with COSE, only the pure EdDSA version+    -- is used.+    --+    -- Security considerations are [here](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.2.1)+    CoseSignAlgEdDSA+  | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1)+    -- ECDSA+    --+    -- ECDSA [DSS] defines a signature algorithm using ECC.  Implementations+    -- SHOULD use a deterministic version of ECDSA such as the one defined+    -- in [RFC6979].+    --+    -- The ECDSA signature algorithm is parameterized with a hash function+    -- (h).  In the event that the length of the hash function output is+    -- greater than the group of the key, the leftmost bytes of the hash+    -- output are used.+    -- ECDSA w/ SHA-256+    --+    -- This document defines ECDSA to work only with the curves P-256,+    -- P-384, and P-521. Future documents may define it to work with other+    -- curves and points in the future.+    --+    -- In order to promote interoperability, it is suggested that SHA-256 be+    -- used only with curve P-256, SHA-384 be used only with curve P-384,+    -- and SHA-512 be used with curve P-521.  This is aligned with the+    -- recommendation in [Section 4 of RFC5480](https://datatracker.ietf.org/doc/html/rfc5480#section-4)+    --+    -- Security considerations are [here](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1.1)+    CoseSignAlgECDSA CoseHashAlgECDSA+  | -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8812.html#section-2)+    -- The RSASSA-PKCS1-v1_5 signature algorithm is defined in+    -- [RFC8017](https://www.rfc-editor.org/rfc/rfc8812.html#RFC8017).+    -- The RSASSA-PKCS1-v1_5 signature algorithm is parameterized with a hash function (h).+    --+    -- A key of size 2048 bits or larger MUST be used with these algorithms.+    --+    -- Security considerations are [here](https://www.rfc-editor.org/rfc/rfc8812.html#section-5)+    CoseSignAlgRSA CoseHashAlgRSA+  deriving (Eq, Show, Ord, Generic, ToJSON)++-- | Hash algorithms that can be used with the ECDSA signature algorithm+data CoseHashAlgECDSA+  = -- | SHA-256+    CoseHashAlgECDSASHA256+  | -- | SHA-384+    CoseHashAlgECDSASHA384+  | -- | SHA-512+    CoseHashAlgECDSASHA512+  deriving (Eq, Show, Ord, Enum, Bounded, Generic, ToJSON)++-- | Hash algorithms that can be used with the RSA signature algorithm+data CoseHashAlgRSA+  = -- | SHA-1 (deprecated)+    CoseHashAlgRSASHA1+  | -- | SHA-256+    CoseHashAlgRSASHA256+  | -- | SHA-384+    CoseHashAlgRSASHA384+  | -- | SHA-512+    CoseHashAlgRSASHA512+  deriving (Eq, Show, Ord, Enum, Bounded, Generic, ToJSON)++-- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.2)+-- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms)+-- entry @EdDSA@. Alias for 'CoseSignAlgEdDSA'+--+-- * Name: EdDSA+-- * Description: EdDSA+-- * Recommended: Yes+pattern CoseAlgorithmEdDSA :: CoseSignAlg+pattern CoseAlgorithmEdDSA = CoseSignAlgEdDSA++-- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1)+-- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms)+-- entry @ES256@. Alias for @'CoseSignAlgECDSA' 'CoseHashAlgECDSASHA256'@+--+-- * Name: ES256+-- * Description: ECDSA w/ SHA-256+-- * Recommended: Yes+pattern CoseAlgorithmES256 :: CoseSignAlg+pattern CoseAlgorithmES256 = CoseSignAlgECDSA CoseHashAlgECDSASHA256++-- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1)+-- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms)+-- entry @ES384@. Alias for @'CoseSignAlgECDSA' 'CoseHashAlgECDSASHA384'@+--+-- * Name: ES384+-- * Description: ECDSA w/ SHA-384+-- * Recommended: Yes+pattern CoseAlgorithmES384 :: CoseSignAlg+pattern CoseAlgorithmES384 = CoseSignAlgECDSA CoseHashAlgECDSASHA384++-- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1)+-- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms)+-- entry @ES512@. Alias for @'CoseSignAlgECDSA' 'CoseHashAlgECDSASHA512'@+--+-- * Name: ES512+-- * Description: ECDSA w/ SHA-512+-- * Recommended: Yes+pattern CoseAlgorithmES512 :: CoseSignAlg+pattern CoseAlgorithmES512 = CoseSignAlgECDSA CoseHashAlgECDSASHA512++-- | [(spec)](https://www.rfc-editor.org/rfc/rfc8812.html#section-2)+-- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms)+-- entry @RS256@. Alias for @'CoseSignAlgRSA' 'CoseHashAlgRSASHA256'@+--+-- * Name: RS256+-- * Description: RSASSA-PKCS1-v1_5 using SHA-256+-- * Recommended: No+pattern CoseAlgorithmRS256 :: CoseSignAlg+pattern CoseAlgorithmRS256 = CoseSignAlgRSA CoseHashAlgRSASHA256++-- | [(spec)](https://www.rfc-editor.org/rfc/rfc8812.html#section-2)+-- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms)+-- entry @RS384@. Alias for @'CoseSignAlgRSA' 'CoseHashAlgRSASHA384'@+--+-- * Name: RS384+-- * Description: RSASSA-PKCS1-v1_5 using SHA-384+-- * Recommended: No+pattern CoseAlgorithmRS384 :: CoseSignAlg+pattern CoseAlgorithmRS384 = CoseSignAlgRSA CoseHashAlgRSASHA384++-- | [(spec)](https://www.rfc-editor.org/rfc/rfc8812.html#section-2)+-- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms)+-- entry @RS512@. Alias for @'CoseSignAlgRSA' 'CoseHashAlgRSASHA512'@+--+-- * Name: RS512+-- * Description: RSASSA-PKCS1-v1_5 using SHA-512+-- * Recommended: No+pattern CoseAlgorithmRS512 :: CoseSignAlg+pattern CoseAlgorithmRS512 = CoseSignAlgRSA CoseHashAlgRSASHA512++-- | [(spec)](https://www.rfc-editor.org/rfc/rfc8812.html#section-2)+-- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms)+-- entry @RS1@. Alias for @'CoseSignAlgRSA' 'CoseHashAlgRSASHA1'@+--+-- * Name: RS1+-- * Description: RSASSA-PKCS1-v1_5 using SHA-1+-- * Recommended: Deprecated+pattern CoseAlgorithmRS1 :: CoseSignAlg+pattern CoseAlgorithmRS1 = CoseSignAlgRSA CoseHashAlgRSASHA1++-- | Serialises COSE Algorithms using the @Value@ column from the+-- [COSE Algorithms registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms).+-- This uses the 'fromCoseSignAlg' and 'toCoseSignAlg' functions to do the+-- encoding and decoding respectively.+instance Serialise CoseSignAlg where+  encode = encodeInt . fromCoseSignAlg+  decode = do+    int <- decodeIntCanonical+    case toCoseSignAlg int of+      Right res -> pure res+      Left err -> fail $ Text.unpack err++-- | Converts a 'CoseSignAlg' to the corresponding integer value from the+-- [COSE Algorithms registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms).+-- The inverse operation is 'toCoseSignAlg'+fromCoseSignAlg :: Num p => CoseSignAlg -> p+fromCoseSignAlg (CoseSignAlgRSA CoseHashAlgRSASHA1) = -65535+fromCoseSignAlg (CoseSignAlgRSA CoseHashAlgRSASHA512) = -259+fromCoseSignAlg (CoseSignAlgRSA CoseHashAlgRSASHA384) = -258+fromCoseSignAlg (CoseSignAlgRSA CoseHashAlgRSASHA256) = -257+fromCoseSignAlg (CoseSignAlgECDSA CoseHashAlgECDSASHA512) = -36+fromCoseSignAlg (CoseSignAlgECDSA CoseHashAlgECDSASHA384) = -35+fromCoseSignAlg CoseSignAlgEdDSA = -8+fromCoseSignAlg (CoseSignAlgECDSA CoseHashAlgECDSASHA256) = -7++-- | Converts an integer value to the corresponding 'CoseSignAlg' from the+-- [COSE Algorithms registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms).+-- Returns an error if the integer doesn't represent a known algorithm.+-- The inverse operation is 'fromCoseSignAlg'+toCoseSignAlg :: (Eq a, Num a, Show a) => a -> Either Text CoseSignAlg+toCoseSignAlg (-65535) = pure (CoseSignAlgRSA CoseHashAlgRSASHA1)+toCoseSignAlg (-259) = pure (CoseSignAlgRSA CoseHashAlgRSASHA512)+toCoseSignAlg (-258) = pure (CoseSignAlgRSA CoseHashAlgRSASHA384)+toCoseSignAlg (-257) = pure (CoseSignAlgRSA CoseHashAlgRSASHA256)+toCoseSignAlg (-36) = pure (CoseSignAlgECDSA CoseHashAlgECDSASHA512)+toCoseSignAlg (-35) = pure (CoseSignAlgECDSA CoseHashAlgECDSASHA384)+toCoseSignAlg (-8) = pure CoseSignAlgEdDSA+toCoseSignAlg (-7) = pure (CoseSignAlgECDSA CoseHashAlgECDSASHA256)+toCoseSignAlg value = Left $ "Unknown COSE algorithm value " <> Text.pack (show value)

@@ -0,0 +1,295 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Stability: internal+-- This module contains definitions for [COSE registry](https://www.iana.org/assignments/cose/cose.xhtml)+-- entries that are relevant for Webauthn COSE public keys. All the types in+-- this module implement the 'Serialise' class, mapping them to the respective+-- CBOR values/labels.+--+-- This modules sometimes uses this+-- [CBOR Grammar](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-struct-13#section-1.4)+-- to describe CBOR value types corresponding to CBOR parameters+module Crypto.WebAuthn.Cose.Internal.Registry+  ( -- * COSE Key Types+    CoseKeyType (..),++    -- * COSE Parameters+    CoseKeyCommonParameter (..),+    CoseKeyTypeParameterOKP (..),+    CoseKeyTypeParameterEC2 (..),+    CoseKeyTypeParameterRSA (..),+    parameterCount,++    -- * COSE Elliptic Curves+    CoseEllipticCurveOKP (..),+    CoseEllipticCurveEC2 (..),+  )+where++import Codec.CBOR.Decoding (decodeIntCanonical)+import Codec.CBOR.Encoding (encodeInt)+import Codec.Serialise (Serialise)+import Codec.Serialise.Class (decode, encode)++-- | [(spec)](https://www.iana.org/assignments/cose/cose.xhtml#key-common-parameters)+-- All the entries from the [COSE Key Common Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-common-parameters)+-- that are needed for Webauthn public keys+data CoseKeyCommonParameter+  = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-struct-15#section-7.1)+    --+    -- * COSE value type: tstr / int+    -- * Value registry: 'CoseKeyType'+    -- * Description: Identification of the key type+    --+    -- This parameter is used to identify the family of keys for this+    -- structure and, thus, the set of key-type-specific parameters to be+    -- found. The key type MUST be included as part of the trust decision+    -- process.+    CoseKeyCommonParameterKty+  | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-struct-15#section-7.1)+    --+    -- * COSE value type: tstr / int+    -- * Value registry: 'Crypto.WebAuthn.Cose.Algorithm.CoseSignAlg'+    -- * Description: Key usage restriction to this algorithm+    --+    -- This parameter is used to restrict the algorithm that is used+    -- with the key.+    CoseKeyCommonParameterAlg+  deriving (Eq, Show, Bounded, Enum)++-- | Serialises the parameters using the @Label@ column from the+-- [COSE Key Common Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-common-parameters)+instance Serialise CoseKeyCommonParameter where+  encode CoseKeyCommonParameterKty = encodeInt 1+  encode CoseKeyCommonParameterAlg = encodeInt 3+  decode =+    decodeIntCanonical >>= \case+      1 -> pure CoseKeyCommonParameterKty+      3 -> pure CoseKeyCommonParameterAlg+      value -> fail $ "Unknown COSE key common parameter " <> show value++-- | [(spec)](https://www.iana.org/assignments/cose/cose.xhtml#key-type)+-- All the entries from the [COSE Key Types registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type)+-- that are known to be needed for Webauthn public keys+data CoseKeyType+  = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2)+    -- Octet Key Pair.+    -- See 'CoseKeyTypeParameterOKP' for the parameters specific to this key type.+    CoseKeyTypeOKP+  | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1)+    -- Elliptic Curve Keys w/ x- and y-coordinate pair.+    -- See 'CoseKeyTypeParameterEC2' for the parameters specific to this key type.+    CoseKeyTypeEC2+  | -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8230.html#section-4)+    -- RSA Key.+    -- See 'CoseKeyTypeParameterRSA' for the parameters specific to this key type.+    CoseKeyTypeRSA+  deriving (Eq, Show)++-- | Serialises the key type using the @Value@ column from the+-- [COSE Key Types registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type)+instance Serialise CoseKeyType where+  encode CoseKeyTypeOKP = encodeInt 1+  encode CoseKeyTypeEC2 = encodeInt 2+  encode CoseKeyTypeRSA = encodeInt 3+  decode =+    decodeIntCanonical >>= \case+      1 -> pure CoseKeyTypeOKP+      2 -> pure CoseKeyTypeEC2+      3 -> pure CoseKeyTypeRSA+      value -> fail $ "Unknown COSE key type " <> show value++-- | [(spec)](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters)+-- All the entries from the [COSE Key Type Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters)+-- for key type 'CoseKeyTypeOKP' (aka @Key Type@ is @1@) that are required for+-- public keys+data CoseKeyTypeParameterOKP+  = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2)+    --+    -- * COSE value type: int / tstr+    -- * Value registry: 'CoseEllipticCurveOKP'+    -- * Description: EC identifier+    --+    -- This contains an identifier of the curve to be used with the key.+    CoseKeyTypeParameterOKPCrv+  | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2)+    --+    -- * COSE value type: bstr+    -- * Description: Public Key+    --+    -- This contains the public key. The byte string contains the public key as defined by the algorithm.+    CoseKeyTypeParameterOKPX+  deriving (Eq, Show, Bounded, Enum)++-- | Serialises the parameters using the @Label@ column from the+-- [COSE Key Type Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters)+instance Serialise CoseKeyTypeParameterOKP where+  encode CoseKeyTypeParameterOKPCrv = encodeInt (-1)+  encode CoseKeyTypeParameterOKPX = encodeInt (-2)+  decode =+    decodeIntCanonical >>= \case+      -1 -> pure CoseKeyTypeParameterOKPCrv+      -2 -> pure CoseKeyTypeParameterOKPX+      value -> fail $ "Unknown COSE key type parameter " <> show value <> " for key type OKP"++-- | Elliptic curves for key type 'CoseKeyTypeOKP' from the+-- [COSE Elliptic Curves registry](https://www.iana.org/assignments/cose/cose.xhtml#elliptic-curves),+-- limited to the ones that are currently needed for Webauthn+data CoseEllipticCurveOKP+  = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1)+    -- Ed25519 for use w/ EdDSA only+    CoseEllipticCurveEd25519+  deriving (Eq, Show)++-- | Serialises COSE Elliptic Curves using the @Value@ column from the+-- [COSE Elliptic Curves registry](https://www.iana.org/assignments/cose/cose.xhtml#elliptic-curves).+instance Serialise CoseEllipticCurveOKP where+  encode CoseEllipticCurveEd25519 = encodeInt 6+  decode =+    decodeIntCanonical >>= \case+      6 -> pure CoseEllipticCurveEd25519+      value -> fail $ "Unknown COSE elliptic curve " <> show value <> " for key type OKP"++-- | [(spec)](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters)+-- All the entries from the [COSE Key Type Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters)+-- for key type 'CoseKeyTypeEC2' (aka @Key Type@ is @2@) that are required for+-- public keys+data CoseKeyTypeParameterEC2+  = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1)+    --+    -- * COSE value type: int / tstr+    -- * Value registry: 'CoseEllipticCurveEC2'+    -- * Description: EC identifier+    --+    -- This contains an identifier of the curve to be used with the key.+    CoseKeyTypeParameterEC2Crv+  | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1)+    --+    -- * COSE value type: bstr+    -- * Description: x-coordinate+    --+    -- This contains the x-coordinate for the EC point. The integer is+    -- converted to a byte string as defined in [SEC1]. Leading zero+    -- octets MUST be preserved.+    CoseKeyTypeParameterEC2X+  | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1)+    --+    -- * COSE value type: bstr / bool+    -- * Description: y-coordinate+    --+    -- This contains either the sign bit or the value of the+    -- y-coordinate for the EC point. When encoding the value y, the+    -- integer is converted to an byte string (as defined in+    -- [SEC1](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#ref-SEC1))+    -- and encoded as a CBOR bstr. Leading zero octets MUST be+    -- preserved. The compressed point encoding is also supported.+    -- Compute the sign bit as laid out in the Elliptic-Curve-Point-to-+    -- Octet-String Conversion function of+    -- [SEC1](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#ref-SEC1).+    -- If the sign bit is zero, then encode y as a CBOR false value;+    -- otherwise, encode y as a CBOR true value.+    -- The encoding of the infinity point is not supported.+    CoseKeyTypeParameterEC2Y+  deriving (Eq, Show, Bounded, Enum)++-- | Serialises the parameters using the @Label@ column from the+-- [COSE Key Type Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters)+instance Serialise CoseKeyTypeParameterEC2 where+  encode CoseKeyTypeParameterEC2Crv = encodeInt (-1)+  encode CoseKeyTypeParameterEC2X = encodeInt (-2)+  encode CoseKeyTypeParameterEC2Y = encodeInt (-3)+  decode =+    decodeIntCanonical >>= \case+      -1 -> pure CoseKeyTypeParameterEC2Crv+      -2 -> pure CoseKeyTypeParameterEC2X+      -3 -> pure CoseKeyTypeParameterEC2Y+      value -> fail $ "Unknown COSE key type parameter " <> show value <> " for key type EC2"++-- | Elliptic curves for key type 'CoseKeyTypeEC2' from the+-- [COSE Elliptic Curves registry](https://www.iana.org/assignments/cose/cose.xhtml#elliptic-curves),+-- limited to the ones that are currently needed for Webauthn+data CoseEllipticCurveEC2+  = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1)+    -- NIST P-256 also known as secp256r1+    CoseEllipticCurveEC2P256+  | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1)+    -- NIST P-384 also known as secp384r1+    CoseEllipticCurveEC2P384+  | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1)+    -- NIST P-521 also known as secp521r1+    CoseEllipticCurveEC2P521+  deriving (Eq, Show)++-- | Serialises COSE Elliptic Curves using the @Value@ column from the+-- [COSE Elliptic Curves registry](https://www.iana.org/assignments/cose/cose.xhtml#elliptic-curves).+instance Serialise CoseEllipticCurveEC2 where+  encode CoseEllipticCurveEC2P256 = encodeInt 1+  encode CoseEllipticCurveEC2P384 = encodeInt 2+  encode CoseEllipticCurveEC2P521 = encodeInt 3+  decode =+    decodeIntCanonical >>= \case+      1 -> pure CoseEllipticCurveEC2P256+      2 -> pure CoseEllipticCurveEC2P384+      3 -> pure CoseEllipticCurveEC2P521+      value -> fail $ "Unknown COSE elliptic curve " <> show value <> " for key type EC2"++-- | [(spec)](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters)+-- All the entries from the [COSE Key Type Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters)+-- for key type 'CoseKeyTypeRSA' (aka @Key Type@ is @3@) that are required for+-- public keys+data CoseKeyTypeParameterRSA+  = -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8230.html#section-4)+    --+    -- * COSE value type: bstr+    -- * Description: the RSA modulus n+    --+    -- The RSA modulus n is a product of u distinct odd primes+    -- r_i, i = 1, 2, ..., u, where u >= 2+    --+    -- All numeric key parameters are encoded in an unsigned big-endian+    -- representation as an octet sequence using the CBOR byte string+    -- type (major type 2). The octet sequence MUST utilize the minimum+    -- number of octets needed to represent the value. For instance, the+    -- value 32,768 is represented as the CBOR byte sequence 0b010_00010,+    -- 0x80 0x00 (major type 2, additional information 2 for the length).+    CoseKeyTypeParameterRSAN+  | -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8230.html#section-4)+    --+    -- * COSE value type: bstr+    -- * Description: the RSA public exponent e+    --+    -- The RSA public exponent e is an integer between 3 and n - 1 satisfying+    -- GCD(e,\lambda(n)) = 1, where \lambda(n) = LCM(r_1 - 1, ..., r_u - 1)+    --+    -- All numeric key parameters are encoded in an unsigned big-endian+    -- representation as an octet sequence using the CBOR byte string+    -- type (major type 2). The octet sequence MUST utilize the minimum+    -- number of octets needed to represent the value. For instance, the+    -- value 32,768 is represented as the CBOR byte sequence 0b010_00010,+    -- 0x80 0x00 (major type 2, additional information 2 for the length).+    CoseKeyTypeParameterRSAE+  deriving (Eq, Show, Bounded, Enum)++-- | Serialises the parameters using the @Label@ column from the+-- [COSE Key Type Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters)+instance Serialise CoseKeyTypeParameterRSA where+  encode CoseKeyTypeParameterRSAN = encodeInt (-1)+  encode CoseKeyTypeParameterRSAE = encodeInt (-2)+  decode =+    decodeIntCanonical >>= \case+      -1 -> pure CoseKeyTypeParameterRSAN+      -2 -> pure CoseKeyTypeParameterRSAE+      value -> fail $ "Unknown COSE key type parameter " <> show value <> " for key type RSA"++-- | The number of parameters for a 'CoseKeyType' relevant for Webauthn public+-- keys+parameterCount :: CoseKeyType -> Word+parameterCount CoseKeyTypeOKP = cardinality @CoseKeyCommonParameter + cardinality @CoseKeyTypeParameterOKP+parameterCount CoseKeyTypeEC2 = cardinality @CoseKeyCommonParameter + cardinality @CoseKeyTypeParameterEC2+parameterCount CoseKeyTypeRSA = cardinality @CoseKeyCommonParameter + cardinality @CoseKeyTypeParameterRSA++-- | A utility function for getting the number of constructors for a type+-- that implements both 'Bounded' and 'Enum'+cardinality :: forall a b. (Bounded a, Enum a, Num b) => b+cardinality = fromIntegral $ 1 + fromEnum @a maxBound - fromEnum @a minBound

@@ -0,0 +1,238 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}++-- | Stability: internal+-- public keys and signature algorithms are represented with three+-- different types:+--+-- * 'Cose.CoseSignAlg', which is the signature algorithm used, equivalent to a+--   COSE Algorithm from the COSE registry+-- * 'Cose.CosePublicKey', which is a combination of a 'Cose.CoseSignAlg' along with+--   a public key that can be used with it. This is what the COSE_Key+--   CBOR structure decodes to+-- * 'PublicKey', only the public key part of 'Cose.CosePublicKey'+--+-- The following main operations are supported for these types:+--+-- * 'Cose.CosePublicKey' can be totally decomposed into a 'Cose.CoseSignAlg'+--   with 'Cose.keySignAlg' and a 'PublicKey' with 'fromCose'+-- * A 'PublicKey' can be created from an X.509 public key with 'fromX509'+-- * A 'Cose.CoseSignAlg' and a 'PublicKey' can be used to verify a signature+--   with 'verify'+module Crypto.WebAuthn.Cose.Internal.Verify+  ( -- * Public Key+    PublicKey (..),+    fromCose,+    fromX509,++    -- * Signature verification+    verify,++    -- * Hash Conversions to cryptonite types+    SomeHashAlgorithm (..),+    toCryptHashECDSA,+    SomeHashAlgorithmASN1 (..),+    toCryptHashRSA,++    -- * Conversions from/to cryptonite elliptic curves+    toCryptCurveECDSA,+    fromCryptCurveECDSA,+  )+where++import Crypto.Error (CryptoFailable (CryptoFailed, CryptoPassed))+import qualified Crypto.Hash as Hash+import Crypto.Number.Serialize (i2osp, i2ospOf, os2ip)+import qualified Crypto.PubKey.ECC.ECDSA as ECDSA+import qualified Crypto.PubKey.ECC.Types as ECC+import qualified Crypto.PubKey.Ed25519 as Ed25519+import qualified Crypto.PubKey.RSA as RSA+import qualified Crypto.PubKey.RSA.PKCS15 as RSA+import qualified Crypto.WebAuthn.Cose.Algorithm as A+import qualified Crypto.WebAuthn.Cose.Key as Cose+import Crypto.WebAuthn.Internal.ToJSONOrphans ()+import qualified Data.ASN1.BinaryEncoding as ASN1+import qualified Data.ASN1.Encoding as ASN1+import qualified Data.ASN1.Types as ASN1+import Data.Aeson (ToJSON)+import Data.ByteArray (convert)+import qualified Data.ByteString as BS+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.X509 as X509+import qualified Data.X509.EC as X509+import GHC.Generics (Generic)++-- | Same as 'Cose.CosePublicKey', but without signature algorithm parameters, i.e.+-- hash algorithms.+data PublicKey+  = -- | See 'Cose.CosePublicKeyEdDSA'+    PublicKeyEdDSA+      { -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2)+        -- The elliptic curve to use+        eddsaCurve :: Cose.CoseCurveEdDSA,+        -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2)+        -- This contains the public key bytes+        eddsaX :: BS.ByteString+      }+  | -- | See 'Cose.CosePublicKeyECDSA'+    PublicKeyECDSA+      { -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1)+        -- The elliptic curve to use+        ecdsaCurve :: Cose.CoseCurveECDSA,+        -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1)+        -- This contains the x-coordinate for the EC point. The integer is+        -- converted to a byte string as defined in [SEC1]. Leading zero+        -- octets MUST be preserved.+        ecdsaX :: BS.ByteString,+        -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1)+        -- This contains the value of the+        -- y-coordinate for the EC point. When encoding the value y, the+        -- integer is converted to an byte string (as defined in+        -- [SEC1](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#ref-SEC1))+        -- and encoded as a CBOR bstr. Leading zero octets MUST be+        -- preserved.+        ecdsaY :: BS.ByteString+      }+  | -- | See 'Cose.CosePublicKeyRSA'+    PublicKeyRSA+      { -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8230.html#section-4)+        -- The RSA modulus n is a product of u distinct odd primes+        -- r_i, i = 1, 2, ..., u, where u >= 2+        rsaN :: Integer,+        -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8230.html#section-4)+        -- The RSA public exponent e is an integer between 3 and n - 1 satisfying+        -- GCD(e,\\lambda(n)) = 1, where \\lambda(n) = LCM(r_1 - 1, ..., r_u - 1)+        rsaE :: Integer+      }+  deriving (Eq, Show, Generic, ToJSON)++-- | Turns a 'Cose.CosePublicKey' into a 'PublicKey' by removing the hash functions+fromCose :: Cose.CosePublicKey -> PublicKey+fromCose Cose.CosePublicKeyEdDSA {..} = PublicKeyEdDSA {..}+fromCose Cose.CosePublicKeyECDSA {..} = PublicKeyECDSA {..}+fromCose Cose.CosePublicKeyRSA {..} = PublicKeyRSA {..}++-- | Turns a X.509 certificates 'X509.PubKey' into a 'PublicKey'+fromX509 :: X509.PubKey -> Either Text PublicKey+fromX509 (X509.PubKeyEd25519 key) =+  Right $+    PublicKeyEdDSA+      { eddsaCurve = Cose.CoseCurveEd25519,+        eddsaX = convert key+      }+fromX509 (X509.PubKeyEC X509.PubKeyEC_Named {..}) = do+  let curve = ECC.getCurveByName pubkeyEC_name+  ecdsaCurve <- fromCryptCurveECDSA pubkeyEC_name+  point <- case X509.unserializePoint curve pubkeyEC_pub of+    Nothing -> Left "Failed to unserialize ECDSA point in X509 certificate"+    Just res -> pure res+  -- Round up to a full byte+  let byteSize = (ECC.curveSizeBits curve + 7) `div` 8+  case point of+    ECC.Point x y -> do+      ecdsaX <- case i2ospOf byteSize x of+        Nothing -> Left $ "Failed to convert ECDSA x coordinate integer " <> Text.pack (show x) <> " to bytes of size " <> Text.pack (show byteSize)+        Just res -> pure res+      ecdsaY <- case i2ospOf byteSize y of+        Nothing -> Left $ "Failed to convert ECDSA y coordinate integer " <> Text.pack (show y) <> " to bytes of size " <> Text.pack (show byteSize)+        Just res -> pure res+      Right $ PublicKeyECDSA {..}+    ECC.PointO -> Left "The infinity point is not supported"+fromX509 (X509.PubKeyRSA RSA.PublicKey {..}) =+  Right+    PublicKeyRSA+      { rsaN = public_n,+        rsaE = public_e+      }+fromX509 key = Left $ "X509 public key algorithm is not supported: " <> Text.pack (show (X509.pubkeyToAlg key))++-- | Verifies an asymmetric signature for a message using a 'Cose.CoseSignAlg'+-- and a 'PublicKey'. Returns an error if the signature algorithm doesn't+-- match. Also returns an error if the signature wasn't valid or for other+-- errors.+verify :: A.CoseSignAlg -> PublicKey -> BS.ByteString -> BS.ByteString -> Either Text ()+verify A.CoseSignAlgEdDSA PublicKeyEdDSA {eddsaCurve = Cose.CoseCurveEd25519, ..} msg sig = do+  key <- case Ed25519.publicKey eddsaX of+    CryptoFailed err -> Left $ "Failed to create Ed25519 public key: " <> Text.pack (show err)+    CryptoPassed res -> pure res+  sig <- case Ed25519.signature sig of+    CryptoFailed err -> Left $ "Failed to create Ed25519 signature: " <> Text.pack (show err)+    CryptoPassed res -> pure res+  if Ed25519.verify key msg sig+    then Right ()+    else Left "EdDSA Signature invalid"+verify (A.CoseSignAlgECDSA (toCryptHashECDSA -> SomeHashAlgorithm hash)) PublicKeyECDSA {..} msg sig = do+  let key =+        ECDSA.PublicKey+          { public_curve = ECC.getCurveByName $ toCryptCurveECDSA ecdsaCurve,+            public_q = ECC.Point (os2ip ecdsaX) (os2ip ecdsaY)+          }++  -- https://www.w3.org/TR/webauthn-2/#sctn-signature-attestation-types+  -- > For COSEAlgorithmIdentifier -7 (ES256), and other ECDSA-based algorithms,+  -- the `sig` value MUST be encoded as an ASN.1 DER Ecdsa-Sig-Value, as defined+  -- in [RFC3279](https://www.w3.org/TR/webauthn-2/#biblio-rfc3279) section 2.2.3.+  sig <- case ASN1.decodeASN1' ASN1.DER sig of+    Left err -> Left $ "Failed to decode ECDSA DER value: " <> Text.pack (show err)+    -- Ecdsa-Sig-Value in https://datatracker.ietf.org/doc/html/rfc3279#section-2.2.3+    Right [ASN1.Start ASN1.Sequence, ASN1.IntVal r, ASN1.IntVal s, ASN1.End ASN1.Sequence] ->+      pure $ ECDSA.Signature r s+    Right asns -> Left $ "Unexpected ECDSA ASN.1 structure: " <> Text.pack (show asns)++  if ECDSA.verify hash key sig msg+    then Right ()+    else Left "ECDSA Signature invalid"+verify (A.CoseSignAlgRSA (toCryptHashRSA -> SomeHashAlgorithmASN1 hash)) PublicKeyRSA {..} msg sig = do+  let key =+        RSA.PublicKey+          { -- https://www.rfc-editor.org/rfc/rfc8017#section-8.2.2+            -- > k is the length in octets of the RSA modulus n+            --+            -- > Length checking: If the length of the signature S is not k+            -- > octets, output "invalid signature" and stop.+            -- This is done by the RSA.verify call+            public_size = BS.length (i2osp rsaN),+            public_n = rsaN,+            public_e = rsaE+          }+  if RSA.verify (Just hash) key msg sig+    then Right ()+    else Left "RSA Signature invalid"+verify sigAlg pubKey _ _ =+  Left $ "Unsupported combination of signature algorithm " <> Text.pack (show sigAlg) <> " and public key " <> Text.pack (show pubKey)++-- | Some cryptonite 'Hash.HashAlgorithm' type, used as a return value of 'toCryptHashECDSA'+data SomeHashAlgorithm = forall a. Hash.HashAlgorithm a => SomeHashAlgorithm a++-- | Returns the cryptonite 'SomeHashAlgorithm' corresponding to this hash algorithm+toCryptHashECDSA :: A.CoseHashAlgECDSA -> SomeHashAlgorithm+toCryptHashECDSA A.CoseHashAlgECDSASHA256 = SomeHashAlgorithm Hash.SHA256+toCryptHashECDSA A.CoseHashAlgECDSASHA384 = SomeHashAlgorithm Hash.SHA384+toCryptHashECDSA A.CoseHashAlgECDSASHA512 = SomeHashAlgorithm Hash.SHA512++-- | Some cryptonite 'RSA.HashAlgorithmASN1' type, used as a return value of 'toCryptHashRSA'+data SomeHashAlgorithmASN1 = forall a. RSA.HashAlgorithmASN1 a => SomeHashAlgorithmASN1 a++-- | Returns the cryptonite 'SomeHashAlgorithmASN1' corresponding to this hash algorithm+toCryptHashRSA :: A.CoseHashAlgRSA -> SomeHashAlgorithmASN1+toCryptHashRSA A.CoseHashAlgRSASHA1 = SomeHashAlgorithmASN1 Hash.SHA1+toCryptHashRSA A.CoseHashAlgRSASHA256 = SomeHashAlgorithmASN1 Hash.SHA256+toCryptHashRSA A.CoseHashAlgRSASHA384 = SomeHashAlgorithmASN1 Hash.SHA384+toCryptHashRSA A.CoseHashAlgRSASHA512 = SomeHashAlgorithmASN1 Hash.SHA512++-- | Converts a 'Cose.CoseCurveECDSA' to an 'ECC.CurveName'. The inverse+-- function is 'fromCryptCurveECDSA'+toCryptCurveECDSA :: Cose.CoseCurveECDSA -> ECC.CurveName+toCryptCurveECDSA Cose.CoseCurveP256 = ECC.SEC_p256r1+toCryptCurveECDSA Cose.CoseCurveP384 = ECC.SEC_p384r1+toCryptCurveECDSA Cose.CoseCurveP521 = ECC.SEC_p521r1++-- | Tries to converts a 'ECC.CurveName' to an 'Cose.CoseCurveECDSA'. The inverse+-- function is 'toCryptCurveECDSA'+fromCryptCurveECDSA :: ECC.CurveName -> Either Text Cose.CoseCurveECDSA+fromCryptCurveECDSA ECC.SEC_p256r1 = Right Cose.CoseCurveP256+fromCryptCurveECDSA ECC.SEC_p384r1 = Right Cose.CoseCurveP384+fromCryptCurveECDSA ECC.SEC_p521r1 = Right Cose.CoseCurveP521+fromCryptCurveECDSA curve = Left $ "Curve " <> Text.pack (show curve) <> " is not a supported COSE ECDSA public key curve"

@@ -0,0 +1,297 @@+{-# LANGUAGE RecordWildCards #-}++-- | Stability: experimental+-- This module contains a partial implementation of the+-- [COSE_Key](https://datatracker.ietf.org/doc/html/rfc8152#section-7) format,+-- limited to what is needed for Webauthn, and in a structured way.+module Crypto.WebAuthn.Cose.Key+  ( -- * COSE public Key+    CosePublicKey (..),+    keySignAlg,++    -- * COSE Elliptic Curves+    CoseCurveEdDSA (..),+    CoseCurveECDSA (..),+  )+where++import Codec.CBOR.Decoding (Decoder, TokenType (TypeBool, TypeBytes), decodeBytesCanonical, decodeMapLenCanonical, peekTokenType)+import Codec.CBOR.Encoding (Encoding, encodeBytes, encodeMapLen)+import Codec.Serialise (Serialise (decode, encode))+import Control.Monad (unless)+import Crypto.Number.Serialize (i2osp, os2ip)+import qualified Crypto.WebAuthn.Cose.Algorithm as A+import qualified Crypto.WebAuthn.Cose.Internal.Registry as R+import Crypto.WebAuthn.Internal.ToJSONOrphans ()+import Data.Aeson (ToJSON)+import qualified Data.ByteString as BS+import GHC.Generics (Generic)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#credentialpublickey)+-- A structured representation of a [COSE_Key](https://datatracker.ietf.org/doc/html/rfc8152#section-7)+-- limited to what is know to be necessary for Webauthn public keys for the+-- [credentialPublicKey](https://www.w3.org/TR/webauthn-2/#credentialpublickey) field.+-- Constructors represent signature algorithms.+data CosePublicKey+  = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.2)+    -- EdDSA Signature Algorithm+    --+    -- [RFC8032](https://datatracker.ietf.org/doc/html/rfc8032) describes the+    -- elliptic curve signature scheme Edwards-curve+    -- Digital Signature Algorithm (EdDSA). In that document, the signature+    -- algorithm is instantiated using parameters for edwards25519 and+    -- edwards448 curves. The document additionally describes two variants+    -- of the EdDSA algorithm: Pure EdDSA, where no hash function is applied+    -- to the content before signing, and HashEdDSA, where a hash function+    -- is applied to the content before signing and the result of that hash+    -- function is signed. For EdDSA, the content to be signed (either the+    -- message or the pre-hash value) is processed twice inside of the+    -- signature algorithm. For use with COSE, only the pure EdDSA version+    -- is used.+    --+    -- Security considerations are [here](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.2.1)+    CosePublicKeyEdDSA+      { -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2)+        -- The elliptic curve to use+        eddsaCurve :: CoseCurveEdDSA,+        -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2)+        -- This contains the public key bytes+        eddsaX :: BS.ByteString+      }+  | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1)+    -- ECDSA Signature Algorithm+    --+    -- This document defines ECDSA to work only with the curves P-256,+    -- P-384, and P-521. Future documents may define it to work with other+    -- curves and points in the future.+    --+    -- In order to promote interoperability, it is suggested that SHA-256 be+    -- used only with curve P-256, SHA-384 be used only with curve P-384,+    -- and SHA-512 be used with curve P-521. This is aligned with the recommendation in+    -- [Section 4 of RFC5480](https://datatracker.ietf.org/doc/html/rfc5480#section-4).+    --+    -- Security considerations are [here](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1.1)+    CosePublicKeyECDSA+      { -- | The hash function to use+        ecdsaHash :: A.CoseHashAlgECDSA,+        -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1)+        -- The elliptic curve to use+        ecdsaCurve :: CoseCurveECDSA,+        -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1)+        -- This contains the x-coordinate for the EC point. The integer is+        -- converted to a byte string as defined in [SEC1]. Leading zero+        -- octets MUST be preserved.+        ecdsaX :: BS.ByteString,+        -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1)+        -- This contains the value of the+        -- y-coordinate for the EC point. When encoding the value y, the+        -- integer is converted to an byte string (as defined in+        -- [SEC1](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#ref-SEC1))+        -- and encoded as a CBOR bstr. Leading zero octets MUST be+        -- preserved.+        ecdsaY :: BS.ByteString+      }+  | -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8812.html#section-2)+    -- [RSASSA-PKCS1-v1_5](https://www.rfc-editor.org/rfc/rfc8017#section-8.2) Signature Algorithm+    --+    -- A key of size 2048 bits or larger MUST be used with these algorithms.+    -- Security considerations are [here](https://www.rfc-editor.org/rfc/rfc8812.html#section-5)+    CosePublicKeyRSA+      { -- | The hash function to use+        rsaHash :: A.CoseHashAlgRSA,+        -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8230.html#section-4)+        -- The RSA modulus n is a product of u distinct odd primes+        -- r_i, i = 1, 2, ..., u, where u >= 2+        rsaN :: Integer,+        -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8230.html#section-4)+        -- The RSA public exponent e is an integer between 3 and n - 1 satisfying+        -- GCD(e,\\lambda(n)) = 1, where \\lambda(n) = LCM(r_1 - 1, ..., r_u - 1)+        rsaE :: Integer+      }+  deriving (Eq, Show, Generic, ToJSON)++-- | CBOR encoding as a [COSE_Key](https://tools.ietf.org/html/rfc8152#section-7)+-- using the [CTAP2 canonical CBOR encoding form](https://fidoalliance.org/specs/fido-v2.0-ps-20190130/fido-client-to-authenticator-protocol-v2.0-ps-20190130.html#ctap2-canonical-cbor-encoding-form)+instance Serialise CosePublicKey where+  encode key = case key of+    CosePublicKeyEdDSA {..} ->+      common R.CoseKeyTypeOKP+        <> encode R.CoseKeyTypeParameterOKPCrv+        <> encode (fromCurveEdDSA eddsaCurve)+        <> encode R.CoseKeyTypeParameterOKPX+        <> encodeBytes eddsaX+    CosePublicKeyECDSA {..} ->+      common R.CoseKeyTypeEC2+        <> encode R.CoseKeyTypeParameterEC2Crv+        <> encode (fromCurveECDSA ecdsaCurve)+        -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1+        -- > Leading zero octets MUST be preserved.+        <> encode R.CoseKeyTypeParameterEC2X+        <> encodeBytes ecdsaX+        <> encode R.CoseKeyTypeParameterEC2Y+        <> encodeBytes ecdsaY+    CosePublicKeyRSA {..} ->+      common R.CoseKeyTypeRSA+        -- https://www.rfc-editor.org/rfc/rfc8230.html#section-4+        -- > The octet sequence MUST utilize the minimum+        -- number of octets needed to represent the value.+        <> encode R.CoseKeyTypeParameterRSAN+        <> encodeBytes (i2osp rsaN)+        <> encode R.CoseKeyTypeParameterRSAE+        <> encodeBytes (i2osp rsaE)+    where+      alg = keySignAlg key+      common :: R.CoseKeyType -> Encoding+      common kty =+        encodeMapLen (R.parameterCount kty)+          <> encode R.CoseKeyCommonParameterKty+          <> encode kty+          <> encode R.CoseKeyCommonParameterAlg+          <> encode alg++  -- NOTE: CBOR itself doesn't give an ordering of map keys, but the CTAP2 canonical CBOR encoding form does:+  -- > The keys in every map must be sorted lowest value to highest. The sorting rules are:+  -- >+  -- > * If the major types are different, the one with the lower value in numerical order sorts earlier.+  -- > * If two keys have different lengths, the shorter one sorts earlier;+  -- > * If two keys have the same length, the one with the lower value in (byte-wise) lexical order sorts earlier.+  --+  -- This has the effect that numeric keys are sorted like 1, 2, 3, ..., -1, -2, -3, ...+  -- Which aligns very nicely with the fact that common parameters use positive+  -- values and can therefore be decoded first, while key type specific+  -- parameters use negative values+  decode = do+    n <- fromIntegral <$> decodeMapLenCanonical+    -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-struct-15#section-7.1+    -- This parameter MUST be present in a key object.+    decodeExpected R.CoseKeyCommonParameterKty+    kty <- decode+    -- https://www.w3.org/TR/webauthn-2/#credentialpublickey+    -- The COSE_Key-encoded credential public key MUST contain the "alg"+    -- parameter and MUST NOT contain any other OPTIONAL parameters.+    decodeExpected R.CoseKeyCommonParameterAlg+    alg <- decode++    decodeKey n kty alg+    where+      decodeKey :: Word -> R.CoseKeyType -> A.CoseSignAlg -> Decoder s CosePublicKey+      decodeKey n kty alg = case alg of+        A.CoseSignAlgEdDSA -> decodeEdDSAKey+        A.CoseSignAlgECDSA hash -> decodeECDSAKey hash+        A.CoseSignAlgRSA hash -> decodeRSAKey hash+        where+          -- [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-struct-15#section-7.1)+          -- Implementations MUST verify that the key type is appropriate for+          -- the algorithm being processed.+          checkKty :: R.CoseKeyType -> Decoder s ()+          checkKty expectedKty = do+            unless (expectedKty == kty) $+              fail $+                "Expected COSE key type "+                  <> show expectedKty+                  <> " for COSE algorithm "+                  <> show alg+                  <> " but got COSE key type "+                  <> show kty+                  <> " instead"+            unless (R.parameterCount kty == n) $+              fail $+                "Expected CBOR map to contain "+                  <> show (R.parameterCount kty)+                  <> " parameters for COSE key type "+                  <> show kty+                  <> " but got "+                  <> show n+                  <> " parameters instead"++          decodeEdDSAKey :: Decoder s CosePublicKey+          decodeEdDSAKey = do+            -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.2+            -- > The 'kty' field MUST be present, and it MUST be 'OKP' (Octet Key Pair).+            checkKty R.CoseKeyTypeOKP+            -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2+            decodeExpected R.CoseKeyTypeParameterOKPCrv+            eddsaCurve <- toCurveEdDSA <$> decode+            decodeExpected R.CoseKeyTypeParameterOKPX+            eddsaX <- decodeBytesCanonical+            pure $ CosePublicKeyEdDSA {..}++          decodeECDSAKey :: A.CoseHashAlgECDSA -> Decoder s CosePublicKey+          decodeECDSAKey ecdsaHash = do+            -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1+            -- > The 'kty' field MUST be present, and it MUST be 'EC2'.+            checkKty R.CoseKeyTypeEC2+            -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1+            decodeExpected R.CoseKeyTypeParameterEC2Crv+            ecdsaCurve <- toCurveECDSA <$> decode+            decodeExpected R.CoseKeyTypeParameterEC2X+            ecdsaX <- decodeBytesCanonical+            decodeExpected R.CoseKeyTypeParameterEC2Y+            ecdsaY <-+              peekTokenType >>= \case+                TypeBytes -> decodeBytesCanonical+                -- TODO: Implement this+                TypeBool -> fail "Compressed EC2 y coordinate not yet supported"+                typ -> fail $ "Unexpected type in EC2 y parameter: " <> show typ+            pure $ CosePublicKeyECDSA {..}++          decodeRSAKey :: A.CoseHashAlgRSA -> Decoder s CosePublicKey+          decodeRSAKey rsaHash = do+            -- https://www.rfc-editor.org/rfc/rfc8812.html#section-2+            -- > Implementations need to check that the key type is 'RSA' when creating or verifying a signature.+            checkKty R.CoseKeyTypeRSA+            -- https://www.rfc-editor.org/rfc/rfc8230.html#section-4+            decodeExpected R.CoseKeyTypeParameterRSAN+            rsaN <- os2ip <$> decodeBytesCanonical+            decodeExpected R.CoseKeyTypeParameterRSAE+            rsaE <- os2ip <$> decodeBytesCanonical+            pure $ CosePublicKeyRSA {..}++-- | Decode a value and ensure it's the same as the value that was given+decodeExpected :: (Show a, Eq a, Serialise a) => a -> Decoder s ()+decodeExpected expected = do+  actual <- decode+  unless (expected == actual) $+    fail $ "Expected " <> show expected <> " but got " <> show actual++-- | The COSE signing algorithm corresponding to a COSE public key+keySignAlg :: CosePublicKey -> A.CoseSignAlg+keySignAlg CosePublicKeyEdDSA {} = A.CoseSignAlgEdDSA+keySignAlg CosePublicKeyECDSA {..} = A.CoseSignAlgECDSA ecdsaHash+keySignAlg CosePublicKeyRSA {..} = A.CoseSignAlgRSA rsaHash++-- | COSE elliptic curves that can be used with EdDSA+data CoseCurveEdDSA+  = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1)+    -- Ed25519 for use w/ EdDSA only+    CoseCurveEd25519+  deriving (Eq, Show, Enum, Bounded, Generic, ToJSON)++fromCurveEdDSA :: CoseCurveEdDSA -> R.CoseEllipticCurveOKP+fromCurveEdDSA CoseCurveEd25519 = R.CoseEllipticCurveEd25519++toCurveEdDSA :: R.CoseEllipticCurveOKP -> CoseCurveEdDSA+toCurveEdDSA R.CoseEllipticCurveEd25519 = CoseCurveEd25519++-- | COSE elliptic curves that can be used with ECDSA+data CoseCurveECDSA+  = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1)+    -- NIST P-256 also known as secp256r1+    CoseCurveP256+  | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1)+    -- NIST P-384 also known as secp384r1+    CoseCurveP384+  | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1)+    -- NIST P-521 also known as secp521r1+    CoseCurveP521+  deriving (Eq, Show, Enum, Bounded, Generic, ToJSON)++fromCurveECDSA :: CoseCurveECDSA -> R.CoseEllipticCurveEC2+fromCurveECDSA CoseCurveP256 = R.CoseEllipticCurveEC2P256+fromCurveECDSA CoseCurveP384 = R.CoseEllipticCurveEC2P384+fromCurveECDSA CoseCurveP521 = R.CoseEllipticCurveEC2P521++toCurveECDSA :: R.CoseEllipticCurveEC2 -> CoseCurveECDSA+toCurveECDSA R.CoseEllipticCurveEC2P256 = CoseCurveP256+toCurveECDSA R.CoseEllipticCurveEC2P384 = CoseCurveP384+toCurveECDSA R.CoseEllipticCurveEC2P521 = CoseCurveP521

@@ -0,0 +1,47 @@+{-# OPTIONS_GHC -Wno-orphans #-}++-- | Stability: internal+--+-- This module contains orphan instances connecting different date libraries together:+--+-- * [time](https://hackage.haskell.org/package/time), a commonly used library+--   containing the 'UTCTime' type, which is a bit slow and inconvenient to use+-- * [monad-time](https://hackage.haskell.org/package/monad-time) which defines+--   the 'MonadTime' class which uses 'UTCTime'. monad-time is used by the+--   [jose](https://hackage.haskell.org/package/jose) library to get the time+-- * [hourglass](https://hackage.haskell.org/package/hourglass), an alternative+--   to the time library which is nicer to use. It is used by the+--   [x509-validation](https://hackage.haskell.org/package/x509-validation) library+-- * [Data.Fixed](https://hackage.haskell.org/package/base/docs/Data-Fixed.html)+--   in @base@, which is used as the underlying representation of 'Data.Time.NominalDiffTime'+--   in the @time@ library.+--+-- This module contains a 'Timeable' and 'Time' implementation for 'UTCTime',+-- and a 'MonadTime' implementation for any 'ReaderT' of a 'Timeable'+module Crypto.WebAuthn.Internal.DateOrphans () where++import Control.Monad.Reader (ReaderT, asks)+import Control.Monad.Time (MonadTime, currentTime)+import Data.Fixed (Fixed (MkFixed), HasResolution, Nano)+import Data.Hourglass (Elapsed (Elapsed), ElapsedP (ElapsedP), NanoSeconds (NanoSeconds), Seconds (Seconds), Time, Timeable, timeConvert, timeFromElapsedP, timeGetElapsedP)+import Data.Time (UTCTime, nominalDiffTimeToSeconds, secondsToNominalDiffTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)++instance Timeable UTCTime where+  timeGetElapsedP utcTime =+    timeGetElapsedP $ nominalDiffTimeToSeconds $ utcTimeToPOSIXSeconds utcTime++instance Time UTCTime where+  timeFromElapsedP = posixSecondsToUTCTime . secondsToNominalDiffTime . realToFrac++instance HasResolution a => Timeable (Fixed a) where+  timeGetElapsedP value = ElapsedP seconds nanos+    where+      ns :: Nano+      ns = realToFrac value+      (s, MkFixed n) = properFraction ns+      seconds = Elapsed $ Seconds s+      nanos = NanoSeconds $ fromInteger n++instance (Timeable t, Monad m) => MonadTime (ReaderT t m) where+  currentTime = asks timeConvert

@@ -0,0 +1,91 @@+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-- | Stability: internal+-- This module contain some useful orphan 'ToJSON' instances for pretty-printing values from third-party libraries+module Crypto.WebAuthn.Internal.ToJSONOrphans () where++import Crypto.Hash (Digest)+import qualified Crypto.PubKey.ECC.Types as ECC+import Data.ASN1.Types (ASN1Object)+import qualified Data.ASN1.Types as ASN1+import Data.Aeson (ToJSON, Value (String), object, toJSON, (.=))+import Data.Aeson.Types (Pair)+import Data.ByteArray (convert)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base16 as Base16+import qualified Data.Hourglass as HG+import Data.List (intercalate)+import Data.Maybe (fromMaybe, mapMaybe)+import Data.String (fromString)+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import qualified Data.X509 as X509+import qualified Data.X509.Validation as X509++instance ToJSON BS.ByteString where+  toJSON = String . Text.decodeUtf8 . Base16.encode++instance ToJSON (Digest h) where+  toJSON = String . Text.decodeUtf8 . Base16.encode . convert++instance (Eq a, Show a, ASN1Object a, ToJSON a) => ToJSON (X509.SignedExact a) where+  toJSON = toJSON . X509.signedObject . X509.getSigned++instance ToJSON X509.Certificate where+  toJSON X509.Certificate {..} =+    object+      [ "certIssuerDN" .= certIssuerDN,+        "certValidity"+          .= object+            [ "notBefore" .= fst certValidity,+              "notAfter" .= snd certValidity+            ],+        "certSubjectDN" .= certSubjectDN,+        "certExtensions" .= certExtensions+      ]++instance ToJSON X509.FailedReason where+  toJSON = String . Text.pack . show++instance ToJSON X509.Extensions where+  toJSON (X509.Extensions raws) = toJSON $ fromMaybe [] raws++instance ToJSON X509.ExtensionRaw where+  toJSON X509.ExtensionRaw {..} =+    object+      [ "extRawOID" .= oidToJSON extRawOID,+        "extRawContent" .= extRawContent+      ]++instance ToJSON ECC.CurveName where+  toJSON = String . Text.pack . show++oidToJSON :: ASN1.OID -> Value+oidToJSON oid = String $ Text.pack $ intercalate "." $ map show oid++instance ToJSON HG.DateTime where+  toJSON = String . Text.pack . HG.timePrint HG.ISO8601_DateAndTime++instance ToJSON HG.Date where+  toJSON = String . Text.pack . HG.timePrint HG.ISO8601_Date++instance ToJSON X509.DistinguishedName where+  toJSON dn = object $ mapMaybe getPair dnElements+    where+      getPair :: X509.DnElement -> Maybe Pair+      getPair el = do+        asnStr <- X509.getDnElement el dn+        str <- ASN1.asn1CharacterToString asnStr+        let key = fromString $ show el+            value = String $ Text.pack str+        pure (key, value)++      dnElements :: [X509.DnElement]+      dnElements =+        [ X509.DnCommonName,+          X509.DnCountry,+          X509.DnOrganization,+          X509.DnOrganizationUnit,+          X509.DnEmailAddress+        ]

@@ -0,0 +1,106 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}++-- | Stability: internal+--+-- Internal utilities+module Crypto.WebAuthn.Internal.Utils+  ( JSONEncoding,+    EnumJSONEncoding,+    Aeson.CustomJSON (..),+    Lowercase,+    failure,+    certificateSubjectKeyIdentifier,+    IdFidoGenCeAAGUID (..),+  )+where++import Control.Monad (void)+import Crypto.Hash (hash)+import Crypto.WebAuthn.Model.Identifier (AAGUID (AAGUID), SubjectKeyIdentifier (SubjectKeyIdentifier))+import qualified Data.ASN1.BitArray as ASN1+import Data.ASN1.Parse (ParseASN1, getNext, runParseASN1)+import qualified Data.ASN1.Parse as ASN1+import Data.ASN1.Prim (ASN1 (OctetString))+import qualified Data.ASN1.Types as ASN1+import Data.Bifunctor (first)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import Data.Char (toLower)+import Data.List.NonEmpty (NonEmpty)+import qualified Data.UUID as UUID+import Data.Validation (Validation (Failure))+import Data.X509 (Extension)+import qualified Data.X509 as X509+import qualified Deriving.Aeson as Aeson+import GHC.TypeLits (Symbol)++-- | Custom JSONEncoding for use in the library. We add a "lit" prefix to every+-- field that would otherwise be a Haskell keyword.+type JSONEncoding = Aeson.CustomJSON '[Aeson.OmitNothingFields, Aeson.FieldLabelModifier (Aeson.StripPrefix "lit")]++-- | Type for 'Aeson.StringModifier' that makes all characters lowercase+data Lowercase++-- | Deriving.Aeson instance turning a string into lowercase.+instance Aeson.StringModifier Lowercase where+  getStringModifier = map toLower++-- | Custom JSON Encoding for enumerations, strips the given prefix and maps+-- all constructors to lowercase.+type EnumJSONEncoding (prefix :: Symbol) = Aeson.CustomJSON '[Aeson.ConstructorTagModifier '[Aeson.StripPrefix prefix, Lowercase]]++-- | A convenience function for creating a 'Validation' failure of a single+-- 'NonEmpty' value+failure :: e -> Validation (NonEmpty e) a+failure = Failure . pure++-- | [(spec)](https://datatracker.ietf.org/doc/html/rfc5280#section-4.2.1.2)+-- Computes the 'SubjectKeyIdentifier' from a 'X509.Certificate' according to+-- method 1 in the above specification.+-- Note that this function only fails if the 'ASN1.ASN1Object' instance of+-- 'X509.PubKey' has a bug+certificateSubjectKeyIdentifier :: X509.Certificate -> SubjectKeyIdentifier+certificateSubjectKeyIdentifier cert = SubjectKeyIdentifier . hash $ publicKeyBytes+  where+    -- The x509 library doesn't expose the public key bytes directly+    -- so we instead render the ASN.1 from the public key,+    -- then decode only the public key bytes+    asns = ASN1.toASN1 (X509.certPubKey cert) []+    err = error $ "Failed to decode the public key from the ASN.1 object generated: " <> show asns+    publicKeyBytes = either err id $ ASN1.runParseASN1 parsePublicKeyBytes asns++    -- SubjectPublicKeyInfo  ::=  SEQUENCE  {+    --      algorithm            AlgorithmIdentifier,+    --      subjectPublicKey     BIT STRING  }+    parsePublicKeyBytes :: ASN1.ParseASN1 BS.ByteString+    parsePublicKeyBytes = ASN1.onNextContainer ASN1.Sequence $ do+      -- AlgorithmIdentifier  ::=  SEQUENCE  { ... }+      -- We're not interested in this+      void $ ASN1.getNextContainer ASN1.Sequence+      ASN1.BitString bitArray <- ASN1.getNext+      if ASN1.bitArrayLength bitArray `mod` 8 == 0+        then pure $ ASN1.bitArrayGetData bitArray+        else -- This should never happen, because the x509 libraries 'ASN1.ASN1Object'+        -- instance for 'X509.PubKey' always inserts 8-bit aligned bit strings+          ASN1.throwParseError "subjectPublicKey is not 8-bit aligned!"++-- | The `id-fido-gen-ce-aaguid` contains the AAGUID of the authenticator.+newtype IdFidoGenCeAAGUID = IdFidoGenCeAAGUID AAGUID+  deriving (Eq, Show)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-packed-attestation-cert-requirements)+instance Extension IdFidoGenCeAAGUID where+  extOID = const [1, 3, 6, 1, 4, 1, 45724, 1, 1, 4]+  extHasNestedASN1 = const True+  extEncode = error "Unimplemented: This library does not implement encoding the ID_FIDO_GEN_CE_AAGUID extension"+  extDecode asn1 =+    first ("Could not decode ASN1 id-fido-gen-ce-aaguid extension: " ++) $+      runParseASN1 decodeFidoAAGUID asn1+    where+      decodeFidoAAGUID :: ParseASN1 IdFidoGenCeAAGUID+      decodeFidoAAGUID = do+        OctetString bytes <- getNext+        case UUID.fromByteString $ LBS.fromStrict bytes of+          Just aaguid -> pure $ IdFidoGenCeAAGUID $ AAGUID aaguid+          Nothing -> fail "Could not extract aaguid"

@@ -0,0 +1,34 @@+-- | Stability: experimental+-- A function for decoding a [FIDO Alliance Metadata Service](https://fidoalliance.org/metadata/)+-- BLOB in order to be able to enforce a set of requirements on the authenticator+-- used, e.g. to only allow authenticators that have been+-- [FIDO certified](https://fidoalliance.org/certification/functional-certification/).+module Crypto.WebAuthn.Metadata+  ( metadataBlobToRegistry,+    Service.MetadataServiceRegistry,+  )+where++import qualified Crypto.WebAuthn.Metadata.Service.Processing as Service+import qualified Crypto.WebAuthn.Metadata.Service.Types as Service+import qualified Data.ByteString as BS+import qualified Data.Hourglass as HG+import Data.Text (Text)+import qualified Data.Text as Text++-- | Verifies, decodes and extracts a 'Service.MetadataServiceRegistry' from a+-- [FIDO Alliance Metadata Service](https://fidoalliance.org/metadata/) BLOB.+-- The result can be passed to 'Crypto.WebAuthn.Operation.Registration.verifyRegistrationResponse'.+metadataBlobToRegistry ::+  -- | A Metadata BLOB fetched from <https://mds.fidoalliance.org>+  BS.ByteString ->+  -- | The time at which it was fetched+  HG.DateTime ->+  -- | Either an error on a registry of metadata entries+  Either Text Service.MetadataServiceRegistry+metadataBlobToRegistry bytes now = do+  json <- case Service.jwtToJson bytes Service.fidoAllianceRootCertificate now of+    Left err -> Left $ Text.pack $ show err+    Right res -> pure res+  payload <- Service.jsonToPayload json+  pure $ Service.createMetadataRegistry $ Service.mpEntries payload

@@ -0,0 +1,123 @@+{-# LANGUAGE DataKinds #-}++-- | Stability: experimental+-- [Fido Registry of Predefined Values](https://fidoalliance.org/specs/common-specs/fido-registry-v2.1-ps-20191217.html#authenticator-attestation-types)+-- FIDO Alliance Proposed Standard 17 December 2019+module Crypto.WebAuthn.Metadata.FidoRegistry+  ( UserVerificationMethod (..),+    KeyProtectionType (..),+    MatcherProtectionType (..),+    AuthenticatorAttachmentHint (..),+    TransactionConfirmationDisplayType (..),+    AuthenticationAlgorithm (..),+    PublicKeyRepresentationFormat (..),+    AuthenticatorAttestationType (..),+  )+where++import Crypto.WebAuthn.Internal.Utils (EnumJSONEncoding)+import qualified Data.Aeson as Aeson+import Deriving.Aeson (CustomJSON (CustomJSON))+import GHC.Generics (Generic)++-- | [(spec)](https://fidoalliance.org/specs/common-specs/fido-registry-v2.1-ps-20191217.html#user-verification-methods)+data UserVerificationMethod+  = USER_VERIFY_PRESENCE_INTERNAL+  | USER_VERIFY_FINGERPRINT_INTERNAL+  | USER_VERIFY_PASSCODE_INTERNAL+  | USER_VERIFY_VOICEPRINT_INTERNAL+  | USER_VERIFY_FACEPRINT_INTERNAL+  | USER_VERIFY_LOCATION_INTERNAL+  | USER_VERIFY_EYEPRINT_INTERNAL+  | USER_VERIFY_PATTERN_INTERNAL+  | USER_VERIFY_HANDPRINT_INTERNAL+  | USER_VERIFY_PASSCODE_EXTERNAL+  | USER_VERIFY_PATTERN_EXTERNAL+  | USER_VERIFY_NONE+  | USER_VERIFY_ALL+  deriving (Show, Eq, Generic)+  deriving (Aeson.FromJSON, Aeson.ToJSON) via EnumJSONEncoding "USER_VERIFY_" UserVerificationMethod++-- | [(spec)](https://fidoalliance.org/specs/common-specs/fido-registry-v2.1-ps-20191217.html#key-protection-types)+data KeyProtectionType+  = KEY_PROTECTION_SOFTWARE+  | KEY_PROTECTION_HARDWARE+  | KEY_PROTECTION_TEE+  | KEY_PROTECTION_SECURE_ELEMENT+  | KEY_PROTECTION_REMOTE_HANDLE+  deriving (Show, Eq, Generic)+  deriving (Aeson.FromJSON, Aeson.ToJSON) via EnumJSONEncoding "KEY_PROTECTION_" KeyProtectionType++-- | [(spec)](https://fidoalliance.org/specs/common-specs/fido-registry-v2.1-ps-20191217.html#matcher-protection-types)+data MatcherProtectionType+  = MATCHER_PROTECTION_SOFTWARE+  | MATCHER_PROTECTION_TEE+  | MATCHER_PROTECTION_ON_CHIP+  deriving (Show, Eq, Generic)+  deriving (Aeson.FromJSON, Aeson.ToJSON) via EnumJSONEncoding "MATCHER_PROTECTION_" MatcherProtectionType++-- | [(spec)](https://fidoalliance.org/specs/common-specs/fido-registry-v2.1-ps-20191217.html#authenticator-attachment-hints)+data AuthenticatorAttachmentHint+  = ATTACHMENT_HINT_INTERNAL+  | ATTACHMENT_HINT_EXTERNAL+  | ATTACHMENT_HINT_WIRED+  | ATTACHMENT_HINT_WIRELESS+  | ATTACHMENT_HINT_NFC+  | ATTACHMENT_HINT_BLUETOOTH+  | ATTACHMENT_HINT_NETWORK+  | ATTACHMENT_HINT_READY+  | ATTACHMENT_HINT_WIFI_DIRECT+  deriving (Show, Eq, Generic)+  deriving (Aeson.FromJSON, Aeson.ToJSON) via EnumJSONEncoding "ATTACHMENT_HINT_" AuthenticatorAttachmentHint++-- | [(spec)](https://fidoalliance.org/specs/common-specs/fido-registry-v2.1-ps-20191217.html#transaction-confirmation-display-types)+data TransactionConfirmationDisplayType+  = TRANSACTION_CONFIRMATION_DISPLAY_ANY+  | TRANSACTION_CONFIRMATION_DISPLAY_PRIVILEGED_SOFTWARE+  | TRANSACTION_CONFIRMATION_DISPLAY_TEE+  | TRANSACTION_CONFIRMATION_DISPLAY_HARDWARE+  | TRANSACTION_CONFIRMATION_DISPLAY_REMOTE+  deriving (Show, Eq, Generic)+  deriving (Aeson.FromJSON, Aeson.ToJSON) via EnumJSONEncoding "TRANSACTION_CONFIRMATION_DISPLAY_" TransactionConfirmationDisplayType++-- | [(spec)](https://fidoalliance.org/specs/common-specs/fido-registry-v2.1-ps-20191217.html#authentication-algorithms)+data AuthenticationAlgorithm+  = ALG_SIGN_SECP256R1_ECDSA_SHA256_RAW+  | ALG_SIGN_SECP256R1_ECDSA_SHA256_DER+  | ALG_SIGN_RSASSA_PSS_SHA256_RAW+  | ALG_SIGN_RSASSA_PSS_SHA256_DER+  | ALG_SIGN_SECP256K1_ECDSA_SHA256_RAW+  | ALG_SIGN_SECP256K1_ECDSA_SHA256_DER+  | ALG_SIGN_SM2_SM3_RAW+  | ALG_SIGN_RSA_EMSA_PKCS1_SHA256_RAW+  | ALG_SIGN_RSA_EMSA_PKCS1_SHA256_DER+  | ALG_SIGN_RSASSA_PSS_SHA384_RAW+  | ALG_SIGN_RSASSA_PSS_SHA512_RAW+  | ALG_SIGN_RSASSA_PKCSV15_SHA256_RAW+  | ALG_SIGN_RSASSA_PKCSV15_SHA384_RAW+  | ALG_SIGN_RSASSA_PKCSV15_SHA512_RAW+  | ALG_SIGN_RSASSA_PKCSV15_SHA1_RAW+  | ALG_SIGN_SECP384R1_ECDSA_SHA384_RAW+  | ALG_SIGN_SECP512R1_ECDSA_SHA512_RAW+  | ALG_SIGN_ED25519_EDDSA_SHA512_RAW+  deriving (Show, Eq, Generic)+  deriving (Aeson.FromJSON, Aeson.ToJSON) via EnumJSONEncoding "ALG_SIGN_" AuthenticationAlgorithm++-- | [(spec)](https://fidoalliance.org/specs/common-specs/fido-registry-v2.1-ps-20191217.html#public-key-representation-formats)+data PublicKeyRepresentationFormat+  = ALG_KEY_ECC_X962_RAW+  | ALG_KEY_ECC_X962_DER+  | ALG_KEY_RSA_2048_RAW+  | ALG_KEY_RSA_2048_DER+  | ALG_KEY_COSE+  deriving (Show, Eq, Generic)+  deriving (Aeson.FromJSON, Aeson.ToJSON) via EnumJSONEncoding "ALG_KEY_" PublicKeyRepresentationFormat++-- | [(spec)](https://fidoalliance.org/specs/common-specs/fido-registry-v2.1-ps-20191217.html#authenticator-attestation-types)+data AuthenticatorAttestationType+  = ATTESTATION_BASIC_FULL+  | ATTESTATION_BASIC_SURROGATE+  | ATTESTATION_ECDAA+  | ATTESTATION_ATTCA+  deriving (Show, Eq, Generic)+  deriving (Aeson.FromJSON, Aeson.ToJSON) via EnumJSONEncoding "ATTESTATION_" AuthenticatorAttestationType

@@ -0,0 +1,92 @@+{-# LANGUAGE RecordWildCards #-}++-- | Stability: experimental+-- This module contains functions to further decode+-- [FIDO Metadata Service](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html)+-- IDL types defined in 'Crypto.WebAuthn.Metadata.Service.WebIDL' into the Haskell-specific types defined in 'Crypto.WebAuthn.Metadata.Service.Types'+module Crypto.WebAuthn.Metadata.Service.Decode+  ( decodeMetadataPayload,+    decodeMetadataEntry,+  )+where++import qualified Crypto.WebAuthn.Metadata.Service.Types as ServiceTypes+import qualified Crypto.WebAuthn.Metadata.Service.WebIDL as ServiceIDL+import Crypto.WebAuthn.Metadata.Statement.Decode (decodeAAGUID, decodeCertificate, decodeMetadataStatement, decodeSubjectKeyIdentifier)+import qualified Crypto.WebAuthn.WebIDL as IDL+import Data.Bifunctor (first)+import Data.Hourglass (Date, DateTime (dtDate), ISO8601_Date (ISO8601_Date), timeParse)+import Data.List.NonEmpty (NonEmpty)+import qualified Data.List.NonEmpty as NE+import Data.Maybe (mapMaybe)+import Data.Text (Text)+import qualified Data.Text as Text++-- | Decodes a 'ServiceTypes.MetadataPayload' from a 'ServiceIDL.MetadataBLOBPayload',+-- discarding any 'ServiceIDL.MetadataBLOBPayloadEntry' that are not relevant to webauthn.+-- This includes entries of the protocol family 'StatementIDL.ProtocolFamilyUAF'+-- and entries whose 'StatementIDL.attestationTypes' doesn't include either+-- 'Registry.ATTESTATION_BASIC_FULL' or 'Registry.ATTESTATION_ATTCA'+decodeMetadataPayload :: ServiceIDL.MetadataBLOBPayload -> Either Text ServiceTypes.MetadataPayload+decodeMetadataPayload ServiceIDL.MetadataBLOBPayload {..} = do+  let mpLegalHeader = legalHeader+      mpNo = no+  mpNextUpdate <- decodeDate nextUpdate+  decodedEntries <- sequence $ mapMaybe decodeMetadataEntry entries+  let mpEntries = foldMap NE.toList decodedEntries+  pure ServiceTypes.MetadataPayload {..}++liftEitherMaybe :: Either (Maybe a) b -> Maybe (Either a b)+liftEitherMaybe (Left Nothing) = Nothing+liftEitherMaybe (Left (Just a)) = Just $ Left a+liftEitherMaybe (Right b) = Just $ Right b++-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#metadata-blob-payload-entry-dictionary)+-- | Decodes a 'ServiceIDL.MetadataBLOBPayloadEntry' into one or more+-- 'ServiceTypes.SomeMetadataEntry'. If the entry is not relevant for webauthn+-- (i.e. UAF authenticators or FIDO2 authenticators that only support basic+-- surrogate attestation), then this function returns 'Nothing'. If an error+-- occured during decoding, 'Left' is returned.+decodeMetadataEntry :: ServiceIDL.MetadataBLOBPayloadEntry -> Maybe (Either Text (NonEmpty ServiceTypes.SomeMetadataEntry))+decodeMetadataEntry ServiceIDL.MetadataBLOBPayloadEntry {..} = liftEitherMaybe $+  case (aaid, aaguid, attestationCertificateKeyIdentifiers) of+    (Just _aaid, Nothing, Nothing) ->+      -- This is an UAF entry, we can skip it since it's not relevant for webauthn+      Left Nothing+    (Nothing, Just aaguid, Nothing) -> do+      -- This is a FIDO 2 entry+      identifier <- first Just $ decodeAAGUID aaguid+      meMetadataStatement <- traverse decodeMetadataStatement metadataStatement+      meStatusReports <- first Just $ traverse decodeStatusReport statusReports+      meTimeOfLastStatusChange <- first Just $ decodeDate timeOfLastStatusChange+      Right $ pure $ ServiceTypes.SomeMetadataEntry identifier ServiceTypes.MetadataEntry {..}+    (Nothing, Nothing, Just attestationCertificateKeyIdentifiers) -> do+      -- This is a FIDO U2F entry+      identifiers <- first Just $ traverse decodeSubjectKeyIdentifier attestationCertificateKeyIdentifiers+      meMetadataStatement <- traverse decodeMetadataStatement metadataStatement+      meStatusReports <- first Just $ traverse decodeStatusReport statusReports+      meTimeOfLastStatusChange <- first Just $ decodeDate timeOfLastStatusChange+      let entry = ServiceTypes.MetadataEntry {..}+      Right $ fmap (`ServiceTypes.SomeMetadataEntry` entry) identifiers+    (Nothing, Nothing, Nothing) ->+      Left $ Just "None of aaid, aaguid or attestationCertificateKeyIdentifiers are set for this entry"+    _ ->+      Left $ Just "Multiple of aaid, aaguid and/or attestationCertificateKeyIdentifiers are set for this entry"++decodeStatusReport :: ServiceIDL.StatusReport -> Either Text ServiceTypes.StatusReport+decodeStatusReport ServiceIDL.StatusReport {..} = do+  let srStatus = status+  srEffectiveDate <- traverse decodeDate effectiveDate+  let srAuthenticatorVersion = authenticatorVersion+  srCertificate <- traverse decodeCertificate certificate+  let srUrl = url+      srCertificationDescriptor = certificationDescriptor+      srCertificateNumber = certificateNumber+      srCertificationPolicyVersion = certificationPolicyVersion+      srCertificationRequirementsVersion = certificationRequirementsVersion+  pure ServiceTypes.StatusReport {..}++decodeDate :: IDL.DOMString -> Either Text Date+decodeDate text = case timeParse ISO8601_Date (Text.unpack text) of+  Nothing -> Left $ "Could not parse ISO 8601 date: " <> text+  Just dt -> Right $ dtDate dt

@@ -0,0 +1,243 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}++-- | Stability: experimental+-- This module exposes functions for processing and querying+-- [FIDO Metadata Service](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html)+-- blobs and entries.+module Crypto.WebAuthn.Metadata.Service.Processing+  ( RootCertificate (..),+    ProcessingError (..),+    createMetadataRegistry,+    queryMetadata,+    jwtToJson,+    jsonToPayload,+    fidoAllianceRootCertificate,+  )+where++import Control.Lens ((^.), (^?), _Just)+import Control.Lens.Combinators (makeClassyPrisms)+import Control.Monad.Except (MonadError, runExcept, throwError)+import Control.Monad.Reader (MonadReader, ask, runReaderT)+import Crypto.JOSE (AsError (_Error), fromX509Certificate)+import Crypto.JOSE.JWK.Store (VerificationKeyStore (getVerificationKeys))+import Crypto.JOSE.Types (URI)+import Crypto.JWT+  ( AsJWTError (_JWTError),+    Error,+    HasX5c (x5c),+    HasX5u (x5u),+    JWSHeader,+    JWTError,+    decodeCompact,+    defaultJWTValidationSettings,+    param,+    unregisteredClaims,+    verifyClaims,+  )+import Crypto.WebAuthn.Internal.DateOrphans ()+import Crypto.WebAuthn.Metadata.Service.Decode (decodeMetadataPayload)+import qualified Crypto.WebAuthn.Metadata.Service.Types as Service+import qualified Crypto.WebAuthn.Model as M+import Crypto.WebAuthn.Model.Identifier+  ( AAGUID,+    AuthenticatorIdentifier+      ( AuthenticatorIdentifierFido2,+        AuthenticatorIdentifierFidoU2F,+        idAaguid,+        idSubjectKeyIdentifier+      ),+    SubjectKeyIdentifier,+  )+import Data.Aeson (Value (Object))+import qualified Data.Aeson as Aeson+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import Data.FileEmbed (embedFile)+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HashMap+import Data.Hourglass (DateTime)+import qualified Data.List.NonEmpty as NE+import Data.Maybe (mapMaybe)+import Data.Singletons (SingI, sing)+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.X509 as X509+import qualified Data.X509.CertificateStore as X509+import qualified Data.X509.Validation as X509++-- | A root certificate along with the host it should be verified against+data RootCertificate = RootCertificate+  { -- | The root certificate itself+    rootCertificateStore :: X509.CertificateStore,+    -- | The hostname it is for+    rootCertificateHostName :: X509.HostName+  }++-- | Errors related to the processing of the metadata+data ProcessingError+  = -- | An error wrapping the errors encountered by the X509 Validation+    ProcessingValidationErrors (NE.NonEmpty X509.FailedReason)+  | -- | There was no x5c header present in the metadata JWT+    ProcessingMissingX5CHeader+  | -- | An error wrapping the general Errors from the JOSE library+    ProcessingJWSError Error+  | -- | An error wrapping the JWT specific Errors from the JOSE library+    ProcessingJWTError JWTError+  | -- | There was a x5u header present in the metadata JWT but this is unimplemented+    -- TODO: Implement step 4 of the+    -- [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#metadata-blob-object-processing-rules)+    ProcessingX5UPresent URI+  deriving (Show, Eq)++-- | Create Prisms for the error type, used in the AsError and AsJWTError+-- instances below+makeClassyPrisms ''ProcessingError++-- | Instantiate JOSE's AsError typeclass as a simple cast to our own error+-- type. This allows using our own error type in JOSE operations.+instance AsError ProcessingError where+  _Error = _ProcessingJWSError++-- | Instantiate JOSE's AsJWTError typeclass as a simple cast to our own error+-- type. This allows using our own error type in JWT operations.+instance AsJWTError ProcessingError where+  _JWTError = _ProcessingJWTError++-- | The root certificate used for the blob downloaded from <https://mds.fidoalliance.org/>,+-- which can be found in [here](https://valid.r3.roots.globalsign.com/),+-- see also <https://fidoalliance.org/metadata/>+fidoAllianceRootCertificate :: RootCertificate+fidoAllianceRootCertificate =+  RootCertificate+    { rootCertificateStore = X509.makeCertificateStore [rootCert],+      rootCertificateHostName = "mds.fidoalliance.org"+    }+  where+    bytes :: BS.ByteString+    bytes = $(embedFile "root-certs/metadata/root.crt")+    rootCert :: X509.SignedCertificate+    rootCert = case X509.decodeSignedCertificate bytes of+      Left err -> error err+      Right cert -> cert++instance (MonadError ProcessingError m, MonadReader DateTime m) => VerificationKeyStore m (JWSHeader ()) p RootCertificate where+  getVerificationKeys header _ (RootCertificate rootStore hostName) = do+    -- TODO: Implement step 4 of the spec, which says to try to get the chain+    -- from x5u first before trying x5c. See:+    -- <https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#metadata-blob-object-processing-rules>+    -- and <https://github.com/tweag/webauthn/issues/23>+    --+    -- In order to prevent issues due to the lack of an implementation for x5u,+    -- we do check if it is empty before continuing. If not empty, we result in+    -- an error instead.+    case header ^? x5u . _Just . param of+      Nothing -> pure ()+      Just uri -> throwError $ ProcessingX5UPresent uri++    chain <- case header ^? x5c . _Just . param of+      Nothing ->+        throwError ProcessingMissingX5CHeader+      Just chain -> return chain++    now <- ask++    -- TODO: Check CRLs, see <https://github.com/tweag/haskell-fido2/issues/23>+    let validationErrors =+          X509.validatePure+            now+            X509.defaultHooks+            X509.defaultChecks+            rootStore+            (hostName, "")+            (X509.CertificateChain (NE.toList chain))++    case NE.nonEmpty validationErrors of+      Nothing -> do+        -- Create a JWK from the leaf certificate, which is used to sign the payload+        jwk <- fromX509Certificate (NE.head chain)+        return [jwk]+      Just errors ->+        throwError $ ProcessingValidationErrors errors++-- | Extracts a FIDO Metadata payload JSON value from a JWT bytestring according to https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html+jwtToJson ::+  -- | The bytes of the JWT blob+  BS.ByteString ->+  -- | The root certificate the blob is signed with+  RootCertificate ->+  -- | The current time for which to validate the JWT blob+  DateTime ->+  Either ProcessingError (HashMap Text Value)+jwtToJson blob rootCert now = runExcept $ do+  jwt <- decodeCompact $ LBS.fromStrict blob+  claims <- runReaderT (verifyClaims (defaultJWTValidationSettings (const True)) rootCert jwt) now+  return $ claims ^. unregisteredClaims++-- | Decodes a FIDO Metadata payload JSON value to a 'Service.MetadataPayload',+-- returning an error when the JSON is invalid, and ignoring any entries not+-- relevant for webauthn. For the purposes of implementing the+-- relying party the `Crypto.WebAuthn.Metadata.Service.Types.mpNextUpdate`+-- and `Crypto.WebAuthn.Metadata.Service.Types.mpEntries` fields are most+-- important.+jsonToPayload :: HashMap Text Value -> Either Text Service.MetadataPayload+jsonToPayload value = case Aeson.fromJSON $ Object value of+  Aeson.Error err -> Left $ Text.pack err+  Aeson.Success payload -> case decodeMetadataPayload payload of+    Left err -> Left err+    Right result -> pure result++-- | Creates a 'Service.MetadataServiceRegistry' from a list of+-- 'Service.SomeMetadataEntry', which can either be obtained from a+-- 'Service.MetadataPayload's 'Service.mpEntries' field, or be constructed+-- directly+--+-- The resulting structure can be queried efficiently for+-- 'Service.MetadataEntry' using 'queryMetadata'+createMetadataRegistry :: [Service.SomeMetadataEntry] -> Service.MetadataServiceRegistry+createMetadataRegistry entries = Service.MetadataServiceRegistry {..}+  where+    fido2Entries = HashMap.fromList $ mapMaybe getFido2Pairs entries+    fidoU2FEntries = HashMap.fromList $ mapMaybe getFidoU2FPairs entries++    getFido2Pairs (Service.SomeMetadataEntry ident entry) = getFido2Pairs' ident entry+    getFidoU2FPairs (Service.SomeMetadataEntry ident entry) = getFidoU2FPairs' ident entry++    getFido2Pairs' ::+      forall p.+      SingI p =>+      AuthenticatorIdentifier p ->+      Service.MetadataEntry p ->+      Maybe (AAGUID, Service.MetadataEntry 'M.Fido2)+    getFido2Pairs' ident entry = case sing @p of+      M.SFido2 ->+        Just (idAaguid ident, entry)+      _ -> Nothing++    getFidoU2FPairs' ::+      forall p.+      SingI p =>+      AuthenticatorIdentifier p ->+      Service.MetadataEntry p ->+      Maybe (SubjectKeyIdentifier, Service.MetadataEntry 'M.FidoU2F)+    getFidoU2FPairs' ident entry = case sing @p of+      M.SFidoU2F ->+        Just (idSubjectKeyIdentifier ident, entry)+      _ -> Nothing++-- | Query a 'Service.MetadataEntry' for an 'M.AuthenticatorIdentifier'+queryMetadata ::+  Service.MetadataServiceRegistry ->+  AuthenticatorIdentifier p ->+  Maybe (Service.MetadataEntry p)+queryMetadata registry (AuthenticatorIdentifierFido2 aaguid) =+  HashMap.lookup aaguid (Service.fido2Entries registry)+queryMetadata registry (AuthenticatorIdentifierFidoU2F subjectKeyIdentifier) =+  HashMap.lookup subjectKeyIdentifier (Service.fidoU2FEntries registry)

@@ -0,0 +1,115 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}++-- | Stability: experimental+-- This module contains additional Haskell-specific type definitions for the+-- [FIDO Metadata Service](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html)+-- specification+module Crypto.WebAuthn.Metadata.Service.Types+  ( MetadataServiceRegistry (..),+    MetadataPayload (..),+    MetadataEntry (..),+    SomeMetadataEntry (..),+    StatusReport (..),+  )+where++import qualified Crypto.WebAuthn.Metadata.Service.WebIDL as ServiceIDL+import Crypto.WebAuthn.Metadata.Statement.Types (MetadataStatement)+import qualified Crypto.WebAuthn.Model as M+import Crypto.WebAuthn.Model.Identifier (AAGUID, AuthenticatorIdentifier, SubjectKeyIdentifier)+import Data.Aeson (ToJSON)+import Data.HashMap.Strict (HashMap)+import Data.Hourglass (Date)+import Data.List.NonEmpty (NonEmpty)+import Data.Singletons (SingI)+import Data.Text (Text)+import Data.Word (Word32)+import qualified Data.X509 as X509+import GHC.Generics (Generic)++-- | A registry of 'MetadataEntry's, allowing fast lookup using 'M.AAGUID's or+-- 'SubjectKeyIdentifier's. This is used by 'Crypto.WebAuthn.Operation.Registration.verifyRegistrationResponse'+-- as a way to look up root certificates of authenticators and return meta information.+-- Using 'Crypto.WebAuthn.Metadata.Service.Processing.createMetadataRegistry'+-- it's also possible to create additional custom entries, which can be merged+-- with '<>'. Meanwhile 'mempty' can be used if no metadata is needed.+data MetadataServiceRegistry = MetadataServiceRegistry+  { fido2Entries :: HashMap AAGUID (MetadataEntry 'M.Fido2),+    fidoU2FEntries :: HashMap SubjectKeyIdentifier (MetadataEntry 'M.FidoU2F)+  }++instance Semigroup MetadataServiceRegistry where+  MetadataServiceRegistry l2 lu2f <> MetadataServiceRegistry r2 ru2f =+    MetadataServiceRegistry (l2 <> r2) (lu2f <> ru2f)++instance Monoid MetadataServiceRegistry where+  mempty = MetadataServiceRegistry mempty mempty++-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#metadata-blob-payload-dictionary)+-- Same as 'StatementIDL.MetadataBLOBPayload', but fully decoded. However all+-- 'StatementIDL.entries' not relevant for webauthn are discarded+data MetadataPayload = MetadataPayload+  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayload-legalheader)+    -- The legalHeader, which MUST be in each BLOB, is an indication of the+    -- acceptance of the relevant legal agreement for using the MDS.+    mpLegalHeader :: Maybe Text,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayload-no)+    -- The serial number of this UAF Metadata BLOB Payload. Serial numbers MUST+    -- be consecutive and strictly monotonic, i.e. the successor BLOB will have+    -- a no value exactly incremented by one.+    mpNo :: Int,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayload-nextupdate)+    -- Date when the next update will be provided at latest.+    mpNextUpdate :: Date,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayload-entries)+    -- List of zero or more entries. This can be passed to+    -- 'Crypto.WebAuthn.Metadata.Service.Processing.createMetadataRegistry'+    mpEntries :: [SomeMetadataEntry]+  }++-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#metadata-blob-payload-entry-dictionary)+-- Same as 'StatementIDL.MetadataBLOBPayloadEntry', but fully decoded. This type+-- is parametrized over the 'StatementIDL.ProtocolFamily' this metadata entry is for+data MetadataEntry (p :: M.ProtocolKind) = MetadataEntry+  { -- [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayloadentry-metadatastatement)+    meMetadataStatement :: Maybe (MetadataStatement p),+    -- TODO: Implement this, currently not used in the blob however+    -- meBiometricStatusReports :: Maybe (NonEmpty BiometricStatusReport),++    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayloadentry-statusreports)+    meStatusReports :: NonEmpty StatusReport,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayloadentry-timeoflaststatuschange)+    meTimeOfLastStatusChange :: Date+    -- rogueListURL, rogueListHash. TODO, but not currently used in the+    -- BLOB and difficult to implement since it involves JWT+  }+  deriving (Eq, Show, Generic, ToJSON)++-- | Same as 'MetadataEntry', but with its type parameter erased+data SomeMetadataEntry = forall p. SingI p => SomeMetadataEntry (AuthenticatorIdentifier p) (MetadataEntry p)++-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#statusreport-dictionary)+-- Same as 'StatementIDL.StatusReport', but fully decoded.+data StatusReport = StatusReport+  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-status)+    srStatus :: ServiceIDL.AuthenticatorStatus,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-effectivedate)+    srEffectiveDate :: Maybe Date,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-authenticatorversion)+    srAuthenticatorVersion :: Maybe Word32,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-certificate)+    srCertificate :: Maybe X509.SignedCertificate,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-url)+    srUrl :: Maybe Text,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-certificationdescriptor)+    srCertificationDescriptor :: Maybe Text,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-certificatenumber)+    srCertificateNumber :: Maybe Text,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-certificationpolicyversion)+    srCertificationPolicyVersion :: Maybe Text,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-certificationrequirementsversion)+    srCertificationRequirementsVersion :: Maybe Text+  }+  deriving (Eq, Show, Generic, ToJSON)

@@ -0,0 +1,127 @@+{-# LANGUAGE DuplicateRecordFields #-}++-- | Stability: experimental+-- Type definitions directly corresponding to the+-- [FIDO Metadata Service](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html)+-- specification.+module Crypto.WebAuthn.Metadata.Service.WebIDL+  ( MetadataBLOBPayloadEntry (..),+    BiometricStatusReport (..),+    StatusReport (..),+    AuthenticatorStatus (..),+    MetadataBLOBPayload (..),+  )+where++-- Note from https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#notation :+-- Unless otherwise specified, if a WebIDL dictionary member is DOMString, it MUST NOT be empty.+-- Unless otherwise specified, if a WebIDL dictionary member is a List, it MUST NOT be an empty list.++import Crypto.WebAuthn.Internal.Utils (CustomJSON (CustomJSON), JSONEncoding)+import Crypto.WebAuthn.Metadata.Statement.WebIDL (AAGUID, MetadataStatement)+import qualified Crypto.WebAuthn.Metadata.UAF as UAF+import qualified Crypto.WebAuthn.WebIDL as IDL+import qualified Data.Aeson as Aeson+import Data.List.NonEmpty (NonEmpty)+import GHC.Generics (Generic)++-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#metadata-blob-payload-entry-dictionary)+data MetadataBLOBPayloadEntry = MetadataBLOBPayloadEntry+  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayloadentry-aaid)+    aaid :: Maybe UAF.AAID,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayloadentry-aaguid)+    aaguid :: Maybe AAGUID,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayloadentry-attestationcertificatekeyidentifiers)+    attestationCertificateKeyIdentifiers :: Maybe (NonEmpty IDL.DOMString),+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayloadentry-metadatastatement)+    metadataStatement :: Maybe MetadataStatement,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayloadentry-biometricstatusreports)+    biometricStatusReports :: Maybe (NonEmpty BiometricStatusReport),+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayloadentry-statusreports)+    statusReports :: NonEmpty StatusReport,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayloadentry-timeoflaststatuschange)+    timeOfLastStatusChange :: IDL.DOMString+    -- Unused in the current blob, also annoying to implement+    -- entryRogueListURL :: IDL.DOMString,+    -- entryRogueListHash :: IDL.DOMString+  }+  deriving (Show, Eq, Generic)+  deriving (Aeson.FromJSON, Aeson.ToJSON) via JSONEncoding MetadataBLOBPayloadEntry++-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#biometricstatusreport-dictionary)+data BiometricStatusReport = BiometricStatusReport+  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-biometricstatusreport-certlevel)+    certLevel :: IDL.UnsignedShort,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-biometricstatusreport-modality)+    modality :: IDL.DOMString,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-biometricstatusreport-effectivedate)+    effectiveDate :: Maybe IDL.DOMString,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-biometricstatusreport-certificationdescriptor)+    certificationDescriptor :: Maybe IDL.DOMString,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-biometricstatusreport-certificatenumber)+    certificateNumber :: Maybe IDL.DOMString,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-biometricstatusreport-certificationpolicyversion)+    certificationPolicyVersion :: Maybe IDL.DOMString,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-biometricstatusreport-certificationrequirementsversion)+    certificationRequirementsVersion :: Maybe IDL.DOMString+  }+  deriving (Show, Eq, Generic)+  deriving (Aeson.FromJSON, Aeson.ToJSON) via JSONEncoding BiometricStatusReport++-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#statusreport-dictionary)+data StatusReport = StatusReport+  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-status)+    status :: AuthenticatorStatus,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-effectivedate)+    effectiveDate :: Maybe IDL.DOMString,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-authenticatorversion)+    authenticatorVersion :: Maybe IDL.UnsignedLong,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-certificate)+    certificate :: Maybe IDL.DOMString,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-url)+    url :: Maybe IDL.DOMString,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-certificationdescriptor)+    certificationDescriptor :: Maybe IDL.DOMString,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-certificatenumber)+    certificateNumber :: Maybe IDL.DOMString,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-certificationpolicyversion)+    certificationPolicyVersion :: Maybe IDL.DOMString,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-certificationrequirementsversion)+    certificationRequirementsVersion :: Maybe IDL.DOMString+  }+  deriving (Show, Eq, Generic)+  deriving (Aeson.FromJSON, Aeson.ToJSON) via JSONEncoding StatusReport++-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#authenticatorstatus-enum)+data AuthenticatorStatus+  = NOT_FIDO_CERTIFIED+  | FIDO_CERTIFIED+  | USER_VERIFICATION_BYPASS+  | ATTESTATION_KEY_COMPROMISE+  | USER_KEY_REMOTE_COMPROMISE+  | USER_KEY_PHYSICAL_COMPROMISE+  | UPDATE_AVAILABLE+  | REVOKED+  | SELF_ASSERTION_SUBMITTED+  | FIDO_CERTIFIED_L1+  | FIDO_CERTIFIED_L1plus+  | FIDO_CERTIFIED_L2+  | FIDO_CERTIFIED_L2plus+  | FIDO_CERTIFIED_L3+  | FIDO_CERTIFIED_L3plus+  deriving (Show, Eq, Generic)+  deriving (Aeson.FromJSON, Aeson.ToJSON) via JSONEncoding AuthenticatorStatus++-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#metadata-blob-payload-dictionary)+data MetadataBLOBPayload = MetadataBLOBPayload+  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayload-legalheader)+    legalHeader :: Maybe IDL.DOMString,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayload-no)+    no :: Int,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayload-nextupdate)+    nextUpdate :: IDL.DOMString,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayload-entries)+    entries :: [MetadataBLOBPayloadEntry]+  }+  deriving (Show, Eq, Generic)+  deriving (Aeson.FromJSON, Aeson.ToJSON) via JSONEncoding MetadataBLOBPayload

@@ -0,0 +1,145 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Stability: experimental+-- This module contains functions to further decode+-- [FIDO Metadata Statement](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html)+-- IDL types defined in 'Crypto.WebAuthn.Metadata.Statement.IDL' into the Haskell-specific types defined in 'Crypto.WebAuthn.Metadata.Statement.Types'+module Crypto.WebAuthn.Metadata.Statement.Decode+  ( decodeMetadataStatement,+    decodeAAGUID,+    decodeSubjectKeyIdentifier,+    decodeCertificate,+  )+where++import Control.Monad (unless)+import Crypto.Hash (SHA1, digestFromByteString)+import qualified Crypto.WebAuthn.Metadata.FidoRegistry as Registry+import Crypto.WebAuthn.Metadata.Statement.Types (WebauthnAttestationType (WebauthnAttestationAttCA, WebauthnAttestationBasic))+import qualified Crypto.WebAuthn.Metadata.Statement.Types as StatementTypes+import qualified Crypto.WebAuthn.Metadata.Statement.WebIDL as StatementIDL+import qualified Crypto.WebAuthn.Metadata.UAF as UAF+import qualified Crypto.WebAuthn.Model as M+import Crypto.WebAuthn.Model.Identifier (AAGUID (AAGUID), AuthenticatorIdentifier (AuthenticatorIdentifierFido2, AuthenticatorIdentifierFidoU2F), SubjectKeyIdentifier (SubjectKeyIdentifier))+import qualified Crypto.WebAuthn.WebIDL as IDL+import Data.Bifunctor (first)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base16 as Base16+import qualified Data.ByteString.Base64 as Base64+import Data.List.NonEmpty (NonEmpty)+import qualified Data.List.NonEmpty as NE+import Data.Maybe (mapMaybe)+import Data.Singletons (SingI, sing)+import Data.Text (Text)+import qualified Data.Text as Text+import Data.Text.Encoding (encodeUtf8)+import qualified Data.UUID as UUID+import qualified Data.X509 as X509++-- | Decodes an 'M.AAGUID' from an [aaguid](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-aaguid) field of a metadata statement or an [aaguid](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayloadentry-aaguid) field of a metadata service payload entry field+decodeAAGUID :: StatementIDL.AAGUID -> Either Text (AuthenticatorIdentifier 'M.Fido2)+decodeAAGUID (StatementIDL.AAGUID aaguidText) = case UUID.fromText aaguidText of+  Nothing -> Left $ "Could not decode metadata aaguid: " <> aaguidText+  Just aaguid -> Right $ AuthenticatorIdentifierFido2 $ AAGUID aaguid++-- | Decodes a 'M.SubjectKeyIdentifier' from an [attestationCertificateKeyIdentifiers](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-attestationcertificatekeyidentifiers) field of a metadata statement or an [attestationCertificateKeyIdentifiers](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayloadentry-attestationcertificatekeyidentifiers) field of a metadata service payload entry+decodeSubjectKeyIdentifier :: IDL.DOMString -> Either Text (AuthenticatorIdentifier 'M.FidoU2F)+decodeSubjectKeyIdentifier subjectKeyIdentifierText = case Base16.decode (encodeUtf8 subjectKeyIdentifierText) of+  Left err -> Left $ "A attestationCertificateKeyIdentifier failed to parse because it's not a valid base-16 encoding: " <> subjectKeyIdentifierText <> ", error: " <> Text.pack err+  Right bytes -> case digestFromByteString @SHA1 bytes of+    Nothing -> Left $ "A attestationCertificateKeyIdentifier failed to parse because it has the wrong length for a SHA1 hash: " <> subjectKeyIdentifierText+    Just hash -> Right $ AuthenticatorIdentifierFidoU2F $ SubjectKeyIdentifier hash++-- | Decodes a 'X509.SignedCertificate' from an [attestationRootCertificates](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-attestationrootcertificates) field of a metadata statement or the [certificate](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-statusreport-certificate) field of a metadata service status report+decodeCertificate :: IDL.DOMString -> Either Text X509.SignedCertificate+decodeCertificate text =+  -- TODO: Remove Text.strip, it's only needed because of a spec violation, see+  -- <https://github.com/tweag/haskell-fido2/issues/68>+  -- TODO: Don't use decodeLenient, it's only needed because of a spec+  -- violation, see TODO above+  let bytes = Base64.decodeLenient (encodeUtf8 $ Text.strip text)+   in case X509.decodeSignedCertificate bytes of+        Left err -> Left $ "A certificate failed to parse because it's not a valid encoding: " <> text <> ", error: " <> Text.pack err+        Right certificate -> Right certificate++-- | Fully decodes a [MetadataStatement](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#metadata-keys).+-- The @p@ type parameter is the 'StatementIDL.ProtocolFamily' that this metadata statement is for.+decodeMetadataStatement ::+  forall p.+  SingI p =>+  -- | The raw metadata statement, directly parsed from JSON+  StatementIDL.MetadataStatement ->+  -- | Either an early exit with 'Left', where @Left Nothing@ signals that+  -- this entry can be skipped because it's not relevant for Webauthn, and+  -- @Left . Just@ signals that an error happened during decoding+  -- Otherwise a successful result with 'Right'+  Either (Maybe Text) (StatementTypes.MetadataStatement p)+decodeMetadataStatement StatementIDL.MetadataStatement {..} = do+  let msLegalHeader = legalHeader+      msDescription = description+      msAlternativeDescriptions = alternativeDescriptions+      msAuthenticatorVersion = authenticatorVersion+  unless (schema == 3) $ Left $ Just $ "Schema version is not 3 but " <> Text.pack (show schema)+  msUpv <- case sing @p of+    M.SFidoU2F -> first Just $ traverse decodeUpvFidoU2F upv+    M.SFido2 -> first Just $ traverse decodeUpvFido2 upv+  let msAuthenticationAlgorithms = authenticationAlgorithms+      msPublicKeyAlgAndEncodings = publicKeyAlgAndEncodings+  msAttestationTypes <- decodeAttestationTypes attestationTypes+  let msUserVerificationDetails = userVerificationDetails+      msKeyProtection = keyProtection+      msIsKeyRestricted = isKeyRestricted+      msIsFreshUserVerificationRequired = isFreshUserVerificationRequired+      msMatcherProtection = matcherProtection+      msCryptoStrength = cryptoStrength+      msAttachmentHint = attachmentHint+      msTcDisplay = tcDisplay+      msTcDisplayContentType = tcDisplayContentType+      msTcDisplayPNGCharacteristics = tcDisplayPNGCharacteristics+  msAttestationRootCertificates <- case NE.nonEmpty attestationRootCertificates of+    -- > When supporting surrogate basic attestation only, no attestation trust anchor is required/used. So this array MUST be empty in that case.+    -- This will never be the case, because if only surrogate basic attestation is used, then decodeAttestationTypes above will have returned (Left Nothing) already+    Nothing -> Left $ Just "attestationRootCertificates should not be empty"+    Just certs -> first Just $ traverse decodeCertificate certs+  msIcon <- first Just $ traverse decodeIcon icon+  let msSupportedExtensions = supportedExtensions+      msAuthenticatorGetInfo = authenticatorGetInfo+  pure $ StatementTypes.MetadataStatement {..}+  where+    decodeUpvFidoU2F :: UAF.Version -> Either Text (StatementTypes.ProtocolVersion 'M.FidoU2F)+    decodeUpvFidoU2F UAF.Version {UAF.major = 1, UAF.minor = 0} = Right StatementTypes.U2F1_0+    decodeUpvFidoU2F UAF.Version {UAF.major = 1, UAF.minor = 1} = Right StatementTypes.U2F1_1+    decodeUpvFidoU2F UAF.Version {UAF.major = 1, UAF.minor = 2} = Right StatementTypes.U2F1_2+    decodeUpvFidoU2F version = Left $ "Unknown FIDO U2F UPV version: " <> Text.pack (show version)++    decodeUpvFido2 :: UAF.Version -> Either Text (StatementTypes.ProtocolVersion 'M.Fido2)+    decodeUpvFido2 UAF.Version {UAF.major = 1, UAF.minor = 0} = Right StatementTypes.CTAP2_0+    decodeUpvFido2 UAF.Version {UAF.major = 1, UAF.minor = 1} = Right StatementTypes.CTAP2_1+    decodeUpvFido2 version = Left $ "Unknown FIDO2 UPV version: " <> Text.pack (show version)++    -- Turns a non-empty list of 'Registry.AuthenticatorAttestationType' into a non-empty list of 'WebauthnAttestationType'.+    -- If the authenticator doesn't support any webauthn attestation types,+    -- `Left Nothing` is returned, indicating that this authenticator should be ignored+    decodeAttestationTypes ::+      NonEmpty Registry.AuthenticatorAttestationType ->+      Either (Maybe Text) (NonEmpty WebauthnAttestationType)+    decodeAttestationTypes types = case NE.nonEmpty $ mapMaybe transform $ NE.toList types of+      Nothing -> Left Nothing+      Just result -> Right result+      where+        transform :: Registry.AuthenticatorAttestationType -> Maybe WebauthnAttestationType+        transform Registry.ATTESTATION_BASIC_FULL = Just WebauthnAttestationBasic+        transform Registry.ATTESTATION_ATTCA = Just WebauthnAttestationAttCA+        transform _ = Nothing++    -- Decodes the PNG bytes of an [icon](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-icon) field of a metadata statement+    decodeIcon :: IDL.DOMString -> Either Text BS.ByteString+    decodeIcon dataUrl = case Text.stripPrefix "data:image/png;base64," dataUrl of+      Nothing -> Left $ "Icon decoding failed because there is no \"data:image/png;base64,\" prefix: " <> dataUrl+      Just suffix ->+        -- TODO: Use non-lenient decoding, it's only needed because of a spec violation,+        -- see <https://github.com/tweag/haskell-fido2/issues/68>+        Right $ Base64.decodeLenient (encodeUtf8 suffix)

@@ -0,0 +1,113 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE StandaloneDeriving #-}++-- | Stability: experimental+-- This module contains additional Haskell-specific type definitions for the+-- [FIDO Metadata Statement](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html)+-- specification+module Crypto.WebAuthn.Metadata.Statement.Types+  ( MetadataStatement (..),+    ProtocolVersion (..),+    WebauthnAttestationType (..),+  )+where++import qualified Crypto.WebAuthn.Metadata.FidoRegistry as Registry+import qualified Crypto.WebAuthn.Metadata.Statement.WebIDL as StatementIDL+import qualified Crypto.WebAuthn.Model as M+import Data.Aeson (ToJSON, toJSON)+import qualified Data.ByteString as BS+import Data.List.NonEmpty (NonEmpty)+import Data.Text (Text)+import Data.Word (Word32)+import qualified Data.X509 as X509+import GHC.Generics (Generic)+import GHC.Word (Word16)++-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#metadata-keys)+data MetadataStatement (p :: M.ProtocolKind) = MetadataStatement+  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-legalheader)+    msLegalHeader :: Text,+    -- msAaid, msAaguid, attestationCertificateKeyIdentifiers: These fields are the key of the hashmaps in MetadataServiceRegistry++    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-description)+    msDescription :: Text,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-alternativedescriptions)+    msAlternativeDescriptions :: Maybe StatementIDL.AlternativeDescriptions,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-authenticatorversion)+    msAuthenticatorVersion :: Word32,+    -- protocolFamily, encoded as the type-level p+    -- msSchema, this is always schema version 3++    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-upv)+    msUpv :: NonEmpty (ProtocolVersion p),+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-authenticationalgorithms)+    msAuthenticationAlgorithms :: NonEmpty Registry.AuthenticationAlgorithm,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-publickeyalgandencodings)+    msPublicKeyAlgAndEncodings :: NonEmpty Registry.PublicKeyRepresentationFormat,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-attestationtypes)+    msAttestationTypes :: NonEmpty WebauthnAttestationType,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-userverificationdetails)+    msUserVerificationDetails :: NonEmpty StatementIDL.VerificationMethodANDCombinations,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-keyprotection)+    msKeyProtection :: NonEmpty Registry.KeyProtectionType,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-iskeyrestricted)+    msIsKeyRestricted :: Maybe Bool,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-isfreshuserverificationrequired)+    msIsFreshUserVerificationRequired :: Maybe Bool,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-matcherprotection)+    msMatcherProtection :: NonEmpty Registry.MatcherProtectionType,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-cryptostrength)+    msCryptoStrength :: Maybe Word16,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-attachmenthint)+    msAttachmentHint :: NonEmpty Registry.AuthenticatorAttachmentHint,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-tcdisplay)+    msTcDisplay :: [Registry.TransactionConfirmationDisplayType],+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-tcdisplaycontenttype)+    msTcDisplayContentType :: Maybe Text,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-tcdisplaypngcharacteristics)+    msTcDisplayPNGCharacteristics :: Maybe (NonEmpty StatementIDL.DisplayPNGCharacteristicsDescriptor),+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-attestationrootcertificates)+    msAttestationRootCertificates :: NonEmpty X509.SignedCertificate,+    -- msEcdaaTrustAnchors, not needed for the subset we implement, FIDO 2 and FIDO U2F++    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-icon)+    msIcon :: Maybe BS.ByteString,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-supportedextensions)+    msSupportedExtensions :: Maybe (NonEmpty StatementIDL.ExtensionDescriptor),+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-authenticatorgetinfo)+    msAuthenticatorGetInfo :: Maybe StatementIDL.AuthenticatorGetInfo+  }+  deriving (Eq, Show, Generic, ToJSON)++-- | FIDO protocol versions, parametrized by the protocol family+data ProtocolVersion (p :: M.ProtocolKind) where+  -- | FIDO U2F 1.0+  U2F1_0 :: ProtocolVersion 'M.FidoU2F+  -- | FIDO U2F 1.1+  U2F1_1 :: ProtocolVersion 'M.FidoU2F+  -- | FIDO U2F 1.2+  U2F1_2 :: ProtocolVersion 'M.FidoU2F+  -- | FIDO 2, CTAP 2.0+  CTAP2_0 :: ProtocolVersion 'M.Fido2+  -- | FIDO 2, CTAP 2.1+  CTAP2_1 :: ProtocolVersion 'M.Fido2++deriving instance Eq (ProtocolVersion p)++deriving instance Show (ProtocolVersion p)++instance ToJSON (ProtocolVersion p) where+  toJSON U2F1_0 = "U2F 1.0"+  toJSON U2F1_1 = "U2F 1.1"+  toJSON U2F1_2 = "U2F 1.2"+  toJSON CTAP2_0 = "CTAP 2.0"+  toJSON CTAP2_1 = "CTAP 2.1"++-- | Values of 'Registry.AuthenticatorAttestationType' but limited to the ones possible with Webauthn, see https://www.w3.org/TR/webauthn-2/#sctn-attestation-types+data WebauthnAttestationType+  = WebauthnAttestationBasic+  | WebauthnAttestationAttCA+  deriving (Eq, Show, Generic, ToJSON)

@@ -0,0 +1,264 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DuplicateRecordFields #-}++-- | Stability: experimental+-- Type definitions directly corresponding to the+-- [FIDO Metadata Service](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html)+-- specification.+module Crypto.WebAuthn.Metadata.Statement.WebIDL+  ( -- * Types+    AAGUID (..),+    CodeAccuracyDescriptor (..),+    BiometricAccuracyDescriptor (..),+    PatternAccuracyDescriptor (..),+    VerificationMethodDescriptor (..),+    VerificationMethodANDCombinations (..),+    RgbPaletteEntry (..),+    DisplayPNGCharacteristicsDescriptor (..),+    EcdaaTrustAnchor (..),+    ExtensionDescriptor (..),+    AlternativeDescriptions (..),+    AuthenticatorGetInfo (..),+    ProtocolFamily (..),++    -- * Metadata Statement+    MetadataStatement (..),+  )+where++import Crypto.WebAuthn.Internal.Utils (CustomJSON (CustomJSON), EnumJSONEncoding, JSONEncoding)+import qualified Crypto.WebAuthn.Metadata.FidoRegistry as Registry+import qualified Crypto.WebAuthn.Metadata.UAF as UAF+import qualified Crypto.WebAuthn.WebIDL as IDL+import qualified Data.Aeson as Aeson+import Data.List.NonEmpty (NonEmpty)+import Data.Map (Map)+import Data.Text (Text)+import GHC.Generics (Generic)++-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#authenticator-attestation-guid-aaguid-typedef)+newtype AAGUID = AAGUID IDL.DOMString+  deriving (Show, Eq)+  deriving newtype (Aeson.FromJSON, Aeson.ToJSON)++-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#codeaccuracydescriptor-dictionary)+data CodeAccuracyDescriptor = CodeAccuracyDescriptor+  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-codeaccuracydescriptor-base)+    base :: IDL.UnsignedShort,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-codeaccuracydescriptor-minlength)+    minLength :: IDL.UnsignedShort,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-codeaccuracydescriptor-maxretries)+    maxRetries :: Maybe IDL.UnsignedShort,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-codeaccuracydescriptor-blockslowdown)+    blockSlowdown :: Maybe IDL.UnsignedShort+  }+  deriving (Show, Eq, Generic)+  deriving (Aeson.FromJSON, Aeson.ToJSON) via JSONEncoding CodeAccuracyDescriptor++-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#biometricaccuracydescriptor-dictionary)+data BiometricAccuracyDescriptor = BiometricAccuracyDescriptor+  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-biometricaccuracydescriptor-selfattestedfrr)+    selfAttestedFRR :: Maybe IDL.Double,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-biometricaccuracydescriptor-selfattestedfar)+    selfAttestedFAR :: Maybe IDL.Double,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-biometricaccuracydescriptor-maxtemplates)+    maxTemplates :: Maybe IDL.UnsignedShort,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-biometricaccuracydescriptor-maxretries)+    maxRetries :: Maybe IDL.UnsignedShort,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-biometricaccuracydescriptor-blockslowdown)+    blockSlowdown :: Maybe IDL.UnsignedShort+  }+  deriving (Show, Eq, Generic)+  deriving (Aeson.FromJSON, Aeson.ToJSON) via JSONEncoding BiometricAccuracyDescriptor++-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#patternaccuracydescriptor-dictionary)+data PatternAccuracyDescriptor = PatternAccuracyDescriptor+  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-patternaccuracydescriptor-mincomplexity)+    -- FIXME: The spec declares this as an unsigned long, but the blob they+    -- provide has a value in it (34359738368) that doesn't fit into an+    -- unsigned long. See <https://github.com/tweag/webauthn/issues/68>.+    minComplexity :: IDL.UnsignedLongLong,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-patternaccuracydescriptor-maxretries)+    maxRetries :: Maybe IDL.UnsignedShort,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-patternaccuracydescriptor-blockslowdown)+    blockSlowdown :: Maybe IDL.UnsignedShort+  }+  deriving (Show, Eq, Generic)+  deriving (Aeson.FromJSON, Aeson.ToJSON) via JSONEncoding PatternAccuracyDescriptor++-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#verificationmethoddescriptor-dictionary)+data VerificationMethodDescriptor = VerificationMethodDescriptor+  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-verificationmethoddescriptor-userverificationmethod)+    userVerificationMethod :: Registry.UserVerificationMethod,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-verificationmethoddescriptor-cadesc)+    caDesc :: Maybe CodeAccuracyDescriptor,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-verificationmethoddescriptor-badesc)+    baDesc :: Maybe BiometricAccuracyDescriptor,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-verificationmethoddescriptor-padesc)+    paDesc :: Maybe PatternAccuracyDescriptor+  }+  deriving (Show, Eq, Generic)+  deriving (Aeson.FromJSON, Aeson.ToJSON) via JSONEncoding VerificationMethodDescriptor++-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#verificationmethodandcombinations-typedef)+newtype VerificationMethodANDCombinations = VerificationMethodANDCombinations (NonEmpty VerificationMethodDescriptor)+  deriving (Show, Eq)+  deriving newtype (Aeson.FromJSON, Aeson.ToJSON)++-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#rgbpaletteentry-dictionary)+data RgbPaletteEntry = RgbPaletteEntry+  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-rgbpaletteentry-r)+    r :: IDL.UnsignedShort,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-rgbpaletteentry-g)+    g :: IDL.UnsignedShort,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-rgbpaletteentry-b)+    b :: IDL.UnsignedShort+  }+  deriving (Show, Eq, Generic)+  deriving (Aeson.FromJSON, Aeson.ToJSON) via JSONEncoding RgbPaletteEntry++-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#displaypngcharacteristicsdescriptor-dictionary)+data DisplayPNGCharacteristicsDescriptor = DisplayPNGCharacteristicsDescriptor+  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-displaypngcharacteristicsdescriptor-width)+    width :: IDL.UnsignedLong,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-displaypngcharacteristicsdescriptor-height)+    height :: IDL.UnsignedLong,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-displaypngcharacteristicsdescriptor-bitdepth)+    bitDepth :: IDL.Octet,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-displaypngcharacteristicsdescriptor-colortype)+    colorType :: IDL.Octet,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-displaypngcharacteristicsdescriptor-compression)+    compression :: IDL.Octet,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-displaypngcharacteristicsdescriptor-filter)+    filter :: IDL.Octet,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-displaypngcharacteristicsdescriptor-interlace)+    interlace :: IDL.Octet,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-displaypngcharacteristicsdescriptor-plte)+    plte :: Maybe (NonEmpty RgbPaletteEntry)+  }+  deriving (Show, Eq, Generic)+  deriving (Aeson.FromJSON, Aeson.ToJSON) via JSONEncoding DisplayPNGCharacteristicsDescriptor++-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#ecdaatrustanchor-dictionary)+data EcdaaTrustAnchor = EcdaaTrustAnchor+  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-ecdaatrustanchor-x)+    litX :: IDL.DOMString,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-ecdaatrustanchor-y)+    litY :: IDL.DOMString,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-ecdaatrustanchor-c)+    c :: IDL.DOMString,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-ecdaatrustanchor-sx)+    sx :: IDL.DOMString,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-ecdaatrustanchor-sy)+    sy :: IDL.DOMString,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-ecdaatrustanchor-g1curve)+    litG1Curve :: IDL.DOMString+  }+  deriving (Show, Eq, Generic)+  deriving (Aeson.FromJSON, Aeson.ToJSON) via JSONEncoding EcdaaTrustAnchor++-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#extensiondescriptor-dictionary)+data ExtensionDescriptor = ExtensionDescriptor+  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-extensiondescriptor-id)+    id :: IDL.DOMString,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-extensiondescriptor-tag)+    tag :: Maybe IDL.UnsignedShort,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-extensiondescriptor-data)+    litdata :: Maybe IDL.DOMString,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-extensiondescriptor-fail_if_unknown)+    fail_if_unknown :: IDL.Boolean+  }+  deriving (Show, Eq, Generic)+  deriving (Aeson.FromJSON, Aeson.ToJSON) via JSONEncoding ExtensionDescriptor++-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#alternativedescriptions-dictionary)+-- TODO: Replace Text with+-- <https://hackage.haskell.org/package/aeson-2.0.2.0/docs/Data-Aeson-Key.html#t:Key>+-- when updating aeson. Updating aeson is currently blocked by+-- <https://github.com/fumieval/deriving-aeson/issues/16>.+newtype AlternativeDescriptions = AlternativeDescriptions (Map Text IDL.DOMString)+  deriving (Show, Eq)+  deriving newtype (Aeson.FromJSON, Aeson.ToJSON)++-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#authenticatorgetinfo-dictionary)+newtype AuthenticatorGetInfo+  = -- TODO: Replace Text with+    -- <https://hackage.haskell.org/package/aeson-2.0.2.0/docs/Data-Aeson-Key.html#t:Key>+    -- when updating aeson. Updating aeson is currently blocked by+    -- <https://github.com/fumieval/deriving-aeson/issues/16>.+    -- FIXME: The spec wrongfully declares the values to be DOMString's when+    -- they really aren't in the provided blob. See:+    -- <https://github.com/tweag/webauthn/issues/68>+    AuthenticatorGetInfo (Map Text Aeson.Value)+  deriving (Show, Eq)+  deriving newtype (Aeson.FromJSON, Aeson.ToJSON)++-- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#metadata-keys)+data MetadataStatement = MetadataStatement+  { -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-legalheader)+    legalHeader :: IDL.DOMString,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-aaid)+    aaid :: Maybe UAF.AAID,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-aaguid)+    aaguid :: Maybe AAGUID,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-attestationcertificatekeyidentifiers)+    attestationCertificateKeyIdentifiers :: Maybe (NonEmpty UAF.KeyIdentifier),+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-description)+    description :: IDL.DOMString,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-alternativedescriptions)+    alternativeDescriptions :: Maybe AlternativeDescriptions,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-authenticatorversion)+    authenticatorVersion :: IDL.UnsignedLong,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-protocolfamily)+    protocolFamily :: ProtocolFamily,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-schema)+    schema :: IDL.UnsignedShort,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-upv)+    upv :: NonEmpty UAF.Version,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-authenticationalgorithms)+    authenticationAlgorithms :: NonEmpty Registry.AuthenticationAlgorithm,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-publickeyalgandencodings)+    publicKeyAlgAndEncodings :: NonEmpty Registry.PublicKeyRepresentationFormat,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-attestationtypes)+    attestationTypes :: NonEmpty Registry.AuthenticatorAttestationType,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-userverificationdetails)+    userVerificationDetails :: NonEmpty VerificationMethodANDCombinations,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-keyprotection)+    keyProtection :: NonEmpty Registry.KeyProtectionType,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-iskeyrestricted)+    isKeyRestricted :: Maybe IDL.Boolean,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-isfreshuserverificationrequired)+    isFreshUserVerificationRequired :: Maybe IDL.Boolean,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-matcherprotection)+    matcherProtection :: NonEmpty Registry.MatcherProtectionType,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-cryptostrength)+    cryptoStrength :: Maybe IDL.UnsignedShort,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-attachmenthint)+    attachmentHint :: NonEmpty Registry.AuthenticatorAttachmentHint,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-tcdisplay)+    tcDisplay :: [Registry.TransactionConfirmationDisplayType],+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-tcdisplaycontenttype)+    tcDisplayContentType :: Maybe IDL.DOMString,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-tcdisplaypngcharacteristics)+    tcDisplayPNGCharacteristics :: Maybe (NonEmpty DisplayPNGCharacteristicsDescriptor),+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-attestationrootcertificates)+    attestationRootCertificates :: [IDL.DOMString],+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-ecdaatrustanchors)+    ecdaaTrustAnchors :: Maybe (NonEmpty EcdaaTrustAnchor),+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-icon)+    icon :: Maybe IDL.DOMString,+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-supportedextensions)+    supportedExtensions :: Maybe (NonEmpty ExtensionDescriptor),+    -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-authenticatorgetinfo)+    authenticatorGetInfo :: Maybe AuthenticatorGetInfo+  }+  deriving (Show, Eq, Generic)+  deriving (Aeson.FromJSON, Aeson.ToJSON) via JSONEncoding MetadataStatement++-- | Possible FIDO protocol families for 'protocolFamily'+data ProtocolFamily+  = ProtocolFamilyUAF+  | ProtocolFamilyU2F+  | ProtocolFamilyFIDO2+  deriving (Show, Eq, Generic)+  deriving (Aeson.FromJSON, Aeson.ToJSON) via EnumJSONEncoding "ProtocolFamily" ProtocolFamily

@@ -0,0 +1,38 @@+-- | Stability: experimental+-- Types related to the FIDO UAF Protocol as defined in the relevant+-- [(spec)](https://fidoalliance.org/specs/fido-uaf-v1.2-ps-20201020/fido-uaf-protocol-v1.2-ps-20201020.html)+module Crypto.WebAuthn.Metadata.UAF+  ( AAID (..),+    KeyIdentifier (..),+    Version (..),+  )+where++import Crypto.WebAuthn.Internal.Utils (JSONEncoding)+import qualified Crypto.WebAuthn.WebIDL as IDL+import qualified Data.Aeson as Aeson+import Data.Text (Text)+import qualified Deriving.Aeson as Aeson+import GHC.Generics (Generic)++-- | [(spec)](https://fidoalliance.org/specs/fido-uaf-v1.2-ps-20201020/fido-uaf-protocol-v1.2-ps-20201020.html#authenticator-attestation-id-aaid-typedef)+newtype AAID = AAID Text+  deriving (Show, Eq)+  deriving newtype (Aeson.FromJSON, Aeson.ToJSON)++-- | Hex string, this value MUST be calculated according to method 1 for+-- computing the keyIdentifier as defined in+-- [RFC5280 section 4.2.1.2](https://datatracker.ietf.org/doc/html/rfc5280#section-4.2.1.2).+newtype KeyIdentifier = KeyIdentifier Text+  deriving (Show, Eq)+  deriving newtype (Aeson.FromJSON, Aeson.ToJSON)++-- | [(spec)](https://fidoalliance.org/specs/fido-uaf-v1.2-ps-20201020/fido-uaf-protocol-v1.2-ps-20201020.html#version-interface)+data Version = Version+  { -- | [(spec)](https://fidoalliance.org/specs/fido-uaf-v1.2-ps-20201020/fido-uaf-protocol-v1.2-ps-20201020.html#widl-Version-major)+    major :: IDL.UnsignedShort,+    -- | [(spec)](https://fidoalliance.org/specs/fido-uaf-v1.2-ps-20201020/fido-uaf-protocol-v1.2-ps-20201020.html#widl-Version-minor)+    minor :: IDL.UnsignedShort+  }+  deriving (Show, Eq, Generic)+  deriving (Aeson.FromJSON, Aeson.ToJSON) via JSONEncoding Version

@@ -0,0 +1,37 @@+{-# OPTIONS_GHC -Wno-missing-import-lists #-}++-- | Stability: experimental+-- A set of types representing credential options ('CredentialOptions')+-- and their resulting credentials responses ('Credential').+--+-- Also includes a set of functions for indirectly encoding credential+-- options to JSON ('encodeCredentialOptionsRegistration',+-- 'encodeCredentialOptionsAuthentication') and indirectly decoding+-- credential responses from JSON ('decodeCredentialRegistration',+-- 'decodeCredentialAuthentication'), using the same encoding as+-- [webauthn-json](https://github.com/github/webauthn-json) which can be+-- used on the JavaScript side.+--+-- The types in this module form one way the library represents the WebAuthn+-- types, another are the internal WebIDL modules, which is a lower-level, more+-- one-to-one mapping. As a user of the library, you will most likely use the+-- representation in this module over the one in the WebIDL modules.+--+-- This module is reexported by the "Crypto.WebAuthn" module, which is the+-- preferred way of using it.+module Crypto.WebAuthn.Model+  ( module Crypto.WebAuthn.Model.Identifier,+    module Crypto.WebAuthn.Model.Kinds,+    module Crypto.WebAuthn.Model.Types,+    module Crypto.WebAuthn.Model.WebIDL,+    module Crypto.WebAuthn.Cose.Algorithm,+    module Crypto.WebAuthn.Cose.Key,+  )+where++import Crypto.WebAuthn.Cose.Algorithm+import Crypto.WebAuthn.Cose.Key+import Crypto.WebAuthn.Model.Identifier+import Crypto.WebAuthn.Model.Kinds+import Crypto.WebAuthn.Model.Types+import Crypto.WebAuthn.Model.WebIDL

@@ -0,0 +1,77 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE StandaloneDeriving #-}++-- | Stability: experimental+-- This module concerns identification of authenticatiors, notably 'AAGUID',+-- 'SubjectKeyIdentifier' and a generic identifier type 'AuthenticatorIdentifier'+module Crypto.WebAuthn.Model.Identifier+  ( AuthenticatorIdentifier (..),+    AAGUID (..),+    SubjectKeyIdentifier (..),+  )+where++import Crypto.Hash (Digest, SHA1)+import Crypto.WebAuthn.Internal.ToJSONOrphans ()+import qualified Crypto.WebAuthn.Model.Kinds as M+import Data.Aeson (KeyValue ((.=)), ToJSON (toJSON), Value (String), object)+import Data.ByteArray (convert)+import qualified Data.ByteString as BS+import Data.Hashable (Hashable (hashWithSalt), hashUsing)+import Data.UUID (UUID)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#aaguid)+newtype AAGUID = AAGUID {unAAGUID :: UUID}+  deriving (Eq, Show)+  deriving newtype (Hashable, ToJSON)++-- | A way to identify an authenticator+data AuthenticatorIdentifier (p :: M.ProtocolKind) where+  -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-aaguid)+  -- A known FIDO2 [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator),+  -- identified by a 'AAGUID'. Note that the 'AAGUID' may be zero, meaning that+  -- we were able to verify that the [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential).+  -- was generated by a trusted [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator),+  -- but we don't know which model it is.+  AuthenticatorIdentifierFido2 ::+    {idAaguid :: AAGUID} ->+    AuthenticatorIdentifier 'M.Fido2+  -- | [(spec)](https://fidoalliance.org/specs/mds/fido-metadata-statement-v3.0-ps-20210518.html#dom-metadatastatement-attestationcertificatekeyidentifiers)+  -- A known FIDO U2F [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator),+  -- identified by a 'SubjectKeyIdentifier'. Clients that don't implement CTAP2+  -- (which is used to communicate with FIDO2 authenticators) will use U2F to+  -- communicate with the authenticator instead, which doesn't have support for 'AAGUID's.+  AuthenticatorIdentifierFidoU2F ::+    {idSubjectKeyIdentifier :: SubjectKeyIdentifier} ->+    AuthenticatorIdentifier 'M.FidoU2F++deriving instance Show (AuthenticatorIdentifier p)++deriving instance Eq (AuthenticatorIdentifier p)++instance ToJSON (AuthenticatorIdentifier p) where+  toJSON (AuthenticatorIdentifierFido2 aaguid) =+    object+      [ "tag" .= String "AuthenticatorIdentifierFido2",+        "idAaguid" .= aaguid+      ]+  toJSON (AuthenticatorIdentifierFidoU2F subjectKeyIdentifier) =+    object+      [ "tag" .= String "AuthenticatorIdentifierFidoU2F",+        "idSubjectKeyIdentifier" .= subjectKeyIdentifier+      ]++-- | [(spec)](https://datatracker.ietf.org/doc/html/rfc5280#section-4.2.1.2)+-- This type represents method 1 of computing the identifier, as used in the+-- [attestationCertificateKeyIdentifiers](https://fidoalliance.org/specs/mds/fido-metadata-service-v3.0-ps-20210518.html#dom-metadatablobpayloadentry-attestationcertificatekeyidentifiers)+-- field of the [Metadata Service](https://fidoalliance.org/metadata/)+newtype SubjectKeyIdentifier = SubjectKeyIdentifier {unSubjectKeyIdentifier :: Digest SHA1}+  deriving (Eq, Show)++instance ToJSON SubjectKeyIdentifier where+  toJSON = toJSON @BS.ByteString . convert . unSubjectKeyIdentifier++instance Hashable SubjectKeyIdentifier where+  hashWithSalt = hashUsing @BS.ByteString (convert . unSubjectKeyIdentifier)

@@ -0,0 +1,141 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}++-- | Stability: experimental+-- This module contains some useful kinds used throughout this library to+-- ensure better type safety. Also included are some singleton types for these+-- kinds via the [singletons](https://hackage.haskell.org/package/singletons)+-- library+module Crypto.WebAuthn.Model.Kinds+  ( CeremonyKind (..),+    SCeremonyKind (..),+    ProtocolKind (..),+    SProtocolKind (..),+    AttestationKind (..),+  )+where++import Data.Aeson (ToJSON, toJSON)+import Data.Kind (Type)+import Data.Singletons (Sing, SingI (sing))++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#ceremony)+-- A Haskell kind for a Webauthn [ceremony](https://www.w3.org/TR/webauthn-2/#ceremony).+-- This is used throughout this library for extra type safety and API clarity.+data CeremonyKind+  = -- | [(spec)](https://www.w3.org/TR/webauthn-2/#registration)+    -- The [ceremony](https://www.w3.org/TR/webauthn-2/#ceremony) where a user,+    -- a [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party), and+    -- the user’s [client](https://www.w3.org/TR/webauthn-2/#client) (containing+    -- at least one [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator))+    -- work in concert to create a+    -- [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential)+    -- and associate it with the user’s [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)+    -- account. Note that this includes employing a+    -- [test of user presence](https://www.w3.org/TR/webauthn-2/#test-of-user-presence)+    -- or [user verification](https://www.w3.org/TR/webauthn-2/#user-verification).+    -- After a successful [registration ceremony](https://www.w3.org/TR/webauthn-2/#registration-ceremony),+    -- the user can be authenticated by an+    -- [authentication ceremony](https://www.w3.org/TR/webauthn-2/#authentication-ceremony).+    -- The WebAuthn [registration ceremony](https://www.w3.org/TR/webauthn-2/#registration-ceremony) is defined in+    -- [§ 7.1 Registering a New Credential](https://www.w3.org/TR/webauthn-2/#sctn-registering-a-new-credential),+    -- and is initiated by the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party) calling+    -- [@navigator.credentials.create()@](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-create)+    -- with a [@publicKey@](https://www.w3.org/TR/webauthn-2/#dom-credentialcreationoptions-publickey) argument.+    -- See [§ 5 Web Authentication API](https://www.w3.org/TR/webauthn-2/#sctn-api) for an introductory+    -- overview and [§ 1.3.1 Registration](https://www.w3.org/TR/webauthn-2/#sctn-sample-registration)+    -- for implementation examples.+    Registration+  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#authentication)+    -- The [ceremony](https://www.w3.org/TR/webauthn-2/#ceremony) where a user,+    -- and the user’s [client](https://www.w3.org/TR/webauthn-2/#client) (containing+    -- at least one [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)) work in concert+    -- to cryptographically prove to a [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)+    -- that the user controls the+    -- [credential private key](https://www.w3.org/TR/webauthn-2/#credential-private-key)+    -- of a previously-registered [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential)+    -- (see [Registration](https://www.w3.org/TR/webauthn-2/#registration)).+    -- Note that this includes a [test of user presence](https://www.w3.org/TR/webauthn-2/#test-of-user-presence)+    -- or [user verification](https://www.w3.org/TR/webauthn-2/#user-verification).+    --+    -- The WebAuthn [authentication ceremony](https://www.w3.org/TR/webauthn-2/#authentication-ceremony)+    -- is defined in [§ 7.2 Verifying an Authentication Assertion](https://www.w3.org/TR/webauthn-2/#sctn-verifying-assertion),+    -- and is initiated by the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party) calling+    -- [@navigator.credentials.get()@](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get)+    -- with a [@publicKey@](https://www.w3.org/TR/webauthn-2/#dom-credentialrequestoptions-publickey)+    -- argument. See [§ 5 Web Authentication API](https://www.w3.org/TR/webauthn-2/#sctn-api)+    -- for an introductory overview and+    -- [§ 1.3.3 Authentication](https://www.w3.org/TR/webauthn-2/#sctn-sample-authentication) for implementation examples.+    Authentication++-- | The singleton type for 'CeremonyKind'+data SCeremonyKind :: CeremonyKind -> Type where+  SRegistration :: SCeremonyKind 'Registration+  SAuthentication :: SCeremonyKind 'Authentication++deriving instance Show (SCeremonyKind c)++deriving instance Eq (SCeremonyKind c)++instance ToJSON (SCeremonyKind c) where+  toJSON SRegistration = "Registration"+  toJSON SAuthentication = "Authentication"++type instance Sing = SCeremonyKind++instance SingI 'Registration where+  sing = SRegistration++instance SingI 'Authentication where+  sing = SAuthentication++-- | Authenticator protocols supported by webauthn attestations+data ProtocolKind+  = -- | FIDO U2F Protocol, supported via the+    -- [fido-u2f](https://www.w3.org/TR/webauthn-2/#sctn-fido-u2f-attestation)+    -- attestation format+    FidoU2F+  | -- | FIDO 2 Protocol+    Fido2++-- | The singleton type for 'ProtocolKind'+data SProtocolKind :: ProtocolKind -> Type where+  SFidoU2F :: SProtocolKind 'FidoU2F+  SFido2 :: SProtocolKind 'Fido2++deriving instance Show (SProtocolKind p)++deriving instance Eq (SProtocolKind p)++instance ToJSON (SProtocolKind p) where+  toJSON SFidoU2F = "FidoU2F"+  toJSON SFido2 = "Fido2"++type instance Sing = SProtocolKind++instance SingI 'FidoU2F where+  sing = SFidoU2F++instance SingI 'Fido2 where+  sing = SFido2++-- | A Haskell kind for the [attestation type](https://www.w3.org/TR/webauthn-2/#attestation-type),+-- indicating whether we have verifiable information about the+-- [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator) that created+-- the [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential).+data AttestationKind+  = -- | An unverifiable [attestation type](https://www.w3.org/TR/webauthn-2/#attestation-type).+    -- This includes [None](https://www.w3.org/TR/webauthn-2/#none)+    -- and [Self](https://www.w3.org/TR/webauthn-2/#self-attestation) attestation.+    -- This kind indicates that we do not have any information about the+    -- [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator) model used.+    Unverifiable+  | -- | A verifiable [attestation type](https://www.w3.org/TR/webauthn-2/#attestation-type).+    -- This includes [Basic](https://www.w3.org/TR/webauthn-2/#basic-attestation),+    -- [AttCA](https://www.w3.org/TR/webauthn-2/#attca) and+    -- [AnonCA](https://www.w3.org/TR/webauthn-2/#anonca) attestation.+    -- This kind indicates that we have verifiable information about the+    -- [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator) model used.+    Verifiable ProtocolKind

@@ -0,0 +1,1350 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}++-- | Stability: experimental+-- This module contains the same top-level definitions as 'Crypto.WebAuthn.Client.JavaScript',+-- but with the types containing a more Haskell-friendly structure.+--+-- Note: The 'ToJSON' instances of these types are for pretty-printing purposes+-- only.+--+-- #extensions#+-- TODO:+-- [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-extensions) This library+-- does not currently implement extensions. In order to fully comply with level+-- 2 of the webauthn spec extensions are required. At least, we wish the+-- library to offer a typeclass implementable by relying parties to allow+-- extensions in a scheme similar to the attestation statement formats.+-- Ideally, we would implement all 8 extensions tracked by+-- [IANA](https://www.iana.org/assignments/webauthn/webauthn.xhtml#webauthn-extension-ids).+module Crypto.WebAuthn.Model.Types+  ( -- * Enumerations+    CredentialType (..),+    AuthenticatorTransport (..),+    AuthenticatorAttachment (..),+    ResidentKeyRequirement (..),+    UserVerificationRequirement (..),+    AttestationConveyancePreference (..),+    AttestationChain (..),+    AttestationKind (..),+    AttestationType (..),+    VerifiableAttestationType (..),++    -- * Newtypes+    RpId (..),+    RelyingPartyName (..),+    UserHandle (..),+    generateUserHandle,+    UserAccountDisplayName (..),+    UserAccountName (..),+    CredentialId (..),+    generateCredentialId,+    Challenge (..),+    generateChallenge,+    Timeout (..),+    AssertionSignature (..),+    RpIdHash (..),+    ClientDataHash (..),+    Origin (..),+    SignatureCounter (..),+    PublicKeyBytes (..),++    -- * Extensions (unimplemented, see module documentation)+    AuthenticationExtensionsClientInputs (..),+    AuthenticationExtensionsClientOutputs (..),+    AuthenticatorExtensionOutputs (..),++    -- * Dictionaries+    CredentialRpEntity (..),+    CredentialUserEntity (..),+    CredentialParameters (..),+    CredentialDescriptor (..),+    AuthenticatorSelectionCriteria (..),+    AuthenticatorDataFlags (..),+    CollectedClientData (..),+    AttestedCredentialData (..),+    AuthenticatorData (..),+    AttestationObject (..),+    AuthenticatorResponse (..),++    -- * Attestation Statement Formats+    SomeAttestationType (..),+    AttestationStatementFormat (..),+    SomeAttestationStatementFormat (..),+    SupportedAttestationStatementFormats,+    singletonAttestationStatementFormat,+    lookupAttestationStatementFormat,++    -- * Raw fields+    RawField (..),++    -- * Top-level types+    CredentialOptions (..),+    Credential (..),+    stripRawCredential,+  )+where++import qualified Codec.CBOR.Term as CBOR+import Control.Exception (Exception)+import Crypto.Hash (Digest)+import Crypto.Hash.Algorithms (SHA256)+import Crypto.Random (MonadRandom, getRandomBytes)+import qualified Crypto.WebAuthn.Cose.Algorithm as Cose+import qualified Crypto.WebAuthn.Cose.Key as Cose+import Crypto.WebAuthn.Internal.ToJSONOrphans ()+import Crypto.WebAuthn.Model.Identifier (AAGUID)+import Crypto.WebAuthn.Model.Kinds+  ( AttestationKind (Unverifiable, Verifiable),+    CeremonyKind (Authentication, Registration),+    ProtocolKind (Fido2, FidoU2F),+    SCeremonyKind (SAuthentication, SRegistration),+  )+import Data.Aeson (ToJSON, Value (Null, String), object, (.=))+import Data.Aeson.Types (toJSON)+import qualified Data.ByteString as BS+import Data.HashMap.Strict (HashMap, (!?))+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Hourglass as HG+import Data.Kind (Type)+import Data.List.NonEmpty (NonEmpty)+import Data.Singletons (SingI, sing)+import Data.String (IsString)+import Data.Text (Text)+import Data.Validation (Validation)+import Data.Word (Word32)+import qualified Data.X509 as X509+import qualified Data.X509.CertificateStore as X509+import GHC.Generics (Generic)+import Type.Reflection (Typeable, eqTypeRep, typeOf, type (:~~:) (HRefl))++-- | A model field parametrized by whether it's empty ('False') or contains raw bytes ('True')+data RawField (raw :: Bool) where+  NoRaw :: RawField 'False+  WithRaw :: {unRaw :: BS.ByteString} -> RawField 'True++deriving instance Eq (RawField raw)++deriving instance Show (RawField raw)++instance ToJSON (RawField raw) where+  toJSON NoRaw = "<none>"+  toJSON (WithRaw bytes) = toJSON bytes++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enumdef-publickeycredentialtype)+-- This enumeration defines the valid credential types. It is an extension point;+-- values can be added to it in the future, as more credential types are defined.+-- The values of this enumeration are used for versioning the Authentication Assertion+-- and attestation structures according to the type of the authenticator.+data CredentialType = CredentialTypePublicKey+  deriving (Eq, Show, Bounded, Enum, Ord, Generic)++instance ToJSON CredentialType where+  toJSON CredentialTypePublicKey = "CredentialTypePublicKey"++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enum-transport)+-- [Authenticators](https://www.w3.org/TR/webauthn-2/#authenticator) may implement+-- various [transports](https://www.w3.org/TR/webauthn-2/#enum-transport) for communicating+-- with [clients](https://www.w3.org/TR/webauthn-2/#client). This enumeration defines+-- hints as to how clients might communicate with a particular authenticator in order+-- to obtain an assertion for a specific credential. Note that these hints represent+-- the [WebAuthn Relying Party](https://www.w3.org/TR/webauthn-2/#webauthn-relying-party)'s+-- best belief as to how an authenticator may be reached. A [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)+-- will typically learn of the supported transports for a [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential)+-- via [getTransports()](https://www.w3.org/TR/webauthn-2/#dom-authenticatorattestationresponse-gettransports).+data AuthenticatorTransport+  = -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatortransport-usb)+    -- Indicates the respective [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)+    -- can be contacted over removable USB.+    AuthenticatorTransportUSB+  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatortransport-nfc)+    -- Indicates the respective [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)+    -- can be contacted over Near Field Communication (NFC).+    AuthenticatorTransportNFC+  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatortransport-ble)+    -- Indicates the respective [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)+    -- can be contacted over Bluetooth Smart (Bluetooth Low Energy / BLE).+    AuthenticatorTransportBLE+  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatortransport-internal)+    -- Indicates the respective [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)+    -- is contacted using a [client device](https://www.w3.org/TR/webauthn-2/#client-device)-specific+    -- transport, i.e., it is a [platform authenticator](https://www.w3.org/TR/webauthn-2/#platform-authenticators).+    -- These authenticators are not removable from the [client device](https://www.w3.org/TR/webauthn-2/#client-device).+    AuthenticatorTransportInternal+  deriving (Eq, Show, Bounded, Enum, Ord, Generic, ToJSON)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enumdef-authenticatorattachment)+-- This enumeration’s values describe [authenticators](https://www.w3.org/TR/webauthn-2/#authenticator)'+-- [attachment modalities](https://www.w3.org/TR/webauthn-2/#authenticator-attachment-modality).+-- [Relying Parties](https://www.w3.org/TR/webauthn-2/#relying-party) use this to+-- express a preferred [authenticator attachment modality](https://www.w3.org/TR/webauthn-2/#authenticator-attachment-modality)+-- when calling [@navigator.credentials.create()@](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-create)+-- to [create a credential](https://www.w3.org/TR/webauthn-2/#sctn-createCredential).+data AuthenticatorAttachment+  = -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorattachment-platform)+    -- This value indicates [platform attachment](https://www.w3.org/TR/webauthn-2/#platform-attachment).+    AuthenticatorAttachmentPlatform+  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorattachment-cross-platform)+    -- This value indicates [cross-platform attachment](https://www.w3.org/TR/webauthn-2/#cross-platform-attachment).+    AuthenticatorAttachmentCrossPlatform+  deriving (Eq, Show, Bounded, Enum, Ord, Generic, ToJSON)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enumdef-residentkeyrequirement)+-- This enumeration’s values describe the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)'s+-- requirements for [client-side discoverable credentials](https://www.w3.org/TR/webauthn-2/#client-side-discoverable-credential)+-- (formerly known as [resident credentials](https://www.w3.org/TR/webauthn-2/#resident-credential)+-- or [resident keys](https://www.w3.org/TR/webauthn-2/#resident-key)):+data ResidentKeyRequirement+  = -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-residentkeyrequirement-discouraged)+    -- This value indicates the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)+    -- prefers creating a [server-side credential](https://www.w3.org/TR/webauthn-2/#server-side-credential),+    -- but will accept a [client-side discoverable credential](https://www.w3.org/TR/webauthn-2/#client-side-discoverable-credential).+    ResidentKeyRequirementDiscouraged+  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-residentkeyrequirement-preferred)+    -- This value indicates the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)+    -- strongly prefers [creating a client-side discoverable credential](https://www.w3.org/TR/webauthn-2/#client-side-discoverable-credential),+    -- but will accept a [server-side credential](https://www.w3.org/TR/webauthn-2/#server-side-credential).+    -- For example, user agents SHOULD guide the user through setting up [user verification](https://www.w3.org/TR/webauthn-2/#user-verification)+    -- if needed to create a [client-side discoverable credential](https://www.w3.org/TR/webauthn-2/#client-side-discoverable-credential)+    -- in this case. This takes precedence over the setting of 'coaUserVerification'.+    ResidentKeyRequirementPreferred+  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-residentkeyrequirement-required)+    -- This value indicates the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)+    -- requires a [client-side discoverable credential](https://www.w3.org/TR/webauthn-2/#client-side-discoverable-credential),+    -- and is prepared to receive an error if a+    -- [client-side discoverable credential](https://www.w3.org/TR/webauthn-2/#client-side-discoverable-credential) cannot be created.+    ResidentKeyRequirementRequired+  deriving (Eq, Show, Bounded, Enum, Ord, Generic, ToJSON)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enum-userVerificationRequirement)+-- A [WebAuthn Relying Party](https://www.w3.org/TR/webauthn-2/#webauthn-relying-party) may+-- require [user verification](https://www.w3.org/TR/webauthn-2/#user-verification) for some+-- of its operations but not for others, and may use this type to express its needs.+data UserVerificationRequirement+  = -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-userverificationrequirement-required)+    -- This value indicates that the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)+    -- requires [user verification](https://www.w3.org/TR/webauthn-2/#user-verification) for the+    -- operation and will fail the operation if the response does not have the+    -- [UV](https://www.w3.org/TR/webauthn-2/#uv) [flag](https://www.w3.org/TR/webauthn-2/#flags) set.+    UserVerificationRequirementRequired+  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-userverificationrequirement-preferred)+    -- This value indicates that the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)+    -- prefers [user verification](https://www.w3.org/TR/webauthn-2/#user-verification) for the+    -- operation if possible, but will not fail the operation if the response does not have the+    -- [UV](https://www.w3.org/TR/webauthn-2/#uv) [flag](https://www.w3.org/TR/webauthn-2/#flags) set.+    UserVerificationRequirementPreferred+  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-userverificationrequirement-discouraged)+    -- This value indicates that the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)+    -- does not want [user verification](https://www.w3.org/TR/webauthn-2/#user-verification) employed+    -- during the operation (e.g., in the interest of minimizing disruption to the user interaction flow).+    UserVerificationRequirementDiscouraged+  deriving (Eq, Show, Bounded, Enum, Ord, Generic, ToJSON)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enum-attestation-convey)+-- [WebAuthn Relying Parties](https://www.w3.org/TR/webauthn-2/#webauthn-relying-party) may use+-- [AttestationConveyancePreference](https://www.w3.org/TR/webauthn-2/#enumdef-attestationconveyancepreference)+-- to specify their preference regarding+-- [attestation conveyance](https://www.w3.org/TR/webauthn-2/#attestation-conveyance) during credential generation.+data AttestationConveyancePreference+  = -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-attestationconveyancepreference-none)+    -- This value indicates that the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)+    -- is not interested in [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)+    -- [attestation](https://www.w3.org/TR/webauthn-2/#attestation). For example, in order to+    -- potentially avoid having to obtain [user consent](https://www.w3.org/TR/webauthn-2/#user-consent)+    -- to relay identifying information to the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party),+    -- or to save a roundtrip to an [Attestation CA](https://www.w3.org/TR/webauthn-2/#attestation-ca)+    -- or [Anonymization CA](https://www.w3.org/TR/webauthn-2/#anonymization-ca). This is the default value.+    AttestationConveyancePreferenceNone+  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-attestationconveyancepreference-indirect)+    -- This value indicates that the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)+    -- prefers an [attestation](https://www.w3.org/TR/webauthn-2/#attestation) conveyance yielding+    -- verifiable [attestation statements](https://www.w3.org/TR/webauthn-2/#attestation-statement),+    -- but allows the client to decide how to obtain such+    -- [attestation statements](https://www.w3.org/TR/webauthn-2/#attestation-statement).+    -- The client MAY replace the authenticator-generated [attestation statements](https://www.w3.org/TR/webauthn-2/#attestation-statement)+    -- with [attestation statements](https://www.w3.org/TR/webauthn-2/#attestation-statement)+    -- generated by an [Anonymization CA](https://www.w3.org/TR/webauthn-2/#anonymization-ca),+    -- in order to protect the user’s privacy, or to assist [Relying Parties](https://www.w3.org/TR/webauthn-2/#relying-party)+    -- with attestation verification in a heterogeneous ecosystem.+    --+    -- Note: There is no guarantee that the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)+    -- will obtain a verifiable [attestation statement](https://www.w3.org/TR/webauthn-2/#attestation-statement)+    -- in this case. For example, in the case that the authenticator employs+    -- [self attestation](https://www.w3.org/TR/webauthn-2/#self-attestation).+    AttestationConveyancePreferenceIndirect+  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-attestationconveyancepreference-direct)+    -- This value indicates that the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)+    -- wants to receive the [attestation statement](https://www.w3.org/TR/webauthn-2/#attestation-statement)+    -- as generated by the [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator).+    AttestationConveyancePreferenceDirect+  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-attestationconveyancepreference-enterprise)+    -- This value indicates that the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)+    -- wants to receive an [attestation statement](https://www.w3.org/TR/webauthn-2/#attestation-statement)+    -- that may include uniquely identifying information. This is intended for controlled deployments+    -- within an enterprise where the organization wishes to tie registrations to specific authenticators.+    -- User agents MUST NOT provide such an attestation unless the user agent or authenticator configuration+    -- permits it for the requested 'RpId'.+    --+    -- If permitted, the user agent SHOULD signal to the authenticator+    -- (at [invocation time](https://www.w3.org/TR/webauthn-2/#CreateCred-InvokeAuthnrMakeCred))+    -- that enterprise attestation is requested, and convey the resulting [AAGUID](https://www.w3.org/TR/webauthn-2/#aaguid)+    -- and [attestation statement](https://www.w3.org/TR/webauthn-2/#attestation-statement), unaltered,+    -- to the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party).+    AttestationConveyancePreferenceEnterprise+  deriving (Eq, Show, Bounded, Enum, Ord, Generic, ToJSON)++-- | An X.509 certificate chain that can be used to verify an attestation+-- statement+data AttestationChain (p :: ProtocolKind) where+  -- | For Fido 2, we can have a chain consisting of multiple certificates.+  Fido2Chain :: NonEmpty X509.SignedCertificate -> AttestationChain 'Fido2+  -- | For Fido U2F, we can only have a single certificate, which is then also+  -- used to generate the 'Crypto.WebAuthn.Identifier.SubjectKeyIdentifier' from+  FidoU2FCert :: X509.SignedCertificate -> AttestationChain 'FidoU2F++deriving instance Eq (AttestationChain p)++deriving instance Show (AttestationChain p)++instance ToJSON (AttestationChain p) where+  toJSON (Fido2Chain chain) = toJSON chain+  toJSON (FidoU2FCert cert) = toJSON [cert]++-- | An [attestation type](https://www.w3.org/TR/webauthn-2/#attestation-type)+-- that is verifiable, indicating that we can have trusted information about+-- the [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator) that+-- created the [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential)+data VerifiableAttestationType+  = -- | [Attestation statements](https://www.w3.org/TR/webauthn-2/#attestation-statement)+    -- conveying [attestations](https://www.w3.org/TR/webauthn-2/#attestation) of+    -- [type](https://www.w3.org/TR/webauthn-2/#attestation-type)+    -- [AttCA](https://www.w3.org/TR/webauthn-2/#attca) or+    -- [AnonCA](https://www.w3.org/TR/webauthn-2/#anonca) use the same data+    -- structure as those of [type](https://www.w3.org/TR/webauthn-2/#attestation-type)+    -- [Basic](https://www.w3.org/TR/webauthn-2/#basic), so the three attestation+    -- types are, in general, distinguishable only with externally provided knowledge regarding the contents+    -- of the [attestation certificates](https://www.w3.org/TR/webauthn-2/#attestation-certificate)+    -- conveyed in the [attestation statement](https://www.w3.org/TR/webauthn-2/#attestation-statement).+    VerifiableAttestationTypeUncertain+  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#basic-attestation)+    -- In the case of basic attestation [UAFProtocol](https://www.w3.org/TR/webauthn-2/#biblio-uafprotocol),+    -- the authenticator’s [attestation key pair](https://www.w3.org/TR/webauthn-2/#attestation-key-pair)+    -- is specific to an authenticator "model", i.e., a "batch" of authenticators.+    -- Thus, authenticators of the same, or similar, model often share the same+    -- [attestation key pair](https://www.w3.org/TR/webauthn-2/#attestation-key-pair).+    -- See [§ 14.4.1 Attestation Privacy](https://www.w3.org/TR/webauthn-2/#sctn-attestation-privacy)+    -- for further information.+    VerifiableAttestationTypeBasic+  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#attca)+    -- In this case, an [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)+    -- is based on a Trusted Platform Module (TPM) and holds an authenticator-specific+    -- "endorsement key" (EK). This key is used to securely communicate with a+    -- trusted third party, the [Attestation CA](https://www.w3.org/TR/webauthn-2/#attestation-ca)+    -- [TCG-CMCProfile-AIKCertEnroll](https://www.w3.org/TR/webauthn-2/#biblio-tcg-cmcprofile-aikcertenroll)+    -- (formerly known as a "Privacy CA"). The [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)+    -- can generate multiple attestation identity key pairs (AIK) and requests an+    -- [Attestation CA](https://www.w3.org/TR/webauthn-2/#attestation-ca) to+    -- issue an AIK certificate for each. Using this approach, such an+    -- [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator) can+    -- limit the exposure of the EK (which is a global correlation handle) to+    -- Attestation CA(s). AIKs can be requested for each+    -- [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)\-generated+    -- [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential)+    -- individually, and conveyed to [Relying Parties](https://www.w3.org/TR/webauthn-2/#relying-party)+    -- as [attestation certificates](https://www.w3.org/TR/webauthn-2/#attestation-certificate).+    VerifiableAttestationTypeAttCA+  | -- | [(spec)](https://www.w3.org/TR/webauthn-2/#anonca)+    -- In this case, the [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)+    -- uses an [Anonymization CA](https://www.w3.org/TR/webauthn-2/#anonymization-ca)+    -- which dynamically generates per-[credential](https://w3c.github.io/webappsec-credential-management/#concept-credential)+    -- [attestation certificates](https://www.w3.org/TR/webauthn-2/#attestation-certificate)+    -- such that the [attestation statements](https://www.w3.org/TR/webauthn-2/#attestation-statement)+    -- presented to [Relying Parties](https://www.w3.org/TR/webauthn-2/#relying-party)+    -- do not provide uniquely identifiable information, e.g., that might be used for tracking purposes.+    VerifiableAttestationTypeAnonCA+  deriving (Eq, Show, Bounded, Enum, Ord, Generic, ToJSON)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-attestation-types)+-- WebAuthn supports several [attestation types](https://www.w3.org/TR/webauthn-2/#attestation-type),+-- defining the semantics of [attestation statements](https://www.w3.org/TR/webauthn-2/#attestation-statement)+-- and their underlying trust models:+data AttestationType (k :: AttestationKind) where+  -- | [(spec)](https://www.w3.org/TR/webauthn-2/#none)+  -- In this case, no attestation information is available. See also+  -- [§ 8.7 None Attestation Statement Format](https://www.w3.org/TR/webauthn-2/#sctn-none-attestation).+  AttestationTypeNone :: AttestationType 'Unverifiable+  -- | [(spec)](https://www.w3.org/TR/webauthn-2/#self-attestation)+  -- In the case of [self attestation](https://www.w3.org/TR/webauthn-2/#self-attestation),+  -- also known as surrogate basic attestation [UAFProtocol](https://www.w3.org/TR/webauthn-2/#biblio-uafprotocol),+  -- the Authenticator does not have any specific [attestation key pair](https://www.w3.org/TR/webauthn-2/#attestation-key-pair).+  -- Instead it uses the [credential private key](https://www.w3.org/TR/webauthn-2/#credential-private-key)+  -- to create the [attestation signature](https://www.w3.org/TR/webauthn-2/#attestation-signature).+  -- Authenticators without meaningful protection measures for an+  -- [attestation private key](https://www.w3.org/TR/webauthn-2/#attestation-private-key)+  -- typically use this attestation type.+  AttestationTypeSelf :: AttestationType 'Unverifiable+  -- | Grouping of attestations that are verifiable by a certificate chain+  AttestationTypeVerifiable ::+    { -- | The type of verifiable attestation+      atvType :: VerifiableAttestationType,+      -- | The certificate chain of this attestation type, can be used to+      -- validate the authenticator model+      atvChain :: AttestationChain p+    } ->+    AttestationType ('Verifiable p)++deriving instance Eq (AttestationType k)++deriving instance Show (AttestationType k)++instance ToJSON (AttestationType k) where+  toJSON AttestationTypeNone =+    object+      [ "tag" .= String "AttestationTypeNone"+      ]+  toJSON AttestationTypeSelf =+    object+      [ "tag" .= String "AttestationTypeSelf"+      ]+  toJSON AttestationTypeVerifiable {..} =+    object+      [ "tag" .= String "AttestationTypeVerifiable",+        "atvType" .= atvType,+        "atvChain" .= atvChain+      ]++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#rp-id)+-- A [valid domain string](https://url.spec.whatwg.org/#valid-domain-string)+-- identifying the [WebAuthn Relying Party](https://www.w3.org/TR/webauthn-2/#webauthn-relying-party)+-- on whose behalf a given [registration](https://www.w3.org/TR/webauthn-2/#registration)+-- or [authentication ceremony](https://www.w3.org/TR/webauthn-2/#authentication) is being performed.+-- A [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential)+-- can only be used for [authentication](https://www.w3.org/TR/webauthn-2/#authentication)+-- with the same entity (as identified by 'RpId') it was registered with.+--+-- By default, the 'RpId' for a WebAuthn operation is set to the caller’s+-- [origin](https://html.spec.whatwg.org/multipage/webappapis.html#concept-settings-object-origin)'s+-- [effective domain](https://html.spec.whatwg.org/multipage/origin.html#concept-origin-effective-domain).+-- This default MAY be overridden by the caller, as long as the caller-specified 'RpId' value+-- [is a registrable domain suffix of or is equal to](https://html.spec.whatwg.org/multipage/origin.html#is-a-registrable-domain-suffix-of-or-is-equal-to)+-- the caller’s [origin](https://html.spec.whatwg.org/multipage/webappapis.html#concept-settings-object-origin)'s+-- [effective domain](https://html.spec.whatwg.org/multipage/origin.html#concept-origin-effective-domain).+--+-- TODO: 'RpId' is used for both <https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrpentity-id>+-- and <https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-rpid>, but the former+-- uses DOMString, while the latter uses USVString. Is this a bug in the spec or is there an actual difference?+newtype RpId = RpId {unRpId :: Text}+  deriving (Eq, Show, Ord)+  deriving newtype (IsString, ToJSON)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialentity-name)+-- A [human-palatable](https://www.w3.org/TR/webauthn-2/#human-palatability)+-- identifier for the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party),+-- intended only for display. For example, "ACME Corporation", "Wonderful Widgets, Inc." or "ОАО Примертех".+--+-- - [Relying Parties](https://www.w3.org/TR/webauthn-2/#relying-party) SHOULD perform+-- enforcement, as prescribed in Section 2.3 of [RFC8266](https://www.w3.org/TR/webauthn-2/#biblio-rfc8266)+-- for the Nickname Profile of the PRECIS FreeformClass [RFC8264](https://www.w3.org/TR/webauthn-2/#biblio-rfc8264),+-- when setting 'RelyingPartyName's value, or displaying the value to the user.+-- - This string MAY contain language and direction metadata. [Relying Parties](https://www.w3.org/TR/webauthn-2/#relying-party)+-- SHOULD consider providing this information. See [§ 6.4.2 Language and Direction Encoding](https://www.w3.org/TR/webauthn-2/#sctn-strings-langdir)+-- about how this metadata is encoded.+newtype RelyingPartyName = RelyingPartyName {unRelyingPartyName :: Text}+  deriving (Eq, Show)+  deriving newtype (IsString, ToJSON)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#user-handle)+-- The user handle is specified by a [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party),+-- as the value of 'id', and used to [map](https://www.w3.org/TR/webauthn-2/#authenticator-credentials-map)+-- a specific [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential)+-- to a specific user account with the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party).+-- Authenticators in turn [map](https://www.w3.org/TR/webauthn-2/#authenticator-credentials-map)+-- [RP IDs](https://www.w3.org/TR/webauthn-2/#rp-id) and user handle pairs to [public key credential sources](https://www.w3.org/TR/webauthn-2/#public-key-credential-source).+-- A user handle is an opaque [byte sequence](https://infra.spec.whatwg.org/#byte-sequence)+-- with a maximum size of 64 bytes, and is not meant to be displayed to the user.+newtype UserHandle = UserHandle {unUserHandle :: BS.ByteString}+  deriving (Eq, Show, Ord)+  deriving newtype (ToJSON)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#user-handle)+-- A user handle is an opaque [byte sequence](https://infra.spec.whatwg.org/#byte-sequence)+-- with a maximum size of 64 bytes, and is not meant to be displayed to the user.+generateUserHandle :: MonadRandom m => m UserHandle+generateUserHandle = UserHandle <$> getRandomBytes 16++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialuserentity-displayname)+-- A [human-palatable](https://www.w3.org/TR/webauthn-2/#human-palatability) name for the user account,+-- intended only for display. For example, "Alex Müller" or "田中倫". The Relying Party SHOULD+-- let the user choose this, and SHOULD NOT restrict the choice more than necessary.+--+-- - [Relying Parties](https://www.w3.org/TR/webauthn-2/#relying-party) SHOULD perform+-- enforcement, as prescribed in Section 2.3 of [RFC8266](https://www.w3.org/TR/webauthn-2/#biblio-rfc8266)+-- for the Nickname Profile of the PRECIS FreeformClass [RFC8264](https://www.w3.org/TR/webauthn-2/#biblio-rfc8264),+-- when setting 'cueDisplayName's value, or displaying the value to the user.+-- - This string MAY contain language and direction metadata. [Relying Parties](https://www.w3.org/TR/webauthn-2/#relying-party)+-- SHOULD consider providing this information. See [§ 6.4.2 Language and Direction Encoding](https://www.w3.org/TR/webauthn-2/#sctn-strings-langdir)+-- about how this metadata is encoded.+newtype UserAccountDisplayName = UserAccountDisplayName {unUserAccountDisplayName :: Text}+  deriving (Eq, Show)+  deriving newtype (IsString, ToJSON)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialentity-name)+-- A [human-palatable](https://www.w3.org/TR/webauthn-2/#human-palatability) identifier for a user account.+-- It is intended only for display, i.e., aiding the user in determining the difference between user accounts with+-- similar 'cueDisplayName's. For example, "alexm", "alex.mueller@example.com" or "+14255551234".+--+-- - The [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party) MAY let the user choose this value.+--   The [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party) SHOULD perform enforcement,+--   as prescribed in Section 3.4.3 of [RFC8265](https://www.w3.org/TR/webauthn-2/#biblio-rfc8265)+--   for the UsernameCasePreserved Profile of the PRECIS IdentifierClass+--   [RFC8264](https://www.w3.org/TR/webauthn-2/#biblio-rfc8264), when setting 'UserAccountName's value,+--   or displaying the value to the user.+-- - This string MAY contain language and direction metadata.+--   [Relying Parties](https://www.w3.org/TR/webauthn-2/#relying-party) SHOULD consider providing this information.+--   See [§ 6.4.2 Language and Direction Encoding](https://www.w3.org/TR/webauthn-2/#sctn-strings-langdir)+--   about how this metadata is encoded.+newtype UserAccountName = UserAccountName {unUserAccountName :: Text}+  deriving (Eq, Show)+  deriving newtype (IsString, ToJSON)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#credential-id)+-- A probabilistically-unique [byte sequence](https://infra.spec.whatwg.org/#byte-sequence)+-- identifying a [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential-source)+-- source and its [authentication assertions](https://www.w3.org/TR/webauthn-2/#authentication-assertion).+newtype CredentialId = CredentialId {unCredentialId :: BS.ByteString}+  deriving (Eq, Show, Ord)+  deriving newtype (ToJSON)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#credential-id)+-- Generates a random 'CredentialId' using 16 random bytes.+-- This is only useful for authenticators, not for relying parties.+-- This function is only included for completeness and testing purposes.+generateCredentialId :: MonadRandom m => m CredentialId+generateCredentialId = CredentialId <$> getRandomBytes 16++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-cryptographic-challenges)+-- This member contains a challenge intended to be used for generating the newly+-- created credential’s attestation object. See the [§ 13.4.3 Cryptographic Challenges](https://www.w3.org/TR/webauthn-2/#sctn-cryptographic-challenges)+-- security consideration.+newtype Challenge = Challenge {unChallenge :: BS.ByteString}+  deriving (Eq, Show, Ord)+  deriving newtype (ToJSON)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-cryptographic-challenges)+-- In order to prevent replay attacks, the challenges MUST contain enough entropy+-- to make guessing them infeasible. Challenges SHOULD therefore be at least 16 bytes long.+generateChallenge :: MonadRandom m => m Challenge+generateChallenge = Challenge <$> getRandomBytes 16++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-timeout)+-- This member specifies a time, in milliseconds, that the caller is willing to wait for the call to complete.+-- This is treated as a hint, and MAY be overridden by the [client](https://www.w3.org/TR/webauthn-2/#client).+newtype Timeout = Timeout {unTimeout :: Word32}+  deriving (Eq, Show)+  deriving newtype (ToJSON)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#assertion-signature)+-- An assertion signature is produced when the+-- [authenticatorGetAssertion](https://www.w3.org/TR/webauthn-2/#authenticatorgetassertion)+-- method is invoked. It represents an assertion by the [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)+-- that the user has [consented](https://www.w3.org/TR/webauthn-2/#user-consent)+-- to a specific transaction, such as logging in, or completing a purchase. Thus,+-- an [assertion signature](https://www.w3.org/TR/webauthn-2/#assertion-signature)+-- asserts that the [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)+-- possessing a particular [credential private key](https://www.w3.org/TR/webauthn-2/#credential-private-key)+-- has established, to the best of its ability, that the user requesting this transaction+-- is the same user who [consented](https://www.w3.org/TR/webauthn-2/#user-consent)+-- to creating that particular [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential).+-- It also asserts additional information, termed [client data](https://www.w3.org/TR/webauthn-2/#client-data),+-- that may be useful to the caller, such as the means by which+-- [user consent](https://www.w3.org/TR/webauthn-2/#user-consent) was provided,+-- and the prompt shown to the user by the [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator).+-- The [assertion signature](https://www.w3.org/TR/webauthn-2/#assertion-signature)+-- format is illustrated in [Figure 4, below](https://www.w3.org/TR/webauthn-2/#fig-signature).+newtype AssertionSignature = AssertionSignature {unAssertionSignature :: BS.ByteString}+  deriving (Eq, Show)+  deriving newtype (ToJSON)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#rpidhash)+-- SHA-256 hash of the [RP ID](https://www.w3.org/TR/webauthn-2/#rp-id) the+-- [credential](https://www.w3.org/TR/webauthn-2/#public-key-credential) is+-- [scoped](https://www.w3.org/TR/webauthn-2/#scope) to.+newtype RpIdHash = RpIdHash {unRpIdHash :: Digest SHA256}+  deriving (Eq, Show)+  deriving newtype (ToJSON)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#collectedclientdata-hash-of-the-serialized-client-data)+-- This is the hash (computed using SHA-256) of the [JSON-compatible serialization of client data](https://www.w3.org/TR/webauthn-2/#collectedclientdata-json-compatible-serialization-of-client-data),+-- as constructed by the client.+newtype ClientDataHash = ClientDataHash {unClientDataHash :: Digest SHA256}+  deriving (Eq, Show)+  deriving newtype (ToJSON)++-- | [(spec)](https://html.spec.whatwg.org/multipage/origin.html#concept-origin)+newtype Origin = Origin {unOrigin :: Text}+  deriving (Eq, Show)+  deriving newtype (IsString, ToJSON)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#signcount)+-- [Signature counter](https://www.w3.org/TR/webauthn-2/#signature-counter)+newtype SignatureCounter = SignatureCounter {unSignatureCounter :: Word32}+  deriving (Eq, Show)+  deriving newtype (Num, Ord, ToJSON)++-- | The encoding of a 'Cose.CosePublicKey'+newtype PublicKeyBytes = PublicKeyBytes {unPublicKeyBytes :: BS.ByteString}+  deriving (Eq, Show)+  deriving newtype (ToJSON)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#iface-authentication-extensions-client-inputs)+-- This is a dictionary containing the [client extension input](https://www.w3.org/TR/webauthn-2/#client-extension-input)+-- values for zero or more [WebAuthn Extensions](https://www.w3.org/TR/webauthn-2/#webauthn-extensions).+-- TODO: Extensions are not implemented by this library, see "Crypto.WebAuthn.Model#extensions".+data AuthenticationExtensionsClientInputs = AuthenticationExtensionsClientInputs+  {+  }+  deriving (Eq, Show)++instance ToJSON AuthenticationExtensionsClientInputs where+  toJSON _ = object []++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#iface-authentication-extensions-client-outputs)+-- This is a dictionary containing the [client extension output](https://www.w3.org/TR/webauthn-2/#client-extension-output)+-- values for zero or more [WebAuthn Extensions](https://www.w3.org/TR/webauthn-2/#webauthn-extensions).+-- TODO: Extensions are not implemented by this library, see "Crypto.WebAuthn.Model#extensions".+data AuthenticationExtensionsClientOutputs = AuthenticationExtensionsClientOutputs+  {+  }+  deriving (Eq, Show)++instance ToJSON AuthenticationExtensionsClientOutputs where+  toJSON _ = object []++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#authenticator-extension-output)+data AuthenticatorExtensionOutputs = AuthenticatorExtensionOutputs+  {+  }+  deriving (Eq, Show)++instance ToJSON AuthenticatorExtensionOutputs where+  toJSON _ = object []++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-rp-credential-params)+-- The 'CredentialRpEntity' dictionary is used to supply additional+-- [Relying Party](https://www.w3.org/TR/webauthn-2/#webauthn-relying-party) attributes when creating a new credential.+data CredentialRpEntity = CredentialRpEntity+  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrpentity-id)+    -- A unique identifier for the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)+    -- entity, which sets the 'RpId'.+    creId :: Maybe RpId,+    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialentity-name)+    -- A [human-palatable](https://www.w3.org/TR/webauthn-2/#human-palatability)+    -- identifier for the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party),+    -- intended only for display. For example, "ACME Corporation", "Wonderful Widgets, Inc." or "ОАО Примертех".+    creName :: RelyingPartyName+  }+  deriving (Eq, Show, Generic, ToJSON)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-user-credential-params)+-- The 'CredentialUserEntity' dictionary is used to supply additional+-- user account attributes when creating a new credential.+data CredentialUserEntity = CredentialUserEntity+  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialuserentity-id)+    -- The 'UserHandle' of the user account entity.+    -- To ensure secure operation, authentication and authorization decisions MUST+    -- be made on the basis of this 'cueId' member, not the 'cueDisplayName' nor 'cueName' members.+    -- See Section 6.1 of [RFC8266](https://www.w3.org/TR/webauthn-2/#biblio-rfc8266).+    -- The 'UserHandle' MUST NOT contain personally identifying information about the user, such as a username+    -- or e-mail address; see [§ 14.6.1 User Handle Contents](https://www.w3.org/TR/webauthn-2/#sctn-user-handle-privacy)+    -- for details. The user handle MUST NOT be empty, though it MAY be null.+    -- NOTE: We don't allow encoding it as null here, because it isn't an+    -- allowed value in the client, see <https://www.w3.org/TR/webauthn-2/#sctn-createCredential>+    -- This was confirmed and a fix was merged: <https://github.com/w3c/webauthn/pull/1600>+    cueId :: UserHandle,+    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialuserentity-displayname)+    -- A [human-palatable](https://www.w3.org/TR/webauthn-2/#human-palatability) name for the user account,+    -- intended only for display. For example, "Alex Müller" or "田中倫".+    cueDisplayName :: UserAccountDisplayName,+    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialentity-name)+    -- A [human-palatable](https://www.w3.org/TR/webauthn-2/#human-palatability) identifier for a user account.+    -- It is intended only for display, i.e., aiding the user in determining the difference between user+    -- accounts with similar 'cueDisplayName's. For example, "alexm", "alex.mueller@example.com" or "+14255551234".+    cueName :: UserAccountName+  }+  deriving (Eq, Show, Generic, ToJSON)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-credential-params)+-- This dictionary is used to supply additional parameters when creating a new credential.+data CredentialParameters = CredentialParameters+  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialparameters-type)+    -- This member specifies the type of credential to be created.+    cpTyp :: CredentialType,+    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialparameters-alg)+    -- This member specifies the cryptographic signature algorithm with which the newly+    -- generated credential will be used, and thus also the type of asymmetric+    -- key pair to be generated, e.g., RSA or Elliptic Curve.+    cpAlg :: Cose.CoseSignAlg+  }+  deriving (Eq, Show, Generic, ToJSON)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictdef-publickeycredentialdescriptor)+-- This dictionary contains the attributes that are specified by a caller when referring to a+-- [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential) as an input parameter to the+-- [create()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-create) or+-- [get()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get) methods.+-- It mirrors the fields of the 'Credential' object returned by the latter methods.+data CredentialDescriptor = CredentialDescriptor+  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialdescriptor-type)+    -- This member contains the type of the [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential) the caller is referring to.+    cdTyp :: CredentialType,+    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialdescriptor-id)+    -- This member contains the [credential ID](https://www.w3.org/TR/webauthn-2/#credential-id) of the+    -- [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential) the caller is referring to.+    cdId :: CredentialId,+    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialdescriptor-transports)+    -- This OPTIONAL member contains a hint as to how the [client](https://www.w3.org/TR/webauthn-2/#client)+    -- might communicate with the [managing authenticator](https://www.w3.org/TR/webauthn-2/#public-key-credential-source-managing-authenticator)+    -- of the [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential) the caller is referring to.+    -- The values SHOULD be members of 'AuthenticatorTransport' but [client platforms](https://www.w3.org/TR/webauthn-2/#client-platform) MUST ignore unknown values.+    cdTransports :: Maybe [AuthenticatorTransport]+  }+  deriving (Eq, Show, Generic, ToJSON)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictdef-authenticatorselectioncriteria)+-- [WebAuthn Relying Parties](https://www.w3.org/TR/webauthn-2/#webauthn-relying-party)+-- may use the 'AuthenticatorSelectionCriteria' dictionary to specify their+-- requirements regarding authenticator attributes.+data AuthenticatorSelectionCriteria = AuthenticatorSelectionCriteria+  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-authenticatorattachment)+    -- If this member is present, eligible authenticators are filtered to+    -- only authenticators attached with the specified [§ 5.4.5 Authenticator+    -- Attachment Enumeration (enum AuthenticatorAttachment)](https://www.w3.org/TR/webauthn-2/#enum-attachment).+    ascAuthenticatorAttachment :: Maybe AuthenticatorAttachment,+    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-residentkey)+    -- Specifies the extent to which the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)+    -- desires to create a [client-side discoverable credential](https://www.w3.org/TR/webauthn-2/#client-side-discoverable-credential).+    -- For historical reasons the naming retains the deprecated “resident” terminology.+    ascResidentKey :: ResidentKeyRequirement,+    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-userverification)+    -- This member describes the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)'s+    -- requirements regarding [user verification](https://www.w3.org/TR/webauthn-2/#user-verification)+    -- for the [create()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-create)+    -- operation. Eligible authenticators are filtered to only those capable of satisfying this requirement.+    -- The value SHOULD be a member of 'UserVerificationRequirement' but+    -- [client platforms](https://www.w3.org/TR/webauthn-2/#client-platform) MUST ignore unknown values,+    -- treating an unknown value as if the [member does not exist](https://infra.spec.whatwg.org/#map-exists).+    ascUserVerification :: UserVerificationRequirement+  }+  deriving (Eq, Show, Generic, ToJSON)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#flags)+data AuthenticatorDataFlags = AuthenticatorDataFlags+  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#concept-user-present)+    -- Upon successful completion of a [user presence test](https://www.w3.org/TR/webauthn-2/#test-of-user-presence),+    -- the user is said to be "[present](https://www.w3.org/TR/webauthn-2/#concept-user-present)".+    adfUserPresent :: Bool,+    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#concept-user-verified)+    -- Upon successful completion of a [user verification](https://www.w3.org/TR/webauthn-2/#user-verification) process,+    -- the user is said to be "[verified](https://www.w3.org/TR/webauthn-2/#concept-user-verified)".+    adfUserVerified :: Bool+  }+  deriving (Eq, Show, Generic, ToJSON)++-- | A type encompassing the credential options, both for+-- [creation](https://www.w3.org/TR/webauthn-2/#dictionary-makecredentialoptions)+-- and+-- [requesting](https://www.w3.org/TR/webauthn-2/#dictionary-assertion-options).+-- The CeremonyKind araument specifies which.+data CredentialOptions (c :: CeremonyKind) where+  -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-makecredentialoptions)+  CredentialOptionsRegistration ::+    { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-rp)+      -- This member contains data about the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)+      -- responsible for the request.+      corRp :: CredentialRpEntity,+      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-user)+      -- This member contains data about the user account for which the+      -- [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party) is requesting attestation.+      corUser :: CredentialUserEntity,+      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-challenge)+      -- This member contains a challenge intended to be used for generating the newly created+      -- credential’s attestation object. See the [§ 13.4.3 Cryptographic Challenges](https://www.w3.org/TR/webauthn-2/#sctn-cryptographic-challenges)+      -- security consideration.+      corChallenge :: Challenge,+      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-pubkeycredparams)+      -- This member contains information about the desired properties of the credential to be created.+      -- The sequence is ordered from most preferred to least preferred.+      -- The [client](https://www.w3.org/TR/webauthn-2/#client) makes a best-effort+      -- to create the most preferred credential that it can.+      corPubKeyCredParams :: [CredentialParameters],+      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-timeout)+      -- This member specifies a time, in milliseconds, that the caller is willing to wait for the call to complete.+      -- This is treated as a hint, and MAY be overridden by the [client](https://www.w3.org/TR/webauthn-2/#client).+      corTimeout :: Maybe Timeout,+      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-excludecredentials)+      -- This member is intended for use by [Relying Parties](https://www.w3.org/TR/webauthn-2/#relying-party)+      -- that wish to limit the creation of multiple credentials for the same account on a single authenticator.+      -- The [client](https://www.w3.org/TR/webauthn-2/#client) is requested to return an error if the new credential+      -- would be created on an authenticator that also contains one of the credentials enumerated in this parameter.+      corExcludeCredentials :: [CredentialDescriptor],+      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-authenticatorselection)+      -- This member is intended for use by [Relying Parties](https://www.w3.org/TR/webauthn-2/#relying-party)+      -- that wish to select the appropriate authenticators to participate in the+      -- [create()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-create) operation.+      corAuthenticatorSelection :: Maybe AuthenticatorSelectionCriteria,+      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-attestation)+      -- This member is intended for use by [Relying Parties](https://www.w3.org/TR/webauthn-2/#relying-party)+      -- that wish to express their preference for [attestation conveyance](https://www.w3.org/TR/webauthn-2/#attestation-conveyance).+      corAttestation :: AttestationConveyancePreference,+      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialcreationoptions-extensions)+      -- This member contains additional parameters requesting additional processing by the client and authenticator.+      -- For example, the caller may request that only authenticators with certain capabilities be used to create the credential,+      -- or that particular information be returned in the [attestation object](https://www.w3.org/TR/webauthn-2/#attestation-object).+      -- Some extensions are defined in [§ 9 WebAuthn Extensions](https://www.w3.org/TR/webauthn-2/#sctn-extensions);+      -- consult the IANA "WebAuthn Extension Identifiers" registry [IANA-WebAuthn-Registries](https://www.w3.org/TR/webauthn-2/#biblio-iana-webauthn-registries)+      -- established by [RFC8809](https://www.w3.org/TR/webauthn-2/#biblio-rfc8809) for an up-to-date+      -- list of registered [WebAuthn Extensions](https://www.w3.org/TR/webauthn-2/#webauthn-extensions).+      -- TODO: Extensions are not implemented by this library, see "Crypto.WebAuthn.Model#extensions".+      corExtensions :: Maybe AuthenticationExtensionsClientInputs+    } ->+    CredentialOptions 'Registration+  -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-assertion-options)+  -- The 'CredentialOptionsAuthentication' dictionary supplies `[get()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get)`+  -- with the data it needs to generate an assertion.+  CredentialOptionsAuthentication ::+    { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-challenge)+      -- This member represents a challenge that the selected [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator) signs,+      -- along with other data, when producing an [authentication assertion](https://www.w3.org/TR/webauthn-2/#authentication-assertion).+      -- See the [§ 13.4.3 Cryptographic Challenges](https://www.w3.org/TR/webauthn-2/#sctn-cryptographic-challenges) security consideration.+      coaChallenge :: Challenge,+      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-timeout)+      -- This OPTIONAL member specifies a time, in milliseconds, that the caller is willing to wait for the call to complete.+      -- The value is treated as a hint, and MAY be overridden by the [client](https://www.w3.org/TR/webauthn-2/#client).+      coaTimeout :: Maybe Timeout,+      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-rpid)+      -- This OPTIONAL member specifies the [relying party identifier](https://www.w3.org/TR/webauthn-2/#relying-party-identifier) claimed by the caller.+      -- If omitted, its value will be the `[CredentialsContainer](https://w3c.github.io/webappsec-credential-management/#credentialscontainer)`+      -- object’s [relevant settings object](https://html.spec.whatwg.org/multipage/webappapis.html#relevant-settings-object)'s+      -- [origin](https://html.spec.whatwg.org/multipage/webappapis.html#concept-settings-object-origin)'s+      -- [effective domain](https://html.spec.whatwg.org/multipage/origin.html#concept-origin-effective-domain).+      coaRpId :: Maybe RpId,+      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-allowcredentials)+      -- This OPTIONAL member contains a list of 'CredentialDescriptor'+      -- objects representing [public key credentials](https://www.w3.org/TR/webauthn-2/#public-key-credential) acceptable to the caller,+      -- in descending order of the caller’s preference (the first item in the list is the most preferred credential, and so on down the list).+      coaAllowCredentials :: [CredentialDescriptor],+      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-userverification)+      -- This OPTIONAL member describes the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)'s requirements regarding+      -- [user verification](https://www.w3.org/TR/webauthn-2/#user-verification) for the+      -- `[get()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get)` operation.+      coaUserVerification :: UserVerificationRequirement,+      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredentialrequestoptions-extensions)+      -- This OPTIONAL member contains additional parameters requesting additional processing by the client and authenticator.+      -- For example, if transaction confirmation is sought from the user, then the prompt string might be included as an extension.+      coaExtensions :: Maybe AuthenticationExtensionsClientInputs+    } ->+    CredentialOptions 'Authentication++deriving instance Eq (CredentialOptions c)++deriving instance Show (CredentialOptions c)++instance ToJSON (CredentialOptions c) where+  toJSON CredentialOptionsRegistration {..} =+    object+      [ "tag" .= String "CredentialOptionsRegistration",+        "corRp" .= corRp,+        "corUser" .= corUser,+        "corChallenge" .= corChallenge,+        "corPubKeyCredParams" .= corPubKeyCredParams,+        "corTimeout" .= corTimeout,+        "corExcludeCredentials" .= corExcludeCredentials,+        "corAuthenticatorSelection" .= corAuthenticatorSelection,+        "corAttestation" .= corAttestation,+        "corExtensions" .= corExtensions+      ]+  toJSON CredentialOptionsAuthentication {..} =+    object+      [ "tag" .= String "CredentialOptionsAuthentication",+        "coaChallenge" .= coaChallenge,+        "coaTimeout" .= coaTimeout,+        "coaRpId" .= coaRpId,+        "coaAllowCredentials" .= coaAllowCredentials,+        "coaUserVerification" .= coaUserVerification,+        "coaExtensions" .= coaExtensions+      ]++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-client-data)+-- The client data represents the contextual bindings of both the+-- [WebAuthn Relying Party](https://www.w3.org/TR/webauthn-2/#webauthn-relying-party)+-- and the [client](https://www.w3.org/TR/webauthn-2/#client).+data CollectedClientData (c :: CeremonyKind) raw = CollectedClientData+  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-collectedclientdata-challenge)+    -- This member contains the challenge provided by the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party).+    -- See the [§ 13.4.3 Cryptographic Challenges](https://www.w3.org/TR/webauthn-2/#sctn-cryptographic-challenges) security consideration.+    ccdChallenge :: Challenge,+    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-collectedclientdata-origin)+    -- This member contains the fully qualified [origin](https://html.spec.whatwg.org/multipage/origin.html#concept-origin)+    -- of the requester, as provided to the authenticator by the client, in the syntax+    -- defined by [RFC6454](https://www.w3.org/TR/webauthn-2/#biblio-rfc6454).+    ccdOrigin :: Origin,+    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-collectedclientdata-crossorigin)+    -- This member contains the inverse of the @sameOriginWithAncestors@ araument value+    -- that was passed into the [internal method](https://tc39.github.io/ecma262/#sec-object-internal-methods-and-internal-slots).+    ccdCrossOrigin :: Bool,+    -- | Raw data of the client data, for verification purposes+    ccdRawData :: RawField raw+    -- TODO: This library does not implement token binding, this is in+    -- anticipation of version 3 of the webauthn spec that likely removes this+    -- field in its entirety. Discussion can be found in+    -- [the relevant PR](https://github.com/w3c/webauthn/pull/1630).+    -- Chromium and Firefox both don't propagate this field.+    -- Once v3 of the webauthn has been released, and this library is updated+    -- to the new spec, this field and related references can be removed.+    -- tokenBinding :: Maybe TokenBinding,+  }+  deriving (Eq, Show)++instance SingI c => ToJSON (CollectedClientData c raw) where+  toJSON CollectedClientData {..} =+    object+      [ "webauthnKind" .= sing @c,+        "ccdChallenge" .= ccdChallenge,+        "ccdOrigin" .= ccdOrigin,+        "ccdCrossOrigin" .= ccdCrossOrigin,+        "ccdRawData" .= ccdRawData+      ]++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-attested-credential-data)+-- Attested credential data is a variable-length byte array added to the+-- [authenticator data](https://www.w3.org/TR/webauthn-2/#authenticator-data)+-- when generating an [attestation object](https://www.w3.org/TR/webauthn-2/#attestation-object)+-- for a given credential.+data AttestedCredentialData (c :: CeremonyKind) raw where+  AttestedCredentialData ::+    { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#aaguid)+      acdAaguid :: AAGUID,+      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#credentialid)+      acdCredentialId :: CredentialId,+      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#credentialpublickey)+      acdCredentialPublicKey :: Cose.CosePublicKey,+      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#credentialpublickey)+      acdCredentialPublicKeyBytes :: RawField raw+    } ->+    AttestedCredentialData 'Registration raw+  NoAttestedCredentialData ::+    AttestedCredentialData 'Authentication raw++deriving instance Eq (AttestedCredentialData c raw)++deriving instance Show (AttestedCredentialData c raw)++instance ToJSON (AttestedCredentialData c raw) where+  toJSON AttestedCredentialData {..} =+    object+      [ "acdAaguid" .= acdAaguid,+        "acdCredentialId" .= acdCredentialId,+        "acdCredentialPublicKey" .= acdCredentialPublicKey,+        "acdCredentialPublicKeyBytes" .= acdCredentialPublicKeyBytes+      ]+  toJSON NoAttestedCredentialData {} = Null++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-authenticator-data)+-- The authenticator data structure encodes contextual bindings made by the+-- [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator). These+-- bindings are controlled by the authenticator itself, and derive their trust+-- from the [WebAuthn Relying Party](https://www.w3.org/TR/webauthn-2/#webauthn-relying-party)'s+-- assessment of the security properties of the authenticator. In one extreme case,+-- the authenticator may be embedded in the client, and its bindings may be no+-- more trustworthy than the [client data](https://www.w3.org/TR/webauthn-2/#client-data).+-- At the other extreme, the authenticator may be a discrete entity with high-security+-- hardware and software, connected to the client over a secure channel. In both cases,+-- the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party) receives+-- the [authenticator data](https://www.w3.org/TR/webauthn-2/#authenticator-data)+-- in the same format, and uses its knowledge of the authenticator to make trust decisions.+data AuthenticatorData (c :: CeremonyKind) raw = AuthenticatorData+  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#rpidhash)+    -- SHA-256 hash of the [RP ID](https://www.w3.org/TR/webauthn-2/#rp-id) the+    -- [credential](https://www.w3.org/TR/webauthn-2/#public-key-credential) is+    -- [scoped](https://www.w3.org/TR/webauthn-2/#scope) to.+    adRpIdHash :: RpIdHash,+    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#flags)+    adFlags :: AuthenticatorDataFlags,+    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#signcount)+    -- [Signature counter](https://www.w3.org/TR/webauthn-2/#signature-counter)+    adSignCount :: SignatureCounter,+    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#attestedcredentialdata)+    -- [attested credential data](https://www.w3.org/TR/webauthn-2/#attested-credential-data) (if present)+    adAttestedCredentialData :: AttestedCredentialData c raw,+    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#authdataextensions)+    -- Extension-defined [authenticator data](https://www.w3.org/TR/webauthn-2/#authenticator-data)+    adExtensions :: Maybe AuthenticatorExtensionOutputs,+    -- | Raw encoded data for verification purposes+    adRawData :: RawField raw+  }+  deriving (Eq, Show, Generic, ToJSON)++-- | The result from verifying an attestation statement.+-- Either the result is verifiable, in which case @k ~ 'Verifiable'@, the+-- 'AttestationType' contains a verifiable certificate chain.+-- Or the result is not verifiable, in which case @k ~ 'Unverifiable'@, the+-- 'AttestationType' is None or Self.+data SomeAttestationType = forall k. SomeAttestationType (AttestationType k)++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-attestation-formats)+-- This class is used to specify an [attestation statement format](https://www.w3.org/TR/webauthn-2/#attestation-statement-format)'s+-- [identifier](https://www.w3.org/TR/webauthn-2/#sctn-attstn-fmt-ids)+-- and [attestation statement structure](https://www.w3.org/TR/webauthn-2/#attestation-statement)+class+  ( Eq (AttStmt a),+    Show (AttStmt a),+    ToJSON (AttStmt a),+    Typeable a,+    Show a,+    Exception (AttStmtVerificationError a)+  ) =>+  AttestationStatementFormat a+  where+  -- | The type of a fully-decoded and structurally valid attestation statement+  type AttStmt a :: Type++  -- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-attstn-fmt-ids)+  -- Attestation statement formats are identified by a string, called an attestation+  -- statement format identifier, chosen by the author of the+  -- [attestation statement format](https://www.w3.org/TR/webauthn-2/#attestation-statement-format).+  --+  -- Attestation statement format identifiers SHOULD be registered in the IANA "WebAuthn Attestation Statement Format Identifiers" registry+  -- [IANA-WebAuthn-Registries](https://www.w3.org/TR/webauthn-2/#biblio-iana-webauthn-registries)+  -- established by [RFC8809](https://www.w3.org/TR/webauthn-2/#biblio-rfc8809).+  -- All registered attestation statement format identifiers are unique amongst+  -- themselves as a matter of course.+  --+  -- Unregistered attestation statement format identifiers SHOULD use lowercase+  -- reverse domain-name naming, using a domain name registered by the developer,+  -- in order to assure uniqueness of the identifier. All attestation statement+  -- format identifiers MUST be a maximum of 32 octets in length and MUST+  -- consist only of printable USASCII characters, excluding backslash and+  -- doublequote, i.e., VCHAR as defined in [RFC5234](https://www.w3.org/TR/webauthn-2/#biblio-rfc5234)+  -- but without %x22 and %x5c.+  --+  -- Note: This means attestation statement format identifiers based on domain+  -- names MUST incorporate only LDH Labels [RFC5890](https://www.w3.org/TR/webauthn-2/#biblio-rfc5890).+  --+  -- Attestation statement formats that may exist in multiple versions SHOULD+  -- include a version in their identifier. In effect, different versions are+  -- thus treated as different formats, e.g., @packed2@ as a new version of the+  -- [§ 8.2 Packed Attestation Statement Format](https://www.w3.org/TR/webauthn-2/#sctn-packed-attestation).+  asfIdentifier :: a -> Text++  -- | The type of verification errors that can occur when verifying this+  -- attestation statement using 'asfVerify'+  type AttStmtVerificationError a :: Type++  -- | [(spec)](https://www.w3.org/TR/webauthn-2/#verification-procedure)+  -- The procedure to verify an [attestation statement](https://www.w3.org/TR/webauthn-2/#attestation-statement)+  asfVerify ::+    a ->+    HG.DateTime ->+    AttStmt a ->+    AuthenticatorData 'Registration 'True ->+    ClientDataHash ->+    Validation (NonEmpty (AttStmtVerificationError a)) SomeAttestationType++  -- | The trusted root certificates specifically for this attestation+  -- statement format. For attestation statement chain validation, these+  -- certificates are used, in addition to the ones from the metadata registry+  --+  -- [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-registering-a-new-credential) step 20:+  -- If validation is successful, obtain a list of acceptable trust anchors+  -- (i.e. attestation root certificates) for that attestation type and+  -- attestation statement format fmt, from a trusted source or from policy.+  --+  -- While for the attestation statement formats we implement, none of them use+  -- the 'VerifiableAttestationType', it is implied that it could be used by+  -- the above sentence from the spec.+  asfTrustAnchors ::+    a ->+    VerifiableAttestationType ->+    X509.CertificateStore++  -- | A decoder for the attestation statement [syntax](https://www.w3.org/TR/webauthn-2/#sctn-attestation-formats).+  -- The @attStmt@ CBOR map is given as an input. See+  -- [Generating an Attestation Object](https://www.w3.org/TR/webauthn-2/#sctn-generating-an-attestation-object)+  asfDecode ::+    a ->+    HashMap Text CBOR.Term ->+    Either Text (AttStmt a)++  -- | An encoder for the attestation statement [syntax](https://www.w3.org/TR/webauthn-2/#sctn-attestation-formats).+  -- The @attStmt@ CBOR map is expected as the result. See+  -- [Generating an Attestation Object](https://www.w3.org/TR/webauthn-2/#sctn-generating-an-attestation-object)+  asfEncode ::+    a ->+    AttStmt a ->+    CBOR.Term++-- | An arbitrary [attestation statement format](https://www.w3.org/TR/webauthn-2/#sctn-attestation-formats).+-- In contrast to 'AttestationStatementFormat', this type can be put into a list.+-- This is used for 'singletonAttestationStatementFormat'+data SomeAttestationStatementFormat+  = forall a.+    AttestationStatementFormat a =>+    SomeAttestationStatementFormat a++-- | A type representing the set of supported attestation statement formats.+-- The constructor is intentionally not exported, use+-- 'singletonAttestationStatementFormat' instead to construct it and+-- 'lookupAttestationStatementFormat' to look up formats. '<>' can be used to+-- combine multiple formats. 'mempty' can be used for not supporting any formats.+newtype SupportedAttestationStatementFormats+  = -- HashMap invariant: asfIdentifier (hm ! k) == k+    SupportedAttestationStatementFormats (HashMap Text SomeAttestationStatementFormat)+  deriving newtype (Semigroup, Monoid)++-- | Creates a `SupportedAttestationStatementFormats`-Map containing a single+-- supported format.+singletonAttestationStatementFormat :: SomeAttestationStatementFormat -> SupportedAttestationStatementFormats+singletonAttestationStatementFormat someFormat@(SomeAttestationStatementFormat format) =+  SupportedAttestationStatementFormats $ HashMap.singleton (asfIdentifier format) someFormat++-- | Attempt to find the desired attestation statement format in a map of+-- supported formats. Can then be used to perform attestation.+lookupAttestationStatementFormat :: Text -> SupportedAttestationStatementFormats -> Maybe SomeAttestationStatementFormat+lookupAttestationStatementFormat id (SupportedAttestationStatementFormats sasf) = sasf !? id++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#attestation-object)+data AttestationObject raw = forall a.+  AttestationStatementFormat a =>+  AttestationObject+  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#authenticator-data)+    -- The authenticator data structure encodes contextual bindings made by the+    -- [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator).+    -- These bindings are controlled by the authenticator itself, and derive+    -- their trust from the [WebAuthn Relying Party](https://www.w3.org/TR/webauthn-2/#webauthn-relying-party)'s+    -- assessment of the security properties of the authenticator. In one+    -- extreme case, the authenticator may be embedded in the client, and its+    -- bindings may be no more trustworthy than the [client data](https://www.w3.org/TR/webauthn-2/#client-data).+    -- At the other extreme, the authenticator may be a discrete entity with high-security hardware+    -- and software, connected to the client over a secure channel. In both cases,+    -- the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party) receives+    -- the [authenticator data](https://www.w3.org/TR/webauthn-2/#authenticator-data)+    -- in the same format, and uses its knowledge of the authenticator to make trust decisions.+    aoAuthData :: AuthenticatorData 'Registration raw,+    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#attestation-statement-format)+    aoFmt :: a,+    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#attestation-statement)+    aoAttStmt :: AttStmt a+  }++instance Eq (AttestationObject raw) where+  AttestationObject {aoAuthData = lAuthData, aoFmt = lFmt, aoAttStmt = lAttStmt}+    == AttestationObject {aoAuthData = rAuthData, aoFmt = rFmt, aoAttStmt = rAttStmt} =+      lAuthData == rAuthData+        -- We need to use some simple reflection in order to be able to compare the attestation statements+        && case eqTypeRep (typeOf lFmt) (typeOf rFmt) of+          Just HRefl -> lAttStmt == rAttStmt+          Nothing -> False++deriving instance Show (AttestationObject raw)++instance ToJSON (AttestationObject raw) where+  toJSON AttestationObject {..} =+    object+      [ "aoAuthData" .= aoAuthData,+        "aoFmt" .= asfIdentifier aoFmt,+        "aoAttStmt" .= aoAttStmt+      ]++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#authenticatorresponse)+-- [Authenticators](https://www.w3.org/TR/webauthn-2/#authenticator) respond to+-- [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party) requests by+-- returning an object derived from the `[AuthenticatorResponse](https://www.w3.org/TR/webauthn-2/#authenticatorresponse)` interface+data AuthenticatorResponse (c :: CeremonyKind) raw where+  -- | [(spec)](https://www.w3.org/TR/webauthn-2/#iface-authenticatorattestationresponse)+  -- The [AuthenticatorAttestationResponse](https://www.w3.org/TR/webauthn-2/#authenticatorattestationresponse)+  -- interface represents the [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)'s response+  -- to a client’s request for the creation of a new+  -- [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential).+  -- It contains information about the new credential that can be used to identify+  -- it for later use, and metadata that can be used by the+  -- [WebAuthn Relying Party](https://www.w3.org/TR/webauthn-2/#webauthn-relying-party)+  -- to assess the characteristics of the credential during registration.+  AuthenticatorResponseRegistration ::+    { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorresponse-clientdatajson)+      -- This attribute, inherited from `[AuthenticatorResponse](https://www.w3.org/TR/webauthn-2/#authenticatorresponse)`,+      -- contains the [JSON-compatible serialization of client data](https://www.w3.org/TR/webauthn-2/#collectedclientdata-json-compatible-serialization-of-client-data)+      -- (see [§ 6.5 Attestation](https://www.w3.org/TR/webauthn-2/#sctn-attestation))+      -- passed to the authenticator by the client in order to generate this credential.+      -- The exact JSON serialization MUST be preserved, as the+      -- [hash of the serialized client data](https://www.w3.org/TR/webauthn-2/#collectedclientdata-hash-of-the-serialized-client-data) has been computed over it.+      arrClientData :: CollectedClientData 'Registration raw,+      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorattestationresponse-attestationobject)+      -- This attribute contains an [attestation object](https://www.w3.org/TR/webauthn-2/#attestation-object),+      -- which is opaque to, and cryptographically protected against tampering by, the client.+      -- The [attestation object](https://www.w3.org/TR/webauthn-2/#attestation-object) contains both+      -- [authenticator data](https://www.w3.org/TR/webauthn-2/#authenticator-data) and an+      -- [attestation statement](https://www.w3.org/TR/webauthn-2/#attestation-statement).+      -- The former contains the AAGUID, a unique [credential ID](https://www.w3.org/TR/webauthn-2/#credential-id),+      -- and the [credential public key](https://www.w3.org/TR/webauthn-2/#credential-public-key).+      -- The contents of the [attestation statement](https://www.w3.org/TR/webauthn-2/#attestation-statement)+      -- are determined by the [attestation statement format](https://www.w3.org/TR/webauthn-2/#attestation-statement-format)+      -- used by the [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator).+      -- It also contains any additional information that the [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party)'s+      -- server requires to validate the [attestation statement](https://www.w3.org/TR/webauthn-2/#attestation-statement),+      -- as well as to decode and validate the [authenticator data](https://www.w3.org/TR/webauthn-2/#authenticator-data)+      -- along with the [JSON-compatible serialization of client data](https://www.w3.org/TR/webauthn-2/#collectedclientdata-json-compatible-serialization-of-client-data).+      -- For more details, see [§ 6.5 Attestation](https://www.w3.org/TR/webauthn-2/#sctn-attestation),+      -- [§ 6.5.4 Generating an Attestation Object](https://www.w3.org/TR/webauthn-2/#sctn-generating-an-attestation-object),+      -- and [Figure 6](https://www.w3.org/TR/webauthn-2/#fig-attStructs).+      arrAttestationObject :: AttestationObject raw+      -- TODO: This property is currently not propagated by webauthn-json. See:+      -- <https://github.com/github/webauthn-json/pull/44>+      -- [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorattestationresponse-gettransports)+      -- This [internal slot](https://tc39.github.io/ecma262/#sec-object-internal-methods-and-internal-slots)+      -- contains a sequence of zero or more unique `[DOMString](https://heycam.github.io/webidl/#idl-DOMString)`s+      -- in lexicoaraphical order. These values are the transports that the+      -- [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator) is believed to support,+      -- or an empty sequence if the information is unavailable.+      -- arrTransports :: Set AuthenticatorTransport+    } ->+    AuthenticatorResponse 'Registration raw+  -- | [(spec)](https://www.w3.org/TR/webauthn-2/#authenticatorassertionresponse)+  -- The [AuthenticatorAssertionResponse](https://www.w3.org/TR/webauthn-2/#authenticatorassertionresponse) interface represents an+  -- [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)'s response+  -- to a client’s request for generation of a new+  -- [authentication assertion](https://www.w3.org/TR/webauthn-2/#authentication-assertion)+  -- given the [WebAuthn Relying Party](https://www.w3.org/TR/webauthn-2/#webauthn-relying-party)'s+  -- challenge and OPTIONAL list of credentials it is aware of. This response+  -- contains a cryptographic signature proving possession of the+  -- [credential private key](https://www.w3.org/TR/webauthn-2/#credential-private-key),+  -- and optionally evidence of [user consent](https://www.w3.org/TR/webauthn-2/#user-consent)+  -- to a specific transaction.+  AuthenticatorResponseAuthentication ::+    { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorresponse-clientdatajson)+      -- This attribute, inherited from `[AuthenticatorResponse](https://www.w3.org/TR/webauthn-2/#authenticatorresponse)`,+      -- contains the [JSON-compatible serialization of client data](https://www.w3.org/TR/webauthn-2/#collectedclientdata-json-compatible-serialization-of-client-data)+      -- (see [§ 6.5 Attestation](https://www.w3.org/TR/webauthn-2/#sctn-attestation))+      -- passed to the authenticator by the client in order to generate this credential.+      -- The exact JSON serialization MUST be preserved, as the+      -- [hash of the serialized client data](https://www.w3.org/TR/webauthn-2/#collectedclientdata-hash-of-the-serialized-client-data) has been computed over it.+      araClientData :: CollectedClientData 'Authentication raw,+      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorassertionresponse-authenticatordata)+      -- This attribute contains the [authenticator data](https://www.w3.org/TR/webauthn-2/#authenticator-data)+      -- returned by the authenticator. See [§ 6.1 Authenticator Data](https://www.w3.org/TR/webauthn-2/#sctn-authenticator-data).+      araAuthenticatorData :: AuthenticatorData 'Authentication raw,+      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorassertionresponse-signature)+      -- This attribute contains the raw signature returned from the authenticator.+      -- See [§ 6.3.3 The authenticatorGetAssertion Operation](https://www.w3.org/TR/webauthn-2/#sctn-op-get-assertion).+      araSignature :: AssertionSignature,+      -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorassertionresponse-userhandle)+      -- This attribute contains the [user handle](https://www.w3.org/TR/webauthn-2/#user-handle)+      -- returned from the authenticator, or null if the authenticator did not return a+      -- [user handle](https://www.w3.org/TR/webauthn-2/#user-handle). See+      -- [§ 6.3.3 The authenticatorGetAssertion Operation](https://www.w3.org/TR/webauthn-2/#sctn-op-get-assertion).+      araUserHandle :: Maybe UserHandle+    } ->+    AuthenticatorResponse 'Authentication raw++deriving instance Eq (AuthenticatorResponse c raw)++deriving instance Show (AuthenticatorResponse c raw)++instance ToJSON (AuthenticatorResponse c raw) where+  toJSON AuthenticatorResponseRegistration {..} =+    object+      [ "arrClientData" .= arrClientData,+        "arrAttestationObject" .= arrAttestationObject+      ]+  toJSON AuthenticatorResponseAuthentication {..} =+    object+      [ "araClientData" .= araClientData,+        "araAuthenticatorData" .= araAuthenticatorData,+        "araSignature" .= araSignature,+        "araUserHandle" .= araUserHandle+      ]++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#iface-pkcredential)+-- The 'Credential' interface contains the attributes that are returned to the caller when a new credential is created, or a new assertion is requested.+data Credential (c :: CeremonyKind) raw = Credential+  { -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredential-identifier-slot)+    -- Contains the [credential ID](https://www.w3.org/TR/webauthn-2/#credential-id),+    -- chosen by the authenticator. The [credential ID](https://www.w3.org/TR/webauthn-2/#credential-id)+    -- is used to look up credentials for use, and is therefore expected to be globally+    -- unique with high probability across all credentials of the same type, across all authenticators.+    cIdentifier :: CredentialId,+    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredential-response)+    -- This attribute contains the [authenticator](https://www.w3.org/TR/webauthn-2/#authenticator)'s+    -- response to the client’s request to either create a [public key credential](https://www.w3.org/TR/webauthn-2/#public-key-credential),+    -- or generate an [authentication assertion](https://www.w3.org/TR/webauthn-2/#authentication-assertion).+    -- If the `[PublicKeyCredential](https://www.w3.org/TR/webauthn-2/#publickeycredential)`+    -- is created in response to `[create()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-create)`,+    -- this attribute’s value will be an `[AuthenticatorAttestationResponse](https://www.w3.org/TR/webauthn-2/#authenticatorattestationresponse)`,+    -- otherwise, the `[PublicKeyCredential](https://www.w3.org/TR/webauthn-2/#publickeycredential)`+    -- was created in response to `[get()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get)`,+    -- and this attribute’s value will be an `[AuthenticatorAssertionResponse](https://www.w3.org/TR/webauthn-2/#authenticatorassertionresponse)`.+    cResponse :: AuthenticatorResponse c raw,+    -- | [(spec)](https://www.w3.org/TR/webauthn-2/#dom-publickeycredential-getclientextensionresults)+    -- This operation returns the value of `[[[clientExtensionsResults]]](https://www.w3.org/TR/webauthn-2/#dom-publickeycredential-clientextensionsresults-slot)`,+    -- which is a [map](https://infra.spec.whatwg.org/#ordered-map) containing+    -- [extension identifier](https://www.w3.org/TR/webauthn-2/#extension-identifier) →+    -- [client extension output](https://www.w3.org/TR/webauthn-2/#client-extension-output) entries produced+    -- by the extension’s [client extension processing](https://www.w3.org/TR/webauthn-2/#client-extension-processing).+    cClientExtensionResults :: AuthenticationExtensionsClientOutputs+  }+  deriving (Eq, Show, Generic, ToJSON)++-- | Removes all raw fields from a 'Credential', useful for+-- e.g. pretty-printing only the desired fields. This is the counterpart to+-- 'Crypto.WebAuthn.Model.Binary.Encoding.encodeRawCredential'+stripRawCredential :: forall c raw. SingI c => Credential c raw -> Credential c 'False+stripRawCredential Credential {..} =+  Credential+    { cResponse = case sing @c of+        SRegistration -> stripRawAuthenticatorResponseRegistration cResponse+        SAuthentication -> stripRawAuthenticatorResponseAuthentication cResponse,+      ..+    }+  where+    stripRawAuthenticatorResponseAuthentication :: AuthenticatorResponse 'Authentication raw -> AuthenticatorResponse 'Authentication 'False+    stripRawAuthenticatorResponseAuthentication AuthenticatorResponseAuthentication {..} =+      AuthenticatorResponseAuthentication+        { araClientData = stripRawCollectedClientData araClientData,+          araAuthenticatorData = stripRawAuthenticatorData araAuthenticatorData,+          ..+        }++    stripRawAuthenticatorResponseRegistration :: AuthenticatorResponse 'Registration raw -> AuthenticatorResponse 'Registration 'False+    stripRawAuthenticatorResponseRegistration AuthenticatorResponseRegistration {..} =+      AuthenticatorResponseRegistration+        { arrClientData = stripRawCollectedClientData arrClientData,+          arrAttestationObject = stripRawAttestationObject arrAttestationObject,+          ..+        }++    stripRawAttestationObject :: AttestationObject raw -> AttestationObject 'False+    stripRawAttestationObject AttestationObject {..} =+      AttestationObject+        { aoAuthData = stripRawAuthenticatorData aoAuthData,+          ..+        }++    stripRawAuthenticatorData :: forall c raw. SingI c => AuthenticatorData c raw -> AuthenticatorData c 'False+    stripRawAuthenticatorData AuthenticatorData {..} =+      AuthenticatorData+        { adRawData = NoRaw,+          adAttestedCredentialData = stripRawAttestedCredentialData adAttestedCredentialData,+          ..+        }++    stripRawAttestedCredentialData :: forall c raw. SingI c => AttestedCredentialData c raw -> AttestedCredentialData c 'False+    stripRawAttestedCredentialData = case sing @c of+      SRegistration -> \AttestedCredentialData {..} -> AttestedCredentialData {acdCredentialPublicKeyBytes = NoRaw, ..}+      SAuthentication -> \NoAttestedCredentialData -> NoAttestedCredentialData++    stripRawCollectedClientData :: forall c raw. SingI c => CollectedClientData c raw -> CollectedClientData c 'False+    stripRawCollectedClientData CollectedClientData {..} = CollectedClientData {ccdRawData = NoRaw, ..}

@@ -0,0 +1,112 @@+{-# LANGUAGE DataKinds #-}++-- | Stability: experimental+-- This module contains functions and types for encoding 'T.CredentialOptions'+-- and decoding 'T.Credential's, based on intermediate types that implement the 'ToJSON' and 'FromJSON' types respectively, matching the serialization used by [webauthn-json](https://github.com/github/webauthn-json).+module Crypto.WebAuthn.Model.WebIDL+  ( -- * Registration+    encodeCredentialOptionsRegistration,+    IDLCredentialOptionsRegistration,+    IDLCredentialRegistration,+    decodeCredentialRegistration,++    -- * Authentication+    encodeCredentialOptionsAuthentication,+    IDLCredentialOptionsAuthentication,+    IDLCredentialAuthentication,+    decodeCredentialAuthentication,+  )+where++import qualified Crypto.WebAuthn.Model.Kinds as K+import qualified Crypto.WebAuthn.Model.Types as T+import Crypto.WebAuthn.Model.WebIDL.Internal.Decoding (Decode (decode), DecodeCreated (decodeCreated))+import Crypto.WebAuthn.Model.WebIDL.Internal.Encoding (Encode (encode))+import qualified Crypto.WebAuthn.Model.WebIDL.Types as IDL+import Data.Aeson (FromJSON, ToJSON)+import Data.Text (Text)++-- | Encodes a @'T.CredentialOptions' 'K.Registration'@, which is needed for the+-- [registration ceremony](https://www.w3.org/TR/webauthn-2/#registration). The+-- resulting type from this function can be encoded using 'Data.Aeson.toJSON',+-- sent as a response, received by the Relying Party script, passed directly as the [@publicKey@](https://www.w3.org/TR/webauthn-2/#dom-credentialcreationoptions-publickey)+-- field in the argument to [webauthn-json](https://github.com/github/webauthn-json)'s [@create()@](https://github.com/github/webauthn-json#api) (or equivalent) function. The result of that function can then be decoded using 'decodeCredentialRegistration'.+encodeCredentialOptionsRegistration ::+  T.CredentialOptions 'K.Registration ->+  IDLCredentialOptionsRegistration+encodeCredentialOptionsRegistration = IDLCredentialOptionsRegistration <$> encode++-- | The intermediate type returned by 'encodeCredentialOptionsRegistration',+-- equivalent to the [@PublicKeyCredentialCreationOptions@](https://www.w3.org/TR/webauthn-2/#dictdef-publickeycredentialcreationoptions) dictionary+newtype IDLCredentialOptionsRegistration = IDLCredentialOptionsRegistration+  { _unIDLCredentialOptionsRegistration :: IDL.PublicKeyCredentialCreationOptions+  }+  deriving newtype (Show, Eq, ToJSON)++-- | The intermediate type as an input to 'decodeCredentialRegistration',+-- equivalent to the [PublicKeyCredential](https://www.w3.org/TR/webauthn-2/#iface-pkcredential)+-- interface with the response being an+-- [AuthenticatorAttestationResponse](https://www.w3.org/TR/webauthn-2/#authenticatorattestationresponse).+newtype IDLCredentialRegistration = IDLCredentialRegistration+  { unIDLCredentialRegistration :: IDL.PublicKeyCredential IDL.AuthenticatorAttestationResponse+  }+  deriving newtype (Show, Eq, FromJSON, ToJSON)++-- | Decodes the intermediate 'IDLCredentialRegistration' type which can be+-- parsed with 'Data.Aeson.fromJSON' from the result of+-- [webauthn-json](https://github.com/github/webauthn-json)'s+-- [@create()@](https://github.com/github/webauthn-json#api) (or equivalent)+-- function, to a @'T.Credential' 'K.Registration'@. This is the continuation+-- of 'encodeCredentialOptionsRegistration'.+decodeCredentialRegistration ::+  -- | The [attestation statement formats](https://www.w3.org/TR/webauthn-2/#sctn-attestation-formats)+  -- that should be supported. The value of 'Crypto.WebAuthn.allSupportedFormats'+  -- can be passed here, but additional or custom formats may also be used if needed+  T.SupportedAttestationStatementFormats ->+  IDLCredentialRegistration ->+  Either Text (T.Credential 'K.Registration 'True)+decodeCredentialRegistration supportedFormats = decodeCreated supportedFormats . unIDLCredentialRegistration++-- | Encodes a @'T.CredentialOptions' 'K.Authentication'@, which is needed for the+-- [authentication ceremony](https://www.w3.org/TR/webauthn-2/#authentication). The+-- resulting type from this function can be encoded using 'Data.Aeson.toJSON',+-- sent as a response, received by the Relying Party script, parsed as JSON,+-- and passed directly as the [@publicKey@](https://www.w3.org/TR/webauthn-2/#dom-credentialrequestoptions-publickey)+-- field in the argument to the [@navigator.credentials.get()@](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get)+-- function.+encodeCredentialOptionsAuthentication ::+  T.CredentialOptions 'K.Authentication ->+  IDLCredentialOptionsAuthentication+encodeCredentialOptionsAuthentication = IDLCredentialOptionsAuthentication <$> encode++-- | The intermediate type returned by 'encodeCredentialOptionsAuthentication',+-- equivalent to the [@PublicKeyCredentialRequestOptions@](https://www.w3.org/TR/webauthn-2/#dictdef-publickeycredentialrequestoptions) dictionary+newtype IDLCredentialOptionsAuthentication = IDLCredentialOptionsAuthentication+  { _unIDLCredentialOptionsAuthentication :: IDL.PublicKeyCredentialRequestOptions+  }+  deriving newtype (Show, Eq, ToJSON)++-- | The intermediate type as an input to 'decodeCredentialAuthentication',+-- equivalent to the [PublicKeyCredential](https://www.w3.org/TR/webauthn-2/#iface-pkcredential)+-- interface with the response being an+-- [AuthenticatorAssertionResponse](https://www.w3.org/TR/webauthn-2/#authenticatorassertionresponse).+newtype IDLCredentialAuthentication = IDLCredentialAuthentication+  { unIDLCredentialAuthentication :: IDL.PublicKeyCredential IDL.AuthenticatorAssertionResponse+  }+  deriving newtype (Show, Eq, FromJSON, ToJSON)++-- | Decodes a 'IDL.RequestedPublicKeyCredential' result, corresponding to the+-- [@PublicKeyCredential@ interface](https://www.w3.org/TR/webauthn-2/#iface-pkcredential)+-- as returned by the [get()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get)+-- method while [Verifying an Authentication Assertion](https://www.w3.org/TR/webauthn-2/#sctn-verifying-assertion)+--+-- | Decodes the intermediate 'IDLCredentialAuthentication' type which can be+-- parsed with 'Data.Aeson.fromJSON' from the result of+-- [webauthn-json](https://github.com/github/webauthn-json)'s+-- [@get()@](https://github.com/github/webauthn-json#api) (or equivalent)+-- function, to a @'T.Credential' 'K.Authentication' True@. This is the continuation+-- of 'encodeCredentialOptionsAuthentication'+decodeCredentialAuthentication ::+  IDLCredentialAuthentication ->+  Either Text (T.Credential 'K.Authentication 'True)+decodeCredentialAuthentication = decode . unIDLCredentialAuthentication

@@ -0,0 +1,257 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Stability: internal+-- Certain parts of the specification require that data is decoded from a+-- binary form. This module holds such functions.+module Crypto.WebAuthn.Model.WebIDL.Internal.Binary.Decoding+  ( -- * Decoding from bytes+    decodeAuthenticatorData,+    decodeAttestationObject,+    decodeCollectedClientData,+  )+where++import qualified Codec.CBOR.Decoding as CBOR+import qualified Codec.CBOR.Read as CBOR+import qualified Codec.CBOR.Term as CBOR+import Codec.Serialise (decode)+import Control.Monad (forM, unless)+import Control.Monad.Except (MonadError (throwError))+import Control.Monad.State (MonadState (get, put), StateT (runStateT))+import qualified Crypto.Hash as Hash+import Crypto.WebAuthn.Internal.Utils (CustomJSON (CustomJSON), JSONEncoding)+import Crypto.WebAuthn.Model.Identifier (AAGUID (AAGUID))+import qualified Crypto.WebAuthn.Model.Kinds as K+import qualified Crypto.WebAuthn.Model.Types as M+import qualified Crypto.WebAuthn.WebIDL as IDL+import qualified Data.Aeson as Aeson+import Data.Bifunctor (first)+import qualified Data.Binary.Get as Binary+import qualified Data.Bits as Bits+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base64 as Base64+import qualified Data.ByteString.Base64.URL as Base64Url+import qualified Data.ByteString.Lazy as LBS+import qualified Data.HashMap.Strict as HashMap+import Data.Maybe (fromJust, fromMaybe)+import Data.Singletons (SingI, sing)+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import qualified Data.UUID as UUID+import GHC.Generics (Generic)++-- | Webauthn contains a mixture of binary formats. For one it's CBOR and+-- for another it's a custom format. For CBOR we wish to use the+-- [cborg](https://hackage.haskell.org/package/cborg) library+-- and for the 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 the decoders 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 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+-- makes sure that no bytes are left, otherwise returns an error+runPartialBinaryDecoder :: BS.ByteString -> PartialBinaryDecoder a -> Either Text a+runPartialBinaryDecoder bytes decoder = case runStateT decoder . LBS.fromStrict $ bytes of+  Left err -> Left err+  Right (result, rest)+    | LBS.null rest -> return result+    | otherwise -> Left $ "Not all binary input used, rest in base64 format is: " <> Text.decodeUtf8 (Base64.encode $ LBS.toStrict rest)++-- | A 'PartialBinaryDecoder DecodingError' for a binary encoding specified using 'Binary.Get'+runBinary :: Binary.Get a -> PartialBinaryDecoder a+runBinary decoder = do+  bytes <- get+  case Binary.runGetOrFail decoder bytes of+    Left (_rest, _offset, err) ->+      throwError $ "Binary decoding error: " <> Text.pack err+    Right (rest, _offset, result) -> do+      put rest+      pure result++-- | A 'PartialBinaryDecoder DecodingError' for a CBOR encoding specified using the given Decoder+runCBOR :: (forall s. CBOR.Decoder s a) -> PartialBinaryDecoder (LBS.ByteString, a)+runCBOR decoder = do+  bytes <- get+  case CBOR.deserialiseFromBytesWithSize decoder bytes of+    Left err ->+      throwError $ "CBOR decoding error: " <> Text.pack (show err)+    Right (rest, consumed, a) -> do+      put rest+      pure (LBS.take (fromIntegral consumed) bytes, a)++-- | Decodes a 'M.AuthenticatorData' from a 'BS.ByteString'.+-- This is needed to parse a webauthn clients+-- [authenticatorData](https://www.w3.org/TR/webauthn-2/#dom-authenticatorassertionresponse-authenticatordata)+-- field in the [AuthenticatorAssertionResponse](https://www.w3.org/TR/webauthn-2/#iface-authenticatorassertionresponse)+-- structure+decodeAuthenticatorData ::+  forall c.+  SingI c =>+  BS.ByteString ->+  Either Text (M.AuthenticatorData c 'True)+decodeAuthenticatorData strictBytes = runPartialBinaryDecoder strictBytes $ do+  -- https://www.w3.org/TR/webauthn-2/#authenticator-data+  let adRawData = M.WithRaw strictBytes++  -- https://www.w3.org/TR/webauthn-2/#rpidhash+  adRpIdHash <-+    M.RpIdHash . fromJust . Hash.digestFromByteString+      <$> runBinary (Binary.getByteString 32)++  -- https://www.w3.org/TR/webauthn-2/#flags+  bitFlags <- runBinary Binary.getWord8+  let adFlags =+        M.AuthenticatorDataFlags+          { M.adfUserPresent = Bits.testBit bitFlags 0,+            M.adfUserVerified = Bits.testBit bitFlags 2+          }++  -- https://www.w3.org/TR/webauthn-2/#signcount+  adSignCount <- M.SignatureCounter <$> runBinary Binary.getWord32be++  -- https://www.w3.org/TR/webauthn-2/#attestedcredentialdata+  adAttestedCredentialData <- case (sing @c, Bits.testBit bitFlags 6) of+    -- For [attestation signatures](https://www.w3.org/TR/webauthn-2/#attestation-signature),+    -- the authenticator MUST set the AT [flag](https://www.w3.org/TR/webauthn-2/#flags)+    -- and include the `[attestedCredentialData](https://www.w3.org/TR/webauthn-2/#attestedcredentialdata)`.+    (K.SRegistration, True) -> decodeAttestedCredentialData+    (K.SRegistration, False) -> throwError "Expected attested credential data, but there is none"+    -- For [assertion signatures](https://www.w3.org/TR/webauthn-2/#assertion-signature),+    -- the AT [flag](https://www.w3.org/TR/webauthn-2/#flags) MUST NOT be set and the+    -- `[attestedCredentialData](https://www.w3.org/TR/webauthn-2/#attestedcredentialdata)` MUST NOT be included.+    (K.SAuthentication, False) -> pure M.NoAttestedCredentialData+    (K.SAuthentication, True) -> throwError "Expected no attested credential data, but there is"++  -- https://www.w3.org/TR/webauthn-2/#authdataextensions+  adExtensions <-+    if Bits.testBit bitFlags 7+      then Just <$> decodeExtensions+      else pure Nothing++  pure M.AuthenticatorData {..}+  where+    decodeAttestedCredentialData :: PartialBinaryDecoder (M.AttestedCredentialData 'K.Registration 'True)+    decodeAttestedCredentialData = do+      -- https://www.w3.org/TR/webauthn-2/#aaguid+      acdAaguid <-+        -- Note: fromJust is safe because UUID.fromByteString only returns+        -- nothing if there's not exactly 16 bytes+        AAGUID . fromJust . UUID.fromByteString+          <$> runBinary (Binary.getLazyByteString 16)++      -- https://www.w3.org/TR/webauthn-2/#credentialidlength+      credentialLength <-+        runBinary Binary.getWord16be++      -- https://www.w3.org/TR/webauthn-2/#credentialid+      acdCredentialId <-+        M.CredentialId+          <$> runBinary (Binary.getByteString (fromIntegral credentialLength))++      -- https://www.w3.org/TR/webauthn-2/#credentialpublickey+      (usedBytes, acdCredentialPublicKey) <- runCBOR decode+      let acdCredentialPublicKeyBytes = M.WithRaw $ LBS.toStrict usedBytes++      pure M.AttestedCredentialData {..}++    decodeExtensions :: PartialBinaryDecoder M.AuthenticatorExtensionOutputs+    decodeExtensions = do+      -- TODO: Extensions are not implemented by this library, see the TODO in the+      -- module documentation of `Crypto.WebAuthn.Model` for more information.+      (_, _extensions :: CBOR.Term) <- runCBOR CBOR.decodeTerm+      pure M.AuthenticatorExtensionOutputs {}++-- | Decodes a 'M.AttestationObject' from a 'BS.ByteString'.+-- This is needed to parse a webauthn clients+-- [attestationObject](https://www.w3.org/TR/webauthn-2/#dom-authenticatorattestationresponse-attestationobject)+-- field in the [AuthenticatorAttestationResponse](https://www.w3.org/TR/webauthn-2/#iface-authenticatorattestationresponse)+-- structure This function takes a 'M.SupportedAttestationStatementFormats'+-- argument to indicate which attestation statement formats are supported.+-- structure+decodeAttestationObject :: M.SupportedAttestationStatementFormats -> BS.ByteString -> Either Text (M.AttestationObject 'True)+decodeAttestationObject supportedFormats bytes = do+  (_consumed, result) <- runPartialBinaryDecoder bytes (runCBOR CBOR.decodeTerm)+  pairs <- case result of+    CBOR.TMap pairs -> return pairs+    _ -> Left $ "The attestation object should be a CBOR map, but it's not: " <> Text.pack (show result)++  -- https://www.w3.org/TR/webauthn-2/#sctn-generating-an-attestation-object+  case (CBOR.TString "authData" `lookup` pairs, CBOR.TString "fmt" `lookup` pairs, CBOR.TString "attStmt" `lookup` pairs) of+    (Just (CBOR.TBytes authDataBytes), Just (CBOR.TString fmt), Just (CBOR.TMap attStmtPairs)) -> do+      aoAuthData <- decodeAuthenticatorData authDataBytes++      case M.lookupAttestationStatementFormat fmt supportedFormats of+        Nothing -> Left $ "Unknown attestation statement format: " <> fmt+        Just (M.SomeAttestationStatementFormat aoFmt) -> do+          attStmtMap <-+            HashMap.fromList+              <$> forM+                attStmtPairs+                ( \case+                    (CBOR.TString text, term) -> pure (text, term)+                    (nonString, _) -> Left $ "Unexpected non-string attestation statement key: " <> Text.pack (show nonString)+                )+          aoAttStmt <- M.asfDecode aoFmt attStmtMap+          pure M.AttestationObject {..}+    _ -> Left $ "The attestation object doesn't have the expected structure of (authData: bytes, fmt: string, attStmt: map): " <> Text.pack (show result)++--- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-client-data)+--- Intermediate type used to extract the JSON structure stored in the+--- CBOR-encoded [clientDataJSON](https://www.w3.org/TR/webauthn-2/#dom-authenticatorresponse-clientdatajson).+data ClientDataJSON = ClientDataJSON+  { littype :: IDL.DOMString,+    challenge :: IDL.DOMString,+    origin :: IDL.DOMString,+    crossOrigin :: Maybe IDL.Boolean+    -- TODO: We do not implement TokenBinding, see the documentation of+    -- `CollectedClientData` for more information.+    -- tokenBinding :: Maybe TokenBinding+  }+  deriving (Generic)+  -- Note: Encoding should NOT be derived via aeson. See the Encoding module instead+  deriving (Aeson.FromJSON) via JSONEncoding ClientDataJSON++-- | Decodes a 'M.CollectedClientData' from a 'BS.ByteString'. This is needed+-- to parse the [clientDataJSON](https://www.w3.org/TR/webauthn-2/#dom-authenticatorresponse-clientdatajson)+-- field in the [AuthenticatorResponse](https://www.w3.org/TR/webauthn-2/#iface-authenticatorresponse)+-- structure, which is used for both attestation and assertion+decodeCollectedClientData :: forall c. SingI c => BS.ByteString -> Either Text (M.CollectedClientData c 'True)+decodeCollectedClientData bytes = do+  -- https://www.w3.org/TR/webauthn-2/#collectedclientdata-json-compatible-serialization-of-client-data+  ClientDataJSON {..} <-+    first (("Collected client data JSON decoding error: " <>) . Text.pack) $+      Aeson.eitherDecodeStrict bytes+  -- [(spec)](https://www.w3.org/TR/webauthn-2/#dom-collectedclientdata-challenge)+  -- This member contains the base64url encoding of the challenge provided by the+  -- [Relying Party](https://www.w3.org/TR/webauthn-2/#relying-party). See the+  -- [§ 13.4.3 Cryptographic Challenges](https://www.w3.org/TR/webauthn-2/#sctn-cryptographic-challenges)+  -- security consideration.+  challenge <-+    first ((("Failed to base64url-decode challenge " <> challenge <> ": ") <>) . Text.pack) $+      Base64Url.decode (Text.encodeUtf8 challenge)+  -- [(spec)](https://www.w3.org/TR/webauthn-2/#dom-collectedclientdata-type)+  -- This member contains the string "webauthn.create" when creating new credentials,+  -- and "webauthn.get" when getting an assertion from an existing credential.+  -- The purpose of this member is to prevent certain types of signature confusion+  -- attacks (where an attacker substitutes one legitimate signature for another).+  let expectedType = case sing @c of+        K.SRegistration -> "webauthn.create"+        K.SAuthentication -> "webauthn.get"+  unless (littype == expectedType) $+    Left $+      "Expected collected client data to have webauthn type " <> expectedType <> " but it is " <> littype+  pure+    M.CollectedClientData+      { ccdChallenge = M.Challenge challenge,+        ccdOrigin = M.Origin origin,+        ccdCrossOrigin = fromMaybe False crossOrigin,+        ccdRawData = M.WithRaw bytes+      }

@@ -0,0 +1,199 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Stability: internal+-- Certain parts of the specification require that data is encoded to a+-- binary form. This module holds such functions.+module Crypto.WebAuthn.Model.WebIDL.Internal.Binary.Encoding+  ( -- * Encoding raw fields+    encodeRawCredential,+    encodeRawAuthenticatorData,+    encodeRawCollectedClientData,++    -- * Encoding structures to bytes+    encodeAttestationObject,+    encodeCollectedClientData,+  )+where++import qualified Codec.CBOR.Term as CBOR+import qualified Codec.CBOR.Write as CBOR+import Codec.Serialise (Serialise (encode))+import Crypto.WebAuthn.Model.Identifier (AAGUID (unAAGUID))+import qualified Crypto.WebAuthn.Model.Kinds as K+import qualified Crypto.WebAuthn.Model.Types as M+import qualified Data.Aeson as Aeson+import qualified Data.Binary.Put as Binary+import Data.Bits ((.|.))+import qualified Data.Bits as Bits+import Data.ByteArray (convert)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base64.URL as Base64Url+import Data.ByteString.Builder (Builder, stringUtf8, toLazyByteString)+import qualified Data.ByteString.Lazy as LBS+import Data.Singletons (SingI, sing)+import Data.Text (Text)+import Data.Text.Encoding (decodeUtf8)+import qualified Data.UUID as UUID+import Data.Word (Word16, Word8)++-- | Encodes all raw fields of a 'M.Credential'. This function is+-- mainly useful for testing that the encoding/decoding functions are correct.+-- The counterpart to this function is 'Crypto.WebAuthn.Model.Binary.Decoding.stripRawCredential'+encodeRawCredential :: forall c raw. SingI c => M.Credential c raw -> M.Credential c 'True+encodeRawCredential M.Credential {..} =+  M.Credential+    { cResponse = case sing @c of+        K.SRegistration -> encodeRawAuthenticatorResponseRegistration cResponse+        K.SAuthentication -> encodeRawAuthenticatorResponseAuthentication cResponse,+      ..+    }+  where+    encodeRawAuthenticatorResponseAuthentication :: M.AuthenticatorResponse 'K.Authentication raw -> M.AuthenticatorResponse 'K.Authentication 'True+    encodeRawAuthenticatorResponseAuthentication M.AuthenticatorResponseAuthentication {..} =+      M.AuthenticatorResponseAuthentication+        { araClientData = encodeRawCollectedClientData araClientData,+          araAuthenticatorData = encodeRawAuthenticatorData araAuthenticatorData,+          ..+        }++    encodeRawAuthenticatorResponseRegistration :: M.AuthenticatorResponse 'K.Registration raw -> M.AuthenticatorResponse 'K.Registration 'True+    encodeRawAuthenticatorResponseRegistration M.AuthenticatorResponseRegistration {..} =+      M.AuthenticatorResponseRegistration+        { arrClientData = encodeRawCollectedClientData arrClientData,+          arrAttestationObject = encodeRawAttestationObject arrAttestationObject,+          ..+        }++    encodeRawAttestationObject :: M.AttestationObject raw -> M.AttestationObject 'True+    encodeRawAttestationObject M.AttestationObject {..} =+      M.AttestationObject+        { aoAuthData = encodeRawAuthenticatorData aoAuthData,+          ..+        }++-- | Encodes all raw fields of a 'M.AuthenticatorData'. This function is needed+-- for an authenticator implementation+encodeRawAuthenticatorData :: forall c raw. SingI c => M.AuthenticatorData c raw -> M.AuthenticatorData c 'True+encodeRawAuthenticatorData M.AuthenticatorData {..} =+  M.AuthenticatorData+    { adRawData = M.WithRaw bytes,+      adAttestedCredentialData = rawAttestedCredentialData,+      ..+    }+  where+    rawAttestedCredentialData = encodeRawAttestedCredentialData adAttestedCredentialData++    bytes :: BS.ByteString+    bytes = LBS.toStrict $ toLazyByteString builder++    -- https://www.w3.org/TR/webauthn-2/#flags+    flags :: Word8+    flags =+      userPresentFlag+        .|. userVerifiedFlag+        .|. attestedCredentialDataPresentFlag+        .|. extensionsPresentFlag+      where+        userPresentFlag = if M.adfUserPresent adFlags then Bits.bit 0 else 0+        userVerifiedFlag = if M.adfUserVerified adFlags then Bits.bit 2 else 0+        attestedCredentialDataPresentFlag = case sing @c of+          K.SRegistration -> Bits.bit 6+          K.SAuthentication -> 0+        extensionsPresentFlag = case adExtensions of+          Just _ -> Bits.bit 7+          Nothing -> 0++    -- https://www.w3.org/TR/webauthn-2/#sctn-authenticator-data+    builder :: Builder+    builder =+      Binary.execPut (Binary.putByteString $ convert $ M.unRpIdHash adRpIdHash)+        <> Binary.execPut (Binary.putWord8 flags)+        <> Binary.execPut (Binary.putWord32be $ M.unSignatureCounter adSignCount)+        <> ( case sing @c of+               K.SRegistration -> encodeAttestedCredentialData rawAttestedCredentialData+               K.SAuthentication -> mempty+           )+        <> maybe mempty encodeExtensions adExtensions++    encodeExtensions :: M.AuthenticatorExtensionOutputs -> Builder+    encodeExtensions M.AuthenticatorExtensionOutputs {} = CBOR.toBuilder $ CBOR.encodeTerm (CBOR.TMap [])++    -- https://www.w3.org/TR/webauthn-2/#sctn-attested-credential-data+    encodeAttestedCredentialData :: M.AttestedCredentialData 'K.Registration 'True -> Builder+    encodeAttestedCredentialData M.AttestedCredentialData {..} =+      Binary.execPut (Binary.putLazyByteString $ UUID.toByteString $ unAAGUID acdAaguid)+        <> Binary.execPut (Binary.putWord16be credentialLength)+        <> Binary.execPut (Binary.putByteString $ M.unCredentialId acdCredentialId)+        <> Binary.execPut (Binary.putByteString $ M.unRaw acdCredentialPublicKeyBytes)+      where+        credentialLength :: Word16+        credentialLength = fromIntegral $ BS.length $ M.unCredentialId acdCredentialId++    encodeRawAttestedCredentialData :: forall c raw. SingI c => M.AttestedCredentialData c raw -> M.AttestedCredentialData c 'True+    encodeRawAttestedCredentialData = case sing @c of+      K.SRegistration -> \M.AttestedCredentialData {..} ->+        M.AttestedCredentialData+          { acdCredentialPublicKeyBytes =+              M.WithRaw $ LBS.toStrict $ CBOR.toLazyByteString $ encode acdCredentialPublicKey,+            ..+          }+      K.SAuthentication -> \M.NoAttestedCredentialData -> M.NoAttestedCredentialData++-- | Encodes all raw fields of a 'M.CollectedClientData'. This function is+-- needed for a client implementation+encodeRawCollectedClientData :: forall c raw. SingI c => M.CollectedClientData c raw -> M.CollectedClientData c 'True+encodeRawCollectedClientData M.CollectedClientData {..} = M.CollectedClientData {..}+  where+    ccdRawData = M.WithRaw $ LBS.toStrict $ toLazyByteString builder++    -- https://www.w3.org/TR/webauthn-2/#clientdatajson-serialization+    builder :: Builder+    builder =+      stringUtf8 "{\"type\":"+        <> jsonBuilder typeValue+        <> stringUtf8 ",\"challenge\":"+        <> jsonBuilder challengeValue+        <> stringUtf8 ",\"origin\":"+        <> jsonBuilder originValue+        <> stringUtf8 ",\"crossOrigin\":"+        <> jsonBuilder crossOriginValue+        <> stringUtf8 "}"++    typeValue :: Text+    typeValue = case sing @c of+      K.SRegistration -> "webauthn.create"+      K.SAuthentication -> "webauthn.get"++    challengeValue :: Text+    challengeValue = decodeUtf8 (Base64Url.encode (M.unChallenge ccdChallenge))++    originValue :: Text+    originValue = M.unOrigin ccdOrigin++    crossOriginValue :: Bool+    crossOriginValue = ccdCrossOrigin++    jsonBuilder :: Aeson.ToJSON a => a -> Builder+    jsonBuilder = Aeson.fromEncoding . Aeson.toEncoding++-- | Encodes an 'M.AttestationObject' as a 'BS.ByteString'. This is needed by+-- the client side to generate a valid JSON response+encodeAttestationObject :: M.AttestationObject 'True -> BS.ByteString+encodeAttestationObject M.AttestationObject {..} = CBOR.toStrictByteString $ CBOR.encodeTerm term+  where+    -- https://www.w3.org/TR/webauthn-2/#sctn-generating-an-attestation-object+    term :: CBOR.Term+    term =+      CBOR.TMap+        [ (CBOR.TString "authData", CBOR.TBytes $ M.unRaw $ M.adRawData aoAuthData),+          (CBOR.TString "fmt", CBOR.TString $ M.asfIdentifier aoFmt),+          (CBOR.TString "attStmt", M.asfEncode aoFmt aoAttStmt)+        ]++-- | Encodes an 'M.CollectedClientData' as a 'BS.ByteString'. This is needed by+-- the client side to generate a valid JSON response+encodeCollectedClientData :: forall c. SingI c => M.CollectedClientData c 'True -> BS.ByteString+encodeCollectedClientData M.CollectedClientData {..} = M.unRaw ccdRawData

@@ -0,0 +1,129 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}++-- | Stability: internal+-- This module maps every Model type to a WebIDL type. As the name of the+-- module and typclass suggest, this is used to perform the conversion between+-- the WebIDL and Model representations.+module Crypto.WebAuthn.Model.WebIDL.Internal.Convert+  ( Convert (..),+  )+where++import qualified Crypto.WebAuthn.Cose.Algorithm as Cose+import qualified Crypto.WebAuthn.Model.Kinds as K+import qualified Crypto.WebAuthn.Model.Types as M+import qualified Crypto.WebAuthn.Model.WebIDL.Types as IDL+import qualified Crypto.WebAuthn.WebIDL as IDL+import qualified Data.Aeson as Aeson+import Data.Kind (Type)+import Data.Map (Map)+import Data.Text (Text)++-- | @'Convert' hs@ indicates that the Haskell-specific type @hs@ has a more+-- general JavaScript-specific type associated with it, which can be accessed with 'IDL'.+class Convert hs where+  type IDL hs :: Type++instance Convert hs => Convert (Maybe hs) where+  type IDL (Maybe hs) = Maybe (IDL hs)++instance Convert M.RpId where+  type IDL M.RpId = IDL.DOMString++instance Convert M.RelyingPartyName where+  type IDL M.RelyingPartyName = IDL.DOMString++instance Convert M.CredentialRpEntity where+  type IDL M.CredentialRpEntity = IDL.PublicKeyCredentialRpEntity++instance Convert M.UserHandle where+  type IDL M.UserHandle = IDL.BufferSource++instance Convert M.UserAccountDisplayName where+  type IDL M.UserAccountDisplayName = IDL.DOMString++instance Convert M.UserAccountName where+  type IDL M.UserAccountName = IDL.DOMString++instance Convert M.CredentialUserEntity where+  type IDL M.CredentialUserEntity = IDL.PublicKeyCredentialUserEntity++instance Convert M.Challenge where+  type IDL M.Challenge = IDL.BufferSource++instance Convert M.CredentialType where+  type IDL M.CredentialType = IDL.DOMString++instance Convert Cose.CoseSignAlg where+  type IDL Cose.CoseSignAlg = IDL.COSEAlgorithmIdentifier++instance Convert [M.CredentialParameters] where+  type IDL [M.CredentialParameters] = [IDL.PublicKeyCredentialParameters]++instance Convert M.Timeout where+  type IDL M.Timeout = IDL.UnsignedLong++instance Convert M.CredentialId where+  type IDL M.CredentialId = IDL.BufferSource++instance Convert [M.AuthenticatorTransport] where+  type IDL [M.AuthenticatorTransport] = [IDL.DOMString]++instance Convert M.CredentialDescriptor where+  type IDL M.CredentialDescriptor = IDL.PublicKeyCredentialDescriptor++instance Convert [M.CredentialDescriptor] where+  type IDL [M.CredentialDescriptor] = Maybe [IDL.PublicKeyCredentialDescriptor]++instance Convert M.AuthenticatorAttachment where+  type IDL M.AuthenticatorAttachment = IDL.DOMString++instance Convert M.ResidentKeyRequirement where+  type IDL M.ResidentKeyRequirement = Maybe IDL.DOMString++instance Convert M.UserVerificationRequirement where+  type IDL M.UserVerificationRequirement = Maybe IDL.DOMString++instance Convert M.AuthenticatorSelectionCriteria where+  type IDL M.AuthenticatorSelectionCriteria = IDL.AuthenticatorSelectionCriteria++instance Convert M.AttestationConveyancePreference where+  type IDL M.AttestationConveyancePreference = Maybe IDL.DOMString++instance Convert M.AuthenticationExtensionsClientInputs where+  type IDL M.AuthenticationExtensionsClientInputs = Map Text Aeson.Value++instance Convert (M.CredentialOptions 'K.Registration) where+  type IDL (M.CredentialOptions 'K.Registration) = IDL.PublicKeyCredentialCreationOptions++instance Convert (M.CredentialOptions 'K.Authentication) where+  type IDL (M.CredentialOptions 'K.Authentication) = IDL.PublicKeyCredentialRequestOptions++instance Convert (M.Credential 'K.Registration raw) where+  type IDL (M.Credential 'K.Registration raw) = IDL.PublicKeyCredential IDL.AuthenticatorAttestationResponse++instance Convert (M.AuthenticatorResponse 'K.Registration raw) where+  type IDL (M.AuthenticatorResponse 'K.Registration raw) = IDL.AuthenticatorAttestationResponse++instance Convert (M.Credential 'K.Authentication raw) where+  type IDL (M.Credential 'K.Authentication raw) = IDL.PublicKeyCredential IDL.AuthenticatorAssertionResponse++instance Convert (M.AuthenticatorResponse 'K.Authentication raw) where+  type IDL (M.AuthenticatorResponse 'K.Authentication raw) = IDL.AuthenticatorAssertionResponse++instance Convert M.AuthenticationExtensionsClientOutputs where+  type IDL M.AuthenticationExtensionsClientOutputs = Map Text Aeson.Value++instance Convert (M.CollectedClientData c 'True) where+  type IDL (M.CollectedClientData c 'True) = IDL.ArrayBuffer++instance Convert (M.AttestationObject 'True) where+  type IDL (M.AttestationObject 'True) = IDL.ArrayBuffer++instance Convert M.AssertionSignature where+  type IDL M.AssertionSignature = IDL.ArrayBuffer++instance Convert (M.AuthenticatorData 'K.Authentication raw) where+  type IDL (M.AuthenticatorData 'K.Authentication raw) = IDL.ArrayBuffer

@@ -0,0 +1,242 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RecordWildCards #-}++-- | Stability: internal+-- This module handles the decoding of structures returned by the+-- [create()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-create)+-- and [get()](https://w3c.github.io/webappsec-credential-management/#dom-credentialscontainer-get)+-- methods while [Registering a New Credential](https://www.w3.org/TR/webauthn-2/#sctn-registering-a-new-credential)+-- and [Verifying an Authentication Assertion](https://www.w3.org/TR/webauthn-2/#sctn-verifying-assertion) respectively.+module Crypto.WebAuthn.Model.WebIDL.Internal.Decoding+  ( Decode (..),+    DecodeCreated (..),+  )+where++import qualified Crypto.WebAuthn.Cose.Algorithm as Cose+import qualified Crypto.WebAuthn.Model.Kinds as K+import qualified Crypto.WebAuthn.Model.Types as M+import qualified Crypto.WebAuthn.Model.WebIDL.Internal.Binary.Decoding as B+import Crypto.WebAuthn.Model.WebIDL.Internal.Convert (Convert (IDL))+import qualified Crypto.WebAuthn.Model.WebIDL.Types as IDL+import qualified Crypto.WebAuthn.WebIDL as IDL+import Data.Coerce (Coercible, coerce)+import Data.Maybe (catMaybes, mapMaybe)+import Data.Singletons (SingI)+import Data.Text (Text)++-- | @'Decode' a@ indicates that the Haskell-specific type @a@ can be+-- decoded from the more generic JavaScript type @'IDL' a@ with the 'decode' function.+class Convert a => Decode a where+  decode :: IDL a -> Either Text a+  default decode :: Coercible (IDL a) a => IDL a -> Either Text a+  decode = pure . coerce++-- | Like 'Decode', but with a 'decodeCreated' function that also takes a+-- 'M.SupportedAttestationStatementFormats' in order to allow decoding to depend+-- on the supported attestation formats.+class Convert a => DecodeCreated a where+  decodeCreated :: M.SupportedAttestationStatementFormats -> IDL a -> Either Text a++instance Decode a => Decode (Maybe a) where+  decode Nothing = pure Nothing+  decode (Just a) = Just <$> decode a++instance Decode M.CredentialId++instance Decode M.AssertionSignature++instance Decode M.UserHandle++instance Decode M.AuthenticationExtensionsClientOutputs where+  -- TODO: Extensions are not implemented by this library, see the TODO in the+  -- module documentation of `Crypto.WebAuthn.Model` for more information.+  decode _ = pure M.AuthenticationExtensionsClientOutputs {}++instance SingI c => Decode (M.CollectedClientData c 'True) where+  decode (IDL.URLEncodedBase64 bytes) = B.decodeCollectedClientData bytes++instance Decode (M.AuthenticatorData 'K.Authentication 'True) where+  decode (IDL.URLEncodedBase64 bytes) = B.decodeAuthenticatorData bytes++instance Decode (M.AuthenticatorResponse 'K.Authentication 'True) where+  decode IDL.AuthenticatorAssertionResponse {..} = do+    araClientData <- decode clientDataJSON+    araAuthenticatorData <- decode authenticatorData+    araSignature <- decode signature+    araUserHandle <- decode userHandle+    pure $ M.AuthenticatorResponseAuthentication {..}++instance Decode (M.Credential 'K.Authentication 'True) where+  decode IDL.PublicKeyCredential {..} = do+    cIdentifier <- decode rawId+    cResponse <- decode response+    cClientExtensionResults <- decode clientExtensionResults+    pure $ M.Credential {..}++instance Decode M.RpId++instance Decode M.RelyingPartyName++instance Decode M.CredentialRpEntity where+  decode IDL.PublicKeyCredentialRpEntity {..} = do+    creId <- decode id+    creName <- decode name+    pure $ M.CredentialRpEntity {..}++instance Decode M.UserAccountDisplayName++instance Decode M.UserAccountName++instance Decode M.CredentialUserEntity where+  decode IDL.PublicKeyCredentialUserEntity {..} = do+    cueId <- decode id+    cueDisplayName <- decode displayName+    cueName <- decode name+    pure $ M.CredentialUserEntity {..}++instance Decode M.Challenge++instance Decode Cose.CoseSignAlg where+  -- The specification does not inspect the algorithm until+  -- assertion/attestation. We implement the check here to go to a Haskell+  -- type. Erring on the side of caution by failing to parse if an unsupported+  -- alg was encountered.+  decode = Cose.toCoseSignAlg++instance Decode M.Timeout++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enum-transport)+instance Decode [M.AuthenticatorTransport] where+  decode = pure . mapMaybe decodeTransport+    where+      decodeTransport "usb" = Just M.AuthenticatorTransportUSB+      decodeTransport "nfc" = Just M.AuthenticatorTransportNFC+      decodeTransport "ble" = Just M.AuthenticatorTransportBLE+      decodeTransport "internal" = Just M.AuthenticatorTransportInternal+      decodeTransport _ = Nothing++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-credential-descriptor)+-- [The type] member contains the type of the public key credential the caller+-- is referring to. The value SHOULD be a member of+-- PublicKeyCredentialType but client platforms MUST ignore any+-- PublicKeyCredentialDescriptor with an unknown type.+instance Decode [M.CredentialDescriptor] where+  decode Nothing = pure []+  decode (Just xs) = catMaybes <$> traverse decodeDescriptor xs+    where+      decodeDescriptor :: IDL.PublicKeyCredentialDescriptor -> Either Text (Maybe M.CredentialDescriptor)+      decodeDescriptor IDL.PublicKeyCredentialDescriptor {littype = "public-key", ..} = do+        let cdTyp = M.CredentialTypePublicKey+        cdId <- decode id+        cdTransports <- decode transports+        pure . Just $ M.CredentialDescriptor {..}+      decodeDescriptor _ = pure Nothing++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enum-userVerificationRequirement)+-- The value SHOULD be a member of UserVerificationRequirement but client+-- platforms MUST ignore unknown values, treating an unknown value as if the+-- member does not exist. The default is "preferred".+instance Decode M.UserVerificationRequirement where+  decode (Just "discouraged") = Right M.UserVerificationRequirementDiscouraged+  decode (Just "preferred") = Right M.UserVerificationRequirementPreferred+  decode (Just "required") = Right M.UserVerificationRequirementRequired+  decode _ = Right M.UserVerificationRequirementPreferred++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-authenticatorSelection)+instance Decode M.AuthenticatorSelectionCriteria where+  decode IDL.AuthenticatorSelectionCriteria {..} = do+    let ascAuthenticatorAttachment = decodeAttachment =<< authenticatorAttachment+        ascResidentKey = decodeResidentKey residentKey+    ascUserVerification <- decode userVerification+    pure $ M.AuthenticatorSelectionCriteria {..}+    where+      -- Any unknown values must be ignored, treating them as if the member does not exist+      decodeAttachment "platform" = Just M.AuthenticatorAttachmentPlatform+      decodeAttachment "cross-platform" = Just M.AuthenticatorAttachmentCrossPlatform+      decodeAttachment _ = Nothing++      -- [(spec)](https://www.w3.org/TR/webauthn-2/#dom-authenticatorselectioncriteria-residentkey)+      -- The value SHOULD be a member of ResidentKeyRequirement but client platforms+      -- MUST ignore unknown values, treating an unknown value as if the member does not+      -- exist. If no value is given then the effective value is required if+      -- requireResidentKey is true or discouraged if it is false or absent.+      decodeResidentKey :: Maybe IDL.DOMString -> M.ResidentKeyRequirement+      decodeResidentKey (Just "discouraged") = M.ResidentKeyRequirementDiscouraged+      decodeResidentKey (Just "preferred") = M.ResidentKeyRequirementPreferred+      decodeResidentKey (Just "required") = M.ResidentKeyRequirementRequired+      decodeResidentKey _ = case requireResidentKey of+        Just True -> M.ResidentKeyRequirementRequired+        _ -> M.ResidentKeyRequirementDiscouraged++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#enumdef-attestationconveyancepreference)+-- Its values SHOULD be members of AttestationConveyancePreference. Client+-- platforms MUST ignore unknown values, treating an unknown value as if the+-- member does not exist. Its default value is "none".+instance Decode M.AttestationConveyancePreference where+  decode (Just "none") = Right M.AttestationConveyancePreferenceNone+  decode (Just "indirect") = Right M.AttestationConveyancePreferenceIndirect+  decode (Just "direct") = Right M.AttestationConveyancePreferenceDirect+  decode (Just "enterprise") = Right M.AttestationConveyancePreferenceEnterprise+  decode _ = Right M.AttestationConveyancePreferenceNone++-- [(spec)](https://www.w3.org/TR/webauthn-2/#dictdef-publickeycredentialparameters)+-- [The type] member specifies the type of credential to be created. The value SHOULD+-- be a member of PublicKeyCredentialType but client platforms MUST ignore+-- unknown values, ignoring any PublicKeyCredentialParameters with an unknown+-- type.+instance Decode [M.CredentialParameters] where+  decode xs = catMaybes <$> traverse decodeParam xs+    where+      decodeParam :: IDL.PublicKeyCredentialParameters -> Either Text (Maybe M.CredentialParameters)+      decodeParam IDL.PublicKeyCredentialParameters {littype = "public-key", ..} = do+        let cpTyp = M.CredentialTypePublicKey+        cpAlg <- decode alg+        pure . Just $ M.CredentialParameters {..}+      decodeParam _ = pure Nothing++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-makecredentialoptions)+instance Decode (M.CredentialOptions 'K.Registration) where+  decode IDL.PublicKeyCredentialCreationOptions {..} = do+    corRp <- decode rp+    corUser <- decode user+    corChallenge <- decode challenge+    corPubKeyCredParams <- decode pubKeyCredParams+    corTimeout <- decode timeout+    corExcludeCredentials <- decode excludeCredentials+    corAuthenticatorSelection <- decode authenticatorSelection+    corAttestation <- decode attestation+    let corExtensions = M.AuthenticationExtensionsClientInputs {} <$ extensions+    pure $ M.CredentialOptionsRegistration {..}++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#dictionary-assertion-options)+instance Decode (M.CredentialOptions 'K.Authentication) where+  decode IDL.PublicKeyCredentialRequestOptions {..} = do+    coaChallenge <- decode challenge+    coaTimeout <- decode timeout+    coaRpId <- decode rpId+    coaAllowCredentials <- decode allowCredentials+    coaUserVerification <- decode userVerification+    let coaExtensions = M.AuthenticationExtensionsClientInputs {} <$ extensions+    pure $ M.CredentialOptionsAuthentication {..}++-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-generating-an-attestation-object)+instance DecodeCreated (M.AttestationObject 'True) where+  decodeCreated supportedFormats (IDL.URLEncodedBase64 bytes) =+    B.decodeAttestationObject supportedFormats bytes++instance DecodeCreated (M.AuthenticatorResponse 'K.Registration 'True) where+  decodeCreated supportedFormats IDL.AuthenticatorAttestationResponse {..} = do+    arrClientData <- decode clientDataJSON+    arrAttestationObject <- decodeCreated supportedFormats attestationObject+    pure $ M.AuthenticatorResponseRegistration {..}++instance DecodeCreated (M.Credential 'K.Registration 'True) where+  decodeCreated supportedFormats IDL.PublicKeyCredential {..} = do+    cIdentifier <- decode rawId+    cResponse <- decodeCreated supportedFormats response+    cClientExtensionResults <- decode clientExtensionResults+    pure $ M.Credential {..}