From 0aa21fe4f96cdc42c50b35e7ae0e2898d4016d52 Mon Sep 17 00:00:00 2001 From: Fabian Hauck Date: Fri, 5 Apr 2024 17:15:12 +0200 Subject: [PATCH 01/29] Total and Stateful code of the DH model --- src/.fst.config.json | 4 + src/DY.Example.DH.Debug.fst | 54 ++++++++++ src/DY.Example.DH.Protocol.Stateful.fst | 129 +++++++++++++++++++++++ src/DY.Example.DH.Protocol.Total.fst | 130 ++++++++++++++++++++++++ 4 files changed, 317 insertions(+) create mode 100644 src/.fst.config.json create mode 100644 src/DY.Example.DH.Debug.fst create mode 100644 src/DY.Example.DH.Protocol.Stateful.fst create mode 100644 src/DY.Example.DH.Protocol.Total.fst diff --git a/src/.fst.config.json b/src/.fst.config.json new file mode 100644 index 0000000..5f5ec9e --- /dev/null +++ b/src/.fst.config.json @@ -0,0 +1,4 @@ +{ "fstar_exe":"fstar.exe", + "options":["--cache_dir", "../cache", "--hint_dir", "../.hints", "--use_hints", "--record_hints"], + "include_dirs":[".", "../../comparse/src"] +} \ No newline at end of file diff --git a/src/DY.Example.DH.Debug.fst b/src/DY.Example.DH.Debug.fst new file mode 100644 index 0000000..65b64c9 --- /dev/null +++ b/src/DY.Example.DH.Debug.fst @@ -0,0 +1,54 @@ +module DY.Example.DH.Debug + +(* + Extract code by running: + 1. make extract_lib + 2. In the obj/ directory: OCAMLPATH=$FSTAR_HOME/lib ocamlbuild -use-ocamlfind -pkg batteries -pkg fstar.lib DY_Example_DH_Debug.native + 3. ./DY_Example_DH_Debug.native +*) + +open DY.Core +open DY.Lib +open DY.Example.DH.Protocol.Stateful + +val discard: bool -> crypto (option unit) +let discard _ = return (Some ()) + +let debug () : crypto (option unit) = + (*** Initialize protocol run ***) + let alice = "alice" in + let bob = "bob" in + + let* alice_global_session_id = new_session_id alice in + generate_private_key alice alice_global_session_id (Sign "DH.SigningKey");* + + let* bob_global_session_id = new_session_id bob in + generate_private_key bob bob_global_session_id (Sign "DH.SigningKey");* + + //install_public_key alice alice_global_session_id (Verify "DH.SigningKey") bob + + let alice_global_session_ids: dh_global_sess_ids = {pki=alice_global_session_id; private_keys=alice_global_session_id} in + let bob_global_session_ids: dh_global_sess_ids = {pki=bob_global_session_id; private_keys=bob_global_session_id} in + + (*** Run the protocol ***) + // Alice + let* alice_session_id = prepare_msg1 alice bob in + let*? msg1_id = send_msg1 alice alice_session_id in + + // Bob + let*? bob_session_id = prepare_msg2 alice bob msg1_id in + let*? msg2_id = send_msg2 bob_global_session_ids bob bob_session_id in + + // Alice + prepare_msg3 alice_global_session_ids alice bob msg2_id alice_session_id;* + let*? msg3_id = send_msg3 alice_global_session_ids alice bob alice_session_id in + + // Bob + verify_msg3 bob_global_session_ids alice bob msg3_id bob_session_id;* + + return (Some ()) + +//Run ``main ()`` when the module loads +#push-options "--warn_error -272" +let _ = debug () +#pop-options \ No newline at end of file diff --git a/src/DY.Example.DH.Protocol.Stateful.fst b/src/DY.Example.DH.Protocol.Stateful.fst new file mode 100644 index 0000000..0ea04f3 --- /dev/null +++ b/src/DY.Example.DH.Protocol.Stateful.fst @@ -0,0 +1,129 @@ +module DY.Example.DH.Protocol.Stateful + +open Comparse +open DY.Core +open DY.Lib +open DY.Example.DH.Protocol.Total + +(*** Definition of state ***) + +[@@ with_bytes bytes] +type dh_session = + | InitiatorSentMsg1: b:principal -> x:bytes -> dh_session + | ResponderSentMsg2: a:principal -> gx:bytes -> gy:bytes -> y:bytes -> dh_session + | InitiatorSendMsg3: b:principal -> gx:bytes -> gy:bytes -> x:bytes -> dh_session + | ResponderReceivedMsg3: a:principal -> gx:bytes -> gy:bytes -> y:bytes -> dh_session + +%splice [ps_dh_session] (gen_parser (`dh_session)) +%splice [ps_dh_session_is_well_formed] (gen_is_well_formed_lemma (`dh_session)) + +instance dh_session_parseable_serializeable: parseable_serializeable bytes dh_session + = mk_parseable_serializeable ps_dh_session + +(*** Setup for the stateful code ***) + +val dh_session_label: string +let dh_session_label = "DH.Session" + +type dh_global_sess_ids = { + pki: nat; + private_keys: nat; +} + +(*** Stateful code ***) + +// Alice prepares message 1 +// +// This method is separated from the send_msg1 method +// to give the attacker more flexibility. With this +// separation an attacker can set a state without sending +// a message over the network. +val prepare_msg1: principal -> principal -> crypto nat +let prepare_msg1 alice bob = + let* x = mk_rand NoUsage (join (principal_label alice) (principal_label bob)) 32 in + let* session_id = new_session_id alice in + set_typed_state dh_session_label alice session_id (InitiatorSentMsg1 bob x <: dh_session);* + return session_id + +// Alice sends message 1 +val send_msg1: principal -> nat -> crypto (option nat) +let send_msg1 alice session_id = + let*? session_state: dh_session = get_typed_state dh_session_label alice session_id in + match session_state with + | InitiatorSentMsg1 bob x -> ( + let msg = compute_message1 bob x in + let* msg_id = send_msg msg in + return (Some msg_id) + ) + | _ -> return None + +// Bob prepares message 2 +val prepare_msg2: principal -> principal -> nat -> crypto (option nat) +let prepare_msg2 alice bob msg_id = + let*? msg = recv_msg msg_id in + let*? msg1: message1 = return (decode_message1 msg) in + let* y = mk_rand NoUsage (join (principal_label alice) (principal_label bob)) 32 in + let gy = dh_pk y in + let* session_id = new_session_id bob in + set_typed_state dh_session_label bob session_id (ResponderSentMsg2 alice msg1.gx gy y <: dh_session);* + return (Some session_id) + +// Bob sends message 2 +val send_msg2: dh_global_sess_ids -> principal -> nat -> crypto (option nat) +let send_msg2 global_sess_id bob session_id = + let*? session_state: dh_session = get_typed_state dh_session_label bob session_id in + match session_state with + | ResponderSentMsg2 alice gx gy y -> ( + let*? sk_b = get_private_key bob global_sess_id.private_keys (Sign "DH.SigningKey") in + let* n_sig = mk_rand SigNonce (principal_label bob) 32 in + let msg = compute_message2 alice bob gx gy sk_b n_sig in + let* msg_id = send_msg msg in + return (Some msg_id) + ) + | _ -> return None + +// Alice prepares message 3 +// +// This message has to verify the signature from message 2 +val prepare_msg3: dh_global_sess_ids -> principal -> principal -> nat -> nat -> crypto (option unit) +let prepare_msg3 global_sess_id alice bob msg_id session_id = + let*? session_state: dh_session = get_typed_state dh_session_label alice session_id in + match session_state with + | InitiatorSentMsg1 bob x -> ( + let*? pk_b = get_public_key alice global_sess_id.pki (PkEnc "DH.PublicKey") bob in + let*? msg = recv_msg msg_id in + let gx = dh_pk x in + let*? msg2: message2 = return (decode_message2 msg alice gx pk_b) in + set_typed_state dh_session_label alice session_id (InitiatorSendMsg3 bob gx msg2.gy x <: dh_session);* + return (Some ()) + ) + | _ -> return None + +// Alice send message 3 +val send_msg3: dh_global_sess_ids -> principal -> principal -> nat -> crypto (option nat) +let send_msg3 global_sess_id alice bob session_id = + let*? session_state: dh_session = get_typed_state dh_session_label alice session_id in + match session_state with + | InitiatorSendMsg3 bob gx gy x -> ( + let*? sk_a = get_private_key alice global_sess_id.private_keys (Sign "DH.SigningKey") in + let* n_sig = mk_rand SigNonce (principal_label alice) 32 in + let msg = compute_message3 alice bob gx gy sk_a n_sig in + let* msg_id = send_msg msg in + return (Some msg_id) + ) + | _ -> return None + +// Bob verifies message 3 +val verify_msg3: dh_global_sess_ids -> principal -> principal -> nat -> nat -> crypto (option unit) +let verify_msg3 global_sess_id alice bob msg_id session_id = + let*? session_state: dh_session = get_typed_state dh_session_label bob session_id in + match session_state with + | ResponderSentMsg2 alice gx gy y -> ( + let*? pk_a = get_public_key bob global_sess_id.pki (PkEnc "DH.PublicKey") alice in + let*? msg = recv_msg msg_id in + let*? msg3: message3 = return (decode_message3 msg bob gx gy pk_a) in + set_typed_state dh_session_label bob session_id (ResponderReceivedMsg3 alice gx gy y <: dh_session);* + return (Some ()) + ) + | _ -> return None + \ No newline at end of file diff --git a/src/DY.Example.DH.Protocol.Total.fst b/src/DY.Example.DH.Protocol.Total.fst new file mode 100644 index 0000000..81cf591 --- /dev/null +++ b/src/DY.Example.DH.Protocol.Total.fst @@ -0,0 +1,130 @@ +module DY.Example.DH.Protocol.Total + +open Comparse +open DY.Core +open DY.Lib + +(* + *** ISO-DH Protocol *** + + A -> B: {A, gx} msg1 + B -> A: {B, gy, sign({A; gx; gy}, privB)} msg2 + A -> B: {sign({B; gx; gy}, privA)} msg3 + +*) + +(*** Definition of messages ***) +// Annotation is needed for comparse to generate serialization methods +[@@ with_bytes bytes] +type message1 = { + alice:principal; + gx:bytes; +} + +%splice [ps_message1] (gen_parser (`message1)) +%splice [ps_message1_is_well_formed] (gen_is_well_formed_lemma (`message1)) + +[@@ with_bytes bytes] +type message2 = { + bob:principal; + gy:bytes; + sg:bytes; +} + +%splice [ps_message2] (gen_parser (`message2)) +%splice [ps_message2_is_well_formed] (gen_is_well_formed_lemma (`message2)) + +[@@ with_bytes bytes] +type message3 = { + sg:bytes; +} + +%splice [ps_message3] (gen_parser (`message3)) +%splice [ps_message3_is_well_formed] (gen_is_well_formed_lemma (`message3)) + +[@@ with_bytes bytes] +type signature_message = { + p:principal; + gx:bytes; + gy:bytes; +} + +%splice [ps_signature_message] (gen_parser (`signature_message)) +%splice [ps_signature_message_is_well_formed] (gen_is_well_formed_lemma (`signature_message)) + +[@@ with_bytes bytes] +type message = + | Msg1: msg:message1 -> message + | Msg2: msg:message2 -> message + | Msg3: msg:message3 -> message + | Sig: sig:signature_message -> message + +%splice [ps_message] (gen_parser (`message)) +%splice [ps_message_is_well_formed] (gen_is_well_formed_lemma (`message)) + +instance parseable_serializeable_message: parseable_serializeable bytes message = mk_parseable_serializeable ps_message + +(*** Message Processing ***) + +// Alice generates message 1 +val compute_message1: principal -> bytes -> bytes +let compute_message1 alice x = + let gx = dh_pk x in + let msg = Msg1 {alice; gx} in + serialize message msg + +// Bob parses message 1 +val decode_message1: bytes -> option message1 +let decode_message1 msg1_bytes = + let? msg1 = parse message msg1_bytes in + // These lines are the... + guard (Msg1? msg1);? + Some (Msg1?.msg msg1) + // ...short version of the following match: + (* + match msg1 with + | Msg1 msg -> Some msg + | _ -> None + *) + +// Bob generates message 2 +val compute_message2: principal -> principal -> bytes -> bytes -> bytes -> bytes -> bytes +let compute_message2 alice bob gx gy sk_b n_sig = + let sig_msg = Sig {p=alice; gx; gy} in + let sg = sign sk_b n_sig (serialize message sig_msg) in + let msg = Msg2 {bob; gy; sg} in + serialize message msg + +// Alice parses message 2 +val decode_message2: bytes -> principal -> bytes -> bytes -> option message2 +let decode_message2 msg2_bytes alice gx pk_b = + let? msg2_parsed = parse message msg2_bytes in + guard (Msg2? msg2_parsed);? + let msg2 = Msg2?.msg msg2_parsed in + // Verify the signature contained in the message 2 + // with the gy value from the message and the gx + // value from Alice's state. + let gy = msg2.gy in + let sig_msg = Sig {p=alice; gx; gy} in + if verify pk_b (serialize message sig_msg) msg2.sg then Some (msg2) + else None + +// Alice generates message3 +val compute_message3: principal -> principal -> bytes -> bytes -> bytes -> bytes -> bytes +let compute_message3 alice bob gx gy sk_a n_sig = + let sig_msg = Sig {p=bob; gx; gy} in + let sg = sign sk_a n_sig (serialize message sig_msg) in + let msg = Msg3 {sg} in + serialize message msg + +// Bob parses message3 +val decode_message3: bytes -> principal -> bytes -> bytes -> bytes -> option message3 +let decode_message3 msg3_bytes bob gx gy pk_a = + let? msg3_parsed = parse message msg3_bytes in + guard (Msg3? msg3_parsed);? + let msg3 = Msg3?.msg msg3_parsed in + // Verify the signature contained in message 3 + // with the gx and gy values from Bob's state. + let sig_msg = Sig {p=bob; gx; gy} in + if verify pk_a (serialize message sig_msg) msg3.sg then Some (msg3) + else None From fd39c271081d451d863bd6924b795a17666b2c97 Mon Sep 17 00:00:00 2001 From: Fabian Hauck Date: Fri, 5 Apr 2024 17:17:25 +0200 Subject: [PATCH 02/29] Updated comment --- src/DY.Example.DH.Protocol.Stateful.fst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/DY.Example.DH.Protocol.Stateful.fst b/src/DY.Example.DH.Protocol.Stateful.fst index 0ea04f3..c39ee63 100644 --- a/src/DY.Example.DH.Protocol.Stateful.fst +++ b/src/DY.Example.DH.Protocol.Stateful.fst @@ -84,7 +84,7 @@ let send_msg2 global_sess_id bob session_id = // Alice prepares message 3 // -// This message has to verify the signature from message 2 +// This function has to verify the signature from message 2 val prepare_msg3: dh_global_sess_ids -> principal -> principal -> nat -> nat -> crypto (option unit) let prepare_msg3 global_sess_id alice bob msg_id session_id = let*? session_state: dh_session = get_typed_state dh_session_label alice session_id in From d6ee6476e22a7d999664c0478896cfc332ded233 Mon Sep 17 00:00:00 2001 From: Fabian Hauck Date: Fri, 5 Apr 2024 17:19:08 +0200 Subject: [PATCH 03/29] Updated key usage in DH example --- src/DY.Example.DH.Protocol.Stateful.fst | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/DY.Example.DH.Protocol.Stateful.fst b/src/DY.Example.DH.Protocol.Stateful.fst index c39ee63..f8de386 100644 --- a/src/DY.Example.DH.Protocol.Stateful.fst +++ b/src/DY.Example.DH.Protocol.Stateful.fst @@ -90,7 +90,7 @@ let prepare_msg3 global_sess_id alice bob msg_id session_id = let*? session_state: dh_session = get_typed_state dh_session_label alice session_id in match session_state with | InitiatorSentMsg1 bob x -> ( - let*? pk_b = get_public_key alice global_sess_id.pki (PkEnc "DH.PublicKey") bob in + let*? pk_b = get_public_key alice global_sess_id.pki (Verify "DH.PublicKey") bob in let*? msg = recv_msg msg_id in let gx = dh_pk x in let*? msg2: message2 = return (decode_message2 msg alice gx pk_b) in @@ -119,7 +119,7 @@ let verify_msg3 global_sess_id alice bob msg_id session_id = let*? session_state: dh_session = get_typed_state dh_session_label bob session_id in match session_state with | ResponderSentMsg2 alice gx gy y -> ( - let*? pk_a = get_public_key bob global_sess_id.pki (PkEnc "DH.PublicKey") alice in + let*? pk_a = get_public_key bob global_sess_id.pki (Verify "DH.PublicKey") alice in let*? msg = recv_msg msg_id in let*? msg3: message3 = return (decode_message3 msg bob gx gy pk_a) in set_typed_state dh_session_label bob session_id (ResponderReceivedMsg3 alice gx gy y <: dh_session);* From faab06c1af4a7515660c8bd82774cb935ba406be Mon Sep 17 00:00:00 2001 From: Fabian Hauck Date: Fri, 19 Apr 2024 10:25:07 +0200 Subject: [PATCH 04/29] Executable DH protocol run --- src/DY.Example.DH.Debug.fst | 33 +++++++++++++++++++------ src/DY.Example.DH.Protocol.Stateful.fst | 24 ++++++++++++++++-- 2 files changed, 47 insertions(+), 10 deletions(-) diff --git a/src/DY.Example.DH.Debug.fst b/src/DY.Example.DH.Debug.fst index 65b64c9..275e07d 100644 --- a/src/DY.Example.DH.Debug.fst +++ b/src/DY.Example.DH.Debug.fst @@ -15,20 +15,37 @@ val discard: bool -> crypto (option unit) let discard _ = return (Some ()) let debug () : crypto (option unit) = + let _ = IO.debug_print_string "************* Trace *************\n" in (*** Initialize protocol run ***) let alice = "alice" in let bob = "bob" in - let* alice_global_session_id = new_session_id alice in - generate_private_key alice alice_global_session_id (Sign "DH.SigningKey");* + // Generate private key for Alice + let* alice_global_session_priv_key_id = initialize_private_keys alice in + generate_private_key alice alice_global_session_priv_key_id (Sign "DH.SigningKey");* - let* bob_global_session_id = new_session_id bob in - generate_private_key bob bob_global_session_id (Sign "DH.SigningKey");* + // Generate private key for Bob + let* bob_global_session_priv_key_id = initialize_private_keys bob in + generate_private_key bob bob_global_session_priv_key_id (Sign "DH.SigningKey");* - //install_public_key alice alice_global_session_id (Verify "DH.SigningKey") bob + // Store Bob's public key in Alice's state + // 1. Retrieve Bob's private key from his session + // 2. Compute the public key from the private key + // 3. Initialize Alice's session to store public keys + // 4. Install Bob's public key in Alice's public key store + let*? priv_key_bob = get_private_key bob bob_global_session_priv_key_id (Sign "DH.SigningKey") in + let pub_key_bob = vk priv_key_bob in + let* alice_global_session_pub_key_id = initialize_pki alice in + install_public_key alice alice_global_session_pub_key_id (Verify "DH.SigningKey") bob pub_key_bob;* - let alice_global_session_ids: dh_global_sess_ids = {pki=alice_global_session_id; private_keys=alice_global_session_id} in - let bob_global_session_ids: dh_global_sess_ids = {pki=bob_global_session_id; private_keys=bob_global_session_id} in + // Store Alice's public key in Bob's state + let*? priv_key_alice = get_private_key alice alice_global_session_priv_key_id (Sign "DH.SigningKey") in + let pub_key_alice = vk priv_key_alice in + let* bob_global_session_pub_key_id = initialize_pki bob in + install_public_key bob bob_global_session_pub_key_id (Verify "DH.SigningKey") alice pub_key_alice;* + + let alice_global_session_ids: dh_global_sess_ids = {pki=alice_global_session_pub_key_id; private_keys=alice_global_session_priv_key_id} in + let bob_global_session_ids: dh_global_sess_ids = {pki=bob_global_session_pub_key_id; private_keys=bob_global_session_priv_key_id} in (*** Run the protocol ***) // Alice @@ -50,5 +67,5 @@ let debug () : crypto (option unit) = //Run ``main ()`` when the module loads #push-options "--warn_error -272" -let _ = debug () +let _ = debug () Nil #pop-options \ No newline at end of file diff --git a/src/DY.Example.DH.Protocol.Stateful.fst b/src/DY.Example.DH.Protocol.Stateful.fst index f8de386..4d7cbe1 100644 --- a/src/DY.Example.DH.Protocol.Stateful.fst +++ b/src/DY.Example.DH.Protocol.Stateful.fst @@ -20,6 +20,22 @@ type dh_session = instance dh_session_parseable_serializeable: parseable_serializeable bytes dh_session = mk_parseable_serializeable ps_dh_session +(*** Definition of events ***) +[@@ with_bytes bytes] +type dh_event = + | Initiate1: a:principal -> b:principal -> x:bytes -> dh_event + | Respond1: a:principal -> b:principal -> gx:bytes -> gy:bytes -> y:bytes -> dh_event + | Initiate2: a:principal -> b:principal -> gx:bytes -> gy:bytes -> x:bytes -> dh_event + | Respond2: a:principal -> b:principal -> gx:bytes -> gy:bytes -> y:bytes -> dh_event + +%splice [ps_dh_event] (gen_parser (`dh_event)) +%splice [ps_dh_event_is_well_formed] (gen_is_well_formed_lemma (`dh_event)) + +instance dh_event_instance: event dh_event = { + tag = "DH.Event"; + format = mk_parseable_serializeable ps_dh_event; +} + (*** Setup for the stateful code ***) val dh_session_label: string @@ -41,6 +57,7 @@ type dh_global_sess_ids = { val prepare_msg1: principal -> principal -> crypto nat let prepare_msg1 alice bob = let* x = mk_rand NoUsage (join (principal_label alice) (principal_label bob)) 32 in + trigger_event alice (Initiate1 alice bob x);* let* session_id = new_session_id alice in set_typed_state dh_session_label alice session_id (InitiatorSentMsg1 bob x <: dh_session);* return session_id @@ -64,6 +81,7 @@ let prepare_msg2 alice bob msg_id = let*? msg1: message1 = return (decode_message1 msg) in let* y = mk_rand NoUsage (join (principal_label alice) (principal_label bob)) 32 in let gy = dh_pk y in + trigger_event bob (Respond1 alice bob msg1.gx gy y);* let* session_id = new_session_id bob in set_typed_state dh_session_label bob session_id (ResponderSentMsg2 alice msg1.gx gy y <: dh_session);* return (Some session_id) @@ -90,10 +108,11 @@ let prepare_msg3 global_sess_id alice bob msg_id session_id = let*? session_state: dh_session = get_typed_state dh_session_label alice session_id in match session_state with | InitiatorSentMsg1 bob x -> ( - let*? pk_b = get_public_key alice global_sess_id.pki (Verify "DH.PublicKey") bob in + let*? pk_b = get_public_key alice global_sess_id.pki (Verify "DH.SigningKey") bob in let*? msg = recv_msg msg_id in let gx = dh_pk x in let*? msg2: message2 = return (decode_message2 msg alice gx pk_b) in + trigger_event alice (Initiate2 alice bob gx msg2.gy x);* set_typed_state dh_session_label alice session_id (InitiatorSendMsg3 bob gx msg2.gy x <: dh_session);* return (Some ()) ) @@ -119,9 +138,10 @@ let verify_msg3 global_sess_id alice bob msg_id session_id = let*? session_state: dh_session = get_typed_state dh_session_label bob session_id in match session_state with | ResponderSentMsg2 alice gx gy y -> ( - let*? pk_a = get_public_key bob global_sess_id.pki (Verify "DH.PublicKey") alice in + let*? pk_a = get_public_key bob global_sess_id.pki (Verify "DH.SigningKey") alice in let*? msg = recv_msg msg_id in let*? msg3: message3 = return (decode_message3 msg bob gx gy pk_a) in + trigger_event bob (Respond2 alice bob gx gy y);* set_typed_state dh_session_label bob session_id (ResponderReceivedMsg3 alice gx gy y <: dh_session);* return (Some ()) ) From da35de8854ac2b91a84abcdd037491c5ac9cb1a8 Mon Sep 17 00:00:00 2001 From: Fabian Hauck Date: Sun, 21 Apr 2024 23:43:53 +0200 Subject: [PATCH 05/29] Adapted DH example to folder structure change in the main branch --- .fst.config.json | 5 +++++ Makefile | 2 +- {src => examples/dh}/DY.Example.DH.Debug.fst | 0 {src => examples/dh}/DY.Example.DH.Protocol.Stateful.fst | 0 {src => examples/dh}/DY.Example.DH.Protocol.Total.fst | 0 src/.fst.config.json | 4 ---- 6 files changed, 6 insertions(+), 5 deletions(-) create mode 100644 .fst.config.json rename {src => examples/dh}/DY.Example.DH.Debug.fst (100%) rename {src => examples/dh}/DY.Example.DH.Protocol.Stateful.fst (100%) rename {src => examples/dh}/DY.Example.DH.Protocol.Total.fst (100%) delete mode 100644 src/.fst.config.json diff --git a/.fst.config.json b/.fst.config.json new file mode 100644 index 0000000..7262c8c --- /dev/null +++ b/.fst.config.json @@ -0,0 +1,5 @@ +{ "fstar_exe":"fstar.exe", + "options":["--cache_dir", "cache", "--hint_dir", "hints", "--use_hints", "--record_hints"], + "include_dirs":[ + "../comparse/src", "src/core", "src/lib", "src/lib/comparse", "src/lib/event", "src/lib/state", "src/lib/utils", "examples/nsl_pk", "examples/dh"] +} \ No newline at end of file diff --git a/Makefile b/Makefile index e0c73d9..52d265d 100644 --- a/Makefile +++ b/Makefile @@ -5,7 +5,7 @@ COMPARSE_HOME ?= $(DY_HOME)/../comparse INNER_SOURCE_DIRS = core lib lib/comparse lib/event lib/state lib/utils SOURCE_DIRS = $(addprefix $(DY_HOME)/src/, $(INNER_SOURCE_DIRS)) -INNER_EXAMPLE_DIRS = nsl_pk +INNER_EXAMPLE_DIRS = nsl_pk dh EXAMPLE_DIRS = $(addprefix $(DY_HOME)/examples/, $(INNER_EXAMPLE_DIRS)) INCLUDE_DIRS = $(SOURCE_DIRS) $(EXAMPLE_DIRS) $(COMPARSE_HOME)/src diff --git a/src/DY.Example.DH.Debug.fst b/examples/dh/DY.Example.DH.Debug.fst similarity index 100% rename from src/DY.Example.DH.Debug.fst rename to examples/dh/DY.Example.DH.Debug.fst diff --git a/src/DY.Example.DH.Protocol.Stateful.fst b/examples/dh/DY.Example.DH.Protocol.Stateful.fst similarity index 100% rename from src/DY.Example.DH.Protocol.Stateful.fst rename to examples/dh/DY.Example.DH.Protocol.Stateful.fst diff --git a/src/DY.Example.DH.Protocol.Total.fst b/examples/dh/DY.Example.DH.Protocol.Total.fst similarity index 100% rename from src/DY.Example.DH.Protocol.Total.fst rename to examples/dh/DY.Example.DH.Protocol.Total.fst diff --git a/src/.fst.config.json b/src/.fst.config.json deleted file mode 100644 index 5f5ec9e..0000000 --- a/src/.fst.config.json +++ /dev/null @@ -1,4 +0,0 @@ -{ "fstar_exe":"fstar.exe", - "options":["--cache_dir", "../cache", "--hint_dir", "../.hints", "--use_hints", "--record_hints"], - "include_dirs":[".", "../../comparse/src"] -} \ No newline at end of file From 2fe4dc595040a3382a0e8be8fc202f22173d99d4 Mon Sep 17 00:00:00 2001 From: Fabian Hauck Date: Mon, 6 May 2024 17:24:13 +0200 Subject: [PATCH 06/29] DH example trace and crypto predicates; DH security lemmas --- examples/dh/DY.Example.DH.Debug.fst | 2 +- .../DY.Example.DH.Protocol.Stateful.Proof.fst | 141 +++++++++++++++++ .../dh/DY.Example.DH.Protocol.Stateful.fst | 146 +++++++++--------- .../dh/DY.Example.DH.Protocol.Total.Proof.fst | 41 +++++ examples/dh/DY.Example.DH.Protocol.Total.fst | 138 ++++++++++------- .../dh/DY.Example.DH.SecurityProperties.fst | 78 ++++++++++ 6 files changed, 415 insertions(+), 131 deletions(-) create mode 100644 examples/dh/DY.Example.DH.Protocol.Stateful.Proof.fst create mode 100644 examples/dh/DY.Example.DH.Protocol.Total.Proof.fst create mode 100644 examples/dh/DY.Example.DH.SecurityProperties.fst diff --git a/examples/dh/DY.Example.DH.Debug.fst b/examples/dh/DY.Example.DH.Debug.fst index 275e07d..0dce021 100644 --- a/examples/dh/DY.Example.DH.Debug.fst +++ b/examples/dh/DY.Example.DH.Debug.fst @@ -65,7 +65,7 @@ let debug () : crypto (option unit) = return (Some ()) -//Run ``main ()`` when the module loads +//Run ``debug ()`` when the module loads #push-options "--warn_error -272" let _ = debug () Nil #pop-options \ No newline at end of file diff --git a/examples/dh/DY.Example.DH.Protocol.Stateful.Proof.fst b/examples/dh/DY.Example.DH.Protocol.Stateful.Proof.fst new file mode 100644 index 0000000..55bd8f2 --- /dev/null +++ b/examples/dh/DY.Example.DH.Protocol.Stateful.Proof.fst @@ -0,0 +1,141 @@ +module DY.Example.DH.Protocol.Stateful.Proof + +open Comparse +open DY.Core +open DY.Lib +open DY.Example.DH.Protocol.Total +open DY.Example.DH.Protocol.Total.Proof +open DY.Example.DH.Protocol.Stateful + +#set-options "--fuel 0 --ifuel 1 --z3rlimit 25 --z3cliopt 'smt.qi.eager_threshold=100'" + +(*** Trace invariants ***) + +/// The (local) state predicate. + +val is_dh_shared_key: trace -> principal -> principal -> bytes -> prop +let is_dh_shared_key tr a b k = exists si sj. + is_secret (join (principal_state_label a si) (principal_state_label b sj)) tr k /\ + get_usage k == AeadKey "DH.aead_key" + +let dh_session_pred: typed_session_pred dh_session = { + pred = (fun tr prin sess_id st -> + match st with + | InitiatorSentMsg1 bob x -> ( + let alice = prin in + is_secret (principal_state_label alice sess_id) tr x /\ + get_usage x == DhKey "DH.dh_key" /\ + event_triggered tr alice (Initiate1 alice bob x) + ) + | ResponderSentMsg2 alice gx gy y -> ( + let bob = prin in + is_publishable tr gx /\ is_publishable tr gy /\ + is_knowable_by (principal_state_label bob sess_id) tr y /\ + is_secret (principal_state_label bob sess_id) tr y /\ get_usage y == DhKey "DH.dh_key" /\ + gy == dh_pk y /\ + event_triggered tr bob (Respond1 alice bob gx gy y) + ) + | InitiatorSendMsg3 bob gx gy k -> ( + let alice = prin in + is_publishable tr gx /\ is_publishable tr gy /\ + is_knowable_by (principal_state_label alice sess_id) tr k /\ + event_triggered tr alice (Initiate2 alice bob gx gy k) /\ + (is_corrupt tr (principal_state_label alice sess_id) \/ + (exists y. k == dh y gx /\ is_dh_shared_key tr alice bob k /\ + event_triggered tr bob (Respond1 alice bob gx gy y))) + ) + | ResponderReceivedMsg3 alice gx gy k -> ( + let bob = prin in + is_publishable tr gx /\ is_publishable tr gy /\ + is_knowable_by (principal_state_label bob sess_id) tr k /\ + event_triggered tr bob (Respond2 alice bob gx gy k) /\ + (is_corrupt tr (principal_state_label bob sess_id) \/ + is_dh_shared_key tr alice bob k /\ event_triggered tr alice (Initiate2 alice bob gx gy k)) + ) + ); + pred_later = (fun tr1 tr2 prin sess_id st -> ()); + pred_knowable = (fun tr prin sess_id st -> ()); +} + +/// The (local) event predicate. + +let dh_event_pred: event_predicate dh_event = + fun tr prin e -> + match e with + | Initiate1 alice bob x -> True + | Respond1 alice bob gx gy y -> ( + is_publishable tr gx /\ is_publishable tr gy /\ + (exists sess_id. is_secret (principal_state_label bob sess_id) tr y) /\ + get_usage y == DhKey "DH.dh_key" /\ + gy = dh_pk y + ) + | Initiate2 alice bob gx gy k -> ( + is_publishable tr gx /\ is_publishable tr gy /\ + (exists x sess_id. is_secret (principal_state_label alice sess_id) tr x /\ + gx = dh_pk x) /\ + (is_corrupt tr (principal_label bob) \/ + (exists y. k == dh y gx /\ is_dh_shared_key tr alice bob k /\ event_triggered tr bob (Respond1 alice bob gx gy y))) + ) + | Respond2 alice bob gx gy k -> ( + is_corrupt tr (principal_label alice) \/ + (is_dh_shared_key tr alice bob k /\ + event_triggered tr alice (Initiate2 alice bob gx gy k)) + ) + +(* Couldn't we hide all of the following code in a function returning a record? *) + +/// List of all local state predicates. + +let all_sessions = [ + (pki_label, typed_session_pred_to_session_pred (map_session_invariant pki_pred)); + (private_keys_label, typed_session_pred_to_session_pred (map_session_invariant private_keys_pred)); + (dh_session_label, typed_session_pred_to_session_pred dh_session_pred); +] + +/// List of all local event predicates. + +let all_events = [ + (dh_event_instance.tag, compile_event_pred dh_event_pred) +] + +/// Create the global trace invariants. + +let dh_trace_invs: trace_invariants (dh_crypto_invs) = { + state_pred = mk_state_predicate dh_crypto_invs all_sessions; + event_pred = mk_event_pred all_events; +} + +instance dh_protocol_invs: protocol_invariants = { + crypto_invs = dh_crypto_invs; + trace_invs = dh_trace_invs; +} + +/// Lemmas that the global state predicate contains all the local ones + +val all_sessions_has_all_sessions: unit -> Lemma (norm [delta_only [`%all_sessions; `%for_allP]; iota; zeta] (for_allP (has_session_pred dh_protocol_invs) all_sessions)) +let all_sessions_has_all_sessions () = + assert_norm(List.Tot.no_repeats_p (List.Tot.map fst (all_sessions))); + mk_global_session_pred_correct dh_protocol_invs all_sessions; + norm_spec [delta_only [`%all_sessions; `%for_allP]; iota; zeta] (for_allP (has_session_pred dh_protocol_invs) all_sessions) + +val full_dh_session_pred_has_pki_invariant: squash (has_pki_invariant dh_protocol_invs) +let full_dh_session_pred_has_pki_invariant = all_sessions_has_all_sessions () + +val full_dh_session_pred_has_private_keys_invariant: squash (has_private_keys_invariant dh_protocol_invs) +let full_dh_session_pred_has_private_keys_invariant = all_sessions_has_all_sessions () + +val full_dh_session_pred_has_nsl_invariant: squash (has_typed_session_pred dh_protocol_invs (dh_session_label, dh_session_pred)) +let full_dh_session_pred_has_nsl_invariant = all_sessions_has_all_sessions () + +/// Lemmas that the global event predicate contains all the local ones + +val all_events_has_all_events: unit -> Lemma (norm [delta_only [`%all_events; `%for_allP]; iota; zeta] (for_allP (has_compiled_event_pred dh_protocol_invs) all_events)) +let all_events_has_all_events () = + assert_norm(List.Tot.no_repeats_p (List.Tot.map fst (all_events))); + mk_event_pred_correct dh_protocol_invs all_events; + norm_spec [delta_only [`%all_events; `%for_allP]; iota; zeta] (for_allP (has_compiled_event_pred dh_protocol_invs) all_events); + let dumb_lemma (x:prop) (y:prop): Lemma (requires x /\ x == y) (ensures y) = () in + dumb_lemma (for_allP (has_compiled_event_pred dh_protocol_invs) all_events) (norm [delta_only [`%all_events; `%for_allP]; iota; zeta] (for_allP (has_compiled_event_pred dh_protocol_invs) all_events)) + +val full_nsl_event_pred_has_nsl_invariant: squash (has_event_pred dh_protocol_invs dh_event_pred) +let full_nsl_event_pred_has_nsl_invariant = all_events_has_all_events () diff --git a/examples/dh/DY.Example.DH.Protocol.Stateful.fst b/examples/dh/DY.Example.DH.Protocol.Stateful.fst index 4d7cbe1..be7dcd9 100644 --- a/examples/dh/DY.Example.DH.Protocol.Stateful.fst +++ b/examples/dh/DY.Example.DH.Protocol.Stateful.fst @@ -9,10 +9,10 @@ open DY.Example.DH.Protocol.Total [@@ with_bytes bytes] type dh_session = - | InitiatorSentMsg1: b:principal -> x:bytes -> dh_session - | ResponderSentMsg2: a:principal -> gx:bytes -> gy:bytes -> y:bytes -> dh_session - | InitiatorSendMsg3: b:principal -> gx:bytes -> gy:bytes -> x:bytes -> dh_session - | ResponderReceivedMsg3: a:principal -> gx:bytes -> gy:bytes -> y:bytes -> dh_session + | InitiatorSentMsg1: b:principal -> x:bytes -> dh_session + | ResponderSentMsg2: a:principal -> gx:bytes -> gy:bytes -> y:bytes -> dh_session + | InitiatorSendMsg3: b:principal -> gx:bytes -> gy:bytes -> k:bytes -> dh_session + | ResponderReceivedMsg3: a:principal -> gx:bytes -> gy:bytes -> k:bytes -> dh_session %splice [ps_dh_session] (gen_parser (`dh_session)) %splice [ps_dh_session_is_well_formed] (gen_is_well_formed_lemma (`dh_session)) @@ -25,8 +25,8 @@ instance dh_session_parseable_serializeable: parseable_serializeable bytes dh_se type dh_event = | Initiate1: a:principal -> b:principal -> x:bytes -> dh_event | Respond1: a:principal -> b:principal -> gx:bytes -> gy:bytes -> y:bytes -> dh_event - | Initiate2: a:principal -> b:principal -> gx:bytes -> gy:bytes -> x:bytes -> dh_event - | Respond2: a:principal -> b:principal -> gx:bytes -> gy:bytes -> y:bytes -> dh_event + | Initiate2: a:principal -> b:principal -> gx:bytes -> gy:bytes -> k:bytes -> dh_event + | Respond2: a:principal -> b:principal -> gx:bytes -> gy:bytes -> k:bytes -> dh_event %splice [ps_dh_event] (gen_parser (`dh_event)) %splice [ps_dh_event_is_well_formed] (gen_is_well_formed_lemma (`dh_event)) @@ -42,8 +42,8 @@ val dh_session_label: string let dh_session_label = "DH.Session" type dh_global_sess_ids = { - pki: nat; - private_keys: nat; + pki: nat; + private_keys: nat; } (*** Stateful code ***) @@ -56,94 +56,96 @@ type dh_global_sess_ids = { // a message over the network. val prepare_msg1: principal -> principal -> crypto nat let prepare_msg1 alice bob = - let* x = mk_rand NoUsage (join (principal_label alice) (principal_label bob)) 32 in - trigger_event alice (Initiate1 alice bob x);* - let* session_id = new_session_id alice in - set_typed_state dh_session_label alice session_id (InitiatorSentMsg1 bob x <: dh_session);* - return session_id + let* session_id = new_session_id alice in + let* x = mk_rand (DhKey "DH.dh_key") (principal_state_label alice session_id) 32 in + trigger_event alice (Initiate1 alice bob x);* + set_typed_state dh_session_label alice session_id (InitiatorSentMsg1 bob x <: dh_session);* + return session_id // Alice sends message 1 val send_msg1: principal -> nat -> crypto (option nat) let send_msg1 alice session_id = - let*? session_state: dh_session = get_typed_state dh_session_label alice session_id in - match session_state with - | InitiatorSentMsg1 bob x -> ( - let msg = compute_message1 bob x in - let* msg_id = send_msg msg in - return (Some msg_id) - ) - | _ -> return None + let*? session_state: dh_session = get_typed_state dh_session_label alice session_id in + match session_state with + | InitiatorSentMsg1 bob x -> ( + let msg = compute_message1 bob x in + let* msg_id = send_msg msg in + return (Some msg_id) + ) + | _ -> return None // Bob prepares message 2 val prepare_msg2: principal -> principal -> nat -> crypto (option nat) let prepare_msg2 alice bob msg_id = - let*? msg = recv_msg msg_id in - let*? msg1: message1 = return (decode_message1 msg) in - let* y = mk_rand NoUsage (join (principal_label alice) (principal_label bob)) 32 in - let gy = dh_pk y in - trigger_event bob (Respond1 alice bob msg1.gx gy y);* - let* session_id = new_session_id bob in - set_typed_state dh_session_label bob session_id (ResponderSentMsg2 alice msg1.gx gy y <: dh_session);* - return (Some session_id) + let*? msg = recv_msg msg_id in + let*? msg1: message1 = return (decode_message1 msg) in + let* session_id = new_session_id bob in + let* y = mk_rand (DhKey "DH.dh_key") (principal_state_label bob session_id) 32 in + let gy = dh_pk y in + trigger_event bob (Respond1 alice bob msg1.gx gy y);* + set_typed_state dh_session_label bob session_id (ResponderSentMsg2 alice msg1.gx gy y <: dh_session);* + return (Some session_id) // Bob sends message 2 val send_msg2: dh_global_sess_ids -> principal -> nat -> crypto (option nat) let send_msg2 global_sess_id bob session_id = - let*? session_state: dh_session = get_typed_state dh_session_label bob session_id in - match session_state with - | ResponderSentMsg2 alice gx gy y -> ( - let*? sk_b = get_private_key bob global_sess_id.private_keys (Sign "DH.SigningKey") in - let* n_sig = mk_rand SigNonce (principal_label bob) 32 in - let msg = compute_message2 alice bob gx gy sk_b n_sig in - let* msg_id = send_msg msg in - return (Some msg_id) - ) - | _ -> return None + let*? session_state: dh_session = get_typed_state dh_session_label bob session_id in + match session_state with + | ResponderSentMsg2 alice gx gy y -> ( + let*? sk_b = get_private_key bob global_sess_id.private_keys (Sign "DH.SigningKey") in + let* n_sig = mk_rand SigNonce (principal_label bob) 32 in + let msg = compute_message2 alice bob gx gy sk_b n_sig in + let* msg_id = send_msg msg in + return (Some msg_id) + ) + | _ -> return None // Alice prepares message 3 // // This function has to verify the signature from message 2 val prepare_msg3: dh_global_sess_ids -> principal -> principal -> nat -> nat -> crypto (option unit) let prepare_msg3 global_sess_id alice bob msg_id session_id = - let*? session_state: dh_session = get_typed_state dh_session_label alice session_id in - match session_state with - | InitiatorSentMsg1 bob x -> ( - let*? pk_b = get_public_key alice global_sess_id.pki (Verify "DH.SigningKey") bob in - let*? msg = recv_msg msg_id in - let gx = dh_pk x in - let*? msg2: message2 = return (decode_message2 msg alice gx pk_b) in - trigger_event alice (Initiate2 alice bob gx msg2.gy x);* - set_typed_state dh_session_label alice session_id (InitiatorSendMsg3 bob gx msg2.gy x <: dh_session);* - return (Some ()) - ) - | _ -> return None + let*? session_state: dh_session = get_typed_state dh_session_label alice session_id in + match session_state with + | InitiatorSentMsg1 bob x -> ( + let*? pk_b = get_public_key alice global_sess_id.pki (Verify "DH.SigningKey") bob in + let*? msg = recv_msg msg_id in + let gx = dh_pk x in + let*? msg2: message2 = return (decode_message2 msg alice gx pk_b) in + let k = dh x msg2.gy in + trigger_event alice (Initiate2 alice bob gx msg2.gy k);* + set_typed_state dh_session_label alice session_id (InitiatorSendMsg3 bob gx msg2.gy k <: dh_session);* + return (Some ()) + ) + | _ -> return None // Alice send message 3 val send_msg3: dh_global_sess_ids -> principal -> principal -> nat -> crypto (option nat) let send_msg3 global_sess_id alice bob session_id = - let*? session_state: dh_session = get_typed_state dh_session_label alice session_id in - match session_state with - | InitiatorSendMsg3 bob gx gy x -> ( - let*? sk_a = get_private_key alice global_sess_id.private_keys (Sign "DH.SigningKey") in - let* n_sig = mk_rand SigNonce (principal_label alice) 32 in - let msg = compute_message3 alice bob gx gy sk_a n_sig in - let* msg_id = send_msg msg in - return (Some msg_id) - ) - | _ -> return None + let*? session_state: dh_session = get_typed_state dh_session_label alice session_id in + match session_state with + | InitiatorSendMsg3 bob gx gy x -> ( + let*? sk_a = get_private_key alice global_sess_id.private_keys (Sign "DH.SigningKey") in + let* n_sig = mk_rand SigNonce (principal_label alice) 32 in + let msg = compute_message3 alice bob gx gy sk_a n_sig in + let* msg_id = send_msg msg in + return (Some msg_id) + ) + | _ -> return None // Bob verifies message 3 val verify_msg3: dh_global_sess_ids -> principal -> principal -> nat -> nat -> crypto (option unit) let verify_msg3 global_sess_id alice bob msg_id session_id = - let*? session_state: dh_session = get_typed_state dh_session_label bob session_id in - match session_state with - | ResponderSentMsg2 alice gx gy y -> ( - let*? pk_a = get_public_key bob global_sess_id.pki (Verify "DH.SigningKey") alice in - let*? msg = recv_msg msg_id in - let*? msg3: message3 = return (decode_message3 msg bob gx gy pk_a) in - trigger_event bob (Respond2 alice bob gx gy y);* - set_typed_state dh_session_label bob session_id (ResponderReceivedMsg3 alice gx gy y <: dh_session);* - return (Some ()) - ) - | _ -> return None + let*? session_state: dh_session = get_typed_state dh_session_label bob session_id in + match session_state with + | ResponderSentMsg2 alice gx gy y -> ( + let*? pk_a = get_public_key bob global_sess_id.pki (Verify "DH.SigningKey") alice in + let*? msg = recv_msg msg_id in + let*? msg3: message3 = return (decode_message3 msg bob gx gy pk_a) in + let k = dh y gx in + trigger_event bob (Respond2 alice bob gx gy k);* + set_typed_state dh_session_label bob session_id (ResponderReceivedMsg3 alice gx gy k <: dh_session);* + return (Some ()) + ) + | _ -> return None \ No newline at end of file diff --git a/examples/dh/DY.Example.DH.Protocol.Total.Proof.fst b/examples/dh/DY.Example.DH.Protocol.Total.Proof.fst new file mode 100644 index 0000000..615c05f --- /dev/null +++ b/examples/dh/DY.Example.DH.Protocol.Total.Proof.fst @@ -0,0 +1,41 @@ +module DY.Example.DH.Protocol.Total.Proof + +open Comparse +open DY.Core +open DY.Lib +open DY.Example.DH.Protocol.Total +open DY.Example.DH.Protocol.Stateful + +(*** Cryptographic invariants ***) + +val dh_crypto_usages: crypto_usages +instance dh_crypto_usages = default_crypto_usages + +#push-options "--ifuel 2 --fuel 0" +val dh_crypto_preds: crypto_predicates dh_crypto_usages +let dh_crypto_preds = { + default_crypto_predicates dh_crypto_usages with + + sign_pred = (fun tr vk sig_msg -> + get_signkey_usage vk == SigKey "DH.SigningKey" /\ + (exists prin. get_signkey_label vk = principal_label prin /\ ( + match parse sig_message sig_msg with + | Some (SigMsg2 sig_msg2) -> ( + exists y. sig_msg2.gy == (dh_pk y) /\ event_triggered tr prin (Respond1 sig_msg2.a prin sig_msg2.gx sig_msg2.gy y) + ) + | Some (SigMsg3 sig_msg3) -> ( + exists x. sig_msg3.gx == (dh_pk x) /\ event_triggered tr prin (Initiate2 prin sig_msg3.b sig_msg3.gx sig_msg3.gy x) + ) + | None -> False + )) + ); + sign_pred_later = (fun tr1 tr2 vk msg -> ()) +} +#pop-options + +instance dh_crypto_invs = { + usages = dh_crypto_usages; + preds = dh_crypto_preds; +} + +(*** Proofs ***) \ No newline at end of file diff --git a/examples/dh/DY.Example.DH.Protocol.Total.fst b/examples/dh/DY.Example.DH.Protocol.Total.fst index 81cf591..b1f5d98 100644 --- a/examples/dh/DY.Example.DH.Protocol.Total.fst +++ b/examples/dh/DY.Example.DH.Protocol.Total.fst @@ -17,8 +17,8 @@ open DY.Lib // Annotation is needed for comparse to generate serialization methods [@@ with_bytes bytes] type message1 = { - alice:principal; - gx:bytes; + alice:principal; + gx:bytes; } %splice [ps_message1] (gen_parser (`message1)) @@ -26,9 +26,9 @@ type message1 = { [@@ with_bytes bytes] type message2 = { - bob:principal; - gy:bytes; - sg:bytes; + bob:principal; + gy:bytes; + sg:bytes; } %splice [ps_message2] (gen_parser (`message2)) @@ -36,95 +36,117 @@ type message2 = { [@@ with_bytes bytes] type message3 = { - sg:bytes; + sg:bytes; } %splice [ps_message3] (gen_parser (`message3)) %splice [ps_message3_is_well_formed] (gen_is_well_formed_lemma (`message3)) -[@@ with_bytes bytes] -type signature_message = { - p:principal; - gx:bytes; - gy:bytes; -} - -%splice [ps_signature_message] (gen_parser (`signature_message)) -%splice [ps_signature_message_is_well_formed] (gen_is_well_formed_lemma (`signature_message)) [@@ with_bytes bytes] type message = - | Msg1: msg:message1 -> message - | Msg2: msg:message2 -> message - | Msg3: msg:message3 -> message - | Sig: sig:signature_message -> message + | Msg1: msg:message1 -> message + | Msg2: msg:message2 -> message + | Msg3: msg:message3 -> message %splice [ps_message] (gen_parser (`message)) %splice [ps_message_is_well_formed] (gen_is_well_formed_lemma (`message)) instance parseable_serializeable_message: parseable_serializeable bytes message = mk_parseable_serializeable ps_message +// Definition of signature terms +[@@ with_bytes bytes] +type sig_message2 = { + a:principal; + gx:bytes; + gy:bytes; +} + +%splice [ps_sig_message2] (gen_parser (`sig_message2)) +%splice [ps_sig_message2_is_well_formed] (gen_is_well_formed_lemma (`sig_message2)) + +[@@ with_bytes bytes] +type sig_message3 = { + b:principal; + gx:bytes; + gy:bytes; +} + +%splice [ps_sig_message3] (gen_parser (`sig_message3)) +%splice [ps_sig_message3_is_well_formed] (gen_is_well_formed_lemma (`sig_message3)) + +[@@ with_bytes bytes] +type sig_message = + | SigMsg2: msg:sig_message2 -> sig_message + | SigMsg3: msg:sig_message3 -> sig_message + +%splice [ps_sig_message] (gen_parser (`sig_message)) +%splice [ps_sig_message_is_well_formed] (gen_is_well_formed_lemma (`sig_message)) + +instance parseable_serializeable_sig_message: parseable_serializeable bytes sig_message = mk_parseable_serializeable ps_sig_message + + (*** Message Processing ***) // Alice generates message 1 val compute_message1: principal -> bytes -> bytes let compute_message1 alice x = - let gx = dh_pk x in - let msg = Msg1 {alice; gx} in - serialize message msg + let gx = dh_pk x in + let msg = Msg1 {alice; gx} in + serialize message msg // Bob parses message 1 val decode_message1: bytes -> option message1 let decode_message1 msg1_bytes = - let? msg1 = parse message msg1_bytes in - // These lines are the... - guard (Msg1? msg1);? - Some (Msg1?.msg msg1) - // ...short version of the following match: - (* - match msg1 with - | Msg1 msg -> Some msg - | _ -> None - *) + let? msg1 = parse message msg1_bytes in + // These lines are the... + guard (Msg1? msg1);? + Some (Msg1?.msg msg1) + // ...short version of the following match: + (* + match msg1 with + | Msg1 msg -> Some msg + | _ -> None + *) // Bob generates message 2 val compute_message2: principal -> principal -> bytes -> bytes -> bytes -> bytes -> bytes let compute_message2 alice bob gx gy sk_b n_sig = - let sig_msg = Sig {p=alice; gx; gy} in - let sg = sign sk_b n_sig (serialize message sig_msg) in - let msg = Msg2 {bob; gy; sg} in - serialize message msg + let sig_msg = SigMsg2 {a=alice; gx; gy} in + let sg = sign sk_b n_sig (serialize sig_message sig_msg) in + let msg = Msg2 {bob; gy; sg} in + serialize message msg // Alice parses message 2 val decode_message2: bytes -> principal -> bytes -> bytes -> option message2 let decode_message2 msg2_bytes alice gx pk_b = - let? msg2_parsed = parse message msg2_bytes in - guard (Msg2? msg2_parsed);? - let msg2 = Msg2?.msg msg2_parsed in - // Verify the signature contained in the message 2 - // with the gy value from the message and the gx - // value from Alice's state. - let gy = msg2.gy in - let sig_msg = Sig {p=alice; gx; gy} in - if verify pk_b (serialize message sig_msg) msg2.sg then Some (msg2) - else None + let? msg2_parsed = parse message msg2_bytes in + guard (Msg2? msg2_parsed);? + let msg2 = Msg2?.msg msg2_parsed in + // Verify the signature contained in the message 2 + // with the gy value from the message and the gx + // value from Alice's state. + let gy = msg2.gy in + let sig_msg = SigMsg2 {a=alice; gx; gy} in + if verify pk_b (serialize sig_message sig_msg) msg2.sg then Some (msg2) + else None // Alice generates message3 val compute_message3: principal -> principal -> bytes -> bytes -> bytes -> bytes -> bytes let compute_message3 alice bob gx gy sk_a n_sig = - let sig_msg = Sig {p=bob; gx; gy} in - let sg = sign sk_a n_sig (serialize message sig_msg) in - let msg = Msg3 {sg} in - serialize message msg + let sig_msg = SigMsg3 {b=bob; gx; gy} in + let sg = sign sk_a n_sig (serialize sig_message sig_msg) in + let msg = Msg3 {sg} in + serialize message msg // Bob parses message3 val decode_message3: bytes -> principal -> bytes -> bytes -> bytes -> option message3 let decode_message3 msg3_bytes bob gx gy pk_a = - let? msg3_parsed = parse message msg3_bytes in - guard (Msg3? msg3_parsed);? - let msg3 = Msg3?.msg msg3_parsed in - // Verify the signature contained in message 3 - // with the gx and gy values from Bob's state. - let sig_msg = Sig {p=bob; gx; gy} in - if verify pk_a (serialize message sig_msg) msg3.sg then Some (msg3) - else None + let? msg3_parsed = parse message msg3_bytes in + guard (Msg3? msg3_parsed);? + let msg3 = Msg3?.msg msg3_parsed in + // Verify the signature contained in message 3 + // with the gx and gy values from Bob's state. + let sig_msg = SigMsg3 {b=bob; gx; gy} in + if verify pk_a (serialize sig_message sig_msg) msg3.sg then Some (msg3) + else None diff --git a/examples/dh/DY.Example.DH.SecurityProperties.fst b/examples/dh/DY.Example.DH.SecurityProperties.fst new file mode 100644 index 0000000..274f0fa --- /dev/null +++ b/examples/dh/DY.Example.DH.SecurityProperties.fst @@ -0,0 +1,78 @@ +module DY.Example.DH.SecurityProperties + +open Comparse +open DY.Core +open DY.Lib +open DY.Example.DH.Protocol.Total.Proof +open DY.Example.DH.Protocol.Stateful +open DY.Example.DH.Protocol.Stateful.Proof + +#set-options "--fuel 8 --ifuel 8 --z3rlimit 25 --z3cliopt 'smt.qi.eager_threshold=100'" + +(* + TODO: In the intrinsic version we use method like corrupt_at + and did_event_occur_before. Do we need these method here too? +*) +val initiator_correspondence_lemma: tr:trace -> i:nat -> alice:principal -> bob:principal -> gx:bytes -> gy:bytes -> k:bytes -> + Lemma + (requires event_triggered_at tr i alice (Initiate2 alice bob gx gy k) /\ + trace_invariant tr) + (ensures is_corrupt tr (principal_label bob) \/ + (exists y. event_triggered tr bob (Respond1 alice bob gx gy y) /\ + k == dh y gx) + ) +let initiator_correspondence_lemma tr i alice bob gx gy k = () + +val responder_correspondence_lemma: tr:trace -> i:nat -> alice:principal -> bob:principal -> gx:bytes -> gy:bytes -> k:bytes -> + Lemma + (requires event_triggered_at tr i bob (Respond2 alice bob gx gy k) /\ + trace_invariant tr) + (ensures is_corrupt tr (principal_label alice) \/ + event_triggered tr alice (Initiate2 alice bob gx gy k)) +let responder_correspondence_lemma tr i alice bob gx gy k = () + +val key_secrecy_lemma: tr:trace -> k:bytes -> alice:principal -> bob:principal -> + Lemma + (requires + trace_invariant tr /\ + attacker_knows tr k + ) + (ensures + forall si sj. is_secret (join (principal_state_label alice si) (principal_state_label bob sj)) tr k ==> + (is_corrupt tr (principal_state_label alice si) \/ is_corrupt tr (principal_state_label bob sj)) + ) +let key_secrecy_lemma tr k alice bob = attacker_only_knows_publishable_values tr k + +val initiator_forward_secrecy_lemma: + tr:trace -> i:nat -> alice:principal -> bob:principal -> gx:bytes -> gy:bytes -> k:bytes -> + Lemma + (requires + trace_invariant tr /\ + event_triggered_at tr i alice (Initiate2 alice bob gx gy k) /\ + attacker_knows tr k + ) + (ensures + is_corrupt tr (principal_label bob) \/ + (exists si sj. is_secret (join (principal_state_label alice si) (principal_state_label bob sj)) tr k /\ + (is_corrupt tr (principal_state_label alice si) \/ is_corrupt tr (principal_state_label bob sj)) + ) + ) +let initiator_forward_secrecy_lemma tr i alice bob gx gy k = + attacker_only_knows_publishable_values tr k + +val responder_forward_secrecy_lemma: + tr:trace -> i:nat -> alice:principal -> bob:principal -> gx:bytes -> gy:bytes -> k:bytes -> + Lemma + (requires + trace_invariant tr /\ + event_triggered_at tr i bob (Respond2 alice bob gx gy k) /\ + attacker_knows tr k + ) + (ensures + is_corrupt tr (principal_label alice) \/ + (exists si sj. is_secret (join (principal_state_label alice si) (principal_state_label bob sj)) tr k /\ + (is_corrupt tr (principal_state_label alice si) \/ is_corrupt tr (principal_state_label bob sj)) + ) + ) +let responder_forward_secrecy_lemma tr i alice bob gx gy k = + attacker_only_knows_publishable_values tr k From b659f3f56f90a4e8d7c1fe6f04524e88c4221fe3 Mon Sep 17 00:00:00 2001 From: Fabian Hauck Date: Mon, 6 May 2024 18:23:38 +0200 Subject: [PATCH 07/29] DH example add trace printing to debug protocol run --- examples/dh/DY.Example.DH.Debug.fst | 5 +++++ .../DY.Example.DH.Protocol.Stateful.Proof.fst | 14 ++++++------ .../dh/DY.Example.DH.Protocol.Stateful.fst | 22 +++++++++---------- examples/dh/Makefile | 6 +++++ 4 files changed, 29 insertions(+), 18 deletions(-) create mode 100644 examples/dh/Makefile diff --git a/examples/dh/DY.Example.DH.Debug.fst b/examples/dh/DY.Example.DH.Debug.fst index 0dce021..30933e1 100644 --- a/examples/dh/DY.Example.DH.Debug.fst +++ b/examples/dh/DY.Example.DH.Debug.fst @@ -63,6 +63,11 @@ let debug () : crypto (option unit) = // Bob verify_msg3 bob_global_session_ids alice bob msg3_id bob_session_id;* + let* tr = get_trace in + let _ = IO.debug_print_string ( + trace_to_string default_trace_to_string_printers tr + ) in + return (Some ()) //Run ``debug ()`` when the module loads diff --git a/examples/dh/DY.Example.DH.Protocol.Stateful.Proof.fst b/examples/dh/DY.Example.DH.Protocol.Stateful.Proof.fst index 55bd8f2..9408194 100644 --- a/examples/dh/DY.Example.DH.Protocol.Stateful.Proof.fst +++ b/examples/dh/DY.Example.DH.Protocol.Stateful.Proof.fst @@ -87,9 +87,9 @@ let dh_event_pred: event_predicate dh_event = /// List of all local state predicates. let all_sessions = [ - (pki_label, typed_session_pred_to_session_pred (map_session_invariant pki_pred)); - (private_keys_label, typed_session_pred_to_session_pred (map_session_invariant private_keys_pred)); - (dh_session_label, typed_session_pred_to_session_pred dh_session_pred); + (pki_tag, typed_session_pred_to_session_pred (map_session_invariant pki_pred)); + (private_keys_tag, typed_session_pred_to_session_pred (map_session_invariant private_keys_pred)); + (dh_session_tag, typed_session_pred_to_session_pred dh_session_pred); ] /// List of all local event predicates. @@ -124,8 +124,8 @@ let full_dh_session_pred_has_pki_invariant = all_sessions_has_all_sessions () val full_dh_session_pred_has_private_keys_invariant: squash (has_private_keys_invariant dh_protocol_invs) let full_dh_session_pred_has_private_keys_invariant = all_sessions_has_all_sessions () -val full_dh_session_pred_has_nsl_invariant: squash (has_typed_session_pred dh_protocol_invs (dh_session_label, dh_session_pred)) -let full_dh_session_pred_has_nsl_invariant = all_sessions_has_all_sessions () +val full_dh_session_pred_has_dh_invariant: squash (has_typed_session_pred dh_protocol_invs (dh_session_tag, dh_session_pred)) +let full_dh_session_pred_has_dh_invariant = all_sessions_has_all_sessions () /// Lemmas that the global event predicate contains all the local ones @@ -137,5 +137,5 @@ let all_events_has_all_events () = let dumb_lemma (x:prop) (y:prop): Lemma (requires x /\ x == y) (ensures y) = () in dumb_lemma (for_allP (has_compiled_event_pred dh_protocol_invs) all_events) (norm [delta_only [`%all_events; `%for_allP]; iota; zeta] (for_allP (has_compiled_event_pred dh_protocol_invs) all_events)) -val full_nsl_event_pred_has_nsl_invariant: squash (has_event_pred dh_protocol_invs dh_event_pred) -let full_nsl_event_pred_has_nsl_invariant = all_events_has_all_events () +val full_dh_event_pred_has_dh_invariant: squash (has_event_pred dh_protocol_invs dh_event_pred) +let full_dh_event_pred_has_dh_invariant = all_events_has_all_events () diff --git a/examples/dh/DY.Example.DH.Protocol.Stateful.fst b/examples/dh/DY.Example.DH.Protocol.Stateful.fst index be7dcd9..7d6cfc1 100644 --- a/examples/dh/DY.Example.DH.Protocol.Stateful.fst +++ b/examples/dh/DY.Example.DH.Protocol.Stateful.fst @@ -38,8 +38,8 @@ instance dh_event_instance: event dh_event = { (*** Setup for the stateful code ***) -val dh_session_label: string -let dh_session_label = "DH.Session" +val dh_session_tag: string +let dh_session_tag = "DH.Session" type dh_global_sess_ids = { pki: nat; @@ -59,13 +59,13 @@ let prepare_msg1 alice bob = let* session_id = new_session_id alice in let* x = mk_rand (DhKey "DH.dh_key") (principal_state_label alice session_id) 32 in trigger_event alice (Initiate1 alice bob x);* - set_typed_state dh_session_label alice session_id (InitiatorSentMsg1 bob x <: dh_session);* + set_typed_state dh_session_tag alice session_id (InitiatorSentMsg1 bob x <: dh_session);* return session_id // Alice sends message 1 val send_msg1: principal -> nat -> crypto (option nat) let send_msg1 alice session_id = - let*? session_state: dh_session = get_typed_state dh_session_label alice session_id in + let*? session_state: dh_session = get_typed_state dh_session_tag alice session_id in match session_state with | InitiatorSentMsg1 bob x -> ( let msg = compute_message1 bob x in @@ -83,13 +83,13 @@ let prepare_msg2 alice bob msg_id = let* y = mk_rand (DhKey "DH.dh_key") (principal_state_label bob session_id) 32 in let gy = dh_pk y in trigger_event bob (Respond1 alice bob msg1.gx gy y);* - set_typed_state dh_session_label bob session_id (ResponderSentMsg2 alice msg1.gx gy y <: dh_session);* + set_typed_state dh_session_tag bob session_id (ResponderSentMsg2 alice msg1.gx gy y <: dh_session);* return (Some session_id) // Bob sends message 2 val send_msg2: dh_global_sess_ids -> principal -> nat -> crypto (option nat) let send_msg2 global_sess_id bob session_id = - let*? session_state: dh_session = get_typed_state dh_session_label bob session_id in + let*? session_state: dh_session = get_typed_state dh_session_tag bob session_id in match session_state with | ResponderSentMsg2 alice gx gy y -> ( let*? sk_b = get_private_key bob global_sess_id.private_keys (Sign "DH.SigningKey") in @@ -105,7 +105,7 @@ let send_msg2 global_sess_id bob session_id = // This function has to verify the signature from message 2 val prepare_msg3: dh_global_sess_ids -> principal -> principal -> nat -> nat -> crypto (option unit) let prepare_msg3 global_sess_id alice bob msg_id session_id = - let*? session_state: dh_session = get_typed_state dh_session_label alice session_id in + let*? session_state: dh_session = get_typed_state dh_session_tag alice session_id in match session_state with | InitiatorSentMsg1 bob x -> ( let*? pk_b = get_public_key alice global_sess_id.pki (Verify "DH.SigningKey") bob in @@ -114,7 +114,7 @@ let prepare_msg3 global_sess_id alice bob msg_id session_id = let*? msg2: message2 = return (decode_message2 msg alice gx pk_b) in let k = dh x msg2.gy in trigger_event alice (Initiate2 alice bob gx msg2.gy k);* - set_typed_state dh_session_label alice session_id (InitiatorSendMsg3 bob gx msg2.gy k <: dh_session);* + set_typed_state dh_session_tag alice session_id (InitiatorSendMsg3 bob gx msg2.gy k <: dh_session);* return (Some ()) ) | _ -> return None @@ -122,7 +122,7 @@ let prepare_msg3 global_sess_id alice bob msg_id session_id = // Alice send message 3 val send_msg3: dh_global_sess_ids -> principal -> principal -> nat -> crypto (option nat) let send_msg3 global_sess_id alice bob session_id = - let*? session_state: dh_session = get_typed_state dh_session_label alice session_id in + let*? session_state: dh_session = get_typed_state dh_session_tag alice session_id in match session_state with | InitiatorSendMsg3 bob gx gy x -> ( let*? sk_a = get_private_key alice global_sess_id.private_keys (Sign "DH.SigningKey") in @@ -136,7 +136,7 @@ let send_msg3 global_sess_id alice bob session_id = // Bob verifies message 3 val verify_msg3: dh_global_sess_ids -> principal -> principal -> nat -> nat -> crypto (option unit) let verify_msg3 global_sess_id alice bob msg_id session_id = - let*? session_state: dh_session = get_typed_state dh_session_label bob session_id in + let*? session_state: dh_session = get_typed_state dh_session_tag bob session_id in match session_state with | ResponderSentMsg2 alice gx gy y -> ( let*? pk_a = get_public_key bob global_sess_id.pki (Verify "DH.SigningKey") alice in @@ -144,7 +144,7 @@ let verify_msg3 global_sess_id alice bob msg_id session_id = let*? msg3: message3 = return (decode_message3 msg bob gx gy pk_a) in let k = dh y gx in trigger_event bob (Respond2 alice bob gx gy k);* - set_typed_state dh_session_label bob session_id (ResponderReceivedMsg3 alice gx gy k <: dh_session);* + set_typed_state dh_session_tag bob session_id (ResponderReceivedMsg3 alice gx gy k <: dh_session);* return (Some ()) ) | _ -> return None diff --git a/examples/dh/Makefile b/examples/dh/Makefile new file mode 100644 index 0000000..542d594 --- /dev/null +++ b/examples/dh/Makefile @@ -0,0 +1,6 @@ +DY_HOME ?= ../.. +include $(DY_HOME)/Makefile + +test: + cd $(DY_HOME)/obj; OCAMLPATH=$(FSTAR_HOME)/lib ocamlbuild -use-ocamlfind -pkg batteries -pkg fstar.lib DY_Example_DH_Debug.native + $(DY_HOME)/obj/DY_Example_DH_Debug.native From b423727318ef5f75a6bb5984ef91b1b594800302 Mon Sep 17 00:00:00 2001 From: Fabian Hauck Date: Wed, 8 May 2024 18:26:21 +0200 Subject: [PATCH 08/29] DH example compute_message1_proof and decode_message1_proof --- .../dh/DY.Example.DH.Protocol.Stateful.fst | 2 +- .../dh/DY.Example.DH.Protocol.Total.Proof.fst | 104 +++++++++++++++++- 2 files changed, 103 insertions(+), 3 deletions(-) diff --git a/examples/dh/DY.Example.DH.Protocol.Stateful.fst b/examples/dh/DY.Example.DH.Protocol.Stateful.fst index 7d6cfc1..bbe52c8 100644 --- a/examples/dh/DY.Example.DH.Protocol.Stateful.fst +++ b/examples/dh/DY.Example.DH.Protocol.Stateful.fst @@ -68,7 +68,7 @@ let send_msg1 alice session_id = let*? session_state: dh_session = get_typed_state dh_session_tag alice session_id in match session_state with | InitiatorSentMsg1 bob x -> ( - let msg = compute_message1 bob x in + let msg = compute_message1 alice x in let* msg_id = send_msg msg in return (Some msg_id) ) diff --git a/examples/dh/DY.Example.DH.Protocol.Total.Proof.fst b/examples/dh/DY.Example.DH.Protocol.Total.Proof.fst index 615c05f..02bd38a 100644 --- a/examples/dh/DY.Example.DH.Protocol.Total.Proof.fst +++ b/examples/dh/DY.Example.DH.Protocol.Total.Proof.fst @@ -6,6 +6,8 @@ open DY.Lib open DY.Example.DH.Protocol.Total open DY.Example.DH.Protocol.Stateful +#set-options "--fuel 0 --ifuel 0 --z3cliopt 'smt.qi.eager_threshold=100'" + (*** Cryptographic invariants ***) val dh_crypto_usages: crypto_usages @@ -33,9 +35,107 @@ let dh_crypto_preds = { } #pop-options -instance dh_crypto_invs = { +instance dh_crypto_invs: crypto_invariants = { usages = dh_crypto_usages; preds = dh_crypto_preds; } -(*** Proofs ***) \ No newline at end of file +(*** Proofs ***) + +val compute_message1_proof: + tr:trace -> + alice:principal -> bob:principal -> x:bytes -> si:nat -> + Lemma + (requires + event_triggered tr alice (Initiate1 alice bob x) /\ + is_secret (principal_state_label alice si) tr x /\ + DhKey? (get_usage x) + ) + (ensures is_publishable tr (compute_message1 alice x)) +let compute_message1_proof tr alice bob x si = + let gx = dh_pk x in + assert(is_publishable tr gx); + let msg = Msg1 {alice; gx} in + serialize_wf_lemma message (is_publishable tr) msg; + + // The following code is not needed for the prove. + // It just shows what we need to show to prove the lemma. + let msgb = compute_message1 alice x in + assert(bytes_invariant tr msgb); + assert(get_label msgb `can_flow tr` public); + assert(is_publishable tr msgb); + () + +val decode_message1_proof: + tr:trace -> + alice:principal -> bob:principal -> + msg_bytes:bytes -> + Lemma + (requires bytes_invariant tr msg_bytes /\ + is_publishable tr msg_bytes) + (ensures ( + match decode_message1 msg_bytes with + | Some msg1 -> ( + is_publishable tr msg1.gx + ) + | None -> True + )) +let decode_message1_proof tr alice bob msg_bytes = + match decode_message1 msg_bytes with + | Some msg1 -> ( + FStar.Classical.move_requires (parse_wf_lemma message (is_publishable tr)) msg_bytes; + FStar.Classical.move_requires (parse_wf_lemma message (bytes_invariant tr)) msg_bytes; + + // Only for debugging purposes + assert(bytes_invariant tr msg1.gx); + assert(get_label msg1.gx `can_flow tr` public); + () + ) + | None -> () + +val compute_message2_proof: + tr:trace -> si:nat -> + alice:principal -> bob:principal -> + msg1:message1 -> + gy:bytes -> y:bytes -> + sk_b:bytes -> n_sig:bytes -> + Lemma + (requires + event_triggered tr bob (Respond1 bob alice msg1.gx gy y) /\ + is_publishable tr msg1.gx /\ is_publishable tr gy /\ + is_secret (principal_state_label bob si) tr y /\ + is_signature_key "DH.SigningKey" (principal_label bob) tr sk_b /\ + is_secret (principal_label bob) tr n_sig /\ + SigNonce? (get_usage n_sig) + ) + (ensures + is_publishable tr (compute_message2 alice bob msg1.gx gy sk_b n_sig) + ) +let compute_message2_proof tr si alice bob msg1 gy y sk_b n_sig = + let sig_msg = SigMsg2 {a=alice; gx=msg1.gx; gy} in + serialize_wf_lemma sig_message (is_publishable tr) sig_msg; + let sig_msg_bytes = serialize sig_message sig_msg in + assert(is_publishable tr sig_msg_bytes); + let sg = sign sk_b n_sig sig_msg_bytes in + + assert(bytes_invariant tr sk_b); + assert(bytes_invariant tr n_sig); + assert(bytes_invariant tr (serialize sig_message sig_msg)); + assume(SigKey? (get_signkey_usage (Vk sk_b))); + assume(dh_crypto_invs.preds.sign_pred tr (Vk sk_b) sig_msg_bytes); + assert(SigNonce? (get_usage n_sig)); + assert((get_label sig_msg_bytes) `can_flow tr` (get_label n_sig)); + + assume((get_label sk_b) `can_flow tr` public); + assume((get_label n_sig) `can_flow tr` public); + assert((get_label sig_msg_bytes) `can_flow tr` public); + + assume(bytes_invariant tr sg); + + assert(is_publishable tr sg); + let msg = Msg2 {bob; gy; sg} in + serialize_wf_lemma message (is_publishable tr) msg; + + let msg_bytes = compute_message2 alice bob msg1.gx gy sk_b n_sig in + assert(bytes_invariant tr msg_bytes); + () From 872b3e8a23f659d3d08c4d0406dc543960170791 Mon Sep 17 00:00:00 2001 From: Fabian Hauck Date: Wed, 15 May 2024 15:31:09 +0200 Subject: [PATCH 09/29] DH example compute_message2_proof and decode_message2_proof --- .../dh/DY.Example.DH.Protocol.Total.Proof.fst | 126 ++++++++++++++++-- examples/dh/DY.Example.DH.Protocol.Total.fst | 2 +- 2 files changed, 113 insertions(+), 15 deletions(-) diff --git a/examples/dh/DY.Example.DH.Protocol.Total.Proof.fst b/examples/dh/DY.Example.DH.Protocol.Total.Proof.fst index 02bd38a..5f06bb8 100644 --- a/examples/dh/DY.Example.DH.Protocol.Total.Proof.fst +++ b/examples/dh/DY.Example.DH.Protocol.Total.Proof.fst @@ -18,7 +18,7 @@ val dh_crypto_preds: crypto_predicates dh_crypto_usages let dh_crypto_preds = { default_crypto_predicates dh_crypto_usages with - sign_pred = (fun tr vk sig_msg -> + sign_pred = (fun tr vk sig_msg -> get_signkey_usage vk == SigKey "DH.SigningKey" /\ (exists prin. get_signkey_label vk = principal_label prin /\ ( match parse sig_message sig_msg with @@ -56,6 +56,12 @@ let compute_message1_proof tr alice bob x si = let gx = dh_pk x in assert(is_publishable tr gx); let msg = Msg1 {alice; gx} in + + // This lemma makes sure that the second argument + // (is_publishable tr) is true for the third argument + // (msg) before and after serialization. Without + // this lemma we would loose all the guarantees about + // the bytes after the message was serialized. serialize_wf_lemma message (is_publishable tr) msg; // The following code is not needed for the prove. @@ -83,6 +89,12 @@ val decode_message1_proof: let decode_message1_proof tr alice bob msg_bytes = match decode_message1 msg_bytes with | Some msg1 -> ( + // The second argument of the lemma parse_wf_lemma is a predicate defined + // on bytes (is_publishable tr). + // The lemma has the precondition that the predicate is true if the + // third argument is applied to the predicate. + // It then makes sure that the predicate is also true after + // parsing the third argument from bytes into a data type (message). FStar.Classical.move_requires (parse_wf_lemma message (is_publishable tr)) msg_bytes; FStar.Classical.move_requires (parse_wf_lemma message (bytes_invariant tr)) msg_bytes; @@ -93,6 +105,7 @@ let decode_message1_proof tr alice bob msg_bytes = ) | None -> () +//#push-options "--ifuel 8 --fuel 8 --z3rlimit 25" val compute_message2_proof: tr:trace -> si:nat -> alice:principal -> bob:principal -> @@ -101,8 +114,9 @@ val compute_message2_proof: sk_b:bytes -> n_sig:bytes -> Lemma (requires - event_triggered tr bob (Respond1 bob alice msg1.gx gy y) /\ + event_triggered tr bob (Respond1 alice bob msg1.gx gy y) /\ is_publishable tr msg1.gx /\ is_publishable tr gy /\ + gy == dh_pk y /\ is_secret (principal_state_label bob si) tr y /\ is_signature_key "DH.SigningKey" (principal_label bob) tr sk_b /\ is_secret (principal_label bob) tr n_sig /\ @@ -115,27 +129,111 @@ let compute_message2_proof tr si alice bob msg1 gy y sk_b n_sig = let sig_msg = SigMsg2 {a=alice; gx=msg1.gx; gy} in serialize_wf_lemma sig_message (is_publishable tr) sig_msg; let sig_msg_bytes = serialize sig_message sig_msg in - assert(is_publishable tr sig_msg_bytes); + //assert(is_publishable tr sig_msg_bytes); let sg = sign sk_b n_sig sig_msg_bytes in - assert(bytes_invariant tr sk_b); + (*assert(bytes_invariant tr sk_b); assert(bytes_invariant tr n_sig); - assert(bytes_invariant tr (serialize sig_message sig_msg)); - assume(SigKey? (get_signkey_usage (Vk sk_b))); - assume(dh_crypto_invs.preds.sign_pred tr (Vk sk_b) sig_msg_bytes); + assert(bytes_invariant tr sig_msg_bytes); + assert(get_usage sk_b == SigKey "DH.SigningKey"); + assert(is_secret (principal_label bob) tr sk_b); + assert(SigKey? (get_usage sk_b));*) + + // The reveal_opaques is needed to look into the definition + // of get_signkey_usage and see that it simply calls + // get_usage on the given key. + //reveal_opaque (`%get_signkey_usage) (get_signkey_usage); + + (*assert(SigKey? (get_signkey_usage (Vk sk_b))); + assert(get_signkey_usage (Vk sk_b) == SigKey "DH.SigningKey"); + assert((SigMsg2?.msg sig_msg).gy == (dh_pk y));*) + + //reveal_opaque (`%get_signkey_label) (get_signkey_label); + (*assert(exists prin. get_signkey_label (Vk sk_b) = principal_label prin /\ + (SigMsg2?.msg sig_msg).gy == (dh_pk y) /\ + event_triggered tr prin (Respond1 (SigMsg2?.msg sig_msg).a prin (SigMsg2?.msg sig_msg).gx (SigMsg2?.msg sig_msg).gy y)); + assert(dh_crypto_invs.preds.sign_pred tr (Vk sk_b) sig_msg_bytes) by (let open FStar.Tactics in dump ""); assert(SigNonce? (get_usage n_sig)); assert((get_label sig_msg_bytes) `can_flow tr` (get_label n_sig)); - - assume((get_label sk_b) `can_flow tr` public); - assume((get_label n_sig) `can_flow tr` public); - assert((get_label sig_msg_bytes) `can_flow tr` public); - assume(bytes_invariant tr sg); + assert(bytes_invariant tr sg); - assert(is_publishable tr sg); + assert(is_publishable tr sg);*) let msg = Msg2 {bob; gy; sg} in serialize_wf_lemma message (is_publishable tr) msg; let msg_bytes = compute_message2 alice bob msg1.gx gy sk_b n_sig in - assert(bytes_invariant tr msg_bytes); + //assert(bytes_invariant tr msg_bytes); () + +//#push-options "--ifuel 20 --fuel 20 --z3rlimit 100" +val decode_message2_proof: + tr:trace -> + alice:principal -> bob:principal -> + msg_bytes:bytes -> gx:bytes -> pk_b:bytes -> + Lemma + (requires + is_publishable tr msg_bytes /\ + is_verification_key "DH.SigningKey" (principal_label bob) tr pk_b + ) + (ensures ( + match decode_message2 msg_bytes alice gx pk_b with + | Some msg2 -> ( + let sig_msg = SigMsg2 {a=alice; gx; gy=msg2.gy} in + is_publishable tr msg2.gy /\ + is_publishable tr msg2.sg /\ + verify pk_b (serialize sig_message sig_msg) msg2.sg /\ + (is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ + (exists y. event_triggered tr bob (Respond1 alice bob gx msg2.gy y))) + ) + | None -> True + )) +let decode_message2_proof tr alice bob msg_bytes gx pk_b = + match decode_message2 msg_bytes alice gx pk_b with + | Some msg2 -> ( + FStar.Classical.move_requires (parse_wf_lemma message (is_publishable tr)) msg_bytes; + //FStar.Classical.move_requires (parse_wf_lemma message (bytes_invariant tr)) msg_bytes; + + reveal_opaque (`%verify) (verify); + + // Revealing a recursive function does not work with + // ``reveal_opaque``. That's why we need to use + // ``normalize_term_spec bytes_invariant;`` or + // ``norm_spec [zeta; delta_only [`%bytes_invariant]](bytes_invariant);`` + normalize_term_spec bytes_invariant; + + (*assert(bytes_invariant tr msg_bytes); + assert(bytes_invariant tr msg2.sg); + + let sig_msg = SigMsg2 {a=alice; gx; gy=msg2.gy} in + + let sig_msg_bytes = serialize sig_message sig_msg in + assert(verify pk_b sig_msg_bytes msg2.sg = true); + + let open DY.Core.Bytes.Type in + let Sign sk nonce msg = msg2.sg in + assert(msg = sig_msg_bytes); + + assert(is_publishable tr msg2.sg); + assert(get_label msg2.sg `can_flow tr` get_label msg); + assert(get_label msg2.sg `can_flow tr` public); + + + normalize_term_spec get_label; + + assert(bytes_invariant tr msg); + assert(is_publishable tr msg); + + FStar.Classical.move_requires (parse_wf_lemma sig_message (is_publishable tr)) msg; + FStar.Classical.move_requires (parse_wf_lemma sig_message (bytes_invariant tr)) msg; + + assert(bytes_invariant tr gx); + assert(bytes_invariant tr msg2.gy); + + assert(is_corrupt tr (principal_label alice) \/ + is_corrupt tr (principal_label bob) \/ + (exists y. msg2.gy == dh_pk y /\ event_triggered tr bob (Respond1 alice bob gx msg2.gy y)) + );*) + () + ) + | None -> () \ No newline at end of file diff --git a/examples/dh/DY.Example.DH.Protocol.Total.fst b/examples/dh/DY.Example.DH.Protocol.Total.fst index b1f5d98..fdeecb0 100644 --- a/examples/dh/DY.Example.DH.Protocol.Total.fst +++ b/examples/dh/DY.Example.DH.Protocol.Total.fst @@ -128,7 +128,7 @@ let decode_message2 msg2_bytes alice gx pk_b = // value from Alice's state. let gy = msg2.gy in let sig_msg = SigMsg2 {a=alice; gx; gy} in - if verify pk_b (serialize sig_message sig_msg) msg2.sg then Some (msg2) + if verify pk_b (serialize sig_message sig_msg) msg2.sg then Some msg2 else None // Alice generates message3 From a89e4533a93776bc34dc574dddcd12b37c79b260 Mon Sep 17 00:00:00 2001 From: Fabian Hauck Date: Thu, 16 May 2024 13:04:24 +0200 Subject: [PATCH 10/29] DH example compute_message3_proof and decode_message3_proof --- .../dh/DY.Example.DH.Protocol.Stateful.fst | 1 - .../dh/DY.Example.DH.Protocol.Total.Proof.fst | 95 ++++++++++++++++--- examples/dh/DY.Example.DH.Protocol.Total.fst | 2 +- 3 files changed, 82 insertions(+), 16 deletions(-) diff --git a/examples/dh/DY.Example.DH.Protocol.Stateful.fst b/examples/dh/DY.Example.DH.Protocol.Stateful.fst index bbe52c8..036ff5a 100644 --- a/examples/dh/DY.Example.DH.Protocol.Stateful.fst +++ b/examples/dh/DY.Example.DH.Protocol.Stateful.fst @@ -99,7 +99,6 @@ let send_msg2 global_sess_id bob session_id = return (Some msg_id) ) | _ -> return None - // Alice prepares message 3 // // This function has to verify the signature from message 2 diff --git a/examples/dh/DY.Example.DH.Protocol.Total.Proof.fst b/examples/dh/DY.Example.DH.Protocol.Total.Proof.fst index 5f06bb8..dd31d4b 100644 --- a/examples/dh/DY.Example.DH.Protocol.Total.Proof.fst +++ b/examples/dh/DY.Example.DH.Protocol.Total.Proof.fst @@ -13,7 +13,6 @@ open DY.Example.DH.Protocol.Stateful val dh_crypto_usages: crypto_usages instance dh_crypto_usages = default_crypto_usages -#push-options "--ifuel 2 --fuel 0" val dh_crypto_preds: crypto_predicates dh_crypto_usages let dh_crypto_preds = { default_crypto_predicates dh_crypto_usages with @@ -26,14 +25,13 @@ let dh_crypto_preds = { exists y. sig_msg2.gy == (dh_pk y) /\ event_triggered tr prin (Respond1 sig_msg2.a prin sig_msg2.gx sig_msg2.gy y) ) | Some (SigMsg3 sig_msg3) -> ( - exists x. sig_msg3.gx == (dh_pk x) /\ event_triggered tr prin (Initiate2 prin sig_msg3.b sig_msg3.gx sig_msg3.gy x) + exists x k. sig_msg3.gx == (dh_pk x) /\ event_triggered tr prin (Initiate2 prin sig_msg3.b sig_msg3.gx sig_msg3.gy k) ) | None -> False )) ); sign_pred_later = (fun tr1 tr2 vk msg -> ()) } -#pop-options instance dh_crypto_invs: crypto_invariants = { usages = dh_crypto_usages; @@ -51,7 +49,10 @@ val compute_message1_proof: is_secret (principal_state_label alice si) tr x /\ DhKey? (get_usage x) ) - (ensures is_publishable tr (compute_message1 alice x)) + (ensures + is_publishable tr (compute_message1 alice x) /\ + (exists gx. gx == dh_pk x /\ is_publishable tr gx) + ) let compute_message1_proof tr alice bob x si = let gx = dh_pk x in assert(is_publishable tr gx); @@ -77,8 +78,7 @@ val decode_message1_proof: alice:principal -> bob:principal -> msg_bytes:bytes -> Lemma - (requires bytes_invariant tr msg_bytes /\ - is_publishable tr msg_bytes) + (requires is_publishable tr msg_bytes) (ensures ( match decode_message1 msg_bytes with | Some msg1 -> ( @@ -95,8 +95,7 @@ let decode_message1_proof tr alice bob msg_bytes = // third argument is applied to the predicate. // It then makes sure that the predicate is also true after // parsing the third argument from bytes into a data type (message). - FStar.Classical.move_requires (parse_wf_lemma message (is_publishable tr)) msg_bytes; - FStar.Classical.move_requires (parse_wf_lemma message (bytes_invariant tr)) msg_bytes; + parse_wf_lemma message (is_publishable tr) msg_bytes; // Only for debugging purposes assert(bytes_invariant tr msg1.gx); @@ -105,7 +104,6 @@ let decode_message1_proof tr alice bob msg_bytes = ) | None -> () -//#push-options "--ifuel 8 --fuel 8 --z3rlimit 25" val compute_message2_proof: tr:trace -> si:nat -> alice:principal -> bob:principal -> @@ -162,11 +160,10 @@ let compute_message2_proof tr si alice bob msg1 gy y sk_b n_sig = let msg = Msg2 {bob; gy; sg} in serialize_wf_lemma message (is_publishable tr) msg; - let msg_bytes = compute_message2 alice bob msg1.gx gy sk_b n_sig in + //let msg_bytes = compute_message2 alice bob msg1.gx gy sk_b n_sig in //assert(bytes_invariant tr msg_bytes); () -//#push-options "--ifuel 20 --fuel 20 --z3rlimit 100" val decode_message2_proof: tr:trace -> alice:principal -> bob:principal -> @@ -174,6 +171,7 @@ val decode_message2_proof: Lemma (requires is_publishable tr msg_bytes /\ + is_publishable tr gx /\ is_verification_key "DH.SigningKey" (principal_label bob) tr pk_b ) (ensures ( @@ -191,16 +189,18 @@ val decode_message2_proof: let decode_message2_proof tr alice bob msg_bytes gx pk_b = match decode_message2 msg_bytes alice gx pk_b with | Some msg2 -> ( - FStar.Classical.move_requires (parse_wf_lemma message (is_publishable tr)) msg_bytes; + parse_wf_lemma message (is_publishable tr) msg_bytes; //FStar.Classical.move_requires (parse_wf_lemma message (bytes_invariant tr)) msg_bytes; + + serialize_wf_lemma sig_message (bytes_invariant tr) (SigMsg2 {a=alice; gx; gy = msg2.gy}); - reveal_opaque (`%verify) (verify); + //reveal_opaque (`%verify) (verify); // Revealing a recursive function does not work with // ``reveal_opaque``. That's why we need to use // ``normalize_term_spec bytes_invariant;`` or // ``norm_spec [zeta; delta_only [`%bytes_invariant]](bytes_invariant);`` - normalize_term_spec bytes_invariant; + //normalize_term_spec bytes_invariant; (*assert(bytes_invariant tr msg_bytes); assert(bytes_invariant tr msg2.sg); @@ -236,4 +236,71 @@ let decode_message2_proof tr alice bob msg_bytes gx pk_b = );*) () ) + | None -> () + +val compute_message3_proof: + tr:trace -> si:nat -> + alice:principal -> bob:principal -> + msg2:message2 -> gx:bytes -> x:bytes -> + sk_a:bytes -> n_sig:bytes -> + Lemma + (requires + (exists k. event_triggered tr alice (Initiate2 alice bob gx msg2.gy k)) /\ + is_publishable tr gx /\ is_publishable tr msg2.gy /\ + gx == dh_pk x /\ + is_signature_key "DH.SigningKey" (principal_label alice) tr sk_a /\ + is_secret (principal_label alice) tr n_sig /\ + SigNonce? (get_usage n_sig) + ) + (ensures + is_publishable tr (compute_message3 alice bob gx msg2.gy sk_a n_sig) + ) +let compute_message3_proof tr si alice bob msg2 gx x sk_a n_sig = + let sig_msg = SigMsg3 {b=bob; gx; gy=msg2.gy} in + serialize_wf_lemma sig_message (is_publishable tr) sig_msg; + + (* Debugging code + assert(is_publishable tr (serialize sig_message sig_msg));*) + let sg = sign sk_a n_sig (serialize sig_message sig_msg) in + + (* Debugging code + assert(get_label sg `can_flow tr` public); + assert(bytes_invariant tr sg); + assert(is_publishable tr sg);*) + + let msg = Msg3 {sg} in + serialize_wf_lemma message (is_publishable tr) msg; + + (* Debugging code + assert(is_publishable tr (serialize message msg));*) + () + +val decode_message3_proof: + tr:trace -> alice:principal -> bob:principal -> + gx:bytes -> gy:bytes -> msg_bytes:bytes -> pk_a:bytes -> + Lemma + (requires + is_publishable tr msg_bytes /\ + is_publishable tr gx /\ + is_publishable tr gy /\ + is_verification_key "DH.SigningKey" (principal_label alice) tr pk_a + ) + (ensures ( + match decode_message3 msg_bytes bob gx gy pk_a with + | Some msg3 -> ( + let sig_msg = SigMsg3 {b=bob; gx; gy} in + is_publishable tr msg3.sg /\ + verify pk_a (serialize sig_message sig_msg) msg3.sg /\ + (is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ + (exists x k. gx == dh_pk x /\ event_triggered tr alice (Initiate2 alice bob gx gy k))) + ) + | None -> True + )) +let decode_message3_proof tr alice bob gx gy msg_bytes pk_a = + match decode_message3 msg_bytes bob gx gy pk_a with + | Some msg3 -> ( + parse_wf_lemma message (is_publishable tr) msg_bytes; + serialize_wf_lemma sig_message (is_publishable tr) (SigMsg3 {b=bob; gx; gy}); + () + ) | None -> () \ No newline at end of file diff --git a/examples/dh/DY.Example.DH.Protocol.Total.fst b/examples/dh/DY.Example.DH.Protocol.Total.fst index fdeecb0..633bd4f 100644 --- a/examples/dh/DY.Example.DH.Protocol.Total.fst +++ b/examples/dh/DY.Example.DH.Protocol.Total.fst @@ -148,5 +148,5 @@ let decode_message3 msg3_bytes bob gx gy pk_a = // Verify the signature contained in message 3 // with the gx and gy values from Bob's state. let sig_msg = SigMsg3 {b=bob; gx; gy} in - if verify pk_a (serialize sig_message sig_msg) msg3.sg then Some (msg3) + if verify pk_a (serialize sig_message sig_msg) msg3.sg then Some msg3 else None From d7208b0a0bc1fd187781f32a23654f51d2f3da53 Mon Sep 17 00:00:00 2001 From: Fabian Hauck Date: Thu, 16 May 2024 14:10:49 +0200 Subject: [PATCH 11/29] DH example add ifuel option to crypto preds --- examples/dh/DY.Example.DH.Protocol.Total.Proof.fst | 2 ++ 1 file changed, 2 insertions(+) diff --git a/examples/dh/DY.Example.DH.Protocol.Total.Proof.fst b/examples/dh/DY.Example.DH.Protocol.Total.Proof.fst index dd31d4b..beedffe 100644 --- a/examples/dh/DY.Example.DH.Protocol.Total.Proof.fst +++ b/examples/dh/DY.Example.DH.Protocol.Total.Proof.fst @@ -13,6 +13,7 @@ open DY.Example.DH.Protocol.Stateful val dh_crypto_usages: crypto_usages instance dh_crypto_usages = default_crypto_usages +#push-options "--ifuel 2 --fuel 0" val dh_crypto_preds: crypto_predicates dh_crypto_usages let dh_crypto_preds = { default_crypto_predicates dh_crypto_usages with @@ -32,6 +33,7 @@ let dh_crypto_preds = { ); sign_pred_later = (fun tr1 tr2 vk msg -> ()) } +#pop-options instance dh_crypto_invs: crypto_invariants = { usages = dh_crypto_usages; From 74c55265fd29153846d591bc447892614bcb6570 Mon Sep 17 00:00:00 2001 From: Fabian Hauck Date: Thu, 16 May 2024 14:46:58 +0200 Subject: [PATCH 12/29] DH example compatibility with main branch restored --- .../DY.Example.DH.Protocol.Stateful.Proof.fst | 16 ++++++------- .../dh/DY.Example.DH.Protocol.Stateful.fst | 24 ++++++++++--------- 2 files changed, 21 insertions(+), 19 deletions(-) diff --git a/examples/dh/DY.Example.DH.Protocol.Stateful.Proof.fst b/examples/dh/DY.Example.DH.Protocol.Stateful.Proof.fst index 9408194..52ee86e 100644 --- a/examples/dh/DY.Example.DH.Protocol.Stateful.Proof.fst +++ b/examples/dh/DY.Example.DH.Protocol.Stateful.Proof.fst @@ -18,7 +18,7 @@ let is_dh_shared_key tr a b k = exists si sj. is_secret (join (principal_state_label a si) (principal_state_label b sj)) tr k /\ get_usage k == AeadKey "DH.aead_key" -let dh_session_pred: typed_session_pred dh_session = { +let dh_session_pred: local_state_predicate dh_session = { pred = (fun tr prin sess_id st -> match st with | InitiatorSentMsg1 bob x -> ( @@ -87,9 +87,9 @@ let dh_event_pred: event_predicate dh_event = /// List of all local state predicates. let all_sessions = [ - (pki_tag, typed_session_pred_to_session_pred (map_session_invariant pki_pred)); - (private_keys_tag, typed_session_pred_to_session_pred (map_session_invariant private_keys_pred)); - (dh_session_tag, typed_session_pred_to_session_pred dh_session_pred); + pki_tag_and_invariant; + private_keys_tag_and_invariant; + (local_state_dh_session.tag, local_state_predicate_to_local_bytes_state_predicate dh_session_pred); ] /// List of all local event predicates. @@ -112,11 +112,11 @@ instance dh_protocol_invs: protocol_invariants = { /// Lemmas that the global state predicate contains all the local ones -val all_sessions_has_all_sessions: unit -> Lemma (norm [delta_only [`%all_sessions; `%for_allP]; iota; zeta] (for_allP (has_session_pred dh_protocol_invs) all_sessions)) +val all_sessions_has_all_sessions: unit -> Lemma (norm [delta_only [`%all_sessions; `%for_allP]; iota; zeta] (for_allP (has_local_bytes_state_predicate dh_protocol_invs) all_sessions)) let all_sessions_has_all_sessions () = assert_norm(List.Tot.no_repeats_p (List.Tot.map fst (all_sessions))); - mk_global_session_pred_correct dh_protocol_invs all_sessions; - norm_spec [delta_only [`%all_sessions; `%for_allP]; iota; zeta] (for_allP (has_session_pred dh_protocol_invs) all_sessions) + mk_global_local_bytes_state_predicate_correct dh_protocol_invs all_sessions; + norm_spec [delta_only [`%all_sessions; `%for_allP]; iota; zeta] (for_allP (has_local_bytes_state_predicate dh_protocol_invs) all_sessions) val full_dh_session_pred_has_pki_invariant: squash (has_pki_invariant dh_protocol_invs) let full_dh_session_pred_has_pki_invariant = all_sessions_has_all_sessions () @@ -124,7 +124,7 @@ let full_dh_session_pred_has_pki_invariant = all_sessions_has_all_sessions () val full_dh_session_pred_has_private_keys_invariant: squash (has_private_keys_invariant dh_protocol_invs) let full_dh_session_pred_has_private_keys_invariant = all_sessions_has_all_sessions () -val full_dh_session_pred_has_dh_invariant: squash (has_typed_session_pred dh_protocol_invs (dh_session_tag, dh_session_pred)) +val full_dh_session_pred_has_dh_invariant: squash (has_local_state_predicate dh_protocol_invs dh_session_pred) let full_dh_session_pred_has_dh_invariant = all_sessions_has_all_sessions () /// Lemmas that the global event predicate contains all the local ones diff --git a/examples/dh/DY.Example.DH.Protocol.Stateful.fst b/examples/dh/DY.Example.DH.Protocol.Stateful.fst index 036ff5a..c5c4a68 100644 --- a/examples/dh/DY.Example.DH.Protocol.Stateful.fst +++ b/examples/dh/DY.Example.DH.Protocol.Stateful.fst @@ -38,8 +38,10 @@ instance dh_event_instance: event dh_event = { (*** Setup for the stateful code ***) -val dh_session_tag: string -let dh_session_tag = "DH.Session" +instance local_state_dh_session: local_state dh_session = { + tag = "DH.Session"; + format = mk_parseable_serializeable ps_dh_session; +} type dh_global_sess_ids = { pki: nat; @@ -59,13 +61,13 @@ let prepare_msg1 alice bob = let* session_id = new_session_id alice in let* x = mk_rand (DhKey "DH.dh_key") (principal_state_label alice session_id) 32 in trigger_event alice (Initiate1 alice bob x);* - set_typed_state dh_session_tag alice session_id (InitiatorSentMsg1 bob x <: dh_session);* + set_state alice session_id (InitiatorSentMsg1 bob x <: dh_session);* return session_id // Alice sends message 1 val send_msg1: principal -> nat -> crypto (option nat) let send_msg1 alice session_id = - let*? session_state: dh_session = get_typed_state dh_session_tag alice session_id in + let*? session_state: dh_session = get_state alice session_id in match session_state with | InitiatorSentMsg1 bob x -> ( let msg = compute_message1 alice x in @@ -83,13 +85,13 @@ let prepare_msg2 alice bob msg_id = let* y = mk_rand (DhKey "DH.dh_key") (principal_state_label bob session_id) 32 in let gy = dh_pk y in trigger_event bob (Respond1 alice bob msg1.gx gy y);* - set_typed_state dh_session_tag bob session_id (ResponderSentMsg2 alice msg1.gx gy y <: dh_session);* + set_state bob session_id (ResponderSentMsg2 alice msg1.gx gy y <: dh_session);* return (Some session_id) // Bob sends message 2 val send_msg2: dh_global_sess_ids -> principal -> nat -> crypto (option nat) let send_msg2 global_sess_id bob session_id = - let*? session_state: dh_session = get_typed_state dh_session_tag bob session_id in + let*? session_state: dh_session = get_state bob session_id in match session_state with | ResponderSentMsg2 alice gx gy y -> ( let*? sk_b = get_private_key bob global_sess_id.private_keys (Sign "DH.SigningKey") in @@ -104,7 +106,7 @@ let send_msg2 global_sess_id bob session_id = // This function has to verify the signature from message 2 val prepare_msg3: dh_global_sess_ids -> principal -> principal -> nat -> nat -> crypto (option unit) let prepare_msg3 global_sess_id alice bob msg_id session_id = - let*? session_state: dh_session = get_typed_state dh_session_tag alice session_id in + let*? session_state: dh_session = get_state alice session_id in match session_state with | InitiatorSentMsg1 bob x -> ( let*? pk_b = get_public_key alice global_sess_id.pki (Verify "DH.SigningKey") bob in @@ -113,7 +115,7 @@ let prepare_msg3 global_sess_id alice bob msg_id session_id = let*? msg2: message2 = return (decode_message2 msg alice gx pk_b) in let k = dh x msg2.gy in trigger_event alice (Initiate2 alice bob gx msg2.gy k);* - set_typed_state dh_session_tag alice session_id (InitiatorSendMsg3 bob gx msg2.gy k <: dh_session);* + set_state alice session_id (InitiatorSendMsg3 bob gx msg2.gy k <: dh_session);* return (Some ()) ) | _ -> return None @@ -121,7 +123,7 @@ let prepare_msg3 global_sess_id alice bob msg_id session_id = // Alice send message 3 val send_msg3: dh_global_sess_ids -> principal -> principal -> nat -> crypto (option nat) let send_msg3 global_sess_id alice bob session_id = - let*? session_state: dh_session = get_typed_state dh_session_tag alice session_id in + let*? session_state: dh_session = get_state alice session_id in match session_state with | InitiatorSendMsg3 bob gx gy x -> ( let*? sk_a = get_private_key alice global_sess_id.private_keys (Sign "DH.SigningKey") in @@ -135,7 +137,7 @@ let send_msg3 global_sess_id alice bob session_id = // Bob verifies message 3 val verify_msg3: dh_global_sess_ids -> principal -> principal -> nat -> nat -> crypto (option unit) let verify_msg3 global_sess_id alice bob msg_id session_id = - let*? session_state: dh_session = get_typed_state dh_session_tag bob session_id in + let*? session_state: dh_session = get_state bob session_id in match session_state with | ResponderSentMsg2 alice gx gy y -> ( let*? pk_a = get_public_key bob global_sess_id.pki (Verify "DH.SigningKey") alice in @@ -143,7 +145,7 @@ let verify_msg3 global_sess_id alice bob msg_id session_id = let*? msg3: message3 = return (decode_message3 msg bob gx gy pk_a) in let k = dh y gx in trigger_event bob (Respond2 alice bob gx gy k);* - set_typed_state dh_session_tag bob session_id (ResponderReceivedMsg3 alice gx gy k <: dh_session);* + set_state bob session_id (ResponderReceivedMsg3 alice gx gy k <: dh_session);* return (Some ()) ) | _ -> return None From 7820c8a00f50c5844ffe20858ab41613470829aa Mon Sep 17 00:00:00 2001 From: Fabian Hauck Date: Mon, 17 Jun 2024 21:48:50 +0200 Subject: [PATCH 13/29] DH example finished stateful proofs --- .../DY.Example.DH.Protocol.Stateful.Proof.fst | 284 +++++++++++++++++- .../dh/DY.Example.DH.Protocol.Total.Proof.fst | 38 ++- .../dh/DY.Example.DH.SecurityProperties.fst | 14 +- 3 files changed, 309 insertions(+), 27 deletions(-) diff --git a/examples/dh/DY.Example.DH.Protocol.Stateful.Proof.fst b/examples/dh/DY.Example.DH.Protocol.Stateful.Proof.fst index 52ee86e..d63ef89 100644 --- a/examples/dh/DY.Example.DH.Protocol.Stateful.Proof.fst +++ b/examples/dh/DY.Example.DH.Protocol.Stateful.Proof.fst @@ -14,8 +14,9 @@ open DY.Example.DH.Protocol.Stateful /// The (local) state predicate. val is_dh_shared_key: trace -> principal -> principal -> bytes -> prop -let is_dh_shared_key tr a b k = exists si sj. - is_secret (join (principal_state_label a si) (principal_state_label b sj)) tr k /\ +let is_dh_shared_key tr alice bob k = exists si sj. + (is_secret (join (principal_state_label alice si) (principal_state_label bob sj)) tr k \/ + is_secret (join (principal_state_label bob sj) (principal_state_label alice si)) tr k) /\ get_usage k == AeadKey "DH.aead_key" let dh_session_pred: local_state_predicate dh_session = { @@ -30,7 +31,6 @@ let dh_session_pred: local_state_predicate dh_session = { | ResponderSentMsg2 alice gx gy y -> ( let bob = prin in is_publishable tr gx /\ is_publishable tr gy /\ - is_knowable_by (principal_state_label bob sess_id) tr y /\ is_secret (principal_state_label bob sess_id) tr y /\ get_usage y == DhKey "DH.dh_key" /\ gy == dh_pk y /\ event_triggered tr bob (Respond1 alice bob gx gy y) @@ -40,7 +40,7 @@ let dh_session_pred: local_state_predicate dh_session = { is_publishable tr gx /\ is_publishable tr gy /\ is_knowable_by (principal_state_label alice sess_id) tr k /\ event_triggered tr alice (Initiate2 alice bob gx gy k) /\ - (is_corrupt tr (principal_state_label alice sess_id) \/ + (is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ (exists y. k == dh y gx /\ is_dh_shared_key tr alice bob k /\ event_triggered tr bob (Respond1 alice bob gx gy y))) ) @@ -49,8 +49,9 @@ let dh_session_pred: local_state_predicate dh_session = { is_publishable tr gx /\ is_publishable tr gy /\ is_knowable_by (principal_state_label bob sess_id) tr k /\ event_triggered tr bob (Respond2 alice bob gx gy k) /\ - (is_corrupt tr (principal_state_label bob sess_id) \/ - is_dh_shared_key tr alice bob k /\ event_triggered tr alice (Initiate2 alice bob gx gy k)) + (is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ + (is_dh_shared_key tr alice bob k /\ + event_triggered tr alice (Initiate2 alice bob gx gy k))) ) ); pred_later = (fun tr1 tr2 prin sess_id st -> ()); @@ -73,11 +74,11 @@ let dh_event_pred: event_predicate dh_event = is_publishable tr gx /\ is_publishable tr gy /\ (exists x sess_id. is_secret (principal_state_label alice sess_id) tr x /\ gx = dh_pk x) /\ - (is_corrupt tr (principal_label bob) \/ + (is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ (exists y. k == dh y gx /\ is_dh_shared_key tr alice bob k /\ event_triggered tr bob (Respond1 alice bob gx gy y))) ) | Respond2 alice bob gx gy k -> ( - is_corrupt tr (principal_label alice) \/ + is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ (is_dh_shared_key tr alice bob k /\ event_triggered tr alice (Initiate2 alice bob gx gy k)) ) @@ -139,3 +140,270 @@ let all_events_has_all_events () = val full_dh_event_pred_has_dh_invariant: squash (has_event_pred dh_protocol_invs dh_event_pred) let full_dh_event_pred_has_dh_invariant = all_events_has_all_events () + +(*** Proofs ****) + +val prepare_msg1_proof: + tr:trace -> + alice:principal -> bob:principal -> + Lemma + (requires trace_invariant tr) + (ensures ( + let (sess_id, tr_out) = prepare_msg1 alice bob tr in + trace_invariant tr_out + )) +let prepare_msg1_proof tr alice bob = () + +val send_msg1_proof: + tr:trace -> + alice:principal -> bob:principal -> sess_id:nat -> + Lemma + (requires trace_invariant tr) + (ensures ( + let (msg_id, tr_out) = send_msg1 alice sess_id tr in + trace_invariant tr_out + )) +let send_msg1_proof tr alice bob sess_id = + match get_state alice sess_id tr with + | (Some (InitiatorSentMsg1 bob x), tr) -> ( + compute_message1_proof tr alice bob x sess_id + ) + | _ -> () + +val prepare_msg2_proof: + tr:trace -> + alice:principal -> bob:principal -> msg_id:nat -> + Lemma + (requires trace_invariant tr) + (ensures ( + let (msg_id, tr_out) = prepare_msg2 alice bob msg_id tr in + trace_invariant tr_out + )) +let prepare_msg2_proof tr alice bob msg_id = + match recv_msg msg_id tr with + | (Some msg, tr) -> ( + decode_message1_proof tr alice bob msg + ) + | (None, tr) -> () + +val send_msg2_proof: + tr:trace -> + global_sess_id:dh_global_sess_ids -> bob:principal -> sess_id:nat -> + Lemma + (requires trace_invariant tr) + (ensures ( + let (msg_id, tr_out) = send_msg2 global_sess_id bob sess_id tr in + trace_invariant tr_out + )) +let send_msg2_proof tr global_sess_id bob sess_id = + match get_state bob sess_id tr with + | (Some (ResponderSentMsg2 alice gx gy y), tr) -> ( + match get_private_key bob global_sess_id.private_keys (Sign "DH.SigningKey") tr with + | (Some sk_b, tr) -> ( + let (n_sig, tr) = mk_rand SigNonce (principal_label bob) 32 tr in + compute_message2_proof tr sess_id alice bob {alice; gx} gy y sk_b n_sig + ) + | (None, tr) -> () + ) + | _ -> () + +#push-options "--z3rlimit 30" +val prepare_msg3_proof: + tr:trace -> + global_sess_id:dh_global_sess_ids -> alice:principal -> bob:principal -> msg_id:nat -> sess_id:nat -> + Lemma + (requires trace_invariant tr) + (ensures ( + let (_, tr_out) = prepare_msg3 global_sess_id alice bob msg_id sess_id tr in + trace_invariant tr_out + )) +let prepare_msg3_proof tr global_sess_id alice bob msg_id sess_id = + match get_state alice sess_id tr with + | (Some (InitiatorSentMsg1 bob x), tr) -> ( + match recv_msg msg_id tr with + | (Some msg_bytes, tr) -> ( + match get_public_key alice global_sess_id.pki (Verify "DH.SigningKey") bob tr with + | (Some pk_b, tr) -> ( + let gx = dh_pk x in + match decode_message2 msg_bytes alice gx pk_b with + | Some msg2 -> ( + decode_message2_proof tr alice bob msg_bytes gx pk_b; + let k = dh x msg2.gy in + assert(is_publishable tr gx); + assert(is_publishable tr msg2.gy); + assert(is_knowable_by (principal_state_label alice sess_id) tr k); + + assert((exists x sess_id. is_secret (principal_state_label alice sess_id) tr x /\ + gx = dh_pk x)); + assert(get_usage k = AeadKey "DH.aead_key"); + assert(exists si. is_knowable_by (principal_state_label alice si) tr k); + + introduce (~(is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob))) ==> (exists y. k == dh y gx /\ is_dh_shared_key tr alice bob k /\ event_triggered tr bob (Respond1 alice bob gx msg2.gy y)) + with _. ( + assert(exists y k'. k' == dh y gx /\ msg2.gy == dh_pk y /\ event_triggered tr bob (Respond1 alice bob gx msg2.gy y)); + eliminate exists y k'. k' == dh y gx /\ event_triggered tr bob (Respond1 alice bob gx msg2.gy y) + returns _ + with _. ( + assert(event_triggered tr bob (Respond1 alice bob gx msg2.gy y)); + + assert(dh_pk y == msg2.gy); + assert(dh_pk x = gx); + dh_shared_secret_lemma x y; + assert(dh y gx == dh x msg2.gy); + assert(k == k'); + + assert(exists si. is_secret (principal_state_label alice si) tr x); + assert(exists sj. is_secret (principal_state_label bob sj) tr y); + assert(exists si. get_label x == principal_state_label alice si); + assert(exists sj. get_label y == principal_state_label bob sj); + assert(exists si sj. join (get_label x) (get_label y) == join (principal_state_label alice si) (principal_state_label bob sj)); + + normalize_term_spec get_label; + reveal_opaque (`%dh) (dh); + reveal_opaque (`%dh_pk) (dh_pk); + reveal_opaque (`%join) (join); + assert(get_label (dh x msg2.gy) == join (get_label x) (get_dh_label msg2.gy) \/ + get_label (dh x msg2.gy) == join (get_dh_label msg2.gy) (get_label x)); + + assert(exists si sj. is_secret (join (principal_state_label alice si) (principal_state_label bob sj)) tr k \/ + is_secret (join (principal_state_label bob sj) (principal_state_label alice si)) tr k); + () + ) + ) + ) + | None -> () + ) + | (None, tr) -> () + ) + | (None, tr) -> () + ) + | _ -> () +#pop-options + +val send_msg3_proof: + tr:trace -> + global_sess_id:dh_global_sess_ids -> alice:principal -> bob:principal -> sess_id:nat -> + Lemma + (requires trace_invariant tr) + (ensures ( + let (_, tr_out) = send_msg3 global_sess_id alice bob sess_id tr in + trace_invariant tr_out + )) +let send_msg3_proof tr global_sess_id alice bob sess_id = + match get_state alice sess_id tr with + | (Some (InitiatorSendMsg3 bob gx gy k), tr) -> ( + match get_private_key alice global_sess_id.private_keys (Sign "DH.SigningKey") tr with + | (Some sk_a, tr) -> ( + let (n_sig, tr) = mk_rand SigNonce (principal_label alice) 32 tr in + + (* Debugging code + assert(event_triggered tr alice (Initiate2 alice bob gx gy k)); + assert(exists x. gx == dh_pk x); *) + + compute_message3_proof tr sess_id alice bob gx gy sk_a n_sig; + () + ) + | (None, tr) -> () + ) + | _ -> () + +val event_respond1_injective: + tr:trace -> + alice:principal -> bob:principal -> + gx:bytes -> gy:bytes -> y:bytes -> y':bytes -> + Lemma + (requires + trace_invariant tr /\ + event_triggered tr bob (Respond1 alice bob gx gy y) /\ + event_triggered tr bob (Respond1 alice bob gx gy y') + ) + (ensures + y == y' + ) +let event_respond1_injective tr alice bob gx gy y y' = + reveal_opaque (`%dh_pk) (dh_pk); + assert(gy == dh_pk y); + assert(gy == dh_pk y'); + assert(y == y'); + () + +#push-options "--z3rlimit 40" +val verify_msg3_proof: + tr:trace -> + global_sess_id:dh_global_sess_ids -> alice:principal -> bob:principal -> msg_id:nat -> sess_id:nat -> + Lemma + (requires trace_invariant tr) + (ensures ( + let (_, tr_out) = verify_msg3 global_sess_id alice bob msg_id sess_id tr in + trace_invariant tr_out + )) +let verify_msg3_proof tr global_sess_id alice bob msg_id sess_id = + match get_state bob sess_id tr with + | (Some (ResponderSentMsg2 alice gx gy y), tr) -> ( + match recv_msg msg_id tr with + | (Some msg_bytes, tr) -> ( + match get_public_key bob global_sess_id.pki (Verify "DH.SigningKey") alice tr with + | (Some pk_a, tr) -> ( + decode_message3_proof tr alice bob gx gy msg_bytes pk_a; + + match decode_message3 msg_bytes bob gx gy pk_a with + | Some msg3 -> ( + + let k = dh y gx in + + assert(event_triggered tr bob (Respond1 alice bob gx gy y)); + // The decode_message3_proof gives us that there exists a k' such that + // the event Initiate2 has been triggered or alice is corrupt. + // On a high level we need to show now that this event was triggered + // for our concrete k. + assert(exists k'. event_triggered tr alice (Initiate2 alice bob gx gy k') \/ is_corrupt tr (principal_label alice)); + + // Proof strategy: We want to work without the corruption case + // so we introduce this implication. + introduce (~((principal_label alice) `can_flow tr` public \/ (principal_label bob) `can_flow tr` public)) ==> event_triggered tr alice (Initiate2 alice bob gx gy k) with _. ( + // We can now assert that there exists a k' such that the event Initiate2 has been triggered + // without the corruption case. + assert(exists k'. event_triggered tr alice (Initiate2 alice bob gx gy k')); + // We now introduce k' to concretely reason about it. + eliminate exists k'. event_triggered tr alice (Initiate2 alice bob gx gy k') + returns _ + with _. ( + // From the Initiate2 event we know that there exists a Respond1 event with + // gx, gy and some y'. To show that k equals k' it is enough to show that + // y' equals y since k = dh y gx. + assert(exists y'. k' == dh y' gx /\ event_triggered tr bob (Respond1 alice bob gx gy y')); + + // To concretely reason about y' we introduce it via an elimination. + eliminate exists y'. gy == dh_pk y' /\ k' == dh y' gx /\ event_triggered tr bob (Respond1 alice bob gx gy y') + returns _ + with _. ( + // The event_respond1_injective lemma gives us that the + // event triggered with y and y' is the same + event_respond1_injective tr alice bob gx gy y y'; + // With the lemma above F* can automatically deduce that + // k and k' must be equal. + assert(k == k'); + // This gives us that the event Initiate2 has been triggered + // for our concrete k. + assert(event_triggered tr alice (Initiate2 alice bob gx gy k)); + assert(event_triggered tr alice (Initiate2 alice bob gx gy k')); + () + ) + ) + ); + + assert(is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ + (exists si sj. is_secret (join (principal_state_label alice si) (principal_state_label bob sj)) tr k \/ + is_secret (join (principal_state_label bob sj) (principal_state_label alice si)) tr k)); + assert(get_usage k == AeadKey "DH.aead_key"); + assert(is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ + (is_dh_shared_key tr alice bob k /\ event_triggered tr alice (Initiate2 alice bob gx gy k))); + () + ) + | None -> () + ) + | (None, tr) -> () + ) + | (None, tr) -> () + ) + | (_, tr) -> () \ No newline at end of file diff --git a/examples/dh/DY.Example.DH.Protocol.Total.Proof.fst b/examples/dh/DY.Example.DH.Protocol.Total.Proof.fst index beedffe..00117ba 100644 --- a/examples/dh/DY.Example.DH.Protocol.Total.Proof.fst +++ b/examples/dh/DY.Example.DH.Protocol.Total.Proof.fst @@ -11,7 +11,20 @@ open DY.Example.DH.Protocol.Stateful (*** Cryptographic invariants ***) val dh_crypto_usages: crypto_usages -instance dh_crypto_usages = default_crypto_usages +instance dh_crypto_usages = { + dh_known_peer_usage = (fun s1 s2 -> + match s1, s2 with + | "DH.dh_key", _ -> AeadKey "DH.aead_key" + | _, "DH.dh_key" -> AeadKey "DH.aead_key" + | _, _ -> NoUsage + ); + dh_unknown_peer_usage = (fun s1 -> + match s1 with + | "DH.dh_key" -> AeadKey "DH.aead_key" + | _ -> NoUsage); + dh_known_peer_usage_commutes = (fun s1 s2 -> ()); + dh_unknown_peer_usage_implies = (fun s1 s2 -> ()); +} #push-options "--ifuel 2 --fuel 0" val dh_crypto_preds: crypto_predicates dh_crypto_usages @@ -243,32 +256,31 @@ let decode_message2_proof tr alice bob msg_bytes gx pk_b = val compute_message3_proof: tr:trace -> si:nat -> alice:principal -> bob:principal -> - msg2:message2 -> gx:bytes -> x:bytes -> + gx:bytes -> gy:bytes -> sk_a:bytes -> n_sig:bytes -> Lemma (requires - (exists k. event_triggered tr alice (Initiate2 alice bob gx msg2.gy k)) /\ - is_publishable tr gx /\ is_publishable tr msg2.gy /\ - gx == dh_pk x /\ + (exists x k. event_triggered tr alice (Initiate2 alice bob gx gy k) /\ gx = dh_pk x) /\ + is_publishable tr gx /\ is_publishable tr gy /\ is_signature_key "DH.SigningKey" (principal_label alice) tr sk_a /\ is_secret (principal_label alice) tr n_sig /\ SigNonce? (get_usage n_sig) ) (ensures - is_publishable tr (compute_message3 alice bob gx msg2.gy sk_a n_sig) + is_publishable tr (compute_message3 alice bob gx gy sk_a n_sig) ) -let compute_message3_proof tr si alice bob msg2 gx x sk_a n_sig = - let sig_msg = SigMsg3 {b=bob; gx; gy=msg2.gy} in +let compute_message3_proof tr si alice bob gx gy sk_a n_sig = + let sig_msg = SigMsg3 {b=bob; gx; gy} in serialize_wf_lemma sig_message (is_publishable tr) sig_msg; - + (* Debugging code assert(is_publishable tr (serialize sig_message sig_msg));*) - let sg = sign sk_a n_sig (serialize sig_message sig_msg) in + let sg = sign sk_a n_sig (serialize sig_message sig_msg) in - (* Debugging code + (* Debugging code assert(get_label sg `can_flow tr` public); assert(bytes_invariant tr sg); - assert(is_publishable tr sg);*) + assert(is_publishable tr sg); *) let msg = Msg3 {sg} in serialize_wf_lemma message (is_publishable tr) msg; @@ -293,7 +305,7 @@ val decode_message3_proof: let sig_msg = SigMsg3 {b=bob; gx; gy} in is_publishable tr msg3.sg /\ verify pk_a (serialize sig_message sig_msg) msg3.sg /\ - (is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ + (is_corrupt tr (principal_label alice) \/ (exists x k. gx == dh_pk x /\ event_triggered tr alice (Initiate2 alice bob gx gy k))) ) | None -> True diff --git a/examples/dh/DY.Example.DH.SecurityProperties.fst b/examples/dh/DY.Example.DH.SecurityProperties.fst index 274f0fa..4e5e10b 100644 --- a/examples/dh/DY.Example.DH.SecurityProperties.fst +++ b/examples/dh/DY.Example.DH.SecurityProperties.fst @@ -17,7 +17,7 @@ val initiator_correspondence_lemma: tr:trace -> i:nat -> alice:principal -> bob: Lemma (requires event_triggered_at tr i alice (Initiate2 alice bob gx gy k) /\ trace_invariant tr) - (ensures is_corrupt tr (principal_label bob) \/ + (ensures is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ (exists y. event_triggered tr bob (Respond1 alice bob gx gy y) /\ k == dh y gx) ) @@ -27,7 +27,7 @@ val responder_correspondence_lemma: tr:trace -> i:nat -> alice:principal -> bob: Lemma (requires event_triggered_at tr i bob (Respond2 alice bob gx gy k) /\ trace_invariant tr) - (ensures is_corrupt tr (principal_label alice) \/ + (ensures is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ event_triggered tr alice (Initiate2 alice bob gx gy k)) let responder_correspondence_lemma tr i alice bob gx gy k = () @@ -52,8 +52,9 @@ val initiator_forward_secrecy_lemma: attacker_knows tr k ) (ensures - is_corrupt tr (principal_label bob) \/ - (exists si sj. is_secret (join (principal_state_label alice si) (principal_state_label bob sj)) tr k /\ + is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ + (exists si sj. (is_secret (join (principal_state_label alice si) (principal_state_label bob sj)) tr k \/ + is_secret (join (principal_state_label bob sj) (principal_state_label alice si)) tr k) /\ (is_corrupt tr (principal_state_label alice si) \/ is_corrupt tr (principal_state_label bob sj)) ) ) @@ -69,8 +70,9 @@ val responder_forward_secrecy_lemma: attacker_knows tr k ) (ensures - is_corrupt tr (principal_label alice) \/ - (exists si sj. is_secret (join (principal_state_label alice si) (principal_state_label bob sj)) tr k /\ + is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ + (exists si sj. (is_secret (join (principal_state_label alice si) (principal_state_label bob sj)) tr k \/ + is_secret (join (principal_state_label bob sj) (principal_state_label alice si)) tr k) /\ (is_corrupt tr (principal_state_label alice si) \/ is_corrupt tr (principal_state_label bob sj)) ) ) From 5bc010643046030e5d73216c4fad0e4bb9d34a67 Mon Sep 17 00:00:00 2001 From: Fabian Hauck Date: Tue, 18 Jun 2024 11:53:43 +0200 Subject: [PATCH 14/29] Make DH example compatible with current main branch and clean up --- examples/dh/DY.Example.DH.Debug.fst | 4 +--- .../DY.Example.DH.Protocol.Stateful.Proof.fst | 21 +++++++++---------- .../dh/DY.Example.DH.Protocol.Stateful.fst | 18 ++++++++-------- .../dh/DY.Example.DH.Protocol.Total.Proof.fst | 16 ++++++++++---- 4 files changed, 32 insertions(+), 27 deletions(-) diff --git a/examples/dh/DY.Example.DH.Debug.fst b/examples/dh/DY.Example.DH.Debug.fst index 30933e1..d6d9454 100644 --- a/examples/dh/DY.Example.DH.Debug.fst +++ b/examples/dh/DY.Example.DH.Debug.fst @@ -11,10 +11,8 @@ open DY.Core open DY.Lib open DY.Example.DH.Protocol.Stateful -val discard: bool -> crypto (option unit) -let discard _ = return (Some ()) -let debug () : crypto (option unit) = +let debug () : traceful (option unit) = let _ = IO.debug_print_string "************* Trace *************\n" in (*** Initialize protocol run ***) let alice = "alice" in diff --git a/examples/dh/DY.Example.DH.Protocol.Stateful.Proof.fst b/examples/dh/DY.Example.DH.Protocol.Stateful.Proof.fst index d63ef89..87cff6c 100644 --- a/examples/dh/DY.Example.DH.Protocol.Stateful.Proof.fst +++ b/examples/dh/DY.Example.DH.Protocol.Stateful.Proof.fst @@ -156,7 +156,7 @@ let prepare_msg1_proof tr alice bob = () val send_msg1_proof: tr:trace -> - alice:principal -> bob:principal -> sess_id:nat -> + alice:principal -> bob:principal -> sess_id:state_id -> Lemma (requires trace_invariant tr) (ensures ( @@ -188,7 +188,7 @@ let prepare_msg2_proof tr alice bob msg_id = val send_msg2_proof: tr:trace -> - global_sess_id:dh_global_sess_ids -> bob:principal -> sess_id:nat -> + global_sess_id:dh_global_sess_ids -> bob:principal -> sess_id:state_id -> Lemma (requires trace_invariant tr) (ensures ( @@ -210,7 +210,7 @@ let send_msg2_proof tr global_sess_id bob sess_id = #push-options "--z3rlimit 30" val prepare_msg3_proof: tr:trace -> - global_sess_id:dh_global_sess_ids -> alice:principal -> bob:principal -> msg_id:nat -> sess_id:nat -> + global_sess_id:dh_global_sess_ids -> alice:principal -> bob:principal -> msg_id:nat -> sess_id:state_id -> Lemma (requires trace_invariant tr) (ensures ( @@ -261,9 +261,8 @@ let prepare_msg3_proof tr global_sess_id alice bob msg_id sess_id = normalize_term_spec get_label; reveal_opaque (`%dh) (dh); reveal_opaque (`%dh_pk) (dh_pk); - reveal_opaque (`%join) (join); assert(get_label (dh x msg2.gy) == join (get_label x) (get_dh_label msg2.gy) \/ - get_label (dh x msg2.gy) == join (get_dh_label msg2.gy) (get_label x)); + get_label (dh x msg2.gy) == join (get_dh_label msg2.gy) (get_label x)); assert(exists si sj. is_secret (join (principal_state_label alice si) (principal_state_label bob sj)) tr k \/ is_secret (join (principal_state_label bob sj) (principal_state_label alice si)) tr k); @@ -282,7 +281,7 @@ let prepare_msg3_proof tr global_sess_id alice bob msg_id sess_id = val send_msg3_proof: tr:trace -> - global_sess_id:dh_global_sess_ids -> alice:principal -> bob:principal -> sess_id:nat -> + global_sess_id:dh_global_sess_ids -> alice:principal -> bob:principal -> sess_id:state_id -> Lemma (requires trace_invariant tr) (ensures ( @@ -300,7 +299,7 @@ let send_msg3_proof tr global_sess_id alice bob sess_id = assert(event_triggered tr alice (Initiate2 alice bob gx gy k)); assert(exists x. gx == dh_pk x); *) - compute_message3_proof tr sess_id alice bob gx gy sk_a n_sig; + compute_message3_proof tr alice bob gx gy sk_a n_sig; () ) | (None, tr) -> () @@ -327,10 +326,10 @@ let event_respond1_injective tr alice bob gx gy y y' = assert(y == y'); () -#push-options "--z3rlimit 40" +#push-options "--z3rlimit 70" val verify_msg3_proof: tr:trace -> - global_sess_id:dh_global_sess_ids -> alice:principal -> bob:principal -> msg_id:nat -> sess_id:nat -> + global_sess_id:dh_global_sess_ids -> alice:principal -> bob:principal -> msg_id:nat -> sess_id:state_id -> Lemma (requires trace_invariant tr) (ensures ( @@ -366,7 +365,7 @@ let verify_msg3_proof tr global_sess_id alice bob msg_id sess_id = assert(exists k'. event_triggered tr alice (Initiate2 alice bob gx gy k')); // We now introduce k' to concretely reason about it. eliminate exists k'. event_triggered tr alice (Initiate2 alice bob gx gy k') - returns _ + returns event_triggered tr alice (Initiate2 alice bob gx gy k) with _. ( // From the Initiate2 event we know that there exists a Respond1 event with // gx, gy and some y'. To show that k equals k' it is enough to show that @@ -375,7 +374,7 @@ let verify_msg3_proof tr global_sess_id alice bob msg_id sess_id = // To concretely reason about y' we introduce it via an elimination. eliminate exists y'. gy == dh_pk y' /\ k' == dh y' gx /\ event_triggered tr bob (Respond1 alice bob gx gy y') - returns _ + returns event_triggered tr alice (Initiate2 alice bob gx gy k) with _. ( // The event_respond1_injective lemma gives us that the // event triggered with y and y' is the same diff --git a/examples/dh/DY.Example.DH.Protocol.Stateful.fst b/examples/dh/DY.Example.DH.Protocol.Stateful.fst index c5c4a68..8174749 100644 --- a/examples/dh/DY.Example.DH.Protocol.Stateful.fst +++ b/examples/dh/DY.Example.DH.Protocol.Stateful.fst @@ -44,8 +44,8 @@ instance local_state_dh_session: local_state dh_session = { } type dh_global_sess_ids = { - pki: nat; - private_keys: nat; + pki: state_id; + private_keys: state_id; } (*** Stateful code ***) @@ -56,7 +56,7 @@ type dh_global_sess_ids = { // to give the attacker more flexibility. With this // separation an attacker can set a state without sending // a message over the network. -val prepare_msg1: principal -> principal -> crypto nat +val prepare_msg1: principal -> principal -> traceful state_id let prepare_msg1 alice bob = let* session_id = new_session_id alice in let* x = mk_rand (DhKey "DH.dh_key") (principal_state_label alice session_id) 32 in @@ -65,7 +65,7 @@ let prepare_msg1 alice bob = return session_id // Alice sends message 1 -val send_msg1: principal -> nat -> crypto (option nat) +val send_msg1: principal -> state_id -> traceful (option nat) let send_msg1 alice session_id = let*? session_state: dh_session = get_state alice session_id in match session_state with @@ -77,7 +77,7 @@ let send_msg1 alice session_id = | _ -> return None // Bob prepares message 2 -val prepare_msg2: principal -> principal -> nat -> crypto (option nat) +val prepare_msg2: principal -> principal -> nat -> traceful (option state_id) let prepare_msg2 alice bob msg_id = let*? msg = recv_msg msg_id in let*? msg1: message1 = return (decode_message1 msg) in @@ -89,7 +89,7 @@ let prepare_msg2 alice bob msg_id = return (Some session_id) // Bob sends message 2 -val send_msg2: dh_global_sess_ids -> principal -> nat -> crypto (option nat) +val send_msg2: dh_global_sess_ids -> principal -> state_id -> traceful (option nat) let send_msg2 global_sess_id bob session_id = let*? session_state: dh_session = get_state bob session_id in match session_state with @@ -104,7 +104,7 @@ let send_msg2 global_sess_id bob session_id = // Alice prepares message 3 // // This function has to verify the signature from message 2 -val prepare_msg3: dh_global_sess_ids -> principal -> principal -> nat -> nat -> crypto (option unit) +val prepare_msg3: dh_global_sess_ids -> principal -> principal -> nat -> state_id -> traceful (option unit) let prepare_msg3 global_sess_id alice bob msg_id session_id = let*? session_state: dh_session = get_state alice session_id in match session_state with @@ -121,7 +121,7 @@ let prepare_msg3 global_sess_id alice bob msg_id session_id = | _ -> return None // Alice send message 3 -val send_msg3: dh_global_sess_ids -> principal -> principal -> nat -> crypto (option nat) +val send_msg3: dh_global_sess_ids -> principal -> principal -> state_id -> traceful (option nat) let send_msg3 global_sess_id alice bob session_id = let*? session_state: dh_session = get_state alice session_id in match session_state with @@ -135,7 +135,7 @@ let send_msg3 global_sess_id alice bob session_id = | _ -> return None // Bob verifies message 3 -val verify_msg3: dh_global_sess_ids -> principal -> principal -> nat -> nat -> crypto (option unit) +val verify_msg3: dh_global_sess_ids -> principal -> principal -> nat -> state_id -> traceful (option unit) let verify_msg3 global_sess_id alice bob msg_id session_id = let*? session_state: dh_session = get_state bob session_id in match session_state with diff --git a/examples/dh/DY.Example.DH.Protocol.Total.Proof.fst b/examples/dh/DY.Example.DH.Protocol.Total.Proof.fst index 00117ba..bd1cede 100644 --- a/examples/dh/DY.Example.DH.Protocol.Total.Proof.fst +++ b/examples/dh/DY.Example.DH.Protocol.Total.Proof.fst @@ -24,6 +24,14 @@ instance dh_crypto_usages = { | _ -> NoUsage); dh_known_peer_usage_commutes = (fun s1 s2 -> ()); dh_unknown_peer_usage_implies = (fun s1 s2 -> ()); + + kdf_extract_usage = (fun salt_usg ikm_usg salt ikm -> NoUsage); + kdf_extract_label = (fun salt_usg ikm_usg salt_label ikm_label salt ikm -> salt_label `meet` ikm_label); + kdf_extract_label_lemma = (fun tr salt_usg ikm_usg salt_label ikm_label salt ikm -> ()); + + kdf_expand_usage = (fun prk_usage info -> NoUsage); + kdf_expand_label = (fun prk_usage prk_label info -> prk_label); + kdf_expand_label_lemma = (fun tr prk_usage prk_label info -> ()); } #push-options "--ifuel 2 --fuel 0" @@ -57,7 +65,7 @@ instance dh_crypto_invs: crypto_invariants = { val compute_message1_proof: tr:trace -> - alice:principal -> bob:principal -> x:bytes -> si:nat -> + alice:principal -> bob:principal -> x:bytes -> si:state_id -> Lemma (requires event_triggered tr alice (Initiate1 alice bob x) /\ @@ -120,7 +128,7 @@ let decode_message1_proof tr alice bob msg_bytes = | None -> () val compute_message2_proof: - tr:trace -> si:nat -> + tr:trace -> si:state_id -> alice:principal -> bob:principal -> msg1:message1 -> gy:bytes -> y:bytes -> @@ -254,7 +262,7 @@ let decode_message2_proof tr alice bob msg_bytes gx pk_b = | None -> () val compute_message3_proof: - tr:trace -> si:nat -> + tr:trace -> alice:principal -> bob:principal -> gx:bytes -> gy:bytes -> sk_a:bytes -> n_sig:bytes -> @@ -269,7 +277,7 @@ val compute_message3_proof: (ensures is_publishable tr (compute_message3 alice bob gx gy sk_a n_sig) ) -let compute_message3_proof tr si alice bob gx gy sk_a n_sig = +let compute_message3_proof tr alice bob gx gy sk_a n_sig = let sig_msg = SigMsg3 {b=bob; gx; gy} in serialize_wf_lemma sig_message (is_publishable tr) sig_msg; From 50da6db502f094316f7b8025f69f9ffa6240590a Mon Sep 17 00:00:00 2001 From: Fabian Hauck Date: Wed, 19 Jun 2024 14:19:19 +0200 Subject: [PATCH 15/29] DH example: changed is_dh_shared_key definition to use `equivalent tr` --- .../DY.Example.DH.Protocol.Stateful.Proof.fst | 15 +++------ .../dh/DY.Example.DH.SecurityProperties.fst | 31 ++++++++++++++----- 2 files changed, 29 insertions(+), 17 deletions(-) diff --git a/examples/dh/DY.Example.DH.Protocol.Stateful.Proof.fst b/examples/dh/DY.Example.DH.Protocol.Stateful.Proof.fst index 87cff6c..92ad88e 100644 --- a/examples/dh/DY.Example.DH.Protocol.Stateful.Proof.fst +++ b/examples/dh/DY.Example.DH.Protocol.Stateful.Proof.fst @@ -15,8 +15,7 @@ open DY.Example.DH.Protocol.Stateful val is_dh_shared_key: trace -> principal -> principal -> bytes -> prop let is_dh_shared_key tr alice bob k = exists si sj. - (is_secret (join (principal_state_label alice si) (principal_state_label bob sj)) tr k \/ - is_secret (join (principal_state_label bob sj) (principal_state_label alice si)) tr k) /\ + get_label k `equivalent tr` join (principal_state_label alice si) (principal_state_label bob sj) /\ get_usage k == AeadKey "DH.aead_key" let dh_session_pred: local_state_predicate dh_session = { @@ -207,7 +206,6 @@ let send_msg2_proof tr global_sess_id bob sess_id = ) | _ -> () -#push-options "--z3rlimit 30" val prepare_msg3_proof: tr:trace -> global_sess_id:dh_global_sess_ids -> alice:principal -> bob:principal -> msg_id:nat -> sess_id:state_id -> @@ -242,7 +240,7 @@ let prepare_msg3_proof tr global_sess_id alice bob msg_id sess_id = with _. ( assert(exists y k'. k' == dh y gx /\ msg2.gy == dh_pk y /\ event_triggered tr bob (Respond1 alice bob gx msg2.gy y)); eliminate exists y k'. k' == dh y gx /\ event_triggered tr bob (Respond1 alice bob gx msg2.gy y) - returns _ + returns exists y. k == dh y gx /\ is_dh_shared_key tr alice bob k /\ event_triggered tr bob (Respond1 alice bob gx msg2.gy y) with _. ( assert(event_triggered tr bob (Respond1 alice bob gx msg2.gy y)); @@ -261,11 +259,11 @@ let prepare_msg3_proof tr global_sess_id alice bob msg_id sess_id = normalize_term_spec get_label; reveal_opaque (`%dh) (dh); reveal_opaque (`%dh_pk) (dh_pk); + assert(get_label (dh x msg2.gy) == join (get_label x) (get_dh_label msg2.gy) \/ get_label (dh x msg2.gy) == join (get_dh_label msg2.gy) (get_label x)); - assert(exists si sj. is_secret (join (principal_state_label alice si) (principal_state_label bob sj)) tr k \/ - is_secret (join (principal_state_label bob sj) (principal_state_label alice si)) tr k); + assert(exists si sj. get_label k `equivalent tr` join (principal_state_label alice si) (principal_state_label bob sj)); () ) ) @@ -277,7 +275,6 @@ let prepare_msg3_proof tr global_sess_id alice bob msg_id sess_id = | (None, tr) -> () ) | _ -> () -#pop-options val send_msg3_proof: tr:trace -> @@ -326,7 +323,6 @@ let event_respond1_injective tr alice bob gx gy y y' = assert(y == y'); () -#push-options "--z3rlimit 70" val verify_msg3_proof: tr:trace -> global_sess_id:dh_global_sess_ids -> alice:principal -> bob:principal -> msg_id:nat -> sess_id:state_id -> @@ -392,8 +388,7 @@ let verify_msg3_proof tr global_sess_id alice bob msg_id sess_id = ); assert(is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ - (exists si sj. is_secret (join (principal_state_label alice si) (principal_state_label bob sj)) tr k \/ - is_secret (join (principal_state_label bob sj) (principal_state_label alice si)) tr k)); + (exists si sj. get_label k `equivalent tr` join (principal_state_label alice si) (principal_state_label bob sj))); assert(get_usage k == AeadKey "DH.aead_key"); assert(is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ (is_dh_shared_key tr alice bob k /\ event_triggered tr alice (Initiate2 alice bob gx gy k))); diff --git a/examples/dh/DY.Example.DH.SecurityProperties.fst b/examples/dh/DY.Example.DH.SecurityProperties.fst index 4e5e10b..cac7850 100644 --- a/examples/dh/DY.Example.DH.SecurityProperties.fst +++ b/examples/dh/DY.Example.DH.SecurityProperties.fst @@ -53,13 +53,20 @@ val initiator_forward_secrecy_lemma: ) (ensures is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ - (exists si sj. (is_secret (join (principal_state_label alice si) (principal_state_label bob sj)) tr k \/ - is_secret (join (principal_state_label bob sj) (principal_state_label alice si)) tr k) /\ + (exists si sj. get_label k `equivalent tr` join (principal_state_label alice si) (principal_state_label bob sj) /\ (is_corrupt tr (principal_state_label alice si) \/ is_corrupt tr (principal_state_label bob sj)) ) ) -let initiator_forward_secrecy_lemma tr i alice bob gx gy k = - attacker_only_knows_publishable_values tr k +let initiator_forward_secrecy_lemma tr i alice bob gx gy k = + attacker_only_knows_publishable_values tr k; + + (* Debugging code + assert(is_dh_shared_key tr alice bob k \/ is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob)); *) + + normalize_term_spec is_corrupt; + reveal_opaque (`%can_flow) (can_flow); + reveal_opaque (`%join) (join); + () val responder_forward_secrecy_lemma: tr:trace -> i:nat -> alice:principal -> bob:principal -> gx:bytes -> gy:bytes -> k:bytes -> @@ -71,10 +78,20 @@ val responder_forward_secrecy_lemma: ) (ensures is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ - (exists si sj. (is_secret (join (principal_state_label alice si) (principal_state_label bob sj)) tr k \/ - is_secret (join (principal_state_label bob sj) (principal_state_label alice si)) tr k) /\ + (exists si sj. get_label k `equivalent tr` join (principal_state_label alice si) (principal_state_label bob sj) /\ (is_corrupt tr (principal_state_label alice si) \/ is_corrupt tr (principal_state_label bob sj)) ) ) let responder_forward_secrecy_lemma tr i alice bob gx gy k = - attacker_only_knows_publishable_values tr k + attacker_only_knows_publishable_values tr k; + + (* Debugging code + assert(is_dh_shared_key tr alice bob k \/ + is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob)); + assert(event_triggered tr alice (Initiate2 alice bob gx gy k) \/ + is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob)); *) + + normalize_term_spec is_corrupt; + reveal_opaque (`%can_flow) (can_flow); + reveal_opaque (`%join) (join); + () From afa6fe25b472b5e33fec019ce212b9d392cc6a4d Mon Sep 17 00:00:00 2001 From: Fabian Hauck Date: Wed, 19 Jun 2024 16:02:23 +0200 Subject: [PATCH 16/29] DH example renamed folder to iso_dh and used 'equivalent tr' function in key_secrecy_lemma --- .fst.config.json | 2 +- Makefile | 2 +- examples/{dh => iso_dh}/DY.Example.DH.Debug.fst | 7 ------- .../DY.Example.DH.Protocol.Stateful.Proof.fst | 4 +--- .../{dh => iso_dh}/DY.Example.DH.Protocol.Stateful.fst | 0 .../DY.Example.DH.Protocol.Total.Proof.fst | 0 .../{dh => iso_dh}/DY.Example.DH.Protocol.Total.fst | 0 .../DY.Example.DH.SecurityProperties.fst | 10 ++++++++-- examples/{dh => iso_dh}/Makefile | 0 9 files changed, 11 insertions(+), 14 deletions(-) rename examples/{dh => iso_dh}/DY.Example.DH.Debug.fst (92%) rename examples/{dh => iso_dh}/DY.Example.DH.Protocol.Stateful.Proof.fst (99%) rename examples/{dh => iso_dh}/DY.Example.DH.Protocol.Stateful.fst (100%) rename examples/{dh => iso_dh}/DY.Example.DH.Protocol.Total.Proof.fst (100%) rename examples/{dh => iso_dh}/DY.Example.DH.Protocol.Total.fst (100%) rename examples/{dh => iso_dh}/DY.Example.DH.SecurityProperties.fst (92%) rename examples/{dh => iso_dh}/Makefile (100%) diff --git a/.fst.config.json b/.fst.config.json index 7262c8c..075a446 100644 --- a/.fst.config.json +++ b/.fst.config.json @@ -1,5 +1,5 @@ { "fstar_exe":"fstar.exe", "options":["--cache_dir", "cache", "--hint_dir", "hints", "--use_hints", "--record_hints"], "include_dirs":[ - "../comparse/src", "src/core", "src/lib", "src/lib/comparse", "src/lib/event", "src/lib/state", "src/lib/utils", "examples/nsl_pk", "examples/dh"] + "../comparse/src", "src/core", "src/lib", "src/lib/comparse", "src/lib/event", "src/lib/state", "src/lib/utils", "examples/nsl_pk", "examples/iso_dh"] } \ No newline at end of file diff --git a/Makefile b/Makefile index 29c20b6..f95d0dd 100644 --- a/Makefile +++ b/Makefile @@ -5,7 +5,7 @@ COMPARSE_HOME ?= $(DY_HOME)/../comparse INNER_SOURCE_DIRS = core lib lib/comparse lib/event lib/state lib/utils SOURCE_DIRS = $(addprefix $(DY_HOME)/src/, $(INNER_SOURCE_DIRS)) -INNER_EXAMPLE_DIRS = nsl_pk dh +INNER_EXAMPLE_DIRS = nsl_pk iso_dh EXAMPLE_DIRS = $(addprefix $(DY_HOME)/examples/, $(INNER_EXAMPLE_DIRS)) INCLUDE_DIRS = $(SOURCE_DIRS) $(EXAMPLE_DIRS) $(COMPARSE_HOME)/src diff --git a/examples/dh/DY.Example.DH.Debug.fst b/examples/iso_dh/DY.Example.DH.Debug.fst similarity index 92% rename from examples/dh/DY.Example.DH.Debug.fst rename to examples/iso_dh/DY.Example.DH.Debug.fst index d6d9454..439af52 100644 --- a/examples/dh/DY.Example.DH.Debug.fst +++ b/examples/iso_dh/DY.Example.DH.Debug.fst @@ -1,12 +1,5 @@ module DY.Example.DH.Debug -(* - Extract code by running: - 1. make extract_lib - 2. In the obj/ directory: OCAMLPATH=$FSTAR_HOME/lib ocamlbuild -use-ocamlfind -pkg batteries -pkg fstar.lib DY_Example_DH_Debug.native - 3. ./DY_Example_DH_Debug.native -*) - open DY.Core open DY.Lib open DY.Example.DH.Protocol.Stateful diff --git a/examples/dh/DY.Example.DH.Protocol.Stateful.Proof.fst b/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst similarity index 99% rename from examples/dh/DY.Example.DH.Protocol.Stateful.Proof.fst rename to examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst index 92ad88e..06cfd95 100644 --- a/examples/dh/DY.Example.DH.Protocol.Stateful.Proof.fst +++ b/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst @@ -82,8 +82,6 @@ let dh_event_pred: event_predicate dh_event = event_triggered tr alice (Initiate2 alice bob gx gy k)) ) -(* Couldn't we hide all of the following code in a function returning a record? *) - /// List of all local state predicates. let all_sessions = [ @@ -386,7 +384,7 @@ let verify_msg3_proof tr global_sess_id alice bob msg_id sess_id = ) ) ); - + assert(is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ (exists si sj. get_label k `equivalent tr` join (principal_state_label alice si) (principal_state_label bob sj))); assert(get_usage k == AeadKey "DH.aead_key"); diff --git a/examples/dh/DY.Example.DH.Protocol.Stateful.fst b/examples/iso_dh/DY.Example.DH.Protocol.Stateful.fst similarity index 100% rename from examples/dh/DY.Example.DH.Protocol.Stateful.fst rename to examples/iso_dh/DY.Example.DH.Protocol.Stateful.fst diff --git a/examples/dh/DY.Example.DH.Protocol.Total.Proof.fst b/examples/iso_dh/DY.Example.DH.Protocol.Total.Proof.fst similarity index 100% rename from examples/dh/DY.Example.DH.Protocol.Total.Proof.fst rename to examples/iso_dh/DY.Example.DH.Protocol.Total.Proof.fst diff --git a/examples/dh/DY.Example.DH.Protocol.Total.fst b/examples/iso_dh/DY.Example.DH.Protocol.Total.fst similarity index 100% rename from examples/dh/DY.Example.DH.Protocol.Total.fst rename to examples/iso_dh/DY.Example.DH.Protocol.Total.fst diff --git a/examples/dh/DY.Example.DH.SecurityProperties.fst b/examples/iso_dh/DY.Example.DH.SecurityProperties.fst similarity index 92% rename from examples/dh/DY.Example.DH.SecurityProperties.fst rename to examples/iso_dh/DY.Example.DH.SecurityProperties.fst index cac7850..2e37745 100644 --- a/examples/dh/DY.Example.DH.SecurityProperties.fst +++ b/examples/iso_dh/DY.Example.DH.SecurityProperties.fst @@ -38,10 +38,16 @@ val key_secrecy_lemma: tr:trace -> k:bytes -> alice:principal -> bob:principal - attacker_knows tr k ) (ensures - forall si sj. is_secret (join (principal_state_label alice si) (principal_state_label bob sj)) tr k ==> + forall si sj. get_label k `equivalent tr` join (principal_state_label alice si) (principal_state_label bob sj) ==> (is_corrupt tr (principal_state_label alice si) \/ is_corrupt tr (principal_state_label bob sj)) ) -let key_secrecy_lemma tr k alice bob = attacker_only_knows_publishable_values tr k +let key_secrecy_lemma tr k alice bob = + attacker_only_knows_publishable_values tr k; + + normalize_term_spec is_corrupt; + reveal_opaque (`%can_flow) (can_flow); + reveal_opaque (`%join) (join); + () val initiator_forward_secrecy_lemma: tr:trace -> i:nat -> alice:principal -> bob:principal -> gx:bytes -> gy:bytes -> k:bytes -> diff --git a/examples/dh/Makefile b/examples/iso_dh/Makefile similarity index 100% rename from examples/dh/Makefile rename to examples/iso_dh/Makefile From e621fde699a32e862c30456f03cd74d9857fd7f9 Mon Sep 17 00:00:00 2001 From: Fabian Hauck Date: Wed, 19 Jun 2024 17:01:17 +0200 Subject: [PATCH 17/29] DH example added ISO reference --- examples/iso_dh/DY.Example.DH.Protocol.Total.fst | 3 +++ 1 file changed, 3 insertions(+) diff --git a/examples/iso_dh/DY.Example.DH.Protocol.Total.fst b/examples/iso_dh/DY.Example.DH.Protocol.Total.fst index 633bd4f..0953140 100644 --- a/examples/iso_dh/DY.Example.DH.Protocol.Total.fst +++ b/examples/iso_dh/DY.Example.DH.Protocol.Total.fst @@ -7,6 +7,9 @@ open DY.Lib (* *** ISO-DH Protocol *** + ISO/IEC 9798-3:2019(E): IT Security techniques — Entity authentication — Part + 3: Mechanisms using digital signature techniques. Tech. rep. (Jan 2019) + A -> B: {A, gx} msg1 B -> A: {B, gy, sign({A; gx; gy}, privB)} msg2 A -> B: {sign({B; gx; gy}, privA)} msg3 From 952037ee9ca82ef5f24ec20ec36e49f3360418b2 Mon Sep 17 00:00:00 2001 From: Fabian Hauck Date: Thu, 20 Jun 2024 11:59:37 +0200 Subject: [PATCH 18/29] DH example: changed names of security properties and added README.md --- .../iso_dh/DY.Example.DH.Protocol.Total.fst | 1 + .../DY.Example.DH.SecurityProperties.fst | 31 +++++++----- examples/iso_dh/README.md | 48 +++++++++++++++++++ 3 files changed, 68 insertions(+), 12 deletions(-) create mode 100644 examples/iso_dh/README.md diff --git a/examples/iso_dh/DY.Example.DH.Protocol.Total.fst b/examples/iso_dh/DY.Example.DH.Protocol.Total.fst index 0953140..df251d3 100644 --- a/examples/iso_dh/DY.Example.DH.Protocol.Total.fst +++ b/examples/iso_dh/DY.Example.DH.Protocol.Total.fst @@ -7,6 +7,7 @@ open DY.Lib (* *** ISO-DH Protocol *** + Diffie-Hellman key exchange protocol with digital signatures based on ISO/IEC 9798-3:2019(E): IT Security techniques — Entity authentication — Part 3: Mechanisms using digital signature techniques. Tech. rep. (Jan 2019) diff --git a/examples/iso_dh/DY.Example.DH.SecurityProperties.fst b/examples/iso_dh/DY.Example.DH.SecurityProperties.fst index 2e37745..11456af 100644 --- a/examples/iso_dh/DY.Example.DH.SecurityProperties.fst +++ b/examples/iso_dh/DY.Example.DH.SecurityProperties.fst @@ -13,25 +13,30 @@ open DY.Example.DH.Protocol.Stateful.Proof TODO: In the intrinsic version we use method like corrupt_at and did_event_occur_before. Do we need these method here too? *) -val initiator_correspondence_lemma: tr:trace -> i:nat -> alice:principal -> bob:principal -> gx:bytes -> gy:bytes -> k:bytes -> + +(*** Authentication Properties ***) + +val initiator_authentication: tr:trace -> i:nat -> alice:principal -> bob:principal -> gx:bytes -> gy:bytes -> k:bytes -> Lemma (requires event_triggered_at tr i alice (Initiate2 alice bob gx gy k) /\ trace_invariant tr) (ensures is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ - (exists y. event_triggered tr bob (Respond1 alice bob gx gy y) /\ + (exists y. event_triggered (prefix tr i) bob (Respond1 alice bob gx gy y) /\ k == dh y gx) ) -let initiator_correspondence_lemma tr i alice bob gx gy k = () +let initiator_authentication tr i alice bob gx gy k = () -val responder_correspondence_lemma: tr:trace -> i:nat -> alice:principal -> bob:principal -> gx:bytes -> gy:bytes -> k:bytes -> +val responder_authentication: tr:trace -> i:nat -> alice:principal -> bob:principal -> gx:bytes -> gy:bytes -> k:bytes -> Lemma (requires event_triggered_at tr i bob (Respond2 alice bob gx gy k) /\ trace_invariant tr) (ensures is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ - event_triggered tr alice (Initiate2 alice bob gx gy k)) -let responder_correspondence_lemma tr i alice bob gx gy k = () + event_triggered (prefix tr i) alice (Initiate2 alice bob gx gy k)) +let responder_authentication tr i alice bob gx gy k = () -val key_secrecy_lemma: tr:trace -> k:bytes -> alice:principal -> bob:principal -> +(*** Key Secrecy Property ***) + +val key_secrecy: tr:trace -> k:bytes -> alice:principal -> bob:principal -> Lemma (requires trace_invariant tr /\ @@ -41,7 +46,7 @@ val key_secrecy_lemma: tr:trace -> k:bytes -> alice:principal -> bob:principal - forall si sj. get_label k `equivalent tr` join (principal_state_label alice si) (principal_state_label bob sj) ==> (is_corrupt tr (principal_state_label alice si) \/ is_corrupt tr (principal_state_label bob sj)) ) -let key_secrecy_lemma tr k alice bob = +let key_secrecy tr k alice bob = attacker_only_knows_publishable_values tr k; normalize_term_spec is_corrupt; @@ -49,7 +54,9 @@ let key_secrecy_lemma tr k alice bob = reveal_opaque (`%join) (join); () -val initiator_forward_secrecy_lemma: +(*** Forward Secrecy Properties ***) + +val initiator_forward_secrecy: tr:trace -> i:nat -> alice:principal -> bob:principal -> gx:bytes -> gy:bytes -> k:bytes -> Lemma (requires @@ -63,7 +70,7 @@ val initiator_forward_secrecy_lemma: (is_corrupt tr (principal_state_label alice si) \/ is_corrupt tr (principal_state_label bob sj)) ) ) -let initiator_forward_secrecy_lemma tr i alice bob gx gy k = +let initiator_forward_secrecy tr i alice bob gx gy k = attacker_only_knows_publishable_values tr k; (* Debugging code @@ -74,7 +81,7 @@ let initiator_forward_secrecy_lemma tr i alice bob gx gy k = reveal_opaque (`%join) (join); () -val responder_forward_secrecy_lemma: +val responder_forward_secrecy: tr:trace -> i:nat -> alice:principal -> bob:principal -> gx:bytes -> gy:bytes -> k:bytes -> Lemma (requires @@ -88,7 +95,7 @@ val responder_forward_secrecy_lemma: (is_corrupt tr (principal_state_label alice si) \/ is_corrupt tr (principal_state_label bob sj)) ) ) -let responder_forward_secrecy_lemma tr i alice bob gx gy k = +let responder_forward_secrecy tr i alice bob gx gy k = attacker_only_knows_publishable_values tr k; (* Debugging code diff --git a/examples/iso_dh/README.md b/examples/iso_dh/README.md new file mode 100644 index 0000000..060fbdc --- /dev/null +++ b/examples/iso_dh/README.md @@ -0,0 +1,48 @@ +# Formal Security Analysis of the ISO-DH Protocol + +This folder contains a formal security analysis +of the Diffie-Hellman key exchange protocol with +digital signatures based on the [ISO/IEC 9798-3:2019(E)](https://www.iso.org/standard/67115.html) +standard. In this analysis, we prove the following +properties of the ISO-DH protocol: + +1. Mutual authentication +2. Secrecy of the key ``k`` +3. Forward secrecy of the key ``k`` + (as long as the private DH keys are secret, + the key ``k`` does not leak) + +**Protocol Flow** + +``` +A -> B: {A, gx} msg1 +B -> A: {B, gy, sign({A; gx; gy}, privB)} msg2 +A -> B: {sign({B; gx; gy}, privA)} msg3 +``` + +The model of the protocol is split into two +parts. The first part is in the ``DY.Example.DH.Protocol.Total`` +module which contains all the code that does +not depend on the trace, e.g., message definitions, +cryptographic functions, and message encoding. +The second part is in the ``DY.Example.DH.Protocol.Stateful`` +module, containing the logic that depends on the +trace, e.g., state definitions, state encoding, and sending messages. + +Since the model is split into two parts, the proof is also +split into the two modules ``DY.Example.DH.Protocol.Total.Proof`` +and ``DY.Example.DH.Protocol.Stateful.Proof``. The first +module contains helper lemmas about the total functions +used in the stateful proof to prove that every +stateful function fulfills the trace invariants. + +The two modules that are left are the ``DY.Example.DH.SecurityProperties`` +module and the ``DY.Example.DH.Debug`` module. The former +defines and proves the security properties, and the latter generates +an example trace of an honest protocol run. + +## Check and Run the Model +To verify the F* code you can call ``make`` from either this +directory or the repository's root directory. +To run the ``DY.Example.DH.Debug`` module you have to +execute ``make test`` from this directory. From 418160428b1b62a9680dba5938919f5da4685fa0 Mon Sep 17 00:00:00 2001 From: Fabian Hauck Date: Fri, 21 Jun 2024 12:56:16 +0200 Subject: [PATCH 19/29] DH example sanity check for trace invariants and proof refactoring --- .../DY.Example.DH.Debug.TraceInvariants.fst | 110 ++++++++++++++++++ .../DY.Example.DH.Protocol.Stateful.Proof.fst | 37 +++--- .../DY.Example.DH.SecurityProperties.fst | 4 - examples/iso_dh/Makefile | 4 + 4 files changed, 131 insertions(+), 24 deletions(-) create mode 100644 examples/iso_dh/DY.Example.DH.Debug.TraceInvariants.fst diff --git a/examples/iso_dh/DY.Example.DH.Debug.TraceInvariants.fst b/examples/iso_dh/DY.Example.DH.Debug.TraceInvariants.fst new file mode 100644 index 0000000..ad88a8b --- /dev/null +++ b/examples/iso_dh/DY.Example.DH.Debug.TraceInvariants.fst @@ -0,0 +1,110 @@ +module DY.Example.DH.Debug.TraceInvariants + +open DY.Core +open DY.Lib +open DY.Example.DH.Protocol.Stateful +open DY.Example.DH.Protocol.Stateful.Proof + +/// This module provides a sanity check for the trace invariants. +/// It does this by showing that at least one trace satisfies the invariants. + +#set-options "--fuel 0 --ifuel 0 --z3rlimit 10" +let debug (tr:trace) : string = + assume(trace_invariant tr); + + let _ = IO.debug_print_string "************* Trace *************\n" in + (*** Initialize protocol run ***) + let alice = "alice" in + let bob = "bob" in + + // Generate private key for Alice + let (alice_global_session_priv_key_id, tr) = initialize_private_keys alice tr in + let (_, tr) = generate_private_key alice alice_global_session_priv_key_id (Sign "DH.SigningKey") tr in + + // Generate private key for Bob + let (bob_global_session_priv_key_id, tr) = initialize_private_keys bob tr in + let (_, tr) = generate_private_key bob bob_global_session_priv_key_id (Sign "DH.SigningKey") tr in + + // Store Bob's public key in Alice's state + // 1. Retrieve Bob's private key from his session + // 2. Compute the public key from the private key + // 3. Initialize Alice's session to store public keys + // 4. Install Bob's public key in Alice's public key store + let (priv_key_bob, tr) = get_private_key bob bob_global_session_priv_key_id (Sign "DH.SigningKey") tr in + match priv_key_bob with + | None -> "Failed to execute protocol run\n" + | Some priv_key_bob -> ( + let pub_key_bob = vk priv_key_bob in + let (alice_global_session_pub_key_id, tr) = initialize_pki alice tr in + let (_, tr) = install_public_key alice alice_global_session_pub_key_id (Verify "DH.SigningKey") bob pub_key_bob tr in + + // Store Alice's public key in Bob's state + let (priv_key_alice, tr) = get_private_key alice alice_global_session_priv_key_id (Sign "DH.SigningKey") tr in + match priv_key_alice with + | None -> "Failed to execute protocol run\n" + | Some priv_key_alice -> ( + let pub_key_alice = vk priv_key_alice in + let (bob_global_session_pub_key_id, tr) = initialize_pki bob tr in + let (_, tr) = install_public_key bob bob_global_session_pub_key_id (Verify "DH.SigningKey") alice pub_key_alice tr in + + let alice_global_session_ids: dh_global_sess_ids = {pki=alice_global_session_pub_key_id; private_keys=alice_global_session_priv_key_id} in + let bob_global_session_ids: dh_global_sess_ids = {pki=bob_global_session_pub_key_id; private_keys=bob_global_session_priv_key_id} in + + (*** Run the protocol ***) + // Alice + prepare_msg1_proof tr alice bob; + let (alice_session_id, tr) = prepare_msg1 alice bob tr in + assert(trace_invariant tr); + + send_msg1_proof tr alice bob alice_session_id; + let (msg1_id, tr) = send_msg1 alice alice_session_id tr in + assert(trace_invariant tr); + + match msg1_id with + | None -> "Failed to execute protocol run\n" + | Some msg1_id -> ( + // Bob + prepare_msg2_proof tr alice bob msg1_id; + let (bob_session_id, tr) = prepare_msg2 alice bob msg1_id tr in + assert(trace_invariant tr); + + match bob_session_id with + | None -> "Failed to execute protocol run\n" + | Some bob_session_id -> ( + send_msg2_proof tr bob_global_session_ids bob bob_session_id; + let (msg2_id, tr) = send_msg2 bob_global_session_ids bob bob_session_id tr in + assert(trace_invariant tr); + + match msg2_id with + | None -> "Failed to execute protocol run\n" + | Some msg2_id -> ( + // Alice + prepare_msg3_proof tr alice_global_session_ids alice bob msg2_id alice_session_id; + let (_, tr) = prepare_msg3 alice_global_session_ids alice bob msg2_id alice_session_id tr in + assert(trace_invariant tr); + + send_msg3_proof tr alice_global_session_ids alice bob alice_session_id; + let (msg3_id, tr) = send_msg3 alice_global_session_ids alice bob alice_session_id tr in + assert(trace_invariant tr); + + match msg3_id with + | None -> "Failed to execute protocol run\n" + | Some msg3_id -> ( + // Bob + verify_msg3_proof tr bob_global_session_ids alice bob msg3_id bob_session_id; + let (_, tr) = verify_msg3 bob_global_session_ids alice bob msg3_id bob_session_id tr in + assert(trace_invariant tr); + + trace_to_string default_trace_to_string_printers tr + ) + ) + ) + ) + ) + ) + +//Run ``debug ()`` when the module loads +#push-options "--warn_error -272" +let tr_string = debug Nil +let _ = IO.debug_print_string (tr_string) +#pop-options \ No newline at end of file diff --git a/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst b/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst index 06cfd95..1f33021 100644 --- a/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst +++ b/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst @@ -15,6 +15,10 @@ open DY.Example.DH.Protocol.Stateful val is_dh_shared_key: trace -> principal -> principal -> bytes -> prop let is_dh_shared_key tr alice bob k = exists si sj. + // We are using the equivalent relation here because depending on the party we are looking at + // the label is either ``join (principal_state_label alice si) (principal_state_label bob sj)`` or + // ``join (principal_state_label bob sj) (principal_state_label alice si)``. + // This is because k is either build from ``dh x (dh_pk y)`` or ``dh y (dh_pk x)``. get_label k `equivalent tr` join (principal_state_label alice si) (principal_state_label bob sj) /\ get_usage k == AeadKey "DH.aead_key" @@ -234,11 +238,13 @@ let prepare_msg3_proof tr global_sess_id alice bob msg_id sess_id = assert(get_usage k = AeadKey "DH.aead_key"); assert(exists si. is_knowable_by (principal_state_label alice si) tr k); - introduce (~(is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob))) ==> (exists y. k == dh y gx /\ is_dh_shared_key tr alice bob k /\ event_triggered tr bob (Respond1 alice bob gx msg2.gy y)) + let alice_and_bob_not_corrupt = (~(is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob))) in + let dh_key_and_event_respond1 = (exists y. k == dh y gx /\ is_dh_shared_key tr alice bob k /\ event_triggered tr bob (Respond1 alice bob gx msg2.gy y)) in + introduce alice_and_bob_not_corrupt ==> dh_key_and_event_respond1 with _. ( assert(exists y k'. k' == dh y gx /\ msg2.gy == dh_pk y /\ event_triggered tr bob (Respond1 alice bob gx msg2.gy y)); eliminate exists y k'. k' == dh y gx /\ event_triggered tr bob (Respond1 alice bob gx msg2.gy y) - returns exists y. k == dh y gx /\ is_dh_shared_key tr alice bob k /\ event_triggered tr bob (Respond1 alice bob gx msg2.gy y) + returns dh_key_and_event_respond1 with _. ( assert(event_triggered tr bob (Respond1 alice bob gx msg2.gy y)); @@ -247,21 +253,10 @@ let prepare_msg3_proof tr global_sess_id alice bob msg_id sess_id = dh_shared_secret_lemma x y; assert(dh y gx == dh x msg2.gy); assert(k == k'); - - assert(exists si. is_secret (principal_state_label alice si) tr x); - assert(exists sj. is_secret (principal_state_label bob sj) tr y); - assert(exists si. get_label x == principal_state_label alice si); - assert(exists sj. get_label y == principal_state_label bob sj); - assert(exists si sj. join (get_label x) (get_label y) == join (principal_state_label alice si) (principal_state_label bob sj)); - - normalize_term_spec get_label; - reveal_opaque (`%dh) (dh); - reveal_opaque (`%dh_pk) (dh_pk); - - assert(get_label (dh x msg2.gy) == join (get_label x) (get_dh_label msg2.gy) \/ - get_label (dh x msg2.gy) == join (get_dh_label msg2.gy) (get_label x)); assert(exists si sj. get_label k `equivalent tr` join (principal_state_label alice si) (principal_state_label bob sj)); + + assert(dh_key_and_event_respond1); () ) ) @@ -352,14 +347,17 @@ let verify_msg3_proof tr global_sess_id alice bob msg_id sess_id = assert(exists k'. event_triggered tr alice (Initiate2 alice bob gx gy k') \/ is_corrupt tr (principal_label alice)); // Proof strategy: We want to work without the corruption case - // so we introduce this implication. - introduce (~((principal_label alice) `can_flow tr` public \/ (principal_label bob) `can_flow tr` public)) ==> event_triggered tr alice (Initiate2 alice bob gx gy k) with _. ( + // so we introduce this implication. + let alice_and_bob_not_corrupt = (~(is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob))) in + let event_initiate2 = event_triggered tr alice (Initiate2 alice bob gx gy k) in + introduce alice_and_bob_not_corrupt ==> event_initiate2 + with _. ( // We can now assert that there exists a k' such that the event Initiate2 has been triggered // without the corruption case. assert(exists k'. event_triggered tr alice (Initiate2 alice bob gx gy k')); // We now introduce k' to concretely reason about it. eliminate exists k'. event_triggered tr alice (Initiate2 alice bob gx gy k') - returns event_triggered tr alice (Initiate2 alice bob gx gy k) + returns event_initiate2 with _. ( // From the Initiate2 event we know that there exists a Respond1 event with // gx, gy and some y'. To show that k equals k' it is enough to show that @@ -378,8 +376,7 @@ let verify_msg3_proof tr global_sess_id alice bob msg_id sess_id = assert(k == k'); // This gives us that the event Initiate2 has been triggered // for our concrete k. - assert(event_triggered tr alice (Initiate2 alice bob gx gy k)); - assert(event_triggered tr alice (Initiate2 alice bob gx gy k')); + assert(event_initiate2); () ) ) diff --git a/examples/iso_dh/DY.Example.DH.SecurityProperties.fst b/examples/iso_dh/DY.Example.DH.SecurityProperties.fst index 11456af..7c23f97 100644 --- a/examples/iso_dh/DY.Example.DH.SecurityProperties.fst +++ b/examples/iso_dh/DY.Example.DH.SecurityProperties.fst @@ -9,10 +9,6 @@ open DY.Example.DH.Protocol.Stateful.Proof #set-options "--fuel 8 --ifuel 8 --z3rlimit 25 --z3cliopt 'smt.qi.eager_threshold=100'" -(* - TODO: In the intrinsic version we use method like corrupt_at - and did_event_occur_before. Do we need these method here too? -*) (*** Authentication Properties ***) diff --git a/examples/iso_dh/Makefile b/examples/iso_dh/Makefile index 542d594..9fac801 100644 --- a/examples/iso_dh/Makefile +++ b/examples/iso_dh/Makefile @@ -4,3 +4,7 @@ include $(DY_HOME)/Makefile test: cd $(DY_HOME)/obj; OCAMLPATH=$(FSTAR_HOME)/lib ocamlbuild -use-ocamlfind -pkg batteries -pkg fstar.lib DY_Example_DH_Debug.native $(DY_HOME)/obj/DY_Example_DH_Debug.native + +test-traceinvariants: + cd $(DY_HOME)/obj; OCAMLPATH=$(FSTAR_HOME)/lib ocamlbuild -use-ocamlfind -pkg batteries -pkg fstar.lib DY_Example_DH_Debug_TraceInvariants.native + $(DY_HOME)/obj/DY_Example_DH_Debug_TraceInvariants.native From d1484ed7fd57f0130684a94cae77ed5974fce51d Mon Sep 17 00:00:00 2001 From: Fabian Hauck Date: Fri, 21 Jun 2024 17:14:38 +0200 Subject: [PATCH 20/29] =?UTF-8?q?DH=20example=20feedback=20Th=C3=A9ophile?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../DY.Example.DH.Protocol.Stateful.Proof.fst | 19 +- .../DY.Example.DH.Protocol.Total.Proof.fst | 168 ++++++------------ .../iso_dh/DY.Example.DH.Protocol.Total.fst | 12 +- .../DY.Example.DH.SecurityProperties.fst | 41 +++-- examples/iso_dh/README.md | 3 +- 5 files changed, 105 insertions(+), 138 deletions(-) diff --git a/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst b/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst index 1f33021..13f899a 100644 --- a/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst +++ b/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst @@ -53,8 +53,8 @@ let dh_session_pred: local_state_predicate dh_session = { is_knowable_by (principal_state_label bob sess_id) tr k /\ event_triggered tr bob (Respond2 alice bob gx gy k) /\ (is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ - (is_dh_shared_key tr alice bob k /\ - event_triggered tr alice (Initiate2 alice bob gx gy k))) + (is_dh_shared_key tr alice bob k /\ + event_triggered tr alice (Initiate2 alice bob gx gy k))) ) ); pred_later = (fun tr1 tr2 prin sess_id st -> ()); @@ -78,12 +78,12 @@ let dh_event_pred: event_predicate dh_event = (exists x sess_id. is_secret (principal_state_label alice sess_id) tr x /\ gx = dh_pk x) /\ (is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ - (exists y. k == dh y gx /\ is_dh_shared_key tr alice bob k /\ event_triggered tr bob (Respond1 alice bob gx gy y))) + (exists y. k == dh y gx /\ is_dh_shared_key tr alice bob k /\ event_triggered tr bob (Respond1 alice bob gx gy y))) ) | Respond2 alice bob gx gy k -> ( is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ (is_dh_shared_key tr alice bob k /\ - event_triggered tr alice (Initiate2 alice bob gx gy k)) + event_triggered tr alice (Initiate2 alice bob gx gy k)) ) /// List of all local state predicates. @@ -202,7 +202,7 @@ let send_msg2_proof tr global_sess_id bob sess_id = match get_private_key bob global_sess_id.private_keys (Sign "DH.SigningKey") tr with | (Some sk_b, tr) -> ( let (n_sig, tr) = mk_rand SigNonce (principal_label bob) 32 tr in - compute_message2_proof tr sess_id alice bob {alice; gx} gy y sk_b n_sig + compute_message2_proof tr sess_id alice bob {alice; gx} y sk_b n_sig ) | (None, tr) -> () ) @@ -219,7 +219,7 @@ val prepare_msg3_proof: )) let prepare_msg3_proof tr global_sess_id alice bob msg_id sess_id = match get_state alice sess_id tr with - | (Some (InitiatorSentMsg1 bob x), tr) -> ( + | (Some (InitiatorSentMsg1 bob x), tr) -> ( match recv_msg msg_id tr with | (Some msg_bytes, tr) -> ( match get_public_key alice global_sess_id.pki (Verify "DH.SigningKey") bob tr with @@ -285,9 +285,10 @@ let send_msg3_proof tr global_sess_id alice bob sess_id = | (Some sk_a, tr) -> ( let (n_sig, tr) = mk_rand SigNonce (principal_label alice) 32 tr in - (* Debugging code + // The following code is not needed for the proof. + // It just shows what we need to show to prove the lemma. assert(event_triggered tr alice (Initiate2 alice bob gx gy k)); - assert(exists x. gx == dh_pk x); *) + assert(exists x. gx == dh_pk x); compute_message3_proof tr alice bob gx gy sk_a n_sig; () @@ -316,6 +317,8 @@ let event_respond1_injective tr alice bob gx gy y y' = assert(y == y'); () + +#set-options "--z3rlimit 50" val verify_msg3_proof: tr:trace -> global_sess_id:dh_global_sess_ids -> alice:principal -> bob:principal -> msg_id:nat -> sess_id:state_id -> diff --git a/examples/iso_dh/DY.Example.DH.Protocol.Total.Proof.fst b/examples/iso_dh/DY.Example.DH.Protocol.Total.Proof.fst index bd1cede..01960a9 100644 --- a/examples/iso_dh/DY.Example.DH.Protocol.Total.Proof.fst +++ b/examples/iso_dh/DY.Example.DH.Protocol.Total.Proof.fst @@ -12,6 +12,8 @@ open DY.Example.DH.Protocol.Stateful val dh_crypto_usages: crypto_usages instance dh_crypto_usages = { + default_crypto_usages with + dh_known_peer_usage = (fun s1 s2 -> match s1, s2 with | "DH.dh_key", _ -> AeadKey "DH.aead_key" @@ -24,14 +26,6 @@ instance dh_crypto_usages = { | _ -> NoUsage); dh_known_peer_usage_commutes = (fun s1 s2 -> ()); dh_unknown_peer_usage_implies = (fun s1 s2 -> ()); - - kdf_extract_usage = (fun salt_usg ikm_usg salt ikm -> NoUsage); - kdf_extract_label = (fun salt_usg ikm_usg salt_label ikm_label salt ikm -> salt_label `meet` ikm_label); - kdf_extract_label_lemma = (fun tr salt_usg ikm_usg salt_label ikm_label salt ikm -> ()); - - kdf_expand_usage = (fun prk_usage info -> NoUsage); - kdf_expand_label = (fun prk_usage prk_label info -> prk_label); - kdf_expand_label_lemma = (fun tr prk_usage prk_label info -> ()); } #push-options "--ifuel 2 --fuel 0" @@ -44,10 +38,10 @@ let dh_crypto_preds = { (exists prin. get_signkey_label vk = principal_label prin /\ ( match parse sig_message sig_msg with | Some (SigMsg2 sig_msg2) -> ( - exists y. sig_msg2.gy == (dh_pk y) /\ event_triggered tr prin (Respond1 sig_msg2.a prin sig_msg2.gx sig_msg2.gy y) + exists y. sig_msg2.gy == (dh_pk y) /\ event_triggered tr prin (Respond1 sig_msg2.alice prin sig_msg2.gx sig_msg2.gy y) ) | Some (SigMsg3 sig_msg3) -> ( - exists x k. sig_msg3.gx == (dh_pk x) /\ event_triggered tr prin (Initiate2 prin sig_msg3.b sig_msg3.gx sig_msg3.gy k) + exists x k. sig_msg3.gx == (dh_pk x) /\ event_triggered tr prin (Initiate2 prin sig_msg3.bob sig_msg3.gx sig_msg3.gy k) ) | None -> False )) @@ -73,22 +67,19 @@ val compute_message1_proof: DhKey? (get_usage x) ) (ensures - is_publishable tr (compute_message1 alice x) /\ - (exists gx. gx == dh_pk x /\ is_publishable tr gx) + is_publishable tr (compute_message1 alice x) ) let compute_message1_proof tr alice bob x si = let gx = dh_pk x in assert(is_publishable tr gx); let msg = Msg1 {alice; gx} in - // This lemma makes sure that the second argument - // (is_publishable tr) is true for the third argument - // (msg) before and after serialization. Without - // this lemma we would loose all the guarantees about - // the bytes after the message was serialized. + // This lemma + // - requires that msg.gx is is publishable + // - ensures that `serialize _ msg` is publishable serialize_wf_lemma message (is_publishable tr) msg; - // The following code is not needed for the prove. + // The following code is not needed for the proof. // It just shows what we need to show to prove the lemma. let msgb = compute_message1 alice x in assert(bytes_invariant tr msgb); @@ -112,15 +103,14 @@ val decode_message1_proof: let decode_message1_proof tr alice bob msg_bytes = match decode_message1 msg_bytes with | Some msg1 -> ( - // The second argument of the lemma parse_wf_lemma is a predicate defined - // on bytes (is_publishable tr). - // The lemma has the precondition that the predicate is true if the - // third argument is applied to the predicate. - // It then makes sure that the predicate is also true after - // parsing the third argument from bytes into a data type (message). + // This lemma + // - requires that msg_bytes is publishable + // - ensures that `msg1.gx` is publishable + // (`msg1` being the result of parsing `msg_bytes` to the type `message1`) parse_wf_lemma message (is_publishable tr) msg_bytes; - // Only for debugging purposes + // The following code is not needed for the proof. + // It just shows what we need to show to prove the lemma. assert(bytes_invariant tr msg1.gx); assert(get_label msg1.gx `can_flow tr` public); () @@ -130,11 +120,11 @@ let decode_message1_proof tr alice bob msg_bytes = val compute_message2_proof: tr:trace -> si:state_id -> alice:principal -> bob:principal -> - msg1:message1 -> - gy:bytes -> y:bytes -> + msg1:message1 -> y:bytes -> sk_b:bytes -> n_sig:bytes -> Lemma - (requires + (requires ( + let gy = dh_pk y in event_triggered tr bob (Respond1 alice bob msg1.gx gy y) /\ is_publishable tr msg1.gx /\ is_publishable tr gy /\ gy == dh_pk y /\ @@ -142,49 +132,39 @@ val compute_message2_proof: is_signature_key "DH.SigningKey" (principal_label bob) tr sk_b /\ is_secret (principal_label bob) tr n_sig /\ SigNonce? (get_usage n_sig) + ) ) - (ensures + (ensures ( + let gy = dh_pk y in is_publishable tr (compute_message2 alice bob msg1.gx gy sk_b n_sig) + ) ) -let compute_message2_proof tr si alice bob msg1 gy y sk_b n_sig = - let sig_msg = SigMsg2 {a=alice; gx=msg1.gx; gy} in +let compute_message2_proof tr si alice bob msg1 y sk_b n_sig = + // Proof that the SigMsg2 is publishable + // From the precondition we know that + // msg1.gx and gy are publishable. + let gy = dh_pk y in + let sig_msg = SigMsg2 {alice; gx=msg1.gx; gy} in serialize_wf_lemma sig_message (is_publishable tr) sig_msg; let sig_msg_bytes = serialize sig_message sig_msg in - //assert(is_publishable tr sig_msg_bytes); + + // This assert is not needed for the proof + // but shows that the serialized SigMsg2 is publishable. + assert(is_publishable tr sig_msg_bytes); + let sg = sign sk_b n_sig sig_msg_bytes in - - (*assert(bytes_invariant tr sk_b); - assert(bytes_invariant tr n_sig); - assert(bytes_invariant tr sig_msg_bytes); - assert(get_usage sk_b == SigKey "DH.SigningKey"); - assert(is_secret (principal_label bob) tr sk_b); - assert(SigKey? (get_usage sk_b));*) - - // The reveal_opaques is needed to look into the definition - // of get_signkey_usage and see that it simply calls - // get_usage on the given key. - //reveal_opaque (`%get_signkey_usage) (get_signkey_usage); - - (*assert(SigKey? (get_signkey_usage (Vk sk_b))); - assert(get_signkey_usage (Vk sk_b) == SigKey "DH.SigningKey"); - assert((SigMsg2?.msg sig_msg).gy == (dh_pk y));*) - //reveal_opaque (`%get_signkey_label) (get_signkey_label); - (*assert(exists prin. get_signkey_label (Vk sk_b) = principal_label prin /\ - (SigMsg2?.msg sig_msg).gy == (dh_pk y) /\ - event_triggered tr prin (Respond1 (SigMsg2?.msg sig_msg).a prin (SigMsg2?.msg sig_msg).gx (SigMsg2?.msg sig_msg).gy y)); - assert(dh_crypto_invs.preds.sign_pred tr (Vk sk_b) sig_msg_bytes) by (let open FStar.Tactics in dump ""); - assert(SigNonce? (get_usage n_sig)); - assert((get_label sig_msg_bytes) `can_flow tr` (get_label n_sig)); + // This assert is not needed for the proof + // but shows that the signature is also publishable. + assert(is_publishable tr sg); - assert(bytes_invariant tr sg); - - assert(is_publishable tr sg);*) + // Since all parts of the Msg2 are publishable, we + // can show that the serialized Msg2 is also publishable. let msg = Msg2 {bob; gy; sg} in serialize_wf_lemma message (is_publishable tr) msg; - //let msg_bytes = compute_message2 alice bob msg1.gx gy sk_b n_sig in - //assert(bytes_invariant tr msg_bytes); + // This proves the post-condition + assert(is_publishable tr (compute_message2 alice bob msg1.gx gy sk_b n_sig)); () val decode_message2_proof: @@ -200,10 +180,9 @@ val decode_message2_proof: (ensures ( match decode_message2 msg_bytes alice gx pk_b with | Some msg2 -> ( - let sig_msg = SigMsg2 {a=alice; gx; gy=msg2.gy} in + let sig_msg = SigMsg2 {alice; gx; gy=msg2.gy} in is_publishable tr msg2.gy /\ is_publishable tr msg2.sg /\ - verify pk_b (serialize sig_message sig_msg) msg2.sg /\ (is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ (exists y. event_triggered tr bob (Respond1 alice bob gx msg2.gy y))) ) @@ -213,50 +192,17 @@ let decode_message2_proof tr alice bob msg_bytes gx pk_b = match decode_message2 msg_bytes alice gx pk_b with | Some msg2 -> ( parse_wf_lemma message (is_publishable tr) msg_bytes; - //FStar.Classical.move_requires (parse_wf_lemma message (bytes_invariant tr)) msg_bytes; + serialize_wf_lemma sig_message (bytes_invariant tr) (SigMsg2 {alice; gx; gy = msg2.gy}); - serialize_wf_lemma sig_message (bytes_invariant tr) (SigMsg2 {a=alice; gx; gy = msg2.gy}); - - //reveal_opaque (`%verify) (verify); - - // Revealing a recursive function does not work with - // ``reveal_opaque``. That's why we need to use - // ``normalize_term_spec bytes_invariant;`` or - // ``norm_spec [zeta; delta_only [`%bytes_invariant]](bytes_invariant);`` - //normalize_term_spec bytes_invariant; - - (*assert(bytes_invariant tr msg_bytes); - assert(bytes_invariant tr msg2.sg); - - let sig_msg = SigMsg2 {a=alice; gx; gy=msg2.gy} in - - let sig_msg_bytes = serialize sig_message sig_msg in - assert(verify pk_b sig_msg_bytes msg2.sg = true); - - let open DY.Core.Bytes.Type in - let Sign sk nonce msg = msg2.sg in - assert(msg = sig_msg_bytes); - + // The following code is not needed for the proof. + // It just shows what we need to show to prove the lemma. assert(is_publishable tr msg2.sg); - assert(get_label msg2.sg `can_flow tr` get_label msg); - assert(get_label msg2.sg `can_flow tr` public); - - - normalize_term_spec get_label; - - assert(bytes_invariant tr msg); - assert(is_publishable tr msg); - - FStar.Classical.move_requires (parse_wf_lemma sig_message (is_publishable tr)) msg; - FStar.Classical.move_requires (parse_wf_lemma sig_message (bytes_invariant tr)) msg; - - assert(bytes_invariant tr gx); - assert(bytes_invariant tr msg2.gy); + assert(is_publishable tr msg2.gy); assert(is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ (exists y. msg2.gy == dh_pk y /\ event_triggered tr bob (Respond1 alice bob gx msg2.gy y)) - );*) + ); () ) | None -> () @@ -278,23 +224,26 @@ val compute_message3_proof: is_publishable tr (compute_message3 alice bob gx gy sk_a n_sig) ) let compute_message3_proof tr alice bob gx gy sk_a n_sig = - let sig_msg = SigMsg3 {b=bob; gx; gy} in + let sig_msg = SigMsg3 {bob; gx; gy} in serialize_wf_lemma sig_message (is_publishable tr) sig_msg; - (* Debugging code - assert(is_publishable tr (serialize sig_message sig_msg));*) + // The following code is not needed for the proof. + // It just shows what we need to show to prove the lemma. + assert(is_publishable tr (serialize sig_message sig_msg)); let sg = sign sk_a n_sig (serialize sig_message sig_msg) in - (* Debugging code + // The following code is not needed for the proof. + // It just shows what we need to show to prove the lemma. assert(get_label sg `can_flow tr` public); assert(bytes_invariant tr sg); - assert(is_publishable tr sg); *) + assert(is_publishable tr sg); let msg = Msg3 {sg} in serialize_wf_lemma message (is_publishable tr) msg; - (* Debugging code - assert(is_publishable tr (serialize message msg));*) + // The following code is not needed for the proof. + // It just shows what we need to show to prove the lemma. + assert(is_publishable tr (serialize message msg)); () val decode_message3_proof: @@ -310,9 +259,8 @@ val decode_message3_proof: (ensures ( match decode_message3 msg_bytes bob gx gy pk_a with | Some msg3 -> ( - let sig_msg = SigMsg3 {b=bob; gx; gy} in + let sig_msg = SigMsg3 {bob; gx; gy} in is_publishable tr msg3.sg /\ - verify pk_a (serialize sig_message sig_msg) msg3.sg /\ (is_corrupt tr (principal_label alice) \/ (exists x k. gx == dh_pk x /\ event_triggered tr alice (Initiate2 alice bob gx gy k))) ) @@ -322,7 +270,7 @@ let decode_message3_proof tr alice bob gx gy msg_bytes pk_a = match decode_message3 msg_bytes bob gx gy pk_a with | Some msg3 -> ( parse_wf_lemma message (is_publishable tr) msg_bytes; - serialize_wf_lemma sig_message (is_publishable tr) (SigMsg3 {b=bob; gx; gy}); + serialize_wf_lemma sig_message (is_publishable tr) (SigMsg3 {bob; gx; gy}); () ) | None -> () \ No newline at end of file diff --git a/examples/iso_dh/DY.Example.DH.Protocol.Total.fst b/examples/iso_dh/DY.Example.DH.Protocol.Total.fst index df251d3..1ca6300 100644 --- a/examples/iso_dh/DY.Example.DH.Protocol.Total.fst +++ b/examples/iso_dh/DY.Example.DH.Protocol.Total.fst @@ -61,7 +61,7 @@ instance parseable_serializeable_message: parseable_serializeable bytes message // Definition of signature terms [@@ with_bytes bytes] type sig_message2 = { - a:principal; + alice:principal; gx:bytes; gy:bytes; } @@ -71,7 +71,7 @@ type sig_message2 = { [@@ with_bytes bytes] type sig_message3 = { - b:principal; + bob:principal; gx:bytes; gy:bytes; } @@ -116,7 +116,7 @@ let decode_message1 msg1_bytes = // Bob generates message 2 val compute_message2: principal -> principal -> bytes -> bytes -> bytes -> bytes -> bytes let compute_message2 alice bob gx gy sk_b n_sig = - let sig_msg = SigMsg2 {a=alice; gx; gy} in + let sig_msg = SigMsg2 {alice; gx; gy} in let sg = sign sk_b n_sig (serialize sig_message sig_msg) in let msg = Msg2 {bob; gy; sg} in serialize message msg @@ -131,14 +131,14 @@ let decode_message2 msg2_bytes alice gx pk_b = // with the gy value from the message and the gx // value from Alice's state. let gy = msg2.gy in - let sig_msg = SigMsg2 {a=alice; gx; gy} in + let sig_msg = SigMsg2 {alice; gx; gy} in if verify pk_b (serialize sig_message sig_msg) msg2.sg then Some msg2 else None // Alice generates message3 val compute_message3: principal -> principal -> bytes -> bytes -> bytes -> bytes -> bytes let compute_message3 alice bob gx gy sk_a n_sig = - let sig_msg = SigMsg3 {b=bob; gx; gy} in + let sig_msg = SigMsg3 {bob; gx; gy} in let sg = sign sk_a n_sig (serialize sig_message sig_msg) in let msg = Msg3 {sg} in serialize message msg @@ -151,6 +151,6 @@ let decode_message3 msg3_bytes bob gx gy pk_a = let msg3 = Msg3?.msg msg3_parsed in // Verify the signature contained in message 3 // with the gx and gy values from Bob's state. - let sig_msg = SigMsg3 {b=bob; gx; gy} in + let sig_msg = SigMsg3 {bob; gx; gy} in if verify pk_a (serialize sig_message sig_msg) msg3.sg then Some msg3 else None diff --git a/examples/iso_dh/DY.Example.DH.SecurityProperties.fst b/examples/iso_dh/DY.Example.DH.SecurityProperties.fst index 7c23f97..7f8cec3 100644 --- a/examples/iso_dh/DY.Example.DH.SecurityProperties.fst +++ b/examples/iso_dh/DY.Example.DH.SecurityProperties.fst @@ -45,10 +45,29 @@ val key_secrecy: tr:trace -> k:bytes -> alice:principal -> bob:principal -> let key_secrecy tr k alice bob = attacker_only_knows_publishable_values tr k; + (* + We can reveal the following functions from the + core DY* to prove the lemma but we don't want + to break this abstraction barrier. + normalize_term_spec is_corrupt; reveal_opaque (`%can_flow) (can_flow); - reveal_opaque (`%join) (join); - () + reveal_opaque (`%join) (join); *) + + // The following proof triggers the join_flow_to_public_eq lemma + // with the [SMTPat ((join x1 x2) `can_flow tr` public)] + introduce + forall si sj. get_label k `equivalent tr` join (principal_state_label alice si) (principal_state_label bob sj) ==> + (is_corrupt tr (principal_state_label alice si) \/ is_corrupt tr (principal_state_label bob sj)) + with ( + introduce + (is_corrupt tr (principal_state_label alice si) \/ is_corrupt tr (principal_state_label bob sj)) ==> + (join (principal_state_label alice si) (principal_state_label bob sj) `can_flow tr` public ) + with _. ( + // This assert triggers the SMTPat of the join_flow_to_public_eq lemma + assert(join (principal_state_label alice si) (principal_state_label bob sj) `can_flow tr` public) + ) + ) (*** Forward Secrecy Properties ***) @@ -69,12 +88,11 @@ val initiator_forward_secrecy: let initiator_forward_secrecy tr i alice bob gx gy k = attacker_only_knows_publishable_values tr k; - (* Debugging code - assert(is_dh_shared_key tr alice bob k \/ is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob)); *) + // The following code is not needed for the proof. + // It just shows what we need to show to prove the lemma. + assert(is_dh_shared_key tr alice bob k \/ is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob)); - normalize_term_spec is_corrupt; - reveal_opaque (`%can_flow) (can_flow); - reveal_opaque (`%join) (join); + key_secrecy tr k alice bob; () val responder_forward_secrecy: @@ -94,13 +112,12 @@ val responder_forward_secrecy: let responder_forward_secrecy tr i alice bob gx gy k = attacker_only_knows_publishable_values tr k; - (* Debugging code + // The following code is not needed for the proof. + // It just shows what we need to show to prove the lemma. assert(is_dh_shared_key tr alice bob k \/ is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob)); assert(event_triggered tr alice (Initiate2 alice bob gx gy k) \/ - is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob)); *) + is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob)); - normalize_term_spec is_corrupt; - reveal_opaque (`%can_flow) (can_flow); - reveal_opaque (`%join) (join); + key_secrecy tr k alice bob; () diff --git a/examples/iso_dh/README.md b/examples/iso_dh/README.md index 060fbdc..50bbf6b 100644 --- a/examples/iso_dh/README.md +++ b/examples/iso_dh/README.md @@ -7,8 +7,7 @@ standard. In this analysis, we prove the following properties of the ISO-DH protocol: 1. Mutual authentication -2. Secrecy of the key ``k`` -3. Forward secrecy of the key ``k`` +2. Forward secrecy of the key ``k`` (as long as the private DH keys are secret, the key ``k`` does not leak) From d1538467d55efc10e3700048385efc75c0ec1f6f Mon Sep 17 00:00:00 2001 From: Fabian Hauck Date: Tue, 25 Jun 2024 11:41:00 +0200 Subject: [PATCH 21/29] DH example proof trace invariants for example trace with SMTPats --- examples/iso_dh/DY.Example.DH.Debug.Proof.fst | 343 ++++++++++++++++++ .../DY.Example.DH.Debug.TraceInvariants.fst | 110 ------ .../DY.Example.DH.Protocol.Stateful.Proof.fst | 11 +- examples/iso_dh/Makefile | 4 - 4 files changed, 352 insertions(+), 116 deletions(-) create mode 100644 examples/iso_dh/DY.Example.DH.Debug.Proof.fst delete mode 100644 examples/iso_dh/DY.Example.DH.Debug.TraceInvariants.fst diff --git a/examples/iso_dh/DY.Example.DH.Debug.Proof.fst b/examples/iso_dh/DY.Example.DH.Debug.Proof.fst new file mode 100644 index 0000000..a613043 --- /dev/null +++ b/examples/iso_dh/DY.Example.DH.Debug.Proof.fst @@ -0,0 +1,343 @@ +module DY.Example.DH.Debug.Proof + +open DY.Core +open DY.Lib +open DY.Example.DH.Protocol.Stateful +open DY.Example.DH.Protocol.Stateful.Proof +open DY.Example.DH.Debug + +#push-options "--fuel 0 --ifuel 0 --z3rlimit 10 --z3cliopt 'smt.qi.eager_threshold=100'" +val debug_proof: + tr:trace -> + Lemma + (requires + trace_invariant tr + ) + (ensures ( + let (_, tr_out) = debug () tr in + trace_invariant tr_out + ) + ) +let debug_proof tr = () +#pop-options + +/// Other ways to proof the debug function +/// but I think the SMTPat way is the nicest one +(* +#push-options "--fuel 0 --ifuel 0 --z3rlimit 10 --z3cliopt 'smt.qi.eager_threshold=100'" +val debug_proof2: + tr:trace -> + Lemma + (requires + trace_invariant tr + ) + (ensures ( + let (_, tr_out) = debug () tr in + trace_invariant tr_out + ) + ) +let debug_proof2 tr = + (*** Initialize protocol run ***) + let alice = "alice" in + let bob = "bob" in + + let (alice_global_session_priv_key_id, tr) = initialize_private_keys alice tr in + let (_, tr) = generate_private_key alice alice_global_session_priv_key_id (Sign "DH.SigningKey") tr in + + let (bob_global_session_priv_key_id, tr) = initialize_private_keys bob tr in + let (_, tr) = generate_private_key bob bob_global_session_priv_key_id (Sign "DH.SigningKey") tr in + let (priv_key_bob, tr) = get_private_key bob bob_global_session_priv_key_id (Sign "DH.SigningKey") tr in + match priv_key_bob with + | None -> () + | Some priv_key_bob -> ( + let pub_key_bob = vk priv_key_bob in + let (alice_global_session_pub_key_id, tr) = initialize_pki alice tr in + let (_, tr) = install_public_key alice alice_global_session_pub_key_id (Verify "DH.SigningKey") bob pub_key_bob tr in + + let (priv_key_alice, tr) = get_private_key alice alice_global_session_priv_key_id (Sign "DH.SigningKey") tr in + assert(trace_invariant tr); + match priv_key_alice with + | None -> () + | Some priv_key_alice -> ( + let pub_key_alice = vk priv_key_alice in + let (bob_global_session_pub_key_id, tr) = initialize_pki bob tr in + let (_, tr) = install_public_key bob bob_global_session_pub_key_id (Verify "DH.SigningKey") alice pub_key_alice tr in + + let alice_global_session_ids: dh_global_sess_ids = {pki=alice_global_session_pub_key_id; private_keys=alice_global_session_priv_key_id} in + let bob_global_session_ids: dh_global_sess_ids = {pki=bob_global_session_pub_key_id; private_keys=bob_global_session_priv_key_id} in + + (*** Run the protocol ***) + prepare_msg1_proof tr alice bob; + let (alice_session_id, tr) = prepare_msg1 alice bob tr in + assert(trace_invariant tr); + + send_msg1_proof tr alice alice_session_id; + let (msg1_id, tr) = send_msg1 alice alice_session_id tr in + assert(trace_invariant tr); + + match msg1_id with + | None -> () + | Some msg1_id -> ( + prepare_msg2_proof tr alice bob msg1_id; + let (bob_session_id, tr) = prepare_msg2 alice bob msg1_id tr in + assert(trace_invariant tr); + + match bob_session_id with + | None -> () + | Some bob_session_id -> ( + send_msg2_proof tr bob_global_session_ids bob bob_session_id; + let (msg2_id, tr) = send_msg2 bob_global_session_ids bob bob_session_id tr in + assert(trace_invariant tr); + + match msg2_id with + | None -> () + | Some msg2_id -> ( + prepare_msg3_proof tr alice_global_session_ids alice bob msg2_id alice_session_id; + let (_, tr) = prepare_msg3 alice_global_session_ids alice bob msg2_id alice_session_id tr in + + send_msg3_proof tr alice_global_session_ids alice bob alice_session_id; + let (msg3_id, tr) = send_msg3 alice_global_session_ids alice bob alice_session_id tr in + assert(trace_invariant tr); + + match msg3_id with + | None -> () + | Some msg3_id -> ( + verify_msg3_proof tr bob_global_session_ids alice bob msg3_id bob_session_id; + let (_, tr) = verify_msg3 bob_global_session_ids alice bob msg3_id bob_session_id tr in + assert(trace_invariant tr); + () + ) + ) + ) + ) + ) + ) +#pop-options + + +#push-options "--fuel 0 --ifuel 0 --z3rlimit 10" +val prepare_msg1_proof_forall: + tr:trace -> + Lemma + (requires + trace_invariant tr + ) + (ensures ( + forall alice bob. + let (_, tr_out) = prepare_msg1 alice bob tr in + trace_invariant tr_out + ) + ) +let prepare_msg1_proof_forall tr = + introduce forall alice bob. trace_invariant (snd (prepare_msg1 alice bob tr)) + with ( + prepare_msg1_proof tr alice bob; + let (alice_session_id, tr) = prepare_msg1 alice bob tr in + () + ) + +val send_msg1_proof_forall: + tr:trace -> + Lemma + (requires + trace_invariant tr + ) + (ensures ( + forall alice alice_session_id. + let (_, tr_out) = send_msg1 alice alice_session_id tr in + trace_invariant tr_out + ) + ) +let send_msg1_proof_forall tr = + introduce forall alice alice_session_id. trace_invariant (snd (send_msg1 alice alice_session_id tr)) + with ( + send_msg1_proof tr alice alice_session_id; + let (msg1_id, tr) = send_msg1 alice alice_session_id tr in + () + ) + +val prepare_msg2_proof_forall: + tr:trace -> + Lemma + (requires + trace_invariant tr + ) + (ensures ( + forall alice bob msg1_id. + let (_, tr_out) = prepare_msg2 alice bob msg1_id tr in + trace_invariant tr_out + ) + ) +let prepare_msg2_proof_forall tr = + introduce forall alice bob msg1_id. trace_invariant (snd (prepare_msg2 alice bob msg1_id tr)) + with ( + prepare_msg2_proof tr alice bob msg1_id; + let (bob_session_id, tr) = prepare_msg2 alice bob msg1_id tr in + () + ) + +val send_msg2_proof_forall: + tr:trace -> + Lemma + (requires + trace_invariant tr + ) + (ensures ( + forall bob_global_session_ids bob bob_session_id. + let (_, tr_out) = send_msg2 bob_global_session_ids bob bob_session_id tr in + trace_invariant tr_out + ) + ) +let send_msg2_proof_forall tr = + introduce forall bob_global_session_ids bob bob_session_id. trace_invariant (snd (send_msg2 bob_global_session_ids bob bob_session_id tr)) + with ( + send_msg2_proof tr bob_global_session_ids bob bob_session_id; + let (msg2_id, tr) = send_msg2 bob_global_session_ids bob bob_session_id tr in + () + ) + +val prepare_msg3_proof_forall: + tr:trace -> + Lemma + (requires + trace_invariant tr + ) + (ensures ( + forall alice_global_session_ids alice bob msg2_id alice_session_id. + let (_, tr_out) = prepare_msg3 alice_global_session_ids alice bob msg2_id alice_session_id tr in + trace_invariant tr_out + ) + ) +let prepare_msg3_proof_forall tr = + introduce forall alice_global_session_ids alice bob msg2_id alice_session_id. trace_invariant (snd (prepare_msg3 alice_global_session_ids alice bob msg2_id alice_session_id tr)) + with ( + prepare_msg3_proof tr alice_global_session_ids alice bob msg2_id alice_session_id; + let (_, tr) = prepare_msg3 alice_global_session_ids alice bob msg2_id alice_session_id tr in + () + ) + +val send_msg3_proof_forall: + tr:trace -> + Lemma + (requires + trace_invariant tr + ) + (ensures ( + forall alice_global_session_ids alice bob alice_session_id. + let (_, tr_out) = send_msg3 alice_global_session_ids alice bob alice_session_id tr in + trace_invariant tr_out + ) + ) +let send_msg3_proof_forall tr = + introduce forall alice_global_session_ids alice bob alice_session_id. trace_invariant (snd (send_msg3 alice_global_session_ids alice bob alice_session_id tr)) + with ( + send_msg3_proof tr alice_global_session_ids alice bob alice_session_id; + let (msg3_id, tr) = send_msg3 alice_global_session_ids alice bob alice_session_id tr in + () + ) + +val verify_msg3_proof_forall: + tr:trace -> + Lemma + (requires + trace_invariant tr + ) + (ensures ( + forall bob_global_session_ids alice bob msg3_id bob_session_id. + let (_, tr_out) = verify_msg3 bob_global_session_ids alice bob msg3_id bob_session_id tr in + trace_invariant tr_out + ) + ) +let verify_msg3_proof_forall tr = + introduce forall bob_global_session_ids alice bob msg3_id bob_session_id. trace_invariant (snd (verify_msg3 bob_global_session_ids alice bob msg3_id bob_session_id tr)) + with ( + verify_msg3_proof tr bob_global_session_ids alice bob msg3_id bob_session_id; + let (_, tr) = verify_msg3 bob_global_session_ids alice bob msg3_id bob_session_id tr in + () + ) +#pop-options + +#push-options "--fuel 8 --ifuel 8 --z3rlimit 50 --z3cliopt 'smt.qi.eager_threshold=100'" +val debug_proof_test: + tr:trace -> + Lemma + (requires + trace_invariant tr + ) + (ensures ( + let (_, tr_out) = debug () tr in + trace_invariant tr_out + ) + ) +let debug_proof_test tr = + (*** Initialize protocol run ***) + let alice = "alice" in + let bob = "bob" in + + let (alice_global_session_priv_key_id, tr) = initialize_private_keys alice tr in + let (_, tr) = generate_private_key alice alice_global_session_priv_key_id (Sign "DH.SigningKey") tr in + + let (bob_global_session_priv_key_id, tr) = initialize_private_keys bob tr in + let (_, tr) = generate_private_key bob bob_global_session_priv_key_id (Sign "DH.SigningKey") tr in + let (priv_key_bob, tr) = get_private_key bob bob_global_session_priv_key_id (Sign "DH.SigningKey") tr in + match priv_key_bob with + | None -> () + | Some priv_key_bob -> ( + let pub_key_bob = vk priv_key_bob in + let (alice_global_session_pub_key_id, tr) = initialize_pki alice tr in + let (_, tr) = install_public_key alice alice_global_session_pub_key_id (Verify "DH.SigningKey") bob pub_key_bob tr in + + let (priv_key_alice, tr) = get_private_key alice alice_global_session_priv_key_id (Sign "DH.SigningKey") tr in + assert(trace_invariant tr); + match priv_key_alice with + | None -> () + | Some priv_key_alice -> ( + let pub_key_alice = vk priv_key_alice in + let (bob_global_session_pub_key_id, tr) = initialize_pki bob tr in + let (_, tr) = install_public_key bob bob_global_session_pub_key_id (Verify "DH.SigningKey") alice pub_key_alice tr in + + let alice_global_session_ids: dh_global_sess_ids = {pki=alice_global_session_pub_key_id; private_keys=alice_global_session_priv_key_id} in + let bob_global_session_ids: dh_global_sess_ids = {pki=bob_global_session_pub_key_id; private_keys=bob_global_session_priv_key_id} in + + (*** Run the protocol ***) + prepare_msg1_proof tr alice bob; + let (alice_session_id, tr) = prepare_msg1 alice bob tr in + assert(trace_invariant tr); + + send_msg1_proof tr alice alice_session_id; + let (msg1_id, tr) = send_msg1 alice alice_session_id tr in + assert(trace_invariant tr); + + match msg1_id with + | None -> () + | Some msg1_id -> ( + prepare_msg2_proof tr alice bob msg1_id; + let (bob_session_id, tr) = prepare_msg2 alice bob msg1_id tr in + assert(trace_invariant tr); + + match bob_session_id with + | None -> () + | Some bob_session_id -> ( + send_msg2_proof tr bob_global_session_ids bob bob_session_id; + let (msg2_id, tr) = send_msg2 bob_global_session_ids bob bob_session_id tr in + assert(trace_invariant tr); + + match msg2_id with + | None -> () + | Some msg2_id -> ( + prepare_msg3_proof tr alice_global_session_ids alice bob msg2_id alice_session_id; + let (_, tr) = prepare_msg3 alice_global_session_ids alice bob msg2_id alice_session_id tr in + + send_msg3_proof_forall tr; + // This line is needed for the proof + let (msg3_id, tr) = send_msg3 alice_global_session_ids alice bob alice_session_id tr in + assert(trace_invariant tr); + + verify_msg3_proof_forall tr; + () + ) + ) + ) + ) + ) +*) diff --git a/examples/iso_dh/DY.Example.DH.Debug.TraceInvariants.fst b/examples/iso_dh/DY.Example.DH.Debug.TraceInvariants.fst deleted file mode 100644 index ad88a8b..0000000 --- a/examples/iso_dh/DY.Example.DH.Debug.TraceInvariants.fst +++ /dev/null @@ -1,110 +0,0 @@ -module DY.Example.DH.Debug.TraceInvariants - -open DY.Core -open DY.Lib -open DY.Example.DH.Protocol.Stateful -open DY.Example.DH.Protocol.Stateful.Proof - -/// This module provides a sanity check for the trace invariants. -/// It does this by showing that at least one trace satisfies the invariants. - -#set-options "--fuel 0 --ifuel 0 --z3rlimit 10" -let debug (tr:trace) : string = - assume(trace_invariant tr); - - let _ = IO.debug_print_string "************* Trace *************\n" in - (*** Initialize protocol run ***) - let alice = "alice" in - let bob = "bob" in - - // Generate private key for Alice - let (alice_global_session_priv_key_id, tr) = initialize_private_keys alice tr in - let (_, tr) = generate_private_key alice alice_global_session_priv_key_id (Sign "DH.SigningKey") tr in - - // Generate private key for Bob - let (bob_global_session_priv_key_id, tr) = initialize_private_keys bob tr in - let (_, tr) = generate_private_key bob bob_global_session_priv_key_id (Sign "DH.SigningKey") tr in - - // Store Bob's public key in Alice's state - // 1. Retrieve Bob's private key from his session - // 2. Compute the public key from the private key - // 3. Initialize Alice's session to store public keys - // 4. Install Bob's public key in Alice's public key store - let (priv_key_bob, tr) = get_private_key bob bob_global_session_priv_key_id (Sign "DH.SigningKey") tr in - match priv_key_bob with - | None -> "Failed to execute protocol run\n" - | Some priv_key_bob -> ( - let pub_key_bob = vk priv_key_bob in - let (alice_global_session_pub_key_id, tr) = initialize_pki alice tr in - let (_, tr) = install_public_key alice alice_global_session_pub_key_id (Verify "DH.SigningKey") bob pub_key_bob tr in - - // Store Alice's public key in Bob's state - let (priv_key_alice, tr) = get_private_key alice alice_global_session_priv_key_id (Sign "DH.SigningKey") tr in - match priv_key_alice with - | None -> "Failed to execute protocol run\n" - | Some priv_key_alice -> ( - let pub_key_alice = vk priv_key_alice in - let (bob_global_session_pub_key_id, tr) = initialize_pki bob tr in - let (_, tr) = install_public_key bob bob_global_session_pub_key_id (Verify "DH.SigningKey") alice pub_key_alice tr in - - let alice_global_session_ids: dh_global_sess_ids = {pki=alice_global_session_pub_key_id; private_keys=alice_global_session_priv_key_id} in - let bob_global_session_ids: dh_global_sess_ids = {pki=bob_global_session_pub_key_id; private_keys=bob_global_session_priv_key_id} in - - (*** Run the protocol ***) - // Alice - prepare_msg1_proof tr alice bob; - let (alice_session_id, tr) = prepare_msg1 alice bob tr in - assert(trace_invariant tr); - - send_msg1_proof tr alice bob alice_session_id; - let (msg1_id, tr) = send_msg1 alice alice_session_id tr in - assert(trace_invariant tr); - - match msg1_id with - | None -> "Failed to execute protocol run\n" - | Some msg1_id -> ( - // Bob - prepare_msg2_proof tr alice bob msg1_id; - let (bob_session_id, tr) = prepare_msg2 alice bob msg1_id tr in - assert(trace_invariant tr); - - match bob_session_id with - | None -> "Failed to execute protocol run\n" - | Some bob_session_id -> ( - send_msg2_proof tr bob_global_session_ids bob bob_session_id; - let (msg2_id, tr) = send_msg2 bob_global_session_ids bob bob_session_id tr in - assert(trace_invariant tr); - - match msg2_id with - | None -> "Failed to execute protocol run\n" - | Some msg2_id -> ( - // Alice - prepare_msg3_proof tr alice_global_session_ids alice bob msg2_id alice_session_id; - let (_, tr) = prepare_msg3 alice_global_session_ids alice bob msg2_id alice_session_id tr in - assert(trace_invariant tr); - - send_msg3_proof tr alice_global_session_ids alice bob alice_session_id; - let (msg3_id, tr) = send_msg3 alice_global_session_ids alice bob alice_session_id tr in - assert(trace_invariant tr); - - match msg3_id with - | None -> "Failed to execute protocol run\n" - | Some msg3_id -> ( - // Bob - verify_msg3_proof tr bob_global_session_ids alice bob msg3_id bob_session_id; - let (_, tr) = verify_msg3 bob_global_session_ids alice bob msg3_id bob_session_id tr in - assert(trace_invariant tr); - - trace_to_string default_trace_to_string_printers tr - ) - ) - ) - ) - ) - ) - -//Run ``debug ()`` when the module loads -#push-options "--warn_error -272" -let tr_string = debug Nil -let _ = IO.debug_print_string (tr_string) -#pop-options \ No newline at end of file diff --git a/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst b/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst index 13f899a..f60b88a 100644 --- a/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst +++ b/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst @@ -153,18 +153,20 @@ val prepare_msg1_proof: let (sess_id, tr_out) = prepare_msg1 alice bob tr in trace_invariant tr_out )) + [SMTPat (trace_invariant (snd (prepare_msg1 alice bob tr)))] let prepare_msg1_proof tr alice bob = () val send_msg1_proof: tr:trace -> - alice:principal -> bob:principal -> sess_id:state_id -> + alice:principal -> sess_id:state_id -> Lemma (requires trace_invariant tr) (ensures ( let (msg_id, tr_out) = send_msg1 alice sess_id tr in trace_invariant tr_out )) -let send_msg1_proof tr alice bob sess_id = + [SMTPat (trace_invariant (snd (send_msg1 alice sess_id tr)))] +let send_msg1_proof tr alice sess_id = match get_state alice sess_id tr with | (Some (InitiatorSentMsg1 bob x), tr) -> ( compute_message1_proof tr alice bob x sess_id @@ -180,6 +182,7 @@ val prepare_msg2_proof: let (msg_id, tr_out) = prepare_msg2 alice bob msg_id tr in trace_invariant tr_out )) + [SMTPat (trace_invariant (snd (prepare_msg2 alice bob msg_id tr)))] let prepare_msg2_proof tr alice bob msg_id = match recv_msg msg_id tr with | (Some msg, tr) -> ( @@ -196,6 +199,7 @@ val send_msg2_proof: let (msg_id, tr_out) = send_msg2 global_sess_id bob sess_id tr in trace_invariant tr_out )) + [SMTPat (trace_invariant (snd (send_msg2 global_sess_id bob sess_id tr)))] let send_msg2_proof tr global_sess_id bob sess_id = match get_state bob sess_id tr with | (Some (ResponderSentMsg2 alice gx gy y), tr) -> ( @@ -217,6 +221,7 @@ val prepare_msg3_proof: let (_, tr_out) = prepare_msg3 global_sess_id alice bob msg_id sess_id tr in trace_invariant tr_out )) + [SMTPat (trace_invariant (snd (prepare_msg3 global_sess_id alice bob msg_id sess_id tr)))] let prepare_msg3_proof tr global_sess_id alice bob msg_id sess_id = match get_state alice sess_id tr with | (Some (InitiatorSentMsg1 bob x), tr) -> ( @@ -278,6 +283,7 @@ val send_msg3_proof: let (_, tr_out) = send_msg3 global_sess_id alice bob sess_id tr in trace_invariant tr_out )) + [SMTPat (trace_invariant (snd (send_msg3 global_sess_id alice bob sess_id tr)))] let send_msg3_proof tr global_sess_id alice bob sess_id = match get_state alice sess_id tr with | (Some (InitiatorSendMsg3 bob gx gy k), tr) -> ( @@ -328,6 +334,7 @@ val verify_msg3_proof: let (_, tr_out) = verify_msg3 global_sess_id alice bob msg_id sess_id tr in trace_invariant tr_out )) + [SMTPat (trace_invariant (snd (verify_msg3 global_sess_id alice bob msg_id sess_id tr)))] let verify_msg3_proof tr global_sess_id alice bob msg_id sess_id = match get_state bob sess_id tr with | (Some (ResponderSentMsg2 alice gx gy y), tr) -> ( diff --git a/examples/iso_dh/Makefile b/examples/iso_dh/Makefile index 9fac801..542d594 100644 --- a/examples/iso_dh/Makefile +++ b/examples/iso_dh/Makefile @@ -4,7 +4,3 @@ include $(DY_HOME)/Makefile test: cd $(DY_HOME)/obj; OCAMLPATH=$(FSTAR_HOME)/lib ocamlbuild -use-ocamlfind -pkg batteries -pkg fstar.lib DY_Example_DH_Debug.native $(DY_HOME)/obj/DY_Example_DH_Debug.native - -test-traceinvariants: - cd $(DY_HOME)/obj; OCAMLPATH=$(FSTAR_HOME)/lib ocamlbuild -use-ocamlfind -pkg batteries -pkg fstar.lib DY_Example_DH_Debug_TraceInvariants.native - $(DY_HOME)/obj/DY_Example_DH_Debug_TraceInvariants.native From 4229af36a288e941c6c6114047343b0b52eb55f3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Th=C3=A9ophile=20Wallez?= Date: Tue, 25 Jun 2024 18:08:32 +0200 Subject: [PATCH 22/29] cleanup: tighten ISO-DH invariants to simplify proofs --- .../DY.Example.DH.Protocol.Stateful.Proof.fst | 60 ++++--------------- .../DY.Example.DH.Protocol.Total.Proof.fst | 8 +-- 2 files changed, 15 insertions(+), 53 deletions(-) diff --git a/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst b/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst index f60b88a..bb799d7 100644 --- a/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst +++ b/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst @@ -76,7 +76,7 @@ let dh_event_pred: event_predicate dh_event = | Initiate2 alice bob gx gy k -> ( is_publishable tr gx /\ is_publishable tr gy /\ (exists x sess_id. is_secret (principal_state_label alice sess_id) tr x /\ - gx = dh_pk x) /\ + gx = dh_pk x /\ k == dh x gy) /\ (is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ (exists y. k == dh y gx /\ is_dh_shared_key tr alice bob k /\ event_triggered tr bob (Respond1 alice bob gx gy y))) ) @@ -294,7 +294,7 @@ let send_msg3_proof tr global_sess_id alice bob sess_id = // The following code is not needed for the proof. // It just shows what we need to show to prove the lemma. assert(event_triggered tr alice (Initiate2 alice bob gx gy k)); - assert(exists x. gx == dh_pk x); + assert(exists x. event_triggered tr alice (Initiate2 alice bob gx gy (dh x gy)) /\ gx = dh_pk x); compute_message3_proof tr alice bob gx gy sk_a n_sig; () @@ -303,27 +303,6 @@ let send_msg3_proof tr global_sess_id alice bob sess_id = ) | _ -> () -val event_respond1_injective: - tr:trace -> - alice:principal -> bob:principal -> - gx:bytes -> gy:bytes -> y:bytes -> y':bytes -> - Lemma - (requires - trace_invariant tr /\ - event_triggered tr bob (Respond1 alice bob gx gy y) /\ - event_triggered tr bob (Respond1 alice bob gx gy y') - ) - (ensures - y == y' - ) -let event_respond1_injective tr alice bob gx gy y y' = - reveal_opaque (`%dh_pk) (dh_pk); - assert(gy == dh_pk y); - assert(gy == dh_pk y'); - assert(y == y'); - () - - #set-options "--z3rlimit 50" val verify_msg3_proof: tr:trace -> @@ -354,7 +333,7 @@ let verify_msg3_proof tr global_sess_id alice bob msg_id sess_id = // the event Initiate2 has been triggered or alice is corrupt. // On a high level we need to show now that this event was triggered // for our concrete k. - assert(exists k'. event_triggered tr alice (Initiate2 alice bob gx gy k') \/ is_corrupt tr (principal_label alice)); + assert(exists x. gx == dh_pk x /\ event_triggered tr alice (Initiate2 alice bob gx gy (dh x gy)) \/ is_corrupt tr (principal_label alice)); // Proof strategy: We want to work without the corruption case // so we introduce this implication. @@ -362,33 +341,16 @@ let verify_msg3_proof tr global_sess_id alice bob msg_id sess_id = let event_initiate2 = event_triggered tr alice (Initiate2 alice bob gx gy k) in introduce alice_and_bob_not_corrupt ==> event_initiate2 with _. ( - // We can now assert that there exists a k' such that the event Initiate2 has been triggered + // We can now assert that there exists a x such that the event Initiate2 has been triggered // without the corruption case. - assert(exists k'. event_triggered tr alice (Initiate2 alice bob gx gy k')); - // We now introduce k' to concretely reason about it. - eliminate exists k'. event_triggered tr alice (Initiate2 alice bob gx gy k') + assert(exists x. gx == dh_pk x /\ event_triggered tr alice (Initiate2 alice bob gx gy (dh x gy))); + // We now introduce x to concretely reason about it. + eliminate exists x. gx == dh_pk x /\ event_triggered tr alice (Initiate2 alice bob gx gy (dh x gy)) returns event_initiate2 with _. ( - // From the Initiate2 event we know that there exists a Respond1 event with - // gx, gy and some y'. To show that k equals k' it is enough to show that - // y' equals y since k = dh y gx. - assert(exists y'. k' == dh y' gx /\ event_triggered tr bob (Respond1 alice bob gx gy y')); - - // To concretely reason about y' we introduce it via an elimination. - eliminate exists y'. gy == dh_pk y' /\ k' == dh y' gx /\ event_triggered tr bob (Respond1 alice bob gx gy y') - returns event_triggered tr alice (Initiate2 alice bob gx gy k) - with _. ( - // The event_respond1_injective lemma gives us that the - // event triggered with y and y' is the same - event_respond1_injective tr alice bob gx gy y y'; - // With the lemma above F* can automatically deduce that - // k and k' must be equal. - assert(k == k'); - // This gives us that the event Initiate2 has been triggered - // for our concrete k. - assert(event_initiate2); - () - ) + // We use commutativity of DH to reconcile the (dh x gy) in our hypothesis, + // and the (dh y gx) in event_initiate2 + dh_shared_secret_lemma x y ) ); @@ -405,4 +367,4 @@ let verify_msg3_proof tr global_sess_id alice bob msg_id sess_id = ) | (None, tr) -> () ) - | (_, tr) -> () \ No newline at end of file + | (_, tr) -> () diff --git a/examples/iso_dh/DY.Example.DH.Protocol.Total.Proof.fst b/examples/iso_dh/DY.Example.DH.Protocol.Total.Proof.fst index 01960a9..40a8a4a 100644 --- a/examples/iso_dh/DY.Example.DH.Protocol.Total.Proof.fst +++ b/examples/iso_dh/DY.Example.DH.Protocol.Total.Proof.fst @@ -41,7 +41,7 @@ let dh_crypto_preds = { exists y. sig_msg2.gy == (dh_pk y) /\ event_triggered tr prin (Respond1 sig_msg2.alice prin sig_msg2.gx sig_msg2.gy y) ) | Some (SigMsg3 sig_msg3) -> ( - exists x k. sig_msg3.gx == (dh_pk x) /\ event_triggered tr prin (Initiate2 prin sig_msg3.bob sig_msg3.gx sig_msg3.gy k) + exists x. sig_msg3.gx == (dh_pk x) /\ event_triggered tr prin (Initiate2 prin sig_msg3.bob sig_msg3.gx sig_msg3.gy (dh x sig_msg3.gy)) ) | None -> False )) @@ -214,7 +214,7 @@ val compute_message3_proof: sk_a:bytes -> n_sig:bytes -> Lemma (requires - (exists x k. event_triggered tr alice (Initiate2 alice bob gx gy k) /\ gx = dh_pk x) /\ + (exists x. event_triggered tr alice (Initiate2 alice bob gx gy (dh x gy)) /\ gx = dh_pk x) /\ is_publishable tr gx /\ is_publishable tr gy /\ is_signature_key "DH.SigningKey" (principal_label alice) tr sk_a /\ is_secret (principal_label alice) tr n_sig /\ @@ -262,7 +262,7 @@ val decode_message3_proof: let sig_msg = SigMsg3 {bob; gx; gy} in is_publishable tr msg3.sg /\ (is_corrupt tr (principal_label alice) \/ - (exists x k. gx == dh_pk x /\ event_triggered tr alice (Initiate2 alice bob gx gy k))) + (exists x. gx == dh_pk x /\ event_triggered tr alice (Initiate2 alice bob gx gy (dh x gy)))) ) | None -> True )) @@ -273,4 +273,4 @@ let decode_message3_proof tr alice bob gx gy msg_bytes pk_a = serialize_wf_lemma sig_message (is_publishable tr) (SigMsg3 {bob; gx; gy}); () ) - | None -> () \ No newline at end of file + | None -> () From 905d09749041081bd91c94ba3186d3b88de3ae73 Mon Sep 17 00:00:00 2001 From: Fabian Hauck Date: Thu, 27 Jun 2024 16:06:42 +0200 Subject: [PATCH 23/29] DH example improved security properties and changed SMTPats for the stateful proof functions --- examples/iso_dh/DY.Example.DH.Debug.Proof.fst | 2 +- .../DY.Example.DH.Protocol.Stateful.Proof.fst | 45 +++-- .../DY.Example.DH.Protocol.Total.Proof.fst | 6 +- .../iso_dh/DY.Example.DH.Protocol.Total.fst | 10 +- .../DY.Example.DH.SecurityProperties.fst | 184 +++++++++++------- 5 files changed, 159 insertions(+), 88 deletions(-) diff --git a/examples/iso_dh/DY.Example.DH.Debug.Proof.fst b/examples/iso_dh/DY.Example.DH.Debug.Proof.fst index a613043..c5191a6 100644 --- a/examples/iso_dh/DY.Example.DH.Debug.Proof.fst +++ b/examples/iso_dh/DY.Example.DH.Debug.Proof.fst @@ -20,7 +20,7 @@ val debug_proof: ) let debug_proof tr = () #pop-options - + /// Other ways to proof the debug function /// but I think the SMTPat way is the nicest one (* diff --git a/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst b/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst index bb799d7..c064284 100644 --- a/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst +++ b/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst @@ -42,8 +42,9 @@ let dh_session_pred: local_state_predicate dh_session = { let alice = prin in is_publishable tr gx /\ is_publishable tr gy /\ is_knowable_by (principal_state_label alice sess_id) tr k /\ + (exists x. gx == dh_pk x /\ k == dh x gy /\ is_secret (principal_state_label alice sess_id) tr x) /\ event_triggered tr alice (Initiate2 alice bob gx gy k) /\ - (is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ + (is_corrupt tr (principal_label bob) \/ is_corrupt tr (principal_state_label alice sess_id) \/ (exists y. k == dh y gx /\ is_dh_shared_key tr alice bob k /\ event_triggered tr bob (Respond1 alice bob gx gy y))) ) @@ -51,8 +52,9 @@ let dh_session_pred: local_state_predicate dh_session = { let bob = prin in is_publishable tr gx /\ is_publishable tr gy /\ is_knowable_by (principal_state_label bob sess_id) tr k /\ + (exists y. gy == dh_pk y /\ k == dh y gx /\ is_secret (principal_state_label bob sess_id) tr y) /\ event_triggered tr bob (Respond2 alice bob gx gy k) /\ - (is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ + (is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_state_label bob sess_id) \/ (is_dh_shared_key tr alice bob k /\ event_triggered tr alice (Initiate2 alice bob gx gy k))) ) @@ -77,11 +79,11 @@ let dh_event_pred: event_predicate dh_event = is_publishable tr gx /\ is_publishable tr gy /\ (exists x sess_id. is_secret (principal_state_label alice sess_id) tr x /\ gx = dh_pk x /\ k == dh x gy) /\ - (is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ + ((exists alice_si. is_corrupt tr (principal_state_label alice alice_si)) \/ is_corrupt tr (principal_label bob) \/ (exists y. k == dh y gx /\ is_dh_shared_key tr alice bob k /\ event_triggered tr bob (Respond1 alice bob gx gy y))) ) | Respond2 alice bob gx gy k -> ( - is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ + is_corrupt tr (principal_label alice) \/ (exists bob_si. is_corrupt tr (principal_state_label bob bob_si)) \/ (is_dh_shared_key tr alice bob k /\ event_triggered tr alice (Initiate2 alice bob gx gy k)) ) @@ -153,7 +155,12 @@ val prepare_msg1_proof: let (sess_id, tr_out) = prepare_msg1 alice bob tr in trace_invariant tr_out )) - [SMTPat (trace_invariant (snd (prepare_msg1 alice bob tr)))] + // The SMTPat is used to automatically proof that + // the debug trace fulfills the trace invariants. + // The SMTPat says that if the trace invariants hold on tr + // and the function prepare_msg1 is called then instantiate + // this lemma. + [SMTPat (trace_invariant tr); SMTPat (prepare_msg1 alice bob tr)] let prepare_msg1_proof tr alice bob = () val send_msg1_proof: @@ -165,7 +172,7 @@ val send_msg1_proof: let (msg_id, tr_out) = send_msg1 alice sess_id tr in trace_invariant tr_out )) - [SMTPat (trace_invariant (snd (send_msg1 alice sess_id tr)))] + [SMTPat (trace_invariant tr); SMTPat (send_msg1 alice sess_id tr)] let send_msg1_proof tr alice sess_id = match get_state alice sess_id tr with | (Some (InitiatorSentMsg1 bob x), tr) -> ( @@ -182,7 +189,7 @@ val prepare_msg2_proof: let (msg_id, tr_out) = prepare_msg2 alice bob msg_id tr in trace_invariant tr_out )) - [SMTPat (trace_invariant (snd (prepare_msg2 alice bob msg_id tr)))] + [SMTPat (trace_invariant tr); SMTPat (prepare_msg2 alice bob msg_id tr)] let prepare_msg2_proof tr alice bob msg_id = match recv_msg msg_id tr with | (Some msg, tr) -> ( @@ -199,7 +206,7 @@ val send_msg2_proof: let (msg_id, tr_out) = send_msg2 global_sess_id bob sess_id tr in trace_invariant tr_out )) - [SMTPat (trace_invariant (snd (send_msg2 global_sess_id bob sess_id tr)))] + [SMTPat (trace_invariant tr); SMTPat (send_msg2 global_sess_id bob sess_id tr)] let send_msg2_proof tr global_sess_id bob sess_id = match get_state bob sess_id tr with | (Some (ResponderSentMsg2 alice gx gy y), tr) -> ( @@ -221,7 +228,7 @@ val prepare_msg3_proof: let (_, tr_out) = prepare_msg3 global_sess_id alice bob msg_id sess_id tr in trace_invariant tr_out )) - [SMTPat (trace_invariant (snd (prepare_msg3 global_sess_id alice bob msg_id sess_id tr)))] + [SMTPat (trace_invariant tr); SMTPat (prepare_msg3 global_sess_id alice bob msg_id sess_id tr)] let prepare_msg3_proof tr global_sess_id alice bob msg_id sess_id = match get_state alice sess_id tr with | (Some (InitiatorSentMsg1 bob x), tr) -> ( @@ -232,8 +239,12 @@ let prepare_msg3_proof tr global_sess_id alice bob msg_id sess_id = let gx = dh_pk x in match decode_message2 msg_bytes alice gx pk_b with | Some msg2 -> ( - decode_message2_proof tr alice bob msg_bytes gx pk_b; + decode_message2_proof tr alice sess_id bob msg_bytes gx pk_b; + let k = dh x msg2.gy in + + assert((exists x. gx == dh_pk x /\ k == dh x msg2.gy /\ is_secret (principal_state_label alice sess_id) tr x)); + assert(is_publishable tr gx); assert(is_publishable tr msg2.gy); assert(is_knowable_by (principal_state_label alice sess_id) tr k); @@ -243,7 +254,7 @@ let prepare_msg3_proof tr global_sess_id alice bob msg_id sess_id = assert(get_usage k = AeadKey "DH.aead_key"); assert(exists si. is_knowable_by (principal_state_label alice si) tr k); - let alice_and_bob_not_corrupt = (~(is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob))) in + let alice_and_bob_not_corrupt = (~(is_corrupt tr (principal_state_label alice sess_id) \/ is_corrupt tr (principal_label bob))) in let dh_key_and_event_respond1 = (exists y. k == dh y gx /\ is_dh_shared_key tr alice bob k /\ event_triggered tr bob (Respond1 alice bob gx msg2.gy y)) in introduce alice_and_bob_not_corrupt ==> dh_key_and_event_respond1 with _. ( @@ -283,7 +294,7 @@ val send_msg3_proof: let (_, tr_out) = send_msg3 global_sess_id alice bob sess_id tr in trace_invariant tr_out )) - [SMTPat (trace_invariant (snd (send_msg3 global_sess_id alice bob sess_id tr)))] + [SMTPat (trace_invariant tr); SMTPat (send_msg3 global_sess_id alice bob sess_id tr)] let send_msg3_proof tr global_sess_id alice bob sess_id = match get_state alice sess_id tr with | (Some (InitiatorSendMsg3 bob gx gy k), tr) -> ( @@ -313,7 +324,7 @@ val verify_msg3_proof: let (_, tr_out) = verify_msg3 global_sess_id alice bob msg_id sess_id tr in trace_invariant tr_out )) - [SMTPat (trace_invariant (snd (verify_msg3 global_sess_id alice bob msg_id sess_id tr)))] + [SMTPat (trace_invariant tr); SMTPat (verify_msg3 global_sess_id alice bob msg_id sess_id tr)] let verify_msg3_proof tr global_sess_id alice bob msg_id sess_id = match get_state bob sess_id tr with | (Some (ResponderSentMsg2 alice gx gy y), tr) -> ( @@ -328,6 +339,8 @@ let verify_msg3_proof tr global_sess_id alice bob msg_id sess_id = let k = dh y gx in + assert(exists y. gy == dh_pk y /\ k == dh y gx /\ is_secret (principal_state_label bob sess_id) tr y); + assert(event_triggered tr bob (Respond1 alice bob gx gy y)); // The decode_message3_proof gives us that there exists a k' such that // the event Initiate2 has been triggered or alice is corrupt. @@ -337,7 +350,7 @@ let verify_msg3_proof tr global_sess_id alice bob msg_id sess_id = // Proof strategy: We want to work without the corruption case // so we introduce this implication. - let alice_and_bob_not_corrupt = (~(is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob))) in + let alice_and_bob_not_corrupt = (~(is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_state_label bob sess_id))) in let event_initiate2 = event_triggered tr alice (Initiate2 alice bob gx gy k) in introduce alice_and_bob_not_corrupt ==> event_initiate2 with _. ( @@ -354,10 +367,10 @@ let verify_msg3_proof tr global_sess_id alice bob msg_id sess_id = ) ); - assert(is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ + assert(is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_state_label bob sess_id) \/ (exists si sj. get_label k `equivalent tr` join (principal_state_label alice si) (principal_state_label bob sj))); assert(get_usage k == AeadKey "DH.aead_key"); - assert(is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ + assert(is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_state_label bob sess_id) \/ (is_dh_shared_key tr alice bob k /\ event_triggered tr alice (Initiate2 alice bob gx gy k))); () ) diff --git a/examples/iso_dh/DY.Example.DH.Protocol.Total.Proof.fst b/examples/iso_dh/DY.Example.DH.Protocol.Total.Proof.fst index 40a8a4a..076fea5 100644 --- a/examples/iso_dh/DY.Example.DH.Protocol.Total.Proof.fst +++ b/examples/iso_dh/DY.Example.DH.Protocol.Total.Proof.fst @@ -169,7 +169,7 @@ let compute_message2_proof tr si alice bob msg1 y sk_b n_sig = val decode_message2_proof: tr:trace -> - alice:principal -> bob:principal -> + alice:principal -> alice_si:state_id -> bob:principal -> msg_bytes:bytes -> gx:bytes -> pk_b:bytes -> Lemma (requires @@ -183,12 +183,12 @@ val decode_message2_proof: let sig_msg = SigMsg2 {alice; gx; gy=msg2.gy} in is_publishable tr msg2.gy /\ is_publishable tr msg2.sg /\ - (is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ + (is_corrupt tr (principal_state_label alice alice_si) \/ is_corrupt tr (principal_label bob) \/ (exists y. event_triggered tr bob (Respond1 alice bob gx msg2.gy y))) ) | None -> True )) -let decode_message2_proof tr alice bob msg_bytes gx pk_b = +let decode_message2_proof tr alice alice_si bob msg_bytes gx pk_b = match decode_message2 msg_bytes alice gx pk_b with | Some msg2 -> ( parse_wf_lemma message (is_publishable tr) msg_bytes; diff --git a/examples/iso_dh/DY.Example.DH.Protocol.Total.fst b/examples/iso_dh/DY.Example.DH.Protocol.Total.fst index 1ca6300..285f543 100644 --- a/examples/iso_dh/DY.Example.DH.Protocol.Total.fst +++ b/examples/iso_dh/DY.Example.DH.Protocol.Total.fst @@ -132,8 +132,14 @@ let decode_message2 msg2_bytes alice gx pk_b = // value from Alice's state. let gy = msg2.gy in let sig_msg = SigMsg2 {alice; gx; gy} in + // These lines are the... + guard(verify pk_b (serialize sig_message sig_msg) msg2.sg);? + Some msg2 + // ...short version of the following if-else block: + (* if verify pk_b (serialize sig_message sig_msg) msg2.sg then Some msg2 else None + *) // Alice generates message3 val compute_message3: principal -> principal -> bytes -> bytes -> bytes -> bytes -> bytes @@ -152,5 +158,5 @@ let decode_message3 msg3_bytes bob gx gy pk_a = // Verify the signature contained in message 3 // with the gx and gy values from Bob's state. let sig_msg = SigMsg3 {bob; gx; gy} in - if verify pk_a (serialize sig_message sig_msg) msg3.sg then Some msg3 - else None + guard(verify pk_a (serialize sig_message sig_msg) msg3.sg);? + Some msg3 diff --git a/examples/iso_dh/DY.Example.DH.SecurityProperties.fst b/examples/iso_dh/DY.Example.DH.SecurityProperties.fst index 7f8cec3..0f0bf52 100644 --- a/examples/iso_dh/DY.Example.DH.SecurityProperties.fst +++ b/examples/iso_dh/DY.Example.DH.SecurityProperties.fst @@ -12,112 +12,164 @@ open DY.Example.DH.Protocol.Stateful.Proof (*** Authentication Properties ***) -val initiator_authentication: tr:trace -> i:nat -> alice:principal -> bob:principal -> gx:bytes -> gy:bytes -> k:bytes -> +val initiator_authentication: + tr:trace -> i:nat -> + alice:principal -> bob:principal -> + gx:bytes -> gy:bytes -> k:bytes -> Lemma - (requires event_triggered_at tr i alice (Initiate2 alice bob gx gy k) /\ - trace_invariant tr) - (ensures is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ + (requires + trace_invariant tr /\ + event_triggered_at tr i alice (Initiate2 alice bob gx gy k) + ) + (ensures + (exists alice_si. is_corrupt tr (principal_state_label alice alice_si)) \/ + is_corrupt tr (principal_label bob) \/ (exists y. event_triggered (prefix tr i) bob (Respond1 alice bob gx gy y) /\ k == dh y gx) ) let initiator_authentication tr i alice bob gx gy k = () -val responder_authentication: tr:trace -> i:nat -> alice:principal -> bob:principal -> gx:bytes -> gy:bytes -> k:bytes -> +val responder_authentication: + tr:trace -> i:nat -> + alice:principal -> bob:principal -> + gx:bytes -> gy:bytes -> k:bytes -> Lemma - (requires event_triggered_at tr i bob (Respond2 alice bob gx gy k) /\ - trace_invariant tr) - (ensures is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ - event_triggered (prefix tr i) alice (Initiate2 alice bob gx gy k)) + (requires + trace_invariant tr /\ + event_triggered_at tr i bob (Respond2 alice bob gx gy k) + ) + (ensures + is_corrupt tr (principal_label alice) \/ + (exists bob_si. is_corrupt tr (principal_state_label bob bob_si)) \/ + event_triggered (prefix tr i) alice (Initiate2 alice bob gx gy k) + ) let responder_authentication tr i alice bob gx gy k = () -(*** Key Secrecy Property ***) +(*** Forward Secrecy Properties ***) -val key_secrecy: tr:trace -> k:bytes -> alice:principal -> bob:principal -> +/// This lemma is needed to proof the forward secrecy +/// security properties. +/// It is never explicitly called but automatically +/// instantiated via the SMTPat. +/// In the forward secrecy security property the problem +/// is that we do not explicitly have the session id +/// available. That is the reason for using the SMTPat. +/// +/// Alternatively the SMTPat of the lemma +/// principal_flow_to_principal_state in DY.Core.Label +/// could be extended with this SMTPat to proof the +/// forward secrecy security properties. +val principal_state_corrupt_implies_principal_corrupt: + tr:trace -> prin:principal -> si:state_id -> Lemma - (requires + (requires trace_invariant tr /\ - attacker_knows tr k + is_corrupt tr (principal_state_label prin si) ) (ensures - forall si sj. get_label k `equivalent tr` join (principal_state_label alice si) (principal_state_label bob sj) ==> - (is_corrupt tr (principal_state_label alice si) \/ is_corrupt tr (principal_state_label bob sj)) + is_corrupt tr (principal_label prin) ) -let key_secrecy tr k alice bob = - attacker_only_knows_publishable_values tr k; - - (* - We can reveal the following functions from the - core DY* to prove the lemma but we don't want - to break this abstraction barrier. - + [SMTPat (trace_invariant tr); SMTPat (is_corrupt tr (principal_state_label prin si))] +let principal_state_corrupt_implies_principal_corrupt tr prin si = + reveal_opaque (`%principal_state_label) (principal_state_label); + reveal_opaque (`%principal_label) (principal_label); + reveal_opaque (`%pre_is_corrupt) (pre_is_corrupt); normalize_term_spec is_corrupt; - reveal_opaque (`%can_flow) (can_flow); - reveal_opaque (`%join) (join); *) - - // The following proof triggers the join_flow_to_public_eq lemma - // with the [SMTPat ((join x1 x2) `can_flow tr` public)] - introduce - forall si sj. get_label k `equivalent tr` join (principal_state_label alice si) (principal_state_label bob sj) ==> - (is_corrupt tr (principal_state_label alice si) \/ is_corrupt tr (principal_state_label bob sj)) - with ( - introduce - (is_corrupt tr (principal_state_label alice si) \/ is_corrupt tr (principal_state_label bob sj)) ==> - (join (principal_state_label alice si) (principal_state_label bob sj) `can_flow tr` public ) - with _. ( - // This assert triggers the SMTPat of the join_flow_to_public_eq lemma - assert(join (principal_state_label alice si) (principal_state_label bob sj) `can_flow tr` public) - ) - ) - -(*** Forward Secrecy Properties ***) + + // The following code is not needed for the proof. + // It just shows what we need to show to prove the lemma. + assert(is_corrupt tr (principal_state_label prin si)); + assert(exists prin' si'. pre_can_flow (S prin si) (S prin' si')); + assert(pre_is_corrupt tr (S prin si)); + assert(exists prin' si'. (S prin si) `pre_can_flow` (S prin' si') /\ + was_corrupt tr prin' si'); + assert(exists prin' si'. (P prin) `pre_can_flow` (S prin' si') /\ + was_corrupt tr prin' si'); + () val initiator_forward_secrecy: - tr:trace -> i:nat -> alice:principal -> bob:principal -> gx:bytes -> gy:bytes -> k:bytes -> + tr:trace -> alice:principal -> alice_si:state_id -> bob:principal -> gx:bytes -> gy:bytes -> k:bytes -> Lemma (requires trace_invariant tr /\ - event_triggered_at tr i alice (Initiate2 alice bob gx gy k) /\ + state_was_set tr alice alice_si (InitiatorSendMsg3 bob gx gy k) /\ attacker_knows tr k ) (ensures - is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ - (exists si sj. get_label k `equivalent tr` join (principal_state_label alice si) (principal_state_label bob sj) /\ - (is_corrupt tr (principal_state_label alice si) \/ is_corrupt tr (principal_state_label bob sj)) - ) + is_corrupt tr (principal_label bob) \/ is_corrupt tr (principal_state_label alice alice_si) ) -let initiator_forward_secrecy tr i alice bob gx gy k = +let initiator_forward_secrecy tr alice alice_si bob gx gy k = + assert(trace_invariant tr); + assert(attacker_knows tr k); attacker_only_knows_publishable_values tr k; + assert(is_publishable tr k); + assert(is_corrupt tr (get_label k)); + + assert(get_label k `can_flow tr` public); + assert(is_corrupt tr (get_label k)); + assert(get_label k `can_flow tr` join (principal_state_label alice alice_si) (principal_label bob)); + assert(get_label k `can_flow tr` principal_state_label alice alice_si); + assert(get_label k `can_flow tr` principal_label bob); + + assert(is_dh_shared_key tr alice bob k \/ is_corrupt tr (principal_label bob) \/ + is_corrupt tr (principal_state_label alice alice_si)); + assert(exists bob_si. get_label k `equivalent tr` + join (principal_state_label alice alice_si) (principal_state_label bob bob_si) \/ + is_corrupt tr (principal_label bob) \/ + is_corrupt tr (principal_state_label alice alice_si)); + assert(exists bob_si. join (principal_state_label alice alice_si) (principal_state_label bob bob_si) + `can_flow tr` public \/ + is_corrupt tr (principal_label bob)); + + assert(principal_state_label alice alice_si `can_flow tr` public \/ + (exists bob_si. principal_state_label bob bob_si `can_flow tr` public) \/ + is_corrupt tr (principal_label bob)); + assert(exists bob_si. is_corrupt tr (join (principal_state_label alice alice_si) (principal_state_label bob bob_si)) \/ + is_corrupt tr (principal_label bob)); - // The following code is not needed for the proof. - // It just shows what we need to show to prove the lemma. - assert(is_dh_shared_key tr alice bob k \/ is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob)); - - key_secrecy tr k alice bob; + assert(is_corrupt tr (principal_state_label alice alice_si) \/ + (exists bob_si. is_corrupt tr (principal_state_label bob bob_si)) \/ + is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob)); () val responder_forward_secrecy: - tr:trace -> i:nat -> alice:principal -> bob:principal -> gx:bytes -> gy:bytes -> k:bytes -> + tr:trace -> alice:principal -> bob:principal -> bob_si:state_id -> gx:bytes -> gy:bytes -> k:bytes -> Lemma (requires trace_invariant tr /\ - event_triggered_at tr i bob (Respond2 alice bob gx gy k) /\ + state_was_set tr bob bob_si (ResponderReceivedMsg3 alice gx gy k) /\ attacker_knows tr k ) (ensures - is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ - (exists si sj. get_label k `equivalent tr` join (principal_state_label alice si) (principal_state_label bob sj) /\ - (is_corrupt tr (principal_state_label alice si) \/ is_corrupt tr (principal_state_label bob sj)) - ) + is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_state_label bob bob_si) ) -let responder_forward_secrecy tr i alice bob gx gy k = +let responder_forward_secrecy tr alice bob bob_si gx gy k = attacker_only_knows_publishable_values tr k; // The following code is not needed for the proof. // It just shows what we need to show to prove the lemma. - assert(is_dh_shared_key tr alice bob k \/ - is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob)); - assert(event_triggered tr alice (Initiate2 alice bob gx gy k) \/ + assert(is_dh_shared_key tr alice bob k \/ is_corrupt tr (principal_label alice) \/ + is_corrupt tr (principal_state_label bob bob_si)); + + assert(exists alice_si. get_label k `equivalent tr` + join (principal_state_label alice alice_si) (principal_state_label bob bob_si) \/ + is_corrupt tr (principal_label alice) \/ + is_corrupt tr (principal_state_label bob bob_si)); + + // This assert is needed for the proof + assert(exists alice_si. join (principal_state_label alice alice_si) (principal_state_label bob bob_si) + `can_flow tr` public \/ + is_corrupt tr (principal_label alice)); + + // The following code is not needed for the proof. + // It just shows what we need to show to prove the lemma. + assert(principal_state_label bob bob_si `can_flow tr` public \/ + (exists alice_si. principal_state_label alice alice_si `can_flow tr` public) \/ + is_corrupt tr (principal_label alice)); + assert(exists alice_si. is_corrupt tr (join (principal_state_label alice alice_si) (principal_state_label bob bob_si)) \/ + is_corrupt tr (principal_label alice)); + + assert(is_corrupt tr (principal_state_label bob bob_si) \/ + (exists alice_si. is_corrupt tr (principal_state_label alice alice_si)) \/ is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob)); - - key_secrecy tr k alice bob; () From 8f93d662e52fbfca07334b47fc17ef924a5ca076 Mon Sep 17 00:00:00 2001 From: Fabian Hauck Date: Mon, 1 Jul 2024 15:52:20 +0200 Subject: [PATCH 24/29] DH example move all crypto functions to the total code; cleanup code --- CONTRIBUTING.md | 3 + examples/iso_dh/DY.Example.DH.Debug.Proof.fst | 333 +----------------- examples/iso_dh/DY.Example.DH.Debug.fst | 2 +- .../DY.Example.DH.Protocol.Stateful.Proof.fst | 129 +++---- .../DY.Example.DH.Protocol.Stateful.fst | 49 ++- .../DY.Example.DH.Protocol.Total.Proof.fst | 110 +++--- .../iso_dh/DY.Example.DH.Protocol.Total.fst | 21 +- .../DY.Example.DH.SecurityProperties.fst | 27 +- 8 files changed, 185 insertions(+), 489 deletions(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 72a7dd0..4aea25e 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -216,6 +216,9 @@ In general the `requires` is a big conjunction, each hypothesis should be on a separate line. The `ensures` often contains a `let`, a `match`, in that case extra parenthesis are needed for F\*'s parser. +Defining variables with the `let` keyword should be +replaced by inlining the statement directly into the function that +requires the variable if it does not blow up the statement too much. When the lemma is very short, it may be written on one line. diff --git a/examples/iso_dh/DY.Example.DH.Debug.Proof.fst b/examples/iso_dh/DY.Example.DH.Debug.Proof.fst index c5191a6..a39b5ab 100644 --- a/examples/iso_dh/DY.Example.DH.Debug.Proof.fst +++ b/examples/iso_dh/DY.Example.DH.Debug.Proof.fst @@ -6,7 +6,16 @@ open DY.Example.DH.Protocol.Stateful open DY.Example.DH.Protocol.Stateful.Proof open DY.Example.DH.Debug -#push-options "--fuel 0 --ifuel 0 --z3rlimit 10 --z3cliopt 'smt.qi.eager_threshold=100'" +/// This module proves that the debug function +/// fulfills the trace invariants. +/// +/// The proof works automatically because each +/// stateful proof as a SMTPat (`[SMTPat (trace_invariant tr); SMTPat (protocol_function)]`). +/// Another way to do this proof is to basically +/// duplicate the code from the debug function and +/// call all the lemmas for the stateful code manually. + +#set-options "--fuel 0 --ifuel 0 --z3rlimit 10 --z3cliopt 'smt.qi.eager_threshold=100'" val debug_proof: tr:trace -> Lemma @@ -19,325 +28,3 @@ val debug_proof: ) ) let debug_proof tr = () -#pop-options - -/// Other ways to proof the debug function -/// but I think the SMTPat way is the nicest one -(* -#push-options "--fuel 0 --ifuel 0 --z3rlimit 10 --z3cliopt 'smt.qi.eager_threshold=100'" -val debug_proof2: - tr:trace -> - Lemma - (requires - trace_invariant tr - ) - (ensures ( - let (_, tr_out) = debug () tr in - trace_invariant tr_out - ) - ) -let debug_proof2 tr = - (*** Initialize protocol run ***) - let alice = "alice" in - let bob = "bob" in - - let (alice_global_session_priv_key_id, tr) = initialize_private_keys alice tr in - let (_, tr) = generate_private_key alice alice_global_session_priv_key_id (Sign "DH.SigningKey") tr in - - let (bob_global_session_priv_key_id, tr) = initialize_private_keys bob tr in - let (_, tr) = generate_private_key bob bob_global_session_priv_key_id (Sign "DH.SigningKey") tr in - let (priv_key_bob, tr) = get_private_key bob bob_global_session_priv_key_id (Sign "DH.SigningKey") tr in - match priv_key_bob with - | None -> () - | Some priv_key_bob -> ( - let pub_key_bob = vk priv_key_bob in - let (alice_global_session_pub_key_id, tr) = initialize_pki alice tr in - let (_, tr) = install_public_key alice alice_global_session_pub_key_id (Verify "DH.SigningKey") bob pub_key_bob tr in - - let (priv_key_alice, tr) = get_private_key alice alice_global_session_priv_key_id (Sign "DH.SigningKey") tr in - assert(trace_invariant tr); - match priv_key_alice with - | None -> () - | Some priv_key_alice -> ( - let pub_key_alice = vk priv_key_alice in - let (bob_global_session_pub_key_id, tr) = initialize_pki bob tr in - let (_, tr) = install_public_key bob bob_global_session_pub_key_id (Verify "DH.SigningKey") alice pub_key_alice tr in - - let alice_global_session_ids: dh_global_sess_ids = {pki=alice_global_session_pub_key_id; private_keys=alice_global_session_priv_key_id} in - let bob_global_session_ids: dh_global_sess_ids = {pki=bob_global_session_pub_key_id; private_keys=bob_global_session_priv_key_id} in - - (*** Run the protocol ***) - prepare_msg1_proof tr alice bob; - let (alice_session_id, tr) = prepare_msg1 alice bob tr in - assert(trace_invariant tr); - - send_msg1_proof tr alice alice_session_id; - let (msg1_id, tr) = send_msg1 alice alice_session_id tr in - assert(trace_invariant tr); - - match msg1_id with - | None -> () - | Some msg1_id -> ( - prepare_msg2_proof tr alice bob msg1_id; - let (bob_session_id, tr) = prepare_msg2 alice bob msg1_id tr in - assert(trace_invariant tr); - - match bob_session_id with - | None -> () - | Some bob_session_id -> ( - send_msg2_proof tr bob_global_session_ids bob bob_session_id; - let (msg2_id, tr) = send_msg2 bob_global_session_ids bob bob_session_id tr in - assert(trace_invariant tr); - - match msg2_id with - | None -> () - | Some msg2_id -> ( - prepare_msg3_proof tr alice_global_session_ids alice bob msg2_id alice_session_id; - let (_, tr) = prepare_msg3 alice_global_session_ids alice bob msg2_id alice_session_id tr in - - send_msg3_proof tr alice_global_session_ids alice bob alice_session_id; - let (msg3_id, tr) = send_msg3 alice_global_session_ids alice bob alice_session_id tr in - assert(trace_invariant tr); - - match msg3_id with - | None -> () - | Some msg3_id -> ( - verify_msg3_proof tr bob_global_session_ids alice bob msg3_id bob_session_id; - let (_, tr) = verify_msg3 bob_global_session_ids alice bob msg3_id bob_session_id tr in - assert(trace_invariant tr); - () - ) - ) - ) - ) - ) - ) -#pop-options - - -#push-options "--fuel 0 --ifuel 0 --z3rlimit 10" -val prepare_msg1_proof_forall: - tr:trace -> - Lemma - (requires - trace_invariant tr - ) - (ensures ( - forall alice bob. - let (_, tr_out) = prepare_msg1 alice bob tr in - trace_invariant tr_out - ) - ) -let prepare_msg1_proof_forall tr = - introduce forall alice bob. trace_invariant (snd (prepare_msg1 alice bob tr)) - with ( - prepare_msg1_proof tr alice bob; - let (alice_session_id, tr) = prepare_msg1 alice bob tr in - () - ) - -val send_msg1_proof_forall: - tr:trace -> - Lemma - (requires - trace_invariant tr - ) - (ensures ( - forall alice alice_session_id. - let (_, tr_out) = send_msg1 alice alice_session_id tr in - trace_invariant tr_out - ) - ) -let send_msg1_proof_forall tr = - introduce forall alice alice_session_id. trace_invariant (snd (send_msg1 alice alice_session_id tr)) - with ( - send_msg1_proof tr alice alice_session_id; - let (msg1_id, tr) = send_msg1 alice alice_session_id tr in - () - ) - -val prepare_msg2_proof_forall: - tr:trace -> - Lemma - (requires - trace_invariant tr - ) - (ensures ( - forall alice bob msg1_id. - let (_, tr_out) = prepare_msg2 alice bob msg1_id tr in - trace_invariant tr_out - ) - ) -let prepare_msg2_proof_forall tr = - introduce forall alice bob msg1_id. trace_invariant (snd (prepare_msg2 alice bob msg1_id tr)) - with ( - prepare_msg2_proof tr alice bob msg1_id; - let (bob_session_id, tr) = prepare_msg2 alice bob msg1_id tr in - () - ) - -val send_msg2_proof_forall: - tr:trace -> - Lemma - (requires - trace_invariant tr - ) - (ensures ( - forall bob_global_session_ids bob bob_session_id. - let (_, tr_out) = send_msg2 bob_global_session_ids bob bob_session_id tr in - trace_invariant tr_out - ) - ) -let send_msg2_proof_forall tr = - introduce forall bob_global_session_ids bob bob_session_id. trace_invariant (snd (send_msg2 bob_global_session_ids bob bob_session_id tr)) - with ( - send_msg2_proof tr bob_global_session_ids bob bob_session_id; - let (msg2_id, tr) = send_msg2 bob_global_session_ids bob bob_session_id tr in - () - ) - -val prepare_msg3_proof_forall: - tr:trace -> - Lemma - (requires - trace_invariant tr - ) - (ensures ( - forall alice_global_session_ids alice bob msg2_id alice_session_id. - let (_, tr_out) = prepare_msg3 alice_global_session_ids alice bob msg2_id alice_session_id tr in - trace_invariant tr_out - ) - ) -let prepare_msg3_proof_forall tr = - introduce forall alice_global_session_ids alice bob msg2_id alice_session_id. trace_invariant (snd (prepare_msg3 alice_global_session_ids alice bob msg2_id alice_session_id tr)) - with ( - prepare_msg3_proof tr alice_global_session_ids alice bob msg2_id alice_session_id; - let (_, tr) = prepare_msg3 alice_global_session_ids alice bob msg2_id alice_session_id tr in - () - ) - -val send_msg3_proof_forall: - tr:trace -> - Lemma - (requires - trace_invariant tr - ) - (ensures ( - forall alice_global_session_ids alice bob alice_session_id. - let (_, tr_out) = send_msg3 alice_global_session_ids alice bob alice_session_id tr in - trace_invariant tr_out - ) - ) -let send_msg3_proof_forall tr = - introduce forall alice_global_session_ids alice bob alice_session_id. trace_invariant (snd (send_msg3 alice_global_session_ids alice bob alice_session_id tr)) - with ( - send_msg3_proof tr alice_global_session_ids alice bob alice_session_id; - let (msg3_id, tr) = send_msg3 alice_global_session_ids alice bob alice_session_id tr in - () - ) - -val verify_msg3_proof_forall: - tr:trace -> - Lemma - (requires - trace_invariant tr - ) - (ensures ( - forall bob_global_session_ids alice bob msg3_id bob_session_id. - let (_, tr_out) = verify_msg3 bob_global_session_ids alice bob msg3_id bob_session_id tr in - trace_invariant tr_out - ) - ) -let verify_msg3_proof_forall tr = - introduce forall bob_global_session_ids alice bob msg3_id bob_session_id. trace_invariant (snd (verify_msg3 bob_global_session_ids alice bob msg3_id bob_session_id tr)) - with ( - verify_msg3_proof tr bob_global_session_ids alice bob msg3_id bob_session_id; - let (_, tr) = verify_msg3 bob_global_session_ids alice bob msg3_id bob_session_id tr in - () - ) -#pop-options - -#push-options "--fuel 8 --ifuel 8 --z3rlimit 50 --z3cliopt 'smt.qi.eager_threshold=100'" -val debug_proof_test: - tr:trace -> - Lemma - (requires - trace_invariant tr - ) - (ensures ( - let (_, tr_out) = debug () tr in - trace_invariant tr_out - ) - ) -let debug_proof_test tr = - (*** Initialize protocol run ***) - let alice = "alice" in - let bob = "bob" in - - let (alice_global_session_priv_key_id, tr) = initialize_private_keys alice tr in - let (_, tr) = generate_private_key alice alice_global_session_priv_key_id (Sign "DH.SigningKey") tr in - - let (bob_global_session_priv_key_id, tr) = initialize_private_keys bob tr in - let (_, tr) = generate_private_key bob bob_global_session_priv_key_id (Sign "DH.SigningKey") tr in - let (priv_key_bob, tr) = get_private_key bob bob_global_session_priv_key_id (Sign "DH.SigningKey") tr in - match priv_key_bob with - | None -> () - | Some priv_key_bob -> ( - let pub_key_bob = vk priv_key_bob in - let (alice_global_session_pub_key_id, tr) = initialize_pki alice tr in - let (_, tr) = install_public_key alice alice_global_session_pub_key_id (Verify "DH.SigningKey") bob pub_key_bob tr in - - let (priv_key_alice, tr) = get_private_key alice alice_global_session_priv_key_id (Sign "DH.SigningKey") tr in - assert(trace_invariant tr); - match priv_key_alice with - | None -> () - | Some priv_key_alice -> ( - let pub_key_alice = vk priv_key_alice in - let (bob_global_session_pub_key_id, tr) = initialize_pki bob tr in - let (_, tr) = install_public_key bob bob_global_session_pub_key_id (Verify "DH.SigningKey") alice pub_key_alice tr in - - let alice_global_session_ids: dh_global_sess_ids = {pki=alice_global_session_pub_key_id; private_keys=alice_global_session_priv_key_id} in - let bob_global_session_ids: dh_global_sess_ids = {pki=bob_global_session_pub_key_id; private_keys=bob_global_session_priv_key_id} in - - (*** Run the protocol ***) - prepare_msg1_proof tr alice bob; - let (alice_session_id, tr) = prepare_msg1 alice bob tr in - assert(trace_invariant tr); - - send_msg1_proof tr alice alice_session_id; - let (msg1_id, tr) = send_msg1 alice alice_session_id tr in - assert(trace_invariant tr); - - match msg1_id with - | None -> () - | Some msg1_id -> ( - prepare_msg2_proof tr alice bob msg1_id; - let (bob_session_id, tr) = prepare_msg2 alice bob msg1_id tr in - assert(trace_invariant tr); - - match bob_session_id with - | None -> () - | Some bob_session_id -> ( - send_msg2_proof tr bob_global_session_ids bob bob_session_id; - let (msg2_id, tr) = send_msg2 bob_global_session_ids bob bob_session_id tr in - assert(trace_invariant tr); - - match msg2_id with - | None -> () - | Some msg2_id -> ( - prepare_msg3_proof tr alice_global_session_ids alice bob msg2_id alice_session_id; - let (_, tr) = prepare_msg3 alice_global_session_ids alice bob msg2_id alice_session_id tr in - - send_msg3_proof_forall tr; - // This line is needed for the proof - let (msg3_id, tr) = send_msg3 alice_global_session_ids alice bob alice_session_id tr in - assert(trace_invariant tr); - - verify_msg3_proof_forall tr; - () - ) - ) - ) - ) - ) -*) diff --git a/examples/iso_dh/DY.Example.DH.Debug.fst b/examples/iso_dh/DY.Example.DH.Debug.fst index 439af52..6338d15 100644 --- a/examples/iso_dh/DY.Example.DH.Debug.fst +++ b/examples/iso_dh/DY.Example.DH.Debug.fst @@ -48,7 +48,7 @@ let debug () : traceful (option unit) = let*? msg2_id = send_msg2 bob_global_session_ids bob bob_session_id in // Alice - prepare_msg3 alice_global_session_ids alice bob msg2_id alice_session_id;* + prepare_msg3 alice_global_session_ids alice alice_session_id bob msg2_id;* let*? msg3_id = send_msg3 alice_global_session_ids alice bob alice_session_id in // Bob diff --git a/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst b/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst index c064284..892d778 100644 --- a/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst +++ b/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst @@ -152,7 +152,7 @@ val prepare_msg1_proof: Lemma (requires trace_invariant tr) (ensures ( - let (sess_id, tr_out) = prepare_msg1 alice bob tr in + let (_, tr_out) = prepare_msg1 alice bob tr in trace_invariant tr_out )) // The SMTPat is used to automatically proof that @@ -165,18 +165,18 @@ let prepare_msg1_proof tr alice bob = () val send_msg1_proof: tr:trace -> - alice:principal -> sess_id:state_id -> + alice:principal -> alice_si:state_id -> Lemma (requires trace_invariant tr) (ensures ( - let (msg_id, tr_out) = send_msg1 alice sess_id tr in + let (msg_id, tr_out) = send_msg1 alice alice_si tr in trace_invariant tr_out )) - [SMTPat (trace_invariant tr); SMTPat (send_msg1 alice sess_id tr)] -let send_msg1_proof tr alice sess_id = - match get_state alice sess_id tr with + [SMTPat (trace_invariant tr); SMTPat (send_msg1 alice alice_si tr)] +let send_msg1_proof tr alice alice_si = + match get_state alice alice_si tr with | (Some (InitiatorSentMsg1 bob x), tr) -> ( - compute_message1_proof tr alice bob x sess_id + compute_message1_proof tr alice bob x ) | _ -> () @@ -193,27 +193,27 @@ val prepare_msg2_proof: let prepare_msg2_proof tr alice bob msg_id = match recv_msg msg_id tr with | (Some msg, tr) -> ( - decode_message1_proof tr alice bob msg + decode_message1_proof tr msg ) | (None, tr) -> () val send_msg2_proof: tr:trace -> - global_sess_id:dh_global_sess_ids -> bob:principal -> sess_id:state_id -> + global_sess_id:dh_global_sess_ids -> bob:principal -> bob_si:state_id -> Lemma (requires trace_invariant tr) (ensures ( - let (msg_id, tr_out) = send_msg2 global_sess_id bob sess_id tr in + let (msg_id, tr_out) = send_msg2 global_sess_id bob bob_si tr in trace_invariant tr_out )) - [SMTPat (trace_invariant tr); SMTPat (send_msg2 global_sess_id bob sess_id tr)] -let send_msg2_proof tr global_sess_id bob sess_id = - match get_state bob sess_id tr with + [SMTPat (trace_invariant tr); SMTPat (send_msg2 global_sess_id bob bob_si tr)] +let send_msg2_proof tr global_sess_id bob bob_si = + match get_state bob bob_si tr with | (Some (ResponderSentMsg2 alice gx gy y), tr) -> ( match get_private_key bob global_sess_id.private_keys (Sign "DH.SigningKey") tr with | (Some sk_b, tr) -> ( let (n_sig, tr) = mk_rand SigNonce (principal_label bob) 32 tr in - compute_message2_proof tr sess_id alice bob {alice; gx} y sk_b n_sig + compute_message2_proof tr alice bob gx y sk_b n_sig ) | (None, tr) -> () ) @@ -221,53 +221,54 @@ let send_msg2_proof tr global_sess_id bob sess_id = val prepare_msg3_proof: tr:trace -> - global_sess_id:dh_global_sess_ids -> alice:principal -> bob:principal -> msg_id:nat -> sess_id:state_id -> + global_sess_id:dh_global_sess_ids -> + alice:principal -> alice_si:state_id -> bob:principal -> + msg_id:nat -> Lemma (requires trace_invariant tr) (ensures ( - let (_, tr_out) = prepare_msg3 global_sess_id alice bob msg_id sess_id tr in + let (_, tr_out) = prepare_msg3 global_sess_id alice alice_si bob msg_id tr in trace_invariant tr_out )) - [SMTPat (trace_invariant tr); SMTPat (prepare_msg3 global_sess_id alice bob msg_id sess_id tr)] -let prepare_msg3_proof tr global_sess_id alice bob msg_id sess_id = - match get_state alice sess_id tr with + [SMTPat (trace_invariant tr); SMTPat (prepare_msg3 global_sess_id alice alice_si bob msg_id tr)] +let prepare_msg3_proof tr global_sess_id alice alice_si bob msg_id = + match get_state alice alice_si tr with | (Some (InitiatorSentMsg1 bob x), tr) -> ( match recv_msg msg_id tr with | (Some msg_bytes, tr) -> ( match get_public_key alice global_sess_id.pki (Verify "DH.SigningKey") bob tr with | (Some pk_b, tr) -> ( - let gx = dh_pk x in - match decode_message2 msg_bytes alice gx pk_b with - | Some msg2 -> ( - decode_message2_proof tr alice sess_id bob msg_bytes gx pk_b; - - let k = dh x msg2.gy in + match decode_and_verify_message2 msg_bytes alice x pk_b with + | Some res -> ( + decode_and_verify_message2_proof tr msg_bytes alice alice_si bob x pk_b; + + let k = dh x res.gy in - assert((exists x. gx == dh_pk x /\ k == dh x msg2.gy /\ is_secret (principal_state_label alice sess_id) tr x)); + assert((exists x. res.gx == dh_pk x /\ k == dh x res.gy /\ is_secret (principal_state_label alice alice_si) tr x)); - assert(is_publishable tr gx); - assert(is_publishable tr msg2.gy); - assert(is_knowable_by (principal_state_label alice sess_id) tr k); + assert(is_publishable tr res.gx); + assert(is_publishable tr res.gy); + assert(is_knowable_by (principal_state_label alice alice_si) tr k); assert((exists x sess_id. is_secret (principal_state_label alice sess_id) tr x /\ - gx = dh_pk x)); + res.gx = dh_pk x)); assert(get_usage k = AeadKey "DH.aead_key"); assert(exists si. is_knowable_by (principal_state_label alice si) tr k); - let alice_and_bob_not_corrupt = (~(is_corrupt tr (principal_state_label alice sess_id) \/ is_corrupt tr (principal_label bob))) in - let dh_key_and_event_respond1 = (exists y. k == dh y gx /\ is_dh_shared_key tr alice bob k /\ event_triggered tr bob (Respond1 alice bob gx msg2.gy y)) in + let alice_and_bob_not_corrupt = (~(is_corrupt tr (principal_state_label alice alice_si) \/ is_corrupt tr (principal_label bob))) in + let dh_key_and_event_respond1 = (exists y. k == dh y res.gx /\ is_dh_shared_key tr alice bob k /\ event_triggered tr bob (Respond1 alice bob res.gx res.gy y)) in introduce alice_and_bob_not_corrupt ==> dh_key_and_event_respond1 with _. ( - assert(exists y k'. k' == dh y gx /\ msg2.gy == dh_pk y /\ event_triggered tr bob (Respond1 alice bob gx msg2.gy y)); - eliminate exists y k'. k' == dh y gx /\ event_triggered tr bob (Respond1 alice bob gx msg2.gy y) + assert(exists y k'. k' == dh y res.gx /\ res.gy == dh_pk y /\ event_triggered tr bob (Respond1 alice bob res.gx res.gy y)); + eliminate exists y k'. k' == dh y res.gx /\ event_triggered tr bob (Respond1 alice bob res.gx res.gy y) returns dh_key_and_event_respond1 with _. ( - assert(event_triggered tr bob (Respond1 alice bob gx msg2.gy y)); + assert(event_triggered tr bob (Respond1 alice bob res.gx res.gy y)); - assert(dh_pk y == msg2.gy); - assert(dh_pk x = gx); + assert(dh_pk y == res.gy); + assert(dh_pk x = res.gx); dh_shared_secret_lemma x y; - assert(dh y gx == dh x msg2.gy); + assert(dh y res.gx == dh x res.gy); assert(k == k'); assert(exists si sj. get_label k `equivalent tr` join (principal_state_label alice si) (principal_state_label bob sj)); @@ -287,34 +288,37 @@ let prepare_msg3_proof tr global_sess_id alice bob msg_id sess_id = val send_msg3_proof: tr:trace -> - global_sess_id:dh_global_sess_ids -> alice:principal -> bob:principal -> sess_id:state_id -> + global_sess_id:dh_global_sess_ids -> alice:principal -> alice_si:state_id -> bob:principal -> Lemma (requires trace_invariant tr) (ensures ( - let (_, tr_out) = send_msg3 global_sess_id alice bob sess_id tr in + let (_, tr_out) = send_msg3 global_sess_id alice bob alice_si tr in trace_invariant tr_out )) - [SMTPat (trace_invariant tr); SMTPat (send_msg3 global_sess_id alice bob sess_id tr)] -let send_msg3_proof tr global_sess_id alice bob sess_id = - match get_state alice sess_id tr with - | (Some (InitiatorSendMsg3 bob gx gy k), tr) -> ( - match get_private_key alice global_sess_id.private_keys (Sign "DH.SigningKey") tr with - | (Some sk_a, tr) -> ( - let (n_sig, tr) = mk_rand SigNonce (principal_label alice) 32 tr in + [SMTPat (trace_invariant tr); SMTPat (send_msg3 global_sess_id alice bob alice_si tr)] +let send_msg3_proof tr global_sess_id alice alice_si bob = + match get_state alice alice_si tr with + | (Some (InitiatorSendMsg3 bob gx gy k), tr') -> ( + match get_private_key alice global_sess_id.private_keys (Sign "DH.SigningKey") tr' with + | (Some sk_a, tr') -> ( + let (n_sig, tr') = mk_rand SigNonce (principal_label alice) 32 tr' in // The following code is not needed for the proof. // It just shows what we need to show to prove the lemma. assert(event_triggered tr alice (Initiate2 alice bob gx gy k)); assert(exists x. event_triggered tr alice (Initiate2 alice bob gx gy (dh x gy)) /\ gx = dh_pk x); - compute_message3_proof tr alice bob gx gy sk_a n_sig; - () + eliminate exists x. event_triggered tr alice (Initiate2 alice bob gx gy (dh x gy)) /\ gx = dh_pk x + returns trace_invariant (snd (send_msg3 global_sess_id alice bob alice_si tr)) + with _. ( + compute_message3_proof tr' alice bob gx gy x sk_a n_sig + ) ) - | (None, tr) -> () + | (None, tr') -> () ) | _ -> () -#set-options "--z3rlimit 50" +#push-options "--z3rlimit 50" val verify_msg3_proof: tr:trace -> global_sess_id:dh_global_sess_ids -> alice:principal -> bob:principal -> msg_id:nat -> sess_id:state_id -> @@ -332,26 +336,24 @@ let verify_msg3_proof tr global_sess_id alice bob msg_id sess_id = | (Some msg_bytes, tr) -> ( match get_public_key bob global_sess_id.pki (Verify "DH.SigningKey") alice tr with | (Some pk_a, tr) -> ( - decode_message3_proof tr alice bob gx gy msg_bytes pk_a; + decode_and_verify_message3_proof tr msg_bytes alice bob sess_id gx y pk_a; - match decode_message3 msg_bytes bob gx gy pk_a with - | Some msg3 -> ( - - let k = dh y gx in - - assert(exists y. gy == dh_pk y /\ k == dh y gx /\ is_secret (principal_state_label bob sess_id) tr y); + match decode_and_verify_message3 msg_bytes bob gx gy y pk_a with + | Some res -> ( + assert(exists y. gy == dh_pk y /\ res.k == dh y gx /\ is_secret (principal_state_label bob sess_id) tr y); assert(event_triggered tr bob (Respond1 alice bob gx gy y)); // The decode_message3_proof gives us that there exists a k' such that // the event Initiate2 has been triggered or alice is corrupt. // On a high level we need to show now that this event was triggered // for our concrete k. - assert(exists x. gx == dh_pk x /\ event_triggered tr alice (Initiate2 alice bob gx gy (dh x gy)) \/ is_corrupt tr (principal_label alice)); + assert(exists x. gx == dh_pk x /\ event_triggered tr alice (Initiate2 alice bob gx gy (dh x gy)) \/ + is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_state_label bob sess_id)); // Proof strategy: We want to work without the corruption case // so we introduce this implication. let alice_and_bob_not_corrupt = (~(is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_state_label bob sess_id))) in - let event_initiate2 = event_triggered tr alice (Initiate2 alice bob gx gy k) in + let event_initiate2 = event_triggered tr alice (Initiate2 alice bob gx gy res.k) in introduce alice_and_bob_not_corrupt ==> event_initiate2 with _. ( // We can now assert that there exists a x such that the event Initiate2 has been triggered @@ -368,10 +370,10 @@ let verify_msg3_proof tr global_sess_id alice bob msg_id sess_id = ); assert(is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_state_label bob sess_id) \/ - (exists si sj. get_label k `equivalent tr` join (principal_state_label alice si) (principal_state_label bob sj))); - assert(get_usage k == AeadKey "DH.aead_key"); + (exists si. get_label res.k `equivalent tr` join (principal_state_label alice si) (principal_state_label bob sess_id))); + assert(get_usage res.k == AeadKey "DH.aead_key"); assert(is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_state_label bob sess_id) \/ - (is_dh_shared_key tr alice bob k /\ event_triggered tr alice (Initiate2 alice bob gx gy k))); + (is_dh_shared_key tr alice bob res.k /\ event_triggered tr alice (Initiate2 alice bob gx gy res.k))); () ) | None -> () @@ -381,3 +383,4 @@ let verify_msg3_proof tr global_sess_id alice bob msg_id sess_id = | (None, tr) -> () ) | (_, tr) -> () +#pop-options diff --git a/examples/iso_dh/DY.Example.DH.Protocol.Stateful.fst b/examples/iso_dh/DY.Example.DH.Protocol.Stateful.fst index 8174749..1dc5214 100644 --- a/examples/iso_dh/DY.Example.DH.Protocol.Stateful.fst +++ b/examples/iso_dh/DY.Example.DH.Protocol.Stateful.fst @@ -58,16 +58,16 @@ type dh_global_sess_ids = { // a message over the network. val prepare_msg1: principal -> principal -> traceful state_id let prepare_msg1 alice bob = - let* session_id = new_session_id alice in - let* x = mk_rand (DhKey "DH.dh_key") (principal_state_label alice session_id) 32 in + let* alice_si = new_session_id alice in + let* x = mk_rand (DhKey "DH.dh_key") (principal_state_label alice alice_si) 32 in trigger_event alice (Initiate1 alice bob x);* - set_state alice session_id (InitiatorSentMsg1 bob x <: dh_session);* - return session_id + set_state alice alice_si (InitiatorSentMsg1 bob x <: dh_session);* + return alice_si // Alice sends message 1 val send_msg1: principal -> state_id -> traceful (option nat) -let send_msg1 alice session_id = - let*? session_state: dh_session = get_state alice session_id in +let send_msg1 alice alice_si = + let*? session_state: dh_session = get_state alice alice_si in match session_state with | InitiatorSentMsg1 bob x -> ( let msg = compute_message1 alice x in @@ -81,17 +81,16 @@ val prepare_msg2: principal -> principal -> nat -> traceful (option state_id) let prepare_msg2 alice bob msg_id = let*? msg = recv_msg msg_id in let*? msg1: message1 = return (decode_message1 msg) in - let* session_id = new_session_id bob in - let* y = mk_rand (DhKey "DH.dh_key") (principal_state_label bob session_id) 32 in - let gy = dh_pk y in - trigger_event bob (Respond1 alice bob msg1.gx gy y);* - set_state bob session_id (ResponderSentMsg2 alice msg1.gx gy y <: dh_session);* - return (Some session_id) + let* bob_si = new_session_id bob in + let* y = mk_rand (DhKey "DH.dh_key") (principal_state_label bob bob_si) 32 in + trigger_event bob (Respond1 alice bob msg1.gx (dh_pk y) y);* + set_state bob bob_si (ResponderSentMsg2 alice msg1.gx (dh_pk y) y <: dh_session);* + return (Some bob_si) // Bob sends message 2 val send_msg2: dh_global_sess_ids -> principal -> state_id -> traceful (option nat) -let send_msg2 global_sess_id bob session_id = - let*? session_state: dh_session = get_state bob session_id in +let send_msg2 global_sess_id bob bob_si = + let*? session_state: dh_session = get_state bob bob_si in match session_state with | ResponderSentMsg2 alice gx gy y -> ( let*? sk_b = get_private_key bob global_sess_id.private_keys (Sign "DH.SigningKey") in @@ -101,21 +100,20 @@ let send_msg2 global_sess_id bob session_id = return (Some msg_id) ) | _ -> return None + // Alice prepares message 3 // // This function has to verify the signature from message 2 -val prepare_msg3: dh_global_sess_ids -> principal -> principal -> nat -> state_id -> traceful (option unit) -let prepare_msg3 global_sess_id alice bob msg_id session_id = - let*? session_state: dh_session = get_state alice session_id in +val prepare_msg3: dh_global_sess_ids -> principal -> state_id -> principal -> nat -> traceful (option unit) +let prepare_msg3 global_sess_id alice alice_si bob msg_id = + let*? session_state: dh_session = get_state alice alice_si in match session_state with | InitiatorSentMsg1 bob x -> ( let*? pk_b = get_public_key alice global_sess_id.pki (Verify "DH.SigningKey") bob in let*? msg = recv_msg msg_id in - let gx = dh_pk x in - let*? msg2: message2 = return (decode_message2 msg alice gx pk_b) in - let k = dh x msg2.gy in - trigger_event alice (Initiate2 alice bob gx msg2.gy k);* - set_state alice session_id (InitiatorSendMsg3 bob gx msg2.gy k <: dh_session);* + let*? res:verify_msg2_result = return (decode_and_verify_message2 msg alice x pk_b) in + trigger_event alice (Initiate2 alice bob res.gx res.gy res.k);* + set_state alice alice_si (InitiatorSendMsg3 bob res.gx res.gy res.k <: dh_session);* return (Some ()) ) | _ -> return None @@ -142,10 +140,9 @@ let verify_msg3 global_sess_id alice bob msg_id session_id = | ResponderSentMsg2 alice gx gy y -> ( let*? pk_a = get_public_key bob global_sess_id.pki (Verify "DH.SigningKey") alice in let*? msg = recv_msg msg_id in - let*? msg3: message3 = return (decode_message3 msg bob gx gy pk_a) in - let k = dh y gx in - trigger_event bob (Respond2 alice bob gx gy k);* - set_state bob session_id (ResponderReceivedMsg3 alice gx gy k <: dh_session);* + let*? res:verify_msg3_result = return (decode_and_verify_message3 msg bob gx gy y pk_a) in + trigger_event bob (Respond2 alice bob gx gy res.k);* + set_state bob session_id (ResponderReceivedMsg3 alice gx gy res.k <: dh_session);* return (Some ()) ) | _ -> return None diff --git a/examples/iso_dh/DY.Example.DH.Protocol.Total.Proof.fst b/examples/iso_dh/DY.Example.DH.Protocol.Total.Proof.fst index 076fea5..ef29208 100644 --- a/examples/iso_dh/DY.Example.DH.Protocol.Total.Proof.fst +++ b/examples/iso_dh/DY.Example.DH.Protocol.Total.Proof.fst @@ -59,17 +59,17 @@ instance dh_crypto_invs: crypto_invariants = { val compute_message1_proof: tr:trace -> - alice:principal -> bob:principal -> x:bytes -> si:state_id -> + alice:principal -> bob:principal -> x:bytes -> Lemma (requires event_triggered tr alice (Initiate1 alice bob x) /\ - is_secret (principal_state_label alice si) tr x /\ + bytes_invariant tr x /\ DhKey? (get_usage x) ) (ensures is_publishable tr (compute_message1 alice x) ) -let compute_message1_proof tr alice bob x si = +let compute_message1_proof tr alice bob x = let gx = dh_pk x in assert(is_publishable tr gx); let msg = Msg1 {alice; gx} in @@ -89,7 +89,6 @@ let compute_message1_proof tr alice bob x si = val decode_message1_proof: tr:trace -> - alice:principal -> bob:principal -> msg_bytes:bytes -> Lemma (requires is_publishable tr msg_bytes) @@ -100,7 +99,7 @@ val decode_message1_proof: ) | None -> True )) -let decode_message1_proof tr alice bob msg_bytes = +let decode_message1_proof tr msg_bytes = match decode_message1 msg_bytes with | Some msg1 -> ( // This lemma @@ -118,33 +117,28 @@ let decode_message1_proof tr alice bob msg_bytes = | None -> () val compute_message2_proof: - tr:trace -> si:state_id -> + tr:trace -> alice:principal -> bob:principal -> - msg1:message1 -> y:bytes -> + gx:bytes -> y:bytes -> sk_b:bytes -> n_sig:bytes -> Lemma - (requires ( - let gy = dh_pk y in - event_triggered tr bob (Respond1 alice bob msg1.gx gy y) /\ - is_publishable tr msg1.gx /\ is_publishable tr gy /\ - gy == dh_pk y /\ - is_secret (principal_state_label bob si) tr y /\ + (requires + event_triggered tr bob (Respond1 alice bob gx (dh_pk y) y) /\ + is_publishable tr gx /\ + bytes_invariant tr y /\ is_signature_key "DH.SigningKey" (principal_label bob) tr sk_b /\ is_secret (principal_label bob) tr n_sig /\ SigNonce? (get_usage n_sig) - ) ) - (ensures ( - let gy = dh_pk y in - is_publishable tr (compute_message2 alice bob msg1.gx gy sk_b n_sig) - ) + (ensures + is_publishable tr (compute_message2 alice bob gx (dh_pk y) sk_b n_sig) ) -let compute_message2_proof tr si alice bob msg1 y sk_b n_sig = +let compute_message2_proof tr alice bob gx y sk_b n_sig = // Proof that the SigMsg2 is publishable // From the precondition we know that // msg1.gx and gy are publishable. let gy = dh_pk y in - let sig_msg = SigMsg2 {alice; gx=msg1.gx; gy} in + let sig_msg = SigMsg2 {alice; gx; gy} in serialize_wf_lemma sig_message (is_publishable tr) sig_msg; let sig_msg_bytes = serialize sig_message sig_msg in @@ -164,66 +158,72 @@ let compute_message2_proof tr si alice bob msg1 y sk_b n_sig = serialize_wf_lemma message (is_publishable tr) msg; // This proves the post-condition - assert(is_publishable tr (compute_message2 alice bob msg1.gx gy sk_b n_sig)); + assert(is_publishable tr (compute_message2 alice bob gx gy sk_b n_sig)); () -val decode_message2_proof: +#push-options "--ifuel 1 --z3rlimit 10" +val decode_and_verify_message2_proof: tr:trace -> + msg_bytes:bytes -> alice:principal -> alice_si:state_id -> bob:principal -> - msg_bytes:bytes -> gx:bytes -> pk_b:bytes -> + x:bytes -> pk_b:bytes -> Lemma (requires is_publishable tr msg_bytes /\ - is_publishable tr gx /\ + is_secret (principal_state_label alice alice_si) tr x /\ is_verification_key "DH.SigningKey" (principal_label bob) tr pk_b ) (ensures ( - match decode_message2 msg_bytes alice gx pk_b with - | Some msg2 -> ( - let sig_msg = SigMsg2 {alice; gx; gy=msg2.gy} in - is_publishable tr msg2.gy /\ - is_publishable tr msg2.sg /\ + match decode_and_verify_message2 msg_bytes alice x pk_b with + | Some res -> ( + let sig_msg = SigMsg2 {alice; gx=(dh_pk x); gy=res.gy} in + is_publishable tr res.gy /\ + is_publishable tr res.sg /\ (is_corrupt tr (principal_state_label alice alice_si) \/ is_corrupt tr (principal_label bob) \/ - (exists y. event_triggered tr bob (Respond1 alice bob gx msg2.gy y))) + (exists y. event_triggered tr bob (Respond1 alice bob (dh_pk x) res.gy y))) ) | None -> True )) -let decode_message2_proof tr alice alice_si bob msg_bytes gx pk_b = - match decode_message2 msg_bytes alice gx pk_b with - | Some msg2 -> ( +let decode_and_verify_message2_proof tr msg_bytes alice alice_si bob x pk_b = + match decode_and_verify_message2 msg_bytes alice x pk_b with + | Some res -> ( parse_wf_lemma message (is_publishable tr) msg_bytes; - serialize_wf_lemma sig_message (bytes_invariant tr) (SigMsg2 {alice; gx; gy = msg2.gy}); + let gx = dh_pk x in + let gy = res.gy in + serialize_wf_lemma sig_message (bytes_invariant tr) (SigMsg2 {alice; gx; gy}); // The following code is not needed for the proof. // It just shows what we need to show to prove the lemma. - assert(is_publishable tr msg2.sg); - assert(is_publishable tr msg2.gy); + assert(is_publishable tr res.sg); + assert(is_publishable tr res.gy); assert(is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob) \/ - (exists y. msg2.gy == dh_pk y /\ event_triggered tr bob (Respond1 alice bob gx msg2.gy y)) + (exists y. res.gy == dh_pk y /\ event_triggered tr bob (Respond1 alice bob gx gy y)) ); () ) | None -> () +#pop-options val compute_message3_proof: tr:trace -> alice:principal -> bob:principal -> - gx:bytes -> gy:bytes -> + gx:bytes -> gy:bytes -> x:bytes -> sk_a:bytes -> n_sig:bytes -> Lemma (requires - (exists x. event_triggered tr alice (Initiate2 alice bob gx gy (dh x gy)) /\ gx = dh_pk x) /\ + event_triggered tr alice (Initiate2 alice bob (dh_pk x) gy (dh x gy)) /\ is_publishable tr gx /\ is_publishable tr gy /\ + gx = dh_pk x /\ is_signature_key "DH.SigningKey" (principal_label alice) tr sk_a /\ is_secret (principal_label alice) tr n_sig /\ SigNonce? (get_usage n_sig) ) (ensures - is_publishable tr (compute_message3 alice bob gx gy sk_a n_sig) + is_publishable tr (compute_message3 alice bob (dh_pk x) gy sk_a n_sig) ) -let compute_message3_proof tr alice bob gx gy sk_a n_sig = +let compute_message3_proof tr alice bob gx gy x sk_a n_sig = let sig_msg = SigMsg3 {bob; gx; gy} in serialize_wf_lemma sig_message (is_publishable tr) sig_msg; @@ -246,31 +246,37 @@ let compute_message3_proof tr alice bob gx gy sk_a n_sig = assert(is_publishable tr (serialize message msg)); () -val decode_message3_proof: - tr:trace -> alice:principal -> bob:principal -> - gx:bytes -> gy:bytes -> msg_bytes:bytes -> pk_a:bytes -> +#push-options "--ifuel 1 --z3rlimit 10" +val decode_and_verify_message3_proof: + tr:trace -> + msg_bytes:bytes -> + alice:principal -> bob:principal -> bob_si:state_id -> + gx:bytes -> y:bytes -> pk_a:bytes -> Lemma (requires is_publishable tr msg_bytes /\ is_publishable tr gx /\ - is_publishable tr gy /\ + is_secret (principal_state_label bob bob_si) tr y /\ is_verification_key "DH.SigningKey" (principal_label alice) tr pk_a ) (ensures ( - match decode_message3 msg_bytes bob gx gy pk_a with - | Some msg3 -> ( + let gy = dh_pk y in + match decode_and_verify_message3 msg_bytes bob gx gy y pk_a with + | Some res -> ( let sig_msg = SigMsg3 {bob; gx; gy} in - is_publishable tr msg3.sg /\ - (is_corrupt tr (principal_label alice) \/ + is_publishable tr res.sg /\ + (is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_state_label bob bob_si) \/ (exists x. gx == dh_pk x /\ event_triggered tr alice (Initiate2 alice bob gx gy (dh x gy)))) ) | None -> True )) -let decode_message3_proof tr alice bob gx gy msg_bytes pk_a = - match decode_message3 msg_bytes bob gx gy pk_a with - | Some msg3 -> ( +let decode_and_verify_message3_proof tr msg_bytes alice bob bob_si gx y pk_a = + let gy = dh_pk y in + match decode_and_verify_message3 msg_bytes bob gx gy y pk_a with + | Some res -> ( parse_wf_lemma message (is_publishable tr) msg_bytes; serialize_wf_lemma sig_message (is_publishable tr) (SigMsg3 {bob; gx; gy}); () ) | None -> () +#pop-options diff --git a/examples/iso_dh/DY.Example.DH.Protocol.Total.fst b/examples/iso_dh/DY.Example.DH.Protocol.Total.fst index 285f543..00d8b0f 100644 --- a/examples/iso_dh/DY.Example.DH.Protocol.Total.fst +++ b/examples/iso_dh/DY.Example.DH.Protocol.Total.fst @@ -122,22 +122,25 @@ let compute_message2 alice bob gx gy sk_b n_sig = serialize message msg // Alice parses message 2 -val decode_message2: bytes -> principal -> bytes -> bytes -> option message2 -let decode_message2 msg2_bytes alice gx pk_b = +type verify_msg2_result = {sg:bytes; gy:bytes; gx:bytes; k:bytes} +val decode_and_verify_message2: bytes -> principal -> bytes -> bytes -> option verify_msg2_result +let decode_and_verify_message2 msg2_bytes alice x pk_b = let? msg2_parsed = parse message msg2_bytes in guard (Msg2? msg2_parsed);? let msg2 = Msg2?.msg msg2_parsed in // Verify the signature contained in the message 2 // with the gy value from the message and the gx // value from Alice's state. + let gx = dh_pk x in let gy = msg2.gy in let sig_msg = SigMsg2 {alice; gx; gy} in // These lines are the... guard(verify pk_b (serialize sig_message sig_msg) msg2.sg);? - Some msg2 + let k = dh x gy in + Some {sg=msg2.sg; gy; gx; k} // ...short version of the following if-else block: (* - if verify pk_b (serialize sig_message sig_msg) msg2.sg then Some msg2 + if verify pk_b (serialize sig_message sig_msg) msg2.sg then Some {msg2; gx; k} else None *) @@ -150,13 +153,15 @@ let compute_message3 alice bob gx gy sk_a n_sig = serialize message msg // Bob parses message3 -val decode_message3: bytes -> principal -> bytes -> bytes -> bytes -> option message3 -let decode_message3 msg3_bytes bob gx gy pk_a = +type verify_msg3_result = {sg:bytes; k:bytes} +val decode_and_verify_message3: bytes -> principal -> bytes -> bytes -> bytes -> bytes -> option verify_msg3_result +let decode_and_verify_message3 msg3_bytes bob gx gy y pk_a = let? msg3_parsed = parse message msg3_bytes in guard (Msg3? msg3_parsed);? - let msg3 = Msg3?.msg msg3_parsed in + let msg3:message3 = Msg3?.msg msg3_parsed in // Verify the signature contained in message 3 // with the gx and gy values from Bob's state. let sig_msg = SigMsg3 {bob; gx; gy} in guard(verify pk_a (serialize sig_message sig_msg) msg3.sg);? - Some msg3 + let k = dh y gx in + Some {sg=msg3.sg; k} diff --git a/examples/iso_dh/DY.Example.DH.SecurityProperties.fst b/examples/iso_dh/DY.Example.DH.SecurityProperties.fst index 0f0bf52..a805426 100644 --- a/examples/iso_dh/DY.Example.DH.SecurityProperties.fst +++ b/examples/iso_dh/DY.Example.DH.SecurityProperties.fst @@ -71,20 +71,10 @@ val principal_state_corrupt_implies_principal_corrupt: ) [SMTPat (trace_invariant tr); SMTPat (is_corrupt tr (principal_state_label prin si))] let principal_state_corrupt_implies_principal_corrupt tr prin si = - reveal_opaque (`%principal_state_label) (principal_state_label); - reveal_opaque (`%principal_label) (principal_label); - reveal_opaque (`%pre_is_corrupt) (pre_is_corrupt); - normalize_term_spec is_corrupt; - - // The following code is not needed for the proof. - // It just shows what we need to show to prove the lemma. - assert(is_corrupt tr (principal_state_label prin si)); - assert(exists prin' si'. pre_can_flow (S prin si) (S prin' si')); - assert(pre_is_corrupt tr (S prin si)); - assert(exists prin' si'. (S prin si) `pre_can_flow` (S prin' si') /\ - was_corrupt tr prin' si'); - assert(exists prin' si'. (P prin) `pre_can_flow` (S prin' si') /\ - was_corrupt tr prin' si'); + // Triggers principal_flow_to_principal_state + assert(principal_label prin `can_flow tr` principal_state_label prin si); + // Triggers flow_to_public_eq + assert(principal_label prin `can_flow tr` public); () val initiator_forward_secrecy: @@ -99,9 +89,10 @@ val initiator_forward_secrecy: is_corrupt tr (principal_label bob) \/ is_corrupt tr (principal_state_label alice alice_si) ) let initiator_forward_secrecy tr alice alice_si bob gx gy k = - assert(trace_invariant tr); - assert(attacker_knows tr k); attacker_only_knows_publishable_values tr k; + + // The following code is not needed for the proof. + // It just shows what we need to show to prove the lemma. assert(is_publishable tr k); assert(is_corrupt tr (get_label k)); @@ -117,10 +108,14 @@ let initiator_forward_secrecy tr alice alice_si bob gx gy k = join (principal_state_label alice alice_si) (principal_state_label bob bob_si) \/ is_corrupt tr (principal_label bob) \/ is_corrupt tr (principal_state_label alice alice_si)); + + // This assert is needed for the proof assert(exists bob_si. join (principal_state_label alice alice_si) (principal_state_label bob bob_si) `can_flow tr` public \/ is_corrupt tr (principal_label bob)); + // The following code is not needed for the proof. + // It just shows what we need to show to prove the lemma. assert(principal_state_label alice alice_si `can_flow tr` public \/ (exists bob_si. principal_state_label bob bob_si `can_flow tr` public) \/ is_corrupt tr (principal_label bob)); From e78a4f2d6e9345d93905fa4e825e97c66fc1324a Mon Sep 17 00:00:00 2001 From: Fabian Hauck Date: Tue, 2 Jul 2024 17:04:04 +0200 Subject: [PATCH 25/29] =?UTF-8?q?DH=20example=20feedback=20Th=C3=A9ophile?= =?UTF-8?q?=20and=20code=20cleanup?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../DY.Example.DH.Protocol.Stateful.Proof.fst | 24 ++++++------ .../DY.Example.DH.Protocol.Stateful.fst | 10 ++--- .../DY.Example.DH.Protocol.Total.Proof.fst | 39 +++++++++---------- .../iso_dh/DY.Example.DH.Protocol.Total.fst | 15 ++++--- 4 files changed, 44 insertions(+), 44 deletions(-) diff --git a/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst b/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst index 892d778..2778bb4 100644 --- a/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst +++ b/examples/iso_dh/DY.Example.DH.Protocol.Stateful.Proof.fst @@ -321,26 +321,26 @@ let send_msg3_proof tr global_sess_id alice alice_si bob = #push-options "--z3rlimit 50" val verify_msg3_proof: tr:trace -> - global_sess_id:dh_global_sess_ids -> alice:principal -> bob:principal -> msg_id:nat -> sess_id:state_id -> + global_sess_id:dh_global_sess_ids -> alice:principal -> bob:principal -> msg_id:nat -> bob_si:state_id -> Lemma (requires trace_invariant tr) (ensures ( - let (_, tr_out) = verify_msg3 global_sess_id alice bob msg_id sess_id tr in + let (_, tr_out) = verify_msg3 global_sess_id alice bob msg_id bob_si tr in trace_invariant tr_out )) - [SMTPat (trace_invariant tr); SMTPat (verify_msg3 global_sess_id alice bob msg_id sess_id tr)] -let verify_msg3_proof tr global_sess_id alice bob msg_id sess_id = - match get_state bob sess_id tr with + [SMTPat (trace_invariant tr); SMTPat (verify_msg3 global_sess_id alice bob msg_id bob_si tr)] +let verify_msg3_proof tr global_sess_id alice bob msg_id bob_si = + match get_state bob bob_si tr with | (Some (ResponderSentMsg2 alice gx gy y), tr) -> ( match recv_msg msg_id tr with | (Some msg_bytes, tr) -> ( match get_public_key bob global_sess_id.pki (Verify "DH.SigningKey") alice tr with | (Some pk_a, tr) -> ( - decode_and_verify_message3_proof tr msg_bytes alice bob sess_id gx y pk_a; + decode_and_verify_message3_proof tr msg_bytes alice bob bob_si gx y pk_a; match decode_and_verify_message3 msg_bytes bob gx gy y pk_a with | Some res -> ( - assert(exists y. gy == dh_pk y /\ res.k == dh y gx /\ is_secret (principal_state_label bob sess_id) tr y); + assert(exists y. gy == dh_pk y /\ res.k == dh y gx /\ is_secret (principal_state_label bob bob_si) tr y); assert(event_triggered tr bob (Respond1 alice bob gx gy y)); // The decode_message3_proof gives us that there exists a k' such that @@ -348,11 +348,11 @@ let verify_msg3_proof tr global_sess_id alice bob msg_id sess_id = // On a high level we need to show now that this event was triggered // for our concrete k. assert(exists x. gx == dh_pk x /\ event_triggered tr alice (Initiate2 alice bob gx gy (dh x gy)) \/ - is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_state_label bob sess_id)); + is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_state_label bob bob_si)); // Proof strategy: We want to work without the corruption case // so we introduce this implication. - let alice_and_bob_not_corrupt = (~(is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_state_label bob sess_id))) in + let alice_and_bob_not_corrupt = (~(is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_state_label bob bob_si))) in let event_initiate2 = event_triggered tr alice (Initiate2 alice bob gx gy res.k) in introduce alice_and_bob_not_corrupt ==> event_initiate2 with _. ( @@ -369,10 +369,10 @@ let verify_msg3_proof tr global_sess_id alice bob msg_id sess_id = ) ); - assert(is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_state_label bob sess_id) \/ - (exists si. get_label res.k `equivalent tr` join (principal_state_label alice si) (principal_state_label bob sess_id))); + assert(is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_state_label bob bob_si) \/ + (exists si. get_label res.k `equivalent tr` join (principal_state_label alice si) (principal_state_label bob bob_si))); assert(get_usage res.k == AeadKey "DH.aead_key"); - assert(is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_state_label bob sess_id) \/ + assert(is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_state_label bob bob_si) \/ (is_dh_shared_key tr alice bob res.k /\ event_triggered tr alice (Initiate2 alice bob gx gy res.k))); () ) diff --git a/examples/iso_dh/DY.Example.DH.Protocol.Stateful.fst b/examples/iso_dh/DY.Example.DH.Protocol.Stateful.fst index 1dc5214..95f1c60 100644 --- a/examples/iso_dh/DY.Example.DH.Protocol.Stateful.fst +++ b/examples/iso_dh/DY.Example.DH.Protocol.Stateful.fst @@ -120,8 +120,8 @@ let prepare_msg3 global_sess_id alice alice_si bob msg_id = // Alice send message 3 val send_msg3: dh_global_sess_ids -> principal -> principal -> state_id -> traceful (option nat) -let send_msg3 global_sess_id alice bob session_id = - let*? session_state: dh_session = get_state alice session_id in +let send_msg3 global_sess_id alice bob alice_si = + let*? session_state: dh_session = get_state alice alice_si in match session_state with | InitiatorSendMsg3 bob gx gy x -> ( let*? sk_a = get_private_key alice global_sess_id.private_keys (Sign "DH.SigningKey") in @@ -134,15 +134,15 @@ let send_msg3 global_sess_id alice bob session_id = // Bob verifies message 3 val verify_msg3: dh_global_sess_ids -> principal -> principal -> nat -> state_id -> traceful (option unit) -let verify_msg3 global_sess_id alice bob msg_id session_id = - let*? session_state: dh_session = get_state bob session_id in +let verify_msg3 global_sess_id alice bob msg_id bob_si = + let*? session_state: dh_session = get_state bob bob_si in match session_state with | ResponderSentMsg2 alice gx gy y -> ( let*? pk_a = get_public_key bob global_sess_id.pki (Verify "DH.SigningKey") alice in let*? msg = recv_msg msg_id in let*? res:verify_msg3_result = return (decode_and_verify_message3 msg bob gx gy y pk_a) in trigger_event bob (Respond2 alice bob gx gy res.k);* - set_state bob session_id (ResponderReceivedMsg3 alice gx gy res.k <: dh_session);* + set_state bob bob_si (ResponderReceivedMsg3 alice gx gy res.k <: dh_session);* return (Some ()) ) | _ -> return None diff --git a/examples/iso_dh/DY.Example.DH.Protocol.Total.Proof.fst b/examples/iso_dh/DY.Example.DH.Protocol.Total.Proof.fst index ef29208..9427fb1 100644 --- a/examples/iso_dh/DY.Example.DH.Protocol.Total.Proof.fst +++ b/examples/iso_dh/DY.Example.DH.Protocol.Total.Proof.fst @@ -89,24 +89,24 @@ let compute_message1_proof tr alice bob x = val decode_message1_proof: tr:trace -> - msg_bytes:bytes -> + msg1_bytes:bytes -> Lemma - (requires is_publishable tr msg_bytes) + (requires is_publishable tr msg1_bytes) (ensures ( - match decode_message1 msg_bytes with + match decode_message1 msg1_bytes with | Some msg1 -> ( is_publishable tr msg1.gx ) | None -> True )) -let decode_message1_proof tr msg_bytes = - match decode_message1 msg_bytes with +let decode_message1_proof tr msg1_bytes = + match decode_message1 msg1_bytes with | Some msg1 -> ( // This lemma // - requires that msg_bytes is publishable // - ensures that `msg1.gx` is publishable // (`msg1` being the result of parsing `msg_bytes` to the type `message1`) - parse_wf_lemma message (is_publishable tr) msg_bytes; + parse_wf_lemma message (is_publishable tr) msg1_bytes; // The following code is not needed for the proof. // It just shows what we need to show to prove the lemma. @@ -164,37 +164,35 @@ let compute_message2_proof tr alice bob gx y sk_b n_sig = #push-options "--ifuel 1 --z3rlimit 10" val decode_and_verify_message2_proof: tr:trace -> - msg_bytes:bytes -> + msg2_bytes:bytes -> alice:principal -> alice_si:state_id -> bob:principal -> x:bytes -> pk_b:bytes -> Lemma (requires - is_publishable tr msg_bytes /\ + is_publishable tr msg2_bytes /\ is_secret (principal_state_label alice alice_si) tr x /\ is_verification_key "DH.SigningKey" (principal_label bob) tr pk_b ) (ensures ( - match decode_and_verify_message2 msg_bytes alice x pk_b with + match decode_and_verify_message2 msg2_bytes alice x pk_b with | Some res -> ( let sig_msg = SigMsg2 {alice; gx=(dh_pk x); gy=res.gy} in is_publishable tr res.gy /\ - is_publishable tr res.sg /\ (is_corrupt tr (principal_state_label alice alice_si) \/ is_corrupt tr (principal_label bob) \/ (exists y. event_triggered tr bob (Respond1 alice bob (dh_pk x) res.gy y))) ) | None -> True )) -let decode_and_verify_message2_proof tr msg_bytes alice alice_si bob x pk_b = - match decode_and_verify_message2 msg_bytes alice x pk_b with +let decode_and_verify_message2_proof tr msg2_bytes alice alice_si bob x pk_b = + match decode_and_verify_message2 msg2_bytes alice x pk_b with | Some res -> ( - parse_wf_lemma message (is_publishable tr) msg_bytes; + parse_wf_lemma message (is_publishable tr) msg2_bytes; let gx = dh_pk x in let gy = res.gy in serialize_wf_lemma sig_message (bytes_invariant tr) (SigMsg2 {alice; gx; gy}); // The following code is not needed for the proof. // It just shows what we need to show to prove the lemma. - assert(is_publishable tr res.sg); assert(is_publishable tr res.gy); assert(is_corrupt tr (principal_label alice) \/ @@ -249,32 +247,31 @@ let compute_message3_proof tr alice bob gx gy x sk_a n_sig = #push-options "--ifuel 1 --z3rlimit 10" val decode_and_verify_message3_proof: tr:trace -> - msg_bytes:bytes -> + msg3_bytes:bytes -> alice:principal -> bob:principal -> bob_si:state_id -> gx:bytes -> y:bytes -> pk_a:bytes -> Lemma (requires - is_publishable tr msg_bytes /\ + is_publishable tr msg3_bytes /\ is_publishable tr gx /\ is_secret (principal_state_label bob bob_si) tr y /\ is_verification_key "DH.SigningKey" (principal_label alice) tr pk_a ) (ensures ( let gy = dh_pk y in - match decode_and_verify_message3 msg_bytes bob gx gy y pk_a with + match decode_and_verify_message3 msg3_bytes bob gx gy y pk_a with | Some res -> ( let sig_msg = SigMsg3 {bob; gx; gy} in - is_publishable tr res.sg /\ (is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_state_label bob bob_si) \/ (exists x. gx == dh_pk x /\ event_triggered tr alice (Initiate2 alice bob gx gy (dh x gy)))) ) | None -> True )) -let decode_and_verify_message3_proof tr msg_bytes alice bob bob_si gx y pk_a = +let decode_and_verify_message3_proof tr msg3_bytes alice bob bob_si gx y pk_a = let gy = dh_pk y in - match decode_and_verify_message3 msg_bytes bob gx gy y pk_a with + match decode_and_verify_message3 msg3_bytes bob gx gy y pk_a with | Some res -> ( - parse_wf_lemma message (is_publishable tr) msg_bytes; + parse_wf_lemma message (is_publishable tr) msg3_bytes; serialize_wf_lemma sig_message (is_publishable tr) (SigMsg3 {bob; gx; gy}); () ) diff --git a/examples/iso_dh/DY.Example.DH.Protocol.Total.fst b/examples/iso_dh/DY.Example.DH.Protocol.Total.fst index 00d8b0f..b5e92f3 100644 --- a/examples/iso_dh/DY.Example.DH.Protocol.Total.fst +++ b/examples/iso_dh/DY.Example.DH.Protocol.Total.fst @@ -122,7 +122,7 @@ let compute_message2 alice bob gx gy sk_b n_sig = serialize message msg // Alice parses message 2 -type verify_msg2_result = {sg:bytes; gy:bytes; gx:bytes; k:bytes} +type verify_msg2_result = {gy:bytes; gx:bytes; k:bytes} val decode_and_verify_message2: bytes -> principal -> bytes -> bytes -> option verify_msg2_result let decode_and_verify_message2 msg2_bytes alice x pk_b = let? msg2_parsed = parse message msg2_bytes in @@ -137,11 +137,14 @@ let decode_and_verify_message2 msg2_bytes alice x pk_b = // These lines are the... guard(verify pk_b (serialize sig_message sig_msg) msg2.sg);? let k = dh x gy in - Some {sg=msg2.sg; gy; gx; k} + Some {gy; gx; k} // ...short version of the following if-else block: (* - if verify pk_b (serialize sig_message sig_msg) msg2.sg then Some {msg2; gx; k} - else None + if verify pk_b (serialize sig_message sig_msg) msg2.sg then + let k = dh x gy in + Some {gy; gx; k} + else + None *) // Alice generates message3 @@ -153,7 +156,7 @@ let compute_message3 alice bob gx gy sk_a n_sig = serialize message msg // Bob parses message3 -type verify_msg3_result = {sg:bytes; k:bytes} +type verify_msg3_result = {k:bytes} val decode_and_verify_message3: bytes -> principal -> bytes -> bytes -> bytes -> bytes -> option verify_msg3_result let decode_and_verify_message3 msg3_bytes bob gx gy y pk_a = let? msg3_parsed = parse message msg3_bytes in @@ -164,4 +167,4 @@ let decode_and_verify_message3 msg3_bytes bob gx gy y pk_a = let sig_msg = SigMsg3 {bob; gx; gy} in guard(verify pk_a (serialize sig_message sig_msg) msg3.sg);? let k = dh y gx in - Some {sg=msg3.sg; k} + Some {k} From 990a47dc43c2589d59ba8f978aa1970f89717cec Mon Sep 17 00:00:00 2001 From: Fabian Hauck Date: Wed, 3 Jul 2024 11:26:44 +0200 Subject: [PATCH 26/29] Updated README to include the ISO-DH example --- README.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index 66e5b51..9b86f57 100644 --- a/README.md +++ b/README.md @@ -15,7 +15,8 @@ we can find functions and theorems built on top of [`DY.Core`](src/core/DY.Core. ### Examples -The NSL protocol is proved secure in the namespace [`DY.Example.NSL`](examples/nsl_pk/DY.Example.NSL.SecurityProperties.fst). +The NSL protocol has been proven secure in the namespace [`DY.Example.NSL`](examples/nsl_pk/DY.Example.NSL.SecurityProperties.fst), and the ISO-DH protocol has been +proven secure in the namespace [`DY.Example.DH`](examples/iso_dh/DY.Example.DH.SecurityProperties.fst). ## How to build From 581fba922d72bbeac72cd9e27619278b18391aed Mon Sep 17 00:00:00 2001 From: Fabian Hauck Date: Wed, 3 Jul 2024 11:28:06 +0200 Subject: [PATCH 27/29] README changed path to ISO-DH example --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 9b86f57..48cf201 100644 --- a/README.md +++ b/README.md @@ -16,7 +16,7 @@ we can find functions and theorems built on top of [`DY.Core`](src/core/DY.Core. ### Examples The NSL protocol has been proven secure in the namespace [`DY.Example.NSL`](examples/nsl_pk/DY.Example.NSL.SecurityProperties.fst), and the ISO-DH protocol has been -proven secure in the namespace [`DY.Example.DH`](examples/iso_dh/DY.Example.DH.SecurityProperties.fst). +proven secure in the namespace [`DY.Example.DH`](examples/iso_dh). ## How to build From 3b0c377355c427b59b895ef0b991fa047ae15ef0 Mon Sep 17 00:00:00 2001 From: Fabian Hauck Date: Wed, 3 Jul 2024 11:56:25 +0200 Subject: [PATCH 28/29] DH example updated README --- examples/iso_dh/README.md | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/examples/iso_dh/README.md b/examples/iso_dh/README.md index 50bbf6b..bf95c46 100644 --- a/examples/iso_dh/README.md +++ b/examples/iso_dh/README.md @@ -35,10 +35,17 @@ module contains helper lemmas about the total functions used in the stateful proof to prove that every stateful function fulfills the trace invariants. -The two modules that are left are the ``DY.Example.DH.SecurityProperties`` -module and the ``DY.Example.DH.Debug`` module. The former -defines and proves the security properties, and the latter generates -an example trace of an honest protocol run. +The module ``DY.Example.DH.SecurityProperties`` formalizes the +above-mentioned security properties and proves them with the +protocol invariants. + +To see whether the protocol has been modeled correctly the module +``DY.Example.DH.Debug`` provides an implementation of an honest +protocol run. This module can be extracted to OCaml code to +print an example trace to the console. +The module ``DY.Example.DH.Debug.Proof`` proves that the +honest protocol run fulfills the protocol invariants. +This proof serves as a sanity check for the protocol invariants. ## Check and Run the Model To verify the F* code you can call ``make`` from either this From cffcd3af5c0cd00b17fa792adf60b3ac72028bfc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Th=C3=A9ophile=20Wallez?= Date: Wed, 3 Jul 2024 15:21:30 +0200 Subject: [PATCH 29/29] cleanup: rework some ISO-DH security proofs --- .../DY.Example.DH.SecurityProperties.fst | 145 ++++++++---------- src/core/DY.Core.Label.Derived.fst | 13 ++ 2 files changed, 77 insertions(+), 81 deletions(-) diff --git a/examples/iso_dh/DY.Example.DH.SecurityProperties.fst b/examples/iso_dh/DY.Example.DH.SecurityProperties.fst index a805426..eae6699 100644 --- a/examples/iso_dh/DY.Example.DH.SecurityProperties.fst +++ b/examples/iso_dh/DY.Example.DH.SecurityProperties.fst @@ -7,7 +7,7 @@ open DY.Example.DH.Protocol.Total.Proof open DY.Example.DH.Protocol.Stateful open DY.Example.DH.Protocol.Stateful.Proof -#set-options "--fuel 8 --ifuel 8 --z3rlimit 25 --z3cliopt 'smt.qi.eager_threshold=100'" +#set-options "--fuel 0 --ifuel 0 --z3rlimit 25 --z3cliopt 'smt.qi.eager_threshold=100'" (*** Authentication Properties ***) @@ -47,36 +47,6 @@ let responder_authentication tr i alice bob gx gy k = () (*** Forward Secrecy Properties ***) -/// This lemma is needed to proof the forward secrecy -/// security properties. -/// It is never explicitly called but automatically -/// instantiated via the SMTPat. -/// In the forward secrecy security property the problem -/// is that we do not explicitly have the session id -/// available. That is the reason for using the SMTPat. -/// -/// Alternatively the SMTPat of the lemma -/// principal_flow_to_principal_state in DY.Core.Label -/// could be extended with this SMTPat to proof the -/// forward secrecy security properties. -val principal_state_corrupt_implies_principal_corrupt: - tr:trace -> prin:principal -> si:state_id -> - Lemma - (requires - trace_invariant tr /\ - is_corrupt tr (principal_state_label prin si) - ) - (ensures - is_corrupt tr (principal_label prin) - ) - [SMTPat (trace_invariant tr); SMTPat (is_corrupt tr (principal_state_label prin si))] -let principal_state_corrupt_implies_principal_corrupt tr prin si = - // Triggers principal_flow_to_principal_state - assert(principal_label prin `can_flow tr` principal_state_label prin si); - // Triggers flow_to_public_eq - assert(principal_label prin `can_flow tr` public); - () - val initiator_forward_secrecy: tr:trace -> alice:principal -> alice_si:state_id -> bob:principal -> gx:bytes -> gy:bytes -> k:bytes -> Lemma @@ -91,40 +61,40 @@ val initiator_forward_secrecy: let initiator_forward_secrecy tr alice alice_si bob gx gy k = attacker_only_knows_publishable_values tr k; - // The following code is not needed for the proof. - // It just shows what we need to show to prove the lemma. - assert(is_publishable tr k); - assert(is_corrupt tr (get_label k)); - - assert(get_label k `can_flow tr` public); - assert(is_corrupt tr (get_label k)); - assert(get_label k `can_flow tr` join (principal_state_label alice alice_si) (principal_label bob)); - assert(get_label k `can_flow tr` principal_state_label alice alice_si); - assert(get_label k `can_flow tr` principal_label bob); - - assert(is_dh_shared_key tr alice bob k \/ is_corrupt tr (principal_label bob) \/ - is_corrupt tr (principal_state_label alice alice_si)); - assert(exists bob_si. get_label k `equivalent tr` - join (principal_state_label alice alice_si) (principal_state_label bob bob_si) \/ + // We derive the following fact from InitiatorSendMsg3 state invariant + // and Respond1 event invariant + // (this assert is not needed and only there for pedagogical purposes) + assert( + (exists x. gx == dh_pk x /\ k == dh x gy /\ is_secret (principal_state_label alice alice_si) tr x) /\ + ( + is_corrupt tr (principal_label bob) \/ + is_corrupt tr (principal_state_label alice alice_si) \/ + (exists y. + (exists bob_si. is_secret (principal_state_label bob bob_si) tr y) /\ + gy = dh_pk y + ) + ) + ); + + // We can deduce from it the label of `k`, up to some corruption + // (this assert is not needed and only there for pedagogical purposes) + assert( is_corrupt tr (principal_label bob) \/ - is_corrupt tr (principal_state_label alice alice_si)); + is_corrupt tr (principal_state_label alice alice_si) \/ + (exists bob_si. get_label k `equivalent tr` join (principal_state_label alice alice_si) (principal_state_label bob bob_si)) + ); + + // We deduce from the following this assertion, + // that will trigger transitivity of `can_flow tr` from `join ...` to `get_label k` to `public` + assert( + is_corrupt tr (principal_label bob) \/ + is_corrupt tr (principal_state_label alice alice_si) \/ + (exists bob_si. join (principal_state_label alice alice_si) (principal_state_label bob bob_si) `can_flow tr` public) + ); + + // This assert allows to deduce corruption of principal bob from corruption state bob_si of principal bob + assert(forall bob_si. principal_label bob `can_flow tr` principal_state_label bob bob_si); - // This assert is needed for the proof - assert(exists bob_si. join (principal_state_label alice alice_si) (principal_state_label bob bob_si) - `can_flow tr` public \/ - is_corrupt tr (principal_label bob)); - - // The following code is not needed for the proof. - // It just shows what we need to show to prove the lemma. - assert(principal_state_label alice alice_si `can_flow tr` public \/ - (exists bob_si. principal_state_label bob bob_si `can_flow tr` public) \/ - is_corrupt tr (principal_label bob)); - assert(exists bob_si. is_corrupt tr (join (principal_state_label alice alice_si) (principal_state_label bob bob_si)) \/ - is_corrupt tr (principal_label bob)); - - assert(is_corrupt tr (principal_state_label alice alice_si) \/ - (exists bob_si. is_corrupt tr (principal_state_label bob bob_si)) \/ - is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob)); () val responder_forward_secrecy: @@ -141,30 +111,43 @@ val responder_forward_secrecy: let responder_forward_secrecy tr alice bob bob_si gx gy k = attacker_only_knows_publishable_values tr k; - // The following code is not needed for the proof. - // It just shows what we need to show to prove the lemma. - assert(is_dh_shared_key tr alice bob k \/ is_corrupt tr (principal_label alice) \/ - is_corrupt tr (principal_state_label bob bob_si)); + // We derive the following fact from ResponderReceivedMsg3 state invariant + // and Initiate2 event invariant + // (this assert is not needed and only there for pedagogical purposes) + assert( + (exists y. gy == dh_pk y /\ k == dh y gx /\ is_secret (principal_state_label bob bob_si) tr y) /\ + ( + is_corrupt tr (principal_label alice) \/ + is_corrupt tr (principal_state_label bob bob_si) \/ + (exists x. + (exists alice_si. is_secret (principal_state_label alice alice_si) tr x) /\ + k == dh x gy + ) + ) + ); + + // We can deduce from it the label of `k`, up to some corruption + // (this assert is not needed and only there for pedagogical purposes) + assert( + is_corrupt tr (principal_label alice) \/ + is_corrupt tr (principal_state_label bob bob_si) \/ + (exists alice_si. get_label k `equivalent tr` join (principal_state_label alice alice_si) (principal_state_label bob bob_si)) + ); - assert(exists alice_si. get_label k `equivalent tr` - join (principal_state_label alice alice_si) (principal_state_label bob bob_si) \/ + // We deduce from the following this assertion, + // that will trigger transitivity of `can_flow tr` from `join ...` to `get_label k` to `public` + assert( is_corrupt tr (principal_label alice) \/ - is_corrupt tr (principal_state_label bob bob_si)); - + is_corrupt tr (principal_state_label bob bob_si) \/ + (exists alice_si. join (principal_state_label alice alice_si) (principal_state_label bob bob_si) `can_flow tr` public) + ); + // This assert is needed for the proof assert(exists alice_si. join (principal_state_label alice alice_si) (principal_state_label bob bob_si) `can_flow tr` public \/ is_corrupt tr (principal_label alice)); - // The following code is not needed for the proof. - // It just shows what we need to show to prove the lemma. - assert(principal_state_label bob bob_si `can_flow tr` public \/ - (exists alice_si. principal_state_label alice alice_si `can_flow tr` public) \/ - is_corrupt tr (principal_label alice)); - assert(exists alice_si. is_corrupt tr (join (principal_state_label alice alice_si) (principal_state_label bob bob_si)) \/ - is_corrupt tr (principal_label alice)); + // This assert allows to deduce corruption of principal alice from corruption state alice_si of principal alice + assert(forall alice_si. principal_label alice `can_flow tr` principal_state_label alice alice_si); - assert(is_corrupt tr (principal_state_label bob bob_si) \/ - (exists alice_si. is_corrupt tr (principal_state_label alice alice_si)) \/ - is_corrupt tr (principal_label alice) \/ is_corrupt tr (principal_label bob)); () diff --git a/src/core/DY.Core.Label.Derived.fst b/src/core/DY.Core.Label.Derived.fst index ef91130..b9f6e3e 100644 --- a/src/core/DY.Core.Label.Derived.fst +++ b/src/core/DY.Core.Label.Derived.fst @@ -88,3 +88,16 @@ val right_flows_to_meet: [SMTPat (l2 `can_flow tr` (l1 `meet` l2))] let right_flows_to_meet tr l1 l2 = meet_eq tr (meet l1 l2) l1 l2 + +val can_flow_propagates_is_corrupt: + tr:trace -> l1:label -> l2:label -> + Lemma + (requires + is_corrupt tr l2 /\ + l1 `can_flow tr` l2 + ) + (ensures is_corrupt tr l1) + [SMTPat (is_corrupt tr l2); SMTPat (l1 `can_flow tr` l2)] +let can_flow_propagates_is_corrupt tr l1 l2 = + flow_to_public_eq tr l1; + flow_to_public_eq tr l2