module STLC.Coquand.Renaming where

open import STLC.Syntax public
open import Category

--------------------------------------------------------------------------------

-- Renamings
infix 4 _∋⋆_
data _∋⋆_ : 𝒞 → 𝒞 → Set
  where
    ∅   : ∀ {Γ} → Γ ∋⋆ ∅

    _,_ : ∀ {Γ Γ′ A} → (η : Γ′ ∋⋆ Γ) (i : Γ′ ∋ A)
                     → Γ′ ∋⋆ Γ , A

putᵣ : ∀ {Γ Γ′} → (∀ {A} → Γ ∋ A → Γ′ ∋ A) → Γ′ ∋⋆ Γ
putᵣ {∅}     f = ∅
putᵣ {Γ , A} f = putᵣ (λ i → f (suc i)) , f 0

getᵣ : ∀ {Γ Γ′ A} → Γ′ ∋⋆ Γ → Γ ∋ A → Γ′ ∋ A
getᵣ (η , i) zero    = i
getᵣ (η , i) (suc j) = getᵣ η j

wkᵣ : ∀ {A Γ Γ′} → Γ′ ∋⋆ Γ → Γ′ , A ∋⋆ Γ
wkᵣ ∅       = ∅
wkᵣ (η , i) = wkᵣ η , suc i

liftᵣ : ∀ {A Γ Γ′} → Γ′ ∋⋆ Γ → Γ′ , A ∋⋆ Γ , A
liftᵣ η = wkᵣ η , 0

idᵣ : ∀ {Γ} → Γ ∋⋆ Γ
idᵣ {∅}     = ∅
idᵣ {Γ , A} = liftᵣ idᵣ

ren : ∀ {Γ Γ′ A} → Γ′ ∋⋆ Γ → Γ ⊢ A → Γ′ ⊢ A
ren η (𝓋 i)   = 𝓋 (getᵣ η i)
ren η (ƛ M)   = ƛ (ren (liftᵣ η) M)
ren η (M ∙ N) = ren η M ∙ ren η N

wk : ∀ {B Γ A} → Γ ⊢ A → Γ , B ⊢ A
wk M = ren (wkᵣ idᵣ) M

-- NOTE: _○_ = getᵣ⋆
_○_ : ∀ {Γ Γ′ Γ″} → Γ″ ∋⋆ Γ′ → Γ′ ∋⋆ Γ → Γ″ ∋⋆ Γ
η₁ ○ ∅        = ∅
η₁ ○ (η₂ , i) = η₁ ○ η₂ , getᵣ η₁ i

--------------------------------------------------------------------------------

-- (wkgetᵣ)
natgetᵣ : ∀ {Γ Γ′ A B} → (η : Γ′ ∋⋆ Γ) (i : Γ ∋ A)
                       → getᵣ (wkᵣ {B} η) i ≡ (suc ∘ getᵣ η) i
natgetᵣ (η , j) zero    = refl
natgetᵣ (η , j) (suc i) = natgetᵣ η i

idgetᵣ : ∀ {Γ A} → (i : Γ ∋ A)
                 → getᵣ idᵣ i ≡ i
idgetᵣ zero    = refl
idgetᵣ (suc i) = natgetᵣ idᵣ i
               ⦙ suc & idgetᵣ i

idren : ∀ {Γ A} → (M : Γ ⊢ A)
                → ren idᵣ M ≡ M
idren (𝓋 i)   = 𝓋 & idgetᵣ i
idren (ƛ M)   = ƛ & idren M
idren (M ∙ N) = _∙_ & idren M
                    ⊗ idren N

--------------------------------------------------------------------------------

zap○ : ∀ {Γ Γ′ Γ″ A} → (η₁ : Γ″ ∋⋆ Γ′) (η₂ : Γ′ ∋⋆ Γ) (i : Γ″ ∋ A)
                     → (η₁ , i) ○ wkᵣ η₂ ≡ η₁ ○ η₂
zap○ η₁ ∅        i = refl
zap○ η₁ (η₂ , j) i = (_, getᵣ η₁ j) & zap○ η₁ η₂ i

lid○ : ∀ {Γ Γ′} → (η : Γ′ ∋⋆ Γ)
                → idᵣ ○ η ≡ η
lid○ ∅       = refl
lid○ (η , i) = _,_ & lid○ η
                   ⊗ idgetᵣ i

rid○ : ∀ {Γ Γ′} → (η : Γ′ ∋⋆ Γ)
                → η ○ idᵣ ≡ η
rid○ {∅}     ∅       = refl
rid○ {Γ , A} (η , i) = (_, i) & ( zap○ η idᵣ i
                                ⦙ rid○ η
                                )

--------------------------------------------------------------------------------

get○ : ∀ {Γ Γ′ Γ″ A} → (η₁ : Γ″ ∋⋆ Γ′) (η₂ : Γ′ ∋⋆ Γ) (i : Γ ∋ A)
                     → getᵣ (η₁ ○ η₂) i ≡ (getᵣ η₁ ∘ getᵣ η₂) i
get○ η₁ (η₂ , j) zero    = refl
get○ η₁ (η₂ , j) (suc i) = get○ η₁ η₂ i

wk○ : ∀ {Γ Γ′ Γ″ A} → (η₁ : Γ″ ∋⋆ Γ′) (η₂ : Γ′ ∋⋆ Γ)
                    → wkᵣ {A} (η₁ ○ η₂) ≡ wkᵣ η₁ ○ η₂
wk○ η₁ ∅        = refl
wk○ η₁ (η₂ , i) = _,_ & wk○ η₁ η₂
                      ⊗ (natgetᵣ η₁ i ⁻¹)

lift○ : ∀ {Γ Γ′ Γ″ A} → (η₁ : Γ″ ∋⋆ Γ′) (η₂ : Γ′ ∋⋆ Γ)
                      → liftᵣ {A} (η₁ ○ η₂) ≡ liftᵣ η₁ ○ liftᵣ η₂
lift○ η₁ η₂ = (_, 0) & ( wk○ η₁ η₂
                          ⦙ (zap○ (wkᵣ η₁) η₂ 0 ⁻¹)
                          )

wklid○ : ∀ {Γ Γ′ A} → (η : Γ′ ∋⋆ Γ)
                    → wkᵣ {A} idᵣ ○ η ≡ wkᵣ η
wklid○ η = wk○ idᵣ η ⁻¹
         ⦙ wkᵣ & lid○ η

wkrid○ : ∀ {Γ Γ′ A} → (η : Γ′ ∋⋆ Γ)
                    → wkᵣ {A} η ○ idᵣ ≡ wkᵣ η
wkrid○ η = wk○ η idᵣ ⁻¹
         ⦙ wkᵣ & rid○ η

liftwkrid○ : ∀ {Γ Γ′ A} → (η : Γ′ ∋⋆ Γ)
                        → liftᵣ {A} η ○ wkᵣ idᵣ ≡ wkᵣ η
liftwkrid○ η = zap○ (wkᵣ η) idᵣ 0 ⦙ wkrid○ η

mutual
  ren○ : ∀ {Γ Γ′ Γ″ A} → (η₁ : Γ″ ∋⋆ Γ′) (η₂ : Γ′ ∋⋆ Γ) (M : Γ ⊢ A)
                       → ren (η₁ ○ η₂) M ≡ (ren η₁ ∘ ren η₂) M
  ren○ η₁ η₂ (𝓋 i)   = 𝓋 & get○ η₁ η₂ i
  ren○ η₁ η₂ (ƛ M)   = ƛ & renlift○ η₁ η₂ M
  ren○ η₁ η₂ (M ∙ N) = _∙_ & ren○ η₁ η₂ M
                           ⊗ ren○ η₁ η₂ N

  renlift○ : ∀ {Γ Γ′ Γ″ A B} → (η₁ : Γ″ ∋⋆ Γ′) (η₂ : Γ′ ∋⋆ Γ) (M : Γ , B ⊢ A)
                             → ren (liftᵣ {B} (η₁ ○ η₂)) M ≡
                                (ren (liftᵣ η₁) ∘ ren (liftᵣ η₂)) M
  renlift○ η₁ η₂ M = (λ η′ → ren η′ M) & lift○ η₁ η₂
                   ⦙ ren○ (liftᵣ η₁) (liftᵣ η₂) M

renwk○ : ∀ {Γ Γ′ Γ″ A B} → (η₁ : Γ″ ∋⋆ Γ′) (η₂ : Γ′ ∋⋆ Γ) (M : Γ ⊢ A)
                         → ren (wkᵣ {B} (η₁ ○ η₂)) M ≡
                            (ren (wkᵣ η₁) ∘ ren η₂) M
renwk○ η₁ η₂ M = (λ η′ → ren η′ M) & wk○ η₁ η₂
               ⦙ ren○ (wkᵣ η₁) η₂ M

renliftwk○ : ∀ {Γ Γ′ Γ″ A B} → (η₁ : Γ″ ∋⋆ Γ′) (η₂ : Γ′ ∋⋆ Γ) (M : Γ ⊢ A)
                             → ren (wkᵣ {B} (η₁ ○ η₂)) M ≡
                                (ren (liftᵣ η₁) ∘ ren (wkᵣ η₂)) M
renliftwk○ η₁ η₂ M = (λ η′ → ren η′ M) & ( wk○ η₁ η₂
                                          ⦙ zap○ (wkᵣ η₁) η₂ 0 ⁻¹
                                          )
                   ⦙ ren○ (liftᵣ η₁) (wkᵣ η₂) M

--------------------------------------------------------------------------------

assoc○ : ∀ {Γ Γ′ Γ″ Γ‴} → (η₁ : Γ‴ ∋⋆ Γ″) (η₂ : Γ″ ∋⋆ Γ′) (η₃ : Γ′ ∋⋆ Γ)
                        → η₁ ○ (η₂ ○ η₃) ≡ (η₁ ○ η₂) ○ η₃
assoc○ η₁ η₂ ∅        = refl
assoc○ η₁ η₂ (η₃ , i) = _,_ & assoc○ η₁ η₂ η₃
                            ⊗ (get○ η₁ η₂ i ⁻¹)

--------------------------------------------------------------------------------

𝗥𝗲𝗻 : Category 𝒞 _∋⋆_
𝗥𝗲𝗻 =
  record
    { idₓ    = idᵣ
    ; _⋄_    = flip _○_
    ; lid⋄   = rid○
    ; rid⋄   = lid○
    ; assoc⋄ = assoc○
    }

getᵣPsh : 𝒯 → Presheaf₀ 𝗥𝗲𝗻
getᵣPsh A =
  record
    { Fₓ  = _∋ A
    ; F   = getᵣ
    ; idF = fext! idgetᵣ
    ; F⋄  = λ η₂ η₁ → fext! (get○ η₁ η₂)
    }

renPsh : 𝒯 → Presheaf₀ 𝗥𝗲𝗻
renPsh A =
  record
    { Fₓ  = _⊢ A
    ; F   = ren
    ; idF = fext! idren
    ; F⋄  = λ η₂ η₁ → fext! (ren○ η₁ η₂)
    }

--------------------------------------------------------------------------------


module free-vars where
open import cedille-types
open import syntax-util
open import general-util
open import type-util

infixr 7 _++ₛ_
_++ₛ_ : stringset → stringset → stringset
s₁ ++ₛ s₂ = stringset-insert* s₂ (stringset-strings s₁)

stringset-single : string → stringset
stringset-single = flip trie-single triv

{-# TERMINATING #-}
free-vars : ∀ {ed} → ⟦ ed ⟧ → stringset
free-vars? : ∀ {ed} → maybe ⟦ ed ⟧ → stringset
free-vars-args : args → stringset
free-vars-arg : arg → stringset
free-vars-cases : cases → stringset
free-vars-case : case → stringset
free-vars-tk : tpkd → stringset
free-vars-tT : tmtp → stringset

free-vars-tk = free-vars -tk'_
free-vars-tT = free-vars -tT'_

free-vars? = maybe-else empty-stringset free-vars

free-vars {TERM} (App t t') = free-vars t ++ₛ free-vars t'
free-vars {TERM} (AppE t tT) = free-vars t ++ₛ free-vars -tT' tT
free-vars {TERM} (Beta t t') = free-vars t ++ₛ free-vars t'
free-vars {TERM} (Delta b? T t) = free-vars? (fst <$> b?) ++ₛ free-vars? (snd <$> b?) ++ₛ free-vars T ++ₛ free-vars t
free-vars {TERM} (Hole pi) = empty-stringset
free-vars {TERM} (IotaPair t t' x T) = free-vars t ++ₛ free-vars t' ++ₛ stringset-remove (free-vars T) x
free-vars {TERM} (IotaProj t n) = free-vars t
free-vars {TERM} (Lam me x tk t) = maybe-else empty-stringset (free-vars-tk) tk ++ₛ stringset-remove (free-vars t) x
free-vars {TERM} (LetTm me x T? t t') = free-vars? T? ++ₛ free-vars t ++ₛ stringset-remove (free-vars t') x
free-vars {TERM} (LetTp x k T t) = free-vars k ++ₛ free-vars T ++ₛ stringset-remove (free-vars t) x
free-vars {TERM} (Phi tₑ t₁ t₂) = free-vars tₑ ++ₛ free-vars t₁ ++ₛ free-vars t₂
free-vars {TERM} (Rho t x T t') = free-vars t ++ₛ stringset-remove (free-vars T) x ++ₛ free-vars t'
free-vars {TERM} (Sigma t) = free-vars t
free-vars {TERM} (Mu μ t T t~ cs) = free-vars t ++ₛ free-vars? T ++ₛ free-vars-cases cs
free-vars {TERM} (Var x) = stringset-single x
free-vars {TYPE} (TpAbs me x tk T) = free-vars-tk tk ++ₛ stringset-remove (free-vars T) x
free-vars {TYPE} (TpIota x T₁ T₂) = free-vars T₁ ++ₛ stringset-remove (free-vars T₂) x
free-vars {TYPE} (TpApp T tT) = free-vars T ++ₛ free-vars -tT' tT
free-vars {TYPE} (TpEq t₁ t₂) = free-vars t₁ ++ₛ free-vars t₂
free-vars {TYPE} (TpHole pi) = empty-stringset
free-vars {TYPE} (TpLam x tk T) = free-vars-tk tk ++ₛ stringset-remove (free-vars T) x
free-vars {TYPE} (TpVar x) = stringset-single x
free-vars {KIND} KdStar = empty-stringset
free-vars {KIND} (KdHole pi) = empty-stringset
free-vars {KIND} (KdAbs x tk k) = free-vars-tk tk ++ₛ stringset-remove (free-vars k) x

free-vars-arg (Arg t) = free-vars t
free-vars-arg (ArgE tT) = free-vars -tT' tT
free-vars-args = foldr (_++ₛ_ ∘ free-vars-arg) empty-stringset
free-vars-case (Case x cas t T) = foldr (λ {(CaseArg e x tk) → flip trie-remove x}) (free-vars t) cas
free-vars-cases = foldr (_++ₛ_ ∘ free-vars-case) empty-stringset

{-# TERMINATING #-}
erase : ∀ {ed} → ⟦ ed ⟧ → ⟦ ed ⟧
erase-cases : cases → cases
erase-case : case → case
erase-args : args → 𝕃 term
erase-params : params → 𝕃 var
erase-tk : tpkd → tpkd
erase-tT : tmtp → tmtp
erase-is-mu : is-mu → is-mu

erase-is-mu = either-else (λ _ → inj₁ nothing) inj₂

erase-tk = erase -tk_
erase-tT = erase -tT_

erase {TERM} (App t t') = App (erase t) (erase t')
erase {TERM} (AppE t T) = erase t
erase {TERM} (Beta t t') = erase t'
erase {TERM} (Delta b? T t) = id-term
erase {TERM} (Hole pi) = Hole pi
erase {TERM} (IotaPair t t' x T) = erase t
erase {TERM} (IotaProj t n) = erase t
erase {TERM} (Lam me x tk t) = if me then erase t else Lam ff x nothing (erase t)
erase {TERM} (LetTm me x T? t t') =
  let t'' = erase t' in
  if ~ me && stringset-contains (free-vars t'') x
    then LetTm ff x nothing (erase t) t''
    else t''
erase {TERM} (LetTp x k T t) = erase t
erase {TERM} (Phi tₑ t₁ t₂) = erase t₂
erase {TERM} (Rho t x T t') = erase t'
erase {TERM} (Sigma t) = erase t
erase {TERM} (Mu μ t T t~ ms) = Mu (erase-is-mu μ) (erase t) nothing t~ (erase-cases ms)
erase {TERM} (Var x) = Var x
erase {TYPE} (TpAbs me x tk T) = TpAbs me x (erase-tk tk) (erase T)
erase {TYPE} (TpIota x T₁ T₂) = TpIota x (erase T₁) (erase T₂)
erase {TYPE} (TpApp T tT) = TpApp (erase T) (erase -tT tT)
erase {TYPE} (TpEq t₁ t₂) = TpEq (erase t₁) (erase t₂)
erase {TYPE} (TpHole pi) = TpHole pi
erase {TYPE} (TpLam x tk T) = TpLam x (erase-tk tk) (erase T)
erase {TYPE} (TpVar x) = TpVar x
erase {KIND} KdStar = KdStar
erase {KIND} (KdHole pi) = KdHole pi
erase {KIND} (KdAbs x tk k) = KdAbs x (erase-tk tk) (erase k)

erase-case-args : case-args → case-args
erase-case-args (CaseArg ff x _ :: cas) = CaseArg ff x nothing :: erase-case-args cas
erase-case-args (_ :: cas) = erase-case-args cas
erase-case-args [] = []

erase-cases = map erase-case
erase-case (Case x cas t T) = Case x (erase-case-args cas) (erase t) T

erase-args (Arg t :: as) = erase t :: erase-args as
erase-args (_ :: as) = erase-args as
erase-args [] = []

erase-arg-keep : arg → arg
erase-args-keep : args → args
erase-args-keep = map erase-arg-keep
erase-arg-keep (Arg t) = Arg (erase t)
erase-arg-keep (ArgE tT) = ArgE (erase -tT tT)

erase-params (Param ff x (Tkt T) :: ps) = x :: erase-params ps
erase-params (_ :: ps) = erase-params ps
erase-params [] = []

free-vars-erased : ∀ {ed} → ⟦ ed ⟧ → stringset
free-vars-erased = free-vars ∘ erase

is-free-in : ∀ {ed} → var → ⟦ ed ⟧ → 𝔹
is-free-in x t = stringset-contains (free-vars t) x

are-free-in-h : ∀ {X} → trie X → stringset → 𝔹
are-free-in-h xs fxs = list-any (trie-contains fxs) (map fst (trie-mappings xs))

are-free-in : ∀ {X} {ed} → trie X → ⟦ ed ⟧ → 𝔹
are-free-in xs t = are-free-in-h xs (free-vars t)

erase-if : ∀ {ed} → 𝔹 → ⟦ ed ⟧ → ⟦ ed ⟧
erase-if tt = erase
erase-if ff = id

infix 5 `|_|`
`|_|` = erase


module PrintNat where

import PreludeShow
open PreludeShow

mainS = showNat 42


{- Byzantine Fault Tolerant Consensus Verification in Agda, version 0.9.

   Copyright (c) 2020 Oracle and/or its affiliates.
   Licensed under the Universal Permissive License v 1.0 as shown at https://opensource.oracle.com/licenses/upl
-}
{-# OPTIONS --allow-unsolved-metas #-}
open import LibraBFT.Prelude
open import LibraBFT.Lemmas
open import LibraBFT.Base.PKCS
open import LibraBFT.Base.Types
open import LibraBFT.Abstract.Types -- TODO-2: remove this, see comment below

open import LibraBFT.Yasm.AvailableEpochs using (AvailableEpochs) renaming (lookup'' to EC-lookup)
import LibraBFT.Yasm.AvailableEpochs as AE

open import LibraBFT.Yasm.Base

-- This module defines a model of a distributed system, parameterized by
-- SystemParameters, which establishes various application-dependent types,
-- handlers, etc.  The model supports a set of peers executing handlers in
-- response to messages received; these handlers can update the peer's
-- local state and/or send additional messages.  The model also enables
-- "cheat" steps, which can send arbitrary messages, except that they are
-- constrained to prevent a cheat step from introducing a new signature for
-- an "honest" public key.  The module also contains some structures for
-- proving properties of executions of the modeled system.

module LibraBFT.Yasm.System (parms : SystemParameters) where
 open SystemParameters parms

 -- TODO-2: The System model currently depends on a specific EpochConfig
 -- type, which is imported from LibraBFT-specific types.  However, the
 -- system model should be entirely application-independent.  Therefore, we
 -- should factor EpochConfig out of Yasm, and have the SystemParameters
 -- include an EpochConfig type and a way to query whether a given peer is
 -- a member of the represented epoch, and if so, with what associated PK.
 open EpochConfig

 PeerId : Set -- TODO-2: When we factor EpochConfig out of here (see
              -- comment above), PeerId will be a parameter to
              -- SystemParameters; for now, it's NodeId to make it
              -- compatible with everything else.
 PeerId = NodeId

 SenderMsgPair : Set
 SenderMsgPair = PeerId × Msg

 SentMessages : Set
 SentMessages = List SenderMsgPair

 -- The model supports sending messages that contain some fields that are
 -- /not/ covered by the message's signature.  Therefore, given a message
 -- with a verifiable signature, it is possible for a propositionally
 -- different message that verifies against the same signature to have been
 -- sent before, which is captured by the following definition.
 record MsgWithSig∈ (pk : PK)(sig : Signature)(pool : SentMessages) : Set where
   constructor mkMsgWithSig∈
   field
     msgWhole   : Msg
     msgPart    : Part
     msg⊆       : msgPart ⊂Msg msgWhole
     msgSender  : PeerId
     msg∈pool   : (msgSender , msgWhole) ∈ pool
     msgSigned  : WithVerSig pk msgPart
     msgSameSig : ver-signature msgSigned ≡ sig
 open MsgWithSig∈ public

 postulate  -- TODO-1: prove it
   MsgWithSig∈? : ∀ {pk} {sig} {pool} → Dec (MsgWithSig∈ pk sig pool)

 MsgWithSig∈-++ʳ : ∀{pk sig pool ms} → MsgWithSig∈ pk sig pool → MsgWithSig∈ pk sig (ms ++ pool)
 MsgWithSig∈-++ʳ {ms = pre} msig = record
    { msgWhole   = msgWhole msig
    ; msgPart    = msgPart  msig
    ; msg⊆       = msg⊆     msig
    ; msg∈pool   = Any-++ʳ pre (msg∈pool msig)
    ; msgSigned  = msgSigned msig
    ; msgSameSig = msgSameSig msig
    }

 MsgWithSig∈-++ˡ : ∀{pk sig pool ms} → MsgWithSig∈ pk sig ms → MsgWithSig∈ pk sig (ms ++ pool)
 MsgWithSig∈-++ˡ {ms = pre} msig = record
    { msgWhole   = msgWhole msig
    ; msgPart    = msgPart  msig
    ; msg⊆       = msg⊆     msig
    ; msg∈pool   = Any-++ˡ (msg∈pool msig)
    ; msgSigned  = msgSigned msig
    ; msgSameSig = msgSameSig msig
    }

 MsgWithSig∈-transp : ∀{pk sig pool pool'}
                    → (mws : MsgWithSig∈ pk sig pool)
                    → (msgSender mws , msgWhole mws) ∈ pool'
                    → MsgWithSig∈ pk sig pool'
 MsgWithSig∈-transp msig ∈pool' = record
    { msgWhole   = msgWhole msig
    ; msgPart    = msgPart  msig
    ; msg⊆       = msg⊆     msig
    ; msg∈pool   = ∈pool'
    ; msgSigned  = msgSigned msig
    ; msgSameSig = msgSameSig msig
    }

 -- * Forbidding the Forging of Signatures
 --
 -- Whenever our reasoning must involve digital signatures, it is standard
 -- to talk about EUF-CMA resistant signature schemes. Informally, this captures
 -- signatures schemes that cannot be compromised by certain adversaries.
 -- Formally, it means that for any probabilistic-polynomial-time adversary 𝓐,
 -- and some security parameter k:
 --
 --      Pr[ EUF-CMA(k) ] ≤ ε(k) for ε a negigible function.
 --
 -- EUF-CMA is defined as:
 --
 -- EUF-CMA(k):                           |  O(m):
 --   L        ← ∅                        |    σ ← Sign(sk , m)
 --   (pk, sk) ← Gen(k)                   |    L ← L ∪ { m }
 --   (m , σ)  ← 𝓐ᴼ(pk)                   |    return σ
 --   return (Verify(pk, m, σ) ∧ m ∉ L)   |
 --
 -- This says that 𝓐 cannot create a message that has /not yet been signed/ and
 -- forge a signature for it. The list 'L' keeps track of the messages that 𝓐
 -- asked to be signed by the oracle.
 --
 -- Because the probability of the adversary to win the EUF-CMA(k) game
 -- approaches 0 as k increases; it is reasonable to assume that winning
 -- the game is /impossible/ for realistic security parameters.
 --
 -- EUF-CMA security is incorporated into our model by constraining messages
 -- sent by a cheat step to ensure that for every verifiably signed part of
 -- such a message, if there is a signature on the part, then it is either for
 -- a dishonest public key (in which cases it's secret key may have been leaked),
 -- or a message has been sent with the same signature before (in which case the
 -- signature is simply being "replayed" from a previous message).
 --
 -- Dishonest (or "cheat") messages are those that are not the result of
 -- a /handle/ or /init/ call, but rather are the result of a /cheat/ step.
 --
 -- A part of a cheat message can contain a verifiable signature only if it
 -- is for a dishonest public key, or a message with the same signature has
 -- been sent before (a cheater can "reuse" an honest signature sent
 -- before; it just can't produce a new one).  Note that this constraint
 -- precludes a peer sending a message that contains a new verifiable
 -- signature for an honest PK, even if the PK is the peer's own PK for
 -- some epoch (implying that the peer possesses the associated secret
 -- key).  In other words, a peer that is honest for a given epoch (by
 -- virtue of being a member of that epoch and being assigned an honest PK
 -- for the epoch), cannot send a message for that epoch using a cheat
 -- step.
 CheatPartConstraint : SentMessages → Part → Set
 CheatPartConstraint pool m = ∀{pk} → (ver : WithVerSig pk m)
                                    → Meta-Dishonest-PK pk
                                    ⊎ MsgWithSig∈ pk (ver-signature ver) pool

 -- The only constraints on messages sent by cheat steps are that:
 -- * the sender is not an honest member in the epoch of any part of the message
 -- * the signature on any part of the message satisfies CheatCanSign, meaning
 --   that it is not a new signature for an honest public key
 CheatMsgConstraint : SentMessages → Msg → Set
 CheatMsgConstraint pool m = ∀{part} → part ⊂Msg m → CheatPartConstraint pool part

 -- * The System State
 --
 -- A system consists in a partial map from PeerId to PeerState, a pool
 -- of sent messages and a number of available epochs.
 record SystemState (e : ℕ) : Set₁ where
   field
     peerStates  : Map PeerId PeerState
     msgPool     : SentMessages          -- All messages ever sent
     availEpochs : AvailableEpochs e
 open SystemState public

 initialState : SystemState 0
 initialState = record
   { peerStates  = Map-empty
   ; msgPool     = []
   ; availEpochs = []
   }

 -- Convenience function for appending an epoch to the system state
 pushEpoch : ∀{e} → EpochConfigFor e → SystemState e → SystemState (suc e)
 pushEpoch 𝓔 st = record
   { peerStates  = peerStates st
   ; msgPool     = msgPool st
   ; availEpochs = AE.append 𝓔 (availEpochs st)
   }

 -- * Small Step Semantics
 --
 -- The small step semantics are divided into three datatypes:
 --
 -- i)   StepPeerState executes a step through init or handle
 -- ii)  StepPeer executes a step through StepPeerState or cheat
 -- iii) Step transitions the system state by a StepPeer or by
 --      bringing a new epoch into existence

 -- The pre and post states of Honest peers are related iff
 data StepPeerState {e}(pid : PeerId)(𝓔s : AvailableEpochs e)(pool : SentMessages)
          : Maybe PeerState → PeerState → List Msg → Set where
   -- The peer receives an "initialization package"; for now, this consists
   -- of the actual EpochConfig for the epoch being initialized.  Later, we
   -- may move to a more general scheme, enabled by assuming a function
   -- 'render : InitPackage -> EpochConfig'.
   step-init : ∀{ms s' out}(ix : Fin e)
             → (s' , out) ≡ init pid (AE.lookup' 𝓔s ix) ms
             → StepPeerState pid 𝓔s pool ms s' out

   -- The peer processes a message in the pool
   step-msg  : ∀{m ms s s' out}
             → m ∈ pool
             → ms ≡ just s → (s' , out) ≡ handle pid (proj₂ m) s
             → StepPeerState pid 𝓔s pool ms s' out

 -- The pre-state of the suplied PeerId is related to the post-state and list of output messages iff:
 data StepPeer {e}(pre : SystemState e) : PeerId → Maybe PeerState → List Msg → Set where
   -- it can be obtained by a handle or init call.
   step-honest : ∀{pid st outs}
               → StepPeerState pid (availEpochs pre) (msgPool pre) (Map-lookup pid (peerStates pre)) st outs
               → StepPeer pre pid (just st) outs

   -- or the peer decides to cheat.  CheatMsgConstraint ensures it cannot
   -- forge signatures by honest peers.  Cheat steps do not modify peer
   -- state: these are maintained exclusively by the implementation
   -- handlers.
   step-cheat  : ∀{pid}
               → (fm : SentMessages → Maybe PeerState → Msg)
               → let m = fm (msgPool pre) (Map-lookup pid (peerStates pre))
                  in CheatMsgConstraint (msgPool pre) m
                   → StepPeer pre pid (Map-lookup pid (peerStates pre)) (m ∷ [])

 isCheat : ∀ {e pre pid ms outs} → StepPeer {e} pre pid ms outs → Set
 isCheat (step-honest _)  = ⊥
 isCheat (step-cheat _ _) = Unit

 -- Computes the post-sysstate for a given step-peer.
 StepPeer-post : ∀{e pid st' outs}{pre : SystemState e}
               → StepPeer pre pid st' outs → SystemState e
 StepPeer-post {e} {pid} {st'} {outs} {pre} _ = record pre
   { peerStates = Map-set pid st' (peerStates pre)
   ; msgPool    = List-map (pid ,_) outs ++ msgPool pre
   }

 data Step : ∀{e e'} → SystemState e → SystemState e' → Set₁ where
   step-epoch : ∀{e}{pre : SystemState e}
              → (𝓔 : EpochConfigFor e)
              -- TODO-3: Eventually, we'll condition this step to only be
              -- valid when peers on the previous epoch have agreed that 𝓔
              -- is the new one.  → ∃EnoughValidCommitMsgsFor pre 𝓔
              → Step pre (pushEpoch 𝓔 pre)

   step-peer : ∀{e pid st' outs}{pre : SystemState e}
             → (pstep : StepPeer pre pid st' outs)
             → Step pre (StepPeer-post pstep)

 postulate -- TODO-1: prove it
   msgs-stable : ∀ {e e'} {pre : SystemState e} {post : SystemState e'} {m}
               → (theStep : Step pre post)
               → m ∈ msgPool pre
               → m ∈ msgPool post

 postulate -- not used yet, but some proofs could probably be cleaned up using this,
           -- e.g., prevVoteRnd≤-pred-step in Impl.VotesOnce
   sendMessages-target : ∀ {m : SenderMsgPair} {sm : SentMessages} {ml : List SenderMsgPair}
                       → ¬ (m ∈ sm)
                       → m ∈ (ml ++ sm)
                       → m ∈ ml

 step-epoch-does-not-send : ∀ {e} (pre : SystemState e) (𝓔 : EpochConfigFor e)
                            → msgPool (pushEpoch 𝓔 pre) ≡ msgPool pre
 step-epoch-does-not-send _ _ = refl

 -- * Reflexive-Transitive Closure

 data Step* : ∀{e e'} → SystemState e → SystemState e' → Set₁ where
   step-0 : ∀{e}{pre : SystemState e}
          → Step* pre pre

   step-s : ∀{e e' e''}{fst : SystemState e}{pre : SystemState e'}{post : SystemState e''}
          → Step* fst pre
          → Step pre post
          → Step* fst post

 ReachableSystemState : ∀{e} → SystemState e → Set₁
 ReachableSystemState = Step* initialState

 Step*-mono : ∀{e e'}{st : SystemState e}{st' : SystemState e'}
            → Step* st st' → e ≤ e'
 Step*-mono step-0 = ≤-refl
 Step*-mono (step-s tr (step-peer _)) = Step*-mono tr
 Step*-mono (step-s tr (step-epoch _)) = ≤-step (Step*-mono tr)

 MsgWithSig∈-Step* : ∀{e e' sig pk}{st : SystemState e}{st' : SystemState e'}
                   → Step* st st'
                   → MsgWithSig∈ pk sig (msgPool st)
                   → MsgWithSig∈ pk sig (msgPool st')
 MsgWithSig∈-Step* step-0        msig = msig
 MsgWithSig∈-Step* (step-s tr (step-epoch _)) msig
   = MsgWithSig∈-Step* tr msig
 MsgWithSig∈-Step* (step-s tr (step-peer ps)) msig
   = MsgWithSig∈-++ʳ (MsgWithSig∈-Step* tr msig)

 MsgWithSig∈-Step*-part : ∀{e e' sig pk}{st : SystemState e}{st' : SystemState e'}
                        → (tr   : Step* st st')
                        → (msig : MsgWithSig∈ pk sig (msgPool st))
                        → msgPart msig ≡ msgPart (MsgWithSig∈-Step* tr msig)
 MsgWithSig∈-Step*-part step-0        msig = refl
 MsgWithSig∈-Step*-part (step-s tr (step-epoch _)) msig
   = MsgWithSig∈-Step*-part tr msig
 MsgWithSig∈-Step*-part (step-s tr (step-peer ps)) msig
   = MsgWithSig∈-Step*-part tr msig

 ------------------------------------------

 -- Type synonym to express a relation over system states;
 SystemStateRel : (∀{e e'} → SystemState e → SystemState e' → Set₁) → Set₂
 SystemStateRel P = ∀{e e'}{st : SystemState e}{st' : SystemState e'} → P st st' → Set₁

 -- Just like Data.List.Any maps a predicate over elements to a predicate over lists,
 -- Any-step maps a relation over steps to a relation over steps in a trace.
 data Any-Step (P : SystemStateRel Step) : SystemStateRel Step* where
  step-here  : ∀{e e' e''}{fst : SystemState e}{pre : SystemState e'}{post : SystemState e''}
             → (cont : Step* fst pre)
             → {this : Step pre post}(prf  : P this)
             → Any-Step P (step-s cont this)

  step-there : ∀{e e' e''}{fst : SystemState e}{pre : SystemState e'}{post : SystemState e''}
             → {cont : Step* fst pre}
             → {this : Step pre post}
             → (prf  : Any-Step P cont)
             → Any-Step P (step-s cont this)

 Any-Step-elim
   : ∀{e₀ e₁}{st₀ : SystemState e₀}{st₁ : SystemState e₁}{P : SystemStateRel Step}{Q : Set₁}
   → {r : Step* st₀ st₁}
   → (P⇒Q : ∀{d d'}{s : SystemState d}{s' : SystemState d'}{st : Step s s'}
          → P st → Step* s' st₁ → Q)
   → Any-Step P r → Q
 Any-Step-elim P⇒Q (step-here cont prf)
   = P⇒Q prf step-0
 Any-Step-elim P⇒Q (step-there {this = this} f)
   = Any-Step-elim (λ p s → P⇒Q p (step-s s this)) f

 ------------------------------------------

 module _ (P : ∀{e} → SystemState e → Set) where

   Step*-Step-fold : (∀{e}{st : SystemState e}
                        → ReachableSystemState st
                        → (𝓔 : EpochConfigFor e)
                        → P st
                        → P (pushEpoch 𝓔 st))
                   → (∀{e pid st' outs}{st : SystemState e}
                        → ReachableSystemState st
                        → (pstep : StepPeer st pid st' outs)
                        → P st
                        → P (StepPeer-post pstep))
                   → P initialState
                   → ∀{e}{st : SystemState e}
                   → (tr : ReachableSystemState st) → P st
   Step*-Step-fold fe fs p₀ step-0 = p₀
   Step*-Step-fold fe fs p₀ (step-s tr (step-epoch 𝓔)) = fe tr 𝓔 (Step*-Step-fold fe fs p₀ tr)
   Step*-Step-fold fe fs p₀ (step-s tr (step-peer p)) = fs tr p (Step*-Step-fold fe fs p₀ tr)


module Structs where

open import Data.List
open import Data.String
open import Data.Product hiding (map)
open import Relation.Binary.PropositionalEquality as PE hiding ([_])
open import Data.List.Any hiding (map)
open module M {ℓ}{X : Set ℓ} = Membership (PE.setoid X )
import Level

data StructEnd {ℓ} : Set ℓ where
  end : StructEnd

data StructField {ℓ}(s : String)(t : Set ℓ) : Set ℓ where
  _∹_ : (x : String) → {_ : x ≡ s} → t → StructField s t

FieldTypes = λ ℓ → List (String × Set ℓ)

Struct : ∀{ℓ} → FieldTypes ℓ → Set ℓ
Struct [] = StructEnd
Struct {ℓ} ( (n , t) ∷ l) = StructField {ℓ} n t × Struct l

infixr 6 _∶_∷_
data StructLit {ℓ} : FieldTypes ℓ → Set (Level.suc ℓ) where
  [] : StructLit []
  _∶_∷_ : ∀{t : Set ℓ}{ls} → (s : String) → t → StructLit ls → StructLit ((s , t) ∷ ls)

⟨_⟩ : ∀{ℓ}{ls} → StructLit {ℓ} ls → Struct ls
⟨ [] ⟩ = end
⟨ s ∶ x ∷ xs ⟩ = _∹_ s {refl} x , ⟨ xs ⟩

instance
  found-it : ∀{ℓ}{X : Set ℓ}{x : X}{xs : List X}
           → x ∈ (x ∷ xs)
  found-it = here refl
  keep-looking : ∀{ℓ}{X : Set ℓ}{x y : X}{xs : List X}
               → ⦃ t : y ∈ xs ⦄
               → y ∈ (x ∷ xs)
  keep-looking ⦃ t ⦄ = there t

lookup : ∀{ℓ ℓ′}{K : Set ℓ}{V : Set ℓ′}{s}
       → (l : List (K × V)) → s ∈ (map proj₁ l) → V
lookup [] ()
lookup (x ∷ l) (here refl) = proj₂ x
lookup (x ∷ l) (there p)   = lookup l p

update : ∀{ℓ ℓ′}{K : Set ℓ}{V : Set ℓ′}{s}
       → (l : List (K × V)) → s ∈ (map proj₁ l) → V → List (K × V)
update [] () _
update (x ∷ l) (here refl) n = (proj₁ x , n) ∷ l
update (x ∷ l) (there p) n = x ∷ update l p n

field-names = λ{ℓ}(ls : FieldTypes ℓ) → map proj₁ ls

infixl 6 _∙_

_∙_ : ∀{ℓ}{ls : FieldTypes ℓ}
    → Struct ls
    → (s : String) ⦃ prf : s ∈ field-names ls ⦄
    → lookup ls prf
_∙_ {ls = []} _ x ⦃ () ⦄
_∙_ {ls = x ∷ ls} (tg ∹ v , r) ._ ⦃ here refl ⦄ = v
_∙_ {ls = x ∷ ls} (k , r) x₁ ⦃ there prf ⦄ = _∙_ {ls = ls} r x₁ ⦃ prf ⦄

infixl 6 _∙_≔_

module TypeChangingAssignment where

  infixl 6 _∙_≔′_

  _∙_≔′_ : ∀{ℓ}{ls : FieldTypes ℓ}{X : Set ℓ}
        → Struct ls
        → (s : String) ⦃ prf : s ∈ field-names ls ⦄
        → X
        → Struct (update ls prf X)
  _∙_≔′_ {ls = []} s t ⦃ () ⦄ n
  _∙_≔′_ {ls = (q , _) ∷ ls} (_∹_ .q {refl} v , r) ._ ⦃ here refl ⦄ n = _∹_ q {refl} n , r
  _∙_≔′_ {ls = x ∷ ls} (t , r) k  ⦃ there prf ⦄ n = t , (r ∙ k ≔′ n)

  memb-update : ∀{ℓ ℓ′}{K : Set ℓ}{V : Set ℓ′}{ls : List (K × V)}{k}{x : V} → ⦃ prf : k ∈ map proj₁ ls ⦄ → k ∈ map proj₁ (update ls prf x)
  memb-update {ls = []} ⦃ () ⦄
  memb-update {ls = x ∷ ls} {{prf = here refl}} = here refl
  memb-update {ls = x ∷ ls} {{prf = there prf}} = there (memb-update {ls = ls} ⦃ prf ⦄)

  lookup-update : ∀{ℓ ℓ′}{K : Set ℓ}{V : Set ℓ′}{ls : List (K × V)}{k}{x : V}
        → ⦃ prf : k ∈ map proj₁ ls ⦄
        → lookup (update ls prf x) (memb-update ⦃ prf ⦄) ≡ x
  lookup-update {ls = []} ⦃ prf = () ⦄
  lookup-update {ls = x ∷ ls} ⦃ prf = here refl ⦄ = refl
  lookup-update {ls = x ∷ ls} ⦃ prf = there prf ⦄ = lookup-update {ls = ls} ⦃ prf ⦄

  update-lookup : ∀{ℓ ℓ′}{K : Set ℓ}{V : Set ℓ′}{ls : List (K × V)}{k}
                → ⦃ prf : k ∈ map proj₁ ls ⦄
                → update ls prf (lookup ls prf) ≡ ls
  update-lookup {ls = []} ⦃ () ⦄
  update-lookup {ls = x ∷ ls} ⦃ here refl ⦄ = refl
  update-lookup {ls = x ∷ ls} ⦃ there prf ⦄ rewrite update-lookup {ls = ls} ⦃ prf ⦄ = refl

_∙_≔_ : ∀{ℓ}{ls : FieldTypes ℓ}
      → Struct ls
      → (s : String) ⦃ prf : s ∈ field-names ls ⦄
      → lookup ls prf
      → Struct ls
_∙_≔_ {ls = []} s f ⦃ () ⦄ v
_∙_≔_ {ls = x ∷ ls} (_∹_ ._ {refl} _ , r) ._ ⦃ here refl ⦄ v = _∹_ (proj₁ x) {refl} v , r
_∙_≔_ {ls = x ∷ ls} (k , r) f ⦃ there prf ⦄ v = k , r ∙ f ≔ v

spurious-update : ∀{ℓ}{ls : FieldTypes ℓ}{s : Struct ls}{f}
                → ⦃ prf : f ∈ field-names ls ⦄
                → (s ∙ f ≔ (s ∙ f)) ≡ s
spurious-update {ls = []}                         ⦃ () ⦄
spurious-update {ls = _ ∷ _}{_∹_ ._ {refl} _ , _} ⦃ here refl ⦄ = refl
spurious-update {ls = _ ∷ _}{_∹_ ._ {refl} _ , _} ⦃ there prf ⦄ = cong (_,_ _) spurious-update

read-after-update : ∀{ℓ}{ls : FieldTypes ℓ}{s : Struct ls}{f}
                  → ⦃ prf : f ∈ field-names ls ⦄
                  → {v : lookup ls prf}
                  → (s ∙ f ≔ v) ∙ f ≡ v
read-after-update {ls = []}                           ⦃ () ⦄
read-after-update {ls = _ ∷ _}{ _∹_ ._ {refl} _ , _ } ⦃ here refl ⦄ = refl
read-after-update {ls = _ ∷ _}{ _∹_ ._ {refl} _ , _ } ⦃ there prf ⦄ = read-after-update ⦃ prf ⦄

frame-inertia : ∀{ℓ}{ls : FieldTypes ℓ}{s : Struct ls}{f f′}
              → f ≢ f′
              → ⦃ prf : f  ∈ field-names ls ⦄
              → ⦃ prf′ : f′ ∈ field-names ls ⦄
              → {v : lookup ls prf′}
              → (s ∙ f′ ≔ v) ∙ f ≡ (s ∙ f)
frame-inertia {ls = []}                            _ ⦃ () ⦄
frame-inertia {ls = _ ∷ ls}{ _∹_ ._ {refl} _ , _ } _ ⦃ here refl ⦄ ⦃ there prf′ ⦄ = refl
frame-inertia {ls = _ ∷ ls}{ _∹_ ._ {refl} _ , _ } _ ⦃ there prf ⦄ ⦃ here refl  ⦄ = refl
frame-inertia {ls = _ ∷ ls}{ _∹_ ._ {refl} _ , _ } p ⦃ there prf ⦄ ⦃ there prf′ ⦄ = frame-inertia {ls = ls} p
frame-inertia {ls = _ ∷ ls}{ _∹_ ._ {refl} _ , _ } p ⦃ here refl ⦄ ⦃ here refl  ⦄ with p refl
... | ()

append : ∀{ℓ}{ls : FieldTypes ℓ}{ms : FieldTypes ℓ} → Struct ls → Struct ms → Struct (Data.List._++_ ls ms)
append {ls = [] } s₁ s₂ = s₂
append {ls = x ∷ xs} (f , rest) s₂ = f , append rest s₂

drop-append : ∀{ℓ}{ls : FieldTypes ℓ}{ms : FieldTypes ℓ} → Struct (Data.List._++_ ls ms) → Struct ms
drop-append {ls = []} m = m
drop-append {ls = x ∷ xs} (f , rest) = drop-append {ls = xs} rest


-- Andreas, 2016-07-20

-- With clauses should follow the parent clause
-- what copattern style (prefix/postfix) concerns.

record R : Set₂ where
  field f : Set₁

test : R
test .R.f with R    -- post-fix here
R.f test | _ = Set  -- pre-fix there

-- That's not nice, thus, it is an error.


{-# OPTIONS --safe #-}

open import Definition.Typed.EqualityRelation

module Definition.LogicalRelation.Substitution.Introductions.Idlemmas {{eqrel : EqRelSet}} where
open EqRelSet {{...}}

open import Definition.Untyped
open import Definition.Untyped.Properties
open import Definition.Typed
open import Definition.Typed.Properties
import Definition.Typed.Weakening as Twk
open import Definition.Typed.EqualityRelation
open import Definition.Typed.RedSteps
open import Definition.LogicalRelation
open import Definition.LogicalRelation.Irrelevance
open import Definition.LogicalRelation.Properties
open import Definition.LogicalRelation.Application
open import Definition.LogicalRelation.Substitution
import Definition.LogicalRelation.Weakening as Lwk
open import Definition.LogicalRelation.Substitution.Properties
import Definition.LogicalRelation.Substitution.Irrelevance as S
open import Definition.LogicalRelation.Substitution.Reflexivity
open import Definition.LogicalRelation.Substitution.Weakening
-- open import Definition.LogicalRelation.Substitution.Introductions.Nat
open import Definition.LogicalRelation.Substitution.Introductions.Empty
open import Definition.LogicalRelation.Substitution.Introductions.Pi
open import Definition.LogicalRelation.Substitution.MaybeEmbed
open import Definition.LogicalRelation.Substitution.Introductions.Cast
-- open import Definition.LogicalRelation.Substitution.Introductions.SingleSubst
open import Definition.LogicalRelation.Substitution.Introductions.Universe

open import Tools.Product
open import Tools.Empty
import Tools.Unit as TU
import Tools.PropositionalEquality as PE
import Data.Nat as Nat

[proj₁cast] : ∀ {A B Γ r}
         (⊢Γ : ⊢ Γ)
         ([A] : Γ ⊩⟨ ι ⁰ ⟩ A ^ [ r , ι ⁰ ])
         ([B] : Γ ⊩⟨ ι ⁰ ⟩ B ^ [ r , ι ⁰ ])
       → (∀ {t e} → ([t] : Γ ⊩⟨ ι ⁰ ⟩ t ∷ A ^ [ r , ι ⁰ ] / [A]) → (⊢e : Γ ⊢ e ∷ Id (Univ r ⁰) A B ^ [ % , ι ¹ ]) → Γ ⊩⟨ ι ⁰ ⟩ cast ⁰ A B e t ∷ B ^ [ r , ι ⁰ ] / [B])
[proj₁cast] ⊢Γ [A] [B] = proj₁ ([cast] ⊢Γ [A] [B])

[proj₁castext] : ∀ {A A′ B B′ Γ r}
         (⊢Γ : ⊢ Γ)
         ([A] : Γ ⊩⟨ ι ⁰ ⟩ A ^ [ r , ι ⁰ ])
         ([A′] : Γ ⊩⟨ ι ⁰ ⟩ A′ ^ [ r , ι ⁰ ])
         ([A≡A′] : Γ ⊩⟨ ι ⁰ ⟩ A ≡ A′ ^ [ r , ι ⁰ ] / [A])
         ([B] : Γ ⊩⟨ ι ⁰ ⟩ B ^ [ r , ι ⁰ ])
         ([B′] : Γ ⊩⟨ ι ⁰ ⟩ B′ ^ [ r , ι ⁰ ])
         ([B≡B′] : Γ ⊩⟨ ι ⁰ ⟩ B ≡ B′ ^ [ r , ι ⁰ ] / [B])
       → (∀ {t t′ e e′} → ([t] : Γ ⊩⟨ ι ⁰ ⟩ t ∷ A ^ [ r , ι ⁰ ] / [A])
                        → ([t′] : Γ ⊩⟨ ι ⁰ ⟩ t′ ∷ A′ ^ [ r , ι ⁰ ] / [A′])
                        → ([t≡t′] : Γ ⊩⟨ ι ⁰ ⟩ t ≡ t′ ∷ A ^ [ r , ι ⁰ ] / [A])
                        → (⊢e : Γ ⊢ e ∷ Id (Univ r ⁰) A B ^ [ % , ι ¹ ])
                        → (⊢e′ : Γ ⊢ e′ ∷ Id (Univ r ⁰) A′ B′ ^ [ % , ι ¹ ])
                        → Γ ⊩⟨ ι ⁰ ⟩ cast ⁰ A B e t ≡ cast ⁰ A′ B′ e′ t′ ∷ B ^ [ r , ι ⁰ ] / [B])
[proj₁castext] ⊢Γ [A] [A′] [A≡A′] [B] [B′] [B≡B′] = proj₁ ([castext] ⊢Γ [A] [A′] [A≡A′] [B] [B′] [B≡B′])

[nondep] : ∀ {Γ A B l} → Γ ⊩⟨ l ⟩ B ^ [ % , l ]
  → ([A] : ∀ {ρ} {Δ} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) → (⊢Δ : ⊢ Δ) → Δ ⊩⟨ l ⟩ wk ρ A ^ [ % , l ])
  → ∀ {ρ} {Δ} {a} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) → (⊢Δ : ⊢ Δ)
  → ([a] : Δ ⊩⟨ l ⟩ a ∷ wk ρ A ^ [ % , l ] / [A] [ρ] ⊢Δ)
  → Δ ⊩⟨ l ⟩ wk (lift ρ) (wk1 B) [ a ] ^ [ % , l ]
[nondep] {Γ} {A} {B} {l} [B] [A] {ρ} {Δ} {a} [ρ] ⊢Δ [a] = PE.subst (λ X → Δ ⊩⟨ l ⟩ X ^ [ % , l ]) (Id-subst-lemma ρ B a) (Lwk.wk [ρ] ⊢Δ [B])

[nondepext] : ∀ {Γ A B l} → ([B] : Γ ⊩⟨ l ⟩ B ^ [ % , l ])
  → ([A] : ∀ {ρ} {Δ} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) → (⊢Δ : ⊢ Δ) → Δ ⊩⟨ l ⟩ wk ρ A ^ [ % , l ])
  → ∀ {ρ} {Δ} {a} {b} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) → (⊢Δ : ⊢ Δ)
  → ([a] : Δ ⊩⟨ l ⟩ a ∷ wk ρ A ^ [ % , l ] / [A] [ρ] ⊢Δ)
  → ([b] : Δ ⊩⟨ l ⟩ b ∷ wk ρ A ^ [ % , l ] / [A] [ρ] ⊢Δ)
  → ([a≡b] : Δ ⊩⟨ l ⟩ a ≡ b ∷ wk ρ A ^ [ % , l ] / [A] [ρ] ⊢Δ)
  → Δ ⊩⟨ l ⟩ wk (lift ρ) (wk1 B) [ a ] ≡ wk (lift ρ) (wk1 B) [ b ] ^ [ % , l ] / [nondep] [B] [A] [ρ] ⊢Δ [a]
[nondepext] {Γ} {A} {B} {l} [B] [A] {ρ} {Δ} {a} {b} [ρ] ⊢Δ [a] [b] [a≡b] =
  irrelevanceEq″ (Id-subst-lemma ρ B a) (Id-subst-lemma ρ B b) PE.refl PE.refl
    (Lwk.wk [ρ] ⊢Δ [B]) ([nondep] [B] [A] [ρ] ⊢Δ [a]) (reflEq (Lwk.wk [ρ] ⊢Δ [B]))

[nondepext'] : ∀ {Γ A A' B B' l}
  → ([B] : Γ ⊩⟨ l ⟩ B ^ [ % , l ])
  → ([B'] : Γ ⊩⟨ l ⟩ B' ^ [ % , l ])
  → ([B≡B'] : Γ ⊩⟨ l ⟩ B ≡ B' ^ [ % , l ] / [B])
  → ([A] : ∀ {ρ} {Δ} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) → (⊢Δ : ⊢ Δ) → Δ ⊩⟨ l ⟩ wk ρ A ^ [ % , l ])
  → ([A'] : ∀ {ρ} {Δ} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) → (⊢Δ : ⊢ Δ) → Δ ⊩⟨ l ⟩ wk ρ A' ^ [ % , l ])
  → ∀ {ρ} {Δ} {a} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) → (⊢Δ : ⊢ Δ)
  → ([a] : Δ ⊩⟨ l ⟩ a ∷ wk ρ A ^ [ % , l ] / [A] [ρ] ⊢Δ)
  → Δ ⊩⟨ l ⟩ wk (lift ρ) (wk1 B) [ a ] ≡ wk (lift ρ) (wk1 B') [ a ] ^ [ % , l ] / [nondep] [B] [A] [ρ] ⊢Δ [a]
[nondepext'] {Γ} {A} {A'} {B} {B'} {l} [B] [B'] [B≡B'] [A] [A'] {ρ} {Δ} {a} [ρ] ⊢Δ [a] =
  irrelevanceEq″ (Id-subst-lemma ρ B a) (Id-subst-lemma ρ B' a) PE.refl PE.refl
    (Lwk.wk [ρ] ⊢Δ [B]) ([nondep] [B] [A] [ρ] ⊢Δ [a]) (Lwk.wkEq [ρ] ⊢Δ [B] [B≡B'])

module IdTypeU-lemmas
       {Γ rF A B F G F₁ G₁}
       (⊢Γ : ⊢ Γ)
       (⊢A : Γ ⊢ A ^ [ ! , ι ⁰ ])
       (⊢ΠFG : Γ ⊢ Π F ^ rF ° ⁰ ▹ G ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (D : Γ ⊢ A ⇒* Π F ^ rF ° ⁰ ▹ G ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (⊢F : Γ ⊢ F ^ [ rF , ι ⁰ ])
       (⊢G : (Γ ∙ F ^ [ rF , ι ⁰ ]) ⊢ G ^ [ ! , ι ⁰ ])
       (A≡A : Γ ⊢ (Π F ^ rF ° ⁰ ▹ G ° ⁰ ° ⁰) ≅ (Π F ^ rF ° ⁰ ▹ G ° ⁰ ° ⁰) ^ [ ! , ι ⁰ ])
       ([F] : ∀ {ρ} {Δ} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) → Δ ⊩⟨ ι ⁰ ⟩ wk ρ F ^ [ rF , ι ⁰ ])
       ([G] : ∀ {ρ} {Δ} {a} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷  wk ρ F ^ [ rF , ι ⁰ ] / ([F] [ρ] ⊢Δ))
          → (Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G [ a ] ^ [ ! , ι ⁰ ]))
       (G-ext : ∀ {ρ} {Δ} {a} {b} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷  wk ρ F ^ [ rF , ι ⁰ ] / ([F] [ρ] ⊢Δ))
          ([b] : Δ ⊩⟨ ι ⁰ ⟩ b ∷  wk ρ F ^ [ rF , ι ⁰ ] / ([F] [ρ] ⊢Δ))
          ([a≡b] : Δ ⊩⟨ ι ⁰ ⟩ a ≡ b ∷ wk ρ F ^ [ rF , ι ⁰ ] / ([F] [ρ] ⊢Δ))
          → (Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G [ a ] ≡ wk (lift ρ) G [ b ] ^ [ ! , ι ⁰ ] / ([G] [ρ] ⊢Δ [a])))
       (⊢B     : Γ ⊢ B ^ [ ! , ι ⁰ ])
       (⊢ΠF₁G₁ : Γ ⊢ Π F₁ ^ rF ° ⁰ ▹ G₁ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (D₁     : Γ ⊢ B ⇒* Π F₁ ^ rF ° ⁰ ▹ G₁ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (⊢F₁    : Γ ⊢ F₁ ^ [ rF , ι ⁰ ])
       (⊢G₁    : (Γ ∙ F₁ ^ [ rF , ι ⁰ ]) ⊢ G₁ ^ [ ! , ι ⁰ ])
       (B≡B  : Γ ⊢ (Π F₁ ^ rF ° ⁰ ▹ G₁ ° ⁰ ° ⁰) ≅ (Π F₁ ^ rF ° ⁰ ▹ G₁ ° ⁰ ° ⁰) ^ [ ! , ι ⁰ ])
       ([F₁] : ∀ {ρ} {Δ} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) → Δ ⊩⟨ ι ⁰ ⟩ wk ρ F₁ ^ [ rF , ι ⁰ ])
       ([G₁] : ∀ {ρ} {Δ} {a} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷  wk ρ F₁ ^ [ rF , ι ⁰ ] / ([F₁] [ρ] ⊢Δ))
          → (Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G₁ [ a ] ^ [ ! , ι ⁰ ]))
       (G₁-ext : ∀ {ρ} {Δ} {a} {b} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷  wk ρ F₁ ^ [ rF , ι ⁰ ] / ([F₁] [ρ] ⊢Δ))
          ([b] : Δ ⊩⟨ ι ⁰ ⟩ b ∷  wk ρ F₁ ^ [ rF , ι ⁰ ] / ([F₁] [ρ] ⊢Δ))
          ([a≡b] : Δ ⊩⟨ ι ⁰ ⟩ a ≡ b ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / ([F₁] [ρ] ⊢Δ))
          → (Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G₁ [ a ] ≡ wk (lift ρ) G₁ [ b ] ^ [ ! , ι ⁰ ] / ([G₁] [ρ] ⊢Δ [a])))
       (recursor₁ : ∀ {ρ Δ}
          ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          → Δ ⊩⟨ ι ¹ ⟩ Id (Univ rF ⁰) (wk ρ F) (wk ρ F₁) ^ [ % , ι ¹ ])
       (recursor₂ : ∀ {ρ Δ x y}
          ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([x] : Δ ⊩⟨ ι ⁰ ⟩ x ∷ wk ρ F ^ [ rF , ι ⁰ ] / [F] [ρ] ⊢Δ)
          ([y] : Δ ⊩⟨ ι ⁰ ⟩ y ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
          → Δ ⊩⟨ ι ¹ ⟩ Id (U ⁰) (wk (lift ρ) G [ x ]) (wk (lift ρ) G₁ [ y ]) ^ [ % , ι ¹ ])
       (extrecursor : ∀ {ρ Δ x y x′ y′}
          ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([x] : Δ ⊩⟨ ι ⁰ ⟩ x ∷ wk ρ F ^ [ rF , ι ⁰ ] / [F] [ρ] ⊢Δ)
          ([x′] : Δ ⊩⟨ ι ⁰ ⟩ x′ ∷ wk ρ F ^ [ rF , ι ⁰ ] / [F] [ρ] ⊢Δ)
          ([x≡x′] : Δ ⊩⟨ ι ⁰ ⟩ x ≡ x′ ∷ wk ρ F ^ [ rF , ι ⁰ ] / [F] [ρ] ⊢Δ)
          ([y] : Δ ⊩⟨ ι ⁰ ⟩ y ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
          ([y′] : Δ ⊩⟨ ι ⁰ ⟩ y′ ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
          ([y≡y′] : Δ ⊩⟨ ι ⁰ ⟩ y ≡ y′ ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
          → Δ ⊩⟨ ι ¹ ⟩ Id (U ⁰) (wk (lift ρ) G [ x ]) (wk (lift ρ) G₁ [ y ]) ≡ Id (U ⁰) (wk (lift ρ) G [ x′ ]) (wk (lift ρ) G₁ [ y′ ]) ^ [ % , ι ¹ ] / recursor₂ [ρ] ⊢Δ [x] [y])
  where
    ⊢IdFF₁ : Γ ⊢ Id (Univ rF ⁰) F F₁ ^ [ % , ι ¹ ]
    ⊢IdFF₁ = univ (Idⱼ (univ 0<1 ⊢Γ) (un-univ ⊢F) (un-univ ⊢F₁))

    [IdFF₁] : ∀ {ρ Δ} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) → (⊢Δ : ⊢ Δ) → Δ ⊩⟨ ι ¹ ⟩ wk ρ (Id (Univ rF ⁰) F F₁) ^ [ % , ι ¹ ]
    [IdFF₁] [ρ] ⊢Δ = recursor₁ [ρ] ⊢Δ

    b = λ ρ e x → cast ⁰ (wk ρ F₁) (wk ρ F) (Idsym (Univ rF ⁰) (wk ρ F) (wk ρ F₁) e) x
    IdGG₁ = λ ρ e → Π (wk ρ F₁) ^ rF ° ⁰ ▹ Id (U ⁰) (wk (lift (step ρ)) G [ b (step ρ) (wk1 e) (var 0) ]) (wk (lift ρ) G₁) ° ¹ ° ¹

    abstract
      IdTel₂-prettify : ∀ ρ₁ ρ e a → wk (lift ρ₁) (Id (U ⁰) (wk (lift (step ρ)) G [ b (step ρ) (wk1 e) (var 0) ]) (wk (lift ρ) G₁)) [ a ]
        PE.≡ Id (U ⁰) (wk (lift (ρ₁ • ρ)) G [ b (ρ₁ • ρ) (wk ρ₁ e) a ]) (wk (lift (ρ₁ • ρ)) G₁ [ a ])
      IdTel₂-prettify ρ₁ ρ e a = let
          x₂ = PE.trans (PE.cong (subst (sgSubst a)) (wk-Idsym (lift ρ₁) (Univ rF ⁰) (wk (step ρ) F) (wk (step ρ) F₁) (wk1 e)))
            (PE.trans (subst-Idsym (sgSubst a) (Univ rF ⁰) (wk _ (wk (step ρ) F)) (wk _ (wk (step ρ) F₁)) (wk _ (wk1 e)))
              (PE.cong₃ (λ X Y Z → Idsym (Univ rF ⁰) X Y Z) (Id-subst-lemma4 ρ ρ₁ F a) (Id-subst-lemma4 ρ ρ₁ F₁ a) (irrelevant-subst′ ρ₁ e a)))
          x₁ = PE.cong₂ (λ X Y → X [ Y ]) (Id-subst-lemma3 ρ ρ₁ G a) (PE.cong₃ (λ X Y Z → cast ⁰ X Y Z a) (Id-subst-lemma4 ρ ρ₁ F₁ a) ((Id-subst-lemma4 ρ ρ₁ F a)) x₂)
          x = PE.trans (PE.cong (λ X → X [ a ]) (wk-β (wk (lift (step ρ)) G)))
            (PE.trans (singleSubstLift (wk (lift (lift ρ₁)) (wk (lift (step ρ)) G)) (wk (lift ρ₁) (b (step ρ) (wk1 e) (var 0)))) x₁)
        in PE.cong₂ (λ X Y → Id (U ⁰) X Y) x (PE.cong (λ X → X [ a ]) (wk-comp (lift ρ₁) (lift ρ) G₁))

    abstract
      [Id] : ∀ {ρ Δ e} →([ρ] : ρ Twk.∷ Δ ⊆ Γ) → (⊢Δ : ⊢ Δ)
        → ([e] : Δ ⊩⟨ ι ¹ ⟩ e ∷ wk ρ (Id (Univ rF ⁰) F F₁) ^ [ % , ι ¹ ] / [IdFF₁] [ρ] ⊢Δ)
        → ∀ {ρ₁ Δ₁ a} → ([ρ₁] : ρ₁ Twk.∷ Δ₁ ⊆ Δ) → (⊢Δ₁ : ⊢ Δ₁)
        → ([a] : Δ₁ ⊩⟨ ι ⁰ ⟩ a ∷ wk ρ₁ (wk ρ F₁) ^ [ rF , ι ⁰ ] / (Lwk.wk [ρ₁] ⊢Δ₁ ([F₁] [ρ] ⊢Δ)))
        → Δ₁ ⊩⟨ ι ¹ ⟩ wk (lift ρ₁) (Id (U ⁰) (wk (lift (step ρ)) G [ b (step ρ) (wk1 e) (var 0) ]) (wk (lift ρ) G₁)) [ a ] ^ [ % , ι ¹ ]
      [Id] {ρ} {Δ} {e} [ρ] ⊢Δ [e] {ρ₁} {Δ₁} {a} [ρ₁] ⊢Δ₁ [a] =
        let
          [a] : Δ₁ ⊩⟨ ι ⁰ ⟩ a ∷ wk (ρ₁ • ρ) F₁ ^ [ rF , ι ⁰ ] / [F₁] ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁
          [a] = irrelevanceTerm′ (wk-comp ρ₁ ρ F₁) PE.refl PE.refl (Lwk.wk [ρ₁] ⊢Δ₁ ([F₁] [ρ] ⊢Δ)) ([F₁] ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁) [a]
          ⊢e″ = PE.subst (λ X → Δ₁ ⊢ wk ρ₁ e ∷ X ^ [ % , ι ¹ ]) (wk-comp ρ₁ ρ _) (Twk.wkTerm [ρ₁] ⊢Δ₁ (escapeTerm ([IdFF₁] [ρ] ⊢Δ) [e]))
          ⊢e′ = Idsymⱼ (univ 0<1 ⊢Δ₁) (un-univ (escape ([F] ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁))) (un-univ (escape ([F₁] ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁))) ⊢e″
          [b] : Δ₁ ⊩⟨ ι ⁰ ⟩ b (ρ₁ • ρ) (wk ρ₁ e) a ∷ wk (ρ₁ • ρ) F ^ [ rF , ι ⁰ ] / [F] ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁
          [b] = [proj₁cast] ⊢Δ₁ ([F₁] ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁) ([F] ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁) [a] ⊢e′
          x = recursor₂ ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁ [b] [a]
        in PE.subst (λ X → Δ₁ ⊩⟨ ι ¹ ⟩ X ^ [ % , ι ¹ ]) (PE.sym (IdTel₂-prettify ρ₁ ρ e a)) x

    abstract
      [Idext] : ∀ {ρ Δ e e′} →([ρ] : ρ Twk.∷ Δ ⊆ Γ) → (⊢Δ : ⊢ Δ)
        → ([e] : Δ ⊩⟨ ι ¹ ⟩ e ∷ wk ρ (Id (Univ rF ⁰) F F₁) ^ [ % , ι ¹ ] / [IdFF₁] [ρ] ⊢Δ)
        → ([e′] : Δ ⊩⟨ ι ¹ ⟩ e′ ∷ wk ρ (Id (Univ rF ⁰) F F₁) ^ [ % , ι ¹ ] / [IdFF₁] [ρ] ⊢Δ)
        → ∀ {ρ₁ Δ₁ a a′} → ([ρ₁] : ρ₁ Twk.∷ Δ₁ ⊆ Δ) → (⊢Δ₁ : ⊢ Δ₁)
        → ([a] : Δ₁ ⊩⟨ ι ⁰ ⟩ a ∷ wk ρ₁ (wk ρ F₁) ^ [ rF , ι ⁰ ] / (Lwk.wk [ρ₁] ⊢Δ₁ ([F₁] [ρ] ⊢Δ)))
        → ([a′] : Δ₁ ⊩⟨ ι ⁰ ⟩ a′ ∷ wk ρ₁ (wk ρ F₁) ^ [ rF , ι ⁰ ] / (Lwk.wk [ρ₁] ⊢Δ₁ ([F₁] [ρ] ⊢Δ)))
        → ([a≡a′] : Δ₁ ⊩⟨ ι ⁰ ⟩ a ≡ a′ ∷ wk ρ₁ (wk ρ F₁) ^ [ rF , ι ⁰ ] / (Lwk.wk [ρ₁] ⊢Δ₁ ([F₁] [ρ] ⊢Δ)))
        → Δ₁ ⊩⟨ ι ¹ ⟩ wk (lift ρ₁) (Id (U ⁰) (wk (lift (step ρ)) G [ b (step ρ) (wk1 e) (var 0) ]) (wk (lift ρ) G₁)) [ a ]
             ≡ wk (lift ρ₁) (Id (U ⁰) (wk (lift (step ρ)) G [ b (step ρ) (wk1 e′) (var 0) ]) (wk (lift ρ) G₁)) [ a′ ] ^ [ % , ι ¹ ]
             / [Id] [ρ] ⊢Δ [e] [ρ₁] ⊢Δ₁ [a]
      [Idext] {ρ} {Δ} {e} {e′} [ρ] ⊢Δ [e] [e′] {ρ₁} {Δ₁} {a} {a′} [ρ₁] ⊢Δ₁ [a] [a′] [a≡a′] =
        let
          [a]₁ : Δ₁ ⊩⟨ ι ⁰ ⟩ a ∷ wk (ρ₁ • ρ) F₁ ^ [ rF , ι ⁰ ] / [F₁] ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁
          [a]₁ = irrelevanceTerm′ (wk-comp ρ₁ ρ F₁) PE.refl PE.refl (Lwk.wk [ρ₁] ⊢Δ₁ ([F₁] [ρ] ⊢Δ)) ([F₁] ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁) [a]
          [a′] = irrelevanceTerm′ (wk-comp ρ₁ ρ F₁) PE.refl PE.refl (Lwk.wk [ρ₁] ⊢Δ₁ ([F₁] [ρ] ⊢Δ)) ([F₁] ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁) [a′]
          [a≡a′] = irrelevanceEqTerm′ (wk-comp ρ₁ ρ F₁) PE.refl PE.refl (Lwk.wk [ρ₁] ⊢Δ₁ ([F₁] [ρ] ⊢Δ)) ([F₁] ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁) [a≡a′]
          ⊢e₂ = PE.subst (λ X → Δ₁ ⊢ wk ρ₁ e ∷ X ^ [ % , ι ¹ ]) (wk-comp ρ₁ ρ _) (Twk.wkTerm [ρ₁] ⊢Δ₁ (escapeTerm ([IdFF₁] [ρ] ⊢Δ) [e]))
          ⊢e₁ = Idsymⱼ (univ 0<1 ⊢Δ₁) (un-univ (escape ([F] ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁))) (un-univ (escape ([F₁] ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁))) ⊢e₂
          ⊢e′₂ = PE.subst (λ X → Δ₁ ⊢ wk ρ₁ e′ ∷ X ^ [ % , ι ¹ ]) (wk-comp ρ₁ ρ _) (Twk.wkTerm [ρ₁] ⊢Δ₁ (escapeTerm ([IdFF₁] [ρ] ⊢Δ) [e′]))
          ⊢e′₁ = Idsymⱼ (univ 0<1 ⊢Δ₁) (un-univ (escape ([F] ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁))) (un-univ (escape ([F₁] ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁))) ⊢e′₂
          [b] : Δ₁ ⊩⟨ ι ⁰ ⟩ b (ρ₁ • ρ) (wk ρ₁ e) a ∷ wk (ρ₁ • ρ) F ^ [ rF , ι ⁰ ] / [F] ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁
          [b] = [proj₁cast] ⊢Δ₁ ([F₁] ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁) ([F] ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁) [a]₁ ⊢e₁
          [b′] = [proj₁cast] ⊢Δ₁ ([F₁] ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁) ([F] ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁) [a′] ⊢e′₁
          [b≡b′] = [proj₁castext] ⊢Δ₁ ([F₁] ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁) ([F₁] ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁) (reflEq ([F₁] ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁))
            ([F] ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁) ([F] ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁) (reflEq ([F] ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁))
            [a]₁ [a′] [a≡a′] ⊢e₁ ⊢e′₁
          x₁ = recursor₂ ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁ [b] [a]₁
          x = extrecursor ([ρ₁] Twk.•ₜ [ρ]) ⊢Δ₁ [b] [b′] [b≡b′] [a]₁ [a′] [a≡a′]
        in irrelevanceEq″ (PE.sym (IdTel₂-prettify ρ₁ ρ e a)) (PE.sym (IdTel₂-prettify ρ₁ ρ e′ a′)) PE.refl PE.refl x₁ ([Id] [ρ] ⊢Δ [e] [ρ₁] ⊢Δ₁ [a]) x

    [IdGG₁] : ∀ {ρ Δ e} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) → (⊢Δ : ⊢ Δ)
      → ([e] : Δ ⊩⟨ ι ¹ ⟩ e ∷ wk ρ (Id (Univ rF ⁰) F F₁) ^ [ % , ι ¹ ] / [IdFF₁] [ρ] ⊢Δ)
      → Δ ⊩⟨ ι ¹ ⟩ IdGG₁ ρ e ^ [ % , ι ¹ ]
    [IdGG₁] {ρ} {Δ} {e} [ρ] ⊢Δ [e] =
      let
        ⊢wkF₁ = escape ([F₁] [ρ] ⊢Δ)
        [0] = let ⊢0 = (var (⊢Δ ∙ ⊢wkF₁) here) in
          neuTerm (Lwk.wk (Twk.step Twk.id) (⊢Δ ∙ escape ([F₁] [ρ] ⊢Δ)) ([F₁] [ρ] ⊢Δ)) (var 0) ⊢0 (~-var ⊢0)
        x : Δ ∙ wk ρ F₁ ^ [ rF , ι ⁰ ] ⊩⟨ ι ¹ ⟩ Id (U ⁰) (wk (lift (step ρ)) G [ b (step ρ) (wk1 e) (var 0) ]) (wk (lift ρ) G₁) ^ [ % , ι ¹ ]
        x = PE.subst (λ X → Δ ∙ wk ρ F₁ ^ [ rF , ι ⁰ ] ⊩⟨ ι ¹ ⟩ X ^ [ % , ι ¹ ]) (wkSingleSubstId _) ([Id] [ρ] ⊢Δ [e] (Twk.step Twk.id) (⊢Δ ∙ ⊢wkF₁) [0])
        ⊢Id = escape x
      in
      Πᵣ′ rF ⁰ ¹ (<is≤ 0<1) (≡is≤ PE.refl) (wk ρ F₁) (Id (U ⁰) (wk (lift (step ρ)) G [ b (step ρ) (wk1 e) (var 0) ]) (wk (lift ρ) G₁))
        (idRed:*: (univ (Πⱼ <is≤ 0<1 ▹ ≡is≤ PE.refl ▹ un-univ ⊢wkF₁ ▹ un-univ ⊢Id)))
        ⊢wkF₁ ⊢Id (≅-univ (≅ₜ-Π-cong (<is≤ 0<1) (≡is≤ PE.refl) ⊢wkF₁ (≅-un-univ (escapeEqRefl ([F₁] [ρ] ⊢Δ))) (≅-un-univ (escapeEqRefl x))))
        (λ [ρ₁] ⊢Δ₁ → emb emb< (Lwk.wk [ρ₁] ⊢Δ₁ ([F₁] [ρ] ⊢Δ))) ([Id] [ρ] ⊢Δ [e]) ([Idext] [ρ] ⊢Δ [e] [e])

    abstract
      [IdGG₁-ext] : ∀ {ρ Δ e e′} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) → (⊢Δ : ⊢ Δ)
        → ([e] : Δ ⊩⟨ ι ¹ ⟩ e ∷ wk ρ (Id (Univ rF ⁰) F F₁) ^ [ % , ι ¹ ] / [IdFF₁] [ρ] ⊢Δ)
        → ([e′] : Δ ⊩⟨ ι ¹ ⟩ e′ ∷ wk ρ (Id (Univ rF ⁰) F F₁) ^ [ % , ι ¹ ] / [IdFF₁] [ρ] ⊢Δ)
        → ([e≡e′] : Δ ⊩⟨ ι ¹ ⟩ e ≡ e′ ∷ wk ρ (Id (Univ rF ⁰) F F₁) ^ [ % , ι ¹ ] / [IdFF₁] [ρ] ⊢Δ)
        → Δ ⊩⟨ ι ¹ ⟩ IdGG₁ ρ e ≡ IdGG₁ ρ e′ ^ [ % , ι ¹ ] / [IdGG₁] [ρ] ⊢Δ [e]
      [IdGG₁-ext] {ρ} {Δ} {e} {e′} [ρ] ⊢Δ [e] [e′] _ =
        let
          ⊢wkF₁ = escape ([F₁] [ρ] ⊢Δ)
          [0] = let ⊢0 = (var (⊢Δ ∙ ⊢wkF₁) here) in
            neuTerm (Lwk.wk (Twk.step Twk.id) (⊢Δ ∙ escape ([F₁] [ρ] ⊢Δ)) ([F₁] [ρ] ⊢Δ)) (var 0) ⊢0 (~-var ⊢0)
          x = [Id] [ρ] ⊢Δ [e′] (Twk.step Twk.id) (⊢Δ ∙ ⊢wkF₁) [0]
          ⊢x = PE.subst (λ X → Δ ∙ wk ρ F₁ ^ [ rF , ι ⁰ ] ⊢ X ^ [ % , ι ¹ ]) (wkSingleSubstId _) (escape x)
          x₁ = [Idext] [ρ] ⊢Δ [e′] [e] (Twk.step Twk.id) (⊢Δ ∙ ⊢wkF₁) [0] [0] (reflEqTerm (Lwk.wk (Twk.step Twk.id) (⊢Δ ∙ escape ([F₁] [ρ] ⊢Δ)) ([F₁] [ρ] ⊢Δ)) [0])
          ⊢x₁ = PE.subst₂ (λ X Y → Δ ∙ wk ρ F₁ ^ [ rF , ι ⁰ ] ⊢ X ≅ Y ^ [ % , ι ¹ ]) (wkSingleSubstId _) (wkSingleSubstId _) (escapeEq x x₁)
        in
        Π₌ (wk ρ F₁) (Id (U ⁰) (wk (lift (step ρ)) G [ b (step ρ) (wk1 e′) (var 0) ]) (wk (lift ρ) G₁))
           (id (univ (Πⱼ <is≤ 0<1 ▹ ≡is≤ PE.refl ▹ un-univ ⊢wkF₁ ▹ un-univ ⊢x)))
           (≅-univ (≅ₜ-Π-cong (<is≤ 0<1) (≡is≤ PE.refl) ⊢wkF₁ (≅-un-univ (escapeEqRefl ([F₁] [ρ] ⊢Δ))) (≅-un-univ (≅-sym ⊢x₁))))
           (λ [ρ]₁ ⊢Δ₁ → reflEq (Lwk.wk [ρ]₁ ⊢Δ₁ ([F₁] [ρ] ⊢Δ)))
           (λ [ρ₁] ⊢Δ₁ [a] → [Idext] [ρ] ⊢Δ [e] [e′] [ρ₁] ⊢Δ₁ [a] [a] (reflEqTerm (Lwk.wk [ρ₁] ⊢Δ₁ ([F₁] [ρ] ⊢Δ)) [a]))

    abstract
      IdTel≡IdUΠΠ : ∃ Id (Univ rF ⁰) F F₁ ▹ (IdGG₁ (step id) (var 0)) PE.≡
        ∃ (Id (Univ rF ⁰) F F₁) ▹ (Π (wk1 F₁) ^ rF ° ⁰ ▹
          Id (U ⁰) ((wk1d G) [ cast ⁰ (wk1 (wk1 F₁)) (wk1 (wk1 F)) (Idsym (Univ rF ⁰) (wk1 (wk1 F)) (wk1 (wk1 F₁)) (var 1)) (var 0) ]↑) (wk1d G₁) ° ¹ ° ¹)
      IdTel≡IdUΠΠ = PE.cong (λ X → ∃ Id (Univ rF ⁰) F F₁ ▹ Π (wk1 F₁) ^ rF ° ⁰ ▹ Id (U ⁰) X (wk1d G₁) ° ¹ ° ¹)
        (PE.trans
          (PE.cong₃ (λ X Y Z → X [ cast ⁰ Z Y (Idsym (Univ rF ⁰) Y Z (var 1)) (var 0) ])
            (PE.sym (wk-comp (lift (step id)) (lift (step id)) G))
            (PE.sym (wk-comp (step id) (step id) F))
            (PE.sym (wk-comp (step id) (step id) F₁)))
          (PE.sym (wk1d[]-[]↑ (wk1d G) _)))

    abstract
      wksubst-IdTel : ∀ ρ e → wk (lift ρ) (IdGG₁ (step id) (var 0)) [ e ] PE.≡ IdGG₁ ρ e
      wksubst-IdTel ρ e =
        let
          x₃ = PE.trans (PE.cong (subst (liftSubst (sgSubst e))) (wk-Idsym (lift (lift ρ)) (Univ rF ⁰) (wk (step (step id)) F) (wk (step (step id)) F₁) (var 1)))
            (PE.trans (subst-Idsym (liftSubst (sgSubst e)) (Univ rF ⁰) (wk _ (wk (step (step id)) F)) (wk _ (wk (step (step id)) F₁)) (var 1))
              (PE.cong₂ (λ X Y → Idsym (Univ rF ⁰) X Y (wk1 e)) (Id-subst-lemma1 ρ F e) (Id-subst-lemma1 ρ F₁ e)))
          x₂ = PE.cong₃ (λ X Y Z → cast ⁰ X Y Z (var 0)) (Id-subst-lemma1 ρ F₁ e) (Id-subst-lemma1 ρ F e) x₃
          x₁ = PE.cong₂ (λ X Y → X [ Y ]) (Id-subst-lemma2 ρ G e) x₂
          x₀ = (PE.trans (PE.cong (subst (liftSubst (sgSubst e))) (wk-β (wk (lift (step (step id))) G)))
            (PE.trans (singleSubstLift (wk (lift (lift (lift ρ))) (wk (lift (step (step id))) G)) (wk (lift (lift ρ)) (b (step (step id)) (var 1) (var 0)))) x₁))
        in PE.cong₃ (λ X Y Z → Π X ^ rF ° ⁰ ▹ Id (U ⁰) Y Z ° ¹ ° ¹) (irrelevant-subst′ ρ F₁ e) x₀ (cast-subst-lemma4 ρ e G₁)

    [IdGG₁0] : Γ ∙ Id (Univ rF ⁰) F F₁ ^ [ % , ι ¹ ] ⊩⟨ ι ¹ ⟩ IdGG₁ (step id) (var 0) ^ [ % , ι ¹ ]
    [IdGG₁0] = let
        ⊢0 = var (⊢Γ ∙ ⊢IdFF₁) here
        [0] = neuTerm ([IdFF₁] (Twk.step Twk.id) (⊢Γ ∙ ⊢IdFF₁)) (var 0) ⊢0 (~-var ⊢0)
      in [IdGG₁] (Twk.step Twk.id) (⊢Γ ∙ ⊢IdFF₁) [0]

    ⊢IdGG₁ : Γ ∙ Id (Univ rF ⁰) F F₁ ^ [ % , ι ¹ ] ⊢ IdGG₁ (step id) (var 0) ^ [ % , ι ¹ ]
    ⊢IdGG₁ = escape [IdGG₁0]

    ⊢∃ : Γ ⊢ ∃ Id (Univ rF ⁰) F F₁ ▹ IdGG₁ (step id) (var 0) ^ [ % , ι ¹ ]
    ⊢∃ = univ (∃ⱼ un-univ ⊢IdFF₁ ▹ un-univ ⊢IdGG₁)

    ∃≡∃ : Γ ⊢ ∃ Id (Univ rF ⁰) F F₁ ▹ IdGG₁ (step id) (var 0) ≅ ∃ Id (Univ rF ⁰) F F₁ ▹ IdGG₁ (step id) (var 0) ^ [ % , ι ¹ ]
    ∃≡∃ = (≅-univ (≅ₜ-∃-cong
      ⊢IdFF₁
      (≅-un-univ (escapeEqRefl (PE.subst (λ X → Γ ⊩⟨ ι ¹ ⟩ X ^ [ % , ι ¹ ]) (wk-id (Id (Univ rF ⁰) F F₁)) ([IdFF₁] Twk.id ⊢Γ))))
      (≅-un-univ (escapeEqRefl [IdGG₁0]))))

    D∃ : Γ ⊢ Id (U ⁰) A B ⇒* ∃ Id (Univ rF ⁰) F F₁ ▹ IdGG₁ (step id) (var 0) ^ [ % , ι ¹ ]
    D∃ = univ⇒* (IdURed*Term′ (un-univ ⊢A) (un-univ ⊢ΠFG) (un-univ⇒* D) (un-univ ⊢B)
      ⇨∷* IdUΠRed*Term′ (un-univ ⊢F) (un-univ ⊢G) (un-univ ⊢B) (un-univ ⊢ΠF₁G₁) (un-univ⇒* D₁))
      ⇨* PE.subst (λ X → Γ ⊢ Id (U ⁰) (Π F ^ rF ° ⁰ ▹ G ° ⁰ ° ⁰) (Π F₁ ^ rF ° ⁰ ▹ G₁ ° ⁰ ° ⁰) ⇒* X ^ [ % , ι ¹ ]) (PE.sym IdTel≡IdUΠΠ)
        (univ (Id-U-ΠΠ (un-univ ⊢F) (un-univ ⊢G) (un-univ ⊢F₁) (un-univ ⊢G₁))
      ⇨ id (PE.subst (λ X → Γ ⊢ X ^ [ % , ι ¹ ]) IdTel≡IdUΠΠ ⊢∃))

module IdTypeU-lemmas-2
       {Γ rF A₁ A₂ A₃ A₄ F₁ F₂ F₃ F₄ G₁ G₂ G₃ G₄}
       (⊢Γ : ⊢ Γ)

       (⊢A₁ : Γ ⊢ A₁ ^ [ ! , ι ⁰ ])
       (⊢ΠF₁G₁ : Γ ⊢ Π F₁ ^ rF ° ⁰ ▹ G₁ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (D₁     : Γ ⊢ A₁ ⇒* Π F₁ ^ rF ° ⁰ ▹ G₁ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (⊢F₁    : Γ ⊢ F₁ ^ [ rF , ι ⁰ ])
       (⊢G₁    : (Γ ∙ F₁ ^ [ rF , ι ⁰ ]) ⊢ G₁ ^ [ ! , ι ⁰ ])
       (A₁≡A₁  : Γ ⊢ (Π F₁ ^ rF ° ⁰ ▹ G₁ ° ⁰ ° ⁰) ≅ (Π F₁ ^ rF ° ⁰ ▹ G₁ ° ⁰ ° ⁰) ^ [ ! , ι ⁰ ])
       ([F₁] : ∀ {ρ} {Δ} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) → Δ ⊩⟨ ι ⁰ ⟩ wk ρ F₁ ^ [ rF , ι ⁰ ])
       ([G₁] : ∀ {ρ} {Δ} {a} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷  wk ρ F₁ ^ [ rF , ι ⁰ ] / ([F₁] [ρ] ⊢Δ))
          → (Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G₁ [ a ] ^ [ ! , ι ⁰ ]))
       (G₁-ext : ∀ {ρ} {Δ} {a} {b} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷  wk ρ F₁ ^ [ rF , ι ⁰ ] / ([F₁] [ρ] ⊢Δ))
          ([b] : Δ ⊩⟨ ι ⁰ ⟩ b ∷  wk ρ F₁ ^ [ rF , ι ⁰ ] / ([F₁] [ρ] ⊢Δ))
          ([a≡b] : Δ ⊩⟨ ι ⁰ ⟩ a ≡ b ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / ([F₁] [ρ] ⊢Δ))
          → (Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G₁ [ a ] ≡ wk (lift ρ) G₁ [ b ] ^ [ ! , ι ⁰ ] / ([G₁] [ρ] ⊢Δ [a])))

       (⊢A₂ : Γ ⊢ A₂ ^ [ ! , ι ⁰ ])
       (⊢ΠF₂G₂ : Γ ⊢ Π F₂ ^ rF ° ⁰ ▹ G₂ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (D₂     : Γ ⊢ A₂ ⇒* Π F₂ ^ rF ° ⁰ ▹ G₂ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (⊢F₂    : Γ ⊢ F₂ ^ [ rF , ι ⁰ ])
       (⊢G₂    : (Γ ∙ F₂ ^ [ rF , ι ⁰ ]) ⊢ G₂ ^ [ ! , ι ⁰ ])
       (A₂≡A₂  : Γ ⊢ (Π F₂ ^ rF ° ⁰ ▹ G₂ ° ⁰ ° ⁰) ≅ (Π F₂ ^ rF ° ⁰ ▹ G₂ ° ⁰ ° ⁰) ^ [ ! , ι ⁰ ])
       ([F₂] : ∀ {ρ} {Δ} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) → Δ ⊩⟨ ι ⁰ ⟩ wk ρ F₂ ^ [ rF , ι ⁰ ])
       ([G₂] : ∀ {ρ} {Δ} {a} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷  wk ρ F₂ ^ [ rF , ι ⁰ ] / ([F₂] [ρ] ⊢Δ))
          → (Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G₂ [ a ] ^ [ ! , ι ⁰ ]))
       (G₂-ext : ∀ {ρ} {Δ} {a} {b} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷  wk ρ F₂ ^ [ rF , ι ⁰ ] / ([F₂] [ρ] ⊢Δ))
          ([b] : Δ ⊩⟨ ι ⁰ ⟩ b ∷  wk ρ F₂ ^ [ rF , ι ⁰ ] / ([F₂] [ρ] ⊢Δ))
          ([a≡b] : Δ ⊩⟨ ι ⁰ ⟩ a ≡ b ∷ wk ρ F₂ ^ [ rF , ι ⁰ ] / ([F₂] [ρ] ⊢Δ))
          → (Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G₂ [ a ] ≡ wk (lift ρ) G₂ [ b ] ^ [ ! , ι ⁰ ] / ([G₂] [ρ] ⊢Δ [a])))

       (⊢A₃ : Γ ⊢ A₃ ^ [ ! , ι ⁰ ])
       (⊢ΠF₃G₃ : Γ ⊢ Π F₃ ^ rF ° ⁰ ▹ G₃ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (D₃     : Γ ⊢ A₃ ⇒* Π F₃ ^ rF ° ⁰ ▹ G₃ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (⊢F₃    : Γ ⊢ F₃ ^ [ rF , ι ⁰ ])
       (⊢G₃    : (Γ ∙ F₃ ^ [ rF , ι ⁰ ]) ⊢ G₃ ^ [ ! , ι ⁰ ])
       (A₃≡A₃  : Γ ⊢ (Π F₃ ^ rF ° ⁰ ▹ G₃ ° ⁰ ° ⁰) ≅ (Π F₃ ^ rF ° ⁰ ▹ G₃ ° ⁰ ° ⁰) ^ [ ! , ι ⁰ ])
       ([F₃] : ∀ {ρ} {Δ} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) → Δ ⊩⟨ ι ⁰ ⟩ wk ρ F₃ ^ [ rF , ι ⁰ ])
       ([G₃] : ∀ {ρ} {Δ} {a} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷  wk ρ F₃ ^ [ rF , ι ⁰ ] / ([F₃] [ρ] ⊢Δ))
          → (Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G₃ [ a ] ^ [ ! , ι ⁰ ]))
       (G₃-ext : ∀ {ρ} {Δ} {a} {b} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷  wk ρ F₃ ^ [ rF , ι ⁰ ] / ([F₃] [ρ] ⊢Δ))
          ([b] : Δ ⊩⟨ ι ⁰ ⟩ b ∷  wk ρ F₃ ^ [ rF , ι ⁰ ] / ([F₃] [ρ] ⊢Δ))
          ([a≡b] : Δ ⊩⟨ ι ⁰ ⟩ a ≡ b ∷ wk ρ F₃ ^ [ rF , ι ⁰ ] / ([F₃] [ρ] ⊢Δ))
          → (Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G₃ [ a ] ≡ wk (lift ρ) G₃ [ b ] ^ [ ! , ι ⁰ ] / ([G₃] [ρ] ⊢Δ [a])))

       (⊢A₄ : Γ ⊢ A₄ ^ [ ! , ι ⁰ ])
       (⊢ΠF₄G₄ : Γ ⊢ Π F₄ ^ rF ° ⁰ ▹ G₄ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (D₄     : Γ ⊢ A₄ ⇒* Π F₄ ^ rF ° ⁰ ▹ G₄ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (⊢F₄    : Γ ⊢ F₄ ^ [ rF , ι ⁰ ])
       (⊢G₄    : (Γ ∙ F₄ ^ [ rF , ι ⁰ ]) ⊢ G₄ ^ [ ! , ι ⁰ ])
       (A₄≡A₄  : Γ ⊢ (Π F₄ ^ rF ° ⁰ ▹ G₄ ° ⁰ ° ⁰) ≅ (Π F₄ ^ rF ° ⁰ ▹ G₄ ° ⁰ ° ⁰) ^ [ ! , ι ⁰ ])
       ([F₄] : ∀ {ρ} {Δ} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) → Δ ⊩⟨ ι ⁰ ⟩ wk ρ F₄ ^ [ rF , ι ⁰ ])
       ([G₄] : ∀ {ρ} {Δ} {a} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷  wk ρ F₄ ^ [ rF , ι ⁰ ] / ([F₄] [ρ] ⊢Δ))
          → (Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G₄ [ a ] ^ [ ! , ι ⁰ ]))
       (G₄-ext : ∀ {ρ} {Δ} {a} {b} ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷  wk ρ F₄ ^ [ rF , ι ⁰ ] / ([F₄] [ρ] ⊢Δ))
          ([b] : Δ ⊩⟨ ι ⁰ ⟩ b ∷  wk ρ F₄ ^ [ rF , ι ⁰ ] / ([F₄] [ρ] ⊢Δ))
          ([a≡b] : Δ ⊩⟨ ι ⁰ ⟩ a ≡ b ∷ wk ρ F₄ ^ [ rF , ι ⁰ ] / ([F₄] [ρ] ⊢Δ))
          → (Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G₄ [ a ] ≡ wk (lift ρ) G₄ [ b ] ^ [ ! , ι ⁰ ] / ([G₄] [ρ] ⊢Δ [a])))

       (A₁≡A₂ : Γ ⊢ Π F₁ ^ rF ° ⁰ ▹ G₁ ° ⁰ ° ⁰ ≅ Π F₂ ^ rF ° ⁰ ▹ G₂ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       (A₃≡A₄ : Γ ⊢ Π F₃ ^ rF ° ⁰ ▹ G₃ ° ⁰ ° ⁰ ≅ Π F₄ ^ rF ° ⁰ ▹ G₄ ° ⁰ ° ⁰ ^ [ ! , ι ⁰ ])
       ([F₁≡F₂] : ∀ {ρ Δ} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) → Δ ⊩⟨ ι ⁰ ⟩ wk ρ F₁ ≡ wk ρ F₂ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
       ([F₃≡F₄] : ∀ {ρ Δ} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ) → Δ ⊩⟨ ι ⁰ ⟩ wk ρ F₃ ≡ wk ρ F₄ ^ [ rF , ι ⁰ ] / [F₃] [ρ] ⊢Δ)
       ([G₁≡G₂] : ∀ {ρ Δ a} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
                  → ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
                  → Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G₁ [ a ] ≡ wk (lift ρ) G₂ [ a ] ^ [ ! , ι ⁰ ] / [G₁] [ρ] ⊢Δ [a])
       ([G₃≡G₄] : ∀ {ρ Δ a} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
                  → ([a] : Δ ⊩⟨ ι ⁰ ⟩ a ∷ wk ρ F₃ ^ [ rF , ι ⁰ ] / [F₃] [ρ] ⊢Δ)
                  → Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G₃ [ a ] ≡ wk (lift ρ) G₄ [ a ] ^ [ ! , ι ⁰ ] / [G₃] [ρ] ⊢Δ [a])

       (recursor₁ : ∀ {ρ Δ}
          ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          → Δ ⊩⟨ ι ¹ ⟩ Id (Univ rF ⁰) (wk ρ F₁) (wk ρ F₃) ^ [ % , ι ¹ ])
       (recursor₂ : ∀ {ρ Δ x y}
          ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([x] : Δ ⊩⟨ ι ⁰ ⟩ x ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
          ([y] : Δ ⊩⟨ ι ⁰ ⟩ y ∷ wk ρ F₃ ^ [ rF , ι ⁰ ] / [F₃] [ρ] ⊢Δ)
          → Δ ⊩⟨ ι ¹ ⟩ Id (U ⁰) (wk (lift ρ) G₁ [ x ]) (wk (lift ρ) G₃ [ y ]) ^ [ % , ι ¹ ])
       (recursor₃ : ∀ {ρ Δ}
          ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          → Δ ⊩⟨ ι ¹ ⟩ Id (Univ rF ⁰) (wk ρ F₂) (wk ρ F₄) ^ [ % , ι ¹ ])
       (recursor₄ : ∀ {ρ Δ x y}
          ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([x] : Δ ⊩⟨ ι ⁰ ⟩ x ∷ wk ρ F₂ ^ [ rF , ι ⁰ ] / [F₂] [ρ] ⊢Δ)
          ([y] : Δ ⊩⟨ ι ⁰ ⟩ y ∷ wk ρ F₄ ^ [ rF , ι ⁰ ] / [F₄] [ρ] ⊢Δ)
          → Δ ⊩⟨ ι ¹ ⟩ Id (U ⁰) (wk (lift ρ) G₂ [ x ]) (wk (lift ρ) G₄ [ y ]) ^ [ % , ι ¹ ])
       (extrecursor₁ : ∀ {ρ Δ x y x′ y′}
          ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([x] : Δ ⊩⟨ ι ⁰ ⟩ x ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
          ([x′] : Δ ⊩⟨ ι ⁰ ⟩ x′ ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
          ([x≡x′] : Δ ⊩⟨ ι ⁰ ⟩ x ≡ x′ ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
          ([y] : Δ ⊩⟨ ι ⁰ ⟩ y ∷ wk ρ F₃ ^ [ rF , ι ⁰ ] / [F₃] [ρ] ⊢Δ)
          ([y′] : Δ ⊩⟨ ι ⁰ ⟩ y′ ∷ wk ρ F₃ ^ [ rF , ι ⁰ ] / [F₃] [ρ] ⊢Δ)
          ([y≡y′] : Δ ⊩⟨ ι ⁰ ⟩ y ≡ y′ ∷ wk ρ F₃ ^ [ rF , ι ⁰ ] / [F₃] [ρ] ⊢Δ)
          → Δ ⊩⟨ ι ¹ ⟩ Id (U ⁰) (wk (lift ρ) G₁ [ x ]) (wk (lift ρ) G₃ [ y ]) ≡ Id (U ⁰) (wk (lift ρ) G₁ [ x′ ]) (wk (lift ρ) G₃ [ y′ ]) ^ [ % , ι ¹ ] / recursor₂ [ρ] ⊢Δ [x] [y])
       (extrecursor₂ : ∀ {ρ Δ x y x′ y′}
          ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          ([x] : Δ ⊩⟨ ι ⁰ ⟩ x ∷ wk ρ F₂ ^ [ rF , ι ⁰ ] / [F₂] [ρ] ⊢Δ)
          ([x′] : Δ ⊩⟨ ι ⁰ ⟩ x′ ∷ wk ρ F₂ ^ [ rF , ι ⁰ ] / [F₂] [ρ] ⊢Δ)
          ([x≡x′] : Δ ⊩⟨ ι ⁰ ⟩ x ≡ x′ ∷ wk ρ F₂ ^ [ rF , ι ⁰ ] / [F₂] [ρ] ⊢Δ)
          ([y] : Δ ⊩⟨ ι ⁰ ⟩ y ∷ wk ρ F₄ ^ [ rF , ι ⁰ ] / [F₄] [ρ] ⊢Δ)
          ([y′] : Δ ⊩⟨ ι ⁰ ⟩ y′ ∷ wk ρ F₄ ^ [ rF , ι ⁰ ] / [F₄] [ρ] ⊢Δ)
          ([y≡y′] : Δ ⊩⟨ ι ⁰ ⟩ y ≡ y′ ∷ wk ρ F₄ ^ [ rF , ι ⁰ ] / [F₄] [ρ] ⊢Δ)
          → Δ ⊩⟨ ι ¹ ⟩ Id (U ⁰) (wk (lift ρ) G₂ [ x ]) (wk (lift ρ) G₄ [ y ]) ≡ Id (U ⁰) (wk (lift ρ) G₂ [ x′ ]) (wk (lift ρ) G₄ [ y′ ]) ^ [ % , ι ¹ ] / recursor₄ [ρ] ⊢Δ [x] [y])
       (eqrecursor₁ : ∀ {ρ Δ}
          ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          → Δ ⊩⟨ ι ¹ ⟩ Id (Univ rF ⁰) (wk ρ F₁) (wk ρ F₃) ≡ Id (Univ rF ⁰) (wk ρ F₂) (wk ρ F₄) ^ [ % , ι ¹ ] / recursor₁ [ρ] ⊢Δ)
       (eqrecursor₂ : ∀ {ρ Δ x₁ x₂ x₃ x₄}
          → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) (⊢Δ : ⊢ Δ)
          → ([x₁] : Δ ⊩⟨ ι ⁰ ⟩ x₁ ∷ wk ρ F₁ ^ [ rF , ι ⁰ ] / [F₁] [ρ] ⊢Δ)
          → ([x₂] : Δ ⊩⟨ ι ⁰ ⟩ x₂ ∷ wk ρ F₂ ^ [ rF , ι ⁰ ] / [F₂] [ρ] ⊢Δ)
          → ([G₁x₁≡G₂x₂] : Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G₁ [ x₁ ] ≡ wk (lift ρ) G₂ [ x₂ ] ^ [ ! , ι ⁰ ] / [G₁] [ρ] ⊢Δ [x₁])
          → ([x₃] : Δ ⊩⟨ ι ⁰ ⟩ x₃ ∷ wk ρ F₃ ^ [ rF , ι ⁰ ] / [F₃] [ρ] ⊢Δ)
          → ([x₄] : Δ ⊩⟨ ι ⁰ ⟩ x₄ ∷ wk ρ F₄ ^ [ rF , ι ⁰ ] / [F₄] [ρ] ⊢Δ)
          → ([G₃x₃≡G₄x₄] : Δ ⊩⟨ ι ⁰ ⟩ wk (lift ρ) G₃ [ x₃ ] ≡ wk (lift ρ) G₄ [ x₄ ] ^ [ ! , ι ⁰ ] / [G₃] [ρ] ⊢Δ [x₃])
          → Δ ⊩⟨ ι ¹ ⟩ Id (U ⁰) (wk (lift ρ) G₁ [ x₁ ]) (wk (lift ρ) G₃ [ x₃ ]) ≡ Id (U ⁰) (wk (lift ρ) G₂ [ x₂ ]) (wk (lift ρ) G₄ [ x₄ ]) ^ [ % , ι ¹ ] / recursor₂ [ρ] ⊢Δ [x₁] [x₃])
  where
    module E₁ = IdTypeU-lemmas ⊢Γ ⊢A₁ ⊢ΠF₁G₁ D₁ ⊢F₁ ⊢G₁ A₁≡A₁ [F₁] [G₁] G₁-ext ⊢A₃ ⊢ΠF₃G₃ D₃ ⊢F₃ ⊢G₃ A₃≡A₃ [F₃] [G₃] G₃-ext
      recursor₁ recursor₂ extrecursor₁
    module E₂ = IdTypeU-lemmas ⊢Γ ⊢A₂ ⊢ΠF₂G₂ D₂ ⊢F₂ ⊢G₂ A₂≡A₂ [F₂] [G₂] G₂-ext ⊢A₄ ⊢ΠF₄G₄ D₄ ⊢F₄ ⊢G₄ A₄≡A₄ [F₄] [G₄] G₄-ext
      recursor₃ recursor₄ extrecursor₂

    [IdFF₁≡IdFF₂] : ∀ {ρ Δ} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) → (⊢Δ : ⊢ Δ)
      → Δ ⊩⟨ ι ¹ ⟩ wk ρ (Id (Univ rF ⁰) F₁ F₃) ≡ wk ρ (Id (Univ rF ⁰) F₂ F₄) ^ [ % , ι ¹ ] / E₁.[IdFF₁] [ρ] ⊢Δ
    [IdFF₁≡IdFF₂] = (λ [ρ] ⊢Δ → irrelevanceEq (recursor₁ [ρ] ⊢Δ) (E₁.[IdFF₁] [ρ] ⊢Δ) (eqrecursor₁ [ρ] ⊢Δ))

    abstract
      [Ideq] : ∀ {ρ Δ e} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) → (⊢Δ : ⊢ Δ)
        → ([e] : Δ ⊩⟨ ι ¹ ⟩ e ∷ wk ρ (Id (Univ rF ⁰) F₁ F₃) ^ [ % , ι ¹ ] / E₁.[IdFF₁] [ρ] ⊢Δ)
        → ∀ {ρ₁ Δ₁ a} → ([ρ₁] : ρ₁ Twk.∷ Δ₁ ⊆ Δ) → (⊢Δ₁ : ⊢ Δ₁)
        → ([a] : Δ₁ ⊩⟨ ι ⁰ ⟩ a ∷ wk ρ₁ (wk ρ F₃) ^ [ rF , ι ⁰ ] / (Lwk.wk [ρ₁] ⊢Δ₁ ([F₃] [ρ] ⊢Δ)))
        → Δ₁ ⊩⟨ ι ¹ ⟩ wk (lift ρ₁) (Id (U ⁰) (wk (lift (step ρ)) G₁ [ E₁.b (step ρ) (wk1 e) (var 0) ]) (wk (lift ρ) G₃)) [ a ]
             ≡ wk (lift ρ₁) (Id (U ⁰) (wk (lift (step ρ)) G₂ [ E₂.b (step ρ) (wk1 e) (var 0) ]) (wk (lift ρ) G₄)) [ a ] ^ [ % , ι ¹ ]
             / E₁.[Id] [ρ] ⊢Δ [e] [ρ₁] ⊢Δ₁ [a]
      [Ideq] {ρ} {Δ} {e} [ρ] ⊢Δ [e] {ρ₁} {Δ₁} {a} [ρ₁] ⊢Δ₁ [a] =
        let
          ρ′ = ρ₁ • ρ
          [ρ′] : ρ′ Twk.∷ Δ₁ ⊆ Γ
          [ρ′] = [ρ₁] Twk.•ₜ [ρ]
          [a₃] : Δ₁ ⊩⟨ ι ⁰ ⟩ a ∷ wk ρ′ F₃ ^ [ rF , ι ⁰ ] / [F₃] [ρ′] ⊢Δ₁
          [a₃] = irrelevanceTerm′ (wk-comp ρ₁ ρ F₃) PE.refl PE.refl (Lwk.wk [ρ₁] ⊢Δ₁ ([F₃] [ρ] ⊢Δ)) ([F₃] [ρ′] ⊢Δ₁) [a]
          [a₄] = convTerm₁ ([F₃] [ρ′] ⊢Δ₁) ([F₄] [ρ′] ⊢Δ₁) ([F₃≡F₄] [ρ′] ⊢Δ₁) [a₃]
          [a₃≡a₄] = reflEqTerm ([F₃] [ρ′] ⊢Δ₁) [a₃]
          ⊢e′ = PE.subst (λ X → Δ₁ ⊢ wk ρ₁ e ∷ X ^ [ % , ι ¹ ]) (wk-comp ρ₁ ρ _) (Twk.wkTerm [ρ₁] ⊢Δ₁ (escapeTerm (E₁.[IdFF₁] [ρ] ⊢Δ) [e]))
          ⊢e₁ = Idsymⱼ (univ 0<1 ⊢Δ₁) (un-univ (escape ([F₁] [ρ′] ⊢Δ₁))) (un-univ (escape ([F₃] [ρ′] ⊢Δ₁))) ⊢e′
          ⊢e″ = conv ⊢e′ (≅-eq (escapeEq (E₁.[IdFF₁] [ρ′] ⊢Δ₁) ([IdFF₁≡IdFF₂] [ρ′] ⊢Δ₁)))
          ⊢e₂ = Idsymⱼ (univ 0<1 ⊢Δ₁) (un-univ (escape ([F₂] [ρ′] ⊢Δ₁))) (un-univ (escape ([F₄] [ρ′] ⊢Δ₁))) ⊢e″
          [b₁] = [proj₁cast] ⊢Δ₁ ([F₃] [ρ′] ⊢Δ₁) ([F₁] [ρ′] ⊢Δ₁) [a₃] ⊢e₁
          [b₂] = [proj₁cast] ⊢Δ₁ ([F₄] [ρ′] ⊢Δ₁) ([F₂] [ρ′] ⊢Δ₁) [a₄] ⊢e₂
          [b₁≡b₂] = [proj₁castext] ⊢Δ₁ ([F₃] [ρ′] ⊢Δ₁) ([F₄] [ρ′] ⊢Δ₁) ([F₃≡F₄] [ρ′] ⊢Δ₁)
            ([F₁] [ρ′] ⊢Δ₁) ([F₂] [ρ′] ⊢Δ₁) ([F₁≡F₂] [ρ′] ⊢Δ₁)
            [a₃] [a₄] [a₃≡a₄] ⊢e₁ ⊢e₂
          [b₁:F₂] = convTerm₁ ([F₁] [ρ′] ⊢Δ₁) ([F₂] [ρ′] ⊢Δ₁) ([F₁≡F₂] [ρ′] ⊢Δ₁) [b₁]
          [b₁≡b₂:F₂] = convEqTerm₁ ([F₁] [ρ′] ⊢Δ₁) ([F₂] [ρ′] ⊢Δ₁) ([F₁≡F₂] [ρ′] ⊢Δ₁) [b₁≡b₂]
          [G₁b₁≡G₂b₂] = transEq ([G₁] [ρ′] ⊢Δ₁ [b₁]) ([G₂] [ρ′] ⊢Δ₁ [b₁:F₂]) ([G₂] [ρ′] ⊢Δ₁ [b₂])
            ([G₁≡G₂] [ρ′] ⊢Δ₁ [b₁]) (G₂-ext [ρ′] ⊢Δ₁ [b₁:F₂] [b₂] [b₁≡b₂:F₂])
          [a₃≡a₄:F₄] = convEqTerm₁ ([F₃] [ρ′] ⊢Δ₁) ([F₄] [ρ′] ⊢Δ₁) ([F₃≡F₄] [ρ′] ⊢Δ₁) [a₃≡a₄]
          [G₃a₃≡G₄a₄] = transEq ([G₃] [ρ′] ⊢Δ₁ [a₃]) ([G₄] [ρ′] ⊢Δ₁ [a₄]) ([G₄] [ρ′] ⊢Δ₁ [a₄])
            ([G₃≡G₄] [ρ′] ⊢Δ₁ [a₃]) (G₄-ext [ρ′] ⊢Δ₁ [a₄] [a₄] [a₃≡a₄:F₄])
          x₁ = recursor₂ [ρ′] ⊢Δ₁ [b₁] [a₃]
          x = eqrecursor₂ [ρ′] ⊢Δ₁ [b₁] [b₂] [G₁b₁≡G₂b₂] [a₃] [a₄] [G₃a₃≡G₄a₄]
        in irrelevanceEq″ (PE.sym (E₁.IdTel₂-prettify ρ₁ ρ e a)) (PE.sym (E₂.IdTel₂-prettify ρ₁ ρ e a)) PE.refl PE.refl x₁ (E₁.[Id] [ρ] ⊢Δ [e] [ρ₁] ⊢Δ₁ [a]) x

    abstract
      [IdGG₁≡IdGG₂] : ∀ {ρ Δ e} → ([ρ] : ρ Twk.∷ Δ ⊆ Γ) → (⊢Δ : ⊢ Δ)
          → ([e] : Δ ⊩⟨ ι ¹ ⟩ e ∷ wk ρ (Id (Univ rF ⁰) F₁ F₃) ^ [ % , ι ¹ ] / E₁.[IdFF₁] [ρ] ⊢Δ)
          → Δ ⊩⟨ ι ¹ ⟩ E₁.IdGG₁ ρ e ≡ E₂.IdGG₁ ρ e ^ [ % , ι ¹ ] / E₁.[IdGG₁] [ρ] ⊢Δ [e]
      [IdGG₁≡IdGG₂] {ρ} {Δ} {e} [ρ] ⊢Δ [e] = let
          [e]′ = convTerm₁ (E₁.[IdFF₁] [ρ] ⊢Δ) (E₂.[IdFF₁] [ρ] ⊢Δ) ([IdFF₁≡IdFF₂] [ρ] ⊢Δ) [e]
          ⊢wkF₃ = escape ([F₃] [ρ] ⊢Δ)
          ⊢wkF₄ = escape ([F₄] [ρ] ⊢Δ)
          [0:F₃] : Δ ∙ wk ρ F₃ ^ [ rF , ι ⁰ ] ⊩⟨ ι ⁰ ⟩ var 0 ∷ wk1 (wk ρ F₃) ^ [ rF , ι ⁰ ] / (Lwk.wk (Twk.step Twk.id) (⊢Δ ∙ ⊢wkF₃) ([F₃] [ρ] ⊢Δ))
          [0:F₃] = let ⊢0 = (var (⊢Δ ∙ ⊢wkF₃) here) in
            neuTerm (Lwk.wk (Twk.step Twk.id) (⊢Δ ∙ ⊢wkF₃) ([F₃] [ρ] ⊢Δ)) (var 0) ⊢0 (~-var ⊢0)
          [0:F₄] = let ⊢0 = (var (⊢Δ ∙ ⊢wkF₄) here) in
            neuTerm (Lwk.wk (Twk.step Twk.id) (⊢Δ ∙ ⊢wkF₄) ([F₄] [ρ] ⊢Δ)) (var 0) ⊢0 (~-var ⊢0)
          x = E₁.[Id] [ρ] ⊢Δ [e] (Twk.step Twk.id) (⊢Δ ∙ ⊢wkF₃) [0:F₃]
          x₁ = [Ideq] [ρ] ⊢Δ [e] (Twk.step Twk.id) (⊢Δ ∙ ⊢wkF₃) [0:F₃]
          ⊢x₁ = PE.subst₂ (λ X Y → Δ ∙ wk ρ F₃ ^ [ rF , ι ⁰ ] ⊢ X ≅ Y ^ [ % , ι ¹ ]) (wkSingleSubstId _) (wkSingleSubstId _) (escapeEq x x₁)
          x₂ = E₂.[Id] [ρ] ⊢Δ [e]′ (Twk.step Twk.id) (⊢Δ ∙ ⊢wkF₄) [0:F₄]
          ⊢x₂ = PE.subst (λ X → Δ ∙ wk ρ F₄ ^ [ rF , ι ⁰ ] ⊢ X ^ [ % , ι ¹ ]) (wkSingleSubstId _) (escape x₂)
        in Π₌ (wk ρ F₄) (Id (U ⁰) (wk (lift (step ρ)) G₂ [ E₂.b (step ρ) (wk1 e) (var 0) ]) (wk (lift ρ) G₄))
          (id (univ (Πⱼ <is≤ 0<1 ▹ ≡is≤ PE.refl ▹ un-univ ⊢wkF₄ ▹ un-univ ⊢x₂)))
          (≅-univ (≅ₜ-Π-cong (<is≤ 0<1) (≡is≤ PE.refl) ⊢wkF₃ (≅-un-univ (escapeEq ([F₃] [ρ] ⊢Δ) ([F₃≡F₄] [ρ] ⊢Δ))) (≅-un-univ ⊢x₁)))
          (λ [ρ₁] ⊢Δ₁ → Lwk.wkEq [ρ₁] ⊢Δ₁ ([F₃] [ρ] ⊢Δ) ([F₃≡F₄] [ρ] ⊢Δ))
          (λ [ρ₁] ⊢Δ₁ [a] → [Ideq] [ρ] ⊢Δ [e] [ρ₁] ⊢Δ₁ [a])

    [IdGG₁≡IdGG₂0] : Γ ∙ Id (Univ rF ⁰) F₁ F₃ ^ [ % , ι ¹ ] ⊩⟨ ι ¹ ⟩ E₁.IdGG₁ (step id) (var 0) ≡ E₂.IdGG₁ (step id) (var 0) ^ [ % , ι ¹ ] / E₁.[IdGG₁0]
    [IdGG₁≡IdGG₂0] = let
        ⊢0 = var (⊢Γ ∙ E₁.⊢IdFF₁) here
        [0] = neuTerm (E₁.[IdFF₁] (Twk.step Twk.id) (⊢Γ ∙ E₁.⊢IdFF₁)) (var 0) ⊢0 (~-var ⊢0)
      in [IdGG₁≡IdGG₂] (Twk.step Twk.id) (⊢Γ ∙ E₁.⊢IdFF₁) [0]

    ∃₁≡∃₂ : Γ ⊢ ∃ Id (Univ rF ⁰) F₁ F₃ ▹ E₁.IdGG₁ (step id) (var 0) ≅ ∃ Id (Univ rF ⁰) F₂ F₄ ▹ E₂.IdGG₁ (step id) (var 0) ^ [ % , ι ¹ ]
    ∃₁≡∃₂ = (≅-univ (≅ₜ-∃-cong
      E₁.⊢IdFF₁
      (≅-un-univ (PE.subst₂ (λ X Y → Γ ⊢ X ≅ Y ^ [ % , ι ¹ ]) (wk-id (Id (Univ rF ⁰) F₁ F₃)) (wk-id (Id (Univ rF ⁰) F₂ F₄)) (escapeEq (E₁.[IdFF₁] Twk.id ⊢Γ) ([IdFF₁≡IdFF₂] Twk.id ⊢Γ))))
      (≅-un-univ (escapeEq E₁.[IdGG₁0] [IdGG₁≡IdGG₂0]))))


{-# OPTIONS --no-qualified-instances #-}

module NoQualifiedInstances-AnonymousInstance where

postulate
  A : Set
  f : {{A}} → A

postulate instance _ : A

test : A
test = f


module _ where

module M where
  private
    module _ (A : Set) where
      Id : Set
      Id = A

  foo : Set → Set
  foo A = Id A

open M

bar : Set → Set
bar A = Id A -- Id should not be in scope


-- Andreas, 2017-01-24, issue #2429
-- ..-annotation in lambdas should be taken seriously

-- A ≤ ..A ≤ .A
-- (.A → B) ≤ (..A → B) ≤ A → B

should-fail : ∀{A B : Set} → (.A → B) → (.A → B)
should-fail f = λ ..a → f a

-- Expected error:
-- Found a non-strict lambda where a irrelevant lambda was expected
-- when checking that the expression λ ..a → f a has type ..A → .B

-- Note: Since A and B are not in scope, they are printed as .A and .B
-- This makes this error message super confusing.


module Rec1 where

  import Rec2

  y : ℕ
  y = x


{-# OPTIONS --without-K --safe #-}

module Definition.Typed.Reduction where

open import Definition.Untyped
open import Definition.Typed
open import Definition.Typed.Properties

-- Weak head expansion of type equality
reduction : ∀ {A A′ B B′ Γ}
          → Γ ⊢ A ⇒* A′
          → Γ ⊢ B ⇒* B′
          → Whnf A′
          → Whnf B′
          → Γ ⊢ A′ ≡ B′
          → Γ ⊢ A ≡ B
reduction D D′ whnfA′ whnfB′ A′≡B′ =
  trans (subset* D) (trans A′≡B′ (sym (subset* D′)))

reduction′ : ∀ {A A′ B B′ Γ}
          → Γ ⊢ A ⇒* A′
          → Γ ⊢ B ⇒* B′
          → Whnf A′
          → Whnf B′
          → Γ ⊢ A ≡ B
          → Γ ⊢ A′ ≡ B′
reduction′ D D′ whnfA′ whnfB′ A≡B =
  trans (sym (subset* D)) (trans A≡B (subset* D′))

-- Weak head expansion of term equality
reductionₜ : ∀ {a a′ b b′ A B Γ}
           → Γ ⊢ A ⇒* B
           → Γ ⊢ a ⇒* a′ ∷ B
           → Γ ⊢ b ⇒* b′ ∷ B
           → Whnf B
           → Whnf a′
           → Whnf b′
           → Γ ⊢ a′ ≡ b′ ∷ B
           → Γ ⊢ a ≡ b ∷ A
reductionₜ D d d′ whnfB whnfA′ whnfB′ a′≡b′ =
  conv (trans (subset*Term d)
              (trans a′≡b′ (sym (subset*Term d′))))
       (sym (subset* D))

reductionₜ′ : ∀ {a a′ b b′ A B Γ}
           → Γ ⊢ A ⇒* B
           → Γ ⊢ a ⇒* a′ ∷ B
           → Γ ⊢ b ⇒* b′ ∷ B
           → Whnf B
           → Whnf a′
           → Whnf b′
           → Γ ⊢ a ≡ b ∷ A
           → Γ ⊢ a′ ≡ b′ ∷ B
reductionₜ′ D d d′ whnfB whnfA′ whnfB′ a≡b =
  trans (sym (subset*Term d))
        (trans (conv a≡b (subset* D)) (subset*Term d′))


{-# OPTIONS --without-K #-}

open import lib.Basics
open import lib.types.Paths
open import lib.types.Pi
open import lib.types.Unit
open import lib.types.Nat
open import lib.types.TLevel
open import lib.types.Pointed
open import lib.types.Sigma
open import lib.NType2
open import lib.types.PathSeq

open import nicolai.pseudotruncations.Liblemmas
open import nicolai.pseudotruncations.SeqColim

{- The main work is done in two separate files.

   The first defines some general lemmas
   and constructs what is overline(i) in the paper.

   The second is the 'heptagon-argument', a very
   tedious calculation with paths, which constructs
   what is overline(g) in the paper -- the coherence
   laws for overline (i). -}
open import nicolai.pseudotruncations.wconst-preparation
open import nicolai.pseudotruncations.heptagon

module nicolai.pseudotruncations.wconstSequence where

  {- As a first step, assume we are given a weakly constant
     sequence with an inhabitant of the first type. -}
  module _ {i} {C : Sequence {i}} (wc : wconst-chain C) (a₀ : fst C O) where

    {- We want to show that the colimit of this sequence is
       contractible.
       The heart of the argument are the definitions of the data
       that is needed in order to apply the induction principle
       of the sequential colimit.
       We call these î and ĝ. They are not constructed here, but
       in two separate files; the construction of ĝ is very tedious.
       Here, we just load them from the files where they are defined.
    -}

    {- First, some preliminary lemmas and the definition of î,
       defined in the following module: -}
    open wconst-init {i} {C} wc a₀

    î : (n : ℕ) → (a : A n) → (ins {C = C} n a) =-= (ins O a₀)
    î = î-def

    {- from î, we get the 'real' overline(i) just by applying ↯,
       i.e. by getting the path out of the sequence î -}
    ins-n-O : (n : ℕ) → (a : A n) → ins {C = C} n a == ins O a₀
    ins-n-O n a = ↯ (î-def n a)

    {- The difficult part is ĝ, in the paper called 'overline(g)'.
       It is defined in heptagon.agda and just loaded here. -}

    ĝ : (n : ℕ) → (a : A n)
        → (↯ ((î (S n) (f n a)) ⋯ (‼ (î n a) ⋯ toSeq (glue n a)))) == idp
    ĝ n a = ĝ-def wc a₀ n a

    -- from ĝ, we should be able to get this postulate:
    postulate
      ins-glue-coh : (n : ℕ) (a : A n)
                     → ins-n-O (S n) (f n a) ∙ ! (ins-n-O n a) ∙ glue n a == idp
    -- ins-glue-coh n a = {!ins-n-O n a !} --  {!ĝ n a!}

    {- Now, we define the 'real' overline(g) from the text;
       this is just the 'unwrapped' version of ĝ, and not much happens
       here!
       All we are doing is showing that commutativity of the 'triangle'
       is really enough. The hard part is the commutativity of the
       'triangle' which, is shown via commutativity of the 'heptagon',
       which we have already done! -}
    glue-n-O : (n : ℕ) (a : A n)
               → (ins-n-O n a)
                  ==
                 (ins-n-O (S n) (f n a)) [ (λ w → w == ins O a₀) ↓ glue n a ]

    glue-n-O n a = from-transp _ (glue n a)
      -- now, let use calculate...
      (transport (λ w → w == ins O a₀) (glue n a) (ins-n-O n a)
        -- we use the version of trans-ap where the second function is constant
        =⟨ trans-ap₁ (idf _) (ins O a₀) (glue n a) (ins-n-O n a) ⟩
      ! (ap (idf _) (glue n a)) ∙ (ins-n-O n a)
        =⟨ ap (λ p → (! p) ∙ (ins-n-O n a)) (ap-idf (glue n a)) ⟩
      ! (glue n a) ∙ (ins-n-O n a)
        -- we use the adhoc lemma to 're-order' paths
        =⟨ ! (adhoc-lemma (ins-n-O (S n) (f n a)) (ins-n-O n a) (glue n a) (ins-glue-coh n a)) ⟩
      ins-n-O (S n) (f n a)
        ∎)

    -- We combine 'overline(i)' and 'overline(g)' to conclude:
    equal-n-O : (w : SC) → w == ins O a₀
    equal-n-O = SeqCo-ind ins-n-O glue-n-O

    -- Thus, the sequential colimit is contractible:
    SC-contr : is-contr SC
    SC-contr = ins O a₀ , (λ w → ! (equal-n-O w))

{- This completes the proof that the sequential colimit of a weakly constant
   sequence with *inhabited first type* is contractible.
   Let us now work with general weakly constant sequences again.

   First, let us now show that removing the first map from a weakly constant sequence
   gives a weakly constant sequence.
   Then, we show that we can remove any finite initial sequence.
   Of course, this is trivial; the conclusion of the statement asks for weak
   constancy of nearly all of the maps, while the assumption gives weak constancy
   of all maps. -}
removeFst-preserves-wconst : ∀ {i} → (C : Sequence {i}) → wconst-chain C → wconst-chain (removeFst C)
removeFst-preserves-wconst C wc n = wc (S n)

removeInit-preserves-wconst : ∀ {i} → (C : Sequence {i}) → (n : ℕ) → wconst-chain C → wconst-chain (removeInit C n)
removeInit-preserves-wconst C O wc = wc
removeInit-preserves-wconst C (S n) wc =
  removeInit-preserves-wconst (removeFst C) n
    (removeFst-preserves-wconst C wc)

{- THE FIRST MAIN RESULT:
   the colimit of a weakly constant sequence is propositional. -}

wconst-prop : ∀ {i} → (C : Sequence {i}) → wconst-chain C → is-prop (SeqCo C)
wconst-prop C wc = inhab-to-contr-is-prop (SeqCo-rec wc-prp-ins automatic) where

  A = fst C
  f = snd C

  wc-prp-ins : (n : ℕ) → A n → is-contr (SeqCo C)
  wc-prp-ins n a = equiv-preserves-level {n = ⟨-2⟩} (ignore-init C n ⁻¹) C'-contr where

    C' = removeInit C n
    A' = fst C'
    f' = snd C'

    a₀' : A' O
    a₀' = new-initial C n a

    wc' : wconst-chain C'
    wc' = removeInit-preserves-wconst C n wc

    C'-contr : is-contr (SeqCo C')
    C'-contr = SC-contr wc' a₀'

  automatic : (n : ℕ) (a : fst C n) → wc-prp-ins n a == wc-prp-ins (S n) (snd C n a)
  automatic n a = prop-has-all-paths (has-level-is-prop {n = ⟨-2⟩} {A = SeqCo C}) _ _


module ProcessSyntax where

open import Data.List

open import Typing
open import Syntax

-- processes
data Proc (Φ : TCtx) : Set where
  exp : (e : Expr Φ TUnit)
    → Proc Φ

  par : ∀ {Φ₁ Φ₂}
    → (sp : Split Φ Φ₁ Φ₂)
    → (P₁ : Proc Φ₁)
    → (P₂ : Proc Φ₂)
    → Proc Φ

  res : (s : SType)
    → (P : Proc (TChan (SType.force s) ∷ TChan (SType.force (dual s)) ∷ Φ))
    → Proc Φ


-- Andreas, 2018-10-17, re #2757
--
-- Don't project from erased matches.

open import Agda.Builtin.List
open import Common.Prelude

data IsCons {A : Set} : List A → Set where
  isCons : ∀{@0 x : A} {@0 xs : List A} → IsCons (x ∷ xs)

headOfErased : ∀{A} (@0 xs : List A) → IsCons xs → A
headOfErased (x ∷ xs) isCons = x

-- Should fail with error:
--
-- Variable x is declared erased, so it cannot be used here

main = printNat (headOfErased (1 ∷ 2 ∷ []) isCons)

-- Otherwise, main segfaults.


{-# OPTIONS --without-K --safe --no-sized-types --no-guardedness --no-subtyping #-}

module Agda.Builtin.Reflection.External where

open import Agda.Builtin.List
open import Agda.Builtin.Nat
open import Agda.Builtin.Sigma
open import Agda.Builtin.String

postulate
  execTC : String → List String → String
         → TC (Σ Nat (λ _ → Σ String (λ _ → String)))

{-# BUILTIN AGDATCMEXEC execTC #-}


{-

  Homotopy colimits of graphs

-}
{-# OPTIONS --cubical --safe #-}
module Cubical.HITs.Colimit.Base where

open import Cubical.Core.Glue
open import Cubical.Foundations.Prelude
open import Cubical.Foundations.Function
open import Cubical.Foundations.HLevels
open import Cubical.Foundations.Equiv
open import Cubical.Foundations.Isomorphism

open import Cubical.Data.Graph

-- Cones under a diagram

record Cocone ℓ {ℓd ℓv ℓe} {I : Graph ℓv ℓe} (F : Diag ℓd I) (X : Type ℓ)
              : Type (ℓ-suc (ℓ-max ℓ (ℓ-max (ℓ-max ℓv ℓe) (ℓ-suc ℓd)))) where
  field
    leg : ∀ (j : Obj I) → F $ j → X
    com : ∀ {j k} (f : Hom I j k) → leg k ∘ F <$> f ≡ leg j

  postcomp : ∀ {ℓ'} {Y : Type ℓ'} → (X → Y) → Cocone ℓ' F Y
  leg (postcomp h) j = h ∘ leg j
  com (postcomp h) f = cong (h ∘_) (com f)

open Cocone public

-- Σ (Type ℓ) (Cocone ℓ F) forms a category:

module _ {ℓd ℓv ℓe} {I : Graph ℓv ℓe} {F : Diag ℓd I} where

  private
    -- the "lower star" functor
    _* : ∀ {ℓ ℓ'} {X : Type ℓ} {Y : Type ℓ'} → (X → Y) → Cocone _ F X → Cocone _ F Y
    (h *) C = postcomp C h

  CoconeMor : ∀ {ℓ ℓ'} → Σ (Type ℓ) (Cocone ℓ F) → Σ (Type ℓ') (Cocone ℓ' F) → Type _
  CoconeMor (X , C) (Y , D) = Σ[ h ∈ (X → Y) ] (h *) C ≡ D

  idCoconeMor : ∀ {ℓ} (Cp : Σ (Type ℓ) (Cocone ℓ F)) → CoconeMor Cp Cp
  idCoconeMor Cp = (λ x → x) , refl

  compCoconeMor : ∀ {ℓ ℓ' ℓ''} {C : Σ (Type ℓ) (Cocone ℓ F)} {D : Σ (Type ℓ') (Cocone ℓ' F)}
                    {E : Σ (Type ℓ'') (Cocone ℓ'' F)}
                  → CoconeMor D E → CoconeMor C D → CoconeMor C E
  compCoconeMor (g , q) (f , p) = g ∘ f , (cong (g *) p) ∙ q

-- Universal cocones are initial objects in the category Σ (Type ℓ) (Cocone ℓ F)

module _ {ℓ ℓd ℓv ℓe} {I : Graph ℓv ℓe} {F : Diag ℓd I} {X : Type ℓ} where

  isUniversalAt : ∀ ℓq → Cocone ℓ F X → Type (ℓ-max ℓ (ℓ-suc (ℓ-max ℓq (ℓ-max (ℓ-max ℓv ℓe) (ℓ-suc ℓd)))))
  isUniversalAt ℓq C = ∀ (Y : Type ℓq) → isEquiv {A = (X → Y)} {B = Cocone ℓq F Y} (postcomp C)
                  -- (unfolding isEquiv, this ^ is equivalent to what one might expect:)
                  -- ∀ (Y : Type ℓ) (D : Cocone ℓ F Y) → isContr (Σ[ h ∈ (X → Y) ] (h *) C ≡ D)
                  --                                  (≡ isContr (CoconeMor (X , C) (Y , D)))

  isPropIsUniversalAt : ∀ ℓq (C : Cocone ℓ F X) → isProp (isUniversalAt ℓq C)
  isPropIsUniversalAt ℓq C = propPi (λ Y → isPropIsEquiv (postcomp C))

  isUniversal : Cocone ℓ F X → Typeω
  isUniversal C = ∀ ℓq → isUniversalAt ℓq C

-- Colimits are universal cocones

record isColimit {ℓ ℓd ℓv ℓe} {I : Graph ℓv ℓe} (F : Diag ℓd I) (X : Type ℓ) : Typeω where
  field
    cone : Cocone ℓ F X
    univ : isUniversal cone
open isColimit public

module _ {ℓ ℓ' ℓd ℓv ℓe} {I : Graph ℓv ℓe} {F : Diag ℓd I} {X : Type ℓ} {Y : Type ℓ'} where

  postcomp⁻¹ : isColimit F X → Cocone ℓ' F Y → (X → Y)
  postcomp⁻¹ cl = invEq (_ , univ cl _ Y)

  postcomp⁻¹-inv : (cl : isColimit F X) (D : Cocone ℓ' F Y) → (postcomp (cone cl) (postcomp⁻¹ cl D)) ≡ D
  postcomp⁻¹-inv cl D = retEq (_ , univ cl _ Y) D

  postcomp⁻¹-mor : (cl : isColimit F X) (D : Cocone ℓ' F Y) → CoconeMor (X , cone cl) (Y , D)
  postcomp⁻¹-mor cl D = (postcomp⁻¹ cl D) , (postcomp⁻¹-inv cl D)

-- Colimits are unique

module _ {ℓ ℓ' ℓd ℓv ℓe} {I : Graph ℓv ℓe} {F : Diag ℓd I} {X : Type ℓ} {Y : Type ℓ'} where

  uniqColimit : isColimit F X → isColimit F Y → X ≃ Y
  uniqColimit cl cl'
    = isoToEquiv (iso (fst fwd) (fst bwd)
                      (λ x i → fst (isContr→isProp (equiv-proof (univ cl' ℓ' Y) (cone cl'))
                                                   (compCoconeMor fwd bwd)
                                                   (idCoconeMor (Y , cone cl')) i) x)
                      (λ x i → fst (isContr→isProp (equiv-proof (univ cl ℓ  X) (cone cl))
                                                   (compCoconeMor bwd fwd)
                                                   (idCoconeMor (X , cone cl)) i) x))
    where fwd : CoconeMor (X , cone cl ) (Y , cone cl')
          bwd : CoconeMor (Y , cone cl') (X , cone cl )
          fwd = postcomp⁻¹-mor cl (cone cl')
          bwd = postcomp⁻¹-mor cl' (cone cl)

-- Colimits always exist

data colim {ℓd ℓe ℓv} {I : Graph ℓv ℓe} (F : Diag ℓd I) : Type (ℓ-suc (ℓ-max (ℓ-max ℓv ℓe) (ℓ-suc ℓd))) where
  colim-leg : ∀ (j : Obj I) → F $ j → colim F
  colim-com : ∀ {j k} (f : Hom I j k) → colim-leg k ∘ F <$> f ≡ colim-leg j

module _ {ℓd ℓv ℓe} {I : Graph ℓv ℓe} {F : Diag ℓd I} where

  colimCone : Cocone _ F (colim F)
  leg colimCone = colim-leg
  com colimCone = colim-com

  colim-rec : ∀ {ℓ} {X : Type ℓ} → Cocone ℓ F X → (colim F → X)
  colim-rec C (colim-leg j A)   = leg C j A
  colim-rec C (colim-com f i A) = com C f i A

  colimIsColimit : isColimit F (colim F)
  cone colimIsColimit = colimCone
  univ colimIsColimit ℓq Y
    = isoToIsEquiv record { fun = postcomp colimCone
                          ; inv = colim-rec
                          ; rightInv = λ C → refl
                          ; leftInv  = λ h → funExt (eq h) }
    where eq : ∀ h (x : colim _) → colim-rec (postcomp colimCone h) x ≡ h x
          eq h (colim-leg j A)   = refl
          eq h (colim-com f i A) = refl


module ShouldBePi where

data One : Set where
  one : One

err1 : One
err1 = \x -> x

err2 : One
err2 = one one

err3 : One
err3 x = x


{- Byzantine Fault Tolerant Consensus Verification in Agda, version 0.9.

   Copyright (c) 2021, Oracle and/or its affiliates.
   Licensed under the Universal Permissive License v 1.0 as shown at https://opensource.oracle.com/licenses/upl
-}

open import LibraBFT.ImplShared.Consensus.Types
open import Optics.All
open import Util.KVMap                          as Map hiding (empty)
open import Util.Prelude

module LibraBFT.Impl.Types.OnChainConfig.ValidatorSet where

new : List ValidatorInfo → ValidatorSet
new = ValidatorSet∙new ConsensusScheme∙new

empty : ValidatorSet
empty = new []

obmFromVV : ValidatorVerifier → ValidatorSet
obmFromVV vv0 = record -- ValidatorSet
  { _vsScheme  = ConsensusScheme∙new -- TODO
  ; _vsPayload = fmap go (Map.toList (vv0 ^∙ vvAddressToValidatorInfo))
  }
 where
  go : (Author × ValidatorConsensusInfo) → ValidatorInfo
  go (address , ValidatorConsensusInfo∙new pk vp) =
    record -- ValidatorInfo
    { _viAccountAddress = address
    ; _viConsensusVotingPower = vp
    ; _viConfig = record -- ValidatorConfig
                  { _vcConsensusPublicKey      = pk
                  ; _vcValidatorNetworkAddress = address ^∙ aAuthorName } }

obmGetValidatorInfo : AuthorName → ValidatorSet → Either ErrLog ValidatorInfo
obmGetValidatorInfo name vs =
  case List-filter (λ vi → vi ^∙ viAccountAddress ∙ aAuthorName ≟ name) (vs ^∙ vsPayload) of λ where
    (vi ∷ []) → pure vi
    _         → Left fakeErr  -- ["ValidatorSet", "obmGetValidatorInfo", "TODO better err msg"]