diff --git a/docs/kdf-scopes.md b/docs/kdf-scopes.md new file mode 100644 index 00000000..d7d7b1ed --- /dev/null +++ b/docs/kdf-scopes.md @@ -0,0 +1,633 @@ +# Key Derivation Functions and `kdf_scope`s + +Owl models key derivation functions (KDFs) using *KDF scopes*: named blocks +that encapsulate all the ways that a particular set of names can be used with +the key derivation function. This includes the DH key names that may participate +in ODH, the pre-shared kdfkeys, any intermediate nametypes used to describe +KDF outputs, and the labeled derivation rules that say which salt + ikm + info +combination produces which output. + +This document describes the surface syntax of `kdf_scope` declarations, the +well-formedness constraints that scopes and their rules must satisfy, the +call-site syntax of the `kdf`/`gkdf`/`KDF<...>` forms, and the typing +rules that the checker uses to give a type to a KDF call. A more formal +reference appears in the *Typing rules* section at the bottom. + +A running example that uses almost every feature is +[tests/success/kdf-enc.owl](../tests/success/kdf-enc.owl). For the simplest +ODH call see [tests/success/odh_kdfkey_salt.owl](../tests/success/odh_kdfkey_salt.owl). + +--- + +## 1. The `kdf_scope` block + +A KDF scope groups together all of the names and rules that share a single KDF +derivation chain. The block has the form: + +``` +kdf_scope GroupName { + // Key material declarations + name X : DH @ loc1 + name Y : DH @ loc2 + name k : kdfkey @ alice, bob + + // (optional) helper nametypes, funcs, predicates + nametype Chain1 : ... + predicate p(x) = ... + func mkinfo arity 1 + + // Derivation rules + kdf L1 : k, 0x, 0x01 -> enckey Name(secret) + odh L2 : k, dh_ss(X, Y), 0x -> strict kdfkey + // ... +} +``` + +The block does not act as a namespace. Names declared inside are registered at the +top level with their bare identifiers and can be referred to from anywhere +else in the file as `get(X)`, `dhpk(X)`, `[k]`, etc., and there is no `G.` or +`GroupName.` qualifier on ordinary uses. + +### 1.1 What can appear inside a `kdf_scope` + +Only the following declarations are allowed: + +- `name n : DH @ loc`---a Diffie–Hellman name for this group's ODH rules. +- `name k : kdfkey @ locs`---a pre-shared kdfkey that may appear in the + salt or ikm of a rule. +- `nametype Cx : `---a nametype used to describe the behavior + of a KDF output. Any Owl nametype is permitted here (`kdfkey`, + `enckey t`, `sigkey t`, `nonce`, `st_aead ...`, and so on); it is not + restricted to `kdfkey`. Actual KDF output names use the + `KDF` name expression syntax (§3.3). +- `predicate p(...) = ...`---regular Owl predicates. +- `func f arity n` / `func f(...) = ...`---regular Owl pure user-defined + functions. +- `kdf L ...` / `odh L ...`---KDF derivation rules (see §2). + +The checker rejects everything else inside a scope. In particular, `name` +declarations inside a `kdf_scope` must have base name type `DH` or `kdfkey` +(no other kinds are accepted, and abstract names and name abbreviations +are also rejected). + +Conversely, `kdf` and `odh` rules are only legal *inside* a scope---writing +one at the top level is a type error. + +### 1.2 Where to place a scope in your file + +Since names declared inside a scope are registered at the top level, any +`corr` declaration, `def`, or predicate that refers to `get(X)` / `[k]` must +appear *after* the `kdf_scope` that introduces them. Scopes may appear +before or after other `name`/`nametype` declarations as long as the +references they contain are themselves in scope. + +### 1.3 Multiple scopes in one file + +A file may declare several independent `kdf_scope` blocks; each one's DH keys +and kdfkeys are independent and cannot interact with each other. + +--- + +## 2. KDF rules + +Each rule inside a scope has the form + +``` +(kdf | odh) Label(params) [where Constraint] : + salt_expr , + ikm_expr , + info_expr + -> output_spec +``` + +- `Label` is an identifier that names the rule. Labels are *global* across + every `kdf_scope` in the file---when the checker resolves a label at a + call site, it searches every scope until it finds a match + ([src/TypingBase.hs:736-753](../src/TypingBase.hs#L736-L753)). This may + change in the future. +- `` is an optional list of `` style session/PId index + parameters (same syntax as name and def declarations). +- `(params)` is an optional list of bytestring-valued parameters that the + rule body may refer to---these become free variables in the salt, ikm, + and info expressions. They are supplied at the call site as bytestring arguments + (see §3). +- `where Constraint` is an optional `Prop` that narrows when the rule fires. + +`kdf` is used when no Diffie–Hellman secret appears in the ikm. `odh` must be +used when the ikm contains a `dh_ss(A, B)` atom. Internally these are handled +the same way, but the syntax requires the programmer to be explicit about uses +of the PRF-ODH assumption. + +### 2.1 `salt_expr` + +The `salt_expr` is one of: + +- **A name**: a bare group kdfkey (e.g. `k`), or a derived kdfkey name + `KDF(args); kind1 || ... ; j>` that names the `j`-th + output of another rule in the same chain. +- **A public expression**: a hex constant (`0x`, `0x01`), or any public + function applied to public arguments. + +### 2.2 `ikm_expr` + +The `ikm_expr` is a `++` concatenation of one or more *atoms*, each of which +is one of: + +- **A public expression**: a hex constant, a DH public key `dhpk(N)`, or a + public function applied to public arguments. +- **A group kdfkey name**: a bare `k` (or a derived kdfkey name + `KDF`). +- **A DH shared secret**: `dh_ss(A, B)` where `A` and `B` are both DH names + declared in *the current KDF scope*. This is the only form the parser accepts + for a Diffie–Hellman secret inside a rule body, and the checker rejects + the rule when `A` or `B` comes from a different scope + ([tests/failure/kdf-scope-cross-scope-dh.owl](../tests/failure/kdf-scope-cross-scope-dh.owl)). + +A rule is classified as `odh` if and only if its ikm contains at least one +`dh_ss` atom. Otherwise, it is a `kdf` rule. + +### 2.3 `info_expr` + +The `info_expr` is a single public expression (hex constant or public +function application). + +### 2.4 `output_spec` + +The output is a `||`-separated list of + +``` +[strict | public]? NameType +``` + +entries. The three strictnesses are: + +- `strict T`---the output is a secret name of nametype `T`. If the inputs are secret, + the call-site result is refined with `sec(ne)` (i.e. `[ne] !<= adv`). +- `public T`---the output is declared publicly derivable (the call-site + result is refined with `corr(ne)`). +- bare `T`---unstrict: no secrecy refinement is added to the result. + +Each `NameType` must be *uniform*---it must be a name type whose members +have a fixed, public bit-length and are uniformly distributed among bytestrings +of that length. Group elements are not uniform, so `DH` is rejected as an output +([tests/failure/kdf-scope-nonuniform-output.owl](../tests/failure/kdf-scope-nonuniform-output.owl)). + +A single rule with several `||`-separated outputs is how one `kdf` call at +runtime produces several independent keys. The `j` index at the call site +picks which of the outputs is being extracted. + +### 2.5 Well-formedness of KDF rules + +When the checker processes a scope, it validates each rule +([src/Typing.hs:1141-1207](../src/Typing.hs#L1141-L1207)): + +1. **Scope binding.** At least one of the following must hold: + - the salt is a group kdfkey name (or a derived kdfkey whose j-th output + has `NK_KDF` kind), + - the ikm contains at least one group kdfkey name, or + - the ikm contains a `dh_ss(A, B)` where both `A` and `B` are declared + in *this* scope. + + A rule whose salt and ikm are entirely public with no scope-owned secret + is rejected + ([tests/failure/kdf-scope-no-secret.owl](../tests/failure/kdf-scope-no-secret.owl)). + +2. **Every index parameter is used.** Each session / PId index declared in + the rule header must appear free in the salt, ikm, or info expression + ([tests/failure/kdf-scope-unused-idx.owl](../tests/failure/kdf-scope-unused-idx.owl)). + +3. **Every data parameter is used.** Each bytestring argument must appear + free in the salt, ikm, or info expression + ([tests/failure/kdf-scope-unused-dvar.owl](../tests/failure/kdf-scope-unused-dvar.owl)). + +4. **Output types typecheck and are uniform.** Each declared output + nametype must pass `checkNameType` and `nameTypeUniform`. + +5. **Pairwise disjointness of (salt, ikm, info, where).** For every pair of + rules in the same scope, the SMT solver must prove that their + salt-equality, ikm-equality, info-equality, *and* both `where`-clauses + cannot simultaneously hold + ([src/Typing.hs:1248-1273](../src/Typing.hs#L1248-L1273)). Duplicate + rules with the same shape fail this check + ([tests/failure/kdf-scope-dup-sii.owl](../tests/failure/kdf-scope-dup-sii.owl)). + +5b. **Self-disjointness of each rule.** Each individual rule must also be + disjoint with itself: two distinct choices of its own index / data + parameters must not yield the same `(salt, ikm, info)` under its + `where` predicate + ([src/Typing.hs:1208-1246](../src/Typing.hs#L1208-L1246)). For example, + `kdf L(a, b): k, 0x, a ++ b -> ...` is rejected, because + `(a=0x12, b=0x34)` and `(a=0x1234, b=0x)` produce the same + `info = 0x1234`, yet `(a, b)` differ. A rule with no index or data + parameters trivially satisfies this check. + +6. **Name identifier uniqueness.** Names declared inside a scope must not + collide with any other top-level name + ([tests/failure/kdf-scope-repeated-name.owl](../tests/failure/kdf-scope-repeated-name.owl)). + +--- + +## 3. Using KDF rules in code + +### 3.1 Runtime KDF calls: `kdf(...)` + +The call-site form is + +``` +kdf(args), Label2<...>, ...; kind1 || kind2 || ... ; j>(salt, ikm, info) +``` + +- The first angle-bracket field is a non-empty comma-separated list of + **rule hints**. Each hint is a `KDFScopeRuleRef`: a label, an optional + `` index list, and optional `(args)` bytestring arguments. The + checker tries each hint and uses the one (if any) that actually matches. +- The second field is a `||`-separated list of the rule's output `NameKind`s + (`kdfkey`, `nonce`, `enckey`, `mackey`, `sigkey`, `pkekey`). Its + length and contents must match what the chosen rule declares. +- `j` is the index into the `||` list: which output is being extracted. + +Concretely, from [tests/success/kdf-enc.owl](../tests/success/kdf-enc.owl): + +```owl +let ek = kdf(get(k), 0x, 0x01) in // one hint +let k2 = kdf(get(k), 0x, 0x02) in +let ek2 = kdf(0x, k2, 0x01) in +let k1 = kdf(get(kk), 0x, 0x) in // two outputs +let k2 = kdf(get(kk), 0x, 0x) in +``` + +Multiple hints are passed as a comma-separated list and are commonly used +when different rules can apply in different branches of the typechecker. +All hints must produce compatible outputs (i.e., the name kinds for each output must be equal). + +### 3.2 Ghost KDF calls: `gkdf<...>(...)` + +The same syntax is used in ghost position (inside `func` bodies, struct +ghost fields, etc.) as in the old version: + +``` +gkdf(args); kinds; j>(salt, ikm, info) +``` + +### 3.3 Derived KDF outputs inside rule bodies and struct field types + +The `KDF(args); kinds; j>` form is a *name expression*. It +uniquely defines a name, since KDF rules must have disjoint domains and so +(by the injectivity assumption on KDF) have disjoint codomains. + +--- + +## 4. How a `kdf` call is type-checked + +The logic lives in [src/Typing.hs:3286-3303](../src/Typing.hs#L3286-L3303) +and the helpers it calls. At a high level, given a call + +``` +kdf(saltE, ikmE, infoE) +``` + +the checker proceeds in three stages. + +### 4.1 Stage 1---match the hints + +For each hint `h_k`, `tryKDFRuleHint` +([src/Typing.hs:2975-3031](../src/Typing.hs#L2975-L3031)) looks up the rule +body (substituting the hint's index and bytestring arguments) and then checks: + +1. `checkSaltMatch`: the runtime salt expression is provably equal + to the rule's `salt_expr`. +2. `checkIKMMatch`: the runtime ikm is provably equal to the concatenation + of the rule's ikm atoms. +3. `checkInfoMatch`: the runtime info is provably equal to the rule's + `info_expr`. +4. `checkWhereClause`: the rule's `where` predicate is provable in the + current path condition. + +If any of these fails, the hint doesn't match and returns `Nothing`. If all +pass, the call-site name-kind row `nks` is checked against the rule's +declared output kinds, and the hint is matched. + +The three possible outcomes are: + +- **Exactly one hint matches.** The checker returns the matched rule's + output type (see §4.2 for how it picks between a secret and a public + shape). +- **More than one hint matches.** The call is *ambiguous* and rejected + with `"Ambiguous KDF call: multiple hints matched"`. +- **No hint matches.** Fall through to stage 2 (§4.3). + +### 4.2 Output type of a matching hint + +Assume hint `h` matched and the rule declares output `j` with strictness `S` +and nametype `T`. Let `saltPub` / `ikmPub` be `true` if the corresponding +runtime argument flows to `adv`. Write `saltHasKey` for "the rule's salt +is a name" and `ikmHasKey` for "the rule's ikm contains a kdfkey name or a +`dh_ss`". Then the result type is: + +| condition | result | +|-----------|--------| +| `saltPub ∧ ikmPub` | `Data` (public KDF output) | +| `¬saltPub ∧ saltHasKey` or `¬ikmPub ∧ ikmHasKey` | refined `Name(KDFName...)` with strictness refinement from `S` | +| otherwise | type error | + +The info argument must always be public---the checker asserts this +unconditionally. + +The name expression returned is `KDF`. + +The strictness-derived refinement is: + +| strictness | refinement added to `.res` | +|------------|----------------------------| +| `strict` | `¬([res] <= adv)`, i.e. `sec(res)` | +| `public` | `[res] <= adv`, i.e. `corr(res)` | +| unstrict | `True` | + +### 4.3 Stage 2---no hint matched + +`handleKDFNoMatch` ([src/Typing.hs:3164-3218](../src/Typing.hs#L3164-L3218)) +handles the remaining cases. + +**Fast path---all-public arguments.** If the salt, ikm, and info are all +public (flow to `adv`) then the KDF output is `Data` and no further +analysis is needed. + +**Locate the scope.** All hints (if any) must refer to labels in the same +scope; the checker looks up that scope. + +**Provably out of bounds.** For every rule in the scope, the checker asks +SMT whether the call's (salt, ikm, info) *could* match the rule's +(salt, ikm, info, where condition). Two outcomes are acceptable: + +- If at least one rule might match, the call is + potentially in-bounds and we continue. +- If *every* rule's match proposition is provably false, the call is + provably out of bounds and the output is `Data`. This is how + deliberately-wrong hint mismatches (e.g., calling with a wrong salt + key) fall through to a public output + ([tests/failure/kdf-scope-wrong-salt.owl](../tests/failure/kdf-scope-wrong-salt.owl)). + +If the result is inconclusive (some rules possibly match and the +checker cannot rule them all out) the call is rejected with +`"Inconclusive: cannot match this KDF call with a rule or prove that it +doesn't match any of the rules"`. + +**Scope-bound + public fallback.** Otherwise (at least one rule can't be proven not to match +but no hint matches exactly), the checker requires that the call is +provably bound to this scope *and* that every one of its arguments is +already public: + +- At least one of `(saltE, ikmE-atom₁, ikmE-atom₂, …)` must be a + *local scope binding expression*: a name from the scope used as a salt/ikm + atom, or a `dh_combine(pk, sk)` whose `pk` or `sk` is a scope DH name. +- *Every* component must also be public (flow to `adv`). + +If those hold, the output is `Data`. Otherwise the call is rejected. + +At a site with no matching hint, the call may still be +accepted, but only when the checker can prove either that no rule in the +scope could possibly apply or that every component of the call is already +public. The intent is to rule out cases where Owl expects a KDF call to +match rule `L1`, but the adversary supplies inputs that match rule `L2` and +confuse the typechecker into generating (and possibly releasing) unrelated secrets. + +--- + +## 5. A worked example + +[tests/success/kdf-enc.owl](../tests/success/kdf-enc.owl) exercises a short +chain: + +```owl +kdf_scope G { + name k : kdfkey @ alice, bob + + kdf L1_enc : k, 0x, 0x01 -> enckey Name(alice1) + kdf L1_kdf : k, 0x, 0x02 -> strict kdfkey + kdf L2_enc : 0x, KDF, 0x01 -> enckey Name(alice2) + kdf L2_kdf : 0x, KDF, 0x02 -> strict kdfkey + kdf L3_enc : KDF, 0x, 0x01 -> enckey Name(alice3) +} + +def alice_main() @ alice : Unit = + let ek = kdf(get(k), 0x, 0x01) in + let c = aenc(ek, get(alice1)) in + output c to endpoint(bob); + let k2 = kdf(get(k), 0x, 0x02) in + let ek2 = kdf(0x, k2, 0x01) in + let c2 = aenc(ek2, get(alice2)) in + output c2 to endpoint(bob); + () +``` + +- `L1_enc` and `L1_kdf` share the salt `k` and differ only in their info + (`0x01` vs `0x02`); the salt-ikm-info-disjointness SMT check verifies they cannot + both match. +- `L2_enc` and `L2_kdf` take a chained salt: the rule's salt is + `KDF`, and the call-site salt is `k2`, the runtime + value produced by the `kdf(…)` call. The checker + recognizes `k2`'s type as `KDFName … L1_kdf`, which matches the rule's + declared salt. +- Because `L1_kdf` is `strict`, `k2` is typed as a secret + `Name(KDFName… L1_kdf)` refined with `sec(k2)`, allowing it to be passed + in the salt position of the L2 rules. + +--- + +## 6. Typing rules + +The rules below mirror the style of +[docs/internals/kdf.md](internals/kdf.md)---each premise is on its own +line, and indices and capture-avoiding substitutions are written +explicitly where they matter. They ignore: + +- the `findScopeForLabel` lookup (labels are global across scopes, so each + hint resolves to a unique scope); +- the `unconcatIKM` concatenation handling on the call side (treated as if + the runtime ikm arrives as a single value that is provably equal to the + rule's concatenation); +- the ghost `gkdf` / `KDF<...>` forms, which reuse the same rule machinery + as `kdf`. + +### Notation + +- `G` is the overall typing context. +- `G[k]` looks up `k` as a name definition; `G[L]` looks up `L` as a KDF + scope rule. +- `p[x := y]` is capture-avoiding substitution. +- `gkdf(as), nks, j>(a,b,c)` is the ghost KDF value. +- `adv` is the adversary label; `sec(n) ≜ ¬([n] <= adv)`; + `corr(n) ≜ [n] <= adv`. +- `dhpk(n)` is not written explicitly on DH names when used in `dh_combine`. + +### Rule lookup: `ruleOfRef(ref, body)` + +Given a call-site reference `ref = L(as)`, we look up `body` in some +scope `GName`: + +``` +(GName, gdef) ∈ G.kdfScopes +gdef.rules[L] = kdf L(dvars'): ruleBody +|is| = |is'| |as| = |dvars'| +body = ruleBody[is' := is][dvars' := as] +----------------------------------------------------- +G |- ruleOfRef(L(as), body) +``` + +When several scopes define the same label, the first matching one wins; +labels are expected to be globally unique. + +### Hint match: `hintMatches(ref, (a,b,c))` + +Given `body` as above, with output spec +`[(S_0, T_0), ..., (S_{m-1}, T_{m-1})]`: + +``` +G |- ruleOfRef(ref, body) +G |- a = body.salt +G |- b = body.ikm (atoms concatenated) +G |- c = body.info +G |- body.where +--------------------------------------------------------------- +G |- hintMatches(ref, (a,b,c)) with body, outputs +``` + +### Well-typed KDF with a matching hint + +Let `ref = L(as)` and suppose exactly one hint `ref_i ∈ {ref_1, ..., ref_k}` +satisfies `hintMatches`. Let the matched rule's j-th output be +`(S_j, T_j)` with name kind `nks[j]`. Let +`ne = KDFName(nks, j, true, ref_i)`. + +**Fully public case** (salt and ikm both adversary-controlled): + +``` +G |- hintMatches(ref_i, (a,b,c)) +G |- nks matches outputs +G |- c <= adv // info always public +G |- a <= adv +G |- b <= adv +----------------------------------------------- +G |- kdf<{ref_1,...,ref_k}; nks; j>(a,b,c) : + x : Data { |x| = |nks[j]| ∧ x = gkdf(a,b,c) } +``` + +**Honest case** (some secret ingredient present in a key position of the +rule): + +``` +G |- hintMatches(ref_i, (a,b,c)) +G |- nks matches outputs +G |- c <= adv +(a !<= adv ∧ body.salt is a name) + ∨ (b !<= adv ∧ body.ikm contains a kdfkey-name or dh_ss atom) +--------------------------------------------------------- +G |- kdf<{ref_1,...,ref_k}; nks; j>(a,b,c) : + x : Name(ne) { + strictnessOf(ne, S_j) + ∧ |x| = |nks[j]| + ∧ x = gkdf(a,b,c) + } +``` + +**Ambiguous hints.** If more than one `ref_i` matches simultaneously, the +checker raises a type error---the rule body is undefined. + +### No hint matched---out-of-bounds case + +Let `scope(refs) = GName` with rules `rules = {(L_1, body_1), ..., (L_n, body_n)}`. + +``` +∀ k ∈ {1..|refs|}. ¬ hintMatches(refs[k], (a,b,c)) +∀ i ∈ {1..n}. G |- ¬ ∃ is dvars. (a = body_i.salt ∧ b = body_i.ikm + ∧ c = body_i.info ∧ body_i.where) +G |- c <= adv +-------------------------------------------------------- +G |- kdf(a,b,c) : + x : Data { |x| = |nks[j]| ∧ x = gkdf(a,b,c) } +``` + +### No hint matched---public-arguments fallback + +Let `entryNames(GName)` be the kdfkeys and DH names declared in the scope. +Write `LSBE(e)` for "`e` is a name from `entryNames`, or `e = +dh_combine(pk, sk)` where `pk` or `sk` is a DH name from `entryNames`". + +``` +∀ k ∈ {1..|refs|}. ¬ hintMatches(refs[k], (a,b,c)) +∃ i. G |- ∃ is dvars. (a = body_i.salt ∧ b = body_i.ikm + ∧ c = body_i.info ∧ body_i.where) // not all provably out-of-bounds +G |- c <= adv +b = b_1 ++ ... ++ b_p // expose the ikm atoms +LSBE(a) ∨ ∃ q. LSBE(b_q) // call is bound to this scope +G |- a <= adv ∧ b_1 <= adv ∧ ... ∧ b_p <= adv +-------------------------------------------------------- +G |- kdf(a,b,c) : + x : Data { |x| = |nks[j]| ∧ x = gkdf(a,b,c) } +``` + +Both "no-hint" rules are special cases of the overapproximating rule from +[docs/internals/kdf.md](internals/kdf.md): they return `Data` but only +when the checker is able to prove that this is safe. If neither applies, +the call is rejected with `"Inconclusive: cannot match this KDF call with +a rule or prove that it doesn't match any of the rules"` (inconclusive SMT +result) or `"This KDF call isn't bound to scope 'G': it must contain a +name or DH secret from the scope"` (no LSBE component). + +### `strictnessOf(ne, strictness)` + +``` +strictnessOf(ne, strict) ≜ ¬([ne] <= adv) +strictnessOf(ne, public) ≜ [ne] <= adv +strictnessOf(ne, unstrict) ≜ True +``` + +### Well-formedness of rules (`validateKDFScopeRule`) + +For a rule `R = (kdf|odh) L(dvars) [where W] : s, k, i -> outputs` in +scope `GName` with entry names `N = kdfkeys ∪ dhs`: + +``` +scopeHasKey(R) ≜ + (s is a name whose leaf symbol ∈ kdfkeys, or a `KDF<...>` + reference with kdfkey kind) + ∨ (∃ atom ∈ k. atom is a kdfkey name from kdfkeys, + or a `KDF<...>` reference with kdfkey kind) + ∨ (∃ atom ∈ k. atom = dh_ss(A, B) with A, B ∈ dhs) + +fv(s) ∪ fv(k) ∪ fv(i) ⊇ is ∪ dvars +each output T_j typechecks and is uniform +∀ R' ∈ scope rules, R' ≠ R. + G |- ¬ ∃ is' dvars'. (s = s' ∧ k = k' ∧ i = i' ∧ W ∧ W') +----------------------------------------------------------- +G |- validateRule(GName, R) +``` + +Failure of any of these premises produces a compile-time error at the +`kdf_scope` block itself. + +--- + +## 7. Design notes + +- **Why one rule per case.** Where the old `kdf {ikm info. … }` nametype + syntax used predicate branches to discriminate cases, `kdf_scope` uses + one labeled rule per case. The condition is expressed structurally: a + `Chain1`-typed salt can only arise from the rule that produced it. + This is easier to audit and lets the SII-disjointness SMT check cover all overlap. + +- **Why `where` clauses.** They exist so that two rules that differ only + by a relation on their indices---commonly a "correct session" vs. a + "wrong session" variant---can coexist without overlap, or to capture "off-chain" + cases where some but not all of the input to the KDF doesn't match the expected form. + +- **Why hints are *ghost*.** At runtime, a KDF call is just a call to the + underlying KDF primitive; the hint list only affects the type the checker + gives to the result. The multi-hint form is useful when different branches + of the typechecker (e.g., different `corr_case`s or index conditions) require + different hints to typecheck. + +- **Soundness assumption: type provenance.** The checker trusts that a + value typed as `Name(KDFName…)` could only have been produced by the + corresponding rule's KDF call, and uses this to type derived kdfkeys + like `KDF` as salt arguments of later rules. diff --git a/prelude.smt2 b/prelude.smt2 index 824778e8..f4711e63 100644 --- a/prelude.smt2 +++ b/prelude.smt2 @@ -268,6 +268,8 @@ :pattern (dh_combine (dhpk x) y) :qid dh_combine_comm ))) + +; Below two axioms are only sound if we have the "unique subgroup" property for the DH group (assert (forall ((x Bits) (y Bits) (z Bits)) (! (=> (and (IsExponent x) (IsExponent y) (= TRUE (is_group_elem z)) (= TRUE (eq (dh_combine z x) (dh_combine z y)))) @@ -330,7 +332,6 @@ ; intersect. For soundness, this set must have measure zero (declare-fun KDF (Bits Bits Bits Int Int) Bits) -(declare-fun KDFName (Bits Bits Bits Int Int) Name) (assert (forall ((x Bits) (y Bits) (z Bits) (i Int) (j Int)) (! (=> diff --git a/src/AST.hs b/src/AST.hs index 1b7c61ad..4c0b67e2 100644 --- a/src/AST.hs +++ b/src/AST.hs @@ -130,8 +130,9 @@ data KDFStrictness = KDFStrict | KDFPub | KDFUnstrict data NameExpX = NameConst ([Idx], [Idx]) Path [AExpr] - | KDFName AExpr AExpr AExpr [NameKind] Int NameType (Ignore Bool) + | KDFName [NameKind] Int (Ignore Bool) KDFScopeRuleRef -- Ignore Bool is whether we trust that the name is well-formed + -- KDFScopeRuleRef identifies the kdf_scope rule that produced this name deriving (Show, Generic, Typeable) @@ -236,21 +237,16 @@ pHappened :: Path -> ([Idx], [Idx]) -> [AExpr] -> Prop pHappened s ids xs = mkSpanned $ PHappened s ids xs -data KDFPos = KDF_SaltPos | KDF_IKMPos - deriving (Show, Generic, Typeable, Eq) - data NameTypeX = NT_DH | NT_Sig Ty - | NT_Nonce String + | NT_Nonce String | NT_Enc Ty - | NT_StAEAD Ty (Bind (DataVar, DataVar) Prop) Path (Bind DataVar AExpr) + | NT_StAEAD Ty (Bind (DataVar, DataVar) Prop) Path (Bind DataVar AExpr) | NT_PKE Ty | NT_MAC Ty | NT_App Path ([Idx], [Idx]) [AExpr] - | NT_KDF KDFPos - -- (Maybe (NameExp, Int, Int)) (Maybe (NameExp, Int, Int)) - KDFBody + | NT_KDF -- bare kdfkey marker; no payload deriving (Show, Generic, Typeable) @@ -319,14 +315,37 @@ type ModuleExp = Spanned ModuleExpX data DepBind a = DPDone a | DPVar Ty String (Bind DataVar (DepBind a)) deriving (Show, Generic, Typeable) -type KDFBody = Bind ((String, DataVar), (String, DataVar), (String, DataVar)) - [Bind [IdxVar] (Prop, [(KDFStrictness, NameType)])] +-- New kdf_scope AST types + +data KDFOutputSpec = KDFOutputSpec [(KDFStrictness, NameType)] + deriving (Show, Generic, Typeable) + +data KDFScopeRuleBody = KDFScopeRuleBody { + _ksrbWhere :: Prop, -- PTrue when no where clause + _ksrbSalt :: AExpr, + _ksrbIkm :: AExpr, + _ksrbInfo :: AExpr, + _ksrbOutput :: KDFOutputSpec +} deriving (Show, Generic, Typeable) + +data KDFScopeRuleX = KDFScopeRule { + _ksrIsODH :: Bool, + _ksrLabel :: String, + _ksrBody :: Bind (([IdxVar], [IdxVar]), [DataVar]) KDFScopeRuleBody +} deriving (Show, Generic, Typeable) + +type KDFScopeRule = Spanned KDFScopeRuleX +data KDFScopeRuleRef = KDFScopeRuleRef { + _ksrrLabel :: String, + _ksrrIdxs :: ([Idx], [Idx]), + _ksrrArgs :: [AExpr] +} deriving (Show, Generic, Typeable) -- Decls are surface syntax -data DeclX = - DeclName String (Bind ([IdxVar], [IdxVar]) NameDecl) - | DeclSMTOption String String +data DeclX = + DeclName String (Bind ([IdxVar], [IdxVar]) NameDecl) + | DeclSMTOption String String | DeclDefHeader String (Bind ([IdxVar], [IdxVar]) Locality) | DeclPredicate String (Bind ([IdxVar], [DataVar]) Prop) | DeclFun String (Bind (([IdxVar], [IdxVar]), [DataVar]) AExpr) @@ -336,17 +355,18 @@ data DeclX = )) | DeclEnum String (Bind [IdxVar] [(String, Maybe Ty)]) -- Int is arity of indices | DeclInclude String - | DeclCounter String (Bind ([IdxVar], [IdxVar]) Locality) + | DeclCounter String (Bind ([IdxVar], [IdxVar]) Locality) | DeclStruct String (Bind [IdxVar] (DepBind ())) -- Int is arity of indices - | DeclODH String (Bind ([IdxVar], [IdxVar]) (NameExp, NameExp, KDFBody)) | DeclTy String (Maybe Ty) | DeclNameType String (Bind (([IdxVar], [IdxVar]), [DataVar]) NameType) | DeclDetFunc String DetFuncOps Int | DeclTable String Ty Locality -- Only valid for localities without indices, for now | DeclCorr (Bind ([IdxVar], [DataVar]) (Label, Label)) - | DeclCorrGroup (Bind ([IdxVar], [DataVar]) [Label]) + | DeclCorrGroup (Bind ([IdxVar], [DataVar]) [Label]) | DeclLocality String (Either Int Path) - | DeclModule String IsModuleType ModuleExp (Maybe ModuleExp) + | DeclModule String IsModuleType ModuleExp (Maybe ModuleExp) + | DeclKDFScope String [Decl] + | DeclKDFRule KDFScopeRuleX deriving (Show, Generic, Typeable) type Decl = Spanned DeclX @@ -435,12 +455,8 @@ data ExprX = type Expr = Spanned ExprX -type KDFSelector = (Int, [Idx]) - -data CryptOp = - CKDF [KDFSelector] [Either KDFSelector (String, ([Idx], [Idx]), KDFSelector)] - [NameKind] - Int +data CryptOp = + CKDF [KDFScopeRuleRef] [NameKind] Int | CLemma BuiltinLemma | CAEnc | CADec @@ -492,6 +508,10 @@ data FuncParam = deriving (Show, Generic, Typeable) +makeLenses ''KDFScopeRuleBody +makeLenses ''KDFScopeRuleX +makeLenses ''KDFScopeRuleRef + -- LocallyNameless instances $(makeClosedAlpha ''Position) @@ -550,10 +570,25 @@ instance Subst Idx NameExpX instance Subst AExpr NameExpX instance Subst ResolvedPath NameExpX -instance Alpha KDFPos -instance Subst Idx KDFPos -instance Subst AExpr KDFPos -instance Subst ResolvedPath KDFPos +instance Alpha KDFOutputSpec +instance Subst Idx KDFOutputSpec +instance Subst AExpr KDFOutputSpec +instance Subst ResolvedPath KDFOutputSpec + +instance Alpha KDFScopeRuleBody +instance Subst Idx KDFScopeRuleBody +instance Subst AExpr KDFScopeRuleBody +instance Subst ResolvedPath KDFScopeRuleBody + +instance Alpha KDFScopeRuleX +instance Subst Idx KDFScopeRuleX +instance Subst AExpr KDFScopeRuleX +instance Subst ResolvedPath KDFScopeRuleX + +instance Alpha KDFScopeRuleRef +instance Subst Idx KDFScopeRuleRef +instance Subst AExpr KDFScopeRuleRef +instance Subst ResolvedPath KDFScopeRuleRef instance Alpha NameTypeX instance Subst Idx NameTypeX @@ -672,3 +707,11 @@ mkExistsIdx :: [IdxVar] -> Prop -> Prop mkExistsIdx [] p = p mkExistsIdx (x:xs) p = mkSpanned $ PQuantIdx Exists (ignore $ show x) $ bind x $ mkExistsIdx xs p +mkForallBv :: [DataVar] -> Prop -> Prop +mkForallBv [] p = p +mkForallBv (x:xs) p = mkSpanned $ PQuantBV Forall (ignore $ show x) $ bind x $ mkForallBv xs p + +mkExistsBv :: [DataVar] -> Prop -> Prop +mkExistsBv [] p = p +mkExistsBv (x:xs) p = mkSpanned $ PQuantBV Exists (ignore $ show x) $ bind x $ mkExistsBv xs p + diff --git a/src/CmdArgs.hs b/src/CmdArgs.hs index f498ba0d..f6ee4abf 100644 --- a/src/CmdArgs.hs +++ b/src/CmdArgs.hs @@ -18,12 +18,15 @@ data Flags = Flags { _fDebugExtraction :: Bool, _fExtractBufOpt :: Bool, _fDoTests :: Bool, + _fTestWithSMTCache :: Bool, _fLax :: Bool, _fSkipRODisj :: Bool, _fFilePath :: String, _fLocalTypeError :: Bool, _fLogTypecheck :: Bool, _fOnlyCheck :: Maybe String, + _fOnlyParse :: Bool, + _fNoColor :: Bool, _fFileContents :: String } @@ -48,6 +51,9 @@ parseArgs = <*> switch ( long "test" <> help "Do tests") + <*> + switch + ( long "test-with-smtcache" <> help "Do tests without clearing the SMT cache" ) <*> switch ( long "lax" <> help "Lax checking (skip some SMT queries)" ) @@ -62,6 +68,10 @@ parseArgs = switch ( long "log-typecheck" <> help "Log typechecker progress" ) <*> option (Just <$> str) (long "only-check" <> help "Only check the given function" <> value Nothing) + <*> switch + ( long "only-parse" <> help "Run parser only; print parsed module and exit" ) + <*> switch + ( long "no-color-output" <> help "Print errors without terminal colors (suitable for file output)" ) <*> (pure "") where extractAllFlag = switch (long "extract" <> short 'e' <> help "Extract all specs and code") @@ -81,7 +91,8 @@ doParseArgs = do postProcessFlags :: Flags -> Flags postProcessFlags f = - f { _fCleanCache = _fCleanCache f || _fLogSMT f || _fDoTests f } + f { _fCleanCache = _fCleanCache f || _fLogSMT f || _fDoTests f, + _fDoTests = _fTestWithSMTCache f || _fDoTests f } getHelpMessage :: String getHelpMessage = diff --git a/src/Extraction/ConcreteAST.hs b/src/Extraction/ConcreteAST.hs index 31f2488f..ec4d4d3c 100644 --- a/src/Extraction/ConcreteAST.hs +++ b/src/Extraction/ConcreteAST.hs @@ -464,7 +464,7 @@ instance Subst AExpr (CExpr t) compatTys :: CTy -> CTy -> Bool compatTys (CTName n1) (CTName n2) = case (n1 ^. val, n2 ^. val) of - (KDFName _ _ _ nks1 i1 _ _, KDFName _ _ _ nks2 i2 _ _) -> + (KDFName nks1 i1 _ _, KDFName nks2 i2 _ _) -> (nks1 !! i1) `aeq` (nks2 !! i2) _ -> n1 `aeq` n2 compatTys (CTDH_PK _) (CTDH_PK _) = True diff --git a/src/Extraction/Concretify.hs b/src/Extraction/Concretify.hs index 544ea0a8..d6717600 100644 --- a/src/Extraction/Concretify.hs +++ b/src/Extraction/Concretify.hs @@ -184,7 +184,7 @@ formatTyOfNameExp ne = do fl <- fLenOfNameTy nt sec <- secrecyOfNameTy nt return $ FBuf sec $ Just fl - KDFName _ _ _ nks i _ _ -> do + KDFName nks i _ _ -> do let nk = nks !! i sec <- secrecyOfNameKind nk FBuf sec . Just <$> fLenOfNameKind nk @@ -748,7 +748,7 @@ tySigOfCall p = do concretifyCryptOp :: [AExpr] -> CryptOp -> [CAExpr FormatTy] -> EM (CExpr FormatTy, [CLetBinding]) -concretifyCryptOp resolvedArgs (CKDF _ _ nks nkidx) [salt, ikm, info] = do +concretifyCryptOp resolvedArgs (CKDF _ nks nkidx) [salt, ikm, info] = do let nk = nks !! nkidx kdfLen <- kdfLenOf nks outLen <- fLenOfNameKind nk diff --git a/src/LabelChecking.hs b/src/LabelChecking.hs index f4d034e8..5392c79a 100644 --- a/src/LabelChecking.hs +++ b/src/LabelChecking.hs @@ -78,34 +78,7 @@ nameDefFlows n nt = do lv <- symLabel l ln <- symLabel $ mkSpanned $ LName n return $ sFlows lv ln - NT_KDF pos bnd -> do - ctr <- getFreshCtr - (((sx, x), (sy, y), (sz, z)), cases) <- liftCheck $ unbind bnd - -- TODO: below, we need to generealize - axs <- withSMTVars [x, y, z] $ do - axis <- forM [0 .. (length cases - 1)] $ \i -> do - (ixs, (p, nts)) <- liftCheck $ unbind $ cases !! i - axijs <- forM [0 .. (length nts - 1)] $ \j -> do - let (strictness, nt) = nts !! j - ne_axioms <- withSMTIndices (map (\i -> (i, IdxGhost)) ixs) $ do - nks <- liftCheck $ mapM (\(_, nt) -> getNameKind nt) nts - let ne = case pos of - KDF_SaltPos -> - mkSpanned $ KDFName (mkSpanned $ AEGet n) (aeVar' x) (aeVar' y) nks j nt (ignore True) - KDF_IKMPos -> - mkSpanned $ KDFName (aeVar' x) (mkSpanned $ AEGet n) (aeVar' y) nks j nt (ignore True) - nameDefFlows ne nt - ctr <- getFreshCtr - vp <- interpretProp p - return $ sForall (map (\i -> (SAtom $ cleanSMTIdent $ show i, indexSort)) ixs) - (sImpl vp ne_axioms) - [] - ("ax_" ++ show ctr) - return $ sAnd axijs - return $ sAnd axis - let vx = SAtom (show x) - let vy = SAtom (show y) - return $ sForall [(vx, bitstringSort), (vy, bitstringSort)] axs [] ("kdfFlows_" ++ show ctr) + NT_KDF -> return $ SAtom "true" -- bare kdfkey marker; no flow axioms smtLabelSetup :: Sym () smtLabelSetup = do diff --git a/src/Main.hs b/src/Main.hs index 3275c56f..1a1f4a36 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -11,6 +11,7 @@ import Prettyprinter import TypingBase import System.FilePath import CmdArgs +import Pretty import System.Directory import System.Process import System.CPUTime @@ -41,6 +42,9 @@ main = do putStrLn $ "parse error: " ++ show err exitFailure Right ast -> do + when (args^.fOnlyParse) $ do + mapM_ (putStrLn . show . owlpretty) ast + exitSuccess do res <- typeCheckDecls (set fFileContents s args) ast case res of diff --git a/src/Parse.hs b/src/Parse.hs index 4b6ed167..729a7831 100644 --- a/src/Parse.hs +++ b/src/Parse.hs @@ -31,7 +31,7 @@ owlStyle = P.LanguageDef , P.identLetter = alphaNum <|> oneOf "_'?" , P.opStart = oneOf ":!#$%&*+./<=>?@\\^|-~" , P.opLetter = oneOf ":!#$%&*+./<=>?@\\^|-~" - , P.reservedNames = ["adv", "ghost", "Ghost", "bool", "Option", "name", "Name", "SecName", "PubName", "st_aead", "mackey", "sec", "st_aead_enc", "st_aead_dec", "let", "DH", "nonce", "if", "then", "else", "enum", "Data", "sigkey", "type", "Unit", "Lemma", "random_oracle", "return", "corr", "RO", "debug", "assert", "assume", "admit", "ensures", "true", "false", "True", "False", "call", "static", "corr_case", "false_elim", "union_case", "exists", "get", "getpk", "getvk", "pack", "def", "Union", "pkekey", "pke_sk", "pke_pk", "label", "aexp", "type", "idx", "table", "lookup", "write", "unpack", "to", "include", "maclen", "begin", "end", "module", "aenc", "adec", "pkenc", "pkdec", "mac", "mac_vrfy", "sign", "vrfy", "prf", "PRF", "forall", "bv", "pcase", "choose_idx", "choose_bv", "crh_lemma", "ro", "is_constant_lemma", "strict", "aad", "Const", "proof", "gkdf"] + , P.reservedNames = ["adv", "ghost", "Ghost", "bool", "Option", "name", "Name", "SecName", "PubName", "st_aead", "mackey", "sec", "st_aead_enc", "st_aead_dec", "let", "DH", "nonce", "if", "then", "else", "enum", "Data", "sigkey", "type", "Unit", "Lemma", "random_oracle", "return", "corr", "RO", "debug", "assert", "assume", "admit", "ensures", "true", "false", "True", "False", "call", "static", "corr_case", "false_elim", "union_case", "exists", "get", "getpk", "getvk", "pack", "def", "Union", "pkekey", "pke_sk", "pke_pk", "label", "aexp", "type", "idx", "table", "lookup", "write", "unpack", "to", "include", "maclen", "begin", "end", "module", "aenc", "adec", "pkenc", "pkdec", "mac", "mac_vrfy", "sign", "vrfy", "prf", "PRF", "forall", "bv", "pcase", "choose_idx", "choose_bv", "crh_lemma", "ro", "is_constant_lemma", "strict", "aad", "Const", "proof", "gkdf", "kdf_scope", "kdfkey", "odh", "kdf", "where", "nametype", "public", "dh_ss"] , P.reservedOpNames= ["(", ")", "->", ":", "=", "==", "!", "<=", "!<=", "!=", "*", "|-", "+x"] , P.caseSensitive = True } @@ -79,31 +79,31 @@ parseSpanned k = do p' <- getPosition return $ Spanned (ignore $ Position (sourceLine p, sourceColumn p) (sourceLine p', sourceColumn p') (sourceName p)) v -parseKDFSelector :: Parser KDFSelector -parseKDFSelector = do - i <- many1 digit - ps <- parseIdxParams1 - return (read i, ps) +-- Convert a NameKind to a NameType (for KDF name expressions using the new +-- kdf_scope-based format, where the NameType is inferred from the name kind). +nameKindToNameType :: NameKind -> NameType +nameKindToNameType NK_KDF = mkSpanned NT_KDF +nameKindToNameType (NK_Nonce s) = mkSpanned $ NT_Nonce s +nameKindToNameType NK_Enc = mkSpanned $ NT_Enc (tData advLbl advLbl) +nameKindToNameType NK_MAC = mkSpanned $ NT_MAC (tData advLbl advLbl) +nameKindToNameType NK_Sig = mkSpanned $ NT_Sig (tData advLbl advLbl) +nameKindToNameType NK_DH = mkSpanned NT_DH +nameKindToNameType NK_PKE = mkSpanned $ NT_PKE (tData advLbl advLbl) parseNameExp :: Parser NameExp -parseNameExp = - (parseSpanned $ do +parseNameExp = + -- kdf_scope format: KDF; nks; j> + (try $ parseSpanned $ do reserved "KDF" symbol "<" + ref <- parseKDFScopeRuleRef + symbol ";" nks <- parseNameKind `sepBy1` (symbol "||") symbol ";" j <- many1 digit - symbol ";" - nt <- parseNameType symbol ">" - symbol "(" - a <- parseAExpr - symbol "," - b <- parseAExpr - symbol "," - c <- parseAExpr - symbol ")" - return $ KDFName a b c nks (read j) nt (ignore False) + let ji = read j + return $ KDFName nks ji (ignore False) ref ) <|> (parseSpanned $ do @@ -680,18 +680,8 @@ parseNameType = return $ NT_MAC t) <|> (parseSpanned $ do - kpos <- alt (reserved "kdf" >> return KDF_SaltPos) (reserved "dualkdf" >> return KDF_IKMPos) - symbol "{" - x <- identifier - y <- identifier - oz <- optionMaybe identifier - let z = case oz of - Just v -> v - Nothing -> "%self" - symbol "." - kdfCases <- kdfCase `sepBy1` (symbol ",") - symbol "}" - return $ NT_KDF kpos (bind ((x, s2n x), (y, s2n y), (z, s2n z)) kdfCases) + reserved "kdfkey" + return NT_KDF ) <|> (parseSpanned $ do @@ -708,36 +698,11 @@ parseNameType = return $ NT_App p ps as ) -parseKDFStrictness = +parseKDFStrictness = (reserved "strict" >> return KDFStrict) <|> (reserved "public" >> return KDFPub) - -kdfCase :: Parser (Bind [IdxVar] (Prop, [(KDFStrictness, NameType)])) -kdfCase = do - ois <- parseIdxParamBinds1 - p <- parseProp - symbol "->" - nts <- (do - ostrict <- optionMaybe $ parseKDFStrictness - nt <- parseNameType - let strictness = case ostrict of - Nothing -> KDFUnstrict - Just v -> v - return (strictness, nt)) `sepBy` (symbol "||") - return $ bind ois (p, nts) - -parseKDFHint :: Parser (NameExp, Int, Int) -parseKDFHint = do - n <- parseNameExp - symbol "[" - i <- many1 digit - symbol "," - j <- many1 digit - symbol "]" - return (n, read i, read j) - parseLocality :: Parser Locality parseLocality = do x <- parsePath @@ -794,9 +759,96 @@ parseNameDeclBody = (return $ DeclAbstractName) -parseDecls = - many $ - parseNameDecl +-- kdf_scope sub-parsers + +-- parseAExpr, but with two extra term-level productions recognized in +-- kdf_scope rule bodies: +-- 1. `dh_ss(A, B)` -> dh_combine(dhpk(get(A)), get(B)) +-- 2. bare NameExp -> AEGet ne (or AEVar if the bare ident is a rule formal) +-- Reuses parseAExprTable so `++` folds via the normal AExpr grammar. +parseRuleBodyAExpr :: [String] -> Parser AExpr +parseRuleBodyAExpr ruleParams = + buildExpressionParser parseAExprTable (parseRuleBodyAExprTerm ruleParams) + +parseRuleBodyAExprTerm :: [String] -> Parser AExpr +parseRuleBodyAExprTerm ruleParams = + try dhSsShort <|> try nameShort <|> parseAExprTerm + where + dhSsShort = parseSpanned $ do + reserved "dh_ss" + symbol "(" + ne1 <- parseNameExp + symbol "," + ne2 <- parseNameExp + symbol ")" + let getNE ne = mkSpanned $ AEGet ne + let dhpkOf ne = mkSpanned $ + AEApp (topLevelPath "dhpk") [] [getNE ne] + return $ AEApp (topLevelPath "dh_combine") [] + [dhpkOf ne1, getNE ne2] + nameShort = parseSpanned $ do + ne <- parseNameExp + notFollowedBy (whiteSpace >> char '(') -- don't consume function calls + case ne^.val of + NameConst ([], []) (PUnresolvedVar s) [] + | s `elem` ruleParams -> + return $ AEVar (ignore s) (s2n s) + _ -> return $ AEGet ne + +parseKDFOutputSpec :: Parser KDFOutputSpec +parseKDFOutputSpec = do + nts <- (do + ostrict <- optionMaybe parseKDFStrictness + nt <- parseNameType + let strictness = case ostrict of + Nothing -> KDFUnstrict + Just v -> v + return (strictness, nt)) `sepBy1` (symbol "||") + return $ KDFOutputSpec nts + +parseKDFRuleFormals :: Parser [DataVar] +parseKDFRuleFormals = + option [] $ do + symbol "(" + names <- identifier `sepBy1` (symbol ",") + symbol ")" + return $ map s2n names + +parseKDFRule :: Parser Decl +parseKDFRule = parseSpanned $ do + isODH <- alt (reserved "odh" >> return True) (reserved "kdf" >> return False) + lbl <- identifier + idxs <- parseIdxParamBinds + args <- parseKDFRuleFormals + let ruleParams = map name2String args + wh <- option (mkSpanned PTrue) (reserved "where" >> parseProp) + symbol ":" + salt <- parseRuleBodyAExpr ruleParams + symbol "," + ikm <- parseRuleBodyAExpr ruleParams + symbol "," + info <- parseAExpr + symbol "->" + out <- parseKDFOutputSpec + let body = KDFScopeRuleBody wh salt ikm info out + return $ DeclKDFRule $ KDFScopeRule isODH lbl $ bind (idxs, args) body + +parseKDFScope :: Parser Decl +parseKDFScope = parseSpanned $ do + reserved "kdf_scope" + grp <- identifier + symbol "{" + items <- many parseOneDecl + symbol "}" + return $ DeclKDFScope grp items + +parseOneDecl :: Parser Decl +parseOneDecl = + parseKDFScope + <|> + parseKDFRule + <|> + parseNameDecl <|> parseEnum <|> @@ -850,28 +902,6 @@ parseDecls = return $ DeclTy n t ) <|> - (parseSpanned $ do - reserved "odh" - n <- identifier - ps <- parseIdxParamBinds - symbol ":" - ne1 <- parseNameExp - symbol "," - ne2 <- parseNameExp - symbol "->" - symbol "{" - x <- identifier - y <- identifier - oz <- optionMaybe identifier - let z = case oz of - Just v -> v - Nothing -> "%self" - symbol "." - kdfCases <- kdfCase `sepBy1` (symbol ",") - symbol "}" - return $ DeclODH n (bind ps $ (ne1, ne2, bind ((x, s2n x), (y, s2n y), (z, s2n z)) kdfCases)) - ) - <|> (parseSpanned $ do reserved "nametype" n <- identifier @@ -986,7 +1016,7 @@ parseDecls = loc <- parseLocality return $ DeclTable n t loc) <|> - (parseSpanned $ do + (parseSpanned $ do reserved "module" imt <- parseIsModType n <- identifier @@ -1005,10 +1035,12 @@ parseDecls = parseModuleExp ModType $ "TYPEOF" ++ n symbol "=" me <- parseModuleExp imt n - let (bdy, otype) = mkModuleBinders modArgs me omt - return $ DeclModule n imt bdy otype + let (bdy, otype) = mkModuleBinders modArgs me omt + return $ DeclModule n imt bdy otype ) +parseDecls = many parseOneDecl + parseDepBind :: Alpha a => Parser (a -> DepBind a) parseDepBind = do args <- (do @@ -1605,29 +1637,29 @@ parseROHint = do Just v -> v return (p, inds, xs) +parseKDFScopeRuleRef :: Parser KDFScopeRuleRef +parseKDFScopeRuleRef = do + lbl <- identifier + idxs <- parseIdxParams + actuals <- option [] $ do + symbol "(" + es <- parseAExpr `sepBy1` (symbol ",") + symbol ")" + return es + return $ KDFScopeRuleRef lbl idxs actuals + parseCryptOp :: Parser CryptOp -parseCryptOp = +parseCryptOp = (do reserved "kdf" symbol "<" - oann1 <- parseKDFSelector `sepBy` (symbol ",") - symbol ";" - oann2 <- (alt - (do - reserved "odh" - s <- identifier - p <- parseIdxParams - symbol "[" - i <- parseKDFSelector - symbol "]" - return $ Right (s, p, i)) - (Left <$> parseKDFSelector)) `sepBy` (symbol ",") + refs <- parseKDFScopeRuleRef `sepBy` (symbol ",") symbol ";" nks <- parseNameKind `sepBy1` (symbol "||") symbol ";" j <- many1 digit symbol ">" - return $ CKDF oann1 oann2 nks (read j) + return $ CKDF refs nks (read j) ) <|> (do diff --git a/src/Pass/ModuleFlattening.hs b/src/Pass/ModuleFlattening.hs index 9446e1c6..6b5cb147 100644 --- a/src/Pass/ModuleFlattening.hs +++ b/src/Pass/ModuleFlattening.hs @@ -44,7 +44,7 @@ instance Semigroup ModBody where (md1^.predicates <> md2^.predicates) (md1^.advCorrConstraints <> md2^.advCorrConstraints) (md1^.tyDefs <> md2^.tyDefs) - (md1^.odh <> md2^.odh) + (md1^.kdfScopes <> md2^.kdfScopes) (md1^.nameTypeDefs <> md2^.nameTypeDefs) (md1^.userFuncs <> md2^.userFuncs) (md1^.nameDefs <> md2^.nameDefs) @@ -90,7 +90,7 @@ flattenModules p0 md = do (md^.predicates) (md^.advCorrConstraints) (globalizeMap p0 $ md^.tyDefs) - (globalizeMap p0 $ md^.odh) + (globalizeMap p0 $ md^.kdfScopes) (globalizeMap p0 $ md^.nameTypeDefs) (globalizeMap p0 $ md^.userFuncs) (globalizeMap p0 $ md^.nameDefs) diff --git a/src/Pass/PathResolution.hs b/src/Pass/PathResolution.hs index 8bedff9d..6e1f889b 100644 --- a/src/Pass/PathResolution.hs +++ b/src/Pass/PathResolution.hs @@ -7,6 +7,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} module PathResolution where +import Data.List (intercalate) import AST import Error.Diagnose.Position (Position) import Control.Lens @@ -118,8 +119,9 @@ resolveError pos msg = do fl <- takeDirectory <$> (view $ flags . fFilePath) f <- view $ flags . fFileContents let rep = Err Nothing msg [(unignore pos, This ("Resolution error: " ++ msg))] [] - let diag = addFile (addReport def rep) (fn) f - printDiagnostic stdout True True 4 defaultStyle diag + let diag = addFile (addReport def rep) (fn) f + noColor <- view $ flags . fNoColor + printDiagnostic stdout True (not noColor) 4 defaultStyle diag Resolve $ lift $ throwError () resolveDepBind :: Alpha a => DepBind a -> (a -> Resolve a) -> Resolve (DepBind a) @@ -244,21 +246,18 @@ resolveDecls (d:ds) = p <- view curPath ds' <- local (over tyPaths $ T.insert s p) $ resolveDecls ds return (d' : ds') - DeclODH s b -> do - (is, (ne1, ne2, kdfBody)) <- unbind b - ne1' <- resolveNameExp ne1 - ne2' <- resolveNameExp ne2 - (args, cases) <- unbind kdfBody - cases' <- forM cases $ \bpnts -> do - (ixs, (p, nts)) <- unbind bpnts - p' <- resolveProp p - nts' <- forM nts $ \(str, nt) -> do - nt' <- resolveNameType nt - return (str, nt') - return $ bind ixs $ (p', nts') - let d' = Spanned (d^.spanOf) $ DeclODH s $ bind is (ne1', ne2', bind args cases') + DeclKDFRule ruleX -> do + ruleX' <- resolveKDFRuleX (d^.spanOf) ruleX + let d' = Spanned (d^.spanOf) $ DeclKDFRule ruleX' + ds' <- resolveDecls ds + return (d' : ds') + DeclKDFScope s innerDecls -> do p <- view curPath - ds' <- local (over odhPaths $ T.insert s p) $ resolveDecls ds + innerDecls' <- resolveDecls innerDecls + let d' = Spanned (d^.spanOf) $ DeclKDFScope s innerDecls' + -- Propagate paths from inner decls to subsequent outer decls. + -- The scope name itself is NOT added to any path map. + ds' <- withDeclPaths innerDecls' p $ resolveDecls ds return (d' : ds') DeclDetFunc s _ _ -> do let d' = d @@ -303,6 +302,54 @@ resolveDecls (d:ds) = ds' <- local (over modPaths $ T.insert s (False, p)) $ resolveDecls ds return (d' : ds') +-- | Propagate path-map additions from a list of (already-resolved) inner +-- decls to a subsequent computation, so that names declared inside a +-- kdf_scope are visible to outer declarations. +withDeclPaths :: [Decl] -> ResolvedPath -> Resolve a -> Resolve a +withDeclPaths innerDecls p k = foldr (\d -> local (declPathUpdates d p)) k innerDecls + +declPathUpdates :: Decl -> ResolvedPath -> ResolveEnv -> ResolveEnv +declPathUpdates d p = case d^.val of + DeclName s _ -> over namePaths (T.insert s p) + DeclNameType s _ -> over nameTypePaths (T.insert s p) + DeclFun s _ -> over funcPaths (T.insert s p) + DeclPredicate s _ -> over predPaths (T.insert s p) + DeclDefHeader s _ -> over defPaths (T.insert s p) + DeclDef s _ -> over defPaths (T.insert s p) + DeclEnum s bnd -> + let (_, vs) = unsafeUnbind bnd + in over tyPaths (T.insert s p) + . over funcPaths (T.insertMany $ map (\(x, _) -> (x, p)) vs) + . over funcPaths (T.insertMany $ map (\(x, _) -> (x ++ "?", p)) vs) + DeclStruct s bnd -> + let (_, vs) = unsafeUnbind bnd + in over tyPaths (T.insert s p) + . over funcPaths (T.insert s p) + . over funcPaths (T.insertMany $ map (\x -> (x, p)) (depBindNames vs)) + DeclTy s _ -> over tyPaths (T.insert s p) + DeclCounter s _ -> over ctrPaths (T.insert s p) + DeclDetFunc s _ _ -> over funcPaths (T.insert s p) + DeclTable s _ _ -> over tablePaths (T.insert s p) + DeclLocality s _ -> over localityPaths (T.insert s p) + DeclModule s _ _ _ -> over modPaths (T.insert s (False, p)) + _ -> id + +-- | Resolve all fields of a KDFScopeRuleX in place. +resolveKDFRuleX :: Ignore Position -> KDFScopeRuleX -> Resolve KDFScopeRuleX +resolveKDFRuleX _pos rule = do + ((idxs, dvars), body) <- unbind (_ksrBody rule) + wh' <- resolveProp (_ksrbWhere body) + salt' <- resolveAExpr (_ksrbSalt body) + ikm' <- resolveAExpr (_ksrbIkm body) + info' <- resolveAExpr (_ksrbInfo body) + let KDFOutputSpec outputs = _ksrbOutput body + outputs' <- mapM (\(str, nt) -> fmap (\nt' -> (str, nt')) (resolveNameType nt)) + outputs + let body' = body { _ksrbWhere = wh', _ksrbSalt = salt', _ksrbIkm = ikm' + , _ksrbInfo = info', _ksrbOutput = KDFOutputSpec outputs' + } + return $ rule { _ksrBody = bind (idxs, dvars) body' } + resolveModuleExp :: Ignore Position -> ModuleExp -> Resolve ModuleExp resolveModuleExp pos me = case me^.val of @@ -349,16 +396,7 @@ resolveNameType e = do (y, pat) <- unbind ypat pat' <- resolveAExpr pat return $ NT_StAEAD t' (bind x pr') p' (bind y pat') - NT_KDF pos b -> do - (((s, x), (s2, y), (s3, z)), cases) <- unbind b - cases' <- forM cases $ \bpnts -> do - (is, (p, nts)) <- unbind bpnts - p' <- resolveProp p - nts' <- forM nts $ \(str, nt) -> do - nt' <- resolveNameType nt - return (str, nt') - return $ bind is (p', nts') - return $ NT_KDF pos $ bind ((s, x), (s2, y), (s3, z)) cases' + NT_KDF -> return NT_KDF resolveTy :: Ty -> Resolve Ty resolveTy e = do @@ -406,6 +444,11 @@ resolveTy e = do THexConst a -> return $ THexConst a +resolveKDFScopeRuleRef :: KDFScopeRuleRef -> Resolve KDFScopeRuleRef +resolveKDFScopeRuleRef ref = do + args' <- mapM resolveAExpr (ref^.ksrrArgs) + return $ ref & ksrrArgs .~ args' + resolveNameExp :: NameExp -> Resolve NameExp resolveNameExp ne = case ne^.val of @@ -413,12 +456,9 @@ resolveNameExp ne = p' <- resolvePath (ne^.spanOf) PTName p as' <- mapM resolveAExpr as return $ Spanned (ne^.spanOf) $ NameConst s p' as' - KDFName a b c nks j nt ib -> do - a' <- resolveAExpr a - b' <- resolveAExpr b - c' <- resolveAExpr c - nt' <- resolveNameType nt - return $ Spanned (ne^.spanOf) $ KDFName a' b' c' nks j nt' ib + KDFName nks j ib ref -> do + ref' <- resolveKDFScopeRuleRef ref + return $ Spanned (ne^.spanOf) $ KDFName nks j ib ref' resolveFuncParam :: FuncParam -> Resolve FuncParam resolveFuncParam f = @@ -445,7 +485,7 @@ resolvePath' pos pt p = Just (b, p) -> do let xs' = if b then xs else x:xs return $ PRes $ go (Just p) (reverse xs') - Nothing -> do + Nothing -> return $ PRes $ go Nothing (reverse (x:xs)) return res PUnresolvedVar s -> @@ -561,7 +601,9 @@ resolveCryptOp pos cop = CLemma l -> do l' <- resolveLemma pos l return $ CLemma l' - CKDF x y nks i -> return cop + CKDF refs nks j -> do + refs' <- mapM resolveKDFScopeRuleRef refs + return $ CKDF refs' nks j CAEnc -> return CAEnc CEncStAEAD p is xpat -> do (x, pat) <- unbind xpat diff --git a/src/Pretty.hs b/src/Pretty.hs index 8efa1904..3fddc1ea 100644 --- a/src/Pretty.hs +++ b/src/Pretty.hs @@ -60,25 +60,13 @@ flowColor = Cyan corrColor = Red tyColor = Magenta -owlprettyKDFSelector :: KDFSelector -> OwlDoc -owlprettyKDFSelector (i, []) = owlpretty i -owlprettyKDFSelector (i, xs) = owlpretty i <> angles (mconcat $ intersperse (owlpretty ",") (map owlpretty xs)) - instance OwlPretty NameExpX where - owlpretty (KDFName a b c nks j nt _) = - Prettyprinter.group $ - owlpretty "KDF<" <> (mconcat $ intersperse (owlpretty "||") (map owlpretty nks)) - <> - owlpretty ";" - <> - owlpretty j - <> - owlpretty ";" - <> - -- (flatAlt (owlpretty "") (owlpretty nt)) - owlpretty nt - <> owlpretty ">" - <> tupled (map owlpretty [a, b, c]) + owlpretty (KDFName nks j _ ref) = + Prettyprinter.group $ + owlpretty "KDF<" <> owlpretty ref + <> owlpretty ";" <> (mconcat $ intersperse (owlpretty "||") (map owlpretty nks)) + <> owlpretty ";" <> owlpretty j + <> owlpretty ">" owlpretty (NameConst vs n xs) = let pxs = case xs of [] -> mempty @@ -202,7 +190,50 @@ instance OwlPretty NameKindRow where owlpretty (NameKindRow n) = mconcat $ intersperse (owlpretty "||") (map owlpretty n) -instance OwlPretty PropX where +instance OwlPretty KDFOutputSpec where + owlpretty (KDFOutputSpec nts) = + hsep $ intersperse (owlpretty " ||") $ + map (\(str, nt) -> owlpretty str <+> owlpretty nt) nts + +instance OwlPretty KDFScopeRuleBody where + owlpretty (KDFScopeRuleBody _ salt ikm info out) = + owlpretty salt <> owlpretty ", " <> owlpretty ikm <> owlpretty ", " <> owlpretty info + <> owlpretty " -> " <> owlpretty out + +instance OwlPretty KDFScopeRuleX where + owlpretty rule = + let kw = if _ksrIsODH rule then owlpretty "odh" else owlpretty "kdf" + lbl = owlpretty (_ksrLabel rule) + ((idxs, fargs), body) = unsafeUnbind (_ksrBody rule) + pidxs = owlprettyIdxBindsPair idxs + pfargs | null fargs = mempty + | otherwise = owlpretty "(" <> + hsep (intersperse (owlpretty ",") $ map owlpretty fargs) <> + owlpretty ")" + wh = case _ksrbWhere body of + Spanned _ PTrue -> mempty + p -> owlpretty " where " <> owlpretty p + in + kw <+> lbl <> pidxs <> pfargs <> wh <> owlpretty " : " <> owlpretty body + +owlprettyIdxBindsPair :: ([IdxVar], [IdxVar]) -> OwlDoc +owlprettyIdxBindsPair ([], []) = mempty +owlprettyIdxBindsPair (xs, ys) = + owlpretty "<" <> + hsep (intersperse (owlpretty ",") $ map owlpretty xs) <> + (if null ys then mempty else owlpretty "@" <> hsep (intersperse (owlpretty ",") $ map owlpretty ys)) <> + owlpretty ">" + +instance OwlPretty KDFScopeRuleRef where + owlpretty ref = + let pargs | null (_ksrrArgs ref) = mempty + | otherwise = owlpretty "(" <> + hsep (intersperse (owlpretty ",") $ map owlpretty (_ksrrArgs ref)) <> + owlpretty ")" + in owlpretty (_ksrrLabel ref) <> + owlprettyIdxParams (_ksrrIdxs ref) <> pargs + +instance OwlPretty PropX where owlpretty PTrue = owlpretty "true" owlpretty PFalse = owlpretty "false" owlpretty (PAnd p1 p2) = @@ -260,18 +291,7 @@ owlprettyIdxBinds1 xs = owlpretty "<" <> hsep (intersperse (owlpretty ",") $ map instance OwlPretty NameTypeX where - owlpretty (NT_KDF kpos cases) = - let (((sx, _), (sy, _), (sself, _)), c) = unsafeUnbind cases in - let pcases = map (\b -> - let (is, (p, nts)) = unsafeUnbind b in - owlprettyIdxBinds1 is <> owlpretty p <+> owlpretty "->" <+> (hsep $ intersperse (owlpretty "||") $ - map (\(str, nt) -> owlpretty str <+> owlpretty nt) nts)) c - in - let hd = case kpos of - KDF_SaltPos -> owlpretty "KDF" - KDF_IKMPos -> owlpretty "DualKDF" - in - hd <> owlpretty "{" <> owlpretty sx <> owlpretty sy <> owlpretty sself <> owlpretty "." <> nest 4 (vsep pcases) <> owlpretty "}" + owlpretty NT_KDF = owlpretty "kdfkey" owlpretty (NT_Sig ty) = owlpretty "sig" <+> owlpretty ty owlpretty (NT_StAEAD ty xaad p pat) = let (x, aad) = owlprettyBind xaad in @@ -344,7 +364,14 @@ instance OwlPretty CryptOp where owlpretty CMacVrfy = owlpretty "mac_vrfy" owlpretty CSign = owlpretty "sign" owlpretty CSigVrfy = owlpretty "vrfy" - owlpretty (CKDF _ _ _ _) = owlpretty "kdf" + owlpretty (CKDF refs nks j) = + owlpretty "kdf<" <> + hsep (intersperse (owlpretty ",") (map owlpretty refs)) <> + owlpretty ";" <> + owlpretty (NameKindRow nks) <> + owlpretty ";" <> + owlpretty j <> + owlpretty ">" owlpretty (CEncStAEAD p (idx1, idx2) _) = owlpretty "st_aead_enc" <> angles (owlpretty p <> angles (tupled (map owlpretty idx1) <> owlpretty "@" <> tupled (map owlpretty idx2))) owlpretty (CDecStAEAD) = owlpretty "st_aead_dec" diff --git a/src/SMT.hs b/src/SMT.hs index 9e2ad9f0..9d35a5f1 100644 --- a/src/SMT.hs +++ b/src/SMT.hs @@ -93,7 +93,20 @@ setupNameEnvRO = do -- emit $ SApp [SAtom "declare-fun", sn, SApp (replicate iar indexSort ++ replicate var bitstringSort), nameSort] mkCrossDisjointness fdfs mkSelfDisjointness fdfs - -- Axioms relevant for each def + -- Declare per-label KDF name functions and their disjointness axioms + kdfRules <- liftCheck $ collectKDFScopeRules + forM_ kdfRules $ \(lbl, bRule) -> do + let (((is1, is2), dvars), _) = unsafeUnbind bRule + let paramSorts = replicate (length is1 + length is2) indexSort + ++ replicate (length dvars) bitstringSort + ++ [SAtom "Int", SAtom "Int"] + emit $ SApp [SAtom "declare-fun", + SAtom ("%kdf_" ++ cleanSMTIdent lbl), + SApp paramSorts, nameSort] + mkKDFLengthAxioms kdfRules + mkKDFValueOfAxioms kdfRules + mkKDFDisjointness kdfRules fdfs + -- Axioms relevant for each def forM_ fdfs $ \fd -> do withSMTNameDef fd $ \(sn, pth) ((is, ps)) ont -> do -- Name def flows @@ -168,7 +181,7 @@ mkCrossDisjointness fdfs = do mkSelfDisjointness :: [SMTNameDef] -> Sym () mkSelfDisjointness fdfs = do -- TODO: factor in preqreqs? - forM_ fdfs $ \fd -> + forM_ fdfs $ \fd -> withSMTNameDef fd $ \(sn, pth) ((is1, ps1)) _ -> do withSMTNameDef fd $ \_ ((is2, ps2)) _ -> do when ((length is1 + length ps1) > 0) $ do @@ -177,7 +190,7 @@ mkSelfDisjointness fdfs = do let v1 = sApp (sn : (map fst q1)) let v2 = sApp (sn : (map fst q2)) let q1_eq_q2 = sAnd $ map (\i -> sEq (fst $ q1 !! i) (fst $ q2 !! i)) [0 .. (length q1 - 1)] - let v1_eq_v2 = SApp [SAtom "=", SAtom "TRUE", SApp [SAtom "eq", SApp [SAtom "ValueOf", v1], + let v1_eq_v2 = SApp [SAtom "=", SAtom "TRUE", SApp [SAtom "eq", SApp [SAtom "ValueOf", v1], SApp [SAtom "ValueOf", v2]]] emitAssertion $ sForall (q1 ++ q2) (v1_eq_v2 `sImpl` q1_eq_q2) @@ -185,6 +198,117 @@ mkSelfDisjointness fdfs = do ("self_disj_" ++ T.unpack (renderSExp sn)) +-- Helper: unbind a KDF rule binding to get fresh quantifier variables and the applied SMT term. +-- Index vars get sort Index, data vars get sort Bits, and two fresh Int vars capture start/segment. +withKDFRuleVars :: (String, Bind (([IdxVar], [IdxVar]), [DataVar]) KDFScopeRuleBody) + -> ([(SExp, SExp)] -> SExp -> Sym a) + -> Sym a +withKDFRuleVars (lbl, bRule) k = do + (((is1, is2), dvars), _) <- liftCheck $ unbind bRule + ctr <- getFreshCtr + let idxVars = map (\i -> (SAtom (cleanSMTIdent $ show i), indexSort)) (is1 ++ is2) + let bitsVars = map (\v -> (SAtom (cleanSMTIdent $ show v), bitstringSort)) dvars + let sVar = SAtom ("kdf_s_" ++ cleanSMTIdent lbl ++ "_" ++ show ctr) + let segVar = SAtom ("kdf_seg_" ++ cleanSMTIdent lbl ++ "_" ++ show ctr) + let intVars = [(sVar, SAtom "Int"), (segVar, SAtom "Int")] + let allVars = idxVars ++ bitsVars ++ intVars + let term = sApp $ SAtom ("%kdf_" ++ cleanSMTIdent lbl) : map fst allVars + k allVars term + +mkKDFLengthAxioms :: [(String, Bind (([IdxVar], [IdxVar]), [DataVar]) KDFScopeRuleBody)] + -> Sym () +mkKDFLengthAxioms kdfRules = + forM_ kdfRules $ \rule@(lbl, _) -> + withKDFRuleVars rule $ \allVars term -> do + let sVar = fst $ allVars !! (length allVars - 2) + let segVar = fst $ allVars !! (length allVars - 1) + let geZero v = SApp [SAtom ">=", v, SAtom "0"] + let guard = sAnd [geZero sVar, geZero segVar] + let lenEq = sEq (sLength (SApp [SAtom "ValueOf", term])) + (SApp [SAtom "I2B", segVar]) + emitAssertion $ sForall allVars + (guard `sImpl` lenEq) + [term] + ("kdf_length_" ++ cleanSMTIdent lbl) + +-- For each kdf rule, emit an axiom relating ValueOf(%kdf_(...)) to the +-- ghost KDF(salt, ikm, info, start, segment) call. +mkKDFValueOfAxioms :: [(String, Bind (([IdxVar], [IdxVar]), [DataVar]) KDFScopeRuleBody)] + -> Sym () +mkKDFValueOfAxioms kdfRules = + forM_ kdfRules $ \(lbl, bRule) -> do + (((is1, is2), dvars), body) <- liftCheck $ unbind bRule + ctr <- getFreshCtr + let idxVars = map (\i -> (SAtom (cleanSMTIdent $ show i), indexSort)) (is1 ++ is2) + let bitsVars = map (\v -> (SAtom (cleanSMTIdent $ show v), bitstringSort)) dvars + let sVar = SAtom ("kdf_s_" ++ cleanSMTIdent lbl ++ "_" ++ show ctr) + let segVar = SAtom ("kdf_seg_" ++ cleanSMTIdent lbl ++ "_" ++ show ctr) + let intVars = [(sVar, SAtom "Int"), (segVar, SAtom "Int")] + let allVars = idxVars ++ bitsVars ++ intVars + let kdfTerm = sApp $ SAtom ("%kdf_" ++ cleanSMTIdent lbl) : map fst allVars + let lhs = SApp [SAtom "ValueOf", kdfTerm] + let saltAE = _ksrbSalt body + let ikmAE = _ksrbIkm body + let infoAE = _ksrbInfo body + let whereP = _ksrbWhere body + withSMTIndices (map (\i -> (i, IdxSession)) is1 ++ map (\i -> (i, IdxPId)) is2) $ do + withSMTVars dvars $ do + vSalt <- interpretAExp saltAE + vIkm <- interpretAExp ikmAE + vInfo <- interpretAExp infoAE + let rhs = SApp [SAtom "KDF", vSalt, vIkm, vInfo, sVar, segVar] + let bodyEq = SApp [SAtom "=", SAtom "TRUE", + SApp [SAtom "eq", lhs, rhs]] + let qid = "kdf_valueof_" ++ cleanSMTIdent lbl + axBody <- case whereP ^. val of + PTrue -> return bodyEq + _ -> do + vWhere <- interpretProp whereP + return $ vWhere `sImpl` bodyEq + emitAssertion $ sForall allVars axBody [lhs] qid + +mkKDFDisjointness :: [(String, Bind (([IdxVar], [IdxVar]), [DataVar]) KDFScopeRuleBody)] + -> [SMTNameDef] + -> Sym () +mkKDFDisjointness kdfRules baseDefs = do + -- Self-disjointness (injectivity) for each kdf rule function + forM_ kdfRules $ \rule@(lbl, _) -> + withKDFRuleVars rule $ \qvars1 term1 -> + withKDFRuleVars rule $ \qvars2 term2 -> do + let v1_eq_v2 = SApp [SAtom "=", SAtom "TRUE", + SApp [SAtom "eq", SApp [SAtom "ValueOf", term1], + SApp [SAtom "ValueOf", term2]]] + let args_eq = sAnd $ map (\i -> sEq (fst $ qvars1 !! i) (fst $ qvars2 !! i)) + [0 .. length qvars1 - 1] + emitAssertion $ sForall (qvars1 ++ qvars2) + (v1_eq_v2 `sImpl` args_eq) + [term1, term2] + ("kdf_self_disj_" ++ cleanSMTIdent lbl) + -- Cross-disjointness between pairs of kdf rule functions + let kdfPairs = [(x, y) | (x : ys) <- tails kdfRules, y <- ys] + forM_ kdfPairs $ \(rule1@(lbl1, _), rule2@(lbl2, _)) -> + withKDFRuleVars rule1 $ \qvars1 term1 -> + withKDFRuleVars rule2 $ \qvars2 term2 -> do + let v1_eq_v2 = SApp [SAtom "=", SAtom "TRUE", + SApp [SAtom "eq", SApp [SAtom "ValueOf", term1], + SApp [SAtom "ValueOf", term2]]] + let pat = (if null qvars1 then [] else [term1]) ++ (if null qvars2 then [] else [term2]) + emitAssertion $ sForall (qvars1 ++ qvars2) (sNot v1_eq_v2) pat + ("kdf_cross_disj_" ++ cleanSMTIdent lbl1 ++ "_" ++ cleanSMTIdent lbl2) + -- Cross-disjointness between each kdf rule function and each base name function + forM_ kdfRules $ \rule@(lbl, _) -> + forM_ baseDefs $ \baseDef -> + withKDFRuleVars rule $ \kdfVars kdfTerm -> + withSMTNameDef baseDef $ \(sn, _) ((is, ps)) _ -> do + let baseVars = map (\i -> (SAtom $ show i, indexSort)) (is ++ ps) + let baseTerm = sApp (sn : map fst baseVars) + let k_eq_b = SApp [SAtom "=", SAtom "TRUE", + SApp [SAtom "eq", SApp [SAtom "ValueOf", kdfTerm], + SApp [SAtom "ValueOf", baseTerm]]] + let pat = (if null kdfVars then [] else [kdfTerm]) + ++ (if null baseVars then [] else [baseTerm]) + emitAssertion $ sForall (kdfVars ++ baseVars) (sNot k_eq_b) pat + ("kdf_base_disj_" ++ cleanSMTIdent lbl ++ "_" ++ T.unpack (renderSExp sn)) @@ -348,10 +472,7 @@ smtTy xv t = TName n -> do kdfRefinement <- case n^.val of NameConst _ _ _ -> return sTrue - KDFName a b c nks j nt _ -> do - (va, vb, vc, start, segment) <- getKDFArgs a b c nks j - -- p <- kdfPerm va vb vc start segment nt - return $ xv `sEq` (SApp [SAtom "KDF", va, vb, vc, start, segment]) + KDFName nks j _ _ -> return sTrue vn <- getSymName n return $ sAnd2 kdfRefinement (xv `sHasType` (SApp [SAtom "TName", vn])) TVK n -> do diff --git a/src/SMTBase.hs b/src/SMTBase.hs index d62ac8e3..f969ee09 100644 --- a/src/SMTBase.hs +++ b/src/SMTBase.hs @@ -688,14 +688,16 @@ getSymName ne = do vs1 <- mapM symIndex is1 vs2 <- mapM symIndex is2 sName sn (vs1 ++ vs2) - KDFName a b c nks j nt _ -> do - va <- interpretAExp a - vb <- interpretAExp b - vc <- interpretAExp c + KDFName nks j _ ref -> do nk_lengths <- liftCheck $ forM nks $ \nk -> sNameKindLength <$> smtNameKindOf nk let start = sPlus $ take j nk_lengths let segment = nk_lengths !! j - return $ SApp [SAtom "KDFName", va, vb, vc, start, segment] + let (idxs1, idxs2) = _ksrrIdxs ref + vidxs1 <- mapM symIndex idxs1 + vidxs2 <- mapM symIndex idxs2 + vargs <- mapM interpretAExp (_ksrrArgs ref) + return $ sApp $ [SAtom ("%kdf_" ++ cleanSMTIdent (_ksrrLabel ref))] + ++ vidxs1 ++ vidxs2 ++ vargs ++ [start, segment] symNameExp :: NameExp -> Sym SExp symNameExp ne = do @@ -864,7 +866,7 @@ instance SMTNameKindOf NameType where NT_StAEAD _ _ _ _ -> return $ SAtom "Enckey" NT_PKE _ -> return $ SAtom "PKEkey" NT_Sig _ -> return $ SAtom "Sigkey" - NT_KDF _ _ -> return $ SAtom "KDFkey" + NT_KDF -> return $ SAtom "KDFkey" NT_MAC _ -> return $ SAtom "MACkey" NT_Nonce l -> do let v = lengthConstant l diff --git a/src/Typing.hs b/src/Typing.hs index f69490d7..c51142b4 100644 --- a/src/Typing.hs +++ b/src/Typing.hs @@ -68,7 +68,7 @@ emptyEnv f = do rs <- newIORef [] memo <- mkMemoEntry return $ Env mempty mempty mempty Nothing f initDetFuncs (TcGhost False) mempty [(Nothing, emptyModBody ModConcrete)] mempty - interpUserFunc r m [memo] mempty rs r' r'' (typeError') checkNameType normalizeTy normalizeProp decideProp Nothing [] False False def + interpUserFunc r m [memo] mempty rs r' r'' (typeError') checkNameType normalizeTy normalizeProp decideProp Nothing Nothing [] False False def assertEmptyParams :: [FuncParam] -> String -> Check () @@ -759,11 +759,11 @@ isSubtype' t1 r1 t2 r2 = local (set tcScope (TcGhost False)) $ do case ob of Nothing -> return False Just b -> return b - (_, TName (Spanned _ (KDFName a2 b2 c2 nks2 j2 nt2 _))) -> - case (stripRefinements t1)^.val of - TName (Spanned _ (KDFName a1 b1 c1 nks1 j1 nt1 _)) | (nks1 == nks2 && j1 == j2) - -> subKDFName a1 b1 c1 nt1 a2 b2 c2 nt2 - _ -> return False + -- (_, TName (Spanned _ (KDFName nks2 j2 _ ref2))) -> + -- case (stripRefinements t1)^.val of + -- TName (Spanned _ (KDFName nks1 j1 _ ref1)) | (nks1 == nks2 && j1 == j2) + -- -> return $ aeq ref1 ref2 + -- _ -> return False _ | isSingleton t2 -> return True (TConst x ps1, TConst y ps2) -> do x' <- normalizePath x @@ -820,10 +820,6 @@ isSubtypeLeaf t = THexConst _ -> True _ -> False -subKDFName a1 b1 c1 nt1 a2 b2 c2 nt2 = do - argsEq <- decideProp $ (pEq a1 a2) `pAnd` (pEq b1 b2) `pAnd` (pEq c1 c2) - ntSub <- subNameType nt1 nt2 - return $ (argsEq == Just True) && ntSub allM :: Monad m => [a] -> (a -> m Bool) -> m Bool allM [] f = return True @@ -850,29 +846,7 @@ subNameType nt1 nt2 = do (w, pat2) <- unbind xpat2 b4 <- withVars [(z, (ignore $ show z, Nothing, tGhost))] $ decideProp $ pat1 `pEq` (subst w (aeVar' z) pat2) return $ b1 && (b2 == Just True) && b3 && (b4 == Just True) - (NT_KDF pos1 body1, NT_KDF pos2 body2) -> do - (((sx, x), (sy, y), (sz, z)), bnds) <- unbind body1 - (((sx', x'), (sy', y'), (sz', z')), bnds') <- unbind body2 - withVars [(x, (ignore sx, Nothing, tGhost)), (y, (ignore sy, Nothing, tGhost)), (z, (ignore sz, Nothing, tGhost))] $ - if pos1 == pos2 && length bnds == length bnds' then go bnds (substs [(x', aeVar' x), (y', aeVar' y), (z', aeVar' z)] bnds') else return False - where - go :: [Bind [IdxVar] (Prop, [(KDFStrictness, NameType)])] -> - [Bind [IdxVar] (Prop, [(KDFStrictness, NameType)])] -> - Check Bool - go [] [] = return True - go (b1:xs) (b2:ys) = do - (is1, rest1) <- unbind b1 - (is2, rest2_) <- unbind b2 - bhere <- if length is1 == length is2 then do - let rest2 = substs (map (\(i1, i2) -> (i2, mkIVar i1)) (zip is1 is2)) rest2_ - withIndices (map (\i -> (i, (ignore $ show i, IdxGhost))) is1) $ do - b1 <- decideProp $ pImpl (fst rest1) (fst rest2) - if (b1 == Just True) then do - allM (zip (snd rest1) (snd rest2)) $ \(nt1, nt2) -> - if (fst nt1 == fst nt2) then subNameType (snd nt1) (snd nt2) else return False - else return False - else return False - if bhere then go xs ys else return False + (NT_KDF, NT_KDF) -> return True _ -> return False return res @@ -882,10 +856,7 @@ subNameType nt1 nt2 = do isSingleton :: Ty -> Bool isSingleton t = case t^.val of - TName ne -> - case ne^.val of - KDFName _ _ _ _ _ _ _ -> False - NameConst _ _ _ -> True + TName ne -> True TVK _ -> True TDH_PK _ -> True TEnc_PK _ -> True @@ -915,15 +886,6 @@ tyFlowsTo' = withMemoize (memoTyFlowsTo') $ \(t, l) -> Nothing -> return False Just b -> return b --- A more precise version of tyFlowsTo, taking into account concats -isIKMDerivable :: AExpr -> Check Bool -isIKMDerivable a = do - xs <- unconcatIKM a - ts <- mapM inferAExpr xs - bs <- mapM (\t -> tyFlowsTo t advLbl) ts - return $ foldr (&&) True bs - - -- We check t1 <: t2 by first normalizing both isSubtype :: Ty -> Ty -> Check Bool @@ -1143,10 +1105,181 @@ checkTyPubLenOrGhost t = do +nameEqProp :: NameExp -> NameExp -> Maybe Prop +nameEqProp ne1 ne2 = case (ne1^.val, ne2^.val) of + (NameConst _ p1 _, NameConst _ p2 _) + | aeq p1 p2 -> Just (pEq (aeGet ne1) (aeGet ne2)) + | otherwise -> Nothing -- different resolved paths + (KDFName _ _ _ ref1, KDFName _ _ _ ref2) + | _ksrrLabel ref1 == _ksrrLabel ref2 -> Just (pEq (aeGet ne1) (aeGet ne2)) + | otherwise -> Nothing -- different KDF labels + _ -> Nothing -- NameConst vs KDFName + +saltEqProp :: AExpr -> AExpr -> Maybe Prop +saltEqProp a b = case (a^.val, b^.val) of + (AEGet n1, AEGet n2) -> nameEqProp n1 n2 + (AEGet _, _) -> Nothing + (_, AEGet _) -> Nothing + _ -> Just (pEq a b) + +ikmEqProp :: AExpr -> AExpr -> Maybe Prop +ikmEqProp a b = Just (pEq a b) + +-- Validate a kdf_scope rule declaration. +validateKDFScopeRule + :: String -- group name + -> [String] -- kdfkey entry names in the group + -> [String] -- DH entry names in the group + -> KDFScopeRuleX + -> Check () +validateKDFScopeRule groupName kdfKeyEntryNames dhEntryNames rule = do + let lbl = _ksrLabel rule + isODH = _ksrIsODH rule + (((is1, is2), dvars), body) <- unbind (_ksrBody rule) + ikmAtoms <- + withIndices (map (\i -> (i, (ignore $ show i, IdxSession))) is1 ++ + map (\i -> (i, (ignore $ show i, IdxPId ))) is2) $ + withVars (map (\dv -> (dv, (ignore $ show dv, Nothing, tGhost))) dvars) $ do + _ <- inferAExpr (_ksrbSalt body) + _ <- inferAExpr (_ksrbIkm body) + _ <- inferAExpr (_ksrbInfo body) + checkProp (_ksrbWhere body) + ikmE' <- resolveANF (_ksrbIkm body) >>= normalizeAExpr + case ikmE'^.val of + AEVar{} -> return [ikmE'] + _ -> unconcat ikmE' + + let saltHasGroupKdfKey = saltHasGroupKdfKeyCheck kdfKeyEntryNames (_ksrbSalt body) + let ikmHasGroupKdfKey = ikmHasGroupKdfKeyCheck kdfKeyEntryNames ikmAtoms + let ikmHasLocalDH = ikmHasLocalDHCheck dhEntryNames ikmAtoms + assert ("kdf_scope rule '" ++ lbl ++ "' in group '" ++ groupName ++ + "': salt or IKM must contain a kdfkey from the group, or " ++ + "IKM must contain dh_combine where both arguments are local DH keys from the group") $ + saltHasGroupKdfKey || ikmHasGroupKdfKey || ikmHasLocalDH + + -- Conditions 2 & 3: each parameter must appear free in (salt, ikm, info) + let lhs = (_ksrbSalt body, _ksrbIkm body, _ksrbInfo body) + let freeIdxVars = toListOf fv lhs :: [IdxVar] + let freeDataVars = toListOf fv lhs :: [DataVar] + forM_ (is1 ++ is2) $ \i -> + assert ("kdf_scope rule '" ++ lbl ++ "' in group '" ++ groupName ++ + "': index parameter '" ++ show i ++ "' does not appear in salt/IKM/info") $ + i `elem` freeIdxVars + forM_ dvars $ \d -> + assert ("kdf_scope rule '" ++ lbl ++ "' in group '" ++ groupName ++ + "': data parameter '" ++ show d ++ "' does not appear in salt/IKM/info") $ + d `elem` freeDataVars + + -- Validate output name types + let KDFOutputSpec outputs = _ksrbOutput body + withIndices (map (\i -> (i, (ignore $ show i, IdxSession))) is1 ++ + map (\i -> (i, (ignore $ show i, IdxPId ))) is2) $ + withVars (map (\dv -> (dv, (ignore $ show dv, Nothing, tGhost))) dvars) $ + forM_ outputs $ \(_, nt) -> do + checkNameType nt + nameTypeUniform nt + + return () + where + saltHasGroupKdfKeyCheck keyNames salt = case salt^.val of + AEGet ne -> isGroupKdfKey keyNames ne + _ -> False + + ikmHasGroupKdfKeyCheck keyNames atoms = + any (\a -> case a^.val of + AEGet ne -> isGroupKdfKey keyNames ne + _ -> False) + atoms + + ikmHasLocalDHCheck dhNames atoms = + any (\a -> case a^.val of + AEApp (PRes (PDot PTop "dh_combine")) _ [x, y] + | AEApp (PRes (PDot PTop "dhpk")) _ [xx] <- x^.val + , AEGet ne1 <- xx^.val + , AEGet ne2 <- y^.val -> + isGroupDH dhNames ne1 && isGroupDH dhNames ne2 + _ -> False) + atoms + + isGroupKdfKey keyNames ne = case ne^.val of + NameConst _ (PRes (PDot _ n)) _ -> n `elem` keyNames + KDFName nks j _ _ -> j < length nks && (nks !! j) == NK_KDF + _ -> False + + isGroupDH dhNames ne = case ne^.val of + NameConst _ (PRes (PDot _ n)) _ -> n `elem` dhNames + _ -> False + + +ensureSelfDisjoint + :: String + -> String + -> Bind (([IdxVar], [IdxVar]), [DataVar]) KDFScopeRuleBody + -> Check () +ensureSelfDisjoint groupName lbl bnd = do + (((is1a, is2a), dvarsA), bodyA) <- unbind bnd + (((is1b, is2b), dvarsB), bodyB) <- unbind bnd + when (not (null is1a && null is2a && null dvarsA)) $ + withIndices (map (\i -> (i, (ignore $ show i, IdxSession))) (is1a ++ is1b) ++ + map (\i -> (i, (ignore $ show i, IdxPId ))) (is2a ++ is2b)) $ + withVars (map (\d -> (d, (ignore $ show d, Nothing, tGhost))) (dvarsA ++ dvarsB)) $ do + let mSalt = saltEqProp (_ksrbSalt bodyA) (_ksrbSalt bodyB) + let pInfo = pEq (_ksrbInfo bodyA) (_ksrbInfo bodyB) + let mIkm = ikmEqProp (_ksrbIkm bodyA) (_ksrbIkm bodyB) + case (mSalt, mIkm) of + (Just pSalt, Just pIkm) -> do + let pSame = pAnd pSalt (pAnd pIkm pInfo) + let pWhere = pAnd (_ksrbWhere bodyA) (_ksrbWhere bodyB) + let idxDiffs = + [ pNot (mkSpanned (PEqIdx (mkIVar iA) (mkIVar iB))) + | (iA, iB) <- zip (is1a ++ is2a) (is1b ++ is2b) ] + let dvarDiffs = + [ pNot (pEq (aeVar' dA) (aeVar' dB)) + | (dA, dB) <- zip dvarsA dvarsB ] + let diffs = idxDiffs ++ dvarDiffs + case diffs of + [] -> return () + (d0:ds) -> do + let pDiff = foldl pOr d0 ds + let pOverlap = pAnd pSame (pAnd pWhere pDiff) + (_, b) <- SMT.smtTypingQuery "kdf_rule_self_disjoint" $ + SMT.symAssert (pNot pOverlap) + assert ("KDF rule self-disjointness in group '" ++ groupName ++ + "': rule '" ++ lbl ++ + "' overlaps with itself under distinct parameter choices") b + _ -> return () + +ensureSIIDisjoint + :: String + -> String + -> KDFScopeRuleBody + -> [(String, Bind (([IdxVar], [IdxVar]), [DataVar]) KDFScopeRuleBody)] + -> Check () +ensureSIIDisjoint groupName lbl body existingRules = + forM_ existingRules $ \(lbl2, bnd2) -> do + (((is2, ps2), dvars2), body2) <- unbind bnd2 + withIndices (map (\i -> (i, (ignore $ show i, IdxSession))) is2 ++ + map (\i -> (i, (ignore $ show i, IdxPId ))) ps2) $ + withVars (map (\d -> (d, (ignore $ show d, Nothing, tGhost))) dvars2) $ do + let mSalt = saltEqProp (_ksrbSalt body) (_ksrbSalt body2) + let pInfo = pEq (_ksrbInfo body) (_ksrbInfo body2) + let mIkm = ikmEqProp (_ksrbIkm body) (_ksrbIkm body2) + case (mSalt, mIkm) of + (Just pSalt, Just pIkm) -> do + let pSame = pAnd pSalt (pAnd pIkm pInfo) + let pOverlap = pAnd pSame (pAnd (_ksrbWhere body) (_ksrbWhere body2)) + (_, b) <- SMT.smtTypingQuery "kdf_rule_disjoint" $ + SMT.symAssert (pNot pOverlap) + assert ("KDF rule disjointness in group '" ++ groupName ++ + "': rule '" ++ lbl ++ "' overlaps with rule '" ++ lbl2 ++ "'") b + _ -> return () + checkDecl :: Decl -> Check a -> Check a checkDecl d cont = withSpan (d^.spanOf) $ case d^.val of (DeclLocality n dcl) -> do + mScope <- view curKDFScope + when (isJust mScope) $ typeError "locality declarations not allowed inside kdf_scope" ensureNoConcreteDefs case dcl of Left i -> local (over (curMod . localities) $ insert n (Left i)) $ cont @@ -1183,13 +1316,28 @@ checkDecl d cont = withSpan (d^.spanOf) $ checkProp p local (over (curMod . predicates) $ insert s bnd) $ cont DeclName n o -> do - ensureNoConcreteDefs + mScope <- view curKDFScope ((is1, is2), ndecl) <- unbind o - case ndecl of - DeclAbstractName -> local (over (curMod . nameDefs) $ insert n (bind (is1, is2) AbstractName)) $ cont - DeclBaseName nt nls -> addNameDef n (is1, is2) (nt, nls) $ cont - DeclAbbrev bne -> addNameAbbrev n (is1, is2) bne $ cont + case mScope of + Just _ -> + case ndecl of + DeclBaseName nt nls -> case nt^.val of + NT_DH -> local (over curKDFScope $ fmap $ \s -> s { _kssDHNames = _kssDHNames s ++ [n] }) $ + addNameDef n (is1, is2) (nt, nls) cont + NT_KDF -> local (over curKDFScope $ fmap $ \s -> s { _kssKdfKeyNames = _kssKdfKeyNames s ++ [n] }) $ + addNameDef n (is1, is2) (nt, nls) cont + _ -> typeError $ "Only DH and kdfkey names are allowed in kdf_scope (bad type for '" ++ n ++ "')" + DeclAbstractName -> typeError $ "Abstract name declarations not allowed in kdf_scope: " ++ n + DeclAbbrev _ -> typeError $ "Name abbreviations not allowed in kdf_scope: " ++ n + Nothing -> do + ensureNoConcreteDefs + case ndecl of + DeclAbstractName -> local (over (curMod . nameDefs) $ insert n (bind (is1, is2) AbstractName)) $ cont + DeclBaseName nt nls -> addNameDef n (is1, is2) (nt, nls) $ cont + DeclAbbrev bne -> addNameAbbrev n (is1, is2) bne $ cont DeclModule n imt me omt -> do + mScope <- view curKDFScope + when (isJust mScope) $ typeError "module declarations not allowed inside kdf_scope" ensureNoConcreteDefs md <- case me^.val of ModuleVar (PRes p) -> return $ MAlias p @@ -1207,12 +1355,16 @@ checkDecl d cont = withSpan (d^.spanOf) $ withSpan (singleLineSpan $ d^.spanOf) $ moduleMatches md mdt local (over (curMod . modules) $ insert n md) $ cont DeclDefHeader n isl -> do + mScope <- view curKDFScope + when (isJust mScope) $ typeError "def header declarations not allowed inside kdf_scope" ((is1, is2), l) <- unbind isl withIndices (map (\i -> (i, (ignore $ show i, IdxSession))) is1 ++ map (\i -> (i, (ignore $ show i, IdxPId))) is2) $ do normLocality l let df = DefHeader isl addDef n df $ cont DeclDef n o1 -> do + mScope <- view curKDFScope + when (isJust mScope) $ typeError "def declarations not allowed inside kdf_scope" ((is1, is2), (l, db)) <- unbind o1 dspec <- withIndices (map (\i -> (i, (ignore $ show i, IdxSession))) is1 ++ map (\i -> (i, (ignore $ show i, IdxPId))) is2) $ do normLocality l @@ -1306,24 +1458,49 @@ checkDecl d cont = withSpan (d^.spanOf) $ withVars (map (\x -> (x, (ignore $ show x, Nothing, tGhost))) xs) $ do checkNameType nt local (over (curMod . nameTypeDefs) $ insert s bnt) $ cont - DeclODH s b -> do - ensureNoConcreteDefs - ((is, ps), (ne1, ne2, kdf)) <- unbind b - withIndices (map (\i -> (i, (ignore $ show i, IdxSession))) is ++ map (\i -> (i, (ignore $ show i, IdxPId))) ps) $ do - nt <- getNameType ne1 - nt2 <- getNameType ne2 - assert ("Name " ++ show (owlpretty ne1) ++ " must be DH") $ nt `aeq` (mkSpanned $ NT_DH) - assert ("Name " ++ show (owlpretty ne1) ++ " must be DH") $ nt2 `aeq` (mkSpanned $ NT_DH) - b1 <- nameExpIsLocal ne1 - b2 <- nameExpIsLocal ne2 - - assert ("Name must be local to module: " ++ show (owlpretty ne1)) $ b1 - assert ("Name must be local to module: " ++ show (owlpretty ne2)) $ b2 - let indsLocal = all (\i -> i `elem` (toListOf fv ne1 ++ toListOf fv ne2)) (is ++ ps) - assert ("All indices in odh must appear in name expressions") indsLocal - checkNameType $ Spanned (d^.spanOf) $ NT_KDF KDF_IKMPos kdf - ensureODHDisjoint (bind (is, ps) (ne1, ne2)) - local (over (curMod . odh) $ insert s b) $ cont + DeclKDFRule ruleX -> do + mScope <- view curKDFScope + case mScope of + Nothing -> typeError "kdf/odh rules must appear inside a kdf_scope block" + Just kss -> do + let groupName = _kssGroupName kss + kdfKeyEntryNames = _kssKdfKeyNames kss + dhEntryNames = _kssDHNames kss + validateKDFScopeRule groupName kdfKeyEntryNames dhEntryNames ruleX + let lbl = _ksrLabel ruleX + bRule = _ksrBody ruleX + newRules = insert lbl bRule (_kssRules kss) + local (over (curMod . kdfScopes) $ insert groupName + (KDFScopeDef newRules [] (_kssKdfKeyNames kss ++ _kssDHNames kss))) $ do + ensureSelfDisjoint groupName lbl bRule + (((is1, is2), dvars), body) <- unbind bRule + ikmAtoms <- + withIndices (map (\i -> (i, (ignore $ show i, IdxSession))) is1 ++ + map (\i -> (i, (ignore $ show i, IdxPId ))) is2) $ + withVars (map (\dv -> (dv, (ignore $ show dv, Nothing, tGhost))) dvars) $ do + ensureSIIDisjoint groupName lbl body (_kssRules kss) + unconcat (_ksrbIkm body) + let newOdhPairs = + [ (lbl, bind ((is1, is2), dvars) (ne1, ne2)) + | atom <- ikmAtoms + , AEApp (PRes (PDot PTop "dh_combine")) _ [x, y] <- [atom^.val] + , AEApp (PRes (PDot PTop "dhpk")) _ [xx] <- [x^.val] + , AEGet ne1 <- [xx^.val] + , AEGet ne2 <- [y^.val] ] + local (over curKDFScope $ fmap $ \s -> s + { _kssRules = newRules + , _kssOdhPairs = _kssOdhPairs s ++ newOdhPairs + }) cont + DeclKDFScope groupName innerDecls -> do + mScope <- view curKDFScope + when (isJust mScope) $ typeError "nested kdf_scope blocks not allowed" + let initState = KDFScopeState groupName [] [] [] [] + local (set curKDFScope (Just initState)) $ + checkDeclsWithCont innerDecls $ do + Just kss <- view curKDFScope + let gdef = KDFScopeDef (_kssRules kss) (_kssOdhPairs kss) + (_kssKdfKeyNames kss ++ _kssDHNames kss) + local (set curKDFScope Nothing . over (curMod . kdfScopes) (insert groupName gdef)) cont (DeclTy s ot) -> do tds <- view $ curMod . tyDefs case ot of @@ -1347,22 +1524,6 @@ checkDecl d cont = withSpan (d^.spanOf) $ local (over (curMod . userFuncs) $ insert f (UninterpUserFunc f ar)) $ cont -ensureODHDisjoint :: Bind ([IdxVar], [IdxVar]) (NameExp, NameExp) -> Check () -ensureODHDisjoint b = do - cur_odh <- view $ curMod . odh - ((is, ps), (ne1, ne2)) <- unbind b - withIndices (map (\i -> (i, (ignore $ show i, IdxSession))) is ++ map (\i -> (i, (ignore $ show i, IdxPId))) ps) $ do - forM_ cur_odh $ \(_, bnd2) -> do - ((is2, ps2), ((ne1', ne2', _))) <- unbind bnd2 - withIndices (map (\i -> (i, (ignore $ show i, IdxSession))) is2 ++ map (\i -> (i, (ignore $ show i, IdxPId))) ps2) $ do - let peq1 = pAnd (pEq (mkSpanned $ AEGet ne1) (mkSpanned $ AEGet ne1')) - (pEq (mkSpanned $ AEGet ne2) (mkSpanned $ AEGet ne2')) - let peq2 = pAnd (pEq (mkSpanned $ AEGet ne2) (mkSpanned $ AEGet ne1')) - (pEq (mkSpanned $ AEGet ne1) (mkSpanned $ AEGet ne2')) - let pdisj = pNot $ pOr peq1 peq2 - (_, b) <- SMT.smtTypingQuery "" $ SMT.symAssert pdisj - assert ("ODH Disjointness") b - nameExpIsLocal :: NameExp -> Check Bool nameExpIsLocal ne = case ne^.val of @@ -1397,7 +1558,7 @@ nameTypeUniform nt = NT_Enc _ -> return () NT_App p ps as -> resolveNameTypeApp p ps as >>= nameTypeUniform NT_MAC _ -> return () - NT_KDF _ _ -> return () + NT_KDF -> return () _ -> typeError $ "Name type must be uniform: " ++ show (owlpretty nt) -- We then fold the list of decls, checking later ones after processing the @@ -1485,26 +1646,7 @@ checkNameType nt = withSpan (nt^.spanOf) $ NT_Nonce l -> do assert ("Unknown length constant: " ++ l) $ l `elem` lengthConstants return () - NT_KDF kdfPos b -> do - (((sx, x), (sy, y), (sself, xself)), cases) <- unbind b - withVars [(x, (ignore sx, Nothing, tGhost)), - (y, (ignore sy, Nothing, tGhost)), - (xself, (ignore sself, Nothing, tGhost))] $ do - assert ("KDF cases must be non-empty") $ not $ null cases - ps <- forM cases $ \bcase -> do - (ixs, (p, nts)) <- unbind bcase - withIndices (map (\i -> (i, (ignore $ show i, IdxGhost))) ixs) $ do - withSpan (p^.spanOf) $ - assert ("Self variable must not appear in precondition") $ - not $ xself `elem` (toListOf fv p) - checkProp p - forM_ nts $ \(str, nt) -> do - checkNameType nt - nameTypeUniform nt - return $ mkExistsIdx ixs p - (_, b) <- SMT.smtTypingQuery "disjoint" $ SMT.disjointProps ps - assert ("KDF disjointness check failed") b - return () + NT_KDF -> return () -- bare kdfkey marker; no cases to check NT_Enc t -> do checkTy t checkNoTopTy False t @@ -1973,7 +2115,7 @@ checkExpr ot e = withSpan (e^.spanOf) $ pushRoutine ("checkExpr") $ local (set e (EDebug (DebugPrintTyContext anf)) -> do tC <- view tyContext let tC' = if anf then removeAnfVars tC else tC - liftIO $ putDoc $ owlprettyTyContext tC' + liftPutDoc $ owlprettyTyContext tC' getOutTy ot $ tUnit (EDebug (DebugPrintExpr e)) -> do liftIO $ putStrLn $ show $ owlpretty e @@ -2498,7 +2640,7 @@ getValidatedTy albl t = local (set tcScope $ TcGhost False) $ do NT_DH -> return $ mkSpanned $ AELenConst "group" NT_Sig _ -> return $ mkSpanned $ AELenConst "signature" NT_PKE _ -> return $ mkSpanned $ AELenConst "pke_sk" - NT_KDF _ _ -> return $ mkSpanned $ AELenConst "kdfkey" + NT_KDF -> return $ mkSpanned $ AELenConst "kdfkey" -- NT_PRF _ -> typeError $ "Unparsable name type: " ++ show (owlpretty nt) doAEnc t1 x t args = @@ -2613,7 +2755,6 @@ unifyValidKDFResults valids = do -- If the result is `Left True`, the KDF key is public (either flows to adv or is an out-of-bounds DH shared secret). -- If the result is `Left False`, the KDF call is ill-typed in some way. - -- Unify the results of multiple KDF calls (sort of inverse to `findBestKDFCallResult`). -- Used to join the results of checking multiple candidate concats in IKM position (so all must either be public or match a KDF case). -- If we got any bad KDF calls from the concats, then we have an ill-typed KDF call overall. @@ -2650,135 +2791,7 @@ findBestKDFCallResult xs = do -- Find all possible KDF salt position calls that match the given annotations `anns` and choose the best one. -- Attempt to extract a KDF key from the salt position argument `a`. If successful, use `matchKDF` -- to find all calls to the KDF that match the annotations `anns`; if unsuccessful, check whether the salt argument is public. -findValidSaltCalls :: (AExpr, Ty) -> (AExpr, Ty) -> (AExpr, Ty) -> [KDFSelector] -> Int -> [NameKind] -> Check (Either Bool (KDFStrictness, NameExp)) -findValidSaltCalls a b c anns j nks = do - results <- forM anns $ \(i, is_case) -> do - mapM_ inferIdx is_case - case (extractNameFromType (snd a)) of - Nothing -> Left <$> tyFlowsTo (snd a) advLbl - Just ne -> do - nt <- getNameType ne - case nt^.val of - NT_KDF KDF_SaltPos kdfbody -> matchKDF [] KDF_SaltPos ne kdfbody a ((fst b, fst b), snd b) c (i, is_case) j nks - _ -> Left <$> kdfArgPublic [] KDF_SaltPos a b c - findBestKDFCallResult results - --- Find all possible KDF IKM position calls that match the given annotations `anns` and choose the best one. --- Use `unconcatIKM` to split out all concats from the IKM position arg `b`. For each subrange `b'` of `b`, try to find --- a name in `b'`; if successful, use either `matchKDF` or `matchODH` (depending on the selectors in the annotation) --- to find all calls to the KDF that match the annotations `anns`; if unsuccessful, check whether the IKM argument is public. -findValidIKMCalls :: (AExpr, Ty) -> (AExpr, Ty) -> (AExpr, Ty) -> [Either KDFSelector (String, ([Idx], [Idx]), KDFSelector)] - -> Int -> [NameKind] -> Check (Either Bool (KDFStrictness, NameExp)) -findValidIKMCalls a b c anns j nks = do - bs <- unconcatIKM (fst b) - dhs_ <- forM anns $ \e -> - case e of - Left _ -> return [] - Right (s, ips, i) -> do - pth <- curModName - (ne1, ne2, _, _) <- getODHNameInfo (PRes $ PDot pth s) ips (fst a) (fst b) (fst c) i j - return [(ne1, ne2)] - let dhs = concat dhs_ - b_results <- forM bs $ \b' -> do - bt' <- inferAExpr b' >>= normalizeTy - b'_res <- forM anns $ \e -> do - case e of - Left (i, is_case) -> do - mapM_ inferIdx is_case - case (extractNameFromType bt') of - Nothing -> Left <$> kdfArgPublic dhs KDF_IKMPos a (b', bt') c - Just ne -> do - nt <- getNameType ne - case nt^.val of - NT_KDF KDF_IKMPos kdfbody -> do - matchKDF dhs KDF_IKMPos ne kdfbody a ((fst b, b'), bt') c (i, is_case) j nks - _ -> do - Left <$> kdfArgPublic dhs KDF_IKMPos a (b', bt') c - Right (s, ips, i) -> matchODH dhs a ((fst b, b'), bt') c (s, ips, i) j nks - findBestKDFCallResult b'_res - unifyKDFCallResult $ b_results - - --- Compute the result name exp for an ODH call using a particular ODH selector. Arguments: --- dhs: DH key pairs from the odh declaration --- a: salt argument --- ((bFull, b), bt): ikm argument (`bFull` is the original argument, `b` is the concat component to analyze, `bt` is the type of `b`) --- c: info argument --- (s, ips, i): ODH selector (ODH name, sid/pid arguments, selector) --- j: index into the name kind row `nks` --- nks: output name kind row --- Returns either a boolean indicating whether the ODH call is public (if it doesn't match the case), or the strictness and the name exp of the result -matchODH :: [(NameExp, NameExp)] -> (AExpr, Ty) -> ((AExpr, AExpr), Ty) -> (AExpr, Ty) -> (String, ([Idx], [Idx]), KDFSelector) -> Int -> [NameKind] -> - Check (Either Bool (KDFStrictness, NameExp)) -matchODH dhs a ((bFull, b), bt) c (s, ips, i) j nks = do - pth <- curModName - (ne1, ne2, p, str_nts) <- getODHNameInfo (PRes $ PDot pth s) ips (fst a) bFull (fst c) i j - nks2 <- mapM (\(_, nt) -> getNameKind nt) str_nts - assert ("Mismatch on name kinds for kdf: annotation says " ++ show (owlpretty $ NameKindRow nks) ++ " but key says " ++ show (owlpretty $ NameKindRow nks2)) $ L.isPrefixOf nks nks2 - let (str, nt) = str_nts !! j - let dhCombine x y = mkSpanned $ AEApp (topLevelPath "dh_combine") [] [x, y] - let dhpk x = mkSpanned $ AEApp (topLevelPath "dhpk") [] [x] - let real_ss = dhCombine (dhpk (mkSpanned $ AEGet ne1)) (mkSpanned $ AEGet ne2) - -- We ask if one of the unconcatted elements is equal to the specified - -- DH name - beq <- decideProp $ pEq real_ss b - case beq of - Just True -> do - b2 <- decideProp p - b3 <- flowsTo (nameLbl ne1) advLbl - b4 <- flowsTo (nameLbl ne2) advLbl - -- If it is, and if the DH name is a secret, then we are good - if (b2 == Just True) then - if (not b3) && (not b4) then do - return $ Right (str, mkSpanned $ KDFName (fst a) bFull (fst c) nks2 j nt (ignore $ True)) - else Left <$> kdfArgPublic dhs KDF_IKMPos a (b, bt) c - else Left <$> kdfArgPublic dhs KDF_IKMPos a (b, bt) c - _ -> Left <$> kdfArgPublic dhs KDF_IKMPos a (b, bt) c - - --- Compute the result name exp for a KDF call using a particular selector. Arguments: --- dhs: DH key pairs from the annotation (used to check public args) --- pos: KDF position (salt or IKM) --- ne: name exp extracted from the KDF key (either salt or IKM position) --- bcases: KDF body corresponding to `ne` in the environment --- a: salt argument --- ((bFull, b), bt): ikm argument (`bFull` is the original argument, `b` is the concat component to analyze, `bt` is the type of `b`) --- c: info argument --- (i, is_case): KDF selector (selector into `bcases` and index arguments) --- j: index into the name kind row `nks` --- nks: output name kind row --- Returns either a boolean indicating whether the KDF call is public (if it doesn't match the case), or the strictness and the name exp of the result -matchKDF :: [(NameExp, NameExp)] -> KDFPos -> NameExp -> KDFBody -> (AExpr, Ty) -> ((AExpr, AExpr), Ty) -> (AExpr, Ty) -> KDFSelector -> Int -> [NameKind] -> - Check (Either Bool (KDFStrictness, NameExp)) -matchKDF dhs pos ne bcases a ((bFull, b), bt) c (i, is_case) j nks = do - (((sx, x), (sy, y), (sself, xself)), cases_) <- unbind bcases - let cases = case pos of - KDF_SaltPos -> subst x bFull $ subst y (fst c) $ subst xself (fst a) $ cases_ - KDF_IKMPos -> subst x (fst a) $ subst y (fst c) $ subst xself b $ cases_ - if i < length cases then do - (ixs, pnts) <- unbind $ cases !! i - assert ("KDF case index arity mismatch") $ length ixs == length is_case - let (p, nts) = substs (zip ixs is_case) $ pnts - nks2 <- forM nts $ \(_, nt) -> getNameKind nt - assert ("Mismatch on name kinds for kdf: annotation says " ++ show (owlpretty $ NameKindRow nks) ++ " but key says " ++ show (owlpretty $ NameKindRow nks2)) $ L.isPrefixOf nks nks2 - assert "KDF row index out of bounds" $ j < length nks - let (str, nt) = nts !! j - bp <- decideProp p - b2 <- not <$> flowsTo (nameLbl ne) advLbl - if (bp == Just True) then - if b2 then do - return $ Right (str, mkSpanned $ KDFName (fst a) bFull (fst c) nks2 j nt (ignore $ True)) - else Left <$> kdfArgPublic dhs pos a (b, bt) c - else Left <$> kdfArgPublic dhs pos a (b, bt) c - else Left <$> kdfArgPublic dhs pos a (b, bt) c - --- check if the key position argument to a KDF call is public --- salt must flow to adv --- ikm must either flow to adv or be an out-of-bounds DH shared secret -kdfArgPublic dhs pos a b c = do - case pos of - KDF_SaltPos -> tyFlowsTo (snd a) advLbl - KDF_IKMPos -> pubIKM dhs a b c +-- Old findValidSaltCalls, findValidIKMCalls, matchKDF, matchODH removed; replaced by tryKDFRuleHint pubIKM :: [(NameExp, NameExp)] -> (AExpr, Ty) -> (AExpr, Ty) -> (AExpr, Ty) -> Check Bool pubIKM dhs a b c = do @@ -2839,39 +2852,6 @@ getLocalDHComputation a = pushRoutine ("getLocalDHComp") $ do _ -> go_from_ty _ -> go_from_ty --- Resolve the AExpr and split it up into its concat components. For soundness, --- we restrict the computations that can show up in IKMs, so we cannot smuggle --- in a concat that is not caught --- Values that can appear in an IKM expression: --- - A name (`TName`/`get(_)`) --- - A DH public key (`TDH_PK`/`dhpk(_)`) --- - A DH shared secret (`TSS`/`dh_combine(_,_)`) --- - A hex const (`THexConst`) --- - A DH group element (`is_group_elem(_)` checked by SMT) --- - Concats of the above -unconcatIKM :: AExpr -> Check [AExpr] -unconcatIKM a = do - a' <- resolveANF a >>= normalizeAExpr - case a'^.val of - AEApp (PRes (PDot PTop "concat")) [] [x, y] -> - liftM2 (++) (unconcatIKM x) (unconcatIKM y) - AEGet _ -> return [a'] - AEApp (PRes (PDot PTop "dh_combine")) _ _ -> return [a'] - AEApp (PRes (PDot PTop "dhpk")) _ _ -> return [a'] - AEHex _ -> return [a'] - _ -> do - t <- inferAExpr a >>= normalizeTy - case (stripRefinements t)^.val of - TSS _ _ -> return [a'] - TDH_PK _ -> return [a'] - THexConst _ -> return [a'] - TName _ -> return [a'] - _ -> do - wf <- decideProp $ pEq (builtinFunc "is_group_elem" [a']) (builtinFunc "true" []) - case wf of - Just True -> return [a'] - _ -> typeError $ "Unsupported computation for IKM: " ++ show (owlpretty a') ++ " with type " ++ show (owlpretty t) - unconcat :: AExpr -> Check [AExpr] unconcat a = do a' <- resolveANF a >>= normalizeAExpr @@ -2906,7 +2886,8 @@ crhInjLemma x y = _ -> return pTrue kdfInjLemma :: AExpr -> AExpr -> Check Prop -kdfInjLemma x y = +kdfInjLemma x y = pushRoutine ("kdfInjLemma(" ++ show (owlpretty x) ++ ", " ++ show (owlpretty y) ++ ")") $ do + -- liftIO $ putStrLn ("Trying kdfInjLemma on " ++ show ( x) ++ " and " ++ show ( y)) case (x^.val, y^.val) of (AEKDF a b c nks j, AEKDF a' b' c' nks' j') | j < length nks && j' < length nks' && (nks !! j == nks' !! j') -> do let p1 = pImpl (pEq x y) (pAnd (pAnd (pEq a a') (pEq b b')) (pEq c c')) @@ -2919,6 +2900,45 @@ kdfInjLemma x y = return $ pAnd p1 p2 _ -> return pTrue +-- Build the conjunction of injectivity lemmas between this kdf call's gkdf +-- (curKDF) and every kdfkey-producing output (ruleKDF) of every rule in the +-- call's active scope. Returns pTrue when the call's output at index j is +-- not a kdfkey, or when no scope is identifiable from the hints. +kdfInjLemmasForScope :: + [NameKind] -> Int + -> AExpr -> AExpr -> AExpr + -> [KDFScopeRuleRef] + -> Check Prop +kdfInjLemmasForScope nks j saltE ikmE infoE hints = pushRoutine ("kdfInjLemmasForScope") $ + local (set tcScope $ TcGhost False) $ do + if j >= length nks || nks !! j /= NK_KDF + then return pTrue + else do + scopeResults <- mapM (findScopeForLabel . _ksrrLabel) hints + case catMaybes scopeResults of + [] -> return pTrue + ((sn, scopeDef) : _) -> do + let curKDF = mkSpanned $ AEKDF saltE ikmE infoE nks j + let allRules = _ksdRules scopeDef + ruleProps <- forM allRules $ \(rn, bRule) -> do + (((is1, is2), dvars), body) <- unbind bRule + let idxAssocs = [(i, (ignore $ show i, IdxSession)) | i <- is1] + ++ [(i, (ignore $ show i, IdxPId)) | i <- is2] + let varAssocs = [(d, (ignore $ show d, Nothing, tData advLbl advLbl)) | d <- dvars] + withIndices idxAssocs $ withVars varAssocs $ do + let KDFOutputSpec outputs = _ksrbOutput body + ruleNks <- mapM (\(_, outNt) -> getNameKind outNt) outputs + outProps <- forM (zip [0..] ruleNks) $ \(i, outNk) -> + if outNk /= NK_KDF + then return pTrue + else do + let ruleKDF = mkSpanned $ + AEKDF (_ksrbSalt body) (_ksrbIkm body) (_ksrbInfo body) ruleNks i + lemma <- kdfInjLemma curKDF ruleKDF + return $ mkForallIdx (is1 ++ is2) $ mkForallBv dvars lemma + return $ foldr pAnd pTrue outProps + return $ foldr pAnd pTrue ruleProps + patternPublicAndEquivalent :: Bind DataVar AExpr -> Bind DataVar AExpr -> Check (Bool, Bool) patternPublicAndEquivalent pat1 pat2 = do (x, pat) <- unbind pat1 @@ -2934,6 +2954,289 @@ patternPublicAndEquivalent pat1 pat2 = do +-- Assert that all KDFScopeRuleRefs in the list declare the same output namekinds. +checkHintOutputsCompatible :: [KDFScopeRuleRef] -> Check () +checkHintOutputsCompatible hints = do + mNksList <- forM hints $ \h -> do + mBody <- lookupKDFScopeRule (_ksrrLabel h) (_ksrrIdxs h) (_ksrrArgs h) + case mBody of + Nothing -> return Nothing + Just body -> do + let KDFOutputSpec outputs = _ksrbOutput body + nks' <- local (set tcScope $ TcGhost False) $ + mapM (\(_, outNt') -> getNameKind outNt') outputs + return $ Just (_ksrrLabel h, nks') + case catMaybes mNksList of + [] -> return () + ((firstLbl, firstNks):rest) -> + forM_ rest $ \(lbl, nks') -> + assert ("Incompatible KDF hints: rule " ++ firstLbl ++ + " declares output kinds " ++ show (owlpretty (NameKindRow firstNks)) ++ + " but rule " ++ lbl ++ " declares " ++ + show (owlpretty (NameKindRow nks'))) + (firstNks == nks') + +anyM :: [AExpr] -> (AExpr -> Check Bool) -> Check Bool +anyM as p = do + bs <- mapM p as + return $ or bs + +normalizeHint :: KDFScopeRuleRef -> Check KDFScopeRuleRef +normalizeHint hint = do + let args = _ksrrArgs hint + args' <- mapM resolveANF args >>= mapM normalizeAExpr + return hint { _ksrrArgs = args' } + +-- Try a single KDFScopeRuleRef hint against salt/ikm/info. +-- Returns Just outputBaseTy if the hint matches, Nothing otherwise. +tryKDFRuleHint :: KDFScopeRuleRef -> (AExpr, Ty) -> (AExpr, Ty) -> (AExpr, Ty) -> [NameKind] -> Int -> Check (Maybe Ty) +tryKDFRuleHint hint (saltE, saltT) (ikmE, ikmT) (infoE, infoT) nks j = pushRoutine ("tryKDFRuleHint(" ++ show (owlpretty hint) ++ ")") $ do + let actuals = _ksrrArgs hint + mBody <- local (set tcScope $ TcGhost False) $ lookupKDFScopeRule (_ksrrLabel hint) (_ksrrIdxs hint) actuals + + case mBody of + Nothing -> return Nothing + Just body -> do + saltOk <- checkExprEqual saltE (_ksrbSalt body) + ikmOk <- checkExprEqual ikmE (_ksrbIkm body) + infoOk <- checkExprEqual infoE (_ksrbInfo body) + whereOk <- checkWhereClause (_ksrbWhere body) + if not (saltOk && ikmOk && infoOk && whereOk) then do + -- TODO: can/should we provide some kind of warning here? + return Nothing + else do + let KDFOutputSpec outputs = _ksrbOutput body + -- Validate that call-site name kinds match rule's declared output types + assert ("KDF name kinds length mismatch for rule " ++ _ksrrLabel hint ++ + ": call has " ++ show (length nks) ++ " output(s), rule declares " ++ + show (length outputs)) + (length nks == length outputs) + expectedNks <- mapM (\(_, outNt') -> local (set tcScope $ TcGhost False) $ getNameKind outNt') outputs + assert ("KDF name kinds mismatch for rule " ++ _ksrrLabel hint ++ + ": call has " ++ show (owlpretty (NameKindRow nks)) ++ + ", rule declares " ++ show (owlpretty (NameKindRow expectedNks))) + (nks == expectedNks) + if j >= length outputs then + typeError $ "KDF rule hint index " ++ show j ++ " out of bounds for rule " ++ _ksrrLabel hint + else do + let (strictness, outNt) = outputs !! j + let ne = mkSpanned $ KDFName nks j (ignore True) hint + -- (1) info must always be public + infoPub <- tyFlowsTo infoT advLbl + assert "KDF info argument must be public" infoPub + -- (2-4) check actual publicness of salt and ikm; classify inline + + -- Check whether the salt and IKM are public + saltPub <- tyFlowsTo saltT advLbl + ikmE' <- resolveANF ikmE >>= normalizeAExpr + ikmAtoms <- unconcat ikmE' + + ikmPub <- allM ikmAtoms $ \a -> do + case a^.val of + AEApp (PRes (PDot PTop "dh_combine")) _ [Spanned _ (AEApp (PRes (PDot PTop "dhpk")) _ [Spanned _ (AEGet x)]), Spanned _ (AEGet y)] -> do + b1 <- flowsTo (nameLbl x) advLbl + b2 <- flowsTo (nameLbl y) advLbl + return $ b1 || b2 + _ -> do + t <- inferAExpr a >>= normalizeTy + res <- tyFlowsTo t advLbl + -- logTypecheck $ owlpretty "ikm atom: " <> owlpretty a <> owlpretty " with type " <> owlpretty t <> owlpretty " flows to advLbl: " <> owlpretty res + return res + + -- If so, just return Data + if saltPub && ikmPub then return $ Just $ tData advLbl advLbl + else do + -- Otherwise, check whether the salt and IKM are secret. + -- Here, we use the matched hint body rather than the given arguments (which we have already checked are equal) + saltIsSecret <- case (_ksrbSalt body)^.val of + AEGet ne -> not <$> flowsTo (nameLbl ne) advLbl + _ -> do + t <- inferAExpr (_ksrbSalt body) >>= normalizeTy + case t^.val of + TName ne -> not <$> flowsTo (nameLbl ne) advLbl + _ -> return False + ikmAtoms <- unconcat (_ksrbIkm body) + ikmIsSecret <- anyM ikmAtoms $ \a -> do + case a^.val of + AEApp (PRes (PDot PTop "dh_combine")) _ [Spanned _ (AEApp (PRes (PDot PTop "dhpk")) _ [Spanned _ (AEGet x)]), Spanned _ (AEGet y)] -> do + b1 <- flowsTo (nameLbl x) advLbl + b2 <- flowsTo (nameLbl y) advLbl + return $ (not b1) && (not b2) + AEGet ne -> not <$> flowsTo (nameLbl ne) advLbl + _ -> do + t <- inferAExpr a >>= normalizeTy + case t^.val of + TName ne -> not <$> flowsTo (nameLbl ne) advLbl + _ -> return False + let secretFlowAx = case strictness of + KDFStrict -> pNot $ pFlow (nameLbl ne) advLbl + KDFPub -> pFlow (nameLbl ne) advLbl + KDFUnstrict -> pTrue + if saltIsSecret || ikmIsSecret then + return $ Just $ mkSpanned $ TRefined (mkSpanned $ TName ne) ".res" $ + bind (s2n ".res") secretFlowAx + else do + hint' <- normalizeHint hint + typeError $ + "KDF call matched hint " ++ show (owlpretty hint') ++ " but " ++ + "could not prove that the salt or ikm are secret or fully public" + +checkWhereClause :: Prop -> Check Bool +checkWhereClause p = fmap (== Just True) (decideProp p) + +checkExprEqual :: AExpr -> AExpr -> Check Bool +checkExprEqual actual expected = do + actual' <- resolveANF actual >>= normalizeAExpr + expected' <- resolveANF expected >>= normalizeAExpr + if aeq actual' expected' + then return True + else fmap (== Just True) $ decideProp (mkSpanned $ PEq actual' expected') + +buildRuleMatchProp :: AExpr -> AExpr -> AExpr + -> Bind (([IdxVar], [IdxVar]), [DataVar]) KDFScopeRuleBody + -> Check Prop +buildRuleMatchProp actualSalt actualIkm actualInfo bRule = do + (((is1, is2), dvars), body) <- unbind bRule + let allEqProp aes = + let eqs = map (\(ae1, ae2) -> if ae1 `aeq` ae2 then Nothing else Just (pEq ae1 ae2)) aes + in case catMaybes eqs of + [] -> pTrue + eqs' -> foldr1 pAnd eqs' + let matchProp = allEqProp [(actualSalt, _ksrbSalt body), (actualIkm, _ksrbIkm body), (actualInfo, _ksrbInfo body)] + withWhere = case (_ksrbWhere body)^.val of + PTrue -> matchProp + _ -> pAnd (_ksrbWhere body) matchProp + return $ mkExistsIdx (is1 ++ is2) $ mkExistsBv dvars withWhere + +nameExpInScope :: KDFScopeDef -> NameExp -> Bool +nameExpInScope scopeDef ne = + case ne^.val of + NameConst _ (PRes (PDot _ s)) _ -> s `elem` _ksdEntryNames scopeDef + KDFName _ _ _ hint -> member (_ksrrLabel hint) (_ksdRules scopeDef) + _ -> False -- unresolved name expressions + +-- returns (isLSBE, isPublic) +checkDHCombineLSBE :: KDFScopeDef -> AExpr -> AExpr -> Check (Bool, Bool) +checkDHCombineLSBE scopeDef x y = do + tx <- inferAExpr x >>= normalizeTy + ty' <- inferAExpr y >>= normalizeTy + let mPkName = case (stripRefinements tx)^.val of + TDH_PK ne -> Just ne + _ -> extractDHPKFromType tx + mSkName = extractNameFromType ty' + let nameInScope mNe = case mNe of + Just ne -> nameExpInScope scopeDef ne + Nothing -> False + let namePublic mNe = case mNe of + Just ne -> flowsTo (nameLbl ne) advLbl + Nothing -> return False + let pkBinding = nameInScope mPkName + let skBinding = nameInScope mSkName + pkPublic <- namePublic mPkName + skPublic <- namePublic mSkName + let isLSBE = (pkBinding && not pkPublic) || (skBinding && not skPublic) + let isPub = pkPublic || skPublic -- if either side is public, the shared secret is public + return (isLSBE, isPub) + +-- returns (isLSBE, isPublic) +fallbackFromType :: KDFScopeDef -> AExpr -> Check (Bool, Bool) +fallbackFromType scopeDef a = do + t <- inferAExpr a >>= normalizeTy + case (stripRefinements t)^.val of + TName ne | nameExpInScope scopeDef ne -> do + pub <- flowsTo (nameLbl ne) advLbl + return (True, pub) + TSS ne1 ne2 -> do + let ne1InScope = nameExpInScope scopeDef ne1 + ne2InScope = nameExpInScope scopeDef ne2 + ne1Public <- flowsTo (nameLbl ne1) advLbl + ne2Public <- flowsTo (nameLbl ne2) advLbl + let ssPublic = ne1Public || ne2Public -- if either side is public, the shared secret is public + if not (ne1InScope || ne2InScope) + then return (False, ssPublic) + else do + -- at least one in scope and not public + return $ ((ne1InScope && not ne1Public) || (ne2InScope && not ne2Public), ssPublic) + _ -> do + pub <- tyFlowsTo t advLbl + return (False, pub) + +classifyComponent :: KDFScopeDef -> AExpr -> Ty -> Check (Bool, Bool) +classifyComponent scopeDef expr ty = do + a <- resolveANF expr >>= normalizeAExpr + (lsbe, pub) <- case a^.val of + AEGet ne | nameExpInScope scopeDef ne -> do + tyPub <- tyFlowsTo ty advLbl + return (True, tyPub) + AEApp (PRes (PDot PTop "dh_combine")) _ [x, y] -> checkDHCombineLSBE scopeDef x y + _ -> fallbackFromType scopeDef a + return (lsbe, pub) + +unconcatWithTypes :: AExpr -> Check [(AExpr, Ty)] +unconcatWithTypes ikmE = do + components <- unconcat ikmE + forM components $ \c -> do + t <- inferAExpr c >>= normalizeTy + return (c, t) + +prettyInconclusiveKDFRules :: [(Prop, String)] -> OwlDoc +prettyInconclusiveKDFRules inconclusiveRules = + hsep $ map (\(p, ruleName) -> owlpretty "rule " <+> owlpretty ruleName <+> owlpretty ":" <+> owlpretty p <> line) inconclusiveRules + +handleKDFNoMatch :: [KDFScopeRuleRef] -> (AExpr, Ty) -> (AExpr, Ty) -> (AExpr, Ty) + -> (Ty -> Ty) -> Check Ty +handleKDFNoMatch hints (saltE, saltT) (ikmE, ikmT) (infoE, infoT) kdfRefinement = pushRoutine "handleKDFNoMatch" $ do + bInfo <- tyFlowsTo infoT advLbl + -- Determine scope for hints + scopeResults <- mapM (findScopeForLabel . _ksrrLabel) hints + let foundScopes = catMaybes scopeResults + (scopeName, scopeDef) <- case foundScopes of + [] -> typeError ("No KDF rule applies, and arguments are not all public. " ++ + "Could not find KDF scope for the given hints.") + ((gn, gd):rest) -> do + assert "KDF hints must all be from the same scope" + (all (\(gn', _) -> gn' == gn) rest) + return (gn, gd) + + -- Step 1: For each rule, check via SMT whether it can possibly match + let allRules = _ksdRules scopeDef + allMatchResults <- forM allRules $ \(_, bRule) -> do + pmatch <- buildRuleMatchProp saltE ikmE infoE bRule + res <- decideProp pmatch + return (pmatch, res) + let inconclusiveRules = [ (p, ruleName) | ((ruleName, _), (p, Nothing)) <- zip allRules allMatchResults ] + assert + ("Inconclusive: cannot match this KDF call with a rule or prove that it doesn't match any of the rules" ++ + if null inconclusiveRules then "" + else ", inconclusive rules: " ++ (show $ line <> prettyInconclusiveKDFRules inconclusiveRules)) $ + any (\(_, x) -> x == Just True) allMatchResults || all (\(_, x) -> x == Just False) allMatchResults + if all (\(_, x) -> x == Just False) allMatchResults + then + -- Out-of-bounds case: the KDF call provably doesn't match any rule in the scope, so it should be public + return $ kdfRefinement (tData advLbl advLbl) + else do + -- Step 2+3: Check scope-binding via salt + IKM components + assert "KDF info argument must be public" bInfo + ikmComponentsWithTypes <- unconcatWithTypes ikmE + let allComponents = (saltE, saltT) : ikmComponentsWithTypes + + results <- forM allComponents $ \(comp, compT) -> + classifyComponent scopeDef comp compT + + let hasLSBE = any fst results + + assert ("This KDF call isn't bound to scope '" ++ scopeName ++ + "': it must contain a name or DH secret from the scope") + hasLSBE + + forM_ (zip allComponents results) $ \((comp, _), (isLSBE, isPub)) -> + assert ("KDF call doesn't match any of its rule hints and can't be proven out of bounds, " ++ + "so all arguments must be public, but component " ++ + show (owlpretty comp) ++ + " cannot be proven public") isPub + + return $ kdfRefinement (tData advLbl advLbl) + checkCryptoOp :: CryptOp -> [(AExpr, Ty)] -> Check Ty checkCryptoOp cop args = pushRoutine ("checkCryptoOp(" ++ show (owlpretty cop) ++ ")") $ do tcs <- view tcScope @@ -2971,19 +3274,27 @@ checkCryptoOp cop args = pushRoutine ("checkCryptoOp(" ++ show (owlpretty cop) + assert ("Argument to cross_dh_lemma must flow to adv") b nt <- getNameType n assert ("Name parameter to cross_dh_lemma must be a DH name") $ (nt^.val) `aeq` NT_DH - odhs <- view $ curMod . odh - let dhCombine x y = mkSpanned $ AEApp (topLevelPath "dh_combine") [] [x, y] - let dhpk x = mkSpanned $ AEApp (topLevelPath "dhpk") [] [x] + allScopes <- view $ curMod . kdfScopes + let nStr = case n^.val of + NameConst _ (PRes (PDot _ s)) _ -> s + _ -> "" + let odhs = [ odhPair + | (_, gdef) <- allScopes + , nStr `elem` _ksdEntryNames gdef + , odhPair <- _ksdOdhPairs gdef ] + let dhCombine a b' = mkSpanned $ AEApp (topLevelPath "dh_combine") [] [a, b'] + let dhpk a = mkSpanned $ AEApp (topLevelPath "dhpk") [] [a] let pSec m = pNot $ pFlow (nameLbl m) advLbl - ps <- forM odhs $ \(_, b) -> do - ((is, ps), (n2, n3, _)) <- unbind b - p <- withIndices (map (\i -> (i, (ignore $ show i, IdxSession))) is ++ map (\i -> (i, (ignore $ show i, IdxPId))) ps) $ do + ps <- forM odhs $ \(_, bnd) -> do + (((is, pids), _dvars), (n2, n3)) <- unbind bnd + p <- withIndices (map (\i -> (i, (ignore $ show i, IdxSession))) is ++ + map (\i -> (i, (ignore $ show i, IdxPId))) pids) $ do n_disj <- liftM2 pAnd (pNot <$> pNameExpEq n n2) (pNot <$> pNameExpEq n n3) return $ pImpl (n_disj `pAnd` (pSec n)) - (pNot $ pEq (dhCombine x $ aeGet n) - (dhCombine (dhpk $ aeGet n2) (aeGet n3))) - return $ mkForallIdx (is ++ ps) p - p <- normalizeProp $ (foldr pAnd pTrue ps) + (pNot $ pEq (dhCombine x $ aeGet n) + (dhCombine (dhpk $ aeGet n2) (aeGet n3))) + return $ mkForallIdx (is ++ pids) p + p <- normalizeProp $ foldr pAnd pTrue ps return $ tLemma p CLemma (LemmaConstant) -> do assert ("Wrong number of arguments to is_constant_lemma") $ length args == 1 @@ -2993,68 +3304,35 @@ checkCryptoOp cop args = pushRoutine ("checkCryptoOp(" ++ show (owlpretty cop) + let b = isConstant x'' assert ("Argument is not a constant: " ++ show (owlpretty x'')) b return $ tRefined tUnit "._" $ mkSpanned $ PIsConstant x'' --- For CKDF: --- 0. Ensure that info is public --- 1. For the salt: --- - Ensure it matches a secret, or is public --- 2. For the IKM: --- - Split it into components --- - For each component, ensure it matches a secret, or is public --- 3. Collect the secret ann's, make sure they are consistent - -- oann1: which case of the kdf to use for kdfkey in salt position - -- oann2: which case of the kdf to use for kdfkey in ikm position (also for odh name in ikm position) - CKDF oann1 oann2 nks j -> do + CKDF hints nks j -> do assert ("KDF must take three arguments") $ length args == 3 - let [a, b, c] = args -- a == salt, b == ikm, c == info - cpub <- tyFlowsTo (snd c) advLbl -- check that info is public - apub <- tyFlowsTo (snd a) advLbl - bpub <- tyFlowsTo (snd b) advLbl - if apub && bpub && cpub then do - -- Fully corrupt case. TODO: Unify with below code. - a' <- resolveANF (fst a) - b' <- resolveANF (fst b) - c' <- resolveANF (fst c) - let kdfProp = pEq (aeVar ".res") $ mkSpanned $ AEKDF a' b' c' nks j - let outLen = nameKindLength $ nks !! j - let kdfRefinement t = tRefined t ".res" $ - pAnd - (pEq (aeLength (aeVar ".res")) outLen) - kdfProp - return $ kdfRefinement (tData advLbl advLbl) + let [(saltE, saltT), (ikmE, ikmT), (infoE, infoT)] = args + saltE' <- resolveANF saltE + ikmE' <- resolveANF ikmE + infoE' <- resolveANF infoE + checkHintOutputsCompatible hints + let kdfProp = pEq (aeVar ".res") $ mkSpanned $ AEKDF saltE' ikmE' infoE' nks j + let outLen = nameKindLength $ nks !! j + injLemmasProp <- kdfInjLemmasForScope nks j saltE' ikmE' infoE' hints + let kdfRefinement t = tRefined t ".res" $ + pAnd (pEq (aeLength (aeVar ".res")) outLen) + (pAnd kdfProp injLemmasProp) + + everythingPublic <- do + b1 <- tyFlowsTo saltT advLbl + b2 <- tyFlowsTo ikmT advLbl + b3 <- tyFlowsTo infoT advLbl + return $ b1 && b2 && b3 + if everythingPublic then + return $ kdfRefinement (tData advLbl advLbl) else do - -- Uncorrupt case - assert ("Third argument to KDF must flow to adv") cpub - kdfCaseSplits <- findGoodKDFSplits (fst a) (fst b) (fst c) oann2 j - resT <- manyCasePropTy kdfCaseSplits $ local (set tcScope $ TcGhost False) $ do - falseCase <- doAssertFalse - case falseCase of - True -> return tAdmit - False -> do - saltResult <- findValidSaltCalls a b c oann1 j nks - ikmResult <- findValidIKMCalls a b c oann2 j nks - unif <- unifyKDFCallResult [saltResult, ikmResult] - resT <- case unif of - Left False -> mkSpanned <$> enforcePublicArguments "KDF ill typed, so arguments must be public" [snd a, snd b, snd c] - Left True -> return $ tData advLbl advLbl - Right (strictness, ne) -> do - let flowAx = case strictness of - KDFStrict -> pNot $ pFlow (nameLbl ne) advLbl -- Justified since one of the keys must be secret - KDFPub -> pFlow (nameLbl ne) advLbl - KDFUnstrict -> pTrue - return $ mkSpanned $ TRefined (tName ne) ".res" $ bind (s2n ".res") $ - flowAx - kdfProp <- do - a' <- resolveANF (fst a) - b' <- resolveANF (fst b) - c' <- resolveANF (fst c) - return $ pEq (aeVar ".res") $ mkSpanned $ AEKDF a' b' c' nks j - let outLen = nameKindLength $ nks !! j - let kdfRefinement t = tRefined t ".res" $ - pAnd - (pEq (aeLength (aeVar ".res")) outLen) - kdfProp - return $ kdfRefinement resT - normalizeTy resT + resultsWithHints <- local (set tcScope $ TcGhost False) $ catMaybes <$> mapM (\h -> fmap (\t -> (h, t)) <$> tryKDFRuleHint h (saltE', saltT) (ikmE', ikmT) (infoE', infoT) nks j) hints + case resultsWithHints of + [] -> local (set tcScope $ TcGhost False) $ handleKDFNoMatch hints (saltE', saltT) (ikmE', ikmT) (infoE', infoT) kdfRefinement + [(_, t)] -> return $ kdfRefinement t + matched -> + typeError ("Ambiguous KDF call: multiple hints matched: " ++ + L.intercalate ", " (map (_ksrrLabel . fst) matched)) CAEnc -> do assert ("Wrong number of arguments to encryption") $ length args == 2 let [(_, t1), (x, t)] = args @@ -3208,39 +3486,6 @@ checkCryptoOp cop args = pushRoutine ("checkCryptoOp(" ++ show (owlpretty cop) + else mkSpanned <$> enforcePublicArgumentsOption "sig vrfy ill-typed, so arguments must be public" [t1, t2, t3] _ -> typeError $ show $ ErrWrongNameType k "sig" nt --- Find all names that appear in any of the arguments to the KDF, as well as any --- DH pairs that appear in the ODH annotation. --- Return a list of props for whether each of the above names flows to the adv. -findGoodKDFSplits :: AExpr -> AExpr -> AExpr -> [Either a (String, ([Idx], [Idx]), KDFSelector)] -> Int -> Check [Prop] -findGoodKDFSplits a b c oann2 j = local (set tcScope $ TcGhost False) $ do - names1 <- do - t <- inferAExpr a - case (stripRefinements t)^.val of - TName n -> return [n] - TSS n m -> return [n, m] - _ -> return [] - names2 <- do - bs <- unconcat b - ts <- mapM (inferAExpr >=> normalizeTy) bs - ps <- forM (zip bs ts) $ \(x, t) -> - case (stripRefinements t)^.val of - TName n -> return [n] - TSS n m -> return [n, m] - _ -> do - o <- getLocalDHComputation x - case o of - Nothing -> return [] - Just (_, n) -> return [n] - return $ concat ps - names3 <- forM oann2 $ \o -> do - case o of - Left _ -> return [] - Right (s, ips, i) -> do - pth <- curModName - (ne1, ne2, p, str_nts) <- getODHNameInfo (PRes (PDot pth s)) ips a b c i j - return [ne1, ne2] - return $ map (\n -> pFlow (nameLbl n) advLbl) $ aundup $ names1 ++ names2 ++ (concat names3) - aundup :: Alpha a => [a] -> [a] aundup [] = [] aundup (x:xs) = if x `aelem` xs then aundup xs else x : aundup xs @@ -3413,17 +3658,18 @@ typeError' msg = do local (set inTypeError True) $ (removeAnfVars <$> view tyContext) >>= normalizeTyContext let rep = E.Err Nothing msg [(pos, E.This msg)] info let diag = E.addFile (E.addReport def rep) (fn) f - liftIO $ putDoc $ owlpretty "Type context" <> line <> pretty "===================" <> line <> owlprettyTyContext tyc <> line <> pretty "====================" <> line + liftPutDoc $ owlpretty "Type context" <> line <> pretty "===================" <> line <> owlprettyTyContext tyc <> line <> pretty "====================" <> line e <- ask - E.printDiagnostic S.stdout True True 4 E.defaultStyle diag + noColor <- view $ envFlags . fNoColor + E.printDiagnostic S.stdout True (not noColor) 4 E.defaultStyle diag pc <- view pathCondition case pc of [] -> return () - _ -> liftIO $ putDoc $ owlpretty "Path condition: " <> list (map owlpretty pc) <> line + _ -> liftPutDoc $ owlpretty "Path condition: " <> list (map owlpretty pc) <> line writeSMTCache -- Uncomment for debugging - -- rs <- view tcRoutineStack - -- logTypecheck $ owlpretty "Routines: " <> (mconcat $ L.intersperse (owlpretty ", ") $ map owlpretty rs) + rs <- view tcRoutineStack + logTypecheck $ owlpretty "Routines: " <> (mconcat $ L.intersperse (owlpretty ", ") $ map owlpretty rs) -- inds <- view inScopeIndices - -- logTypecheck $ "Indices: " ++ show (owlprettyIndices inds) + -- logTypecheck $ owlpretty "Indices: " <> owlprettyIndices inds Check $ lift $ throwError e diff --git a/src/TypingBase.hs b/src/TypingBase.hs index 726eb9c0..2d7d634b 100644 --- a/src/TypingBase.hs +++ b/src/TypingBase.hs @@ -131,7 +131,7 @@ instance Alpha CorrConstraint instance Subst Idx CorrConstraint instance Subst ResolvedPath CorrConstraint -data ModBody = ModBody { +data ModBody = ModBody { _isModuleType :: IsModuleType, _localities :: Map String (Either Int ResolvedPath), -- left is arity; right is if it's a synonym _defs :: Map String Def, @@ -140,7 +140,7 @@ data ModBody = ModBody { _predicates :: Map String (Bind ([IdxVar], [DataVar]) Prop), _advCorrConstraints :: [Bind ([IdxVar], [DataVar]) CorrConstraint], _tyDefs :: Map TyVar TyDef, - _odh :: Map String (Bind ([IdxVar], [IdxVar]) (NameExp, NameExp, KDFBody)), + _kdfScopes :: Map String KDFScopeDef, _nameTypeDefs :: Map String (Bind (([IdxVar], [IdxVar]), [DataVar]) NameType), _userFuncs :: Map String UserFunc, _nameDefs :: Map String (Bind ([IdxVar], [IdxVar]) NameDef), @@ -149,6 +149,26 @@ data ModBody = ModBody { } deriving (Show, Generic, Typeable) +data KDFScopeDef = KDFScopeDef { + _ksdRules :: Map String (Bind (([IdxVar], [IdxVar]), [DataVar]) KDFScopeRuleBody), + _ksdOdhPairs :: [(String, Bind (([IdxVar], [IdxVar]), [DataVar]) (NameExp, NameExp))], + _ksdEntryNames :: [String] -- names (DH + kdfkey) declared in this scope +} + deriving (Show, Generic, Typeable) + +instance Alpha KDFScopeDef +instance Subst ResolvedPath KDFScopeDef +instance Subst Idx KDFScopeDef + +-- Accumulator threaded through checkDecl while inside a kdf_scope block +data KDFScopeState = KDFScopeState + { _kssGroupName :: String + , _kssKdfKeyNames :: [String] + , _kssDHNames :: [String] + , _kssRules :: Map String (Bind (([IdxVar], [IdxVar]), [DataVar]) KDFScopeRuleBody) + , _kssOdhPairs :: [(String, Bind (([IdxVar], [IdxVar]), [DataVar]) (NameExp, NameExp))] + } + instance Alpha ModBody instance Subst ResolvedPath ModBody @@ -193,6 +213,7 @@ data Env senv = Env { _normalizePropHook :: Prop -> Check' senv Prop, _decidePropHook :: Prop -> Check' senv (Maybe Bool), _curDef :: Maybe String, + _curKDFScope :: Maybe KDFScopeState, _tcRoutineStack :: [String], _inTypeError :: Bool, _inSMT :: Bool, @@ -243,7 +264,10 @@ instance OwlPretty (TypeError) where owlpretty (ErrWrongCases s a expected actual) = owlpretty "Wrong cases for " <> owlpretty s <> owlpretty " with " <> owlpretty a <> owlpretty " expected " <> owlpretty (map fst expected) <> owlpretty " but got " <> owlpretty (map fst actual) owlpretty (ErrAssertionFailed fn p) = - owlpretty "Assertion failed: " <> owlpretty p <> owlpretty " from " <> owlpretty fn + owlpretty "Assertion failed: " <> owlpretty p <> + case fn of + Just fn -> owlpretty " from " <> owlpretty fn + Nothing -> owlpretty "" owlpretty (ErrUnknownName s) = owlpretty "Unknown name: " <> owlpretty s owlpretty (ErrUnknownFunc s) = @@ -277,6 +301,8 @@ makeLenses ''MemoEntry makeLenses ''Env makeLenses ''ModBody +makeLenses ''KDFScopeDef +makeLenses ''KDFScopeState modDefKind :: ModDef -> Check' senv IsModuleType modDefKind (MBody xd) = @@ -600,28 +626,9 @@ checkCounterIsLocal p0@(PRes (PDot p s)) (vs1, vs2) = do assert ("Wrong locality for counter") $ l1' `aeq` l2' Nothing -> typeError $ "Unknown counter: " ++ show p0 -inKDFBody :: KDFBody -> AExpr -> AExpr -> AExpr -> Check' senv Prop -inKDFBody kdfBody salt info self = do - (((sx, x), (sy, y), (sz, z)), cases') <- unbind kdfBody - let cases = subst x salt $ subst y info $ subst z self $ cases' - bs <- forM cases $ \bcase -> do - (xs, (p, _)) <- unbind bcase - return $ mkExistsIdx xs p - return $ foldr pOr pFalse bs - +-- inODHProp: stub returning False; ODH checking now done via tryKDFRuleHint in Typing.hs inODHProp :: AExpr -> AExpr -> AExpr -> Check' senv Prop -inODHProp salt ikm info = do - let dhCombine x y = mkSpanned $ AEApp (topLevelPath "dh_combine") [] [x, y] - let dhpk x = mkSpanned $ AEApp (topLevelPath "dhpk") [] [x] - cur_odh <- view $ curMod . odh - ps <- forM cur_odh $ \(_, bnd2) -> do - ((is, ps), (ne1, ne2, kdfBody)) <- unbind bnd2 - let pd1 = pEq ikm (dhCombine (dhpk $ mkSpanned $ AEGet ne1) - (mkSpanned $ AEGet ne2) - ) - pd2 <- inKDFBody kdfBody salt info ikm - return $ mkExistsIdx (is ++ ps) $ pd1 `pAnd` pd2 - return $ foldr pOr pFalse ps +inODHProp salt ikm info = return pFalse --getROStrictness :: NameExp -> Check' senv ROStrictness --getROStrictness ne = @@ -675,19 +682,7 @@ normalizeNameType :: NameType -> Check' senv NameType normalizeNameType nt = pushRoutine "normalizeNameType" $ case nt^.val of NT_App p is as -> resolveNameTypeApp p is as >>= normalizeNameType - NT_KDF pos bcases -> do - (((sx, x), (sy, y), (sz, z)), cases) <- unbind bcases - cases' <- withVars - [(x, (ignore sx, Nothing, tGhost)), - (y, (ignore sy, Nothing, tGhost)), - (z, (ignore sz, Nothing, tGhost))] $ forM cases $ \bcase -> do - (is, (p, nts)) <- unbind bcase - withIndices (map (\i -> (i, (ignore $ show i, IdxGhost))) is) $ do - nts' <- forM nts $ \(str, nt) -> do - nt' <- normalizeNameType nt - return (str, nt') - return $ bind is (p, nts') - return $ Spanned (nt^.spanOf) $ NT_KDF pos (bind ((sx, x), (sy, y), (sz, z)) cases') + NT_KDF -> return nt -- bare kdfkey, no cases to normalize _ -> return nt pushRoutine :: MonadReader (Env senv) m => String -> m a -> m a @@ -723,39 +718,69 @@ getNameInfo = withMemoize (memogetNameInfo) $ \ne -> pushRoutine "getNameInfo" $ BaseDef (nt, lcls) -> do assert ("Value parameters not allowed for base names") $ length as == 0 return $ Just (nt, Just (PDot p n, lcls)) - KDFName a b c nks j nt ib -> do - _ <- local (set tcScope $ TcGhost False) $ mapM inferAExpr [a, b, c] - when (not $ unignore ib) $ do - nth <- view checkNameTypeHook - nth nt - assert ("Name kind row index out of scope") $ j < length nks - return $ Just (nt, Nothing) + KDFName nks j ib ref -> do + mBody <- lookupKDFScopeRule (_ksrrLabel ref) (_ksrrIdxs ref) (_ksrrArgs ref) + case mBody of + Nothing -> typeError $ "Unknown KDF group rule in name type: " ++ _ksrrLabel ref + Just body -> do + let KDFOutputSpec outputs = _ksrbOutput body + unless (unignore ib) $ do + assert ("KDF name kinds length mismatch for rule " ++ _ksrrLabel ref ++ + ": annotation has " ++ show (length nks) ++ + " output(s), rule declares " ++ show (length outputs)) + (length nks == length outputs) + expectedNks <- mapM (\(_, outNt') -> getNameKind outNt') outputs + assert ("KDF name kinds mismatch for rule " ++ _ksrrLabel ref ++ + ": annotation has " ++ show (owlpretty (NameKindRow nks)) ++ + ", rule declares " ++ show (owlpretty (NameKindRow expectedNks))) + (nks == expectedNks) + assert "Name kind row index out of scope" $ j < length nks + assert "KDF j out of scope for rule outputs" $ j < length outputs + let (_, outNt) = outputs !! j + unless (unignore ib) $ do + nth <- view checkNameTypeHook + nth outNt + return $ Just (outNt, Nothing) case res of Nothing -> return Nothing Just (nt, lcls) -> do nt' <- normalizeNameType nt return $ Just (nt', lcls) -getODHNameInfo :: Path -> ([Idx], [Idx]) -> AExpr -> AExpr -> AExpr -> KDFSelector -> Int -> Check' senv (NameExp, NameExp, Prop, [(KDFStrictness, NameType)]) -getODHNameInfo (PRes (PDot p s)) (is, ps) a ikm c (i, is_case) j = do - mapM_ checkIdxSession is - mapM_ checkIdxPId ps - mapM_ inferIdx is_case - md <- openModule p - case lookup s (md^.odh) of - Nothing -> typeError $ "Unknown ODH handle: " ++ show s - Just bd -> do - ((ixs, pxs), bdy) <- unbind bd - assert ("KDF index arity mismatch") $ (length ixs, length pxs) == (length is, length ps) - let (ne1, ne2, kdfBody) = substs (zip ixs is) $ substs (zip pxs ps) $ bdy - (((sx, x), (sy, y), (sz, z)), cases) <- unbind kdfBody - assert ("Number of KDF case mismatch") $ i < length cases - let bpcases = subst x a $ subst y c $ subst z ikm $ cases !! i - (xs_case, pcases') <- unbind bpcases - assert ("KDF case index arity mismatch") $ length xs_case == length is_case - let (p, cases') = substs (zip xs_case is_case) pcases' - assert ("KDF name row mismatch") $ j < length cases' - return (ne1, ne2, p, cases') +lookupKDFScopeRule :: String -> ([Idx], [Idx]) -> [AExpr] -> Check' senv (Maybe KDFScopeRuleBody) +lookupKDFScopeRule lbl (vs1, vs2) actuals = do + kgs <- view (curMod . kdfScopes) + let findInGroups [] = return Nothing + findInGroups ((_, gdef):rest) = + case lookup lbl (gdef^.ksdRules) of + Nothing -> findInGroups rest + Just bRule -> do + (((is1, is2), dvars), body) <- unbind bRule + when ((length vs1, length vs2) /= (length is1, length is2)) $ + typeError $ "Index arity mismatch for KDF scope rule " ++ show lbl ++ + ": expected (" ++ show (length is1) ++ ", " ++ show (length is2) ++ + ") indices but got (" ++ show (length vs1) ++ ", " ++ show (length vs2) ++ ")" + when (length dvars /= length actuals) $ + typeError $ "Bytestring argument arity mismatch for KDF scope rule " ++ show lbl ++ + ": expected " ++ show (length dvars) ++ + " arguments but got " ++ show (length actuals) + return $ Just + $ substs (zip dvars actuals) + $ substs (zip is1 vs1) + $ substs (zip is2 vs2) body + findInGroups kgs + + +findScopeForLabel :: String -> Check' senv (Maybe (String, KDFScopeDef)) +findScopeForLabel lbl = do + kgs <- view (curMod . kdfScopes) + return $ go kgs + where + go [] = Nothing + go ((gname, gdef):rest) = + case lookup lbl (_ksdRules gdef) of + Just _ -> Just (gname, gdef) + Nothing -> go rest getNameKind :: NameType -> Check' senv NameKind @@ -769,7 +794,7 @@ getNameKind nt = NT_PKE _ -> return $ NK_PKE NT_MAC _ -> return $ NK_MAC NT_App p ps as -> resolveNameTypeApp p ps as >>= getNameKind - NT_KDF _ _ -> return $ NK_KDF + NT_KDF -> return $ NK_KDF resolveNameTypeApp :: Path -> ([Idx], [Idx]) -> [AExpr] -> Check' senv NameType resolveNameTypeApp pth@(PRes (PDot p s)) (is, ps) as = do @@ -820,13 +845,18 @@ withPushLog k = do popLogTypecheckScope return r +liftPutDoc :: OwlDoc -> Check' senv () +liftPutDoc doc = do + noColor <- view $ envFlags . fNoColor + liftIO $ if noColor then putDoc (unAnnotate doc) else putDoc doc + logTypecheck :: OwlDoc -> Check' senv () logTypecheck s = do b <- view $ envFlags . fLogTypecheck when b $ do r <- view $ typeCheckLogDepth n <- liftIO $ readIORef r - liftIO $ putDoc $ owlpretty (replicate (n*2) ' ') <> align s <> line + liftPutDoc $ owlpretty (replicate (n*2) ' ') <> align s <> line bd <- view $ envFlags . fDebug case bd of Just fname -> do @@ -895,12 +925,12 @@ lenConstOfUniformName ne = do NT_Enc _ -> return $ mkSpanned $ AELenConst "enckey" NT_StAEAD _ _ _ _ -> return $ mkSpanned $ AELenConst "enckey" NT_MAC _ -> return $ mkSpanned $ AELenConst "mackey" - NT_KDF _ _ -> return $ mkSpanned $ AELenConst "kdfkey" + NT_KDF -> return $ mkSpanned $ AELenConst "kdfkey" NT_App p ps as -> resolveNameTypeApp p ps as >>= go _ -> typeError $ "Name not uniform: " ++ show (owlpretty ne) normalizeAExpr :: AExpr -> Check' senv AExpr -normalizeAExpr ae = pushRoutine "normalizeAExpr" $ withSpan (ae^.spanOf) $ +normalizeAExpr ae = pushRoutine ("normalizeAExpr " ++ show (owlpretty ae)) $ withSpan (ae^.spanOf) $ case ae^.val of AEVar _ _ -> return ae AEHex _ -> return ae @@ -1090,6 +1120,7 @@ getStructParams ps = getFunDefParams :: [FuncParam] -> Check' senv ([Idx], [Idx]) getFunDefParams [] = return ([], []) getFunDefParams (p:ps) = + pushRoutine ("getFunDefParams " ++ show (owlpretty p)) $ do case p of ParamIdx i oann -> do t <- inferIdx i @@ -1113,9 +1144,10 @@ extractFunDef :: Bind (([IdxVar], [IdxVar]), [DataVar]) AExpr -> [FuncParam] -> extractFunDef b ps as = do (is, ps) <- getFunDefParams ps (((ixs, pxs), xs), a) <- unbind b - assert ("Wrong index arity for fun def") $ (length ixs, length pxs) == (length is, length ps) - assert ("Wrong arity for fun def") $ length xs == length as - return $ substs (zip ixs is) $ substs (zip pxs ps) $ substs (zip xs as) a + pushRoutine ("extractFunDef " ++ show (owlpretty ((ixs, pxs), xs), a)) $ do + assert ("Wrong index arity for fun def") $ (length ixs, length pxs) == (length is, length ps) + assert ("Wrong arity for fun def") $ length xs == length as + return $ substs (zip ixs is) $ substs (zip pxs ps) $ substs (zip xs as) a extractAAD :: NameExp -> AExpr -> Check' senv Prop extractAAD ne a = do @@ -1304,7 +1336,7 @@ owlprettyContext e = -- _ -> return False normalizeNameExp :: NameExp -> Check' senv NameExp -normalizeNameExp ne = +normalizeNameExp ne = pushRoutine "normalizeNameExp" $ case ne^.val of NameConst (vs1, vs2) pth@(PRes (PDot p n)) as -> do md <- openModule p @@ -1319,12 +1351,8 @@ normalizeNameExp ne = assert ("Wrong arity") $ length xs == length as normalizeNameExp $ substs (zip xs as) ne2 _ -> return ne - KDFName a b c nks j nt ib -> do - a' <- resolveANF a >>= normalizeAExpr - b' <- resolveANF b >>= normalizeAExpr - c' <- resolveANF c >>= normalizeAExpr - nt' <- normalizeNameType nt - return $ Spanned (ne^.spanOf) $ KDFName a' b' c' nks j nt' ib + KDFName nks j ib ref -> return ne + _ -> error ("Not normalizing name exp: " ++ show (owlpretty ne)) -- Traversing modules to collect global info @@ -1394,6 +1422,10 @@ collectEnvAxioms f = do collectNameDefs :: Check' senv (Map ResolvedPath (Bind ([IdxVar], [IdxVar]) NameDef)) collectNameDefs = collectEnvInfo (_nameDefs) +collectKDFScopeRules :: Check' senv [(String, Bind (([IdxVar], [IdxVar]), [DataVar]) KDFScopeRuleBody)] +collectKDFScopeRules = collectEnvAxioms $ \mb -> + concatMap (\(_, gdef) -> _ksdRules gdef) (_kdfScopes mb) + collectFlowAxioms :: Check' senv ([(Label, Label)]) collectFlowAxioms = collectEnvAxioms (_flowAxioms) @@ -1482,7 +1514,7 @@ normResolvedPath p = normModulePath p normalizePath :: Path -> Check' senv Path normalizePath (PRes p) = PRes <$> normResolvedPath p -normalizePath _ = error "normalizePath: unresolved path" +normalizePath p = error $ "normalizePath: unresolved path: " ++ show p getModDefFVs :: ModDef -> [Name ResolvedPath] getModDefFVs = toListOf fv @@ -1649,13 +1681,11 @@ stripNameExp x e = typeError $ "Cannot remove " ++ show x ++ " from the scope of " ++ show (owlpretty e) else return e - KDFName a b c nks j nt ib -> do - a' <- resolveANF a - b' <- resolveANF b - c' <- resolveANF c - if x `elem` (getAExprDataVars a' ++ getAExprDataVars b' ++ getAExprDataVars c' ++ toListOf fv nt) then + KDFName nks j ib ref -> do + outNt <- getNameType e + if x `elem` toListOf fv outNt then typeError $ "Cannot remove " ++ show x ++ " from the scope of " ++ show (owlpretty e) - else return $ Spanned (e^.spanOf) $ KDFName a' b' c' nks j nt ib + else return $ Spanned (e^.spanOf) $ KDFName nks j ib ref stripLabel :: DataVar -> Label -> Check' senv Label stripLabel x l = return l diff --git a/tests/failure/kdf-hints-incompatible-nks.owl b/tests/failure/kdf-hints-incompatible-nks.owl new file mode 100644 index 00000000..25b71e5f --- /dev/null +++ b/tests/failure/kdf-hints-incompatible-nks.owl @@ -0,0 +1,17 @@ +locality alice + +name n : nonce @ alice + +kdf_scope G { + name k : kdfkey @ alice + + // L1 outputs nonce || kdfkey + kdf L1 : k, 0x, 0x01 -> nonce || strict kdfkey + // L2 outputs nonce || nonce + kdf L2 : k, 0x, 0x02 -> nonce || nonce +} + +def alice_main() @ alice : Unit = + // SHOULD FAIL: L1 and L2 have incompatible output namekinds + let x = kdf(get(k), 0x, 0x01) in + () diff --git a/tests/failure/kdf-rule-outside-scope.owl b/tests/failure/kdf-rule-outside-scope.owl new file mode 100644 index 00000000..3967d96c --- /dev/null +++ b/tests/failure/kdf-rule-outside-scope.owl @@ -0,0 +1,7 @@ +locality alice + +name k : kdfkey @ alice +name n : nonce @ alice + +// SHOULD FAIL: kdf/odh rules must be inside a kdf_scope block +kdf L1 : k, 0x, 0x01 -> enckey Name(n) diff --git a/tests/failure/kdf-scope-cross-scope-dh.owl b/tests/failure/kdf-scope-cross-scope-dh.owl new file mode 100644 index 00000000..03acf8cb --- /dev/null +++ b/tests/failure/kdf-scope-cross-scope-dh.owl @@ -0,0 +1,20 @@ +locality alice + +name d : nonce @ alice + +// G2 must come first so Y is in scope during path resolution of G1's rules +kdf_scope G2 { + name Y : DH @ alice +} + +kdf_scope G1 { + name X : DH @ alice + + // SHOULD FAIL: Y is a DH key from G2, not G1. + // dh_combine in an ODH rule requires both arguments to be local DH keys + // of the same group. + odh L : 0x, dh_ss(X, Y), 0x -> enckey Name(d) +} + +corr [X] ==> [d] +corr [Y] ==> [d] diff --git a/tests/failure/kdf-scope-def-inside.owl b/tests/failure/kdf-scope-def-inside.owl new file mode 100644 index 00000000..10f300c7 --- /dev/null +++ b/tests/failure/kdf-scope-def-inside.owl @@ -0,0 +1,12 @@ +locality alice + +name n : nonce @ alice + +kdf_scope G { + name k : kdfkey @ alice + + // SHOULD FAIL: def declarations not allowed inside kdf_scope + def helper() @ alice : Unit = () + + kdf L1 : k, 0x, 0x01 -> enckey Name(n) +} diff --git a/tests/failure/kdf-scope-dup-sii.owl b/tests/failure/kdf-scope-dup-sii.owl new file mode 100644 index 00000000..9ffaa3bb --- /dev/null +++ b/tests/failure/kdf-scope-dup-sii.owl @@ -0,0 +1,11 @@ +locality alice + +name n : nonce @ alice + +kdf_scope G { + name k : kdfkey @ alice + + // SHOULD FAIL: two rules with identical (salt, ikm, info) are ambiguous + kdf L1 : k, 0x, 0x -> enckey Name(n) + kdf L2 : k, 0x, 0x -> enckey Name(n) +} diff --git a/tests/failure/kdf-scope-no-secret.owl b/tests/failure/kdf-scope-no-secret.owl new file mode 100644 index 00000000..d3eba622 --- /dev/null +++ b/tests/failure/kdf-scope-no-secret.owl @@ -0,0 +1,12 @@ +locality alice + +name n : nonce @ alice + +kdf_scope G { + name k : kdfkey @ alice + + // SHOULD FAIL (constraint 1): salt and IKM are all public literals, + // so no kdfkey from the group appears anywhere, and there is no + // dh_combine with a local DH key. + kdf L : 0x, 0x, 0x -> enckey Name(n) +} diff --git a/tests/failure/kdf-scope-nonuniform-output.owl b/tests/failure/kdf-scope-nonuniform-output.owl new file mode 100644 index 00000000..37a61e9f --- /dev/null +++ b/tests/failure/kdf-scope-nonuniform-output.owl @@ -0,0 +1,8 @@ +locality alice + +kdf_scope G { + name k : kdfkey @ alice + + // SHOULD FAIL: DH is not a uniform name type, so this output is rejected + kdf L : k, 0x, 0x -> DH +} diff --git a/tests/failure/kdf-scope-repeated-name.owl b/tests/failure/kdf-scope-repeated-name.owl new file mode 100644 index 00000000..307606e0 --- /dev/null +++ b/tests/failure/kdf-scope-repeated-name.owl @@ -0,0 +1,19 @@ +locality alice +locality bob + +name alice1 : nonce @ alice +name alice2 : nonce @ alice +name alice3 : nonce @ alice + +kdf_scope G { + name alice1 : kdfkey @ alice // SHOULD FAIL: identifier reused + + name k : kdfkey @ alice, bob + + kdf L1_enc : k, 0x, 0x01 -> enckey Name(alice1) + kdf L1_kdf : k, 0x, 0x02 -> strict kdfkey + kdf L2_enc : 0x, KDF, 0x01 -> enckey Name(alice2) + kdf L2_kdf : 0x, KDF, 0x02 -> strict kdfkey + kdf L3_enc : KDF, 0x, 0x01 -> enckey Name(alice3) + +} diff --git a/tests/failure/kdf-scope-self-disjoint-ikm.owl b/tests/failure/kdf-scope-self-disjoint-ikm.owl new file mode 100644 index 00000000..cbfc2f6f --- /dev/null +++ b/tests/failure/kdf-scope-self-disjoint-ikm.owl @@ -0,0 +1,11 @@ +locality alice + +name n : nonce @ alice + +kdf_scope G { + name k : kdfkey @ alice + + // SHOULD FAIL: a ++ b in ikm is untagged concat, so + // (a=0x12, b=0x34) and (a=0x1234, b=0x) produce the same ikm = 0x1234 + kdf L(a, b) : k, a ++ b, 0x -> enckey Name(n) +} diff --git a/tests/failure/kdf-scope-self-disjoint-info.owl b/tests/failure/kdf-scope-self-disjoint-info.owl new file mode 100644 index 00000000..637ff7e7 --- /dev/null +++ b/tests/failure/kdf-scope-self-disjoint-info.owl @@ -0,0 +1,11 @@ +locality alice + +name n : nonce @ alice + +kdf_scope G { + name k : kdfkey @ alice + + // SHOULD FAIL: a ++ b in info is untagged concat, so + // (a=0x12, b=0x34) and (a=0x1234, b=0x) produce the same info = 0x1234 + kdf L(a, b) : k, 0x, a ++ b -> enckey Name(n) +} diff --git a/tests/failure/kdf-scope-unused-dvar.owl b/tests/failure/kdf-scope-unused-dvar.owl new file mode 100644 index 00000000..fbd30069 --- /dev/null +++ b/tests/failure/kdf-scope-unused-dvar.owl @@ -0,0 +1,11 @@ +locality alice + +name n : nonce @ alice + +kdf_scope G { + name k : kdfkey @ alice + + // SHOULD FAIL (constraint 3): bytestring parameter x does not appear + // anywhere in the salt, IKM, or info. + kdf L(x) : k, 0x, 0x -> enckey Name(n) +} diff --git a/tests/failure/kdf-scope-unused-idx.owl b/tests/failure/kdf-scope-unused-idx.owl new file mode 100644 index 00000000..fd0ba0a6 --- /dev/null +++ b/tests/failure/kdf-scope-unused-idx.owl @@ -0,0 +1,11 @@ +locality alice + +name n : nonce @ alice + +kdf_scope G { + name k : kdfkey @ alice + + // SHOULD FAIL (constraint 2): index parameters i (session) and p (PId) + // do not appear anywhere in the salt, IKM, or info. + kdf L : k, 0x, 0x -> enckey Name(n) +} diff --git a/tests/failure/kdf-scope-wrong-ikm.owl b/tests/failure/kdf-scope-wrong-ikm.owl new file mode 100644 index 00000000..5a50e4b0 --- /dev/null +++ b/tests/failure/kdf-scope-wrong-ikm.owl @@ -0,0 +1,19 @@ +locality alice + +name d : nonce @ alice + +kdf_scope G { + name k : kdfkey @ alice + name k2 : kdfkey @ alice + + // Rule expects k in the IKM position + kdf L : 0x, k, 0x -> enckey Name(d) +} + +def main() @ alice : Unit = + // SHOULD FAIL: k2 does not match k in the ikm position, so + // kdf(0x, get(k2), 0x) produces Data. + // Using Data as an encryption key for a secret nonce fails. + let ek = kdf(0x, get(k2), 0x) in + let c = aenc(ek, get(d)) in + output c diff --git a/tests/failure/kdf-scope-wrong-odh.owl b/tests/failure/kdf-scope-wrong-odh.owl new file mode 100644 index 00000000..43c5f8c9 --- /dev/null +++ b/tests/failure/kdf-scope-wrong-odh.owl @@ -0,0 +1,24 @@ +locality alice + +name d : nonce @ alice + +kdf_scope G { + name X : DH @ alice + name X2 : DH @ alice + name Y : DH @ alice + + // Rule expects dh_ss(X, Y) in the IKM position + odh L : 0x, dh_ss(X, Y), 0x -> enckey Name(d) +} + +corr [X] ==> [d] +corr [Y] ==> [d] + +def main() @ alice : Unit = + // SHOULD FAIL: X2 != X, so dh_combine(dhpk(get(X2)), get(Y)) does not match + // dh_ss(X, Y). The KDF call produces Data, which cannot be used + // as an encryption key for a secret nonce. + let ss = dh_combine(dhpk(get(X2)), get(Y)) in + let ek = kdf(0x, ss, 0x) in + let c = aenc(ek, get(d)) in + output c diff --git a/tests/failure/kdf-scope-wrong-salt.owl b/tests/failure/kdf-scope-wrong-salt.owl new file mode 100644 index 00000000..3f0d10ff --- /dev/null +++ b/tests/failure/kdf-scope-wrong-salt.owl @@ -0,0 +1,20 @@ +locality alice + +name d : nonce @ alice + +kdf_scope G { + name k : kdfkey @ alice + name k2 : kdfkey @ alice + + // Rule expects k in the salt position + kdf L : k, 0x, 0x -> enckey Name(d) +} + +def main() @ alice : Unit = + // SHOULD FAIL: k2 does not match k in the salt position, so + // kdf(get(k2), 0x, 0x) produces Data. + // Using Data as an encryption key for a secret nonce fails. + let ek = kdf(get(k2), 0x, 0x) in + debug printTyOf(ek); + let c = aenc(ek, get(d)) in + output c diff --git a/tests/failure/kdf-wrong-nks-annotation.owl b/tests/failure/kdf-wrong-nks-annotation.owl new file mode 100644 index 00000000..7070ea80 --- /dev/null +++ b/tests/failure/kdf-wrong-nks-annotation.owl @@ -0,0 +1,14 @@ +locality alice + +name n : nonce @ alice + +kdf_scope G { + name k : kdfkey @ alice + + // Rule L1 declares a single kdfkey output + kdf L1 : k, 0x, 0x01 -> strict kdfkey +} + +// SHOULD FAIL: return type says SecName(KDF) but L1 declares kdfkey output +def alice_main() @ alice : SecName(KDF) = + kdf(get(k), 0x, 0x01) diff --git a/tests/failure/kdf-wrong-nks-count.owl b/tests/failure/kdf-wrong-nks-count.owl new file mode 100644 index 00000000..48cc4c3a --- /dev/null +++ b/tests/failure/kdf-wrong-nks-count.owl @@ -0,0 +1,15 @@ +locality alice + +name n : nonce @ alice + +kdf_scope G { + name k : kdfkey @ alice + + // Rule has a single output (kdfkey) + kdf L : k, 0x, 0x -> strict kdfkey +} + +def alice_main() @ alice : Unit = + // SHOULD FAIL: rule L declares 1 output, but name kinds list has 2 + let x = kdf(get(k), 0x, 0x) in + () diff --git a/tests/failure/kdf-wrong-nks-kind.owl b/tests/failure/kdf-wrong-nks-kind.owl new file mode 100644 index 00000000..e61b08db --- /dev/null +++ b/tests/failure/kdf-wrong-nks-kind.owl @@ -0,0 +1,15 @@ +locality alice + +name n : nonce @ alice + +kdf_scope G { + name k : kdfkey @ alice + + // Rule declares an enckey output + kdf L : k, 0x, 0x01 -> enckey Name(n) +} + +def alice_main() @ alice : Unit = + // SHOULD FAIL: rule L declares enckey output, but name kinds says kdfkey + let x = kdf(get(k), 0x, 0x01) in + () diff --git a/tests/failure/odh_concat_dh_inconclusive.owl b/tests/failure/odh_concat_dh_inconclusive.owl new file mode 100644 index 00000000..071ee860 --- /dev/null +++ b/tests/failure/odh_concat_dh_inconclusive.owl @@ -0,0 +1,33 @@ +locality alice + +kdf_scope G { + + name A : DH @ alice + name B : DH @ alice + name C : DH @ alice + name D : DH @ alice + + odh L : 0x, dh_ss(A, B) ++ dh_ss(C, D), 0x -> strict enckey Data |0| + +} + + +def main() @ alice : Option Unit = + // corr_case A in + // corr_case B in + // corr_case C in + // corr_case D in + // assume(sec(A) /\ sec(B) /\ corr(C) /\ corr(D)); // This is one of the "interesting" cases + input pk_of_A in + input pk_of_C in + guard is_group_elem(pk_of_A) in + guard is_group_elem(pk_of_C) in + // Without the below case-splitting, we can't decide for sure whether or not the adversary-supplied + // group elements are indeed the public keys for A and C, so we don't know whether rule L applies or not + // pcase (pk_of_A == dhpk(get(A))) in + // pcase (pk_of_C == dhpk(get(C))) in + let k = kdf(0x, dh_combine(pk_of_A, get(B)) ++ dh_combine(pk_of_C, get(D)), 0x) in + let c = aenc(k, 0x) in + debug printTyOf(k); + output c; + Some(()) diff --git a/tests/parse/kdf_scope/basic_dh_name.owl b/tests/parse/kdf_scope/basic_dh_name.owl new file mode 100644 index 00000000..435dbfc3 --- /dev/null +++ b/tests/parse/kdf_scope/basic_dh_name.owl @@ -0,0 +1,7 @@ +// Tests: name N : DH @ loc inside kdf_scope + +locality alice + +kdf_scope G { + name A : DH @ alice +} diff --git a/tests/parse/kdf_scope/basic_kdfkey_name.owl b/tests/parse/kdf_scope/basic_kdfkey_name.owl new file mode 100644 index 00000000..c01ab54f --- /dev/null +++ b/tests/parse/kdf_scope/basic_kdfkey_name.owl @@ -0,0 +1,7 @@ +// Tests: name psk : kdfkey inside kdf_scope + +locality alice + +kdf_scope G { + name psk : kdfkey @ alice +} diff --git a/tests/parse/kdf_scope/basic_nametype.owl b/tests/parse/kdf_scope/basic_nametype.owl new file mode 100644 index 00000000..c192f3d8 --- /dev/null +++ b/tests/parse/kdf_scope/basic_nametype.owl @@ -0,0 +1,9 @@ +// Tests: KDF reference in salt position of kdf_scope rule + +locality alice + +kdf_scope G { + name C1 : kdfkey @ alice + kdf L1 : C1, 0x, 0x -> strict kdfkey + kdf L2 : KDF, 0x, 0x -> strict kdfkey +} diff --git a/tests/parse/kdf_scope/call_site_single.owl b/tests/parse/kdf_scope/call_site_single.owl new file mode 100644 index 00000000..9db81c03 --- /dev/null +++ b/tests/parse/kdf_scope/call_site_single.owl @@ -0,0 +1,17 @@ +// Tests: kdf; kdfkey; 0> call site + +locality alice + +kdf_scope G { + name A : DH @ alice + name B : DH @ alice + name C1 : kdfkey @ alice + + odh L : C1, dh_combine(A, B), 0x -> strict kdfkey +} + +def test () @ alice : SecName(KDF; kdfkey; 0>) = + let salt = get(C1) in + let ikm = dh_combine(dhpk(get(A)), get(B)) in + let result = kdf; kdfkey; 0>(salt, ikm, 0x) in + result diff --git a/tests/parse/kdf_scope/ikm_concat.owl b/tests/parse/kdf_scope/ikm_concat.owl new file mode 100644 index 00000000..52fae7d7 --- /dev/null +++ b/tests/parse/kdf_scope/ikm_concat.owl @@ -0,0 +1,13 @@ +// Tests: odh L : 0x, dh_combine(A,B) ++ dh_combine(C,D), 0x -> ... + +locality alice +locality bob + +kdf_scope G { + name A : DH @ alice + name B : DH @ bob + name C : DH @ alice + name D : DH @ bob + + odh L : 0x, dh_combine(A, B) ++ dh_combine(C, D), 0x -> strict kdfkey +} diff --git a/tests/parse/kdf_scope/ikm_func_wrap.owl b/tests/parse/kdf_scope/ikm_func_wrap.owl new file mode 100644 index 00000000..f1680742 --- /dev/null +++ b/tests/parse/kdf_scope/ikm_func_wrap.owl @@ -0,0 +1,19 @@ +// Tests: odh L : 0x, lbl_ikm(f(), g(), dh_combine(A,B)), 0x -> ... +// lbl_ikm is parsed as IKMPublicExpr wrapping a function application + +locality alice +locality bob + +func f arity 0 +func g arity 0 +func h() = 0x12345678 +func lbl_ikm arity 3 + +kdf_scope G { + name A : DH @ alice + name B : DH @ bob + name C : DH @ alice + name D : DH @ bob + + odh L : h(), lbl_ikm(f(), g(), dh_combine(A,B) ++ dh_combine(C,D)), 0x -> strict kdfkey +} diff --git a/tests/parse/kdf_scope/indices_and_quantified_where_clauses.owl b/tests/parse/kdf_scope/indices_and_quantified_where_clauses.owl new file mode 100644 index 00000000..12187bdd --- /dev/null +++ b/tests/parse/kdf_scope/indices_and_quantified_where_clauses.owl @@ -0,0 +1,18 @@ +// Tests kdf rules with predicates on arguments + +locality alice: 1 + +kdf_scope G { + name A : DH @ alice + name B : DH @ alice + name C1<@m> : kdfkey @ alice + + kdf L3<@m>(ikm) where (forall j:idx. ikm != dhpk(get(A))): C1, ikm, 0x -> + strict kdfkey || public nonce +} + +// def test () @ alice : SecName(KDF; kdfkey; 0>) = +// let salt = get(G.C1) in +// let ikm = dh_combine(dhpk(get(G.A)), get(G.B)) in +// let result = kdf; kdfkey; 0>(salt, ikm, 0x) in +// result diff --git a/tests/parse/kdf_scope/kdf_arg_should_fail.owl b/tests/parse/kdf_scope/kdf_arg_should_fail.owl new file mode 100644 index 00000000..7f07ff47 --- /dev/null +++ b/tests/parse/kdf_scope/kdf_arg_should_fail.owl @@ -0,0 +1,19 @@ +// Tests that a mismatched kdf argument fails type checking + +locality alice + +kdf_scope G { + name A : DH @ alice + name B : DH @ alice + name C1 : kdfkey @ alice + + kdf L1(x): C1, x, 0x -> + strict kdfkey || public nonce +} + +def this_should_fail () @ alice : SecName(KDF) = + let salt = get(C1) in + let ikm = dhpk(get(B)) in + // The provided `ikm` doesn't match the expected value of `0x1234` in the kdf rule, so this should fail to type check. + let result = kdf(salt, ikm, 0x) in + result diff --git a/tests/parse/kdf_scope/kdf_odh_decl_argument.owl b/tests/parse/kdf_scope/kdf_odh_decl_argument.owl new file mode 100644 index 00000000..1e9a94ee --- /dev/null +++ b/tests/parse/kdf_scope/kdf_odh_decl_argument.owl @@ -0,0 +1,34 @@ +// Tests kdf rules arguments + +locality alice + +kdf_scope G { + name A : DH @ alice + name B : DH @ alice + name C1 : kdfkey @ alice + + kdf L1(x): C1, x, 0x -> + strict kdfkey || public nonce + + odh L2(y): y, dh_combine(A, B), 0x -> + strict nonce +} + +def test () @ alice : SecName(KDF) = + let salt = get(C1) in + let ikm = 0x1234 in + let result = kdf(salt, ikm, 0x) in + result + +def test2 () @ alice : SecName(KDF) = + let salt = 0x1234 in + let ikm = dh_combine(dhpk(get(B)), get(A)) in + let result = kdf(salt, ikm, 0x) in + result + +// def this_should_fail () @ alice : SecName(KDF) = +// let salt = get(C1) in +// let ikm = dhpk(get(B)) in +// // The provided `ikm` doesn't match the expected value of `0x1234` in the kdf rule, so this should fail to type check. +// let result = kdf(salt, ikm, 0x) in +// result diff --git a/tests/parse/kdf_scope/kdf_rule_simple.owl b/tests/parse/kdf_scope/kdf_rule_simple.owl new file mode 100644 index 00000000..18aa8dea --- /dev/null +++ b/tests/parse/kdf_scope/kdf_rule_simple.owl @@ -0,0 +1,10 @@ +// Tests: kdf L : C1, psk, 0x -> strict kdfkey + +locality alice + +kdf_scope G { + name psk : kdfkey @ alice + name C1 : kdfkey @ alice + + kdf L : C1, psk, 0x -> strict kdfkey +} diff --git a/tests/parse/kdf_scope/multi_output.owl b/tests/parse/kdf_scope/multi_output.owl new file mode 100644 index 00000000..6a52000e --- /dev/null +++ b/tests/parse/kdf_scope/multi_output.owl @@ -0,0 +1,10 @@ +// Tests: kdf L : C, k, info -> strict kdfkey || strict kdfkey + +locality alice + +kdf_scope G { + name psk : kdfkey @ alice + name C : kdfkey @ alice + + kdf L : C, psk, 0x -> strict kdfkey || strict kdfkey +} diff --git a/tests/parse/kdf_scope/odh_rule_simple.owl b/tests/parse/kdf_scope/odh_rule_simple.owl new file mode 100644 index 00000000..42d7a4a6 --- /dev/null +++ b/tests/parse/kdf_scope/odh_rule_simple.owl @@ -0,0 +1,12 @@ +// Tests: odh L : C1, dh_combine(A, B), 0x -> strict kdfkey + +locality alice +locality bob + +kdf_scope G { + name A : DH @ alice + name B : DH @ bob + name C1 : kdfkey @ alice + + odh L : C1, dh_combine(A, B), 0x -> strict kdfkey +} diff --git a/tests/parse/kdf_scope/parameter_in_where_clause.owl b/tests/parse/kdf_scope/parameter_in_where_clause.owl new file mode 100644 index 00000000..ae14c63a --- /dev/null +++ b/tests/parse/kdf_scope/parameter_in_where_clause.owl @@ -0,0 +1,35 @@ +// Tests kdf rules arguments + +locality alice + +kdf_scope G { + name A : DH @ alice + name B : DH @ alice + name C1 : kdfkey @ alice + + odh L1: C1, dh_combine(A, B), 0x -> + strict kdfkey || public nonce + + kdf L2(x) where (x != dh_combine(dhpk(get(A)), get(B))): C1, x, 0x -> + strict kdfkey || public nonce +} + +def test () @ alice : SecName(KDF) = + let salt = get(C1) in + let ikm = dh_combine(dhpk(get(A)), get(B)) in + let result = kdf(salt, ikm, 0x) in + result + +def test2 () @ alice : SecName(KDF) = + let salt = get(C1) in + let ikm = 0x1234 in + assume(0x1234 != dh_combine(dhpk(get(A)), get(B))); + let result = kdf(salt, ikm, 0x) in + result + +// def this_should_fail () @ alice : SecName(KDF) = +// let salt = get(C1) in +// let ikm = dh_combine(dhpk(get(A)), get(B)) in +// // The provided `ikm` matches the disallowed value of dh_combine(dhpk(get(A)), get(B)) in the kdf rule, so this should fail to type check. +// let result = kdf(salt, ikm, 0x) in +// result diff --git a/tests/parse/kdf_scope/unlabeled_public_kdf.owl b/tests/parse/kdf_scope/unlabeled_public_kdf.owl new file mode 100644 index 00000000..0e87527f --- /dev/null +++ b/tests/parse/kdf_scope/unlabeled_public_kdf.owl @@ -0,0 +1,11 @@ +locality alice + +kdf_scope G { + name C1 : kdfkey @ alice + + kdf L: 0x, C1, 0x -> strict kdfkey +} + +def test () @ alice : Data = + let public_nonce = kdf<;kdfkey||nonce;1>(0xabcd, 0x1234, 0x5678) in + public_nonce diff --git a/tests/parse/kdf_scope/where_clause.owl b/tests/parse/kdf_scope/where_clause.owl new file mode 100644 index 00000000..ca851d6a --- /dev/null +++ b/tests/parse/kdf_scope/where_clause.owl @@ -0,0 +1,12 @@ +// Tests: odh L where n_eph !=idx n : ... + +locality alice +locality bob + +kdf_scope G { + name A<@n> : DH @ alice + name B<@m> : DH @ bob + name C2<@n> : kdfkey @ alice + + odh L_corr where n_eph !=idx n : C2<@n_eph>, dh_combine(A<@n>, B<@m>), 0x -> strict kdfkey +} diff --git a/tests/success/cross_kdf_scope.owl b/tests/success/cross_kdf_scope.owl new file mode 100644 index 00000000..429d9a57 --- /dev/null +++ b/tests/success/cross_kdf_scope.owl @@ -0,0 +1,39 @@ +locality alice +locality bob + +name n1 : nonce @ alice +name n2 : nonce @ alice + +corr adv ==> [n1] // needed in case we derive a bad key in this example, since nothing is signed +// corr adv ==> [n2] + +kdf_scope S1 { + name A: DH @ bob + name B: DH @ alice + odh L1 : 0x, dh_ss(A,B), 0x -> strict enckey Name(n1) +} +kdf_scope S2 { + name C: DH @ bob + name D: DH @ alice + odh L2 : 0x, dh_ss(C,D), 0x -> strict enckey Name(n2) +} + +corr [A] ==> [n1] +corr [B] ==> [n1] +corr [C] ==> [n2] +corr [D] ==> [n2] + +def alice_main() @ alice : Option Unit = + input x in + guard is_group_elem(x) in + pcase (x == dhpk(get(A))) in + let x : if x == dhpk(get(A)) then dhpk(A) else y:Data{y == x} = x in + let ss = dh_combine(x, get(B)) in + corr_case B in + corr_case A in + debug printTyOf(ss); + let k = kdf(0x, ss, 0x) in + debug printTyOf(k); + let c = aenc(k, get(n1)) in + output c; + Some(()) diff --git a/tests/success/dhke.owl b/tests/success/dhke.owl index 3b0a3fcf..03808995 100644 --- a/tests/success/dhke.owl +++ b/tests/success/dhke.owl @@ -3,14 +3,15 @@ locality alice locality bob name d : nonce @ alice -name X : DH @ alice -name Y : DH @ bob + +kdf_scope G { + name X : DH @ alice + name Y : DH @ bob + odh L : 0x, dh_ss(X,Y), 0x -> enckey Name(d) +} + name skA : sigkey (dhpk(X)) @ alice name skB : sigkey (dhpk(Y)) @ bob -odh L : X, Y -> - {salt info. - True -> enckey Name(d) - } struct alice_msg { _a1: dhpk(X), @@ -47,9 +48,12 @@ def alice_main () @ alice corr_case Y in corr_case d in if !is_group_elem(bobs_pk) then () else { - pcase (dh_combine(bobs_pk, get(X)) == dh_combine(dhpk(get(Y)), get(X))) in - let ss = dh_combine(bobs_pk, get(X)) in - let k = kdf<;odh L[0];enckey;0>(0x, ss, 0x) in + // debug printTyOf(ss); + // let _ = debug decideProp(ss == dh_combine(dhpk(get(Y)), get(X))) in + pcase (bobs_pk == dhpk(get(Y))) in + let bobs_pk : if bobs_pk == dhpk(get(Y)) then dhpk(Y) else x:Data{x == bobs_pk} = bobs_pk in + let ss = dh_combine(bobs_pk, get(X)) in + let k = kdf(0x, ss, 0x) in let c = aenc(k, get(d)) in let _ = output c to endpoint(bob) in () @@ -77,15 +81,16 @@ def bob_main () @ bob corr_case d in if !is_group_elem(pkX) then () else { pcase (dh_combine(pkX, get(Y)) == dh_combine(dhpk(get(X)), get(Y))) in - let ss = dh_combine(pkX, get(Y)) in - let k = kdf<;odh L[0];enckey;0>(0x, ss, 0x) in + let pkX : if pkX == dhpk(get(X)) then dhpk(X) else x:Data{x == pkX} = pkX in + let ss = dh_combine(pkX, get(Y)) in + let k = kdf(0x, ss, 0x) in corr_case nameOf(k) in input ii, _ in case adec(k, ii) /* as Option (Name(d)) */ { | None => () | Some dd => let ddd : - if (sec(X) /\ sec(Y) /\ sec(KDF(0x, ss, 0x))) + if (sec(X) /\ sec(Y) /\ sec(KDF)) then Name(d) else Data = dd in diff --git a/tests/success/kdf-corr.owl b/tests/success/kdf-corr.owl index 809b8006..1033a3a5 100644 --- a/tests/success/kdf-corr.owl +++ b/tests/success/kdf-corr.owl @@ -1,25 +1,36 @@ locality alice name d : nonce @ alice -name k : kdf {ikm info. - True -> strict kdf {ikm2 info2. - True -> enckey Name(d) - } -} @ alice - -name f : dualkdf {salt info. - True -> strict kdf {ikm2 info2. - True -> enckey Name(d) - } -} @ alice + +kdf_scope G { + + name k : kdfkey @ alice + name f : kdfkey @ alice + + kdf L1 : k, f, 0x -> strict kdfkey + kdf L2 : KDF, 0x, 0x -> enckey Name(d) + + // name k : kdf {ikm info. + // True -> strict kdf {ikm2 info2. + // True -> enckey Name(d) + // } + // } @ alice + + // name f : dualkdf {salt info. + // True -> strict kdf {ikm2 info2. + // True -> enckey Name(d) + // } + // } @ alice +} + corr [k] /\ [f] ==> [d] def main() @ alice : (x:Unit{corr(k) /\ corr(f) ==> corr(d)}) = corr_case k in corr_case f in - let k2 = kdf<0;0;kdfkey;0>(get(k), get(f), 0x) in - let ek = kdf<0;;enckey;0>(k2, 0x, 0x) in + let k2 = kdf(get(k), get(f), 0x) in + let ek = kdf(k2, 0x, 0x) in let c = aenc(ek, get(d)) in output c diff --git a/tests/success/kdf-enc.owl b/tests/success/kdf-enc.owl index c2ac8e9b..82a5fe2c 100644 --- a/tests/success/kdf-enc.owl +++ b/tests/success/kdf-enc.owl @@ -15,41 +15,57 @@ struct s { _b : Data ||nonce|| } -name k : kdf {ikm info. - (info == 0x01) -> enckey Name(alice1), - (info == 0x02) -> strict kdf {ikm info. - (info == 0x01) -> enckey Name(alice2), - (info == 0x02) -> kdf {ikm info. - (info == 0x01) -> enckey Name(alice3) - } - } -} @ alice, bob +kdf_scope G { + name k : kdfkey @ alice, bob + + kdf L1_enc : k, 0x, 0x01 -> enckey Name(alice1) + kdf L1_kdf : k, 0x, 0x02 -> strict kdfkey + kdf L2_enc : 0x, KDF, 0x01 -> enckey Name(alice2) + kdf L2_kdf : 0x, KDF, 0x02 -> strict kdfkey + kdf L3_enc : KDF, 0x, 0x01 -> enckey Name(alice3) + + // This is just a hack for extraction to test slicing the KDF output + // It's not supposed to mean anything cryptographically + name kk : kdfkey @ bob + kdf L4 : kk, 0x, 0x -> strict (nonce) || nonce +} + + +// name k : kdf {ikm info. +// (info == 0x01) -> enckey Name(alice1), +// (info == 0x02) -> strict kdf {ikm info. +// (info == 0x01) -> enckey Name(alice2), +// (info == 0x02) -> kdf {ikm info. +// (info == 0x01) -> enckey Name(alice3) +// } +// } +// } @ alice, bob corr [k] ==> [alice1] corr [k] ==> [alice2] -// This is just a hack for extraction to test slicing the KDF output -// It's not supposed to mean anything cryptographically -name kk : kdf {ikm info. - True -> strict (nonce) || nonce -} @ bob + +// name kk : kdf {ikm info. +// True -> strict (nonce) || nonce +// } @ bob corr adv ==> [kk] def alice_main() @ alice : Unit = - // corr_case k in - let ek = kdf<0;;enckey;0>(get(k), 0x, 0x01) in + corr_case k in + let ek = kdf(get(k), 0x, 0x01) in // assert (corr(k) ==> corr(KDF(0x, 0x01)[0])); let c = aenc(ek, get(alice1)) in output c to endpoint(bob); - let k2 = kdf<1;;kdfkey;0>(get(k), 0x, 0x02) in - let ek2 = kdf<0;;enckey;0>(k2, 0x, 0x01) in + let k2 = kdf(get(k), 0x, 0x02) in + let ek2 = kdf(0x, k2, 0x01) in + // debug printTyContext; let c2 = aenc(ek2, get(alice2)) in output c2 to endpoint(bob); () def bob_main() @ bob : Unit = - let k1 = kdf<0;; nonce || nonce; 0>(get(kk), 0x, 0x) in - let k2 = kdf<0;; nonce || nonce; 1>(get(kk), 0x, 0x) in + let k1 = kdf(get(kk), 0x, 0x) in + let k2 = kdf(get(kk), 0x, 0x) in () /* diff --git a/tests/success/kdf-scope-with-predicate.owl b/tests/success/kdf-scope-with-predicate.owl new file mode 100644 index 00000000..2bdc954e --- /dev/null +++ b/tests/success/kdf-scope-with-predicate.owl @@ -0,0 +1,25 @@ +// Positive test: func and predicate declarations are allowed inside kdf_scope. +// The predicate defined inside the scope should be visible to outer defs. + +locality alice + +name n : nonce @ alice + +func parse + arity 1 + +kdf_scope G { + name k : kdfkey @ alice + + func mkinfo + arity 1 + + predicate p(x) = (x == get(n)) + + kdf L1 : k, 0x, 0x01 -> enckey Name(n) +} + +corr [k] ==> [n] + +def main(x : (a:Data{p[a]})) @ alice : Unit = + assert(x == get(n)) diff --git a/tests/success/kdf-self.owl b/tests/success/kdf-self.owl index c3bc112f..1a0a18ca 100644 --- a/tests/success/kdf-self.owl +++ b/tests/success/kdf-self.owl @@ -4,20 +4,31 @@ name alice_secret : nonce @ alice counter C @ alice -name k0 : kdf {ikm info self. - info == 0x01 -> public nonce |counter|, - info == 0x02 -> strict st_aead Data<[alice_secret] /\ adv, |adv|> +kdf_scope G { + name k0 : kdfkey @ alice + + kdf L1 : k0, 0x, 0x01 -> public nonce |counter| + kdf L2 : k0, 0x, 0x02 -> strict st_aead Data<[alice_secret] /\ adv, |adv|> aad x. true nonce C - pattern i. xor(i, gkdf(self, ikm, 0x01)) -} @ alice + pattern i. xor(i, gkdf(get(k0), 0x, 0x01)) +} + + +// name k0 : kdf {ikm info self. +// info == 0x01 -> public nonce |counter|, +// info == 0x02 -> strict st_aead Data<[alice_secret] /\ adv, |adv|> +// aad x. true +// nonce C +// pattern i. xor(i, gkdf(self, ikm, 0x01)) +// } @ alice corr [k0] ==> [alice_secret] def main() @ alice : Unit = corr_case k0 in - let base_nonce = kdf<0;;nonce |counter|;0>(get(k0), 0x, 0x01) in - let k_enc = kdf<1;;enckey;0>(get(k0), 0x, 0x02) in + let base_nonce = kdf(get(k0), 0x, 0x01) in + let k_enc = kdf(get(k0), 0x, 0x02) in let c = st_aead_enc(k_enc, get(alice_secret), 0x) in output c; input in_cipher in diff --git a/tests/success/kdf_scope_arg_in_rhs.owl b/tests/success/kdf_scope_arg_in_rhs.owl new file mode 100644 index 00000000..6c9534e8 --- /dev/null +++ b/tests/success/kdf_scope_arg_in_rhs.owl @@ -0,0 +1,19 @@ +locality alice + +name n : nonce @ alice +counter n_ctr @ alice + + +kdf_scope S { + name k: kdfkey @ alice + + predicate foo(x, ikm) = true + + kdf L(ikm) : k, ikm, 0x -> + strict kdfkey || + strict st_aead (Data |0|) + aad x. foo[x, ikm] + nonce n_ctr +} + + \ No newline at end of file diff --git a/tests/success/ke/dh_ke.owl b/tests/success/ke/dh_ke.owl index 2aad6ced..ccdd347b 100644 --- a/tests/success/ke/dh_ke.owl +++ b/tests/success/ke/dh_ke.owl @@ -1,15 +1,14 @@ include "ke.owli" -name S : DH @ Server -name C : DH @ Client +kdf_scope G { + name S : DH @ Server + name C : DH @ Client + odh L : 0x, dh_ss(C, S), 0x -> strict enckey Name(k) +} + name skS : sigkey (dhpk(S)) @ Server name skC : sigkey (dhpk(C)) @ Client -odh L : C, S -> - {salt info. - True -> strict enckey Name(k) - } - struct server_msg { _s1: dhpk(S), _s2: Data ||signature|| @@ -45,7 +44,7 @@ def ke_Server () @ Server corr_case C in let ss = dh_combine(client_pk, get(S)) in pcase (ss == dh_combine(dhpk(get(C)), get(S))) in - let dhk = kdf<;odh L[0];enckey;0>(0x, ss, 0x) in + let dhk = kdf(0x, ss, 0x) in let c = aenc(dhk, get(k)) in corr_case k in false_elim in @@ -71,7 +70,7 @@ def ke_Client () @ Client | Some server_pk => let ss = dh_combine(server_pk, get(C)) in pcase (ss == dh_combine(dhpk(get(C)), get(S))) in - let dhk = kdf<;odh L[0];enckey;0>(0x,ss, 0x) in + let dhk = kdf(0x,ss, 0x) in input ii, _ in corr_case k in false_elim in diff --git a/tests/success/ke_mod/dh_ke.owl b/tests/success/ke_mod/dh_ke.owl index 9cc78281..4d531107 100644 --- a/tests/success/ke_mod/dh_ke.owl +++ b/tests/success/ke_mod/dh_ke.owl @@ -2,15 +2,15 @@ include "ke.owli" module DH_KE (P : Params) : KE(P) = { name k : enckey Name(P.data) @ P.Server - name S : DH @ P.Server - name C : DH @ P.Client + + kdf_scope G { + name S : DH @ P.Server + name C : DH @ P.Client + odh L : 0x, dh_ss(C, S), 0x -> strict enckey Name(k) + } + name skS : sigkey (dhpk(S)) @ P.Server name skC : sigkey (dhpk(C)) @ P.Client - - odh L : C, S -> - {salt info. - True -> strict enckey Name(k) - } struct server_msg { _s1: dhpk(S), @@ -47,7 +47,7 @@ module DH_KE (P : Params) : KE(P) = { corr_case C in let ss = dh_combine(client_pk, get(S)) in pcase (ss == dh_combine(dhpk(get(C)), get(S))) in - let dhk = kdf<;odh L[0];enckey;0>(0x, ss, 0x) in + let dhk = kdf(0x, ss, 0x) in let c = aenc(dhk, get(k)) in corr_case k in false_elim in @@ -72,7 +72,7 @@ module DH_KE (P : Params) : KE(P) = { | Some server_pk => let ss = dh_combine(server_pk, get(C)) in pcase (ss == dh_combine(dhpk(get(C)), get(S))) in - let dhk = kdf<;odh L[0];enckey;0>(0x, ss, 0x) in + let dhk = kdf(0x, ss, 0x) in input ii, _ in corr_case k in false_elim in diff --git a/tests/success/odh.owl b/tests/success/odh.owl index 2a142940..54fc75d6 100644 --- a/tests/success/odh.owl +++ b/tests/success/odh.owl @@ -1,14 +1,15 @@ locality alice -name X : DH @ alice -name Y : DH @ alice - name n : nonce @ alice -odh L : - X, Y -> {salt info. - salt == 0x -> strict enckey Name(n) - } +kdf_scope G { + + name X : DH @ alice + name Y : DH @ alice + + odh L : 0x, dh_ss(X, Y) ++ 0x1234, 0x -> strict enckey Name(n) + +} corr [X] ==> [n] corr [Y] ==> [n] @@ -16,6 +17,6 @@ corr [Y] ==> [n] def main() @ alice : Unit = corr_case X in corr_case Y in - let k = kdf<;odh L[0];enckey;0>(0x, dh_combine(dhpk(get(X)), get(Y)) ++ 0x1234, 0x) in + let k = kdf(0x, dh_combine(dhpk(get(X)), get(Y)) ++ 0x1234, 0x) in let c = aenc(k, get(n)) in output c diff --git a/tests/success/odh_concat_dh.owl b/tests/success/odh_concat_dh.owl new file mode 100644 index 00000000..c24ff6a5 --- /dev/null +++ b/tests/success/odh_concat_dh.owl @@ -0,0 +1,28 @@ +locality alice + +name n : nonce @ alice + +kdf_scope G { + + name A : DH @ alice + name B : DH @ alice + name C : DH @ alice + name D : DH @ alice + + odh L : 0x, dh_ss(A, B) ++ dh_ss(C, D), 0x -> strict enckey Name(n) + +} + +corr [A] ==> [n] +corr [B] ==> [n] +corr [C] ==> [n] +corr [D] ==> [n] + +def main() @ alice : Unit = + corr_case A in + corr_case B in + corr_case C in + corr_case D in + let k = kdf(0x, dh_combine(dhpk(get(A)), get(B)) ++ dh_combine(dhpk(get(C)), get(D)), 0x) in + let c = aenc(k, get(n)) in + output c diff --git a/tests/success/odh_concat_dh_public_inputs.owl b/tests/success/odh_concat_dh_public_inputs.owl new file mode 100644 index 00000000..7ed03701 --- /dev/null +++ b/tests/success/odh_concat_dh_public_inputs.owl @@ -0,0 +1,33 @@ +locality alice + +kdf_scope G { + + name A : DH @ alice + name B : DH @ alice + name C : DH @ alice + name D : DH @ alice + + odh L : 0x, dh_ss(A, B) ++ dh_ss(C, D), 0x -> strict enckey Data |0| + +} + + +def main() @ alice : Option Unit = + corr_case A in + corr_case B in + corr_case C in + corr_case D in + // assume(sec(A) /\ sec(B) /\ corr(C) /\ corr(D)); // This is one of the "interesting" cases + input pk_of_A in + input pk_of_C in + guard is_group_elem(pk_of_A) in + guard is_group_elem(pk_of_C) in + pcase (pk_of_A == dhpk(get(A))) in + let pk_of_A : if pk_of_A == dhpk(get(A)) then dhpk(A) else x:Data{x == pk_of_A} = pk_of_A in + pcase (pk_of_C == dhpk(get(C))) in + let pk_of_C : if pk_of_C == dhpk(get(C)) then dhpk(C) else x:Data{x == pk_of_C} = pk_of_C in + let k = kdf(0x, dh_combine(pk_of_A, get(B)) ++ dh_combine(pk_of_C, get(D)), 0x) in + let c = aenc(k, 0x) in + debug printTyOf(k); + output c; + Some(()) diff --git a/tests/success/odh_ikm_concat_public_funcs.owl b/tests/success/odh_ikm_concat_public_funcs.owl new file mode 100644 index 00000000..fe3167c8 --- /dev/null +++ b/tests/success/odh_ikm_concat_public_funcs.owl @@ -0,0 +1,30 @@ +// IKM concat mixes public zero-arity funcs with dh_ss(A,B) between them. +// (Predicates are Props in Owl and cannot sit in IKM; funcs are the right +// surface form for f() / g() public label fragments in rule bodies.) + +locality alice + +name n : nonce @ alice + +kdf_scope G { + + name A : DH @ alice + name B : DH @ alice + + // Public constants as zero-arity funcs (callable as f() / g() in salt/ikm). + func f() = 0x01 + func g() = 0x02 + + odh L : 0x, f() ++ dh_ss(B, A) ++ g(), 0x -> strict enckey Name(n) + +} + +corr [A] ==> [n] +corr [B] ==> [n] + +def main() @ alice : Unit = + corr_case A in + corr_case B in + let k = kdf(0x, 0x01 ++ dh_combine(dhpk(get(A)), get(B)) ++ 0x02, 0x) in + let c = aenc(k, get(n)) in + output c diff --git a/tests/success/odh_kdfkey_salt.owl b/tests/success/odh_kdfkey_salt.owl new file mode 100644 index 00000000..36c1e29c --- /dev/null +++ b/tests/success/odh_kdfkey_salt.owl @@ -0,0 +1,25 @@ +locality alice + +name n : nonce @ alice + +kdf_scope G { + + name k : kdfkey @ alice + name X : DH @ alice + name Y : DH @ alice + + odh L : k, dh_ss(X, Y), 0x -> strict enckey Name(n) + +} + +corr [k] ==> [n] +corr [X] ==> [n] +corr [Y] ==> [n] + +def main() @ alice : Unit = + corr_case k in + corr_case X in + corr_case Y in + let enc_key = kdf(get(k), dh_combine(dhpk(get(X)), get(Y)), 0x) in + let c = aenc(enc_key, get(n)) in + output c diff --git a/tests/success/ssh.owl b/tests/success/ssh.owl index ed8fec81..3ad7dd75 100644 --- a/tests/success/ssh.owl +++ b/tests/success/ssh.owl @@ -30,10 +30,14 @@ enum sign_request_response { | _res Data } -name a : DH @ PFA -name b : DH @ PDIS -name b1 : DH @ PDIS -name c : DH @ SDIS +kdf_scope G { + name a : DH @ PFA + name b : DH @ PDIS + name b1 : DH @ PDIS + name c : DH @ SDIS + odh l1 : 0x, dh_ss(b,a), 0x01 -> enckey sign_request_response + odh l2 : 0x, dh_ss(b1,c), 0x02 -> enckey Data +} enum dhpk_b { | _comm_with_pfa dhpk(b) @@ -54,15 +58,7 @@ corr_group [skPDIS], [b], [b1] name skSDIS : sigkey (dhpk(c)) @ SDIS // g^a1 corr_group [skSDIS], [c] -odh l1: - b, a -> {salt info. - (info == 0x01) -> enckey sign_request_response - } -odh l2: - b1, c -> {salt info. - (info == 0x02) -> enckey Data - } struct pfa_msg { _pfa1: dhpk(a), @@ -86,13 +82,12 @@ struct sdis_msg { def PFA_FW (gb : Ghost, k11: if (corr(skPDIS) /\ gb != dh_combine(dhpk(get(a)), get(b))) \/ (corr(a) \/ corr(b)) - then Data else Name(KDF(0x, - dh_combine(dhpk(get(b)), get(a)), 0x01))) @ PFA + then Data else Name(KDF)) @ PFA : Unit = pcase (corr(skPDIS) /\ gb != dh_combine(dhpk(get(a)), get(b))) in pcase (corr(a) \/ corr(b)) in input inp in // from PDIS (actual non-KE) - case adec(k11, inp) as Option sign_request_response { + case adec(k11, inp) as Option Data { | None => () | Some m' => case m' as sign_request_response { @@ -114,8 +109,7 @@ def PDIS_actual(gb : Ghost, if (corr(skPFA) /\ gb != dh_combine(dhpk(get(a)), get(b))) \/ (corr(a) \/ corr(b)) then Data else - Name(KDF(0x, - dh_combine(dhpk(get(b)), get(a)), 0x01))) @ PDIS + Name(KDF)) @ PDIS : Unit = pcase (sec(a) /\ sec(b)) in let g_pow_b1 = dhpk(get(b1)) in @@ -130,11 +124,11 @@ def PDIS_actual(gb : Ghost, | None => () | Some g_pow_c => if !is_group_elem(g_pow_c) then () else { + pcase (g_pow_c == dhpk(get(c))) in + let g_pow_c : if g_pow_c == dhpk(get(c)) then dhpk(c) else x:Data{x == g_pow_c} = g_pow_c in let ss = dh_combine(g_pow_c, get(b1)) in - pcase (ss == dh_combine(dhpk(get(b1)), get(c))) in - corr_case b1 in - corr_case c in - let k = kdf<; odh l2[0]; enckey; 0>(0x, ss, 0x02) in + corr_case c in + let k = kdf(0x, ss, 0x02) in // request PFA to sign let request = _req(0x01) in // TODO: 0x01 is the hash @@ -143,7 +137,7 @@ def PDIS_actual(gb : Ghost, // get its input input inp2 in - case adec(k11, inp2) as Option sign_request_response { + case adec(k11, inp2) as Option Data { | None => () | Some m' => case m' as sign_request_response { @@ -181,11 +175,12 @@ def SDIS_actual () @ SDIS | _comm_with_sdis g_pow_b1 => if !is_group_elem(g_pow_b1) then () else { + pcase (g_pow_b1 == dhpk(get(b1))) in + let g_pow_b1 : if g_pow_b1 == dhpk(get(b1)) then dhpk(b1) else x:Data{x == g_pow_b1} = g_pow_b1 in let ss = dh_combine(g_pow_b1, get(c)) in - pcase (ss == dh_combine(dhpk(get(b1)), get(c))) in corr_case c in corr_case b1 in - let k = kdf<;odh l2[0];enckey;0>(0x, ss, 0x02) in + let k = kdf(0x, ss, 0x02) in input inp2 in corr_case nameOf(k) in @@ -222,10 +217,13 @@ def PFA_KE () @ PFA corr_case a in corr_case b in if !is_group_elem(g_pow_b) then () else { - let ss = dh_combine(g_pow_b, get(a)) in - pcase (ss == dh_combine(dhpk(get(a)), get(b))) in - let k11 - = kdf<; odh l1[0]; enckey; 0>(0x, ss, 0x01) in + // TODO: can we avoid the explicit subtyping somehow + // let g_pow_b' : if (g_pow_b == dhpk(get(b))) then dhpk(b) else (x:Data ||group||{is_group_elem(x) /\ x == g_pow_b}) = g_pow_b in + pcase (g_pow_b == dhpk(get(b))) in + let g_pow_b : if g_pow_b == dhpk(get(b)) then dhpk(b) else x:Data{x == g_pow_b} = g_pow_b in + let ss = dh_combine(g_pow_b, get(a)) in + // pcase (ss == dh_combine(dhpk(get(a)), get(b))) in + let k11 = kdf(0x, ss, 0x01) in call PFA_FW(ss, k11) } otherwise => () @@ -254,9 +252,11 @@ def PDIS_KE () @ PDIS corr_case a in corr_case b in if !is_group_elem(g_pow_a) then () else { - let ss = dh_combine(g_pow_a, get(b)) in - pcase (ss == dh_combine(dhpk(get(a)), get(b))) in - let k11 = kdf<; odh l1[0]; enckey; 0>(0x, ss, 0x01) in + // let g_pow_a' : if (g_pow_a == dhpk(get(a))) then dhpk(a) else (x:Data ||group||{is_group_elem(x) /\ x == g_pow_a}) = g_pow_a in + pcase (g_pow_a == dhpk(get(a))) in + let g_pow_a : if g_pow_a == dhpk(get(a)) then dhpk(a) else x:Data{x == g_pow_a} = g_pow_a in + let ss = dh_combine(g_pow_a, get(b)) in + let k11 = kdf(0x, ss, 0x01) in let _ = output 0x to endpoint(SDIS) in // TODO: The hash stuff call PDIS_actual(ss, k11) } diff --git a/tests/success/toy_examples/dhke.owl b/tests/success/toy_examples/dhke.owl index 33e088cd..11f5025c 100644 --- a/tests/success/toy_examples/dhke.owl +++ b/tests/success/toy_examples/dhke.owl @@ -3,14 +3,15 @@ locality alice locality bob name d : nonce @ alice -name X : DH @ alice -name Y : DH @ bob + +kdf_scope G { + name X : DH @ alice + name Y : DH @ bob + odh L : 0x, dh_ss(X,Y), 0x -> enckey Name(d) +} + name skA : sigkey (dhpk(X)) @ alice name skB : sigkey (dhpk(Y)) @ bob -odh L : X, Y -> - {salt info. - True -> enckey Name(d) - } struct alice_msg { _a1: dhpk(X), @@ -47,7 +48,7 @@ def alice_main () @ alice corr_case Y in corr_case d in let ss = dh_combine(bobs_pk, get(X)) in - let k = kdf<;odh L[0];enckey;0>(0x, ss, 0x) in + let k = kdf(0x, ss, 0x) in let c = aenc(k, get(d)) in let _ = output c to endpoint(bob) in () @@ -73,14 +74,13 @@ def bob_main () @ bob corr_case Y in corr_case d in let ss = dh_combine(pkX, get(Y)) in - let k = kdf<;odh L[0];enckey;0>(0x, ss, 0x) in + let k = kdf(0x, ss, 0x) in corr_case nameOf(k) in input ii, _ in case adec(k, ii) /* as Option (Name(d)) */ { | None => () | Some dd => - let ddd : if (sec(X) /\ sec(Y) /\ sec(KDF(0x, ss, 0x))) then + let ddd : if (sec(X) /\ sec(Y) /\ sec(KDF)) then Name(d) else Data = dd in () // otherwise => () diff --git a/tests/success/toy_examples/ssh.owl b/tests/success/toy_examples/ssh.owl index 4a4f7ec1..8a371fe6 100644 --- a/tests/success/toy_examples/ssh.owl +++ b/tests/success/toy_examples/ssh.owl @@ -30,10 +30,14 @@ enum sign_request_response { | _res Data } -name a : DH @ PFA -name b : DH @ PDIS -name b1 : DH @ PDIS -name c : DH @ SDIS +kdf_scope G { + name a : DH @ PFA + name b : DH @ PDIS + name b1 : DH @ PDIS + name c : DH @ SDIS + odh l1 : 0x, dh_ss(b,a), 0x01 -> enckey sign_request_response + odh l2 : 0x, dh_ss(b1,c), 0x02 -> enckey Data +} enum dhpk_b { | _comm_with_pfa dhpk(b) @@ -54,15 +58,7 @@ corr_group [skPDIS], [b], [b1] name skSDIS : sigkey (dhpk(c)) @ SDIS // g^a1 corr_group [skSDIS], [c] -odh l1: - b, a -> {salt info. - (info == 0x01) -> enckey sign_request_response - } -odh l2: - b1, c -> {salt info. - (info == 0x02) -> enckey Data - } struct pfa_msg { _pfa1: dhpk(a), @@ -86,8 +82,7 @@ struct sdis_msg { def PFA_FW (gb : Ghost, k11: if (corr(skPDIS) /\ gb != dh_combine(dhpk(get(a)), get(b))) \/ (corr(a) \/ corr(b)) - then Data else Name(KDF(0x, - dh_combine(dhpk(get(b)), get(a)), 0x01))) @ PFA + then Data else Name(KDF)) @ PFA : Unit = pcase (corr(skPDIS) /\ gb != dh_combine(dhpk(get(a)), get(b))) in pcase (corr(a) \/ corr(b)) in @@ -114,8 +109,7 @@ def PDIS_actual(gb : Ghost, if (corr(skPFA) /\ gb != dh_combine(dhpk(get(a)), get(b))) \/ (corr(a) \/ corr(b)) then Data else - Name(KDF(0x, - dh_combine(dhpk(get(b)), get(a)), 0x01))) @ PDIS + Name(KDF)) @ PDIS : Unit = pcase (sec(a) /\ sec(b)) in let g_pow_b1 = dhpk(get(b1)) in @@ -130,11 +124,12 @@ def PDIS_actual(gb : Ghost, | None => () | Some g_pow_c => if !is_group_elem(g_pow_c) then () else { + pcase (g_pow_c == dhpk(get(c))) in + let g_pow_c : if g_pow_c == dhpk(get(c)) then dhpk(c) else x:Data{x == g_pow_c} = g_pow_c in let ss = dh_combine(g_pow_c, get(b1)) in - pcase (ss == dh_combine(dhpk(get(b1)), get(c))) in corr_case b1 in corr_case c in - let k = kdf<; odh l2[0]; enckey; 0>(0x, ss, 0x02) in + let k = kdf(0x, ss, 0x02) in // request PFA to sign let request = _req(0x01) in // TODO: 0x01 is the hash @@ -181,11 +176,12 @@ def SDIS_actual () @ SDIS | _comm_with_sdis g_pow_b1 => if !is_group_elem(g_pow_b1) then () else { + pcase (g_pow_b1 == dhpk(get(b1))) in + let g_pow_b1 : if g_pow_b1 == dhpk(get(b1)) then dhpk(b1) else x:Data{x == g_pow_b1} = g_pow_b1 in let ss = dh_combine(g_pow_b1, get(c)) in - pcase (ss == dh_combine(dhpk(get(b1)), get(c))) in corr_case c in corr_case b1 in - let k = kdf<;odh l2[0];enckey;0>(0x, ss, 0x02) in + let k = kdf(0x, ss, 0x02) in input inp2 in corr_case nameOf(k) in @@ -222,10 +218,13 @@ def PFA_KE () @ PFA corr_case a in corr_case b in if !is_group_elem(g_pow_b) then () else { - let ss = dh_combine(g_pow_b, get(a)) in - pcase (ss == dh_combine(dhpk(get(a)), get(b))) in - let k11 - = kdf<; odh l1[0]; enckey; 0>(0x, ss, 0x01) in + // TODO: can we avoid the explicit subtyping somehow + // let g_pow_b' : if (g_pow_b == dhpk(get(b))) then dhpk(b) else (x:Data ||group||{is_group_elem(x) /\ x == g_pow_b}) = g_pow_b in + pcase (g_pow_b == dhpk(get(b))) in + let g_pow_b : if g_pow_b == dhpk(get(b)) then dhpk(b) else x:Data{x == g_pow_b} = g_pow_b in + let ss = dh_combine(g_pow_b, get(a)) in + // pcase (ss == dh_combine(dhpk(get(a)), get(b))) in + let k11 = kdf(0x, ss, 0x01) in call PFA_FW(ss, k11) } otherwise => () @@ -254,9 +253,11 @@ def PDIS_KE () @ PDIS corr_case a in corr_case b in if !is_group_elem(g_pow_a) then () else { - let ss = dh_combine(g_pow_a, get(b)) in - pcase (ss == dh_combine(dhpk(get(a)), get(b))) in - let k11 = kdf<; odh l1[0]; enckey; 0>(0x, ss, 0x01) in + // let g_pow_a' : if (g_pow_a == dhpk(get(a))) then dhpk(a) else (x:Data ||group||{is_group_elem(x) /\ x == g_pow_a}) = g_pow_a in + pcase (g_pow_a == dhpk(get(a))) in + let g_pow_a : if g_pow_a == dhpk(get(a)) then dhpk(a) else x:Data{x == g_pow_a} = g_pow_a in + let ss = dh_combine(g_pow_a, get(b)) in + let k11 = kdf(0x, ss, 0x01) in let _ = output 0x to endpoint(SDIS) in // TODO: The hash stuff call PDIS_actual(ss, k11) } diff --git a/tests/success/unauth_dh.owl b/tests/success/unauth_dh.owl index 00c05d47..0b1d392e 100644 --- a/tests/success/unauth_dh.owl +++ b/tests/success/unauth_dh.owl @@ -1,24 +1,24 @@ locality client : 1 locality server -name X<@g> : DH @ client -name Y : DH @ server name data<@h> : nonce @ client + +kdf_scope G { + name X<@g> : DH @ client + name Y : DH @ server + odh L<@f> : 0x, dh_ss(X<@f>, Y), 0x -> enckey Name(data<@f>) +} + corr [X<@i>] ==> [data<@i>] corr [Y] ==> [data<@i>] -odh L<@f> : - X<@f>, Y -> {salt info. - True -> enckey Name(data<@f>) - } - def client_main<@i>(pky : dhpk(Y)) @ client : Unit = let h = dhpk(get(X<@i>)) in output h; corr_case X<@i> in corr_case Y in - let y = kdf<;odh L<@i>[0]; enckey; 0>(0x, dh_combine(pky, get(X<@i>)), 0x) + let y = kdf; enckey; 0>(0x, dh_combine(pky, get(X<@i>)), 0x) in let c = aenc(y, get(data<@i>)) in output c @@ -30,9 +30,7 @@ struct server_getkey_result { /\ sec(X<@j>) /\ sec(Y) - then - Name(KDF)>(0x, - dh_combine(dhpk(get(X<@j>)), get(Y)), 0x)) + then Name(KDF;enckey;0>) else Data } @@ -40,13 +38,16 @@ def server_getkey() @ server : Option (exists j. server_getkey_result = input h in if is_group_elem(h) then { - pcase (exists j:idx. dh_combine(h, get(Y)) == dh_combine(dhpk(get(X<@j>)), get(Y))) in - choose_idx j | dh_combine(h, get(Y)) == dh_combine(dhpk(get(X<@j>)), get(Y)) in + // pcase (exists j:idx. dh_combine(h, get(Y)) == dh_combine(dhpk(get(X<@j>)), get(Y))) in + // choose_idx j | dh_combine(h, get(Y)) == dh_combine(dhpk(get(X<@j>)), get(Y)) in + pcase (exists j:idx. h == dhpk(get(X<@j>))) in + choose_idx j | h == dhpk(get(X<@j>)) in + let h : if h == dhpk(get(X<@j>)) then dhpk(X<@j>) else x:Data{x == h} = h in let ss - = dh_combine(h, get(Y)) in + = dh_combine, name Y>(h, get(Y)) in corr_case X<@j> in corr_case Y in - let y = kdf<;odh L<@j>[0]; enckey; 0>(0x, ss, 0x) in + let y = kdf; enckey; 0>(0x, ss, 0x) in let res = pack(server_getkey_result(h, y)) in Some(res) diff --git a/tests/wip/forward_declared_funcs_and_predicates.owl b/tests/wip/forward_declared_funcs_and_predicates.owl new file mode 100644 index 00000000..06ff1071 --- /dev/null +++ b/tests/wip/forward_declared_funcs_and_predicates.owl @@ -0,0 +1,35 @@ +locality Initiator : 1 +locality Responder : 1 + +// Constants used in WireGuard. They get interpreted as ASCII hex +func construction() = "Noise_IKpsk2_25519_ChaChaPoly_BLAKE2s" +func identifier() = "WireGuard v1 zx2c4 Jason@zx2c4.com" +func mac1() = "mac1----" + +counter aead_counter_msg1_C2 @ Initiator + + +kdf_scope G { + // Ephemeral Diffie-Hellman keys + name E_init : DH @ Initiator + name E_resp : DH @ Responder + + // Static Diffie-Hellman keys + name S_init<@n> : DH @ Initiator + name S_resp<@m> : DH @ Responder + + // Pre-shared key between initiator and responder. + name psk<@n,m> : kdfkey @ Initiator, Responder + + odh L1 : honest_c1(), dh_combine(E_init, S_resp<@m>), 0x -> + strict nonce || + strict st_aead (dhpk(S_init<@n>)) + aad x. true + nonce aead_counter_msg1_C2 + +} + +func honest_c1() = + gkdf(crh(construction()), dhpk(get(E_init)), 0x) + + diff --git a/tests/wip/hpke/defs.owl b/tests/wip/hpke/defs.owl index ce3b3bcd..24f13ec3 100644 --- a/tests/wip/hpke/defs.owl +++ b/tests/wip/hpke/defs.owl @@ -10,20 +10,6 @@ name channel_secret : nonce def sent_message @ sender type plaintext_t = (x:Data<[channel_secret] /\ adv, |adv|>{happened(sent_message(x))}) -// Diffie-Hellman secrets - -// Recever's static key -name skR : DH @ receiver - -// Ephemeral keys for the sender; one per session -name skE : DH @ sender - -// Sender's static key -name skS : DH @ sender - - -counter send_counter @ sender -counter recv_counter @ receiver /* secret = Extract(dh_shared_secret, concat("HPKE-v1", suite_id, "secret", psk)) @@ -39,33 +25,33 @@ constant as well we will need extra machinery for psk to be valid in concat position; let's leave it off for now as well -key = hkdf(dh_shared_secret, concat("HPKE-v1", suite_id, "secret", psk), +key = hkdf(dh_shared_secret, concat("HPKE-v1", suite_id, "secret", psk), concat(I2OSP(Nk, 2), "HPKE-v1", suite_id, "key", key_schedule_context); Nk -base_nonce = hkdf(dh_shared_secret, concat("HPKE-v1", suite_id, "secret", psk), +base_nonce = hkdf(dh_shared_secret, concat("HPKE-v1", suite_id, "secret", psk), concat(I2OSP(Nk, 2), "HPKE-v1", suite_id, "base_nonce", key_schedule_context); Nk ) */ -func hpke_v1() = "HPKE-v1" +func hpke_v1() = "HPKE-v1" /* Precomputed suite_id constants; see 5.1 and 4.1 of the HPKE RFC. Precomputed * (since we don't support cryptographic agility yet) to SHA256 and X25519. */ -func hpke_suite_id() = 0x48504b45002000010003 +func hpke_suite_id() = 0x48504b45002000010003 func kem_suite_id() = 0x4b454d0020 -func secret_string() = "secret" -func shared_secret_string() = "shared_secret" -func key_string() = "key" -func base_nonce_string() = "base_nonce" -func export_string() = "exp" -func info_hash_string() = "info_hash" -func psk_id_hash_string() = "psk_id_hash" -func crh_labeled_extract_0salt(lbl, ikm) = - crh(hpke_v1() ++ hpke_suite_id() ++ lbl ++ ikm) +func secret_string() = "secret" +func shared_secret_string() = "shared_secret" +func key_string() = "key" +func base_nonce_string() = "base_nonce" +func export_string() = "exp" +func info_hash_string() = "info_hash" +func psk_id_hash_string() = "psk_id_hash" +func crh_labeled_extract_0salt(lbl, ikm) = + crh(hpke_v1() ++ hpke_suite_id() ++ lbl ++ ikm) func psk_id() = (0x) @@ -73,114 +59,234 @@ func info() = (0x) func mode() = 0x03 // auth_psk func key_schedule_context() = 0x03431df6cd95e11ff49d7013563baf7f11588c75a6611ee2a4404a49306ae4cfc555e7b39d7a73553c14eee3b605f8c4438fb8c4a5d32fb2bef735f26128ed5695 - // Precomputed value to be equal to: + // Precomputed value to be equal to: // mode() ++ crh_labeled_extract_0salt(info_hash_string(), info()) ++ // crh_labeled_extract_0salt(psk_id_hash_string(), psk_id()) -func eae_prk() = "eae_prk" +func eae_prk() = "eae_prk" /* These functions model how HPKE use LabeledExtract and LabeledExpand */ -func lbl_ikm(suite_id, lbl, ikm) = +func lbl_ikm(suite_id, lbl, ikm) = hpke_v1() ++ suite_id ++ lbl ++ ikm -func lbl_info(suite_id, len, lbl, info) = +func lbl_info(suite_id, len, lbl, info) = len ++ hpke_v1() ++ suite_id ++ lbl ++ info -/* Coming from HPKE RFC */ -func kdfkey_len() = +/* Coming from HPKE RFC */ +func kdfkey_len() = 0x0020 -func enckey_len() = +func enckey_len() = 0x0020 -func nonce_len() = +func nonce_len() = 0x000c /* Inputs to HKDF from the protocol */ -func base_nonce_kdf_info() = +func base_nonce_kdf_info() = lbl_info(hpke_suite_id(), nonce_len(), base_nonce_string(), key_schedule_context()) -func key_kdf_info() = +func key_kdf_info() = lbl_info(hpke_suite_id(), enckey_len(), key_string(), key_schedule_context()) -func export_kdf_info() = +func export_kdf_info() = lbl_info(hpke_suite_id(), enckey_len(), export_string(), key_schedule_context()) func dh_secret_kdf_ikm(psk_) = lbl_ikm(hpke_suite_id(), secret_string(), psk_) -/* Diffie-Hellman secrets uesd in AuthEncap */ -func AuthEncap_dh() = - dh_combine(dhpk(get(skR)), get(skE)) - ++ - dh_combine(dhpk(get(skR)), get(skS)) - -func AuthEncap_kem_context() = - dhpk(get(skE)) - ++ - dhpk(get(skR)) - ++ - dhpk(get(skS)) - -func AuthEncap_honest_info() = - lbl_info(kem_suite_id(), kdfkey_len(), shared_secret_string(), AuthEncap_kem_context()) - -func AuthEncap_shared_secret() = - gkdf(0x, lbl_ikm(kem_suite_id(), eae_prk(), AuthEncap_dh()), - lbl_info(kem_suite_id(), kdfkey_len(), shared_secret_string(), - AuthEncap_kem_context())) - - -func AuthDecap_dh(eph) = - dh_combine(eph, get(skR)) - ++ - dh_combine(dhpk(get(skR)), get(skS)) - -func AuthDecap_kem_context(eph) = - eph - ++ - dhpk(get(skR)) - ++ - dhpk(get(skS)) +counter send_counter @ sender +counter recv_counter @ receiver -func AuthDecap_shared_secret(eph) = - gkdf(0x, lbl_ikm(kem_suite_id(), eae_prk(), AuthDecap_dh(eph)), - lbl_info(kem_suite_id(), kdfkey_len(), shared_secret_string(), - AuthDecap_kem_context(eph))) /* Similar to WireGuard, a "junk secret" that later can be ruled out */ -nametype hpke_corr_key_t = +nametype hpke_corr_key_t = st_aead (x:Data{false}) aad x. false nonce send_counter -/* Type for the pre-shared key */ -nametype psk_t = dualkdf {salt info self. - /* The base nonce */ - (info == base_nonce_kdf_info()) -> public nonce |counter|, - (exists i:idx. salt == AuthEncap_shared_secret()) /\ info == key_kdf_info() -> - /* The actual encryption key for data */ - strict st_aead plaintext_t - aad x. true - nonce send_counter - pattern i. xor(i, gkdf(salt, - dh_secret_kdf_ikm(self), - base_nonce_kdf_info())), - /* Junk secret, if the salt is incorrect */ - (forall i:idx. salt != AuthEncap_shared_secret()) /\ info == key_kdf_info() -> - strict hpke_corr_key_t, - (info == export_kdf_info()) -> strict nonce +// ===================================================================== +// KDF Group: HPKE_KDF +// +// This group collects all DH key names and the PSK used in HPKE's +// AuthEncap/AuthDecap and key schedule, along with the intermediate +// kdfkey nametypes and the kdf/odh rules that define the KDF chain. +// +// The KDF chain in HPKE proceeds as follows: +// +// shared_secret = KDF(salt=0x, +// ikm=lbl_ikm(kem_suite_id(), eae_prk(), +// dh(skE,skR) ++ dh(skS,skR)), +// info=lbl_info(kem_suite_id(), kdfkey_len(), +// shared_secret_string(), kem_context)) +// [ODH L_kem] +// +// base_nonce = KDF(salt=shared_secret, +// ikm=dh_secret_kdf_ikm(psk), +// info=base_nonce_kdf_info()) [kdf L_sched_nonce] +// +// key = KDF(salt=shared_secret, +// ikm=dh_secret_kdf_ikm(psk), +// info=key_kdf_info()) [kdf L_sched_key] +// +// export = KDF(salt=shared_secret, +// ikm=dh_secret_kdf_ikm(psk), +// info=export_kdf_info()) [kdf L_sched_export] +// ===================================================================== + +kdf_scope HPKE_KDF { + // Receiver's static key + name skR : DH @ receiver + + // Sender's ephemeral key + name skE : DH @ sender + + // Sender's static key + name skS : DH @ sender + + // Pre-shared key between sender and receiver + name psk : kdfkey // @ sender, receiver + + func AuthEncap_kem_context(eph) = + eph + ++ + dhpk(get(skR)) + ++ + dhpk(get(skS)) + + func AuthEncap_info(eph) = + lbl_info(kem_suite_id(), kdfkey_len(), shared_secret_string(), AuthEncap_kem_context(eph)) + + + + // ----------------------------------------------------------------- + // ODH rules for KEM shared_secret derivation (AuthEncap / AuthDecap) + // + // The HPKE KEM derives shared_secret as: + // KDF(0x, + // lbl_ikm(kem_suite_id(), eae_prk(), dh(skE,skR) ++ dh(skS,skR)), + // lbl_info(kem_suite_id(), kdfkey_len(), shared_secret_string(), kem_context)) + // + // In the old syntax this was covered by tw ODH declarations: + // odh ss : skR, skS -> { salt info. ... } (static DH) + // odh se: skR, skE -> { salt info. ... } (ephemeral DH) + // and at call sites both hints were listed: odh ss[0], odh se[0]. + // ----------------------------------------------------------------- + + // L_kem: KEM shared_secret, correct case for session i. + // Applies when: info == AuthEncap_honest_info(). + // Replaces the `exists i. info == AuthEncap_honest_info()` + // branch of both old `odh ss` and `odh se`. + + // TODO: if I omit the info argument from the ODH declaration, the below parses, but shouldn't: + // I think the parser is not using the same mechanism for variable binding as elsewhere in the repo. + // Pratap: Resolved by explicitly checking the salt/ikm/info/where when processing the rule decl. + /* + odh L_kem where (info == AuthEncap_honest_info()) : 0x, + hpke_v1() ++ kem_suite_id() ++ eae_prk() ++ dh_ss(skE, skR) ++ dh_ss(skS, skR), + AuthEncap_honest_info() + -> strict kdfkey + */ + + + odh L_kem : 0x, + hpke_v1() ++ kem_suite_id() ++ eae_prk() ++ dh_ss(skE, skR) ++ dh_ss(skS, skR), + AuthEncap_info(dhpk(get(skE))) + -> strict kdfkey + + // L_kem_corr: KEM step, ephemeral skE is present in ikm but + // the info does NOT match the honest info for session i. Replaces the + // `info != AuthEncap_honest_info()` branch of `odh se`. + /* + odh L_kem_corr where (is_group_elem(dh) /\ (forall i:idx. dh != dhpk(get(skE)))) : 0x, + hpke_v1() ++ kem_suite_id() ++ eae_prk() ++ dh_combine(dh, get(skR)) ++ dh_ss(skS, skR), + info + -> strict kdfkey + */ + + // ----------------------------------------------------------------- + // KDF rules for the key_schedule (steps 2–4) + // + // These three rules replace the old shared_secret_t and + // shared_secret_corr_t nametypes, which were of the form: + // nametype shared_secret_t = kdf {ikm info self. + // (ikm == dh_secret_kdf_ikm(get(psk))) /\ info == base_nonce_kdf_info() + // -> public nonce |counter|, + // (ikm == dh_secret_kdf_ikm(get(psk))) /\ info == key_kdf_info() + // -> strict st_aead ..., + // (ikm == dh_secret_kdf_ikm(get(psk))) /\ info == export_kdf_info() + // -> strict nonce + // } + // The three conditional branches become three separate kdf rules. + // Corrupted variants (old shared_secret_corr_t) add three more rules. + // ----------------------------------------------------------------- + + kdf L_sched_nonce : KDF;kdfkey;0>, + hpke_v1() ++ hpke_suite_id() ++ secret_string () ++ get(psk), + base_nonce_kdf_info() + // dh_secret_kdf_ikm(HPKE_KDF.psk), base_nonce_kdf_info() + -> public nonce |counter| + + // TODO: Below: Should work + // Pratap: Resolved. + + + func sched_key_base_nonce() = + gkdf(get(KDF; kdfkey; 0>), + dh_secret_kdf_ikm(get(psk)), + base_nonce_kdf_info()) + + + // L_sched_key: key_schedule → encryption key (correct case) + kdf L_sched_key : KDF;kdfkey;0>, + hpke_v1() ++ hpke_suite_id() ++ secret_string () ++ get(psk), + key_kdf_info() + -> strict st_aead plaintext_t + aad x. true + nonce send_counter -} + // TODO: Should work. Says "Unknown KDF group rule" + // Pratap: Resolved. Now it fails with "Pattern injectivity failed" seemingly because + // it doesn't know that length(get(KDF; nonce |counter|; 0>)) == |counter|. + // This also didn't work in the old version. Need to explicitly encode this in SMT + //pattern y. xor(y, get(KDF; nonce |counter|; 0>)) + pattern y. xor(y, sched_key_base_nonce()) + + // L_sched_export: key_schedule → export key (correct case) + kdf L_sched_export : KDF;kdfkey;0>, + hpke_v1() ++ hpke_suite_id() ++ secret_string () ++ get(psk), + export_kdf_info() + -> strict nonce + + // Corrupted variants: when the shared_secret has type SS_corr_t + // (produced by L_kem_corr or L_kem_ss_corr instead of L_kem). + // These replace the old shared_secret_corr_t nametype's three branches. + /* + kdf L_sched_nonce_corr(dh, info) : KDF, + hpke_v1() ++ hpke_suite_id() ++ secret_string () ++ get(psk), + base_nonce_kdf_info() + -> public nonce |counter| + + kdf L_sched_key_corr(dh, info) : KDF, + hpke_v1() ++ hpke_suite_id() ++ secret_string () ++ get(psk), + key_kdf_info() + -> strict hpke_corr_key_t + + kdf L_sched_export_corr(dh, info) : KDF, + hpke_v1() ++ hpke_suite_id() ++ secret_string () ++ get(psk), + export_kdf_info() + -> strict nonce + */ + +} // end kdf_scope HPKE_KDF -name psk : psk_t @ sender, receiver /* Corruption scenario we model for HPKE. */ -/* If the sender is completely corrupt -- its DH secrets and the psk -- then -we give up on secrecy for the transport layer */ +/* If the sender is completely corrupt -- its DH secrets and the psk -- then +we give up on secrecy for the transport layer */ corr [skE] /\ [skS] /\ [psk] ==> [channel_secret] /* If the receiver is completely corrupt -- its DH key and the psk -- then @@ -188,73 +294,57 @@ we give up on secrecy for the transport layer */ corr [skR] /\ [psk] ==> [channel_secret] -/* The actual encryption key for data */ -nametype hpke_key_t = - st_aead plaintext_t - aad x. true - nonce send_counter - pattern i. xor(i, gkdf(AuthEncap_shared_secret(), - dh_secret_kdf_ikm(get(psk)), - base_nonce_kdf_info())) +// ===================================================================== +// Ghost functions for AuthEncap/AuthDecap +// +// RESOLVED (I8): gkdf calls use the label-free form gkdf(...) +// rather than the labeled form gkdf; type; index>(...). +// ===================================================================== +/* Diffie-Hellman secrets used in AuthEncap */ +func AuthEncap_dh() = + dh_combine(dhpk(get(skR)), get(skE)) + ++ + dh_combine(dhpk(get(skR)), get(skS)) -/* The type for the DH shared_secret */ -nametype shared_secret_t = - kdf {ikm info self. - (ikm == dh_secret_kdf_ikm(get(psk))) - /\ - info == base_nonce_kdf_info() - -> public nonce |counter|, - (ikm == dh_secret_kdf_ikm(get(psk))) - /\ - info == key_kdf_info() - -> strict st_aead plaintext_t - aad x. true - nonce send_counter - pattern i. xor(i, gkdf(self, - dh_secret_kdf_ikm(get(psk)), base_nonce_kdf_info())), +func AuthEncap_shared_secret() = + gkdf(0x, lbl_ikm(kem_suite_id(), eae_prk(), AuthEncap_dh()), + lbl_info(kem_suite_id(), kdfkey_len(), shared_secret_string(), + AuthEncap_kem_context(dhpk(get(skE))))) - (ikm == dh_secret_kdf_ikm(get(psk))) - /\ - info == export_kdf_info() - -> strict nonce - } - -/* Another "junk secret" */ -nametype shared_secret_corr_t = - kdf {ikm info self. - (ikm == dh_secret_kdf_ikm(get(psk))) - /\ - info == base_nonce_kdf_info() - -> public nonce |counter|, - - (ikm == dh_secret_kdf_ikm(get(psk))) - /\ - info == key_kdf_info() - -> strict hpke_corr_key_t, - - (ikm == dh_secret_kdf_ikm(get(psk))) - /\ - info == export_kdf_info() - -> strict nonce - } +func AuthDecap_dh(eph) = + dh_combine(eph, get(skR)) + ++ + dh_combine(dhpk(get(skR)), get(skS)) -/* Oracle Diffie-Hellman declarations. These specify how the DH secrets may be - * combined together inside of an HKDF call */ -odh ss : skR, skS -> { salt info. - (exists i:idx. info == AuthEncap_honest_info()) -> strict shared_secret_t, - (forall i:idx. info != AuthEncap_honest_info()) -> strict shared_secret_corr_t -} +func AuthDecap_kem_context(eph) = + eph + ++ + dhpk(get(skR)) + ++ + dhpk(get(skS)) + +func AuthDecap_shared_secret(eph) = + gkdf(0x, lbl_ikm(kem_suite_id(), eae_prk(), AuthDecap_dh(eph)), + lbl_info(kem_suite_id(), kdfkey_len(), shared_secret_string(), + AuthDecap_kem_context(eph))) + + +/* The actual encryption key for data. */ +nametype hpke_key_t = + st_aead plaintext_t + aad x. true + nonce send_counter + pattern i. xor(i, gkdf( + AuthEncap_shared_secret(), + dh_secret_kdf_ikm(get(psk)), + base_nonce_kdf_info())) -odh se : skR, skE -> {salt info. - (info == AuthEncap_honest_info()) -> strict shared_secret_t, - (info != AuthEncap_honest_info()) -> strict shared_secret_corr_t -} -struct hpke_ciphertext { +struct hpke_ciphertext { hc_pk : Data | |group| |, hc_cipher : Data } diff --git a/tests/wip/hpke/receiver.owl b/tests/wip/hpke/receiver.owl index 8b4724c2..aaae75db 100644 --- a/tests/wip/hpke/receiver.owl +++ b/tests/wip/hpke/receiver.owl @@ -1,29 +1,22 @@ include "defs.owl" struct AuthDecapResult { - // Ephemeral key. Is ither the correct ephemeral key for session i, or is it + // Ephemeral key. Is either the correct ephemeral key for session i, or is it // not an ephemeral key - adr_eph : (x:Ghost{is_group_elem(x) /\ (x == dhpk(get(skE)) \/ (forall j:idx. x != dhpk(get(skE))))}), + adr_eph : (x:Ghost{is_group_elem(x) /\ (x == dhpk(get(skE)) \/ (forall j:idx. x != dhpk(get(skE))))}), // If the ephemeral key is correct, AND one of the two DH shared secrets are // actually secret, then we get the correct, secret output - adr_shared_secret : + adr_shared_secret : if adr_eph == dhpk(get(skE)) /\ (sec(skR) /\ (sec(skS) \/ sec(skE))) then - SecName(KDF(0x, - lbl_ikm(kem_suite_id(), eae_prk(), AuthDecap_dh(adr_eph)), - lbl_info(kem_suite_id(), kdfkey_len(), shared_secret_string(), AuthDecap_kem_context(adr_eph)))) - // Otherwise, if the static DH shared secret is actually secret, we - // get a "junk" secret that we can rule out later - else if sec(skR) /\ sec(skS) then - SecName(KDF(0x, - lbl_ikm(kem_suite_id(), eae_prk(), AuthDecap_dh(adr_eph)), - lbl_info(kem_suite_id(), kdfkey_len(), shared_secret_string(), AuthDecap_kem_context(adr_eph)))) - // Otherwise, public + SecName(KDF; kdfkey; 0>) else (x:Data ||kdfkey|| { - x == AuthDecap_shared_secret(adr_eph) + x == AuthDecap_shared_secret(adr_eph) }), + // A lemma that says that the derived key is secret if the ephemeral key is correct and one of the two DH shared secrets are actually secret + adr_strict_lem : (x:Ghost{(adr_eph == dhpk(get(skE)) /\ (sec(skR) /\ (sec(skS) \/ sec(skE)))) ==> sec(KDF; kdfkey; 0>)}), // A lemma that says that the shared secret is determined by the identity of - // the ephemeral key + // the ephemeral key adr_shared_secret_inj : (x:Ghost{ (adr_eph == dhpk(get(skE)) <==> adr_shared_secret == AuthEncap_shared_secret()) /\ @@ -31,127 +24,113 @@ struct AuthDecapResult { }) } -def AuthDecap(pkS : dhpk(skS), pkR: dhpk(skR), eph : Data) @ receiver : Option (exists i.AuthDecapResult) = +// TODO: the below code results in an unresolved path error. +// I removed the HPKE_KDF scope prefixes because other things seemed to not work with them. +// If they are necessary for some things but not others, we should unify this. +def AuthDecap(pkS : dhpk(skS), pkR: dhpk(skR), eph : Data) @ receiver : Option (exists i.AuthDecapResult) = // Ensure the ephemeral key is a valid group element - guard is_group_elem(eph) in + guard is_group_elem(eph) in // Is the ephemeral key actually an ephemeral key? - pcase (exists i:idx. eph == dhpk(get(skE))) in - // If it's not, is it a static key of the sender? - pcase (eph == dhpk(get(skS))) when (! (exists i:idx. eph == dhpk(get(skE)))) in + pcase (exists i:idx. eph == dhpk(get(skE))) in // Let i be the index of the ephemeral key (if it is one) - choose_idx i | eph == dhpk(get(skE)) in + choose_idx i | eph == dhpk(get(skE)) in + let eph : if eph == dhpk(get(skE)) then dhpk(skE) else x:Data{x == eph} = eph in let dh = dh_combine(eph, get(skR)) ++ dh_combine(pkS, get(skR)) in let kem_context = eph ++ pkR ++ pkS in - let shared_secret = kdf<; odh ss[0], odh ss[1], odh se[0], odh se[1];kdfkey;0>(0x, - lbl_ikm(kem_suite_id(), eae_prk(), dh), - lbl_info(kem_suite_id(), kdfkey_len(), shared_secret_string(), kem_context)) in - let shared_secret_ghost = gkdf(0x, - lbl_ikm(kem_suite_id(), eae_prk(), dh), - lbl_info(kem_suite_id(), kdfkey_len(), shared_secret_string(), kem_context)) in + let info = lbl_info(kem_suite_id(), kdfkey_len(), shared_secret_string(), kem_context) in + corr_case skS in + corr_case skE in + corr_case skR in + let shared_secret = kdf; kdfkey; 0>(0x, + lbl_ikm(kem_suite_id(), eae_prk(), dh), + info) in + let shared_secret_ghost = gkdf(0x, + lbl_ikm(kem_suite_id(), eae_prk(), dh), + info) in forall j:idx { // This calls out to collision-resistance of the KDF kdf_inj_lemma(shared_secret_ghost, AuthEncap_shared_secret()) }; - let res = AuthDecapResult(eph, shared_secret, ()) in - let pres = pack(res) in + let res = AuthDecapResult(eph, shared_secret, (), ()) in + let pres = pack(res) in Some(pres) - + // Context from the RFC, for the receiver struct ContextR { - ctxtR_eph : (x:Ghost{is_group_elem(x) /\ (x == dhpk(get(skE)) \/ (forall j:idx. x != dhpk(get(skE))))}), - - // This confirmed boolean is similar to the boolean "tkr_recvd" from - // WireGuard. The receiver can't know it's actually talking to the - // sender until it's "confirmed", which it gets by doing a round-trip - // transport message - ctxtR_confirmed : Bool, + ctxtR_eph : (x:Ghost{is_group_elem(x) /\ (x == dhpk(get(skE)) \/ (forall j:idx. x != dhpk(get(skE))))}), ctxtR_ss : (x:Ghost{x == AuthDecap_shared_secret(ctxtR_eph)}), - // If the psk is secret, OR we have a truly secret DH shared secret - // (including that the ephemeral key is correct), then we get the right - // base_nonce. Otherwise public - ctxtR_base : - if (sec(psk) \/ (sec(skR) /\ (sec(skS) \/ (ctxtR_eph == dhpk(get(skE)) /\ sec(skE))))) - then PubName(KDF(ctxtR_ss, - dh_secret_kdf_ikm(get(psk)), base_nonce_kdf_info())) + ctxtR_base : + if ctxtR_eph == dhpk(get(skE)) /\ (sec(psk) \/ (sec(skR) /\ (sec(skS) \/ sec(skE)))) + then PubName(KDF; nonce |counter|; 0>) else Data, - // If the ephemeral key is correct, AND either the psk is secret, or a - // DH shared secret is actually secret, we get the correct, secret - // encryption key ctxtR_sk : if ctxtR_eph == dhpk(get(skE)) /\ (sec(psk) \/ (sec(skR) /\ (sec(skS) \/ sec(skE)))) - then SecName(KDF>(ctxtR_ss, - dh_secret_kdf_ikm(get(psk)), key_kdf_info())) - else - // Otherwise, if we haven't confirmed, but the PSK is still - // secret, or the static DH shared secret is secret, then we get - // the "junk secret" - if (ctxtR_confirmed == false) /\ (sec(psk) \/ (sec(skR) /\ sec(skS))) - then SecName(KDF(ctxtR_ss, dh_secret_kdf_ikm(get(psk)), key_kdf_info())) - else - Data, - // Has a similar correctness guarantee to the base_nonce - ctxtR_export : - if (sec(psk) \/ (sec(skR) /\ (sec(skS) \/ (ctxtR_eph == dhpk(get(skE)) /\ sec(skE))))) - then SecName(KDF(ctxtR_ss, - dh_secret_kdf_ikm(get(psk)), export_kdf_info())) + then SecName(KDF; enckey; 0>) + else + Data, + ctxtR_export : + if ctxtR_eph == dhpk(get(skE)) /\ (sec(psk) \/ (sec(skR) /\ (sec(skS) \/ sec(skE)))) + then SecName(KDF; nonce; 0>) else Data } -def KeyScheduleR(adr : exists i. AuthDecapResult) @ receiver : exists i. ContextR = - unpack i, adr' = adr in - parse adr' as AuthDecapResult(eph, shared_secret, _) in - pcase (eph == dhpk(get(skE))) in - let base_nonce = kdf<0;0;nonce |counter|;0>(shared_secret, dh_secret_kdf_ikm(get(psk)), base_nonce_kdf_info()) in - assert (eph != dhpk(get(skE)) ==> shared_secret != AuthEncap_shared_secret()); - assert (eph != dhpk(get(skE)) ==> (forall j:idx. shared_secret != AuthEncap_shared_secret())); - let sk = kdf<1;1,2;enckey;0>(shared_secret, dh_secret_kdf_ikm(get(psk)), key_kdf_info()) in - let exp = kdf<2;3;nonce;0>(shared_secret, dh_secret_kdf_ikm(get(psk)), export_kdf_info()) in - let res : ContextR = ContextR(eph, false, shared_secret, base_nonce, sk, exp) in +def KeyScheduleR(adr : exists i. AuthDecapResult, psk : Name(psk)) @ receiver : exists i. ContextR = + unpack i, adr' = adr in + parse adr' as AuthDecapResult(eph, shared_secret, _, _) in + pcase (eph == dhpk(get(skE))) in + corr_case psk in + corr_case skR in + corr_case skS in + corr_case skE in + corr_case KDF;kdfkey;0> in + let base_nonce = kdf; nonce |counter|; 0>(shared_secret, dh_secret_kdf_ikm(psk), base_nonce_kdf_info()) in + let sk = kdf; enckey; 0>(shared_secret, dh_secret_kdf_ikm(psk), key_kdf_info()) in + let exp = kdf; nonce; 0>(shared_secret, dh_secret_kdf_ikm(psk), export_kdf_info()) in + let res : ContextR = ContextR(eph, shared_secret, base_nonce, sk, exp) in pack(res) // The result of calling Open -enum OpenMsg { +enum OpenMsg { | SomeMsg Data | NoMsg } -// the state we thread through for Open. +// the state we thread through for Open. struct OpenResult { or_ctxt : ContextR, - or_pt : OpenMsg, - // If Open succeeds with a message, then we have confirmed the secret key - or_wf : (x:Ghost{SomeMsg?(or_pt) ==> ctxtR_confirmed(or_ctxt) == true}) + or_pt : OpenMsg } -def Open(ctxtR : exists i. ContextR, ct_aad : Data, ct : Data) @ receiver : exists i. OpenResult = - unpack i, ctxtR = ctxtR in - parse ctxtR as ContextR(eph, confirmed, ss, bn, sk, exp) in - let ctr = get_counter recv_counter in + +def Open(ctxtR : exists i. ContextR, ct_aad : Data, ct : Data) @ receiver : exists i. OpenResult = + unpack i, ctxtR = ctxtR in + parse ctxtR as ContextR(eph, ss, bn, sk, exp) in + let ctr = get_counter recv_counter in let iv = xor(bn, ctr) in inc_counter recv_counter; - pcase (eph == dhpk(get(skE))) in + pcase (eph == dhpk(get(skE))) in case st_aead_dec(sk, ct, ct_aad, iv) as Option Data<[channel_secret] /\ adv, |adv|> { | Some x => - false_elim in - let ctxtR' = ContextR(eph, true, ss, bn, sk, exp) in + false_elim in + let ctxtR' = ContextR(eph, ss, bn, sk, exp) in assert (eph == dhpk(get(skE)) /\ (sec(psk) \/ (sec(skR) /\ (sec(skS) \/ sec(skE))))) ==> happened(sent_message(x)); - let res : OpenResult = OpenResult(ctxtR', SomeMsg(x), ()) in + let res : OpenResult = OpenResult(ctxtR', SomeMsg(x)) in pack(res) - | None => let res = OpenResult(ctxtR, NoMsg(), ()) in pack(res) - otherwise => let res = OpenResult(ctxtR, NoMsg(), ()) in pack(res) + | None => let res = OpenResult(ctxtR, NoMsg()) in pack(res) + otherwise => let res = OpenResult(ctxtR, NoMsg()) in pack(res) } -def SingleShotOpen(pkS : dhpk(skS), pkR : dhpk(skR)) @ receiver : Option (exists i. OpenResult) = - input i in +def SingleShotOpen(pkS : dhpk(skS), pkR : dhpk(skR), psk : Name(psk)) @ receiver : Option (exists i. OpenResult) = + input i in parse i as hpke_ciphertext(eph, ct) in { let oadr = call AuthDecap(pkS, pkR, eph) in case oadr { | Some adr => { - let ctxt = call KeyScheduleR(adr) in + let ctxt = call KeyScheduleR(adr, psk) in let res = call Open(ctxt, 0x, ct) in Some(res) } @@ -159,8 +138,3 @@ def SingleShotOpen(pkS : dhpk(skS), pkR : dhpk(skR)) @ receiver : Option (exi } } otherwise None() - - - - - diff --git a/tests/wip/hpke/sender.owl b/tests/wip/hpke/sender.owl index 658fb3c7..42664450 100644 --- a/tests/wip/hpke/sender.owl +++ b/tests/wip/hpke/sender.owl @@ -5,29 +5,27 @@ struct AuthEncapResult { // If one of the two DH shared secrets are actually secret, then we get the // correct, secret output; otherwise public output aer_shared_secret : if sec(skR) /\ (sec(skS) \/ sec(skE)) then - SecName(KDF(0x, - lbl_ikm(kem_suite_id(), eae_prk(), AuthEncap_dh()), - lbl_info(kem_suite_id(), kdfkey_len(), shared_secret_string(), AuthEncap_kem_context()))) - else - (x:Data ||kdfkey|| { - x == AuthEncap_shared_secret()}), + SecName(KDF; kdfkey; 0>) + else + (x:Data ||kdfkey|| { + x == AuthEncap_shared_secret()}), aer_pke : dhpk(skE) } /* Corresponds 1-1 with AuthEncap in RFC */ -def AuthEncap(pkR : dhpk(skR), dhpk_skE: dhpk(skE), dhpk_skS: dhpk(skS)) @ sender : AuthEncapResult = - let dh = dh_combine(pkR, get(skE)) ++ dh_combine(pkR, get(skS)) in +def AuthEncap(pkR : dhpk(skR), dhpk_skE: dhpk(skE), dhpk_skS: dhpk(skS)) @ sender : AuthEncapResult = + let dh = dh_combine(pkR, get(skE)) ++ dh_combine(pkR, get(skS)) in let kem_context = dhpk_skE ++ pkR ++ dhpk_skS in - let shared_secret = kdf<; odh ss[0], odh se[0];kdfkey;0>(0x, - lbl_ikm(kem_suite_id(), eae_prk(), dh), lbl_info(kem_suite_id(), kdfkey_len(), shared_secret_string(), - kem_context)) in + let shared_secret = kdf; kdfkey; 0>( + 0x, + lbl_ikm(kem_suite_id(), eae_prk(), dh), + lbl_info(kem_suite_id(), kdfkey_len(), shared_secret_string(), kem_context)) + in let res : if sec(skR) /\ (sec(skS) \/ sec(skE)) then - SecName(KDF(0x, - lbl_ikm(kem_suite_id(), eae_prk(), AuthEncap_dh()), - lbl_info(kem_suite_id(), kdfkey_len(), shared_secret_string(), AuthEncap_kem_context()))) + SecName(KDF; kdfkey; 0>) else Data ||kdfkey|| - = shared_secret in + = shared_secret in AuthEncapResult(res, dhpk_skE) @@ -35,45 +33,44 @@ def AuthEncap(pkR : dhpk(skR), dhpk_skE: dhpk(skE), dhpk_skS: dhpk(skS)) @ struct ContextS { // Shared secret value (in ghost) ctxtS_ss : (x:Ghost{x == AuthEncap_shared_secret()}), - // Base nonce. Only guaranteed to be correct if psk is secret, + // Base nonce. Only guaranteed to be correct if psk is secret, // OR one of the DH shared secrets are fully secret - ctxtS_base : if sec(psk) \/ (sec(skR) /\ (sec(skS) \/ sec(skE))) - then PubName(KDF(ctxtS_ss, - dh_secret_kdf_ikm(get(psk)), base_nonce_kdf_info())) + ctxtS_base : if sec(psk) \/ (sec(skR) /\ (sec(skS) \/ sec(skE))) + then PubName(KDF; nonce |counter|; 0>) else Data, - // Secret key. Same correctness guarantee as the base nonce + // Secret key. Same correctness guarantee as the base nonce ctxtS_sk : - if sec(psk) \/ (sec(skR) /\ (sec(skS) \/ sec(skE))) - then SecName(KDF>(ctxtS_ss, - dh_secret_kdf_ikm(get(psk)), key_kdf_info())) + if sec(psk) \/ (sec(skR) /\ (sec(skS) \/ sec(skE))) + then SecName(KDF; enckey; 0>) else Data, - // Export key. Same correctness guarantee as the base nonce - ctxtS_export : - if sec(psk) \/ (sec(skR) /\ (sec(skS) \/ sec(skE))) - then SecName(KDF(ctxtS_ss, - dh_secret_kdf_ikm(get(psk)), export_kdf_info())) + // Export key. Same correctness guarantee as the base nonce + ctxtS_export : + if sec(psk) \/ (sec(skR) /\ (sec(skS) \/ sec(skE))) + then SecName(KDF; nonce; 0>) else Data } -def KeyScheduleS(aer : AuthEncapResult) @ sender : ContextS = - parse aer as AuthEncapResult(shared_secret, pkE) in - let base_nonce = kdf<0;0;nonce |counter|;0>(shared_secret, - dh_secret_kdf_ikm(get(psk)), base_nonce_kdf_info()) in - let sk = kdf<1;1;enckey;0>(shared_secret, dh_secret_kdf_ikm(get(psk)), key_kdf_info()) in - let exp = kdf<2;3;nonce;0>(shared_secret, dh_secret_kdf_ikm(get(psk)), export_kdf_info()) in +def KeyScheduleS(aer : AuthEncapResult, psk : Name(psk)) @ sender : ContextS = + corr_case psk in + corr_case KDF; kdfkey; 0> in + parse aer as AuthEncapResult(shared_secret, pkE) in + let base_nonce = kdf; nonce |counter|; 0>(shared_secret, + dh_secret_kdf_ikm(psk), base_nonce_kdf_info()) in + let sk = kdf; enckey; 0>(shared_secret, dh_secret_kdf_ikm(psk), key_kdf_info()) in + let exp = kdf; nonce; 0>(shared_secret, dh_secret_kdf_ikm(psk), export_kdf_info()) in ContextS(shared_secret, base_nonce, sk, exp) + def sent_message(x : Ghost) @ sender : Unit = () -def Seal(ctxt : ContextS, x : Data<[channel_secret] /\ adv, |adv|>) @ sender : Data = - parse ctxt as ContextS(_, base, sk, _) in +def Seal(ctxt : ContextS, x : Data<[channel_secret] /\ adv, |adv|>) @ sender : Data = + parse ctxt as ContextS(_, base, sk, _) in call sent_message(x); - st_aead_enc, pattern i. xor(i, base)>(sk, x, 0x) + st_aead_enc, pattern i. xor(i, base)>(sk, x, 0x) -def SingleShotSeal(pkR : dhpk(skR), dhpk_skE: dhpk(skE), dhpk_skS: dhpk(skS), x : Data<[channel_secret] /\ adv, |adv|>) @ sender : Unit = +def SingleShotSeal(pkR : dhpk(skR), dhpk_skE: dhpk(skE), dhpk_skS: dhpk(skS), x : Data<[channel_secret] /\ adv, |adv|>, psk : Name(psk)) @ sender : Unit = let aer = call AuthEncap(pkR, dhpk_skE, dhpk_skS) in - let context = call KeyScheduleS(aer) in - let c = call Seal(context, x) in - parse aer as AuthEncapResult(_, pk) in + let context = call KeyScheduleS(aer, psk) in + let c = call Seal(context, x) in + parse aer as AuthEncapResult(_, pk) in output hpke_ciphertext(pk, c) to endpoint(receiver) - diff --git a/tests/wip/signal/double_ratchet.owl b/tests/wip/signal/double_ratchet.owl new file mode 100644 index 00000000..64b72306 --- /dev/null +++ b/tests/wip/signal/double_ratchet.owl @@ -0,0 +1,323 @@ +/* + +Alice Bob + alice_pk_i=dhpk(ark_i) + ctxt_i +ark_i -------------------> brk_i + enckey_i+1 || rk_i+1 = kdf(rk_i, dh_combine(alice_pk_i, brk_i), 0x) + plaintext_i = aead_decrypt(enckey_i+1, ctxt_i, aad contains alice_pk_i and i) + + +Need an off-chain ODH. 3 cases +1. a == dhpk(ark_i) +2. a == some other valid dhpk ---> off-chain case +3. a is not a valid dhpk ---> should be ruled out by AEAD (?) + + +sec(rk_i) ==> sec(enckey_i+1) ==> aead_decrypt succeeds ==> alice_pk_i must have been authentic + ===> sec(rk_i+1) + +*/ + +locality alice +locality bob + +// Long-term DH keys are kept outside the scope: they appear only in AADs, +// not in any dh_ss(...) rule body. In the full model they will come from X3DH. +name long_skA : DH @ alice // Alice's long-term DH key (never changes) +name long_skB : DH @ bob // Bob's long-term DH key (never changes) + +counter N_c_alice @ alice +counter N_c_bob @ bob + +// Plaintext secrets declared at top level (referenced inside scope nametypes) +name ma3 : nonce @ alice // Alice's first ratchet message +name mb2 : nonce @ bob // Bob's first ratchet message + +// Cleanliness predicate used in function signatures +predicate bob_good() = sec(long_skB) \/ sec(long_skA) + +kdf_scope DR { + + // Ephemeral DH keys used in ODH rules go inside the scope + name ae2 : DH @ alice // Round-2 ephemeral (Alice) + name be2 : DH @ bob // Round-2 ephemeral (Bob) + name ae3 : DH @ alice // Round-3 ephemeral (Alice) + name be3 : DH @ bob // Round-3 ephemeral (Bob, declared for completeness; not yet used in any rule) + + // The handshake output acts as the initial ratchet chain key shared by both parties. + // TODO: whether r1 as a bare kdfkey correctly captures the original handshake + // output's secrecy relative to long_skA/long_skB is an open question. If the + // type-checker cannot prove the required secrecy, we may need an _bad variant + // for LR1 that takes both salt and ikm as parameters. + name r1 : kdfkey @ alice, bob + + // AEAD nametypes for Bob's round-2 ratchet message + nametype mb2_enc = st_aead Name(mb2) + aad x. (x == dhpk(get(be2)) ++ dhpk(get(long_skB))) + nonce N_c_bob + nametype mb2_corr = st_aead (y:Name(mb2){False}) + aad x. true + nonce N_c_bob + + // AEAD nametypes for Alice's round-3 ratchet message + nametype mb3_enc = st_aead Name(ma3) + aad x. (x == dhpk(get(ae3)) ++ dhpk(get(long_skA))) + nonce N_c_alice + nametype mb3_corr = st_aead (y:Name(ma3){False}) + aad x. true + nonce N_c_alice + + // Round 2 ODH: Bob's first ratchet step / Alice receives it. + // Salt = r1 (initial ratchet key from handshake); ikm = DH(ae2, be2). + // Index 0 = new ratchet key; index 1 = AEAD key for mb2_enc. + odh LR1 : r1, dh_ss(ae2, be2), 0x + -> strict kdfkey || strict mb2_enc + odh LR1_bad(s) where (s != dh_combine(dhpk(get(ae2)), get(be2))) + : r1, s, 0x + -> strict kdfkey || strict mb2_corr + + // Round 3 ODH: Alice's first ratchet step using new ae3 against Bob's be2. + // Salt = KDF output of LR1 at index 0 (the ratchet key); ikm = DH(ae3, be2). + // Index 0 = new ratchet key; index 1 = AEAD key for mb3_enc. + odh LR2 : KDF, dh_ss(ae3, be2), 0x + -> strict kdfkey || strict mb3_enc + odh LR2_bad_rk(r) where (r != get(KDF)) : r, dh_ss(ae3, be2), 0x + -> strict kdfkey || strict mb3_corr + odh LR2_bad_dh(s) where (s != dh_combine(dhpk(get(ae3)), get(be2))) + : KDF, s, 0x + -> strict kdfkey || strict mb3_corr + +} + +// ------------ FUTURE DESIGN SKETCH (recursive ratchet) ------------ +// The following is a sketch of how indexed/recursive ratchet rounds might look +// using a rec(i) ODH rule. +// +// kdf_scope SignalRatchet { +// +// name alice_dh : DH @ alice +// name bob_dh : DH @ bob +// +// rec(i) odh ratchet : +// | i = 0 : something_from_the_handshake, dh_combine(alice_dh<0>, bob_dh<0>) -> strict ratchet<1> || strict mb1_enc +// | KDF;kdfkey;0> , dh_combine(alice_dh, bob_dh) -> +// strict ratchet +// || +// strict mb_enc +// +// } + +// def bob_round(state: ...) : state = +// send || recv; +// re-ratchet + +// ------------ CORR AXIOMS (verbatim from original) ------------ + +// These encode the relationship between long-term keys and the ratchet key that +// comes from the handshake +corr [long_skA] ==> [r1] +corr [long_skB] ==> [r1] +corr [r1] ==> [ae2] // r1 is derived from the handshake, and the handshake AEAD guarantees authenticity of ae2 + +corr [r1] /\ [ae2] ==> [mb2] +corr [r1] /\ [be2] ==> [mb2] + +// TODO: should be r2 instead of r1 +corr [r1] /\ [be2] ==> [ma3] +corr [r1] /\ [ae3] ==> [ma3] +// corr [KDF] ==> [ma3] + +corr [r1] /\ [ae2] ==> [be2] // TODO: this is too strong + +corr [be2] ==> [ma3] +corr [ae3] ==> [ma3] + + +// ------------ STRUCTS ------------ + +struct alice_message2 { + _a_pk: dhpk(ae3), + _a_ctxt: Data +} + +struct bob_message1 { + _b5: dhpk(be2), + _b6: Data +} + + +// ------------ COMMENTED-OUT DEFS (ported syntax) ------------ + +// def alice_send_round_3 was commented out in the original. Ported changes: +// - Name(KDF()) -> Name(KDF) +// - kdf<0,1;odh LR2[0];...> -> kdf +// - dh_combine(gbe2, get(ae3)) -> dh_combine(gbe2, get(ae3)) +// - cb3 -> ca3 (bug fix: index-1 output of LR2 call) +// - gae3 -> dhpk(get(ae3)) (bug fix: alice_message2 first field) +// - AAD gbe2 ++ dhpk(get(long_skB)) does not match mb3_enc nametype +// (should be dhpk(get(ae3)) ++ dhpk(get(long_skA))); left as-is. +// +// def alice_send_round_3( +// ra2: if bob_good[] then Name(KDF) else Data ||kdfkey||, +// gbe2: if bob_good[] then dhpk(be2) else Data ||group|| +// ) @ alice: Option Unit = +// let ss_ae3_be2 = dh_combine(gbe2, get(ae3)) in +// // debug printTyOf(gae2'); +// // debug printTyOf(ss_ae3_be2); +// let ra3 = kdf(ra2, ss_ae3_be2, 0x) in +// let ca3 = kdf(ra2, ss_ae3_be2, 0x) in +// // debug "==============================="; +// // debug printTyOf(rb1); +// // debug printTyOf(rb2); +// // debug printTyOf(cb2); +// // debug "==============================="; +// +// let x3 = st_aead_enc(ca3, get(ma3), gbe2 ++ dhpk(get(long_skB))) in +// // output x3 to endpoint(alice); +// let msg = alice_message2(dhpk(get(ae3)), x3) in +// let _ = output msg to endpoint(alice) in +// Some(()) // TODO: call alice_recv_round_4 here + +// Draft bob_send_round_2 body (no signature; from original lines 205-240). +// Ported change: kdf<0,1;odh LR1[0];...> -> kdf +// +// pcase sec(r1) in +// pcase bob_good[] in +// pcase sec(ae2) in +// pcase sec(be2) in +// pcase sec(mb2) in +// pcase sec(long_skA) in +// pcase sec(long_skB) in +// pcase gae2 == dhpk(get(ae2)) in +// false_elim in +// +// let gbe2 = dhpk(get(be2)) in +// +// // rk_i || enckey_i = kdf(salt = rk_{i-1}, ikm = dh_combine(alice_pk_{i-1}, bob_sk_{i-1}), 0x) +// let gae2': if (gae2 == dhpk(get(ae2))) then dhpk(ae2) else Data ||group|| = gae2 in +// pcase (dh_combine(gae2', get(be2)) == dh_combine(dhpk(get(ae2)), get(be2))) in +// pcase (dh_combine(gae2', get(be2)) == dh_combine(dhpk(get(be2)), get(be2))) in +// pcase (dh_combine(gae2', get(be2)) == dh_combine(dhpk(get(ae3)), get(be2))) in +// pcase (dh_combine(gae2', get(be2)) == dh_combine(dhpk(get(be3)), get(be2))) in +// cross_dh_lemma(gae2'); +// false_elim in +// let ss_ae2_be2 = dh_combine(gae2', get(be2)) in +// debug printTyOf(gae2'); +// debug printTyOf(ss_ae2_be2); +// let rb2 = kdf(rb1, ss_ae2_be2, 0x) in +// let cb2 = kdf(rb1, ss_ae2_be2, 0x) in +// debug "==============================="; +// debug printTyOf(rb1); +// debug printTyOf(rb2); +// debug printTyOf(cb2); +// debug "==============================="; +// +// let x2 = st_aead_enc(cb2, get(mb2), gbe2 ++ dhpk(get(long_skB))) in +// // output x2 to endpoint(alice); +// let b2 = bob_message1(gbe2, x2) in +// let _ = output b2 to endpoint(alice) in +// Some(()) // TODO: call bob_double_ratchet_recv here + +def alice_recv_round_2( + ra1: if bob_good[] then Name(r1) else Data ||kdfkey||, + b3: if bob_good[] then dhpk(long_skB) else Data ||group|| +) @ alice: Option Unit = + input i2, _ in + parse i2 as bob_message1(gbe2, a6) in { + // b5 -> gbe2, b6 -> x2 + guard is_group_elem(gbe2) in + pcase #[assume false] sec(r1) in + pcase #[assume true] bob_good[] in + pcase #[assume false] sec(ae2) in + pcase #[assume false] sec(be2) in + pcase #[assume false] sec(mb2) in + pcase #[assume true] sec(long_skA) in + pcase #[assume true] sec(long_skB) in + pcase #[assume true] b3 == dhpk(get(long_skB)) in + pcase #[assume false] gbe2 == dhpk(get(be2)) in + // pcase (dh_combine(gbe2, get(ae2)) == dh_combine(dhpk(get(be2)), get(ae2))) in + // pcase (dh_combine(gbe2, get(ae2)) == dh_combine(dhpk(get(ae2)), get(ae2))) in + // pcase (dh_combine(gbe2, get(ae2)) == dh_combine(dhpk(get(be3)), get(ae2))) in + // pcase (dh_combine(gbe2, get(ae2)) == dh_combine(dhpk(get(ae3)), get(ae2))) in + cross_dh_lemma(gbe2); + false_elim in + + // Pre-bind the DH shared secret so it can be passed to LR1_bad(s) + let s = dh_combine(gbe2, get(ae2)) in + let ra2 = kdf(ra1, s, 0x) in + let ghost ra2_ghost = gkdf(ra1, s, 0x) in + let ca2 = kdf(ra1, s, 0x) in + + let N_c = get_counter N_c_alice in + let mb2_opt = st_aead_dec(ca2, a6, gbe2 ++ b3, N_c) in + case mb2_opt { + | None => None() + | Some mb2 => { + // below is alice_send_round_3 inlined + pcase #[assume true] sec(ae3) in + pcase #[assume false] sec(ma3) in + cross_dh_lemma(gbe2); + false_elim in + // Pre-bind the round-3 DH shared secret so it can be passed to LR2_bad(s3) + let ss_ae3_be2 = dh_combine(gbe2, get(ae3)) in + debug "==============================="; + debug printTyOf(ra2); + debug printTyOf(ss_ae3_be2); + debug "==============================="; + // TODO: the below assume is required to typecheck. These should follow from KDF injectivity, but don't currently + assume (ra2 != get(r1)); + kdf_inj_lemma(ra2_ghost, gkdf(get(r1), dh_combine(dhpk(get(ae2)), get(be2)), 0x)); + // disjoint_not_eq_lemma(ra2_ghost, get(r1)); + let ra3 = kdf(ra2, ss_ae3_be2, 0x) in + let ca3 = kdf(ra2, ss_ae3_be2, 0x) in + let x3 = st_aead_enc(ca3, get(ma3), dhpk(get(ae3)) ++ dhpk(get(long_skA))) in + let msg = alice_message2(dhpk(get(ae3)), x3) in + let _ = output msg to endpoint(alice) in + Some(()) // TODO: call alice_recv_round_4 here + + } + } + } otherwise None() + + +def bob_send_round_2( + rb1: if bob_good[] then Name(r1) else Data ||kdfkey||, + gae2: if bob_good[] then dhpk(ae2) else (x:Data ||group||{corr(ae2)}) +) @ bob: Option Unit = + + pcase sec(r1) in + pcase bob_good[] in + pcase sec(ae2) in + pcase sec(be2) in + pcase sec(mb2) in + pcase sec(long_skA) in + pcase sec(long_skB) in + pcase gae2 == dhpk(get(ae2)) in + false_elim in + + let gbe2 = dhpk(get(be2)) in + + // rk_i || enckey_i = kdf(salt = rk_{i-1}, ikm = dh_combine(alice_pk_{i-1}, bob_sk_{i-1}), 0x) + let gae2': if (gae2 == dhpk(get(ae2))) then dhpk(ae2) else (x:Data ||group||{x == gae2}) = gae2 in + pcase (dh_combine(gae2', get(be2)) == dh_combine(dhpk(get(ae2)), get(be2))) in + pcase (dh_combine(gae2', get(be2)) == dh_combine(dhpk(get(be2)), get(be2))) in + pcase (dh_combine(gae2', get(be2)) == dh_combine(dhpk(get(ae3)), get(be2))) in + pcase (dh_combine(gae2', get(be2)) == dh_combine(dhpk(get(be3)), get(be2))) in + cross_dh_lemma(gae2'); + false_elim in + let ss_ae2_be2 = dh_combine(gae2', get(be2)) in + debug printTyOf(gae2'); + debug printTyOf(ss_ae2_be2); + let rb2 = kdf(rb1, ss_ae2_be2, 0x) in + let cb2 = kdf(rb1, ss_ae2_be2, 0x) in + debug "==============================="; + debug printTyOf(rb1); + debug printTyOf(rb2); + debug printTyOf(cb2); + debug "==============================="; + + let x2 = st_aead_enc(cb2, get(mb2), gbe2 ++ dhpk(get(long_skB))) in + let b2 = bob_message1(gbe2, x2) in + let _ = output b2 to endpoint(alice) in + Some(()) // TODO: call bob_double_ratchet_recv here diff --git a/tests/wip/signal/x3dh.owl b/tests/wip/signal/x3dh.owl index 8bc6f225..182a4931 100644 --- a/tests/wip/signal/x3dh.owl +++ b/tests/wip/signal/x3dh.owl @@ -2,39 +2,110 @@ locality alice locality bob // long-term keys, assumed to be verified out of band -name d : nonce @ alice counter N_c @ alice counter N_c_bob @ bob -name long_skA : DH @ alice // Alices's long-term DH key (never changes) -name long_skB : DH @ bob // Bob's long-term DH key (never changes) - -// Alice's ephemeral DH key (changes per individual connection, generated on the fly) -name ae1 : DH @ alice - -// Bob's ephemeral one-time DH key (changes per individual connection, set of them uploaded to server) -name bo : DH @ bob -// Bob's ephemeral signed DH key (only one uploaded to the server) -name bs : DH @ bob -// there is one `bs` per set of `bo`s - +// names outside the KDF scope name ma1 : nonce @ alice // Alice's first message name ma2 : nonce @ alice // Alice's second message (currently unused) +name mb2 : nonce @ bob // Bob's first ratchet message + +def event_alice_send_msg1 @ alice +def event_bob_recv_msg1 @ bob + + +kdf_scope X3DH { + + // Alice's DH keys + name long_skA : DH @ alice // Alice's long-term DH key (never changes) + name ae1 : DH @ alice // Alice's ephemeral DH key (changes per connection) + name ae2 : DH @ alice // Alice's ephemeral key for the double ratchet + + // Bob's DH keys + name long_skB : DH @ bob // Bob's long-term DH key (never changes) + name bs : DH @ bob // Bob's ephemeral signed DH key (one per set of bo) + name bo : DH @ bob // Bob's ephemeral one-time DH key + name be2 : DH @ bob // Bob's ephemeral key for the double ratchet + + // ---------- HELPER FUNCTIONS AND PREDICATES ----------------------------------- + + func correct_amaster_arg() = + dh_combine(dhpk(get(bs)), get(long_skA)) + ++ dh_combine(dhpk(get(long_skB)), get(ae1)) + ++ dh_combine(dhpk(get(bs)), get(ae1)) + ++ dh_combine(dhpk(get(bo)), get(ae1)) + + func correct_bmaster_arg() = + dh_combine(dhpk(get(long_skA)), get(bs)) + ++ dh_combine(dhpk(get(ae1)), get(long_skB)) + ++ dh_combine(dhpk(get(ae1)), get(bs)) + ++ dh_combine(dhpk(get(ae1)), get(bo)) + + predicate bob_good(dh) = + dh == correct_bmaster_arg() + /\ + // disjunction of both sides of each DH shared secret being secret + ((sec(long_skA) /\ sec(ae1)) \/ (sec(long_skB) /\ sec(bs) /\ sec(bo))) + + + + // AEAD nametype for Alice's first message, keyed under the split of amaster + // TODO: AEAD encryption in Signal contains a KDF inside of the encryption to + // produce the IV. See https://signal.org/docs/specifications/doubleratchet/#recommended-cryptographic-algorithms + nametype ma1_enc(dh) = st_aead Name(ma1) //(if dh == correct_amaster_arg() then Name(ma1) else (x:Name(ma1){False})) + aad x. + ((x == (dhpk(get(ae1)) ++ dhpk(get(long_skA)) ++ dhpk(get(ae2)))) + /\ happened(event_alice_send_msg1(get(ma1), dh))) + nonce N_c + + // nametype ma1_enc = st_aead Name(ma1) + // aad x. (x == (dhpk(get(ae1)) ++ dhpk(get(long_skA)) ++ dhpk(get(ae2)))) + // nonce N_c + + // nametype ma1_corr = st_aead (y:Name(ma1){False}) + // aad x. true + // nonce N_c + + // AEAD nametype for Bob's first ratchet message + nametype mb2_enc = st_aead Name(mb2) + aad x. (x == dhpk(get(be2)) ++ dhpk(get(long_skB))) + nonce N_c_bob + + // ODH rule for the master key derivation. + odh L1 : 0x, dh_ss(bs, long_skA) ++ dh_ss(long_skB, ae1) ++ dh_ss(bs, ae1) ++ dh_ss(bo, ae1), 0x -> strict kdfkey + odh L1_bad(stail) where + (stail != dh_combine(dhpk(get(long_skB)), get(ae1)) ++ dh_combine(dhpk(get(bs)), get(ae1)) ++ dh_combine(dhpk(get(bo)), get(ae1))) + : 0x, dh_ss(bs, long_skA) ++ stail, 0x -> strict kdfkey + + // Chain rule: split amaster (output of L1..L4) into ratchet key + AEAD key. + // Index 0 gives kdfkey (used as rb1/ra1), index 1 gives ma1_enc (used as cb1/ca1). + // kdf LR1 : 0x, KDF, 0x -> strict kdfkey || strict ma1_enc + // kdf LR1_bad(s2++s3++s4) where + // (s2 != dh_combine(dhpk(get(long_skB)), get(ae1)) \/ s3 != dh_combine(dhpk(get(bs)), get(ae1)) \/ s4 != dh_combine(dhpk(get(bo)), get(ae1))) + // : 0x, KDF, 0x -> strict kdfkey || strict ma1_corr + + // Version that unifies ma1_enc and ma1_corr: + kdf LR1 : 0x, KDF, 0x -> strict kdfkey || strict ma1_enc(correct_amaster_arg()) + kdf LR1_bad(stail) where + (stail != dh_combine(dhpk(get(long_skB)), get(ae1)) ++ dh_combine(dhpk(get(bs)), get(ae1)) ++ dh_combine(dhpk(get(bo)), get(ae1))) + : 0x, KDF, 0x -> strict kdfkey || strict ma1_enc(dh_combine(dhpk(get(bs)), get(long_skA)) ++ stail) + + // Bob's first ratchet step (first round of the double ratchet). + // Salt is the ratchet key from LR1; ikm is the new DH shared secret be2/ae2. + odh L2 : KDF, dh_ss(be2, ae2), 0x -> strict nonce || strict mb2_enc -// name long_sskA : sigkey(dhpk(ae1)) @ alice -name long_sskB : sigkey(dhpk(bs)) @ bob - -// ---------- DOUBLE RATCHET NAMES ------------ - -name ae2: DH @ alice // ephemeral -name be2: DH @ bob // ephemeral +} -name mb2: nonce @ bob // Bob's first ratchet message +// Bob's long-term signing key (signs bs for the prekey bundle) +// In Signal, long_sskB and long_skB are the SAME byte sequence (x25519 used for +// both signing and DH). Their corruption is therefore linked via corr below. +name long_sskB : sigkey(dhpk(bs)) @ bob +// ---------- STRUCTS ----------------------------------------------------------- struct bob_prekey_msg { _b1: dhpk(bo), - _b2: dhpk(bs), + _b2: dhpk(bs), _b3: dhpk(long_skB), _b4: Data ||signature|| } @@ -52,176 +123,62 @@ struct bob_message1 { } -func correct_amaster_arg() = - dh_combine(dhpk(get(bs)), get(long_skA)) - ++ dh_combine(dhpk(get(long_skB)), get(ae1)) - ++ dh_combine(dhpk(get(bs)), get(ae1)) - ++ dh_combine(dhpk(get(bo)), get(ae1)) - - -func correct_bmaster_arg() = - dh_combine(dhpk(get(long_skA)), get(bs)) - ++ dh_combine(dhpk(get(ae1)), get(long_skB)) - ++ dh_combine(dhpk(get(ae1)), get(bs)) - ++ dh_combine(dhpk(get(ae1)), get(bo)) - -predicate bob_good(dh) = -// predicate bob_good(a1, a2) = - dh == correct_bmaster_arg() - // ( - // (( - // (dh_combine(a2, get(bs)) == dh_combine(dhpk(get(long_skA)), get(bs))) - // \/ - // (dh_combine(a2, get(bs)) == dh_combine(dhpk(get(ae1)), get(bs))) - // ) - // /\ - // ( - // (dh_combine(a1, get(long_skB)) == dh_combine(dhpk(get(ae1)), get(long_skB))) - // \/ - // (dh_combine(a1, get(long_skB)) == dh_combine(dhpk(get(long_skA)), get(long_skB))) - // ) - // /\ - // ( - // (dh_combine(a1, get(bs)) == dh_combine(dhpk(get(ae1)), get(bs))) - // \/ - // (dh_combine(a1, get(bs)) == dh_combine(dhpk(get(long_skA)), get(bs))) - // )) - // \/ - // (( - // (dh_combine(a1, get(bo)) == dh_combine(dhpk(get(ae1)), get(bo))) - // \/ - // (dh_combine(a1, get(bo)) == dh_combine(dhpk(get(long_skA)), get(bo))) - // )) - // ) - /\ - // disjunction of both sides of each DH shared secret being secret - ((sec(long_skA) /\ sec(ae1)) \/ (sec(long_skB) /\ sec(bs) /\ sec(bo))) - - -// TODO: AEAD encryption in Signal contains a KDF inside of the encryption to produce the -// IV. See https://signal.org/docs/specifications/doubleratchet/#recommended-cryptographic-algorithms -nametype mb2_enc = st_aead Name(mb2) - aad x. (x == dhpk(get(be2)) ++ dhpk(get(long_skB))) - nonce N_c_bob - - -// nametype Bratchet = dualkdf { salt info. -// True -> strict nonce /* TODO: this should be recursive KDF ratchet */ -// || -// strict mb2_enc -// } - -nametype ratchet1 = kdf { ikm info. - True -> strict nonce // TODO: recursive KDF ratchet - || - strict mb2_enc -} -nametype ma1_enc(dh) = st_aead (x:Name(ma1) {dh == correct_bmaster_arg() ==> True /\ dh != correct_bmaster_arg() ==> False}) - aad x. (x == dhpk(get(ae1)) ++ dhpk(get(long_skA)) ++ dhpk(get(ae2))) - nonce N_c - -nametype Amaster(dh) = dualkdf { salt info. - True -> strict ratchet1 - || - strict ma1_enc(dh) -} - - -// ------ ODH DECLS ----------- - -// these need to be stacked instances of KDF names. wireguard -> nametypes -odh L1 : bs, long_skA -> - {salt info self. - True -> strict Amaster(self) - } - -odh L2 : long_skB, ae1 -> - {salt info self. - True -> strict Amaster(self) - } +// ---------- CORRUPTION ASSUMPTIONS -------------------------------------------- -odh L3 : bs, ae1 -> - {salt info self. - True -> strict Amaster(self) - } - -odh L4 : bo, ae1 -> - {salt info self. - True -> strict Amaster(self) - } - -odh L5 : be2, ae2 -> - {salt info self. - True -> strict nonce // TODO: recursive KDF ratchet - || - strict mb2_enc - } - -////// Corruption scenarios (assumptions and modeling details) // In Signal, long_sskA and long_skA are the SAME byte sequence! because signal // uses x25519 keys for both signing and DH. So their corruption must be linked. // corr [long_sskA] ==> [long_skA] // corr [long_skA] ==> [long_sskA] -// ae1 is unsigned in the handshake. So if long_skA is corrupt, then adversary can just create its own -// ae1 and impersonate Alice using the stolen long_skA. +// ae1 is unsigned in the handshake. So if long_skA is corrupt, the adversary can +// create its own ae1 and impersonate Alice using the stolen long_skA. corr [long_skA] ==> [ae1] - -// In Signal, long_sskB and long_skB are the SAME byte sequence! because signal -// uses x25519 keys for both signing and DH. So their corruption must be linked. corr [long_sskB] ==> [long_skB] corr [long_skB] ==> [long_sskB] -// if Bob's long-term signing key is corrupt, then Bob's ephemeral key bs is also corrupt -// (because long_sskB signs bs). bo serves to make each computed premaster secret unique -// per session, but is not meant to provide secrecy by itself, so we assume that if bs is -// corrupted, then bo is also corrupted. +// if Bob's long-term signing key is corrupt, then Bob's ephemeral key bs is also +// corrupt (because long_sskB signs bs). bo serves to make each computed +// premaster secret unique per session but is not meant to provide secrecy by +// itself, so we assume that if bs is corrupted then bo is also corrupted. corr [long_sskB] ==> [bs] corr [bs] ==> [bo] -corr [bs] ==> [long_skA] // <------- TODO: this is an unrealistic modeling artifact. Can we remove it? -corr [ae1] ==> [long_skB] // <------- TODO: this is an unrealistic modeling artifact. Can we remove it? +corr [bs] ==> [long_skA] // <------- TODO: unrealistic modeling artifact. Can we remove it? +corr [ae1] ==> [long_skB] // <------ TODO: unrealistic modeling artifact. Can we remove it? corr [bo] ==> [ae1] // corr [bo] ==> [long_skA] -// These corr assumptions are required because Owl doesn't emit the axiom that if the inputs -// to an ODH declaration are corrupt, then the derived name is also corrupt. +// These corr assumptions are required because Owl doesn't emit the axiom that if +// the inputs to an ODH declaration are corrupt, then the derived name is also corrupt. corr [long_skA] /\ [ae1] ==> [ma1] corr [long_skB] /\ [bs] /\ [bo] ==> [ma1] // corr [ma1] ==> [long_skA] /\ [ae1] // corr [ma1] ==> [long_skB] /\ [bs] /\ [bo] -// TODO: corr-cases should also connect ae2, be2, to the long-term keys? Otherwise rb1 can be corrupt but -// the DH shared secret for Bob's send ratchet may be secret -// Maybe these for ephemeral key corruption? +// TODO: corr-cases should also connect ae2, be2 to the long-term keys? Otherwise +// rb1 can be corrupt but the DH shared secret for Bob's send ratchet may be secret. corr [long_skA] /\ [ae1] ==> [ae2] corr [long_skB] /\ [bs] /\ [bo] ==> [be2] -// These are required because Owl doesn't emit the axiom that if the inputs -// to an ODH declaration are corrupt, then the derived name is also corrupt. +// Required because Owl doesn't emit the axiom that if the inputs to an ODH +// declaration are corrupt, then the derived name is also corrupt. corr [long_skA] /\ [ae1] ==> [mb2] corr [long_skB] /\ [bs] /\ [bo] ==> [mb2] +// ---------- EVENTS ----------------------------------------------------------- +def event_alice_send_msg1(msg: Ghost, dh: Ghost) @ alice : Unit = () +def event_bob_recv_msg1(msg: Ghost, dh: Ghost) @ bob : Unit = () -// def bob_double_ratchet_send( -// dh: Ghost, -// rb1: if bob_good[dh] then Name(KDF(0x,gkdf(0x,dh,0x),0x)) else Data, -// gae2: if bob_good[dh] then dhpk(ae2) else Data ||group|| -// ) @ bob: Option Unit = - -// let gbe2 = dhpk(get(be2)) in -// let rb2 = kdf<0;odh L5[0];nonce || enckey;0>(rb1, dh_combine(gae2, get(be2)), 0x) in -// let cb2 = kdf<0;odh L5[0];nonce || enckey;1>(rb1, dh_combine(gae2, get(be2)), 0x) in -// let x2 = st_aead_enc(cb2, get(mb2), gbe2 ++ dhpk(long_skB)) in -// let b2 = bob_message1(gbe2, x2) in -// let _ = output b2 to endpoint(alice) in -// Some(()) // TODO: call bob_double_ratchet_recv here +// ---------- ALICE'S SIDE ----------------------------------------------------- +// Models Alice checking Bob's Signal security number +def alice_out_of_band_auth (b3: Data ||group||) @ alice + : Option (x:Data||group||{x == b3 /\ x == dhpk(get(long_skB))}) // Alice initiates conversation with Bob by looking up Bob's prekey message -// from the signal server and creating the first alice message +// from the Signal server and creating the first alice message. def alice_x3dh () @ alice : Option Unit = @@ -231,142 +188,190 @@ def alice_x3dh () @ alice input i1, _ in // Bob's prekey message implicitly from Signal server pcase (sec(long_sskB)) in - parse i1 as bob_prekey_msg(b1, b2, b3, b4) in - guard is_group_elem(b1) in - guard is_group_elem(b2) in - guard is_group_elem(b3) in + parse i1 as bob_prekey_msg(b1, b2, b3_unauth, b4) in + guard is_group_elem(b1) in + guard is_group_elem(b2) in + guard is_group_elem(b3_unauth) in case vrfy(long_vkB, b2, b4) { | None => None() - | Some gbs => + | Some gbs => // b1 -> gbo, b2 -> gbs, b3 -> long_pkB, b4 -> gbssig - pcase (sec(ae1)) in - pcase (sec(bs)) in - pcase (sec(bo)) in - pcase (sec(long_skA)) in - pcase (sec(long_skB)) in - false_elim in - pcase (dh_combine(b3, get(ae1)) == dh_combine(dhpk(get(long_skB)), get(ae1))) in - pcase (dh_combine(b3, get(ae1)) == dh_combine(dhpk(get(bo)), get(ae1))) in - pcase (dh_combine(b3, get(ae1)) == dh_combine(dhpk(get(bs)), get(ae1))) in - pcase (dh_combine(b3, get(ae1)) == dh_combine(dhpk(get(be2)), get(ae1))) in - false_elim in - pcase (dh_combine(b1, get(ae1)) == dh_combine(dhpk(get(bo)), get(ae1))) in - pcase (dh_combine(b1, get(ae1)) == dh_combine(dhpk(get(bs)), get(ae1))) in - pcase (dh_combine(b1, get(ae1)) == dh_combine(dhpk(get(be2)), get(ae1))) in - pcase (dh_combine(b1, get(ae1)) == dh_combine(dhpk(get(long_skB)), get(ae1))) in - false_elim in - cross_dh_lemma(gbs); - cross_dh_lemma(b3); - cross_dh_lemma(gbs); - cross_dh_lemma(b1); - let s1 = dh_combine(gbs, get(long_skA)) in - let s2 = dh_combine(b3, get(ae1)) in - let s3 = dh_combine(gbs, get(ae1)) in - let s4 = dh_combine(b1, get(ae1)) in - let dh = s1 ++ s2 ++ s3 ++ s4 in - - let amaster = kdf<;odh L1[0], odh L2[0], odh L3[0], odh L4[0];kdfkey;0>(0x, dh, 0x) in - let ra1 = kdf<;0;kdfkey || enckey;0>(0x, amaster, 0x) in - let ca1 = kdf<;0;kdfkey || enckey;1>(0x, amaster, 0x) in - - pcase sec(ma1) in - false_elim in - let gae2 = dhpk(get(ae2)) in - let x1 = st_aead_enc(ca1, get(ma1), gae1 ++ dhpk(get(long_skA)) ++ gae2) in - let a1 = alice_prekey_msg(gae1, dhpk(get(long_skA)), x1, gae2) in - let _ = output a1 to endpoint(bob) in - Some(()) + // Out-of-band auth assumption. This is a property of Signal + let b3_opt = call alice_out_of_band_auth(b3_unauth) in + case b3_opt { + | None => None() + | Some b3 => { + pcase (b1 == dhpk(get(bo))) in + // pcase (b3 == dhpk(get(long_skB))) in + // let b1' : if (b1 == dhpk(get(bo))) then dhpk(bo) else (x:Data||group||{is_group_elem(x) /\ x == b1}) = b1 in + // let b3' : if (b3 == dhpk(get(long_skB))) then dhpk(long_skB) else (x:Data||group||{is_group_elem(x) /\ x == b3}) = b3 in + pcase (sec(ae1)) in + pcase (sec(bs)) in + pcase (sec(bo)) in + pcase (sec(long_skA)) in + pcase (sec(long_skB)) in + cross_dh_lemma(gbs); + cross_dh_lemma(b3); + cross_dh_lemma(gbs); + cross_dh_lemma(b1); + let s1 = dh_combine(gbs, get(long_skA)) in + let s2 = dh_combine(b3, get(ae1)) in + let s3 = dh_combine(gbs, get(ae1)) in + let s4 = dh_combine(b1, get(ae1)) in + let dh = s1 ++ s2 ++ s3 ++ s4 in + debug printTyOf(dh); + // debug decideProp(dh == correct_amaster_arg()); + // TODO: kdf_inj_lemma??? something like this? + assume(dh != get(KDF)); // TODO: this should be provable somehow + // pcase (dh == correct_amaster_arg()) in + false_elim in + + assert (b3 != dhpk(get(long_skB)) ==> s2 != dh_combine(dhpk(get(long_skB)), get(ae1))); + assert (b1 != dhpk(get(bo)) ==> s4 != dh_combine(dhpk(get(bo)), get(ae1))); + + let amaster = kdf(0x, dh, 0x) in + // // assume (!(exists s2':bv. exists s4':bv. ((s2 != dh_combine(dhpk(get(long_skB)), get(ae1)) \/ s4 != dh_combine(dhpk(get(bo)), get(ae1))) /\ (amaster == dh_combine(dhpk(get(bs)), get(long_skA)) ++ s2' ++ dh_combine(dhpk(get(bs)), get(ae1)) ++ s4')))); // TODO: this should be provable + // assert((b3 != dhpk(get(long_skB)) \/ b1 != dhpk(get(bo))) ==> amaster != get(KDF)); + // Chain: split amaster into ratchet key (ra1) and AEAD key (ca1) + // TODO: info should be 0x not 0x01 + let ra1 = kdf(0x, amaster, 0x) in + let ca1 = kdf(0x, amaster, 0x) in + + pcase sec(ma1) in + false_elim in + let gae2 = dhpk(get(ae2)) in + call event_alice_send_msg1(get(ma1), dh); + let x1 = st_aead_enc(ca1, get(ma1), gae1 ++ dhpk(get(long_skA)) ++ gae2) in + let a1 = alice_prekey_msg(gae1, dhpk(get(long_skA)), x1, gae2) in + let _ = output a1 to endpoint(bob) in + Some(()) + } + } } otherwise None() + +// ---------- BOB'S SIDE ------------------------------------------------------- + +// Models Bob checking Alice's Signal security number +def bob_out_of_band_auth (a2: Data ||group||) @ bob + : Option (x:Data||group||{x == a2 /\ x == dhpk(get(long_skA))}) + + def bob_x3dh () @ bob -: Option Unit = +: Option Unit = let long_pkB = dhpk(get(long_skB)) in let gbo = dhpk(get(bo)) in - let gbs = dhpk(get(bs)) in + let gbs = dhpk(get(bs)) in let gbssig = sign(get(long_sskB), gbs) in let b1 = bob_prekey_msg(gbo, gbs, gbssig, long_pkB) in let _ = output b1 to endpoint(alice) in input i2, _ in - parse i2 as alice_prekey_msg(a1, a2, a3, a4) in { - guard is_group_elem(a1) in - guard is_group_elem(a2) in + parse i2 as alice_prekey_msg(a1, a2_unauth, a3, a4) in { + guard is_group_elem(a1) in + guard is_group_elem(a2_unauth) in guard is_group_elem(a4) in // a1 -> gae1, a2 -> long_pkA, a3 -> x1, a4 -> gae2 - pcase (dh_combine(a2, get(bs)) == dh_combine(dhpk(get(long_skA)), get(bs))) in - pcase (dh_combine(a2, get(bs)) == dh_combine(dhpk(get(ae1)), get(bs))) in - false_elim in - - pcase (dh_combine(a1, get(long_skB)) == dh_combine(dhpk(get(ae1)), get(long_skB))) in - pcase (dh_combine(a1, get(long_skB)) == dh_combine(dhpk(get(long_skA)), get(long_skB))) in - false_elim in - - pcase (dh_combine(a1, get(bs)) == dh_combine(dhpk(get(ae1)), get(bs))) in - pcase (dh_combine(a1, get(bs)) == dh_combine(dhpk(get(long_skA)), get(bs))) in - false_elim in - - pcase (dh_combine(a1, get(bo)) == dh_combine(dhpk(get(ae1)), get(bo))) in - pcase (dh_combine(a1, get(bo)) == dh_combine(dhpk(get(long_skA)), get(bo))) in - false_elim in - - cross_dh_lemma(a2); - cross_dh_lemma(a1); - cross_dh_lemma(a1); - cross_dh_lemma(a1); - - corr_case long_skA in - corr_case ae1 in - corr_case bo in - corr_case bs in - corr_case long_skB in - false_elim in - - let s1 = dh_combine(a2, get(bs)) in - let s2 = dh_combine(a1, get(long_skB)) in - let s3 = dh_combine(a1, get(bs)) in - let s4 = dh_combine(a1, get(bo)) in - let dh = s1 ++ s2 ++ s3 ++ s4 in - - let bmaster = kdf<;odh L1[0], odh L2[0], odh L3[0], odh L4[0];kdfkey;0>(0x, dh, 0x) in - // let rb1: if bob_good[dh] then Name(KDF(0x,bmaster,0x)) else Data - // = kdf<;0;kdfkey || enckey;0>(0x, bmaster, 0x) in - let rb1 = kdf<;0;kdfkey || enckey;0>(0x, bmaster, 0x) in - let cb1 = kdf<;0;kdfkey || enckey;1>(0x, bmaster, 0x) in - - let n_c = get_counter N_c_bob in - corr_case long_skA in - false_elim in - let ma1_opt: Option (if bob_good[dh] then (x:Name(ma1){a1 ++ a2 ++ a4 == dhpk(get(ae1)) ++ dhpk(get(long_skA)) ++ dhpk(get(ae2))}) else Data) = st_aead_dec(cb1, a3, a1 ++ a2 ++ a4, n_c) in - case ma1_opt { + // Out-of-band auth assumption. This is a property of Signal + let a2_opt = call bob_out_of_band_auth(a2_unauth) in + case a2_opt { | None => None() - | Some ma1 => { - // assert(bob_good[dh] ==> a1 ++ a2 ++ a4 == dhpk(get(ae1)) ++ dhpk(get(long_skA)) ++ dhpk(get(ae2))); - assert(bob_good[dh] ==> a4 == dhpk(get(ae2))); - - // debug "----------------------------------------------"; - // debug "----------------------------------------------"; - // debug decideProp(bob_good[dh]); - // debug "----------------------------------------------"; - // debug "----------------------------------------------"; - - // call bob_double_ratchet_send(dh, rb1, a4) - let gae2 = a4 in - - let gbe2 = dhpk(get(be2)) in - - let rb2 = kdf<0;odh L5[0];nonce || enckey;0>(rb1, dh_combine(gae2, get(be2)), 0x) in - let cb2 = kdf<0;odh L5[0];nonce || enckey;1>(rb1, dh_combine(gae2, get(be2)), 0x) in - let x2 = st_aead_enc(cb2, get(mb2), gbe2 ++ dhpk(get(long_skB))) in - let b2 = bob_message1(gbe2, x2) in - let _ = output b2 to endpoint(alice) in - Some(()) // TODO: call bob_double_ratchet_recv here - + | Some a2 => { + pcase (a1 == dhpk(get(ae1))) in + // let a1': if (a1 == dhpk(get(ae1))) then dhpk(ae1) else (x:Data||group||{is_group_elem(x) /\ x == a1}) = a1 in + + // pcase (dh_combine(a2, get(bs)) == dh_combine(dhpk(get(long_skA)), get(bs))) in + // pcase (dh_combine(a2, get(bs)) == dh_combine(dhpk(get(ae1)), get(bs))) in + // false_elim in + + // pcase (dh_combine(a1, get(long_skB)) == dh_combine(dhpk(get(ae1)), get(long_skB))) in + // pcase (dh_combine(a1, get(long_skB)) == dh_combine(dhpk(get(long_skA)), get(long_skB))) in + // false_elim in + + // pcase (dh_combine(a1, get(bs)) == dh_combine(dhpk(get(ae1)), get(bs))) in + // pcase (dh_combine(a1, get(bs)) == dh_combine(dhpk(get(long_skA)), get(bs))) in + // false_elim in + + // pcase (dh_combine(a1, get(bo)) == dh_combine(dhpk(get(ae1)), get(bo))) in + // pcase (dh_combine(a1, get(bo)) == dh_combine(dhpk(get(long_skA)), get(bo))) in + // false_elim in + + corr_case long_skA in + corr_case ae1 in + corr_case bo in + corr_case bs in + corr_case long_skB in + false_elim in + + cross_dh_lemma(a2); + cross_dh_lemma(a1); + cross_dh_lemma(a1); + cross_dh_lemma(a1); + + + let s1 = dh_combine(a2, get(bs)) in + let s2 = dh_combine(a1, get(long_skB)) in + let s3 = dh_combine(a1, get(bs)) in + let s4 = dh_combine(a1, get(bo)) in + let dh = s1 ++ s2 ++ s3 ++ s4 in + + // debug printTyOf(dh); + // debug decideProp(dh == correct_bmaster_arg()); + assume(dh != get(KDF)); // TODO: this should be provable somehow + // pcase (dh == correct_bmaster_arg()) in + false_elim in + + let bmaster = kdf(0x, dh, 0x) in + // Chain: split bmaster into ratchet key (rb1) and AEAD key (cb1) + // TODO: info should be 0x not 0x01 + let rb1 = kdf(0x, bmaster, 0x) in + let cb1 = kdf(0x, bmaster, 0x) in + + let n_c = get_counter N_c_bob in + corr_case long_skA in + false_elim in + let ma1_opt = st_aead_dec(cb1, a3, a1 ++ a2 ++ a4, n_c) in + case ma1_opt { + | None => None() + | Some ma1 => { + debug printTyOf(cb1); + // debug decideProp(bob_good[dh]); + assert(bob_good[dh] ==> a4 == dhpk(get(ae2))); + pcase (a4 == dhpk(get(ae2))) in + corr_case ae2 in + corr_case be2 in + false_elim in + + // AUTH QUERY: if we derived the correct keys and at least one party is + // uncompromised, then we know that Alice must have generated the same + // DH input value and thus the same pre-master secret and first ratchet key. + assert(bob_good[dh] ==> happened(event_alice_send_msg1(ma1, dh))); + call event_bob_recv_msg1(ma1, dh); + + + // Double ratchet first step (inlined from bob_double_ratchet_send): + // rb2 = rk_1 || enckey_1 = KDF(salt=rb1, ikm=DH(ae2_pub, be2), info=0x) + let gae2: if (a4 == dhpk(get(ae2))) then dhpk(ae2) else (x:Data||group||{is_group_elem(x) /\ x == a4}) = a4 in + + let gbe2 = dhpk(get(be2)) in + let dh2 = dh_combine(gae2, get(be2)) in + // debug printTyOf(dh2); + + // New-style ODH call for L2 (bob's first ratchet step) + let rb2 = kdf(rb1, dh2, 0x) in + let cb2 = kdf(rb1, dh2, 0x) in + let x2 = st_aead_enc(cb2, get(mb2), gbe2 ++ dhpk(get(long_skB))) in + let b2 = bob_message1(gbe2, x2) in + let _ = output b2 to endpoint(alice) in + Some(()) // TODO: call bob_double_ratchet_recv here + + } + } } } } otherwise None() - diff --git a/tests/wip/wg/defs.owl b/tests/wip/wg/defs.owl index d2ff391d..cc162d64 100644 --- a/tests/wip/wg/defs.owl +++ b/tests/wip/wg/defs.owl @@ -1,13 +1,13 @@ /* -type := 0x1 (1 byte) +type := 0x1 (1 byte) reserved := 0^3 (3 bytes) sender := I_i (4 bytes) ephemeral (32 bytes) static (32 bytes) timestamp (12 bytes) -mac1 (16 bytes) +mac1 (16 bytes) mac2 (16 bytes) */ @@ -26,48 +26,17 @@ type ty_zeros_32 = Const(0x00000000000000000000000000000000000000000000000000000 locality Initiator : 1 locality Responder : 1 -// Ephemeral Diffie-Hellman keys -name E_init : DH @ Initiator -name E_resp : DH @ Responder - -// Static Diffie-Hellman keys (public keys should be preshared) -name S_init<@n> : DH @ Initiator -name S_resp<@m> : DH @ Responder - - -// These specify the preimages of the hashes used in the protocol. -// Used for verification -func h1_pre(s_resp) = crh(crh(construction()) ++ identifier()) ++ s_resp -func h2_pre(s_resp, e_init) = crh(h1_pre(s_resp)) ++ e_init -func h3_pre(s_resp, e_init, c) = crh(h2_pre(s_resp, e_init)) ++ c -func h4_pre(s_resp, e_init, c, ts) = crh(h3_pre(s_resp, e_init, c)) ++ ts -func h5_pre(s_resp, e_init, c, ts, e_resp) = crh(h4_pre(s_resp, e_init, c, ts)) ++ e_resp -func h6_pre(s_resp, e_init, c, ts, e_resp, tau) = crh(h5_pre(s_resp, e_init, c, ts, e_resp)) ++ tau -func honest_H4_pre(c, ts) = h4_pre(dhpk(get(S_resp<@m>)), dhpk(get(E_init)), c, ts) // These names are used to express the information flow label of secret data // flowing through the record layer. Intuitively, the label -// [channel_secret_init_send<@n,m>] is the label of secret data flowing from the -// n'th initiator to the m'th responder. -name channel_secret_init_send<@n,m> : nonce -name channel_secret_resp_send<@n,m> : nonce - -// These lines further specify the corruption model we consider. - -// If an initiator's secret and ephemeral key (for any session) is corrupt, then -// that initiator's channel_secret_init_send label is corrupt -corr [S_init<@n>] /\ [E_init] ==> [channel_secret_init_send<@n,m>] +// [channel_secret_init_send<@n,m>] is the label of secret data flowing from the +// n'th initiator to the m'th responder. +name channel_secret_init_send<@n,m> : nonce +name channel_secret_resp_send<@n,m> : nonce -// This label is also corrupt if the responder's static key is corrupt -corr [S_resp<@m>] ==> [channel_secret_init_send<@n,m>] - -// The conditions are dual for the label that specifies data going from the -// responder to the initiator. -corr [S_resp<@m>] /\ [E_resp] ==> [channel_secret_resp_send<@n,m>] -corr [S_init<@n>] ==> [channel_secret_resp_send<@n,m>] -// These specify local, mutable, monotonic counters used for +// These specify local, mutable, monotonic counters used for // stateful AEAD nonces counter N_init_send @ Initiator counter N_init_recv @ Initiator @@ -75,25 +44,25 @@ counter N_resp_send @ Responder counter N_resp_recv @ Responder // These are forward declared methods used to define Owl's authentication -// guarantees. -def key_confirm_initiator_send<@n> @ Initiator // (k : Ghost) @ Initiator : Unit = () -def key_confirm_initiator_recv<@n> @ Initiator // (k : Ghost) @ Initiator : Unit = () -def key_confirm_responder_send<@m> @ Responder // (k : Ghost) @ Responder : Unit = () -def key_confirm_responder_recv<@m> @ Responder // (k : Ghost) @ Responder : Unit = () +// guarantees. +def key_confirm_initiator_send<@n> @ Initiator // (k : Ghost) @ Initiator : Unit = () +def key_confirm_initiator_recv<@n> @ Initiator // (k : Ghost) @ Initiator : Unit = () +def key_confirm_responder_send<@m> @ Responder // (k : Ghost) @ Responder : Unit = () +def key_confirm_responder_recv<@m> @ Responder // (k : Ghost) @ Responder : Unit = () def init_sent_message<@n> @ Initiator def resp_sent_message<@m> @ Responder -// We now get into the invariants of the protocol, which are specfied via name -// types. +// We now get into the invariants of the protocol, which are specified via name +// types. // The type for encryption keys for transport-layer data, from the initiator to -// the sender. -nametype transp_key_init_send<@n,m> = +// the sender. +nametype transp_key_init_send<@n,m> = // This type says: data with label - // channel_secret_init_send<@n,m>, and we know that + // channel_secret_init_send<@n,m>, and we know that // the initiator actually send that message (the happened // predicate is like CryptoVerif's events) st_aead (x : Data], |adv|> { happened(init_sent_message<@n>(x))}) @@ -101,152 +70,20 @@ nametype transp_key_init_send<@n,m> = nonce N_init_send // Dual for the responder -nametype transp_key_resp_send<@n,m> = +nametype transp_key_resp_send<@n,m> = st_aead (x : Data], |adv|>{ happened(resp_sent_message<@m>(x)) }) aad x. true nonce N_resp_send -// Types for the KDF hash chain secrets -nametype C7<@n,m> = kdf {ikm info. - True -> - strict transp_key_init_send<@n,m> - || - strict transp_key_resp_send<@n,m> -} - -nametype transp_key_init_send_corr = +nametype transp_key_init_send_corr = st_aead (x:Data{False}) aad x. true nonce N_init_send -nametype transp_key_resp_send_corr = +nametype transp_key_resp_send_corr = st_aead (x:Data{False}) aad x. true nonce N_resp_send - -// Due to the unauthenticated nature of WireGuard, we can't guarantee at all -// points of the protocol that we have the correct value of the KDF chain. -// these "_corr" values are the specifications for the "incorrect" values. -// If you look at the specification for encryption keys (given above), we -// see that they are specified to encrypt data refined at False; i.e., -// they are never actually used as encryption keys. This is useful for -// verification of the responder, who may then rule out this case if they -// decrypt data under this key. -nametype C7_corr = kdf {ikm info. - True -> - strict transp_key_init_send_corr - || - strict transp_key_resp_send_corr -} - -counter aead_counter_msg2_C7 @ Responder - -predicate valid_h6(h) = - exists m:idx,j:idx,einit:bv,c:bv,ts:bv,tau:bv. - h == crh(h6_pre(dhpk(get(S_resp<@m>)), einit, c, ts, dhpk(get(E_resp)), tau)) - -func honest_c1() = - gkdf(crh(construction()), dhpk(get(E_init)), 0x) - -func honest_c2() = - gkdf(honest_c1(), - dh_combine(dhpk(get(E_init)), get(S_resp<@m>)), 0x) - -func honest_c3() = - gkdf(honest_c2(), - dh_combine(dhpk(get(S_init<@n_pk>)), get(S_resp<@m>)), - 0x - ) - - -func honest_c4() = - gkdf(honest_c3(), - dhpk(get(E_resp)), - 0x - ) - -func honest_c5() = - gkdf(honest_c4(), - dh_combine(dhpk(get(E_init)), get(E_resp)), - 0x - ) - -func honest_c6() = - gkdf(honest_c5(), - dh_combine(dhpk(get(S_init<@n_pk>)), get(E_resp)), - 0x - ) - -func honest_c7() = - gkdf(honest_c6(), - 0x, - 0x - ) - - -func tk1_of_c6(x, psk) = gkdf(gkdf(x, psk, 0x), 0x, 0x) -func tk2_of_c6(x, psk) = gkdf(gkdf(x, psk, 0x), 0x, 0x) - -nametype C6_dual<@n, m> = dualkdf {salt info self . - (exists i:idx,j:idx. salt == honest_c6()) -> strict C7<@n,m> || public nonce || - strict st_aead (Data |0|) - aad x. valid_h6[x] /\ happened(key_confirm_responder_recv<@m>(tk1_of_c6(salt, self))) - /\ happened(key_confirm_responder_send<@m>(tk2_of_c6(salt, self))) - nonce aead_counter_msg2_C7, - (forall i:idx,j:idx. salt != honest_c6()) -> strict C7_corr || public nonce || - strict st_aead (Data |0|) - aad x. valid_h6[x] - nonce aead_counter_msg2_C7 -} - -// The pre-shared key between initiator and responder. We assume for now we have -// one PSK between each pair -name psk<@n,m> : C6_dual<@n,m> // @ Initiator, Responder - -enum PSKMode { - | HasPSK Name(psk<@n,m>) - | NoPSK -} - -nametype C6_corr = kdf {ikm info. - True -> strict C7_corr || public nonce || - strict st_aead (Data |0|) // (x:(Data |0|){False}) - aad x. valid_h6[x] - nonce aead_counter_msg2_C7 -} - - -nametype C6<@n, m> = kdf {ikm info self. - (ikm == 0x0000000000000000000000000000000000000000000000000000000000000000 \/ ikm == get(psk<@n,m>)) -> - strict C7<@n,m> || public nonce || - strict st_aead (Data |0|) - aad x. valid_h6[x] /\ happened(key_confirm_responder_recv<@m>(tk1_of_c6(self, ikm))) - /\ happened(key_confirm_responder_send<@m>(tk2_of_c6(self, ikm))) - nonce aead_counter_msg2_C7 -} - - -nametype C5_corr = kdf {ikm info. - True -> strict C6_corr -} - - -nametype C5<@n,m> = kdf {ikm info. - True -> - strict C6<@n,m> -} - - - -nametype C4_corr = kdf {ikm info. - True -> strict C5_corr -} - -nametype C4<@n,m> = kdf {ikm info. - (exists i:idx,j:idx. ikm == dh_combine(dhpk(get(E_init)), get(E_resp))) -> strict C5<@n,m>, - (forall i:idx,j:idx. ikm != dh_combine(dhpk(get(E_init)), get(E_resp))) -> strict C5_corr -} // This is just useful for verification. Incurs no runtime overhead locality nobody @@ -254,109 +91,294 @@ counter useless @ nobody nametype useless_enc = st_aead (x:Data | |group| |{False}) aad x. False nonce useless - - -nametype C3<@n,m> = kdf {ikm info. - (exists j:idx. ikm == dhpk(get(E_resp))) -> strict C4<@n,m> || strict useless_enc, - (forall j:idx. ikm != dhpk(get(E_resp))) -> strict C4_corr || strict useless_enc - // !(exists j:idx. ikm == dhpk(get(E_resp))) -> strict C4_corr<@n,m> || strict useless_enc -} - -nametype C3_corr = kdf {ikm info. - True -> strict C4_corr || strict useless_enc -} +counter aead_counter_msg2_C7 @ Responder counter aead_counter_msg1_C3 @ Initiator +counter aead_counter_msg1_C2 @ Initiator -predicate h3_pred(h) = - exists n:idx,m:idx,i:idx,c:bv. - h == crh(h3_pre(dhpk(get(S_resp<@m>)), dhpk(get(E_init)), c)) - -nametype C2<@n,m> = kdf {ikm info. - True -> strict C3<@n,m> || strict st_aead (Data |12|) - aad x. h3_pred[x] - nonce aead_counter_msg1_C3 -} +// ===================================================================== +// KDF Group: WG_KDF +// +// The KDF chain in WireGuard proceeds as follows: +// C1 = KDF(crh(construction()), dhpk(E_init), 0x) +// C2 = KDF(C1, dh(E_init, S_resp), 0x) [ODH L1] +// C3 = KDF(C2, dh(S_init, S_resp), 0x) [ODH L2] +// C4 = KDF(C3, dhpk(E_resp), 0x) [kdf L3 — public key in ikm] +// C5 = KDF(C4, dh(E_init, E_resp), 0x) [ODH L4] +// C6 = KDF(C5, dh(S_init, E_resp), 0x) [ODH L5] +// C7 = KDF(C6, psk (or zeros_32), 0x) [kdf L6] +// TK = KDF(C7, 0x, 0x) [kdf L7] +// ===================================================================== + +kdf_scope WG_KDF { + + // Ephemeral Diffie-Hellman keys + name E_init : DH @ Initiator + name E_resp : DH @ Responder + + // Static Diffie-Hellman keys + name S_init<@n> : DH @ Initiator + name S_resp<@m> : DH @ Responder + + // Pre-shared key between initiator and responder. + name psk<@n,m> : kdfkey @ Initiator, Responder + + // // Forward-declared nametypes for the intermediate chain keys in the KDF + // // chain (used as salts). + // nametype C2<@n,m> : kdfkey + // nametype C3<@n,m> : kdfkey + // nametype C3_corr : kdfkey + + // nametype C4<@n,m> : kdfkey + // nametype C4_corr : kdfkey + + // nametype C5<@n,m> : kdfkey // refers to a group of types that "hash like C5" + // nametype C5_corr : kdfkey + + // nametype C6<@n,m> : kdfkey + // nametype C6_corr : kdfkey + + // nametype C7<@n,m> : kdfkey + // nametype C7_corr : kdfkey + + // ===================================================================== + // Helper functions for authentication conditions in L6's output type. + // ===================================================================== + func tk1_of_c6(x, psk) = + gkdf( + gkdf(x, psk, 0x), + 0x, 0x) + + func tk2_of_c6(x, psk) = + gkdf( + gkdf(x, psk, 0x), + 0x, 0x) + + + // ===================================================================== + // These specify the preimages of the hashes used in the protocol. + // Used for verification + // ===================================================================== + func h1_pre(s_resp) = crh(crh(construction()) ++ identifier()) ++ s_resp + func h2_pre(s_resp, e_init) = crh(h1_pre(s_resp)) ++ e_init + func h3_pre(s_resp, e_init, c) = crh(h2_pre(s_resp, e_init)) ++ c + func h4_pre(s_resp, e_init, c, ts) = crh(h3_pre(s_resp, e_init, c)) ++ ts + func h5_pre(s_resp, e_init, c, ts, e_resp) = crh(h4_pre(s_resp, e_init, c, ts)) ++ e_resp + func h6_pre(s_resp, e_init, c, ts, e_resp, tau) = crh(h5_pre(s_resp, e_init, c, ts, e_resp)) ++ tau + func honest_H4_pre(c, ts) = h4_pre(dhpk(get(S_resp<@m>)), dhpk(get(E_init)), c, ts) + + + // ===================================================================== + // "Honest" ghost functions for verification: these compute what the + // intermediate KDF chain values should be in an honest execution. + // They are used in kdf_inj_lemma and other proof obligations in + // init.owl and resp.owl. + // ===================================================================== + + func honest_c1() = + gkdf(crh(construction()), dhpk(get(E_init)), 0x) + + func honest_c2() = + gkdf(honest_c1(), + dh_combine(dhpk(get(E_init)), get(S_resp<@m>)), 0x) + + func honest_c3() = + gkdf(honest_c2(), + dh_combine(dhpk(get(S_init<@n_pk>)), get(S_resp<@m>)), + 0x + ) + + func honest_c4() = + gkdf(honest_c3(), + dhpk(get(E_resp)), + 0x + ) + + func honest_c5() = + gkdf(honest_c4(), + dh_combine(dhpk(get(E_init)), get(E_resp)), + 0x + ) + + func honest_c6() = + gkdf(honest_c5(), + dh_combine(dhpk(get(S_init<@n_pk>)), get(E_resp)), + 0x + ) + + func honest_c7() = + gkdf(honest_c6(), + get(psk<@n_pk,m>), + 0x + ) + + + predicate valid_h6(h) = + exists m:idx,j:idx,einit:bv,c:bv,ts:bv,tau:bv. + h == crh(h6_pre(dhpk(get(S_resp<@m>)), einit, c, ts, dhpk(get(E_resp)), tau)) + + predicate h3_pred(h) = + exists n:idx,m:idx,i:idx,c:bv. + h == crh(h3_pre(dhpk(get(S_resp<@m>)), dhpk(get(E_init)), c)) + + + + // ----------------------------------------------------------------- + // Rule L1: Derive C2 and enckey for S_init via ODH (E_init x S_resp) + // TODO: Can we just have `honest_c1()` for salt + // ----------------------------------------------------------------- + odh L1 : honest_c1(), dh_ss(E_init, S_resp<@m>), 0x -> + strict kdfkey || + strict st_aead (dhpk(S_init<@n>)) + aad x. true + nonce aead_counter_msg1_C2 + + corr [E_init] ==> [KDF;kdfkey||enckey;0>] // TODO: this should be generated by the tool + + // ----------------------------------------------------------------- + // Rule L2 and L2_corr: Derive C3 via ODH (S_init x S_resp) + // L2 covers the case where the salt is an honest C2 for the same n + // that owns S_init<@n>. The corresponding "wrong n_eph" case is L2_corr. + // ----------------------------------------------------------------- + odh L2 : KDF;kdfkey||enckey;0>, dh_ss(S_init<@n>, S_resp<@m>), 0x -> + strict kdfkey || + strict st_aead (Data |12|) + aad x. h3_pred[x] + nonce aead_counter_msg1_C3 + + // Rule L2_corr: Derive C3_corr via ODH — "wrong n_eph" case. + // n_eph is the index of the C2 value's owner; n is the index of S_init. + // The where clause restricts this rule to proof contexts where n_eph != n. + // TODO: multi-index argument like this should be fine? + // odh L2_corr where n_eph !=idx n : KDF;kdfkey||enckey;0>, dh_combine(S_init<@n>, S_resp<@m>), 0x -> + // strict kdfkey || + // strict st_aead (Data |12|) + // aad x. h3_pred[x] + // nonce aead_counter_msg1_C3 + + // ----------------------------------------------------------------- + // Rule L3: Derive C4 from C3 using the responder's ephemeral public key + // `kdf` not `odh` since the information-flow content derives from the kdfkey + // C3 passed as salt + // ----------------------------------------------------------------- + kdf L3 : KDF;kdfkey||enckey;0>, dhpk(get(E_resp)), 0x -> + strict kdfkey || strict useless_enc + + // TODO: is the where clause on L3_corr correct? + // kdf L3_corr<@m>(ikm) where (forall j:idx. ikm != dhpk(get(E_resp))): C3_corr, ikm, 0x -> + // strict C4_corr || strict useless_enc + + // ----------------------------------------------------------------- + // Rule L4: Derive C5 via ODH (E_init x E_resp) + // TODO: should it be index i or j on L3? + // ----------------------------------------------------------------- + odh L4 : KDF;kdfkey||enckey;0>, dh_ss(E_init, E_resp), 0x -> + strict kdfkey + + // odh L4_corr : C4_corr, dh_combine(E_init, E_resp), 0x -> + // strict C5_corr + + // ----------------------------------------------------------------- + // Rule L5: Derive C6 via ODH (S_init x E_resp) + // + // Replaces `odh L5`. The correct case uses an honest C5 + // (produced by L4); the wrong-n_eph case uses a C5 for a different + // party (produced by L5_corr). + // ----------------------------------------------------------------- + odh L5 : KDF;kdfkey;0>, dh_ss(S_init<@n>, E_resp), 0x -> + strict kdfkey + + // odh L5_corr where n_eph !=idx n : C5<@n_eph,m>, dh_combine(S_init<@n>, E_resp), 0x -> + // strict C6_corr + + // ----------------------------------------------------------------- + // Rules L6 / L6_zeros: Derive C7 from C6 using the PSK (or zeros) + // + // The old design used two complementary nametypes: + // - C6_dual<@n,m> (dualkdf: psk in ikm position, condition on salt + // being honest_c6) + // - C6<@n,m> (kdf: condition on ikm being psk or zeros_32) + // + // In the new design, the two cases (HasPSK / NoPSK) become two + // separate rules sharing the same salt type C6<@n,m>. + // ----------------------------------------------------------------- + kdf L6(ikm) where (ikm == 0x0000000000000000000000000000000000000000000000000000000000000000 \/ ikm == get(psk<@n,m>)) : KDF;kdfkey;0>, ikm, 0x -> + strict kdfkey || public nonce || + strict st_aead (Data |0|) + aad x. valid_h6[x] /\ happened(key_confirm_responder_recv<@m>(tk1_of_c6(get(KDF;kdfkey;0>), ikm))) + /\ happened(key_confirm_responder_send<@m>(tk2_of_c6(get(KDF;kdfkey;0>), ikm))) + nonce aead_counter_msg2_C7 + + // kdf L6_zeros<@n,m> : C6<@n,m>, 0x0000000000000000000000000000000000000000000000000000000000000000, 0x -> + // strict C7<@n,m> || public nonce || + // strict st_aead (Data |0|) + // aad x. valid_h6[x] /\ happened(key_confirm_responder_recv<@m>(tk1_of_c6(self, zeros_32()))) + // /\ happened(key_confirm_responder_send<@m>(tk2_of_c6(self, zeros_32()))) + // nonce aead_counter_msg2_C7 + + // kdf L6_corr<@n,m>(ikm) where (ikm == 0x0000000000000000000000000000000000000000000000000000000000000000 \/ ikm == get(psk<@n,m>)) : C6_corr, ikm, 0x -> + // strict C7_corr || public nonce || + // strict st_aead (Data |0|) + // aad x. valid_h6[x] + // nonce aead_counter_msg2_C7 + + // kdf L6_corr_zeros : C6_corr, 0x0000000000000000000000000000000000000000000000000000000000000000, 0x -> + // strict C7_corr || public nonce || + // strict st_aead (Data |0|) + // aad x. valid_h6[x] + // nonce aead_counter_msg2_C7 + + // ----------------------------------------------------------------- + // Rules L7 / L7_corr: Derive transport keys from C7 + // ----------------------------------------------------------------- + kdf L7(ikm) : KDF(ikm);kdfkey||nonce||enckey;0>, 0x, 0x -> + strict transp_key_init_send<@n,m> || + strict transp_key_resp_send<@n,m> -counter aead_counter_msg1_C2 @ Initiator + // kdf L7_corr : C7_corr, 0x, 0x -> + // strict transp_key_init_send_corr || + // strict transp_key_resp_send_corr -// To actually use the Diffie-Hellman secrets, we have these -// "odh" (oracle Diffie-Hellman) declarations, which specify how -// Diffie-Hellman secrets may be combined in the KDF. -odh L1 : - E_init, S_resp<@m> -> {salt info. - salt == honest_c1() -> - strict C2<@n,m> || strict st_aead (dhpk(S_init<@n>)) - aad x. true - nonce aead_counter_msg1_C2 -} - - -odh L2<@n,m> : - S_init<@n>, S_resp<@m> -> {salt info. - (exists i:idx. salt == honest_c2()) -> - strict C3<@n,m> || strict st_aead (Data |12|) - aad x. h3_pred[x] - nonce aead_counter_msg1_C3, - - n_eph !=idx n /\ - (!exists i:idx. salt == honest_c2()) - /\ - (exists i:idx. - salt == honest_c2()) - -> - strict C3_corr || strict st_aead (Data |12|) - aad x. h3_pred[x] - nonce aead_counter_msg1_C3 - - } +} // end kdf_scope WG_KDF -odh L4 : - E_init, E_resp -> {salt info. - salt == honest_c4() - -> strict C5<@n,m>, - salt != honest_c4() - -> strict C5_corr -} -odh L5 : - S_init<@n>, E_resp -> {salt info. - (exists i:idx. salt == honest_c5()) - -> - strict C6<@n,m>, - - - n_eph !=idx n /\ - (! exists i:idx. salt == honest_c5()) /\ - (exists i:idx. - salt == honest_c5() - ) -> - strict C6_corr +// ===================================================================== +// Enum for the PSK mode +// ===================================================================== +enum PSKMode { + | HasPSK Name(psk<@n,m>) + | NoPSK } -nametype C1<@n,m> = kdf {ikm info. - True -> strict C2<@n,m> || strict st_aead (exists n. dhpk(S_init<@n>)) - aad x. true - nonce aead_counter_msg1_C2 -} +// These lines further specify the corruption model we consider. +// If an initiator's secret and ephemeral key (for any session) is corrupt, then +// that initiator's channel_secret_init_send label is corrupt +corr [S_init<@n>] /\ [E_init] ==> [channel_secret_init_send<@n,m>] +// This label is also corrupt if the responder's static key is corrupt +corr [S_resp<@m>] ==> [channel_secret_init_send<@n,m>] + +// The conditions are dual for the label that specifies data going from the +// responder to the initiator. +corr [S_resp<@m>] /\ [E_resp] ==> [channel_secret_resp_send<@n,m>] +corr [S_init<@n>] ==> [channel_secret_resp_send<@n,m>] //////////////////////////// // Message formats -// Byte-precise format of the first message +// Byte-precise format of the first message struct msg1 { _msg1_tag : Const(0x01000000) , _msg1_sender : Data |4| // bytes?? , _msg1_ephemeral : Data | |group| | - , _msg1_static : Data | cipherlen(|group|) | + , _msg1_static : Data | cipherlen(|group|) | , _msg1_timestamp: Data | cipherlen(12) | , _msg1_mac1: Data | |maclen| | , _msg1_mac2: Const(0x00000000000000000000000000000000) // hardcode |maclen|=16 zeros, for now @@ -378,8 +400,8 @@ struct msg2 { struct transp { _transp_tag : Const(0x04000000) , _transp_receiver : Data |4| - , _transp_counter : Data | |counter| | - , _transp_packet : Data + , _transp_counter : Data | |counter| | + , _transp_packet : Data } @@ -398,7 +420,7 @@ def get_sender_i<@n> () @ Initiator : Data |4| // controlled def timestamp_i<@n> () @ Initiator : Data |12| -def get_sender_r<@m> () @ Responder : Data |4| +def get_sender_r<@m> () @ Responder : Data |4| def timestamp_r<@m> () @ Responder : Data |12| @@ -412,12 +434,12 @@ func dh(x, y) = dh_combine(dhpk(x), y) ///////////////////////// // Transport keys for initiator -// Here are the actual security guarantees. +// Here are the actual security guarantees. // As in other work, we need to define the notion of a clean session. // For us, a clean session for the i'th session, between the n'th initiator and // m'th responder, is one where: -predicate init_clean(haspsk, eph) = +predicate init_clean(haspsk, eph) = // We have a psk, and that psk is secret (not corrupted); OR ((haspsk == true) /\ sec(psk<@n,m>)) \/ @@ -426,53 +448,56 @@ predicate init_clean(haspsk, eph) = (sec(S_init<@n>) \/ sec(E_init)) /\ ( - // The responder's static key is secret; OR - sec(S_resp<@m>) - \/ - // The ephermeral key received by the initiator is a correct one, and it is - // secret + // // The responder's static key is secret; OR + // sec(S_resp<@m>) + // \/ + // The ephemeral key received by the initiator is a correct one, and it is + // secret (exists j:idx. eph == dhpk(get(E_resp)) /\ - sec(E_resp) + (sec(S_resp<@m>) \/ sec(E_resp)) ))) // This is the return type of the initiator from the handshake. The important -// part is the last two fields. -struct transp_keys_init { +// part is the last two fields. +struct transp_keys_init { tki_msg2_receiver : Data |4|, tki_msg2_sender : Data |4|, tki_has_psk : Bool, + tki_ikm : Ghost, tki_eph : Ghost, tki_c7 : Ghost, // If the session is clean, then we get secret, authentic keys for the - // transport layer. Otherwise, we get arbitrary public data + // transport layer. Otherwise, we get arbitrary public data + // + // KDF reference updated: KDF; enckey||enckey; 0> tki_k_init_send : if init_clean[tki_has_psk, tki_eph] then - (x:SecName(KDF>(tki_c7,0x, 0x)){ - happened(key_confirm_responder_recv<@m>(x)) /\ + (x:SecName(KDF(tki_ikm); enckey||enckey; 0>){ + happened(key_confirm_responder_recv<@m>(x)) /\ happened(key_confirm_initiator_send<@n>(x)) }) else Data, tki_k_resp_send : if init_clean[tki_has_psk, tki_eph] then - (x:SecName(KDF>(tki_c7, 0x, 0x)){ - happened(key_confirm_responder_send<@m>(x)) /\ + (x:SecName(KDF(tki_ikm); enckey||enckey; 1>){ + happened(key_confirm_responder_send<@m>(x)) /\ happened(key_confirm_initiator_recv<@n>(x)) }) else Data } - +/* ///////////////////////// // (Pre-)Transport keys for initiator -// The responder's notion of a clean session is dual. -// It is indexed by FOUR indices (not three) because it might not be that -// the initiator corresponding to the received ephemeral key is the same one -// as the initiator corresponding to the received public static key. -predicate resp_clean(haspsk, eph) = - // We have a PSK and it is secret; OR +// The responder's notion of a clean session is dual. +// It is indexed by FOUR indices (not three) because it might not be that +// the initiator corresponding to the received ephemeral key is the same one +// as the initiator corresponding to the received public static key. +predicate resp_clean(haspsk, eph) = + // We have a PSK and it is secret; OR (haspsk == true /\ sec(psk<@n_pk, m>)) \/ ( - // The ephemeral key we receive is actually an ephemeral key; AND + // The ephemeral key we receive is actually an ephemeral key; AND (exists i:idx. eph == dhpk(get(E_init))) /\ // Both static keys are secret; OR @@ -483,55 +508,42 @@ predicate resp_clean(haspsk, eph) = \/ (exists i:idx. eph == dhpk(get(E_init)) /\ // Responder's static key is secret, and initiator's ephemeral is - // secret; OR + // secret; OR ((sec(S_resp<@m>) /\ sec(E_init)) \/ - // Both ephemerals are secret. + // Both ephemerals are secret. (sec(E_resp) /\ sec(E_init)))))) -// Return type of responder from handshake. -struct transp_keys_resp { +// Return type of responder from handshake. +struct transp_keys_resp { tkr_msg2_receiver : Data |4|, tkr_msg2_sender : Data |4|, tkr_has_psk : Bool, tkr_eph : Ghost, tkr_c7 : Ghost, - // The responder in WireGuard cannot be sure it's talking to the initiator - // until after the first transport layer message. We model this with the - // tkr_recvd boolean, which (under a clean session) implies that the - // party corresponding to the received ephemeral key actually equals the - // party corresponding to the received static key. - // Note that Owl lets us reason about this detail modularly, while other - // efforts need to glue to first transport message into the handshake for - // security. - - - // This boolean is initially false, but gets set to true after the first - // transport message. - tkr_recvd : (x:Bool{(x == true /\ resp_clean[tkr_has_psk, tkr_eph]) ==> + tkr_recvd : (x:Bool{(x == true /\ resp_clean[tkr_has_psk, tkr_eph]) ==> (n_pk =idx n_eph /\ exists i:idx. tkr_eph == dhpk(get(E_init)))}), - // If we have a clean session, AND n_pk =idx n_eph (the two indices are - // equal, which is implied by the boolean) then we get the correct, - // authenticated, secret key. Otherwise, we get a secret "junk" key that we can - // later rule out, since nobody ever sends a message under that "junk" key + // KDF references updated to use L7 label tkr_k_init_send : if resp_clean[tkr_has_psk, tkr_eph] then - if (n_pk =idx n_eph) /\ exists i:idx. tkr_eph == dhpk(get(E_init)) then - (x:SecName(KDF>(tkr_c7, 0x, 0x)){ + if (n_pk =idx n_eph) /\ exists i:idx. tkr_eph == dhpk(get(E_init)) then + (x:SecName(KDF; enckey||enckey; 0>){ happened(key_confirm_responder_recv<@m>(x)) }) else - (x:SecName(KDF(tkr_c7, 0x, 0x)){ + (x:SecName(KDF){ happened(key_confirm_responder_recv<@m>(x)) }) else - Data, + Data, tkr_k_resp_send : if resp_clean[tkr_has_psk, tkr_eph] then - if n_pk =idx n_eph /\ exists i:idx. tkr_eph == dhpk(get(E_init)) then - (x:SecName(KDF>(tkr_c7, 0x, 0x)){ + if n_pk =idx n_eph /\ exists i:idx. tkr_eph == dhpk(get(E_init)) then + (x:SecName(KDF; enckey||enckey; 1>){ happened(key_confirm_responder_send<@m>(x)) }) else - (x:SecName(KDF(tkr_c7, 0x, 0x)){ + (x:SecName(KDF){ happened(key_confirm_responder_send<@m>(x)) }) - else Data + else Data } + +*/ \ No newline at end of file diff --git a/tests/wip/wg/init.owl b/tests/wip/wg/init.owl index b0d08ad2..538b348d 100644 --- a/tests/wip/wg/init.owl +++ b/tests/wip/wg/init.owl @@ -2,122 +2,429 @@ include "defs.owl" // Code for the initiator (just the handshake) -// Is eph an ephemeral key for the responder? -predicate is_e_resp(eph) = +// Is eph an ephemeral key for the responder? +predicate is_e_resp(eph) = exists m:idx,j:idx. eph == dhpk(get(E_resp)) // Is eph a static key for the responder? -predicate is_s_resp(eph) = +predicate is_s_resp(eph) = exists m:idx. eph == dhpk(get(S_resp<@m>)) predicate init_safe() = - (sec(S_resp<@m>) /\ sec(E_init)) + (sec(S_resp<@m>) /\ sec(E_init)) \/ - (sec(S_resp<@m>) /\ sec(S_init<@n>)) + (sec(S_resp<@m>) /\ sec(S_init<@n>)) + +def key_confirm_initiator_send<@n>(k : Ghost) @ Initiator : Unit = () +def key_confirm_initiator_recv<@n>(k : Ghost) @ Initiator : Unit = () -def key_confirm_initiator_send<@n>(k : Ghost) @ Initiator : Unit = () -def key_confirm_initiator_recv<@n>(k : Ghost) @ Initiator : Unit = () - // Intermediate state for the initiator, after stage 1 (the first message) struct init_sent_state { - iss_c2 : (x:Ghost{x == honest_c2()}), iss_psk : PSKMode, iss_static_ss : (x:Ghost{x == dh_combine(dhpk(get(S_init<@n>)), get(S_resp<@m>))}), - ss_h4 : (x:Data ||crh|| {exists c:bv,ts:bv. x == crh(honest_H4_pre(c, ts))}), + ss_h4 : (x:Data ||crh|| {exists c:bv,ts:bv. x == crh(honest_H4_pre(c, ts))}), iss_c3 : if init_safe[] then - SecName(KDF>(iss_c2, iss_static_ss, 0x)) + SecName(KDF; kdfkey||enckey; 0>) else (x:Data{x == honest_c3()}) } def init_stage1 (dhpk_S_resp : dhpk(S_resp<@m>), dhpk_S_init : - dhpk(S_init<@n>), ss_S_resp_S_init: shared_secret(S_init<@n>, S_resp<@m>), + dhpk(S_init<@n>), ss_S_resp_S_init: shared_secret(S_init<@n>, S_resp<@m>), psk : PSKMode) @ - Initiator : init_sent_state = + Initiator : init_sent_state = let C0 = crh(construction()) in - let H0 = crh(C0 ++ identifier()) in + let H0 = crh(C0 ++ identifier()) in let H1 = crh(H0 ++ dhpk_S_resp) in - let e_init = dhpk(get(E_init)) in - let C1 = kdf<;;kdfkey;0>(C0, e_init, 0x) in + let e_init = dhpk(get(E_init)) in + // C1 is publicly computable; no kdf_scope rule needed, use unlabeled kdf + let C1 = kdf<;kdfkey;0>(C0, e_init, 0x) in let H2 = crh(H1 ++ e_init) in let ss_S_resp_E_init = dh_combine(dhpk_S_resp, get(E_init)) in - let C2 = kdf<;odh L1[0]; kdfkey||enckey; 0>(C1, ss_S_resp_E_init, 0x) in - let k0 = kdf<;odh L1[0]; kdfkey||enckey; 1>(C1, ss_S_resp_E_init, 0x) in - let msg1_static - = st_aead_enc>(k0, dhpk_S_init, H2) in + // Derive C2 and k0 via ODH L1 (E_init x S_resp) + let C2 = kdf; kdfkey||enckey; 0>(C1, ss_S_resp_E_init, 0x) in + let k0 = kdf; kdfkey||enckey; 1>(C1, ss_S_resp_E_init, 0x) in + let msg1_static + = st_aead_enc>(k0, dhpk_S_init, H2) in let H3 = crh(H2 ++ msg1_static) in - let c3 = kdf<0;odh L2<@n,m>[0]; kdfkey || enckey; 0>(C2, ss_S_resp_S_init, 0x) in - let k1 = kdf<0;odh L2<@n,m>[0]; kdfkey || enckey; 1>(C2, ss_S_resp_S_init, 0x) in + // Derive C3 and k1 via ODH L2 (S_init x S_resp) + corr_case S_init<@n> in + let c3 = kdf; kdfkey || enckey; 0>(C2, ss_S_resp_S_init, 0x) in + let k1 = kdf; kdfkey || enckey; 1>(C2, ss_S_resp_S_init, 0x) in let timestamp = call timestamp_i<@n>() in - let msg1_timestamp = - st_aead_enc>(k1, timestamp, H3) in + let msg1_timestamp = + st_aead_enc>(k1, timestamp, H3) in let h4 = crh(H3 ++ msg1_timestamp) in let msg1_sender : Data |4| = call get_sender_i<@n>() in - let msg1_tag = msg1_tag_value() in + let msg1_tag = msg1_tag_value() in - let msg1_mac1_k = crh(mac1() ++ dhpk_S_resp) in - let msg1_mac1 = mac(msg1_mac1_k, + let msg1_mac1_k = crh(mac1() ++ dhpk_S_resp) in + let msg1_mac1 = mac(msg1_mac1_k, msg1_tag ++ msg1_sender ++ e_init ++ msg1_static ++ msg1_timestamp) in let msg1_mac2 = zeros_16() in let msg1_output = msg1(msg1_tag, msg1_sender, e_init, msg1_static, msg1_timestamp, msg1_mac1, msg1_mac2) in - output msg1_output; - init_sent_state(C2, psk, ss_S_resp_S_init, h4, c3) + output msg1_output; + init_sent_state(psk, ss_S_resp_S_init, h4, c3) def init_stage2 (st : init_sent_state) @ - Initiator : Option transp_keys_init = + Initiator : Option (exists j. transp_keys_init) = set_option ":rlimit" "7000000" in // Z3 settings - parse st as init_sent_state(c2, opsk, static_ss, h4, c3) - in + parse st as init_sent_state(opsk, static_ss, h4, c3) + in input i in - parse i as msg2(msg2_tag, msg2_sender, msg2_receiver, msg2_ephemeral, - msg2_empty_enc, msg2_mac1, msg2_mac2) in + pcase #[assume true] + init_safe[] + in + parse i as msg2(msg2_tag, msg2_sender, msg2_receiver, msg2_ephemeral, msg2_empty_enc, msg2_mac1, msg2_mac2) in { // This guard is a runtime check guard andb(eq(length(msg2_sender), 4), eq(length(msg2_receiver), 4)) in - guard is_group_elem(msg2_ephemeral) in - let e_init = get(E_init) in + guard is_group_elem(msg2_ephemeral) in + let e_init = get(E_init) in + pcase #[assume false] (exists j:idx. msg2_ephemeral == dhpk(get(E_resp))) in + choose_idx j | msg2_ephemeral == dhpk(get(E_resp)) in + assert ( + msg2_ephemeral != dhpk(get(E_resp)) ==> + !(exists i':idx, j':idx, n':idx, m':idx. c3 == get(KDF; kdfkey||enckey; 0>) /\ msg2_ephemeral == dhpk(get(E_resp))) + ); + + forall i':idx, n':idx { + kdf_inj_lemma(honest_c1(), honest_c3()) + }; + + forall i':idx, n':idx { + kdf_inj_lemma(honest_c1(), honest_c4()) + }; + + // // True + // assert (c3 == honest_c3()); + + + let c4 = kdf; kdfkey || enckey; 0>(c3, msg2_ephemeral, 0x) in + + // TODO: can we have a tactic that says "call KDF injectivity as much as possible?" + // After every KDF call, construct the following sequence of lemmas: + // Let t := gkdf expression for every kdfkey generated by the kdf call + // eg, gkdf(c3, msg2_ephemeral, 0x) + // For every KDF rule in scope, make the following lemma: + // For every index, kdf_inj_lemma(KDF rule's preimage as a gkdf, and t) + + // TODO: First actually do this manually and ensure that WG works + // Then, implement the thing + + // // L1 + // forall i':idx, n':idx { + // kdf_inj_lemma(honest_c1(), gkdf(c3, msg2_ephemeral, 0x)) + // }; + // // L2 + // forall i':idx, n':idx, m':idx { + // kdf_inj_lemma(honest_c2(), gkdf(c3, msg2_ephemeral, 0x)) + // }; + // // L3 + // forall i':idx, n':idx, m':idx { + // kdf_inj_lemma(honest_c3(), gkdf(c3, msg2_ephemeral, 0x)) + // }; + // // L4 + // forall i':idx, j':idx, n':idx, m':idx { + // kdf_inj_lemma(honest_c4(), gkdf(c3, msg2_ephemeral, 0x)) + // }; + // // L5 + // forall i':idx, j':idx, n':idx, m':idx { + // kdf_inj_lemma(honest_c5(), gkdf(c3, msg2_ephemeral, 0x)) + // }; + // // L6 + // forall i':idx, j':idx, n':idx, m':idx { + // kdf_inj_lemma(honest_c6(), gkdf(c3, msg2_ephemeral, 0x)) + // }; + // // L7 + // forall i':idx, j':idx, n':idx, m':idx { + // kdf_inj_lemma(honest_c7(), gkdf(c3, msg2_ephemeral, 0x)) + // }; + + + + // True + // assert (c4 != honest_c4()); + + let h5 = crh(h4 ++ msg2_ephemeral) in + let ss = dh_combine(msg2_ephemeral, e_init) in + cross_dh_lemma>(msg2_ephemeral); + // forall i':idx, n':idx, m':idx { + // let lem1 = kdf_inj_lemma(honest_c1(), honest_c4()) in + // let lem2 = kdf_inj_lemma(honest_c2(), honest_c4()) in + // let lem3 = kdf_inj_lemma(honest_c3(), honest_c4()) in + // lem1 &&& lem2 &&& lem3 + // }; + + + + + // kdf_inj_lemma(gkdf(c3, msg2_ephemeral, 0x), honest_c1()); + // kdf_inj_lemma(gkdf(c3, msg2_ephemeral, 0x), honest_c4()); + // kdf_inj_lemma(honest_c3(), + // honest_c3()); + // forall n_pk:idx, i':idx { + // let lem1 = kdf_inj_lemma(honest_c3(), + // honest_c3()) in + // let lem2 = kdf_inj_lemma(gkdf(c3, msg2_ephemeral, 0x), honest_c4()) in + // lem1 &&& lem2 + // }; + // assert ((! exists j:idx. msg2_ephemeral == dhpk(get(E_resp))) ==> + // c4 != honest_c4()); + // assume ((! exists j:idx. msg2_ephemeral == dhpk(get(E_resp))) ==> + // forall i':idx, j':idx, n':idx, m':idx. c4 != honest_c4()); + // assert ((! exists j:idx. msg2_ephemeral == dhpk(get(E_resp))) ==> + // ss != dh_combine(dhpk(get(E_init)), get(E_resp))); + + + // assert (forall i':idx, j':idx, n':idx, m':idx. c4 != get(KDF; kdfkey||enckey; 0>)); + corr_case E_init in + corr_case E_resp in + let c5 = kdf; kdfkey; 0>(c4, ss, 0x) in + + // // L1 + // forall i':idx, n':idx { + // kdf_inj_lemma(honest_c1(), gkdf(c4, ss, 0x)) + // }; + // // L2 + // forall i':idx, n':idx, m':idx { + // kdf_inj_lemma(honest_c2(), gkdf(c4, ss, 0x)) + // }; + // // L3 + // forall i':idx, n':idx, m':idx { + // kdf_inj_lemma(honest_c3(), gkdf(c4, ss, 0x)) + // }; + // // L4 + // forall i':idx, j':idx, n':idx, m':idx { + // kdf_inj_lemma(honest_c4(), gkdf(c4, ss, 0x)) + // }; + // // L5 + // forall i':idx, j':idx, n':idx, m':idx { + // kdf_inj_lemma(honest_c5(), gkdf(c4, ss, 0x)) + // }; + // // L6 + // forall i':idx, j':idx, n':idx, m':idx { + // kdf_inj_lemma(honest_c6(), gkdf(c4, ss, 0x)) + // }; + // // L7 + // forall i':idx, j':idx, n':idx, m':idx { + // kdf_inj_lemma(honest_c7(), gkdf(c4, ss, 0x)) + // }; + + + + // let ghost c5_ghost = gkdf(c4_ghost, ss, 0x) in + + // The below proof effort is necessary because WireGuard does not make + // use of the "info" parameter of the KDF. Thus, to ensure the necessary + // authenticity properties for the KDF, we need to reason about the + // identities of the hash chain values (e.g., to make sure they don't + // collide). + + // forall i':idx { + // assert (dh_combine(dhpk(get(S_init<@n>)), get(S_resp<@m>)) != dhpk(get(E_init))); + // kdf_inj_lemma(c5_ghost, honest_c2()); + // kdf_inj_lemma(c5_ghost, honest_c2()); + // let lem1 = assert (c5 != honest_c2()) in + // let lem2 = assert (c5 != honest_c2()) in + // lem1 &&& lem2 + // }; + // assert (! exists i:idx. c5 == honest_c2()); + // assert (! exists i:idx. c5 == honest_c2()); + // forall n_eph:idx,i':idx { + // kdf_inj_lemma(c5_ghost, honest_c2()); + // kdf_inj_lemma(c5_ghost, honest_c2()); + // let lem1 = assert (c5 != honest_c2()) in + // let lem2 = assert (c5 != honest_c2()) in + // lem1 &&& lem2 + // }; + // assert (forall n_eph:idx. + // ! exists i:idx. + // c5 == honest_c2() + // ); + // assert (forall n_eph:idx. + // ! exists i:idx. + // c5 == honest_c2() + // ); + // forall n_eph:idx, i':idx { + // kdf_inj_lemma(c5_ghost, honest_c5()) + // }; + // assert (m !=idx m2 ==> + // ! exists n_eph:idx. + // exists i:idx. + // c5 == honest_c5() + // ); + + // Derive C6 via ODH L5 (S_init x E_resp) + corr_case S_init<@n> in + let ss_msg2_eph_s_init = dh_combine(msg2_ephemeral, get(S_init<@n>)) in + cross_dh_lemma>(msg2_ephemeral); + corr_case KDF;kdfkey;0> when !init_safe[] in + let c6 = kdf; kdfkey; 0>(c5, ss_msg2_eph_s_init, 0x) in + + // // L1 + // forall i':idx, n':idx { + // kdf_inj_lemma(honest_c1(), gkdf(c5, ss_msg2_eph_s_init, 0x)) + // }; + // // L2 + // forall i':idx, n':idx, m':idx { + // kdf_inj_lemma(honest_c2(), gkdf(c5, ss_msg2_eph_s_init, 0x)) + // }; + // // L3 + // forall i':idx, n':idx, m':idx { + // kdf_inj_lemma(honest_c3(), gkdf(c5, ss_msg2_eph_s_init, 0x)) + // }; + // // L4 + // forall i':idx, j':idx, n':idx, m':idx { + // kdf_inj_lemma(honest_c4(), gkdf(c5, ss_msg2_eph_s_init, 0x)) + // }; + // // L5 + // forall i':idx, j':idx, n':idx, m':idx { + // kdf_inj_lemma(honest_c5(), gkdf(c5, ss_msg2_eph_s_init, 0x)) + // }; + // // L6 + // forall i':idx, j':idx, n':idx, m':idx { + // kdf_inj_lemma(honest_c6(), gkdf(c5, ss_msg2_eph_s_init, 0x)) + // }; + // // L7 + // forall i':idx, j':idx, n':idx, m':idx { + // kdf_inj_lemma(honest_c7(), gkdf(c5, ss_msg2_eph_s_init, 0x)) + // }; + + + + // let ghost c6_ghost = gkdf(c5_ghost, dh_combine(msg2_ephemeral, get(S_init<@n>)), 0x) in + // forall i:idx,j:idx { + // kdf_inj_lemma(c6_ghost, honest_c6()) + // }; + // assert ((m !=idx m2 \/ !is_e_resp[msg2_ephemeral]) ==> + // forall i:idx,j:idx. + // c6 != honest_c6() + // ); + // Derive C7 and tau and k0 from C6 using the PSK. + let psk : if HasPSK?(opsk) then Name(psk<@n,m>) else ty_zeros_32 = + case opsk { + | HasPSK v => v + | NoPSK => zeros_32() + } in + pcase HasPSK?(opsk) in + corr_case KDF;kdfkey;0> when !init_safe[] in + corr_case psk<@n,m> in + let c7 = kdf(psk); kdfkey || nonce || enckey; 0>(c6, psk, 0x) in + let tau = kdf(psk); kdfkey || nonce || enckey; 1>(c6, psk, 0x) in + let k0 = kdf(psk); kdfkey || nonce || enckey; 2>(c6, psk, 0x) in + let h6 = crh(h5 ++ tau) in + case st_aead_dec(k0, msg2_empty_enc, h6, 0x) + as Option (Data|0|) { + | None => None() + | Some x => { + forall m':idx,j:idx + assuming (exists einit:bv,c:bv,ts:bv,tau:bv. h6 == crh(h6_pre(dhpk(get(S_resp<@m'>)), einit, c, ts, dhpk(get(E_resp)), tau))) + { + choose_bv einit | exists c:bv,ts:bv,tau:bv. h6 == + crh(h6_pre(dhpk(get(S_resp<@m'>)), einit, c, ts, dhpk(get(E_resp)), tau)) in + choose_bv c | exists ts:bv,tau:bv. h6 == crh(h6_pre(dhpk(get(S_resp<@m'>)), einit, c, ts, dhpk(get(E_resp)), tau)) in + choose_bv ts | exists tau:bv. h6 == crh(h6_pre(dhpk(get(S_resp<@m'>)), einit, c, ts, dhpk(get(E_resp)), tau)) in + choose_bv tau | h6 == crh(h6_pre(dhpk(get(S_resp<@m'>)), einit, c, ts, dhpk(get(E_resp)), tau)) in + crh_lemma(h6, crh(h6_pre(dhpk(get(S_resp<@m'>)), einit, + c, ts, dhpk(get(E_resp)), tau))); + assert (h4 == crh(h4_pre(dhpk(get(S_resp<@m'>)), einit, c, ts))); + choose_bv h4_c | exists h4_ts:bv. h4 == crh(honest_H4_pre(h4_c, h4_ts)) in + choose_bv h4_ts | h4 == crh(honest_H4_pre(h4_c, h4_ts)) in + crh_lemma(crh(h4_pre(dhpk(get(S_resp<@m'>)), einit, c, + ts)), + crh(honest_H4_pre(h4_c, h4_ts)) + ); + assert (m' =idx m); + // assert (m' =idx m2); + assert (is_e_resp[msg2_ephemeral]) + }; + assert(valid_h6[h6] ==> + (is_e_resp[msg2_ephemeral])); + + false_elim in + // Derive transport keys from C7 via L7 + let k1 = kdf(psk); enckey || enckey; 0>(c7, 0x, 0x) in + let k2 = kdf(psk); enckey || enckey; 1>(c7, 0x, 0x) in + let _ = call key_confirm_initiator_send<@n>(k1) in + let _ = call key_confirm_initiator_recv<@n>(k2) in + + // corr_case psk<@n,m> in + + + + debug "=========================================================================================="; + debug "=========================================================================================="; + debug "=========================================================================================="; + debug decideProp(init_clean[HasPSK?(opsk),msg2_ephemeral]); + debug decideProp((HasPSK?(opsk) == true) /\ (sec(psk<@n,m>))); + debug decideProp((sec(S_init<@n>) \/ sec(E_init))); + debug decideProp(sec(S_resp<@m>)); + debug decideProp(exists j:idx. (msg2_ephemeral == dhpk(get(E_resp)) /\ (sec(S_resp<@m>) \/ sec(E_resp)))); + debug "=========================================================================================="; + debug "=========================================================================================="; + debug "=========================================================================================="; + + // TODO: need a different clean session predicate (or some more proof effort) to make this work + None() + // let tki: exists j. transp_keys_init + // = pack(transp_keys_init(msg2_receiver, msg2_sender, HasPSK?(opsk), psk, msg2_ephemeral, c7, k1, k2)) in + + // Some(tki) + } + otherwise => None() + } + /* // Is msg2_ephemeral an actual ephemeral key? - pcase is_e_resp[msg2_ephemeral] in + pcase is_e_resp[msg2_ephemeral] in // If so, let m2, j be the indices for it - choose_idx m2 | exists j:idx. msg2_ephemeral == dhpk(get(E_resp)) in - choose_idx j | msg2_ephemeral == dhpk(get(E_resp)) in - // Is m equal to m2 ? - pcase (m =idx m2) when (msg2_ephemeral == dhpk(get(E_resp))) in - + choose_idx m2 | exists j:idx. msg2_ephemeral == dhpk(get(E_resp)) in + choose_idx j | msg2_ephemeral == dhpk(get(E_resp)) in + // Is m equal to m2 ? + pcase (m =idx m2) when (msg2_ephemeral == dhpk(get(E_resp))) in + // Otherwise, is it a static key? pcase is_s_resp[msg2_ephemeral] when !is_e_resp[msg2_ephemeral] - in - choose_idx m3 | msg2_ephemeral == dhpk(get(S_resp<@m3>)) in - let c4 = kdf<0,1;;kdfkey;0>(c3, msg2_ephemeral, 0x) in - let ghost c4_ghost = gkdf(c3, msg2_ephemeral, 0x) in - let h5 = crh(h4 ++ msg2_ephemeral) in - let ss = dh_combine(msg2_ephemeral, e_init) in + in + choose_idx m3 | msg2_ephemeral == dhpk(get(S_resp<@m3>)) in + // Derive C4 from C3 using the responder's ephemeral public key (rule L3) + let c4 = kdf, L3_corr(msg2_ephemeral); kdfkey; 0>(c3, msg2_ephemeral, 0x) in + let ghost c4_ghost = gkdf(c3, msg2_ephemeral, 0x) in + let h5 = crh(h4 ++ msg2_ephemeral) in + let ss = dh_combine(msg2_ephemeral, e_init) in // cross_dh_lemma states that, given g^x, y, and z, (for random // different values x, y, // and z), it is hard for the // adversary to construct an h such that h^x = g^(y * z) (when x is a - // secret). If it could do so, we can compute discrete log of x. + // secret). If it could do so, we can compute discrete log of x. // The actual lemma call is for x = E_init and h = msg2_ephemeral, // where y and z are the other Diffie-Hellman secrets in the protocol. cross_dh_lemma>(msg2_ephemeral); // These kdf_inj_lemmas state that the KDF is collision resistant - kdf_inj_lemma(gkdf(c3, msg2_ephemeral, 0x), honest_c1()); - kdf_inj_lemma(gkdf(c3, msg2_ephemeral, 0x), honest_c4(c3, msg2_ephemeral, 0x), honest_c1()); + kdf_inj_lemma(gkdf(c3, msg2_ephemeral, 0x), honest_c4()); kdf_inj_lemma(honest_c3(), honest_c3()); @@ -126,7 +433,7 @@ def init_stage2 forall n_pk:idx, i':idx { kdf_inj_lemma(honest_c3(), honest_c3()); - kdf_inj_lemma(gkdf(c3, msg2_ephemeral, 0x), honest_c4(c3, msg2_ephemeral, 0x), honest_c4()); assert ((m !=idx m2 ==> c4 != honest_c4()) @@ -137,17 +444,25 @@ def init_stage2 )) }; - let c5 = kdf<0,1; odh L4[0], odh - L4[1]; kdfkey; 0>(c4, ss, 0x) in + // Derive C5 via ODH L4 (E_init x E_resp) + // Multi-witness case: two ODH instances cover the two possible values of m2. + // ISSUE (I9): The old syntax `kdf<0,1; odh L4[0], odh L4[1]; kdfkey; 0>` + // carried two salt indices (0,1) and two ODH witnesses simultaneously. + // In the new syntax, each label covers one rule application. If the + // verifier needs to branch on whether m == m2, two separate kdf calls + // may be needed (one per branch). Here we use both labels separated by + // a comma, which is tentative syntax — the actual multi-label + // mechanism needs to be specified. + let c5 = kdf, L4; kdfkey; 0>(c4, ss, 0x) in - let ghost c5_ghost = gkdf(c4_ghost, ss, 0x) in + let ghost c5_ghost = gkdf(c4_ghost, ss, 0x) in cross_dh_lemma>(msg2_ephemeral); // The below proof effort is necessary because WireGuard does not make // use of the "info" parameter of the KDF. Thus, to ensure the necessary // authenticity properties for the KDF, we need to reason about the // identities of the hash chain values (e.g., to make sure they don't - // collide). + // collide). forall i':idx { assert (dh_combine(dhpk(get(S_init<@n>)), get(S_resp<@m>)) != dhpk(get(E_init))); @@ -187,10 +502,12 @@ def init_stage2 m2>() ); - let c6 = kdf<0; odh L5[0]; kdfkey; 0>(c5, + // Derive C6 via ODH L5 (S_init x E_resp) + // Multi-witness case: covers both m and m2 possibilities (see ISSUE I9). + let c6 = kdf, L5; kdfkey; 0>(c5, dh_combine(msg2_ephemeral, get(S_init<@n>)), 0x - ) in - let ghost c6_ghost = gkdf(c5_ghost, dh_combine(msg2_ephemeral, get(S_init<@n>)), 0x) in + ) in + let ghost c6_ghost = gkdf(c5_ghost, dh_combine(msg2_ephemeral, get(S_init<@n>)), 0x) in forall i:idx,j:idx { kdf_inj_lemma(c6_ghost, honest_c6()) @@ -200,17 +517,21 @@ def init_stage2 c6 != honest_c6() ); - let psk : if HasPSK?(opsk) then Name(psk<@n,m>) else ty_zeros_32 = + // Derive C7 and tau and k0 from C6 using the PSK. + // RESOLVED (I10): Both labels listed; pcase HasPSK?(opsk) is ghost-only + // so the type checker narrows per branch (L6 or L6_zeros) while the + // runtime call is identical in both branches. + let psk : if HasPSK?(opsk) then Name(psk<@n,m>) else ty_zeros_32 = case opsk { | HasPSK v => v | NoPSK => zeros_32() } in - pcase HasPSK?(opsk) in - let c7 = kdf<0;0,1;kdfkey || nonce || enckey; 0>(c6, psk, 0x) in - let tau = kdf<0;0,1;kdfkey || nonce || enckey; 1>(c6, psk, 0x) in - let k0 = kdf<0;0,1;kdfkey || nonce || enckey; 2>(c6, psk, 0x) in - let h6 = crh(h5 ++ tau) in - case st_aead_dec(k0, msg2_empty_enc, h6, 0x) + pcase HasPSK?(opsk) in + let c7 = kdf; kdfkey || nonce || enckey; 0>(c6, psk, 0x) in + let tau = kdf; kdfkey || nonce || enckey; 1>(c6, psk, 0x) in + let k0 = kdf; kdfkey || nonce || enckey; 2>(c6, psk, 0x) in + let h6 = crh(h5 ++ tau) in + case st_aead_dec(k0, msg2_empty_enc, h6, 0x) as Option (Data|0|) { | None => None() | Some x => { @@ -224,24 +545,25 @@ def init_stage2 choose_bv tau | h6 == crh(h6_pre(dhpk(get(S_resp<@m'>)), einit, c, ts, dhpk(get(E_resp)), tau)) in crh_lemma(h6, crh(h6_pre(dhpk(get(S_resp<@m'>)), einit, c, ts, dhpk(get(E_resp)), tau))); - assert (h4 == crh(h4_pre(dhpk(get(S_resp<@m'>)), einit, c, ts))); + assert (h4 == crh(h4_pre(dhpk(get(S_resp<@m'>)), einit, c, ts))); choose_bv h4_c | exists h4_ts:bv. h4 == crh(honest_H4_pre(h4_c, h4_ts)) in choose_bv h4_ts | h4 == crh(honest_H4_pre(h4_c, h4_ts)) in crh_lemma(crh(h4_pre(dhpk(get(S_resp<@m'>)), einit, c, - ts)), + ts)), crh(honest_H4_pre(h4_c, h4_ts)) ); assert (m' =idx m); assert (m' =idx m2); assert (is_e_resp[msg2_ephemeral] /\ m =idx m2) }; - assert(valid_h6[h6] ==> + assert(valid_h6[h6] ==> (is_e_resp[msg2_ephemeral] /\ m =idx m2)); - - false_elim in - let k1 = kdf<0;; enckey || enckey; 0>(c7, 0x, 0x) in - let k2 = kdf<0;; enckey || enckey; 1>(c7, 0x, 0x) in + + false_elim in + // Derive transport keys from C7 via L7 + let k1 = kdf; enckey || enckey; 0>(c7, 0x, 0x) in + let k2 = kdf; enckey || enckey; 1>(c7, 0x, 0x) in let _ = call key_confirm_initiator_send<@n>(k1) in let _ = call key_confirm_initiator_recv<@n>(k2) in Some(transp_keys_init } otherwise => None() } + */ } otherwise None() diff --git a/tests/wip/wg/resp.owl b/tests/wip/wg/resp.owl index fed6b183..73c7eb14 100644 --- a/tests/wip/wg/resp.owl +++ b/tests/wip/wg/resp.owl @@ -2,109 +2,110 @@ include "defs.owl" // Code for the responder (just the handshake) -def key_confirm_responder_send<@m> (k : Ghost) @ Responder : Unit = () -def key_confirm_responder_recv<@m> (k : Ghost) @ Responder : Unit = () +def key_confirm_responder_send<@m> (k : Ghost) @ Responder : Unit = () +def key_confirm_responder_recv<@m> (k : Ghost) @ Responder : Unit = () // Is eph an ephemeral key for the initiator? -predicate is_e_init(eph) = +predicate is_e_init(eph) = exists n:idx,i:idx. - eph == dhpk(get(E_init)) + eph == dhpk(get(WG_KDF.E_init)) // Is eph a static key for the initiator? -predicate is_s_init(eph) = +predicate is_s_init(eph) = exists n:idx. - eph == dhpk(get(S_init<@n>)) + eph == dhpk(get(WG_KDF.S_init<@n>)) struct init_info { - init_info_ss : shared_secret(S_init<@n>, S_resp<@m>), - init_info_psk : PSKMode + init_info_ss : shared_secret(WG_KDF.S_init<@n>, WG_KDF.S_resp<@m>), + init_info_psk : PSKMode } -// This models looking up a public key in the responder's database, +// This models looking up a public key in the responder's database, // both to authenticate it and to lookup the precomputed shared secret def get_pk_info<@m>(pk : Data) @ Responder - : Option (exists n. - (x:init_info{dhpk(get(S_init<@n>)) == pk})) + : Option (exists n. + (x:init_info{dhpk(get(WG_KDF.S_init<@n>)) == pk})) -predicate resp_stage1_clean(eph) = - (exists i:idx. eph == dhpk(get(E_init))) +predicate resp_stage1_clean(eph) = + (exists i:idx. eph == dhpk(get(WG_KDF.E_init))) /\ - ((sec(S_resp<@m>) /\ sec(S_init<@n_pk>)) + ((sec(WG_KDF.S_resp<@m>) /\ sec(WG_KDF.S_init<@n_pk>)) \/ - (exists i:idx. eph == dhpk(get(E_init)) + (exists i:idx. eph == dhpk(get(WG_KDF.E_init)) /\ - sec(E_init) /\ sec(S_resp<@m>))) + sec(WG_KDF.E_init) /\ sec(WG_KDF.S_resp<@m>))) struct resp_received_state { - rrs_msg1_sender : Data |4|, - rrs_psk : PSKMode, - rrs_dhpk_S_init : if n_eph =idx n_pk then dhpk(S_init<@n_eph>) else - dhpk(S_init<@n_pk>), + rrs_msg1_sender : Data |4|, + rrs_psk : PSKMode, + rrs_dhpk_S_init : if n_eph =idx n_pk then dhpk(WG_KDF.S_init<@n_eph>) else + dhpk(WG_KDF.S_init<@n_pk>), rrs_msg1_ephemeral : (x:Data| |group| |{is_group_elem(x) /\ - ((exists i:idx. x == dhpk(get(E_init))) \/ !is_e_init[x]) + ((exists i:idx. x == dhpk(get(WG_KDF.E_init))) \/ !is_e_init[x]) }), rrs_c2 : (x:Ghost{ - x == - gkdf( - gkdf(crh(construction()),rrs_msg1_ephemeral, 0x), - dh_combine(rrs_msg1_ephemeral, get(S_resp<@m>)), 0x) + x == + gkdf( + gkdf(crh(construction()),rrs_msg1_ephemeral, 0x), + dh_combine(rrs_msg1_ephemeral, get(WG_KDF.S_resp<@m>)), 0x) }), rrs_h4 : (x:Data | |crh| |{ - exists ts:bv,c:bv. + exists ts:bv,c:bv. x == crh(crh(crh(crh(crh(crh(construction()) ++ identifier()) ++ - dhpk(get(S_resp<@m>))) ++ rrs_msg1_ephemeral) ++ c) ++ ts) + dhpk(get(WG_KDF.S_resp<@m>))) ++ rrs_msg1_ephemeral) ++ c) ++ ts) }), rrs_c3 : if resp_stage1_clean[rrs_msg1_ephemeral] then - if n_pk =idx n_eph then - SecName(KDF>(rrs_c2, dh_combine(dhpk(get(S_init<@n_pk>)), get(S_resp<@m>)), 0x)) + if n_pk =idx n_eph then + SecName(KDF; kdfkey||enckey; 0>) else - SecName(KDF(rrs_c2, dh_combine(dhpk(get(S_init<@n_pk>)), get(S_resp<@m>)), 0x)) - + SecName(KDF; kdfkey||enckey; 0>) + else - (x:Data{x == gkdf(rrs_c2, - dh_combine(dhpk(get(S_init<@n_pk>)), get(S_resp<@m>)), 0x)}) + (x:Data{x == gkdf(rrs_c2, + dh_combine(dhpk(get(WG_KDF.S_init<@n_pk>)), get(WG_KDF.S_resp<@m>)), 0x)}) } -def resp_stage1 (dhpk_S_resp : dhpk(S_resp<@m>)) @ Responder +def resp_stage1 (dhpk_S_resp : dhpk(WG_KDF.S_resp<@m>)) @ Responder : Option (exists n_eph. exists n_pk. resp_received_state ) - = - set_option ":rlimit" "2000000" in + = + set_option ":rlimit" "2000000" in input inp in parse inp as msg1(msg1_tag, msg1_sender, msg1_ephemeral, msg1_static, msg1_timestamp, msg1_mac1, msg1_mac2) in { - guard eq(length(msg1_sender), 4) in - guard is_group_elem(msg1_ephemeral) in + guard eq(length(msg1_sender), 4) in + guard is_group_elem(msg1_ephemeral) in let C0 = crh(construction()) in - let H0 = crh(C0 ++ identifier()) in + let H0 = crh(C0 ++ identifier()) in let H1 = crh(H0 ++ dhpk_S_resp) in - + // Is the received ephemeral key (msg1_ephemeral) actually an ephemeral // key? - pcase - (is_e_init[msg1_ephemeral]) in - // If so, let it be for initator n and session i of that initiator. - choose_idx n | exists i:idx. msg1_ephemeral == dhpk(get(E_init)) in - choose_idx i | msg1_ephemeral == dhpk(get(E_init)) in + pcase + (is_e_init[msg1_ephemeral]) in + // If so, let it be for initiator n and session i of that initiator. + choose_idx n | exists i:idx. msg1_ephemeral == dhpk(get(WG_KDF.E_init)) in + choose_idx i | msg1_ephemeral == dhpk(get(WG_KDF.E_init)) in // Otherwise, is it a static key of an initiator? - pcase (is_s_init[msg1_ephemeral]) when (!is_e_init[msg1_ephemeral]) in + pcase (is_s_init[msg1_ephemeral]) when (!is_e_init[msg1_ephemeral]) in // If so, let it be for initiator n2 - choose_idx n2 | msg1_ephemeral == dhpk(get(S_init<@n2>)) in - let C1 = kdf<;;kdfkey;0>(C0, msg1_ephemeral, 0x) in - let ghost c1_ghost = gkdf(C0, msg1_ephemeral, 0x) in + choose_idx n2 | msg1_ephemeral == dhpk(get(WG_KDF.S_init<@n2>)) in + // C1 is publicly computable; no kdf_scope rule needed, use unlabeled kdf + let C1 = kdf<;kdfkey;0>(C0, msg1_ephemeral, 0x) in + let ghost c1_ghost = gkdf(C0, msg1_ephemeral, 0x) in let H2 = crh(H1 ++ msg1_ephemeral) in - let ss_msg1_ephemeral_S_resp = dh_combine(msg1_ephemeral, get(S_resp<@m>)) in - + let ss_msg1_ephemeral_S_resp = dh_combine(msg1_ephemeral, get(WG_KDF.S_resp<@m>)) in + // cross_dh_lemma states that, given g^x, y, and z, (for random different values x, y, // and z), it is hard for the // adversary to construct an h such that h^x = g^(y * z) (when x is a - // secret). If it could do so, we can compute discrete log of x. + // secret). If it could do so, we can compute discrete log of x. // The actual lemma call is for x = S_resp<@m> and h = msg1_ephemeral, where - // y and z are the other Diffie-Hellman secrets in the protocol. - cross_dh_lemma>(msg1_ephemeral); + // y and z are the other Diffie-Hellman secrets in the protocol. + cross_dh_lemma>(msg1_ephemeral); // H(a, b, c) != H(H(a, b, c), d, e) { forall n:idx,i:idx { @@ -113,30 +114,31 @@ input inp in is_constant_lemma(crh(construction())); assert (forall n:idx. ! exists i:idx. C1 == honest_c2()) }; - let C2 = kdf<;odh L1[0]; kdfkey||enckey; 0>(C1, ss_msg1_ephemeral_S_resp, 0x) in - let ghost c2_ghost = gkdf(c1_ghost, ss_msg1_ephemeral_S_resp, 0x) in - let k0 = kdf<;odh L1[0]; kdfkey||enckey; 1>(C1, ss_msg1_ephemeral_S_resp, 0x) in + // Derive C2 via ODH L1 (E_init x S_resp) + let C2 = kdf(C1); kdfkey||enckey; 0>(C1, ss_msg1_ephemeral_S_resp, 0x) in + let ghost c2_ghost = gkdf(c1_ghost, ss_msg1_ephemeral_S_resp, 0x) in + let k0 = kdf(C1); kdfkey||enckey; 1>(C1, ss_msg1_ephemeral_S_resp, 0x) in case st_aead_dec(k0, msg1_static, H2, 0x) as Option (Data) { | None => None() - | Some msg1_static_dec => + | Some msg1_static_dec => false_elim in let oinfo = call get_pk_info<@m>(msg1_static_dec) in case oinfo { | None => None() | Some info => - unpack n3, info = info in - parse info as init_info(ss, psk) in - cross_dh_lemma>(msg1_static_dec); + unpack n3, info = info in + parse info as init_info(ss, psk) in + cross_dh_lemma>(msg1_static_dec); let H3 = crh(H2 ++ msg1_static) in - + pcase (n =idx n3) in - let dhpk_S_init : if n =idx n3 then dhpk(S_init<@n>) - else dhpk(S_init<@n3>) = msg1_static_dec in + let dhpk_S_init : if n =idx n3 then dhpk(WG_KDF.S_init<@n>) + else dhpk(WG_KDF.S_init<@n3>) = msg1_static_dec in { forall n:idx,i:idx { kdf_inj_lemma(c2_ghost, honest_c2()) }; - let lem1 = assert ((!is_e_init[msg1_ephemeral]) ==> + let lem1 = assert ((!is_e_init[msg1_ephemeral]) ==> forall n:idx. (! exists i:idx. C2 == honest_c2()) ) in @@ -147,24 +149,26 @@ input inp in lem1 &&& lem2 }; - - let C3 = kdf<0;odh L2<@n,m>[0], odh L2<@n3,m>[1]; kdfkey || enckey; 0>(C2, ss, 0x) in - let ghost c3_ghost = gkdf(c2_ghost, - ss, 0x) in - let k1 = kdf<0;odh L2<@n,m>[0], odh L2<@n3,m>[1]; kdfkey || enckey; 1>(C2, ss, 0x) in + // Derive C3 via ODH L2 / L2_corr (S_init x S_resp) + // When n =idx n3: use L2 (correct case). + // When n !=idx n3: use L2_corr (wrong-index case). + let C3 = kdf, WG_KDF.L2_corr; kdfkey || enckey; 0>(C2, ss, 0x) in + let ghost c3_ghost = gkdf(c2_ghost, + ss, 0x) in + let k1 = kdf, WG_KDF.L2_corr; kdfkey || enckey; 1>(C2, ss, 0x) in case st_aead_dec(k1, msg1_timestamp, H3, 0x) as Option (Data |12|) { | None => None() | Some msg1_timestamp_dec => - false_elim in + false_elim in let H4 = crh(H3 ++ msg1_timestamp) in assert (exists i:idx. (msg1_ephemeral == - dhpk(get(E_init)) \/ + dhpk(get(WG_KDF.E_init)) \/ !is_e_init[msg1_ephemeral])); assert (is_group_elem(msg1_ephemeral)); - let st : resp_received_state = + let st : resp_received_state = resp_received_state(msg1_sender, psk, dhpk_S_init, msg1_ephemeral, C2, H4, C3) - in + in let y = pack(pack(st)) in Some(y) otherwise => None() @@ -177,64 +181,66 @@ input inp in def resp_stage2 (st : exists n_eph. exists n_pk. resp_received_state) @ Responder : - Option (exists n_eph. exists n_pk. + n_pk, pid n_eph, pid m>) @ Responder : + Option (exists n_eph. exists n_pk. transp_keys_resp) = - set_option ":rlimit" "5000000" in - unpack n, st' = st in - unpack n3, st'' = st' in + pid m>) = + set_option ":rlimit" "5000000" in + unpack n, st' = st in + unpack n3, st'' = st' in parse st'' as resp_received_state(msg2_receiver, psk, dhpk_S_init, msg1_ephemeral, C2, H4, C3) in - pcase resp_stage1_clean[msg1_ephemeral] in - pcase is_e_init[msg1_ephemeral] in - choose_idx i | msg1_ephemeral == dhpk(get(E_init)) in - pcase (is_s_init[msg1_ephemeral]) when (!is_e_init[msg1_ephemeral]) in - choose_idx n2 | msg1_ephemeral == dhpk(get(S_init<@n2>)) in - pcase (exists i:idx. msg1_ephemeral == dhpk(get(E_init))) in - pcase n3 =idx n in - let e_resp_pk = dhpk(get(E_resp)) in - let ghost c2_ghost = - gkdf( - gkdf(crh(construction()),msg1_ephemeral, 0x), - dh_combine(msg1_ephemeral, get(S_resp<@m>)), 0x) in - let ghost c3_ghost = gkdf(c2_ghost, - dh_combine(dhpk(get(S_init<@n3>)), get(S_resp<@m>)), 0x) in - let c4 = kdf<0;;kdfkey;0>(C3, e_resp_pk, 0x) in - let ghost c4_ghost = gkdf(c3_ghost, e_resp_pk, 0x) in - let h5 = crh(H4 ++ e_resp_pk) in - let ss = dh_combine(msg1_ephemeral, get(E_resp)) in - cross_dh_lemma>(msg1_ephemeral); - forall n1:idx, n2:idx, i:idx { + m>(msg2_receiver, psk, dhpk_S_init, msg1_ephemeral, C2, H4, C3) in + pcase resp_stage1_clean[msg1_ephemeral] in + pcase is_e_init[msg1_ephemeral] in + choose_idx i | msg1_ephemeral == dhpk(get(WG_KDF.E_init)) in + pcase (is_s_init[msg1_ephemeral]) when (!is_e_init[msg1_ephemeral]) in + choose_idx n2 | msg1_ephemeral == dhpk(get(WG_KDF.S_init<@n2>)) in + pcase (exists i:idx. msg1_ephemeral == dhpk(get(WG_KDF.E_init))) in + pcase n3 =idx n in + let e_resp_pk = dhpk(get(WG_KDF.E_resp)) in + let ghost c2_ghost = + gkdf( + gkdf(crh(construction()),msg1_ephemeral, 0x), + dh_combine(msg1_ephemeral, get(WG_KDF.S_resp<@m>)), 0x) in + let ghost c3_ghost = gkdf(c2_ghost, + dh_combine(dhpk(get(WG_KDF.S_init<@n3>)), get(WG_KDF.S_resp<@m>)), 0x) in + // Derive C4 from C3 using responder's ephemeral pk (rule L3) + let c4 = kdf, WG_KDF.L3_corr(e_resp_pk); kdfkey; 0>(C3, e_resp_pk, 0x) in + let ghost c4_ghost = gkdf(c3_ghost, e_resp_pk, 0x) in + let h5 = crh(H4 ++ e_resp_pk) in + let ss = dh_combine(msg1_ephemeral, get(WG_KDF.E_resp)) in + cross_dh_lemma>(msg1_ephemeral); + forall n1:idx, n2:idx, i:idx { kdf_inj_lemma(c4_ghost, honest_c4()) }; assert (n !=idx n3 ==> c4 != honest_c4()); - assert (n !=idx n3 ==> + assert (n !=idx n3 ==> c4 != honest_c4()); forall n_eph:idx, i:idx { kdf_inj_lemma(c4_ghost, honest_c5()) }; - assert (! exists i:idx. + assert (! exists i:idx. c4 == honest_c5()); assert (! exists n_eph:idx. exists i:idx. c4 == honest_c5() ); - let c5 = kdf<0,1; odh L4[0], odh L4[1]; kdfkey; 0>(c4, ss, 0x) in - let ghost c5_ghost = gkdf(c4_ghost, ss, 0x) in + // Derive C5 via ODH L4 (E_init x E_resp) + let c5 = kdf, WG_KDF.L4; kdfkey; 0>(c4, ss, 0x) in + let ghost c5_ghost = gkdf(c4_ghost, ss, 0x) in forall n1:idx,n2:idx,i:idx { kdf_inj_lemma(c5_ghost, honest_c5()) }; assert (((!is_e_init[msg1_ephemeral])) ==> forall n1:idx, n2:idx. - (!exists i:idx. - c5 == honest_c5())); assert ( forall na:idx,nb:idx. @@ -243,10 +249,11 @@ def resp_stage2 (st : exists n_eph. exists n_pk. resp_received_state (na =idx n /\ nb =idx n3)); - let c6 = kdf<0; odh L5[0], odh - L5[1]; kdfkey;0>(c5, dh_combine(dhpk_S_init, get(E_resp)), 0x) in - let ghost c6_ghost = gkdf(c5_ghost, dh_combine(dhpk_S_init, - get(E_resp)), 0x) in + // Derive C6 via ODH L5 / L5_corr (S_init x E_resp) + // Multi-witness case (see ISSUE I9): two witnesses for two possible n indices. + let c6 = kdf, WG_KDF.L5_corr; kdfkey; 0>(c5, dh_combine(dhpk_S_init, get(WG_KDF.E_resp)), 0x) in + let ghost c6_ghost = gkdf(c5_ghost, dh_combine(dhpk_S_init, + get(WG_KDF.E_resp)), 0x) in forall i:idx,j:idx,n1:idx,n2:idx { kdf_inj_lemma(c6_ghost, honest_c6()) @@ -255,38 +262,44 @@ def resp_stage2 (st : exists n_eph. exists n_pk. resp_received_state() ); -let psk_val : if HasPSK?(psk) then - if n =idx n3 then - Name(psk<@n,m>) - else - Name(psk<@n3, m>) - else ty_zeros_32 = +// Derive C7, tau, k0 from C6 using the PSK (rule L6 or L6_corr). +// RESOLVED (I10): All four labels are listed in each call. pcase HasPSK?(psk) +// is a ghost annotation; the type checker uses it to narrow which labels apply +// per branch (HasPSK: L6/L6_corr; NoPSK: L6_zeros/L6_corr_zeros), but the +// runtime call is the same in both branches. +let psk_val : if HasPSK?(psk) then + if n =idx n3 then + Name(WG_KDF.psk<@n,m>) + else + Name(WG_KDF.psk<@n3, m>) + else ty_zeros_32 = case psk { | HasPSK v => v | NoPSK => zeros_32() } in -pcase HasPSK?(psk) in - let c7 = kdf<0,1;0,1; kdfkey || nonce || enckey; 0>(c6, psk_val, 0x) in - let tau = kdf<0,1;0,1; kdfkey || nonce || enckey; 1>(c6, psk_val, 0x) in - let k0 = kdf<0,1;0,1; kdfkey || nonce || enckey; 2>(c6, psk_val, 0x) in - let msg2_tag = msg2_tag_value() in +pcase HasPSK?(psk) in + let c7 = kdf, WG_KDF.L6_zeros, WG_KDF.L6_corr, WG_KDF.L6_corr_zeros; kdfkey || nonce || enckey; 0>(c6, psk_val, 0x) in + let tau = kdf, WG_KDF.L6_zeros, WG_KDF.L6_corr, WG_KDF.L6_corr_zeros; kdfkey || nonce || enckey; 1>(c6, psk_val, 0x) in + let k0 = kdf, WG_KDF.L6_zeros, WG_KDF.L6_corr, WG_KDF.L6_corr_zeros; kdfkey || nonce || enckey; 2>(c6, psk_val, 0x) in + let msg2_tag = msg2_tag_value() in let msg2_sender : Data |4| = call get_sender_r<@m>() in let msg2_mac1_k = crh(mac1() ++ dhpk_S_init) in let h6 = crh(h5 ++ tau) in - let tk1 = kdf<0;; enckey || enckey; 0>(c7, 0x, 0x) in - let tk2 = kdf<0;; enckey || enckey; 1>(c7, 0x, 0x) in + // Derive transport keys from C7 via L7 / L7_corr + let tk1 = kdf, WG_KDF.L7_corr; enckey || enckey; 0>(c7, 0x, 0x) in + let tk2 = kdf, WG_KDF.L7_corr; enckey || enckey; 1>(c7, 0x, 0x) in let _ = call key_confirm_responder_recv<@m>(tk1) in let _ = call key_confirm_responder_send<@m>(tk2) in let msg2_empty : Data | cipherlen(0) | = st_aead_enc>(k0, 0x, h6) in let msg2_mac1 = mac(msg2_mac1_k, msg2_tag ++ msg2_sender ++ msg2_receiver ++ e_resp_pk ++ - msg2_empty) in + msg2_empty) in let msg2_mac2 = zeros_16() in let msg2_output: msg2 = msg2( msg2_tag, msg2_sender, msg2_receiver, e_resp_pk, msg2_empty, msg2_mac1, msg2_mac2 ) in - let _ = output msg2_output in - let ret = + let _ = output msg2_output in + let ret = pack( pack( transp_keys_resp(x : Ghost) @ Initiator : Unit = () @@ -8,14 +8,14 @@ def resp_sent_message<@m>(x : Ghost) @ Responder : Unit = () def init_recv(tki : transp_keys_init) @ Initiator - // When intiator decrypts, it gets secret data - : Option Data]> = - input i in + // When initiator decrypts, it gets secret data + : Option Data]> = + input i in parse tki as transp_keys_init(init, resp, haspsk, eph, c7, init_send, - resp_send) in + resp_send) in parse i as transp(tag, from, ctr, pkt) in { - guard eq(from, resp) in - pcase init_clean[haspsk, eph] in + guard eq(from, resp) in + pcase init_clean[haspsk, eph] in let p = st_aead_dec(resp_send, pkt, 0x, ctr) in { let _ : Unit = case p as Option Data { @@ -39,13 +39,13 @@ Initiator : Unit = parse tki as transp_keys_init(init, resp, haspsk, eph, c7, init_send, - resp_send) in - pcase init_clean[haspsk, eph] in + resp_send) in + pcase init_clean[haspsk, eph] in let transp_counter = get_counter N_init_send in call init_sent_message<@n>(msg); - let c = st_aead_enc>(init_send, msg, 0x) in - let transp_tag = transp_tag_value() in - let o = transp(transp_tag, init, transp_counter, c) in + let c = st_aead_enc>(init_send, msg, 0x) in + let transp_tag = transp_tag_value() in + let o = transp(transp_tag, init, transp_counter, c) in output o to endpoint(Responder) struct resp_transp_recv_result { @@ -54,81 +54,78 @@ struct resp_transp_recv_result { } def resp_recv( - tki : exists n_pk. transp_keys_resp) + tki : exists n_pk. transp_keys_resp) @ Responder : Option (exists n_pk. resp_transp_recv_result) = - input i in + pid m>) = + input i in unpack n_pk, tki' = tki in parse tki' as transp_keys_resp(init, resp, haspsk, eph, c7, _, init_send, - resp_send) in + resp_send) in parse i as transp(tag, from, ctr, pkt) in { - guard eq(from, init) in + guard eq(from, init) in pcase resp_clean[haspsk, eph] in - pcase exists i:idx. eph == dhpk(get(E_init)) when resp_clean[haspsk, eph] in - pcase n =idx n_pk in - case st_aead_dec(init_send, pkt, 0x, ctr) // as Option - // (Data], |adv|>) + pcase exists i:idx. eph == dhpk(get(WG_KDF.E_init)) when resp_clean[haspsk, eph] in + pcase n =idx n_pk in + case st_aead_dec(init_send, pkt, 0x, ctr) { | Some x => - false_elim in + false_elim in let st' : transp_keys_resp = transp_keys_resp(init, resp, haspsk, eph, c7, true, init_send, resp_send) in - let ret = + let ret = pack(resp_transp_recv_result(st', x)) in - assert (resp_clean[haspsk,eph] /\ n =idx n_pk /\ exists i:idx. eph == dhpk(get(E_init))) + m>(st', x)) in + assert (resp_clean[haspsk,eph] /\ n =idx n_pk /\ exists i:idx. eph == dhpk(get(WG_KDF.E_init))) ==> happened(init_sent_message<@n>(x)); Some(ret) | None => None)>() - // otherwise => None() } } otherwise None)>() - -def resp_send(tki : + +def resp_send(tki : exists n_pk. transp_keys_resp, msg : Data], |adv|> ) @ Responder : Option Unit // State stays the same after this - = - unpack npk, tki_ = tki in + = + unpack npk, tki_ = tki in parse tki_ as transp_keys_resp(init, resp, haspsk, eph, c7, b, init_send, - resp_send) in + resp_send) in guard b in { - pcase resp_clean[haspsk, eph] in + pcase resp_clean[haspsk, eph] in assert (resp_clean[haspsk, eph] ==> n =idx npk); // For the responder's security for sending a message, we require that, - // if channel_secret_resp_send<@n,m> is actually secret + // if channel_secret_resp_send<@n,m> is actually secret // (and hence one of the responder's DH keys are secret, and the initiator's - // static key is secret), + // static key is secret), // the ephemeral key it got from the handshake is actually an ephemeral key, - // and it corresponds to the initiator it thinks it corresponds to. + // and it corresponds to the initiator it thinks it corresponds to. // This corresponds to the cleanliness predicate in Lipp's formalization of - // WireGuard in CryptoVerif (4.3.4). - assume (sec(channel_secret_resp_send<@n,m>) ==> exists i:idx. eph == dhpk(get(E_init))); + // WireGuard in CryptoVerif (4.3.4). + assume (sec(channel_secret_resp_send<@n,m>) ==> exists i:idx. eph == dhpk(get(WG_KDF.E_init))); assume (sec(channel_secret_resp_send<@n,m>) ==> n =idx npk); let transp_counter = get_counter N_resp_send in call resp_sent_message<@m>(msg); - let c = st_aead_enc>(resp_send, msg, 0x) in - let transp_tag = transp_tag_value() in - let o = transp(transp_tag, resp, transp_counter, c) in + let c = st_aead_enc>(resp_send, msg, 0x) in + let transp_tag = transp_tag_value() in + let o = transp(transp_tag, resp, transp_counter, c) in output o to endpoint(Initiator); Some(()) }