From 6c3ecb6dd6b4682a9c83db00868a25e021f93912 Mon Sep 17 00:00:00 2001
From: Sebastian Ertel <sebastianertel@Sebastians-MacBook-Air.local>
Date: Tue, 13 Feb 2024 15:16:07 +0100
Subject: [PATCH 01/13] Nix support

---
 flake.lock | 60 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 flake.nix  | 48 +++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 108 insertions(+)
 create mode 100644 flake.lock
 create mode 100644 flake.nix

diff --git a/flake.lock b/flake.lock
new file mode 100644
index 00000000..49c856c9
--- /dev/null
+++ b/flake.lock
@@ -0,0 +1,60 @@
+{
+  "nodes": {
+    "flake-utils": {
+      "inputs": {
+        "systems": "systems"
+      },
+      "locked": {
+        "lastModified": 1705309234,
+        "narHash": "sha256-uNRRNRKmJyCRC/8y1RqBkqWBLM034y4qN7EprSdmgyA=",
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "rev": "1ef2e671c3b0c19053962c07dbda38332dcebf26",
+        "type": "github"
+      },
+      "original": {
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "type": "github"
+      }
+    },
+    "nixpkgs": {
+      "locked": {
+        "lastModified": 1707824078,
+        "narHash": "sha256-Au3wLi2d06bU7TDvahP2jIEeKwmjAxKHqi8l2uiBkGA=",
+        "owner": "nixos",
+        "repo": "nixpkgs",
+        "rev": "99d7b32e4cfdaf763d9335b4d9ecf4415cbdc405",
+        "type": "github"
+      },
+      "original": {
+        "owner": "nixos",
+        "repo": "nixpkgs",
+        "type": "github"
+      }
+    },
+    "root": {
+      "inputs": {
+        "flake-utils": "flake-utils",
+        "nixpkgs": "nixpkgs"
+      }
+    },
+    "systems": {
+      "locked": {
+        "lastModified": 1681028828,
+        "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
+        "owner": "nix-systems",
+        "repo": "default",
+        "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
+        "type": "github"
+      },
+      "original": {
+        "owner": "nix-systems",
+        "repo": "default",
+        "type": "github"
+      }
+    }
+  },
+  "root": "root",
+  "version": 7
+}
diff --git a/flake.nix b/flake.nix
new file mode 100644
index 00000000..e16d7a64
--- /dev/null
+++ b/flake.nix
@@ -0,0 +1,48 @@
+{
+  inputs = {
+    nixpkgs.url        = github:nixos/nixpkgs;
+    flake-utils.url    = github:numtide/flake-utils;
+  };
+  outputs = { self, nixpkgs, flake-utils }:
+    flake-utils.lib.eachDefaultSystem (system:
+      let
+        pkgs = nixpkgs.legacyPackages.${system};
+      in
+       rec {
+          mkDrv = { stdenv, which, coqPackages, coq } :
+            stdenv.mkDerivation {
+              pname = "ssprove";
+              version = "0.0.1";
+              src = ./.;
+              nativeBuildInputs = [ which coq.ocamlPackages.findlib ] ++
+                                  (with coqPackages; [
+                                    equations
+                                    mathcomp-analysis
+                                    mathcomp-ssreflect
+                                    extructures
+                                    deriving
+                                  ]);
+              buildInputs = [ coq ];
+            };
+
+          devShell =
+            let
+              args = {
+                inherit (pkgs) stdenv which;
+                coq = pkgs.coq_8_18;
+                coqPackages = pkgs.coqPackages_8_18.overrideScope
+                  (self: super: {
+                    mathcomp = super.mathcomp.override { version = "2.1.0"; };
+                    mathcomp-analysis = super.mathcomp-analysis.override { version = "1.0.0"; };
+                  });
+              };
+              ssprove' = mkDrv args;
+            in
+              pkgs.mkShell {
+                packages =
+                  (with pkgs; [ coq gnumake ])
+                  ++
+                  (with ssprove';  nativeBuildInputs);
+              };
+       });
+}

From 8b294a81d7d6be3de76804342149f6d438a81a10 Mon Sep 17 00:00:00 2001
From: Sebastian Ertel <sebastian.ertel@barkhauseninstitut.org>
Date: Mon, 26 Feb 2024 17:16:02 +0100
Subject: [PATCH 02/13] porting to mathcomp 2.1.0 [part 1]

---
 _CoqProject                                   |   1 +
 flake.nix                                     |   9 +-
 theories/Crypt/Prelude.v                      |   7 +-
 theories/Crypt/choice_type.v                  | 193 +++++++++++++++---
 theories/Crypt/rhl_semantics/ChoiceAsOrd.v    |   3 +-
 .../rhl_semantics/only_prob/Theta_exCP.v      |  21 +-
 .../state_prob/StateTransformingLaxMorph.v    |   2 +-
 theories/Crypt/rules/RulesProb.v              |  27 +--
 theories/Crypt/rules/RulesStateProb.v         |  12 +-
 theories/Crypt/rules/UniformDistrLemmas.v     |  43 ++--
 10 files changed, 230 insertions(+), 88 deletions(-)

diff --git a/_CoqProject b/_CoqProject
index 7acd4057..d056bfab 100644
--- a/_CoqProject
+++ b/_CoqProject
@@ -22,6 +22,7 @@ theories/Relational/Commutativity.v
 
 theories/Crypt/Prelude.v
 theories/Crypt/Axioms.v
+theories/Crypt/Canonicals.v
 theories/Crypt/choice_type.v
 
 # Categorical semantics
diff --git a/flake.nix b/flake.nix
index e16d7a64..f54ddbc3 100644
--- a/flake.nix
+++ b/flake.nix
@@ -9,7 +9,10 @@
         pkgs = nixpkgs.legacyPackages.${system};
       in
        rec {
-          mkDrv = { stdenv, which, coqPackages, coq } :
+         mkDrv = { stdenv, which, coqPackages, coq } :
+           let
+             extructures' = coqPackages.extructures.override { version = "0.4.0"; };
+           in
             stdenv.mkDerivation {
               pname = "ssprove";
               version = "0.0.1";
@@ -19,9 +22,9 @@
                                     equations
                                     mathcomp-analysis
                                     mathcomp-ssreflect
-                                    extructures
                                     deriving
-                                  ]);
+                                  ])
+                                  ++ [extructures'];
               buildInputs = [ coq ];
             };
 
diff --git a/theories/Crypt/Prelude.v b/theories/Crypt/Prelude.v
index df763081..7898b94b 100644
--- a/theories/Crypt/Prelude.v
+++ b/theories/Crypt/Prelude.v
@@ -5,6 +5,7 @@ From Coq Require Import Utf8 Lia.
 Set Warnings "-notation-overridden".
 From mathcomp Require Import ssreflect eqtype ssrbool ssrnat.
 Set Warnings "notation-overridden".
+From HB Require Import structures.
 From extructures Require Import ord fset.
 From Equations Require Import Equations.
 From Mon Require SPropBase.
@@ -180,9 +181,7 @@ Proof.
     intro h. apply e. inversion h. reflexivity.
 Qed.
 
-Canonical positive_eqMixin := EqMixin positive_eqP.
-  Canonical positive_eqType :=
-    Eval hnf in EqType positive positive_eqMixin.
+HB.instance Definition _ := hasDecEq.Build _ positive_eqP.
 
 (** Lt class, for finite types  *)
 
@@ -314,4 +313,4 @@ Definition testSome {A} (P : A → bool) (o : option A) : bool :=
   match o with
   | Some a => P a
   | None => false
-  end.
\ No newline at end of file
+  end.
diff --git a/theories/Crypt/choice_type.v b/theories/Crypt/choice_type.v
index 0a12499b..a9010927 100644
--- a/theories/Crypt/choice_type.v
+++ b/theories/Crypt/choice_type.v
@@ -9,11 +9,15 @@
 From Coq Require Import Utf8 Lia.
 From Relational Require Import OrderEnrichedCategory
   OrderEnrichedRelativeMonadExamples GenericRulesSimple.
+
 Set Warnings "-ambiguous-paths,-notation-overridden,-notation-incompatible-format".
 From mathcomp Require Import ssrnat ssreflect ssrfun ssrbool ssrnum eqtype
   choice reals distr realsum seq all_algebra fintype.
 Set Warnings "ambiguous-paths,notation-overridden,notation-incompatible-format".
-From Crypt Require Import Prelude Axioms.
+From HB Require Import structures.
+
+From Crypt Require Import Prelude Axioms Canonicals.
+From deriving Require Import deriving.
 From extructures Require Import ord fset fmap.
 From Mon Require Import SPropBase.
 Require Equations.Prop.DepElim.
@@ -52,6 +56,24 @@ Derive NoConfusion NoConfusionHom for choice_type.
 (* Definition void_ordMixin := OrdMixin void_leqP. *)
 (* Canonical void_ordType := Eval hnf in OrdType void void_ordMixin. *)
 
+
+(* From extructures/tests/tutorial.v *)
+(*
+Definition choice_type_indDef := [indDef for choice_type_rect].
+Canonical choice_type_indType := IndType choice_type choice_type_indDef.
+Definition choice_type_hasDecEq := [derive hasDecEq for choice_type].
+HB.instance Definition _ := choice_type_hasDecEq.
+Fail Definition choice_type_hasChoice := [derive hasChoice for choice_type].
+(*
+#[hnf] HB.instance Definition _ := choice_type_hasChoice.
+Definition choice_type_hasOrd := [derive hasOrd for choice_type].
+#[hnf] HB.instance Definition _ := formula_hasOrd.
+ *)
+
+HB.about ordType.
+HB.about choiceType.
+ *)
+
 Fixpoint chElement_ordType (U : choice_type) : ordType :=
   match U with
   | chUnit => unit_ordType
@@ -60,7 +82,7 @@ Fixpoint chElement_ordType (U : choice_type) : ordType :=
   | chProd U1 U2 => prod_ordType (chElement_ordType U1) (chElement_ordType U2)
   | chMap U1 U2 => fmap_ordType (chElement_ordType U1) (chElement_ordType U2)
   | chOption U => option_ordType (chElement_ordType U)
-  | chFin n => [ordType of ordinal n.(pos) ]
+  | chFin n => fin_ordType n
   end.
 
 Fixpoint chElement (U : choice_type) : choiceType :=
@@ -71,7 +93,7 @@ Fixpoint chElement (U : choice_type) : choiceType :=
   | chProd U1 U2 => prod_choiceType (chElement U1) (chElement U2)
   | chMap U1 U2 => fmap_choiceType (chElement_ordType U1) (chElement U2)
   | chOption U => option_choiceType (chElement U)
-  | chFin n => [choiceType of ordinal n.(pos) ]
+  | chFin n => fin_choiceType n
   end.
 
 Coercion chElement : choice_type >-> choiceType.
@@ -97,6 +119,7 @@ Defined.
 
 Section choice_typeTypes.
 
+  (*
   Fixpoint choice_type_test (u v : choice_type) : bool :=
     match u, v with
     | chNat , chNat => true
@@ -148,10 +171,20 @@ Section choice_typeTypes.
     - constructor.
     - move: e => /choice_type_eqP []. reflexivity.
   Qed.
+   *)
 
+  Definition choice_type_indDef := [indDef for choice_type_rect].
+  Canonical choice_type_indType := IndType choice_type choice_type_indDef.
+  Definition choice_type_hasDecEq := [derive hasDecEq for choice_type].
+  HB.instance Definition _ := choice_type_hasDecEq.
+
+  HB.about choice_type.
+  (* Print choice_type_choice_type__canonical__eqtype_Equality. *)
+  (*
   Canonical choice_type_eqMixin := EqMixin choice_type_eqP.
   Canonical choice_type_eqType :=
     Eval hnf in EqType choice_type choice_type_eqMixin.
+   *)
 
   Fixpoint choice_type_lt (t1 t2 : choice_type) :=
   match t1, t2 with
@@ -169,7 +202,7 @@ Section choice_typeTypes.
   | chProd _ _, chNat => false
   | chProd u1 u2, chProd w1 w2 =>
     (choice_type_lt u1 w1) ||
-    (choice_type_eq u1 w1 && choice_type_lt u2 w2)
+    (eq_op u1 w1 && choice_type_lt u2 w2)
   | chProd _ _, _ => true
   | chMap _ _, chUnit => false
   | chMap _ _, chBool => false
@@ -177,7 +210,7 @@ Section choice_typeTypes.
   | chMap _ _, chProd _ _ => false
   | chMap u1 u2, chMap w1 w2 =>
     (choice_type_lt u1 w1) ||
-    (choice_type_eq u1 w1 && choice_type_lt u2 w2)
+    (eq_op u1 w1 && choice_type_lt u2 w2)
   | chMap _ _, _ => true
   | chOption _, chUnit => false
   | chOption _, chBool => false
@@ -196,7 +229,7 @@ Section choice_typeTypes.
   end.
 
   Definition choice_type_leq (t1 t2 : choice_type) :=
-    choice_type_eq t1 t2 || choice_type_lt t1 t2.
+    eq_op t1 t2 || choice_type_lt t1 t2.
 
   Lemma choice_type_lt_transitive : transitive (T:=choice_type) choice_type_lt.
   Proof.
@@ -270,20 +303,39 @@ Section choice_typeTypes.
 
   Lemma choice_type_lt_total_holds :
     ∀ x y,
-      ~~ (choice_type_test x y) ==> (choice_type_lt x y || choice_type_lt y x).
+      ~~ (eq_op x y) ==> (choice_type_lt x y || choice_type_lt y x).
   Proof.
-    intros x y.
-    induction x as [ | | | x1 ih1 x2 ih2| x1 ih1 x2 ih2| x ih| x]
-    in y |- *.
+    intros x.
+    induction x as [ | | | x1 ih1 x2 ih2| x1 ih1 x2 ih2| x ih| x].
     all: try solve [ destruct y ; auto with solve_subterm; reflexivity ].
     - destruct y. all: try (intuition; reflexivity).
-      cbn.
       specialize (ih1 y1). specialize (ih2 y2).
       apply/implyP.
-      move /nandP => H.
+      move/nandP.
+      rewrite Bool.andb_true_l => H.
       apply/orP.
-      destruct (choice_type_test x1 y1) eqn:Heq.
-      + destruct H. 1: discriminate.
+      destruct (eq_op x1 y1) eqn:Heq.
+      + destruct H.
+        1: {
+          move: Heq => /eqP Heq.
+          move/negP: H; rewrite Heq /=.
+          move => H; left.
+          apply/orP; right.
+          have eq_true b : b == b = true. 1:{ apply/idP. apply eq_refl. }
+          rewrite (eq_true choice_type y1) //=.
+          clear ih1 ih2 Heq eq_true.
+          move: H; elim: y1 => //=.
+          - move => A ih1 B ih2.
+            move/negP/nandP.
+            case; move/negP.
+            + exact: ih1.
+            + exact: ih2.
+          - move => A ih1 B ih2.
+            move/negP/nandP.
+            case; move/negP.
+            + exact: ih1.
+            + exact: ih2.
+        }
         move: ih2. move /implyP => ih2.
         specialize (ih2 H).
         move: ih2. move /orP => ih2.
@@ -293,7 +345,7 @@ Section choice_typeTypes.
         * right. apply/orP. right. apply/andP. intuition.
           move: Heq. move /eqP => Heq. rewrite Heq. apply/eqP. reflexivity.
       + destruct H.
-        * move: ih1. move /implyP => ih1.
+        * move: ih1. rewrite -Heq; move /implyP => ih1.
           specialize (ih1 H).
           move: ih1. move /orP => ih1.
           destruct ih1.
@@ -317,8 +369,16 @@ Section choice_typeTypes.
       apply/implyP.
       move /nandP => H.
       apply/orP.
-      destruct (choice_type_test x1 y1) eqn:Heq.
-      + destruct H. 1: discriminate.
+      destruct (eq_op x1 y1) eqn:Heq.
+      + destruct H.
+        1:{
+          move: ih1; rewrite -Heq; move/implyP => ih1.
+          specialize (ih1 H).
+          move: ih1 => /orP ih1.
+          case: ih1 => [ih1|ih1].
+          - by [left; apply/orP; left].
+          - by [right; apply/orP; left].
+        }
         move: ih2. move /implyP => ih2.
         specialize (ih2 H).
         move: ih2. move /orP => ih2.
@@ -328,7 +388,7 @@ Section choice_typeTypes.
         * right. apply/orP. right. apply/andP. intuition.
           move: Heq. move /eqP => Heq. rewrite Heq. apply/eqP. reflexivity.
       + destruct H.
-        * move: ih1. move /implyP => ih1.
+        * move: ih1. rewrite -Heq; move /implyP => ih1.
           specialize (ih1 H).
           move: ih1. move /orP => ih1.
           destruct ih1.
@@ -347,10 +407,9 @@ Section choice_typeTypes.
               +++ left. apply/orP. left. assumption.
               +++ right. apply/orP. left. assumption.
     - destruct y. all: try (intuition; reflexivity).
-      unfold choice_type_lt.
-      unfold choice_type_test.
+      rewrite /choice_type_lt.
       rewrite -neq_ltn.
-      apply /implyP. auto.
+      by [apply/implyP].
   Qed.
 
   Lemma choice_type_lt_asymmetric :
@@ -370,7 +429,7 @@ Section choice_typeTypes.
 
   Lemma choice_type_lt_total_not_holds :
     ∀ x y,
-      ~~ (choice_type_test x y) ==> (~~ (choice_type_lt x y && choice_type_lt y x)).
+      ~~ (eq_op x y) ==> (~~ (choice_type_lt x y && choice_type_lt y x)).
   Proof.
     intros x y. apply /implyP. intros Hneq.
     pose (choice_type_lt_total_holds x y) as Htot.
@@ -384,22 +443,78 @@ Section choice_typeTypes.
 
   Lemma choice_type_lt_tot :
     ∀ x y,
-      (choice_type_lt x y || choice_type_lt y x || choice_type_eq x y).
+      (choice_type_lt x y || choice_type_lt y x || eq_op x y).
   Proof.
     intros x y.
-    destruct (choice_type_eq x y) eqn:H.
+    destruct (eq_op x y) eqn:H.
     - apply/orP.
       by right.
     - apply/orP.
       left.
-      unfold choice_type_eq in H.
       pose (choice_type_lt_total_holds x y).
       move: i. move /implyP => i.
       apply i. apply/negP.
       intuition. move: H0. rewrite H. intuition.
   Qed.
 
-  Lemma choice_type_leqP : Ord.axioms choice_type_leq.
+  Lemma choice_type_leqxx : reflexive choice_type_leq.
+  Proof.
+    move => x; rewrite /choice_type_leq.
+    by [apply/orP; left; apply/eqP].
+  Qed.
+
+  Lemma choice_type_leq_trans : transitive choice_type_leq.
+  Proof.
+    move => v u w; rewrite /choice_type_leq.
+    move/orP => h1; move/orP => h2.
+    case: h1.
+    + by [move/eqP => ih1; rewrite ih1; apply/orP].
+    + case: h2.
+      * move /eqP => H0; rewrite H0 => lt_u_w.
+        by [apply/orP; right].
+      * move => lt_v_w lt_u_v.
+        apply/orP; right.
+        exact: (choice_type_lt_transitive _ _ _ lt_u_v lt_v_w).
+  Qed.
+
+  Lemma choice_type_leq_asym : antisymmetric choice_type_leq.
+  Proof.
+    move => x y; rewrite /choice_type_leq; move/andP.
+    rewrite /choice_type_leq.
+    case.
+    move/orP => h1; move/orP => h2.
+    case: h1.
+    - by [move/eqP].
+    - case: h2.
+      + by [move/eqP].
+      + case Heq: (~~ (eq_op x y)).
+        * move: Heq. move /idP => Heq.
+          pose (choice_type_lt_total_not_holds x y) as Hp.
+          move: Hp. move /implyP => Hp. specialize (Hp Heq).
+          move: Hp. move /nandP => Hp.
+          case: Hp.
+          ** move/eqP => nlt_x_y lt_y_x; move/eqP/eqP => lt_x_y.
+             by [move: nlt_x_y; rewrite lt_x_y /=; move/eqP].
+          ** move/eqP => nlt_y_x lt_y_x; move/eqP/eqP => lt_x_y.
+             by [move: nlt_y_x; rewrite lt_y_x /=; move/eqP].
+      * by [move: Heq; move /eqP].
+  Qed.
+
+  Lemma choice_type_leq_total : total choice_type_leq.
+  Proof.
+    move => x y; rewrite /choice_type_leq.
+    pose (choice_type_lt_tot x y).
+    move: i => /orP i.
+    case: i.
+    + move/orP => i.
+      case: i => [lt_x_y|lt_y_x]; apply/orP.
+      * by [left; apply/orP; right].
+      * by [right; apply/orP; right].
+    + by [move => i; apply/orP; left; apply/orP; left].
+  Qed.
+
+  (*
+  Lemma choice_type_leqP : hasOrd choice_type_leq.
   Proof.
     split => //.
     - intro x. unfold choice_type_leq.
@@ -444,7 +559,7 @@ Section choice_typeTypes.
         * apply/orP. right. apply/orP. right. assumption.
       + apply/orP. left. apply/orP. left. assumption.
   Qed.
-
+*)
 
   Fixpoint encode (t : choice_type) : GenTree.tree nat :=
   match t with
@@ -497,6 +612,29 @@ Section choice_typeTypes.
         rewrite -subnE subn0. repeat f_equal. apply eq_irrelevance.
   Defined.
 
+  HB.about choiceType.
+  HB.about Choice.
+  HB.about hasChoice.Build.
+
+  HB.about choice_type.
+
+  HB.instance Definition _ := Choice.copy choice_type (pcan_type codeK).
+
+  HB.about choice_type. (* Choice is there now *)
+
+  HB.about ordType.
+  HB.about hasOrd.Build.
+  HB.instance Definition _ :=
+    hasOrd.Build
+      choice_type
+      choice_type_leqxx
+      choice_type_leq_trans
+      choice_type_leq_asym
+      choice_type_leq_total.
+
+  HB.about choice_type. (* Ord is there now *)
+
+(*
   Definition choice_type_choiceMixin := PcanChoiceMixin codeK.
   Canonical choice_type_choiceType :=
     ChoiceType choice_type choice_type_choiceMixin.
@@ -504,5 +642,6 @@ Section choice_typeTypes.
   Definition choice_type_ordMixin := OrdMixin choice_type_leqP.
   Canonical choice_type_ordType :=
     Eval hnf in OrdType choice_type choice_type_ordMixin.
+   *)
 
 End choice_typeTypes.
diff --git a/theories/Crypt/rhl_semantics/ChoiceAsOrd.v b/theories/Crypt/rhl_semantics/ChoiceAsOrd.v
index 97ce586c..2a81dd17 100644
--- a/theories/Crypt/rhl_semantics/ChoiceAsOrd.v
+++ b/theories/Crypt/rhl_semantics/ChoiceAsOrd.v
@@ -1,5 +1,6 @@
 From Mon Require Import SPropBase.
 From Relational Require Import OrderEnrichedCategory OrderEnrichedRelativeMonadExamples.
+From Crypt Require Import Canonicals.
 Set Warnings "-notation-overridden".
 From mathcomp Require Import all_ssreflect.
 Set Warnings "notation-overridden".
@@ -32,8 +33,6 @@ Program Definition choice_incl := @mkOrdFunctor ord_choiceType TypeCat
     (fun (A:ord_choiceType) => A)
     (fun (A B : ord_choiceType) f => f)
     _ _ _.
-  Next Obligation. cbv ; intuition. Qed.
-
 
 
 Section Prod_of_choiceTypes.
diff --git a/theories/Crypt/rhl_semantics/only_prob/Theta_exCP.v b/theories/Crypt/rhl_semantics/only_prob/Theta_exCP.v
index fd4a705e..d5476aac 100644
--- a/theories/Crypt/rhl_semantics/only_prob/Theta_exCP.v
+++ b/theories/Crypt/rhl_semantics/only_prob/Theta_exCP.v
@@ -3,7 +3,8 @@ From mathcomp Require Import all_ssreflect all_algebra boolp distr reals realsum
 Set Warnings "notation-overridden,ambiguous-paths".
 From Mon Require Import SpecificationMonads SPropBase SPropMonadicStructures.
 From Relational Require Import OrderEnrichedCategory OrderEnrichedRelativeMonadExamples.
-From Crypt Require Import ChoiceAsOrd SubDistr Couplings Axioms.
+From Crypt Require Import ChoiceAsOrd SubDistr Couplings Axioms Canonicals.
+From HB Require Import structures.
 
 Import SPropNotations.
 Import Num.Theory.
@@ -91,9 +92,7 @@ Proof.
     apply: boolp.funext. by move => [c1 c2] /=.
 Defined.
 
-
-
-Definition θ0 (A1 A2 : Type) (ch1 : Choice.class_of A1) (ch2 : Choice.class_of A2):
+Definition θ0 (A1 A2 : Type) (ch1 : Choice A1) (ch2 : Choice A2):
   (SDistr_carrier (Choice.Pack ch1)) × (SDistr_carrier (Choice.Pack ch2)) ->
   WProp (A1 * A2)%type.
 Proof.
@@ -116,8 +115,8 @@ Proof.
   inversion leq12. by subst.
 Defined.
 
-Definition kd {A1 A2 B1 B2 : Type} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2}
-                                   {chB1 : Choice.class_of B1} {chB2 : Choice.class_of B2}
+Definition kd {A1 A2 B1 B2 : Type} {chA1 : Choice A1} {chA2 : Choice A2}
+                                   {chB1 : Choice B1} {chB2 : Choice B2}
               {f1 : TypeCat ⦅ nfst (prod_functor choice_incl choice_incl ⟨
                                Choice.Pack chA1, Choice.Pack chA2 ⟩);
                               nfst (SDistr_squ ⟨Choice.Pack chB1, Choice.Pack chB2 ⟩) ⦆}
@@ -151,7 +150,7 @@ Proof.
   - exists dnull. intro. inversion H.
 Defined.
 
-Lemma extract_positive : forall {A1 A2 B1 B2 : Type} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2} {chB1 : Choice.class_of B1} {chB2 : Choice.class_of B2}  (dA : SDistr_carrier (F_choice_prod_obj ⟨ Choice.Pack chA1, Choice.Pack chA2 ⟩)) (FF1 : _ -> SDistr (F_choice_prod ⟨ Choice.Pack chB1, Choice.Pack chB2 ⟩)) b1 b2, 0 < (\dlet_(i <- dA) (FF1 i)) (b1, b2) -> exists (a1 : Choice.Pack chA1) (a2 : Choice.Pack chA2), 0 < dA (a1, a2) /\ 0 < FF1 (a1, a2) (b1, b2).
+Lemma extract_positive : forall {A1 A2 B1 B2 : Type} {chA1 : Choice A1} {chA2 : Choice A2} {chB1 : Choice B1} {chB2 : Choice B2}  (dA : SDistr_carrier (F_choice_prod_obj ⟨ Choice.Pack chA1, Choice.Pack chA2 ⟩)) (FF1 : _ -> SDistr (F_choice_prod ⟨ Choice.Pack chB1, Choice.Pack chB2 ⟩)) b1 b2, 0 < (\dlet_(i <- dA) (FF1 i)) (b1, b2) -> exists (a1 : Choice.Pack chA1) (a2 : Choice.Pack chA2), 0 < dA (a1, a2) /\ 0 < FF1 (a1, a2) (b1, b2).
 Proof.
   intuition. rewrite /(\dlet_(i <- _) _) in H. unlock in H. simpl in H.
   rewrite /mlet in H.
@@ -174,7 +173,7 @@ Proof.
     apply FF1z.
 Qed.
 
-Lemma distr_get : forall {A : Type} {chA : Choice.class_of A} x y, 0 < SDistr_unit (Choice.Pack chA) x y -> x = y.
+Lemma distr_get : forall {A : Type} {chA : Choice A} x y, 0 < SDistr_unit (Choice.Pack chA) x y -> x = y.
 Proof.
   intuition. rewrite /SDistr_unit in H. rewrite dunit1E in H.
   case Hxy: (x==y).
@@ -274,7 +273,7 @@ Definition flip (r : R) : SDistr (bool_choiceType).
   - exact (1 - r).
 Defined.
 
-Lemma sample_rule : forall {A1 A2} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2}
+Lemma sample_rule : forall {A1 A2} {chA1 : Choice A1} {chA2 : Choice A2}
                       (pre : Prop) (post : A1 -> A2 -> Prop)
                       (d1 : SDistr (Choice.Pack chA1)) (d2 : SDistr (Choice.Pack chA2)) d
                       (Hd : coupling d d1 d2)
@@ -298,7 +297,7 @@ Qed.
 
 (* GENERIC MONADIC RULES *)
 
-Theorem ret_rule  {A1 A2 : Type} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2}
+Theorem ret_rule  {A1 A2 : Type} {chA1 : Choice A1} {chA2 : Choice A2}
                   (a1 : A1) (a2 : A2) :
 
    ⊨ (ord_relmon_unit SDistr (Choice.Pack chA1) a1) ≈
@@ -317,7 +316,7 @@ Proof.
     by rewrite -(distr_get _ _ Hb1b2).
 Qed.
 
-Theorem weaken_rule  {A1 A2 : Type} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2}
+Theorem weaken_rule  {A1 A2 : Type} {chA1 : Choice A1} {chA2 : Choice A2}
                      {d1 : SDistr (Choice.Pack chA1)}
                      {d2 : SDistr (Choice.Pack chA2)} :
   forall w w', (⊨ d1 ≈ d2 [{ w }]) -> w ≤ w' -> (⊨ d1 ≈ d2 [{ w' }] ).
diff --git a/theories/Crypt/rhl_semantics/state_prob/StateTransformingLaxMorph.v b/theories/Crypt/rhl_semantics/state_prob/StateTransformingLaxMorph.v
index d3082192..d620a95b 100644
--- a/theories/Crypt/rhl_semantics/state_prob/StateTransformingLaxMorph.v
+++ b/theories/Crypt/rhl_semantics/state_prob/StateTransformingLaxMorph.v
@@ -5,7 +5,7 @@ From Mon Require Import SPropBase.
 Set Warnings "-notation-overridden,-ambiguous-paths".
 From mathcomp Require Import all_ssreflect (*boolp*).
 Set Warnings "notation-overridden,ambiguous-paths".
-From Crypt Require Import Axioms OrderEnrichedRelativeAdjunctions LaxFunctorsAndTransf LaxMorphismOfRelAdjunctions TransformingLaxMorph OrderEnrichedRelativeAdjunctionsExamples ThetaDex SubDistr Theta_exCP ChoiceAsOrd FreeProbProg UniversalFreeMap RelativeMonadMorph_prod LaxComp choice_type.
+From Crypt Require Import Axioms OrderEnrichedRelativeAdjunctions LaxFunctorsAndTransf LaxMorphismOfRelAdjunctions TransformingLaxMorph OrderEnrichedRelativeAdjunctionsExamples ThetaDex SubDistr Theta_exCP ChoiceAsOrd FreeProbProg UniversalFreeMap RelativeMonadMorph_prod LaxComp choice_type Canonicals.
 (* From Crypt Require Import only_prob.Rules. *)
 
 Import SPropNotations.
diff --git a/theories/Crypt/rules/RulesProb.v b/theories/Crypt/rules/RulesProb.v
index cc4ff566..e4177329 100644
--- a/theories/Crypt/rules/RulesProb.v
+++ b/theories/Crypt/rules/RulesProb.v
@@ -31,7 +31,8 @@ From Crypt Require Import
      Theta_exCP
      LaxComp
      FreeProbProg
-     RelativeMonadMorph_prod.
+     RelativeMonadMorph_prod
+     Canonicals.
 
 Import SPropNotations.
 Import Num.Theory.
@@ -162,7 +163,7 @@ Definition get_d { A  : choiceType} (c : MFreePr A):=
   (Theta_dens.unary_theta_dens_obligation_1 A c).
 
 Lemma sample_rule :
-  ∀ {A1 A2} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2}
+  ∀ {A1 A2} {chA1 : Choice A1} {chA2 : Choice A2}
     (pre : Prop) (post : A1 -> A2 -> Prop)
     (c1 : MFreePr (Choice.Pack chA1))
     (c2 : MFreePr (Choice.Pack chA2))
@@ -205,7 +206,7 @@ Qed.
 (* GENERIC MONADIC RULES *)
 
 Theorem ret_ule {A1 A2 : Type}
-  {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2}
+  {chA1 : Choice A1} {chA2 : Choice A2}
   (a1 : A1) (a2 : A2) :
    ⊨ (ord_relmon_unit MFreePr (Choice.Pack chA1) a1) ≈
      (ord_relmon_unit MFreePr (Choice.Pack chA2) a2)
@@ -229,7 +230,7 @@ Proof.
   by apply: ret_rule.
 Qed.
 
-Theorem weaken_rule  {A1 A2 : Type} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2}
+Theorem weaken_rule  {A1 A2 : Type} {chA1 : Choice A1} {chA2 : Choice A2}
                      {d1 : MFreePr (Choice.Pack chA1)}
                      {d2 : MFreePr (Choice.Pack chA2)} :
   forall w w', (⊨ d1 ≈ d2 [{ w }]) -> w ≤ w' -> (⊨ d1 ≈ d2 [{ w' }] ).
@@ -243,8 +244,8 @@ Proof.
 Qed.
 
 
-Theorem bind_rule {A1 A2 : Type} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2}
-                  {B1 B2 : Type} {chB1 : Choice.class_of B1} {chB2 : Choice.class_of B2}
+Theorem bind_rule {A1 A2 : Type} {chA1 : Choice A1} {chA2 : Choice A2}
+                  {B1 B2 : Type} {chB1 : Choice B1} {chB2 : Choice B2}
                   {f1 : A1 -> MFreePr (Choice.Pack chB1)}
                   {f2 : A2 -> MFreePr (Choice.Pack chB2)}
                   (m1 : MFreePr (Choice.Pack chA1))
@@ -278,7 +279,7 @@ Qed.
 
 (* Pre-condition manipulating rules *)
 
-Theorem pre_weaken_rule  {A1 A2 : Type} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2}
+Theorem pre_weaken_rule  {A1 A2 : Type} {chA1 : Choice A1} {chA2 : Choice A2}
                         {d1 : MFreePr (Choice.Pack chA1)}
                         {d2 : MFreePr (Choice.Pack chA2)} :
   forall (pre pre' : Prop) post, (⊨ ⦃ pre ⦄ d1 ≈ d2 ⦃ post ⦄) -> (pre' -> pre) -> (⊨ ⦃ pre' ⦄ d1 ≈ d2 ⦃ post ⦄).
@@ -291,7 +292,7 @@ Proof.
   simpl; intuition.
 Qed.
 
-Theorem pre_hypothesis_rule  {A1 A2 : Type} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2}
+Theorem pre_hypothesis_rule  {A1 A2 : Type} {chA1 : Choice A1} {chA2 : Choice A2}
                         {d1 : MFreePr (Choice.Pack chA1)}
                         {d2 : MFreePr (Choice.Pack chA2)} :
   forall (pre : Prop) post, (pre -> ⊨ ⦃ True ⦄ d1 ≈ d2 ⦃ post ⦄) -> (⊨ ⦃ pre ⦄ d1 ≈ d2 ⦃ post ⦄).
@@ -323,7 +324,7 @@ Qed.
 
 (* post-condition manipulating rules *)
 
-Theorem post_weaken_rule  {A1 A2 : Type} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2}
+Theorem post_weaken_rule  {A1 A2 : Type} {chA1 : Choice A1} {chA2 : Choice A2}
         {d1 : MFreePr (Choice.Pack chA1)}
         {d2 : MFreePr (Choice.Pack chA2)} :
   forall (pre : Prop) (post1 post2 : A1 -> A2 -> Prop),
@@ -438,7 +439,7 @@ Proof. by  apply: (seq_rule_ch m1 m2 P (fun _ _ => True) Q judge1 judge2). Qed.
 
 (* *)
 
-Theorem if_rule  {A1 A2 : Type} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2}
+Theorem if_rule  {A1 A2 : Type} {chA1 : Choice A1} {chA2 : Choice A2}
         (c1 c2 : MFreePr (Choice.Pack chA1))
         (c1' c2' : MFreePr (Choice.Pack chA2))
         {b1 b2 : bool}
@@ -463,7 +464,7 @@ Proof.
   - intuition.
 Qed.
 
-Theorem if_rule_weak  {A1 A2 : Type} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2}
+Theorem if_rule_weak  {A1 A2 : Type} {chA1 : Choice A1} {chA2 : Choice A2}
         (c1 c2 : MFreePr (Choice.Pack chA1))
         (c1' c2' : MFreePr (Choice.Pack chA2))
         {b : bool}
@@ -485,7 +486,7 @@ Axiom s_indefinite_description :
 
 
 
-Definition judgement_d {A1 A2 : Type} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2}
+Definition judgement_d {A1 A2 : Type} {chA1 : Choice A1} {chA2 : Choice A2}
            {c1 : MFreePr (Choice.Pack chA1)}
            {c2 : MFreePr (Choice.Pack chA2)}
            {pre : Prop} {post : A1 -> A2 -> Prop}
@@ -548,7 +549,7 @@ Fixpoint bounded_do_while  (n : nat) (c : MFreePr bool_choiceType) :
 
 (* Rem.: maybe something like the rule in the paper can be proven? yes...
        but I do not have intuition of how it could be used... examples needed! *)
-Theorem bounded_do_while_rule  {A1 A2 : Type} {chA1 : Choice.class_of A1} {chA2 : Choice.class_of A2} {n : nat}
+Theorem bounded_do_while_rule  {A1 A2 : Type} {chA1 : Choice A1} {chA2 : Choice A2} {n : nat}
         (c1 c2 : MFreePr bool_choiceType)
         {inv : bool -> bool -> Prop}
         {H : ⊨ ⦃ inv true true ⦄ c1 ≈ c2 ⦃ fun b1 b2 => inv b1 b2 /\ b1 = b2 ⦄ } :
diff --git a/theories/Crypt/rules/RulesStateProb.v b/theories/Crypt/rules/RulesStateProb.v
index 4374d492..d2e0339f 100644
--- a/theories/Crypt/rules/RulesStateProb.v
+++ b/theories/Crypt/rules/RulesStateProb.v
@@ -8,16 +8,18 @@ From Relational Require Import OrderEnrichedCategory
 
 Set Warnings "-notation-overridden,-ambiguous-paths".
 From mathcomp Require Import all_ssreflect all_algebra reals distr realsum
-  finmap.set finmap.finmap xfinmap.
+  finset finmap.finmap xfinmap .
 Set Warnings "notation-overridden,ambiguous-paths".
 
 From Crypt Require Import Axioms ChoiceAsOrd SubDistr Couplings Theta_dens
   Theta_exCP LaxComp FreeProbProg RelativeMonadMorph_prod
-  StateTransformingLaxMorph choice_type.
+  StateTransformingLaxMorph choice_type Canonicals.
 
 Import SPropNotations.
 Import Num.Theory.
 
+From HB Require Import structures.
+
 
 #[local] Open Scope ring_scope.
 
@@ -126,7 +128,7 @@ End RSemanticNotation.
 Import RSemanticNotation.
 #[local] Open Scope rsemantic_scope.
 
-Import finmap.set finmap.finmap xfinmap.
+Import (* finmap.set *) finset finmap.finmap xfinmap.
 
 Open Scope fset_scope.
 
@@ -784,7 +786,7 @@ Proof.
   clear Hpsum.
   eapply neq0_psum in Hpsum'. destruct Hpsum'.
   apply aux_domain in H.
-  destruct (eqType_lem  bool_eqType ((x,x) == (a1,a2)) true) as [Houi | Hnon].
+  destruct (eqType_lem  _ ((x,x) == (a1,a2)) true) as [Houi | Hnon].
   move: Houi => /eqP Houi. move: Houi => [H1 H2]. rewrite -H1 -H2. reflexivity.
   have Hnon' : (x,x) == (a1,a2) = false.
     destruct ((x,x) == (a1,a2)). contradiction. reflexivity.
@@ -805,6 +807,8 @@ Proof.
     apply: H2. apply: aux_lemma H.
 Qed.
 
+HB.about Choice.
+
 Definition dsym { A B : ord_choiceType } { S1 S2 : choiceType } (d : SDistr_carrier
           (F_choice_prod_obj
              ⟨ Choice.Pack {| Choice.base := prod_eqMixin B S2; Choice.mixin := prod_choiceMixin B S2 |},
diff --git a/theories/Crypt/rules/UniformDistrLemmas.v b/theories/Crypt/rules/UniformDistrLemmas.v
index a051ac4a..c9b3bdcf 100644
--- a/theories/Crypt/rules/UniformDistrLemmas.v
+++ b/theories/Crypt/rules/UniformDistrLemmas.v
@@ -31,7 +31,8 @@ From Crypt Require Import
      Theta_dens
      Theta_exCP
      LaxComp
-     FreeProbProg.
+     FreeProbProg
+     Canonicals.
 
 Import SPropNotations.
 Import Num.Theory.
@@ -61,16 +62,15 @@ Qed.
 
 (* Rem.: TODO: generalize this *)
 Lemma sum_const_seq_finType { T : finType } ( J : seq T) (k : R) (Huniq : uniq J) :
-  \sum_(j <- J) k = \sum_(j in (seq_sub_finType J)) k.
+  \sum_(j <- J) k = \sum_(j in J) k.
 Proof.
-  rewrite /seq_sub_finType. simpl.
   rewrite big_const.
   rewrite big_const_seq.
-  rewrite card_seq_sub.
-  - simpl.
-    rewrite count_predT.
-    reflexivity.
-  - apply Huniq.
+  f_equal.
+  rewrite count_predT.
+  apply esym.
+  apply/card_uniqP.
+  exact: Huniq.
 Qed.
 
 
@@ -81,16 +81,16 @@ Proof.
   rewrite sum_const_seq_finType.
   2: { exact Huniq. }
   rewrite GRing.sumr_const pmulrn /=.
-  have hfoo' :  k *~ #|seq_sub_finType (T:=T) J| =  k * #|seq_sub_finType (T:=T) J|%:~R.
-  { by rewrite mulrzr. }
+  have hfoo' :  k *~ #|J| =  k * #|J|%:~R.
+  1: { by rewrite mulrzr. }
   rewrite hfoo' /=.
-  apply: ler_pmul; auto.
-  - rewrite ler0z. rewrite lez_nat. reflexivity.
-  - rewrite card_seq_sub. 2: eauto.
-    rewrite cardT.
-    rewrite ler_int. rewrite lez_nat.
-    rewrite uniq_leq_size. 1,2: auto.
-    intros x hx.
+  clear hfoo'.
+  apply: ler_pM; auto.
+  rewrite cardT.
+  rewrite ler_int. rewrite lez_nat.
+  rewrite cardE. apply uniq_leq_size.
+  - apply: enum_uniq.
+  - intros x hx.
     rewrite mem_enum. reflexivity.
 Qed.
 
@@ -225,12 +225,9 @@ Proof.
   rewrite GRing.mulrC.
   rewrite GRing.Theory.mulr_natl.
   apply f_equal.
-  rewrite card_seq_sub.
-  + rewrite cardE.
-    rewrite -enumT.
-    reflexivity.
-  + rewrite -enumT.
-    apply enum_uniq.
+  rewrite -enumT. rewrite [RHS]cardE.
+  apply: eq_cardT.
+  apply: mem_enum.
 Qed.
 
 (* the uniform distribution over F *)

From 72bb9f23f0f7df9a7ccb5afd75d3daf86efcd238 Mon Sep 17 00:00:00 2001
From: Sebastian Ertel <sebastian.ertel@barkhauseninstitut.org>
Date: Wed, 28 Feb 2024 17:09:45 +0100
Subject: [PATCH 03/13] porting to mathcomp 2.1.0 [part 2]

---
 theories/Crypt/Canonicals.v                  | 35 ++++++++++++++++++++
 theories/Crypt/choice_type.v                 | 26 +++++++++++----
 theories/Crypt/package/pkg_composition.v     |  6 ++--
 theories/Crypt/package/pkg_core_definition.v |  2 +-
 theories/Crypt/rules/RulesStateProb.v        | 11 ++----
 5 files changed, 61 insertions(+), 19 deletions(-)
 create mode 100644 theories/Crypt/Canonicals.v

diff --git a/theories/Crypt/Canonicals.v b/theories/Crypt/Canonicals.v
new file mode 100644
index 00000000..2ea0463f
--- /dev/null
+++ b/theories/Crypt/Canonicals.v
@@ -0,0 +1,35 @@
+Set Warnings "-ambiguous-paths,-notation-overridden,-notation-incompatible-format".
+From mathcomp Require Import ssreflect ssrbool ssrnat choice fintype.
+Set Warnings "ambiguous-paths,notation-overridden,notation-incompatible-format".
+
+From extructures Require Import ord fmap.
+From Crypt Require Import Prelude.
+
+From HB Require Import structures.
+
+
+(*
+  Note for any of these types it would also be okay to write the cast, e.g., [(nat:choiceType)%type]
+ , directly in the term.
+ *)
+
+Definition unit_choiceType : choiceType := Datatypes.unit.
+Definition nat_choiceType : choiceType := nat.
+Definition bool_choiceType : choiceType := bool.
+Definition prod_choiceType (A B: choiceType) : choiceType := prod A B.
+Definition fmap_choiceType (A: ordType) (B: choiceType) : choiceType := {fmap A -> B}.
+Definition option_choiceType (A: choiceType) : choiceType := option A.
+Definition fin_choiceType (p: positive) : choiceType := ordinal p.(pos).
+Definition sum_choiceType (A B: choiceType) : choiceType := (A + B)%type.
+
+Definition unit_ordType: ordType := Datatypes.unit.
+Definition nat_ordType: ordType := nat.
+Definition bool_ordType: ordType := bool.
+Definition prod_ordType (A B: ordType) : ordType := prod A B.
+Definition fmap_ordType (A B: ordType) : ordType := {fmap A -> B}.
+Definition option_ordType (A: ordType) : ordType := option A.
+Definition fin_ordType (p: positive) : ordType := ordinal p.(pos).
+Definition sum_ordType (A B: ordType) : ordType := (A + B)%type.
+
+
+Definition prod_finType (A B: finType) : finType := prod A B.
diff --git a/theories/Crypt/choice_type.v b/theories/Crypt/choice_type.v
index a9010927..9b14c6de 100644
--- a/theories/Crypt/choice_type.v
+++ b/theories/Crypt/choice_type.v
@@ -119,7 +119,7 @@ Defined.
 
 Section choice_typeTypes.
 
-  (*
+
   Fixpoint choice_type_test (u v : choice_type) : bool :=
     match u, v with
     | chNat , chNat => true
@@ -171,13 +171,26 @@ Section choice_typeTypes.
     - constructor.
     - move: e => /choice_type_eqP []. reflexivity.
   Qed.
-   *)
 
   Definition choice_type_indDef := [indDef for choice_type_rect].
   Canonical choice_type_indType := IndType choice_type choice_type_indDef.
-  Definition choice_type_hasDecEq := [derive hasDecEq for choice_type].
+  (* The unfolding became a problem in [pkg_composition]. So I follow the advice on
+     https://github.com/arthuraa/deriving
+   *)
+
+  (*
+    This
+    [Definition choice_type_hasDecEq := [derive hasDecEq for choice_type].]
+    did work well up until [pkg_composition].
+    The unfolding there was too much.
+    The [nored] version then did not provide enough reduction.
+   *)
+  HB.about hasDecEq.Build.
+  Definition choice_type_hasDecEq := hasDecEq.Build choice_type choice_type_eqP.
   HB.instance Definition _ := choice_type_hasDecEq.
 
+ (* Definition choice_type_eqP := @eqP choice_type. *)
+
   HB.about choice_type.
   (* Print choice_type_choice_type__canonical__eqtype_Equality. *)
   (*
@@ -311,9 +324,8 @@ Section choice_typeTypes.
     - destruct y. all: try (intuition; reflexivity).
       specialize (ih1 y1). specialize (ih2 y2).
       apply/implyP.
-      move/nandP.
-      rewrite Bool.andb_true_l => H.
-      apply/orP.
+      move/nandP; rewrite -/choice_type_test -/eq_op.
+      move => H; apply/orP.
       destruct (eq_op x1 y1) eqn:Heq.
       + destruct H.
         1: {
@@ -514,7 +526,7 @@ Section choice_typeTypes.
   Qed.
 
   (*
-  Lemma choice_type_leqP : hasOrd choice_type_leq.
+  Lemma choice_type_leqP : hasOrd.Build choice_type .
   Proof.
     split => //.
     - intro x. unfold choice_type_leq.
diff --git a/theories/Crypt/package/pkg_composition.v b/theories/Crypt/package/pkg_composition.v
index aef005cf..b469896d 100644
--- a/theories/Crypt/package/pkg_composition.v
+++ b/theories/Crypt/package/pkg_composition.v
@@ -431,7 +431,7 @@ Section fset_par_facts.
       - cbn. symmetry. apply h. auto.
       - cbn. reflexivity.
     }
-    rewrite h1. reflexivity.
+    rewrite h1. rewrite eqseqE. by [apply/eqP/eqP].
   Qed.
 
 End fset_par_facts.
@@ -912,7 +912,7 @@ Proof.
 Qed.
 
 Lemma getm_def_in :
-  ∀ {A : eqType} n (x : A) (s : seq (nat_eqType * A)),
+  ∀ {A : eqType} n (x : A) (s : seq ((nat:eqType)%type * A)),
     getm_def s n = Some x →
     (n,x) \in s.
 Proof.
@@ -1106,4 +1106,4 @@ Proof.
     intro h. apply e.
     destruct h as [? h ?]. rewrite in_fset in h.
     eexists. all: eauto.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/theories/Crypt/package/pkg_core_definition.v b/theories/Crypt/package/pkg_core_definition.v
index 6d128aae..c8cee6c0 100644
--- a/theories/Crypt/package/pkg_core_definition.v
+++ b/theories/Crypt/package/pkg_core_definition.v
@@ -15,7 +15,7 @@ Set Warnings "ambiguous-paths,notation-overridden,notation-incompatible-format".
 From extructures Require Import ord fset fmap.
 From Mon Require Import SPropBase.
 From Crypt Require Import Prelude Axioms ChoiceAsOrd RulesStateProb StateTransformingLaxMorph
-     choice_type.
+     choice_type Canonicals.
 
 Require Import Equations.Prop.DepElim.
 From Equations Require Import Equations.
diff --git a/theories/Crypt/rules/RulesStateProb.v b/theories/Crypt/rules/RulesStateProb.v
index d2e0339f..0443c8ad 100644
--- a/theories/Crypt/rules/RulesStateProb.v
+++ b/theories/Crypt/rules/RulesStateProb.v
@@ -807,23 +807,18 @@ Proof.
     apply: H2. apply: aux_lemma H.
 Qed.
 
-HB.about Choice.
-
 Definition dsym { A B : ord_choiceType } { S1 S2 : choiceType } (d : SDistr_carrier
           (F_choice_prod_obj
-             ⟨ Choice.Pack {| Choice.base := prod_eqMixin B S2; Choice.mixin := prod_choiceMixin B S2 |},
-               Choice.Pack {| Choice.base := prod_eqMixin A S1; Choice.mixin := prod_choiceMixin A S1 |} ⟩)) :
+             ⟨ ((B * S2)%type : choiceType), ((A * S1)%type : choiceType) ⟩)) :
 SDistr_carrier
           (F_choice_prod_obj
-             ⟨ Choice.Pack {| Choice.base := prod_eqMixin A S1; Choice.mixin := prod_choiceMixin A S1 |},
-               Choice.Pack {| Choice.base := prod_eqMixin B S2; Choice.mixin := prod_choiceMixin B S2 |} ⟩) :=
+             ⟨ ((A * S1)%type : choiceType), ((B * S2)%type : choiceType) ⟩) :=
 dswap d.
 
 
 Lemma dsym_coupling { A B : ord_choiceType } { S1 S2 : choiceType } { d : SDistr_carrier
           (F_choice_prod_obj
-             ⟨ Choice.Pack {| Choice.base := prod_eqMixin B S2; Choice.mixin := prod_choiceMixin B S2 |},
-               Choice.Pack {| Choice.base := prod_eqMixin A S1; Choice.mixin := prod_choiceMixin A S1 |} ⟩) }
+             ⟨ ((B * S2)%type : choiceType), ((A * S1)%type : choiceType) ⟩) }
       {d1 d2 }
       (Hcoupling : coupling d d1 d2) : coupling (dsym d) d2 d1.
 Proof.

From 6c369c6874a61973d852bd1f74fa7c97333b758d Mon Sep 17 00:00:00 2001
From: Sebastian Ertel <sebastian.ertel@barkhauseninstitut.org>
Date: Mon, 4 Mar 2024 21:29:49 +0100
Subject: [PATCH 04/13] porting to mathcomp 2.1.0 [part 3]. done. wont port:
 OVN.

---
 theories/Crypt/examples/DDH.v                 |    2 +-
 theories/Crypt/examples/ElGamal.v             |   11 +-
 theories/Crypt/examples/OVN.v                 | 4392 ++++++++---------
 theories/Crypt/examples/Schnorr.v             |   59 +-
 theories/Crypt/examples/ShamirSecretSharing.v |    4 +-
 theories/Crypt/examples/SigmaProtocol.v       |    2 +-
 theories/Crypt/examples/concrete_groups.v     |   46 +-
 .../Crypt/examples/package_usage_example.v    |    4 +-
 theories/Crypt/package/pkg_advantage.v        |    4 +-
 theories/Crypt/package/pkg_distr.v            |   10 +-
 theories/Crypt/package/pkg_invariants.v       |   12 +-
 theories/Crypt/package/pkg_rhl.v              |    9 +-
 theories/Crypt/rules/UniformStateProb.v       |   10 +-
 13 files changed, 2314 insertions(+), 2251 deletions(-)

diff --git a/theories/Crypt/examples/DDH.v b/theories/Crypt/examples/DDH.v
index 09e54465..2585e24f 100644
--- a/theories/Crypt/examples/DDH.v
+++ b/theories/Crypt/examples/DDH.v
@@ -56,7 +56,7 @@ Module DDH (DDHP : DDHParams) (GP : GroupParam).
 
   #[local] Existing Instance Space_pos.
 
-  Definition GroupSpace : finType := FinGroup.arg_finType gT.
+  Definition GroupSpace : finType := gT.
   #[local] Instance GroupSpace_pos : Positive #|GroupSpace|.
   Proof.
     apply /card_gt0P; by exists g.
diff --git a/theories/Crypt/examples/ElGamal.v b/theories/Crypt/examples/ElGamal.v
index a24f3d90..697390be 100644
--- a/theories/Crypt/examples/ElGamal.v
+++ b/theories/Crypt/examples/ElGamal.v
@@ -79,11 +79,10 @@ Qed.
 
 Module MyParam <: AsymmetricSchemeParams.
 
-  Definition SecurityParameter : choiceType := nat_choiceType.
-  Definition Plain  : finType := FinGroup.arg_finType gT.
-  Definition Cipher : finType :=
-    prod_finType (FinGroup.arg_finType gT) (FinGroup.arg_finType gT).
-  Definition PubKey : finType := FinGroup.arg_finType gT.
+  Definition SecurityParameter : choiceType := nat.
+  Definition Plain  : finType := gT.
+  Definition Cipher : finType := prod (gT:finType) (gT:finType).
+  Definition PubKey : finType := gT.
   Definition SecKey : finType := [finType of 'Z_q].
 
   Definition plain0 := g.
@@ -479,7 +478,7 @@ End ElGamal.
 
 Module EGP_Z3 <: ElGamalParam.
 
-  Definition gT : finGroupType := Zp_finGroupType 2.
+  Definition gT : finGroupType := 'Z_2.
   Definition ζ : {set gT} := [set : gT].
   Definition g :  gT := Zp1.
 
diff --git a/theories/Crypt/examples/OVN.v b/theories/Crypt/examples/OVN.v
index 6864d6f9..c6bff7bf 100644
--- a/theories/Crypt/examples/OVN.v
+++ b/theories/Crypt/examples/OVN.v
@@ -1,2196 +1,2196 @@
-
-From Relational Require Import OrderEnrichedCategory GenericRulesSimple.
-
-Set Warnings "-notation-overridden,-ambiguous-paths".
-From mathcomp Require Import all_ssreflect all_algebra reals distr realsum
-  fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool ssrnum
-  eqtype choice seq.
-Set Warnings "notation-overridden,ambiguous-paths".
-
-From Crypt Require Import Axioms ChoiceAsOrd SubDistr Couplings
-  UniformDistrLemmas FreeProbProg Theta_dens RulesStateProb UniformStateProb
-  pkg_composition Package Prelude SigmaProtocol Schnorr DDH.
-
-From Coq Require Import Utf8 Lia.
-From extructures Require Import ord fset fmap.
-
-From Equations Require Import Equations.
-Require Equations.Prop.DepElim.
-
-Set Equations With UIP.
-
-Set Bullet Behavior "Strict Subproofs".
-Set Default Goal Selector "!".
-Set Primitive Projections.
-
-Import Num.Def.
-Import Num.Theory.
-Import Order.POrderTheory.
-
-#[local] Open Scope ring_scope.
-Import GroupScope GRing.Theory.
-
-Import PackageNotation.
-
-Module Type GroupParam.
-
-  Parameter n : nat.
-  Parameter n_pos : Positive n.
-
-  Parameter gT : finGroupType.
-  Definition ζ : {set gT} := [set : gT].
-  Parameter g :  gT.
-  Parameter g_gen : ζ = <[g]>.
-  Parameter prime_order : prime #[g].
-
-End GroupParam.
-
-Module Type OVNParam.
-
-  Parameter N : nat.
-  Parameter N_pos : Positive N.
-
-End OVNParam.
-
-Module OVN (GP : GroupParam) (OP : OVNParam).
-Import GP.
-Import OP.
-
-Set Equations Transparent.
-
-Lemma cyclic_zeta: cyclic ζ.
-Proof.
-  apply /cyclicP. exists g. exact: g_gen.
-Qed.
-
-(* order of g *)
-Definition q' := Zp_trunc (pdiv #[g]).
-Definition q : nat := q'.+2.
-
-Lemma q_order_g : q = #[g].
-Proof.
-  unfold q, q'.
-  apply Fp_cast.
-  apply prime_order.
-Qed.
-
-Lemma q_field : (Zp_trunc #[g]) = q'.
-Proof.
-  unfold q'.
-  rewrite pdiv_id.
-  2: apply prime_order.
-  reflexivity.
-Qed.
-
-Lemma expg_g : forall x, exists ix, x = g ^+ ix.
-Proof.
-  intros.
-  apply /cycleP.
-  rewrite -g_gen.
-  apply: in_setT.
-Qed.
-
-Lemma group_prodC :
-  @commutative gT gT mulg.
-Proof.
-  move => x y.
-  destruct (expg_g x) as [ix ->].
-  destruct (expg_g y) as [iy ->].
-  repeat rewrite -expgD addnC.
-  reflexivity.
-Qed.
-
-Definition Pid : finType := [finType of 'I_n].
-Definition Secret : finType := Zp_finComRingType (Zp_trunc #[g]).
-Definition Public : finType := FinGroup.arg_finType gT.
-Definition s0 : Secret := 0.
-
-Definition Pid_pos : Positive #|Pid|.
-Proof.
-  rewrite card_ord.
-  eapply PositiveInFin.
-  apply n_pos.
-Qed.
-
-Definition Secret_pos : Positive #|Secret|.
-Proof.
-  apply /card_gt0P. exists s0. auto.
-Qed.
-
-Definition Public_pos : Positive #|Public|.
-Proof.
-  apply /card_gt0P. exists g. auto.
-Defined.
-
-#[local] Existing Instance Pid_pos.
-#[local] Existing Instance Secret_pos.
-#[local] Existing Instance Public_pos.
-
-Definition pid : choice_type := 'fin #|Pid|.
-Definition secret : choice_type := 'fin #|Secret|.
-Definition public: choice_type := 'fin #|Public|.
-
-Definition nat_to_pid : nat → pid.
-Proof.
-  move=> n.
-  eapply give_fin.
-Defined.
-
-Definition i_secret := #|Secret|.
-Definition i_public := #|Public|.
-
-Module Type CDSParams <: SigmaProtocolParams.
-  Definition Witness : finType := Secret.
-  Definition Statement : finType := prod_finType (prod_finType Public Public) Public.
-
-  Definition Witness_pos : Positive #|Witness| := Secret_pos.
-  Definition Statement_pos : Positive #|Statement|.
-  Proof.
-    unfold Statement.
-    rewrite !card_prod.
-    repeat apply Positive_prod.
-    all: apply Public_pos.
-  Qed.
-
-  Definition R : Statement -> Witness -> bool :=
-    λ (h : Statement) (x : Witness),
-      let '(gx, gy, gyxv) := h in
-      (gy^+x * g^+0 == gyxv) || (gy^+x * g^+1 == gyxv).
-
-  Lemma relation_valid_left:
-    ∀ (x : Secret) (gy : Public),
-      R (g^+x, gy, gy^+x * g^+ 0) x.
-  Proof.
-    intros x gy.
-    unfold R.
-    apply /orP ; left.
-    done.
-  Qed.
-
-  Lemma relation_valid_right:
-    ∀ (x : Secret) (gy : Public),
-      R (g^+x, gy, gy^+x * g^+ 1) x.
-  Proof.
-    intros x y.
-    unfold R.
-    apply /orP ; right.
-    done.
-  Qed.
-
-  Parameter Message Challenge Response State : finType.
-  Parameter w0 : Witness.
-  Parameter e0 : Challenge.
-  Parameter z0 : Response.
-
-  Parameter Message_pos : Positive #|Message|.
-  Parameter Challenge_pos : Positive #|Challenge|.
-  Parameter Response_pos : Positive #|Response|.
-  Parameter State_pos : Positive #|State|.
-  Parameter Bool_pos : Positive #|bool_choiceType|.
-End CDSParams.
-
-Module OVN (π2 : CDSParams) (Alg2 : SigmaProtocolAlgorithms π2).
-
-  Module Sigma1 := Schnorr GP.
-  Module Sigma2 := SigmaProtocol π2 Alg2.
-
-  Obligation Tactic := idtac.
-  Set Equations Transparent.
-
-  Definition skey_loc (i : nat) : Location := (secret; (100+i)%N).
-  Definition ckey_loc (i : nat) : Location := (public; (101+i)%N).
-
-  Definition P_i_locs (i : nat) : {fset Location} := fset [:: skey_loc i ; ckey_loc i].
-
-  Notation choiceStatement1 := Sigma1.MyAlg.choiceStatement.
-  Notation choiceWitness1 := Sigma1.MyAlg.choiceWitness.
-  Notation choiceTranscript1 := Sigma1.MyAlg.choiceTranscript.
-
-  Notation " 'pid " := pid (in custom pack_type at level 2).
-  Notation " 'pids " := (chProd pid pid) (in custom pack_type at level 2).
-  Notation " 'public " := public (in custom pack_type at level 2).
-  Notation " 'public " := public (at level 2) : package_scope.
-
-  Notation " 'chRelation1' " := (chProd choiceStatement1 choiceWitness1) (in custom pack_type at level 2).
-  Notation " 'chTranscript1' " := choiceTranscript1 (in custom pack_type at level 2).
-  Notation " 'public_key " := (chProd public choiceTranscript1) (in custom pack_type at level 2).
-  Notation " 'public_keys " := (chMap pid (chProd public choiceTranscript1)) (in custom pack_type at level 2).
-
-  Notation " 'chRelation2' " := (chProd Alg2.choiceStatement Alg2.choiceWitness) (in custom pack_type at level 2).
-  Notation " 'chTranscript2' " := Alg2.choiceTranscript (in custom pack_type at level 2).
-  Notation " 'vote " := (chProd public Alg2.choiceTranscript) (in custom pack_type at level 2).
-
-  Definition INIT : nat := 4.
-  Definition VOTE : nat := 5.
-  Definition CONSTRUCT : nat := 6.
-
-  Definition P (i : nat) : nat := 14 + i.
-  Definition Exec (i : nat) : nat := 15 + i.
-
-  Lemma not_in_domm {T S} :
-    ∀ i m,
-      i \notin @domm T S m :\ i.
-  Proof.
-    intros.
-    apply /negPn.
-    rewrite in_fsetD.
-    move=> /andP [H _].
-    move: H => /negPn H.
-    apply H.
-    by rewrite in_fset1.
-  Qed.
-
-  Lemma not_in_fsetU :
-    ∀ (l : Location) L0 L1,
-      l \notin L0  →
-      l \notin L1 →
-      l \notin L0 :|: L1.
-  Proof.
-    intros l L0 L1 h1 h2.
-    rewrite -fdisjoints1 fset1E.
-    rewrite fdisjointUl.
-    apply /andP ; split.
-    + rewrite -fdisjoints1 fset1E in h1. apply h1.
-    + rewrite -fdisjoints1 fset1E in h2. apply h2.
-  Qed.
-
-  #[local] Hint Extern 3 (is_true (?l \notin ?L0 :|: ?L1)) =>
-    apply not_in_fsetU : typeclass_instances ssprove_valid_db ssprove_invariant.
-
-  Definition get_value (m : chMap pid (chProd public choiceTranscript1)) (i : pid) :=
-    match m i with
-    | Some (v, _) => otf v
-    | _ => 1
-    end.
-
-  Canonical finGroup_com_law := Monoid.ComLaw group_prodC.
-
-  Definition compute_key
-             (m : chMap pid (chProd public choiceTranscript1))
-             (i : pid)
-    :=
-    let low := \prod_(k <- domm m | (k < i)%ord) (get_value m k) in
-    let high := \prod_(k <- domm m | (i < k)%ord) (get_value m k) in
-    low * invg high.
-
-  Definition compute_key'
-             (m : chMap pid (chProd public choiceTranscript1))
-             (i j : pid)
-             (x : Secret)
-    :=
-    if (j < i)%ord then
-      let low := \prod_(k <- domm m | (k < i)%ord) (get_value m k) in
-      let high := \prod_(k <- domm m | (i < k)%ord) (get_value m k) in
-      (g ^+ x) * low * invg high
-    else
-      let low := \prod_(k <- domm m | (k < i)%ord) (get_value m k) in
-      let high := \prod_(k <- domm m | (i < k)%ord) (get_value m k) in
-      low * invg (high * (g ^+ x)).
-
-  Lemma compute_key'_equiv
-        (i j : pid)
-        (x : Secret)
-        (zk : choiceTranscript1)
-        (keys : chMap pid (chProd public choiceTranscript1)):
-    (i != j) →
-    compute_key (setm keys j (fto (g ^+ x), zk)) i = compute_key' (remm keys j) i j x.
-  Proof.
-    intro ij_neq.
-    unfold compute_key, compute_key'.
-    simpl.
-    rewrite <- setm_rem.
-    rewrite domm_set domm_rem.
-    set X := domm _.
-    rewrite !big_fsetU1.
-    2-3: subst X; apply not_in_domm.
-    rewrite setm_rem.
-
-    have set_rem_eq : forall P x,
-      \big[finGroup_com_law/1]_(k <- X :\ j | P k)
-        get_value (setm keys j x) k =
-      \prod_(k <- X :\ j | P k)
-        get_value (remm keys j) k.
-    { intros.
-      rewrite big_seq_cond.
-      rewrite [RHS] big_seq_cond.
-      unfold get_value.
-      erewrite eq_bigr.
-      1: done.
-      intros k.
-      move => /andP [k_in _].
-      simpl.
-      rewrite setmE remmE.
-      case (k == j) eqn:eq.
-      - move: eq => /eqP eq.
-        rewrite eq in_fsetD1 in k_in.
-        move: k_in => /andP [contra].
-        rewrite eq_refl in contra.
-        discriminate.
-      - reflexivity.
-    }
-
-    case (j < i)%ord eqn:e.
-    - rewrite !e.
-      rewrite -2!mulgA.
-      f_equal.
-      1: unfold get_value ; by rewrite setmE eq_refl otf_fto.
-      f_equal.
-      + apply set_rem_eq.
-      + rewrite Ord.ltNge Ord.leq_eqVlt in e.
-        rewrite negb_or in e.
-        move: e => /andP [_ e].
-        apply negbTE in e.
-        rewrite e.
-        f_equal.
-        apply set_rem_eq.
-    - rewrite e.
-      rewrite Ord.ltNge in e.
-      apply negbT in e.
-      apply negbNE in e.
-      rewrite Ord.leq_eqVlt in e.
-      move: e => /orP [contra|e].
-      1: by rewrite contra in ij_neq.
-      rewrite e !invMg.
-      f_equal.
-      { apply set_rem_eq. }
-      rewrite group_prodC.
-      f_equal.
-      { unfold get_value. by rewrite setmE eq_refl otf_fto. }
-      f_equal.
-      apply set_rem_eq.
-  Qed.
-
-  Lemma compute_key_bij:
-    ∀ (m : chMap pid (chProd public choiceTranscript1)) (i j: pid),
-      (i != j)%ord →
-      exists (a b : nat),
-        (a != 0)%N /\ (a < q)%N /\
-      (∀ (x : Secret) zk,
-        compute_key (setm m j (fto (g ^+ x), zk)) i = g ^+ ((a * x + b) %% q)).
-  Proof.
-    intros m i j ne.
-    simpl.
-    pose low := \prod_(k <- domm m :\ j| (k < i)%ord) get_value m k.
-    pose hi := \prod_(k <- domm m :\ j| (i < k)%ord) get_value m k.
-    have Hlow : exists ilow, low = g ^+ ilow by apply expg_g.
-    have Hhi : exists ihi, hi = g ^+ ihi by apply expg_g.
-    destruct Hlow as [ilow Hlow].
-    destruct Hhi as [ihi Hhi].
-
-    have getv_remm_eq : forall P j m,
-      \prod_(k <- domm m :\ j | P k) get_value (remm m j) k =
-      \prod_(k <- domm m :\ j | P k) get_value m k.
-    {
-      clear low hi ilow ihi Hlow Hhi ne i j m.
-      intros.
-      rewrite big_seq_cond.
-      rewrite [RHS] big_seq_cond.
-      erewrite eq_bigr.
-      1: done.
-      intros k.
-      move => /andP [k_in _].
-      simpl.
-      unfold get_value.
-      rewrite remmE.
-      case (k == j) eqn:eq.
-      ++ move: eq => /eqP eq.
-          rewrite eq in_fsetD1 in k_in.
-          move: k_in => /andP [contra].
-          rewrite eq_refl in contra.
-          discriminate.
-      ++ reflexivity.
-    }
-
-    case (j < i)%ord eqn:ij_rel.
-    - exists 1%N.
-      exists (ilow + (ihi * #[g ^+ ihi].-1))%N.
-      do 2 split.
-      1: rewrite q_order_g ; apply (prime_gt1 prime_order).
-      intros x zk.
-      rewrite compute_key'_equiv.
-      2: assumption.
-      unfold compute_key'.
-      simpl.
-      rewrite ij_rel.
-      rewrite domm_rem.
-      set low' := \prod_(k0 <- _ | _) _.
-      set hi' := \prod_(k0 <- _ | _) _.
-      have -> : low' = low by apply getv_remm_eq.
-      have -> : hi' = hi by apply getv_remm_eq.
-      clear low' hi'.
-      rewrite Hhi Hlow.
-      rewrite invg_expg.
-      rewrite -!expgM.
-      rewrite -!expgD.
-      rewrite !addnA.
-      rewrite -expg_mod_order.
-      f_equal.
-      f_equal.
-      2: {
-        unfold q. rewrite Fp_cast;
-        [reflexivity | apply prime_order].
-      }
-      rewrite mul1n.
-      done.
-    - exists #[g].-1.
-      exists (ilow + (ihi * #[g ^+ ihi].-1))%N.
-      repeat split.
-      { unfold negb.
-        rewrite -leqn0.
-        case (#[g].-1 <= 0)%N eqn:e.
-        2: done.
-        have Hgt1 := (prime_gt1 prime_order).
-        rewrite -ltn_predRL in Hgt1.
-        rewrite -ltnS in Hgt1.
-        rewrite -addn1 in Hgt1.
-        rewrite leq_add2l in Hgt1.
-        eapply leq_trans in e.
-        2: apply Hgt1.
-        discriminate.
-      }
-      {
-        rewrite q_order_g.
-        rewrite ltn_predL.
-        apply (prime_gt0 prime_order).
-      }
-      intros x zk.
-      rewrite compute_key'_equiv.
-      2: assumption.
-      unfold compute_key'.
-      simpl.
-      rewrite ij_rel.
-      rewrite domm_rem.
-      set low' := \prod_(k0 <- _ | _) _.
-      set hi' := \prod_(k0 <- _ | _) _.
-      have -> : low' = low by apply getv_remm_eq.
-      have -> : hi' = hi by apply getv_remm_eq.
-      clear low' hi'.
-      rewrite Hhi Hlow.
-      rewrite invMg.
-      rewrite -expgVn.
-      rewrite !invg_expg.
-      rewrite -!expgM.
-      rewrite mulgA.
-      rewrite -!expgD.
-      rewrite !addnA.
-      rewrite -expg_mod_order.
-      f_equal.
-      f_equal.
-      2: {
-        unfold q. rewrite Fp_cast;
-        [reflexivity | apply prime_order].
-      }
-      rewrite addnAC.
-      rewrite addnC.
-      rewrite addnA.
-      done.
-  Qed.
-
-  Lemma compute_key_set_i
-        (i : pid)
-        (v : (chProd public choiceTranscript1))
-        (m : chMap pid (chProd public choiceTranscript1)):
-    compute_key (setm m i v) i = compute_key m i.
-  Proof.
-    unfold compute_key.
-    simpl.
-    case (i \in domm m) eqn:i_in.
-    all: simpl in i_in.
-    - have -> : forall v, domm (setm m i v) = domm m.
-      { intros.
-        simpl.
-        rewrite domm_set.
-        rewrite -eq_fset.
-        intro k.
-        rewrite in_fsetU1.
-        case (eq_op) eqn:e.
-        + move: e => /eqP ->.
-          by rewrite i_in.
-        + done.
-      }
-      simpl.
-      f_equal.
-      + apply eq_big.
-        1: done.
-        intros k k_lt.
-        unfold get_value.
-        rewrite setmE.
-        rewrite Ord.lt_neqAle in k_lt.
-        move: k_lt => /andP [k_lt _].
-        move: k_lt => /negbTE ->.
-        done.
-      + f_equal.
-        apply eq_big.
-        1: done.
-        intros k k_lt.
-        unfold get_value.
-        rewrite setmE.
-        rewrite Ord.lt_neqAle in k_lt.
-        move: k_lt => /andP [k_lt _].
-        rewrite eq_sym.
-        move: k_lt => /negbTE ->.
-        done.
-    - have -> : domm m = domm (remm m i).
-      {
-        simpl.
-        rewrite -eq_fset.
-        intro k.
-        rewrite domm_rem.
-        rewrite in_fsetD1.
-        case (eq_op) eqn:e.
-        + simpl.
-          move: e => /eqP ->.
-          assumption.
-        + done.
-      }
-      simpl.
-      f_equal.
-      + rewrite -setm_rem domm_set domm_rem.
-        rewrite big_fsetU1.
-        all: simpl.
-        2: by rewrite in_fsetD1 eq_refl.
-        rewrite Ord.ltxx.
-        apply eq_big.
-        1: done.
-        intros k k_lt.
-        unfold get_value.
-        rewrite setmE remmE.
-        rewrite Ord.lt_neqAle in k_lt.
-        move: k_lt => /andP [k_lt _].
-        move: k_lt => /negbTE ->.
-        done.
-      + f_equal.
-        rewrite -setm_rem domm_set domm_rem.
-        rewrite big_fsetU1.
-        all: simpl.
-        2: by rewrite in_fsetD1 eq_refl.
-        rewrite Ord.ltxx.
-        apply eq_big.
-        1: done.
-        intros k k_lt.
-        unfold get_value.
-        rewrite setmE remmE.
-        rewrite Ord.lt_neqAle in k_lt.
-        move: k_lt => /andP [k_lt _].
-        rewrite eq_sym.
-        move: k_lt => /negbTE ->.
-        done.
-  Qed.
-
-  Lemma test_bij
-        (i j : pid)
-        (m : chMap pid (chProd public choiceTranscript1))
-    :
-      (i != j)%N →
-      ∃ (f : Secret → Secret),
-      ∀ (x : Secret),
-        bijective f /\
-          (∀ zk, compute_key (setm m j (fto (g ^+ x), zk)) i = g ^+ (f x)).
-  Proof.
-    simpl.
-    intros ne.
-    have H := compute_key_bij m i j ne.
-    simpl in H.
-    destruct H as [a [b [a_pos [a_leq_q H]]]].
-    set a_ord := @inZp ((Zp_trunc #[g]).+1) a.
-    set b_ord := @inZp ((Zp_trunc #[g]).+1) b.
-    pose f' := (fun (x : Secret) => Zp_add (Zp_mul x a_ord) b_ord).
-    exists f'.
-    unfold f'. clear f'.
-    intros x.
-    have := q_order_g.
-    unfold q.
-    intros Hq.
-    split.
-    2: {
-      intro zk.
-      rewrite (H x zk).
-      apply /eqP.
-      rewrite eq_expg_mod_order.
-      apply /eqP.
-      simpl.
-      rewrite modn_small.
-      2: {
-        rewrite q_order_g.
-        apply ltn_pmod.
-        apply (prime_gt0 prime_order).
-      }
-      repeat rewrite -> Zp_cast at 3.
-      2-5: apply (prime_gt1 prime_order).
-      symmetry.
-      rewrite modn_small.
-      2: {
-        apply ltn_pmod.
-        apply (prime_gt0 prime_order).
-      }
-      simpl.
-      unfold q, q'.
-      rewrite Fp_cast.
-      2: apply prime_order.
-      rewrite modnMmr.
-      rewrite modnDm.
-      rewrite mulnC.
-      reflexivity.
-    }
-    assert (coprime q'.+2 a_ord) as a_ord_coprime.
-    {
-      rewrite -unitFpE.
-      2: rewrite Hq ; apply prime_order.
-      rewrite unitfE. simpl.
-      rewrite Zp_cast.
-      2: apply (prime_gt1 prime_order).
-      unfold q, q' in a_leq_q.
-      rewrite Fp_cast in a_leq_q.
-      2: apply prime_order.
-      rewrite modn_small.
-      2: apply a_leq_q.
-      erewrite <- inj_eq.
-      2: apply ord_inj.
-      rewrite val_Zp_nat.
-      2: {
-        rewrite pdiv_id.
-        1: apply prime_gt1.
-        1,2: rewrite Hq ; apply prime_order.
-      }
-      rewrite -> pdiv_id at 1.
-      1,2: rewrite Hq.
-      2: apply prime_order.
-      unfold q in a_leq_q.
-      rewrite modn_small.
-      2: apply a_leq_q.
-      assumption.
-    }
-    pose f' := (fun (x : Secret) => Zp_mul (Zp_add (Zp_opp b_ord) x) (Zp_inv a_ord)).
-    exists f'.
-    - intro z.
-      unfold f'. clear f'.
-      simpl.
-      rewrite Zp_addC.
-      rewrite -Zp_addA.
-      have -> : (Zp_add b_ord (Zp_opp b_ord)) = Zp0.
-      1: by rewrite Zp_addC Zp_addNz.
-      rewrite Zp_addC.
-      rewrite Zp_add0z.
-      rewrite -Zp_mulA.
-      rewrite Zp_mulzV.
-      2: {
-        rewrite -> q_field at 1.
-        assumption.
-      }
-      rewrite Zp_mulz1.
-      reflexivity.
-    - intro z.
-      unfold f'. clear f'.
-      simpl.
-      rewrite Zp_addC.
-      rewrite -Zp_mulA.
-      rewrite Zp_mul_addl.
-      have -> : (Zp_mul (Zp_inv a_ord) a_ord) = Zp1.
-      {
-        rewrite Zp_mulC.
-        rewrite Zp_mulzV.
-        + reflexivity.
-        + rewrite -> q_field at 1.
-          assumption.
-      }
-      rewrite -Zp_mul_addl.
-      rewrite Zp_mulz1.
-      rewrite Zp_addA.
-      have -> : (Zp_add b_ord (Zp_opp b_ord)) = Zp0.
-      1: by rewrite Zp_addC Zp_addNz.
-      rewrite Zp_add0z.
-      reflexivity.
-  Qed.
-
-  Lemma test_bij'
-        (i j : pid)
-        (m : chMap pid (chProd public choiceTranscript1))
-    :
-      (i != j)%N →
-      ∃ (f : secret → secret),
-      ∀ (x : secret),
-        bijective f /\
-          (∀ zk, compute_key (setm m j (fto (g ^+ otf x), zk)) i = g ^+ (otf (f x))).
-  Proof.
-    simpl.
-    intros ne.
-    have [f H] := test_bij i j m ne.
-    simpl in H.
-    exists (fun (x : secret) => fto (f (otf x))).
-    intro x.
-    destruct (H (otf x)) as [f_bij H'] ; clear H.
-    split.
-    - exists (fun z => fto ((finv f) (otf z))).
-      + apply bij_inj in f_bij.
-        intro z.
-        rewrite otf_fto.
-        apply finv_f in f_bij.
-        rewrite f_bij fto_otf.
-        reflexivity.
-      + apply bij_inj in f_bij.
-        intro z.
-        rewrite otf_fto.
-        apply f_finv in f_bij.
-        rewrite f_bij fto_otf.
-        reflexivity.
-    - intro zk.
-      specialize (H' zk).
-      rewrite otf_fto.
-      apply H'.
-  Qed.
-
-  Definition P_i_E :=
-    [interface
-      #val #[ INIT ] : 'unit → 'public_key ;
-      #val #[ CONSTRUCT ] : 'public_keys → 'unit ;
-      #val #[ VOTE ] : 'bool → 'public
-    ].
-
-  Definition Sigma1_I :=
-    [interface
-      #val #[ Sigma1.Sigma.VERIFY ] : chTranscript1 → 'bool ;
-      #val #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1
-    ].
-
-  Definition P_i (i : pid) (b : bool):
-    package (P_i_locs i)
-      Sigma1_I
-      P_i_E :=
-    [package
-        #def #[ INIT ] (_ : 'unit) : 'public_key
-        {
-          #import {sig #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1} as ZKP ;;
-          #import {sig #[ Sigma1.Sigma.VERIFY ] : chTranscript1 → 'bool} as VER ;;
-          x ← sample uniform i_secret ;;
-          #put (skey_loc i) := x ;;
-          let y := (fto (g ^+ (otf x))) : public in
-            zkp ← ZKP (y, x) ;;
-            ret (y, zkp)
-        }
-        ;
-        #def #[ CONSTRUCT ] (m : 'public_keys) : 'unit
-        {
-          #import {sig #[ Sigma1.Sigma.VERIFY ] : chTranscript1 → 'bool} as VER ;;
-          #assert (size (domm m) == n) ;;
-          let key := fto (compute_key m i) in
-          #put (ckey_loc i) := key ;;
-          @ret 'unit Datatypes.tt
-        }
-        ;
-        #def #[ VOTE ] (v : 'bool) : 'public
-        {
-          skey ← get (skey_loc i) ;;
-          ckey ← get (ckey_loc i) ;;
-          if b then
-            let vote := (otf ckey ^+ skey * g ^+ v) in
-            @ret 'public (fto vote)
-          else
-            let vote := (otf ckey ^+ skey * g ^+ (negb v)) in
-            @ret 'public (fto vote)
-        }
-    ].
-
-  Definition EXEC_i_I :=
-    [interface
-      #val #[ INIT ] : 'unit → 'public_key ;
-      #val #[ CONSTRUCT ] : 'public_keys → 'unit ;
-      #val #[ VOTE ] : 'bool → 'public ;
-      #val #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1
-    ].
-
-  Definition Exec_i_E i := [interface #val #[ Exec i ] : 'bool → 'public].
-
-  Definition Exec_i (i j : pid) (m : chMap pid (chProd public choiceTranscript1)):
-    package fset0
-      EXEC_i_I
-      (Exec_i_E i)
-    :=
-    [package
-        #def #[ Exec i ] (v : 'bool) : 'public
-        {
-          #import {sig #[ INIT ] : 'unit → 'public_key} as Init ;;
-          #import {sig #[ CONSTRUCT ] : 'public_keys → 'unit} as Construct ;;
-          #import {sig #[ VOTE ] : 'bool → 'public} as Vote ;;
-          #import {sig #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1} as ZKP ;;
-          pk ← Init Datatypes.tt ;;
-          x ← sample uniform i_secret ;;
-          let y := (fto (g ^+ (otf x))) : public in
-            zkp ← ZKP (y, x) ;;
-            let m' := setm (setm m j (y, zkp)) i pk in
-              Construct m' ;;
-              vote ← Vote v ;;
-              @ret 'public vote
-        }
-    ].
-
-  Module DDHParams <: DDHParams.
-    Definition Space := Secret.
-    Definition Space_pos := Secret_pos.
-  End DDHParams.
-
-  Module DDH := DDH DDHParams GP.
-
-  #[tactic=notac] Equations? Aux (b : bool) (i j : pid) m f':
-    package DDH.DDH_locs
-      (DDH.DDH_E :|:
-         [interface #val #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1]
-      )
-      [interface #val #[ Exec i ] : 'bool → 'public]
-    := Aux b i j m f' :=
-    [package
-        #def #[ Exec i ] (v : 'bool) : 'public
-        {
-          #import {sig #[ DDH.SAMPLE ] : 'unit → 'public × 'public × 'public} as DDH ;;
-          #import {sig #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1} as ZKP ;;
-          abc ← DDH Datatypes.tt ;;
-          x_i ← get DDH.secret_loc1 ;;
-          x_j ← get DDH.secret_loc2 ;;
-          let '(y_i, (y_j, c)) := abc in
-          let y_j' := fto (g ^+ ((finv f') x_j)) in
-            zkp1 ← ZKP (y_i, x_i) ;;
-            zkp2 ← ZKP (y_j', (finv f') x_j) ;;
-            let m' := (setm (setm m j (y_j', zkp2)) i (y_i, zkp1)) in
-            #assert (size (domm m') == n) ;;
-              @ret 'public (fto ((otf c) *  g ^+ (if b then v else (negb v))))
-        }
-    ].
-  Proof.
-    ssprove_valid.
-    all: rewrite in_fsetU.
-    all: apply /orP.
-    {
-      left.
-      unfold DDH.DDH_E.
-      rewrite fset_cons -fset0E fsetU0.
-      by apply /fset1P.
-    }
-    {
-      right.
-      rewrite fset_cons -fset0E fsetU0.
-      by apply /fset1P.
-    }
-    {
-      right.
-      rewrite fset_cons -fset0E fsetU0.
-      by apply /fset1P.
-    }
-  Qed.
-
-  Module RO1 := Sigma1.Sigma.Oracle.
-  Module RO2 := Sigma2.Oracle.
-
-  Definition combined_locations :=
-    (Sigma1.MyAlg.Sigma_locs :|: RO1.RO_locs).
-
-  Equations? Exec_i_realised b m (i j : pid) : package (P_i_locs i :|: combined_locations) [interface] (Exec_i_E i) :=
-    Exec_i_realised b m i j :=
-      {package (Exec_i i j m) ∘ (par ((P_i i b) ∘ (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO))
-                                      (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO))}.
-  Proof.
-    ssprove_valid.
-    10: apply fsub0set.
-    8:{ rewrite fsetUid. apply fsubsetxx. }
-    9: apply fsubsetxx.
-    7:{ erewrite fsetUid. apply fsubsetxx. }
-    4: apply fsubsetUr.
-    3: apply fsubsetUl.
-    all: unfold combined_locations.
-    - apply fsubsetUl.
-    - apply fsubsetUr.
-    - eapply fsubset_trans. 2: eapply fsubsetUr.
-      apply fsubsetUl.
-    - eapply fsubset_trans. 2: eapply fsubsetUr.
-      apply fsubsetUr.
-    - unfold EXEC_i_I, P_i_E, Sigma1_I.
-      rewrite !fset_cons.
-      rewrite -!fsetUA.
-      repeat apply fsetUS.
-      rewrite -fset0E fsetU0 fset0U.
-      apply fsubsetUr.
-  Qed.
-
-
-  Lemma loc_helper_commit i:
-    Sigma1.MyAlg.commit_loc \in P_i_locs i :|: combined_locations.
-  Proof.
-    unfold combined_locations.
-    unfold Sigma1.MyAlg.Sigma_locs.
-    rewrite in_fsetU.
-    apply /orP ; right.
-    rewrite fset_cons.
-    rewrite in_fsetU.
-    apply /orP ; left.
-    rewrite in_fsetU1.
-    apply /orP ; left.
-    done.
-  Qed.
-
-  Lemma loc_helper_queries i:
-    RO1.queries_loc \in P_i_locs i :|: combined_locations.
-  Proof.
-    unfold combined_locations.
-    unfold RO1.RO_locs.
-    rewrite in_fsetU.
-    apply /orP ; right.
-    rewrite fset_cons.
-    rewrite in_fsetU.
-    apply /orP ; right.
-    rewrite in_fsetU1.
-    apply /orP ; left.
-    done.
-  Qed.
-
-  Lemma loc_helper_skey i:
-    skey_loc i \in P_i_locs i :|: combined_locations.
-  Proof.
-    unfold P_i_locs.
-    rewrite in_fsetU.
-    apply /orP ; left.
-    rewrite fset_cons.
-    rewrite in_fsetU1.
-    apply /orP ; left.
-    done.
-  Qed.
-
-  Lemma loc_helper_ckey i:
-    ckey_loc i \in P_i_locs i :|: combined_locations.
-  Proof.
-    unfold P_i_locs.
-    rewrite in_fsetU.
-    apply /orP ; left.
-    rewrite !fset_cons.
-    rewrite in_fsetU1.
-    apply /orP ; right.
-    rewrite in_fsetU1.
-    apply /orP ; left.
-    done.
-  Qed.
-
-  #[local] Hint Resolve loc_helper_commit : loc_db.
-  #[local] Hint Resolve loc_helper_queries : loc_db.
-  #[local] Hint Resolve loc_helper_skey: loc_db.
-  #[local] Hint Resolve loc_helper_ckey: loc_db.
-
-  #[program] Definition Exec_i_realised_code m (i j : pid) (vote : 'bool):
-    code (P_i_locs i :|: combined_locations) [interface] 'public :=
-    {code
-     x ← sample uniform i_secret ;;
-     #put skey_loc i := x ;;
-     #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x)))) (otf x) ;;
-     x1 ← sample uniform Sigma1.MyAlg.i_witness ;;
-     #put Sigma1.MyAlg.commit_loc := x1 ;;
-     #put RO1.queries_loc := emptym ;;
-     x2 ← get RO1.queries_loc ;;
-     match x2 (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)))) with
-     | Some a =>
-         v ← get Sigma1.MyAlg.commit_loc ;;
-         x3 ← sample uniform i_secret ;;
-         #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x3)))) (otf x3) ;;
-         x5 ← sample uniform Sigma1.MyAlg.i_witness ;;
-         #put Sigma1.MyAlg.commit_loc := x5 ;;
-         #put RO1.queries_loc := emptym ;;
-         v0 ← get RO1.queries_loc ;;
-         match v0 (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) with
-         | Some a0 =>
-             x6 ← get Sigma1.MyAlg.commit_loc ;;
-             let x4 :=
-             (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3))))
-             in
-         #assert eqn
-                    (size
-                       (domm (T:=[ordType of 'I_#|'I_n|]) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|))
-                          (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
-                             (fto (expgn_rec (T:=gT) g (otf x)),
-                             (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;;
-          #put ckey_loc i := fto
-                              (compute_key
-                                 (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
-                                    (fto (expgn_rec (T:=gT) g (otf x)),
-                                    (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a,
-                                    fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;;
-         v0 ← get skey_loc i ;;
-         v1 ← get ckey_loc i ;;
-         @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote))
-         | None =>
-             a0 ← sample uniform RO1.i_random ;;
-             #put RO1.queries_loc := setm v0
-                                      (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) a0 ;;
-             x6 ← get Sigma1.MyAlg.commit_loc ;;
-             let x4 := (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in
-         #assert eqn
-                    (size
-                       (domm (T:=[ordType of 'I_#|'I_n|]) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|))
-                          (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
-                             (fto (expgn_rec (T:=gT) g (otf x)),
-                             (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;;
-          #put ckey_loc i := fto
-                              (compute_key
-                                 (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
-                                    (fto (expgn_rec (T:=gT) g (otf x)),
-                                    (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a,
-                                    fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;;
-         v0 ← get skey_loc i ;;
-         v1 ← get ckey_loc i ;;
-         @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote))
-         end
-     | None =>
-         a ← sample uniform RO1.i_random ;;
-         #put RO1.queries_loc := setm x2
-                                  (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)))) a ;;
-         v ← get Sigma1.MyAlg.commit_loc ;;
-         x3 ← sample uniform i_secret ;;
-         #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x3)))) (otf x3) ;;
-         x5 ← sample uniform Sigma1.MyAlg.i_witness ;;
-         #put Sigma1.MyAlg.commit_loc := x5 ;;
-         #put RO1.queries_loc := emptym ;;
-         v0 ← get RO1.queries_loc ;;
-         match v0 (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) with
-         | Some a0 =>
-             x6 ← get Sigma1.MyAlg.commit_loc ;;
-             let x4 := (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in
-             #assert eqn
-                 (size
-                 (domm (T:=[ordType of 'I_#|'I_n|]) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|))
-                         (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
-                             (fto (expgn_rec (T:=gT) g (otf x)),
-                                 (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;;
-             #put ckey_loc i := fto
-                                 (compute_key
-                                     (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
-                                             (fto (expgn_rec (T:=gT) g (otf x)),
-                                             (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a,
-                                                 fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;;
-            v0 ← get skey_loc i ;;
-            v1 ← get ckey_loc i ;;
-            @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote))
-        | None =>
-                   a0 ← sample uniform RO1.i_random ;;
-                   #put RO1.queries_loc := setm v0
-                                            (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) a0 ;;
-                   x6 ← get Sigma1.MyAlg.commit_loc ;;
-                   let x4 := (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in
-         #assert eqn
-                    (size
-                       (domm (T:=[ordType of 'I_#|'I_n|]) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|))
-                          (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
-                             (fto (expgn_rec (T:=gT) g (otf x)),
-                             (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;;
-          #put ckey_loc i := fto
-                              (compute_key
-                                 (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
-                                    (fto (expgn_rec (T:=gT) g (otf x)),
-                                    (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a,
-                                    fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;;
-         v0 ← get skey_loc i ;;
-         v1 ← get ckey_loc i ;;
-         @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote))
-               end
-     end
-    }.
-  Next Obligation.
-    intros.
-    ssprove_valid ; auto with loc_db.
-    destruct (v1 _) ; ssprove_valid ; auto with loc_db.
-    - destruct (v5 _) ; ssprove_valid ; auto with loc_db.
-    - destruct (v6 _) ; ssprove_valid ; auto with loc_db.
-  Qed.
-
-  #[program] Definition Exec_i_realised_code_runnable m (i j : pid) (vote : 'bool):
-    code (P_i_locs i :|: combined_locations) [interface] 'public :=
-    {code
-     x ← sample uniform i_secret ;;
-     #put skey_loc i := x ;;
-     #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x)))) (otf x) ;;
-     x1 ← sample uniform Sigma1.MyAlg.i_witness ;;
-     #put Sigma1.MyAlg.commit_loc := x1 ;;
-     x2 ← get RO1.queries_loc ;;
-         a ← sample uniform RO1.i_random ;;
-         #put RO1.queries_loc := setm x2
-                                  (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)))) a ;;
-         v ← get Sigma1.MyAlg.commit_loc ;;
-         x3 ← sample uniform i_secret ;;
-         #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x3)))) (otf x3) ;;
-         x5 ← sample uniform Sigma1.MyAlg.i_witness ;;
-         #put Sigma1.MyAlg.commit_loc := x5 ;;
-         v0 ← get RO1.queries_loc ;;
-                   a0 ← sample uniform RO1.i_random ;;
-                   #put RO1.queries_loc := setm v0
-                                            (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) a0 ;;
-                   x6 ← get Sigma1.MyAlg.commit_loc ;;
-                   let x4 := (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in
-         #assert eqn
-                    (size
-                       (domm (T:=[ordType of 'I_#|'I_n|]) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|))
-                          (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
-                             (fto (expgn_rec (T:=gT) g (otf x)),
-                             (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;;
-          #put ckey_loc i := fto
-                              (compute_key
-                                 (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
-                                    (fto (expgn_rec (T:=gT) g (otf x)),
-                                    (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a,
-                                    fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;;
-         v0 ← get skey_loc i ;;
-         v1 ← get ckey_loc i ;;
-         @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote))
-    }.
-  Next Obligation.
-    intros.
-    ssprove_valid ; auto with loc_db.
-  Qed.
-
-  Lemma code_pkg_equiv m i j (vote : 'bool):
-    ⊢
-    ⦃ λ '(h₀, h₁), h₀ = h₁ ⦄
-    get_op_default (Exec_i_realised true m i j) ((Exec i), ('bool, 'public)) vote
-    ≈
-    Exec_i_realised_code m i j vote
-    ⦃ eq ⦄.
-  Proof.
-    unfold Exec_i_realised.
-    rewrite get_op_default_link.
-    erewrite get_op_default_spec.
-    2: {
-      cbn.
-      rewrite eqnE eq_refl.
-      done.
-    }
-    ssprove_code_simpl.
-    simpl.
-    repeat choice_type_eqP_handle.
-    rewrite !cast_fun_K.
-    ssprove_code_simpl.
-    simpl.
-    ssprove_code_simpl.
-    ssprove_code_simpl_more.
-    simpl.
-    ssprove_sync_eq=>x.
-    simpl.
-    ssprove_code_simpl_more.
-    ssprove_sync_eq.
-    ssprove_sync_eq=>rel1.
-    ssprove_sync_eq=>r1.
-    ssprove_sync_eq.
-    ssprove_code_simpl.
-
-    ssprove_contract_put_get_lhs.
-    ssprove_contract_put_get_rhs.
-
-    ssprove_sync_eq.
-    simpl.
-
-    ssprove_code_simpl.
-    ssprove_sync_eq=>a.
-    ssprove_sync_eq.
-    ssprove_sync_eq=>v.
-
-    apply r_uniform_bij with (f := (fun (x : Arit (@uniform i_secret Sigma1.MyParam.Witness_pos)) => (x : Arit (@uniform i_secret Secret_pos)))).
-    1: exact (inv_bij (fun x => erefl)).
-    intros.
-
-    match goal with
-    | |- context [⊢ ⦃ _ ⦄ bind (assertD ?v ?z) ?y ≈ ?x  ⦃ _ ⦄] =>
-        set (temp1 := x) ; set (temp2 := y) ;
-        set (temp3 := z) ; set (temp4 := v) in *
-    end.
-
-    apply (r_transL  (@assertD _ temp4 (fun z => x ← temp3 z ;; temp2 x))).
-    1:{
-      eapply r_transR.
-      1:{
-        apply r_bind_assertD_sym.
-      }
-      apply rreflexivity_rule.
-    }
-    subst temp1 temp2 temp3 temp4.
-    
-    apply (@r_assertD_same (chFin (mkpos #|gT|)) _).
-    intros.
-
-    simpl.
-    ssprove_sync_eq=>a0.
-    ssprove_sync_eq.
-
-    ssprove_contract_put_get_lhs.
-    ssprove_contract_put_get_rhs.
-    
-    ssprove_sync_eq.
-    simpl.
-
-    ssprove_sync_eq=>a1.
-    ssprove_sync_eq.
-    ssprove_sync_eq=>a2.
-
-    match goal with
-    | |- context [⊢ ⦃ _ ⦄ bind (assertD ?v ?z) ?y ≈ ?x  ⦃ _ ⦄] =>
-        set (temp1 := x) ; set (temp2 := y) ;
-        set (temp3 := z) ; set (temp4 := v) in *
-    end.
-    
-    apply (r_transL  (@assertD _ temp4 (fun z => x ← temp3 z ;; temp2 x))).
-    1:{
-      eapply r_transR.
-      1:{
-        apply r_bind_assertD_sym.
-      }
-      apply rreflexivity_rule.
-    }
-    subst temp1 temp2 temp3 temp4. hnf.
-
-    apply r_assertD_same.
-    intros.
-
-    ssprove_sync_eq.
-    ssprove_sync_eq=>a3.
-    ssprove_sync_eq=>a4.
-    apply r_ret.
-    intros. subst.
-    reflexivity.
-  Qed.
-
-  #[tactic=notac] Equations? Aux_realised (b : bool) (i j : pid) m f' :
-    package (DDH.DDH_locs :|: P_i_locs i :|: combined_locations) Game_import [interface #val #[ Exec i ] : 'bool → 'public] :=
-    Aux_realised b i j m f' := {package Aux b i j m f' ∘ (par DDH.DDH_real (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) }.
-  Proof.
-    ssprove_valid.
-    4:{ rewrite fsetUid. rewrite -fset0E. apply fsub0set. }
-    6: apply fsubsetxx.
-    3:{ rewrite -fsetUA. apply fsubsetxx. }
-    4:{ rewrite -fsetUA. apply fsubsetUl. }
-    all: unfold combined_locations.
-    - eapply fsubset_trans. 2: apply fsubsetUr.
-      apply fsubsetUl.
-    - eapply fsubset_trans. 2: apply fsubsetUr.
-      apply fsubsetUr.
-    - unfold DDH.DDH_E.
-      apply fsetUS.
-      rewrite !fset_cons.
-      apply fsubsetUr.
-  Qed.
-
-  #[tactic=notac] Equations? Aux_ideal_realised (b : bool) (i j : pid) m f' :
-    package (DDH.DDH_locs :|: P_i_locs i :|: combined_locations) Game_import [interface #val #[ Exec i ] : 'bool → 'public] :=
-    Aux_ideal_realised b i j m f' := {package Aux b i j m f' ∘ (par DDH.DDH_ideal (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) }.
-  Proof.
-    ssprove_valid.
-    4:{ rewrite fsetUid. rewrite -fset0E. apply fsub0set. }
-    6: apply fsubsetxx.
-    3:{ rewrite -fsetUA. apply fsubsetxx. }
-    4:{ rewrite -fsetUA. apply fsubsetUl. }
-    all: unfold combined_locations.
-    - eapply fsubset_trans. 2: apply fsubsetUr.
-      apply fsubsetUl.
-    - eapply fsubset_trans. 2: apply fsubsetUr.
-      apply fsubsetUr.
-    - unfold DDH.DDH_E.
-      apply fsetUS.
-      rewrite !fset_cons.
-      apply fsubsetUr.
-  Qed.
-
-  Notation inv i := (heap_ignore (P_i_locs i :|: DDH.DDH_locs)).
-
-  #[local] Hint Extern 50 (_ = code_link _ _) =>
-    rewrite code_link_scheme
-    : ssprove_code_simpl.
-
-  (** We extend swapping to schemes.
-    This means that the ssprove_swap tactic will be able to swap any command
-    with a scheme without asking a proof from the user.
-  *)
-  #[local] Hint Extern 40 (⊢ ⦃ _ ⦄ x ← ?s ;; y ← cmd _ ;; _ ≈ _ ⦃ _ ⦄) =>
-    eapply r_swap_scheme_cmd ; ssprove_valid
-    : ssprove_swap.
-
-  Lemma P_i_aux_equiv (i j : pid) m:
-    fdisjoint Sigma1.MyAlg.Sigma_locs DDH.DDH_locs →
-    i != j →
-    (∃ f,
-      bijective f ∧
-      (∀ b, (Exec_i_realised b m i j) ≈₀ Aux_realised b i j m f)).
-  Proof.
-    intros Hdisj ij_neq.
-    have [f' Hf] := test_bij' i j m ij_neq.
-    simpl in Hf.
-    exists f'.
-    split.
-    {
-      assert ('I_#|'Z_#[g]|) as x.
-      { rewrite card_ord.
-        eapply Ordinal.
-        rewrite ltnS.
-        apply ltnSn.
-      }
-      specialize (Hf x).
-      destruct Hf.
-      assumption.
-    }
-    intro b.
-    eapply eq_rel_perf_ind with (inv := inv i).
-    {
-      ssprove_invariant.
-      rewrite -!fsetUA.
-      apply fsetUS.
-      do 2 (apply fsubsetU ; apply /orP ; right).
-      apply fsubsetUl.
-    }
-    simplify_eq_rel v.
-    rewrite !setmE.
-    rewrite !eq_refl.
-    ssprove_code_simpl.
-    repeat simplify_linking.
-    ssprove_sync => x_i.
-
-    rewrite !cast_fun_K.
-    ssprove_code_simpl.
-    ssprove_code_simpl_more.
-    
-    ssprove_swap_seq_rhs [:: 4 ; 5 ; 6 ; 7]%N.
-    ssprove_swap_seq_rhs [:: 2 ; 3 ; 4 ; 5 ; 6]%N.
-    ssprove_swap_seq_rhs [:: 0 ; 1 ; 2 ; 3 ; 4 ; 5]%N.
-    ssprove_contract_put_get_rhs.
-    apply r_put_rhs.
-    ssprove_swap_seq_lhs [:: 0 ; 1 ; 2 ; 3]%N.
-    unfold Sigma1.MyParam.R.
-    have Hord : ∀ x, (nat_of_ord x) = (nat_of_ord (otf x)).
-    {
-      unfold otf.
-      intros n x.
-      rewrite enum_val_ord.
-      done.
-    }
-    rewrite -Hord otf_fto eq_refl.
-    simpl.
-    ssprove_sync => r_i.
-    apply r_put_vs_put.
-    ssprove_restore_pre.
-    { ssprove_invariant.
-      apply preserve_update_r_ignored_heap_ignore.
-      - unfold DDH.DDH_locs.
-        rewrite in_fsetU.
-        apply /orP ; right.
-        rewrite fset_cons.
-        rewrite in_fsetU.
-        apply /orP ; left.
-        by apply /fset1P.
-      - apply preserve_update_mem_nil.
-    }
-    ssprove_sync.
-    ssprove_swap_seq_lhs [:: 0 ]%N.
-    ssprove_swap_seq_rhs [:: 2 ; 1 ; 0]%N.
-    ssprove_sync => queries.
-    destruct (queries (Sigma1.Sigma.prod_assoc (fto (g ^+ x_i), fto (g ^+ otf r_i)))) eqn:e.
-    all: rewrite e; simpl.
-    all: ssprove_code_simpl_more.
-    - ssprove_swap_seq_lhs [:: 0 ; 1 ; 2 ; 3 ; 4 ; 5]%N.
-      ssprove_swap_seq_lhs [:: 0 ; 1 ]%N.
-      eapply r_uniform_bij.
-      { apply Hf.
-        + rewrite card_ord.
-          rewrite Zp_cast.
-          2: apply (prime_gt1 prime_order).
-          eapply Ordinal.
-          apply (prime_gt1 prime_order).
-      }
-      intro x.
-      specialize (Hf x).
-      destruct Hf as [bij_f Hf].
-      apply bij_inj in bij_f.
-      apply finv_f in bij_f.
-      ssprove_contract_put_get_rhs.
-      rewrite bij_f.
-      rewrite -Hord !otf_fto !eq_refl.
-      simpl.
-      apply r_put_rhs.
-      ssprove_restore_pre.
-      {
-        apply preserve_update_r_ignored_heap_ignore.
-        - unfold DDH.DDH_locs.
-          rewrite !fset_cons.
-          rewrite !in_fsetU.
-          apply /orP ; right.
-          apply /orP ; right.
-          apply /orP ; left.
-          by apply /fset1P.
-        - apply preserve_update_mem_nil.
-      }
-      apply r_get_remember_lhs.
-      intros ?.
-      apply r_get_remember_rhs.
-      intros ?.
-      ssprove_forget_all.
-      ssprove_sync=>r_j.
-      apply r_put_vs_put.
-      ssprove_restore_pre.
-      1: ssprove_invariant.
-      clear e queries.
-      ssprove_sync.
-      ssprove_swap_seq_lhs [:: 0]%N.
-      ssprove_sync=>queries.
-      destruct (queries (Sigma1.Sigma.prod_assoc (fto (g ^+ x), fto (g ^+ otf r_j)))) eqn:e.
-      all: rewrite e.
-      all: ssprove_code_simpl.
-      all: ssprove_code_simpl_more.
-      + ssprove_swap_seq_lhs [:: 0 ; 1]%N.
-        simpl.
-        apply r_get_remember_lhs.
-        intros ?.
-        apply r_get_remember_rhs.
-        intros ?.
-        ssprove_forget_all.
-        apply r_assertD.
-        {
-          intros ??.
-          rewrite !domm_set.
-          done.
-        }
-        intros _ _.
-        ssprove_swap_lhs 1%N.
-        {
-          move: H0 => /eqP.
-          erewrite eqn_add2r.
-          intros contra.
-          discriminate.
-        }
-        ssprove_contract_put_get_lhs.
-        apply r_put_lhs.
-        ssprove_contract_put_get_lhs.
-        apply r_put_lhs.
-        ssprove_restore_pre.
-        {
-          repeat apply preserve_update_l_ignored_heap_ignore.
-          1,2: unfold P_i_locs ; rewrite in_fsetU.
-          1,2: apply /orP ; left ; rewrite !fset_cons ;
-               rewrite -fset0E fsetU0 ; rewrite in_fsetU.
-          - apply /orP ; right.
-            by apply /fset1P.
-          - apply /orP ; left.
-            by apply /fset1P.
-          - apply preserve_update_mem_nil.
-        }
-        rewrite otf_fto.
-        rewrite compute_key_set_i.
-        set zk := (fto (g ^+ x), fto (g ^+ otf r_j), s1, fto (otf x2 + otf s1 * otf x)).
-        clearbody zk.
-        specialize (Hf zk).
-        rewrite !Hord.
-        rewrite Hf.
-        rewrite -!Hord.
-        rewrite -expgM.
-        rewrite mulnC.
-        case b; apply r_ret ; done.
-      + ssprove_swap_seq_lhs [:: 0 ; 1 ; 2 ; 3]%N.
-        simpl.
-        ssprove_sync=>e_j.
-        apply r_put_vs_put.
-        apply r_get_remember_lhs.
-        intros ?.
-        apply r_get_remember_rhs.
-        intros ?.
-        ssprove_forget_all.
-        apply r_assertD.
-        {
-          intros ??.
-          rewrite !domm_set.
-          done.
-        }
-        intros _ _.
-        ssprove_swap_lhs 1%N.
-        {
-          move: H0 => /eqP.
-          erewrite eqn_add2r.
-          intros contra.
-          discriminate.
-        }
-        ssprove_contract_put_get_lhs.
-        apply r_put_lhs.
-        ssprove_contract_put_get_lhs.
-        apply r_put_lhs.
-        ssprove_restore_pre.
-        {
-          repeat apply preserve_update_l_ignored_heap_ignore.
-          1,2: unfold P_i_locs ; rewrite in_fsetU.
-          1,2: apply /orP ; left ; rewrite !fset_cons ;
-               rewrite -fset0E fsetU0 ; rewrite in_fsetU.
-          - apply /orP ; right.
-            by apply /fset1P.
-          - apply /orP ; left.
-            by apply /fset1P.
-          - ssprove_invariant.
-        }
-        rewrite otf_fto.
-        rewrite compute_key_set_i.
-        set zk := (fto (g ^+ x), fto (g ^+ otf r_j), e_j, fto (otf x2 + otf e_j * otf x)).
-        clearbody zk.
-        specialize (Hf zk).
-        rewrite !Hord.
-        rewrite Hf.
-        rewrite -!Hord.
-        rewrite -expgM.
-        rewrite mulnC.
-        case b; apply r_ret ; done.
-    - ssprove_swap_seq_lhs [:: 0 ; 1 ; 2 ; 3 ; 4 ; 5  ; 6 ; 7]%N.
-      ssprove_swap_seq_lhs [:: 2 ; 1 ; 0 ]%N.
-      eapply r_uniform_bij.
-      { apply Hf.
-        + rewrite card_ord.
-          rewrite Zp_cast.
-          2: apply (prime_gt1 prime_order).
-          eapply Ordinal.
-          apply (prime_gt1 prime_order).
-      }
-      intro x.
-      specialize (Hf x).
-      destruct Hf as [bij_f Hf].
-      apply bij_inj in bij_f.
-      apply finv_f in bij_f.
-      ssprove_contract_put_get_rhs.
-      rewrite bij_f.
-      rewrite -Hord !otf_fto !eq_refl.
-      simpl.
-      apply r_put_rhs.
-      ssprove_restore_pre.
-      {
-        apply preserve_update_r_ignored_heap_ignore.
-        - unfold DDH.DDH_locs.
-          rewrite !fset_cons.
-          rewrite !in_fsetU.
-          apply /orP ; right.
-          apply /orP ; right.
-          apply /orP ; left.
-          by apply /fset1P.
-        - apply preserve_update_mem_nil.
-      }
-      ssprove_sync=>e_i.
-      apply r_put_vs_put.
-      apply r_get_remember_lhs.
-      intros ?.
-      apply r_get_remember_rhs.
-      intros ?.
-      ssprove_forget_all.
-      rewrite -Hord eq_refl.
-      simpl.
-      ssprove_sync=>r_j.
-      apply r_put_vs_put.
-      ssprove_restore_pre.
-      1: ssprove_invariant.
-      clear e queries.
-      ssprove_sync.
-      ssprove_swap_seq_lhs [:: 0]%N.
-      ssprove_sync=>queries.
-      destruct (queries (Sigma1.Sigma.prod_assoc (fto (g ^+ x), fto (g ^+ otf r_j)))) eqn:e.
-      all: rewrite e.
-      all: ssprove_code_simpl.
-      all: ssprove_code_simpl_more.
-      + ssprove_swap_seq_lhs [:: 0 ; 1]%N.
-        simpl.
-        apply r_get_remember_lhs.
-        intros ?.
-        apply r_get_remember_rhs.
-        intros ?.
-        ssprove_forget_all.
-        apply r_assertD.
-        {
-          intros ??.
-          rewrite !domm_set.
-          done.
-        }
-        intros _ _.
-        ssprove_swap_lhs 1%N.
-        {
-          move: H0 => /eqP.
-          erewrite eqn_add2r.
-          intros contra.
-          discriminate.
-        }
-        ssprove_contract_put_get_lhs.
-        apply r_put_lhs.
-        ssprove_contract_put_get_lhs.
-        apply r_put_lhs.
-        ssprove_restore_pre.
-        {
-          repeat apply preserve_update_l_ignored_heap_ignore.
-          1,2: unfold P_i_locs ; rewrite in_fsetU.
-          1,2: apply /orP ; left ; rewrite !fset_cons ;
-               rewrite -fset0E fsetU0 ; rewrite in_fsetU.
-          - apply /orP ; right.
-            by apply /fset1P.
-          - apply /orP ; left.
-            by apply /fset1P.
-          - apply preserve_update_mem_nil.
-        }
-        rewrite otf_fto.
-        rewrite compute_key_set_i.
-        set zk := (fto (g ^+ x), fto (g ^+ otf r_j), s, fto (otf x2 + otf s * otf x)).
-        clearbody zk.
-        specialize (Hf zk).
-        rewrite !Hord.
-        rewrite Hf.
-        rewrite -!Hord.
-        rewrite -expgM.
-        rewrite mulnC.
-        case b; apply r_ret ; done.
-      + ssprove_swap_seq_lhs [:: 0 ; 1 ; 2 ; 3]%N.
-        simpl.
-        ssprove_sync=>e_j.
-        apply r_put_vs_put.
-        apply r_get_remember_lhs.
-        intros ?.
-        apply r_get_remember_rhs.
-        intros ?.
-        ssprove_forget_all.
-        apply r_assertD.
-        {
-          intros ??.
-          rewrite !domm_set.
-          done.
-        }
-        intros _ _.
-        ssprove_swap_lhs 1%N.
-        {
-          move: H0 => /eqP.
-          erewrite eqn_add2r.
-          intros contra.
-          discriminate.
-        }
-        ssprove_contract_put_get_lhs.
-        apply r_put_lhs.
-        ssprove_contract_put_get_lhs.
-        apply r_put_lhs.
-        ssprove_restore_pre.
-        {
-          repeat apply preserve_update_l_ignored_heap_ignore.
-          1,2: unfold P_i_locs ; rewrite in_fsetU.
-          1,2: apply /orP ; left ; rewrite !fset_cons ;
-               rewrite -fset0E fsetU0 ; rewrite in_fsetU.
-          - apply /orP ; right.
-            by apply /fset1P.
-          - apply /orP ; left.
-            by apply /fset1P.
-          - ssprove_invariant.
-        }
-        rewrite otf_fto.
-        rewrite compute_key_set_i.
-        set zk := (fto (g ^+ x), fto (g ^+ otf r_j), e_j, fto (otf x2 + otf e_j * otf x)).
-        clearbody zk.
-        specialize (Hf zk).
-        rewrite !Hord.
-        rewrite Hf.
-        rewrite -!Hord.
-        rewrite -expgM.
-        rewrite mulnC.
-        case b; apply r_ret ; done.
-  Qed.
-
-  Lemma Hord (x : secret): (nat_of_ord x) = (nat_of_ord (otf x)).
-  Proof.
-      unfold otf.
-      rewrite enum_val_ord.
-      done.
-  Qed.
-
-  Lemma vote_hiding_bij (c : secret) (v : bool):
-    fto (otf (fto (g ^+ c)) * g ^+ v) =
-      fto
-        (otf (fto (g ^+ (if v then fto (Zp_add (otf c) Zp1) else fto (Zp_add (otf c) (Zp_opp Zp1))))) *
-           g ^+ (~~ v)).
-  Proof.
-    f_equal.
-    rewrite !otf_fto.
-    rewrite -!expgD.
-    have h' : ∀ (x : Secret), nat_of_ord x = (nat_of_ord (fto x)).
-    {
-        unfold fto.
-        intros k.
-        rewrite enum_rank_ord.
-        done.
-    }
-    case v.
-    ++ apply /eqP.
-       rewrite eq_expg_mod_order.
-       rewrite addn0.
-       have h : ∀ (x : secret), (((nat_of_ord x) + 1) %% q'.+2)%N = (nat_of_ord (Zp_add (otf x) Zp1)).
-       {
-         intro k.
-         unfold Zp_add.
-         simpl.
-         rewrite -Hord.
-         apply /eqP.
-         rewrite eq_sym.
-         apply /eqP.
-         rewrite -> Zp_cast at 2.
-         2: apply (prime_gt1 prime_order).
-         rewrite -> Zp_cast at 1.
-         2: apply (prime_gt1 prime_order).
-         rewrite modnDmr.
-         rewrite Fp_cast.
-         2: apply prime_order.
-         reflexivity.
-       }
-       rewrite -h'.
-       rewrite -h.
-       rewrite -modn_mod.
-       rewrite Fp_cast.
-       2: apply prime_order.
-       1: apply eq_refl.
-    ++ apply /eqP.
-       rewrite eq_expg_mod_order.
-       rewrite addn0.
-       unfold Zp_add, Zp_opp, Zp1.
-       simpl.
-       repeat rewrite -> Zp_cast at 12.
-       2-4: apply (prime_gt1 prime_order).
-       rewrite -!Hord.
-       have -> : (#[g] - 1 %% #[g])%N = #[g].-1.
-       { rewrite modn_small.
-         2: apply (prime_gt1 prime_order).
-         by rewrite -subn1.
-       }
-       rewrite modn_small.
-       2:{
-         destruct c as [c Hc].
-         move: Hc.
-         simpl.
-         unfold DDH.i_space, DDHParams.Space, Secret.
-         rewrite card_ord.
-         rewrite Zp_cast.
-         2: apply (prime_gt1 prime_order).
-         done.
-       }
-       have -> : (#[g].-1 %% #[g])%N = #[g].-1.
-       {
-         rewrite modn_small.
-         1: reflexivity.
-         apply ltnSE.
-         rewrite -subn1 -2!addn1.
-         rewrite subnK.
-         2: apply (prime_gt0 prime_order).
-         rewrite addn1.
-         apply ltnSn.
-       }
-       rewrite -h'.
-       simpl.
-       rewrite -> Zp_cast at 9.
-       2: apply (prime_gt1 prime_order).
-       rewrite modnDml.
-       rewrite -subn1.
-       rewrite -addnA.
-       rewrite subnK.
-       2: apply (prime_gt0 prime_order).
-       rewrite -modnDmr.
-       rewrite modnn.
-       rewrite addn0.
-       rewrite modn_small.
-       1: apply eq_refl.
-       destruct c as [h Hc].
-       move: Hc.
-       unfold DDH.i_space, DDHParams.Space, Secret.
-       simpl.
-       rewrite card_ord.
-       rewrite Zp_cast.
-       2: apply (prime_gt1 prime_order).
-       done.
-  Qed.
-
-  Lemma vote_hiding (i j : pid) m:
-    i != j →
-    ∀ LA A ϵ_DDH,
-      ValidPackage LA [interface #val #[ Exec i ] : 'bool → 'public] A_export A →
-      fdisjoint Sigma1.MyAlg.Sigma_locs DDH.DDH_locs →
-      fdisjoint LA DDH.DDH_locs →
-      fdisjoint LA (P_i_locs i) →
-      fdisjoint LA combined_locations →
-      (∀ D, DDH.ϵ_DDH D <= ϵ_DDH) →
-    AdvantageE (Exec_i_realised true m i j) (Exec_i_realised false m i j) A <= ϵ_DDH + ϵ_DDH.
-  Proof.
-    intros ij_neq LA A ϵ_DDH Va Hdisj Hdisj2 Hdisj3 Hdisj4 Dadv.
-    have [f' [bij_f Hf]] := P_i_aux_equiv i j m Hdisj ij_neq.
-    ssprove triangle (Exec_i_realised true m i j) [::
-      (Aux_realised true i j m f').(pack) ;
-      (Aux true i j m f') ∘ (par DDH.DDH_ideal (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) ;
-      (Aux false i j m f') ∘ (par DDH.DDH_ideal (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) ;
-      (Aux_realised false i j m f').(pack)
-    ] (Exec_i_realised false m i j) A as ineq.
-    eapply le_trans.
-    2: {
-      instantiate (1 := 0 + ϵ_DDH + 0 + ϵ_DDH + 0).
-      by rewrite ?GRing.addr0 ?GRing.add0r.
-    }
-    eapply le_trans. 1: exact ineq.
-    clear ineq.
-    repeat eapply ler_add.
-    {
-      apply eq_ler.
-      specialize (Hf true LA A Va).
-      apply Hf.
-      - rewrite fdisjointUr.
-        apply /andP ; split ; assumption.
-      - rewrite fdisjointUr.
-        apply /andP ; split.
-        2: assumption.
-        rewrite fdisjointUr.
-        apply /andP ; split ; assumption.
-    }
-    {
-      unfold Aux_realised.
-      rewrite -Advantage_link.
-      rewrite par_commut.
-      have -> : (par DDH.DDH_ideal (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) =
-               (par (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO) DDH.DDH_ideal).
-      { apply par_commut. ssprove_valid. }
-      erewrite Advantage_par.
-      3: apply DDH.DDH_real.
-      3: apply DDH.DDH_ideal.
-      2: {
-        ssprove_valid.
-        - eapply fsubsetUr.
-        - apply fsubsetUl.
-      }
-      1: rewrite Advantage_sym ; apply Dadv.
-      - ssprove_valid.
-      - unfold trimmed.
-        rewrite -link_trim_commut.
-        f_equal.
-        unfold trim.
-        rewrite !fset_cons -fset0E fsetU0.
-        rewrite !filterm_set.
-        simpl.
-        rewrite !in_fsetU !in_fset1 !eq_refl.
-        rewrite filterm0.
-        done.
-      - unfold trimmed.
-        unfold trim.
-        rewrite !fset_cons -fset0E fsetU0.
-        rewrite !filterm_set.
-        simpl.
-        rewrite !in_fset1 !eq_refl.
-        rewrite filterm0.
-        done.
-      - unfold trimmed.
-        unfold trim.
-        rewrite !fset_cons -fset0E fsetU0.
-        rewrite !filterm_set.
-        simpl.
-        rewrite !in_fset1 !eq_refl.
-        rewrite filterm0.
-        done.
-    }
-    2:{
-      unfold Aux_realised.
-      rewrite -Advantage_link.
-      rewrite par_commut.
-      have -> : (par DDH.DDH_real (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) =
-               (par (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO) DDH.DDH_real).
-      { apply par_commut. ssprove_valid. }
-      erewrite Advantage_par.
-      3: apply DDH.DDH_ideal.
-      3: apply DDH.DDH_real.
-      2: {
-        ssprove_valid.
-        - eapply fsubsetUr.
-        - apply fsubsetUl.
-      }
-      1: apply Dadv.
-      - ssprove_valid.
-      - unfold trimmed.
-        rewrite -link_trim_commut.
-        f_equal.
-        unfold trim.
-        rewrite !fset_cons -fset0E fsetU0.
-        rewrite !filterm_set.
-        simpl.
-        rewrite !in_fsetU !in_fset1 !eq_refl.
-        rewrite filterm0.
-        done.
-      - unfold trimmed.
-        unfold trim.
-        unfold DDH.DDH_E.
-        rewrite !fset_cons -fset0E fsetU0.
-        rewrite !filterm_set.
-        simpl.
-        rewrite !in_fset1 !eq_refl.
-        rewrite filterm0.
-        done.
-      - unfold trimmed.
-        unfold trim.
-        unfold DDH.DDH_E.
-        rewrite !fset_cons -fset0E fsetU0.
-        rewrite !filterm_set.
-        simpl.
-        rewrite !in_fset1 !eq_refl.
-        rewrite filterm0.
-        done.
-    }
-    2: {
-      apply eq_ler.
-      specialize (Hf false LA A Va).
-      rewrite Advantage_sym.
-      apply Hf.
-      - rewrite fdisjointUr.
-        apply /andP ; split ; assumption.
-      - rewrite fdisjointUr.
-        apply /andP ; split.
-        2: assumption.
-        rewrite fdisjointUr.
-        apply /andP ; split ; assumption.
-    }
-    apply eq_ler.
-    eapply eq_rel_perf_ind with (inv := inv i).
-    5: apply Va.
-    1,2: apply Aux_ideal_realised.
-    3: {
-      rewrite fdisjointUr.
-      apply /andP ; split.
-      2: assumption.
-      rewrite fdisjointUr.
-      apply /andP ; split ; assumption.
-    }
-    3: {
-      rewrite fdisjointUr.
-      apply /andP ; split.
-      2: assumption.
-      rewrite fdisjointUr.
-      apply /andP ; split ; assumption.
-    }
-    {
-      ssprove_invariant.
-      rewrite fsetUC.
-      rewrite -!fsetUA.
-      apply fsetUS.
-      apply fsubsetUl.
-    }
-    simplify_eq_rel v.
-    rewrite !setmE.
-    rewrite !eq_refl.
-    simpl.
-    repeat simplify_linking.
-    rewrite !cast_fun_K.
-    ssprove_code_simpl.
-    ssprove_code_simpl_more.
-    ssprove_sync=>x_i.
-    ssprove_sync=>x_j.
-    pose f_v := (fun (x : secret) =>
-                   if v then
-                   fto (Zp_add (otf x) Zp1)
-                   else
-                   fto (Zp_add (otf x) (Zp_opp Zp1))
-                ).
-    assert (bijective f_v) as bij_fv.
-    {
-      exists (fun x =>
-           if v then
-             fto (Zp_add (otf x) (Zp_opp Zp1))
-           else
-             fto (Zp_add (otf x) Zp1)
-        ).
-      - intro x.
-        unfold f_v.
-        case v.
-        + rewrite otf_fto.
-          rewrite -Zp_addA.
-          rewrite Zp_addC.
-          have -> : (Zp_add Zp1 (Zp_opp Zp1)) = (Zp_add (Zp_opp Zp1) Zp1).
-          { intro n. by rewrite Zp_addC. }
-          rewrite Zp_addNz.
-          rewrite Zp_add0z.
-          by rewrite fto_otf.
-        + rewrite otf_fto.
-          rewrite -Zp_addA.
-          rewrite Zp_addC.
-          rewrite Zp_addNz.
-          rewrite Zp_add0z.
-          by rewrite fto_otf.
-      - intro x.
-        unfold f_v.
-        case v.
-        + rewrite otf_fto.
-          rewrite -Zp_addA.
-          rewrite Zp_addNz.
-          rewrite Zp_addC.
-          rewrite Zp_add0z.
-          by rewrite fto_otf.
-        + rewrite otf_fto.
-          rewrite -Zp_addA.
-          rewrite Zp_addC.
-          have -> : (Zp_add Zp1 (Zp_opp Zp1)) = (Zp_add (Zp_opp Zp1) Zp1).
-          { intro n. by rewrite Zp_addC. }
-          rewrite Zp_addNz.
-          rewrite Zp_add0z.
-          by rewrite fto_otf.
-    }
-    eapply r_uniform_bij.
-    1: apply bij_fv.
-    intro c.
-    ssprove_swap_seq_rhs [:: 1 ; 2]%N.
-    ssprove_swap_seq_rhs [:: 0 ]%N.
-    ssprove_swap_seq_lhs [:: 1 ; 2]%N.
-    ssprove_swap_seq_lhs [:: 0 ]%N.
-    apply r_put_vs_put.
-    ssprove_contract_put_get_lhs.
-    ssprove_contract_put_get_rhs.
-    apply r_put_vs_put.
-    ssprove_contract_put_get_lhs.
-    ssprove_contract_put_get_rhs.
-    apply r_put_vs_put.
-    unfold Sigma1.MyParam.R.
-    rewrite -Hord otf_fto eq_refl.
-    simpl.
-    ssprove_sync=>r_i.
-    apply r_put_vs_put.
-    ssprove_restore_pre.
-    {
-      ssprove_invariant.
-      apply preserve_update_r_ignored_heap_ignore.
-      {
-        rewrite in_fsetU.
-        apply /orP ; right.
-        unfold DDH.DDH_locs.
-        rewrite !fset_cons -fset0E fsetU0.
-        rewrite in_fsetU.
-        apply /orP ; right.
-        rewrite in_fsetU.
-        apply /orP ; right.
-        by apply /fset1P.
-      }
-      apply preserve_update_l_ignored_heap_ignore.
-      2: apply preserve_update_mem_nil.
-      rewrite in_fsetU.
-      apply /orP ; right.
-      unfold DDH.DDH_locs.
-      rewrite !fset_cons -fset0E fsetU0.
-      rewrite in_fsetU.
-      apply /orP ; right.
-      rewrite in_fsetU.
-      apply /orP ; right.
-      by apply /fset1P.
-    }
-    ssprove_sync.
-    ssprove_sync=>queries.
-    case (queries (Sigma1.Sigma.prod_assoc (fto (g ^+ x_i), fto (g ^+ otf r_i)))) eqn:e.
-    all: rewrite e.
-    all: ssprove_code_simpl ; simpl.
-    all: ssprove_code_simpl_more ; simpl.
-    - apply r_get_remember_lhs.
-      intros ?.
-      apply r_get_remember_rhs.
-      intros ?.
-      ssprove_forget_all.
-      rewrite -Hord otf_fto eq_refl.
-      simpl.
-      ssprove_sync=>e_j.
-      apply r_put_lhs.
-      apply r_put_rhs.
-      clear e queries.
-      ssprove_restore_pre.
-      1: ssprove_invariant.
-      ssprove_sync.
-      ssprove_sync=>queries.
-      case (queries (Sigma1.Sigma.prod_assoc (fto (g ^+ finv f' x_j), fto (g ^+ otf e_j)))) eqn:e.
-      all: rewrite e.
-      all: simpl; ssprove_code_simpl.
-      all: ssprove_code_simpl_more.
-      + apply r_get_remember_lhs.
-        intros ?.
-        apply r_get_remember_rhs.
-        intros ?.
-        ssprove_forget_all.
-        apply r_assertD.
-        {
-          intros ??.
-          rewrite !domm_set.
-          done.
-        }
-        intros _ _.
-        apply r_ret.
-        intros ???.
-        split.
-        2: assumption.
-        unfold f_v.
-        apply vote_hiding_bij.
-      + ssprove_sync=>e_i.
-        apply r_put_vs_put.
-        apply r_get_remember_lhs.
-        intros ?.
-        apply r_get_remember_rhs.
-        intros ?.
-        ssprove_forget_all.
-        apply r_assertD.
-        {
-          intros ??.
-          rewrite !domm_set.
-          done.
-        }
-        intros _ _.
-        ssprove_restore_pre.
-        1: ssprove_invariant.
-        apply r_ret.
-        intros ???.
-        split.
-        2: assumption.
-        unfold f_v.
-        apply vote_hiding_bij.
-    - ssprove_sync=>e_i.
-      apply r_put_vs_put.
-      apply r_get_remember_lhs.
-      intros ?.
-      apply r_get_remember_rhs.
-      intros ?.
-      ssprove_forget_all.
-      rewrite -Hord otf_fto.
-      rewrite -Hord eq_refl.
-      simpl.
-      ssprove_sync=>r_j.
-      apply r_put_lhs.
-      apply r_put_rhs.
-      ssprove_restore_pre.
-      1: ssprove_invariant.
-      ssprove_sync.
-      ssprove_sync=>queries'.
-      case (queries' (Sigma1.Sigma.prod_assoc (fto (g ^+ finv f' x_j), fto (g ^+ otf r_j)))) eqn:e'.
-      all: rewrite e'.
-      all: simpl; ssprove_code_simpl.
-      all: ssprove_code_simpl_more.
-      + apply r_get_remember_lhs.
-        intros ?.
-        apply r_get_remember_rhs.
-        intros ?.
-        ssprove_forget_all.
-        apply r_assertD.
-        {
-          intros ??.
-          rewrite !domm_set.
-          done.
-        }
-        intros _ _.
-        apply r_ret.
-        intros ???.
-        split.
-        2: assumption.
-        unfold f_v.
-        apply vote_hiding_bij.
-      + ssprove_sync=>e_j.
-        apply r_put_vs_put.
-        apply r_get_remember_lhs.
-        intros ?.
-        apply r_get_remember_rhs.
-        intros ?.
-        ssprove_forget_all.
-        apply r_assertD.
-        {
-          intros ??.
-          rewrite !domm_set.
-          done.
-        }
-        intros _ _.
-        ssprove_restore_pre.
-        1: ssprove_invariant.
-        apply r_ret.
-        intros ???.
-        split.
-        2: assumption.
-        unfold f_v.
-        apply vote_hiding_bij.
-  Qed.
-
-End OVN.
-End OVN.
+(*
+ * From Relational Require Import OrderEnrichedCategory GenericRulesSimple.
+ * 
+ * Set Warnings "-notation-overridden,-ambiguous-paths".
+ * From mathcomp Require Import all_ssreflect all_algebra reals distr realsum
+ *   fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool ssrnum
+ *   eqtype choice seq.
+ * Set Warnings "notation-overridden,ambiguous-paths".
+ * 
+ * From Crypt Require Import Axioms ChoiceAsOrd SubDistr Couplings
+ *   UniformDistrLemmas FreeProbProg Theta_dens RulesStateProb UniformStateProb
+ *   pkg_composition Package Prelude SigmaProtocol Schnorr DDH Canonicals.
+ * 
+ * From Coq Require Import Utf8 Lia.
+ * From extructures Require Import ord fset fmap.
+ * 
+ * From Equations Require Import Equations.
+ * Require Equations.Prop.DepElim.
+ * 
+ * Set Equations With UIP.
+ * 
+ * Set Bullet Behavior "Strict Subproofs".
+ * Set Default Goal Selector "!".
+ * Set Primitive Projections.
+ * 
+ * Import Num.Def.
+ * Import Num.Theory.
+ * Import Order.POrderTheory.
+ * 
+ * #[local] Open Scope ring_scope.
+ * Import GroupScope GRing.Theory.
+ * 
+ * Import PackageNotation.
+ * 
+ * Module Type GroupParam.
+ * 
+ *   Parameter n : nat.
+ *   Parameter n_pos : Positive n.
+ * 
+ *   Parameter gT : finGroupType.
+ *   Definition ζ : {set gT} := [set : gT].
+ *   Parameter g :  gT.
+ *   Parameter g_gen : ζ = <[g]>.
+ *   Parameter prime_order : prime #[g].
+ * 
+ * End GroupParam.
+ * 
+ * Module Type OVNParam.
+ * 
+ *   Parameter N : nat.
+ *   Parameter N_pos : Positive N.
+ * 
+ * End OVNParam.
+ * 
+ * Module OVN (GP : GroupParam) (OP : OVNParam).
+ * Import GP.
+ * Import OP.
+ * 
+ * Set Equations Transparent.
+ * 
+ * Lemma cyclic_zeta: cyclic ζ.
+ * Proof.
+ *   apply /cyclicP. exists g. exact: g_gen.
+ * Qed.
+ * 
+ * (* order of g *)
+ * Definition q' := Zp_trunc (pdiv #[g]).
+ * Definition q : nat := q'.+2.
+ * 
+ * Lemma q_order_g : q = #[g].
+ * Proof.
+ *   unfold q, q'.
+ *   apply Fp_cast.
+ *   apply prime_order.
+ * Qed.
+ * 
+ * Lemma q_field : (Zp_trunc #[g]) = q'.
+ * Proof.
+ *   unfold q'.
+ *   rewrite pdiv_id.
+ *   2: apply prime_order.
+ *   reflexivity.
+ * Qed.
+ * 
+ * Lemma expg_g : forall x, exists ix, x = g ^+ ix.
+ * Proof.
+ *   intros.
+ *   apply /cycleP.
+ *   rewrite -g_gen.
+ *   apply: in_setT.
+ * Qed.
+ * 
+ * Lemma group_prodC :
+ *   @commutative gT gT mulg.
+ * Proof.
+ *   move => x y.
+ *   destruct (expg_g x) as [ix ->].
+ *   destruct (expg_g y) as [iy ->].
+ *   repeat rewrite -expgD addnC.
+ *   reflexivity.
+ * Qed.
+ * 
+ * Definition Pid : finType := Finite.clone _ 'I_n.
+ * Definition Secret : finComRingType := 'Z_(Zp_trunc #[g]).
+ * Definition Public : finType := gT.
+ * Definition s0 : Secret := 0.
+ * 
+ * Definition Pid_pos : Positive #|Pid|.
+ * Proof.
+ *   rewrite card_ord.
+ *   eapply PositiveInFin.
+ *   apply n_pos.
+ * Qed.
+ * 
+ * Definition Secret_pos : Positive #|Secret|.
+ * Proof.
+ *   apply /card_gt0P. exists s0. auto.
+ * Qed.
+ * 
+ * Definition Public_pos : Positive #|Public|.
+ * Proof.
+ *   apply /card_gt0P. exists g. auto.
+ * Defined.
+ * 
+ * #[local] Existing Instance Pid_pos.
+ * #[local] Existing Instance Secret_pos.
+ * #[local] Existing Instance Public_pos.
+ * 
+ * Definition pid : choice_type := 'fin #|Pid|.
+ * Definition secret : choice_type := 'fin #|Secret|.
+ * Definition public: choice_type := 'fin #|Public|.
+ * 
+ * Definition nat_to_pid : nat → pid.
+ * Proof.
+ *   move=> n.
+ *   eapply give_fin.
+ * Defined.
+ * 
+ * Definition i_secret := #|Secret|.
+ * Definition i_public := #|Public|.
+ * 
+ * Module Type CDSParams <: SigmaProtocolParams.
+ *   Definition Witness : finType := Secret.
+ *   Definition Statement : finType := prod_finType (prod_finType Public Public) Public.
+ * 
+ *   Definition Witness_pos : Positive #|Witness| := Secret_pos.
+ *   Definition Statement_pos : Positive #|Statement|.
+ *   Proof.
+ *     unfold Statement.
+ *     rewrite !card_prod.
+ *     repeat apply Positive_prod.
+ *     all: apply Public_pos.
+ *   Qed.
+ * 
+ *   Definition R : Statement -> Witness -> bool :=
+ *     λ (h : Statement) (x : Witness),
+ *       let '(gx, gy, gyxv) := h in
+ *       (gy^+x * g^+0 == gyxv) || (gy^+x * g^+1 == gyxv).
+ * 
+ *   Lemma relation_valid_left:
+ *     ∀ (x : Secret) (gy : Public),
+ *       R (g^+x, gy, gy^+x * g^+ 0) x.
+ *   Proof.
+ *     intros x gy.
+ *     unfold R.
+ *     apply /orP ; left.
+ *     done.
+ *   Qed.
+ * 
+ *   Lemma relation_valid_right:
+ *     ∀ (x : Secret) (gy : Public),
+ *       R (g^+x, gy, gy^+x * g^+ 1) x.
+ *   Proof.
+ *     intros x y.
+ *     unfold R.
+ *     apply /orP ; right.
+ *     done.
+ *   Qed.
+ * 
+ *   Parameter Message Challenge Response State : finType.
+ *   Parameter w0 : Witness.
+ *   Parameter e0 : Challenge.
+ *   Parameter z0 : Response.
+ * 
+ *   Parameter Message_pos : Positive #|Message|.
+ *   Parameter Challenge_pos : Positive #|Challenge|.
+ *   Parameter Response_pos : Positive #|Response|.
+ *   Parameter State_pos : Positive #|State|.
+ *   Parameter Bool_pos : Positive #|bool_choiceType|.
+ * End CDSParams.
+ * 
+ * Module OVN (π2 : CDSParams) (Alg2 : SigmaProtocolAlgorithms π2).
+ * 
+ *   Module Sigma1 := Schnorr GP.
+ *   Module Sigma2 := SigmaProtocol π2 Alg2.
+ * 
+ *   Obligation Tactic := idtac.
+ *   Set Equations Transparent.
+ * 
+ *   Definition skey_loc (i : nat) : Location := (secret; (100+i)%N).
+ *   Definition ckey_loc (i : nat) : Location := (public; (101+i)%N).
+ * 
+ *   Definition P_i_locs (i : nat) : {fset Location} := fset [:: skey_loc i ; ckey_loc i].
+ * 
+ *   Notation choiceStatement1 := Sigma1.MyAlg.choiceStatement.
+ *   Notation choiceWitness1 := Sigma1.MyAlg.choiceWitness.
+ *   Notation choiceTranscript1 := Sigma1.MyAlg.choiceTranscript.
+ * 
+ *   Notation " 'pid " := pid (in custom pack_type at level 2).
+ *   Notation " 'pids " := (chProd pid pid) (in custom pack_type at level 2).
+ *   Notation " 'public " := public (in custom pack_type at level 2).
+ *   Notation " 'public " := public (at level 2) : package_scope.
+ * 
+ *   Notation " 'chRelation1' " := (chProd choiceStatement1 choiceWitness1) (in custom pack_type at level 2).
+ *   Notation " 'chTranscript1' " := choiceTranscript1 (in custom pack_type at level 2).
+ *   Notation " 'public_key " := (chProd public choiceTranscript1) (in custom pack_type at level 2).
+ *   Notation " 'public_keys " := (chMap pid (chProd public choiceTranscript1)) (in custom pack_type at level 2).
+ * 
+ *   Notation " 'chRelation2' " := (chProd Alg2.choiceStatement Alg2.choiceWitness) (in custom pack_type at level 2).
+ *   Notation " 'chTranscript2' " := Alg2.choiceTranscript (in custom pack_type at level 2).
+ *   Notation " 'vote " := (chProd public Alg2.choiceTranscript) (in custom pack_type at level 2).
+ * 
+ *   Definition INIT : nat := 4.
+ *   Definition VOTE : nat := 5.
+ *   Definition CONSTRUCT : nat := 6.
+ * 
+ *   Definition P (i : nat) : nat := 14 + i.
+ *   Definition Exec (i : nat) : nat := 15 + i.
+ * 
+ *   Lemma not_in_domm {T S} :
+ *     ∀ i m,
+ *       i \notin @domm T S m :\ i.
+ *   Proof.
+ *     intros.
+ *     apply /negPn.
+ *     rewrite in_fsetD.
+ *     move=> /andP [H _].
+ *     move: H => /negPn H.
+ *     apply H.
+ *     by rewrite in_fset1.
+ *   Qed.
+ * 
+ *   Lemma not_in_fsetU :
+ *     ∀ (l : Location) L0 L1,
+ *       l \notin L0  →
+ *       l \notin L1 →
+ *       l \notin L0 :|: L1.
+ *   Proof.
+ *     intros l L0 L1 h1 h2.
+ *     rewrite -fdisjoints1 fset1E.
+ *     rewrite fdisjointUl.
+ *     apply /andP ; split.
+ *     + rewrite -fdisjoints1 fset1E in h1. apply h1.
+ *     + rewrite -fdisjoints1 fset1E in h2. apply h2.
+ *   Qed.
+ * 
+ *   #[local] Hint Extern 3 (is_true (?l \notin ?L0 :|: ?L1)) =>
+ *     apply not_in_fsetU : typeclass_instances ssprove_valid_db ssprove_invariant.
+ * 
+ *   Definition get_value (m : chMap pid (chProd public choiceTranscript1)) (i : pid) :=
+ *     match m i with
+ *     | Some (v, _) => otf v
+ *     | _ => 1
+ *     end.
+ *
+ *   Canonical finGroup_com_law := Monoid.ComLaw group_prodC.
+ * 
+ *   Definition compute_key
+ *              (m : chMap pid (chProd public choiceTranscript1))
+ *              (i : pid)
+ *     :=
+ *     let low := \prod_(k <- domm m | (k < i)%ord) (get_value m k) in
+ *     let high := \prod_(k <- domm m | (i < k)%ord) (get_value m k) in
+ *     low * invg high.
+ * 
+ *   Definition compute_key'
+ *              (m : chMap pid (chProd public choiceTranscript1))
+ *              (i j : pid)
+ *              (x : Secret)
+ *     :=
+ *     if (j < i)%ord then
+ *       let low := \prod_(k <- domm m | (k < i)%ord) (get_value m k) in
+ *       let high := \prod_(k <- domm m | (i < k)%ord) (get_value m k) in
+ *       (g ^+ x) * low * invg high
+ *     else
+ *       let low := \prod_(k <- domm m | (k < i)%ord) (get_value m k) in
+ *       let high := \prod_(k <- domm m | (i < k)%ord) (get_value m k) in
+ *       low * invg (high * (g ^+ x)).
+ * 
+ *   Lemma compute_key'_equiv
+ *         (i j : pid)
+ *         (x : Secret)
+ *         (zk : choiceTranscript1)
+ *         (keys : chMap pid (chProd public choiceTranscript1)):
+ *     (i != j) →
+ *     compute_key (setm keys j (fto (g ^+ x), zk)) i = compute_key' (remm keys j) i j x.
+ *   Proof.
+ *     intro ij_neq.
+ *     unfold compute_key, compute_key'.
+ *     simpl.
+ *     rewrite <- setm_rem.
+ *     rewrite domm_set domm_rem.
+ *     set X := domm _.
+ *     rewrite !big_fsetU1.
+ *     2-3: subst X; apply not_in_domm.
+ *     rewrite setm_rem.
+ *     have set_rem_eq : forall P x,
+ *       \big[finGroup_com_law/1]_(k <- X :\ j | P k)
+ *         get_value (setm keys j x) k =
+ *       \prod_(k <- X :\ j | P k)
+ *         get_value (remm keys j) k.
+ *     { intros.
+ *       rewrite big_seq_cond.
+ *       rewrite [RHS] big_seq_cond.
+ *       unfold get_value.
+ *       erewrite eq_bigr.
+ *       1: done.
+ *       intros k.
+ *       move => /andP [k_in _].
+ *       simpl.
+ *       rewrite setmE remmE.
+ *       case (k == j) eqn:eq.
+ *       - move: eq => /eqP eq.
+ *         rewrite eq in_fsetD1 in k_in.
+ *         move: k_in => /andP [contra].
+ *         rewrite eq_refl in contra.
+ *         discriminate.
+ *       - reflexivity.
+ * 
+ *     }
+ *     case (j < i)%ord eqn:e.
+ *     - rewrite !e.
+ *       rewrite -2!mulgA.
+ *       f_equal.
+ *       1: unfold get_value ; by rewrite setmE eq_refl otf_fto.
+ *       f_equal.
+ *       + apply set_rem_eq.
+ *       + rewrite Ord.ltNge Ord.leq_eqVlt in e.
+ *         rewrite negb_or in e.
+ *         move: e => /andP [_ e].
+ *         apply negbTE in e.
+ *         rewrite e.
+ *         f_equal.
+ *         apply set_rem_eq.
+ *     - rewrite e.
+ *       rewrite Ord.ltNge in e.
+ *       apply negbT in e.
+ *       apply negbNE in e.
+ *       rewrite Ord.leq_eqVlt in e.
+ *       move: e => /orP [contra|e].
+ *       1: by rewrite contra in ij_neq.
+ *       rewrite e !invMg.
+ *       f_equal.
+ *       { apply set_rem_eq. }
+ *       rewrite group_prodC.
+ *       f_equal.
+ *       { unfold get_value. by rewrite setmE eq_refl otf_fto. }
+ *       f_equal.
+ *       apply set_rem_eq.
+ *   Qed.
+ * 
+ *   Lemma compute_key_bij:
+ *     ∀ (m : chMap pid (chProd public choiceTranscript1)) (i j: pid),
+ *       (i != j)%ord →
+ *       exists (a b : nat),
+ *         (a != 0)%N /\ (a < q)%N /\
+ *       (∀ (x : Secret) zk,
+ *         compute_key (setm m j (fto (g ^+ x), zk)) i = g ^+ ((a * x + b) %% q)).
+ *   Proof.
+ *     intros m i j ne.
+ *     simpl.
+ *     pose low := \prod_(k <- domm m :\ j| (k < i)%ord) get_value m k.
+ *     pose hi := \prod_(k <- domm m :\ j| (i < k)%ord) get_value m k.
+ *     have Hlow : exists ilow, low = g ^+ ilow by apply expg_g.
+ *     have Hhi : exists ihi, hi = g ^+ ihi by apply expg_g.
+ *     destruct Hlow as [ilow Hlow].
+ *     destruct Hhi as [ihi Hhi].
+ * 
+ *     have getv_remm_eq : forall P j m,
+ *       \prod_(k <- domm m :\ j | P k) get_value (remm m j) k =
+ *       \prod_(k <- domm m :\ j | P k) get_value m k.
+ *     {
+ *       clear low hi ilow ihi Hlow Hhi ne i j m.
+ *       intros.
+ *       rewrite big_seq_cond.
+ *       rewrite [RHS] big_seq_cond.
+ *       erewrite eq_bigr.
+ *       1: done.
+ *       intros k.
+ *       move => /andP [k_in _].
+ *       simpl.
+ *       unfold get_value.
+ *       rewrite remmE.
+ *       case (k == j) eqn:eq.
+ *       ++ move: eq => /eqP eq.
+ *           rewrite eq in_fsetD1 in k_in.
+ *           move: k_in => /andP [contra].
+ *           rewrite eq_refl in contra.
+ *           discriminate.
+ *       ++ reflexivity.
+ *     }
+ * 
+ *     case (j < i)%ord eqn:ij_rel.
+ *     - exists 1%N.
+ *       exists (ilow + (ihi * #[g ^+ ihi].-1))%N.
+ *       do 2 split.
+ *       1: rewrite q_order_g ; apply (prime_gt1 prime_order).
+ *       intros x zk.
+ *       rewrite compute_key'_equiv.
+ *       2: assumption.
+ *       unfold compute_key'.
+ *       simpl.
+ *       rewrite ij_rel.
+ *       rewrite domm_rem.
+ *       set low' := \prod_(k0 <- _ | _) _.
+ *       set hi' := \prod_(k0 <- _ | _) _.
+ *       have -> : low' = low by apply getv_remm_eq.
+ *       have -> : hi' = hi by apply getv_remm_eq.
+ *       clear low' hi'.
+ *       rewrite Hhi Hlow.
+ *       rewrite invg_expg.
+ *       rewrite -!expgM.
+ *       rewrite -!expgD.
+ *       rewrite !addnA.
+ *       rewrite -expg_mod_order.
+ *       f_equal.
+ *       f_equal.
+ *       2: {
+ *         unfold q. rewrite Fp_cast;
+ *         [reflexivity | apply prime_order].
+ *       }
+ *       rewrite mul1n.
+ *       done.
+ *     - exists #[g].-1.
+ *       exists (ilow + (ihi * #[g ^+ ihi].-1))%N.
+ *       repeat split.
+ *       { unfold negb.
+ *         rewrite -leqn0.
+ *         case (#[g].-1 <= 0)%N eqn:e.
+ *         2: done.
+ *         have Hgt1 := (prime_gt1 prime_order).
+ *         rewrite -ltn_predRL in Hgt1.
+ *         rewrite -ltnS in Hgt1.
+ *         rewrite -addn1 in Hgt1.
+ *         rewrite leq_add2l in Hgt1.
+ *         eapply leq_trans in e.
+ *         2: apply Hgt1.
+ *         discriminate.
+ *       }
+ *       {
+ *         rewrite q_order_g.
+ *         rewrite ltn_predL.
+ *         apply (prime_gt0 prime_order).
+ *       }
+ *       intros x zk.
+ *       rewrite compute_key'_equiv.
+ *       2: assumption.
+ *       unfold compute_key'.
+ *       simpl.
+ *       rewrite ij_rel.
+ *       rewrite domm_rem.
+ *       set low' := \prod_(k0 <- _ | _) _.
+ *       set hi' := \prod_(k0 <- _ | _) _.
+ *       have -> : low' = low by apply getv_remm_eq.
+ *       have -> : hi' = hi by apply getv_remm_eq.
+ *       clear low' hi'.
+ *       rewrite Hhi Hlow.
+ *       rewrite invMg.
+ *       rewrite -expgVn.
+ *       rewrite !invg_expg.
+ *       rewrite -!expgM.
+ *       rewrite mulgA.
+ *       rewrite -!expgD.
+ *       rewrite !addnA.
+ *       rewrite -expg_mod_order.
+ *       f_equal.
+ *       f_equal.
+ *       2: {
+ *         unfold q. rewrite Fp_cast;
+ *         [reflexivity | apply prime_order].
+ *       }
+ *       rewrite addnAC.
+ *       rewrite addnC.
+ *       rewrite addnA.
+ *       done.
+ *   Qed.
+ * 
+ *   Lemma compute_key_set_i
+ *         (i : pid)
+ *         (v : (chProd public choiceTranscript1))
+ *         (m : chMap pid (chProd public choiceTranscript1)):
+ *     compute_key (setm m i v) i = compute_key m i.
+ *   Proof.
+ *     unfold compute_key.
+ *     simpl.
+ *     case (i \in domm m) eqn:i_in.
+ *     all: simpl in i_in.
+ *     - have -> : forall v, domm (setm m i v) = domm m.
+ *       { intros.
+ *         simpl.
+ *         rewrite domm_set.
+ *         rewrite -eq_fset.
+ *         intro k.
+ *         rewrite in_fsetU1.
+ *         case (eq_op) eqn:e.
+ *         + move: e => /eqP ->.
+ *           by rewrite i_in.
+ *         + done.
+ *       }
+ *       simpl.
+ *       f_equal.
+ *       + apply eq_big.
+ *         1: done.
+ *         intros k k_lt.
+ *         unfold get_value.
+ *         rewrite setmE.
+ *         rewrite Ord.lt_neqAle in k_lt.
+ *         move: k_lt => /andP [k_lt _].
+ *         move: k_lt => /negbTE ->.
+ *         done.
+ *       + f_equal.
+ *         apply eq_big.
+ *         1: done.
+ *         intros k k_lt.
+ *         unfold get_value.
+ *         rewrite setmE.
+ *         rewrite Ord.lt_neqAle in k_lt.
+ *         move: k_lt => /andP [k_lt _].
+ *         rewrite eq_sym.
+ *         move: k_lt => /negbTE ->.
+ *         done.
+ *     - have -> : domm m = domm (remm m i).
+ *       {
+ *         simpl.
+ *         rewrite -eq_fset.
+ *         intro k.
+ *         rewrite domm_rem.
+ *         rewrite in_fsetD1.
+ *         case (eq_op) eqn:e.
+ *         + simpl.
+ *           move: e => /eqP ->.
+ *           assumption.
+ *         + done.
+ *       }
+ *       simpl.
+ *       f_equal.
+ *       + rewrite -setm_rem domm_set domm_rem.
+ *         rewrite big_fsetU1.
+ *         all: simpl.
+ *         2: by rewrite in_fsetD1 eq_refl.
+ *         rewrite Ord.ltxx.
+ *         apply eq_big.
+ *         1: done.
+ *         intros k k_lt.
+ *         unfold get_value.
+ *         rewrite setmE remmE.
+ *         rewrite Ord.lt_neqAle in k_lt.
+ *         move: k_lt => /andP [k_lt _].
+ *         move: k_lt => /negbTE ->.
+ *         done.
+ *       + f_equal.
+ *         rewrite -setm_rem domm_set domm_rem.
+ *         rewrite big_fsetU1.
+ *         all: simpl.
+ *         2: by rewrite in_fsetD1 eq_refl.
+ *         rewrite Ord.ltxx.
+ *         apply eq_big.
+ *         1: done.
+ *         intros k k_lt.
+ *         unfold get_value.
+ *         rewrite setmE remmE.
+ *         rewrite Ord.lt_neqAle in k_lt.
+ *         move: k_lt => /andP [k_lt _].
+ *         rewrite eq_sym.
+ *         move: k_lt => /negbTE ->.
+ *         done.
+ *   Qed.
+ * 
+ *   Lemma test_bij
+ *         (i j : pid)
+ *         (m : chMap pid (chProd public choiceTranscript1))
+ *     :
+ *       (i != j)%N →
+ *       ∃ (f : Secret → Secret),
+ *       ∀ (x : Secret),
+ *         bijective f /\
+ *           (∀ zk, compute_key (setm m j (fto (g ^+ x), zk)) i = g ^+ (f x)).
+ *   Proof.
+ *     simpl.
+ *     intros ne.
+ *     have H := compute_key_bij m i j ne.
+ *     simpl in H.
+ *     destruct H as [a [b [a_pos [a_leq_q H]]]].
+ *     set a_ord := @inZp ((Zp_trunc #[g]).+1) a.
+ *     set b_ord := @inZp ((Zp_trunc #[g]).+1) b.
+ *     pose f' := (fun (x : Secret) => Zp_add (Zp_mul x a_ord) b_ord).
+ *     exists f'.
+ *     unfold f'. clear f'.
+ *     intros x.
+ *     have := q_order_g.
+ *     unfold q.
+ *     intros Hq.
+ *     split.
+ *     2: {
+ *       intro zk.
+ *       rewrite (H x zk).
+ *       apply /eqP.
+ *       rewrite eq_expg_mod_order.
+ *       apply /eqP.
+ *       simpl.
+ *       rewrite modn_small.
+ *       2: {
+ *         rewrite q_order_g.
+ *         apply ltn_pmod.
+ *         apply (prime_gt0 prime_order).
+ *       }
+ *       repeat rewrite -> Zp_cast at 3.
+ *       2-5: apply (prime_gt1 prime_order).
+ *       symmetry.
+ *       rewrite modn_small.
+ *       2: {
+ *         apply ltn_pmod.
+ *         apply (prime_gt0 prime_order).
+ *       }
+ *       simpl.
+ *       unfold q, q'.
+ *       rewrite Fp_cast.
+ *       2: apply prime_order.
+ *       rewrite modnMmr.
+ *       rewrite modnDm.
+ *       rewrite mulnC.
+ *       reflexivity.
+ *     }
+ *     assert (coprime q'.+2 a_ord) as a_ord_coprime.
+ *     {
+ *       rewrite -unitFpE.
+ *       2: rewrite Hq ; apply prime_order.
+ *       rewrite unitfE. simpl.
+ *       rewrite Zp_cast.
+ *       2: apply (prime_gt1 prime_order).
+ *       unfold q, q' in a_leq_q.
+ *       rewrite Fp_cast in a_leq_q.
+ *       2: apply prime_order.
+ *       rewrite modn_small.
+ *       2: apply a_leq_q.
+ *       erewrite <- inj_eq.
+ *       2: apply ord_inj.
+ *       rewrite val_Zp_nat.
+ *       2: {
+ *         rewrite pdiv_id.
+ *         1: apply prime_gt1.
+ *         1,2: rewrite Hq ; apply prime_order.
+ *       }
+ *       rewrite -> pdiv_id at 1.
+ *       1,2: rewrite Hq.
+ *       2: apply prime_order.
+ *       unfold q in a_leq_q.
+ *       rewrite modn_small.
+ *       2: apply a_leq_q.
+ *       assumption.
+ *     }
+ *     pose f' := (fun (x : Secret) => Zp_mul (Zp_add (Zp_opp b_ord) x) (Zp_inv a_ord)).
+ *     exists f'.
+ *     - intro z.
+ *       unfold f'. clear f'.
+ *       simpl.
+ *       rewrite Zp_addC.
+ *       rewrite -Zp_addA.
+ *       have -> : (Zp_add b_ord (Zp_opp b_ord)) = Zp0.
+ *       1: by rewrite Zp_addC Zp_addNz.
+ *       rewrite Zp_addC.
+ *       rewrite Zp_add0z.
+ *       rewrite -Zp_mulA.
+ *       rewrite Zp_mulzV.
+ *       2: {
+ *         rewrite -> q_field at 1.
+ *         assumption.
+ *       }
+ *       rewrite Zp_mulz1.
+ *       reflexivity.
+ *     - intro z.
+ *       unfold f'. clear f'.
+ *       simpl.
+ *       rewrite Zp_addC.
+ *       rewrite -Zp_mulA.
+ *       rewrite Zp_mul_addl.
+ *       have -> : (Zp_mul (Zp_inv a_ord) a_ord) = Zp1.
+ *       {
+ *         rewrite Zp_mulC.
+ *         rewrite Zp_mulzV.
+ *         + reflexivity.
+ *         + rewrite -> q_field at 1.
+ *           assumption.
+ *       }
+ *       rewrite -Zp_mul_addl.
+ *       rewrite Zp_mulz1.
+ *       rewrite Zp_addA.
+ *       have -> : (Zp_add b_ord (Zp_opp b_ord)) = Zp0.
+ *       1: by rewrite Zp_addC Zp_addNz.
+ *       rewrite Zp_add0z.
+ *       reflexivity.
+ *   Qed.
+ * 
+ *   Lemma test_bij'
+ *         (i j : pid)
+ *         (m : chMap pid (chProd public choiceTranscript1))
+ *     :
+ *       (i != j)%N →
+ *       ∃ (f : secret → secret),
+ *       ∀ (x : secret),
+ *         bijective f /\
+ *           (∀ zk, compute_key (setm m j (fto (g ^+ otf x), zk)) i = g ^+ (otf (f x))).
+ *   Proof.
+ *     simpl.
+ *     intros ne.
+ *     have [f H] := test_bij i j m ne.
+ *     simpl in H.
+ *     exists (fun (x : secret) => fto (f (otf x))).
+ *     intro x.
+ *     destruct (H (otf x)) as [f_bij H'] ; clear H.
+ *     split.
+ *     - exists (fun z => fto ((finv f) (otf z))).
+ *       + apply bij_inj in f_bij.
+ *         intro z.
+ *         rewrite otf_fto.
+ *         apply finv_f in f_bij.
+ *         rewrite f_bij fto_otf.
+ *         reflexivity.
+ *       + apply bij_inj in f_bij.
+ *         intro z.
+ *         rewrite otf_fto.
+ *         apply f_finv in f_bij.
+ *         rewrite f_bij fto_otf.
+ *         reflexivity.
+ *     - intro zk.
+ *       specialize (H' zk).
+ *       rewrite otf_fto.
+ *       apply H'.
+ *   Qed.
+ * 
+ *   Definition P_i_E :=
+ *     [interface
+ *       #val #[ INIT ] : 'unit → 'public_key ;
+ *       #val #[ CONSTRUCT ] : 'public_keys → 'unit ;
+ *       #val #[ VOTE ] : 'bool → 'public
+ *     ].
+ * 
+ *   Definition Sigma1_I :=
+ *     [interface
+ *       #val #[ Sigma1.Sigma.VERIFY ] : chTranscript1 → 'bool ;
+ *       #val #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1
+ *     ].
+ * 
+ *   Definition P_i (i : pid) (b : bool):
+ *     package (P_i_locs i)
+ *       Sigma1_I
+ *       P_i_E :=
+ *     [package
+ *         #def #[ INIT ] (_ : 'unit) : 'public_key
+ *         {
+ *           #import {sig #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1} as ZKP ;;
+ *           #import {sig #[ Sigma1.Sigma.VERIFY ] : chTranscript1 → 'bool} as VER ;;
+ *           x ← sample uniform i_secret ;;
+ *           #put (skey_loc i) := x ;;
+ *           let y := (fto (g ^+ (otf x))) : public in
+ *             zkp ← ZKP (y, x) ;;
+ *             ret (y, zkp)
+ *         }
+ *         ;
+ *         #def #[ CONSTRUCT ] (m : 'public_keys) : 'unit
+ *         {
+ *           #import {sig #[ Sigma1.Sigma.VERIFY ] : chTranscript1 → 'bool} as VER ;;
+ *           #assert (size (domm m) == n) ;;
+ *           let key := fto (compute_key m i) in
+ *           #put (ckey_loc i) := key ;;
+ *           @ret 'unit Datatypes.tt
+ *         }
+ *         ;
+ *         #def #[ VOTE ] (v : 'bool) : 'public
+ *         {
+ *           skey ← get (skey_loc i) ;;
+ *           ckey ← get (ckey_loc i) ;;
+ *           if b then
+ *             let vote := (otf ckey ^+ skey * g ^+ v) in
+ *             @ret 'public (fto vote)
+ *           else
+ *             let vote := (otf ckey ^+ skey * g ^+ (negb v)) in
+ *             @ret 'public (fto vote)
+ *         }
+ *     ].
+ * 
+ *   Definition EXEC_i_I :=
+ *     [interface
+ *       #val #[ INIT ] : 'unit → 'public_key ;
+ *       #val #[ CONSTRUCT ] : 'public_keys → 'unit ;
+ *       #val #[ VOTE ] : 'bool → 'public ;
+ *       #val #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1
+ *     ].
+ * 
+ *   Definition Exec_i_E i := [interface #val #[ Exec i ] : 'bool → 'public].
+ * 
+ *   Definition Exec_i (i j : pid) (m : chMap pid (chProd public choiceTranscript1)):
+ *     package fset0
+ *       EXEC_i_I
+ *       (Exec_i_E i)
+ *     :=
+ *     [package
+ *         #def #[ Exec i ] (v : 'bool) : 'public
+ *         {
+ *           #import {sig #[ INIT ] : 'unit → 'public_key} as Init ;;
+ *           #import {sig #[ CONSTRUCT ] : 'public_keys → 'unit} as Construct ;;
+ *           #import {sig #[ VOTE ] : 'bool → 'public} as Vote ;;
+ *           #import {sig #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1} as ZKP ;;
+ *           pk ← Init Datatypes.tt ;;
+ *           x ← sample uniform i_secret ;;
+ *           let y := (fto (g ^+ (otf x))) : public in
+ *             zkp ← ZKP (y, x) ;;
+ *             let m' := setm (setm m j (y, zkp)) i pk in
+ *               Construct m' ;;
+ *               vote ← Vote v ;;
+ *               @ret 'public vote
+ *         }
+ *     ].
+ * 
+ *   Module DDHParams <: DDHParams.
+ *     Definition Space := Secret.
+ *     Definition Space_pos := Secret_pos.
+ *   End DDHParams.
+ * 
+ *   Module DDH := DDH DDHParams GP.
+ * 
+ *   #[tactic=notac] Equations? Aux (b : bool) (i j : pid) m f':
+ *     package DDH.DDH_locs
+ *       (DDH.DDH_E :|:
+ *          [interface #val #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1]
+ *       )
+ *       [interface #val #[ Exec i ] : 'bool → 'public]
+ *     := Aux b i j m f' :=
+ *     [package
+ *         #def #[ Exec i ] (v : 'bool) : 'public
+ *         {
+ *           #import {sig #[ DDH.SAMPLE ] : 'unit → 'public × 'public × 'public} as DDH ;;
+ *           #import {sig #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1} as ZKP ;;
+ *           abc ← DDH Datatypes.tt ;;
+ *           x_i ← get DDH.secret_loc1 ;;
+ *           x_j ← get DDH.secret_loc2 ;;
+ *           let '(y_i, (y_j, c)) := abc in
+ *           let y_j' := fto (g ^+ ((finv f') x_j)) in
+ *             zkp1 ← ZKP (y_i, x_i) ;;
+ *             zkp2 ← ZKP (y_j', (finv f') x_j) ;;
+ *             let m' := (setm (setm m j (y_j', zkp2)) i (y_i, zkp1)) in
+ *             #assert (size (domm m') == n) ;;
+ *               @ret 'public (fto ((otf c) *  g ^+ (if b then v else (negb v))))
+ *         }
+ *     ].
+ *   Proof.
+ *     ssprove_valid.
+ *     all: rewrite in_fsetU.
+ *     all: apply /orP.
+ *     {
+ *       left.
+ *       unfold DDH.DDH_E.
+ *       rewrite fset_cons -fset0E fsetU0.
+ *       by apply /fset1P.
+ *     }
+ *     {
+ *       right.
+ *       rewrite fset_cons -fset0E fsetU0.
+ *       by apply /fset1P.
+ *     }
+ *     {
+ *       right.
+ *       rewrite fset_cons -fset0E fsetU0.
+ *       by apply /fset1P.
+ *     }
+ *   Qed.
+ * 
+ *   Module RO1 := Sigma1.Sigma.Oracle.
+ *   Module RO2 := Sigma2.Oracle.
+ * 
+ *   Definition combined_locations :=
+ *     (Sigma1.MyAlg.Sigma_locs :|: RO1.RO_locs).
+ * 
+ *   Equations? Exec_i_realised b m (i j : pid) : package (P_i_locs i :|: combined_locations) [interface] (Exec_i_E i) :=
+ *     Exec_i_realised b m i j :=
+ *       {package (Exec_i i j m) ∘ (par ((P_i i b) ∘ (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO))
+ *                                       (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO))}.
+ *   Proof.
+ *     ssprove_valid.
+ *     10: apply fsub0set.
+ *     8:{ rewrite fsetUid. apply fsubsetxx. }
+ *     9: apply fsubsetxx.
+ *     7:{ erewrite fsetUid. apply fsubsetxx. }
+ *     4: apply fsubsetUr.
+ *     3: apply fsubsetUl.
+ *     all: unfold combined_locations.
+ *     - apply fsubsetUl.
+ *     - apply fsubsetUr.
+ *     - eapply fsubset_trans. 2: eapply fsubsetUr.
+ *       apply fsubsetUl.
+ *     - eapply fsubset_trans. 2: eapply fsubsetUr.
+ *       apply fsubsetUr.
+ *     - unfold EXEC_i_I, P_i_E, Sigma1_I.
+ *       rewrite !fset_cons.
+ *       rewrite -!fsetUA.
+ *       repeat apply fsetUS.
+ *       rewrite -fset0E fsetU0 fset0U.
+ *       apply fsubsetUr.
+ *   Qed.
+ * 
+ * 
+ *   Lemma loc_helper_commit i:
+ *     Sigma1.MyAlg.commit_loc \in P_i_locs i :|: combined_locations.
+ *   Proof.
+ *     unfold combined_locations.
+ *     unfold Sigma1.MyAlg.Sigma_locs.
+ *     rewrite in_fsetU.
+ *     apply /orP ; right.
+ *     rewrite fset_cons.
+ *     rewrite in_fsetU.
+ *     apply /orP ; left.
+ *     rewrite in_fsetU1.
+ *     apply /orP ; left.
+ *     done.
+ *   Qed.
+ * 
+ *   Lemma loc_helper_queries i:
+ *     RO1.queries_loc \in P_i_locs i :|: combined_locations.
+ *   Proof.
+ *     unfold combined_locations.
+ *     unfold RO1.RO_locs.
+ *     rewrite in_fsetU.
+ *     apply /orP ; right.
+ *     rewrite fset_cons.
+ *     rewrite in_fsetU.
+ *     apply /orP ; right.
+ *     rewrite in_fsetU1.
+ *     apply /orP ; left.
+ *     done.
+ *   Qed.
+ * 
+ *   Lemma loc_helper_skey i:
+ *     skey_loc i \in P_i_locs i :|: combined_locations.
+ *   Proof.
+ *     unfold P_i_locs.
+ *     rewrite in_fsetU.
+ *     apply /orP ; left.
+ *     rewrite fset_cons.
+ *     rewrite in_fsetU1.
+ *     apply /orP ; left.
+ *     done.
+ *   Qed.
+ * 
+ *   Lemma loc_helper_ckey i:
+ *     ckey_loc i \in P_i_locs i :|: combined_locations.
+ *   Proof.
+ *     unfold P_i_locs.
+ *     rewrite in_fsetU.
+ *     apply /orP ; left.
+ *     rewrite !fset_cons.
+ *     rewrite in_fsetU1.
+ *     apply /orP ; right.
+ *     rewrite in_fsetU1.
+ *     apply /orP ; left.
+ *     done.
+ *   Qed.
+ * 
+ *   #[local] Hint Resolve loc_helper_commit : loc_db.
+ *   #[local] Hint Resolve loc_helper_queries : loc_db.
+ *   #[local] Hint Resolve loc_helper_skey: loc_db.
+ *   #[local] Hint Resolve loc_helper_ckey: loc_db.
+ * 
+ *   #[program] Definition Exec_i_realised_code m (i j : pid) (vote : 'bool):
+ *     code (P_i_locs i :|: combined_locations) [interface] 'public :=
+ *     {code
+ *      x ← sample uniform i_secret ;;
+ *      #put skey_loc i := x ;;
+ *      #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x)))) (otf x) ;;
+ *      x1 ← sample uniform Sigma1.MyAlg.i_witness ;;
+ *      #put Sigma1.MyAlg.commit_loc := x1 ;;
+ *      #put RO1.queries_loc := emptym ;;
+ *      x2 ← get RO1.queries_loc ;;
+ *      match x2 (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)))) with
+ *      | Some a =>
+ *          v ← get Sigma1.MyAlg.commit_loc ;;
+ *          x3 ← sample uniform i_secret ;;
+ *          #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x3)))) (otf x3) ;;
+ *          x5 ← sample uniform Sigma1.MyAlg.i_witness ;;
+ *          #put Sigma1.MyAlg.commit_loc := x5 ;;
+ *          #put RO1.queries_loc := emptym ;;
+ *          v0 ← get RO1.queries_loc ;;
+ *          match v0 (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) with
+ *          | Some a0 =>
+ *              x6 ← get Sigma1.MyAlg.commit_loc ;;
+ *              let x4 :=
+ *              (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3))))
+ *              in
+ *          #assert eqn
+ *                     (size
+ *                        (domm (T:=[ordType of 'I_#|'I_n|]) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|))
+ *                           (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
+ *                              (fto (expgn_rec (T:=gT) g (otf x)),
+ *                              (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;;
+ *           #put ckey_loc i := fto
+ *                               (compute_key
+ *                                  (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
+ *                                     (fto (expgn_rec (T:=gT) g (otf x)),
+ *                                     (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a,
+ *                                     fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;;
+ *          v0 ← get skey_loc i ;;
+ *          v1 ← get ckey_loc i ;;
+ *          @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote))
+ *          | None =>
+ *              a0 ← sample uniform RO1.i_random ;;
+ *              #put RO1.queries_loc := setm v0
+ *                                       (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) a0 ;;
+ *              x6 ← get Sigma1.MyAlg.commit_loc ;;
+ *              let x4 := (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in
+ *          #assert eqn
+ *                     (size
+ *                        (domm (T:=[ordType of 'I_#|'I_n|]) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|))
+ *                           (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
+ *                              (fto (expgn_rec (T:=gT) g (otf x)),
+ *                              (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;;
+ *           #put ckey_loc i := fto
+ *                               (compute_key
+ *                                  (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
+ *                                     (fto (expgn_rec (T:=gT) g (otf x)),
+ *                                     (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a,
+ *                                     fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;;
+ *          v0 ← get skey_loc i ;;
+ *          v1 ← get ckey_loc i ;;
+ *          @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote))
+ *          end
+ *      | None =>
+ *          a ← sample uniform RO1.i_random ;;
+ *          #put RO1.queries_loc := setm x2
+ *                                   (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)))) a ;;
+ *          v ← get Sigma1.MyAlg.commit_loc ;;
+ *          x3 ← sample uniform i_secret ;;
+ *          #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x3)))) (otf x3) ;;
+ *          x5 ← sample uniform Sigma1.MyAlg.i_witness ;;
+ *          #put Sigma1.MyAlg.commit_loc := x5 ;;
+ *          #put RO1.queries_loc := emptym ;;
+ *          v0 ← get RO1.queries_loc ;;
+ *          match v0 (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) with
+ *          | Some a0 =>
+ *              x6 ← get Sigma1.MyAlg.commit_loc ;;
+ *              let x4 := (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in
+ *              #assert eqn
+ *                  (size
+ *                  (domm (T:=[ordType of 'I_#|'I_n|]) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|))
+ *                          (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
+ *                              (fto (expgn_rec (T:=gT) g (otf x)),
+ *                                  (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;;
+ *              #put ckey_loc i := fto
+ *                                  (compute_key
+ *                                      (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
+ *                                              (fto (expgn_rec (T:=gT) g (otf x)),
+ *                                              (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a,
+ *                                                  fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;;
+ *             v0 ← get skey_loc i ;;
+ *             v1 ← get ckey_loc i ;;
+ *             @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote))
+ *         | None =>
+ *                    a0 ← sample uniform RO1.i_random ;;
+ *                    #put RO1.queries_loc := setm v0
+ *                                             (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) a0 ;;
+ *                    x6 ← get Sigma1.MyAlg.commit_loc ;;
+ *                    let x4 := (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in
+ *          #assert eqn
+ *                     (size
+ *                        (domm (T:=[ordType of 'I_#|'I_n|]) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|))
+ *                           (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
+ *                              (fto (expgn_rec (T:=gT) g (otf x)),
+ *                              (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;;
+ *           #put ckey_loc i := fto
+ *                               (compute_key
+ *                                  (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
+ *                                     (fto (expgn_rec (T:=gT) g (otf x)),
+ *                                     (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a,
+ *                                     fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;;
+ *          v0 ← get skey_loc i ;;
+ *          v1 ← get ckey_loc i ;;
+ *          @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote))
+ *                end
+ *      end
+ *     }.
+ *   Next Obligation.
+ *     intros.
+ *     ssprove_valid ; auto with loc_db.
+ *     destruct (v1 _) ; ssprove_valid ; auto with loc_db.
+ *     - destruct (v5 _) ; ssprove_valid ; auto with loc_db.
+ *     - destruct (v6 _) ; ssprove_valid ; auto with loc_db.
+ *   Qed.
+ * 
+ *   #[program] Definition Exec_i_realised_code_runnable m (i j : pid) (vote : 'bool):
+ *     code (P_i_locs i :|: combined_locations) [interface] 'public :=
+ *     {code
+ *      x ← sample uniform i_secret ;;
+ *      #put skey_loc i := x ;;
+ *      #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x)))) (otf x) ;;
+ *      x1 ← sample uniform Sigma1.MyAlg.i_witness ;;
+ *      #put Sigma1.MyAlg.commit_loc := x1 ;;
+ *      x2 ← get RO1.queries_loc ;;
+ *          a ← sample uniform RO1.i_random ;;
+ *          #put RO1.queries_loc := setm x2
+ *                                   (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)))) a ;;
+ *          v ← get Sigma1.MyAlg.commit_loc ;;
+ *          x3 ← sample uniform i_secret ;;
+ *          #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x3)))) (otf x3) ;;
+ *          x5 ← sample uniform Sigma1.MyAlg.i_witness ;;
+ *          #put Sigma1.MyAlg.commit_loc := x5 ;;
+ *          v0 ← get RO1.queries_loc ;;
+ *                    a0 ← sample uniform RO1.i_random ;;
+ *                    #put RO1.queries_loc := setm v0
+ *                                             (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) a0 ;;
+ *                    x6 ← get Sigma1.MyAlg.commit_loc ;;
+ *                    let x4 := (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in
+ *          #assert eqn
+ *                     (size
+ *                        (domm (T:=[ordType of 'I_#|'I_n|]) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|))
+ *                           (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
+ *                              (fto (expgn_rec (T:=gT) g (otf x)),
+ *                              (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;;
+ *           #put ckey_loc i := fto
+ *                               (compute_key
+ *                                  (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
+ *                                     (fto (expgn_rec (T:=gT) g (otf x)),
+ *                                     (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a,
+ *                                     fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;;
+ *          v0 ← get skey_loc i ;;
+ *          v1 ← get ckey_loc i ;;
+ *          @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote))
+ *     }.
+ *   Next Obligation.
+ *     intros.
+ *     ssprove_valid ; auto with loc_db.
+ *   Qed.
+ * 
+ *   Lemma code_pkg_equiv m i j (vote : 'bool):
+ *     ⊢
+ *     ⦃ λ '(h₀, h₁), h₀ = h₁ ⦄
+ *     get_op_default (Exec_i_realised true m i j) ((Exec i), ('bool, 'public)) vote
+ *     ≈
+ *     Exec_i_realised_code m i j vote
+ *     ⦃ eq ⦄.
+ *   Proof.
+ *     unfold Exec_i_realised.
+ *     rewrite get_op_default_link.
+ *     erewrite get_op_default_spec.
+ *     2: {
+ *       cbn.
+ *       rewrite eqnE eq_refl.
+ *       done.
+ *     }
+ *     ssprove_code_simpl.
+ *     simpl.
+ *     repeat choice_type_eqP_handle.
+ *     rewrite !cast_fun_K.
+ *     ssprove_code_simpl.
+ *     simpl.
+ *     ssprove_code_simpl.
+ *     ssprove_code_simpl_more.
+ *     simpl.
+ *     ssprove_sync_eq=>x.
+ *     simpl.
+ *     ssprove_code_simpl_more.
+ *     ssprove_sync_eq.
+ *     ssprove_sync_eq=>rel1.
+ *     ssprove_sync_eq=>r1.
+ *     ssprove_sync_eq.
+ *     ssprove_code_simpl.
+ * 
+ *     ssprove_contract_put_get_lhs.
+ *     ssprove_contract_put_get_rhs.
+ * 
+ *     ssprove_sync_eq.
+ *     simpl.
+ * 
+ *     ssprove_code_simpl.
+ *     ssprove_sync_eq=>a.
+ *     ssprove_sync_eq.
+ *     ssprove_sync_eq=>v.
+ * 
+ *     apply r_uniform_bij with (f := (fun (x : Arit (@uniform i_secret Sigma1.MyParam.Witness_pos)) => (x : Arit (@uniform i_secret Secret_pos)))).
+ *     1: exact (inv_bij (fun x => erefl)).
+ *     intros.
+ * 
+ *     match goal with
+ *     | |- context [⊢ ⦃ _ ⦄ bind (assertD ?v ?z) ?y ≈ ?x  ⦃ _ ⦄] =>
+ *         set (temp1 := x) ; set (temp2 := y) ;
+ *         set (temp3 := z) ; set (temp4 := v) in *
+ *     end.
+ * 
+ *     apply (r_transL  (@assertD _ temp4 (fun z => x ← temp3 z ;; temp2 x))).
+ *     1:{
+ *       eapply r_transR.
+ *       1:{
+ *         apply r_bind_assertD_sym.
+ *       }
+ *       apply rreflexivity_rule.
+ *     }
+ *     subst temp1 temp2 temp3 temp4.
+ *     
+ *     apply (@r_assertD_same (chFin (mkpos #|gT|)) _).
+ *     intros.
+ * 
+ *     simpl.
+ *     ssprove_sync_eq=>a0.
+ *     ssprove_sync_eq.
+ * 
+ *     ssprove_contract_put_get_lhs.
+ *     ssprove_contract_put_get_rhs.
+ *     
+ *     ssprove_sync_eq.
+ *     simpl.
+ * 
+ *     ssprove_sync_eq=>a1.
+ *     ssprove_sync_eq.
+ *     ssprove_sync_eq=>a2.
+ * 
+ *     match goal with
+ *     | |- context [⊢ ⦃ _ ⦄ bind (assertD ?v ?z) ?y ≈ ?x  ⦃ _ ⦄] =>
+ *         set (temp1 := x) ; set (temp2 := y) ;
+ *         set (temp3 := z) ; set (temp4 := v) in *
+ *     end.
+ *     
+ *     apply (r_transL  (@assertD _ temp4 (fun z => x ← temp3 z ;; temp2 x))).
+ *     1:{
+ *       eapply r_transR.
+ *       1:{
+ *         apply r_bind_assertD_sym.
+ *       }
+ *       apply rreflexivity_rule.
+ *     }
+ *     subst temp1 temp2 temp3 temp4. hnf.
+ * 
+ *     apply r_assertD_same.
+ *     intros.
+ * 
+ *     ssprove_sync_eq.
+ *     ssprove_sync_eq=>a3.
+ *     ssprove_sync_eq=>a4.
+ *     apply r_ret.
+ *     intros. subst.
+ *     reflexivity.
+ *   Qed.
+ * 
+ *   #[tactic=notac] Equations? Aux_realised (b : bool) (i j : pid) m f' :
+ *     package (DDH.DDH_locs :|: P_i_locs i :|: combined_locations) Game_import [interface #val #[ Exec i ] : 'bool → 'public] :=
+ *     Aux_realised b i j m f' := {package Aux b i j m f' ∘ (par DDH.DDH_real (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) }.
+ *   Proof.
+ *     ssprove_valid.
+ *     4:{ rewrite fsetUid. rewrite -fset0E. apply fsub0set. }
+ *     6: apply fsubsetxx.
+ *     3:{ rewrite -fsetUA. apply fsubsetxx. }
+ *     4:{ rewrite -fsetUA. apply fsubsetUl. }
+ *     all: unfold combined_locations.
+ *     - eapply fsubset_trans. 2: apply fsubsetUr.
+ *       apply fsubsetUl.
+ *     - eapply fsubset_trans. 2: apply fsubsetUr.
+ *       apply fsubsetUr.
+ *     - unfold DDH.DDH_E.
+ *       apply fsetUS.
+ *       rewrite !fset_cons.
+ *       apply fsubsetUr.
+ *   Qed.
+ * 
+ *   #[tactic=notac] Equations? Aux_ideal_realised (b : bool) (i j : pid) m f' :
+ *     package (DDH.DDH_locs :|: P_i_locs i :|: combined_locations) Game_import [interface #val #[ Exec i ] : 'bool → 'public] :=
+ *     Aux_ideal_realised b i j m f' := {package Aux b i j m f' ∘ (par DDH.DDH_ideal (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) }.
+ *   Proof.
+ *     ssprove_valid.
+ *     4:{ rewrite fsetUid. rewrite -fset0E. apply fsub0set. }
+ *     6: apply fsubsetxx.
+ *     3:{ rewrite -fsetUA. apply fsubsetxx. }
+ *     4:{ rewrite -fsetUA. apply fsubsetUl. }
+ *     all: unfold combined_locations.
+ *     - eapply fsubset_trans. 2: apply fsubsetUr.
+ *       apply fsubsetUl.
+ *     - eapply fsubset_trans. 2: apply fsubsetUr.
+ *       apply fsubsetUr.
+ *     - unfold DDH.DDH_E.
+ *       apply fsetUS.
+ *       rewrite !fset_cons.
+ *       apply fsubsetUr.
+ *   Qed.
+ * 
+ *   Notation inv i := (heap_ignore (P_i_locs i :|: DDH.DDH_locs)).
+ * 
+ *   #[local] Hint Extern 50 (_ = code_link _ _) =>
+ *     rewrite code_link_scheme
+ *     : ssprove_code_simpl.
+ * 
+ *   (** We extend swapping to schemes.
+ *     This means that the ssprove_swap tactic will be able to swap any command
+ *     with a scheme without asking a proof from the user.
+ *   *)
+ *   #[local] Hint Extern 40 (⊢ ⦃ _ ⦄ x ← ?s ;; y ← cmd _ ;; _ ≈ _ ⦃ _ ⦄) =>
+ *     eapply r_swap_scheme_cmd ; ssprove_valid
+ *     : ssprove_swap.
+ * 
+ *   Lemma P_i_aux_equiv (i j : pid) m:
+ *     fdisjoint Sigma1.MyAlg.Sigma_locs DDH.DDH_locs →
+ *     i != j →
+ *     (∃ f,
+ *       bijective f ∧
+ *       (∀ b, (Exec_i_realised b m i j) ≈₀ Aux_realised b i j m f)).
+ *   Proof.
+ *     intros Hdisj ij_neq.
+ *     have [f' Hf] := test_bij' i j m ij_neq.
+ *     simpl in Hf.
+ *     exists f'.
+ *     split.
+ *     {
+ *       assert ('I_#|'Z_#[g]|) as x.
+ *       { rewrite card_ord.
+ *         eapply Ordinal.
+ *         rewrite ltnS.
+ *         apply ltnSn.
+ *       }
+ *       specialize (Hf x).
+ *       destruct Hf.
+ *       assumption.
+ *     }
+ *     intro b.
+ *     eapply eq_rel_perf_ind with (inv := inv i).
+ *     {
+ *       ssprove_invariant.
+ *       rewrite -!fsetUA.
+ *       apply fsetUS.
+ *       do 2 (apply fsubsetU ; apply /orP ; right).
+ *       apply fsubsetUl.
+ *     }
+ *     simplify_eq_rel v.
+ *     rewrite !setmE.
+ *     rewrite !eq_refl.
+ *     ssprove_code_simpl.
+ *     repeat simplify_linking.
+ *     ssprove_sync => x_i.
+ * 
+ *     rewrite !cast_fun_K.
+ *     ssprove_code_simpl.
+ *     ssprove_code_simpl_more.
+ *     
+ *     ssprove_swap_seq_rhs [:: 4 ; 5 ; 6 ; 7]%N.
+ *     ssprove_swap_seq_rhs [:: 2 ; 3 ; 4 ; 5 ; 6]%N.
+ *     ssprove_swap_seq_rhs [:: 0 ; 1 ; 2 ; 3 ; 4 ; 5]%N.
+ *     ssprove_contract_put_get_rhs.
+ *     apply r_put_rhs.
+ *     ssprove_swap_seq_lhs [:: 0 ; 1 ; 2 ; 3]%N.
+ *     unfold Sigma1.MyParam.R.
+ *     have Hord : ∀ x, (nat_of_ord x) = (nat_of_ord (otf x)).
+ *     {
+ *       unfold otf.
+ *       intros n x.
+ *       rewrite enum_val_ord.
+ *       done.
+ *     }
+ *     rewrite -Hord otf_fto eq_refl.
+ *     simpl.
+ *     ssprove_sync => r_i.
+ *     apply r_put_vs_put.
+ *     ssprove_restore_pre.
+ *     { ssprove_invariant.
+ *       apply preserve_update_r_ignored_heap_ignore.
+ *       - unfold DDH.DDH_locs.
+ *         rewrite in_fsetU.
+ *         apply /orP ; right.
+ *         rewrite fset_cons.
+ *         rewrite in_fsetU.
+ *         apply /orP ; left.
+ *         by apply /fset1P.
+ *       - apply preserve_update_mem_nil.
+ *     }
+ *     ssprove_sync.
+ *     ssprove_swap_seq_lhs [:: 0 ]%N.
+ *     ssprove_swap_seq_rhs [:: 2 ; 1 ; 0]%N.
+ *     ssprove_sync => queries.
+ *     destruct (queries (Sigma1.Sigma.prod_assoc (fto (g ^+ x_i), fto (g ^+ otf r_i)))) eqn:e.
+ *     all: rewrite e; simpl.
+ *     all: ssprove_code_simpl_more.
+ *     - ssprove_swap_seq_lhs [:: 0 ; 1 ; 2 ; 3 ; 4 ; 5]%N.
+ *       ssprove_swap_seq_lhs [:: 0 ; 1 ]%N.
+ *       eapply r_uniform_bij.
+ *       { apply Hf.
+ *         + rewrite card_ord.
+ *           rewrite Zp_cast.
+ *           2: apply (prime_gt1 prime_order).
+ *           eapply Ordinal.
+ *           apply (prime_gt1 prime_order).
+ *       }
+ *       intro x.
+ *       specialize (Hf x).
+ *       destruct Hf as [bij_f Hf].
+ *       apply bij_inj in bij_f.
+ *       apply finv_f in bij_f.
+ *       ssprove_contract_put_get_rhs.
+ *       rewrite bij_f.
+ *       rewrite -Hord !otf_fto !eq_refl.
+ *       simpl.
+ *       apply r_put_rhs.
+ *       ssprove_restore_pre.
+ *       {
+ *         apply preserve_update_r_ignored_heap_ignore.
+ *         - unfold DDH.DDH_locs.
+ *           rewrite !fset_cons.
+ *           rewrite !in_fsetU.
+ *           apply /orP ; right.
+ *           apply /orP ; right.
+ *           apply /orP ; left.
+ *           by apply /fset1P.
+ *         - apply preserve_update_mem_nil.
+ *       }
+ *       apply r_get_remember_lhs.
+ *       intros ?.
+ *       apply r_get_remember_rhs.
+ *       intros ?.
+ *       ssprove_forget_all.
+ *       ssprove_sync=>r_j.
+ *       apply r_put_vs_put.
+ *       ssprove_restore_pre.
+ *       1: ssprove_invariant.
+ *       clear e queries.
+ *       ssprove_sync.
+ *       ssprove_swap_seq_lhs [:: 0]%N.
+ *       ssprove_sync=>queries.
+ *       destruct (queries (Sigma1.Sigma.prod_assoc (fto (g ^+ x), fto (g ^+ otf r_j)))) eqn:e.
+ *       all: rewrite e.
+ *       all: ssprove_code_simpl.
+ *       all: ssprove_code_simpl_more.
+ *       + ssprove_swap_seq_lhs [:: 0 ; 1]%N.
+ *         simpl.
+ *         apply r_get_remember_lhs.
+ *         intros ?.
+ *         apply r_get_remember_rhs.
+ *         intros ?.
+ *         ssprove_forget_all.
+ *         apply r_assertD.
+ *         {
+ *           intros ??.
+ *           rewrite !domm_set.
+ *           done.
+ *         }
+ *         intros _ _.
+ *         ssprove_swap_lhs 1%N.
+ *         {
+ *           move: H0 => /eqP.
+ *           erewrite eqn_add2r.
+ *           intros contra.
+ *           discriminate.
+ *         }
+ *         ssprove_contract_put_get_lhs.
+ *         apply r_put_lhs.
+ *         ssprove_contract_put_get_lhs.
+ *         apply r_put_lhs.
+ *         ssprove_restore_pre.
+ *         {
+ *           repeat apply preserve_update_l_ignored_heap_ignore.
+ *           1,2: unfold P_i_locs ; rewrite in_fsetU.
+ *           1,2: apply /orP ; left ; rewrite !fset_cons ;
+ *                rewrite -fset0E fsetU0 ; rewrite in_fsetU.
+ *           - apply /orP ; right.
+ *             by apply /fset1P.
+ *           - apply /orP ; left.
+ *             by apply /fset1P.
+ *           - apply preserve_update_mem_nil.
+ *         }
+ *         rewrite otf_fto.
+ *         rewrite compute_key_set_i.
+ *         set zk := (fto (g ^+ x), fto (g ^+ otf r_j), s1, fto (otf x2 + otf s1 * otf x)).
+ *         clearbody zk.
+ *         specialize (Hf zk).
+ *         rewrite !Hord.
+ *         rewrite Hf.
+ *         rewrite -!Hord.
+ *         rewrite -expgM.
+ *         rewrite mulnC.
+ *         case b; apply r_ret ; done.
+ *       + ssprove_swap_seq_lhs [:: 0 ; 1 ; 2 ; 3]%N.
+ *         simpl.
+ *         ssprove_sync=>e_j.
+ *         apply r_put_vs_put.
+ *         apply r_get_remember_lhs.
+ *         intros ?.
+ *         apply r_get_remember_rhs.
+ *         intros ?.
+ *         ssprove_forget_all.
+ *         apply r_assertD.
+ *         {
+ *           intros ??.
+ *           rewrite !domm_set.
+ *           done.
+ *         }
+ *         intros _ _.
+ *         ssprove_swap_lhs 1%N.
+ *         {
+ *           move: H0 => /eqP.
+ *           erewrite eqn_add2r.
+ *           intros contra.
+ *           discriminate.
+ *         }
+ *         ssprove_contract_put_get_lhs.
+ *         apply r_put_lhs.
+ *         ssprove_contract_put_get_lhs.
+ *         apply r_put_lhs.
+ *         ssprove_restore_pre.
+ *         {
+ *           repeat apply preserve_update_l_ignored_heap_ignore.
+ *           1,2: unfold P_i_locs ; rewrite in_fsetU.
+ *           1,2: apply /orP ; left ; rewrite !fset_cons ;
+ *                rewrite -fset0E fsetU0 ; rewrite in_fsetU.
+ *           - apply /orP ; right.
+ *             by apply /fset1P.
+ *           - apply /orP ; left.
+ *             by apply /fset1P.
+ *           - ssprove_invariant.
+ *         }
+ *         rewrite otf_fto.
+ *         rewrite compute_key_set_i.
+ *         set zk := (fto (g ^+ x), fto (g ^+ otf r_j), e_j, fto (otf x2 + otf e_j * otf x)).
+ *         clearbody zk.
+ *         specialize (Hf zk).
+ *         rewrite !Hord.
+ *         rewrite Hf.
+ *         rewrite -!Hord.
+ *         rewrite -expgM.
+ *         rewrite mulnC.
+ *         case b; apply r_ret ; done.
+ *     - ssprove_swap_seq_lhs [:: 0 ; 1 ; 2 ; 3 ; 4 ; 5  ; 6 ; 7]%N.
+ *       ssprove_swap_seq_lhs [:: 2 ; 1 ; 0 ]%N.
+ *       eapply r_uniform_bij.
+ *       { apply Hf.
+ *         + rewrite card_ord.
+ *           rewrite Zp_cast.
+ *           2: apply (prime_gt1 prime_order).
+ *           eapply Ordinal.
+ *           apply (prime_gt1 prime_order).
+ *       }
+ *       intro x.
+ *       specialize (Hf x).
+ *       destruct Hf as [bij_f Hf].
+ *       apply bij_inj in bij_f.
+ *       apply finv_f in bij_f.
+ *       ssprove_contract_put_get_rhs.
+ *       rewrite bij_f.
+ *       rewrite -Hord !otf_fto !eq_refl.
+ *       simpl.
+ *       apply r_put_rhs.
+ *       ssprove_restore_pre.
+ *       {
+ *         apply preserve_update_r_ignored_heap_ignore.
+ *         - unfold DDH.DDH_locs.
+ *           rewrite !fset_cons.
+ *           rewrite !in_fsetU.
+ *           apply /orP ; right.
+ *           apply /orP ; right.
+ *           apply /orP ; left.
+ *           by apply /fset1P.
+ *         - apply preserve_update_mem_nil.
+ *       }
+ *       ssprove_sync=>e_i.
+ *       apply r_put_vs_put.
+ *       apply r_get_remember_lhs.
+ *       intros ?.
+ *       apply r_get_remember_rhs.
+ *       intros ?.
+ *       ssprove_forget_all.
+ *       rewrite -Hord eq_refl.
+ *       simpl.
+ *       ssprove_sync=>r_j.
+ *       apply r_put_vs_put.
+ *       ssprove_restore_pre.
+ *       1: ssprove_invariant.
+ *       clear e queries.
+ *       ssprove_sync.
+ *       ssprove_swap_seq_lhs [:: 0]%N.
+ *       ssprove_sync=>queries.
+ *       destruct (queries (Sigma1.Sigma.prod_assoc (fto (g ^+ x), fto (g ^+ otf r_j)))) eqn:e.
+ *       all: rewrite e.
+ *       all: ssprove_code_simpl.
+ *       all: ssprove_code_simpl_more.
+ *       + ssprove_swap_seq_lhs [:: 0 ; 1]%N.
+ *         simpl.
+ *         apply r_get_remember_lhs.
+ *         intros ?.
+ *         apply r_get_remember_rhs.
+ *         intros ?.
+ *         ssprove_forget_all.
+ *         apply r_assertD.
+ *         {
+ *           intros ??.
+ *           rewrite !domm_set.
+ *           done.
+ *         }
+ *         intros _ _.
+ *         ssprove_swap_lhs 1%N.
+ *         {
+ *           move: H0 => /eqP.
+ *           erewrite eqn_add2r.
+ *           intros contra.
+ *           discriminate.
+ *         }
+ *         ssprove_contract_put_get_lhs.
+ *         apply r_put_lhs.
+ *         ssprove_contract_put_get_lhs.
+ *         apply r_put_lhs.
+ *         ssprove_restore_pre.
+ *         {
+ *           repeat apply preserve_update_l_ignored_heap_ignore.
+ *           1,2: unfold P_i_locs ; rewrite in_fsetU.
+ *           1,2: apply /orP ; left ; rewrite !fset_cons ;
+ *                rewrite -fset0E fsetU0 ; rewrite in_fsetU.
+ *           - apply /orP ; right.
+ *             by apply /fset1P.
+ *           - apply /orP ; left.
+ *             by apply /fset1P.
+ *           - apply preserve_update_mem_nil.
+ *         }
+ *         rewrite otf_fto.
+ *         rewrite compute_key_set_i.
+ *         set zk := (fto (g ^+ x), fto (g ^+ otf r_j), s, fto (otf x2 + otf s * otf x)).
+ *         clearbody zk.
+ *         specialize (Hf zk).
+ *         rewrite !Hord.
+ *         rewrite Hf.
+ *         rewrite -!Hord.
+ *         rewrite -expgM.
+ *         rewrite mulnC.
+ *         case b; apply r_ret ; done.
+ *       + ssprove_swap_seq_lhs [:: 0 ; 1 ; 2 ; 3]%N.
+ *         simpl.
+ *         ssprove_sync=>e_j.
+ *         apply r_put_vs_put.
+ *         apply r_get_remember_lhs.
+ *         intros ?.
+ *         apply r_get_remember_rhs.
+ *         intros ?.
+ *         ssprove_forget_all.
+ *         apply r_assertD.
+ *         {
+ *           intros ??.
+ *           rewrite !domm_set.
+ *           done.
+ *         }
+ *         intros _ _.
+ *         ssprove_swap_lhs 1%N.
+ *         {
+ *           move: H0 => /eqP.
+ *           erewrite eqn_add2r.
+ *           intros contra.
+ *           discriminate.
+ *         }
+ *         ssprove_contract_put_get_lhs.
+ *         apply r_put_lhs.
+ *         ssprove_contract_put_get_lhs.
+ *         apply r_put_lhs.
+ *         ssprove_restore_pre.
+ *         {
+ *           repeat apply preserve_update_l_ignored_heap_ignore.
+ *           1,2: unfold P_i_locs ; rewrite in_fsetU.
+ *           1,2: apply /orP ; left ; rewrite !fset_cons ;
+ *                rewrite -fset0E fsetU0 ; rewrite in_fsetU.
+ *           - apply /orP ; right.
+ *             by apply /fset1P.
+ *           - apply /orP ; left.
+ *             by apply /fset1P.
+ *           - ssprove_invariant.
+ *         }
+ *         rewrite otf_fto.
+ *         rewrite compute_key_set_i.
+ *         set zk := (fto (g ^+ x), fto (g ^+ otf r_j), e_j, fto (otf x2 + otf e_j * otf x)).
+ *         clearbody zk.
+ *         specialize (Hf zk).
+ *         rewrite !Hord.
+ *         rewrite Hf.
+ *         rewrite -!Hord.
+ *         rewrite -expgM.
+ *         rewrite mulnC.
+ *         case b; apply r_ret ; done.
+ *   Qed.
+ * 
+ *   Lemma Hord (x : secret): (nat_of_ord x) = (nat_of_ord (otf x)).
+ *   Proof.
+ *       unfold otf.
+ *       rewrite enum_val_ord.
+ *       done.
+ *   Qed.
+ * 
+ *   Lemma vote_hiding_bij (c : secret) (v : bool):
+ *     fto (otf (fto (g ^+ c)) * g ^+ v) =
+ *       fto
+ *         (otf (fto (g ^+ (if v then fto (Zp_add (otf c) Zp1) else fto (Zp_add (otf c) (Zp_opp Zp1))))) *
+ *            g ^+ (~~ v)).
+ *   Proof.
+ *     f_equal.
+ *     rewrite !otf_fto.
+ *     rewrite -!expgD.
+ *     have h' : ∀ (x : Secret), nat_of_ord x = (nat_of_ord (fto x)).
+ *     {
+ *         unfold fto.
+ *         intros k.
+ *         rewrite enum_rank_ord.
+ *         done.
+ *     }
+ *     case v.
+ *     ++ apply /eqP.
+ *        rewrite eq_expg_mod_order.
+ *        rewrite addn0.
+ *        have h : ∀ (x : secret), (((nat_of_ord x) + 1) %% q'.+2)%N = (nat_of_ord (Zp_add (otf x) Zp1)).
+ *        {
+ *          intro k.
+ *          unfold Zp_add.
+ *          simpl.
+ *          rewrite -Hord.
+ *          apply /eqP.
+ *          rewrite eq_sym.
+ *          apply /eqP.
+ *          rewrite -> Zp_cast at 2.
+ *          2: apply (prime_gt1 prime_order).
+ *          rewrite -> Zp_cast at 1.
+ *          2: apply (prime_gt1 prime_order).
+ *          rewrite modnDmr.
+ *          rewrite Fp_cast.
+ *          2: apply prime_order.
+ *          reflexivity.
+ *        }
+ *        rewrite -h'.
+ *        rewrite -h.
+ *        rewrite -modn_mod.
+ *        rewrite Fp_cast.
+ *        2: apply prime_order.
+ *        1: apply eq_refl.
+ *     ++ apply /eqP.
+ *        rewrite eq_expg_mod_order.
+ *        rewrite addn0.
+ *        unfold Zp_add, Zp_opp, Zp1.
+ *        simpl.
+ *        repeat rewrite -> Zp_cast at 12.
+ *        2-4: apply (prime_gt1 prime_order).
+ *        rewrite -!Hord.
+ *        have -> : (#[g] - 1 %% #[g])%N = #[g].-1.
+ *        { rewrite modn_small.
+ *          2: apply (prime_gt1 prime_order).
+ *          by rewrite -subn1.
+ *        }
+ *        rewrite modn_small.
+ *        2:{
+ *          destruct c as [c Hc].
+ *          move: Hc.
+ *          simpl.
+ *          unfold DDH.i_space, DDHParams.Space, Secret.
+ *          rewrite card_ord.
+ *          rewrite Zp_cast.
+ *          2: apply (prime_gt1 prime_order).
+ *          done.
+ *        }
+ *        have -> : (#[g].-1 %% #[g])%N = #[g].-1.
+ *        {
+ *          rewrite modn_small.
+ *          1: reflexivity.
+ *          apply ltnSE.
+ *          rewrite -subn1 -2!addn1.
+ *          rewrite subnK.
+ *          2: apply (prime_gt0 prime_order).
+ *          rewrite addn1.
+ *          apply ltnSn.
+ *        }
+ *        rewrite -h'.
+ *        simpl.
+ *        rewrite -> Zp_cast at 9.
+ *        2: apply (prime_gt1 prime_order).
+ *        rewrite modnDml.
+ *        rewrite -subn1.
+ *        rewrite -addnA.
+ *        rewrite subnK.
+ *        2: apply (prime_gt0 prime_order).
+ *        rewrite -modnDmr.
+ *        rewrite modnn.
+ *        rewrite addn0.
+ *        rewrite modn_small.
+ *        1: apply eq_refl.
+ *        destruct c as [h Hc].
+ *        move: Hc.
+ *        unfold DDH.i_space, DDHParams.Space, Secret.
+ *        simpl.
+ *        rewrite card_ord.
+ *        rewrite Zp_cast.
+ *        2: apply (prime_gt1 prime_order).
+ *        done.
+ *   Qed.
+ * 
+ *   Lemma vote_hiding (i j : pid) m:
+ *     i != j →
+ *     ∀ LA A ϵ_DDH,
+ *       ValidPackage LA [interface #val #[ Exec i ] : 'bool → 'public] A_export A →
+ *       fdisjoint Sigma1.MyAlg.Sigma_locs DDH.DDH_locs →
+ *       fdisjoint LA DDH.DDH_locs →
+ *       fdisjoint LA (P_i_locs i) →
+ *       fdisjoint LA combined_locations →
+ *       (∀ D, DDH.ϵ_DDH D <= ϵ_DDH) →
+ *     AdvantageE (Exec_i_realised true m i j) (Exec_i_realised false m i j) A <= ϵ_DDH + ϵ_DDH.
+ *   Proof.
+ *     intros ij_neq LA A ϵ_DDH Va Hdisj Hdisj2 Hdisj3 Hdisj4 Dadv.
+ *     have [f' [bij_f Hf]] := P_i_aux_equiv i j m Hdisj ij_neq.
+ *     ssprove triangle (Exec_i_realised true m i j) [::
+ *       (Aux_realised true i j m f').(pack) ;
+ *       (Aux true i j m f') ∘ (par DDH.DDH_ideal (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) ;
+ *       (Aux false i j m f') ∘ (par DDH.DDH_ideal (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) ;
+ *       (Aux_realised false i j m f').(pack)
+ *     ] (Exec_i_realised false m i j) A as ineq.
+ *     eapply le_trans.
+ *     2: {
+ *       instantiate (1 := 0 + ϵ_DDH + 0 + ϵ_DDH + 0).
+ *       by rewrite ?GRing.addr0 ?GRing.add0r.
+ *     }
+ *     eapply le_trans. 1: exact ineq.
+ *     clear ineq.
+ *     repeat eapply ler_add.
+ *     {
+ *       apply eq_ler.
+ *       specialize (Hf true LA A Va).
+ *       apply Hf.
+ *       - rewrite fdisjointUr.
+ *         apply /andP ; split ; assumption.
+ *       - rewrite fdisjointUr.
+ *         apply /andP ; split.
+ *         2: assumption.
+ *         rewrite fdisjointUr.
+ *         apply /andP ; split ; assumption.
+ *     }
+ *     {
+ *       unfold Aux_realised.
+ *       rewrite -Advantage_link.
+ *       rewrite par_commut.
+ *       have -> : (par DDH.DDH_ideal (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) =
+ *                (par (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO) DDH.DDH_ideal).
+ *       { apply par_commut. ssprove_valid. }
+ *       erewrite Advantage_par.
+ *       3: apply DDH.DDH_real.
+ *       3: apply DDH.DDH_ideal.
+ *       2: {
+ *         ssprove_valid.
+ *         - eapply fsubsetUr.
+ *         - apply fsubsetUl.
+ *       }
+ *       1: rewrite Advantage_sym ; apply Dadv.
+ *       - ssprove_valid.
+ *       - unfold trimmed.
+ *         rewrite -link_trim_commut.
+ *         f_equal.
+ *         unfold trim.
+ *         rewrite !fset_cons -fset0E fsetU0.
+ *         rewrite !filterm_set.
+ *         simpl.
+ *         rewrite !in_fsetU !in_fset1 !eq_refl.
+ *         rewrite filterm0.
+ *         done.
+ *       - unfold trimmed.
+ *         unfold trim.
+ *         rewrite !fset_cons -fset0E fsetU0.
+ *         rewrite !filterm_set.
+ *         simpl.
+ *         rewrite !in_fset1 !eq_refl.
+ *         rewrite filterm0.
+ *         done.
+ *       - unfold trimmed.
+ *         unfold trim.
+ *         rewrite !fset_cons -fset0E fsetU0.
+ *         rewrite !filterm_set.
+ *         simpl.
+ *         rewrite !in_fset1 !eq_refl.
+ *         rewrite filterm0.
+ *         done.
+ *     }
+ *     2:{
+ *       unfold Aux_realised.
+ *       rewrite -Advantage_link.
+ *       rewrite par_commut.
+ *       have -> : (par DDH.DDH_real (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) =
+ *                (par (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO) DDH.DDH_real).
+ *       { apply par_commut. ssprove_valid. }
+ *       erewrite Advantage_par.
+ *       3: apply DDH.DDH_ideal.
+ *       3: apply DDH.DDH_real.
+ *       2: {
+ *         ssprove_valid.
+ *         - eapply fsubsetUr.
+ *         - apply fsubsetUl.
+ *       }
+ *       1: apply Dadv.
+ *       - ssprove_valid.
+ *       - unfold trimmed.
+ *         rewrite -link_trim_commut.
+ *         f_equal.
+ *         unfold trim.
+ *         rewrite !fset_cons -fset0E fsetU0.
+ *         rewrite !filterm_set.
+ *         simpl.
+ *         rewrite !in_fsetU !in_fset1 !eq_refl.
+ *         rewrite filterm0.
+ *         done.
+ *       - unfold trimmed.
+ *         unfold trim.
+ *         unfold DDH.DDH_E.
+ *         rewrite !fset_cons -fset0E fsetU0.
+ *         rewrite !filterm_set.
+ *         simpl.
+ *         rewrite !in_fset1 !eq_refl.
+ *         rewrite filterm0.
+ *         done.
+ *       - unfold trimmed.
+ *         unfold trim.
+ *         unfold DDH.DDH_E.
+ *         rewrite !fset_cons -fset0E fsetU0.
+ *         rewrite !filterm_set.
+ *         simpl.
+ *         rewrite !in_fset1 !eq_refl.
+ *         rewrite filterm0.
+ *         done.
+ *     }
+ *     2: {
+ *       apply eq_ler.
+ *       specialize (Hf false LA A Va).
+ *       rewrite Advantage_sym.
+ *       apply Hf.
+ *       - rewrite fdisjointUr.
+ *         apply /andP ; split ; assumption.
+ *       - rewrite fdisjointUr.
+ *         apply /andP ; split.
+ *         2: assumption.
+ *         rewrite fdisjointUr.
+ *         apply /andP ; split ; assumption.
+ *     }
+ *     apply eq_ler.
+ *     eapply eq_rel_perf_ind with (inv := inv i).
+ *     5: apply Va.
+ *     1,2: apply Aux_ideal_realised.
+ *     3: {
+ *       rewrite fdisjointUr.
+ *       apply /andP ; split.
+ *       2: assumption.
+ *       rewrite fdisjointUr.
+ *       apply /andP ; split ; assumption.
+ *     }
+ *     3: {
+ *       rewrite fdisjointUr.
+ *       apply /andP ; split.
+ *       2: assumption.
+ *       rewrite fdisjointUr.
+ *       apply /andP ; split ; assumption.
+ *     }
+ *     {
+ *       ssprove_invariant.
+ *       rewrite fsetUC.
+ *       rewrite -!fsetUA.
+ *       apply fsetUS.
+ *       apply fsubsetUl.
+ *     }
+ *     simplify_eq_rel v.
+ *     rewrite !setmE.
+ *     rewrite !eq_refl.
+ *     simpl.
+ *     repeat simplify_linking.
+ *     rewrite !cast_fun_K.
+ *     ssprove_code_simpl.
+ *     ssprove_code_simpl_more.
+ *     ssprove_sync=>x_i.
+ *     ssprove_sync=>x_j.
+ *     pose f_v := (fun (x : secret) =>
+ *                    if v then
+ *                    fto (Zp_add (otf x) Zp1)
+ *                    else
+ *                    fto (Zp_add (otf x) (Zp_opp Zp1))
+ *                 ).
+ *     assert (bijective f_v) as bij_fv.
+ *     {
+ *       exists (fun x =>
+ *            if v then
+ *              fto (Zp_add (otf x) (Zp_opp Zp1))
+ *            else
+ *              fto (Zp_add (otf x) Zp1)
+ *         ).
+ *       - intro x.
+ *         unfold f_v.
+ *         case v.
+ *         + rewrite otf_fto.
+ *           rewrite -Zp_addA.
+ *           rewrite Zp_addC.
+ *           have -> : (Zp_add Zp1 (Zp_opp Zp1)) = (Zp_add (Zp_opp Zp1) Zp1).
+ *           { intro n. by rewrite Zp_addC. }
+ *           rewrite Zp_addNz.
+ *           rewrite Zp_add0z.
+ *           by rewrite fto_otf.
+ *         + rewrite otf_fto.
+ *           rewrite -Zp_addA.
+ *           rewrite Zp_addC.
+ *           rewrite Zp_addNz.
+ *           rewrite Zp_add0z.
+ *           by rewrite fto_otf.
+ *       - intro x.
+ *         unfold f_v.
+ *         case v.
+ *         + rewrite otf_fto.
+ *           rewrite -Zp_addA.
+ *           rewrite Zp_addNz.
+ *           rewrite Zp_addC.
+ *           rewrite Zp_add0z.
+ *           by rewrite fto_otf.
+ *         + rewrite otf_fto.
+ *           rewrite -Zp_addA.
+ *           rewrite Zp_addC.
+ *           have -> : (Zp_add Zp1 (Zp_opp Zp1)) = (Zp_add (Zp_opp Zp1) Zp1).
+ *           { intro n. by rewrite Zp_addC. }
+ *           rewrite Zp_addNz.
+ *           rewrite Zp_add0z.
+ *           by rewrite fto_otf.
+ *     }
+ *     eapply r_uniform_bij.
+ *     1: apply bij_fv.
+ *     intro c.
+ *     ssprove_swap_seq_rhs [:: 1 ; 2]%N.
+ *     ssprove_swap_seq_rhs [:: 0 ]%N.
+ *     ssprove_swap_seq_lhs [:: 1 ; 2]%N.
+ *     ssprove_swap_seq_lhs [:: 0 ]%N.
+ *     apply r_put_vs_put.
+ *     ssprove_contract_put_get_lhs.
+ *     ssprove_contract_put_get_rhs.
+ *     apply r_put_vs_put.
+ *     ssprove_contract_put_get_lhs.
+ *     ssprove_contract_put_get_rhs.
+ *     apply r_put_vs_put.
+ *     unfold Sigma1.MyParam.R.
+ *     rewrite -Hord otf_fto eq_refl.
+ *     simpl.
+ *     ssprove_sync=>r_i.
+ *     apply r_put_vs_put.
+ *     ssprove_restore_pre.
+ *     {
+ *       ssprove_invariant.
+ *       apply preserve_update_r_ignored_heap_ignore.
+ *       {
+ *         rewrite in_fsetU.
+ *         apply /orP ; right.
+ *         unfold DDH.DDH_locs.
+ *         rewrite !fset_cons -fset0E fsetU0.
+ *         rewrite in_fsetU.
+ *         apply /orP ; right.
+ *         rewrite in_fsetU.
+ *         apply /orP ; right.
+ *         by apply /fset1P.
+ *       }
+ *       apply preserve_update_l_ignored_heap_ignore.
+ *       2: apply preserve_update_mem_nil.
+ *       rewrite in_fsetU.
+ *       apply /orP ; right.
+ *       unfold DDH.DDH_locs.
+ *       rewrite !fset_cons -fset0E fsetU0.
+ *       rewrite in_fsetU.
+ *       apply /orP ; right.
+ *       rewrite in_fsetU.
+ *       apply /orP ; right.
+ *       by apply /fset1P.
+ *     }
+ *     ssprove_sync.
+ *     ssprove_sync=>queries.
+ *     case (queries (Sigma1.Sigma.prod_assoc (fto (g ^+ x_i), fto (g ^+ otf r_i)))) eqn:e.
+ *     all: rewrite e.
+ *     all: ssprove_code_simpl ; simpl.
+ *     all: ssprove_code_simpl_more ; simpl.
+ *     - apply r_get_remember_lhs.
+ *       intros ?.
+ *       apply r_get_remember_rhs.
+ *       intros ?.
+ *       ssprove_forget_all.
+ *       rewrite -Hord otf_fto eq_refl.
+ *       simpl.
+ *       ssprove_sync=>e_j.
+ *       apply r_put_lhs.
+ *       apply r_put_rhs.
+ *       clear e queries.
+ *       ssprove_restore_pre.
+ *       1: ssprove_invariant.
+ *       ssprove_sync.
+ *       ssprove_sync=>queries.
+ *       case (queries (Sigma1.Sigma.prod_assoc (fto (g ^+ finv f' x_j), fto (g ^+ otf e_j)))) eqn:e.
+ *       all: rewrite e.
+ *       all: simpl; ssprove_code_simpl.
+ *       all: ssprove_code_simpl_more.
+ *       + apply r_get_remember_lhs.
+ *         intros ?.
+ *         apply r_get_remember_rhs.
+ *         intros ?.
+ *         ssprove_forget_all.
+ *         apply r_assertD.
+ *         {
+ *           intros ??.
+ *           rewrite !domm_set.
+ *           done.
+ *         }
+ *         intros _ _.
+ *         apply r_ret.
+ *         intros ???.
+ *         split.
+ *         2: assumption.
+ *         unfold f_v.
+ *         apply vote_hiding_bij.
+ *       + ssprove_sync=>e_i.
+ *         apply r_put_vs_put.
+ *         apply r_get_remember_lhs.
+ *         intros ?.
+ *         apply r_get_remember_rhs.
+ *         intros ?.
+ *         ssprove_forget_all.
+ *         apply r_assertD.
+ *         {
+ *           intros ??.
+ *           rewrite !domm_set.
+ *           done.
+ *         }
+ *         intros _ _.
+ *         ssprove_restore_pre.
+ *         1: ssprove_invariant.
+ *         apply r_ret.
+ *         intros ???.
+ *         split.
+ *         2: assumption.
+ *         unfold f_v.
+ *         apply vote_hiding_bij.
+ *     - ssprove_sync=>e_i.
+ *       apply r_put_vs_put.
+ *       apply r_get_remember_lhs.
+ *       intros ?.
+ *       apply r_get_remember_rhs.
+ *       intros ?.
+ *       ssprove_forget_all.
+ *       rewrite -Hord otf_fto.
+ *       rewrite -Hord eq_refl.
+ *       simpl.
+ *       ssprove_sync=>r_j.
+ *       apply r_put_lhs.
+ *       apply r_put_rhs.
+ *       ssprove_restore_pre.
+ *       1: ssprove_invariant.
+ *       ssprove_sync.
+ *       ssprove_sync=>queries'.
+ *       case (queries' (Sigma1.Sigma.prod_assoc (fto (g ^+ finv f' x_j), fto (g ^+ otf r_j)))) eqn:e'.
+ *       all: rewrite e'.
+ *       all: simpl; ssprove_code_simpl.
+ *       all: ssprove_code_simpl_more.
+ *       + apply r_get_remember_lhs.
+ *         intros ?.
+ *         apply r_get_remember_rhs.
+ *         intros ?.
+ *         ssprove_forget_all.
+ *         apply r_assertD.
+ *         {
+ *           intros ??.
+ *           rewrite !domm_set.
+ *           done.
+ *         }
+ *         intros _ _.
+ *         apply r_ret.
+ *         intros ???.
+ *         split.
+ *         2: assumption.
+ *         unfold f_v.
+ *         apply vote_hiding_bij.
+ *       + ssprove_sync=>e_j.
+ *         apply r_put_vs_put.
+ *         apply r_get_remember_lhs.
+ *         intros ?.
+ *         apply r_get_remember_rhs.
+ *         intros ?.
+ *         ssprove_forget_all.
+ *         apply r_assertD.
+ *         {
+ *           intros ??.
+ *           rewrite !domm_set.
+ *           done.
+ *         }
+ *         intros _ _.
+ *         ssprove_restore_pre.
+ *         1: ssprove_invariant.
+ *         apply r_ret.
+ *         intros ???.
+ *         split.
+ *         2: assumption.
+ *         unfold f_v.
+ *         apply vote_hiding_bij.
+ *   Qed.
+ * 
+ * End OVN.
+ * End OVN.
+*)
diff --git a/theories/Crypt/examples/Schnorr.v b/theories/Crypt/examples/Schnorr.v
index 85c54b56..0d455492 100644
--- a/theories/Crypt/examples/Schnorr.v
+++ b/theories/Crypt/examples/Schnorr.v
@@ -12,7 +12,7 @@ From Mon Require Import SPropBase.
 From Crypt Require Import Axioms ChoiceAsOrd SubDistr Couplings
   UniformDistrLemmas FreeProbProg Theta_dens RulesStateProb UniformStateProb
   pkg_core_definition choice_type pkg_composition pkg_rhl Package Prelude
-  SigmaProtocol.
+  SigmaProtocol Canonicals.
 
 From Coq Require Import Utf8.
 From extructures Require Import ord fset fmap.
@@ -54,13 +54,13 @@ Definition q : nat := #[g].
 
 Module MyParam <: SigmaProtocolParams.
 
-  Definition Witness : finType := [finType of 'Z_q].
-  Definition Statement : finType := FinGroup.arg_finType gT.
-  Definition Message : finType := FinGroup.arg_finType gT.
-  Definition Challenge : finType := [finType of 'Z_q].
-  Definition Response : finType :=  [finType of 'Z_q].
-  Definition Transcript :=
-    prod_finType (prod_finType Message Challenge) Response.
+  Definition Witness : finType := Finite.clone _ 'Z_q.
+  Definition Statement : finType := gT.
+  Definition Message : finType := gT.
+  Definition Challenge : finType := Finite.clone _ 'Z_q.
+  Definition Response : finType :=  Finite.clone _ 'Z_q.
+  Definition Transcript : finType :=
+    prod (prod Message Challenge) Response.
 
   Definition w0 : Witness := 0.
   Definition e0 : Challenge := 0.
@@ -83,7 +83,7 @@ Module MyParam <: SigmaProtocolParams.
   Definition Message_pos : Positive #|Message| := _.
   Definition Challenge_pos : Positive #|Challenge| := _.
   Definition Response_pos : Positive #|Response| := _.
-  Definition Bool_pos : Positive #|bool_choiceType|.
+  Definition Bool_pos : Positive #|(bool:choiceType)|.
   Proof.
     rewrite card_bool. done.
   Defined.
@@ -286,7 +286,7 @@ Proof.
 Qed.
 
 Lemma neq_pos :
-  ∀ (q : nat) (a b : Zp_finZmodType q),
+  ∀ (q : nat) (a b : ('Z_q:finZmodType)),
     a != b →
     a - b != 0.
 Proof.
@@ -371,8 +371,11 @@ Proof.
     (modn
        (addn (@nat_of_ord (S (S (Zp_trunc q))) (@otf Challenge s1))
              (@nat_of_ord (S (S (Zp_trunc q)))
-                          (@GRing.opp (FinRing.Zmodule.zmodType (Zp_finZmodType (S (Zp_trunc q))))
-                                      (@otf Challenge s2)))) q) =
+                (GRing.opp
+                   (* (FinRing.Zmodule.zmodType (Zp_finZmodType (S (Zp_trunc q)))) *)
+                   (* ('Z_(S (Zp_trunc q)) : finZmodType) *)
+                   (@otf Challenge s2))))
+       q) =
     (@nat_of_ord (S (S (Zp_trunc q)))
                    (@Zp_add (S (Zp_trunc q)) (@otf Challenge s1) (@Zp_opp (S (Zp_trunc q)) (@otf Challenge s2)))).
   { simpl.
@@ -393,19 +396,25 @@ Proof.
   have -> :
     (modn
        (muln (@nat_of_ord (S (S (Zp_trunc q)))
-                          (@GRing.inv (FinRing.UnitRing.unitRingType (Zp_finUnitRingType (Zp_trunc q)))
-                                      (@GRing.add (FinRing.Zmodule.zmodType (Zp_finZmodType (S (Zp_trunc q))))
-                                                  (@otf Challenge s1)
-                                                  (@GRing.opp (FinRing.Zmodule.zmodType (Zp_finZmodType (S (Zp_trunc q))))
-                                                              (@otf Challenge s2)))))
-             (@nat_of_ord (S (S (Zp_trunc q)))
-                          (@Zp_add (S (Zp_trunc q)) (@otf Challenge s1) (@Zp_opp (S (Zp_trunc q)) (@otf Challenge s2))))) q) =
+                (GRing.inv
+                   (* (FinRing.UnitRing.unitRingType (Zp_finUnitRingType (Zp_trunc q))) *)
+                   (GRing.add
+                      (* (FinRing.Zmodule.zmodType (Zp_finZmodType (S (Zp_trunc q)))) *)
+                      (@otf Challenge s1)
+                      (GRing.opp
+                         (* (FinRing.Zmodule.zmodType (Zp_finZmodType (S (Zp_trunc q)))) *)
+                         (@otf Challenge s2)))))
+          (@nat_of_ord (S (S (Zp_trunc q)))
+             (@Zp_add (S (Zp_trunc q)) (@otf Challenge s1) (@Zp_opp (S (Zp_trunc q)) (@otf Challenge s2))))) q) =
     (Zp_mul
-       (@GRing.inv (FinRing.UnitRing.unitRingType (Zp_finUnitRingType (Zp_trunc q)))
-                   (@GRing.add (FinRing.Zmodule.zmodType (Zp_finZmodType (S (Zp_trunc q))))
-                               (@otf Challenge s1)
-                               (@GRing.opp (FinRing.Zmodule.zmodType (Zp_finZmodType (S (Zp_trunc q))))
-                                           (@otf Challenge s2))))
+       (GRing.inv
+          (* (FinRing.UnitRing.unitRingType (Zp_finUnitRingType (Zp_trunc q))) *)
+          (GRing.add
+             (* (FinRing.Zmodule.zmodType (Zp_finZmodType (S (Zp_trunc q)))) *)
+             (@otf Challenge s1)
+             (GRing.opp
+                (* (FinRing.Zmodule.zmodType (Zp_finZmodType (S (Zp_trunc q)))) *)
+                (@otf Challenge s2))))
        (@Zp_add (S (Zp_trunc q)) (@otf Challenge s1) (@Zp_opp (S (Zp_trunc q)) (@otf Challenge s2)))).
   { simpl.
     rewrite modnDmr.
@@ -665,7 +674,7 @@ End Schnorr.
 
 Module GP_Z3 <: GroupParam.
 
-  Definition gT : finGroupType := Zp_finGroupType 2.
+  Definition gT : finGroupType := 'Z_2.
   Definition ζ : {set gT} := [set : gT].
   Definition g :  gT := Zp1.
 
diff --git a/theories/Crypt/examples/ShamirSecretSharing.v b/theories/Crypt/examples/ShamirSecretSharing.v
index 7d881cda..5fff74f9 100644
--- a/theories/Crypt/examples/ShamirSecretSharing.v
+++ b/theories/Crypt/examples/ShamirSecretSharing.v
@@ -481,7 +481,7 @@ Proof.
   rewrite /nilp size_poly_eq0 in Heq.
   move /eqP in Heq.
   rewrite Heq polyseqC.
-  by destruct (a != 0).
+  by case: (a != 0).
 Qed.
 
 Lemma size_tail_poly {R: ringType} (q: {poly R}):
@@ -927,7 +927,7 @@ Proof.
   }
   rewrite addn0 IHt ?cons_head_tail_poly //.
   rewrite size_tail_poly.
-  by destruct (size q).
+  destruct (size q) eqn:P; by rewrite P.
 Qed.
 
 (**
diff --git a/theories/Crypt/examples/SigmaProtocol.v b/theories/Crypt/examples/SigmaProtocol.v
index f0a117a6..51429563 100644
--- a/theories/Crypt/examples/SigmaProtocol.v
+++ b/theories/Crypt/examples/SigmaProtocol.v
@@ -10,7 +10,7 @@ Set Warnings "notation-overridden,ambiguous-paths".
 From Crypt Require Import Axioms ChoiceAsOrd SubDistr Couplings
   UniformDistrLemmas FreeProbProg Theta_dens RulesStateProb UniformStateProb
   pkg_core_definition choice_type pkg_composition pkg_rhl
-  Package Prelude RandomOracle.
+  Package Prelude RandomOracle Canonicals.
 
 From Coq Require Import Utf8.
 From extructures Require Import ord fset fmap.
diff --git a/theories/Crypt/examples/concrete_groups.v b/theories/Crypt/examples/concrete_groups.v
index a7c2874e..82b50cb0 100644
--- a/theories/Crypt/examples/concrete_groups.v
+++ b/theories/Crypt/examples/concrete_groups.v
@@ -6,7 +6,7 @@ Set Warnings "-notation-overridden,-ambiguous-paths,-notation-incompatible-forma
 From mathcomp Require Import all_ssreflect fingroup.fingroup fintype
      eqtype choice seq.
 Set Warnings "notation-overridden,ambiguous-paths,notation-incompatible-format".
-
+From HB Require Import structures.
 From deriving Require Import deriving.
 
 Set Bullet Behavior "Strict Subproofs".
@@ -42,29 +42,45 @@ Module Z2_manual.
     ltac:(move => [|] [|];
             try solve [ right ; discriminate ];
             try solve [ left ; reflexivity ]).
+(*
   Definition Z2_eqMixin := EqMixin Z2_eqP.
   Canonical Z2_eqType : eqType :=
     Eval hnf in EqType Z2 Z2_eqMixin.
+*)
+  Definition Z2_hasDecEq := hasDecEq.Build Z2 Z2_eqP.
+  HB.instance Definition _ := Z2_hasDecEq.
 
   Definition Z2_pickle x : nat := match x with z => 0 | o => 1 end.
   Definition Z2_unpickle (x : nat) := match x with 0 => Some z | 1 => Some o | _ => None end.
   Lemma Z2_p_u_cancel : @pcancel nat Z2 Z2_pickle Z2_unpickle.
   Proof. move => [|] //. Qed.
 
+  (*
   Definition Z2_choiceMixin := PcanChoiceMixin Z2_p_u_cancel.
   Canonical Z2_choiceType := ChoiceType Z2 Z2_choiceMixin.
+   *)
+  HB.instance Definition _ := Choice.copy Z2 (pcan_type Z2_p_u_cancel).
 
+  (*
   Definition Z2_countMixin := @choice.Countable.Mixin Z2 Z2_pickle Z2_unpickle Z2_p_u_cancel.
   Canonical Z2_countType := Eval hnf in CountType Z2 Z2_countMixin.
+   *)
+  Definition Z2_hasCountable := isCountable.Build Z2 Z2_p_u_cancel.
+  HB.instance Definition _ := Z2_hasCountable.
 
   Definition Z2_enum : seq Z2 := [:: z; o].
   Lemma Z2_enum_uniq : uniq Z2_enum.
   Proof. reflexivity. Qed.
   Lemma mem_Z2_enum i : i \in Z2_enum.
   Proof. destruct i; reflexivity. Qed.
+
+  (*
   Definition Z2_finMixin :=
     Eval hnf in UniqFinMixin Z2_enum_uniq mem_Z2_enum.
   Canonical Z2_finType := Eval hnf in FinType Z2 Z2_finMixin.
+   *)
+  Definition Z2_isFinite := isFinite.Build Z2 (Finite.uniq_enumP Z2_enum_uniq mem_Z2_enum).
+  HB.instance Definition _ := Z2_isFinite.
 
   Lemma assoc_add : associative add.
   Proof. move => [|] [|] [|] //. Qed.
@@ -75,16 +91,26 @@ Module Z2_manual.
   Lemma Z2_invgM : {morph inv : a b / add a b >-> add b a}.
   Proof. move => [|] [|] //. Qed.
 
+  (*
   Definition Z2_finGroupBaseMixin :=
     FinGroup.BaseMixin assoc_add lid inv_inv Z2_invgM.
 
   Canonical Z2_BaseFinGroupType :=
     BaseFinGroupType Z2 Z2_finGroupBaseMixin.
+   *)
+
+  Definition Z2_isMulBaseGroup := isMulBaseGroup.Build Z2 assoc_add lid inv_inv Z2_invgM.
+  HB.instance Definition _ := Z2_isMulBaseGroup.
 
   Definition linv : left_inverse z inv add.
   Proof. move => [|] //. Qed.
 
+  (*
   Canonical Z2_finGroup : finGroupType := FinGroupType linv.
+   *)
+
+  Definition Z2_BaseFinGroup_isGroup := BaseFinGroup_isGroup.Build Z2 linv.
+  HB.instance Definition _ := Z2_BaseFinGroup_isGroup.
 
 End Z2_manual.
 
@@ -104,17 +130,30 @@ Module Z2_bool.
   Lemma bool_invgM : {morph invb : a b / addb a b >-> addb b a}.
   Proof. move => [|] [|] //. Qed.
 
+  (*
   Definition bool_finGroupBaseMixin :=
     FinGroup.BaseMixin assoc_addb lidb inv_invb bool_invgM.
 
   Canonical bool_BaseFinGroupType :=
     BaseFinGroupType bool bool_finGroupBaseMixin.
+   *)
+
+  Definition bool_isMulBaseGroup := isMulBaseGroup.Build bool assoc_addb lidb inv_invb bool_invgM.
+  HB.instance Definition _ := bool_isMulBaseGroup.
+
   Definition linvb : left_inverse false invb addb.
   Proof. move => [|] //. Qed.
 
+  (*
   Canonical bool_finGroup : finGroupType := FinGroupType linvb.
+   *)
+
+  Definition bool_BaseFinGroup_isGroup := BaseFinGroup_isGroup.Build bool linvb.
+  HB.instance Definition _ := bool_BaseFinGroup_isGroup.
+
 End Z2_bool.
 
+(* TODO
 Section Z3_deriving.
   (* Construction of Z3 using deriving but not the fingroup mixin. *)
   Inductive Z3 := z | o | t.
@@ -159,7 +198,9 @@ Section Z3_deriving.
 
   Canonical Z3_finGroup : finGroupType := FinGroupType linv.
 End Z3_deriving.
+*)
 
+(* TODO Is this still needed? - Update or delete.
 Module Z2.
   (* Minimal (?) construction of Z2 using the fingroup mixin. *)
   Definition invb x : bool := x.
@@ -172,7 +213,9 @@ Module Z2.
   Canonical bool_finGroup := BaseFinGroupType _ (FinGroup.Mixin assoc_xorb lidb linvb).
   Canonical Z2_finGroup : finGroupType := FinGroupType linvb.
 End Z2.
+*)
 
+(* TODO
 Module Z3.
   (* Z3 using the fingroup mixin and deriving. *)
   Inductive Z3 := z | o | t.
@@ -208,3 +251,4 @@ Module Z3.
   Canonical Z3_BaseFinGroupType := BaseFinGroupType _ (FinGroup.Mixin assoc_add lid linv).
   Canonical Z3_finGroup : finGroupType := FinGroupType linv.
 End Z3.
+*)
diff --git a/theories/Crypt/examples/package_usage_example.v b/theories/Crypt/examples/package_usage_example.v
index 152c03ac..5e7928d8 100644
--- a/theories/Crypt/examples/package_usage_example.v
+++ b/theories/Crypt/examples/package_usage_example.v
@@ -59,10 +59,10 @@ Definition p1 : package fset0 [interface] I1 :=
     }
   ].
 
-Definition foo (x : bool) : code fset0 [interface] bool_choiceType :=
+Definition foo (x : bool) : code fset0 [interface] bool :=
   {code let u := x in ret u}.
 
-Definition bar (b : bool) : code fset0 [interface] nat_choiceType :=
+Definition bar (b : bool) : code fset0 [interface] nat :=
   {code if b then ret 0 else ret 1}.
 
 Definition p2 : package fset0 [interface] I2 :=
diff --git a/theories/Crypt/package/pkg_advantage.v b/theories/Crypt/package/pkg_advantage.v
index e17f21fe..6876eb76 100644
--- a/theories/Crypt/package/pkg_advantage.v
+++ b/theories/Crypt/package/pkg_advantage.v
@@ -83,7 +83,7 @@ Definition Pr_op (p : raw_package) (o : opsig) (x : src o) :
 Arguments SDistr_bind {_ _}.
 
 Definition Pr (p : raw_package) :
-  SDistr (bool_choiceType) :=
+  SDistr (bool:choiceType) :=
   SDistr_bind
     (λ '(b, _), SDistr_unit _ b)
     (Pr_op p RUN Datatypes.tt empty_heap).
@@ -152,7 +152,7 @@ Qed. *)
   : package_scope. *)
 
 Definition state_pass_ {A} (p : raw_code A) :
-  heap_choiceType → raw_code (prod_choiceType A heap_choiceType).
+  heap_choiceType → raw_code (prod A heap_choiceType).
 Proof.
   induction p; intros h.
   - constructor.
diff --git a/theories/Crypt/package/pkg_distr.v b/theories/Crypt/package/pkg_distr.v
index ebbd1e59..f486dc16 100644
--- a/theories/Crypt/package/pkg_distr.v
+++ b/theories/Crypt/package/pkg_distr.v
@@ -87,7 +87,7 @@ Qed.
 
 Lemma card_prod_iprod :
   ∀ i j,
-    #|prod_finType (ordinal_finType i) (ordinal_finType j)| = (i * j)%N.
+    #|(prod (ordinal i:finType) (ordinal j:finType)) :finType| = (i * j)%N.
 Proof.
   intros i j.
   rewrite card_prod. simpl. rewrite !card_ord. reflexivity.
@@ -95,7 +95,7 @@ Qed.
 
 Definition ch2prod {i j} `{Positive i} `{Positive j}
   (x : Arit (uniform (i * j))) :
-  prod_choiceType (Arit (uniform i)) (Arit (uniform j)).
+  (Arit (uniform i)) * (Arit (uniform j)).
 Proof.
   simpl in *.
   eapply otf. rewrite card_prod_iprod.
@@ -103,7 +103,7 @@ Proof.
 Defined.
 
 Definition prod2ch {i j} `{Positive i} `{Positive j}
-  (x : prod_choiceType (Arit (uniform i)) (Arit (uniform j))) :
+  (x : (Arit (uniform i)) * (Arit (uniform j))) :
   Arit (uniform (i * j)).
 Proof.
   simpl in *.
@@ -114,7 +114,7 @@ Defined.
 
 Definition ch2prod_prod2ch :
   ∀ {i j} `{Positive i} `{Positive j}
-    (x : prod_choiceType (Arit (uniform i)) (Arit (uniform j))),
+    (x : (Arit (uniform i)) * (Arit (uniform j))),
     ch2prod (prod2ch x) = x.
 Proof.
   intros i j hi hj x.
@@ -148,7 +148,7 @@ Proof.
 Qed.
 
 Lemma ordinal_finType_inhabited :
-  ∀ i `{Positive i}, ordinal_finType i.
+  ∀ i `{Positive i}, (ordinal i :finType).
 Proof.
   intros i hi.
   exists 0%N. auto.
diff --git a/theories/Crypt/package/pkg_invariants.v b/theories/Crypt/package/pkg_invariants.v
index aba4a0ff..05fa0d66 100644
--- a/theories/Crypt/package/pkg_invariants.v
+++ b/theories/Crypt/package/pkg_invariants.v
@@ -11,6 +11,9 @@ Set Warnings "-ambiguous-paths,-notation-overridden,-notation-incompatible-forma
 From mathcomp Require Import ssrnat ssreflect ssrfun ssrbool ssrnum eqtype
   choice reals distr seq all_algebra fintype realsum.
 Set Warnings "ambiguous-paths,notation-overridden,notation-incompatible-format".
+
+From HB Require Import structures.
+
 From extructures Require Import ord fset fmap.
 From Mon Require Import SPropBase.
 From Crypt Require Import Prelude Axioms ChoiceAsOrd SubDistr Couplings
@@ -905,9 +908,12 @@ Proof.
   all: intro h. all: inversion h. all: contradiction.
 Qed.
 
-Canonical heap_val_eqMixin := EqMixin heap_val_eqP.
+(*Canonical heap_val_eqMixin := EqMixin heap_val_eqP.
 Canonical heap_val_eqType :=
-  Eval hnf in EqType heap_val heap_val_eqMixin.
+  Eval hnf in EqType heap_val heap_val_eqMixin. *)
+Definition heap_val_hasDecEq := hasDecEq.Build heap_val heap_val_eqP.
+HB.instance Definition _ := heap_val_hasDecEq.
+
 
 Derive NoConfusion for heap_val.
 
@@ -1598,4 +1604,4 @@ Proof.
     specialize ih with (1 := h).
     specialize ih with (1 := hh).
     rewrite e in ih. apply ih.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/theories/Crypt/package/pkg_rhl.v b/theories/Crypt/package/pkg_rhl.v
index 38dc5949..28743d43 100644
--- a/theories/Crypt/package/pkg_rhl.v
+++ b/theories/Crypt/package/pkg_rhl.v
@@ -18,7 +18,7 @@ From Crypt Require Import Prelude Axioms ChoiceAsOrd SubDistr Couplings
   RulesStateProb UniformStateProb UniformDistrLemmas StateTransfThetaDens
   StateTransformingLaxMorph choice_type pkg_core_definition pkg_notation
   pkg_tactics pkg_composition pkg_heap pkg_semantics pkg_lookup pkg_advantage
-  pkg_invariants pkg_distr.
+  pkg_invariants pkg_distr Canonicals.
 Require Import Equations.Prop.DepElim.
 From Equations Require Import Equations.
 
@@ -166,7 +166,9 @@ Proof.
   match goal with
   | |- realsum.summable ?f => eassert (f = _) as Hf end.
   { extensionality x.
-    apply (destruct_pair_eq (a:= f1 x) (b:=f3 x) (c:= f2 x) (d := f4 x)). }
+    instantiate (1 := fun x1 => (f1 x1 == f3 x1)%:R * (f2 x1 == f4 x1)%:R).
+    simpl.
+    exact: (destruct_pair_eq (a:= f1 x) (b:=f3 x) (c:= f2 x) (d := f4 x)). }
   rewrite Hf.
   apply realsum.summableM. all: assumption.
 Qed.
@@ -2133,7 +2135,8 @@ Section Uniform_prod.
       destruct (ch2prod u == (a,b)) eqn:e.
       2:{
         exfalso.
-        move: hu => /negP hu. apply hu. apply eqxx.
+        move: hu => /negP hu. apply hu.
+        by [rewrite e].
       }
       move: e => /eqP e. rewrite -e.
       rewrite inE. apply /eqP. symmetry. apply prod2ch_ch2prod.
diff --git a/theories/Crypt/rules/UniformStateProb.v b/theories/Crypt/rules/UniformStateProb.v
index b221c41d..3aafad90 100644
--- a/theories/Crypt/rules/UniformStateProb.v
+++ b/theories/Crypt/rules/UniformStateProb.v
@@ -117,7 +117,8 @@ Proof.
     rewrite Heq'. rewrite GRing.mulr1. reflexivity.
   - have Heq' : st == s = false. apply /eqP. move /eqP: Heq. congruence.
     rewrite Heq'. rewrite GRing.mulr0. reflexivity.
-  Unshelve. exact (Real.ringType R).
+    Unshelve.
+    exact: R.
 Qed.
 
 Definition f_dprod { F1 F2: finType } { S1 S2 : choiceType } { w0 : F1 } { w0' : F2 } {s1 : S1 } {s2 : S2}
@@ -232,17 +233,18 @@ Proof.
               destruct #|F1| eqn:e. 1: contradiction.
               rewrite ltr0n. reflexivity.
     + unfold r. rewrite -[X in X <= _]mulrzr. rewrite GRing.div1r.
-      erewrite <- GRing.mulr1. rewrite -GRing.mulrA.
+      rewrite -[X in X <= _]GRing.mulr1 -GRing.mulrA.
       rewrite GRing.Theory.mulKf.
       * auto.
       * unshelve eapply card_non_zero. auto.
 Qed.
 
+
 Definition UniformFsq_f { F1 F2 : finType} { w0 : F1 } { w0' : F2 }
                         { S1 S2 : choiceType } { s1 : S1 } { s2 : S2 }
                         {f : F1 -> F2} (f_bij : bijective f):
-  SDistr (ChoiceAsOrd.F_choice_prod ⟨ ChoiceAsOrd.F_choice_prod ⟨ Finite.choiceType F1 , S1 ⟩ ,
-                                    ChoiceAsOrd.F_choice_prod ⟨ Finite.choiceType F2 , S2 ⟩ ⟩ ).
+  SDistr (ChoiceAsOrd.F_choice_prod ⟨ ChoiceAsOrd.F_choice_prod ⟨ (F1:choiceType) , S1 ⟩ ,
+                                    ChoiceAsOrd.F_choice_prod ⟨ (F2:choiceType) , S2 ⟩ ⟩ ).
 Proof.
   unshelve eapply mkdistr.
   1:{

From 703679bb5d59730d77de551010b8ce3c677f26e2 Mon Sep 17 00:00:00 2001
From: Sebastian Ertel <sebastian.ertel@barkhauseninstitut.org>
Date: Tue, 5 Mar 2024 10:34:08 +0100
Subject: [PATCH 05/13] cleanup. fxing mathcomp warnings.

---
 _CoqProject                                   |   2 +-
 theories/Crypt/{Canonicals.v => Casts.v}      |   8 +-
 theories/Crypt/choice_type.v                  | 108 +-----------------
 theories/Crypt/examples/ElGamal.v             |   2 +-
 theories/Crypt/examples/KEMDEM.v              |   6 +-
 theories/Crypt/examples/OTP.v                 |   4 +-
 theories/Crypt/examples/OVN.v                 |   2 +-
 theories/Crypt/examples/PRFPRG.v              |   2 +-
 theories/Crypt/examples/Schnorr.v             |   2 +-
 theories/Crypt/examples/SigmaProtocol.v       |   4 +-
 theories/Crypt/package/pkg_advantage.v        |   6 +-
 theories/Crypt/package/pkg_core_definition.v  |   2 +-
 theories/Crypt/package/pkg_heap.v             |   6 +-
 theories/Crypt/package/pkg_rhl.v              |   4 +-
 theories/Crypt/rhl_semantics/ChoiceAsOrd.v    |   2 +-
 .../rhl_semantics/only_prob/Theta_exCP.v      |   2 +-
 .../state_prob/StateTransformingLaxMorph.v    |   2 +-
 theories/Crypt/rules/RulesProb.v              |   4 +-
 theories/Crypt/rules/RulesStateProb.v         |   6 +-
 theories/Crypt/rules/UniformDistrLemmas.v     |   4 +-
 theories/Crypt/rules/UniformStateProb.v       |   4 +-
 21 files changed, 39 insertions(+), 143 deletions(-)
 rename theories/Crypt/{Canonicals.v => Casts.v} (86%)

diff --git a/_CoqProject b/_CoqProject
index d056bfab..0eaefba1 100644
--- a/_CoqProject
+++ b/_CoqProject
@@ -22,7 +22,7 @@ theories/Relational/Commutativity.v
 
 theories/Crypt/Prelude.v
 theories/Crypt/Axioms.v
-theories/Crypt/Canonicals.v
+theories/Crypt/Casts.v
 theories/Crypt/choice_type.v
 
 # Categorical semantics
diff --git a/theories/Crypt/Canonicals.v b/theories/Crypt/Casts.v
similarity index 86%
rename from theories/Crypt/Canonicals.v
rename to theories/Crypt/Casts.v
index 2ea0463f..4efd278c 100644
--- a/theories/Crypt/Canonicals.v
+++ b/theories/Crypt/Casts.v
@@ -8,9 +8,11 @@ From Crypt Require Import Prelude.
 From HB Require Import structures.
 
 
-(*
-  Note for any of these types it would also be okay to write the cast, e.g., [(nat:choiceType)%type]
- , directly in the term.
+(**
+  Note for any of these types it would also be okay to write the cast, e.g., [(nat:choiceType)%type],
+  directly in the term.
+  This (backward-compatibility) file just made porting to mathcomp 2.1.0 easier.
+  Just delete as soon as all references to the below casts are gone from the code base.
  *)
 
 Definition unit_choiceType : choiceType := Datatypes.unit.
diff --git a/theories/Crypt/choice_type.v b/theories/Crypt/choice_type.v
index 9b14c6de..20f1efed 100644
--- a/theories/Crypt/choice_type.v
+++ b/theories/Crypt/choice_type.v
@@ -16,7 +16,7 @@ From mathcomp Require Import ssrnat ssreflect ssrfun ssrbool ssrnum eqtype
 Set Warnings "ambiguous-paths,notation-overridden,notation-incompatible-format".
 From HB Require Import structures.
 
-From Crypt Require Import Prelude Axioms Canonicals.
+From Crypt Require Import Prelude Axioms Casts.
 From deriving Require Import deriving.
 From extructures Require Import ord fset fmap.
 From Mon Require Import SPropBase.
@@ -48,31 +48,6 @@ Inductive choice_type :=
 
 Derive NoConfusion NoConfusionHom for choice_type.
 
-(* Definition void_leq (x y : void) := true. *)
-
-(* Lemma void_leqP : Ord.axioms void_leq. *)
-(* Proof. split; by do ![case]. Qed. *)
-
-(* Definition void_ordMixin := OrdMixin void_leqP. *)
-(* Canonical void_ordType := Eval hnf in OrdType void void_ordMixin. *)
-
-
-(* From extructures/tests/tutorial.v *)
-(*
-Definition choice_type_indDef := [indDef for choice_type_rect].
-Canonical choice_type_indType := IndType choice_type choice_type_indDef.
-Definition choice_type_hasDecEq := [derive hasDecEq for choice_type].
-HB.instance Definition _ := choice_type_hasDecEq.
-Fail Definition choice_type_hasChoice := [derive hasChoice for choice_type].
-(*
-#[hnf] HB.instance Definition _ := choice_type_hasChoice.
-Definition choice_type_hasOrd := [derive hasOrd for choice_type].
-#[hnf] HB.instance Definition _ := formula_hasOrd.
- *)
-
-HB.about ordType.
-HB.about choiceType.
- *)
 
 Fixpoint chElement_ordType (U : choice_type) : ordType :=
   match U with
@@ -185,20 +160,9 @@ Section choice_typeTypes.
     The unfolding there was too much.
     The [nored] version then did not provide enough reduction.
    *)
-  HB.about hasDecEq.Build.
   Definition choice_type_hasDecEq := hasDecEq.Build choice_type choice_type_eqP.
   HB.instance Definition _ := choice_type_hasDecEq.
 
- (* Definition choice_type_eqP := @eqP choice_type. *)
-
-  HB.about choice_type.
-  (* Print choice_type_choice_type__canonical__eqtype_Equality. *)
-  (*
-  Canonical choice_type_eqMixin := EqMixin choice_type_eqP.
-  Canonical choice_type_eqType :=
-    Eval hnf in EqType choice_type choice_type_eqMixin.
-   *)
-
   Fixpoint choice_type_lt (t1 t2 : choice_type) :=
   match t1, t2 with
   | chUnit, chUnit => false
@@ -525,54 +489,6 @@ Section choice_typeTypes.
     + by [move => i; apply/orP; left; apply/orP; left].
   Qed.
 
-  (*
-  Lemma choice_type_leqP : hasOrd.Build choice_type .
-  Proof.
-    split => //.
-    - intro x. unfold choice_type_leq.
-      apply/orP. left. apply /eqP. reflexivity.
-    - intros v u w h1 h2.
-      move: h1 h2. unfold choice_type_leq.
-      move /orP => h1. move /orP => h2.
-      destruct h1.
-      + move: H. move /eqP => H. destruct H.
-        apply/orP. assumption.
-      + destruct h2.
-        * move: H0. move /eqP => H0. destruct H0.
-          apply/orP. right. assumption.
-        * apply/orP. right. exact (choice_type_lt_transitive _ _ _ H H0).
-    - unfold antisymmetric.
-      move => x y. unfold choice_type_leq. move/andP => [h1 h2].
-      move: h1 h2. unfold choice_type_leq.
-      move /orP => h1. move /orP => h2.
-      destruct h1.
-      1:{ move: H. move /eqP. intuition auto. }
-      destruct h2.
-      1:{ move: H0. move /eqP. intuition auto. }
-      destruct (~~ (choice_type_test x y)) eqn:Heq.
-      + move: Heq. move /idP => Heq.
-        pose (choice_type_lt_total_not_holds x y) as Hp.
-        move: Hp. move /implyP => Hp. specialize (Hp Heq).
-        move: Hp. move /nandP => Hp.
-        destruct Hp.
-        * move: H. move /eqP /eqP => H. rewrite H in H1. simpl in H1.
-          discriminate.
-        * move: H0. move /eqP /eqP => H0. rewrite H0 in H1. simpl in H1.
-          discriminate.
-      + move: Heq. move /eqP. auto.
-    - unfold total.
-      intros x y. unfold choice_type_leq.
-      pose (choice_type_lt_tot x y).
-      move: i. move /orP => H.
-      destruct H.
-      + move: H. move /orP => H.
-        destruct H.
-        * apply/orP. left. apply/orP. right. assumption.
-        * apply/orP. right. apply/orP. right. assumption.
-      + apply/orP. left. apply/orP. left. assumption.
-  Qed.
-*)
-
   Fixpoint encode (t : choice_type) : GenTree.tree nat :=
   match t with
   | chUnit => GenTree.Leaf 1
@@ -624,18 +540,8 @@ Section choice_typeTypes.
         rewrite -subnE subn0. repeat f_equal. apply eq_irrelevance.
   Defined.
 
-  HB.about choiceType.
-  HB.about Choice.
-  HB.about hasChoice.Build.
-
-  HB.about choice_type.
-
   HB.instance Definition _ := Choice.copy choice_type (pcan_type codeK).
 
-  HB.about choice_type. (* Choice is there now *)
-
-  HB.about ordType.
-  HB.about hasOrd.Build.
   HB.instance Definition _ :=
     hasOrd.Build
       choice_type
@@ -644,16 +550,4 @@ Section choice_typeTypes.
       choice_type_leq_asym
       choice_type_leq_total.
 
-  HB.about choice_type. (* Ord is there now *)
-
-(*
-  Definition choice_type_choiceMixin := PcanChoiceMixin codeK.
-  Canonical choice_type_choiceType :=
-    ChoiceType choice_type choice_type_choiceMixin.
-
-  Definition choice_type_ordMixin := OrdMixin choice_type_leqP.
-  Canonical choice_type_ordType :=
-    Eval hnf in OrdType choice_type choice_type_ordMixin.
-   *)
-
 End choice_typeTypes.
diff --git a/theories/Crypt/examples/ElGamal.v b/theories/Crypt/examples/ElGamal.v
index 697390be..40a9829b 100644
--- a/theories/Crypt/examples/ElGamal.v
+++ b/theories/Crypt/examples/ElGamal.v
@@ -83,7 +83,7 @@ Module MyParam <: AsymmetricSchemeParams.
   Definition Plain  : finType := gT.
   Definition Cipher : finType := prod (gT:finType) (gT:finType).
   Definition PubKey : finType := gT.
-  Definition SecKey : finType := [finType of 'Z_q].
+  Definition SecKey : finType := Finite.clone _ 'Z_q.
 
   Definition plain0 := g.
   Definition cipher0 := (g, g).
diff --git a/theories/Crypt/examples/KEMDEM.v b/theories/Crypt/examples/KEMDEM.v
index 142a1e72..9df1e822 100644
--- a/theories/Crypt/examples/KEMDEM.v
+++ b/theories/Crypt/examples/KEMDEM.v
@@ -604,7 +604,7 @@ Section KEMDEM.
     as ineq.
     eapply le_trans. 1: exact ineq.
     clear ineq.
-    eapply ler_add.
+    eapply lerD.
     (* Idealising the core keying package *)
     - replace (par CK₀ CD₀) with ((par (ID EK) CD₀) ∘ (par CK₀ (ID IGET))).
       2:{
@@ -696,7 +696,7 @@ Section KEMDEM.
     as ineq.
     eapply le_trans. 1: exact ineq.
     clear ineq.
-    eapply ler_add.
+    eapply lerD.
     - eapply single_key_a. all: eauto.
     (* De-idealising the core keying package *)
     - replace (par CK₀ CD₁) with ((par (ID EK) CD₁) ∘ (par CK₀ (ID IGET))).
@@ -1065,4 +1065,4 @@ Section KEMDEM.
       all: fdisjoint_auto.
   Qed.
 
-End KEMDEM.
\ No newline at end of file
+End KEMDEM.
diff --git a/theories/Crypt/examples/OTP.v b/theories/Crypt/examples/OTP.v
index 78e3315e..8cf2f8c5 100644
--- a/theories/Crypt/examples/OTP.v
+++ b/theories/Crypt/examples/OTP.v
@@ -63,9 +63,9 @@ Section OTP_example.
 
   Definition N_pos : Positive N := _.
 
-  Definition Words : finType := [finType of 'Z_N].
+  Definition Words : finType := Finite.clone _ 'Z_N.
 
-  Definition Key : finType := [finType of 'Z_N].
+  Definition Key : finType := Finite.clone _ 'Z_N.
 
   Definition w0 : Words := 0.
 
diff --git a/theories/Crypt/examples/OVN.v b/theories/Crypt/examples/OVN.v
index c6bff7bf..3656c75d 100644
--- a/theories/Crypt/examples/OVN.v
+++ b/theories/Crypt/examples/OVN.v
@@ -9,7 +9,7 @@
  * 
  * From Crypt Require Import Axioms ChoiceAsOrd SubDistr Couplings
  *   UniformDistrLemmas FreeProbProg Theta_dens RulesStateProb UniformStateProb
- *   pkg_composition Package Prelude SigmaProtocol Schnorr DDH Canonicals.
+ *   pkg_composition Package Prelude SigmaProtocol Schnorr DDH Casts.
  * 
  * From Coq Require Import Utf8 Lia.
  * From extructures Require Import ord fset fmap.
diff --git a/theories/Crypt/examples/PRFPRG.v b/theories/Crypt/examples/PRFPRG.v
index 750d48d0..9fe35fcb 100644
--- a/theories/Crypt/examples/PRFPRG.v
+++ b/theories/Crypt/examples/PRFPRG.v
@@ -394,7 +394,7 @@ Proof.
   move: {ineq H1 H2 H3} (H1, H2, H3) => H.
   rewrite GEN_GEN_HYB_equiv ?fdisjointUr ?H // GRing.addr0.
   rewrite GEN_GEN_HYB_EVAL_equiv ?fdisjointUr ?H // GRing.addr0.
-  rewrite big_ord_recr ler_add //.
+  rewrite big_ord_recr lerD //.
   by rewrite /prf_epsilon Advantage_E Advantage_link Advantage_sym.
 Qed.
 
diff --git a/theories/Crypt/examples/Schnorr.v b/theories/Crypt/examples/Schnorr.v
index 0d455492..c2850b3d 100644
--- a/theories/Crypt/examples/Schnorr.v
+++ b/theories/Crypt/examples/Schnorr.v
@@ -12,7 +12,7 @@ From Mon Require Import SPropBase.
 From Crypt Require Import Axioms ChoiceAsOrd SubDistr Couplings
   UniformDistrLemmas FreeProbProg Theta_dens RulesStateProb UniformStateProb
   pkg_core_definition choice_type pkg_composition pkg_rhl Package Prelude
-  SigmaProtocol Canonicals.
+  SigmaProtocol Casts.
 
 From Coq Require Import Utf8.
 From extructures Require Import ord fset fmap.
diff --git a/theories/Crypt/examples/SigmaProtocol.v b/theories/Crypt/examples/SigmaProtocol.v
index 51429563..bb5ae4b1 100644
--- a/theories/Crypt/examples/SigmaProtocol.v
+++ b/theories/Crypt/examples/SigmaProtocol.v
@@ -10,7 +10,7 @@ Set Warnings "notation-overridden,ambiguous-paths".
 From Crypt Require Import Axioms ChoiceAsOrd SubDistr Couplings
   UniformDistrLemmas FreeProbProg Theta_dens RulesStateProb UniformStateProb
   pkg_core_definition choice_type pkg_composition pkg_rhl
-  Package Prelude RandomOracle Canonicals.
+  Package Prelude RandomOracle Casts.
 
 From Coq Require Import Utf8.
 From extructures Require Import ord fset fmap.
@@ -520,7 +520,7 @@ Module SigmaProtocol (π : SigmaProtocolParams)
       as ineq.
       eapply le_trans. 1: exact ineq.
       clear ineq.
-      repeat eapply ler_add.
+      repeat eapply lerD.
       - apply eq_ler.
         eapply eq_rel_perf_ind with (inv := inv).
         5: apply VA.
diff --git a/theories/Crypt/package/pkg_advantage.v b/theories/Crypt/package/pkg_advantage.v
index 6876eb76..42d42347 100644
--- a/theories/Crypt/package/pkg_advantage.v
+++ b/theories/Crypt/package/pkg_advantage.v
@@ -369,7 +369,7 @@ Lemma Advantage_triangle :
 Proof.
   intros P Q R A.
   unfold AdvantageE.
-  apply ler_dist_add.
+  apply ler_distD.
 Qed.
 
 Fixpoint advantage_sum P l Q A :=
@@ -387,7 +387,7 @@ Proof.
   - simpl. auto.
   - simpl. eapply order.Order.POrderTheory.le_trans.
     + eapply Advantage_triangle.
-    + eapply ler_add.
+    + eapply lerD.
       * auto.
       * eapply ih.
 Qed.
@@ -429,7 +429,7 @@ Proof.
   intros Game_export F G H ε₁ ε₂ ε₃ h1 h2 h3 LA A vA hF hG hH.
   unfold adv_equiv in *.
   erewrite <- h1, <- h2, <- h3 by eassumption.
-  apply ler_dist_add.
+  apply ler_distD.
 Qed.
 
 Lemma Reduction :
diff --git a/theories/Crypt/package/pkg_core_definition.v b/theories/Crypt/package/pkg_core_definition.v
index c8cee6c0..b5b1e94f 100644
--- a/theories/Crypt/package/pkg_core_definition.v
+++ b/theories/Crypt/package/pkg_core_definition.v
@@ -15,7 +15,7 @@ Set Warnings "ambiguous-paths,notation-overridden,notation-incompatible-format".
 From extructures Require Import ord fset fmap.
 From Mon Require Import SPropBase.
 From Crypt Require Import Prelude Axioms ChoiceAsOrd RulesStateProb StateTransformingLaxMorph
-     choice_type Canonicals.
+     choice_type Casts.
 
 Require Import Equations.Prop.DepElim.
 From Equations Require Import Equations.
diff --git a/theories/Crypt/package/pkg_heap.v b/theories/Crypt/package/pkg_heap.v
index ed71ab8e..cc2c63c3 100644
--- a/theories/Crypt/package/pkg_heap.v
+++ b/theories/Crypt/package/pkg_heap.v
@@ -37,7 +37,7 @@ Set Primitive Projections.
 Definition pointed_value := ∑ (t : choice_type), t.
 
 Definition raw_heap := {fmap Location -> pointed_value}.
-Definition raw_heap_choiceType := [choiceType of raw_heap].
+Definition raw_heap_choiceType := Choice.clone _ raw_heap.
 
 Definition check_loc_val (l : Location) (v : pointed_value) :=
   l.π1 == v.π1.
@@ -67,7 +67,7 @@ Defined.
 
 Definition heap := { h : raw_heap | valid_heap h }.
 
-Definition heap_choiceType := [choiceType of heap].
+Definition heap_choiceType := Choice.clone _ heap.
 
 Lemma heap_ext :
   ∀ (h₀ h₁ : heap),
@@ -264,4 +264,4 @@ Proof.
   intros s ℓ v ℓ' v' ne.
   apply heap_ext. destruct s as [h vh]. simpl.
   apply setmC. auto.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/theories/Crypt/package/pkg_rhl.v b/theories/Crypt/package/pkg_rhl.v
index 28743d43..b3393a5a 100644
--- a/theories/Crypt/package/pkg_rhl.v
+++ b/theories/Crypt/package/pkg_rhl.v
@@ -18,7 +18,7 @@ From Crypt Require Import Prelude Axioms ChoiceAsOrd SubDistr Couplings
   RulesStateProb UniformStateProb UniformDistrLemmas StateTransfThetaDens
   StateTransformingLaxMorph choice_type pkg_core_definition pkg_notation
   pkg_tactics pkg_composition pkg_heap pkg_semantics pkg_lookup pkg_advantage
-  pkg_invariants pkg_distr Canonicals.
+  pkg_invariants pkg_distr Casts.
 Require Import Equations.Prop.DepElim.
 From Equations Require Import Equations.
 
@@ -2187,7 +2187,7 @@ Section Uniform_prod.
     eapply rewrite_eqDistrR. 1: apply: reflexivity_rule.
     intro s. cbn.
     pose proof @prod_uniform as h.
-    specialize (h [finType of 'I_i] [finType of 'I_j]). simpl in h.
+    specialize (h (Finite.clone _ 'I_i) (Finite.clone _ 'I_j)). simpl in h.
     unfold Uni_W'. unfold Uni_W.
     specialize (h (F_w0 (mkpos _)) (F_w0 (mkpos _))).
     unfold uniform_F in h.
diff --git a/theories/Crypt/rhl_semantics/ChoiceAsOrd.v b/theories/Crypt/rhl_semantics/ChoiceAsOrd.v
index 2a81dd17..1e59e3cb 100644
--- a/theories/Crypt/rhl_semantics/ChoiceAsOrd.v
+++ b/theories/Crypt/rhl_semantics/ChoiceAsOrd.v
@@ -1,6 +1,6 @@
 From Mon Require Import SPropBase.
 From Relational Require Import OrderEnrichedCategory OrderEnrichedRelativeMonadExamples.
-From Crypt Require Import Canonicals.
+From Crypt Require Import Casts.
 Set Warnings "-notation-overridden".
 From mathcomp Require Import all_ssreflect.
 Set Warnings "notation-overridden".
diff --git a/theories/Crypt/rhl_semantics/only_prob/Theta_exCP.v b/theories/Crypt/rhl_semantics/only_prob/Theta_exCP.v
index d5476aac..a9275d9d 100644
--- a/theories/Crypt/rhl_semantics/only_prob/Theta_exCP.v
+++ b/theories/Crypt/rhl_semantics/only_prob/Theta_exCP.v
@@ -3,7 +3,7 @@ From mathcomp Require Import all_ssreflect all_algebra boolp distr reals realsum
 Set Warnings "notation-overridden,ambiguous-paths".
 From Mon Require Import SpecificationMonads SPropBase SPropMonadicStructures.
 From Relational Require Import OrderEnrichedCategory OrderEnrichedRelativeMonadExamples.
-From Crypt Require Import ChoiceAsOrd SubDistr Couplings Axioms Canonicals.
+From Crypt Require Import ChoiceAsOrd SubDistr Couplings Axioms Casts.
 From HB Require Import structures.
 
 Import SPropNotations.
diff --git a/theories/Crypt/rhl_semantics/state_prob/StateTransformingLaxMorph.v b/theories/Crypt/rhl_semantics/state_prob/StateTransformingLaxMorph.v
index d620a95b..6db7e7aa 100644
--- a/theories/Crypt/rhl_semantics/state_prob/StateTransformingLaxMorph.v
+++ b/theories/Crypt/rhl_semantics/state_prob/StateTransformingLaxMorph.v
@@ -5,7 +5,7 @@ From Mon Require Import SPropBase.
 Set Warnings "-notation-overridden,-ambiguous-paths".
 From mathcomp Require Import all_ssreflect (*boolp*).
 Set Warnings "notation-overridden,ambiguous-paths".
-From Crypt Require Import Axioms OrderEnrichedRelativeAdjunctions LaxFunctorsAndTransf LaxMorphismOfRelAdjunctions TransformingLaxMorph OrderEnrichedRelativeAdjunctionsExamples ThetaDex SubDistr Theta_exCP ChoiceAsOrd FreeProbProg UniversalFreeMap RelativeMonadMorph_prod LaxComp choice_type Canonicals.
+From Crypt Require Import Axioms OrderEnrichedRelativeAdjunctions LaxFunctorsAndTransf LaxMorphismOfRelAdjunctions TransformingLaxMorph OrderEnrichedRelativeAdjunctionsExamples ThetaDex SubDistr Theta_exCP ChoiceAsOrd FreeProbProg UniversalFreeMap RelativeMonadMorph_prod LaxComp choice_type Casts.
 (* From Crypt Require Import only_prob.Rules. *)
 
 Import SPropNotations.
diff --git a/theories/Crypt/rules/RulesProb.v b/theories/Crypt/rules/RulesProb.v
index e4177329..c65e13ae 100644
--- a/theories/Crypt/rules/RulesProb.v
+++ b/theories/Crypt/rules/RulesProb.v
@@ -32,7 +32,7 @@ From Crypt Require Import
      LaxComp
      FreeProbProg
      RelativeMonadMorph_prod
-     Canonicals.
+     Casts.
 
 Import SPropNotations.
 Import Num.Theory.
@@ -748,7 +748,7 @@ Proof.
            by move/orP: Hd0. }
        --- move/eqP : Hdor1 => Hdor1.
            by rewrite -Hdor1 !GRing.mulr0.
-       --- apply: ler_pmul.
+       --- apply: ler_pM.
            + case: (A x1); rewrite //=; exact ler01.
            + by inversion d.
            + move:  (H2 x1 x2 Hdor2) => HAB.
diff --git a/theories/Crypt/rules/RulesStateProb.v b/theories/Crypt/rules/RulesStateProb.v
index 0443c8ad..d14e9b25 100644
--- a/theories/Crypt/rules/RulesStateProb.v
+++ b/theories/Crypt/rules/RulesStateProb.v
@@ -13,7 +13,7 @@ Set Warnings "notation-overridden,ambiguous-paths".
 
 From Crypt Require Import Axioms ChoiceAsOrd SubDistr Couplings Theta_dens
   Theta_exCP LaxComp FreeProbProg RelativeMonadMorph_prod
-  StateTransformingLaxMorph choice_type Canonicals.
+  StateTransformingLaxMorph choice_type Casts.
 
 Import SPropNotations.
 Import Num.Theory.
@@ -1596,8 +1596,8 @@ Proof.
   apply mulr_ge0.
   destruct q as [qmap q_0 q_sum q_1]. apply q_0.
   easy.
-(* ler_pimulr: forall [R : numDomainType] [x y : R], 0 <= y -> x <= 1 -> y * x <= y *)
-  apply ler_pimulr. destruct q as [qmap q_0 q_sum q_1]. apply q_0.
+(* ler_piMr: forall [R : numDomainType] [x y : R], 0 <= y -> x <= 1 -> y * x <= y *)
+  apply ler_piMr. destruct q as [qmap q_0 q_sum q_1]. apply q_0.
   apply le1_mu1. easy. destruct q as [qmap q_0 q_sum q_1]. apply q_1.
 Qed.
 
diff --git a/theories/Crypt/rules/UniformDistrLemmas.v b/theories/Crypt/rules/UniformDistrLemmas.v
index c9b3bdcf..95bdd3b9 100644
--- a/theories/Crypt/rules/UniformDistrLemmas.v
+++ b/theories/Crypt/rules/UniformDistrLemmas.v
@@ -32,7 +32,7 @@ From Crypt Require Import
      Theta_exCP
      LaxComp
      FreeProbProg
-     Canonicals.
+     Casts.
 
 Import SPropNotations.
 Import Num.Theory.
@@ -104,7 +104,7 @@ Proof.
   (* Basically a rip-off of xfinmap.big_fset_subset *)
   intros T J hu π hπ.
   rewrite [X in _<=X](bigID [pred j : T | j \in J]) /=.
-  rewrite ler_paddr ?sumr_ge0 // -[X in _<=X]big_filter.
+  rewrite ler_wpDr ?sumr_ge0 // -[X in _<=X]big_filter.
   rewrite Order.POrderTheory.le_eqVlt; apply/orP; left; apply/eqP/perm_big.
   apply/uniq_perm; rewrite ?filter_uniq //; last move=> i.
   rewrite -enum_setT. apply enum_uniq.
diff --git a/theories/Crypt/rules/UniformStateProb.v b/theories/Crypt/rules/UniformStateProb.v
index 3aafad90..d4f8c044 100644
--- a/theories/Crypt/rules/UniformStateProb.v
+++ b/theories/Crypt/rules/UniformStateProb.v
@@ -22,7 +22,7 @@ Local Open Scope ring_scope.
 
 Definition Index : Type := positive.
 
-Definition fin_family (i : Index) : finType := [finType of chFin i].
+Definition fin_family (i : Index) : finType := Finite.clone _ (chFin i).
 
 Lemma F_w0 :
   forall (i : Index), fin_family i.
@@ -219,7 +219,7 @@ Proof.
     rewrite item_addr0_mulr.
     eapply Order.POrderTheory.le_trans with (y := @r _ w0 *~ #|F1|).
     + rewrite -mulrzr. rewrite -[X in _<=X]mulrzr.
-      rewrite ler_pmul2l.
+      rewrite ler_pM2l.
       * rewrite ler_int. auto.
       * unfold r. apply mulr_gt0.
         -- cbn. rewrite ltr01. reflexivity.

From 849f426192aaa9809f86209d539afae04ce47429 Mon Sep 17 00:00:00 2001
From: Sebastian Ertel <sebastian.ertel@barkhauseninstitut.org>
Date: Tue, 5 Mar 2024 13:50:08 +0100
Subject: [PATCH 06/13] opam update

---
 ssprove.opam | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/ssprove.opam b/ssprove.opam
index 2a8828f4..89a745ef 100644
--- a/ssprove.opam
+++ b/ssprove.opam
@@ -8,12 +8,12 @@ homepage: "https://github.com/SSProve/ssprove"
 bug-reports: "https://github.com/SSProve/ssprove/issues"
 license: "MIT"
 depends: [
-  "coq" {(>= "8.16" & < "8.18~")}
-  "coq-equations" {>= "1.3"}
-  "coq-mathcomp-ssreflect" {(>= "1.15.0" & < "1.17~")}
-  "coq-mathcomp-analysis" {>= "0.5.3" & <= "0.6.1"}
-  "coq-extructures" {(>= "0.3.1" & < "dev")}
-  "coq-deriving" {(>= "0.1" & < "dev")}
+  "coq" {(>= "8.18~")}
+  "coq-equations" {(>= "1.3+8.18")}
+  "coq-mathcomp-ssreflect" {(>= "2.1.0")}
+  "coq-mathcomp-analysis" {>= "1.0.0"}
+  "coq-extructures" {(>= "0.4.0" & < "dev")}
+  "coq-deriving" {(>= "0.2.0" & < "dev")}
 ]
 build: [
   [make "-j%{jobs}%"]

From 000e20891a983343d64011e5ad0360079038e02b Mon Sep 17 00:00:00 2001
From: Sebastian Ertel <sebastian.ertel@barkhauseninstitut.org>
Date: Tue, 5 Mar 2024 15:30:32 +0100
Subject: [PATCH 07/13] updating the github actions

---
 .github/workflows/build.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index 3067ba33..f983f81f 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -45,6 +45,6 @@ jobs:
       - name: Build
         run: |
           opam repo add coq-released https://coq.inria.fr/opam/released
-          opam install coq.8.16.0 coq-equations.1.3+8.16 coq-mathcomp-ssreflect.1.15.0 coq-mathcomp-analysis.0.5.3 coq-extructures.0.3.1 coq-deriving.0.1.0
+          opam install coq.8.18.0 coq-equations.1.3+8.16 coq-mathcomp-ssreflect.2.1.0 coq-mathcomp-analysis.1.0.0 coq-extructures.0.4.0 coq-deriving.0.2.0
           opam exec -- make -j4
 

From 3e5af309df841bb256a857dc6baa05972d69cc7c Mon Sep 17 00:00:00 2001
From: Sebastian Ertel <sebastian.ertel@barkhauseninstitut.org>
Date: Tue, 5 Mar 2024 15:52:36 +0100
Subject: [PATCH 08/13] upgrading also the OCaml version for the github action.

---
 .github/workflows/build.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index f983f81f..75711701 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -35,7 +35,7 @@ jobs:
       - name: Install OCaml
         uses: avsm/setup-ocaml@v1
         with:
-          ocaml-version: 4.09.1
+          ocaml-version: 4.14.1
 
       # Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it
       - name: Checkout repo

From 214bf4c887a63db65c7b20134d565ae889f596cf Mon Sep 17 00:00:00 2001
From: Sebastian Ertel <sebastian.ertel@barkhauseninstitut.org>
Date: Tue, 5 Mar 2024 16:14:54 +0100
Subject: [PATCH 09/13] fix for typo in equations version on github action.

---
 .github/workflows/build.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index 75711701..46141271 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -45,6 +45,6 @@ jobs:
       - name: Build
         run: |
           opam repo add coq-released https://coq.inria.fr/opam/released
-          opam install coq.8.18.0 coq-equations.1.3+8.16 coq-mathcomp-ssreflect.2.1.0 coq-mathcomp-analysis.1.0.0 coq-extructures.0.4.0 coq-deriving.0.2.0
+          opam install coq.8.18.0 coq-equations.1.3+8.18 coq-mathcomp-ssreflect.2.1.0 coq-mathcomp-analysis.1.0.0 coq-extructures.0.4.0 coq-deriving.0.2.0
           opam exec -- make -j4
 

From 2b3ccd43a3ef276ac583a952addb60c0037b8276 Mon Sep 17 00:00:00 2001
From: Sebastian Ertel <sebastian.ertel@barkhauseninstitut.org>
Date: Wed, 6 Mar 2024 09:31:50 +0100
Subject: [PATCH 10/13] more warning fixes.

---
 theories/Mon/FiniteProbabilities.v | 12 ++++++------
 theories/Mon/Monoid.v              |  2 +-
 2 files changed, 7 insertions(+), 7 deletions(-)

diff --git a/theories/Mon/FiniteProbabilities.v b/theories/Mon/FiniteProbabilities.v
index c0fdb857..c9311c9d 100644
--- a/theories/Mon/FiniteProbabilities.v
+++ b/theories/Mon/FiniteProbabilities.v
@@ -54,8 +54,8 @@ Section FinProb.
   Next Obligation.
     intros x y. simpl.
     rewrite divr_ge0 ?Bool.andb_true_l ?ler0n ?addr_ge0 //.
-    rewrite ler_pdivr_mulr.
-    rewrite mul1r [2%:~R]/(1+1) ler_add //.
+    rewrite ler_pdivrMr.
+    rewrite mul1r [2%:~R]/(1+1) lerD //.
     rewrite ltr0n //.
   Qed.
 
@@ -64,13 +64,13 @@ Section FinProb.
     intros. simpl.
     rewrite mulr_ge0 //=.
     rewrite -{3}(mul1r 1).
-    rewrite ler_pmul //=.
+    rewrite ler_pM //=.
   Qed.
 
   #[program] Definition negI (x:I) : I := ⦑ 1 - x∙1 ⦒.
   Next Obligation.
     intros. simpl.
-    rewrite subr_ge0 (I_le1 x) /= ler_subl_addr -{1}(addr0 1) ler_add ?lerr //.
+    rewrite subr_ge0 (I_le1 x) /= lerBlDr -{1}(addr0 1) lerD ?lerr //.
   Qed.
 
   Definition ProbS := I.
@@ -86,7 +86,7 @@ Section FinProb.
     rewrite addr_ge0 ?mulr_ge0 //.
     have: (1 = p∙1*1 + (1 - p∙1)*1) by rewrite !mulr1 addrA [_+1]addrC addrK.
     move=> heq; rewrite [X in _ <= X]heq.
-    by rewrite ler_add // ler_pmul // (I_ge0 (negI p)).
+    by rewrite lerD // ler_pM // (I_ge0 (negI p)).
   Qed.
 
   #[program] Definition wopProb (p:ProbS) : WI (ProbAr p) :=
@@ -94,7 +94,7 @@ Section FinProb.
   Next Obligation.
     intros p ? ? H.
     rewrite /Irel /=.
-    rewrite ler_add // ler_pmul //; try by apply H.
+    rewrite lerD // ler_pM //; try by apply H.
     by rewrite (I_ge0 (negI p)).
   Qed.
 
diff --git a/theories/Mon/Monoid.v b/theories/Mon/Monoid.v
index bfeb9518..781c4c40 100644
--- a/theories/Mon/Monoid.v
+++ b/theories/Mon/Monoid.v
@@ -62,7 +62,7 @@ Section MonoidExamples.
   Next Obligation. extensionality y ; rewrite monoid_law3 //. Qed.
 
   Program Definition listMonoid (X:Type) : monoid :=
-    @mkMonoid (list X) nil (@app _) _ (@List.app_nil_r _) (@List.app_assoc_reverse _).
+    @mkMonoid (list X) nil (@app _) _ (@List.app_nil_r _) (fun l m n => eq_sym (@List.app_assoc _ l m n)).
 
   Program Definition prodMonoid (M1 M2:monoid) : monoid :=
     @mkMonoid (M1 × M2) ⟨e M1, e M2⟩ (fun x y => ⟨nfst x ⋅ nfst y, nsnd x ⋅ nsnd y⟩)

From 08d0350f9b4d3b95cfb6b90849254b74824eacc9 Mon Sep 17 00:00:00 2001
From: Sebastian Ertel <sebastian.ertel@barkhauseninstitut.org>
Date: Mon, 11 Mar 2024 14:44:22 +0100
Subject: [PATCH 11/13] adapting concrete groups examples

---
 theories/Crypt/examples/concrete_groups.v | 130 ++++------------------
 1 file changed, 21 insertions(+), 109 deletions(-)

diff --git a/theories/Crypt/examples/concrete_groups.v b/theories/Crypt/examples/concrete_groups.v
index 82b50cb0..0c05f838 100644
--- a/theories/Crypt/examples/concrete_groups.v
+++ b/theories/Crypt/examples/concrete_groups.v
@@ -42,11 +42,6 @@ Module Z2_manual.
     ltac:(move => [|] [|];
             try solve [ right ; discriminate ];
             try solve [ left ; reflexivity ]).
-(*
-  Definition Z2_eqMixin := EqMixin Z2_eqP.
-  Canonical Z2_eqType : eqType :=
-    Eval hnf in EqType Z2 Z2_eqMixin.
-*)
   Definition Z2_hasDecEq := hasDecEq.Build Z2 Z2_eqP.
   HB.instance Definition _ := Z2_hasDecEq.
 
@@ -55,16 +50,8 @@ Module Z2_manual.
   Lemma Z2_p_u_cancel : @pcancel nat Z2 Z2_pickle Z2_unpickle.
   Proof. move => [|] //. Qed.
 
-  (*
-  Definition Z2_choiceMixin := PcanChoiceMixin Z2_p_u_cancel.
-  Canonical Z2_choiceType := ChoiceType Z2 Z2_choiceMixin.
-   *)
   HB.instance Definition _ := Choice.copy Z2 (pcan_type Z2_p_u_cancel).
 
-  (*
-  Definition Z2_countMixin := @choice.Countable.Mixin Z2 Z2_pickle Z2_unpickle Z2_p_u_cancel.
-  Canonical Z2_countType := Eval hnf in CountType Z2 Z2_countMixin.
-   *)
   Definition Z2_hasCountable := isCountable.Build Z2 Z2_p_u_cancel.
   HB.instance Definition _ := Z2_hasCountable.
 
@@ -74,11 +61,6 @@ Module Z2_manual.
   Lemma mem_Z2_enum i : i \in Z2_enum.
   Proof. destruct i; reflexivity. Qed.
 
-  (*
-  Definition Z2_finMixin :=
-    Eval hnf in UniqFinMixin Z2_enum_uniq mem_Z2_enum.
-  Canonical Z2_finType := Eval hnf in FinType Z2 Z2_finMixin.
-   *)
   Definition Z2_isFinite := isFinite.Build Z2 (Finite.uniq_enumP Z2_enum_uniq mem_Z2_enum).
   HB.instance Definition _ := Z2_isFinite.
 
@@ -91,24 +73,12 @@ Module Z2_manual.
   Lemma Z2_invgM : {morph inv : a b / add a b >-> add b a}.
   Proof. move => [|] [|] //. Qed.
 
-  (*
-  Definition Z2_finGroupBaseMixin :=
-    FinGroup.BaseMixin assoc_add lid inv_inv Z2_invgM.
-
-  Canonical Z2_BaseFinGroupType :=
-    BaseFinGroupType Z2 Z2_finGroupBaseMixin.
-   *)
-
   Definition Z2_isMulBaseGroup := isMulBaseGroup.Build Z2 assoc_add lid inv_inv Z2_invgM.
   HB.instance Definition _ := Z2_isMulBaseGroup.
 
   Definition linv : left_inverse z inv add.
   Proof. move => [|] //. Qed.
 
-  (*
-  Canonical Z2_finGroup : finGroupType := FinGroupType linv.
-   *)
-
   Definition Z2_BaseFinGroup_isGroup := BaseFinGroup_isGroup.Build Z2 linv.
   HB.instance Definition _ := Z2_BaseFinGroup_isGroup.
 
@@ -130,44 +100,40 @@ Module Z2_bool.
   Lemma bool_invgM : {morph invb : a b / addb a b >-> addb b a}.
   Proof. move => [|] [|] //. Qed.
 
-  (*
-  Definition bool_finGroupBaseMixin :=
-    FinGroup.BaseMixin assoc_addb lidb inv_invb bool_invgM.
-
-  Canonical bool_BaseFinGroupType :=
-    BaseFinGroupType bool bool_finGroupBaseMixin.
-   *)
-
   Definition bool_isMulBaseGroup := isMulBaseGroup.Build bool assoc_addb lidb inv_invb bool_invgM.
   HB.instance Definition _ := bool_isMulBaseGroup.
 
   Definition linvb : left_inverse false invb addb.
   Proof. move => [|] //. Qed.
 
-  (*
-  Canonical bool_finGroup : finGroupType := FinGroupType linvb.
-   *)
-
   Definition bool_BaseFinGroup_isGroup := BaseFinGroup_isGroup.Build bool linvb.
   HB.instance Definition _ := bool_BaseFinGroup_isGroup.
 
 End Z2_bool.
 
-(* TODO
 Section Z3_deriving.
   (* Construction of Z3 using deriving but not the fingroup mixin. *)
   Inductive Z3 := z | o | t.
 
   Definition Z3_indDef := [indDef for Z3_rect].
   Canonical Z3_indType := IndType Z3 Z3_indDef.
-  Definition Z3_eqMixin := [derive eqMixin for Z3].
-  Canonical Z3_eqType := EqType Z3 Z3_eqMixin.
-  Definition Z3_choiceMixin := [derive choiceMixin for Z3].
-  Canonical Z3_choiceType := ChoiceType Z3 Z3_choiceMixin.
-  Definition Z3_countMixin := [derive countMixin for Z3].
-  Canonical Z3_countType := CountType Z3 Z3_countMixin.
-  Definition Z3_finMixin := [derive finMixin for Z3].
-  Canonical Z3_finType := FinType Z3 Z3_finMixin.
+  Definition Z3_eqMixin := [derive hasDecEq for Z3].
+  HB.instance Definition _ := Z3_eqMixin.
+  Definition Z3_choiceMixin := [derive hasChoice for Z3].
+  HB.instance Definition _ := Z3_choiceMixin.
+  Definition Z3_countMixin := [derive isCountable for Z3].
+  HB.instance Definition _ := Z3_countMixin.
+  (* This does not work properly. Please check the output. *)
+  Definition Z3_finMixin := [derive isFinite for Z3].
+
+  (* Manual construction *)
+  Definition Z3_enum : seq Z3 := [:: z; o; t].
+  Lemma Z3_enum_uniq : uniq Z3_enum.
+  Proof. reflexivity. Qed.
+  Lemma mem_Z3_enum i : i \in Z3_enum.
+  Proof. destruct i; reflexivity. Qed.
+  Definition Z3_isFinite := isFinite.Build Z3 (Finite.uniq_enumP Z3_enum_uniq mem_Z3_enum).
+  HB.instance Definition _ := Z3_isFinite.
 
   Definition add (x y : Z3) : Z3 :=
     match x, y with
@@ -189,66 +155,12 @@ Section Z3_deriving.
   Lemma Z3_invgM : {morph inv : a b / add a b >-> add b a}.
   Proof. move => [||] [||] //. Qed.
 
-  Definition Z3_finGroupBaseMixin :=
-    FinGroup.BaseMixin assoc_add lid inv_inv Z3_invgM.
+  Definition Z3_finGroupBaseMixin := isMulBaseGroup.Build Z3 assoc_add lid inv_inv Z3_invgM.
 
-  Canonical Z3_BaseFinGroupType := BaseFinGroupType Z3 Z3_finGroupBaseMixin.
+  HB.instance Definition _ := Z3_finGroupBaseMixin.
   Definition linv : left_inverse z inv add.
   Proof. move => [||] //. Qed.
 
-  Canonical Z3_finGroup : finGroupType := FinGroupType linv.
+  Definition Z3_finGroup := BaseFinGroup_isGroup.Build Z3 linv.
+  HB.instance Definition _ := Z3_finGroup.
 End Z3_deriving.
-*)
-
-(* TODO Is this still needed? - Update or delete.
-Module Z2.
-  (* Minimal (?) construction of Z2 using the fingroup mixin. *)
-  Definition invb x : bool := x.
-  Fact assoc_xorb : associative xorb.
-  Proof. move => [|] [|] [|] //. Qed.
-  Fact lidb : left_id false xorb.
-  Proof. move => [|] //. Qed.
-  Fact linvb : left_inverse false invb xorb.
-  Proof. move => [|] //. Qed.
-  Canonical bool_finGroup := BaseFinGroupType _ (FinGroup.Mixin assoc_xorb lidb linvb).
-  Canonical Z2_finGroup : finGroupType := FinGroupType linvb.
-End Z2.
-*)
-
-(* TODO
-Module Z3.
-  (* Z3 using the fingroup mixin and deriving. *)
-  Inductive Z3 := z | o | t.
-
-  Definition Z3_indDef := [indDef for Z3_rect].
-  Canonical Z3_indType := IndType Z3 Z3_indDef.
-  Definition Z3_eqMixin := [derive eqMixin for Z3].
-  Canonical Z3_eqType := EqType Z3 Z3_eqMixin.
-  Definition Z3_choiceMixin := [derive choiceMixin for Z3].
-  Canonical Z3_choiceType := ChoiceType Z3 Z3_choiceMixin.
-  Definition Z3_countMixin := [derive countMixin for Z3].
-  Canonical Z3_countType := CountType Z3 Z3_countMixin.
-  Definition Z3_finMixin := [derive finMixin for Z3].
-  Canonical Z3_finType := FinType Z3 Z3_finMixin.
-
-  Definition add (x y : Z3) : Z3 :=
-    match x, y with
-    | z, _ => y
-    | _, z => x
-    | o, o => t
-    | o, t
-    | t, o => z
-    | t, t => o
-    end.
-  Definition inv x : Z3 := match x with o => t | t => o | z => z end.
-  Lemma assoc_add : associative add.
-  Proof. move => [||] [||] [||] //. Qed.
-  Lemma lid : left_id z add.
-  Proof. move => [||] //. Qed.
-  Lemma linv : left_inverse z inv add.
-  Proof. move => [||] //. Qed.
-
-  Canonical Z3_BaseFinGroupType := BaseFinGroupType _ (FinGroup.Mixin assoc_add lid linv).
-  Canonical Z3_finGroup : finGroupType := FinGroupType linv.
-End Z3.
-*)

From 4d4ee9a1bcc7509a9daf908fd4cb297beece9a02 Mon Sep 17 00:00:00 2001
From: Sebastian Ertel <sebastian.ertel@gmail.com>
Date: Tue, 12 Mar 2024 16:18:02 +0100
Subject: [PATCH 12/13] slight nix flake restructure

---
 flake.nix | 55 ++++++++++++++++++++++++++++---------------------------
 1 file changed, 28 insertions(+), 27 deletions(-)

diff --git a/flake.nix b/flake.nix
index f54ddbc3..cf4bfc64 100644
--- a/flake.nix
+++ b/flake.nix
@@ -4,12 +4,8 @@
     flake-utils.url    = github:numtide/flake-utils;
   };
   outputs = { self, nixpkgs, flake-utils }:
-    flake-utils.lib.eachDefaultSystem (system:
-      let
-        pkgs = nixpkgs.legacyPackages.${system};
-      in
-       rec {
-         mkDrv = { stdenv, which, coqPackages, coq } :
+    let
+      mkDrv = { stdenv, which, coqPackages, coq } :
            let
              extructures' = coqPackages.extructures.override { version = "0.4.0"; };
            in
@@ -27,25 +23,30 @@
                                   ++ [extructures'];
               buildInputs = [ coq ];
             };
-
-          devShell =
-            let
-              args = {
-                inherit (pkgs) stdenv which;
-                coq = pkgs.coq_8_18;
-                coqPackages = pkgs.coqPackages_8_18.overrideScope
-                  (self: super: {
-                    mathcomp = super.mathcomp.override { version = "2.1.0"; };
-                    mathcomp-analysis = super.mathcomp-analysis.override { version = "1.0.0"; };
-                  });
-              };
-              ssprove' = mkDrv args;
-            in
-              pkgs.mkShell {
-                packages =
-                  (with pkgs; [ coq gnumake ])
-                  ++
-                  (with ssprove';  nativeBuildInputs);
-              };
-       });
+    in { inherit mkDrv; } //
+      flake-utils.lib.eachDefaultSystem (system:
+        let
+          pkgs = nixpkgs.legacyPackages.${system};
+        in
+         rec {
+            devShell =
+              let
+                args = {
+                  inherit (pkgs) stdenv which;
+                  coq = pkgs.coq_8_18;
+                  coqPackages = pkgs.coqPackages_8_18.overrideScope
+                    (self: super: {
+                      mathcomp = super.mathcomp.override { version = "2.1.0"; };
+                      mathcomp-analysis = super.mathcomp-analysis.override { version = "1.0.0"; };
+                    });
+                };
+                ssprove' = mkDrv args;
+              in
+                pkgs.mkShell {
+                  packages =
+                    (with pkgs; [ coq gnumake ])
+                    ++
+                    (with ssprove';  nativeBuildInputs);
+                };
+         });
 }

From 5c212d8a9a2f0824f5c1234717ae04a454126a07 Mon Sep 17 00:00:00 2001
From: Sebastian Ertel <sebastian.ertel@barkhauseninstitut.org>
Date: Mon, 18 Mar 2024 13:59:17 +0100
Subject: [PATCH 13/13] thanks @cmester0 for the review. here are the fixes.

---
 _CoqProject                       |    2 +-
 theories/Crypt/choice_type.v      |   33 +-
 theories/Crypt/examples/OVN.v     | 4407 +++++++++++++++--------------
 theories/Crypt/examples/Schnorr.v |    8 -
 4 files changed, 2214 insertions(+), 2236 deletions(-)

diff --git a/_CoqProject b/_CoqProject
index 0eaefba1..2da21a23 100644
--- a/_CoqProject
+++ b/_CoqProject
@@ -90,7 +90,7 @@ theories/Crypt/examples/KEMDEM.v
 theories/Crypt/examples/RandomOracle.v
 theories/Crypt/examples/SigmaProtocol.v
 theories/Crypt/examples/Schnorr.v
-theories/Crypt/examples/OVN.v
+# theories/Crypt/examples/OVN.v
 theories/Crypt/examples/Executor.v
 
 # Examples from https://github.com/Som1Lse/joy-of-ssprove
diff --git a/theories/Crypt/choice_type.v b/theories/Crypt/choice_type.v
index 20f1efed..ed58c95c 100644
--- a/theories/Crypt/choice_type.v
+++ b/theories/Crypt/choice_type.v
@@ -94,7 +94,6 @@ Defined.
 
 Section choice_typeTypes.
 
-
   Fixpoint choice_type_test (u v : choice_type) : bool :=
     match u, v with
     | chNat , chNat => true
@@ -291,27 +290,7 @@ Section choice_typeTypes.
       move/nandP; rewrite -/choice_type_test -/eq_op.
       move => H; apply/orP.
       destruct (eq_op x1 y1) eqn:Heq.
-      + destruct H.
-        1: {
-          move: Heq => /eqP Heq.
-          move/negP: H; rewrite Heq /=.
-          move => H; left.
-          apply/orP; right.
-          have eq_true b : b == b = true. 1:{ apply/idP. apply eq_refl. }
-          rewrite (eq_true choice_type y1) //=.
-          clear ih1 ih2 Heq eq_true.
-          move: H; elim: y1 => //=.
-          - move => A ih1 B ih2.
-            move/negP/nandP.
-            case; move/negP.
-            + exact: ih1.
-            + exact: ih2.
-          - move => A ih1 B ih2.
-            move/negP/nandP.
-            case; move/negP.
-            + exact: ih1.
-            + exact: ih2.
-        }
+      + setoid_rewrite -> Heq in H. move/nandP: H; rewrite Bool.andb_true_l => H.
         move: ih2. move /implyP => ih2.
         specialize (ih2 H).
         move: ih2. move /orP => ih2.
@@ -346,15 +325,7 @@ Section choice_typeTypes.
       move /nandP => H.
       apply/orP.
       destruct (eq_op x1 y1) eqn:Heq.
-      + destruct H.
-        1:{
-          move: ih1; rewrite -Heq; move/implyP => ih1.
-          specialize (ih1 H).
-          move: ih1 => /orP ih1.
-          case: ih1 => [ih1|ih1].
-          - by [left; apply/orP; left].
-          - by [right; apply/orP; left].
-        }
+      + setoid_rewrite -> Heq in H; move: H => /nandP H; simpl in H.
         move: ih2. move /implyP => ih2.
         specialize (ih2 H).
         move: ih2. move /orP => ih2.
diff --git a/theories/Crypt/examples/OVN.v b/theories/Crypt/examples/OVN.v
index 3656c75d..0f687225 100644
--- a/theories/Crypt/examples/OVN.v
+++ b/theories/Crypt/examples/OVN.v
@@ -1,2196 +1,2211 @@
-(*
- * From Relational Require Import OrderEnrichedCategory GenericRulesSimple.
- * 
- * Set Warnings "-notation-overridden,-ambiguous-paths".
- * From mathcomp Require Import all_ssreflect all_algebra reals distr realsum
- *   fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool ssrnum
- *   eqtype choice seq.
- * Set Warnings "notation-overridden,ambiguous-paths".
- * 
- * From Crypt Require Import Axioms ChoiceAsOrd SubDistr Couplings
- *   UniformDistrLemmas FreeProbProg Theta_dens RulesStateProb UniformStateProb
- *   pkg_composition Package Prelude SigmaProtocol Schnorr DDH Casts.
- * 
- * From Coq Require Import Utf8 Lia.
- * From extructures Require Import ord fset fmap.
- * 
- * From Equations Require Import Equations.
- * Require Equations.Prop.DepElim.
- * 
- * Set Equations With UIP.
- * 
- * Set Bullet Behavior "Strict Subproofs".
- * Set Default Goal Selector "!".
- * Set Primitive Projections.
- * 
- * Import Num.Def.
- * Import Num.Theory.
- * Import Order.POrderTheory.
- * 
- * #[local] Open Scope ring_scope.
- * Import GroupScope GRing.Theory.
- * 
- * Import PackageNotation.
- * 
- * Module Type GroupParam.
- * 
- *   Parameter n : nat.
- *   Parameter n_pos : Positive n.
- * 
- *   Parameter gT : finGroupType.
- *   Definition ζ : {set gT} := [set : gT].
- *   Parameter g :  gT.
- *   Parameter g_gen : ζ = <[g]>.
- *   Parameter prime_order : prime #[g].
- * 
- * End GroupParam.
- * 
- * Module Type OVNParam.
- * 
- *   Parameter N : nat.
- *   Parameter N_pos : Positive N.
- * 
- * End OVNParam.
- * 
- * Module OVN (GP : GroupParam) (OP : OVNParam).
- * Import GP.
- * Import OP.
- * 
- * Set Equations Transparent.
- * 
- * Lemma cyclic_zeta: cyclic ζ.
- * Proof.
- *   apply /cyclicP. exists g. exact: g_gen.
- * Qed.
- * 
- * (* order of g *)
- * Definition q' := Zp_trunc (pdiv #[g]).
- * Definition q : nat := q'.+2.
- * 
- * Lemma q_order_g : q = #[g].
- * Proof.
- *   unfold q, q'.
- *   apply Fp_cast.
- *   apply prime_order.
- * Qed.
- * 
- * Lemma q_field : (Zp_trunc #[g]) = q'.
- * Proof.
- *   unfold q'.
- *   rewrite pdiv_id.
- *   2: apply prime_order.
- *   reflexivity.
- * Qed.
- * 
- * Lemma expg_g : forall x, exists ix, x = g ^+ ix.
- * Proof.
- *   intros.
- *   apply /cycleP.
- *   rewrite -g_gen.
- *   apply: in_setT.
- * Qed.
- * 
- * Lemma group_prodC :
- *   @commutative gT gT mulg.
- * Proof.
- *   move => x y.
- *   destruct (expg_g x) as [ix ->].
- *   destruct (expg_g y) as [iy ->].
- *   repeat rewrite -expgD addnC.
- *   reflexivity.
- * Qed.
- * 
- * Definition Pid : finType := Finite.clone _ 'I_n.
- * Definition Secret : finComRingType := 'Z_(Zp_trunc #[g]).
- * Definition Public : finType := gT.
- * Definition s0 : Secret := 0.
- * 
- * Definition Pid_pos : Positive #|Pid|.
- * Proof.
- *   rewrite card_ord.
- *   eapply PositiveInFin.
- *   apply n_pos.
- * Qed.
- * 
- * Definition Secret_pos : Positive #|Secret|.
- * Proof.
- *   apply /card_gt0P. exists s0. auto.
- * Qed.
- * 
- * Definition Public_pos : Positive #|Public|.
- * Proof.
- *   apply /card_gt0P. exists g. auto.
- * Defined.
- * 
- * #[local] Existing Instance Pid_pos.
- * #[local] Existing Instance Secret_pos.
- * #[local] Existing Instance Public_pos.
- * 
- * Definition pid : choice_type := 'fin #|Pid|.
- * Definition secret : choice_type := 'fin #|Secret|.
- * Definition public: choice_type := 'fin #|Public|.
- * 
- * Definition nat_to_pid : nat → pid.
- * Proof.
- *   move=> n.
- *   eapply give_fin.
- * Defined.
- * 
- * Definition i_secret := #|Secret|.
- * Definition i_public := #|Public|.
- * 
- * Module Type CDSParams <: SigmaProtocolParams.
- *   Definition Witness : finType := Secret.
- *   Definition Statement : finType := prod_finType (prod_finType Public Public) Public.
- * 
- *   Definition Witness_pos : Positive #|Witness| := Secret_pos.
- *   Definition Statement_pos : Positive #|Statement|.
- *   Proof.
- *     unfold Statement.
- *     rewrite !card_prod.
- *     repeat apply Positive_prod.
- *     all: apply Public_pos.
- *   Qed.
- * 
- *   Definition R : Statement -> Witness -> bool :=
- *     λ (h : Statement) (x : Witness),
- *       let '(gx, gy, gyxv) := h in
- *       (gy^+x * g^+0 == gyxv) || (gy^+x * g^+1 == gyxv).
- * 
- *   Lemma relation_valid_left:
- *     ∀ (x : Secret) (gy : Public),
- *       R (g^+x, gy, gy^+x * g^+ 0) x.
- *   Proof.
- *     intros x gy.
- *     unfold R.
- *     apply /orP ; left.
- *     done.
- *   Qed.
- * 
- *   Lemma relation_valid_right:
- *     ∀ (x : Secret) (gy : Public),
- *       R (g^+x, gy, gy^+x * g^+ 1) x.
- *   Proof.
- *     intros x y.
- *     unfold R.
- *     apply /orP ; right.
- *     done.
- *   Qed.
- * 
- *   Parameter Message Challenge Response State : finType.
- *   Parameter w0 : Witness.
- *   Parameter e0 : Challenge.
- *   Parameter z0 : Response.
- * 
- *   Parameter Message_pos : Positive #|Message|.
- *   Parameter Challenge_pos : Positive #|Challenge|.
- *   Parameter Response_pos : Positive #|Response|.
- *   Parameter State_pos : Positive #|State|.
- *   Parameter Bool_pos : Positive #|bool_choiceType|.
- * End CDSParams.
- * 
- * Module OVN (π2 : CDSParams) (Alg2 : SigmaProtocolAlgorithms π2).
- * 
- *   Module Sigma1 := Schnorr GP.
- *   Module Sigma2 := SigmaProtocol π2 Alg2.
- * 
- *   Obligation Tactic := idtac.
- *   Set Equations Transparent.
- * 
- *   Definition skey_loc (i : nat) : Location := (secret; (100+i)%N).
- *   Definition ckey_loc (i : nat) : Location := (public; (101+i)%N).
- * 
- *   Definition P_i_locs (i : nat) : {fset Location} := fset [:: skey_loc i ; ckey_loc i].
- * 
- *   Notation choiceStatement1 := Sigma1.MyAlg.choiceStatement.
- *   Notation choiceWitness1 := Sigma1.MyAlg.choiceWitness.
- *   Notation choiceTranscript1 := Sigma1.MyAlg.choiceTranscript.
- * 
- *   Notation " 'pid " := pid (in custom pack_type at level 2).
- *   Notation " 'pids " := (chProd pid pid) (in custom pack_type at level 2).
- *   Notation " 'public " := public (in custom pack_type at level 2).
- *   Notation " 'public " := public (at level 2) : package_scope.
- * 
- *   Notation " 'chRelation1' " := (chProd choiceStatement1 choiceWitness1) (in custom pack_type at level 2).
- *   Notation " 'chTranscript1' " := choiceTranscript1 (in custom pack_type at level 2).
- *   Notation " 'public_key " := (chProd public choiceTranscript1) (in custom pack_type at level 2).
- *   Notation " 'public_keys " := (chMap pid (chProd public choiceTranscript1)) (in custom pack_type at level 2).
- * 
- *   Notation " 'chRelation2' " := (chProd Alg2.choiceStatement Alg2.choiceWitness) (in custom pack_type at level 2).
- *   Notation " 'chTranscript2' " := Alg2.choiceTranscript (in custom pack_type at level 2).
- *   Notation " 'vote " := (chProd public Alg2.choiceTranscript) (in custom pack_type at level 2).
- * 
- *   Definition INIT : nat := 4.
- *   Definition VOTE : nat := 5.
- *   Definition CONSTRUCT : nat := 6.
- * 
- *   Definition P (i : nat) : nat := 14 + i.
- *   Definition Exec (i : nat) : nat := 15 + i.
- * 
- *   Lemma not_in_domm {T S} :
- *     ∀ i m,
- *       i \notin @domm T S m :\ i.
- *   Proof.
- *     intros.
- *     apply /negPn.
- *     rewrite in_fsetD.
- *     move=> /andP [H _].
- *     move: H => /negPn H.
- *     apply H.
- *     by rewrite in_fset1.
- *   Qed.
- * 
- *   Lemma not_in_fsetU :
- *     ∀ (l : Location) L0 L1,
- *       l \notin L0  →
- *       l \notin L1 →
- *       l \notin L0 :|: L1.
- *   Proof.
- *     intros l L0 L1 h1 h2.
- *     rewrite -fdisjoints1 fset1E.
- *     rewrite fdisjointUl.
- *     apply /andP ; split.
- *     + rewrite -fdisjoints1 fset1E in h1. apply h1.
- *     + rewrite -fdisjoints1 fset1E in h2. apply h2.
- *   Qed.
- * 
- *   #[local] Hint Extern 3 (is_true (?l \notin ?L0 :|: ?L1)) =>
- *     apply not_in_fsetU : typeclass_instances ssprove_valid_db ssprove_invariant.
- * 
- *   Definition get_value (m : chMap pid (chProd public choiceTranscript1)) (i : pid) :=
- *     match m i with
- *     | Some (v, _) => otf v
- *     | _ => 1
- *     end.
- *
- *   Canonical finGroup_com_law := Monoid.ComLaw group_prodC.
- * 
- *   Definition compute_key
- *              (m : chMap pid (chProd public choiceTranscript1))
- *              (i : pid)
- *     :=
- *     let low := \prod_(k <- domm m | (k < i)%ord) (get_value m k) in
- *     let high := \prod_(k <- domm m | (i < k)%ord) (get_value m k) in
- *     low * invg high.
- * 
- *   Definition compute_key'
- *              (m : chMap pid (chProd public choiceTranscript1))
- *              (i j : pid)
- *              (x : Secret)
- *     :=
- *     if (j < i)%ord then
- *       let low := \prod_(k <- domm m | (k < i)%ord) (get_value m k) in
- *       let high := \prod_(k <- domm m | (i < k)%ord) (get_value m k) in
- *       (g ^+ x) * low * invg high
- *     else
- *       let low := \prod_(k <- domm m | (k < i)%ord) (get_value m k) in
- *       let high := \prod_(k <- domm m | (i < k)%ord) (get_value m k) in
- *       low * invg (high * (g ^+ x)).
- * 
- *   Lemma compute_key'_equiv
- *         (i j : pid)
- *         (x : Secret)
- *         (zk : choiceTranscript1)
- *         (keys : chMap pid (chProd public choiceTranscript1)):
- *     (i != j) →
- *     compute_key (setm keys j (fto (g ^+ x), zk)) i = compute_key' (remm keys j) i j x.
- *   Proof.
- *     intro ij_neq.
- *     unfold compute_key, compute_key'.
- *     simpl.
- *     rewrite <- setm_rem.
- *     rewrite domm_set domm_rem.
- *     set X := domm _.
- *     rewrite !big_fsetU1.
- *     2-3: subst X; apply not_in_domm.
- *     rewrite setm_rem.
- *     have set_rem_eq : forall P x,
- *       \big[finGroup_com_law/1]_(k <- X :\ j | P k)
- *         get_value (setm keys j x) k =
- *       \prod_(k <- X :\ j | P k)
- *         get_value (remm keys j) k.
- *     { intros.
- *       rewrite big_seq_cond.
- *       rewrite [RHS] big_seq_cond.
- *       unfold get_value.
- *       erewrite eq_bigr.
- *       1: done.
- *       intros k.
- *       move => /andP [k_in _].
- *       simpl.
- *       rewrite setmE remmE.
- *       case (k == j) eqn:eq.
- *       - move: eq => /eqP eq.
- *         rewrite eq in_fsetD1 in k_in.
- *         move: k_in => /andP [contra].
- *         rewrite eq_refl in contra.
- *         discriminate.
- *       - reflexivity.
- * 
- *     }
- *     case (j < i)%ord eqn:e.
- *     - rewrite !e.
- *       rewrite -2!mulgA.
- *       f_equal.
- *       1: unfold get_value ; by rewrite setmE eq_refl otf_fto.
- *       f_equal.
- *       + apply set_rem_eq.
- *       + rewrite Ord.ltNge Ord.leq_eqVlt in e.
- *         rewrite negb_or in e.
- *         move: e => /andP [_ e].
- *         apply negbTE in e.
- *         rewrite e.
- *         f_equal.
- *         apply set_rem_eq.
- *     - rewrite e.
- *       rewrite Ord.ltNge in e.
- *       apply negbT in e.
- *       apply negbNE in e.
- *       rewrite Ord.leq_eqVlt in e.
- *       move: e => /orP [contra|e].
- *       1: by rewrite contra in ij_neq.
- *       rewrite e !invMg.
- *       f_equal.
- *       { apply set_rem_eq. }
- *       rewrite group_prodC.
- *       f_equal.
- *       { unfold get_value. by rewrite setmE eq_refl otf_fto. }
- *       f_equal.
- *       apply set_rem_eq.
- *   Qed.
- * 
- *   Lemma compute_key_bij:
- *     ∀ (m : chMap pid (chProd public choiceTranscript1)) (i j: pid),
- *       (i != j)%ord →
- *       exists (a b : nat),
- *         (a != 0)%N /\ (a < q)%N /\
- *       (∀ (x : Secret) zk,
- *         compute_key (setm m j (fto (g ^+ x), zk)) i = g ^+ ((a * x + b) %% q)).
- *   Proof.
- *     intros m i j ne.
- *     simpl.
- *     pose low := \prod_(k <- domm m :\ j| (k < i)%ord) get_value m k.
- *     pose hi := \prod_(k <- domm m :\ j| (i < k)%ord) get_value m k.
- *     have Hlow : exists ilow, low = g ^+ ilow by apply expg_g.
- *     have Hhi : exists ihi, hi = g ^+ ihi by apply expg_g.
- *     destruct Hlow as [ilow Hlow].
- *     destruct Hhi as [ihi Hhi].
- * 
- *     have getv_remm_eq : forall P j m,
- *       \prod_(k <- domm m :\ j | P k) get_value (remm m j) k =
- *       \prod_(k <- domm m :\ j | P k) get_value m k.
- *     {
- *       clear low hi ilow ihi Hlow Hhi ne i j m.
- *       intros.
- *       rewrite big_seq_cond.
- *       rewrite [RHS] big_seq_cond.
- *       erewrite eq_bigr.
- *       1: done.
- *       intros k.
- *       move => /andP [k_in _].
- *       simpl.
- *       unfold get_value.
- *       rewrite remmE.
- *       case (k == j) eqn:eq.
- *       ++ move: eq => /eqP eq.
- *           rewrite eq in_fsetD1 in k_in.
- *           move: k_in => /andP [contra].
- *           rewrite eq_refl in contra.
- *           discriminate.
- *       ++ reflexivity.
- *     }
- * 
- *     case (j < i)%ord eqn:ij_rel.
- *     - exists 1%N.
- *       exists (ilow + (ihi * #[g ^+ ihi].-1))%N.
- *       do 2 split.
- *       1: rewrite q_order_g ; apply (prime_gt1 prime_order).
- *       intros x zk.
- *       rewrite compute_key'_equiv.
- *       2: assumption.
- *       unfold compute_key'.
- *       simpl.
- *       rewrite ij_rel.
- *       rewrite domm_rem.
- *       set low' := \prod_(k0 <- _ | _) _.
- *       set hi' := \prod_(k0 <- _ | _) _.
- *       have -> : low' = low by apply getv_remm_eq.
- *       have -> : hi' = hi by apply getv_remm_eq.
- *       clear low' hi'.
- *       rewrite Hhi Hlow.
- *       rewrite invg_expg.
- *       rewrite -!expgM.
- *       rewrite -!expgD.
- *       rewrite !addnA.
- *       rewrite -expg_mod_order.
- *       f_equal.
- *       f_equal.
- *       2: {
- *         unfold q. rewrite Fp_cast;
- *         [reflexivity | apply prime_order].
- *       }
- *       rewrite mul1n.
- *       done.
- *     - exists #[g].-1.
- *       exists (ilow + (ihi * #[g ^+ ihi].-1))%N.
- *       repeat split.
- *       { unfold negb.
- *         rewrite -leqn0.
- *         case (#[g].-1 <= 0)%N eqn:e.
- *         2: done.
- *         have Hgt1 := (prime_gt1 prime_order).
- *         rewrite -ltn_predRL in Hgt1.
- *         rewrite -ltnS in Hgt1.
- *         rewrite -addn1 in Hgt1.
- *         rewrite leq_add2l in Hgt1.
- *         eapply leq_trans in e.
- *         2: apply Hgt1.
- *         discriminate.
- *       }
- *       {
- *         rewrite q_order_g.
- *         rewrite ltn_predL.
- *         apply (prime_gt0 prime_order).
- *       }
- *       intros x zk.
- *       rewrite compute_key'_equiv.
- *       2: assumption.
- *       unfold compute_key'.
- *       simpl.
- *       rewrite ij_rel.
- *       rewrite domm_rem.
- *       set low' := \prod_(k0 <- _ | _) _.
- *       set hi' := \prod_(k0 <- _ | _) _.
- *       have -> : low' = low by apply getv_remm_eq.
- *       have -> : hi' = hi by apply getv_remm_eq.
- *       clear low' hi'.
- *       rewrite Hhi Hlow.
- *       rewrite invMg.
- *       rewrite -expgVn.
- *       rewrite !invg_expg.
- *       rewrite -!expgM.
- *       rewrite mulgA.
- *       rewrite -!expgD.
- *       rewrite !addnA.
- *       rewrite -expg_mod_order.
- *       f_equal.
- *       f_equal.
- *       2: {
- *         unfold q. rewrite Fp_cast;
- *         [reflexivity | apply prime_order].
- *       }
- *       rewrite addnAC.
- *       rewrite addnC.
- *       rewrite addnA.
- *       done.
- *   Qed.
- * 
- *   Lemma compute_key_set_i
- *         (i : pid)
- *         (v : (chProd public choiceTranscript1))
- *         (m : chMap pid (chProd public choiceTranscript1)):
- *     compute_key (setm m i v) i = compute_key m i.
- *   Proof.
- *     unfold compute_key.
- *     simpl.
- *     case (i \in domm m) eqn:i_in.
- *     all: simpl in i_in.
- *     - have -> : forall v, domm (setm m i v) = domm m.
- *       { intros.
- *         simpl.
- *         rewrite domm_set.
- *         rewrite -eq_fset.
- *         intro k.
- *         rewrite in_fsetU1.
- *         case (eq_op) eqn:e.
- *         + move: e => /eqP ->.
- *           by rewrite i_in.
- *         + done.
- *       }
- *       simpl.
- *       f_equal.
- *       + apply eq_big.
- *         1: done.
- *         intros k k_lt.
- *         unfold get_value.
- *         rewrite setmE.
- *         rewrite Ord.lt_neqAle in k_lt.
- *         move: k_lt => /andP [k_lt _].
- *         move: k_lt => /negbTE ->.
- *         done.
- *       + f_equal.
- *         apply eq_big.
- *         1: done.
- *         intros k k_lt.
- *         unfold get_value.
- *         rewrite setmE.
- *         rewrite Ord.lt_neqAle in k_lt.
- *         move: k_lt => /andP [k_lt _].
- *         rewrite eq_sym.
- *         move: k_lt => /negbTE ->.
- *         done.
- *     - have -> : domm m = domm (remm m i).
- *       {
- *         simpl.
- *         rewrite -eq_fset.
- *         intro k.
- *         rewrite domm_rem.
- *         rewrite in_fsetD1.
- *         case (eq_op) eqn:e.
- *         + simpl.
- *           move: e => /eqP ->.
- *           assumption.
- *         + done.
- *       }
- *       simpl.
- *       f_equal.
- *       + rewrite -setm_rem domm_set domm_rem.
- *         rewrite big_fsetU1.
- *         all: simpl.
- *         2: by rewrite in_fsetD1 eq_refl.
- *         rewrite Ord.ltxx.
- *         apply eq_big.
- *         1: done.
- *         intros k k_lt.
- *         unfold get_value.
- *         rewrite setmE remmE.
- *         rewrite Ord.lt_neqAle in k_lt.
- *         move: k_lt => /andP [k_lt _].
- *         move: k_lt => /negbTE ->.
- *         done.
- *       + f_equal.
- *         rewrite -setm_rem domm_set domm_rem.
- *         rewrite big_fsetU1.
- *         all: simpl.
- *         2: by rewrite in_fsetD1 eq_refl.
- *         rewrite Ord.ltxx.
- *         apply eq_big.
- *         1: done.
- *         intros k k_lt.
- *         unfold get_value.
- *         rewrite setmE remmE.
- *         rewrite Ord.lt_neqAle in k_lt.
- *         move: k_lt => /andP [k_lt _].
- *         rewrite eq_sym.
- *         move: k_lt => /negbTE ->.
- *         done.
- *   Qed.
- * 
- *   Lemma test_bij
- *         (i j : pid)
- *         (m : chMap pid (chProd public choiceTranscript1))
- *     :
- *       (i != j)%N →
- *       ∃ (f : Secret → Secret),
- *       ∀ (x : Secret),
- *         bijective f /\
- *           (∀ zk, compute_key (setm m j (fto (g ^+ x), zk)) i = g ^+ (f x)).
- *   Proof.
- *     simpl.
- *     intros ne.
- *     have H := compute_key_bij m i j ne.
- *     simpl in H.
- *     destruct H as [a [b [a_pos [a_leq_q H]]]].
- *     set a_ord := @inZp ((Zp_trunc #[g]).+1) a.
- *     set b_ord := @inZp ((Zp_trunc #[g]).+1) b.
- *     pose f' := (fun (x : Secret) => Zp_add (Zp_mul x a_ord) b_ord).
- *     exists f'.
- *     unfold f'. clear f'.
- *     intros x.
- *     have := q_order_g.
- *     unfold q.
- *     intros Hq.
- *     split.
- *     2: {
- *       intro zk.
- *       rewrite (H x zk).
- *       apply /eqP.
- *       rewrite eq_expg_mod_order.
- *       apply /eqP.
- *       simpl.
- *       rewrite modn_small.
- *       2: {
- *         rewrite q_order_g.
- *         apply ltn_pmod.
- *         apply (prime_gt0 prime_order).
- *       }
- *       repeat rewrite -> Zp_cast at 3.
- *       2-5: apply (prime_gt1 prime_order).
- *       symmetry.
- *       rewrite modn_small.
- *       2: {
- *         apply ltn_pmod.
- *         apply (prime_gt0 prime_order).
- *       }
- *       simpl.
- *       unfold q, q'.
- *       rewrite Fp_cast.
- *       2: apply prime_order.
- *       rewrite modnMmr.
- *       rewrite modnDm.
- *       rewrite mulnC.
- *       reflexivity.
- *     }
- *     assert (coprime q'.+2 a_ord) as a_ord_coprime.
- *     {
- *       rewrite -unitFpE.
- *       2: rewrite Hq ; apply prime_order.
- *       rewrite unitfE. simpl.
- *       rewrite Zp_cast.
- *       2: apply (prime_gt1 prime_order).
- *       unfold q, q' in a_leq_q.
- *       rewrite Fp_cast in a_leq_q.
- *       2: apply prime_order.
- *       rewrite modn_small.
- *       2: apply a_leq_q.
- *       erewrite <- inj_eq.
- *       2: apply ord_inj.
- *       rewrite val_Zp_nat.
- *       2: {
- *         rewrite pdiv_id.
- *         1: apply prime_gt1.
- *         1,2: rewrite Hq ; apply prime_order.
- *       }
- *       rewrite -> pdiv_id at 1.
- *       1,2: rewrite Hq.
- *       2: apply prime_order.
- *       unfold q in a_leq_q.
- *       rewrite modn_small.
- *       2: apply a_leq_q.
- *       assumption.
- *     }
- *     pose f' := (fun (x : Secret) => Zp_mul (Zp_add (Zp_opp b_ord) x) (Zp_inv a_ord)).
- *     exists f'.
- *     - intro z.
- *       unfold f'. clear f'.
- *       simpl.
- *       rewrite Zp_addC.
- *       rewrite -Zp_addA.
- *       have -> : (Zp_add b_ord (Zp_opp b_ord)) = Zp0.
- *       1: by rewrite Zp_addC Zp_addNz.
- *       rewrite Zp_addC.
- *       rewrite Zp_add0z.
- *       rewrite -Zp_mulA.
- *       rewrite Zp_mulzV.
- *       2: {
- *         rewrite -> q_field at 1.
- *         assumption.
- *       }
- *       rewrite Zp_mulz1.
- *       reflexivity.
- *     - intro z.
- *       unfold f'. clear f'.
- *       simpl.
- *       rewrite Zp_addC.
- *       rewrite -Zp_mulA.
- *       rewrite Zp_mul_addl.
- *       have -> : (Zp_mul (Zp_inv a_ord) a_ord) = Zp1.
- *       {
- *         rewrite Zp_mulC.
- *         rewrite Zp_mulzV.
- *         + reflexivity.
- *         + rewrite -> q_field at 1.
- *           assumption.
- *       }
- *       rewrite -Zp_mul_addl.
- *       rewrite Zp_mulz1.
- *       rewrite Zp_addA.
- *       have -> : (Zp_add b_ord (Zp_opp b_ord)) = Zp0.
- *       1: by rewrite Zp_addC Zp_addNz.
- *       rewrite Zp_add0z.
- *       reflexivity.
- *   Qed.
- * 
- *   Lemma test_bij'
- *         (i j : pid)
- *         (m : chMap pid (chProd public choiceTranscript1))
- *     :
- *       (i != j)%N →
- *       ∃ (f : secret → secret),
- *       ∀ (x : secret),
- *         bijective f /\
- *           (∀ zk, compute_key (setm m j (fto (g ^+ otf x), zk)) i = g ^+ (otf (f x))).
- *   Proof.
- *     simpl.
- *     intros ne.
- *     have [f H] := test_bij i j m ne.
- *     simpl in H.
- *     exists (fun (x : secret) => fto (f (otf x))).
- *     intro x.
- *     destruct (H (otf x)) as [f_bij H'] ; clear H.
- *     split.
- *     - exists (fun z => fto ((finv f) (otf z))).
- *       + apply bij_inj in f_bij.
- *         intro z.
- *         rewrite otf_fto.
- *         apply finv_f in f_bij.
- *         rewrite f_bij fto_otf.
- *         reflexivity.
- *       + apply bij_inj in f_bij.
- *         intro z.
- *         rewrite otf_fto.
- *         apply f_finv in f_bij.
- *         rewrite f_bij fto_otf.
- *         reflexivity.
- *     - intro zk.
- *       specialize (H' zk).
- *       rewrite otf_fto.
- *       apply H'.
- *   Qed.
- * 
- *   Definition P_i_E :=
- *     [interface
- *       #val #[ INIT ] : 'unit → 'public_key ;
- *       #val #[ CONSTRUCT ] : 'public_keys → 'unit ;
- *       #val #[ VOTE ] : 'bool → 'public
- *     ].
- * 
- *   Definition Sigma1_I :=
- *     [interface
- *       #val #[ Sigma1.Sigma.VERIFY ] : chTranscript1 → 'bool ;
- *       #val #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1
- *     ].
- * 
- *   Definition P_i (i : pid) (b : bool):
- *     package (P_i_locs i)
- *       Sigma1_I
- *       P_i_E :=
- *     [package
- *         #def #[ INIT ] (_ : 'unit) : 'public_key
- *         {
- *           #import {sig #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1} as ZKP ;;
- *           #import {sig #[ Sigma1.Sigma.VERIFY ] : chTranscript1 → 'bool} as VER ;;
- *           x ← sample uniform i_secret ;;
- *           #put (skey_loc i) := x ;;
- *           let y := (fto (g ^+ (otf x))) : public in
- *             zkp ← ZKP (y, x) ;;
- *             ret (y, zkp)
- *         }
- *         ;
- *         #def #[ CONSTRUCT ] (m : 'public_keys) : 'unit
- *         {
- *           #import {sig #[ Sigma1.Sigma.VERIFY ] : chTranscript1 → 'bool} as VER ;;
- *           #assert (size (domm m) == n) ;;
- *           let key := fto (compute_key m i) in
- *           #put (ckey_loc i) := key ;;
- *           @ret 'unit Datatypes.tt
- *         }
- *         ;
- *         #def #[ VOTE ] (v : 'bool) : 'public
- *         {
- *           skey ← get (skey_loc i) ;;
- *           ckey ← get (ckey_loc i) ;;
- *           if b then
- *             let vote := (otf ckey ^+ skey * g ^+ v) in
- *             @ret 'public (fto vote)
- *           else
- *             let vote := (otf ckey ^+ skey * g ^+ (negb v)) in
- *             @ret 'public (fto vote)
- *         }
- *     ].
- * 
- *   Definition EXEC_i_I :=
- *     [interface
- *       #val #[ INIT ] : 'unit → 'public_key ;
- *       #val #[ CONSTRUCT ] : 'public_keys → 'unit ;
- *       #val #[ VOTE ] : 'bool → 'public ;
- *       #val #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1
- *     ].
- * 
- *   Definition Exec_i_E i := [interface #val #[ Exec i ] : 'bool → 'public].
- * 
- *   Definition Exec_i (i j : pid) (m : chMap pid (chProd public choiceTranscript1)):
- *     package fset0
- *       EXEC_i_I
- *       (Exec_i_E i)
- *     :=
- *     [package
- *         #def #[ Exec i ] (v : 'bool) : 'public
- *         {
- *           #import {sig #[ INIT ] : 'unit → 'public_key} as Init ;;
- *           #import {sig #[ CONSTRUCT ] : 'public_keys → 'unit} as Construct ;;
- *           #import {sig #[ VOTE ] : 'bool → 'public} as Vote ;;
- *           #import {sig #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1} as ZKP ;;
- *           pk ← Init Datatypes.tt ;;
- *           x ← sample uniform i_secret ;;
- *           let y := (fto (g ^+ (otf x))) : public in
- *             zkp ← ZKP (y, x) ;;
- *             let m' := setm (setm m j (y, zkp)) i pk in
- *               Construct m' ;;
- *               vote ← Vote v ;;
- *               @ret 'public vote
- *         }
- *     ].
- * 
- *   Module DDHParams <: DDHParams.
- *     Definition Space := Secret.
- *     Definition Space_pos := Secret_pos.
- *   End DDHParams.
- * 
- *   Module DDH := DDH DDHParams GP.
- * 
- *   #[tactic=notac] Equations? Aux (b : bool) (i j : pid) m f':
- *     package DDH.DDH_locs
- *       (DDH.DDH_E :|:
- *          [interface #val #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1]
- *       )
- *       [interface #val #[ Exec i ] : 'bool → 'public]
- *     := Aux b i j m f' :=
- *     [package
- *         #def #[ Exec i ] (v : 'bool) : 'public
- *         {
- *           #import {sig #[ DDH.SAMPLE ] : 'unit → 'public × 'public × 'public} as DDH ;;
- *           #import {sig #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1} as ZKP ;;
- *           abc ← DDH Datatypes.tt ;;
- *           x_i ← get DDH.secret_loc1 ;;
- *           x_j ← get DDH.secret_loc2 ;;
- *           let '(y_i, (y_j, c)) := abc in
- *           let y_j' := fto (g ^+ ((finv f') x_j)) in
- *             zkp1 ← ZKP (y_i, x_i) ;;
- *             zkp2 ← ZKP (y_j', (finv f') x_j) ;;
- *             let m' := (setm (setm m j (y_j', zkp2)) i (y_i, zkp1)) in
- *             #assert (size (domm m') == n) ;;
- *               @ret 'public (fto ((otf c) *  g ^+ (if b then v else (negb v))))
- *         }
- *     ].
- *   Proof.
- *     ssprove_valid.
- *     all: rewrite in_fsetU.
- *     all: apply /orP.
- *     {
- *       left.
- *       unfold DDH.DDH_E.
- *       rewrite fset_cons -fset0E fsetU0.
- *       by apply /fset1P.
- *     }
- *     {
- *       right.
- *       rewrite fset_cons -fset0E fsetU0.
- *       by apply /fset1P.
- *     }
- *     {
- *       right.
- *       rewrite fset_cons -fset0E fsetU0.
- *       by apply /fset1P.
- *     }
- *   Qed.
- * 
- *   Module RO1 := Sigma1.Sigma.Oracle.
- *   Module RO2 := Sigma2.Oracle.
- * 
- *   Definition combined_locations :=
- *     (Sigma1.MyAlg.Sigma_locs :|: RO1.RO_locs).
- * 
- *   Equations? Exec_i_realised b m (i j : pid) : package (P_i_locs i :|: combined_locations) [interface] (Exec_i_E i) :=
- *     Exec_i_realised b m i j :=
- *       {package (Exec_i i j m) ∘ (par ((P_i i b) ∘ (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO))
- *                                       (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO))}.
- *   Proof.
- *     ssprove_valid.
- *     10: apply fsub0set.
- *     8:{ rewrite fsetUid. apply fsubsetxx. }
- *     9: apply fsubsetxx.
- *     7:{ erewrite fsetUid. apply fsubsetxx. }
- *     4: apply fsubsetUr.
- *     3: apply fsubsetUl.
- *     all: unfold combined_locations.
- *     - apply fsubsetUl.
- *     - apply fsubsetUr.
- *     - eapply fsubset_trans. 2: eapply fsubsetUr.
- *       apply fsubsetUl.
- *     - eapply fsubset_trans. 2: eapply fsubsetUr.
- *       apply fsubsetUr.
- *     - unfold EXEC_i_I, P_i_E, Sigma1_I.
- *       rewrite !fset_cons.
- *       rewrite -!fsetUA.
- *       repeat apply fsetUS.
- *       rewrite -fset0E fsetU0 fset0U.
- *       apply fsubsetUr.
- *   Qed.
- * 
- * 
- *   Lemma loc_helper_commit i:
- *     Sigma1.MyAlg.commit_loc \in P_i_locs i :|: combined_locations.
- *   Proof.
- *     unfold combined_locations.
- *     unfold Sigma1.MyAlg.Sigma_locs.
- *     rewrite in_fsetU.
- *     apply /orP ; right.
- *     rewrite fset_cons.
- *     rewrite in_fsetU.
- *     apply /orP ; left.
- *     rewrite in_fsetU1.
- *     apply /orP ; left.
- *     done.
- *   Qed.
- * 
- *   Lemma loc_helper_queries i:
- *     RO1.queries_loc \in P_i_locs i :|: combined_locations.
- *   Proof.
- *     unfold combined_locations.
- *     unfold RO1.RO_locs.
- *     rewrite in_fsetU.
- *     apply /orP ; right.
- *     rewrite fset_cons.
- *     rewrite in_fsetU.
- *     apply /orP ; right.
- *     rewrite in_fsetU1.
- *     apply /orP ; left.
- *     done.
- *   Qed.
- * 
- *   Lemma loc_helper_skey i:
- *     skey_loc i \in P_i_locs i :|: combined_locations.
- *   Proof.
- *     unfold P_i_locs.
- *     rewrite in_fsetU.
- *     apply /orP ; left.
- *     rewrite fset_cons.
- *     rewrite in_fsetU1.
- *     apply /orP ; left.
- *     done.
- *   Qed.
- * 
- *   Lemma loc_helper_ckey i:
- *     ckey_loc i \in P_i_locs i :|: combined_locations.
- *   Proof.
- *     unfold P_i_locs.
- *     rewrite in_fsetU.
- *     apply /orP ; left.
- *     rewrite !fset_cons.
- *     rewrite in_fsetU1.
- *     apply /orP ; right.
- *     rewrite in_fsetU1.
- *     apply /orP ; left.
- *     done.
- *   Qed.
- * 
- *   #[local] Hint Resolve loc_helper_commit : loc_db.
- *   #[local] Hint Resolve loc_helper_queries : loc_db.
- *   #[local] Hint Resolve loc_helper_skey: loc_db.
- *   #[local] Hint Resolve loc_helper_ckey: loc_db.
- * 
- *   #[program] Definition Exec_i_realised_code m (i j : pid) (vote : 'bool):
- *     code (P_i_locs i :|: combined_locations) [interface] 'public :=
- *     {code
- *      x ← sample uniform i_secret ;;
- *      #put skey_loc i := x ;;
- *      #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x)))) (otf x) ;;
- *      x1 ← sample uniform Sigma1.MyAlg.i_witness ;;
- *      #put Sigma1.MyAlg.commit_loc := x1 ;;
- *      #put RO1.queries_loc := emptym ;;
- *      x2 ← get RO1.queries_loc ;;
- *      match x2 (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)))) with
- *      | Some a =>
- *          v ← get Sigma1.MyAlg.commit_loc ;;
- *          x3 ← sample uniform i_secret ;;
- *          #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x3)))) (otf x3) ;;
- *          x5 ← sample uniform Sigma1.MyAlg.i_witness ;;
- *          #put Sigma1.MyAlg.commit_loc := x5 ;;
- *          #put RO1.queries_loc := emptym ;;
- *          v0 ← get RO1.queries_loc ;;
- *          match v0 (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) with
- *          | Some a0 =>
- *              x6 ← get Sigma1.MyAlg.commit_loc ;;
- *              let x4 :=
- *              (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3))))
- *              in
- *          #assert eqn
- *                     (size
- *                        (domm (T:=[ordType of 'I_#|'I_n|]) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|))
- *                           (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
- *                              (fto (expgn_rec (T:=gT) g (otf x)),
- *                              (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;;
- *           #put ckey_loc i := fto
- *                               (compute_key
- *                                  (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
- *                                     (fto (expgn_rec (T:=gT) g (otf x)),
- *                                     (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a,
- *                                     fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;;
- *          v0 ← get skey_loc i ;;
- *          v1 ← get ckey_loc i ;;
- *          @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote))
- *          | None =>
- *              a0 ← sample uniform RO1.i_random ;;
- *              #put RO1.queries_loc := setm v0
- *                                       (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) a0 ;;
- *              x6 ← get Sigma1.MyAlg.commit_loc ;;
- *              let x4 := (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in
- *          #assert eqn
- *                     (size
- *                        (domm (T:=[ordType of 'I_#|'I_n|]) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|))
- *                           (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
- *                              (fto (expgn_rec (T:=gT) g (otf x)),
- *                              (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;;
- *           #put ckey_loc i := fto
- *                               (compute_key
- *                                  (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
- *                                     (fto (expgn_rec (T:=gT) g (otf x)),
- *                                     (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a,
- *                                     fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;;
- *          v0 ← get skey_loc i ;;
- *          v1 ← get ckey_loc i ;;
- *          @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote))
- *          end
- *      | None =>
- *          a ← sample uniform RO1.i_random ;;
- *          #put RO1.queries_loc := setm x2
- *                                   (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)))) a ;;
- *          v ← get Sigma1.MyAlg.commit_loc ;;
- *          x3 ← sample uniform i_secret ;;
- *          #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x3)))) (otf x3) ;;
- *          x5 ← sample uniform Sigma1.MyAlg.i_witness ;;
- *          #put Sigma1.MyAlg.commit_loc := x5 ;;
- *          #put RO1.queries_loc := emptym ;;
- *          v0 ← get RO1.queries_loc ;;
- *          match v0 (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) with
- *          | Some a0 =>
- *              x6 ← get Sigma1.MyAlg.commit_loc ;;
- *              let x4 := (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in
- *              #assert eqn
- *                  (size
- *                  (domm (T:=[ordType of 'I_#|'I_n|]) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|))
- *                          (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
- *                              (fto (expgn_rec (T:=gT) g (otf x)),
- *                                  (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;;
- *              #put ckey_loc i := fto
- *                                  (compute_key
- *                                      (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
- *                                              (fto (expgn_rec (T:=gT) g (otf x)),
- *                                              (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a,
- *                                                  fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;;
- *             v0 ← get skey_loc i ;;
- *             v1 ← get ckey_loc i ;;
- *             @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote))
- *         | None =>
- *                    a0 ← sample uniform RO1.i_random ;;
- *                    #put RO1.queries_loc := setm v0
- *                                             (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) a0 ;;
- *                    x6 ← get Sigma1.MyAlg.commit_loc ;;
- *                    let x4 := (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in
- *          #assert eqn
- *                     (size
- *                        (domm (T:=[ordType of 'I_#|'I_n|]) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|))
- *                           (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
- *                              (fto (expgn_rec (T:=gT) g (otf x)),
- *                              (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;;
- *           #put ckey_loc i := fto
- *                               (compute_key
- *                                  (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
- *                                     (fto (expgn_rec (T:=gT) g (otf x)),
- *                                     (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a,
- *                                     fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;;
- *          v0 ← get skey_loc i ;;
- *          v1 ← get ckey_loc i ;;
- *          @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote))
- *                end
- *      end
- *     }.
- *   Next Obligation.
- *     intros.
- *     ssprove_valid ; auto with loc_db.
- *     destruct (v1 _) ; ssprove_valid ; auto with loc_db.
- *     - destruct (v5 _) ; ssprove_valid ; auto with loc_db.
- *     - destruct (v6 _) ; ssprove_valid ; auto with loc_db.
- *   Qed.
- * 
- *   #[program] Definition Exec_i_realised_code_runnable m (i j : pid) (vote : 'bool):
- *     code (P_i_locs i :|: combined_locations) [interface] 'public :=
- *     {code
- *      x ← sample uniform i_secret ;;
- *      #put skey_loc i := x ;;
- *      #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x)))) (otf x) ;;
- *      x1 ← sample uniform Sigma1.MyAlg.i_witness ;;
- *      #put Sigma1.MyAlg.commit_loc := x1 ;;
- *      x2 ← get RO1.queries_loc ;;
- *          a ← sample uniform RO1.i_random ;;
- *          #put RO1.queries_loc := setm x2
- *                                   (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)))) a ;;
- *          v ← get Sigma1.MyAlg.commit_loc ;;
- *          x3 ← sample uniform i_secret ;;
- *          #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x3)))) (otf x3) ;;
- *          x5 ← sample uniform Sigma1.MyAlg.i_witness ;;
- *          #put Sigma1.MyAlg.commit_loc := x5 ;;
- *          v0 ← get RO1.queries_loc ;;
- *                    a0 ← sample uniform RO1.i_random ;;
- *                    #put RO1.queries_loc := setm v0
- *                                             (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) a0 ;;
- *                    x6 ← get Sigma1.MyAlg.commit_loc ;;
- *                    let x4 := (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in
- *          #assert eqn
- *                     (size
- *                        (domm (T:=[ordType of 'I_#|'I_n|]) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|))
- *                           (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
- *                              (fto (expgn_rec (T:=gT) g (otf x)),
- *                              (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;;
- *           #put ckey_loc i := fto
- *                               (compute_key
- *                                  (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
- *                                     (fto (expgn_rec (T:=gT) g (otf x)),
- *                                     (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a,
- *                                     fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;;
- *          v0 ← get skey_loc i ;;
- *          v1 ← get ckey_loc i ;;
- *          @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote))
- *     }.
- *   Next Obligation.
- *     intros.
- *     ssprove_valid ; auto with loc_db.
- *   Qed.
- * 
- *   Lemma code_pkg_equiv m i j (vote : 'bool):
- *     ⊢
- *     ⦃ λ '(h₀, h₁), h₀ = h₁ ⦄
- *     get_op_default (Exec_i_realised true m i j) ((Exec i), ('bool, 'public)) vote
- *     ≈
- *     Exec_i_realised_code m i j vote
- *     ⦃ eq ⦄.
- *   Proof.
- *     unfold Exec_i_realised.
- *     rewrite get_op_default_link.
- *     erewrite get_op_default_spec.
- *     2: {
- *       cbn.
- *       rewrite eqnE eq_refl.
- *       done.
- *     }
- *     ssprove_code_simpl.
- *     simpl.
- *     repeat choice_type_eqP_handle.
- *     rewrite !cast_fun_K.
- *     ssprove_code_simpl.
- *     simpl.
- *     ssprove_code_simpl.
- *     ssprove_code_simpl_more.
- *     simpl.
- *     ssprove_sync_eq=>x.
- *     simpl.
- *     ssprove_code_simpl_more.
- *     ssprove_sync_eq.
- *     ssprove_sync_eq=>rel1.
- *     ssprove_sync_eq=>r1.
- *     ssprove_sync_eq.
- *     ssprove_code_simpl.
- * 
- *     ssprove_contract_put_get_lhs.
- *     ssprove_contract_put_get_rhs.
- * 
- *     ssprove_sync_eq.
- *     simpl.
- * 
- *     ssprove_code_simpl.
- *     ssprove_sync_eq=>a.
- *     ssprove_sync_eq.
- *     ssprove_sync_eq=>v.
- * 
- *     apply r_uniform_bij with (f := (fun (x : Arit (@uniform i_secret Sigma1.MyParam.Witness_pos)) => (x : Arit (@uniform i_secret Secret_pos)))).
- *     1: exact (inv_bij (fun x => erefl)).
- *     intros.
- * 
- *     match goal with
- *     | |- context [⊢ ⦃ _ ⦄ bind (assertD ?v ?z) ?y ≈ ?x  ⦃ _ ⦄] =>
- *         set (temp1 := x) ; set (temp2 := y) ;
- *         set (temp3 := z) ; set (temp4 := v) in *
- *     end.
- * 
- *     apply (r_transL  (@assertD _ temp4 (fun z => x ← temp3 z ;; temp2 x))).
- *     1:{
- *       eapply r_transR.
- *       1:{
- *         apply r_bind_assertD_sym.
- *       }
- *       apply rreflexivity_rule.
- *     }
- *     subst temp1 temp2 temp3 temp4.
- *     
- *     apply (@r_assertD_same (chFin (mkpos #|gT|)) _).
- *     intros.
- * 
- *     simpl.
- *     ssprove_sync_eq=>a0.
- *     ssprove_sync_eq.
- * 
- *     ssprove_contract_put_get_lhs.
- *     ssprove_contract_put_get_rhs.
- *     
- *     ssprove_sync_eq.
- *     simpl.
- * 
- *     ssprove_sync_eq=>a1.
- *     ssprove_sync_eq.
- *     ssprove_sync_eq=>a2.
- * 
- *     match goal with
- *     | |- context [⊢ ⦃ _ ⦄ bind (assertD ?v ?z) ?y ≈ ?x  ⦃ _ ⦄] =>
- *         set (temp1 := x) ; set (temp2 := y) ;
- *         set (temp3 := z) ; set (temp4 := v) in *
- *     end.
- *     
- *     apply (r_transL  (@assertD _ temp4 (fun z => x ← temp3 z ;; temp2 x))).
- *     1:{
- *       eapply r_transR.
- *       1:{
- *         apply r_bind_assertD_sym.
- *       }
- *       apply rreflexivity_rule.
- *     }
- *     subst temp1 temp2 temp3 temp4. hnf.
- * 
- *     apply r_assertD_same.
- *     intros.
- * 
- *     ssprove_sync_eq.
- *     ssprove_sync_eq=>a3.
- *     ssprove_sync_eq=>a4.
- *     apply r_ret.
- *     intros. subst.
- *     reflexivity.
- *   Qed.
- * 
- *   #[tactic=notac] Equations? Aux_realised (b : bool) (i j : pid) m f' :
- *     package (DDH.DDH_locs :|: P_i_locs i :|: combined_locations) Game_import [interface #val #[ Exec i ] : 'bool → 'public] :=
- *     Aux_realised b i j m f' := {package Aux b i j m f' ∘ (par DDH.DDH_real (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) }.
- *   Proof.
- *     ssprove_valid.
- *     4:{ rewrite fsetUid. rewrite -fset0E. apply fsub0set. }
- *     6: apply fsubsetxx.
- *     3:{ rewrite -fsetUA. apply fsubsetxx. }
- *     4:{ rewrite -fsetUA. apply fsubsetUl. }
- *     all: unfold combined_locations.
- *     - eapply fsubset_trans. 2: apply fsubsetUr.
- *       apply fsubsetUl.
- *     - eapply fsubset_trans. 2: apply fsubsetUr.
- *       apply fsubsetUr.
- *     - unfold DDH.DDH_E.
- *       apply fsetUS.
- *       rewrite !fset_cons.
- *       apply fsubsetUr.
- *   Qed.
- * 
- *   #[tactic=notac] Equations? Aux_ideal_realised (b : bool) (i j : pid) m f' :
- *     package (DDH.DDH_locs :|: P_i_locs i :|: combined_locations) Game_import [interface #val #[ Exec i ] : 'bool → 'public] :=
- *     Aux_ideal_realised b i j m f' := {package Aux b i j m f' ∘ (par DDH.DDH_ideal (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) }.
- *   Proof.
- *     ssprove_valid.
- *     4:{ rewrite fsetUid. rewrite -fset0E. apply fsub0set. }
- *     6: apply fsubsetxx.
- *     3:{ rewrite -fsetUA. apply fsubsetxx. }
- *     4:{ rewrite -fsetUA. apply fsubsetUl. }
- *     all: unfold combined_locations.
- *     - eapply fsubset_trans. 2: apply fsubsetUr.
- *       apply fsubsetUl.
- *     - eapply fsubset_trans. 2: apply fsubsetUr.
- *       apply fsubsetUr.
- *     - unfold DDH.DDH_E.
- *       apply fsetUS.
- *       rewrite !fset_cons.
- *       apply fsubsetUr.
- *   Qed.
- * 
- *   Notation inv i := (heap_ignore (P_i_locs i :|: DDH.DDH_locs)).
- * 
- *   #[local] Hint Extern 50 (_ = code_link _ _) =>
- *     rewrite code_link_scheme
- *     : ssprove_code_simpl.
- * 
- *   (** We extend swapping to schemes.
- *     This means that the ssprove_swap tactic will be able to swap any command
- *     with a scheme without asking a proof from the user.
- *   *)
- *   #[local] Hint Extern 40 (⊢ ⦃ _ ⦄ x ← ?s ;; y ← cmd _ ;; _ ≈ _ ⦃ _ ⦄) =>
- *     eapply r_swap_scheme_cmd ; ssprove_valid
- *     : ssprove_swap.
- * 
- *   Lemma P_i_aux_equiv (i j : pid) m:
- *     fdisjoint Sigma1.MyAlg.Sigma_locs DDH.DDH_locs →
- *     i != j →
- *     (∃ f,
- *       bijective f ∧
- *       (∀ b, (Exec_i_realised b m i j) ≈₀ Aux_realised b i j m f)).
- *   Proof.
- *     intros Hdisj ij_neq.
- *     have [f' Hf] := test_bij' i j m ij_neq.
- *     simpl in Hf.
- *     exists f'.
- *     split.
- *     {
- *       assert ('I_#|'Z_#[g]|) as x.
- *       { rewrite card_ord.
- *         eapply Ordinal.
- *         rewrite ltnS.
- *         apply ltnSn.
- *       }
- *       specialize (Hf x).
- *       destruct Hf.
- *       assumption.
- *     }
- *     intro b.
- *     eapply eq_rel_perf_ind with (inv := inv i).
- *     {
- *       ssprove_invariant.
- *       rewrite -!fsetUA.
- *       apply fsetUS.
- *       do 2 (apply fsubsetU ; apply /orP ; right).
- *       apply fsubsetUl.
- *     }
- *     simplify_eq_rel v.
- *     rewrite !setmE.
- *     rewrite !eq_refl.
- *     ssprove_code_simpl.
- *     repeat simplify_linking.
- *     ssprove_sync => x_i.
- * 
- *     rewrite !cast_fun_K.
- *     ssprove_code_simpl.
- *     ssprove_code_simpl_more.
- *     
- *     ssprove_swap_seq_rhs [:: 4 ; 5 ; 6 ; 7]%N.
- *     ssprove_swap_seq_rhs [:: 2 ; 3 ; 4 ; 5 ; 6]%N.
- *     ssprove_swap_seq_rhs [:: 0 ; 1 ; 2 ; 3 ; 4 ; 5]%N.
- *     ssprove_contract_put_get_rhs.
- *     apply r_put_rhs.
- *     ssprove_swap_seq_lhs [:: 0 ; 1 ; 2 ; 3]%N.
- *     unfold Sigma1.MyParam.R.
- *     have Hord : ∀ x, (nat_of_ord x) = (nat_of_ord (otf x)).
- *     {
- *       unfold otf.
- *       intros n x.
- *       rewrite enum_val_ord.
- *       done.
- *     }
- *     rewrite -Hord otf_fto eq_refl.
- *     simpl.
- *     ssprove_sync => r_i.
- *     apply r_put_vs_put.
- *     ssprove_restore_pre.
- *     { ssprove_invariant.
- *       apply preserve_update_r_ignored_heap_ignore.
- *       - unfold DDH.DDH_locs.
- *         rewrite in_fsetU.
- *         apply /orP ; right.
- *         rewrite fset_cons.
- *         rewrite in_fsetU.
- *         apply /orP ; left.
- *         by apply /fset1P.
- *       - apply preserve_update_mem_nil.
- *     }
- *     ssprove_sync.
- *     ssprove_swap_seq_lhs [:: 0 ]%N.
- *     ssprove_swap_seq_rhs [:: 2 ; 1 ; 0]%N.
- *     ssprove_sync => queries.
- *     destruct (queries (Sigma1.Sigma.prod_assoc (fto (g ^+ x_i), fto (g ^+ otf r_i)))) eqn:e.
- *     all: rewrite e; simpl.
- *     all: ssprove_code_simpl_more.
- *     - ssprove_swap_seq_lhs [:: 0 ; 1 ; 2 ; 3 ; 4 ; 5]%N.
- *       ssprove_swap_seq_lhs [:: 0 ; 1 ]%N.
- *       eapply r_uniform_bij.
- *       { apply Hf.
- *         + rewrite card_ord.
- *           rewrite Zp_cast.
- *           2: apply (prime_gt1 prime_order).
- *           eapply Ordinal.
- *           apply (prime_gt1 prime_order).
- *       }
- *       intro x.
- *       specialize (Hf x).
- *       destruct Hf as [bij_f Hf].
- *       apply bij_inj in bij_f.
- *       apply finv_f in bij_f.
- *       ssprove_contract_put_get_rhs.
- *       rewrite bij_f.
- *       rewrite -Hord !otf_fto !eq_refl.
- *       simpl.
- *       apply r_put_rhs.
- *       ssprove_restore_pre.
- *       {
- *         apply preserve_update_r_ignored_heap_ignore.
- *         - unfold DDH.DDH_locs.
- *           rewrite !fset_cons.
- *           rewrite !in_fsetU.
- *           apply /orP ; right.
- *           apply /orP ; right.
- *           apply /orP ; left.
- *           by apply /fset1P.
- *         - apply preserve_update_mem_nil.
- *       }
- *       apply r_get_remember_lhs.
- *       intros ?.
- *       apply r_get_remember_rhs.
- *       intros ?.
- *       ssprove_forget_all.
- *       ssprove_sync=>r_j.
- *       apply r_put_vs_put.
- *       ssprove_restore_pre.
- *       1: ssprove_invariant.
- *       clear e queries.
- *       ssprove_sync.
- *       ssprove_swap_seq_lhs [:: 0]%N.
- *       ssprove_sync=>queries.
- *       destruct (queries (Sigma1.Sigma.prod_assoc (fto (g ^+ x), fto (g ^+ otf r_j)))) eqn:e.
- *       all: rewrite e.
- *       all: ssprove_code_simpl.
- *       all: ssprove_code_simpl_more.
- *       + ssprove_swap_seq_lhs [:: 0 ; 1]%N.
- *         simpl.
- *         apply r_get_remember_lhs.
- *         intros ?.
- *         apply r_get_remember_rhs.
- *         intros ?.
- *         ssprove_forget_all.
- *         apply r_assertD.
- *         {
- *           intros ??.
- *           rewrite !domm_set.
- *           done.
- *         }
- *         intros _ _.
- *         ssprove_swap_lhs 1%N.
- *         {
- *           move: H0 => /eqP.
- *           erewrite eqn_add2r.
- *           intros contra.
- *           discriminate.
- *         }
- *         ssprove_contract_put_get_lhs.
- *         apply r_put_lhs.
- *         ssprove_contract_put_get_lhs.
- *         apply r_put_lhs.
- *         ssprove_restore_pre.
- *         {
- *           repeat apply preserve_update_l_ignored_heap_ignore.
- *           1,2: unfold P_i_locs ; rewrite in_fsetU.
- *           1,2: apply /orP ; left ; rewrite !fset_cons ;
- *                rewrite -fset0E fsetU0 ; rewrite in_fsetU.
- *           - apply /orP ; right.
- *             by apply /fset1P.
- *           - apply /orP ; left.
- *             by apply /fset1P.
- *           - apply preserve_update_mem_nil.
- *         }
- *         rewrite otf_fto.
- *         rewrite compute_key_set_i.
- *         set zk := (fto (g ^+ x), fto (g ^+ otf r_j), s1, fto (otf x2 + otf s1 * otf x)).
- *         clearbody zk.
- *         specialize (Hf zk).
- *         rewrite !Hord.
- *         rewrite Hf.
- *         rewrite -!Hord.
- *         rewrite -expgM.
- *         rewrite mulnC.
- *         case b; apply r_ret ; done.
- *       + ssprove_swap_seq_lhs [:: 0 ; 1 ; 2 ; 3]%N.
- *         simpl.
- *         ssprove_sync=>e_j.
- *         apply r_put_vs_put.
- *         apply r_get_remember_lhs.
- *         intros ?.
- *         apply r_get_remember_rhs.
- *         intros ?.
- *         ssprove_forget_all.
- *         apply r_assertD.
- *         {
- *           intros ??.
- *           rewrite !domm_set.
- *           done.
- *         }
- *         intros _ _.
- *         ssprove_swap_lhs 1%N.
- *         {
- *           move: H0 => /eqP.
- *           erewrite eqn_add2r.
- *           intros contra.
- *           discriminate.
- *         }
- *         ssprove_contract_put_get_lhs.
- *         apply r_put_lhs.
- *         ssprove_contract_put_get_lhs.
- *         apply r_put_lhs.
- *         ssprove_restore_pre.
- *         {
- *           repeat apply preserve_update_l_ignored_heap_ignore.
- *           1,2: unfold P_i_locs ; rewrite in_fsetU.
- *           1,2: apply /orP ; left ; rewrite !fset_cons ;
- *                rewrite -fset0E fsetU0 ; rewrite in_fsetU.
- *           - apply /orP ; right.
- *             by apply /fset1P.
- *           - apply /orP ; left.
- *             by apply /fset1P.
- *           - ssprove_invariant.
- *         }
- *         rewrite otf_fto.
- *         rewrite compute_key_set_i.
- *         set zk := (fto (g ^+ x), fto (g ^+ otf r_j), e_j, fto (otf x2 + otf e_j * otf x)).
- *         clearbody zk.
- *         specialize (Hf zk).
- *         rewrite !Hord.
- *         rewrite Hf.
- *         rewrite -!Hord.
- *         rewrite -expgM.
- *         rewrite mulnC.
- *         case b; apply r_ret ; done.
- *     - ssprove_swap_seq_lhs [:: 0 ; 1 ; 2 ; 3 ; 4 ; 5  ; 6 ; 7]%N.
- *       ssprove_swap_seq_lhs [:: 2 ; 1 ; 0 ]%N.
- *       eapply r_uniform_bij.
- *       { apply Hf.
- *         + rewrite card_ord.
- *           rewrite Zp_cast.
- *           2: apply (prime_gt1 prime_order).
- *           eapply Ordinal.
- *           apply (prime_gt1 prime_order).
- *       }
- *       intro x.
- *       specialize (Hf x).
- *       destruct Hf as [bij_f Hf].
- *       apply bij_inj in bij_f.
- *       apply finv_f in bij_f.
- *       ssprove_contract_put_get_rhs.
- *       rewrite bij_f.
- *       rewrite -Hord !otf_fto !eq_refl.
- *       simpl.
- *       apply r_put_rhs.
- *       ssprove_restore_pre.
- *       {
- *         apply preserve_update_r_ignored_heap_ignore.
- *         - unfold DDH.DDH_locs.
- *           rewrite !fset_cons.
- *           rewrite !in_fsetU.
- *           apply /orP ; right.
- *           apply /orP ; right.
- *           apply /orP ; left.
- *           by apply /fset1P.
- *         - apply preserve_update_mem_nil.
- *       }
- *       ssprove_sync=>e_i.
- *       apply r_put_vs_put.
- *       apply r_get_remember_lhs.
- *       intros ?.
- *       apply r_get_remember_rhs.
- *       intros ?.
- *       ssprove_forget_all.
- *       rewrite -Hord eq_refl.
- *       simpl.
- *       ssprove_sync=>r_j.
- *       apply r_put_vs_put.
- *       ssprove_restore_pre.
- *       1: ssprove_invariant.
- *       clear e queries.
- *       ssprove_sync.
- *       ssprove_swap_seq_lhs [:: 0]%N.
- *       ssprove_sync=>queries.
- *       destruct (queries (Sigma1.Sigma.prod_assoc (fto (g ^+ x), fto (g ^+ otf r_j)))) eqn:e.
- *       all: rewrite e.
- *       all: ssprove_code_simpl.
- *       all: ssprove_code_simpl_more.
- *       + ssprove_swap_seq_lhs [:: 0 ; 1]%N.
- *         simpl.
- *         apply r_get_remember_lhs.
- *         intros ?.
- *         apply r_get_remember_rhs.
- *         intros ?.
- *         ssprove_forget_all.
- *         apply r_assertD.
- *         {
- *           intros ??.
- *           rewrite !domm_set.
- *           done.
- *         }
- *         intros _ _.
- *         ssprove_swap_lhs 1%N.
- *         {
- *           move: H0 => /eqP.
- *           erewrite eqn_add2r.
- *           intros contra.
- *           discriminate.
- *         }
- *         ssprove_contract_put_get_lhs.
- *         apply r_put_lhs.
- *         ssprove_contract_put_get_lhs.
- *         apply r_put_lhs.
- *         ssprove_restore_pre.
- *         {
- *           repeat apply preserve_update_l_ignored_heap_ignore.
- *           1,2: unfold P_i_locs ; rewrite in_fsetU.
- *           1,2: apply /orP ; left ; rewrite !fset_cons ;
- *                rewrite -fset0E fsetU0 ; rewrite in_fsetU.
- *           - apply /orP ; right.
- *             by apply /fset1P.
- *           - apply /orP ; left.
- *             by apply /fset1P.
- *           - apply preserve_update_mem_nil.
- *         }
- *         rewrite otf_fto.
- *         rewrite compute_key_set_i.
- *         set zk := (fto (g ^+ x), fto (g ^+ otf r_j), s, fto (otf x2 + otf s * otf x)).
- *         clearbody zk.
- *         specialize (Hf zk).
- *         rewrite !Hord.
- *         rewrite Hf.
- *         rewrite -!Hord.
- *         rewrite -expgM.
- *         rewrite mulnC.
- *         case b; apply r_ret ; done.
- *       + ssprove_swap_seq_lhs [:: 0 ; 1 ; 2 ; 3]%N.
- *         simpl.
- *         ssprove_sync=>e_j.
- *         apply r_put_vs_put.
- *         apply r_get_remember_lhs.
- *         intros ?.
- *         apply r_get_remember_rhs.
- *         intros ?.
- *         ssprove_forget_all.
- *         apply r_assertD.
- *         {
- *           intros ??.
- *           rewrite !domm_set.
- *           done.
- *         }
- *         intros _ _.
- *         ssprove_swap_lhs 1%N.
- *         {
- *           move: H0 => /eqP.
- *           erewrite eqn_add2r.
- *           intros contra.
- *           discriminate.
- *         }
- *         ssprove_contract_put_get_lhs.
- *         apply r_put_lhs.
- *         ssprove_contract_put_get_lhs.
- *         apply r_put_lhs.
- *         ssprove_restore_pre.
- *         {
- *           repeat apply preserve_update_l_ignored_heap_ignore.
- *           1,2: unfold P_i_locs ; rewrite in_fsetU.
- *           1,2: apply /orP ; left ; rewrite !fset_cons ;
- *                rewrite -fset0E fsetU0 ; rewrite in_fsetU.
- *           - apply /orP ; right.
- *             by apply /fset1P.
- *           - apply /orP ; left.
- *             by apply /fset1P.
- *           - ssprove_invariant.
- *         }
- *         rewrite otf_fto.
- *         rewrite compute_key_set_i.
- *         set zk := (fto (g ^+ x), fto (g ^+ otf r_j), e_j, fto (otf x2 + otf e_j * otf x)).
- *         clearbody zk.
- *         specialize (Hf zk).
- *         rewrite !Hord.
- *         rewrite Hf.
- *         rewrite -!Hord.
- *         rewrite -expgM.
- *         rewrite mulnC.
- *         case b; apply r_ret ; done.
- *   Qed.
- * 
- *   Lemma Hord (x : secret): (nat_of_ord x) = (nat_of_ord (otf x)).
- *   Proof.
- *       unfold otf.
- *       rewrite enum_val_ord.
- *       done.
- *   Qed.
- * 
- *   Lemma vote_hiding_bij (c : secret) (v : bool):
- *     fto (otf (fto (g ^+ c)) * g ^+ v) =
- *       fto
- *         (otf (fto (g ^+ (if v then fto (Zp_add (otf c) Zp1) else fto (Zp_add (otf c) (Zp_opp Zp1))))) *
- *            g ^+ (~~ v)).
- *   Proof.
- *     f_equal.
- *     rewrite !otf_fto.
- *     rewrite -!expgD.
- *     have h' : ∀ (x : Secret), nat_of_ord x = (nat_of_ord (fto x)).
- *     {
- *         unfold fto.
- *         intros k.
- *         rewrite enum_rank_ord.
- *         done.
- *     }
- *     case v.
- *     ++ apply /eqP.
- *        rewrite eq_expg_mod_order.
- *        rewrite addn0.
- *        have h : ∀ (x : secret), (((nat_of_ord x) + 1) %% q'.+2)%N = (nat_of_ord (Zp_add (otf x) Zp1)).
- *        {
- *          intro k.
- *          unfold Zp_add.
- *          simpl.
- *          rewrite -Hord.
- *          apply /eqP.
- *          rewrite eq_sym.
- *          apply /eqP.
- *          rewrite -> Zp_cast at 2.
- *          2: apply (prime_gt1 prime_order).
- *          rewrite -> Zp_cast at 1.
- *          2: apply (prime_gt1 prime_order).
- *          rewrite modnDmr.
- *          rewrite Fp_cast.
- *          2: apply prime_order.
- *          reflexivity.
- *        }
- *        rewrite -h'.
- *        rewrite -h.
- *        rewrite -modn_mod.
- *        rewrite Fp_cast.
- *        2: apply prime_order.
- *        1: apply eq_refl.
- *     ++ apply /eqP.
- *        rewrite eq_expg_mod_order.
- *        rewrite addn0.
- *        unfold Zp_add, Zp_opp, Zp1.
- *        simpl.
- *        repeat rewrite -> Zp_cast at 12.
- *        2-4: apply (prime_gt1 prime_order).
- *        rewrite -!Hord.
- *        have -> : (#[g] - 1 %% #[g])%N = #[g].-1.
- *        { rewrite modn_small.
- *          2: apply (prime_gt1 prime_order).
- *          by rewrite -subn1.
- *        }
- *        rewrite modn_small.
- *        2:{
- *          destruct c as [c Hc].
- *          move: Hc.
- *          simpl.
- *          unfold DDH.i_space, DDHParams.Space, Secret.
- *          rewrite card_ord.
- *          rewrite Zp_cast.
- *          2: apply (prime_gt1 prime_order).
- *          done.
- *        }
- *        have -> : (#[g].-1 %% #[g])%N = #[g].-1.
- *        {
- *          rewrite modn_small.
- *          1: reflexivity.
- *          apply ltnSE.
- *          rewrite -subn1 -2!addn1.
- *          rewrite subnK.
- *          2: apply (prime_gt0 prime_order).
- *          rewrite addn1.
- *          apply ltnSn.
- *        }
- *        rewrite -h'.
- *        simpl.
- *        rewrite -> Zp_cast at 9.
- *        2: apply (prime_gt1 prime_order).
- *        rewrite modnDml.
- *        rewrite -subn1.
- *        rewrite -addnA.
- *        rewrite subnK.
- *        2: apply (prime_gt0 prime_order).
- *        rewrite -modnDmr.
- *        rewrite modnn.
- *        rewrite addn0.
- *        rewrite modn_small.
- *        1: apply eq_refl.
- *        destruct c as [h Hc].
- *        move: Hc.
- *        unfold DDH.i_space, DDHParams.Space, Secret.
- *        simpl.
- *        rewrite card_ord.
- *        rewrite Zp_cast.
- *        2: apply (prime_gt1 prime_order).
- *        done.
- *   Qed.
- * 
- *   Lemma vote_hiding (i j : pid) m:
- *     i != j →
- *     ∀ LA A ϵ_DDH,
- *       ValidPackage LA [interface #val #[ Exec i ] : 'bool → 'public] A_export A →
- *       fdisjoint Sigma1.MyAlg.Sigma_locs DDH.DDH_locs →
- *       fdisjoint LA DDH.DDH_locs →
- *       fdisjoint LA (P_i_locs i) →
- *       fdisjoint LA combined_locations →
- *       (∀ D, DDH.ϵ_DDH D <= ϵ_DDH) →
- *     AdvantageE (Exec_i_realised true m i j) (Exec_i_realised false m i j) A <= ϵ_DDH + ϵ_DDH.
- *   Proof.
- *     intros ij_neq LA A ϵ_DDH Va Hdisj Hdisj2 Hdisj3 Hdisj4 Dadv.
- *     have [f' [bij_f Hf]] := P_i_aux_equiv i j m Hdisj ij_neq.
- *     ssprove triangle (Exec_i_realised true m i j) [::
- *       (Aux_realised true i j m f').(pack) ;
- *       (Aux true i j m f') ∘ (par DDH.DDH_ideal (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) ;
- *       (Aux false i j m f') ∘ (par DDH.DDH_ideal (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) ;
- *       (Aux_realised false i j m f').(pack)
- *     ] (Exec_i_realised false m i j) A as ineq.
- *     eapply le_trans.
- *     2: {
- *       instantiate (1 := 0 + ϵ_DDH + 0 + ϵ_DDH + 0).
- *       by rewrite ?GRing.addr0 ?GRing.add0r.
- *     }
- *     eapply le_trans. 1: exact ineq.
- *     clear ineq.
- *     repeat eapply ler_add.
- *     {
- *       apply eq_ler.
- *       specialize (Hf true LA A Va).
- *       apply Hf.
- *       - rewrite fdisjointUr.
- *         apply /andP ; split ; assumption.
- *       - rewrite fdisjointUr.
- *         apply /andP ; split.
- *         2: assumption.
- *         rewrite fdisjointUr.
- *         apply /andP ; split ; assumption.
- *     }
- *     {
- *       unfold Aux_realised.
- *       rewrite -Advantage_link.
- *       rewrite par_commut.
- *       have -> : (par DDH.DDH_ideal (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) =
- *                (par (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO) DDH.DDH_ideal).
- *       { apply par_commut. ssprove_valid. }
- *       erewrite Advantage_par.
- *       3: apply DDH.DDH_real.
- *       3: apply DDH.DDH_ideal.
- *       2: {
- *         ssprove_valid.
- *         - eapply fsubsetUr.
- *         - apply fsubsetUl.
- *       }
- *       1: rewrite Advantage_sym ; apply Dadv.
- *       - ssprove_valid.
- *       - unfold trimmed.
- *         rewrite -link_trim_commut.
- *         f_equal.
- *         unfold trim.
- *         rewrite !fset_cons -fset0E fsetU0.
- *         rewrite !filterm_set.
- *         simpl.
- *         rewrite !in_fsetU !in_fset1 !eq_refl.
- *         rewrite filterm0.
- *         done.
- *       - unfold trimmed.
- *         unfold trim.
- *         rewrite !fset_cons -fset0E fsetU0.
- *         rewrite !filterm_set.
- *         simpl.
- *         rewrite !in_fset1 !eq_refl.
- *         rewrite filterm0.
- *         done.
- *       - unfold trimmed.
- *         unfold trim.
- *         rewrite !fset_cons -fset0E fsetU0.
- *         rewrite !filterm_set.
- *         simpl.
- *         rewrite !in_fset1 !eq_refl.
- *         rewrite filterm0.
- *         done.
- *     }
- *     2:{
- *       unfold Aux_realised.
- *       rewrite -Advantage_link.
- *       rewrite par_commut.
- *       have -> : (par DDH.DDH_real (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) =
- *                (par (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO) DDH.DDH_real).
- *       { apply par_commut. ssprove_valid. }
- *       erewrite Advantage_par.
- *       3: apply DDH.DDH_ideal.
- *       3: apply DDH.DDH_real.
- *       2: {
- *         ssprove_valid.
- *         - eapply fsubsetUr.
- *         - apply fsubsetUl.
- *       }
- *       1: apply Dadv.
- *       - ssprove_valid.
- *       - unfold trimmed.
- *         rewrite -link_trim_commut.
- *         f_equal.
- *         unfold trim.
- *         rewrite !fset_cons -fset0E fsetU0.
- *         rewrite !filterm_set.
- *         simpl.
- *         rewrite !in_fsetU !in_fset1 !eq_refl.
- *         rewrite filterm0.
- *         done.
- *       - unfold trimmed.
- *         unfold trim.
- *         unfold DDH.DDH_E.
- *         rewrite !fset_cons -fset0E fsetU0.
- *         rewrite !filterm_set.
- *         simpl.
- *         rewrite !in_fset1 !eq_refl.
- *         rewrite filterm0.
- *         done.
- *       - unfold trimmed.
- *         unfold trim.
- *         unfold DDH.DDH_E.
- *         rewrite !fset_cons -fset0E fsetU0.
- *         rewrite !filterm_set.
- *         simpl.
- *         rewrite !in_fset1 !eq_refl.
- *         rewrite filterm0.
- *         done.
- *     }
- *     2: {
- *       apply eq_ler.
- *       specialize (Hf false LA A Va).
- *       rewrite Advantage_sym.
- *       apply Hf.
- *       - rewrite fdisjointUr.
- *         apply /andP ; split ; assumption.
- *       - rewrite fdisjointUr.
- *         apply /andP ; split.
- *         2: assumption.
- *         rewrite fdisjointUr.
- *         apply /andP ; split ; assumption.
- *     }
- *     apply eq_ler.
- *     eapply eq_rel_perf_ind with (inv := inv i).
- *     5: apply Va.
- *     1,2: apply Aux_ideal_realised.
- *     3: {
- *       rewrite fdisjointUr.
- *       apply /andP ; split.
- *       2: assumption.
- *       rewrite fdisjointUr.
- *       apply /andP ; split ; assumption.
- *     }
- *     3: {
- *       rewrite fdisjointUr.
- *       apply /andP ; split.
- *       2: assumption.
- *       rewrite fdisjointUr.
- *       apply /andP ; split ; assumption.
- *     }
- *     {
- *       ssprove_invariant.
- *       rewrite fsetUC.
- *       rewrite -!fsetUA.
- *       apply fsetUS.
- *       apply fsubsetUl.
- *     }
- *     simplify_eq_rel v.
- *     rewrite !setmE.
- *     rewrite !eq_refl.
- *     simpl.
- *     repeat simplify_linking.
- *     rewrite !cast_fun_K.
- *     ssprove_code_simpl.
- *     ssprove_code_simpl_more.
- *     ssprove_sync=>x_i.
- *     ssprove_sync=>x_j.
- *     pose f_v := (fun (x : secret) =>
- *                    if v then
- *                    fto (Zp_add (otf x) Zp1)
- *                    else
- *                    fto (Zp_add (otf x) (Zp_opp Zp1))
- *                 ).
- *     assert (bijective f_v) as bij_fv.
- *     {
- *       exists (fun x =>
- *            if v then
- *              fto (Zp_add (otf x) (Zp_opp Zp1))
- *            else
- *              fto (Zp_add (otf x) Zp1)
- *         ).
- *       - intro x.
- *         unfold f_v.
- *         case v.
- *         + rewrite otf_fto.
- *           rewrite -Zp_addA.
- *           rewrite Zp_addC.
- *           have -> : (Zp_add Zp1 (Zp_opp Zp1)) = (Zp_add (Zp_opp Zp1) Zp1).
- *           { intro n. by rewrite Zp_addC. }
- *           rewrite Zp_addNz.
- *           rewrite Zp_add0z.
- *           by rewrite fto_otf.
- *         + rewrite otf_fto.
- *           rewrite -Zp_addA.
- *           rewrite Zp_addC.
- *           rewrite Zp_addNz.
- *           rewrite Zp_add0z.
- *           by rewrite fto_otf.
- *       - intro x.
- *         unfold f_v.
- *         case v.
- *         + rewrite otf_fto.
- *           rewrite -Zp_addA.
- *           rewrite Zp_addNz.
- *           rewrite Zp_addC.
- *           rewrite Zp_add0z.
- *           by rewrite fto_otf.
- *         + rewrite otf_fto.
- *           rewrite -Zp_addA.
- *           rewrite Zp_addC.
- *           have -> : (Zp_add Zp1 (Zp_opp Zp1)) = (Zp_add (Zp_opp Zp1) Zp1).
- *           { intro n. by rewrite Zp_addC. }
- *           rewrite Zp_addNz.
- *           rewrite Zp_add0z.
- *           by rewrite fto_otf.
- *     }
- *     eapply r_uniform_bij.
- *     1: apply bij_fv.
- *     intro c.
- *     ssprove_swap_seq_rhs [:: 1 ; 2]%N.
- *     ssprove_swap_seq_rhs [:: 0 ]%N.
- *     ssprove_swap_seq_lhs [:: 1 ; 2]%N.
- *     ssprove_swap_seq_lhs [:: 0 ]%N.
- *     apply r_put_vs_put.
- *     ssprove_contract_put_get_lhs.
- *     ssprove_contract_put_get_rhs.
- *     apply r_put_vs_put.
- *     ssprove_contract_put_get_lhs.
- *     ssprove_contract_put_get_rhs.
- *     apply r_put_vs_put.
- *     unfold Sigma1.MyParam.R.
- *     rewrite -Hord otf_fto eq_refl.
- *     simpl.
- *     ssprove_sync=>r_i.
- *     apply r_put_vs_put.
- *     ssprove_restore_pre.
- *     {
- *       ssprove_invariant.
- *       apply preserve_update_r_ignored_heap_ignore.
- *       {
- *         rewrite in_fsetU.
- *         apply /orP ; right.
- *         unfold DDH.DDH_locs.
- *         rewrite !fset_cons -fset0E fsetU0.
- *         rewrite in_fsetU.
- *         apply /orP ; right.
- *         rewrite in_fsetU.
- *         apply /orP ; right.
- *         by apply /fset1P.
- *       }
- *       apply preserve_update_l_ignored_heap_ignore.
- *       2: apply preserve_update_mem_nil.
- *       rewrite in_fsetU.
- *       apply /orP ; right.
- *       unfold DDH.DDH_locs.
- *       rewrite !fset_cons -fset0E fsetU0.
- *       rewrite in_fsetU.
- *       apply /orP ; right.
- *       rewrite in_fsetU.
- *       apply /orP ; right.
- *       by apply /fset1P.
- *     }
- *     ssprove_sync.
- *     ssprove_sync=>queries.
- *     case (queries (Sigma1.Sigma.prod_assoc (fto (g ^+ x_i), fto (g ^+ otf r_i)))) eqn:e.
- *     all: rewrite e.
- *     all: ssprove_code_simpl ; simpl.
- *     all: ssprove_code_simpl_more ; simpl.
- *     - apply r_get_remember_lhs.
- *       intros ?.
- *       apply r_get_remember_rhs.
- *       intros ?.
- *       ssprove_forget_all.
- *       rewrite -Hord otf_fto eq_refl.
- *       simpl.
- *       ssprove_sync=>e_j.
- *       apply r_put_lhs.
- *       apply r_put_rhs.
- *       clear e queries.
- *       ssprove_restore_pre.
- *       1: ssprove_invariant.
- *       ssprove_sync.
- *       ssprove_sync=>queries.
- *       case (queries (Sigma1.Sigma.prod_assoc (fto (g ^+ finv f' x_j), fto (g ^+ otf e_j)))) eqn:e.
- *       all: rewrite e.
- *       all: simpl; ssprove_code_simpl.
- *       all: ssprove_code_simpl_more.
- *       + apply r_get_remember_lhs.
- *         intros ?.
- *         apply r_get_remember_rhs.
- *         intros ?.
- *         ssprove_forget_all.
- *         apply r_assertD.
- *         {
- *           intros ??.
- *           rewrite !domm_set.
- *           done.
- *         }
- *         intros _ _.
- *         apply r_ret.
- *         intros ???.
- *         split.
- *         2: assumption.
- *         unfold f_v.
- *         apply vote_hiding_bij.
- *       + ssprove_sync=>e_i.
- *         apply r_put_vs_put.
- *         apply r_get_remember_lhs.
- *         intros ?.
- *         apply r_get_remember_rhs.
- *         intros ?.
- *         ssprove_forget_all.
- *         apply r_assertD.
- *         {
- *           intros ??.
- *           rewrite !domm_set.
- *           done.
- *         }
- *         intros _ _.
- *         ssprove_restore_pre.
- *         1: ssprove_invariant.
- *         apply r_ret.
- *         intros ???.
- *         split.
- *         2: assumption.
- *         unfold f_v.
- *         apply vote_hiding_bij.
- *     - ssprove_sync=>e_i.
- *       apply r_put_vs_put.
- *       apply r_get_remember_lhs.
- *       intros ?.
- *       apply r_get_remember_rhs.
- *       intros ?.
- *       ssprove_forget_all.
- *       rewrite -Hord otf_fto.
- *       rewrite -Hord eq_refl.
- *       simpl.
- *       ssprove_sync=>r_j.
- *       apply r_put_lhs.
- *       apply r_put_rhs.
- *       ssprove_restore_pre.
- *       1: ssprove_invariant.
- *       ssprove_sync.
- *       ssprove_sync=>queries'.
- *       case (queries' (Sigma1.Sigma.prod_assoc (fto (g ^+ finv f' x_j), fto (g ^+ otf r_j)))) eqn:e'.
- *       all: rewrite e'.
- *       all: simpl; ssprove_code_simpl.
- *       all: ssprove_code_simpl_more.
- *       + apply r_get_remember_lhs.
- *         intros ?.
- *         apply r_get_remember_rhs.
- *         intros ?.
- *         ssprove_forget_all.
- *         apply r_assertD.
- *         {
- *           intros ??.
- *           rewrite !domm_set.
- *           done.
- *         }
- *         intros _ _.
- *         apply r_ret.
- *         intros ???.
- *         split.
- *         2: assumption.
- *         unfold f_v.
- *         apply vote_hiding_bij.
- *       + ssprove_sync=>e_j.
- *         apply r_put_vs_put.
- *         apply r_get_remember_lhs.
- *         intros ?.
- *         apply r_get_remember_rhs.
- *         intros ?.
- *         ssprove_forget_all.
- *         apply r_assertD.
- *         {
- *           intros ??.
- *           rewrite !domm_set.
- *           done.
- *         }
- *         intros _ _.
- *         ssprove_restore_pre.
- *         1: ssprove_invariant.
- *         apply r_ret.
- *         intros ???.
- *         split.
- *         2: assumption.
- *         unfold f_v.
- *         apply vote_hiding_bij.
- *   Qed.
- * 
- * End OVN.
- * End OVN.
-*)
+
+From Relational Require Import OrderEnrichedCategory GenericRulesSimple.
+
+Set Warnings "-notation-overridden,-ambiguous-paths".
+From mathcomp Require Import all_ssreflect all_algebra reals distr realsum
+  fingroup.fingroup solvable.cyclic prime ssrnat ssreflect ssrfun ssrbool ssrnum
+  eqtype choice seq.
+Set Warnings "notation-overridden,ambiguous-paths".
+
+From Crypt Require Import Axioms ChoiceAsOrd SubDistr Couplings
+  UniformDistrLemmas FreeProbProg Theta_dens RulesStateProb UniformStateProb
+  pkg_composition Package Prelude SigmaProtocol Schnorr DDH Canonicals.
+
+From Coq Require Import Utf8 Lia.
+From extructures Require Import ord fset fmap.
+
+From Equations Require Import Equations.
+Require Equations.Prop.DepElim.
+
+Set Equations With UIP.
+
+Set Bullet Behavior "Strict Subproofs".
+Set Default Goal Selector "!".
+Set Primitive Projections.
+
+Import Num.Def.
+Import Num.Theory.
+Import Order.POrderTheory.
+
+#[local] Open Scope ring_scope.
+Import GroupScope GRing.Theory.
+
+Import PackageNotation.
+
+Module Type GroupParam.
+
+  Parameter n : nat.
+  Parameter n_pos : Positive n.
+
+  Parameter gT : finGroupType.
+  Definition ζ : {set gT} := [set : gT].
+  Parameter g :  gT.
+  Parameter g_gen : ζ = <[g]>.
+  Parameter prime_order : prime #[g].
+
+End GroupParam.
+
+Module Type OVNParam.
+
+  Parameter N : nat.
+  Parameter N_pos : Positive N.
+
+End OVNParam.
+
+Module OVN (GP : GroupParam) (OP : OVNParam).
+Import GP.
+Import OP.
+
+Set Equations Transparent.
+
+Lemma cyclic_zeta: cyclic ζ.
+Proof.
+  apply /cyclicP. exists g. exact: g_gen.
+Qed.
+
+(* order of g *)
+Definition q' := Zp_trunc (pdiv #[g]).
+Definition q : nat := q'.+2.
+
+Lemma q_order_g : q = #[g].
+Proof.
+  unfold q, q'.
+  apply Fp_cast.
+  apply prime_order.
+Qed.
+
+Lemma q_field : (Zp_trunc #[g]) = q'.
+Proof.
+  unfold q'.
+  rewrite pdiv_id.
+  2: apply prime_order.
+  reflexivity.
+Qed.
+
+Lemma expg_g : forall x, exists ix, x = g ^+ ix.
+Proof.
+  intros.
+  apply /cycleP.
+  rewrite -g_gen.
+  apply: in_setT.
+Qed.
+
+Lemma group_prodC :
+  @commutative gT gT mulg.
+Proof.
+  move => x y.
+  destruct (expg_g x) as [ix ->].
+  destruct (expg_g y) as [iy ->].
+  repeat rewrite -expgD addnC.
+  reflexivity.
+Qed.
+
+Definition Pid : finType := Finite.clone _ 'I_n.
+Definition Secret : finComRingType := 'Z_(Zp_trunc #[g]).
+Definition Public : finType := gT.
+Definition s0 : Secret := 0.
+
+Definition Pid_pos : Positive #|Pid|.
+Proof.
+  rewrite card_ord.
+  eapply PositiveInFin.
+  apply n_pos.
+Qed.
+
+Definition Secret_pos : Positive #|Secret|.
+Proof.
+  apply /card_gt0P. exists s0. auto.
+Qed.
+
+Definition Public_pos : Positive #|Public|.
+Proof.
+  apply /card_gt0P. exists g. auto.
+Defined.
+
+#[local] Existing Instance Pid_pos.
+#[local] Existing Instance Secret_pos.
+#[local] Existing Instance Public_pos.
+
+Definition pid : choice_type := 'fin #|Pid|.
+Definition secret : choice_type := 'fin #|Secret|.
+Definition public: choice_type := 'fin #|Public|.
+
+Definition nat_to_pid : nat → pid.
+Proof.
+  move=> n.
+  eapply give_fin.
+Defined.
+
+Definition i_secret := #|Secret|.
+Definition i_public := #|Public|.
+
+Module Type CDSParams <: SigmaProtocolParams.
+  Definition Witness : finType := Secret.
+  Definition Statement : finType := prod_finType (prod_finType Public Public) Public.
+
+  Definition Witness_pos : Positive #|Witness| := Secret_pos.
+  Definition Statement_pos : Positive #|Statement|.
+  Proof.
+    unfold Statement.
+    rewrite !card_prod.
+    repeat apply Positive_prod.
+    all: apply Public_pos.
+  Qed.
+
+  Definition R : Statement -> Witness -> bool :=
+    λ (h : Statement) (x : Witness),
+      let '(gx, gy, gyxv) := h in
+      (gy^+x * g^+0 == gyxv) || (gy^+x * g^+1 == gyxv).
+
+  Lemma relation_valid_left:
+    ∀ (x : Secret) (gy : Public),
+      R (g^+x, gy, gy^+x * g^+ 0) x.
+  Proof.
+    intros x gy.
+    unfold R.
+    apply /orP ; left.
+    done.
+  Qed.
+
+  Lemma relation_valid_right:
+    ∀ (x : Secret) (gy : Public),
+      R (g^+x, gy, gy^+x * g^+ 1) x.
+  Proof.
+    intros x y.
+    unfold R.
+    apply /orP ; right.
+    done.
+  Qed.
+
+  Parameter Message Challenge Response State : finType.
+  Parameter w0 : Witness.
+  Parameter e0 : Challenge.
+  Parameter z0 : Response.
+
+  Parameter Message_pos : Positive #|Message|.
+  Parameter Challenge_pos : Positive #|Challenge|.
+  Parameter Response_pos : Positive #|Response|.
+  Parameter State_pos : Positive #|State|.
+  Parameter Bool_pos : Positive #|bool_choiceType|.
+End CDSParams.
+
+Module OVN (π2 : CDSParams) (Alg2 : SigmaProtocolAlgorithms π2).
+
+  Module Sigma1 := Schnorr GP.
+  Module Sigma2 := SigmaProtocol π2 Alg2.
+
+  Obligation Tactic := idtac.
+  Set Equations Transparent.
+
+  Definition skey_loc (i : nat) : Location := (secret; (100+i)%N).
+  Definition ckey_loc (i : nat) : Location := (public; (101+i)%N).
+
+  Definition P_i_locs (i : nat) : {fset Location} := fset [:: skey_loc i ; ckey_loc i].
+
+  Notation choiceStatement1 := Sigma1.MyAlg.choiceStatement.
+  Notation choiceWitness1 := Sigma1.MyAlg.choiceWitness.
+  Notation choiceTranscript1 := Sigma1.MyAlg.choiceTranscript.
+
+  Notation " 'pid " := pid (in custom pack_type at level 2).
+  Notation " 'pids " := (chProd pid pid) (in custom pack_type at level 2).
+  Notation " 'public " := public (in custom pack_type at level 2).
+  Notation " 'public " := public (at level 2) : package_scope.
+
+  Notation " 'chRelation1' " := (chProd choiceStatement1 choiceWitness1) (in custom pack_type at level 2).
+  Notation " 'chTranscript1' " := choiceTranscript1 (in custom pack_type at level 2).
+  Notation " 'public_key " := (chProd public choiceTranscript1) (in custom pack_type at level 2).
+  Notation " 'public_keys " := (chMap pid (chProd public choiceTranscript1)) (in custom pack_type at level 2).
+
+  Notation " 'chRelation2' " := (chProd Alg2.choiceStatement Alg2.choiceWitness) (in custom pack_type at level 2).
+  Notation " 'chTranscript2' " := Alg2.choiceTranscript (in custom pack_type at level 2).
+  Notation " 'vote " := (chProd public Alg2.choiceTranscript) (in custom pack_type at level 2).
+
+  Definition INIT : nat := 4.
+  Definition VOTE : nat := 5.
+  Definition CONSTRUCT : nat := 6.
+
+  Definition P (i : nat) : nat := 14 + i.
+  Definition Exec (i : nat) : nat := 15 + i.
+
+  Lemma not_in_domm {T S} :
+    ∀ i m,
+      i \notin @domm T S m :\ i.
+  Proof.
+    intros.
+    apply /negPn.
+    rewrite in_fsetD.
+    move=> /andP [H _].
+    move: H => /negPn H.
+    apply H.
+    by rewrite in_fset1.
+  Qed.
+
+  Lemma not_in_fsetU :
+    ∀ (l : Location) L0 L1,
+      l \notin L0  →
+      l \notin L1 →
+      l \notin L0 :|: L1.
+  Proof.
+    intros l L0 L1 h1 h2.
+    rewrite -fdisjoints1 fset1E.
+    rewrite fdisjointUl.
+    apply /andP ; split.
+    + rewrite -fdisjoints1 fset1E in h1. apply h1.
+    + rewrite -fdisjoints1 fset1E in h2. apply h2.
+  Qed.
+
+  #[local] Hint Extern 3 (is_true (?l \notin ?L0 :|: ?L1)) =>
+    apply not_in_fsetU : typeclass_instances ssprove_valid_db ssprove_invariant.
+
+  Definition get_value (m : chMap pid (chProd public choiceTranscript1)) (i : pid) :=
+    match m i with
+    | Some (v, _) => otf v
+    | _ => 1
+    end.
+
+  From HB Require Import structures.
+  (*HB.about Monoid.ComLaw.
+  HB.howto Monoid.ComLaw.type.
+  HB.about Monoid.isComLaw.Build.
+  HB.about Monoid.ComLaw.
+  Check group_prodC.
+  Locate group_prodC.
+  Print mulg.
+  Locate "*".
+  Print commutative.
+  HB.about Monoid.isComLaw.
+   *)
+  (*
+  HB.instance Definition _ := Monoid.isComLaw.Build gT [1 gT] mulg group_prodA group_prodC group_1prod.
+  Canonical finGroup_com_law := Monoid.ComLaw group_prodC.
+   *)
+
+  Definition compute_key
+             (m : chMap pid (chProd public choiceTranscript1))
+             (i : pid)
+    :=
+    let low := \prod_(k <- domm m | (k < i)%ord) (get_value m k) in
+    let high := \prod_(k <- domm m | (i < k)%ord) (get_value m k) in
+    low * invg high.
+
+  Definition compute_key'
+             (m : chMap pid (chProd public choiceTranscript1))
+             (i j : pid)
+             (x : Secret)
+    :=
+    if (j < i)%ord then
+      let low := \prod_(k <- domm m | (k < i)%ord) (get_value m k) in
+      let high := \prod_(k <- domm m | (i < k)%ord) (get_value m k) in
+      (g ^+ x) * low * invg high
+    else
+      let low := \prod_(k <- domm m | (k < i)%ord) (get_value m k) in
+      let high := \prod_(k <- domm m | (i < k)%ord) (get_value m k) in
+      low * invg (high * (g ^+ x)).
+
+  Lemma compute_key'_equiv
+        (i j : pid)
+        (x : Secret)
+        (zk : choiceTranscript1)
+        (keys : chMap pid (chProd public choiceTranscript1)):
+    (i != j) →
+    compute_key (setm keys j (fto (g ^+ x), zk)) i = compute_key' (remm keys j) i j x.
+  Proof.
+    intro ij_neq.
+    unfold compute_key, compute_key'.
+    simpl.
+    rewrite <- setm_rem.
+    rewrite domm_set domm_rem.
+    set X := domm _.
+    rewrite !big_fsetU1.
+    2-3: subst X; apply not_in_domm.
+    rewrite setm_rem.
+    have set_rem_eq : forall P x,
+      \big[finGroup_com_law/1]_(k <- X :\ j | P k)
+        get_value (setm keys j x) k =
+      \prod_(k <- X :\ j | P k)
+        get_value (remm keys j) k.
+    { intros.
+      rewrite big_seq_cond.
+      rewrite [RHS] big_seq_cond.
+      unfold get_value.
+      erewrite eq_bigr.
+      1: done.
+      intros k.
+      move => /andP [k_in _].
+      simpl.
+      rewrite setmE remmE.
+      case (k == j) eqn:eq.
+      - move: eq => /eqP eq.
+        rewrite eq in_fsetD1 in k_in.
+        move: k_in => /andP [contra].
+        rewrite eq_refl in contra.
+        discriminate.
+      - reflexivity.
+
+    }
+    case (j < i)%ord eqn:e.
+    - rewrite !e.
+      rewrite -2!mulgA.
+      f_equal.
+      1: unfold get_value ; by rewrite setmE eq_refl otf_fto.
+      f_equal.
+      + apply set_rem_eq.
+      + rewrite Ord.ltNge Ord.leq_eqVlt in e.
+        rewrite negb_or in e.
+        move: e => /andP [_ e].
+        apply negbTE in e.
+        rewrite e.
+        f_equal.
+        apply set_rem_eq.
+    - rewrite e.
+      rewrite Ord.ltNge in e.
+      apply negbT in e.
+      apply negbNE in e.
+      rewrite Ord.leq_eqVlt in e.
+      move: e => /orP [contra|e].
+      1: by rewrite contra in ij_neq.
+      rewrite e !invMg.
+      f_equal.
+      { apply set_rem_eq. }
+      rewrite group_prodC.
+      f_equal.
+      { unfold get_value. by rewrite setmE eq_refl otf_fto. }
+      f_equal.
+      apply set_rem_eq.
+  Qed.
+
+  Lemma compute_key_bij:
+    ∀ (m : chMap pid (chProd public choiceTranscript1)) (i j: pid),
+      (i != j)%ord →
+      exists (a b : nat),
+        (a != 0)%N /\ (a < q)%N /\
+      (∀ (x : Secret) zk,
+        compute_key (setm m j (fto (g ^+ x), zk)) i = g ^+ ((a * x + b) %% q)).
+  Proof.
+    intros m i j ne.
+    simpl.
+    pose low := \prod_(k <- domm m :\ j| (k < i)%ord) get_value m k.
+    pose hi := \prod_(k <- domm m :\ j| (i < k)%ord) get_value m k.
+    have Hlow : exists ilow, low = g ^+ ilow by apply expg_g.
+    have Hhi : exists ihi, hi = g ^+ ihi by apply expg_g.
+    destruct Hlow as [ilow Hlow].
+    destruct Hhi as [ihi Hhi].
+
+    have getv_remm_eq : forall P j m,
+      \prod_(k <- domm m :\ j | P k) get_value (remm m j) k =
+      \prod_(k <- domm m :\ j | P k) get_value m k.
+    {
+      clear low hi ilow ihi Hlow Hhi ne i j m.
+      intros.
+      rewrite big_seq_cond.
+      rewrite [RHS] big_seq_cond.
+      erewrite eq_bigr.
+      1: done.
+      intros k.
+      move => /andP [k_in _].
+      simpl.
+      unfold get_value.
+      rewrite remmE.
+      case (k == j) eqn:eq.
+      ++ move: eq => /eqP eq.
+          rewrite eq in_fsetD1 in k_in.
+          move: k_in => /andP [contra].
+          rewrite eq_refl in contra.
+          discriminate.
+      ++ reflexivity.
+    }
+
+    case (j < i)%ord eqn:ij_rel.
+    - exists 1%N.
+      exists (ilow + (ihi * #[g ^+ ihi].-1))%N.
+      do 2 split.
+      1: rewrite q_order_g ; apply (prime_gt1 prime_order).
+      intros x zk.
+      rewrite compute_key'_equiv.
+      2: assumption.
+      unfold compute_key'.
+      simpl.
+      rewrite ij_rel.
+      rewrite domm_rem.
+      set low' := \prod_(k0 <- _ | _) _.
+      set hi' := \prod_(k0 <- _ | _) _.
+      have -> : low' = low by apply getv_remm_eq.
+      have -> : hi' = hi by apply getv_remm_eq.
+      clear low' hi'.
+      rewrite Hhi Hlow.
+      rewrite invg_expg.
+      rewrite -!expgM.
+      rewrite -!expgD.
+      rewrite !addnA.
+      rewrite -expg_mod_order.
+      f_equal.
+      f_equal.
+      2: {
+        unfold q. rewrite Fp_cast;
+        [reflexivity | apply prime_order].
+      }
+      rewrite mul1n.
+      done.
+    - exists #[g].-1.
+      exists (ilow + (ihi * #[g ^+ ihi].-1))%N.
+      repeat split.
+      { unfold negb.
+        rewrite -leqn0.
+        case (#[g].-1 <= 0)%N eqn:e.
+        2: done.
+        have Hgt1 := (prime_gt1 prime_order).
+        rewrite -ltn_predRL in Hgt1.
+        rewrite -ltnS in Hgt1.
+        rewrite -addn1 in Hgt1.
+        rewrite leq_add2l in Hgt1.
+        eapply leq_trans in e.
+        2: apply Hgt1.
+        discriminate.
+      }
+      {
+        rewrite q_order_g.
+        rewrite ltn_predL.
+        apply (prime_gt0 prime_order).
+      }
+      intros x zk.
+      rewrite compute_key'_equiv.
+      2: assumption.
+      unfold compute_key'.
+      simpl.
+      rewrite ij_rel.
+      rewrite domm_rem.
+      set low' := \prod_(k0 <- _ | _) _.
+      set hi' := \prod_(k0 <- _ | _) _.
+      have -> : low' = low by apply getv_remm_eq.
+      have -> : hi' = hi by apply getv_remm_eq.
+      clear low' hi'.
+      rewrite Hhi Hlow.
+      rewrite invMg.
+      rewrite -expgVn.
+      rewrite !invg_expg.
+      rewrite -!expgM.
+      rewrite mulgA.
+      rewrite -!expgD.
+      rewrite !addnA.
+      rewrite -expg_mod_order.
+      f_equal.
+      f_equal.
+      2: {
+        unfold q. rewrite Fp_cast;
+        [reflexivity | apply prime_order].
+      }
+      rewrite addnAC.
+      rewrite addnC.
+      rewrite addnA.
+      done.
+  Qed.
+
+  Lemma compute_key_set_i
+        (i : pid)
+        (v : (chProd public choiceTranscript1))
+        (m : chMap pid (chProd public choiceTranscript1)):
+    compute_key (setm m i v) i = compute_key m i.
+  Proof.
+    unfold compute_key.
+    simpl.
+    case (i \in domm m) eqn:i_in.
+    all: simpl in i_in.
+    - have -> : forall v, domm (setm m i v) = domm m.
+      { intros.
+        simpl.
+        rewrite domm_set.
+        rewrite -eq_fset.
+        intro k.
+        rewrite in_fsetU1.
+        case (eq_op) eqn:e.
+        + move: e => /eqP ->.
+          by rewrite i_in.
+        + done.
+      }
+      simpl.
+      f_equal.
+      + apply eq_big.
+        1: done.
+        intros k k_lt.
+        unfold get_value.
+        rewrite setmE.
+        rewrite Ord.lt_neqAle in k_lt.
+        move: k_lt => /andP [k_lt _].
+        move: k_lt => /negbTE ->.
+        done.
+      + f_equal.
+        apply eq_big.
+        1: done.
+        intros k k_lt.
+        unfold get_value.
+        rewrite setmE.
+        rewrite Ord.lt_neqAle in k_lt.
+        move: k_lt => /andP [k_lt _].
+        rewrite eq_sym.
+        move: k_lt => /negbTE ->.
+        done.
+    - have -> : domm m = domm (remm m i).
+      {
+        simpl.
+        rewrite -eq_fset.
+        intro k.
+        rewrite domm_rem.
+        rewrite in_fsetD1.
+        case (eq_op) eqn:e.
+        + simpl.
+          move: e => /eqP ->.
+          assumption.
+        + done.
+      }
+      simpl.
+      f_equal.
+      + rewrite -setm_rem domm_set domm_rem.
+        rewrite big_fsetU1.
+        all: simpl.
+        2: by rewrite in_fsetD1 eq_refl.
+        rewrite Ord.ltxx.
+        apply eq_big.
+        1: done.
+        intros k k_lt.
+        unfold get_value.
+        rewrite setmE remmE.
+        rewrite Ord.lt_neqAle in k_lt.
+        move: k_lt => /andP [k_lt _].
+        move: k_lt => /negbTE ->.
+        done.
+      + f_equal.
+        rewrite -setm_rem domm_set domm_rem.
+        rewrite big_fsetU1.
+        all: simpl.
+        2: by rewrite in_fsetD1 eq_refl.
+        rewrite Ord.ltxx.
+        apply eq_big.
+        1: done.
+        intros k k_lt.
+        unfold get_value.
+        rewrite setmE remmE.
+        rewrite Ord.lt_neqAle in k_lt.
+        move: k_lt => /andP [k_lt _].
+        rewrite eq_sym.
+        move: k_lt => /negbTE ->.
+        done.
+  Qed.
+
+  Lemma test_bij
+        (i j : pid)
+        (m : chMap pid (chProd public choiceTranscript1))
+    :
+      (i != j)%N →
+      ∃ (f : Secret → Secret),
+      ∀ (x : Secret),
+        bijective f /\
+          (∀ zk, compute_key (setm m j (fto (g ^+ x), zk)) i = g ^+ (f x)).
+  Proof.
+    simpl.
+    intros ne.
+    have H := compute_key_bij m i j ne.
+    simpl in H.
+    destruct H as [a [b [a_pos [a_leq_q H]]]].
+    set a_ord := @inZp ((Zp_trunc #[g]).+1) a.
+    set b_ord := @inZp ((Zp_trunc #[g]).+1) b.
+    pose f' := (fun (x : Secret) => Zp_add (Zp_mul x a_ord) b_ord).
+    exists f'.
+    unfold f'. clear f'.
+    intros x.
+    have := q_order_g.
+    unfold q.
+    intros Hq.
+    split.
+    2: {
+      intro zk.
+      rewrite (H x zk).
+      apply /eqP.
+      rewrite eq_expg_mod_order.
+      apply /eqP.
+      simpl.
+      rewrite modn_small.
+      2: {
+        rewrite q_order_g.
+        apply ltn_pmod.
+        apply (prime_gt0 prime_order).
+      }
+      repeat rewrite -> Zp_cast at 3.
+      2-5: apply (prime_gt1 prime_order).
+      symmetry.
+      rewrite modn_small.
+      2: {
+        apply ltn_pmod.
+        apply (prime_gt0 prime_order).
+      }
+      simpl.
+      unfold q, q'.
+      rewrite Fp_cast.
+      2: apply prime_order.
+      rewrite modnMmr.
+      rewrite modnDm.
+      rewrite mulnC.
+      reflexivity.
+    }
+    assert (coprime q'.+2 a_ord) as a_ord_coprime.
+    {
+      rewrite -unitFpE.
+      2: rewrite Hq ; apply prime_order.
+      rewrite unitfE. simpl.
+      rewrite Zp_cast.
+      2: apply (prime_gt1 prime_order).
+      unfold q, q' in a_leq_q.
+      rewrite Fp_cast in a_leq_q.
+      2: apply prime_order.
+      rewrite modn_small.
+      2: apply a_leq_q.
+      erewrite <- inj_eq.
+      2: apply ord_inj.
+      rewrite val_Zp_nat.
+      2: {
+        rewrite pdiv_id.
+        1: apply prime_gt1.
+        1,2: rewrite Hq ; apply prime_order.
+      }
+      rewrite -> pdiv_id at 1.
+      1,2: rewrite Hq.
+      2: apply prime_order.
+      unfold q in a_leq_q.
+      rewrite modn_small.
+      2: apply a_leq_q.
+      assumption.
+    }
+    pose f' := (fun (x : Secret) => Zp_mul (Zp_add (Zp_opp b_ord) x) (Zp_inv a_ord)).
+    exists f'.
+    - intro z.
+      unfold f'. clear f'.
+      simpl.
+      rewrite Zp_addC.
+      rewrite -Zp_addA.
+      have -> : (Zp_add b_ord (Zp_opp b_ord)) = Zp0.
+      1: by rewrite Zp_addC Zp_addNz.
+      rewrite Zp_addC.
+      rewrite Zp_add0z.
+      rewrite -Zp_mulA.
+      rewrite Zp_mulzV.
+      2: {
+        rewrite -> q_field at 1.
+        assumption.
+      }
+      rewrite Zp_mulz1.
+      reflexivity.
+    - intro z.
+      unfold f'. clear f'.
+      simpl.
+      rewrite Zp_addC.
+      rewrite -Zp_mulA.
+      rewrite Zp_mul_addl.
+      have -> : (Zp_mul (Zp_inv a_ord) a_ord) = Zp1.
+      {
+        rewrite Zp_mulC.
+        rewrite Zp_mulzV.
+        + reflexivity.
+        + rewrite -> q_field at 1.
+          assumption.
+      }
+      rewrite -Zp_mul_addl.
+      rewrite Zp_mulz1.
+      rewrite Zp_addA.
+      have -> : (Zp_add b_ord (Zp_opp b_ord)) = Zp0.
+      1: by rewrite Zp_addC Zp_addNz.
+      rewrite Zp_add0z.
+      reflexivity.
+  Qed.
+
+  Lemma test_bij'
+        (i j : pid)
+        (m : chMap pid (chProd public choiceTranscript1))
+    :
+      (i != j)%N →
+      ∃ (f : secret → secret),
+      ∀ (x : secret),
+        bijective f /\
+          (∀ zk, compute_key (setm m j (fto (g ^+ otf x), zk)) i = g ^+ (otf (f x))).
+  Proof.
+    simpl.
+    intros ne.
+    have [f H] := test_bij i j m ne.
+    simpl in H.
+    exists (fun (x : secret) => fto (f (otf x))).
+    intro x.
+    destruct (H (otf x)) as [f_bij H'] ; clear H.
+    split.
+    - exists (fun z => fto ((finv f) (otf z))).
+      + apply bij_inj in f_bij.
+        intro z.
+        rewrite otf_fto.
+        apply finv_f in f_bij.
+        rewrite f_bij fto_otf.
+        reflexivity.
+      + apply bij_inj in f_bij.
+        intro z.
+        rewrite otf_fto.
+        apply f_finv in f_bij.
+        rewrite f_bij fto_otf.
+        reflexivity.
+    - intro zk.
+      specialize (H' zk).
+      rewrite otf_fto.
+      apply H'.
+  Qed.
+
+  Definition P_i_E :=
+    [interface
+      #val #[ INIT ] : 'unit → 'public_key ;
+      #val #[ CONSTRUCT ] : 'public_keys → 'unit ;
+      #val #[ VOTE ] : 'bool → 'public
+    ].
+
+  Definition Sigma1_I :=
+    [interface
+      #val #[ Sigma1.Sigma.VERIFY ] : chTranscript1 → 'bool ;
+      #val #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1
+    ].
+
+  Definition P_i (i : pid) (b : bool):
+    package (P_i_locs i)
+      Sigma1_I
+      P_i_E :=
+    [package
+        #def #[ INIT ] (_ : 'unit) : 'public_key
+        {
+          #import {sig #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1} as ZKP ;;
+          #import {sig #[ Sigma1.Sigma.VERIFY ] : chTranscript1 → 'bool} as VER ;;
+          x ← sample uniform i_secret ;;
+          #put (skey_loc i) := x ;;
+          let y := (fto (g ^+ (otf x))) : public in
+            zkp ← ZKP (y, x) ;;
+            ret (y, zkp)
+        }
+        ;
+        #def #[ CONSTRUCT ] (m : 'public_keys) : 'unit
+        {
+          #import {sig #[ Sigma1.Sigma.VERIFY ] : chTranscript1 → 'bool} as VER ;;
+          #assert (size (domm m) == n) ;;
+          let key := fto (compute_key m i) in
+          #put (ckey_loc i) := key ;;
+          @ret 'unit Datatypes.tt
+        }
+        ;
+        #def #[ VOTE ] (v : 'bool) : 'public
+        {
+          skey ← get (skey_loc i) ;;
+          ckey ← get (ckey_loc i) ;;
+          if b then
+            let vote := (otf ckey ^+ skey * g ^+ v) in
+            @ret 'public (fto vote)
+          else
+            let vote := (otf ckey ^+ skey * g ^+ (negb v)) in
+            @ret 'public (fto vote)
+        }
+    ].
+
+  Definition EXEC_i_I :=
+    [interface
+      #val #[ INIT ] : 'unit → 'public_key ;
+      #val #[ CONSTRUCT ] : 'public_keys → 'unit ;
+      #val #[ VOTE ] : 'bool → 'public ;
+      #val #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1
+    ].
+
+  Definition Exec_i_E i := [interface #val #[ Exec i ] : 'bool → 'public].
+
+  Definition Exec_i (i j : pid) (m : chMap pid (chProd public choiceTranscript1)):
+    package fset0
+      EXEC_i_I
+      (Exec_i_E i)
+    :=
+    [package
+        #def #[ Exec i ] (v : 'bool) : 'public
+        {
+          #import {sig #[ INIT ] : 'unit → 'public_key} as Init ;;
+          #import {sig #[ CONSTRUCT ] : 'public_keys → 'unit} as Construct ;;
+          #import {sig #[ VOTE ] : 'bool → 'public} as Vote ;;
+          #import {sig #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1} as ZKP ;;
+          pk ← Init Datatypes.tt ;;
+          x ← sample uniform i_secret ;;
+          let y := (fto (g ^+ (otf x))) : public in
+            zkp ← ZKP (y, x) ;;
+            let m' := setm (setm m j (y, zkp)) i pk in
+              Construct m' ;;
+              vote ← Vote v ;;
+              @ret 'public vote
+        }
+    ].
+
+  Module DDHParams <: DDHParams.
+    Definition Space := Secret.
+    Definition Space_pos := Secret_pos.
+  End DDHParams.
+
+  Module DDH := DDH DDHParams GP.
+
+  #[tactic=notac] Equations? Aux (b : bool) (i j : pid) m f':
+    package DDH.DDH_locs
+      (DDH.DDH_E :|:
+         [interface #val #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1]
+      )
+      [interface #val #[ Exec i ] : 'bool → 'public]
+    := Aux b i j m f' :=
+    [package
+        #def #[ Exec i ] (v : 'bool) : 'public
+        {
+          #import {sig #[ DDH.SAMPLE ] : 'unit → 'public × 'public × 'public} as DDH ;;
+          #import {sig #[ Sigma1.Sigma.RUN ] : chRelation1 → chTranscript1} as ZKP ;;
+          abc ← DDH Datatypes.tt ;;
+          x_i ← get DDH.secret_loc1 ;;
+          x_j ← get DDH.secret_loc2 ;;
+          let '(y_i, (y_j, c)) := abc in
+          let y_j' := fto (g ^+ ((finv f') x_j)) in
+            zkp1 ← ZKP (y_i, x_i) ;;
+            zkp2 ← ZKP (y_j', (finv f') x_j) ;;
+            let m' := (setm (setm m j (y_j', zkp2)) i (y_i, zkp1)) in
+            #assert (size (domm m') == n) ;;
+              @ret 'public (fto ((otf c) *  g ^+ (if b then v else (negb v))))
+        }
+    ].
+  Proof.
+    ssprove_valid.
+    all: rewrite in_fsetU.
+    all: apply /orP.
+    {
+      left.
+      unfold DDH.DDH_E.
+      rewrite fset_cons -fset0E fsetU0.
+      by apply /fset1P.
+    }
+    {
+      right.
+      rewrite fset_cons -fset0E fsetU0.
+      by apply /fset1P.
+    }
+    {
+      right.
+      rewrite fset_cons -fset0E fsetU0.
+      by apply /fset1P.
+    }
+  Qed.
+
+  Module RO1 := Sigma1.Sigma.Oracle.
+  Module RO2 := Sigma2.Oracle.
+
+  Definition combined_locations :=
+    (Sigma1.MyAlg.Sigma_locs :|: RO1.RO_locs).
+
+  Equations? Exec_i_realised b m (i j : pid) : package (P_i_locs i :|: combined_locations) [interface] (Exec_i_E i) :=
+    Exec_i_realised b m i j :=
+      {package (Exec_i i j m) ∘ (par ((P_i i b) ∘ (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO))
+                                      (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO))}.
+  Proof.
+    ssprove_valid.
+    10: apply fsub0set.
+    8:{ rewrite fsetUid. apply fsubsetxx. }
+    9: apply fsubsetxx.
+    7:{ erewrite fsetUid. apply fsubsetxx. }
+    4: apply fsubsetUr.
+    3: apply fsubsetUl.
+    all: unfold combined_locations.
+    - apply fsubsetUl.
+    - apply fsubsetUr.
+    - eapply fsubset_trans. 2: eapply fsubsetUr.
+      apply fsubsetUl.
+    - eapply fsubset_trans. 2: eapply fsubsetUr.
+      apply fsubsetUr.
+    - unfold EXEC_i_I, P_i_E, Sigma1_I.
+      rewrite !fset_cons.
+      rewrite -!fsetUA.
+      repeat apply fsetUS.
+      rewrite -fset0E fsetU0 fset0U.
+      apply fsubsetUr.
+  Qed.
+
+
+  Lemma loc_helper_commit i:
+    Sigma1.MyAlg.commit_loc \in P_i_locs i :|: combined_locations.
+  Proof.
+    unfold combined_locations.
+    unfold Sigma1.MyAlg.Sigma_locs.
+    rewrite in_fsetU.
+    apply /orP ; right.
+    rewrite fset_cons.
+    rewrite in_fsetU.
+    apply /orP ; left.
+    rewrite in_fsetU1.
+    apply /orP ; left.
+    done.
+  Qed.
+
+  Lemma loc_helper_queries i:
+    RO1.queries_loc \in P_i_locs i :|: combined_locations.
+  Proof.
+    unfold combined_locations.
+    unfold RO1.RO_locs.
+    rewrite in_fsetU.
+    apply /orP ; right.
+    rewrite fset_cons.
+    rewrite in_fsetU.
+    apply /orP ; right.
+    rewrite in_fsetU1.
+    apply /orP ; left.
+    done.
+  Qed.
+
+  Lemma loc_helper_skey i:
+    skey_loc i \in P_i_locs i :|: combined_locations.
+  Proof.
+    unfold P_i_locs.
+    rewrite in_fsetU.
+    apply /orP ; left.
+    rewrite fset_cons.
+    rewrite in_fsetU1.
+    apply /orP ; left.
+    done.
+  Qed.
+
+  Lemma loc_helper_ckey i:
+    ckey_loc i \in P_i_locs i :|: combined_locations.
+  Proof.
+    unfold P_i_locs.
+    rewrite in_fsetU.
+    apply /orP ; left.
+    rewrite !fset_cons.
+    rewrite in_fsetU1.
+    apply /orP ; right.
+    rewrite in_fsetU1.
+    apply /orP ; left.
+    done.
+  Qed.
+
+  #[local] Hint Resolve loc_helper_commit : loc_db.
+  #[local] Hint Resolve loc_helper_queries : loc_db.
+  #[local] Hint Resolve loc_helper_skey: loc_db.
+  #[local] Hint Resolve loc_helper_ckey: loc_db.
+
+  #[program] Definition Exec_i_realised_code m (i j : pid) (vote : 'bool):
+    code (P_i_locs i :|: combined_locations) [interface] 'public :=
+    {code
+     x ← sample uniform i_secret ;;
+     #put skey_loc i := x ;;
+     #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x)))) (otf x) ;;
+     x1 ← sample uniform Sigma1.MyAlg.i_witness ;;
+     #put Sigma1.MyAlg.commit_loc := x1 ;;
+     #put RO1.queries_loc := emptym ;;
+     x2 ← get RO1.queries_loc ;;
+     match x2 (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)))) with
+     | Some a =>
+         v ← get Sigma1.MyAlg.commit_loc ;;
+         x3 ← sample uniform i_secret ;;
+         #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x3)))) (otf x3) ;;
+         x5 ← sample uniform Sigma1.MyAlg.i_witness ;;
+         #put Sigma1.MyAlg.commit_loc := x5 ;;
+         #put RO1.queries_loc := emptym ;;
+         v0 ← get RO1.queries_loc ;;
+         match v0 (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) with
+         | Some a0 =>
+             x6 ← get Sigma1.MyAlg.commit_loc ;;
+             let x4 :=
+             (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3))))
+             in
+         #assert eqn
+                    (size
+                       (domm (T:=[ordType of 'I_#|'I_n|]) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|))
+                          (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
+                             (fto (expgn_rec (T:=gT) g (otf x)),
+                             (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;;
+          #put ckey_loc i := fto
+                              (compute_key
+                                 (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
+                                    (fto (expgn_rec (T:=gT) g (otf x)),
+                                    (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a,
+                                    fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;;
+         v0 ← get skey_loc i ;;
+         v1 ← get ckey_loc i ;;
+         @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote))
+         | None =>
+             a0 ← sample uniform RO1.i_random ;;
+             #put RO1.queries_loc := setm v0
+                                      (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) a0 ;;
+             x6 ← get Sigma1.MyAlg.commit_loc ;;
+             let x4 := (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in
+         #assert eqn
+                    (size
+                       (domm (T:=[ordType of 'I_#|'I_n|]) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|))
+                          (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
+                             (fto (expgn_rec (T:=gT) g (otf x)),
+                             (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;;
+          #put ckey_loc i := fto
+                              (compute_key
+                                 (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
+                                    (fto (expgn_rec (T:=gT) g (otf x)),
+                                    (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a,
+                                    fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;;
+         v0 ← get skey_loc i ;;
+         v1 ← get ckey_loc i ;;
+         @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote))
+         end
+     | None =>
+         a ← sample uniform RO1.i_random ;;
+         #put RO1.queries_loc := setm x2
+                                  (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)))) a ;;
+         v ← get Sigma1.MyAlg.commit_loc ;;
+         x3 ← sample uniform i_secret ;;
+         #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x3)))) (otf x3) ;;
+         x5 ← sample uniform Sigma1.MyAlg.i_witness ;;
+         #put Sigma1.MyAlg.commit_loc := x5 ;;
+         #put RO1.queries_loc := emptym ;;
+         v0 ← get RO1.queries_loc ;;
+         match v0 (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) with
+         | Some a0 =>
+             x6 ← get Sigma1.MyAlg.commit_loc ;;
+             let x4 := (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in
+             #assert eqn
+                 (size
+                 (domm (T:=[ordType of 'I_#|'I_n|]) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|))
+                         (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
+                             (fto (expgn_rec (T:=gT) g (otf x)),
+                                 (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;;
+             #put ckey_loc i := fto
+                                 (compute_key
+                                     (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
+                                             (fto (expgn_rec (T:=gT) g (otf x)),
+                                             (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a,
+                                                 fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;;
+            v0 ← get skey_loc i ;;
+            v1 ← get ckey_loc i ;;
+            @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote))
+        | None =>
+                   a0 ← sample uniform RO1.i_random ;;
+                   #put RO1.queries_loc := setm v0
+                                            (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) a0 ;;
+                   x6 ← get Sigma1.MyAlg.commit_loc ;;
+                   let x4 := (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in
+         #assert eqn
+                    (size
+                       (domm (T:=[ordType of 'I_#|'I_n|]) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|))
+                          (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
+                             (fto (expgn_rec (T:=gT) g (otf x)),
+                             (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;;
+          #put ckey_loc i := fto
+                              (compute_key
+                                 (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
+                                    (fto (expgn_rec (T:=gT) g (otf x)),
+                                    (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a,
+                                    fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;;
+         v0 ← get skey_loc i ;;
+         v1 ← get ckey_loc i ;;
+         @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote))
+               end
+     end
+    }.
+  Next Obligation.
+    intros.
+    ssprove_valid ; auto with loc_db.
+    destruct (v1 _) ; ssprove_valid ; auto with loc_db.
+    - destruct (v5 _) ; ssprove_valid ; auto with loc_db.
+    - destruct (v6 _) ; ssprove_valid ; auto with loc_db.
+  Qed.
+
+  #[program] Definition Exec_i_realised_code_runnable m (i j : pid) (vote : 'bool):
+    code (P_i_locs i :|: combined_locations) [interface] 'public :=
+    {code
+     x ← sample uniform i_secret ;;
+     #put skey_loc i := x ;;
+     #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x)))) (otf x) ;;
+     x1 ← sample uniform Sigma1.MyAlg.i_witness ;;
+     #put Sigma1.MyAlg.commit_loc := x1 ;;
+     x2 ← get RO1.queries_loc ;;
+         a ← sample uniform RO1.i_random ;;
+         #put RO1.queries_loc := setm x2
+                                  (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)))) a ;;
+         v ← get Sigma1.MyAlg.commit_loc ;;
+         x3 ← sample uniform i_secret ;;
+         #assert Sigma1.MyParam.R (otf (fto (expgn_rec (T:=gT) g (otf x3)))) (otf x3) ;;
+         x5 ← sample uniform Sigma1.MyAlg.i_witness ;;
+         #put Sigma1.MyAlg.commit_loc := x5 ;;
+         v0 ← get RO1.queries_loc ;;
+                   a0 ← sample uniform RO1.i_random ;;
+                   #put RO1.queries_loc := setm v0
+                                            (Sigma1.Sigma.prod_assoc (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)))) a0 ;;
+                   x6 ← get Sigma1.MyAlg.commit_loc ;;
+                   let x4 := (fto (expgn_rec (T:=gT) g (otf x3)), fto (expgn_rec (T:=gT) g (otf x5)), a0, fto (Zp_add (otf x6) (Zp_mul (otf a0) (otf x3)))) in
+         #assert eqn
+                    (size
+                       (domm (T:=[ordType of 'I_#|'I_n|]) (S:='I_#|gT| * ('I_#|gT| * 'I_#|gT| * 'I_#|'Z_Sigma1.q| * 'I_#|'Z_Sigma1.q|))
+                          (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
+                             (fto (expgn_rec (T:=gT) g (otf x)),
+                             (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a, fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))))) n ;;
+          #put ckey_loc i := fto
+                              (compute_key
+                                 (setm (T:=[ordType of 'I_#|'I_n|]) (setm (T:=[ordType of 'I_#|'I_n|]) m j (fto (expgn_rec (T:=gT) g (otf x3)), x4)) i
+                                    (fto (expgn_rec (T:=gT) g (otf x)),
+                                    (fto (expgn_rec (T:=gT) g (otf x)), fto (expgn_rec (T:=gT) g (otf x1)), a,
+                                    fto (Zp_add (otf v) (Zp_mul (otf a) (otf x)))))) i) ;;
+         v0 ← get skey_loc i ;;
+         v1 ← get ckey_loc i ;;
+         @ret 'public (fto (expgn_rec (T:=gT) (otf v1) v0 * expgn_rec (T:=gT) g vote))
+    }.
+  Next Obligation.
+    intros.
+    ssprove_valid ; auto with loc_db.
+  Qed.
+
+  Lemma code_pkg_equiv m i j (vote : 'bool):
+    ⊢
+    ⦃ λ '(h₀, h₁), h₀ = h₁ ⦄
+    get_op_default (Exec_i_realised true m i j) ((Exec i), ('bool, 'public)) vote
+    ≈
+    Exec_i_realised_code m i j vote
+    ⦃ eq ⦄.
+  Proof.
+    unfold Exec_i_realised.
+    rewrite get_op_default_link.
+    erewrite get_op_default_spec.
+    2: {
+      cbn.
+      rewrite eqnE eq_refl.
+      done.
+    }
+    ssprove_code_simpl.
+    simpl.
+    repeat choice_type_eqP_handle.
+    rewrite !cast_fun_K.
+    ssprove_code_simpl.
+    simpl.
+    ssprove_code_simpl.
+    ssprove_code_simpl_more.
+    simpl.
+    ssprove_sync_eq=>x.
+    simpl.
+    ssprove_code_simpl_more.
+    ssprove_sync_eq.
+    ssprove_sync_eq=>rel1.
+    ssprove_sync_eq=>r1.
+    ssprove_sync_eq.
+    ssprove_code_simpl.
+
+    ssprove_contract_put_get_lhs.
+    ssprove_contract_put_get_rhs.
+
+    ssprove_sync_eq.
+    simpl.
+
+    ssprove_code_simpl.
+    ssprove_sync_eq=>a.
+    ssprove_sync_eq.
+    ssprove_sync_eq=>v.
+
+    apply r_uniform_bij with (f := (fun (x : Arit (@uniform i_secret Sigma1.MyParam.Witness_pos)) => (x : Arit (@uniform i_secret Secret_pos)))).
+    1: exact (inv_bij (fun x => erefl)).
+    intros.
+
+    match goal with
+    | |- context [⊢ ⦃ _ ⦄ bind (assertD ?v ?z) ?y ≈ ?x  ⦃ _ ⦄] =>
+        set (temp1 := x) ; set (temp2 := y) ;
+        set (temp3 := z) ; set (temp4 := v) in *
+    end.
+
+    apply (r_transL  (@assertD _ temp4 (fun z => x ← temp3 z ;; temp2 x))).
+    1:{
+      eapply r_transR.
+      1:{
+        apply r_bind_assertD_sym.
+      }
+      apply rreflexivity_rule.
+    }
+    subst temp1 temp2 temp3 temp4.
+    
+    apply (@r_assertD_same (chFin (mkpos #|gT|)) _).
+    intros.
+
+    simpl.
+    ssprove_sync_eq=>a0.
+    ssprove_sync_eq.
+
+    ssprove_contract_put_get_lhs.
+    ssprove_contract_put_get_rhs.
+    
+    ssprove_sync_eq.
+    simpl.
+
+    ssprove_sync_eq=>a1.
+    ssprove_sync_eq.
+    ssprove_sync_eq=>a2.
+
+    match goal with
+    | |- context [⊢ ⦃ _ ⦄ bind (assertD ?v ?z) ?y ≈ ?x  ⦃ _ ⦄] =>
+        set (temp1 := x) ; set (temp2 := y) ;
+        set (temp3 := z) ; set (temp4 := v) in *
+    end.
+    
+    apply (r_transL  (@assertD _ temp4 (fun z => x ← temp3 z ;; temp2 x))).
+    1:{
+      eapply r_transR.
+      1:{
+        apply r_bind_assertD_sym.
+      }
+      apply rreflexivity_rule.
+    }
+    subst temp1 temp2 temp3 temp4. hnf.
+
+    apply r_assertD_same.
+    intros.
+
+    ssprove_sync_eq.
+    ssprove_sync_eq=>a3.
+    ssprove_sync_eq=>a4.
+    apply r_ret.
+    intros. subst.
+    reflexivity.
+  Qed.
+
+  #[tactic=notac] Equations? Aux_realised (b : bool) (i j : pid) m f' :
+    package (DDH.DDH_locs :|: P_i_locs i :|: combined_locations) Game_import [interface #val #[ Exec i ] : 'bool → 'public] :=
+    Aux_realised b i j m f' := {package Aux b i j m f' ∘ (par DDH.DDH_real (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) }.
+  Proof.
+    ssprove_valid.
+    4:{ rewrite fsetUid. rewrite -fset0E. apply fsub0set. }
+    6: apply fsubsetxx.
+    3:{ rewrite -fsetUA. apply fsubsetxx. }
+    4:{ rewrite -fsetUA. apply fsubsetUl. }
+    all: unfold combined_locations.
+    - eapply fsubset_trans. 2: apply fsubsetUr.
+      apply fsubsetUl.
+    - eapply fsubset_trans. 2: apply fsubsetUr.
+      apply fsubsetUr.
+    - unfold DDH.DDH_E.
+      apply fsetUS.
+      rewrite !fset_cons.
+      apply fsubsetUr.
+  Qed.
+
+  #[tactic=notac] Equations? Aux_ideal_realised (b : bool) (i j : pid) m f' :
+    package (DDH.DDH_locs :|: P_i_locs i :|: combined_locations) Game_import [interface #val #[ Exec i ] : 'bool → 'public] :=
+    Aux_ideal_realised b i j m f' := {package Aux b i j m f' ∘ (par DDH.DDH_ideal (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) }.
+  Proof.
+    ssprove_valid.
+    4:{ rewrite fsetUid. rewrite -fset0E. apply fsub0set. }
+    6: apply fsubsetxx.
+    3:{ rewrite -fsetUA. apply fsubsetxx. }
+    4:{ rewrite -fsetUA. apply fsubsetUl. }
+    all: unfold combined_locations.
+    - eapply fsubset_trans. 2: apply fsubsetUr.
+      apply fsubsetUl.
+    - eapply fsubset_trans. 2: apply fsubsetUr.
+      apply fsubsetUr.
+    - unfold DDH.DDH_E.
+      apply fsetUS.
+      rewrite !fset_cons.
+      apply fsubsetUr.
+  Qed.
+
+  Notation inv i := (heap_ignore (P_i_locs i :|: DDH.DDH_locs)).
+
+  #[local] Hint Extern 50 (_ = code_link _ _) =>
+    rewrite code_link_scheme
+    : ssprove_code_simpl.
+
+  (** We extend swapping to schemes.
+    This means that the ssprove_swap tactic will be able to swap any command
+    with a scheme without asking a proof from the user.
+  *)
+  #[local] Hint Extern 40 (⊢ ⦃ _ ⦄ x ← ?s ;; y ← cmd _ ;; _ ≈ _ ⦃ _ ⦄) =>
+    eapply r_swap_scheme_cmd ; ssprove_valid
+    : ssprove_swap.
+
+  Lemma P_i_aux_equiv (i j : pid) m:
+    fdisjoint Sigma1.MyAlg.Sigma_locs DDH.DDH_locs →
+    i != j →
+    (∃ f,
+      bijective f ∧
+      (∀ b, (Exec_i_realised b m i j) ≈₀ Aux_realised b i j m f)).
+  Proof.
+    intros Hdisj ij_neq.
+    have [f' Hf] := test_bij' i j m ij_neq.
+    simpl in Hf.
+    exists f'.
+    split.
+    {
+      assert ('I_#|'Z_#[g]|) as x.
+      { rewrite card_ord.
+        eapply Ordinal.
+        rewrite ltnS.
+        apply ltnSn.
+      }
+      specialize (Hf x).
+      destruct Hf.
+      assumption.
+    }
+    intro b.
+    eapply eq_rel_perf_ind with (inv := inv i).
+    {
+      ssprove_invariant.
+      rewrite -!fsetUA.
+      apply fsetUS.
+      do 2 (apply fsubsetU ; apply /orP ; right).
+      apply fsubsetUl.
+    }
+    simplify_eq_rel v.
+    rewrite !setmE.
+    rewrite !eq_refl.
+    ssprove_code_simpl.
+    repeat simplify_linking.
+    ssprove_sync => x_i.
+
+    rewrite !cast_fun_K.
+    ssprove_code_simpl.
+    ssprove_code_simpl_more.
+    
+    ssprove_swap_seq_rhs [:: 4 ; 5 ; 6 ; 7]%N.
+    ssprove_swap_seq_rhs [:: 2 ; 3 ; 4 ; 5 ; 6]%N.
+    ssprove_swap_seq_rhs [:: 0 ; 1 ; 2 ; 3 ; 4 ; 5]%N.
+    ssprove_contract_put_get_rhs.
+    apply r_put_rhs.
+    ssprove_swap_seq_lhs [:: 0 ; 1 ; 2 ; 3]%N.
+    unfold Sigma1.MyParam.R.
+    have Hord : ∀ x, (nat_of_ord x) = (nat_of_ord (otf x)).
+    {
+      unfold otf.
+      intros n x.
+      rewrite enum_val_ord.
+      done.
+    }
+    rewrite -Hord otf_fto eq_refl.
+    simpl.
+    ssprove_sync => r_i.
+    apply r_put_vs_put.
+    ssprove_restore_pre.
+    { ssprove_invariant.
+      apply preserve_update_r_ignored_heap_ignore.
+      - unfold DDH.DDH_locs.
+        rewrite in_fsetU.
+        apply /orP ; right.
+        rewrite fset_cons.
+        rewrite in_fsetU.
+        apply /orP ; left.
+        by apply /fset1P.
+      - apply preserve_update_mem_nil.
+    }
+    ssprove_sync.
+    ssprove_swap_seq_lhs [:: 0 ]%N.
+    ssprove_swap_seq_rhs [:: 2 ; 1 ; 0]%N.
+    ssprove_sync => queries.
+    destruct (queries (Sigma1.Sigma.prod_assoc (fto (g ^+ x_i), fto (g ^+ otf r_i)))) eqn:e.
+    all: rewrite e; simpl.
+    all: ssprove_code_simpl_more.
+    - ssprove_swap_seq_lhs [:: 0 ; 1 ; 2 ; 3 ; 4 ; 5]%N.
+      ssprove_swap_seq_lhs [:: 0 ; 1 ]%N.
+      eapply r_uniform_bij.
+      { apply Hf.
+        + rewrite card_ord.
+          rewrite Zp_cast.
+          2: apply (prime_gt1 prime_order).
+          eapply Ordinal.
+          apply (prime_gt1 prime_order).
+      }
+      intro x.
+      specialize (Hf x).
+      destruct Hf as [bij_f Hf].
+      apply bij_inj in bij_f.
+      apply finv_f in bij_f.
+      ssprove_contract_put_get_rhs.
+      rewrite bij_f.
+      rewrite -Hord !otf_fto !eq_refl.
+      simpl.
+      apply r_put_rhs.
+      ssprove_restore_pre.
+      {
+        apply preserve_update_r_ignored_heap_ignore.
+        - unfold DDH.DDH_locs.
+          rewrite !fset_cons.
+          rewrite !in_fsetU.
+          apply /orP ; right.
+          apply /orP ; right.
+          apply /orP ; left.
+          by apply /fset1P.
+        - apply preserve_update_mem_nil.
+      }
+      apply r_get_remember_lhs.
+      intros ?.
+      apply r_get_remember_rhs.
+      intros ?.
+      ssprove_forget_all.
+      ssprove_sync=>r_j.
+      apply r_put_vs_put.
+      ssprove_restore_pre.
+      1: ssprove_invariant.
+      clear e queries.
+      ssprove_sync.
+      ssprove_swap_seq_lhs [:: 0]%N.
+      ssprove_sync=>queries.
+      destruct (queries (Sigma1.Sigma.prod_assoc (fto (g ^+ x), fto (g ^+ otf r_j)))) eqn:e.
+      all: rewrite e.
+      all: ssprove_code_simpl.
+      all: ssprove_code_simpl_more.
+      + ssprove_swap_seq_lhs [:: 0 ; 1]%N.
+        simpl.
+        apply r_get_remember_lhs.
+        intros ?.
+        apply r_get_remember_rhs.
+        intros ?.
+        ssprove_forget_all.
+        apply r_assertD.
+        {
+          intros ??.
+          rewrite !domm_set.
+          done.
+        }
+        intros _ _.
+        ssprove_swap_lhs 1%N.
+        {
+          move: H0 => /eqP.
+          erewrite eqn_add2r.
+          intros contra.
+          discriminate.
+        }
+        ssprove_contract_put_get_lhs.
+        apply r_put_lhs.
+        ssprove_contract_put_get_lhs.
+        apply r_put_lhs.
+        ssprove_restore_pre.
+        {
+          repeat apply preserve_update_l_ignored_heap_ignore.
+          1,2: unfold P_i_locs ; rewrite in_fsetU.
+          1,2: apply /orP ; left ; rewrite !fset_cons ;
+               rewrite -fset0E fsetU0 ; rewrite in_fsetU.
+          - apply /orP ; right.
+            by apply /fset1P.
+          - apply /orP ; left.
+            by apply /fset1P.
+          - apply preserve_update_mem_nil.
+        }
+        rewrite otf_fto.
+        rewrite compute_key_set_i.
+        set zk := (fto (g ^+ x), fto (g ^+ otf r_j), s1, fto (otf x2 + otf s1 * otf x)).
+        clearbody zk.
+        specialize (Hf zk).
+        rewrite !Hord.
+        rewrite Hf.
+        rewrite -!Hord.
+        rewrite -expgM.
+        rewrite mulnC.
+        case b; apply r_ret ; done.
+      + ssprove_swap_seq_lhs [:: 0 ; 1 ; 2 ; 3]%N.
+        simpl.
+        ssprove_sync=>e_j.
+        apply r_put_vs_put.
+        apply r_get_remember_lhs.
+        intros ?.
+        apply r_get_remember_rhs.
+        intros ?.
+        ssprove_forget_all.
+        apply r_assertD.
+        {
+          intros ??.
+          rewrite !domm_set.
+          done.
+        }
+        intros _ _.
+        ssprove_swap_lhs 1%N.
+        {
+          move: H0 => /eqP.
+          erewrite eqn_add2r.
+          intros contra.
+          discriminate.
+        }
+        ssprove_contract_put_get_lhs.
+        apply r_put_lhs.
+        ssprove_contract_put_get_lhs.
+        apply r_put_lhs.
+        ssprove_restore_pre.
+        {
+          repeat apply preserve_update_l_ignored_heap_ignore.
+          1,2: unfold P_i_locs ; rewrite in_fsetU.
+          1,2: apply /orP ; left ; rewrite !fset_cons ;
+               rewrite -fset0E fsetU0 ; rewrite in_fsetU.
+          - apply /orP ; right.
+            by apply /fset1P.
+          - apply /orP ; left.
+            by apply /fset1P.
+          - ssprove_invariant.
+        }
+        rewrite otf_fto.
+        rewrite compute_key_set_i.
+        set zk := (fto (g ^+ x), fto (g ^+ otf r_j), e_j, fto (otf x2 + otf e_j * otf x)).
+        clearbody zk.
+        specialize (Hf zk).
+        rewrite !Hord.
+        rewrite Hf.
+        rewrite -!Hord.
+        rewrite -expgM.
+        rewrite mulnC.
+        case b; apply r_ret ; done.
+    - ssprove_swap_seq_lhs [:: 0 ; 1 ; 2 ; 3 ; 4 ; 5  ; 6 ; 7]%N.
+      ssprove_swap_seq_lhs [:: 2 ; 1 ; 0 ]%N.
+      eapply r_uniform_bij.
+      { apply Hf.
+        + rewrite card_ord.
+          rewrite Zp_cast.
+          2: apply (prime_gt1 prime_order).
+          eapply Ordinal.
+          apply (prime_gt1 prime_order).
+      }
+      intro x.
+      specialize (Hf x).
+      destruct Hf as [bij_f Hf].
+      apply bij_inj in bij_f.
+      apply finv_f in bij_f.
+      ssprove_contract_put_get_rhs.
+      rewrite bij_f.
+      rewrite -Hord !otf_fto !eq_refl.
+      simpl.
+      apply r_put_rhs.
+      ssprove_restore_pre.
+      {
+        apply preserve_update_r_ignored_heap_ignore.
+        - unfold DDH.DDH_locs.
+          rewrite !fset_cons.
+          rewrite !in_fsetU.
+          apply /orP ; right.
+          apply /orP ; right.
+          apply /orP ; left.
+          by apply /fset1P.
+        - apply preserve_update_mem_nil.
+      }
+      ssprove_sync=>e_i.
+      apply r_put_vs_put.
+      apply r_get_remember_lhs.
+      intros ?.
+      apply r_get_remember_rhs.
+      intros ?.
+      ssprove_forget_all.
+      rewrite -Hord eq_refl.
+      simpl.
+      ssprove_sync=>r_j.
+      apply r_put_vs_put.
+      ssprove_restore_pre.
+      1: ssprove_invariant.
+      clear e queries.
+      ssprove_sync.
+      ssprove_swap_seq_lhs [:: 0]%N.
+      ssprove_sync=>queries.
+      destruct (queries (Sigma1.Sigma.prod_assoc (fto (g ^+ x), fto (g ^+ otf r_j)))) eqn:e.
+      all: rewrite e.
+      all: ssprove_code_simpl.
+      all: ssprove_code_simpl_more.
+      + ssprove_swap_seq_lhs [:: 0 ; 1]%N.
+        simpl.
+        apply r_get_remember_lhs.
+        intros ?.
+        apply r_get_remember_rhs.
+        intros ?.
+        ssprove_forget_all.
+        apply r_assertD.
+        {
+          intros ??.
+          rewrite !domm_set.
+          done.
+        }
+        intros _ _.
+        ssprove_swap_lhs 1%N.
+        {
+          move: H0 => /eqP.
+          erewrite eqn_add2r.
+          intros contra.
+          discriminate.
+        }
+        ssprove_contract_put_get_lhs.
+        apply r_put_lhs.
+        ssprove_contract_put_get_lhs.
+        apply r_put_lhs.
+        ssprove_restore_pre.
+        {
+          repeat apply preserve_update_l_ignored_heap_ignore.
+          1,2: unfold P_i_locs ; rewrite in_fsetU.
+          1,2: apply /orP ; left ; rewrite !fset_cons ;
+               rewrite -fset0E fsetU0 ; rewrite in_fsetU.
+          - apply /orP ; right.
+            by apply /fset1P.
+          - apply /orP ; left.
+            by apply /fset1P.
+          - apply preserve_update_mem_nil.
+        }
+        rewrite otf_fto.
+        rewrite compute_key_set_i.
+        set zk := (fto (g ^+ x), fto (g ^+ otf r_j), s, fto (otf x2 + otf s * otf x)).
+        clearbody zk.
+        specialize (Hf zk).
+        rewrite !Hord.
+        rewrite Hf.
+        rewrite -!Hord.
+        rewrite -expgM.
+        rewrite mulnC.
+        case b; apply r_ret ; done.
+      + ssprove_swap_seq_lhs [:: 0 ; 1 ; 2 ; 3]%N.
+        simpl.
+        ssprove_sync=>e_j.
+        apply r_put_vs_put.
+        apply r_get_remember_lhs.
+        intros ?.
+        apply r_get_remember_rhs.
+        intros ?.
+        ssprove_forget_all.
+        apply r_assertD.
+        {
+          intros ??.
+          rewrite !domm_set.
+          done.
+        }
+        intros _ _.
+        ssprove_swap_lhs 1%N.
+        {
+          move: H0 => /eqP.
+          erewrite eqn_add2r.
+          intros contra.
+          discriminate.
+        }
+        ssprove_contract_put_get_lhs.
+        apply r_put_lhs.
+        ssprove_contract_put_get_lhs.
+        apply r_put_lhs.
+        ssprove_restore_pre.
+        {
+          repeat apply preserve_update_l_ignored_heap_ignore.
+          1,2: unfold P_i_locs ; rewrite in_fsetU.
+          1,2: apply /orP ; left ; rewrite !fset_cons ;
+               rewrite -fset0E fsetU0 ; rewrite in_fsetU.
+          - apply /orP ; right.
+            by apply /fset1P.
+          - apply /orP ; left.
+            by apply /fset1P.
+          - ssprove_invariant.
+        }
+        rewrite otf_fto.
+        rewrite compute_key_set_i.
+        set zk := (fto (g ^+ x), fto (g ^+ otf r_j), e_j, fto (otf x2 + otf e_j * otf x)).
+        clearbody zk.
+        specialize (Hf zk).
+        rewrite !Hord.
+        rewrite Hf.
+        rewrite -!Hord.
+        rewrite -expgM.
+        rewrite mulnC.
+        case b; apply r_ret ; done.
+  Qed.
+
+  Lemma Hord (x : secret): (nat_of_ord x) = (nat_of_ord (otf x)).
+  Proof.
+      unfold otf.
+      rewrite enum_val_ord.
+      done.
+  Qed.
+
+  Lemma vote_hiding_bij (c : secret) (v : bool):
+    fto (otf (fto (g ^+ c)) * g ^+ v) =
+      fto
+        (otf (fto (g ^+ (if v then fto (Zp_add (otf c) Zp1) else fto (Zp_add (otf c) (Zp_opp Zp1))))) *
+           g ^+ (~~ v)).
+  Proof.
+    f_equal.
+    rewrite !otf_fto.
+    rewrite -!expgD.
+    have h' : ∀ (x : Secret), nat_of_ord x = (nat_of_ord (fto x)).
+    {
+        unfold fto.
+        intros k.
+        rewrite enum_rank_ord.
+        done.
+    }
+    case v.
+    ++ apply /eqP.
+       rewrite eq_expg_mod_order.
+       rewrite addn0.
+       have h : ∀ (x : secret), (((nat_of_ord x) + 1) %% q'.+2)%N = (nat_of_ord (Zp_add (otf x) Zp1)).
+       {
+         intro k.
+         unfold Zp_add.
+         simpl.
+         rewrite -Hord.
+         apply /eqP.
+         rewrite eq_sym.
+         apply /eqP.
+         rewrite -> Zp_cast at 2.
+         2: apply (prime_gt1 prime_order).
+         rewrite -> Zp_cast at 1.
+         2: apply (prime_gt1 prime_order).
+         rewrite modnDmr.
+         rewrite Fp_cast.
+         2: apply prime_order.
+         reflexivity.
+       }
+       rewrite -h'.
+       rewrite -h.
+       rewrite -modn_mod.
+       rewrite Fp_cast.
+       2: apply prime_order.
+       1: apply eq_refl.
+    ++ apply /eqP.
+       rewrite eq_expg_mod_order.
+       rewrite addn0.
+       unfold Zp_add, Zp_opp, Zp1.
+       simpl.
+       repeat rewrite -> Zp_cast at 12.
+       2-4: apply (prime_gt1 prime_order).
+       rewrite -!Hord.
+       have -> : (#[g] - 1 %% #[g])%N = #[g].-1.
+       { rewrite modn_small.
+         2: apply (prime_gt1 prime_order).
+         by rewrite -subn1.
+       }
+       rewrite modn_small.
+       2:{
+         destruct c as [c Hc].
+         move: Hc.
+         simpl.
+         unfold DDH.i_space, DDHParams.Space, Secret.
+         rewrite card_ord.
+         rewrite Zp_cast.
+         2: apply (prime_gt1 prime_order).
+         done.
+       }
+       have -> : (#[g].-1 %% #[g])%N = #[g].-1.
+       {
+         rewrite modn_small.
+         1: reflexivity.
+         apply ltnSE.
+         rewrite -subn1 -2!addn1.
+         rewrite subnK.
+         2: apply (prime_gt0 prime_order).
+         rewrite addn1.
+         apply ltnSn.
+       }
+       rewrite -h'.
+       simpl.
+       rewrite -> Zp_cast at 9.
+       2: apply (prime_gt1 prime_order).
+       rewrite modnDml.
+       rewrite -subn1.
+       rewrite -addnA.
+       rewrite subnK.
+       2: apply (prime_gt0 prime_order).
+       rewrite -modnDmr.
+       rewrite modnn.
+       rewrite addn0.
+       rewrite modn_small.
+       1: apply eq_refl.
+       destruct c as [h Hc].
+       move: Hc.
+       unfold DDH.i_space, DDHParams.Space, Secret.
+       simpl.
+       rewrite card_ord.
+       rewrite Zp_cast.
+       2: apply (prime_gt1 prime_order).
+       done.
+  Qed.
+
+  Lemma vote_hiding (i j : pid) m:
+    i != j →
+    ∀ LA A ϵ_DDH,
+      ValidPackage LA [interface #val #[ Exec i ] : 'bool → 'public] A_export A →
+      fdisjoint Sigma1.MyAlg.Sigma_locs DDH.DDH_locs →
+      fdisjoint LA DDH.DDH_locs →
+      fdisjoint LA (P_i_locs i) →
+      fdisjoint LA combined_locations →
+      (∀ D, DDH.ϵ_DDH D <= ϵ_DDH) →
+    AdvantageE (Exec_i_realised true m i j) (Exec_i_realised false m i j) A <= ϵ_DDH + ϵ_DDH.
+  Proof.
+    intros ij_neq LA A ϵ_DDH Va Hdisj Hdisj2 Hdisj3 Hdisj4 Dadv.
+    have [f' [bij_f Hf]] := P_i_aux_equiv i j m Hdisj ij_neq.
+    ssprove triangle (Exec_i_realised true m i j) [::
+      (Aux_realised true i j m f').(pack) ;
+      (Aux true i j m f') ∘ (par DDH.DDH_ideal (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) ;
+      (Aux false i j m f') ∘ (par DDH.DDH_ideal (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) ;
+      (Aux_realised false i j m f').(pack)
+    ] (Exec_i_realised false m i j) A as ineq.
+    eapply le_trans.
+    2: {
+      instantiate (1 := 0 + ϵ_DDH + 0 + ϵ_DDH + 0).
+      by rewrite ?GRing.addr0 ?GRing.add0r.
+    }
+    eapply le_trans. 1: exact ineq.
+    clear ineq.
+    repeat eapply ler_add.
+    {
+      apply eq_ler.
+      specialize (Hf true LA A Va).
+      apply Hf.
+      - rewrite fdisjointUr.
+        apply /andP ; split ; assumption.
+      - rewrite fdisjointUr.
+        apply /andP ; split.
+        2: assumption.
+        rewrite fdisjointUr.
+        apply /andP ; split ; assumption.
+    }
+    {
+      unfold Aux_realised.
+      rewrite -Advantage_link.
+      rewrite par_commut.
+      have -> : (par DDH.DDH_ideal (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) =
+               (par (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO) DDH.DDH_ideal).
+      { apply par_commut. ssprove_valid. }
+      erewrite Advantage_par.
+      3: apply DDH.DDH_real.
+      3: apply DDH.DDH_ideal.
+      2: {
+        ssprove_valid.
+        - eapply fsubsetUr.
+        - apply fsubsetUl.
+      }
+      1: rewrite Advantage_sym ; apply Dadv.
+      - ssprove_valid.
+      - unfold trimmed.
+        rewrite -link_trim_commut.
+        f_equal.
+        unfold trim.
+        rewrite !fset_cons -fset0E fsetU0.
+        rewrite !filterm_set.
+        simpl.
+        rewrite !in_fsetU !in_fset1 !eq_refl.
+        rewrite filterm0.
+        done.
+      - unfold trimmed.
+        unfold trim.
+        rewrite !fset_cons -fset0E fsetU0.
+        rewrite !filterm_set.
+        simpl.
+        rewrite !in_fset1 !eq_refl.
+        rewrite filterm0.
+        done.
+      - unfold trimmed.
+        unfold trim.
+        rewrite !fset_cons -fset0E fsetU0.
+        rewrite !filterm_set.
+        simpl.
+        rewrite !in_fset1 !eq_refl.
+        rewrite filterm0.
+        done.
+    }
+    2:{
+      unfold Aux_realised.
+      rewrite -Advantage_link.
+      rewrite par_commut.
+      have -> : (par DDH.DDH_real (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO)) =
+               (par (Sigma1.Sigma.Fiat_Shamir ∘ RO1.RO) DDH.DDH_real).
+      { apply par_commut. ssprove_valid. }
+      erewrite Advantage_par.
+      3: apply DDH.DDH_ideal.
+      3: apply DDH.DDH_real.
+      2: {
+        ssprove_valid.
+        - eapply fsubsetUr.
+        - apply fsubsetUl.
+      }
+      1: apply Dadv.
+      - ssprove_valid.
+      - unfold trimmed.
+        rewrite -link_trim_commut.
+        f_equal.
+        unfold trim.
+        rewrite !fset_cons -fset0E fsetU0.
+        rewrite !filterm_set.
+        simpl.
+        rewrite !in_fsetU !in_fset1 !eq_refl.
+        rewrite filterm0.
+        done.
+      - unfold trimmed.
+        unfold trim.
+        unfold DDH.DDH_E.
+        rewrite !fset_cons -fset0E fsetU0.
+        rewrite !filterm_set.
+        simpl.
+        rewrite !in_fset1 !eq_refl.
+        rewrite filterm0.
+        done.
+      - unfold trimmed.
+        unfold trim.
+        unfold DDH.DDH_E.
+        rewrite !fset_cons -fset0E fsetU0.
+        rewrite !filterm_set.
+        simpl.
+        rewrite !in_fset1 !eq_refl.
+        rewrite filterm0.
+        done.
+    }
+    2: {
+      apply eq_ler.
+      specialize (Hf false LA A Va).
+      rewrite Advantage_sym.
+      apply Hf.
+      - rewrite fdisjointUr.
+        apply /andP ; split ; assumption.
+      - rewrite fdisjointUr.
+        apply /andP ; split.
+        2: assumption.
+        rewrite fdisjointUr.
+        apply /andP ; split ; assumption.
+    }
+    apply eq_ler.
+    eapply eq_rel_perf_ind with (inv := inv i).
+    5: apply Va.
+    1,2: apply Aux_ideal_realised.
+    3: {
+      rewrite fdisjointUr.
+      apply /andP ; split.
+      2: assumption.
+      rewrite fdisjointUr.
+      apply /andP ; split ; assumption.
+    }
+    3: {
+      rewrite fdisjointUr.
+      apply /andP ; split.
+      2: assumption.
+      rewrite fdisjointUr.
+      apply /andP ; split ; assumption.
+    }
+    {
+      ssprove_invariant.
+      rewrite fsetUC.
+      rewrite -!fsetUA.
+      apply fsetUS.
+      apply fsubsetUl.
+    }
+    simplify_eq_rel v.
+    rewrite !setmE.
+    rewrite !eq_refl.
+    simpl.
+    repeat simplify_linking.
+    rewrite !cast_fun_K.
+    ssprove_code_simpl.
+    ssprove_code_simpl_more.
+    ssprove_sync=>x_i.
+    ssprove_sync=>x_j.
+    pose f_v := (fun (x : secret) =>
+                   if v then
+                   fto (Zp_add (otf x) Zp1)
+                   else
+                   fto (Zp_add (otf x) (Zp_opp Zp1))
+                ).
+    assert (bijective f_v) as bij_fv.
+    {
+      exists (fun x =>
+           if v then
+             fto (Zp_add (otf x) (Zp_opp Zp1))
+           else
+             fto (Zp_add (otf x) Zp1)
+        ).
+      - intro x.
+        unfold f_v.
+        case v.
+        + rewrite otf_fto.
+          rewrite -Zp_addA.
+          rewrite Zp_addC.
+          have -> : (Zp_add Zp1 (Zp_opp Zp1)) = (Zp_add (Zp_opp Zp1) Zp1).
+          { intro n. by rewrite Zp_addC. }
+          rewrite Zp_addNz.
+          rewrite Zp_add0z.
+          by rewrite fto_otf.
+        + rewrite otf_fto.
+          rewrite -Zp_addA.
+          rewrite Zp_addC.
+          rewrite Zp_addNz.
+          rewrite Zp_add0z.
+          by rewrite fto_otf.
+      - intro x.
+        unfold f_v.
+        case v.
+        + rewrite otf_fto.
+          rewrite -Zp_addA.
+          rewrite Zp_addNz.
+          rewrite Zp_addC.
+          rewrite Zp_add0z.
+          by rewrite fto_otf.
+        + rewrite otf_fto.
+          rewrite -Zp_addA.
+          rewrite Zp_addC.
+          have -> : (Zp_add Zp1 (Zp_opp Zp1)) = (Zp_add (Zp_opp Zp1) Zp1).
+          { intro n. by rewrite Zp_addC. }
+          rewrite Zp_addNz.
+          rewrite Zp_add0z.
+          by rewrite fto_otf.
+    }
+    eapply r_uniform_bij.
+    1: apply bij_fv.
+    intro c.
+    ssprove_swap_seq_rhs [:: 1 ; 2]%N.
+    ssprove_swap_seq_rhs [:: 0 ]%N.
+    ssprove_swap_seq_lhs [:: 1 ; 2]%N.
+    ssprove_swap_seq_lhs [:: 0 ]%N.
+    apply r_put_vs_put.
+    ssprove_contract_put_get_lhs.
+    ssprove_contract_put_get_rhs.
+    apply r_put_vs_put.
+    ssprove_contract_put_get_lhs.
+    ssprove_contract_put_get_rhs.
+    apply r_put_vs_put.
+    unfold Sigma1.MyParam.R.
+    rewrite -Hord otf_fto eq_refl.
+    simpl.
+    ssprove_sync=>r_i.
+    apply r_put_vs_put.
+    ssprove_restore_pre.
+    {
+      ssprove_invariant.
+      apply preserve_update_r_ignored_heap_ignore.
+      {
+        rewrite in_fsetU.
+        apply /orP ; right.
+        unfold DDH.DDH_locs.
+        rewrite !fset_cons -fset0E fsetU0.
+        rewrite in_fsetU.
+        apply /orP ; right.
+        rewrite in_fsetU.
+        apply /orP ; right.
+        by apply /fset1P.
+      }
+      apply preserve_update_l_ignored_heap_ignore.
+      2: apply preserve_update_mem_nil.
+      rewrite in_fsetU.
+      apply /orP ; right.
+      unfold DDH.DDH_locs.
+      rewrite !fset_cons -fset0E fsetU0.
+      rewrite in_fsetU.
+      apply /orP ; right.
+      rewrite in_fsetU.
+      apply /orP ; right.
+      by apply /fset1P.
+    }
+    ssprove_sync.
+    ssprove_sync=>queries.
+    case (queries (Sigma1.Sigma.prod_assoc (fto (g ^+ x_i), fto (g ^+ otf r_i)))) eqn:e.
+    all: rewrite e.
+    all: ssprove_code_simpl ; simpl.
+    all: ssprove_code_simpl_more ; simpl.
+    - apply r_get_remember_lhs.
+      intros ?.
+      apply r_get_remember_rhs.
+      intros ?.
+      ssprove_forget_all.
+      rewrite -Hord otf_fto eq_refl.
+      simpl.
+      ssprove_sync=>e_j.
+      apply r_put_lhs.
+      apply r_put_rhs.
+      clear e queries.
+      ssprove_restore_pre.
+      1: ssprove_invariant.
+      ssprove_sync.
+      ssprove_sync=>queries.
+      case (queries (Sigma1.Sigma.prod_assoc (fto (g ^+ finv f' x_j), fto (g ^+ otf e_j)))) eqn:e.
+      all: rewrite e.
+      all: simpl; ssprove_code_simpl.
+      all: ssprove_code_simpl_more.
+      + apply r_get_remember_lhs.
+        intros ?.
+        apply r_get_remember_rhs.
+        intros ?.
+        ssprove_forget_all.
+        apply r_assertD.
+        {
+          intros ??.
+          rewrite !domm_set.
+          done.
+        }
+        intros _ _.
+        apply r_ret.
+        intros ???.
+        split.
+        2: assumption.
+        unfold f_v.
+        apply vote_hiding_bij.
+      + ssprove_sync=>e_i.
+        apply r_put_vs_put.
+        apply r_get_remember_lhs.
+        intros ?.
+        apply r_get_remember_rhs.
+        intros ?.
+        ssprove_forget_all.
+        apply r_assertD.
+        {
+          intros ??.
+          rewrite !domm_set.
+          done.
+        }
+        intros _ _.
+        ssprove_restore_pre.
+        1: ssprove_invariant.
+        apply r_ret.
+        intros ???.
+        split.
+        2: assumption.
+        unfold f_v.
+        apply vote_hiding_bij.
+    - ssprove_sync=>e_i.
+      apply r_put_vs_put.
+      apply r_get_remember_lhs.
+      intros ?.
+      apply r_get_remember_rhs.
+      intros ?.
+      ssprove_forget_all.
+      rewrite -Hord otf_fto.
+      rewrite -Hord eq_refl.
+      simpl.
+      ssprove_sync=>r_j.
+      apply r_put_lhs.
+      apply r_put_rhs.
+      ssprove_restore_pre.
+      1: ssprove_invariant.
+      ssprove_sync.
+      ssprove_sync=>queries'.
+      case (queries' (Sigma1.Sigma.prod_assoc (fto (g ^+ finv f' x_j), fto (g ^+ otf r_j)))) eqn:e'.
+      all: rewrite e'.
+      all: simpl; ssprove_code_simpl.
+      all: ssprove_code_simpl_more.
+      + apply r_get_remember_lhs.
+        intros ?.
+        apply r_get_remember_rhs.
+        intros ?.
+        ssprove_forget_all.
+        apply r_assertD.
+        {
+          intros ??.
+          rewrite !domm_set.
+          done.
+        }
+        intros _ _.
+        apply r_ret.
+        intros ???.
+        split.
+        2: assumption.
+        unfold f_v.
+        apply vote_hiding_bij.
+      + ssprove_sync=>e_j.
+        apply r_put_vs_put.
+        apply r_get_remember_lhs.
+        intros ?.
+        apply r_get_remember_rhs.
+        intros ?.
+        ssprove_forget_all.
+        apply r_assertD.
+        {
+          intros ??.
+          rewrite !domm_set.
+          done.
+        }
+        intros _ _.
+        ssprove_restore_pre.
+        1: ssprove_invariant.
+        apply r_ret.
+        intros ???.
+        split.
+        2: assumption.
+        unfold f_v.
+        apply vote_hiding_bij.
+  Qed.
+
+End OVN.
+End OVN.
+
diff --git a/theories/Crypt/examples/Schnorr.v b/theories/Crypt/examples/Schnorr.v
index c2850b3d..a1633071 100644
--- a/theories/Crypt/examples/Schnorr.v
+++ b/theories/Crypt/examples/Schnorr.v
@@ -372,8 +372,6 @@ Proof.
        (addn (@nat_of_ord (S (S (Zp_trunc q))) (@otf Challenge s1))
              (@nat_of_ord (S (S (Zp_trunc q)))
                 (GRing.opp
-                   (* (FinRing.Zmodule.zmodType (Zp_finZmodType (S (Zp_trunc q)))) *)
-                   (* ('Z_(S (Zp_trunc q)) : finZmodType) *)
                    (@otf Challenge s2))))
        q) =
     (@nat_of_ord (S (S (Zp_trunc q)))
@@ -397,23 +395,17 @@ Proof.
     (modn
        (muln (@nat_of_ord (S (S (Zp_trunc q)))
                 (GRing.inv
-                   (* (FinRing.UnitRing.unitRingType (Zp_finUnitRingType (Zp_trunc q))) *)
                    (GRing.add
-                      (* (FinRing.Zmodule.zmodType (Zp_finZmodType (S (Zp_trunc q)))) *)
                       (@otf Challenge s1)
                       (GRing.opp
-                         (* (FinRing.Zmodule.zmodType (Zp_finZmodType (S (Zp_trunc q)))) *)
                          (@otf Challenge s2)))))
           (@nat_of_ord (S (S (Zp_trunc q)))
              (@Zp_add (S (Zp_trunc q)) (@otf Challenge s1) (@Zp_opp (S (Zp_trunc q)) (@otf Challenge s2))))) q) =
     (Zp_mul
        (GRing.inv
-          (* (FinRing.UnitRing.unitRingType (Zp_finUnitRingType (Zp_trunc q))) *)
           (GRing.add
-             (* (FinRing.Zmodule.zmodType (Zp_finZmodType (S (Zp_trunc q)))) *)
              (@otf Challenge s1)
              (GRing.opp
-                (* (FinRing.Zmodule.zmodType (Zp_finZmodType (S (Zp_trunc q)))) *)
                 (@otf Challenge s2))))
        (@Zp_add (S (Zp_trunc q)) (@otf Challenge s1) (@Zp_opp (S (Zp_trunc q)) (@otf Challenge s2)))).
   { simpl.