Source file `pkce.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
(**
 * Copyright 2022 Ulrik Strid. All rights reserved.
 * Use of this source code is governed by a BSD-style
 * license that can be found in the LICENSE file.
 *)

(* https://www.rfc-editor.org/rfc/rfc3986#section-2.3 can also contain "." and
   "~" but we already have 64 characters
*)
let alphabet =
  Base64.make_alphabet
    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"

let octets = 96 (* 4 * (96/3) = 128 *)
let base64_encode s = Base64.encode_string ~alphabet ~pad:false s

module Verifier = struct
  type t = string

  (* https://www.rfc-editor.org/rfc/rfc7636#section-4.1 *)
  let make () = Mirage_crypto_rng.generate octets |> base64_encode
  let of_string s = s
end

module Challenge = struct
  (* https://www.rfc-editor.org/rfc/rfc7636#section-4.2 *)
  type t =
    | Plain of string
    | S256 of string

  type transformation =
    [ `S256
    | `Plain
    ]

  (* We MUST create sha256 since we can
     https://www.rfc-editor.org/rfc/rfc7636#section-4.2 *)
  let make verifier =
    let s256_challenge_string =
      Digestif.SHA256.digest_string verifier
      |> Digestif.SHA256.to_raw_string
      |> base64_encode
    in

    S256 s256_challenge_string

  let of_string ~transformation challenge =
    match transformation with
    | `S256 -> S256 challenge
    | `Plain -> Plain challenge

  (* https://www.rfc-editor.org/rfc/rfc7636#section-4.3 *)
  let to_code_challenge_and_method challenge =
    match challenge with
    | Plain challenge -> challenge, "plain"
    | S256 challenge -> challenge, "S256"
end

(* https://www.rfc-editor.org/rfc/rfc7636#section-4.6 *)
let verify (verifier : Verifier.t) (challenge : Challenge.t) =
  match challenge with
  | S256 c ->
    let[@warning "-8"] (Challenge.S256 v) = Challenge.make verifier in
    Eqaf.equal v c
  | Plain c -> Eqaf.equal verifier c