elgamal: fixes

elgamal: fixes

{-# OPTIONS --copatterns #-}
open import Type
open import Function
open import Data.Product
open import Data.Bool.NP as Bool
open import Data.Unit
open import Data.Maybe.NP
import Data.Fin.NP as Fin
open Fin using (Fin; zero; suc) renaming (#_ to ##_)
open import Data.Nat.NP hiding (_^_)
open import Data.Bits
import Data.Vec.NP as Vec
open Vec using (Vec; []; _∷_; _∷ʳ_; allFin; lookup) renaming (map to vmap)
open import Algebra.FunctionProperties
open import Relation.Binary.PropositionalEquality as ≡
import cont as cont
open cont using (Cont; ContA)
open import sum
open import sum-properties

module elgamal where

data `★ : ★ where
  `⊤   : `★
  `X   : `★
  _`×_ : `★ → `★ → `★
infixr 2 _`×_

module Univ (X : ★) where
    El : `★ → ★
    El `⊤         = ⊤
    El `X         = X
    El (u₀ `× u₁) = El u₀ × El u₁

    record ↺ (R : `★) (A : ★) : ★ where
      constructor mk
      field
        run↺ : El R → A
    open ↺ public

    EXP : (R : `★) → ★
    EXP R = ↺ R Bit

    Det : ★ → ★
    Det = ↺ `⊤

    μU : SumProp X → ∀ u → SumProp (El u)
    μU μX `⊤         = μ⊤
    μU μX `X         = μX
    μU μX (u₀ `× u₁) = μU μX u₀ ×μ μU μX u₁

module EntropySmoothing
  (M    : ★)        -- Message
  (Hash : ★)
  (ℋ   : M → Hash) -- Hashing function
  (Rₐ   : ★)        -- Adversary randomness
  where

  -- Entropy smoothing adversary
  ESAdv : ★
  ESAdv = Rₐ → Hash → Bit

  -- The randomness universe needed for the following games
  R : ★
  R = M × Hash × Rₐ

  -- In this game we always use ℋ on a random message
  ES⅁₀ : ESAdv → R → Bit
  ES⅁₀ A (m , _ , rₐ) = A rₐ (ℋ m)

  -- In this game we just retrun a random Hash value
  ES⅁₁ : ESAdv → R → Bit
  ES⅁₁ A (_ , h , rₐ) = A rₐ h

  ES⅁ : ESAdv → Bit → R → Bit
  ES⅁ A b r = (case b 0→ ES⅁₀ 1→ ES⅁₁) A r

module EntropySmoothingWithKey
  (M    : ★)
  (Key  : ★)
  (Hash : ★)
  (ℋ   : Key → M → Hash) -- Hashing function
  (Rₐ   : ★)              -- Adversary randomness
  where

  -- Entropy smoothing adversary
  ESAdv : ★
  ESAdv = Rₐ → Key → Hash → Bit

  -- The randomness universe needed for the following games
  R : ★
  R = Key × M × Hash × Rₐ

  -- In this game we always use ℋ on a random message
  ES⅁₀ : ESAdv → R → Bit
  ES⅁₀ A (k , m , _ , rₐ) = A rₐ k (ℋ k m)

  -- In this game we just retrun a random Hash value
  ES⅁₁ : ESAdv → R → Bit
  ES⅁₁ A (k , _ , h , rₐ) = A rₐ k h

  ES⅁ : ESAdv → Bit → R → Bit
  ES⅁ A b r = (case b 0→ ES⅁₀ 1→ ES⅁₁) A r

module ℤq-count
  (ℤq : ★)
  (_⊞_ : ℤq → ℤq → ℤq)
  (μℤq : SumProp ℤq)
  (sumℤq-⊞-lem : ∀ x f → sum μℤq (f ∘ _⊞_ x) ≡ sum μℤq f)
  where

  -- open Sum
  open Univ ℤq public
  open `★ public renaming (`X to `ℤq)

  #_ : ∀ {u} → ↺ u Bit → ℕ
  #_ {u} f = sum (μU μℤq u) (Bool.toℕ ∘ run↺ f)

  #q_ : Count ℤq
  #q_ = count μℤq

  ⁇ : ∀ R → ↺ R (El R)
  run↺ (⁇ _) = id

  pure↺ : ∀ {R A} → A → ↺ R A
  run↺ (pure↺ x) r = x -- turning r to _ produce an error

  ⟪_⟫ : ∀ {R A} → A → ↺ R A
  ⟪_⟫ = pure↺

  {-
  ⟪_⟫ᴰ : ∀ {a} {A : Set a} → A → Det A
  ⟪_⟫ᴰ = pureᴰ
  -}

  map↺ : ∀ {A B R} → (A → B) → ↺ R A → ↺ R B
  run↺ (map↺ f x) r = f (run↺ x r)

  infixl 4 _⊛_
  _⊛_ : ∀ {R S A B} → ↺ R (A → B) → ↺ S A → ↺ (R `× S) B
  run↺ (af ⊛ ax) rs = run↺ af (proj₁ rs) (run↺ ax (proj₂ rs))

  ⟪_·_⟫ : ∀ {A B R} → (A → B) → ↺ R A → ↺ R B
  ⟪ f · x ⟫ = map↺ f x

  ⟪_·_·_⟫ : ∀ {A B C} {R S} →
              (A → B → C) → ↺ R A → ↺ S B → ↺ (R `× S) C
  ⟪ f · x · y ⟫ = map↺ f x ⊛ y

  _⟨⊞⟩_ : ∀ {R S} → ↺ R ℤq → ↺ S ℤq → ↺ (R `× S) ℤq
  x ⟨⊞⟩ y = ⟪ _⊞_ · x · y ⟫

  ⟨_⊞⟩_ : ∀ {R} → ℤq → ↺ R ℤq → ↺ R ℤq
  ⟨ x ⊞⟩ y = ⟪ _⊞_ x · y ⟫

  infix 4 _≈↺_ _≈ᴬ_
  _≈↺_ : ∀ {R : `★} (f g : EXP R) → ★
  _≈↺_ = _≡_ on #_

  _≈ᴬ_ : ∀ {A R} (f g : ↺ R A) → Set _
  _≈ᴬ_ {A} f g = ∀ (Adv : A → Bit) → ⟪ Adv · f ⟫ ≈↺ ⟪ Adv · g ⟫

  lem : ∀ x → ⟨ x ⊞⟩ (⁇ `ℤq) ≈ᴬ ⁇ _
  lem x Adv = sumℤq-⊞-lem x (Bool.toℕ ∘ Adv)

  -- ∀ (A : ℤq → Bit) → # (A ⁇)

open Fin.Modulo renaming (sucmod to [suc])

{-
module ℤq-implem (q-2 : ℕ) where
  q : ℕ
  q = 2 + q-2

  ℤq : ★
  ℤq = Fin q

  [0] : ℤq
  [0] = zero

  [1] : ℤq
  [1] = suc zero
-}
module ℤq-implem (q : ℕ) ([0]' [1]' : Fin q) where
  -- open Sum
  ℤq : ★
  ℤq = Fin q

  [0] : ℤq
  [0] = [0]'

  [1] : ℤq
  [1] = [1]'

  _ℕ⊞_ : ℕ → ℤq → ℤq
  zero  ℕ⊞ n = n
  suc m ℕ⊞ n = m ℕ⊞ ([suc] n)
  {-
  zero  ℕ⊞ n = n
  suc m ℕ⊞ n = [suc] (m ℕ⊞ n)
  -}

  ℕ⊞-inj : ∀ n {x y} → n ℕ⊞ x ≡ n ℕ⊞ y → x ≡ y
  ℕ⊞-inj zero    eq = eq
  ℕ⊞-inj (suc n) eq = sucmod-inj _ _ (ℕ⊞-inj n eq)

  _⊞_ : ℤq → ℤq → ℤq
  m ⊞ n = Fin.toℕ m ℕ⊞ n

  ⊞-inj : ∀ m {x y} → m ⊞ x ≡ m ⊞ y → x ≡ y
  ⊞-inj m = ℕ⊞-inj (Fin.toℕ m)

  _ℕ⊠_ : ℕ → ℤq → ℤq
  zero  ℕ⊠ n = [0]
  suc m ℕ⊠ n = n ⊞ (m ℕ⊠ n)

  _⊠_ : ℤq → ℤq → ℤq
  m ⊠ n = Fin.toℕ m ℕ⊠ n

  _[^]ℕ_ : ℤq → ℕ → ℤq
  m [^]ℕ zero  = [1]
  m [^]ℕ suc n = m ⊠ (m [^]ℕ n)

  _[^]_ : ℤq → ℤq → ℤq
  m [^] n = m [^]ℕ (Fin.toℕ n)

  μℤq : SumProp ℤq
  μℤq = μFin q

  allℤq : Vec ℤq q
  allℤq = allFin q

  {-
  sumℤq : Sum ℤq
  sumℤq f = Vec.sum (vmap f allℤq)
  -}

  sumℤq-[suc]-lem : ∀ f → sum μℤq (f ∘ [suc]) ≡ sum μℤq f
  sumℤq-[suc]-lem f rewrite ≡.sym (Vec.sum-map-rot₁ f allℤq)
                          | Vec.map-∘ f [suc] allℤq
                          | rot₁-map-sucmod q
                          = refl

  --  comm-[suc]-ℕ⊞ : ∀ m n → [suc] (m ℕ⊞ n) ≡ m ℕ⊞ ([suc] n)

  sumℤq-ℕ⊞-lem : ∀ m f → sum μℤq (f ∘ _ℕ⊞_ m) ≡ sum μℤq f
  sumℤq-ℕ⊞-lem zero f = refl
  sumℤq-ℕ⊞-lem (suc m) f rewrite sumℤq-[suc]-lem (f ∘ _ℕ⊞_ m)
                               | sumℤq-ℕ⊞-lem m f = refl

  sumℤq-⊞-lem : ∀ m f → sum μℤq (f ∘ _⊞_ m) ≡ sum μℤq f
  sumℤq-⊞-lem = sumℤq-ℕ⊞-lem ∘ Fin.toℕ

module G-implem (p q : ℕ) (g' : Fin p) (0[p] 1[p] : Fin p) (0[q] 1[q] : Fin q) where
  open ℤq-implem q 0[q] 1[q] public
  open ℤq-implem p 0[p] 1[p] public using () renaming (ℤq to G; _⊠_ to _∙_; _[^]ℕ_ to _^[p]_)

  g : G
  g = g'

  _^_ : G → ℤq → G
  x ^ n = x ^[p] Fin.toℕ n

  g^_ : ℤq → G
  g^ n = g ^ n

  {-
  g^-inj : ∀ m n → g^ m ≡ g^ n → m ≡ n
  g^-inj = {!!}
  -}

module G-count
  (ℤq : ★)
  (_⊞_ : ℤq → ℤq → ℤq)
  (μℤq : SumProp ℤq)
  (sumℤq-⊞-lem : ∀ x f → sum μℤq (f ∘ _⊞_ x) ≡ sum μℤq f)
  (G : ★)
  (g : G)
  (_^_ : G → ℤq → G)
  (_∙_ : G → G → G)
  where

  g^_ : ℤq → G
  g^ n = g ^ n

  open ℤq-count ℤq _⊞_ μℤq sumℤq-⊞-lem

  ⁇G : ↺ `ℤq G
  run↺ ⁇G x = g^ x

  #G : Count G
  #G f = #q (f ∘ g^_)

  {-
  #G-∙ : ∀ f m → #G (f ∘ _∙_ m) ≡ #G f
  #G-∙ f m = {!!}
  -}

module DDH
  (ℤq  : ★)
  (_⊠_ : ℤq → ℤq → ℤq)
  (G   : ★)
  (g^_ : ℤq → G)
  where
    DDHAdv : ★ → ★
    DDHAdv R = R → G → G → G → Bit

    DDH⅁₀ : ∀ {R} {_I : ★} → DDHAdv R → (R × ℤq × ℤq × _I) → Bit
    DDH⅁₀ d (r , x , y , _) = d r (g^ x) (g^ y) (g^ (x ⊠ y))

    DDH⅁₁ : ∀ {R} → DDHAdv R → (R × ℤq × ℤq × ℤq) → Bit
    DDH⅁₁ d (r , x , y , z) = d r (g^ x) (g^ y) (g^ z)

    DDH⅁ : ∀ {R} → DDHAdv R → Bit → (R × ℤq × ℤq × ℤq) → Bit
    DDH⅁ d b = (case b 0→ DDH⅁₀ 1→ DDH⅁₁) d

    -- DDH⅁′ : ∀ {R} → DDHAdv R → (Bit × ℤq × ℤq × ℤq × R) → Bit
    -- DDH⅁′ d (b , x , y , z , r) = DDH⅁ d b (x , y , z , r)

    module With↺ where
        open Univ ℤq
        open `★ public renaming (`X to `ℤq)
        DDHAdv↺ : `★ → ★
        DDHAdv↺ R = G → G → G → ↺ R Bit
        DDH⅁₀↺ : ∀ {R _I} → DDHAdv↺ R → ↺ (R `× `ℤq `× `ℤq `× _I) Bit
        run↺ (DDH⅁₀↺ d) = DDH⅁₀ (λ x y z t → run↺ (d y z t) x)

module El-Gamal-Generic
  (ℤq : ★)
  (_⊠_ : ℤq → ℤq → ℤq)
  (G : ★)
  (g : G)
  (_^_ : G → ℤq → G)
  (Message : ★)
  (_∙_ : G → Message → Message)

  -- Required for decryption
  (_/_ : Message → G → Message)

  -- Required for the correctness proof
  (/-∙ : ∀ x y → (x ∙ y) / x ≡ y)
  (comm-^   : ∀ α x y → (α ^ x)^ y ≡ (α ^ y)^ x)

  -- Required for the security proof
  (dist-^-⊠ : ∀ α x y → α ^ (x ⊠ y) ≡ (α ^ x) ^ y)
  (μℤq : SumProp ℤq)
  (Rₐ : ★)
  (μRₐ : SumProp Rₐ)
  where

    g^_ : ℤq → G
    g^ x = g ^ x

    -- gˣ is the pk
    -- x is the sk

    PubKey = G
    SecKey = ℤq
    KeyPair = PubKey × SecKey
    CipherText = G × Message

    M = Message
    C = CipherText

    KeyGen : ℤq → KeyPair
    KeyGen x = (g^ x , x)

    -- KeyGen↺ : ↺ ℤq KeyPair
    -- KeyGen↺ = mk KeyGen

    Enc : PubKey → Message → ℤq → CipherText
    Enc gˣ m y = gʸ , ζ where
      gʸ = g^ y
      δ = gˣ ^ y
      ζ = δ ∙ m

    -- Enc↺ : PubKey → Message → ↺ ℤq CipherText
    -- Enc↺ gˣ m = mk (Enc gˣ m)

    Dec : SecKey → CipherText → Message
    Dec x (gʸ , ζ) = ζ / (gʸ ^ x)

    EncAdv : ★ → ★
    EncAdv Rₐ = (Rₐ → PubKey → Bit → M)
              × (Rₐ → PubKey → C → Bit)

    SS⅁ : ∀ {Rₐ _I : ★} → EncAdv Rₐ → Bit → (Rₐ × ℤq × ℤq × _I) → Bit
    SS⅁ (m , d) b (rₐ , x , y , z) =
      let pk = proj₁ (KeyGen x) in
      d rₐ pk (Enc pk (m rₐ pk b) y)

      -- Unused
    Game : (i : Bit) → ∀ {Rₐ} → EncAdv Rₐ → (Bit × Rₐ × ℤq × ℤq × ℤq) → Bit
    Game i (m , d) (b , rₐ , x , y , z) = b ==ᵇ d rₐ gˣ (gʸ , ζ)
      where gˣ = g^ x
            gʸ = g^ y
            δ  = gˣ ^ case i 0→ y 1→ z
            ζ  = δ ∙ m rₐ gˣ b

    {-
    Game-0b≡Game0 : ∀ {Rₐ} → Game 0b ≡ Game0 {Rₐ}
    Game-0b≡Game0 = refl
      -}

    open DDH ℤq _⊠_ G g^_ public

    OTP⅁ : ∀ {R : ★} → (R → G → Message) → (R → G → G → Message → Bit)
                     → (R × ℤq × ℤq × ℤq) → Bit
    OTP⅁ M d (r , x , y , z) = d r gˣ gʸ (gᶻ ∙ M r gˣ)
      where gˣ = g^ x
            gʸ = g^ y
            gᶻ = g^ z

    TrA : ∀ {Rₐ} → Bit → EncAdv Rₐ → DDHAdv Rₐ
    TrA b (m , d) rₐ gˣ gʸ gˣʸ = d rₐ gˣ (gʸ , gˣʸ ∙ m rₐ gˣ b)

    projM : ∀ {Rₐ} → EncAdv Rₐ → Bit → Rₐ → G → Message
    projM (m , _) b rₐ gˣ = m rₐ gˣ b

    projD : ∀ {Rₐ} → EncAdv Rₐ → Rₐ → G → G → Message → Bit
    projD (_ , d) rₐ gˣ gʸ gᶻ∙M = d rₐ gˣ (gʸ , gᶻ∙M)

    like-SS⅁ : ∀ {Rₐ _I : ★} → EncAdv Rₐ → Bit → (Rₐ × ℤq × ℤq × _I) → Bit
    like-SS⅁ (m , d) b (rₐ , x , y , _z) =
      d rₐ gˣ (gʸ , (gˣ ^ y) ∙ m rₐ gˣ b)
      where gˣ = g^ x
            gʸ = g^ y

    SS⅁≡like-SS⅁ : ∀ {R _I} → SS⅁ {R} {_I} ≡ like-SS⅁
    SS⅁≡like-SS⅁ = refl

    -- open Sum

    R = Rₐ × ℤq × ℤq × ℤq
    μR : SumProp R
    μR = μRₐ ×μ μℤq ×μ μℤq ×μ μℤq

    #R_ : Count R
    #R_ = count μR

    #q_ : Count ℤq
    #q_ = count μℤq

    _≈q_ : (f g : ℤq → Bit) → ★
    f ≈q g = #q f ≡ #q g

    _≈R_ : (f g : R → Bit) → ★
    f ≈R g = #R f ≡ #R g

    functional-correctness : ∀ x y m → Dec x (Enc (g^ x) m y) ≡ m
    functional-correctness x y m rewrite comm-^ g x y | /-∙ (g^ y ^ x) m = refl

    module Proof
        (ddh-hyp : ∀ A → DDH⅁ A 0b ≈R DDH⅁ A 1b)
        (otp-lem : ∀ A m₀ m₁ → (λ x → A (g^ x ∙ m₀)) ≈q (λ x → A (g^ x ∙ m₁)))
        (A : EncAdv Rₐ) (b : Bit)
      where

        OTP⅁-lem : ∀ d M₀ M₁ → OTP⅁ M₀ d ≈R OTP⅁ M₁ d
        OTP⅁-lem d M₀ M₁ = sum-ext μRₐ (λ r →
                             sum-ext μℤq (λ x →
                               sum-ext μℤq (λ y →
                                 pf r x y)))
          where
          pf : ∀ r x y → count μℤq (λ z → OTP⅁ M₀ d (r , x , y , z))
                       ≡ count μℤq (λ z → OTP⅁ M₁ d (r , x , y , z))
          pf r x y rewrite otp-lem (d r (g^ x) (g^ y)) (M₀ r (g^ x)) (M₁ r (g^ x))  = refl

        Aᵇ = TrA b A
        A¬ᵇ = TrA (not b) A

        pf0,5 : SS⅁ A b ≗ DDH⅁ Aᵇ 0b
        pf0,5 (r , x , y , z) rewrite dist-^-⊠ g x y = refl

        pf1 : SS⅁ A b ≈R DDH⅁ Aᵇ 0b
        pf1 = sum-ext μR (cong Bool.toℕ ∘ pf0,5)

        pf2 : DDH⅁ Aᵇ 0b ≈R DDH⅁ Aᵇ 1b
        pf2 = ddh-hyp Aᵇ

        pf2,5 : DDH⅁ Aᵇ 1b ≡ OTP⅁ (projM A b) (projD A)
        pf2,5 = refl

        pf3 : DDH⅁ Aᵇ 1b ≈R DDH⅁ A¬ᵇ 1b
        pf3 = OTP⅁-lem (projD A) (projM A b) (projM A (not b))

        pf4 : DDH⅁ A¬ᵇ 1b ≈R DDH⅁ A¬ᵇ 0b
        pf4 = ≡.sym (ddh-hyp A¬ᵇ)

        pf4,5 : SS⅁ A (not b) ≗ DDH⅁ A¬ᵇ 0b
        pf4,5 (r , x , y , z) rewrite dist-^-⊠ g x y = refl

        pf5 : SS⅁ A (not b) ≈R DDH⅁ A¬ᵇ 0b
        pf5 = sum-ext μR (cong Bool.toℕ ∘ pf4,5)

        final : SS⅁ A b ≈R SS⅁ A (not b)
        final rewrite pf1 | pf2 | pf3 | pf4 | pf5 = refl

module El-Gamal-Base
    (ℤq : ★)
    (_⊠_ : ℤq → ℤq → ℤq)
    (G : ★)
    (g : G)
    (_^_ : G → ℤq → G)
    (_∙_ : G → G → G)

    -- Required for decryption
    (_/_ : G → G → G)

    -- Required for the correctness proof
    (/-∙ : ∀ x y → (x ∙ y) / x ≡ y)
    (comm-^   : ∀ α x y → (α ^ x)^ y ≡ (α ^ y)^ x)

    {-
    (_⁻¹ : G → G)
    (⁻¹-inverse : ∀ x → x ⁻¹ ∙ x ≡ 1G)
    -}

    -- Required for the proof
    (dist-^-⊠ : ∀ α x y → α ^ (x ⊠ y) ≡ (α ^ x) ^ y)
    (μℤq : SumProp ℤq)
    (Rₐ : ★)
    (μRₐ : SumProp Rₐ)
    where

    open El-Gamal-Generic ℤq _⊠_ G g _^_ G _∙_
           _/_ /-∙ comm-^
           dist-^-⊠ μℤq Rₐ μRₐ public

    module OTP⅁-LEM
            (otp-lem1 : ∀ (A : G → Bit) m → (λ x → A (g^ x ∙ m)) ≈q (λ x → A (g^ x)))
      where

        otp-lem : ∀ (A : G → Bit) m₀ m₁ → (λ x → A (g^ x ∙ m₀)) ≈q (λ x → A (g^ x ∙ m₁))
        otp-lem A m₀ m₁ rewrite otp-lem1 A m₀ | otp-lem1 A m₁ = refl

module El-Gamal-Hashed
    (ℤq : ★)
    (_⊠_ : ℤq → ℤq → ℤq)
    (G : ★)
    (g : G)
    (_^_ : G → ℤq → G)
    -- (HKey : ★)
    (|M| : ℕ)
    (ℋ : {-HKey →-} G → Bits |M|)

    -- (/-∙ : ∀ x y → (x ∙ y) / x ≡ y)
    (comm-^   : ∀ α x y → (α ^ x)^ y ≡ (α ^ y)^ x)

    -- Required for the proof
    (dist-^-⊠ : ∀ α x y → α ^ (x ⊠ y) ≡ (α ^ x) ^ y)
    (μℤq : SumProp ℤq)
    (Rₐ : ★)
    (μRₐ : SumProp Rₐ)
    where

    Message = Bits |M|

    ℋ⟨_⟩⊕_ : G → Message → Message
    ℋ⟨ δ ⟩⊕ m = ℋ δ ⊕ m

    _/_ : Message → G → Message
    _/_ m δ = ℋ δ ⊕ m

    /-∙ : ∀ x y → ℋ⟨ x ⟩⊕ y / x ≡ y
    /-∙ x y = {!!}
    {-

    open El-Gamal-Generic ℤq _⊠_ G g _^_ Message ℋ⟨_⟩⊕_ _/_ {!!} {!!}
           dist-^-⊠ sumℤq sumℤq-ext Rₐ sumRₐ sumRₐ-ext public
           -}

           {-
    OTP⅁-lem : ∀ d M₀ M₁ → OTP⅁ M₀ d ≈R OTP⅁ M₁ d
    OTP⅁-lem = ?
    -}

module ⟨ℤp⟩★ p-3 {- p is prime -} (`Rₐ : `★) where
  p : ℕ
  p = 3 + p-3

  q : ℕ
  q = p ∸ 1

  module G = G-implem p q (## 2) (## 0) (## 1) (## 0) (## 1)
  open G

  postulate
    _⁻¹ : G → G
    _/_ : G → G → G
    /-• : ∀ x y → (x ∙ y) / x ≡ y
    comm-^ : ∀ α x y → (α ^ x)^ y ≡ (α ^ y)^ x
    dist-^-⊠ : ∀ α x y → α ^ (x ⊠ y) ≡ (α ^ x) ^ y

  open ℤq-count ℤq _⊞_ μℤq sumℤq-⊞-lem

  μRₐ : SumProp (El `Rₐ)
  μRₐ = μU μℤq `Rₐ

  Rₐ = El `Rₐ
  sumRₐ = sum μRₐ
  sumRₐ-ext = sum-ext μRₐ

  module EB = El-Gamal-Base _ _⊠_ G g _^_ _∙_ _/_ /-• comm-^ dist-^-⊠ μℤq Rₐ μRₐ
  open EB hiding (g^_)

  otp-base-lem : ∀ (A : G → Bit) m → (A ∘ g^_) ≈q (A ∘ g^_ ∘ _⊞_ m)
  otp-base-lem A m = #-StableUnderInjection {μ = μFin _} μFinSUI
         (A ∘ g^_) (_⊞_ m) (⊞-inj m)
   -- oh hai! this is:  sym (sumℤq-⊞-lem m (Bool.toℕ ∘ A ∘ g^_)) -- kthxbye

  postulate
    ddh-hyp : (A : DDHAdv Rₐ) → DDH⅁ A 0b ≈R DDH⅁ A 1b
    otp-lem : ∀ (A : G → Bit) m → (λ x → A (g^ x ∙ m)) ≈q (λ x → A (g^ x))

  open OTP⅁-LEM otp-lem

  {-
  final : ∀ A → SS⅁ A 0b ≈R SS⅁ A 1b
  final A = Proof.final ddh-hyp OTP⅁-lem A 0b
  -}

module ⟨ℤ11⟩★ = ⟨ℤp⟩★ (11 ∸ 3)
                   `X -- the amount of adversary randomness

        -- -}
        -- -}
        -- -}
        -- -}
        -- -}
        -- -}

{-# OPTIONS --copatterns #-}
open import Type
open import Function
open import Data.Product
open import Data.Bool.NP as Bool
open import Data.Unit
open import Data.Maybe.NP
import Data.Fin.NP as Fin
open Fin using (Fin; zero; suc) renaming (#_ to ##_)
open import Data.Nat.NP hiding (_^_)
open import Data.Bits
import Data.Vec.NP as Vec
open Vec using (Vec; []; _∷_; _∷ʳ_; allFin; lookup) renaming (map to vmap)
open import Algebra.FunctionProperties
open import Relation.Binary.PropositionalEquality as ≡
import cont as cont
open cont using (Cont; ContA)
open import sum
open import sum-properties

module elgamal where

data `★ : ★ where
  `⊤   : `★
  `X   : `★
  _`×_ : `★ → `★ → `★
infixr 2 _`×_

module Univ (X : ★) where
    El : `★ → ★
    El `⊤         = ⊤
    El `X         = X
    El (u₀ `× u₁) = El u₀ × El u₁

    record ↺ (R : `★) (A : ★) : ★ where
      constructor mk
      field
        run↺ : El R → A
    open ↺ public

    EXP : (R : `★) → ★
    EXP R = ↺ R Bit

    Det : ★ → ★
    Det = ↺ `⊤

    μU : SumProp X → ∀ u → SumProp (El u)
    μU μX `⊤         = μ⊤
    μU μX `X         = μX
    μU μX (u₀ `× u₁) = μU μX u₀ ×μ μU μX u₁

module EntropySmoothing
  (M    : ★)        -- Message
  (Hash : ★)
  (ℋ   : M → Hash) -- Hashing function
  (Rₐ   : ★)        -- Adversary randomness
  where

  -- Entropy smoothing adversary
  ESAdv : ★
  ESAdv = Rₐ → Hash → Bit

  -- The randomness universe needed for the following games
  R : ★
  R = M × Hash × Rₐ

  -- In this game we always use ℋ on a random message
  ES⅁₀ : ESAdv → R → Bit
  ES⅁₀ A (m , _ , rₐ) = A rₐ (ℋ m)

  -- In this game we just retrun a random Hash value
  ES⅁₁ : ESAdv → R → Bit
  ES⅁₁ A (_ , h , rₐ) = A rₐ h

  ES⅁ : ESAdv → Bit → R → Bit
  ES⅁ A b r = (case b 0→ ES⅁₀ 1→ ES⅁₁) A r

module EntropySmoothingWithKey
  (M    : ★)
  (Key  : ★)
  (Hash : ★)
  (ℋ   : Key → M → Hash) -- Hashing function
  (Rₐ   : ★)              -- Adversary randomness
  where

  -- Entropy smoothing adversary
  ESAdv : ★
  ESAdv = Rₐ → Key → Hash → Bit

  -- The randomness universe needed for the following games
  R : ★
  R = Key × M × Hash × Rₐ

  -- In this game we always use ℋ on a random message
  ES⅁₀ : ESAdv → R → Bit
  ES⅁₀ A (k , m , _ , rₐ) = A rₐ k (ℋ k m)

  -- In this game we just retrun a random Hash value
  ES⅁₁ : ESAdv → R → Bit
  ES⅁₁ A (k , _ , h , rₐ) = A rₐ k h

  ES⅁ : ESAdv → Bit → R → Bit
  ES⅁ A b r = (case b 0→ ES⅁₀ 1→ ES⅁₁) A r

module ℤq-count
  (ℤq : ★)
  (_⊞_ : ℤq → ℤq → ℤq)
  (μℤq : SumProp ℤq)
  (sumℤq-⊞-lem : ∀ x f → sum μℤq (f ∘ _⊞_ x) ≡ sum μℤq f)
  where

  -- open Sum
  open Univ ℤq public
  open `★ public renaming (`X to `ℤq)

  #_ : ∀ {u} → ↺ u Bit → ℕ
  #_ {u} f = sum (μU μℤq u) (Bool.toℕ ∘ run↺ f)

  #q_ : Count ℤq
  #q_ = count μℤq

  ⁇ : ∀ R → ↺ R (El R)
  run↺ (⁇ _) = id

  pure↺ : ∀ {R A} → A → ↺ R A
  run↺ (pure↺ x) r = x -- turning r to _ produce an error

  ⟪_⟫ : ∀ {R A} → A → ↺ R A
  ⟪_⟫ = pure↺

  {-
  ⟪_⟫ᴰ : ∀ {a} {A : Set a} → A → Det A
  ⟪_⟫ᴰ = pureᴰ
  -}

  map↺ : ∀ {A B R} → (A → B) → ↺ R A → ↺ R B
  run↺ (map↺ f x) r = f (run↺ x r)

  infixl 4 _⊛_
  _⊛_ : ∀ {R S A B} → ↺ R (A → B) → ↺ S A → ↺ (R `× S) B
  run↺ (af ⊛ ax) rs = run↺ af (proj₁ rs) (run↺ ax (proj₂ rs))

  ⟪_·_⟫ : ∀ {A B R} → (A → B) → ↺ R A → ↺ R B
  ⟪ f · x ⟫ = map↺ f x

  ⟪_·_·_⟫ : ∀ {A B C} {R S} →
              (A → B → C) → ↺ R A → ↺ S B → ↺ (R `× S) C
  ⟪ f · x · y ⟫ = map↺ f x ⊛ y

  _⟨⊞⟩_ : ∀ {R S} → ↺ R ℤq → ↺ S ℤq → ↺ (R `× S) ℤq
  x ⟨⊞⟩ y = ⟪ _⊞_ · x · y ⟫

  ⟨_⊞⟩_ : ∀ {R} → ℤq → ↺ R ℤq → ↺ R ℤq
  ⟨ x ⊞⟩ y = ⟪ _⊞_ x · y ⟫

  infix 4 _≈↺_ _≈ᴬ_
  _≈↺_ : ∀ {R : `★} (f g : EXP R) → ★
  _≈↺_ = _≡_ on #_

  _≈ᴬ_ : ∀ {A R} (f g : ↺ R A) → Set _
  _≈ᴬ_ {A} f g = ∀ (Adv : A → Bit) → ⟪ Adv · f ⟫ ≈↺ ⟪ Adv · g ⟫

  lem : ∀ x → ⟨ x ⊞⟩ (⁇ `ℤq) ≈ᴬ ⁇ _
  lem x Adv = sumℤq-⊞-lem x (Bool.toℕ ∘ Adv)

  -- ∀ (A : ℤq → Bit) → # (A ⁇)

open Fin.Modulo renaming (sucmod to [suc])

{-
module ℤq-implem (q-2 : ℕ) where
  q : ℕ
  q = 2 + q-2

  ℤq : ★
  ℤq = Fin q

  [0] : ℤq
  [0] = zero

  [1] : ℤq
  [1] = suc zero
-}
module ℤq-implem (q : ℕ) ([0]' [1]' : Fin q) where
  -- open Sum
  ℤq : ★
  ℤq = Fin q

  [0] : ℤq
  [0] = [0]'

  [1] : ℤq
  [1] = [1]'

  _ℕ⊞_ : ℕ → ℤq → ℤq
  zero  ℕ⊞ n = n
  suc m ℕ⊞ n = m ℕ⊞ ([suc] n)
  {-
  zero  ℕ⊞ n = n
  suc m ℕ⊞ n = [suc] (m ℕ⊞ n)
  -}

  ℕ⊞-inj : ∀ n {x y} → n ℕ⊞ x ≡ n ℕ⊞ y → x ≡ y
  ℕ⊞-inj zero    eq = eq
  ℕ⊞-inj (suc n) eq = sucmod-inj _ _ (ℕ⊞-inj n eq)

  _⊞_ : ℤq → ℤq → ℤq
  m ⊞ n = Fin.toℕ m ℕ⊞ n

  ⊞-inj : ∀ m {x y} → m ⊞ x ≡ m ⊞ y → x ≡ y
  ⊞-inj m = ℕ⊞-inj (Fin.toℕ m)

  _ℕ⊠_ : ℕ → ℤq → ℤq
  zero  ℕ⊠ n = [0]
  suc m ℕ⊠ n = n ⊞ (m ℕ⊠ n)

  _⊠_ : ℤq → ℤq → ℤq
  m ⊠ n = Fin.toℕ m ℕ⊠ n

  _[^]ℕ_ : ℤq → ℕ → ℤq
  m [^]ℕ zero  = [1]
  m [^]ℕ suc n = m ⊠ (m [^]ℕ n)

  _[^]_ : ℤq → ℤq → ℤq
  m [^] n = m [^]ℕ (Fin.toℕ n)

  μℤq : SumProp ℤq
  μℤq = μFin q

  allℤq : Vec ℤq q
  allℤq = allFin q

  {-
  sumℤq : Sum ℤq
  sumℤq f = Vec.sum (vmap f allℤq)
  -}

  sumℤq-[suc]-lem : ∀ f → sum μℤq (f ∘ [suc]) ≡ sum μℤq f
  sumℤq-[suc]-lem f rewrite ≡.sym (Vec.sum-map-rot₁ f allℤq)
                          | Vec.map-∘ f [suc] allℤq
                          | rot₁-map-sucmod q
                          = refl

  --  comm-[suc]-ℕ⊞ : ∀ m n → [suc] (m ℕ⊞ n) ≡ m ℕ⊞ ([suc] n)

  sumℤq-ℕ⊞-lem : ∀ m f → sum μℤq (f ∘ _ℕ⊞_ m) ≡ sum μℤq f
  sumℤq-ℕ⊞-lem zero f = refl
  sumℤq-ℕ⊞-lem (suc m) f rewrite sumℤq-[suc]-lem (f ∘ _ℕ⊞_ m)
                               | sumℤq-ℕ⊞-lem m f = refl

  sumℤq-⊞-lem : ∀ m f → sum μℤq (f ∘ _⊞_ m) ≡ sum μℤq f
  sumℤq-⊞-lem = sumℤq-ℕ⊞-lem ∘ Fin.toℕ

module G-implem (p q : ℕ) (g' : Fin p) (0[p] 1[p] : Fin p) (0[q] 1[q] : Fin q) where
  open ℤq-implem q 0[q] 1[q] public
  open ℤq-implem p 0[p] 1[p] public using () renaming (ℤq to G; _⊠_ to _∙_; _[^]ℕ_ to _^[p]_)

  g : G
  g = g'

  _^_ : G → ℤq → G
  x ^ n = x ^[p] Fin.toℕ n

  g^_ : ℤq → G
  g^ n = g ^ n

  {-
  g^-inj : ∀ m n → g^ m ≡ g^ n → m ≡ n
  g^-inj = {!!}
  -}

module G-count
  (ℤq : ★)
  (_⊞_ : ℤq → ℤq → ℤq)
  (μℤq : SumProp ℤq)
  (sumℤq-⊞-lem : ∀ x f → sum μℤq (f ∘ _⊞_ x) ≡ sum μℤq f)
  (G : ★)
  (g : G)
  (_^_ : G → ℤq → G)
  (_∙_ : G → G → G)
  where

  g^_ : ℤq → G
  g^ n = g ^ n

  open ℤq-count ℤq _⊞_ μℤq sumℤq-⊞-lem

  ⁇G : ↺ `ℤq G
  run↺ ⁇G x = g^ x

  #G : Count G
  #G f = #q (f ∘ g^_)

  {-
  #G-∙ : ∀ f m → #G (f ∘ _∙_ m) ≡ #G f
  #G-∙ f m = {!!}
  -}

module DDH
  (ℤq  : ★)
  (_⊠_ : ℤq → ℤq → ℤq)
  (G   : ★)
  (g^_ : ℤq → G)
  where
    DDHAdv : ★ → ★
    DDHAdv R = R → G → G → G → Bit

    DDH⅁₀ : ∀ {R} {_I : ★} → DDHAdv R → (R × ℤq × ℤq × _I) → Bit
    DDH⅁₀ d (r , x , y , _) = d r (g^ x) (g^ y) (g^ (x ⊠ y))

    DDH⅁₁ : ∀ {R} → DDHAdv R → (R × ℤq × ℤq × ℤq) → Bit
    DDH⅁₁ d (r , x , y , z) = d r (g^ x) (g^ y) (g^ z)

    DDH⅁ : ∀ {R} → DDHAdv R → Bit → (R × ℤq × ℤq × ℤq) → Bit
    DDH⅁ d b = (case b 0→ DDH⅁₀ 1→ DDH⅁₁) d

    -- DDH⅁′ : ∀ {R} → DDHAdv R → (Bit × ℤq × ℤq × ℤq × R) → Bit
    -- DDH⅁′ d (b , x , y , z , r) = DDH⅁ d b (x , y , z , r)

    module With↺ where
        open Univ ℤq
        open `★ public renaming (`X to `ℤq)
        DDHAdv↺ : `★ → ★
        DDHAdv↺ R = G → G → G → ↺ R Bit
        DDH⅁₀↺ : ∀ {R _I} → DDHAdv↺ R → ↺ (R `× `ℤq `× `ℤq `× _I) Bit
        run↺ (DDH⅁₀↺ d) = DDH⅁₀ (λ a b c d → run↺ (d b c d) a)

module El-Gamal-Generic
  (ℤq : ★)
  (_⊠_ : ℤq → ℤq → ℤq)
  (G : ★)
  (g : G)
  (_^_ : G → ℤq → G)
  (Message : ★)
  (_∙_ : G → Message → Message)

  -- Required for decryption
  (_/_ : Message → G → Message)

  -- Required for the correctness proof
  (/-∙ : ∀ x y → (x ∙ y) / x ≡ y)
  (comm-^   : ∀ α x y → (α ^ x)^ y ≡ (α ^ y)^ x)

  -- Required for the security proof
  (dist-^-⊠ : ∀ α x y → α ^ (x ⊠ y) ≡ (α ^ x) ^ y)
  (μℤq : SumProp ℤq)
  (Rₐ : ★)
  (μRₐ : SumProp Rₐ)
  where

    g^_ : ℤq → G
    g^ x = g ^ x

    -- gˣ is the pk
    -- x is the sk

    PubKey = G
    SecKey = ℤq
    KeyPair = PubKey × SecKey
    CipherText = G × Message

    M = Message
    C = CipherText

    KeyGen : ℤq → KeyPair
    KeyGen x = (g^ x , x)

    -- KeyGen↺ : ↺ ℤq KeyPair
    -- KeyGen↺ = mk KeyGen

    Enc : PubKey → Message → ℤq → CipherText
    Enc gˣ m y = gʸ , ζ where
      gʸ = g^ y
      δ = gˣ ^ y
      ζ = δ ∙ m

    -- Enc↺ : PubKey → Message → ↺ ℤq CipherText
    -- Enc↺ gˣ m = mk (Enc gˣ m)

    Dec : SecKey → CipherText → Message
    Dec x (gʸ , ζ) = ζ / (gʸ ^ x)

    EncAdv : ★ → ★
    EncAdv Rₐ = (Rₐ → PubKey → Bit → M)
              × (Rₐ → PubKey → C → Bit)

    SS⅁ : ∀ {Rₐ _I : ★} → EncAdv Rₐ → Bit → (Rₐ × ℤq × ℤq × _I) → Bit
    SS⅁ (m , d) b (rₐ , x , y , z) =
      let pk = proj₁ (KeyGen x) in
      d rₐ pk (Enc pk (m rₐ pk b) y)

      -- Unused
    Game : (i : Bit) → ∀ {Rₐ} → EncAdv Rₐ → (Bit × Rₐ × ℤq × ℤq × ℤq) → Bit
    Game i (m , d) (b , rₐ , x , y , z) = b ==ᵇ d rₐ gˣ (gʸ , ζ)
      where gˣ = g^ x
            gʸ = g^ y
            δ  = gˣ ^ case i 0→ y 1→ z
            ζ  = δ ∙ m rₐ gˣ b

    {-
    Game-0b≡Game0 : ∀ {Rₐ} → Game 0b ≡ Game0 {Rₐ}
    Game-0b≡Game0 = refl
      -}

    open DDH ℤq _⊠_ G g^_ public

    OTP⅁ : ∀ {R : ★} → (R → G → Message) → (R → G → G → Message → Bit)
                     → (R × ℤq × ℤq × ℤq) → Bit
    OTP⅁ M d (r , x , y , z) = d r gˣ gʸ (gᶻ ∙ M r gˣ)
      where gˣ = g^ x
            gʸ = g^ y
            gᶻ = g^ z

    TrA : ∀ {Rₐ} → Bit → EncAdv Rₐ → DDHAdv Rₐ
    TrA b (m , d) rₐ gˣ gʸ gˣʸ = d rₐ gˣ (gʸ , gˣʸ ∙ m rₐ gˣ b)

    projM : ∀ {Rₐ} → EncAdv Rₐ → Bit → Rₐ → G → Message
    projM (m , _) b rₐ gˣ = m rₐ gˣ b

    projD : ∀ {Rₐ} → EncAdv Rₐ → Rₐ → G → G → Message → Bit
    projD (_ , d) rₐ gˣ gʸ gᶻ∙M = d rₐ gˣ (gʸ , gᶻ∙M)

    like-SS⅁ : ∀ {Rₐ _I : ★} → EncAdv Rₐ → Bit → (Rₐ × ℤq × ℤq × _I) → Bit
    like-SS⅁ (m , d) b (rₐ , x , y , _z) =
      d rₐ gˣ (gʸ , (gˣ ^ y) ∙ m rₐ gˣ b)
      where gˣ = g^ x
            gʸ = g^ y

    SS⅁≡like-SS⅁ : ∀ {R _I} → SS⅁ {R} {_I} ≡ like-SS⅁
    SS⅁≡like-SS⅁ = refl

    -- open Sum

    R = Rₐ × ℤq × ℤq × ℤq
    μR : SumProp R
    μR = μRₐ ×μ μℤq ×μ μℤq ×μ μℤq

    #R_ : Count R
    #R_ = count μR

    #q_ : Count ℤq
    #q_ = count μℤq

    _≈q_ : (f g : ℤq → Bit) → ★
    f ≈q g = #q f ≡ #q g

    _≈R_ : (f g : R → Bit) → ★
    f ≈R g = #R f ≡ #R g

    functional-correctness : ∀ x y m → Dec x (Enc (g^ x) m y) ≡ m
    functional-correctness x y m rewrite comm-^ g x y | /-∙ (g^ y ^ x) m = refl

    module Proof
        (ddh-hyp : ∀ A → DDH⅁ A 0b ≈R DDH⅁ A 1b)
        (otp-lem : ∀ A m₀ m₁ → (λ x → A (g^ x ∙ m₀)) ≈q (λ x → A (g^ x ∙ m₁)))
        (A : EncAdv Rₐ) (b : Bit)
      where

        OTP⅁-lem : ∀ d M₀ M₁ → OTP⅁ M₀ d ≈R OTP⅁ M₁ d
        OTP⅁-lem d M₀ M₁ = sum-ext μRₐ (λ r →
                             sum-ext μℤq (λ x →
                               sum-ext μℤq (λ y →
                                 pf r x y)))
          where
          pf : ∀ r x y → count μℤq (λ z → OTP⅁ M₀ D (r , x , y , z))
                       ≡ count μℤq (λ z → OTP⅁ M₁ D (r , x , y , z))
          pf r x y rewrite otp-lem (D r (g^ x) (g^ y)) (M₀ r (g^ x)) (M₁ r (g^ x))  = refl

        Aᵇ = TrA b A
        A¬ᵇ = TrA (not b) A

        pf0,5 : SS⅁ A b ≗ DDH⅁ Aᵇ 0b
        pf0,5 (r , x , y , z) rewrite dist-^-⊠ g x y = refl

        pf1 : SS⅁ A b ≈R DDH⅁ Aᵇ 0b
        pf1 = sum-ext μR (cong Bool.toℕ ∘ pf0,5)

        pf2 : DDH⅁ Aᵇ 0b ≈R DDH⅁ Aᵇ 1b
        pf2 = ddh-hyp Aᵇ

        pf2,5 : DDH⅁ Aᵇ 1b ≡ OTP⅁ (projM A b) (projD A)
        pf2,5 = refl

        pf3 : DDH⅁ Aᵇ 1b ≈R DDH⅁ A¬ᵇ 1b
        pf3 = OTP⅁-lem (projD A) (projM A b) (projM A (not b))

        pf4 : DDH⅁ A¬ᵇ 1b ≈R DDH⅁ A¬ᵇ 0b
        pf4 = ≡.sym (ddh-hyp A¬ᵇ)

        pf4,5 : SS⅁ A (not b) ≗ DDH⅁ A¬ᵇ 0b
        pf4,5 (r , x , y , z) rewrite dist-^-⊠ g x y = refl

        pf5 : SS⅁ A (not b) ≈R DDH⅁ A¬ᵇ 0b
        pf5 = sum-ext μR (cong Bool.toℕ ∘ pf4,5)

        final : SS⅁ A b ≈R SS⅁ A (not b)
        final rewrite pf1 | pf2 | pf3 | pf4 | pf5 = refl

module El-Gamal-Base
    (ℤq : ★)
    (_⊠_ : ℤq → ℤq → ℤq)
    (G : ★)
    (g : G)
    (_^_ : G → ℤq → G)
    (_∙_ : G → G → G)

    -- Required for decryption
    (_/_ : G → G → G)

    -- Required for the correctness proof
    (/-∙ : ∀ x y → (x ∙ y) / x ≡ y)
    (comm-^   : ∀ α x y → (α ^ x)^ y ≡ (α ^ y)^ x)

    {-
    (_⁻¹ : G → G)
    (⁻¹-inverse : ∀ x → x ⁻¹ ∙ x ≡ 1G)
    -}

    -- Required for the proof
    (dist-^-⊠ : ∀ α x y → α ^ (x ⊠ y) ≡ (α ^ x) ^ y)
    (μℤq : SumProp ℤq)
    (Rₐ : ★)
    (μRₐ : SumProp Rₐ)
    where

    open El-Gamal-Generic ℤq _⊠_ G g _^_ G _∙_
           _/_ /-∙ comm-^
           dist-^-⊠ μℤq Rₐ μRₐ public

    module OTP⅁-LEM
            (otp-lem1 : ∀ (A : G → Bit) m → (λ x → A (g^ x ∙ m)) ≈q (λ x → A (g^ x)))
      where

        otp-lem : ∀ (A : G → Bit) m₀ m₁ → (λ x → A (g^ x ∙ m₀)) ≈q (λ x → A (g^ x ∙ m₁))
        otp-lem A m₀ m₁ rewrite otp-lem1 A m₀ | otp-lem1 A m₁ = refl

module El-Gamal-Hashed
    (ℤq : ★)
    (_⊠_ : ℤq → ℤq → ℤq)
    (G : ★)
    (g : G)
    (_^_ : G → ℤq → G)
    -- (HKey : ★)
    (|M| : ℕ)
    (ℋ : {-HKey →-} G → Bits |M|)

    -- (/-∙ : ∀ x y → (x ∙ y) / x ≡ y)
    (comm-^   : ∀ α x y → (α ^ x)^ y ≡ (α ^ y)^ x)

    -- Required for the proof
    (dist-^-⊠ : ∀ α x y → α ^ (x ⊠ y) ≡ (α ^ x) ^ y)
    (μℤq : SumProp ℤq)
    (Rₐ : ★)
    (μRₐ : SumProp Rₐ)
    where

    Message = Bits |M|

    ℋ⟨_⟩⊕_ : G → Message → Message
    ℋ⟨ δ ⟩⊕ m = ℋ δ ⊕ m

    _/_ : Message → G → Message
    _/_ m δ = ℋ δ ⊕ m

    /-∙ : ∀ x y → ℋ⟨ x ⟩⊕ y / x ≡ y
    /-∙ x y = {!!}
    {-

    open El-Gamal-Generic ℤq _⊠_ G g _^_ Message ℋ⟨_⟩⊕_ _/_ {!!} {!!}
           dist-^-⊠ sumℤq sumℤq-ext Rₐ sumRₐ sumRₐ-ext public
           -}

           {-
    OTP⅁-lem : ∀ d M₀ M₁ → OTP⅁ M₀ d ≈R OTP⅁ M₁ d
    OTP⅁-lem = ?
    -}

module ⟨ℤp⟩★ p-3 {- p is prime -} (`Rₐ : `★) where
  p : ℕ
  p = 3 + p-3

  q : ℕ
  q = p ∸ 1

  module G = G-implem p q (## 2) (## 0) (## 1) (## 0) (## 1)
  open G

  postulate
    _⁻¹ : G → G
    _/_ : G → G → G
    /-• : ∀ x y → (x ∙ y) / x ≡ y
    comm-^ : ∀ α x y → (α ^ x)^ y ≡ (α ^ y)^ x
    dist-^-⊠ : ∀ α x y → α ^ (x ⊠ y) ≡ (α ^ x) ^ y

  open ℤq-count ℤq _⊞_ μℤq sumℤq-⊞-lem

  μRₐ : SumProp (El `Rₐ)
  μRₐ = μU μℤq `Rₐ

  Rₐ = El `Rₐ
  sumRₐ = sum μRₐ
  sumRₐ-ext = sum-ext μRₐ

  module EB = El-Gamal-Base _ _⊠_ G g _^_ _∙_ _/_ /-• comm-^ dist-^-⊠ μℤq Rₐ μRₐ
  open EB hiding (g^_)

  otp-base-lem : ∀ (A : G → Bit) m → (A ∘ g^_) ≈q (A ∘ g^_ ∘ _⊞_ m)
  otp-base-lem A m = #-StableUnderInjection {μ = μFin _} μFinSUI
         (A ∘ g^_) (_⊞_ m) (⊞-inj m)
   -- oh hai! this is:  sym (sumℤq-⊞-lem m (Bool.toℕ ∘ A ∘ g^_)) -- kthxbye

  postulate
    ddh-hyp : (A : DDHAdv Rₐ) → DDH⅁ A 0b ≈R DDH⅁ A 1b
    otp-lem : ∀ (A : G → Bit) m → (λ x → A (g^ x ∙ m)) ≈q (λ x → A (g^ x))

  open OTP⅁-LEM otp-lem

  {-
  final : ∀ A → SS⅁ A 0b ≈R SS⅁ A 1b
  final A = Proof.final ddh-hyp OTP⅁-lem A 0b
  -}

module ⟨ℤ11⟩★ = ⟨ℤp⟩★ (11 ∸ 3)
                   `X -- the amount of adversary randomness

        -- -}
        -- -}
        -- -}
        -- -}
        -- -}
        -- -}


regen the crypto-agda toplevel file

regen the crypto-agda toplevel file

module crypto-agda where
import Attack.Compression
import Attack.Reencryption
import Crypto.Cipher.ElGamal.CPA-DDH
import Crypto.Cipher.ElGamal.Generic
import Crypto.Cipher.ElGamal.Group
import Crypto.Cipher.ElGamal.Homomorphic
import Composition.Forkable
import Composition.Horizontal
import Composition.Vertical
import Control.Beh
import Control.Protocol.BiSim
import Control.Protocol.CoreOld
import Control.Protocol.Reduction
import Control.Strategy
import Control.Strategy.Utils
import Crypto.Schemes
import FiniteField.FinImplem
import FiniteField.JS
import FunUniverse.Agda
import FunUniverse.BinTree
import FunUniverse.Bits
import FunUniverse.Category
import FunUniverse.Category.Op
import FunUniverse.Circuit
import FunUniverse.Const
import FunUniverse.Core
import FunUniverse.Cost
import FunUniverse.Data
import FunUniverse.Defaults.FirstPart
-- import FunUniverse.ExnArrow
import FunUniverse.Fin
import FunUniverse.Fin.Op
import FunUniverse.Fin.Op.Abstract
-- import FunUniverse.FlatFunsProd
import FunUniverse.Interface.Bits
import FunUniverse.Interface.Two
import FunUniverse.Interface.Vec
import FunUniverse.Inverse
import FunUniverse.Loop
import FunUniverse.Nand
import FunUniverse.Nand.Function
import FunUniverse.Nand.Properties
import FunUniverse.README
import FunUniverse.Rewiring.Linear
-- import FunUniverse.State
import FunUniverse.Syntax
import FunUniverse.Types
import Game.Challenge
import Game.DDH
import Game.EntropySmoothing
import Game.EntropySmoothing.WithKey
import Game.Generic
import Game.IND-CCA
import Game.IND-CCA2-dagger
import Game.IND-CCA2-dagger.Adversary
import Game.IND-CCA2-dagger.Experiment
import Game.IND-CCA2-dagger.Protocol
import Game.IND-CCA2-dagger.ProtocolImplementation
import Game.IND-CCA2-dagger.Valid
import Game.IND-CCA2-gen.Protocol
import Game.IND-CCA2-gen.ProtocolImplementation
import Game.IND-CCA2
-- import Game.IND-CCA2.Advantage
import Game.IND-CPA-alt
import Game.IND-CPA-dagger
import Game.IND-CPA-utils
import Game.IND-CPA
import Game.IND-CPA.Core
import Game.IND-NM-CPA
import Game.NCE
import Game.ReceiptFreeness
import Game.ReceiptFreeness.Adversary
import Game.ReceiptFreeness.CheatingAdversaries
import Game.ReceiptFreeness.Definitions
import Game.ReceiptFreeness.Definitions.Encryption
import Game.ReceiptFreeness.Definitions.Receipt
import Game.ReceiptFreeness.Definitions.Tally
import Game.ReceiptFreeness.Experiment
import Game.ReceiptFreeness.Protocol
import Game.ReceiptFreeness.ProtocolImplementation
import Game.ReceiptFreeness.Valid
import Game.ReceiptFreeness.ValidInst
import Game.Transformation.CCA-CPA
import Game.Transformation.CCA2-CCA
import Game.Transformation.CCA2-CCA2d
import Game.Transformation.CCA2d-CCA2
import Game.Transformation.CPA-CPAd
import Game.Transformation.CPAd-CPA
import Game.Transformation.Naor-Yung-proof
import Game.Transformation.Naor-Yung
import Game.Transformation.ReceiptFreeness-CCA2d
import Game.Transformation.ReceiptFreeness-CCA2d.Proof
import Game.Transformation.ReceiptFreeness-CCA2d.Protocol
--TODO import Game.Transformation.ReceiptFreeness-CCA2d.ProtocolImplementation
import Game.Transformation.ReceiptFreeness-CCA2d.Simulator
import Game.Transformation.ReceiptFreeness-CCA2d.SimulatorInst
--TODO import Game.Transformation.ReceiptFreeness-CCA2d.Valid
import Helios
import Language.Simple.Abstract
import Language.Simple.Free
import Language.Simple.Interface
import Language.Simple.Two.Mux
import Language.Simple.Two.Mux.Normalise
import Language.Simple.Two.Nand
import Negligible
import README
import Solver.AddMax
import Solver.Linear
import Solver.Linear.Examples
import Solver.Linear.Parser
import Solver.Linear.Syntax
import ZK.ChaumPedersen
-- import ZK.Disjunctive
import ZK.GroupHom
import ZK.GroupHom.ElGamal
import ZK.GroupHom.FieldChal
import ZK.GroupHom.FieldChal2
import ZK.GroupHom.FieldChal3
import ZK.GroupHom.NatChal
import ZK.GroupHom.NumChal
import ZK.GroupHom.Types
import ZK.JSChecker
import ZK.Lemmas
import ZK.PartialHeliosVerifier
import ZK.Schnorr
import ZK.Schnorr.KnownStatement
import ZK.SigmaProtocol
import ZK.SigmaProtocol.KnownStatement
import ZK.SigmaProtocol.Map
import ZK.SigmaProtocol.Signature
import ZK.SigmaProtocol.Structure
import ZK.SigmaProtocol.Types
import ZK.Statement
-- import ZK.Strong-Fiat-Shamir
import ZK.Types
import adder
import alea.cpo
import bijection-syntax.Bijection-Fin
import bijection-syntax.Bijection
import bijection-syntax.README
import circuits.bytecode
import circuits.circuit
import cycle-id
import cycle
import cycle3
import cyclic10
import forking-lemma
-- import hash-param
-- import misc.merkle-tree
-- import misc.secret-sharing
-- import misc.zk
-- import rewind-on-success
import sha1

module crypto-agda where

--import Control.Protocol
import Explore.README

import Attack.Compression
import Attack.Reencryption
import Crypto.Cipher.ElGamal.CPA-DDH
import Crypto.Cipher.ElGamal.Generic
import Crypto.Cipher.ElGamal.Group
import Crypto.Cipher.ElGamal.Homomorphic
import Composition.Forkable
import Composition.Horizontal
import Composition.Vertical
import Control.Beh
import Control.Protocol.BiSim
import Control.Protocol.CoreOld
import Control.Protocol.Reduction
import Control.Strategy
import Control.Strategy.Utils
import Crypto.Schemes
import FiniteField.FinImplem
import FunUniverse.Agda
import FunUniverse.BinTree
import FunUniverse.Bits
import FunUniverse.Category
import FunUniverse.Category.Op
import FunUniverse.Circuit
import FunUniverse.Const
import FunUniverse.Core
import FunUniverse.Cost
import FunUniverse.Data
import FunUniverse.Defaults.FirstPart
--import FunUniverse.ExnArrow
import FunUniverse.Fin
import FunUniverse.Fin.Op
import FunUniverse.Fin.Op.Abstract
--import FunUniverse.FlatFunsProd
import FunUniverse.Interface.Bits
import FunUniverse.Interface.Two
import FunUniverse.Interface.Vec
import FunUniverse.Inverse
import FunUniverse.Loop
import FunUniverse.Nand
import FunUniverse.Nand.Function
import FunUniverse.Nand.Properties
import FunUniverse.README
import FunUniverse.Rewiring.Linear
--import FunUniverse.State
import FunUniverse.Syntax
import FunUniverse.Types
import Game.Challenge
import Game.DDH
import Game.EntropySmoothing
import Game.EntropySmoothing.WithKey
import Game.Generic
import Game.IND-CCA
import Game.IND-CCA2-dagger
import Game.IND-CCA2-dagger.Adversary
import Game.IND-CCA2-dagger.Experiment
import Game.IND-CCA2-dagger.Protocol
import Game.IND-CCA2-dagger.ProtocolImplementation
import Game.IND-CCA2-dagger.Valid
import Game.IND-CCA2-gen.Protocol
import Game.IND-CCA2-gen.ProtocolImplementation
import Game.IND-CCA2
import Game.IND-CPA-alt
import Game.IND-CPA-dagger
import Game.IND-CPA-utils
import Game.IND-CPA
import Game.NCE
import Game.ReceiptFreeness
import Game.ReceiptFreeness.Adversary
import Game.ReceiptFreeness.CheatingAdversaries
import Game.ReceiptFreeness.Definitions
import Game.ReceiptFreeness.Definitions.Encryption
import Game.ReceiptFreeness.Definitions.Receipt
import Game.ReceiptFreeness.Definitions.Tally
import Game.ReceiptFreeness.Experiment
import Game.ReceiptFreeness.Protocol
import Game.ReceiptFreeness.ProtocolImplementation
import Game.ReceiptFreeness.Valid
import Game.ReceiptFreeness.ValidInst
import Game.Transformation.CCA-CPA
import Game.Transformation.CCA2-CCA
--import Game.Transformation.CCA2-CCA2d
import Game.Transformation.CCA2d-CCA2
import Game.Transformation.CPA-CPAd
import Game.Transformation.CPAd-CPA
import Game.Transformation.Naor-Yung-proof
import Game.Transformation.Naor-Yung
import Game.Transformation.ReceiptFreeness-CCA2d
import Game.Transformation.ReceiptFreeness-CCA2d.Proof
import Game.Transformation.ReceiptFreeness-CCA2d.Protocol
import Game.Transformation.ReceiptFreeness-CCA2d.ProtocolImplementation
import Game.Transformation.ReceiptFreeness-CCA2d.Simulator
import Game.Transformation.ReceiptFreeness-CCA2d.SimulatorInst
-- import Game.Transformation.ReceiptFreeness-CCA2d.Valid
import Language.Simple.Abstract
import Language.Simple.Free
import Language.Simple.Interface
import Language.Simple.Two.Mux
import Language.Simple.Two.Mux.Normalise
import Language.Simple.Two.Nand
import README
import Solver.AddMax
import Solver.Linear
import Solver.Linear.Examples
import Solver.Linear.Parser
import Solver.Linear.Syntax
import ZK.PartialHeliosVerifier
import ZK.JSChecker
import ZK.GroupHom
import ZK.GroupHom.FieldChal
import ZK.GroupHom.FieldChal2
import ZK.GroupHom.FieldChal3
import ZK.GroupHom.ElGamal
import adder
import alea.cpo
import bijection-syntax.Bijection-Fin
import bijection-syntax.Bijection
import bijection-syntax.README
import circuits.bytecode
import circuits.circuit
import sha1


findB -> findKey

findB -> findKey

module Data.Bits.Count where

open import Type hiding (★)
open import Data.Bits
open import Data.Bits.OperationSyntax
import Data.Bits.Search as Search
open Search.SimpleSearch
open import Data.Bits.Sum

import Data.Bool.NP as Bool
open Bool hiding (_==_; toℕ)
open import Data.Bool.Properties using (not-involutive)
open import Data.Empty using (⊥; ⊥-elim)
import Data.Fin as Fin
open Fin using (Fin; zero; suc; #_; inject₁; inject+; raise) renaming (_+_ to _+ᶠ_)

open import Data.Maybe.NP

open import Data.Nat.NP hiding (_==_)
open import Data.Nat.Properties
import Data.Vec.NP as V
open V hiding (rewire; rewireTbl; sum) renaming (map to vmap; swap to vswap)

open import Data.Product using (_×_; _,_; uncurry; proj₁; proj₂)

open import Function.NP

import Relation.Binary.PropositionalEquality.NP as ≡
open ≡

#⟨_⟩ : ∀ {n} → (Bits n → Bool) → ℕ
#⟨ pred ⟩ = sum (Bool.toℕ ∘ pred)

-- #-ext
#-≗ : ∀ {n} (f g : Bits n → Bool) → f ≗ g → #⟨ f ⟩ ≡ #⟨ g ⟩
#-≗ f g f≗g = sum-≗ (Bool.toℕ ∘ f) (Bool.toℕ ∘ g) (λ x → ≡.cong Bool.toℕ (f≗g x))

#-comm : ∀ {n} (pad : Bits n) (f : Bits n → Bool) → #⟨ f ⟩ ≡ #⟨ f ∘ _⊕_ pad ⟩
#-comm pad f = sum-comm pad (Bool.toℕ ∘ f)

#-bij : ∀ {n} f (g : Bits n → Bit) → #⟨ g ∘ eval f ⟩ ≡ #⟨ g ⟩
#-bij f g = sum-bij f (Bool.toℕ ∘ g)

#-⊕ : ∀ {c} (bs : Bits c) (f : Bits c → Bit) → #⟨ f ⟩ ≡ #⟨ f ∘ _⊕_ bs ⟩
#-⊕ = #-comm

#-const : ∀ n b → #⟨ (λ (_ : Bits n) → b) ⟩ ≡ ⟨2^ n * Bool.toℕ b ⟩
#-const n b = sum-const n (Bool.toℕ b)

#never≡0 : ∀ n → #⟨ never n ⟩ ≡ 0
#never≡0 = sum-const0≡0

#always≡2^_ : ∀ n → #⟨ always n ⟩ ≡ 2^ n
#always≡2^ n = sum-const n 1

#-dist : ∀ {n} (f₀ f₁ : Bits n → Bit) → sum (λ x → Bool.toℕ (f₀ x) + Bool.toℕ (f₁ x)) ≡ #⟨ f₀ ⟩ + #⟨ f₁ ⟩
#-dist f₀ f₁ = sum-dist (Bool.toℕ ∘ f₀) (Bool.toℕ ∘ f₁)

#-+ : ∀ {m n} (f : Bits (m + n) → Bit) →
                 #⟨ f ⟩ ≡ sum {m} (λ xs → #⟨ (λ ys → f (xs ++ ys)) ⟩ )
#-+ {m} {n} f = sum-+ {m} {n} (Bool.toℕ ∘ f)

#-# : ∀ {m n} (f : Bits (m + n) → Bit) →
                          sum {m} (λ xs → #⟨ (λ ys → f (xs ++ ys)) ⟩)
                        ≡ sum {n} (λ ys → #⟨ (λ (xs : Bits m) → f (xs ++ ys)) ⟩)
#-# {m} {n} f = sum-sum {m} {n} (Bool.toℕ ∘ f)

#-swap : ∀ {m n} (f : Bits (m + n) → Bit) → #⟨ f ∘ vswap n {m} ⟩ ≡ #⟨ f ⟩
#-swap {m} {n} f = sum-swap {m} {n} (Bool.toℕ ∘ f)

#⟨==_⟩ : ∀ {n} (xs : Bits n) → #⟨ _==_ xs ⟩ ≡ 1
#⟨== [] ⟩ = refl
#⟨==_⟩ {suc n} (true ∷ xs)  rewrite #never≡0 n | #⟨== xs ⟩ = refl
#⟨==_⟩ {suc n} (false ∷ xs) rewrite #never≡0 n | #⟨== xs ⟩ = refl

≗-cong-# : ∀ {n} (f g : Bits n → Bit) → f ≗ g → #⟨ f ⟩ ≡ #⟨ g ⟩
≗-cong-# f g f≗g = sum-≗ _ _ (cong Bool.toℕ ∘ f≗g)

-- #-+ : ∀ {n a b} (f : Bits (suc n) → Bit) → #⟨ f ∘ 0∷_ ⟩ ≡ a → #⟨ f ∘ 1∷_ ⟩ ≡ b → #⟨ f ⟩ ≡ a + b
-- #-+ f f0 f1 rewrite f0 | f1 = refl

#-take-drop : ∀ m n (f : Bits m → Bit) (g : Bits n → Bit)
                → #⟨ (f ∘ take m) |∧| (g ∘ drop m) ⟩ ≡ #⟨ f ⟩ * #⟨ g ⟩
#-take-drop zero n f g with f []
... | true rewrite ℕ°.+-comm #⟨ g ⟩ 0 = refl
... | false = #never≡0 n
#-take-drop (suc m) n f g
  rewrite ≗-cong-# ((f ∘ take (suc m)) |∧| (g ∘ drop (suc m)) ∘ 0∷_)
                   ((f ∘ 0∷_ ∘ take m) |∧| (g ∘ drop m))
                     (λ x → cong₂ (λ x y → f x ∧ g y) (take-∷ m 0b x) (drop-∷ m 0b x))
        | #-take-drop m n (f ∘ 0∷_) g
        | ≗-cong-# ((f ∘ take (suc m)) |∧| (g ∘ drop (suc m)) ∘ 1∷_)
                   ((f ∘ 1∷_ ∘ take m) |∧| (g ∘ drop m))
                     (λ x → cong₂ (λ x y → f x ∧ g y) (take-∷ m 1b x) (drop-∷ m 1b x))
        | #-take-drop m n (f ∘ 1∷_) g
          = sym (proj₂ ℕ°.distrib #⟨ g ⟩ #⟨ f ∘ 0∷_ ⟩ #⟨ f ∘ 1∷_ ⟩)

#-drop-take : ∀ m n (f : Bits n → Bit) (g : Bits m → Bit)
                  → #⟨ (f ∘ drop m) |∧| (g ∘ take m) ⟩ ≡ #⟨ f ⟩ * #⟨ g ⟩
#-drop-take m n f g =
              #⟨ (f ∘ drop m) |∧| (g ∘ take m) ⟩
            ≡⟨ ≗-cong-# ((f ∘ drop m) |∧| (g ∘ take m)) ((g ∘ take m) |∧| (f ∘ drop m)) (λ x → Bool°.+-comm (f (drop m x)) _) ⟩
              #⟨ (g ∘ take m) |∧| (f ∘ drop m) ⟩
            ≡⟨ #-take-drop m n g f ⟩
              #⟨ g ⟩ * #⟨ f ⟩
            ≡⟨ ℕ°.*-comm #⟨ g ⟩ _ ⟩
              #⟨ f ⟩ * #⟨ g ⟩
            ∎
      where open ≡-Reasoning

#-take : ∀ m n (f : Bits m → Bit) → #⟨ f ∘ take m {n} ⟩ ≡ 2^ n * #⟨ f ⟩
#-take m n f = #⟨ f ∘ take m {n} ⟩
             ≡⟨ #-drop-take m n (always n) f ⟩
               #⟨ always n ⟩ * #⟨ f ⟩
             ≡⟨ cong (flip _*_ #⟨ f ⟩) (#always≡2^ n) ⟩
               2^ n * #⟨ f ⟩
             ∎
      where open ≡-Reasoning

#-drop : ∀ m n (f : Bits m → Bit) → #⟨ f ∘ drop n ⟩ ≡ 2^ n * #⟨ f ⟩
#-drop m n f = #⟨ f ∘ drop n ⟩
             ≡⟨ #-take-drop n m (always n) f ⟩
               #⟨ always n ⟩ * #⟨ f ⟩
             ≡⟨ cong (flip _*_ #⟨ f ⟩) (#always≡2^ n) ⟩
               2^ n * #⟨ f ⟩
             ∎
      where open ≡-Reasoning

#⟨_==⟩ : ∀ {n} (xs : Bits n) → #⟨ flip _==_ xs ⟩ ≡ 1
#⟨ xs ==⟩ = trans (≗-cong-# (flip _==_ xs) (_==_ xs) (flip ==-comm xs)) #⟨== xs ⟩

#⇒ : ∀ {n} (f g : Bits n → Bit) → (∀ x → T (f x) → T (g x)) → #⟨ f ⟩ ≤ #⟨ g ⟩
#⇒ {zero} f g f⇒g with f [] | g [] | f⇒g []
... | true  | true  | _ = s≤s z≤n
... | true  | false | p = ⊥-elim (p _)
... | false | _     | _ = z≤n
#⇒ {suc n} f g f⇒g = #⇒ (f ∘ 0∷_) (g ∘ 0∷_) (f⇒g ∘ 0∷_)
               +-mono #⇒ (f ∘ 1∷_) (g ∘ 1∷_) (f⇒g ∘ 1∷_)

#-∧-∨ᵇ : ∀ x y → Bool.toℕ (x ∧ y) + Bool.toℕ (x ∨ y) ≡ Bool.toℕ x + Bool.toℕ y
#-∧-∨ᵇ true y rewrite ℕ°.+-comm (Bool.toℕ y) 1 = refl
#-∧-∨ᵇ false y = refl

#-LEM : ∀ {n} → (f g : Bits n → Bit) → #⟨ f ⟩ ≡ #⟨ g |∧| f ⟩ + #⟨ |not| g |∧| f ⟩
#-LEM {zero} f g with g []
... | false = refl
... | true  = ℕ°.+-comm 0 #⟨ f ⟩
#-LEM {suc n} f g
  rewrite #-LEM (f ∘ 0∷_) (g ∘ 0∷_)
        | #-LEM (f ∘ 1∷_) (g ∘ 1∷_)
          = +-interchange #⟨ (g ∘ 0∷_) |∧| (f ∘ 0∷_) ⟩
                #⟨ |not| (g ∘ 0∷_) |∧| (f ∘ 0∷_) ⟩
                #⟨ (g ∘ 1∷_) |∧| (f ∘ 1∷_) ⟩
                #⟨ |not| (g ∘ 1∷_) |∧| (f ∘ 1∷_) ⟩

#-∧-snd : ∀ {n} (f g : Bits n → Bit) → #⟨ f |∧| g ⟩ ≤ #⟨ g ⟩
#-∧-snd {zero} f g with f [] | g []
... | false | false = z≤n
... | false | true  = z≤n
... | true  | _     = ℕ≤.reflexive refl
#-∧-snd {suc n} f g = #-∧-snd (f ∘ 0∷_) (g ∘ 0∷_)
               +-mono #-∧-snd (f ∘ 1∷_) (g ∘ 1∷_)

#-∧-fst : ∀ {n} (f g : Bits n → Bit) → #⟨ f |∧| g ⟩ ≤ #⟨ f ⟩
#-∧-fst f g =
          #⟨ f |∧| g ⟩
            ≡⟨ #-≗ (f |∧| g) (g |∧| f) (|∧|-comm f g) ⟩
          #⟨ g |∧| f ⟩
            ≤⟨ #-∧-snd g f ⟩
          #⟨ f ⟩ ∎
      where open ≤-Reasoning

#-∧-∨ : ∀ {n} (f g : Bits n → Bit) → #⟨ f |∧| g ⟩ + #⟨ f |∨| g ⟩ ≡ #⟨ f ⟩ + #⟨ g ⟩
#-∧-∨ {zero} f g = #-∧-∨ᵇ (f []) (g [])
#-∧-∨ {suc n} f g =
  trans
    (trans
      (helper #⟨ (f ∘ 0∷_) |∧| (g ∘ 0∷_) ⟩
              #⟨ (f ∘ 1∷_) |∧| (g ∘ 1∷_) ⟩
              #⟨ (f ∘ 0∷_) |∨| (g ∘ 0∷_) ⟩
                #⟨ (f ∘ 1∷_) |∨| (g ∘ 1∷_) ⟩)
      (cong₂ _+_ (#-∧-∨ (f ∘ 0∷_) (g ∘ 0∷_))
                 (#-∧-∨ (f ∘ 1∷_) (g ∘ 1∷_))))
      (helper #⟨ f ∘ 0∷_ ⟩ #⟨ g ∘ 0∷_ ⟩ #⟨ f ∘ 1∷_ ⟩ #⟨ g ∘ 1∷_ ⟩)
        where open SemiringSolver
              helper : ∀ x y z t → x + y + (z + t) ≡ x + z + (y + t)
              helper = solve 4 (λ x y z t → x :+ y :+ (z :+ t) := x :+ z :+ (y :+ t)) refl

#∨' : ∀ {n} (f g : Bits n → Bit) → #⟨ f |∨| g ⟩ ≤ #⟨ f ⟩ + #⟨ g ⟩
#∨' {zero} f g with f []
... | true  = s≤s z≤n
... | false = ℕ≤.refl
#∨' {suc _} f g = ℕ≤.trans (#∨' (f ∘ 0∷_) (g ∘ 0∷_) +-mono
                            #∨' (f ∘ 1∷_) (g ∘ 1∷_))
                        (ℕ≤.reflexive
                          (helper #⟨ f ∘ 0∷_ ⟩ #⟨ g ∘ 0∷_ ⟩ #⟨ f ∘ 1∷_ ⟩ #⟨ g ∘ 1∷_ ⟩))
    where open SemiringSolver
          helper : ∀ x y z t → x + y + (z + t) ≡ x + z + (y + t)
          helper = solve 4 (λ x y z t → x :+ y :+ (z :+ t) := x :+ z :+ (y :+ t)) refl

#∨ : ∀ {m n o} {f g : Bits o → Bit} → #⟨ f ⟩ ≤ m → #⟨ g ⟩ ≤ n → #⟨ f |∨| g ⟩ ≤ (m + n)
#∨ {m} {n} {o} {f} {g} pf pg = ℕ≤.trans (#∨' f g) (pf +-mono pg)

#∧ : ∀ {m n o} {f g : Bits o → Bit} → #⟨ f ⟩ ≤ m → #⟨ g ⟩ ≤ n → #⟨ f |∧| g ⟩ ≤ (m + n)
#∧ {f = f} {g} pf pg = ℕ≤.trans (#⇒ (f |∧| g) (f |∨| g) (λ x → ∧⇒∨ (f x) (g x))) (#∨ {f = f} pf pg)

#-bound : ∀ c (f : Bits c → Bit) → #⟨ f ⟩ ≤ 2^ c
#-bound zero    f = Bool.toℕ≤1 (f [])
#-bound (suc c) f = #-bound c (f ∘ 0∷_) +-mono #-bound c (f ∘ 1∷_)

#-∘vnot : ∀ c (f : Bits c → Bit) → #⟨ f ⟩ ≡ #⟨ f ∘ vnot ⟩
#-∘vnot _ f = #-⊕ 1ⁿ f

#-∘xorᵢ : ∀ {c} (i : Fin c) (f : Bits c → Bit) b → #⟨ f ⟩ ≡ #⟨ f ∘ onᵢ (_xor_ b) i ⟩
#-∘xorᵢ i f b = pf
  where pad = onᵢ (_xor_ b) i 0ⁿ
        pf : #⟨ f ⟩ ≡ #⟨ f ∘ onᵢ (_xor_ b) i ⟩
        pf rewrite #-⊕ pad f = ≗-cong-# (f ∘ _⊕_ pad) (f ∘ onᵢ (_xor_ b) i) (cong (_$_ f) ∘ sym ∘ onᵢ-xor-⊕ b i)

#-∘notᵢ : ∀ {c} (i : Fin c) (f : Bits c → Bit) → #⟨ f ⟩ ≡ #⟨ f ∘ notᵢ i ⟩
#-∘notᵢ i f = #-∘xorᵢ i f true

#-not∘ : ∀ c (f : Bits c → Bit) → #⟨ f ⟩ ≡ 2^ c ∸ #⟨ not ∘ f ⟩
#-not∘ zero f with f []
... | true  = ≡.refl
... | false = ≡.refl
#-not∘ (suc c) f
  rewrite #-not∘ c (f ∘ 0∷_)
        | #-not∘ c (f ∘ 1∷_) = factor-+-∸ (#-bound c (not ∘ f ∘ 0∷_)) (#-bound c (not ∘ f ∘ 1∷_))

#-not∘′ : ∀ c (f : Bits c → Bit) → #⟨ not ∘ f ⟩ ≡ 2^ c ∸ #⟨ f ⟩
#-not∘′ c f = #⟨ not ∘ f ⟩
            ≡⟨ #-not∘ c (not ∘ f) ⟩
              2^ c ∸ #⟨ not ∘ not ∘ f ⟩
            ≡⟨ ≡.cong (λ g → 2^ c ∸ g) (≗-cong-# (not ∘ not ∘ f) f (not-involutive ∘ f)) ⟩
              2^ c ∸ #⟨ f ⟩
            ∎
      where open ≡-Reasoning

difference-lemma : ∀ {n}(A B F : Bits n → Bit)
      → #⟨ |not| F |∧| A ⟩ ≡ #⟨ |not| F |∧| B ⟩
      → dist #⟨ A ⟩ #⟨ B ⟩ ≤ #⟨ F ⟩
difference-lemma A B F A∧¬F≡B∧¬F =
  dist #⟨ A ⟩ #⟨ B ⟩
    ≡⟨ cong₂ dist (#-LEM A F) (#-LEM B F) ⟩
  dist (#⟨ F |∧| A ⟩ + #⟨ |not| F |∧| A ⟩)
       (#⟨ F |∧| B ⟩ + #⟨ |not| F |∧| B ⟩)
    ≡⟨ cong₂ dist (ℕ°.+-comm #⟨ F |∧| A ⟩ #⟨ |not| F |∧| A ⟩)
                  (ℕ°.+-comm #⟨ F |∧| B ⟩ #⟨ |not| F |∧| B ⟩) ⟩
  dist (#⟨ |not| F |∧| A ⟩ + #⟨ F |∧| A ⟩)
       (#⟨ |not| F |∧| B ⟩ + #⟨ F |∧| B ⟩)
    ≡⟨ cong₂ dist (refl {x = #⟨ |not| F |∧| A ⟩ + #⟨ F |∧| A ⟩})
                  (cong₂ _+_ (sym A∧¬F≡B∧¬F) (refl {x = #⟨ F |∧| B ⟩})) ⟩
  dist (#⟨ |not| F |∧| A ⟩ + #⟨ F |∧| A ⟩)
       (#⟨ |not| F |∧| A ⟩ + #⟨ F |∧| B ⟩)
    ≡⟨ dist-x+ #⟨ |not| F |∧| A ⟩ #⟨ F |∧| A ⟩ #⟨ F |∧| B ⟩ ⟩
  dist #⟨ F |∧| A ⟩ #⟨ F |∧| B ⟩
    ≤⟨ dist-bounded {#⟨ F |∧| A ⟩} {#⟨ F |∧| B ⟩} {#⟨ F ⟩} (#-∧-fst F A) (#-∧-fst F B) ⟩
  #⟨ F ⟩ ∎
     where open ≤-Reasoning

#⟨_⟩ᶠ : ∀ {n} → (Bits n → Bool) → Fin (suc (2^ n))
#⟨ pred ⟩ᶠ = countᶠ pred (allBits _)

#⟨⟩-spec : ∀ {n} (pred : Bits n → Bool) → #⟨ pred ⟩ ≡ Fin.toℕ #⟨ pred ⟩ᶠ
#⟨⟩-spec {zero}  pred with pred []
... | true = refl
... | false = refl
#⟨⟩-spec {suc n} pred rewrite count-++ pred (vmap 0∷_ (allBits n)) (vmap 1∷_ (allBits n))
                            | #⟨⟩-spec {n} (pred ∘ 0∷_)
                            | #⟨⟩-spec {n} (pred ∘ 1∷_)
                            | count-∘ 0∷_ pred (allBits n)
                            | count-∘ 1∷_ pred (allBits n) = refl

ext-# : ∀ {c} {f g : Bits c → Bit} → f ≗ g → #⟨ f ⟩ᶠ ≡ #⟨ g ⟩ᶠ
ext-# f≗g = ext-countᶠ f≗g (allBits _)

find? : ∀ {n a} {A : ★ a} → (Bits n →? A) →? A
find? = search (M?._∣_ _)

findKey : ∀ {n} → (Bits n → Bool) →? Bits n
findKey pred = find? (λ x → if pred x then just x else nothing)

module Data.Bits.Count where

open import Type hiding (★)
open import Data.Bits
open import Data.Bits.OperationSyntax
import Data.Bits.Search as Search
open Search.SimpleSearch
open import Data.Bits.Sum

import Data.Bool.NP as Bool
open Bool hiding (_==_; toℕ)
open import Data.Bool.Properties using (not-involutive)
open import Data.Empty using (⊥; ⊥-elim)
import Data.Fin as Fin
open Fin using (Fin; zero; suc; #_; inject₁; inject+; raise) renaming (_+_ to _+ᶠ_)

open import Data.Maybe.NP

open import Data.Nat.NP hiding (_==_)
open import Data.Nat.Properties
import Data.Vec.NP as V
open V hiding (rewire; rewireTbl; sum) renaming (map to vmap; swap to vswap)

open import Data.Product using (_×_; _,_; uncurry; proj₁; proj₂)

open import Function.NP

import Relation.Binary.PropositionalEquality.NP as ≡
open ≡

#⟨_⟩ : ∀ {n} → (Bits n → Bool) → ℕ
#⟨ pred ⟩ = sum (Bool.toℕ ∘ pred)

-- #-ext
#-≗ : ∀ {n} (f g : Bits n → Bool) → f ≗ g → #⟨ f ⟩ ≡ #⟨ g ⟩
#-≗ f g f≗g = sum-≗ (Bool.toℕ ∘ f) (Bool.toℕ ∘ g) (λ x → ≡.cong Bool.toℕ (f≗g x))

#-comm : ∀ {n} (pad : Bits n) (f : Bits n → Bool) → #⟨ f ⟩ ≡ #⟨ f ∘ _⊕_ pad ⟩
#-comm pad f = sum-comm pad (Bool.toℕ ∘ f)

#-bij : ∀ {n} f (g : Bits n → Bit) → #⟨ g ∘ eval f ⟩ ≡ #⟨ g ⟩
#-bij f g = sum-bij f (Bool.toℕ ∘ g)

#-⊕ : ∀ {c} (bs : Bits c) (f : Bits c → Bit) → #⟨ f ⟩ ≡ #⟨ f ∘ _⊕_ bs ⟩
#-⊕ = #-comm

#-const : ∀ n b → #⟨ (λ (_ : Bits n) → b) ⟩ ≡ ⟨2^ n * Bool.toℕ b ⟩
#-const n b = sum-const n (Bool.toℕ b)

#never≡0 : ∀ n → #⟨ never n ⟩ ≡ 0
#never≡0 = sum-const0≡0

#always≡2^_ : ∀ n → #⟨ always n ⟩ ≡ 2^ n
#always≡2^ n = sum-const n 1

#-dist : ∀ {n} (f₀ f₁ : Bits n → Bit) → sum (λ x → Bool.toℕ (f₀ x) + Bool.toℕ (f₁ x)) ≡ #⟨ f₀ ⟩ + #⟨ f₁ ⟩
#-dist f₀ f₁ = sum-dist (Bool.toℕ ∘ f₀) (Bool.toℕ ∘ f₁)

#-+ : ∀ {m n} (f : Bits (m + n) → Bit) →
                 #⟨ f ⟩ ≡ sum {m} (λ xs → #⟨ (λ ys → f (xs ++ ys)) ⟩ )
#-+ {m} {n} f = sum-+ {m} {n} (Bool.toℕ ∘ f)

#-# : ∀ {m n} (f : Bits (m + n) → Bit) →
                          sum {m} (λ xs → #⟨ (λ ys → f (xs ++ ys)) ⟩)
                        ≡ sum {n} (λ ys → #⟨ (λ (xs : Bits m) → f (xs ++ ys)) ⟩)
#-# {m} {n} f = sum-sum {m} {n} (Bool.toℕ ∘ f)

#-swap : ∀ {m n} (f : Bits (m + n) → Bit) → #⟨ f ∘ vswap n {m} ⟩ ≡ #⟨ f ⟩
#-swap {m} {n} f = sum-swap {m} {n} (Bool.toℕ ∘ f)

#⟨==_⟩ : ∀ {n} (xs : Bits n) → #⟨ _==_ xs ⟩ ≡ 1
#⟨== [] ⟩ = refl
#⟨==_⟩ {suc n} (true ∷ xs)  rewrite #never≡0 n | #⟨== xs ⟩ = refl
#⟨==_⟩ {suc n} (false ∷ xs) rewrite #never≡0 n | #⟨== xs ⟩ = refl

≗-cong-# : ∀ {n} (f g : Bits n → Bit) → f ≗ g → #⟨ f ⟩ ≡ #⟨ g ⟩
≗-cong-# f g f≗g = sum-≗ _ _ (cong Bool.toℕ ∘ f≗g)

-- #-+ : ∀ {n a b} (f : Bits (suc n) → Bit) → #⟨ f ∘ 0∷_ ⟩ ≡ a → #⟨ f ∘ 1∷_ ⟩ ≡ b → #⟨ f ⟩ ≡ a + b
-- #-+ f f0 f1 rewrite f0 | f1 = refl

#-take-drop : ∀ m n (f : Bits m → Bit) (g : Bits n → Bit)
                → #⟨ (f ∘ take m) |∧| (g ∘ drop m) ⟩ ≡ #⟨ f ⟩ * #⟨ g ⟩
#-take-drop zero n f g with f []
... | true rewrite ℕ°.+-comm #⟨ g ⟩ 0 = refl
... | false = #never≡0 n
#-take-drop (suc m) n f g
  rewrite ≗-cong-# ((f ∘ take (suc m)) |∧| (g ∘ drop (suc m)) ∘ 0∷_)
                   ((f ∘ 0∷_ ∘ take m) |∧| (g ∘ drop m))
                     (λ x → cong₂ (λ x y → f x ∧ g y) (take-∷ m 0b x) (drop-∷ m 0b x))
        | #-take-drop m n (f ∘ 0∷_) g
        | ≗-cong-# ((f ∘ take (suc m)) |∧| (g ∘ drop (suc m)) ∘ 1∷_)
                   ((f ∘ 1∷_ ∘ take m) |∧| (g ∘ drop m))
                     (λ x → cong₂ (λ x y → f x ∧ g y) (take-∷ m 1b x) (drop-∷ m 1b x))
        | #-take-drop m n (f ∘ 1∷_) g
          = sym (proj₂ ℕ°.distrib #⟨ g ⟩ #⟨ f ∘ 0∷_ ⟩ #⟨ f ∘ 1∷_ ⟩)

#-drop-take : ∀ m n (f : Bits n → Bit) (g : Bits m → Bit)
                  → #⟨ (f ∘ drop m) |∧| (g ∘ take m) ⟩ ≡ #⟨ f ⟩ * #⟨ g ⟩
#-drop-take m n f g =
              #⟨ (f ∘ drop m) |∧| (g ∘ take m) ⟩
            ≡⟨ ≗-cong-# ((f ∘ drop m) |∧| (g ∘ take m)) ((g ∘ take m) |∧| (f ∘ drop m)) (λ x → Bool°.+-comm (f (drop m x)) _) ⟩
              #⟨ (g ∘ take m) |∧| (f ∘ drop m) ⟩
            ≡⟨ #-take-drop m n g f ⟩
              #⟨ g ⟩ * #⟨ f ⟩
            ≡⟨ ℕ°.*-comm #⟨ g ⟩ _ ⟩
              #⟨ f ⟩ * #⟨ g ⟩
            ∎
      where open ≡-Reasoning

#-take : ∀ m n (f : Bits m → Bit) → #⟨ f ∘ take m {n} ⟩ ≡ 2^ n * #⟨ f ⟩
#-take m n f = #⟨ f ∘ take m {n} ⟩
             ≡⟨ #-drop-take m n (always n) f ⟩
               #⟨ always n ⟩ * #⟨ f ⟩
             ≡⟨ cong (flip _*_ #⟨ f ⟩) (#always≡2^ n) ⟩
               2^ n * #⟨ f ⟩
             ∎
      where open ≡-Reasoning

#-drop : ∀ m n (f : Bits m → Bit) → #⟨ f ∘ drop n ⟩ ≡ 2^ n * #⟨ f ⟩
#-drop m n f = #⟨ f ∘ drop n ⟩
             ≡⟨ #-take-drop n m (always n) f ⟩
               #⟨ always n ⟩ * #⟨ f ⟩
             ≡⟨ cong (flip _*_ #⟨ f ⟩) (#always≡2^ n) ⟩
               2^ n * #⟨ f ⟩
             ∎
      where open ≡-Reasoning

#⟨_==⟩ : ∀ {n} (xs : Bits n) → #⟨ flip _==_ xs ⟩ ≡ 1
#⟨ xs ==⟩ = trans (≗-cong-# (flip _==_ xs) (_==_ xs) (flip ==-comm xs)) #⟨== xs ⟩

#⇒ : ∀ {n} (f g : Bits n → Bit) → (∀ x → T (f x) → T (g x)) → #⟨ f ⟩ ≤ #⟨ g ⟩
#⇒ {zero} f g f⇒g with f [] | g [] | f⇒g []
... | true  | true  | _ = s≤s z≤n
... | true  | false | p = ⊥-elim (p _)
... | false | _     | _ = z≤n
#⇒ {suc n} f g f⇒g = #⇒ (f ∘ 0∷_) (g ∘ 0∷_) (f⇒g ∘ 0∷_)
               +-mono #⇒ (f ∘ 1∷_) (g ∘ 1∷_) (f⇒g ∘ 1∷_)

#-∧-∨ᵇ : ∀ x y → Bool.toℕ (x ∧ y) + Bool.toℕ (x ∨ y) ≡ Bool.toℕ x + Bool.toℕ y
#-∧-∨ᵇ true y rewrite ℕ°.+-comm (Bool.toℕ y) 1 = refl
#-∧-∨ᵇ false y = refl

#-LEM : ∀ {n} → (f g : Bits n → Bit) → #⟨ f ⟩ ≡ #⟨ g |∧| f ⟩ + #⟨ |not| g |∧| f ⟩
#-LEM {zero} f g with g []
... | false = refl
... | true  = ℕ°.+-comm 0 #⟨ f ⟩
#-LEM {suc n} f g
  rewrite #-LEM (f ∘ 0∷_) (g ∘ 0∷_)
        | #-LEM (f ∘ 1∷_) (g ∘ 1∷_)
          = +-interchange #⟨ (g ∘ 0∷_) |∧| (f ∘ 0∷_) ⟩
                #⟨ |not| (g ∘ 0∷_) |∧| (f ∘ 0∷_) ⟩
                #⟨ (g ∘ 1∷_) |∧| (f ∘ 1∷_) ⟩
                #⟨ |not| (g ∘ 1∷_) |∧| (f ∘ 1∷_) ⟩

#-∧-snd : ∀ {n} (f g : Bits n → Bit) → #⟨ f |∧| g ⟩ ≤ #⟨ g ⟩
#-∧-snd {zero} f g with f [] | g []
... | false | false = z≤n
... | false | true  = z≤n
... | true  | _     = ℕ≤.reflexive refl
#-∧-snd {suc n} f g = #-∧-snd (f ∘ 0∷_) (g ∘ 0∷_)
               +-mono #-∧-snd (f ∘ 1∷_) (g ∘ 1∷_)

#-∧-fst : ∀ {n} (f g : Bits n → Bit) → #⟨ f |∧| g ⟩ ≤ #⟨ f ⟩
#-∧-fst f g =
          #⟨ f |∧| g ⟩
            ≡⟨ #-≗ (f |∧| g) (g |∧| f) (|∧|-comm f g) ⟩
          #⟨ g |∧| f ⟩
            ≤⟨ #-∧-snd g f ⟩
          #⟨ f ⟩ ∎
      where open ≤-Reasoning

#-∧-∨ : ∀ {n} (f g : Bits n → Bit) → #⟨ f |∧| g ⟩ + #⟨ f |∨| g ⟩ ≡ #⟨ f ⟩ + #⟨ g ⟩
#-∧-∨ {zero} f g = #-∧-∨ᵇ (f []) (g [])
#-∧-∨ {suc n} f g =
  trans
    (trans
      (helper #⟨ (f ∘ 0∷_) |∧| (g ∘ 0∷_) ⟩
              #⟨ (f ∘ 1∷_) |∧| (g ∘ 1∷_) ⟩
              #⟨ (f ∘ 0∷_) |∨| (g ∘ 0∷_) ⟩
                #⟨ (f ∘ 1∷_) |∨| (g ∘ 1∷_) ⟩)
      (cong₂ _+_ (#-∧-∨ (f ∘ 0∷_) (g ∘ 0∷_))
                 (#-∧-∨ (f ∘ 1∷_) (g ∘ 1∷_))))
      (helper #⟨ f ∘ 0∷_ ⟩ #⟨ g ∘ 0∷_ ⟩ #⟨ f ∘ 1∷_ ⟩ #⟨ g ∘ 1∷_ ⟩)
        where open SemiringSolver
              helper : ∀ x y z t → x + y + (z + t) ≡ x + z + (y + t)
              helper = solve 4 (λ x y z t → x :+ y :+ (z :+ t) := x :+ z :+ (y :+ t)) refl

#∨' : ∀ {n} (f g : Bits n → Bit) → #⟨ f |∨| g ⟩ ≤ #⟨ f ⟩ + #⟨ g ⟩
#∨' {zero} f g with f []
... | true  = s≤s z≤n
... | false = ℕ≤.refl
#∨' {suc _} f g = ℕ≤.trans (#∨' (f ∘ 0∷_) (g ∘ 0∷_) +-mono
                            #∨' (f ∘ 1∷_) (g ∘ 1∷_))
                        (ℕ≤.reflexive
                          (helper #⟨ f ∘ 0∷_ ⟩ #⟨ g ∘ 0∷_ ⟩ #⟨ f ∘ 1∷_ ⟩ #⟨ g ∘ 1∷_ ⟩))
    where open SemiringSolver
          helper : ∀ x y z t → x + y + (z + t) ≡ x + z + (y + t)
          helper = solve 4 (λ x y z t → x :+ y :+ (z :+ t) := x :+ z :+ (y :+ t)) refl

#∨ : ∀ {m n o} {f g : Bits o → Bit} → #⟨ f ⟩ ≤ m → #⟨ g ⟩ ≤ n → #⟨ f |∨| g ⟩ ≤ (m + n)
#∨ {m} {n} {o} {f} {g} pf pg = ℕ≤.trans (#∨' f g) (pf +-mono pg)

#∧ : ∀ {m n o} {f g : Bits o → Bit} → #⟨ f ⟩ ≤ m → #⟨ g ⟩ ≤ n → #⟨ f |∧| g ⟩ ≤ (m + n)
#∧ {f = f} {g} pf pg = ℕ≤.trans (#⇒ (f |∧| g) (f |∨| g) (λ x → ∧⇒∨ (f x) (g x))) (#∨ {f = f} pf pg)

#-bound : ∀ c (f : Bits c → Bit) → #⟨ f ⟩ ≤ 2^ c
#-bound zero    f = Bool.toℕ≤1 (f [])
#-bound (suc c) f = #-bound c (f ∘ 0∷_) +-mono #-bound c (f ∘ 1∷_)

#-∘vnot : ∀ c (f : Bits c → Bit) → #⟨ f ⟩ ≡ #⟨ f ∘ vnot ⟩
#-∘vnot _ f = #-⊕ 1ⁿ f

#-∘xorᵢ : ∀ {c} (i : Fin c) (f : Bits c → Bit) b → #⟨ f ⟩ ≡ #⟨ f ∘ onᵢ (_xor_ b) i ⟩
#-∘xorᵢ i f b = pf
  where pad = onᵢ (_xor_ b) i 0ⁿ
        pf : #⟨ f ⟩ ≡ #⟨ f ∘ onᵢ (_xor_ b) i ⟩
        pf rewrite #-⊕ pad f = ≗-cong-# (f ∘ _⊕_ pad) (f ∘ onᵢ (_xor_ b) i) (cong (_$_ f) ∘ sym ∘ onᵢ-xor-⊕ b i)

#-∘notᵢ : ∀ {c} (i : Fin c) (f : Bits c → Bit) → #⟨ f ⟩ ≡ #⟨ f ∘ notᵢ i ⟩
#-∘notᵢ i f = #-∘xorᵢ i f true

#-not∘ : ∀ c (f : Bits c → Bit) → #⟨ f ⟩ ≡ 2^ c ∸ #⟨ not ∘ f ⟩
#-not∘ zero f with f []
... | true  = ≡.refl
... | false = ≡.refl
#-not∘ (suc c) f
  rewrite #-not∘ c (f ∘ 0∷_)
        | #-not∘ c (f ∘ 1∷_) = factor-+-∸ (#-bound c (not ∘ f ∘ 0∷_)) (#-bound c (not ∘ f ∘ 1∷_))

#-not∘′ : ∀ c (f : Bits c → Bit) → #⟨ not ∘ f ⟩ ≡ 2^ c ∸ #⟨ f ⟩
#-not∘′ c f = #⟨ not ∘ f ⟩
            ≡⟨ #-not∘ c (not ∘ f) ⟩
              2^ c ∸ #⟨ not ∘ not ∘ f ⟩
            ≡⟨ ≡.cong (λ g → 2^ c ∸ g) (≗-cong-# (not ∘ not ∘ f) f (not-involutive ∘ f)) ⟩
              2^ c ∸ #⟨ f ⟩
            ∎
      where open ≡-Reasoning

difference-lemma : ∀ {n}(A B F : Bits n → Bit)
      → #⟨ |not| F |∧| A ⟩ ≡ #⟨ |not| F |∧| B ⟩
      → dist #⟨ A ⟩ #⟨ B ⟩ ≤ #⟨ F ⟩
difference-lemma A B F A∧¬F≡B∧¬F =
  dist #⟨ A ⟩ #⟨ B ⟩
    ≡⟨ cong₂ dist (#-LEM A F) (#-LEM B F) ⟩
  dist (#⟨ F |∧| A ⟩ + #⟨ |not| F |∧| A ⟩)
       (#⟨ F |∧| B ⟩ + #⟨ |not| F |∧| B ⟩)
    ≡⟨ cong₂ dist (ℕ°.+-comm #⟨ F |∧| A ⟩ #⟨ |not| F |∧| A ⟩)
                  (ℕ°.+-comm #⟨ F |∧| B ⟩ #⟨ |not| F |∧| B ⟩) ⟩
  dist (#⟨ |not| F |∧| A ⟩ + #⟨ F |∧| A ⟩)
       (#⟨ |not| F |∧| B ⟩ + #⟨ F |∧| B ⟩)
    ≡⟨ cong₂ dist (refl {x = #⟨ |not| F |∧| A ⟩ + #⟨ F |∧| A ⟩})
                  (cong₂ _+_ (sym A∧¬F≡B∧¬F) (refl {x = #⟨ F |∧| B ⟩})) ⟩
  dist (#⟨ |not| F |∧| A ⟩ + #⟨ F |∧| A ⟩)
       (#⟨ |not| F |∧| A ⟩ + #⟨ F |∧| B ⟩)
    ≡⟨ dist-x+ #⟨ |not| F |∧| A ⟩ #⟨ F |∧| A ⟩ #⟨ F |∧| B ⟩ ⟩
  dist #⟨ F |∧| A ⟩ #⟨ F |∧| B ⟩
    ≤⟨ dist-bounded {#⟨ F |∧| A ⟩} {#⟨ F |∧| B ⟩} {#⟨ F ⟩} (#-∧-fst F A) (#-∧-fst F B) ⟩
  #⟨ F ⟩ ∎
     where open ≤-Reasoning

#⟨_⟩ᶠ : ∀ {n} → (Bits n → Bool) → Fin (suc (2^ n))
#⟨ pred ⟩ᶠ = countᶠ pred (allBits _)

#⟨⟩-spec : ∀ {n} (pred : Bits n → Bool) → #⟨ pred ⟩ ≡ Fin.toℕ #⟨ pred ⟩ᶠ
#⟨⟩-spec {zero}  pred with pred []
... | true = refl
... | false = refl
#⟨⟩-spec {suc n} pred rewrite count-++ pred (vmap 0∷_ (allBits n)) (vmap 1∷_ (allBits n))
                            | #⟨⟩-spec {n} (pred ∘ 0∷_)
                            | #⟨⟩-spec {n} (pred ∘ 1∷_)
                            | count-∘ 0∷_ pred (allBits n)
                            | count-∘ 1∷_ pred (allBits n) = refl

ext-# : ∀ {c} {f g : Bits c → Bit} → f ≗ g → #⟨ f ⟩ᶠ ≡ #⟨ g ⟩ᶠ
ext-# f≗g = ext-countᶠ f≗g (allBits _)

find? : ∀ {n a} {A : ★ a} → (Bits n →? A) →? A
find? = search (M?._∣_ _)

findB : ∀ {n} → (Bits n → Bool) →? Bits n
findB pred = find? (λ x → if pred x then just x else nothing)