Source file cipher.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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
(* This file is part of Dream, released under the MIT license. See LICENSE.md
   for details, or visit https://github.com/aantron/dream.

   Copyright 2021 Anton Bachin *)



(* TODO Review all | exception cases in all code and avoid them as much sa
   possible. *)
(* TODO Support mixture of encryption and signing. *)
(* TODO LATER Switch to AEAD_AES_256_GCM_SIV. See
   https://github.com/mirage/mirage-crypto/issues/111. *)



module Message = Dream_pure.Message



module type Cipher =
sig
  val prefix : char
  val name : string

  val encrypt :
    ?associated_data:string -> secret:string -> string -> string

  val decrypt :
    ?associated_data:string -> secret:string -> string -> string option

  val test_encrypt :
    ?associated_data:string -> secret:string -> nonce:string -> string -> string
end

let encrypt (module Cipher : Cipher) ?associated_data secret plaintext =
  Cipher.encrypt ?associated_data ~secret plaintext

let rec decrypt
    ((module Cipher : Cipher) as cipher) ?associated_data secrets ciphertext =

  match secrets with
  | [] -> None
  | secret::secrets ->
    match Cipher.decrypt ?associated_data ~secret ciphertext with
    | Some _ as plaintext -> plaintext
    | None -> decrypt cipher secrets ciphertext

(* Key is good for ~2.5 years if every request e.g. generates one new signed
   cookie, and the installation is doing 1000 requests per second. *)
module AEAD_AES_256_GCM =
struct
  (* Enciphered messages are prefixed with a version. There is only one right
     now, version 0, in which the rest of the message consists of:

     - a 96-bit nonce, as recommended in RFC 5116.
     - ciphertext generated by AEAD_AES_256_GCM (RFC 5116).

     The 256-bit key is "derived" from the given secret by hashing it with
     SHA-256.

     See https://tools.ietf.org/html/rfc5116. *)

  (* TODO Move this check to the envelope loop. *)
  let prefix =
    '\x00'

  let name =
    "AEAD_AES_256_GCM, " ^
    "mirage-crypto, key: SHA-256, nonce: 96 bits mirage-crypto-rng"

  let derive_key secret =
    secret
    |> Cstruct.of_string
    |> Mirage_crypto.Hash.SHA256.digest
    |> Mirage_crypto.Cipher_block.AES.GCM.of_secret

  (* TODO Memoize keys or otherwise avoid key derivation on every call. *)
  let encrypt_with_nonce secret nonce plaintext associated_data =
    let key = derive_key secret in
    let adata = Option.map Cstruct.of_string associated_data in
    let ciphertext =
      Mirage_crypto.Cipher_block.AES.GCM.authenticate_encrypt
        ~key
        ~nonce
        ?adata
        (Cstruct.of_string plaintext)
      |> Cstruct.to_string
    in

    "\x00" ^ (Cstruct.to_string nonce) ^ ciphertext

  let encrypt ?associated_data ~secret plaintext =
    encrypt_with_nonce
      secret (Random.random_buffer 12) plaintext associated_data

  let test_encrypt ?associated_data ~secret ~nonce plaintext =
    encrypt_with_nonce
      secret (Cstruct.of_string nonce) plaintext associated_data

  let decrypt ?associated_data ~secret ciphertext =
    let key = derive_key secret in
    if String.length ciphertext < 14 then
      None
    else
      if ciphertext.[0] != prefix then
        None
      else
        let adata = Option.map Cstruct.of_string associated_data in
        let plaintext =
          Mirage_crypto.Cipher_block.AES.GCM.authenticate_decrypt
            ~key
            ~nonce:(Cstruct.of_string ~off:1 ~len:12 ciphertext)
            ?adata
            (Cstruct.of_string ciphertext ~off:13)
        in
        match plaintext with
        | None -> None
        | Some plaintext -> Some (Cstruct.to_string plaintext)
end

let secrets_field =
  Message.new_field
    ~name:"dream.secret"
    ~show_value:(fun _secrets -> "[redacted]")
    ()

(* TODO Add warnings about secret length and such. *)
(* TODO Also add warnings about implicit secret generation. However, these
   warnings might be pretty spammy. *)
(* TODO Update examples and docs. *)
let set_secret ?(old_secrets = []) secret =
  let value = secret::old_secrets in
  fun next_handler request ->
    Message.set_field request secrets_field value;
    next_handler request

let fallback_secrets =
  lazy [Random.random 32]

let encryption_secret request =
  match Message.field request secrets_field with
  | Some secrets -> List.hd secrets
  | None -> List.hd (Lazy.force fallback_secrets)

let decryption_secrets request =
  match Message.field request secrets_field with
  | Some secrets -> secrets
  | None -> Lazy.force fallback_secrets

let encrypt ?associated_data request plaintext =
  encrypt
    (module AEAD_AES_256_GCM)
    ?associated_data
    (encryption_secret request)
    plaintext

let decrypt ?associated_data request ciphertext =
  decrypt
    (module AEAD_AES_256_GCM)
    ?associated_data
    (decryption_secrets request)
    ciphertext