Browse Source

Almost working example!

gas-move-test
Thomas Kerber 6 months ago
parent
commit
b7de611e6e
Signed by: Thomas Kerber <t.kerber@ed.ac.uk> GPG Key ID: 8489B911F9ED617B
3 changed files with 294 additions and 99 deletions
  1. 165
    0
      Yggdrasil/Examples/SecureChannel.agda
  2. 76
    61
      Yggdrasil/Security.agda
  3. 53
    38
      Yggdrasil/World.agda

+ 165
- 0
Yggdrasil/Examples/SecureChannel.agda View File

@@ -0,0 +1,165 @@
1
+module Yggdrasil.Examples.SecureChannel where
2
+
3
+open import Data.Bool using (Bool; true; false; if_then_else_)
4
+open import Data.List using (List; []; _∷_)
5
+open import Data.Maybe using (Maybe; just; nothing)
6
+open import Data.Product using (_×_) renaming (_,_ to ⟨_,_⟩)
7
+open import Level using (Level; Lift; lift)
8
+open import Relation.Binary.PropositionalEquality using (refl)
9
+open import Yggdrasil.World
10
+open import Yggdrasil.List
11
+open import Yggdrasil.Security
12
+open import Yggdrasil.Probability using (pure)
13
+
14
+open Action↑
15
+open Action↓
16
+open Action↯
17
+open WorldStates
18
+
19
+πᵢ-SecureChannel : {ℓ : Level} → (M L : Set ℓ) → (M → L) → World ℓ
20
+πᵢ-SecureChannel M L l = record
21
+  { Γ = record
22
+    { node = mknode (Maybe M) [] (mknquery L ⊤ ∷ [])
23
+    ; adv  = []
24
+    ; hon  =
25
+      ncall ⊤ (Maybe M) (λ _ → read) ∷
26
+      ncall M ⊤ (λ m → write (just m) >> query here (l m) >> return tt) ∷
27
+      []
28
+    }
29
+  ; Σ = stnode nothing []
30
+  }
31
+
32
+πᵢ-AuthChannel : {ℓ : Level} → Set ℓ → World ℓ
33
+πᵢ-AuthChannel M = record
34
+  { Γ = record
35
+    { node = mknode (Maybe M) [] (mknquery M ⊤ ∷ [])
36
+    ; adv  = []
37
+    ; hon  =
38
+      ncall ⊤ (Maybe M) (λ _ → read) ∷
39
+      ncall M ⊤ (λ m → write (just m) >> query here m >> return tt) ∷
40
+      []
41
+    }
42
+  ; Σ = stnode nothing []
43
+  }
44
+
45
+πᵢ-PKE : {ℓ : Level} → (M C PK L : Set ℓ) → (M → L) → (PK → PK → Bool) →
46
+  (C → C → Bool) → World ℓ
47
+πᵢ-PKE M C PK L l pk?= c?= = record
48
+  { Γ = record
49
+    { node = mknode (Maybe (PK × List (M × C))) []
50
+      (mknquery L C ∷ mknquery ⊤ PK ∷ [])
51
+    ; adv  = []
52
+    ; hon  =
53
+      ncall C (Maybe M) (λ c → read >>= λ
54
+        { nothing            → return nothing
55
+        ; (just ⟨ _ , log ⟩) → return (in-log c log)
56
+        }) ∷
57
+      ncall (PK × M) (Maybe C) (λ{ ⟨ pk′ , m ⟩ → read >>= λ
58
+        { nothing             → return nothing
59
+        ; (just ⟨ pk , log ⟩) → if pk?= pk pk′ then
60
+          query here (l m) >>=
61
+            (λ c → write (just ⟨ pk , ⟨ m , c ⟩ ∷ log ⟩) >>
62
+            return (just c)) else
63
+          return nothing
64
+        }}) ∷
65
+      ncall ⊤ PK (λ _ → query (there here) tt >>=
66
+        (λ pk → write (just ⟨ pk , [] ⟩) >> return pk)) ∷
67
+      []
68
+    }
69
+  ; Σ = stnode nothing []
70
+  }
71
+  where
72
+    in-log : C → List (M × C) → Maybe M
73
+    in-log c [] = nothing
74
+    in-log c (⟨ m , c′ ⟩ ∷ log) = if c?= c c′ then just m else in-log c log
75
+
76
+πᵣ-SecureChannel : {ℓ : Level} → (M C PK L : Set ℓ) → (M → L) →
77
+  (PK → PK → Bool) → (C → C → Bool) → World ℓ
78
+πᵣ-SecureChannel M C PK L l pk?= c?= = record
79
+  { Γ = record
80
+    { node = mknode (Maybe PK) (
81
+        World.Γ (πᵢ-PKE M C PK L l pk?= c?=) ∷
82
+        World.Γ (πᵢ-AuthChannel C) ∷
83
+        [])
84
+      []
85
+    ; adv  = []
86
+    ; hon  =
87
+      ncall ⊤ (Maybe M) (λ _ → call↓ here tt ↑ there here >>= λ
88
+        { nothing  → return nothing
89
+        ; (just c) → call↓ here c ↑ here
90
+        }) ∷
91
+      ncall M ⊤ (λ m → let
92
+          dosend = λ pk m → call↓ (there here) ⟨ pk , m ⟩ ↑ here >>= (λ
93
+           { nothing → abort -- The public key we set was refused!
94
+           ; (just c) → call↓ (there here) c ↑ (there here)
95
+           })
96
+        in read >>= λ
97
+          { nothing   → call↓ (there (there here)) tt ↑ here >>= (λ pk →
98
+              write (just pk) >> dosend pk m)
99
+          ; (just pk) → dosend pk m
100
+          }) ∷
101
+      []
102
+    }
103
+  ; Σ = stnode nothing (
104
+    World.Σ (πᵢ-PKE M C PK L l pk?= c?=) ∷
105
+    World.Σ (πᵢ-AuthChannel C) ∷
106
+    [])
107
+  }
108
+
109
+BitString : ∀ {ℓ} → Set ℓ
110
+BitString {ℓ} = Lift ℓ (List Bool)
111
+
112
+bitstring?= : ∀ {ℓ} → BitString {ℓ} → BitString {ℓ} → Bool
113
+bitstring?= (lift []) (lift []) = true
114
+bitstring?= (lift (_ ∷ _)) (lift []) = false
115
+bitstring?= (lift []) (lift (_ ∷ _)) = false
116
+bitstring?= {ℓ} (lift (true  ∷ xs)) (lift (true  ∷ ys)) = bitstring?= {ℓ} (lift xs) (lift ys)
117
+bitstring?= {ℓ} (lift (false ∷ xs)) (lift (false ∷ ys)) = bitstring?= {ℓ} (lift xs) (lift ys)
118
+bitstring?= (lift (true  ∷ xs)) (lift (false ∷ ys)) = false
119
+bitstring?= (lift (false ∷ xs)) (lift (true  ∷ ys)) = false
120
+
121
+_>>↯_ : ∀ {ℓ Σ Γᵢ Γᵣ A B hon-≡} → Action↯ {ℓ} Σ Γᵢ Γᵣ {hon-≡} A →
122
+  Action↯ {ℓ} Σ Γᵢ Γᵣ {hon-≡} B →
123
+  Action↯ {ℓ} Σ Γᵢ Γᵣ {hon-≡} B
124
+α >>↯ β = α >>= (λ _ → β)
125
+
126
+S-SecureChannel : {ℓ : Level} → (M C PK L : Set ℓ) → (l : M → L) →
127
+  (pk?= : PK → PK → Bool) → (c?= : C → C → Bool) → 
128
+  Simulator (πᵢ-SecureChannel M L l) (πᵣ-SecureChannel M C PK L l pk?= c?=)
129
+S-SecureChannel {ℓ} M C PK L l pk?= c?= = record
130
+    { hon-≡     = refl
131
+    ; state     = Lift ℓ Bool
132
+    ; initial   = lift false
133
+    ; call↯-map = λ
134
+      { () here
135
+      ; () (there here here) 
136
+      ; _  (there here (there () _))
137
+      ; () (there (there here) here) 
138
+      ; _  (there (there here) (there () _))
139
+      ; _  (there (there (there ())) _)
140
+      }
141
+    ; query-map = λ
142
+      { (path here here) l → read >>= let
143
+          perform-leak = query here (there here here) l >>= (λ c → 
144
+            query here (there (there here) here) c)
145
+        in λ
146
+          -- 1. on the first leakage seen, query a π-PKE public key (ignore it).
147
+          -- 2. on *all* leakages seen, query a π-PKE ciphertext with the leakage
148
+          -- 3. finally, query a π-AuthChannel message, with the previous ciphertext.
149
+          { (lift false) → query (there here) (there here here) tt >>↯ perform-leak
150
+          ; (lift true)  → perform-leak
151
+          }
152
+      ; (path here (there ()))  
153
+      ; (path (there () _) _)
154
+      }
155
+    }
156
+
157
+secure : {ℓ : Level} → (M C PK L : Set ℓ) → (l : M → L) →
158
+  (pk?= : PK → PK → Bool) → (c?= : C → C → Bool) → 
159
+  πᵢ-SecureChannel M L l ≃ πᵣ-SecureChannel M C PK L l pk?= c?=
160
+secure {ℓ} M C PK L l pk?= c?= = record
161
+  { g-exec-min = ?
162
+  ; g-sim-min  = ?
163
+  ; simulator  = S-SecureChannel M C PK L l pk?= c?=
164
+  ; proof      = ?
165
+  }

+ 76
- 61
Yggdrasil/Security.agda View File

@@ -9,14 +9,13 @@ open import Data.Product using (_×_; Σ; Σ-syntax; proj₁; proj₂; ∃; ∃-
9 9
 open import Data.Nat using (ℕ; zero; suc; _≤_; _^_; _+_)
10 10
 open import Data.Integer using (ℤ)
11 11
 open import Data.Maybe using (Maybe) renaming (map to mmap)
12
-open import Data.Unit using (⊤; tt)
13 12
 open import Data.Rational using (ℚ)
14 13
 open import Function using (_∘_)
15 14
 open import Level using (Level; Lift; lift) renaming (suc to lsuc)
16
-open import Relation.Binary.PropositionalEquality using (_≡_; _≢_; refl; cong)
15
+open import Relation.Binary.PropositionalEquality using (_≡_; _≢_; refl; cong; sym)
17 16
 open import Relation.Nullary.Decidable using (fromWitnessFalse)
18 17
 open import Yggdrasil.List using (_∈_; here; there; with-proof; map≡-implies-∈≡)
19
-open import Yggdrasil.World using (WorldType; WorldState; World; Oracle; Call; Strategy; Node; Action; weaken; call; call↓; _↑_; stnode; _∷_; []; ⌊exec⌋; _⊑_; Query; _∈↑_; abort; dist; _>>=_; call↯; query; path; _↑; strat)
18
+open import Yggdrasil.World using (WorldType; WorldState; World; Oracle; Call; Strategy; Node; Action; weaken; call; call↓; _↑_; stnode; _∷_; []; ⌊exec⌋; _⊑_; Query; _∈↑_; abort; dist; _>>=_; call↯; query; path; _↑; strat; ⊤; tt)
20 19
 open import Yggdrasil.Probability using (Dist; _>>=_; pure; _≈[_]≈_)
21 20
 open import Yggdrasil.Rational using (_÷_)
22 21
 open WorldType
@@ -34,81 +33,97 @@ instance
34 33
 data Guess {ℓ : Level} : Set ℓ where
35 34
   real? ideal? : Guess
36 35
 
37
-data Action↯ {ℓ : Level} (Γᵢ Γᵣ : WorldType ℓ)
36
+data Action↯ {ℓ : Level} (σ : Set ℓ) (Γᵢ Γᵣ : WorldType ℓ)
38 37
     {hon-≡ : map weaken (hon Γᵢ) ≡ map weaken (hon Γᵣ)} : Set ℓ →
39 38
     Set (lsuc ℓ) where
40
-  query : ∀ {Γ′ q} → q ∈ qry (node Γ′) → Γ′ ⊑ Γᵢ → (x : Query.A q) → Action↯ Γᵢ Γᵣ (Query.B q x)
41
-  abort : ∀ {A} → Action↯ Γᵢ Γᵣ A
42
-  dist  : ∀ {A} → Dist A → Action↯ Γᵢ Γᵣ A
43
-  call↯ : ∀ {Γ′} {f : Call ℓ (node Γ′)} → f ∈ (adv Γ′) → Γ′ ⊑ Γᵣ → (x : Call.A f) →
44
-    Action↯ Γᵢ Γᵣ (Call.B f x)
45
-  _>>=_ : ∀ {A B} → Action↯ Γᵢ Γᵣ {hon-≡} A → (A → Action↯ Γᵢ Γᵣ {hon-≡} B) →
46
-    Action↯ Γᵢ Γᵣ B
47
-
48
-record Simulator {ℓ : Level} (Γᵢ Γᵣ : WorldType ℓ) : Set (lsuc ℓ) where
39
+  read  : Action↯ σ Γᵢ Γᵣ σ
40
+  write : σ → Action↯ σ Γᵢ Γᵣ ⊤
41
+  query : ∀ {Γ′ q} → q ∈ qry (node Γ′) → Γ′ ⊑ Γᵣ → (x : Query.A q) → Action↯ σ Γᵢ Γᵣ (Query.B q x)
42
+  abort : ∀ {A} → Action↯ σ Γᵢ Γᵣ A
43
+  dist  : ∀ {A} → Dist A → Action↯ σ Γᵢ Γᵣ A
44
+  call↯ : ∀ {Γ′} {f : Call ℓ (node Γ′)} → f ∈ (adv Γ′) → Γ′ ⊑ Γᵢ → (x : Call.A f) →
45
+    Action↯ σ Γᵢ Γᵣ (Call.B f x)
46
+  _>>=_ : ∀ {A B} → Action↯ σ Γᵢ Γᵣ {hon-≡} A → (A → Action↯ σ Γᵢ Γᵣ {hon-≡} B) →
47
+    Action↯ σ Γᵢ Γᵣ B
48
+
49
+-- FIXME: Am I an idiot? Shouldn't the simulator map attacks against *real*
50
+-- protocols to attacks against *ideal* protocols?
51
+record Simulator {ℓ : Level} (πᵢ πᵣ : World ℓ) : Set (lsuc ℓ) where
52
+  Γᵢ : WorldType ℓ
53
+  Γᵢ = World.Γ πᵢ
54
+  Γᵣ : WorldType ℓ
55
+  Γᵣ = World.Γ πᵣ
49 56
   field
50 57
     hon-≡ : map weaken (hon Γᵢ) ≡ map weaken (hon Γᵣ)
51 58
     state : Set ℓ
52 59
     initial : state
53
-    call↯-map : ∀ {Γ′} {f : Call ℓ (node Γ′)} → f ∈ (adv Γ′) → Γ′ ⊑ Γᵢ →
54
-      (x : Call.A f) → Action↯ Γᵢ Γᵣ {hon-≡} (Call.B f x)
55
-    query-map : ∀ {q} → q ∈↑ Γᵣ → (x : Query.A q) → Action↯ Γᵢ Γᵣ {hon-≡} (Query.B q x)
60
+    call↯-map : ∀ {Γ′} {f : Call ℓ (node Γ′)} → f ∈ (adv Γ′) → Γ′ ⊑ Γ
61
+      (x : Call.A f) → Action↯ state Γᵢ Γᵣ {hon-≡} (Call.B f x)
62
+    query-map : ∀ {q} → q ∈↑ Γᵢ → (x : Query.A q) → Action↯ state Γᵢ Γᵣ {hon-≡} (Query.B q x)
56 63
 
57 64
 open Simulator
58 65
 
59
-Actionᵢ⇒Actionᵣ : ∀ {ℓ : Level} {Γᵢ Γᵣ : WorldType ℓ} {A : Set ℓ} →
60
-  Simulator Γᵢ Γᵣ → Oracle Γᵢ → ℕ → Action Γᵢ A → Action Γᵣ A
61
-Action↯⇒Action : ∀ {ℓ : Level} {Γᵢ Γᵣ : WorldType ℓ} {A : Set ℓ} →
62
-  (S : Simulator Γᵢ Γᵣ) → Oracle Γᵢ → ℕ → Action↯ Γᵢ Γᵣ {hon-≡ S} A → Action Γᵣ A
63
-
64
-Actionᵢ⇒Actionᵣ _ _ zero _ = abort
65
-Actionᵢ⇒Actionᵣ S O (suc g) ((call↓ ∈Γᵢ x) ↑) with map≡-implies-∈≡ (hon-≡ S) ∈Γᵢ
66
-... | ⟨ _ , ⟨ ∈Γᵣ , refl ⟩ ⟩ = call↓ ∈Γᵣ x ↑
67
-Actionᵢ⇒Actionᵣ _ _ _ abort = abort
68
-Actionᵢ⇒Actionᵣ _ _ _ (dist D) = dist D
69
-Actionᵢ⇒Actionᵣ S O (suc g) (call↯ ∈Γ Γ⊑ x) = Action↯⇒Action S O g (call↯-map S ∈Γ Γ⊑ x)
70
-Actionᵢ⇒Actionᵣ S O (suc g) (α >>= β) = (Actionᵢ⇒Actionᵣ S O (suc g) α) >>=
71
-  (Actionᵢ⇒Actionᵣ S O g ∘ β)
72
-
73
-Action↯⇒Action _ _ zero _ = abort
74
-Action↯⇒Action S O (suc g) (query ∈Γ Γ⊑ x) = Actionᵢ⇒Actionᵣ S O g (O (path Γ⊑ ∈Γ) x)
75
-Action↯⇒Action _ _ _ abort = abort
76
-Action↯⇒Action _ _ _ (dist D) = dist D
77
-Action↯⇒Action _ _ _ (call↯ ∈Γ Γ⊑ x) = call↯ ∈Γ Γ⊑ x
78
-Action↯⇒Action S O (suc g) (α >>= β) = (Action↯⇒Action S O (suc g) α) >>=
79
-  (Action↯⇒Action S O g ∘ β)
80
-
81
-extract-oracle : ∀ {ℓ Γᵢ Γᵣ} → Simulator {ℓ} Γᵢ Γᵣ → Oracle Γᵢ → ℕ → Oracle Γᵣ
82
-extract-oracle S O g ∈Γ x = Action↯⇒Action S O g (query-map S ∈Γ x)
83
-
84
-simulated-strategy : ∀ {ℓ Γᵢ Γᵣ A} → Simulator {ℓ} Γᵢ Γᵣ → Strategy Γᵢ A → ℕ →
85
-  Strategy Γᵣ A
66
+Actionᵣ⇒Actionᵢ : ∀ {ℓ : Level} {πᵢ πᵣ : World ℓ} {A : Set ℓ} →
67
+  (S : Simulator πᵢ πᵣ) → Oracle (World.Γ πᵣ) → state S → ℕ →
68
+  Action (World.Γ πᵣ) A → Action (World.Γ πᵢ) (A × state S)
69
+Action↯⇒Action : ∀ {ℓ : Level} {πᵢ πᵣ : World ℓ} {A : Set ℓ} →
70
+  (S : Simulator πᵢ πᵣ) → Oracle (World.Γ πᵣ) → state S → ℕ →
71
+  Action↯ (state S) (World.Γ πᵢ) (World.Γ πᵣ) {hon-≡ S} A →
72
+  Action (World.Γ πᵢ) (A × state S)
73
+
74
+private
75
+  with-state : ∀ {ℓ Γ A Σ} → Σ → A → Action {ℓ} Γ (A × Σ)
76
+  with-state σ x = dist (pure ⟨ x , σ ⟩)
77
+
78
+  without-state : ∀ {ℓ Γ} {A Σ : Set ℓ} → (A × Σ) → Action {ℓ} Γ A
79
+  without-state ⟨ x , _ ⟩ = dist (pure x)
80
+
81
+Actionᵣ⇒Actionᵢ _ _ _ zero _ = abort
82
+Actionᵣ⇒Actionᵢ S O σ (suc g) ((call↓ {f} ∈Γᵣ x) ↑) with map≡-implies-∈≡ (sym (hon-≡ S)) ∈Γᵣ
83
+... | ⟨ _ , ⟨ ∈Γᵢ , refl ⟩ ⟩ = call↓ ∈Γᵢ x ↑ >>= with-state σ
84
+Actionᵣ⇒Actionᵢ _ _ _ _ abort = abort
85
+Actionᵣ⇒Actionᵢ _ _ σ _ (dist D) = dist D >>= with-state σ
86
+Actionᵣ⇒Actionᵢ S O σ (suc g) (call↯ ∈Γ Γ⊑ x) = Action↯⇒Action S O σ g (call↯-map S ∈Γ Γ⊑ x)
87
+Actionᵣ⇒Actionᵢ S O σ (suc g) (α >>= β) = (Actionᵣ⇒Actionᵢ S O σ (suc g) α) >>= λ{
88
+    ⟨ x , σ′ ⟩ → Actionᵣ⇒Actionᵢ S O σ′ g (β x)
89
+  }
90
+
91
+Action↯⇒Action _ _ _ zero _ = abort
92
+Action↯⇒Action S O σ _ read = dist (pure ⟨ σ , σ ⟩)
93
+Action↯⇒Action S O _ _ (write σ) = dist (pure ⟨ tt , σ ⟩)
94
+Action↯⇒Action S O σ (suc g) (query ∈Γ Γ⊑ x) = Actionᵣ⇒Actionᵢ S O σ g (O (path Γ⊑ ∈Γ) x)
95
+Action↯⇒Action _ _ _ _ abort = abort
96
+Action↯⇒Action _ _ σ _ (dist D) = dist D >>= with-state σ
97
+Action↯⇒Action _ _ σ _ (call↯ ∈Γ Γ⊑ x) = call↯ ∈Γ Γ⊑ x >>= with-state σ
98
+Action↯⇒Action S O σ (suc g) (α >>= β) = (Action↯⇒Action S O σ (suc g) α) >>= λ{
99
+    ⟨ x , σ′ ⟩ → Action↯⇒Action S O σ′ g (β x)
100
+  }
101
+
102
+extract-oracle : ∀ {ℓ πᵢ πᵣ} → Simulator {ℓ} πᵢ πᵣ → Oracle (World.Γ πᵣ) → ℕ →
103
+  Oracle (World.Γ πᵢ)
104
+extract-oracle S O g ∈Γ x = Action↯⇒Action S O (initial S) g (query-map S ∈Γ x)
105
+  >>= without-state
106
+
107
+simulated-strategy : ∀ {ℓ πᵢ πᵣ A} → Simulator {ℓ} πᵢ πᵣ →
108
+  Strategy (World.Γ πᵣ) A → ℕ → Strategy (World.Γ πᵢ) A
86 109
 simulated-strategy S str g = strat
87
-  (Actionᵢ⇒Actionᵣ S (oracle str) g (init str))
110
+  (Actionᵣ⇒Actionᵢ S (oracle str) (initial S) g (init str) >>= without-state)
88 111
   (extract-oracle S (oracle str) g)
89 112
 
90
-record Challenge {ℓ : Level} : Set (lsuc ℓ) where
91
-  field
92
-    Γᵢ : WorldType ℓ
93
-    Γᵣ : WorldType ℓ
94
-    Σᵢ : WorldState Γᵢ
95
-    Σᵣ : WorldState Γᵣ
96
-    sim : Simulator Γᵢ Γᵣ
97
-
98
-record Adv[_]≤_ {ℓ : Level} (c : Challenge {ℓ}) (ε : ℚ) :
113
+record Adv[_,_]≤_ {ℓ : Level} (πᵢ πᵣ : World ℓ) (ε : ℚ) :
99 114
     Set (lsuc (lsuc ℓ)) where
100 115
   field
101 116
     g-exec-min : ℕ
102 117
     g-sim-min : ℕ
118
+    simulator : Simulator πᵢ πᵣ
103 119
     proof : (g-exec g-sim : ℕ) → g-exec-min ≤ g-exec → g-sim-min ≤ g-sim →
104
-      (str : Strategy (Challenge.Γᵢ c) Guess) →
105
-      (⌊exec⌋ str (Challenge.Σᵢ c) g-exec)
120
+      (str : Strategy (World.Γ πᵣ) Guess) →
121
+      (⌊exec⌋ (simulated-strategy simulator str g-sim) (World.Σ πᵢ) g-exec)
106 122
         ≈[ ε ]≈
107
-      (⌊exec⌋ (simulated-strategy (Challenge.sim c) str g-sim) (Challenge.Σᵣ c)
108
-        g-exec)
123
+      (⌊exec⌋ str (World.Σ πᵣ) g-exec)
109 124
 
110
-Perfect : {ℓ : Level} → Challenge {ℓ} → Set (lsuc (lsuc ℓ))
111
-Perfect c = Adv[ c ]≤ 0
125
+_≃_ : {ℓ : Level} → (πᵢ πᵣ : World ℓ) → Set (lsuc (lsuc ℓ))
126
+πᵢ ≃ πᵣ = Adv[ πᵢ , πᵣ ]≤ 0
112 127
 
113 128
 private
114 129
   +-≡0ˡ : ∀ {n m} → n + m ≡ 0 → n ≡ 0
@@ -119,5 +134,5 @@ private
119 134
   ^≢0 {n} {zero} ()
120 135
   ^≢0 {n} {suc m} n^sm≡0 = ^≢0 {n} {m} (+-≡0ˡ n^sm≡0)
121 136
 
122
-Computational : {ℓ : Level} → ℕ → (ℕ → Challenge {ℓ}) → Set (lsuc (lsuc ℓ))
123
-Computational κ f = Adv[ f κ ]≤ (_÷_ 1 (2 ^ κ) {fromWitnessFalse (^≢0 {1} {κ})})
137
+_≈_ : {ℓ : Level} → (πᵢ πᵣ : ℕ → World ℓ) → ℕ → Set (lsuc (lsuc ℓ))
138
+_≈_ πᵢ πᵣ κ = Adv[ πᵢ κ , πᵣ κ ]≤ (_÷_ 1 (2 ^ κ) {fromWitnessFalse (^≢0 {1} {κ})})

+ 53
- 38
Yggdrasil/World.agda View File

@@ -5,7 +5,7 @@ open import Data.Empty using (⊥-elim)
5 5
 open import Data.List using (List; _∷_; []; map)
6 6
 open import Data.Maybe using (Maybe; nothing; just) renaming (map to mmap)
7 7
 open import Data.Nat using (ℕ; zero; suc)
8
-open import Data.Product using (_×_; Σ; ∃; ∃-syntax; proj₁) renaming (_,_ to ⟨_,_⟩)
8
+open import Data.Product using (_×_; ∃; ∃-syntax; proj₁) renaming (_,_ to ⟨_,_⟩)
9 9
 open import Data.Sum using (_⊎_; inj₁; inj₂)
10 10
 open import Function using (_∘_)
11 11
 open import Relation.Binary.PropositionalEquality using (_≡_; _≢_; refl)
@@ -13,14 +13,20 @@ open import Level using (Level; Lift) renaming (suc to lsuc; lift to llift)
13 13
 open import Yggdrasil.Probability using (Dist; pure; _>>=_; lift)
14 14
 open import Yggdrasil.List using (_∈_; here; there)
15 15
 
16
+data ⊤ {ℓ : Level} : Set ℓ where
17
+  tt : ⊤
18
+
16 19
 record Query (ℓ : Level) : Set (lsuc ℓ) where
20
+  constructor mkquery
17 21
   field
18 22
     A : Set ℓ
19 23
     B : A → Set ℓ
20 24
 
25
+mknquery : {ℓ : Level} → Set ℓ → Set ℓ → Query ℓ
26
+mknquery A B = mkquery A (λ _ → B)
27
+
21 28
 record Node (ℓ : Level) : Set (lsuc ℓ)
22 29
 record WorldType (ℓ : Level) : Set (lsuc ℓ)
23
---data Action↯ {ℓ : Level} (Γ : WorldType ℓ) : Set ℓ → Set (lsuc ℓ)
24 30
 data Action↑ {ℓ : Level} (N : Node ℓ) : Set ℓ → Set (lsuc ℓ)
25 31
 data Action↓ {ℓ : Level} (Γ : WorldType ℓ) : Set ℓ → Set (lsuc ℓ)
26 32
 data Action {ℓ : Level} (Γ : WorldType ℓ) : Set ℓ → Set (lsuc ℓ)
@@ -30,6 +36,7 @@ data WorldStates {ℓ : Level} : List (WorldType ℓ) → Set (lsuc ℓ)
30 36
 
31 37
 record Node ℓ where
32 38
   inductive
39
+  constructor mknode
33 40
   field
34 41
     state : Set ℓ
35 42
     chld  : List (WorldType ℓ)
@@ -43,13 +50,18 @@ record Call (ℓ : Level) (N : Node ℓ) : Set (lsuc ℓ) where
43 50
   field
44 51
     A : Set ℓ
45 52
     B : A → Set ℓ
46
-    δ : (state N) → (x : A) → (state N) × Action↑ N (B x)
53
+    δ : (x : A) → Action↑ N (B x)
54
+
55
+-- A non-dependently typed instance of call.
56
+ncall : {ℓ : Level} {N : Node ℓ} → (A B : Set ℓ) → (A → Action↑ N B) → Call ℓ N
57
+ncall A B δ = call A (λ _ → B) δ
47 58
 
48 59
 weaken : ∀ {ℓ N} → Call ℓ N → Query ℓ
49 60
 weaken c = record { A = Call.A c; B = Call.B c }
50 61
 
51 62
 record WorldType ℓ where
52 63
   inductive
64
+  constructor tynode
53 65
   field
54 66
     node : Node ℓ
55 67
     adv  : List (Call ℓ node)
@@ -76,24 +88,28 @@ data Action {ℓ} Γ where
76 88
     Action Γ (Call.B f x)
77 89
   _>>=_ : ∀ {A B} → Action Γ A → (A → Action Γ B) → Action Γ B
78 90
 
79
---A = Action↯ Γ A ⊎ Action↓ Γ A
80
---data Action↯ {ℓ} Γ where
81
-
82 91
 data Action↓ {ℓ} Γ where
83 92
   call↓ : ∀ {f} → f ∈ (hon Γ) → (x : Call.A f) → Action↓ Γ (Call.B f x)
84 93
 
85 94
 data Action↑ {ℓ} N where
95
+  read  : Action↑ N (state N)
96
+  write : state N → Action↑ N ⊤
86 97
   abort : ∀ {A} → Action↑ N A
87 98
   dist  : ∀ {A} → Dist A → Action↑ N A
88 99
   query : ∀ {q} → q ∈ qry N → (x : Query.A q) → Action↑ N (Query.B q x)
89 100
   _↑_   : ∀ {Γ A} → Action↓ Γ A → Γ ∈ chld N → Action↑ N A
90 101
   _>>=_ : ∀ {A B} → Action↑ N A → (A → Action↑ N B) → Action↑ N B
91 102
 
103
+-- TODO: build full monad instances of all actions, and Dist -- once I figure
104
+-- out how that works in agda.
105
+return : ∀ {ℓ N A} → A → Action↑ {ℓ} N A
106
+return x = dist (pure x)
107
+
108
+infixl 1 _>>=_ _>>_
109
+
110
+_>>_ : ∀ {ℓ N A B} → Action↑ {ℓ} N A → Action↑ {ℓ} N B → Action↑ {ℓ} N B
111
+α >> β = α >>= (λ _ → β)
112
+
92 113
 data WorldStates {ℓ} where
93 114
   [] : WorldStates []
94 115
   _∷_ : ∀ {Γ Γs} → WorldState Γ → WorldStates Γs → WorldStates (Γ ∷ Γs)
@@ -101,8 +117,10 @@ data WorldStates {ℓ} where
101 117
 data WorldState {ℓ} Γ where
102 118
   stnode : state (node Γ) → WorldStates (chld (node Γ)) → WorldState Γ
103 119
 
104
-World : (ℓ : Level) → Set (lsuc ℓ)
105
-World ℓ = Σ (WorldType ℓ) WorldState
120
+record World (ℓ : Level) : Set (lsuc ℓ) where
121
+  field
122
+    Γ : WorldType ℓ
123
+    Σ : WorldState Γ
106 124
 
107 125
 data _∈↑_ {ℓ : Level} (q : Query ℓ) (Γ : WorldType ℓ) : Set (lsuc ℓ) where
108 126
   path : ∀ {Γ′} → Γ′ ⊑ Γ → q ∈ qry (node Γ′) → q ∈↑ Γ
@@ -140,57 +158,36 @@ exec : ∀ {ℓ Γ A} → Strategy {ℓ} Γ A → WorldState {ℓ} Γ → ℕ 
140 158
   Dist (Maybe (A × WorldState {ℓ} Γ))
141 159
 exec′ : ∀ {ℓ Γ A} → Oracle Γ → Action Γ A → WorldState {ℓ} Γ → ℕ →
142 160
   Dist (Maybe (A × WorldState {ℓ} Γ))
143
---exec↯ : ∀ {ℓ Γ A} → Oracle Γ → Action↯ Γ A → WorldState {ℓ} Γ → ℕ →
144 161
 exec↓ : ∀ {ℓ Γ₁ Γ₂ A} → Oracle Γ₁ → Action↓ Γ₂ A → WorldState {ℓ} Γ₁ →
145 162
   Γ₂ ⊑ Γ₁ → ℕ → Dist (Maybe (A × WorldState {ℓ} Γ₁))
146
-exec↑ : ∀ {ℓ Γ₁ Γ₂ N A} → Oracle Γ₁ → Action↑ N A → WorldState {ℓ} Γ₁ →
147
-  Γ₂ ⊑ Γ₁ → N ≡ node Γ₂ → ℕ → Dist (Maybe (A × WorldState {ℓ} Γ₁))
163
+exec↑ : ∀ {ℓ Γ₁ Γ₂ A} → Oracle Γ₁ → Action↑ (node Γ₂) A → WorldState {ℓ} Γ₁ →
164
+  Γ₂ ⊑ Γ₁ → ℕ → Dist (Maybe (A × WorldState {ℓ} Γ₁))
148 165
 
149 166
 -- NOTE: Gas is only used for termination here, it is NOT a computational model.
150 167
 ⌊exec⌋ str Σ g = (exec str Σ g) >>= (pure ∘ mmap (llift ∘ proj₁))
151 168
 exec (strat α O) Σ g = exec′ O α Σ g
152 169
 
153
-exec′ _ _ _ zero = pure nothing
154
-exec′ O (α ↑) Σ g = exec↓ O α Σ here g
155
-exec′ _ abort _ _ = pure nothing
156
-exec′ O (dist D) Σ (suc g) = lift D >>= λ{ (llift x) → pure (just ⟨ x , Σ ⟩ ) }
157
-exec′ O (call↯ {f = f} f∈ ⊑Γ x) Σ (suc g) = let
158
-    σ = get ⊑Γ Σ
159
-    ⟨ σ′ , α ⟩ = Call.δ f σ x
160
-    Σ′ = set ⊑Γ Σ σ′
161
-  in exec↑ O α Σ′ ⊑Γ refl g
162
-exec′ O (α >>= β) Σ (suc g) = (exec′ O α Σ (suc g)) >>= λ{
170
+exec′ O α                       Σ zero    = pure nothing
171
+exec′ O (α ↑)                   Σ g       = exec↓ O α Σ here g
172
+exec′ O abort                   Σ g       = pure nothing
173
+exec′ O (dist D)                Σ (suc g) = lift D >>= λ{ (llift x) → pure (just ⟨ x , Σ ⟩ ) }
174
+exec′ O (call↯ {f = f} f∈ ⊑Γ x) Σ (suc g) = exec↑ O (Call.δ f x) Σ ⊑Γ g
175
+exec′ O (α >>= β)               Σ (suc g) = (exec′ O α Σ (suc g)) >>= λ{
163 176
   (just ⟨ x , Σ′ ⟩) → exec′ O (β x) Σ′ g;
164 177
   nothing           → pure nothing }
165 178
 
166
-
167
-exec↓ _ _ _ _ zero = pure nothing
168
-exec↓ O (call↓ {f = f} f∈ x) Σ ⊑Γ (suc g) = let
169
-    σ = get ⊑Γ Σ
170
-    ⟨ σ′ , α ⟩ = Call.δ f σ x
171
-    Σ′ = set ⊑Γ Σ σ′
172
-  in exec↑ O α Σ′ ⊑Γ refl g
173
-
174
-exec↑ _ _ _ _ _ zero = pure nothing
175
-exec↑ O abort Σ ⊑Γ N≡ (suc g) = pure nothing
176
-exec↑ O (dist D) Σ ⊑Γ N≡ (suc g) = lift D >>=
179
+exec↓ _ _                    _ _  zero    = pure nothing
180
+exec↓ O (call↓ {f = f} f∈ x) Σ ⊑Γ (suc g) = exec↑ O (Call.δ f x) Σ ⊑Γ g
181
+
182
+exec↑ O α                    Σ ⊑Γ zero    = pure nothing
183
+exec↑ O read                 Σ ⊑Γ _       = pure (just ⟨ get ⊑Γ Σ , Σ ⟩)
184
+exec↑ O (write σ)            Σ ⊑Γ _       = pure (just ⟨ tt , set ⊑Γ Σ σ ⟩)
185
+exec↑ O abort                Σ ⊑Γ _       = pure nothing
186
+exec↑ O (dist D)             Σ ⊑Γ _       = lift D >>=
177 187
   λ{ (llift x) → pure (just ⟨ x , Σ ⟩) }
178
-exec↑ O (query {q = q} q∈ x) Σ ⊑Γ refl (suc g) =
179
-  exec′ O (O (path ⊑Γ q∈) x) Σ g
180
-exec↑ O (α ↑ Γ′∈) Σ ⊑Γ refl (suc g) = exec↓ O α Σ (⊑-right ⊑Γ Γ′∈) g
181
-exec↑ O (α >>= β) Σ ⊑Γ N≡ (suc g) = (exec↑ O α Σ ⊑Γ N≡ (suc g)) >>= λ{
182
-  (just ⟨ x , Σ′ ⟩) → exec↑ O (β x) Σ′ ⊑Γ N≡ g;
183
-  nothing           → pure nothing }
188
+exec↑ O (query {q = q} q∈ x) Σ ⊑Γ (suc g) = exec′ O (O (path ⊑Γ q∈) x) Σ g
189
+exec↑ O (α ↑ Γ′∈)            Σ ⊑Γ (suc g) = exec↓ O α Σ (⊑-right ⊑Γ Γ′∈) g
190
+exec↑ O (α >>= β)            Σ ⊑Γ (suc g) = (exec↑ O α Σ ⊑Γ (suc g))
191
+  >>= λ{
192
+    (just ⟨ x , Σ′ ⟩) → exec↑ O (β x) Σ′ ⊑Γ g;
193
+    nothing           → pure nothing }

Loading…
Cancel
Save