diff --git a/.github/workflows/build-master.yml b/.github/workflows/build-master.yml index 17223c3..ee99e15 100644 --- a/.github/workflows/build-master.yml +++ b/.github/workflows/build-master.yml @@ -13,9 +13,9 @@ jobs: - name: Checkout uses: actions/checkout@v2 with: - persist-credentials: falsene + persist-credentials: false - - uses: cachix/install-nix-action@v22 + - uses: cachix/install-nix-action@v30 with: extra_nix_config: | access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} diff --git a/.github/workflows/check-pr.yml b/.github/workflows/check-pr.yml index c559d0b..bfecabf 100644 --- a/.github/workflows/check-pr.yml +++ b/.github/workflows/check-pr.yml @@ -3,7 +3,7 @@ name: Check PR on: pull_request: branches: - - master + - master jobs: opam: @@ -13,10 +13,10 @@ jobs: os: - macos-latest - ubuntu-latest - - windows-latest + # - windows-latest ocaml-compiler: - - 4.13.x - - 4.08.x + - 4.14.x + - 5.2.x runs-on: ${{ matrix.os }} @@ -45,15 +45,11 @@ jobs: with: persist-credentials: false - - uses: cachix/install-nix-action@v22 + - uses: cachix/install-nix-action@v30 with: extra_nix_config: | access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} - - uses: cachix/cachix-action@v12 - with: - name: anmonteiro - - name: Build run: nix develop --accept-flake-config -c dune build @@ -61,7 +57,7 @@ jobs: run: nix develop --accept-flake-config -c dune build @runtest --instrument-with bisect_ppx --force - name: Upload coverage - run: nix develop --accept-flake-config -c bisect-ppx-report send-to Codecov + run: nix develop --accept-flake-config -c bisect-ppx-report send-to Codecov --repo-token="${{ secrets.CODECOV_TOKEN }}" - name: Build docs run: nix develop --accept-flake-config -c dune build @doc diff --git a/.ocamlformat b/.ocamlformat index 8ede855..c27fddb 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -1,3 +1,3 @@ -version = 0.24.1 +version = 0.27.0 wrap-comments = false diff --git a/CHANGES.md b/CHANGES.md index 8c545d3..4647ffe 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,7 @@ +next +-------------- +- Upgrade mirage-crypto and remove cstruct + 0.9.0 -------------- - Support all serialization formats, previously only the compact serialization was supported, now we support both general and flattened JSON format (by @ulrikstrid) diff --git a/dune-project b/dune-project index 151a81a..0e93025 100644 --- a/dune-project +++ b/dune-project @@ -33,11 +33,9 @@ (eqaf (>= 0.7)) (mirage-crypto - (>= 0.10.0)) + (>= 1.0.0)) (x509 (>= 0.13.0)) - (cstruct - (>= 6.0.0)) astring (yojson (>= 1.6.0)) @@ -46,7 +44,8 @@ (mirage-crypto-rng (and :with-test - (>= 0.11.0))) + (>= 1.0.0))) + digestif (containers :with-test) (bisect_ppx :with-test) (alcotest :with-test) diff --git a/flake.lock b/flake.lock index 055482e..aca27d4 100644 --- a/flake.lock +++ b/flake.lock @@ -5,11 +5,11 @@ "nixpkgs-lib": "nixpkgs-lib" }, "locked": { - "lastModified": 1693611461, - "narHash": "sha256-aPODl8vAgGQ0ZYFIRisxYG5MOGSkIczvu2Cd8Gb9+1Y=", + "lastModified": 1733312601, + "narHash": "sha256-4pDvzqnegAfRkPwO3wmwBhVi/Sye1mzps0zHWYnP88c=", "owner": "hercules-ci", "repo": "flake-parts", - "rev": "7f53fdb7bdc5bb237da7fefef12d099e4fd611ca", + "rev": "205b12d8b7cd4802fbcb8e8ef6a0f1408781a4f9", "type": "github" }, "original": { @@ -17,31 +17,13 @@ "type": "indirect" } }, - "flake-utils": { - "inputs": { - "systems": "systems" - }, - "locked": { - "lastModified": 1694529238, - "narHash": "sha256-zsNZZGTGnMOf9YpHKJqMSsa0dXbfmxeoJ7xHlrt+xmY=", - "owner": "numtide", - "repo": "flake-utils", - "rev": "ff7b65b44d01cf9ba6a71320833626af21126384", - "type": "github" - }, - "original": { - "owner": "numtide", - "repo": "flake-utils", - "type": "github" - } - }, "nix-filter": { "locked": { - "lastModified": 1694857738, - "narHash": "sha256-bxxNyLHjhu0N8T3REINXQ2ZkJco0ABFPn6PIe2QUfqo=", + "lastModified": 1731533336, + "narHash": "sha256-oRam5PS1vcrr5UPgALW0eo1m/5/pls27Z/pabHNy2Ms=", "owner": "numtide", "repo": "nix-filter", - "rev": "41fd48e00c22b4ced525af521ead8792402de0ea", + "rev": "f7653272fd234696ae94229839a99b73c9ab7de0", "type": "github" }, "original": { @@ -52,15 +34,14 @@ }, "nixpkgs": { "inputs": { - "flake-utils": "flake-utils", "nixpkgs": "nixpkgs_2" }, "locked": { - "lastModified": 1695138105, - "narHash": "sha256-L1xVzf9PWVs4HNhEZMeeABEEV1KzIg8GnPBl2i2nkv8=", + "lastModified": 1734296314, + "narHash": "sha256-+s5qygpzLRk8bNIhB+CtNGq9AGgc1RsdpJ5ohKR09GA=", "owner": "nix-ocaml", "repo": "nix-overlays", - "rev": "81635bb16c283fbf40974c52e2a68fd26e1999a8", + "rev": "80a2e9371642261ffbe44eb94b233448672626d8", "type": "github" }, "original": { @@ -71,35 +52,29 @@ }, "nixpkgs-lib": { "locked": { - "dir": "lib", - "lastModified": 1693471703, - "narHash": "sha256-0l03ZBL8P1P6z8MaSDS/MvuU8E75rVxe5eE1N6gxeTo=", - "owner": "NixOS", - "repo": "nixpkgs", - "rev": "3e52e76b70d5508f3cec70b882a29199f4d1ee85", - "type": "github" + "lastModified": 1733096140, + "narHash": "sha256-1qRH7uAUsyQI7R1Uwl4T+XvdNv778H0Nb5njNrqvylY=", + "type": "tarball", + "url": "https://github.com/NixOS/nixpkgs/archive/5487e69da40cbd611ab2cadee0b4637225f7cfae.tar.gz" }, "original": { - "dir": "lib", - "owner": "NixOS", - "ref": "nixos-unstable", - "repo": "nixpkgs", - "type": "github" + "type": "tarball", + "url": "https://github.com/NixOS/nixpkgs/archive/5487e69da40cbd611ab2cadee0b4637225f7cfae.tar.gz" } }, "nixpkgs_2": { "locked": { - "lastModified": 1695043561, - "narHash": "sha256-ajrDIUJA5RB6Y2I1G4suDhiDMJuwg1WarNuasshRobE=", + "lastModified": 1734274429, + "narHash": "sha256-wl9o+8lyLxU182xws0yNo4odQNVaH8w7a7DzrcbZiSk=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "089313d7c7c864b21648d78fb8700062dafab1f2", + "rev": "539eaf79a5abc7efc5463dcc267d91e6ee4c3b49", "type": "github" }, "original": { "owner": "NixOS", "repo": "nixpkgs", - "rev": "089313d7c7c864b21648d78fb8700062dafab1f2", + "rev": "539eaf79a5abc7efc5463dcc267d91e6ee4c3b49", "type": "github" } }, @@ -111,21 +86,6 @@ "treefmt-nix": "treefmt-nix" } }, - "systems": { - "locked": { - "lastModified": 1681028828, - "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", - "owner": "nix-systems", - "repo": "default", - "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", - "type": "github" - }, - "original": { - "owner": "nix-systems", - "repo": "default", - "type": "github" - } - }, "treefmt-nix": { "inputs": { "nixpkgs": [ @@ -133,11 +93,11 @@ ] }, "locked": { - "lastModified": 1694528738, - "narHash": "sha256-aWMEjib5oTqEzF9f3WXffC1cwICo6v/4dYKjwNktV8k=", + "lastModified": 1733761991, + "narHash": "sha256-s4DalCDepD22jtKL5Nw6f4LP5UwoMcPzPZgHWjAfqbQ=", "owner": "numtide", "repo": "treefmt-nix", - "rev": "7a49c388d7a6b63bb551b1ddedfa4efab8f400d8", + "rev": "0ce9d149d99bc383d1f2d85f31f6ebd146e46085", "type": "github" }, "original": { diff --git a/jose.opam b/jose.opam index 8078111..9842e4c 100644 --- a/jose.opam +++ b/jose.opam @@ -17,14 +17,14 @@ depends: [ "base64" {>= "3.3.0"} "dune" {>= "2.8"} "eqaf" {>= "0.7"} - "mirage-crypto" {>= "0.10.0"} + "mirage-crypto" {>= "1.0.0"} "x509" {>= "0.13.0"} - "cstruct" {>= "6.0.0"} "astring" "yojson" {>= "1.6.0"} "zarith" "ptime" - "mirage-crypto-rng" {with-test & >= "0.11.0"} + "mirage-crypto-rng" {with-test & >= "1.0.0"} + "digestif" "containers" {with-test} "bisect_ppx" {with-test} "alcotest" {with-test} diff --git a/jose/Header.ml b/jose/Header.ml index 31af963..c455121 100644 --- a/jose/Header.ml +++ b/jose/Header.ml @@ -101,10 +101,9 @@ let to_json t = `Assoc (List.filter_map Fun.id values @ t.extra) let of_string header_str = - let s = U_Base64.url_decode header_str - in + let s = U_Base64.url_decode header_str in Result.bind s (fun decoded_header -> - Yojson.Safe.from_string decoded_header |> of_json) + Yojson.Safe.from_string decoded_header |> of_json) let to_string header = to_json header |> Yojson.Safe.to_string |> U_Base64.url_encode_string diff --git a/jose/Jose.mli b/jose/Jose.mli index 757886f..bf1e0be 100644 --- a/jose/Jose.mli +++ b/jose/Jose.mli @@ -1,6 +1,6 @@ (** {1 JSON Web Algorithm} - {{: https://www.tools.ietf.org/rfc/rfc7518.html } Link to RFC } *) + {{:https://www.tools.ietf.org/rfc/rfc7518.html} Link to RFC} *) module Jwa : sig type alg = [ `RS256 (** HMAC using SHA-256 *) @@ -14,10 +14,11 @@ module Jwa : sig | `None | `Unsupported of string ] - (** {{: https://tools.ietf.org/html/rfc7518#section-3.1 } Link to RFC} + (** {{:https://tools.ietf.org/html/rfc7518#section-3.1} Link to RFC} - [RS256] and [HS256] and none is currently the only supported algs for - signature - [RSA_OAEP] is currently the only supported alg for encryption *) + signature - [RSA_OAEP] is currently the only supported alg for + encryption *) val alg_to_string : alg -> string val alg_of_string : string -> alg @@ -26,12 +27,13 @@ module Jwa : sig type kty = [ `oct (** Octet sequence (used to represent symmetric keys) *) - | `RSA (** RSA {{: https://tools.ietf.org/html/rfc3447} Link to RFC} *) + | `RSA (** RSA {{:https://tools.ietf.org/html/rfc3447} Link to RFC} *) | `EC (** Elliptic Curve *) | `OKP - (** Octet Key Pair {{: https://www.rfc-editor.org/rfc/rfc8037.html} Link to RFC} *) + (** Octet Key Pair + {{:https://www.rfc-editor.org/rfc/rfc8037.html} Link to RFC} *) | `Unsupported of string ] - (** {{: https://tools.ietf.org/html/rfc7518#section-6.1 } Link to RFC } *) + (** {{:https://tools.ietf.org/html/rfc7518#section-6.1} Link to RFC} *) val kty_to_string : kty -> string val kty_of_string : string -> kty @@ -49,7 +51,7 @@ end (** {1 JSON Web Key} -{{: https://tools.ietf.org/html/rfc7517 } Link to RFC } *) + {{:https://tools.ietf.org/html/rfc7517} Link to RFC} *) module Jwk : sig type use = [ `Sig | `Enc | `Unsupported of string ] (** [use] will default to [`Sig] in all functions unless supplied *) @@ -96,10 +98,12 @@ module Jwk : sig (** [es512] represents a private JWK with [kty] [`EC] and a [P512.priv] key *) type priv_ed25519 = Mirage_crypto_ec.Ed25519.priv jwk - (** [ed25519] represents a public JWK with [kty] [`OKP] and a [Ed25519.pub] key *) + (** [ed25519] represents a public JWK with [kty] [`OKP] and a [Ed25519.pub] + key *) type pub_ed25519 = Mirage_crypto_ec.Ed25519.pub jwk - (** [ed25519] represents a private JWK with [kty] [`OKP] and a [Ed25519.priv] key *) + (** [ed25519] represents a private JWK with [kty] [`OKP] and a [Ed25519.priv] + key *) (** [t] describes a JSON Web Key which can be either [public] or [private] *) type 'a t = @@ -117,7 +121,8 @@ module Jwk : sig (** {1 Public keys} - These keys are safe to show and should be used to verify signed content. *) + These keys are safe to show and should be used to verify signed content. + *) val make_pub_rsa : ?use:use -> Mirage_crypto_pk.Rsa.pub -> public t (** [rsa_of_pub use pub] takes a public key generated by Nocrypto and returns @@ -140,7 +145,8 @@ module Jwk : sig ( public t, [> `Json_parse_failed of string | `Msg of string | `Unsupported_kty ] ) result - (** [of_pub_json t] takes a [Yojson.Safe.t] and tries to return a [public t] *) + (** [of_pub_json t] takes a [Yojson.Safe.t] and tries to return a [public t] + *) val of_pub_json_string : string -> @@ -218,9 +224,9 @@ module Jwk : sig When using it on [Oct] keys it will just return the same as it's a symetric key. *) - (** {1 Utils } - - Utils to get different data from a JWK *) + (** {1 Utils} + + Utils to get different data from a JWK *) val get_kid : 'a t -> string option (** [get_kid jwk] is a convencience function to get the kid string *) @@ -231,10 +237,9 @@ module Jwk : sig val get_alg : 'a t -> Jwa.alg option (** [get_alg jwk] is a convencience function to get the algorithm *) - val get_thumbprint : - Mirage_crypto.Hash.hash -> 'a t -> (Cstruct.t, [> `Unsafe ]) result + val get_thumbprint : Digestif.hash' -> 'a t -> (string, [> `Unsafe ]) result (** [get_thumbprint hash jwk] calculates the thumbprint of [jwk] with [hash], - following {{: https://tools.ietf.org/html/rfc7638 } RFC 7638 }. + following {{:https://tools.ietf.org/html/rfc7638} RFC 7638}. Returns an error for symmetric keys: sharing the hash may leak information about the key itself ans it's deemed unsafe. *) @@ -245,7 +250,7 @@ end (** {1 JSON Web Key Set} - {{: https://tools.ietf.org/html/rfc7517#section-5 } Link to RFC } *) + {{:https://tools.ietf.org/html/rfc7517#section-5} Link to RFC} *) module Jwks : sig type t = { keys : Jwk.public Jwk.t list } (** [t] describes a Private JSON Web Key Set *) @@ -259,7 +264,8 @@ module Jwks : sig val of_string : string -> t (** [of_string json_string] takes a JSON string representation and returns a - [t]. Keys that can not be serialized safely will be removed from the list *) + [t]. Keys that can not be serialized safely will be removed from the list + *) val to_string : t -> string (** [to_string t] takes a t and returns a JSON string representation *) @@ -280,18 +286,20 @@ module Header : sig extra : (string * Yojson.Safe.t) list; } (** The [header] has the following properties: - - - [alg] {! Jwa.alg } - - [jwk] JSON Web Key - - [kid] Key ID - We currently always expect this to be there, this can change in the future - - [x5t] X.509 Certificate SHA-1 Thumbprint - - - [x5t#S256] X.509 Certificate SHA-256 Thumbprint - - [typ] Type - - [cty] Content Type Not implemented - - {{: https://tools.ietf.org/html/rfc7515#section-4.1 } Link to RFC } - - {{: https://www.iana.org/assignments/jose/jose.xhtml#web-signature-encryption-header-parameters } Complete list of registered header parameters} *) + + - [alg] {! Jwa.alg } + - [jwk] JSON Web Key + - [kid] Key ID - We currently always expect this to be there, this can + change in the future + - [x5t] X.509 Certificate SHA-1 Thumbprint - + - [x5t#S256] X.509 Certificate SHA-256 Thumbprint + - [typ] Type + - [cty] Content Type Not implemented + + {{:https://tools.ietf.org/html/rfc7515#section-4.1} Link to RFC} + + {{:https://www.iana.org/assignments/jose/jose.xhtml#web-signature-encryption-header-parameters} + Complete list of registered header parameters} *) val make_header : ?typ:string -> @@ -302,7 +310,8 @@ module Header : sig Jwk.priv Jwk.t -> t (** [make_header typ alg enc jwk] if [alg] is not provided it will be derived - from [jwk]. [jwk_header] decides if the jwk should be put in the header. *) + from [jwk]. [jwk_header] decides if the jwk should be put in the header. + *) val of_string : string -> (t, [> `Msg of string ]) result val to_string : t -> string @@ -312,7 +321,7 @@ end (** {1 JSON Web Signature} - {{: https://tools.ietf.org/html/rfc7515 } Link to RFC } *) + {{:https://tools.ietf.org/html/rfc7515} Link to RFC} *) module Jws : sig type signature = string @@ -378,7 +387,8 @@ module Jwt : sig | `Not_json | `Not_supported ] ) result - (** [of_string ~jwk jwt_string] parses and validates the encoded JWT string. *) + (** [of_string ~jwk jwt_string] parses and validates the encoded JWT string. + *) val unsafe_of_string : string -> (t, [> `Msg of string | `Not_json | `Not_supported ]) result @@ -392,15 +402,16 @@ module Jwt : sig Jws.validate to validate the signature *) val check_expiration : now:Ptime.t -> t -> (t, [> `Expired ]) result - (** [check_expiration ~now t] checks whether the JWT is valid at the current time. *) + (** [check_expiration ~now t] checks whether the JWT is valid at the current + time. *) val validate : jwk:'a Jwk.t -> now:Ptime.t -> t -> (t, [> `Expired | `Invalid_signature | `Msg of string ]) result - (** [validate ~jwk ~now t] does the same validation as `validate_signature` and - additionally checks expiration. *) + (** [validate ~jwk ~now t] does the same validation as `validate_signature` + and additionally checks expiration. *) val sign : ?header:Header.t -> @@ -415,7 +426,7 @@ module Jwt : sig end module Jwe : sig - (** {{: https://tools.ietf.org/html/rfc7516 } Link to RFC } *) + (** {{:https://tools.ietf.org/html/rfc7516} Link to RFC} *) type t = { header : Header.t; @@ -448,5 +459,6 @@ module Jwe : sig [> `Invalid_JWE | `Invalid_JWK | `Decrypt_cek_failed | `Msg of string ] ) result - (** [decrypt jwk string] decrypts a compact string formated JWE into a {! t } *) + (** [decrypt jwk string] decrypts a compact string formated JWE into a {! t } + *) end diff --git a/jose/Jwe.ml b/jose/Jwe.ml index f177412..6d9b9b8 100644 --- a/jose/Jwe.ml +++ b/jose/Jwe.ml @@ -1,5 +1,5 @@ open Utils -(** {{: https://tools.ietf.org/html/rfc7516 } Link to RFC } *) +(** {{:https://tools.ietf.org/html/rfc7516} Link to RFC} *) type t = { header : Header.t; @@ -9,7 +9,7 @@ type t = { aad : string option; } -module RSA_OAEP = Mirage_crypto_pk.Rsa.OAEP (Mirage_crypto.Hash.SHA1) +module RSA_OAEP = Mirage_crypto_pk.Rsa.OAEP (Digestif.SHA1) (* Steps to create a JWE @@ -30,75 +30,67 @@ let make_cek (header : Header.t) = match header.enc with | Some enc -> let key_length = Jwa.enc_to_length enc in - Mirage_crypto_rng.generate (key_length / 8) - |> Cstruct.to_string |> Result.ok + Mirage_crypto_rng.generate (key_length / 8) |> Result.ok | None -> Error `Missing_enc let make_iv (header : Header.t) = match header.alg with | `RSA_OAEP -> - Mirage_crypto_rng.generate Mirage_crypto.Cipher_block.AES.GCM.block_size - |> Cstruct.to_string |> Result.ok - | `RSA1_5 -> - Mirage_crypto_rng.generate Mirage_crypto.Cipher_block.AES.CBC.block_size - |> Cstruct.to_string |> Result.ok + Ok (Mirage_crypto_rng.generate Mirage_crypto.AES.GCM.block_size) + | `RSA1_5 -> Ok (Mirage_crypto_rng.generate Mirage_crypto.AES.CBC.block_size) | _ -> Error `Unsupported_alg let make ~header payload = let cek = make_cek header in Result.bind cek (fun cek -> - let iv = make_iv header in - Result.bind iv (fun iv -> - let aad = None in - Ok { header; cek; iv; aad; payload })) + let iv = make_iv header in + Result.bind iv (fun iv -> + let aad = None in + Ok { header; cek; iv; aad; payload })) let encrypt_payload ?enc ~cek ~iv ~aad payload = - let iv = Cstruct.of_string iv in match enc with | Some `A128CBC_HS256 -> (* RFC 7516 appendix B.1: first 128 bit hmac, last 128 bit aes *) let hmac_key, aes_key = - Cstruct.( - split (of_string cek) Mirage_crypto.Cipher_block.AES.CBC.block_size) + U_String.split cek Mirage_crypto.AES.CBC.block_size in - let key = Mirage_crypto.Cipher_block.AES.CBC.of_secret aes_key in + let key = Mirage_crypto.AES.CBC.of_secret aes_key in (* B.2 encryption in CBC mode *) - Mirage_crypto.Cipher_block.AES.CBC.encrypt ~key ~iv - (Pkcs7.pad - (Cstruct.of_string payload) - Mirage_crypto.Cipher_block.AES.CBC.block_size) + Mirage_crypto.AES.CBC.encrypt ~key ~iv + (Pkcs7.pad payload Mirage_crypto.AES.CBC.block_size) |> fun data -> (* B.5 input to HMAC computation *) let hmac_input = (* B.3 64 bit big-endian AAD length (in bits!) *) - let aal = Cstruct.create 8 in - Cstruct.BE.set_uint64 aal 0 Int64.(mul 8L (of_int (String.length aad))); - Cstruct.(concat [ of_string aad; iv; data; aal ]) + let aal = Bytes.create 8 in + Bytes.set_int64_be aal 0 Int64.(mul 8L (of_int (String.length aad))); + String.concat "" [ aad; iv; data; Bytes.unsafe_to_string aal ] in let computed_auth_tag = - let full = Mirage_crypto.Hash.SHA256.hmac ~key:hmac_key hmac_input in + let full = + Digestif.SHA256.hmac_string ~key:hmac_key hmac_input + |> Digestif.SHA256.to_raw_string + in (* B.7 truncate to 128 bit *) - Cstruct.sub full 0 16 |> Cstruct.to_string + String.sub full 0 16 in - Ok (Cstruct.to_string data, computed_auth_tag) + Ok (data, computed_auth_tag) | Some `A256GCM -> - let module GCM = Mirage_crypto.Cipher_block.AES.GCM in - let cek = Cstruct.of_string cek in + let module GCM = Mirage_crypto.AES.GCM in let key = GCM.of_secret cek in - let adata = Cstruct.of_string aad in - GCM.authenticate_encrypt ~key ~nonce:iv ~adata (Cstruct.of_string payload) - |> fun cdata -> + let adata = aad in + GCM.authenticate_encrypt ~key ~nonce:iv ~adata payload |> fun cdata -> let cipher, tag_data = - Cstruct.split cdata (Cstruct.length cdata - GCM.tag_size) + U_String.split cdata (String.length cdata - GCM.tag_size) in - let ciphertext = Cstruct.to_string cipher in - let tag_string = Cstruct.to_string tag_data in - Ok (ciphertext, tag_string) + Ok (cipher, tag_data) | None -> Error `Missing_enc | _ -> Error `Unsupported_enc let encrypt_cek (type a) alg (cek : string) ~(jwk : a Jwk.t) = - let key = match jwk with + let key = + match jwk with | Rsa_priv rsa -> Ok (Mirage_crypto_pk.Rsa.pub_of_priv rsa.key) | Rsa_pub rsa -> Ok rsa.key | Oct _ -> Error `Unsupported_kty @@ -112,19 +104,14 @@ let encrypt_cek (type a) alg (cek : string) ~(jwk : a Jwk.t) = | Ed25519_pub _ -> Error `Unsupported_kty in Result.bind key (fun key -> - match alg with - | `RSA1_5 -> - let ecek = - cek |> Cstruct.of_string - |> Mirage_crypto_pk.Rsa.PKCS1.encrypt ~key - |> Cstruct.to_string - in - Ok ecek - | `RSA_OAEP -> - let cek = Cstruct.of_string cek in - let jek = RSA_OAEP.encrypt ~key cek |> Cstruct.to_string in - Ok jek - | _ -> Error `Invalid_alg) + match alg with + | `RSA1_5 -> + let ecek = Mirage_crypto_pk.Rsa.PKCS1.encrypt ~key cek in + Ok ecek + | `RSA_OAEP -> + let jek = RSA_OAEP.encrypt ~key cek in + Ok jek + | _ -> Error `Invalid_alg) let encrypt (type a) ~(jwk : a Jwk.t) t = let header_string = Header.to_string t.header in @@ -132,106 +119,97 @@ let encrypt (type a) ~(jwk : a Jwk.t) t = encrypt_cek t.header.alg t.cek ~jwk |> Result.map U_Base64.url_encode_string in Result.bind ecek (fun ecek -> - let eiv = U_Base64.url_encode_string t.iv in - let ciphertext = - encrypt_payload ?enc:t.header.enc ~cek:t.cek ~iv:t.iv ~aad:header_string - t.payload - in - Result.bind ciphertext (fun (ciphertext, auth_tag) -> - Ok - (String.concat "." - [ - header_string; - ecek; - eiv; - U_Base64.url_encode_string ciphertext; - U_Base64.url_encode_string auth_tag; - ]))) + let eiv = U_Base64.url_encode_string t.iv in + let ciphertext = + encrypt_payload ?enc:t.header.enc ~cek:t.cek ~iv:t.iv ~aad:header_string + t.payload + in + Result.bind ciphertext (fun (ciphertext, auth_tag) -> + Ok + (String.concat "." + [ + header_string; + ecek; + eiv; + U_Base64.url_encode_string ciphertext; + U_Base64.url_encode_string auth_tag; + ]))) let decrypt_cek alg str ~(jwk : Jwk.priv Jwk.t) = - let of_opt_cstruct = function - | Some c -> Ok (Cstruct.to_string c) + let of_opt_string = function + | Some c -> Ok c | None -> Error `Decrypt_cek_failed in match (alg, jwk) with | `RSA1_5, Jwk.Rsa_priv rsa -> - let decoded = Utils.U_Base64.url_decode str - |> Result.map (fun decoded -> - Cstruct.of_string decoded - |> Mirage_crypto_pk.Rsa.PKCS1.decrypt ~key:rsa.key) + let decoded = + Utils.U_Base64.url_decode str + |> Result.map (Mirage_crypto_pk.Rsa.PKCS1.decrypt ~key:rsa.key) in - Result.bind decoded of_opt_cstruct + Result.bind decoded of_opt_string | `RSA_OAEP, Jwk.Rsa_priv rsa -> let decoded = Utils.U_Base64.url_decode str - |> Result.map (fun decoded -> - Cstruct.of_string decoded - |> RSA_OAEP.decrypt ~key:rsa.key) + |> Result.map (RSA_OAEP.decrypt ~key:rsa.key) in - Result.bind decoded of_opt_cstruct + Result.bind decoded of_opt_string | _ -> Error `Invalid_JWK (* Move to Jwa? *) let decrypt_ciphertext enc ~cek ~iv ~auth_tag ~aad ciphertext = - let iv = Cstruct.of_string iv in let encrypted = U_Base64.url_decode ciphertext in Result.bind encrypted (fun encrypted -> - let encrypted = Cstruct.of_string encrypted in - match enc with - | Some `A128CBC_HS256 -> - (* RFC 7516 appendix B.1: first 128 bit hmac, last 128 bit aes *) - let hmac_key, aes_key = Cstruct.(split (of_string cek) 16) in - let key = Mirage_crypto.Cipher_block.AES.CBC.of_secret aes_key in + match enc with + | Some `A128CBC_HS256 -> + (* RFC 7516 appendix B.1: first 128 bit hmac, last 128 bit aes *) + let hmac_key, aes_key = U_String.split cek 16 in + let key = Mirage_crypto.AES.CBC.of_secret aes_key in - (* B.5 input to HMAC computation *) - let hmac_input = - (* B.3 64 bit big-endian AAD length (in bits!) *) - let aal = Cstruct.create 8 in - Cstruct.BE.set_uint64 aal 0 Int64.(mul 8L (of_int (String.length aad))); - Cstruct.(concat [ of_string aad; iv; encrypted; aal ]) - in - let computed_auth_tag = - let full = Mirage_crypto.Hash.SHA256.hmac ~key:hmac_key hmac_input in - (* B.7 truncate to 128 bit *) - Cstruct.sub full 0 16 |> Cstruct.to_string + (* B.5 input to HMAC computation *) + let hmac_input = + (* B.3 64 bit big-endian AAD length (in bits!) *) + let aal = Bytes.create 8 in + Bytes.set_int64_be aal 0 Int64.(mul 8L (of_int (String.length aad))); + String.concat "" [ aad; iv; encrypted; Bytes.unsafe_to_string aal ] in - if not (String.equal computed_auth_tag auth_tag) then - Error (`Msg "invalid auth tag") - else - (* B.2 encryption in CBC mode *) - let data = - Mirage_crypto.Cipher_block.AES.CBC.decrypt ~key ~iv encrypted - |> Pkcs7.unpad + let computed_auth_tag = + let full = Digestif.SHA256.hmac_string ~key:hmac_key hmac_input in + (* B.7 truncate to 128 bit *) + String.sub (Digestif.SHA256.to_raw_string full) 0 16 in - Result.bind data (fun data -> Ok (Cstruct.to_string data)) - | Some `A256GCM -> - let module GCM = Mirage_crypto.Cipher_block.AES.GCM in - let cek = Cstruct.of_string cek in - let key = GCM.of_secret cek in - let adata = Cstruct.of_string aad in - let encrypted = Cstruct.append encrypted (Cstruct.of_string auth_tag) in - Mirage_crypto.Cipher_block.AES.GCM.authenticate_decrypt ~key ~nonce:iv - ~adata encrypted - |> fun message -> - message - |> Option.map (fun x -> Ok (Cstruct.to_string x)) - |> Option.value ~default:(Error (`Msg "invalid auth tag")) - | _ -> Error (`Msg "unsupported encryption")) + if not (String.equal computed_auth_tag auth_tag) then + Error (`Msg "invalid auth tag") + else + (* B.2 encryption in CBC mode *) + Mirage_crypto.AES.CBC.decrypt ~key ~iv encrypted |> Pkcs7.unpad + | Some `A256GCM -> + let module GCM = Mirage_crypto.AES.GCM in + let key = GCM.of_secret cek in + let adata = aad in + let encrypted = encrypted ^ auth_tag in + Mirage_crypto.AES.GCM.authenticate_decrypt ~key ~nonce:iv ~adata + encrypted + |> fun message -> + message + |> Option.map (fun x -> Ok x) + |> Option.value ~default:(Error (`Msg "invalid auth tag")) + | _ -> Error (`Msg "unsupported encryption")) let decrypt ~(jwk : Jwk.priv Jwk.t) jwe = String.split_on_char '.' jwe |> function | [ enc_header; enc_cek; enc_iv; ciphertext; auth_tag ] -> let header = Header.of_string enc_header in Result.bind header (fun header -> - let cek = decrypt_cek header.Header.alg ~jwk enc_cek in - Result.bind cek (fun cek -> - let iv = U_Base64.url_decode enc_iv in - Result.bind iv (fun iv -> - let auth_tag = U_Base64.url_decode auth_tag in - Result.bind auth_tag (fun auth_tag -> - let payload = - decrypt_ciphertext header.Header.enc ~cek ~iv ~auth_tag ~aad:enc_header ciphertext - in - Result.bind payload - (fun payload -> Ok { header; cek; iv; payload; aad = None }))))) + let cek = decrypt_cek header.Header.alg ~jwk enc_cek in + Result.bind cek (fun cek -> + let iv = U_Base64.url_decode enc_iv in + Result.bind iv (fun iv -> + let auth_tag = U_Base64.url_decode auth_tag in + Result.bind auth_tag (fun auth_tag -> + let payload = + decrypt_ciphertext header.Header.enc ~cek ~iv ~auth_tag + ~aad:enc_header ciphertext + in + Result.bind payload (fun payload -> + Ok { header; cek; iv; payload; aad = None }))))) | _ -> Error `Invalid_JWE diff --git a/jose/Jwk.ml b/jose/Jwk.ml index 0ee5c5b..4636032 100644 --- a/jose/Jwk.ml +++ b/jose/Jwk.ml @@ -11,57 +11,54 @@ module Util = struct U_String.pad ~len:8 ~c:'\000' x |> U_String.rev |> Z.of_bits) let kid_of_json json = - Yojson.Safe.to_string json |> Cstruct.of_string - |> Mirage_crypto.Hash.SHA256.digest |> Cstruct.to_bytes |> Bytes.to_string - |> U_Base64.url_encode_string + Yojson.Safe.to_string json |> Digestif.SHA256.digest_string + |> Digestif.SHA256.to_raw_string |> U_Base64.url_encode_string - let get_JWK_x5t fingerprint = - fingerprint |> Cstruct.to_bytes |> Bytes.to_string - |> U_Base64.url_encode ~len:20 + let get_JWK_x5t fingerprint = U_Base64.url_encode ~len:20 fingerprint - let get_ESXXX_x_y ~split_at ~pub_to_cstruct key = - let point = pub_to_cstruct key in - let x_cs, y_cs = Cstruct.(split (shift point 1) split_at) in - let x = x_cs |> Cstruct.to_string |> U_Base64.url_encode_string in - let y = y_cs |> Cstruct.to_string |> U_Base64.url_encode_string in + let get_ESXXX_x_y ~split_at ~pub_to_string key = + let point = pub_to_string key in + let x_cs, y_cs = + U_String.split (String.sub point 1 (String.length point - 1)) split_at + in + let x = x_cs |> U_Base64.url_encode_string in + let y = y_cs |> U_Base64.url_encode_string in (x, y) - let make_ESXXX_of_x_y ~pub_of_cstruct (x, y) = - let x = U_Base64.url_decode x |> Result.map Cstruct.of_string in - let y = U_Base64.url_decode y |> Result.map Cstruct.of_string in - match x,y with + let make_ESXXX_of_x_y ~pub_of_string (x, y) = + let x = U_Base64.url_decode x in + let y = U_Base64.url_decode y in + match (x, y) with | Ok x, Ok y -> - let four = - let cs = Cstruct.create 1 in - Cstruct.set_uint8 cs 0 4; - cs - in - let point = Cstruct.concat [ four; x; y ] in - pub_of_cstruct point - |> Result.get_ok - |> Result.ok + let four = + let cs = Bytes.create 1 in + Bytes.set_uint8 cs 0 4; + Bytes.unsafe_to_string cs + in + let point = String.concat "" [ four; x; y ] in + pub_of_string point |> Result.get_ok |> Result.ok | Error e, _ | _, Error e -> Error e let get_ES256_x_y = get_ESXXX_x_y ~split_at:32 (* 64 octets split in 2 *) - ~pub_to_cstruct:Mirage_crypto_ec.P256.Dsa.pub_to_cstruct + ~pub_to_string:Mirage_crypto_ec.P256.Dsa.pub_to_octets let make_ES256_of_x_y = - make_ESXXX_of_x_y ~pub_of_cstruct:Mirage_crypto_ec.P256.Dsa.pub_of_cstruct + make_ESXXX_of_x_y ~pub_of_string:Mirage_crypto_ec.P256.Dsa.pub_of_octets let get_ES384_x_y = get_ESXXX_x_y ~split_at:48 (* 96 octets split in 2 *) - ~pub_to_cstruct:Mirage_crypto_ec.P384.Dsa.pub_to_cstruct + ~pub_to_string:Mirage_crypto_ec.P384.Dsa.pub_to_octets let make_ES384_of_x_y = - make_ESXXX_of_x_y ~pub_of_cstruct:Mirage_crypto_ec.P384.Dsa.pub_of_cstruct + make_ESXXX_of_x_y ~pub_of_string:Mirage_crypto_ec.P384.Dsa.pub_of_octets let get_ES512_x_y = get_ESXXX_x_y ~split_at:66 (* 132 octets split in 2 *) - ~pub_to_cstruct:Mirage_crypto_ec.P521.Dsa.pub_to_cstruct + ~pub_to_string:Mirage_crypto_ec.P521.Dsa.pub_to_octets let make_ES512_of_x_y = - make_ESXXX_of_x_y ~pub_of_cstruct:Mirage_crypto_ec.P521.Dsa.pub_of_cstruct + make_ESXXX_of_x_y ~pub_of_string:Mirage_crypto_ec.P521.Dsa.pub_of_octets end type use = [ `Sig | `Enc | `Unsupported of string ] @@ -260,7 +257,7 @@ let make_kid (type a) (t : a t) = | Ed25519_priv okt -> let x = Mirage_crypto_ec.Ed25519.pub_of_priv okt.key - |> Mirage_crypto_ec.Ed25519.pub_to_cstruct |> Cstruct.to_string + |> Mirage_crypto_ec.Ed25519.pub_to_octets |> U_Base64.url_encode_string in `Assoc @@ -270,8 +267,8 @@ let make_kid (type a) (t : a t) = |> Util.kid_of_json | Ed25519_pub okt -> let x = - Mirage_crypto_ec.Ed25519.pub_to_cstruct okt.key - |> Cstruct.to_string |> U_Base64.url_encode_string + Mirage_crypto_ec.Ed25519.pub_to_octets okt.key + |> U_Base64.url_encode_string in `Assoc [ @@ -361,60 +358,42 @@ let of_pub_x509 ?use (x509 : X509.Public_key.t) : | _ -> Error `Unsupported_kty let of_pub_pem ?use pem : (public t, [> `Unsupported_kty ]) result = - let pem = - let pem_cs = Cstruct.of_string pem in - X509.Public_key.decode_pem pem_cs - in - Result.bind pem (fun pem -> of_pub_x509 ?use pem) + Result.bind (X509.Public_key.decode_pem pem) (of_pub_x509 ?use) let to_pub_pem (type a) (jwk : a t) = match jwk with - | Rsa_pub rsa -> - Ok (X509.Public_key.encode_pem (`RSA rsa.key) |> Cstruct.to_string) + | Rsa_pub rsa -> Ok (X509.Public_key.encode_pem (`RSA rsa.key)) | Rsa_priv rsa -> rsa.key |> Mirage_crypto_pk.Rsa.pub_of_priv |> (fun key -> X509.Public_key.encode_pem (`RSA key)) - |> Cstruct.to_string |> Result.ok - | Es256_pub ec -> - Ok (X509.Public_key.encode_pem (`P256 ec.key) |> Cstruct.to_string) + |> Result.ok + | Es256_pub ec -> Ok (X509.Public_key.encode_pem (`P256 ec.key)) | Es256_priv ec -> ec.key |> Mirage_crypto_ec.P256.Dsa.pub_of_priv - |> (fun key -> - X509.Public_key.encode_pem (`P256 key) |> Cstruct.to_string) + |> (fun key -> X509.Public_key.encode_pem (`P256 key)) |> Result.ok - | Es384_pub ec -> - Ok (X509.Public_key.encode_pem (`P384 ec.key) |> Cstruct.to_string) + | Es384_pub ec -> Ok (X509.Public_key.encode_pem (`P384 ec.key)) | Es384_priv ec -> ec.key |> Mirage_crypto_ec.P384.Dsa.pub_of_priv - |> (fun key -> - X509.Public_key.encode_pem (`P384 key) |> Cstruct.to_string) + |> (fun key -> X509.Public_key.encode_pem (`P384 key)) |> Result.ok - | Es512_pub ec -> - Ok (X509.Public_key.encode_pem (`P521 ec.key) |> Cstruct.to_string) + | Es512_pub ec -> Ok (X509.Public_key.encode_pem (`P521 ec.key)) | Es512_priv ec -> ec.key |> Mirage_crypto_ec.P521.Dsa.pub_of_priv - |> (fun key -> - X509.Public_key.encode_pem (`P521 key) |> Cstruct.to_string) + |> (fun key -> X509.Public_key.encode_pem (`P521 key)) |> Result.ok | _ -> Error `Unsupported_kty let of_priv_pem ?use pem : (priv t, [> `Unsupported_kty ]) result = - let pem = - let pem_cs = Cstruct.of_string pem in - X509.Private_key.decode_pem pem_cs - in - Result.bind pem (fun pem -> of_priv_x509 ?use pem) + let pem = X509.Private_key.decode_pem pem in + Result.bind pem (of_priv_x509 ?use) let to_priv_pem (jwk : priv t) = match jwk with - | Rsa_priv rsa -> - Ok (X509.Private_key.encode_pem (`RSA rsa.key) |> Cstruct.to_string) - | Es256_priv ec -> - Ok (X509.Private_key.encode_pem (`P256 ec.key) |> Cstruct.to_string) - | Es384_priv ec -> - Ok (X509.Private_key.encode_pem (`P384 ec.key) |> Cstruct.to_string) - | Es512_priv ec -> - Ok (X509.Private_key.encode_pem (`P521 ec.key) |> Cstruct.to_string) + | Rsa_priv rsa -> Ok (X509.Private_key.encode_pem (`RSA rsa.key)) + | Es256_priv ec -> Ok (X509.Private_key.encode_pem (`P256 ec.key)) + | Es384_priv ec -> Ok (X509.Private_key.encode_pem (`P384 ec.key)) + | Es512_priv ec -> Ok (X509.Private_key.encode_pem (`P521 ec.key)) | _ -> Error `Unsupported_kty let oct_to_json (oct : oct) = @@ -514,12 +493,10 @@ let pub_esXXX_to_pub_json ~get_ESXXX_x_y ~crv (pub : 'a) : Yojson.Safe.t = in `Assoc (List.filter_map Fun.id values) -let priv_esXXX_to_priv_json ~get_ESXXX_x_y ~pub_of_priv ~priv_to_cstruct ~crv +let priv_esXXX_to_priv_json ~get_ESXXX_x_y ~pub_of_priv ~priv_to_string ~crv (priv : 'a) : Yojson.Safe.t = let x, y = get_ESXXX_x_y (pub_of_priv priv.key) in - let d = - priv_to_cstruct priv.key |> Cstruct.to_string |> U_Base64.url_encode_string - in + let d = priv_to_string priv.key |> U_Base64.url_encode_string in let values = [ Option.map (fun alg -> ("alg", Jwa.alg_to_json alg)) priv.alg; @@ -543,7 +520,7 @@ let priv_es256_to_pub_json (priv_es256 : priv_es256) : Yojson.Safe.t = let priv_es256_to_priv_json = priv_esXXX_to_priv_json ~get_ESXXX_x_y:Util.get_ES256_x_y ~pub_of_priv:Mirage_crypto_ec.P256.Dsa.pub_of_priv - ~priv_to_cstruct:Mirage_crypto_ec.P256.Dsa.priv_to_cstruct ~crv:"P-256" + ~priv_to_string:Mirage_crypto_ec.P256.Dsa.priv_to_octets ~crv:"P-256" let pub_es384_to_pub_json (pub_es384 : pub_es384) : Yojson.Safe.t = pub_esXXX_to_pub_json ~get_ESXXX_x_y:Util.get_ES384_x_y ~crv:"P-384" pub_es384 @@ -554,7 +531,7 @@ let priv_es384_to_pub_json (priv_es384 : priv_es384) : Yojson.Safe.t = let priv_es384_to_priv_json = priv_esXXX_to_priv_json ~get_ESXXX_x_y:Util.get_ES384_x_y ~pub_of_priv:Mirage_crypto_ec.P384.Dsa.pub_of_priv - ~priv_to_cstruct:Mirage_crypto_ec.P384.Dsa.priv_to_cstruct ~crv:"P-384" + ~priv_to_string:Mirage_crypto_ec.P384.Dsa.priv_to_octets ~crv:"P-384" let pub_es512_to_pub_json (pub_es512 : pub_es512) : Yojson.Safe.t = pub_esXXX_to_pub_json ~get_ESXXX_x_y:Util.get_ES512_x_y ~crv:"P-521" pub_es512 @@ -565,7 +542,7 @@ let priv_es512_to_pub_json (priv_es512 : priv_es512) : Yojson.Safe.t = let priv_es512_to_priv_json = priv_esXXX_to_priv_json ~get_ESXXX_x_y:Util.get_ES512_x_y ~pub_of_priv:Mirage_crypto_ec.P521.Dsa.pub_of_priv - ~priv_to_cstruct:Mirage_crypto_ec.P521.Dsa.priv_to_cstruct ~crv:"P-521" + ~priv_to_string:Mirage_crypto_ec.P521.Dsa.priv_to_octets ~crv:"P-521" let pub_ed25519_to_pub_json okp = `Assoc @@ -574,8 +551,8 @@ let pub_ed25519_to_pub_json okp = ("crv", `String "Ed25519"); ( "x", `String - (okp.key |> Mirage_crypto_ec.Ed25519.pub_to_cstruct - |> Cstruct.to_string |> U_Base64.url_encode_string) ); + (okp.key |> Mirage_crypto_ec.Ed25519.pub_to_octets + |> U_Base64.url_encode_string) ); ] let priv_ed25519_to_pub_json okp = @@ -589,12 +566,12 @@ let priv_ed25519_to_priv_json okp = ("crv", `String "Ed25519"); ( "d", `String - (okp.key |> Mirage_crypto_ec.Ed25519.priv_to_cstruct - |> Cstruct.to_string |> U_Base64.url_encode_string) ); + (okp.key |> Mirage_crypto_ec.Ed25519.priv_to_octets + |> U_Base64.url_encode_string) ); ( "x", `String - (pub_key |> Mirage_crypto_ec.Ed25519.pub_to_cstruct - |> Cstruct.to_string |> U_Base64.url_encode_string) ); + (pub_key |> Mirage_crypto_ec.Ed25519.pub_to_octets + |> U_Base64.url_encode_string) ); ] let to_pub_json (type a) (jwk : a t) : Yojson.Safe.t = @@ -631,11 +608,63 @@ let pub_rsa_of_json json : (public t, 'error) result = try let e = json |> Json.member "e" |> Json.to_string |> Util.get_component in let n = json |> Json.member "n" |> Json.to_string |> Util.get_component in - match e, n with + match (e, n) with | Error e, _ | _, Error e -> Error e | Ok e, Ok n -> - let pub = Mirage_crypto_pk.Rsa.pub ~e ~n in - Result.bind pub (fun key -> + let pub = Mirage_crypto_pk.Rsa.pub ~e ~n in + Result.bind pub (fun key -> + let alg = + json |> Json.member "alg" |> Json.to_string_option + |> Option.map Jwa.alg_of_string + in + let use = + json |> Json.member "use" |> Json.to_string_option + |> Option.map use_of_string + in + let kid = json |> Json.member "kid" |> Json.to_string_option in + let kty = `RSA in + match (alg, use) with + | Some _, Some _ -> Ok (Rsa_pub { alg; kty; use; key; kid }) + | Some alg, None -> + Ok + (Rsa_pub + { + alg = Some alg; + kty; + use = Some (use_of_alg alg); + key; + kid; + }) + | None, Some use -> + Ok + (Rsa_pub + { + alg = Some (alg_of_use_and_kty ~use kty); + kty; + use = Some use; + key; + kid; + }) + | alg, use -> Ok (Rsa_pub { alg; kty; use; key; kid })) + with Json.Type_error (s, _) -> Error (`Json_parse_failed s) + +let priv_rsa_of_json json : (priv t, 'error) result = + let module Json = Yojson.Safe.Util in + try + let e = json |> Json.member "e" |> Json.to_string |> Util.get_component in + let n = json |> Json.member "n" |> Json.to_string |> Util.get_component in + let d = json |> Json.member "d" |> Json.to_string |> Util.get_component in + let p = json |> Json.member "p" |> Json.to_string |> Util.get_component in + let q = json |> Json.member "q" |> Json.to_string |> Util.get_component in + let dp = json |> Json.member "dp" |> Json.to_string |> Util.get_component in + let dq = json |> Json.member "dq" |> Json.to_string |> Util.get_component in + let qi = json |> Json.member "qi" |> Json.to_string |> Util.get_component in + let all8 = U_Result.all8 e n d p q dp dq qi in + let priv = + Result.bind all8 (fun (e, n, d, p, q, dp, dq, qi) -> + Mirage_crypto_pk.Rsa.priv ~e ~n ~d ~p ~q ~dp ~dq ~q':qi) + in + Result.bind priv (fun key -> let alg = json |> Json.member "alg" |> Json.to_string_option |> Option.map Jwa.alg_of_string @@ -647,20 +676,14 @@ let pub_rsa_of_json json : (public t, 'error) result = let kid = json |> Json.member "kid" |> Json.to_string_option in let kty = `RSA in match (alg, use) with - | Some _, Some _ -> Ok (Rsa_pub { alg; kty; use; key; kid }) + | Some _, Some _ -> Ok (Rsa_priv { alg; kty; use; key; kid }) | Some alg, None -> Ok - (Rsa_pub - { - alg = Some alg; - kty; - use = Some (use_of_alg alg); - key; - kid; - }) + (Rsa_priv + { alg = Some alg; kty; use = Some (use_of_alg alg); key; kid }) | None, Some use -> Ok - (Rsa_pub + (Rsa_priv { alg = Some (alg_of_use_and_kty ~use kty); kty; @@ -668,58 +691,7 @@ let pub_rsa_of_json json : (public t, 'error) result = key; kid; }) - | alg, use -> Ok (Rsa_pub { alg; kty; use; key; kid })) - with Json.Type_error (s, _) -> Error (`Json_parse_failed s) - -let priv_rsa_of_json json : (priv t, 'error) result = - let module Json = Yojson.Safe.Util in - try - let e = json |> Json.member "e" |> Json.to_string |> Util.get_component in - let n = json |> Json.member "n" |> Json.to_string |> Util.get_component in - let d = json |> Json.member "d" |> Json.to_string |> Util.get_component in - let p = json |> Json.member "p" |> Json.to_string |> Util.get_component in - let q = json |> Json.member "q" |> Json.to_string |> Util.get_component in - let dp = json |> Json.member "dp" |> Json.to_string |> Util.get_component in - let dq = json |> Json.member "dq" |> Json.to_string |> Util.get_component in - let qi = json |> Json.member "qi" |> Json.to_string |> Util.get_component in - let all8 = U_Result.all8 e n d p q dp dq qi in - let priv = Result.bind all8 (fun (e, n, d, p, q, dp, dq, qi) -> - Mirage_crypto_pk.Rsa.priv ~e ~n ~d ~p ~q ~dp ~dq ~q':qi) - in - Result.bind priv (fun key -> - let alg = - json |> Json.member "alg" |> Json.to_string_option - |> Option.map Jwa.alg_of_string - in - let use = - json |> Json.member "use" |> Json.to_string_option - |> Option.map use_of_string - in - let kid = json |> Json.member "kid" |> Json.to_string_option in - let kty = `RSA in - match (alg, use) with - | Some _, Some _ -> Ok (Rsa_priv { alg; kty; use; key; kid }) - | Some alg, None -> - Ok - (Rsa_priv - { - alg = Some alg; - kty; - use = Some (use_of_alg alg); - key; - kid; - }) - | None, Some use -> - Ok - (Rsa_priv - { - alg = Some (alg_of_use_and_kty ~use kty); - kty; - use = Some use; - key; - kid; - }) - | None, None -> Ok (Rsa_priv { alg; kty; use; key; kid })) + | None, None -> Ok (Rsa_priv { alg; kty; use; key; kid })) with Json.Type_error (s, _) -> Error (`Json_parse_failed s) let oct_of_json json = @@ -786,10 +758,7 @@ let priv_ec_of_json json = |> Option.map Jwa.alg_of_string in let crv = json |> Json.member "crv" |> Json.to_string in - let d = - json |> Json.member "d" |> Json.to_string |> U_Base64.url_decode - |> Result.map Cstruct.of_string - in + let d = json |> Json.member "d" |> Json.to_string |> U_Base64.url_decode in let make_jwk key = { alg; @@ -804,15 +773,15 @@ let priv_ec_of_json json = in match (crv, d) with | "P-256", Ok d -> - Mirage_crypto_ec.P256.Dsa.priv_of_cstruct d + Mirage_crypto_ec.P256.Dsa.priv_of_octets d |> Result.map_error (fun _ -> `Msg "Could not create key") |> Result.map (fun key -> Es256_priv (make_jwk key)) | "P-384", Ok d -> - Mirage_crypto_ec.P384.Dsa.priv_of_cstruct d + Mirage_crypto_ec.P384.Dsa.priv_of_octets d |> Result.map_error (fun _ -> `Msg "Could not create key") |> Result.map (fun key -> Es384_priv (make_jwk key)) | "P-521", Ok d -> - Mirage_crypto_ec.P521.Dsa.priv_of_cstruct d + Mirage_crypto_ec.P521.Dsa.priv_of_octets d |> Result.map_error (fun _ -> `Msg "Could not create key") |> Result.map (fun key -> Es512_priv (make_jwk key)) | _ -> Error (`Msg "kty and alg doesn't match") @@ -827,10 +796,7 @@ let pub_okp_of_json json = in (* TODO: This is needed if we want more curves *) let _crv = json |> Json.member "crv" |> Json.to_string in - let x = - json |> Json.member "x" |> Json.to_string |> U_Base64.url_decode - |> Result.map Cstruct.of_string - in + let x = json |> Json.member "x" |> Json.to_string |> U_Base64.url_decode in let make_jwk key = { alg; @@ -843,9 +809,9 @@ let pub_okp_of_json json = kid = json |> Json.member "kid" |> Json.to_string_option; } in - Result.bind x (fun cstruct -> - Mirage_crypto_ec.Ed25519.pub_of_cstruct cstruct - |> Result.map_error (fun _ -> `Msg "Could not create key")) + Result.bind x (fun str -> + Mirage_crypto_ec.Ed25519.pub_of_octets str + |> Result.map_error (fun _ -> `Msg "Could not create key")) |> Result.map (fun key -> Ed25519_pub (make_jwk key)) with Json.Type_error (s, _) -> Error (`Json_parse_failed s) @@ -858,10 +824,7 @@ let priv_okp_of_json json = in (* TODO: This is needed if we want more curves *) let _crv = json |> Json.member "crv" |> Json.to_string in - let d = - json |> Json.member "d" |> Json.to_string |> U_Base64.url_decode - |> Result.map Cstruct.of_string - in + let d = json |> Json.member "d" |> Json.to_string |> U_Base64.url_decode in let make_jwk key = { alg; @@ -874,9 +837,9 @@ let priv_okp_of_json json = kid = json |> Json.member "kid" |> Json.to_string_option; } in - Result.bind d (fun cstruct -> - Mirage_crypto_ec.Ed25519.priv_of_cstruct cstruct - |> Result.map_error (fun _ -> `Msg "Could not create key")) + Result.bind d (fun str -> + Mirage_crypto_ec.Ed25519.priv_of_octets str + |> Result.map_error (fun _ -> `Msg "Could not create key")) |> Result.map (fun key -> Ed25519_priv (make_jwk key)) with Json.Type_error (s, _) -> Error (`Json_parse_failed s) @@ -917,13 +880,13 @@ let pub_of_priv (jwk : priv t) : public t = | Es512_priv es -> Es512_pub (pub_of_priv_es512 es) | Ed25519_priv okt -> Ed25519_pub (pub_of_priv_ed25519 okt) -let oct_to_sign_key (oct : oct) : (Cstruct.t, [> `Msg of string ]) result = - U_Base64.url_decode oct.key |> Result.map Cstruct.of_string +let oct_to_sign_key (oct : oct) : (string, [> `Msg of string ]) result = + U_Base64.url_decode oct.key let hash_values hash values = - let module Hash = (val Mirage_crypto.Hash.module_of hash) in + let module Hash = (val Digestif.module_of_hash' hash) in `Assoc (List.filter_map Fun.id values) - |> Yojson.to_string |> Cstruct.of_string |> Hash.digest + |> Yojson.to_string |> Hash.digest_string |> Hash.to_raw_string let pub_rsa_to_thumbprint hash (pub_rsa : Mirage_crypto_pk.Rsa.pub jwk) = let e = Util.get_JWK_component pub_rsa.key.e in @@ -993,8 +956,8 @@ let priv_es512_to_thumbprint hash (priv_es512 : priv_es512) = let pub_ed25519_to_thumbprint hash (pub_ed25519 : pub_ed25519) = let kty = Jwa.kty_to_string pub_ed25519.kty in let x = - Mirage_crypto_ec.Ed25519.pub_to_cstruct pub_ed25519.key - |> Cstruct.to_string |> U_Base64.url_encode_string + Mirage_crypto_ec.Ed25519.pub_to_octets pub_ed25519.key + |> U_Base64.url_encode_string in let values = [ @@ -1008,7 +971,7 @@ let pub_ed25519_to_thumbprint hash (pub_ed25519 : pub_ed25519) = let priv_ed25519_to_thumbprint hash (priv_ed25519 : priv_ed25519) = pub_of_priv_ed25519 priv_ed25519 |> pub_ed25519_to_thumbprint hash -let get_thumbprint (type a) (hash : Mirage_crypto.Hash.hash) (jwk : a t) = +let get_thumbprint (type a) (hash : Digestif.hash') (jwk : a t) = match jwk with | Rsa_pub rsa -> Ok (pub_rsa_to_thumbprint hash rsa) | Rsa_priv rsa -> Ok (priv_rsa_to_thumbprint hash rsa) diff --git a/jose/Jws.ml b/jose/Jws.ml index 3a1943f..0d89f04 100644 --- a/jose/Jws.ml +++ b/jose/Jws.ml @@ -13,10 +13,10 @@ type serialization = [ `Compact | `General | `Flattened ] let of_compact_string token = String.split_on_char '.' token |> function - | [ header_str; payload_str; signature ] -> + | [ header_str; payload_str; signature ] -> ( let header = Header.of_string header_str in let payload = payload_str |> U_Base64.url_decode in - (match header, payload with + match (header, payload) with | Ok header, Ok payload -> Ok { header; raw_header = header_str; payload; signature } | Error e, _ | _, Error e -> Error e) @@ -92,102 +92,103 @@ let to_string ?(serialization = `Compact) t = | `General -> to_general_string t | `Flattened -> to_flattened_string t -let verify_jwk (type a) ~(jwk : a Jwk.t) ~input_str str = +let verify_jwk (type a) ~(jwk : a Jwk.t) ~input_str signature = match jwk with | Jwk.Rsa_priv jwk -> ( let pub_jwk = Jwk.pub_of_priv_rsa jwk in - Mirage_crypto_pk.Rsa.PKCS1.sig_decode ~key:pub_jwk.key str |> function + Mirage_crypto_pk.Rsa.PKCS1.sig_decode ~key:pub_jwk.key signature + |> function | None -> Error `Invalid_signature | Some message -> Ok message) | Jwk.Rsa_pub jwk -> ( - Mirage_crypto_pk.Rsa.PKCS1.sig_decode ~key:jwk.key str |> function + Mirage_crypto_pk.Rsa.PKCS1.sig_decode ~key:jwk.key signature |> function | None -> Error `Invalid_signature | Some message -> Ok message) | Jwk.Oct jwk -> let key = Jwk.oct_to_sign_key jwk in Result.bind key (fun key -> - let computed_signature = - Mirage_crypto.Hash.SHA256.hmac ~key (Cstruct.of_string input_str) - in - (* From RFC7518§3.2: - * The comparison of the computed HMAC value to the JWS Signature - * value MUST be done in a constant-time manner to thwart timing - * attacks. *) - if Eqaf_cstruct.equal str computed_signature then - Ok computed_signature - else Error `Invalid_signature) + let computed_signature = + Digestif.SHA256.hmac_string ~key input_str + |> Digestif.SHA256.to_raw_string + in + (* From RFC7518§3.2: + * The comparison of the computed HMAC value to the JWS Signature + * value MUST be done in a constant-time manner to thwart timing + * attacks. *) + if Eqaf.equal signature computed_signature then Ok computed_signature + else Error `Invalid_signature) | Jwk.Es256_pub pub_jwk -> - let r, s = Cstruct.split str 32 in + let r, s = U_String.split signature 32 in let message = - Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string input_str) + Digestif.SHA256.digest_string input_str |> Digestif.SHA256.to_raw_string in if Mirage_crypto_ec.P256.Dsa.verify ~key:pub_jwk.key (r, s) message then - Ok str + Ok signature else Error `Invalid_signature | Jwk.Es256_priv jwk -> - let r, s = Cstruct.split str 32 in + let r, s = U_String.split signature 32 in let message = - Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string input_str) + Digestif.SHA256.digest_string input_str |> Digestif.SHA256.to_raw_string in let pub_jwk = Jwk.pub_of_priv_es256 jwk in if Mirage_crypto_ec.P256.Dsa.verify ~key:pub_jwk.key (r, s) message then - Ok str + Ok signature else Error `Invalid_signature | Jwk.Es384_pub pub_jwk -> - let r, s = Cstruct.split str 48 in + let r, s = U_String.split signature 48 in let message = - Mirage_crypto.Hash.SHA384.digest (Cstruct.of_string input_str) + Digestif.SHA384.digest_string input_str |> Digestif.SHA384.to_raw_string in if Mirage_crypto_ec.P384.Dsa.verify ~key:pub_jwk.key (r, s) message then - Ok str + Ok signature else Error `Invalid_signature | Jwk.Es384_priv jwk -> - let r, s = Cstruct.split str 48 in + let r, s = U_String.split signature 48 in let message = - Mirage_crypto.Hash.SHA384.digest (Cstruct.of_string input_str) + Digestif.SHA384.digest_string input_str |> Digestif.SHA384.to_raw_string in let pub_jwk = Jwk.pub_of_priv_es384 jwk in if Mirage_crypto_ec.P384.Dsa.verify ~key:pub_jwk.key (r, s) message then - Ok str + Ok signature else Error `Invalid_signature | Jwk.Es512_pub pub_jwk -> - let r, s = Cstruct.split str 66 in + let r, s = U_String.split signature 66 in let message = - Mirage_crypto.Hash.SHA512.digest (Cstruct.of_string input_str) + Digestif.SHA512.digest_string input_str |> Digestif.SHA512.to_raw_string in if Mirage_crypto_ec.P521.Dsa.verify ~key:pub_jwk.key (r, s) message then - Ok str + Ok signature else Error `Invalid_signature | Jwk.Es512_priv jwk -> - let r, s = Cstruct.split str 66 in + let r, s = U_String.split signature 66 in let message = - Mirage_crypto.Hash.SHA512.digest (Cstruct.of_string input_str) + Digestif.SHA512.digest_string input_str |> Digestif.SHA512.to_raw_string in let pub_jwk = Jwk.pub_of_priv_es512 jwk in if Mirage_crypto_ec.P521.Dsa.verify ~key:pub_jwk.key (r, s) message then - Ok str + Ok signature else Error `Invalid_signature | Jwk.Ed25519_priv jwk -> let key = Mirage_crypto_ec.Ed25519.pub_of_priv jwk.key in - let msg = Cstruct.of_string input_str in - if Mirage_crypto_ec.Ed25519.verify ~key str ~msg then Ok str + let msg = input_str in + if Mirage_crypto_ec.Ed25519.verify ~key signature ~msg then Ok signature else Error `Invalid_signature | Jwk.Ed25519_pub jwk -> - let msg = Cstruct.of_string input_str in - if Mirage_crypto_ec.Ed25519.verify ~key:jwk.key str ~msg then Ok str + let msg = input_str in + if Mirage_crypto_ec.Ed25519.verify ~key:jwk.key signature ~msg then + Ok signature else Error `Invalid_signature let verify_internal (type a) ~(jwk : a Jwk.t) t = let payload_str = U_Base64.url_encode_string t.payload in let input_str = Printf.sprintf "%s.%s" t.raw_header payload_str in - let unverified_jwk = - U_Base64.url_decode t.signature |> Result.map Cstruct.of_string - in + let unverified_jwk = U_Base64.url_decode t.signature in Result.bind unverified_jwk (verify_jwk ~jwk ~input_str) let validate (type a) ~(jwk : a Jwk.t) t = let header = t.header in - let alg = match header.alg with + let alg = + match header.alg with | `RS256 -> Ok header.alg | `HS256 -> Ok header.alg | `ES256 -> Ok header.alg @@ -198,9 +199,7 @@ let validate (type a) ~(jwk : a Jwk.t) t = Error (`Msg "alg not supported for signing") in Result.bind alg (fun _alg -> - match verify_internal ~jwk t with - | Ok _sig -> Ok t - | Error e -> Error e) + match verify_internal ~jwk t with Ok _sig -> Ok t | Error e -> Error e) (* Assumes a well formed header. *) let sign ?header ~payload (jwk : Jwk.priv Jwk.t) = @@ -217,26 +216,31 @@ let sign ?header ~payload (jwk : Jwk.priv Jwk.t) = Ok (function | `Message x -> - let message = Mirage_crypto.Hash.SHA256.digest x in + let message = + Digestif.SHA256.digest_string x |> Digestif.SHA256.to_raw_string + in let r, s = Mirage_crypto_ec.P256.Dsa.sign ~key message in - Cstruct.append r s + r ^ s | `Digest _ -> raise (Invalid_argument "Digest")) | Jwk.Es384_priv { key; _ } -> Ok (function | `Message x -> - let message = Mirage_crypto.Hash.SHA384.digest x in + let message = + Digestif.SHA384.digest_string x |> Digestif.SHA384.to_raw_string + in let r, s = Mirage_crypto_ec.P384.Dsa.sign ~key message in - Cstruct.append r s + r ^ s | `Digest _ -> raise (Invalid_argument "Digest")) | Jwk.Es512_priv { key; _ } -> Ok (function | `Message x -> - let message = Mirage_crypto.Hash.SHA512.digest x in + let message = + Digestif.SHA512.digest_string x |> Digestif.SHA512.to_raw_string + in let r, s = Mirage_crypto_ec.P521.Dsa.sign ~key message in - let sign = Cstruct.append r s in - sign + r ^ s | `Digest _ -> raise (Invalid_argument "Digest")) | Jwk.Ed25519_priv jwk -> Ok @@ -245,9 +249,12 @@ let sign ?header ~payload (jwk : Jwk.priv Jwk.t) = | `Digest _ -> raise (Invalid_argument "Digest")) | Jwk.Oct oct -> Jwk.oct_to_sign_key oct - |> Result.map (fun key -> function - | `Message x -> Mirage_crypto.Hash.SHA256.hmac ~key x - | `Digest _ -> raise (Invalid_argument "Digest")) + |> Result.map (fun key msg -> + match msg with + | `Message x -> + Digestif.SHA256.hmac_string ~key x + |> Digestif.SHA256.to_raw_string + | `Digest _ -> raise (Invalid_argument "Digest")) in match sign_f with | Ok sign_f -> @@ -255,8 +262,7 @@ let sign ?header ~payload (jwk : Jwk.priv Jwk.t) = let payload_str = U_Base64.url_encode_string payload in let input_str = Printf.sprintf "%s.%s" header_str payload_str in let signature = - `Message (Cstruct.of_string input_str) - |> sign_f |> Cstruct.to_string |> U_Base64.url_encode_string + `Message input_str |> sign_f |> U_Base64.url_encode_string in Ok { header; raw_header = header_str; payload; signature } | Error e -> Error e diff --git a/jose/Utils.ml b/jose/Utils.ml index e094f16..fdbfeda 100644 --- a/jose/Utils.ml +++ b/jose/Utils.ml @@ -21,16 +21,19 @@ module U_String = struct let trim_leading_null s = Astring.String.trim ~drop:(function '\000' -> true | _ -> false) s + + let split s len = + (String.sub s 0 len, String.sub s len (String.length s - len)) end module U_Base64 = struct - let url_encode_string ?(pad=false) payload = + let url_encode_string ?(pad = false) payload = Base64.encode_string ~pad ~alphabet:Base64.uri_safe_alphabet payload - let url_encode ?(pad=false) ?off ?len payload = + let url_encode ?(pad = false) ?off ?len payload = Base64.encode ~pad ~alphabet:Base64.uri_safe_alphabet ?off ?len payload - let url_decode ?(pad=false) ?off ?len payload = + let url_decode ?(pad = false) ?off ?len payload = Base64.decode ~pad ~alphabet:Base64.uri_safe_alphabet ?off ?len payload end @@ -42,22 +45,25 @@ end module Pkcs7 = struct (* https://tools.ietf.org/html/rfc5652#section-6.3 *) let pad data block_size = - let pad_size = block_size - (Cstruct.length data mod block_size) in + let pad_size = block_size - (String.length data mod block_size) in if pad_size = 0 then data else (* this is the remaining bytes in the last block *) - let pad = Cstruct.create pad_size in - Cstruct.memset pad pad_size; + let pad = + let c = Char.chr (pad_size land 0xff) in + Bytes.init pad_size (Fun.const c) + in (* fills the pad buffer with bytes each containing "pad_size" as value *) - Cstruct.append data pad + (* TODO(anmonteiro): allocate a single bytes and blit + set chars *) + data ^ Bytes.to_string pad let unpad cs = - let cs_len = Cstruct.length cs in - let pad_len = Cstruct.get_uint8 cs (cs_len - 1) in - let data, padding = Cstruct.split cs (cs_len - pad_len) in + let cs_len = String.length cs in + let pad_len = String.get_uint8 cs (cs_len - 1) in + let data, padding = U_String.split cs (cs_len - pad_len) in let rec check idx = if idx >= pad_len then true - else Cstruct.get_uint8 padding idx = pad_len && check (idx + 1) + else String.get_uint8 padding idx = pad_len && check (idx + 1) in if check 0 then Ok data else Error (`Msg "bad padding") end diff --git a/jose/dune b/jose/dune index 9d29bdd..80d110a 100644 --- a/jose/dune +++ b/jose/dune @@ -5,6 +5,7 @@ astring eqaf yojson + digestif mirage-crypto mirage-crypto-pk mirage-crypto-ec diff --git a/nix/generic.nix b/nix/generic.nix index e3a5b5d..dbdf09c 100644 --- a/nix/generic.nix +++ b/nix/generic.nix @@ -44,7 +44,6 @@ with ocamlPackages; rec { mirage-crypto-pk mirage-crypto-ec x509 - cstruct astring yojson zarith diff --git a/test/Fixtures.ml b/test/Fixtures.ml index 751e910..a9f2569 100644 --- a/test/Fixtures.ml +++ b/test/Fixtures.ml @@ -144,7 +144,7 @@ let es256_jwt_string = {|eyJ0eXAiOiJKV1QiLCJhbGciOiJFUzI1NiIsImtpZCI6IlVYNHF1OUw3WnlvU0ZDWlJiWGlmWDdhcV94ay1QTGZQaVB5czItS05rQW8ifQ.eyJzdWIiOiJ0ZXN0ZXIifQ.PU5foY53xooRx6PlBUpD9ZPKkDbSEfoXDvBiyTvJAQl2R8ilCglPh_eCSKX6B03SDAh5TcAanche999TBOs31w|} let es512_jwt_string = - {|eyJ0eXAiOiJKV1QiLCJhbGciOiJFUzUxMiIsImtpZCI6IjhmVlZQSTczRE9nZ2xKZ0Y0eXIwbkFMRmg2STVMbG9tMVhtdDhoVHVjLVUifQ.eyJzdWIiOiJ0ZXN0ZXIifQ.AWt-F7KxQnLQoCt3AjK9XBznyus1NszsLpf2o2T0QGU607A-dtdD54vDErz3QFy7LjsAZ639lQBY9ox8n-c5H24xAb5fx7-5iiE0bnIFp5UUzRiWErySV4UAqbEP_qOhewNVYoUtc2PyFZYXiI3lMgVIkJMB3MFLlylTdOe8AAyyfTu3|} + {|eyJ0eXAiOiJKV1QiLCJhbGciOiJFUzUxMiIsImtpZCI6IjhmVlZQSTczRE9nZ2xKZ0Y0eXIwbkFMRmg2STVMbG9tMVhtdDhoVHVjLVUifQ.eyJzdWIiOiJ0ZXN0ZXIifQ.AWnbVz7DJ-g2J7z1a3OF9YzBy-U0o33t9S6hahokJRY126OYV5zjrwLVR5Dr97IlDJvpiDHEAkb7dnrZtE0_uxfkALwwXGit_FwnVpf-rM24OH0gY3RoT_T11OVa_QiW48lIL6NUz7ujtC1GZ9Y9xaiG3rIafxeM0RG1BrGWYYE4HIZL|} let jwt_without_kid = "eyJhbGciOiJSUzI1NiIsImtpZCI6Il9abjZRRXozRG42Um5XN2hvcGFBYzQ2VkZlcFpRa0x5Rk8ycE50M1VzNFkifQ.eyJpc3MiOiJodHRwczovL3JwLmNlcnRpZmljYXRpb24ub3BlbmlkLm5ldDo4MDgwL21vcnBoX2F1dGhfbG9jYWwvcnAtaWRfdG9rZW4taWF0Iiwic3ViIjoiMWIyZmM5MzQxYTE2YWU0ZTMwMDgyOTY1ZDUzN2FlNDdjMjFhMGYyN2ZkNDNlYWI3ODMzMGVkODE3NTFhZTZkYiIsImF1ZCI6WyJIQTBHT2x0ZElHVDYiXSwiZXhwIjoxNTkxMDc5Mjg4LCJhY3IiOiJQQVNTV09SRCIsInNpZCI6IjExMDAxMWE0NTdiOTgyYjA1MjRiN2QzODU4NDI4NjE4MTIwYTE0MDU4MzZiY2Y3NWIxMzEwMDUxIiwiYXV0aF90aW1lIjoxNTkwOTkyODg3LCJub25jZSI6IjFiYWEwYmJiLWM4ZGMtNDQxOS1hNDVkLWY4ZTk5OTkzNDAxMCJ9.L0xFdTBAChXQGCEK1wm7BjDJpiFOGHsGxdrRTgWKjlLKDVk0eSqJ4_zCp0xnUf-Pnzp_B9RreBEsu4RcEi0OEqS0PP1514sncGz7gsFBDfuX6opbIH5bbuhW0GkkkVooxSVkNuEgfBsaZovyo15LcQ8_zpF0nCXa_g6kyCz7KE3thBxC7u3Ex6jrk8fdt80daRn_ZDEpODlD0N6rki2fM4yAMWC6pLYrNZG9h_VIvKK947GsIsMR4CKR0OAsK4cqS3ahR3W49lP66quo6ThK8z5GMFgzlqgzt_A-tbjYmCQp2A110vvKY1U6j_WU2Vn8eHrU1rVdYaOwMlRj5RVbHw" diff --git a/test/Helpers.ml b/test/Helpers.ml index 1304c58..375af81 100644 --- a/test/Helpers.ml +++ b/test/Helpers.ml @@ -48,6 +48,3 @@ let make_test_case (name, test) = Alcotest.test_case name `Quick test let url_encode_string ?(pad = false) payload = Base64.encode_string ~pad ~alphabet:Base64.uri_safe_alphabet payload - -let url_encode_cstruct payload = - payload |> Cstruct.to_string |> url_encode_string diff --git a/test/JWKTest.ml b/test/JWKTest.ml index 763c31d..6ef5c7e 100644 --- a/test/JWKTest.ml +++ b/test/JWKTest.ml @@ -169,7 +169,7 @@ let jwk_suite, _ = in check_result_string "Creates the correct thumbprint" (Ok "ZrBaai73Hi8Fg4MElvDGzIne2NsbI75RHubOViHYE5Q") - @@ Result.map url_encode_cstruct + @@ Result.map url_encode_string @@ Jose.Jwk.get_thumbprint `SHA256 pub_jwk); Alcotest.test_case "P384 - thumbprint" `Quick (fun () -> let pub_string = @@ -183,7 +183,7 @@ let jwk_suite, _ = let pub_jwk = Jose.Jwk.of_pub_json_string pub_string in check_result_string "Creates the correct thumbprint" (Ok "CZv-vJviuyEXKGIeW2fYpEjRXSxUTHUdoQ58asby1Rg") - @@ Result.map url_encode_cstruct + @@ Result.map url_encode_string @@ CCResult.flat_map (Jose.Jwk.get_thumbprint `SHA256) pub_jwk); Alcotest.test_case "P256 - thumbprint" `Quick (fun () -> let pub_string = @@ -199,7 +199,7 @@ let jwk_suite, _ = in check_result_string "Creates the correct thumbprint" (Ok "nBBpbUsITZuECZH0WpBqPH4HKwYV3Tx2KDVyNfwvOkU") - @@ Result.map url_encode_cstruct + @@ Result.map url_encode_string @@ Jose.Jwk.get_thumbprint `SHA256 pub_jwk); ] ); ] diff --git a/test/JWTTest.ml b/test/JWTTest.ml index a1e29b4..f1f2fa5 100644 --- a/test/JWTTest.ml +++ b/test/JWTTest.ml @@ -229,7 +229,7 @@ let jwt_suite, _ = Jose.Jwt.sign ~payload: (`Assoc - [ ("exp", `Int (Ptime.to_float_s exp |> int_of_float)) ]) + [ ("exp", `Int (Ptime.to_float_s exp |> int_of_float)) ]) jwk in let jwt = (CCResult.flat_map (Jose.Jwt.validate ~now ~jwk)) jwt in diff --git a/test/RFC7515.ml b/test/RFC7515.ml index 9371275..6f08d86 100644 --- a/test/RFC7515.ml +++ b/test/RFC7515.ml @@ -44,6 +44,9 @@ let payload_str = "http://example.com/is_root":true}|} |> payload_to_same +let a_4_jws = + {|eyJhbGciOiJFUzUxMiJ9.UGF5bG9hZA.AWflgP1EaMjD8wn0_zbfv-ig7HqR_fIPutaspBmLdEA-4jq_lJSiXVScImGj9H15HwnQCV9rEqz_1IY7L07REF7rAGbY03ZbfpKy8sFRybi12kMjsgU8vGKHJPZl6BT9G930CnEfL7MpSJiZEpxO-CeMyQQFOxPvVh4N6n20NSK9Tlho|} + open Helpers let jws_tests = @@ -85,10 +88,8 @@ let jws_tests = |> CCResult.map (fun (jws : Jose.Jws.t) -> payload_to_same jws.payload) |> check_result_string "Validated payload is correct" (Ok payload_str)); - Alcotest.test_case "A.4" `Quick (fun () -> - let expected_str = - {|eyJhbGciOiJFUzUxMiJ9.UGF5bG9hZA.AdwMgeerwtHoh-l192l60hp9wAHZFVJbLfD_UxMi70cwnZOYaRI1bKPWROc-mZZqwqT2SI-KGDKB34XO0aw_7XdtAG8GaSwFKdCAPZgoXD2YBJZCPEX3xKpRwcdOO8KpEHwJjyqOgzDO7iKvU8vcnwNrmxYbSW9ERBXukOXolLzeO_Jn|} - in + Alcotest.test_case "A.4 - validate" `Quick (fun () -> + let expected_str = a_4_jws in let jwk = Jose.Jwk.of_priv_json_string ec_priv_json_es512 |> CCResult.get_exn in @@ -96,6 +97,28 @@ let jws_tests = |> CCResult.flat_map (Jose.Jws.validate ~jwk) |> CCResult.map (fun (jws : Jose.Jws.t) -> jws.payload) |> check_result_string "Validated payload is correct" (Ok "Payload")); + Alcotest.test_case "A.4 - recreate JWS" `Quick (fun () -> + let expected_str = a_4_jws in + let jwk = + Jose.Jwk.of_priv_json_string ec_priv_json_es512 |> CCResult.get_exn + in + let header = + Jose.Header. + { + alg = `ES512; + jwk = None; + kid = None; + x5t = None; + x5t256 = None; + typ = None; + cty = None; + enc = None; + extra = []; + } + in + Jose.Jws.sign ~header ~payload:"Payload" jwk + |> CCResult.map Jose.Jws.to_string + |> check_result_string "Validated JWS is same" (Ok expected_str)); (* We currently do not support `none` *) Alcotest.test_case "A.5" `Quick (fun () -> let expected_str = diff --git a/test/RFC7638.ml b/test/RFC7638.ml index 8b0ddd8..2a29d40 100644 --- a/test/RFC7638.ml +++ b/test/RFC7638.ml @@ -6,8 +6,9 @@ let get_ok_thumbprint jwk = get_thumbprint jwk |> CCResult.get_exn let public_rsa_thumbprint () = let hashable_reference = - Fixtures.public_jwk_string_rfc_7638_hashable |> Cstruct.of_string - |> Mirage_crypto.Hash.SHA256.digest |> url_encode_cstruct + Fixtures.public_jwk_string_rfc_7638_hashable + |> Digestif.SHA256.digest_string |> Digestif.SHA256.to_raw_string + |> url_encode_string in let hashed_reference = Fixtures.public_jwk_string_rfc_7638_hashed in let thumbprint = @@ -15,18 +16,18 @@ let public_rsa_thumbprint () = |> CCResult.get_exn |> get_ok_thumbprint in check_string "Hashes must match" hashable_reference - (url_encode_cstruct thumbprint); + (url_encode_string thumbprint); check_string "Hashes must match" hashed_reference - (url_encode_cstruct thumbprint) + (url_encode_string thumbprint) let private_rsa_thumbprint () = let private_thumbprint = Fixtures.private_jwk_string |> Jwk.of_priv_json_string |> CCResult.get_exn - |> get_ok_thumbprint |> url_encode_cstruct + |> get_ok_thumbprint |> url_encode_string in let public_thumbprint = Fixtures.public_jwk_string |> Jwk.of_pub_json_string |> CCResult.get_exn - |> get_ok_thumbprint |> url_encode_cstruct + |> get_ok_thumbprint |> url_encode_string in check_string "Hashes must match" public_thumbprint private_thumbprint @@ -35,7 +36,7 @@ let symmetric_thumbprint () = Fixtures.oct_jwk_string |> Jwk.of_pub_json_string |> CCResult.get_exn in check_result_string "Errors must match" (Error `Unsafe) - (Result.map url_encode_cstruct @@ get_thumbprint jwk) + (Result.map url_encode_string @@ get_thumbprint jwk) let tests = List.map make_test_case diff --git a/test/RFC8037.ml b/test/RFC8037.ml index 68822f0..3e95713 100644 --- a/test/RFC8037.ml +++ b/test/RFC8037.ml @@ -50,12 +50,11 @@ let a_3 () = let jwk = Jwk.of_pub_json_string ed25519_public_json in check_result_string "Correct thumbprint" (Ok "kPrK_qmxVWaYVA9wwBF6Iuo3vVzz7TxHCTwXBygrS4k") - (CCResult.flat_map get_thumbprint jwk |> CCResult.map url_encode_cstruct); + (CCResult.flat_map get_thumbprint jwk |> CCResult.map url_encode_string); let priv_jwk = Jwk.of_priv_json_string ed25519_private_json in check_result_string "Correct thumbprint from private" (Ok "kPrK_qmxVWaYVA9wwBF6Iuo3vVzz7TxHCTwXBygrS4k") - (CCResult.flat_map get_thumbprint priv_jwk - |> CCResult.map url_encode_cstruct) + (CCResult.flat_map get_thumbprint priv_jwk |> CCResult.map url_encode_string) let a_4 () = let jwk = Jwk.of_priv_json_string ed25519_private_json in