Browse Source

Fix various parts of the model.

tabularasa
Thomas Kerber 6 months ago
parent
commit
2f8864279a
Signed by: Thomas Kerber <t.kerber@ed.ac.uk> GPG Key ID: 8489B911F9ED617B
4 changed files with 169 additions and 139 deletions
  1. 32
    15
      Yggdrasil/Examples/SecureChannel.agda
  2. 6
    0
      Yggdrasil/Probability.agda
  3. 78
    78
      Yggdrasil/Security.agda
  4. 53
    46
      Yggdrasil/World.agda

+ 32
- 15
Yggdrasil/Examples/SecureChannel.agda View File

@@ -1,7 +1,7 @@
1 1
 module Yggdrasil.Examples.SecureChannel where
2 2
 
3
-open import Data.Bool using (Bool; true; false; if_then_else_)
4
-open import Data.List using (List; []; _∷_)
3
+open import Data.Bool using (Bool; true; false; if_then_else_; _∧_)
4
+open import Data.List using (List; []; _∷_; any)
5 5
 open import Data.Maybe using (Maybe; just; nothing)
6 6
 open import Data.Nat using (_*_)
7 7
 open import Data.Product using (_×_) renaming (_,_ to ⟨_,_⟩)
@@ -13,7 +13,6 @@ open import Yggdrasil.Security
13 13
 open import Yggdrasil.Probability using (pure)
14 14
 
15 15
 open Action↑
16
-open Action↓
17 16
 open Action↯
18 17
 open WorldStates
19 18
 
@@ -85,19 +84,19 @@ open WorldStates
85 84
       []
86 85
     ; adv  = []
87 86
     ; hon  =
88
-      ncall ⊤ (Maybe M) (λ _ → call↓ here tt ↑ there here >>= λ
87
+      ncall ⊤ (Maybe M) (λ _ → call↓ here (there here) tt >>= λ
89 88
         { nothing  → return nothing
90
-        ; (just c) → call↓ here c ↑ here
89
+        ; (just c) → call↓ here here c
91 90
         }) ∷
92 91
       ncall M ⊤ (λ m → let
93
-          dosend = λ pk m → call↓ (there here) ⟨ pk , m ⟩ ↑ here >>= (λ
92
+          doSend = λ pk m → call↓ (there here) here ⟨ pk , m ⟩ >>= (λ
94 93
            { nothing → abort -- The public key we set was refused!
95
-           ; (just c) → call↓ (there here) c ↑ (there here)
94
+           ; (just c) → call↓ (there here) (there here) c
96 95
            })
97 96
         in read >>= λ
98
-          { nothing   → call↓ (there (there here)) tt ↑ here >>= (λ pk →
99
-              write (just pk) >> dosend pk m)
100
-          ; (just pk) → dosend pk m
97
+          { nothing   → call↓ (there (there here)) here tt >>= (λ pk →
98
+              write (just pk) >> doSend pk m)
99
+          ; (just pk) → doSend pk m
101 100
           }) ∷
102 101
       []
103 102
     }
@@ -156,11 +155,29 @@ S-SecureChannel {ℓ} M C PK L l pk?= c?= = record
156 155
     }
157 156
 
158 157
 secure : {ℓ : Level} → (M C PK L : Set ℓ) → (l : M → L) →
159
-  (pk?= : PK → PK → Bool) → (c?= : C → C → Bool) → 
158
+  (pk?= : PK → PK → Bool) → (c?= : C → C → Bool) → (m?= : M → M → Bool) →
160 159
   πᵢ-SecureChannel M L l ≃ πᵣ-SecureChannel M C PK L l pk?= c?=
161
-secure {ℓ} M C PK L l pk?= c?= = record
162
-  { sim-gas    = λ _ → 1000
163
-  ; gas-map    = _* 10
160
+secure {ℓ} M C PK L l pk?= c?= m?= = record
161
+  { gas-map    = _* 2
164 162
   ; simulator  = S-SecureChannel M C PK L l pk?= c?=
165
-  ; proof      = λ{ g (strat α O) → ? }
163
+  ; invariant  = λ
164
+    { ⟨ ⟨ stnode (just m) [] , lift true ⟩ ,
165
+        stnode (just pk) (
166
+          stnode (just ⟨ pk′ , stlog ⟩) [] ∷
167
+          stnode (just c) [] ∷
168
+          []
169
+        ) ⟩ → pk?= pk pk′ ∧ any (λ{ ⟨ m′ , c′ ⟩ → m?= m m′ ∧ c?= c c′ }) stlog
170
+    ; ⟨ ⟨ stnode nothing [] , lift false ⟩ ,
171
+        stnode nothing (
172
+          stnode nothing [] ∷
173
+          stnode nothing [] ∷
174
+          []
175
+        ) ⟩ → true
176
+    ; _ → false
177
+    }
178
+  ; base-case  = refl
179
+  ; proof      = λ
180
+    { g σ O (call↓ ∈Γ x)    Σ inv → ⟨ ? , ⟨ ? , ? ⟩ ⟩
181
+    ; g σ O (call↯ ∈Γ Γ⊑ x) Σ inv → ⟨ ? , ⟨ ? , ? ⟩ ⟩
182
+    }
166 183
   }

+ 6
- 0
Yggdrasil/Probability.agda View File

@@ -54,6 +54,12 @@ data Dist {ℓ : Level} : Set ℓ → Set (lsuc ℓ) where
54 54
   sample : ∀ {n : ℕ} → Dist (PrFin {ℓ} n)
55 55
   _>>=_ : ∀ {A B : Set ℓ} → Dist A → (A → Dist B) → Dist B
56 56
 
57
+dmap : ∀ {ℓ A B} → (A → B) → Dist {ℓ} A → Dist {ℓ} B
58
+dmap f d = d >>= (λ x → pure (f x))
59
+
60
+_*_ : ∀ {ℓ A B} → Dist {ℓ} A → Dist {ℓ} B → Dist {ℓ} (A × B)
61
+a * b = a >>= (λ x → b >>= (λ y → pure ⟨ x , y ⟩))
62
+
57 63
 lift : {ℓ₁ ℓ₂ : Level} {A : Set ℓ₁} → Dist A → Dist (Lift ℓ₂ A)
58 64
 lift (pure x) = pure (llift x)
59 65
 lift {ℓ₁} {ℓ₂} (sample {n = n}) = sample {n = n} >>=

+ 78
- 78
Yggdrasil/Security.agda View File

@@ -9,15 +9,15 @@ open import Data.List using (_∷_; []; map)
9 9
 open import Data.Product using (_×_; Σ; Σ-syntax; proj₁; proj₂; ∃; ∃-syntax) renaming (_,_ to ⟨_,_⟩)
10 10
 open import Data.Nat using (ℕ; zero; suc; _≤_; _^_; _+_)
11 11
 open import Data.Integer using (ℤ)
12
-open import Data.Maybe using (Maybe) renaming (map to mmap)
12
+open import Data.Maybe using (Maybe; just; nothing) renaming (map to mmap)
13 13
 open import Data.Rational using (ℚ)
14 14
 open import Function using (_∘_)
15 15
 open import Level using (Level; Lift; lift) renaming (suc to lsuc)
16 16
 open import Relation.Binary.PropositionalEquality using (_≡_; _≢_; refl; cong; sym)
17
-open import Relation.Nullary.Decidable using (fromWitnessFalse)
17
+open import Relation.Nullary.Decidable using (True; fromWitnessFalse)
18 18
 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; ⊤; tt; Action↓; exec↓)
20
-open import Yggdrasil.Probability using (Dist; _>>=_; pure; _≈[_]≈_)
19
+open import Yggdrasil.World using (WorldType; WorldState; World; Oracle; Call; Strategy; Node; weaken; call; call↓; stnode; _∷_; []; _⊑_; Query; _∈↑_; abort; dist; _>>=_; call↯; query; path; strat; ⊤; tt; Action⊤; read; write; exec⊤; Result; out-of-gas; result; rmap; T)
20
+open import Yggdrasil.Probability as Pr using (Dist; _>>=_; pure; _≈[_]≈_; dmap; _*_; Pr[_[_]]≡_)
21 21
 open import Yggdrasil.Rational using (_÷_)
22 22
 open WorldType
23 23
 open Node
@@ -47,8 +47,6 @@ data Action↯ {ℓ : Level} (σ : Set ℓ) (Γᵢ Γᵣ : WorldType ℓ)
47 47
   _>>=_ : ∀ {A B} → Action↯ σ Γᵢ Γᵣ {hon-≡} A → (A → Action↯ σ Γᵢ Γᵣ {hon-≡} B) →
48 48
     Action↯ σ Γᵢ Γᵣ B
49 49
 
50 50
 record Simulator {ℓ : Level} (πᵢ πᵣ : World ℓ) : Set (lsuc ℓ) where
51 51
   Γᵢ : WorldType ℓ
52 52
   Γᵢ = World.Γ πᵢ
@@ -62,60 +60,55 @@ record Simulator {ℓ : Level} (πᵢ πᵣ : World ℓ) : Set (lsuc ℓ) where
62 60
       (x : Call.A f) → Action↯ state Γᵢ Γᵣ {hon-≡} (Call.B f x)
63 61
     query-map : ∀ {q} → q ∈↑ Γᵢ → (x : Query.A q) → Action↯ state Γᵢ Γᵣ {hon-≡} (Query.B q x)
64 62
 
65
-Actionᵣ⇒Actionᵢ : ∀ {ℓ : Level} {πᵢ πᵣ : World ℓ} {A : Set ℓ} →
66
-  (S : Simulator πᵢ πᵣ) → Oracle (World.Γ πᵣ) → Simulator.state S → ℕ →
67
-  Action (World.Γ πᵣ) A → Action (World.Γ πᵢ) (A × Simulator.state S)
68
-Action↯⇒Action : ∀ {ℓ : Level} {πᵢ πᵣ : World ℓ} {A : Set ℓ} →
69
-  (S : Simulator πᵢ πᵣ) → Oracle (World.Γ πᵣ) → Simulator.state S → ℕ →
63
+Actionᵣ⇒Actionᵢ : ∀ {ℓ : Level} {πᵢ πᵣ : World ℓ} {A : Set ℓ} {σ} 
64
+  (S : Simulator πᵢ πᵣ) → Oracle σ (World.Γ πᵣ) → ℕ →
65
+  Action⊤ σ (World.Γ πᵣ) A → Action⊤ (σ × Simulator.state S) (World.Γ πᵢ) A
66
+Action↯⇒Action : ∀ {ℓ : Level} {πᵢ πᵣ : World ℓ} {A : Set ℓ} {σ} 
67
+  (S : Simulator πᵢ πᵣ) → Oracle σ (World.Γ πᵣ) → ℕ →
70 68
   Action↯ (Simulator.state S) (World.Γ πᵢ) (World.Γ πᵣ) {Simulator.hon-≡ S} A →
71
-  Action (World.Γ πᵢ) (A × Simulator.state S)
69
+  Action⊤ (σ × Simulator.state S) (World.Γ πᵢ) A
72 70
 
73 71
 private
74
-  with-state : ∀ {ℓ Γ A Σ} → Σ → A → Action {ℓ} Γ (A × Σ)
75
-  with-state σ x = dist (pure ⟨ x , σ ⟩)
76
-
77
-  without-state : ∀ {ℓ Γ} {A Σ : Set ℓ} → (A × Σ) → Action {ℓ} Γ A
78
-  without-state ⟨ x , _ ⟩ = dist (pure x)
79
-
80
-Actionᵣ⇒Actionᵢ _ _ _ zero _ = abort
81
-Actionᵣ⇒Actionᵢ S O σ (suc g) ((call↓ {f} ∈Γᵣ x) ↑) with map≡-implies-∈≡  
72
+  amap : ∀ {ℓ S Γ A B} → (A → B) → Action⊤ {ℓ} S Γ A → Action⊤ {ℓ} S Γ B
73
+  amap f α = α >>= (λ x → dist (pure (f x)))
74
+Actionᵣ⇒Actionᵢ S O g read = amap proj₁ read
75
+Actionᵣ⇒Actionᵢ S O g (write σ₁) = read >>= λ { ⟨ _ , σ₂ ⟩ → write ⟨ σ₁ , σ₂ ⟩ }
76
+Actionᵣ⇒Actionᵢ S O g (call↓ {f} ∈Γᵣ x) with map≡-implies-∈≡  
82 77
     (sym (Simulator.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
78
+... | ⟨ _ , ⟨ ∈Γᵢ , refl ⟩ ⟩ = call↓ ∈Γᵢ x
79
+Actionᵣ⇒Actionᵢ _ _ _ abort = abort
80
+Actionᵣ⇒Actionᵢ _ _ _ (dist D) = dist D
81
+Actionᵣ⇒Actionᵢ S O g (call↯ ∈Γ Γ⊑ x) = Action↯⇒Action S O g
87 82
   (Simulator.call↯-map S ∈Γ Γ⊑ x)
88
-Actionᵣ⇒Actionᵢ S O σ (suc g) (α >>= β) = (Actionᵣ⇒Actionᵢ S O σ (suc g) α) >>=
89
-  λ{ ⟨ x , σ′ ⟩ → Actionᵣ⇒Actionᵢ S O σ′ g (β x) }
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
105
-  (Simulator.query-map S ∈Γ x) >>= without-state
83
+Actionᵣ⇒Actionᵢ S O g (α >>= β) = (Actionᵣ⇒Actionᵢ S O g α) >>=
84
+  Actionᵣ⇒Actionᵢ S O g ∘ β
85
+
86
+Action↯⇒Action S O g       read            = amap proj₂ read
87
+Action↯⇒Action S O g       (write σ₂)      = read >>= λ { ⟨ σ₁ , _ ⟩ → write ⟨ σ₁ , σ₂ ⟩ }
88
+Action↯⇒Action S O zero    (query ∈Γ Γ⊑ x) = abort
89
+Action↯⇒Action S O (suc g) (query ∈Γ Γ⊑ x) = Actionᵣ⇒Actionᵢ S O g (O (path Γ⊑ ∈Γ) x)
90
+Action↯⇒Action S O g       abort           = abort
91
+Action↯⇒Action S O g       (dist D)        = dist D
92
+Action↯⇒Action S O g       (call↯ ∈Γ Γ⊑ x) = call↯ ∈Γ Γ⊑ x
93
+Action↯⇒Action S O g       (α >>= β)       = (Action↯⇒Action S O g α) >>=
94
+  Action↯⇒Action S O g ∘ β
95
+
96
+extract-oracle : ∀ {ℓ σ πᵢ πᵣ} → (S : Simulator {ℓ} πᵢ πᵣ) →
97
+  Oracle σ (World.Γ πᵣ) → ℕ → Oracle (σ × Simulator.state S) (World.Γ πᵢ)
98
+extract-oracle S O g ∈Γ x = Action↯⇒Action S O g
99
+  (query-map S ∈Γ x)
106 100
   where open Simulator
107 101
 
108
-simulated-strategy : ∀ {ℓ πᵢ πᵣ A} → Simulator {ℓ} πᵢ πᵣ →
109
-  Strategy (World.Γ πᵣ) A → ℕ → Strategy (World.Γ πᵢ) A
110
-simulated-strategy S str g = strat
111
-  (Actionᵣ⇒Actionᵢ S (oracle str) (initial S) g (init str) >>= without-state)
112
-  (extract-oracle S (oracle str) g)
113
-  where open Simulator
102
+data InterestingAction {ℓ : Level} (Γ : WorldType ℓ) : Set ℓ → Set (lsuc ℓ) where
103
+  call↓ : ∀ {f} → f ∈ (hon Γ) → (x : Call.A f) → InterestingAction Γ (Call.B f x)
104
+  call↯ : ∀ {Γ′} {f : Call ℓ (node Γ′)} → f ∈ (adv Γ′) → Γ′ ⊑ Γ →
105
+    (x : Call.A f) → InterestingAction Γ (Call.B f x)
106
+
107
+toAction : ∀ {ℓ Γ A S} → InterestingAction {ℓ} Γ A → Action⊤ {ℓ} S Γ A
108
+toAction (call↓ f∈ x) = call↓ f∈ x
109
+toAction (call↯ ∈Γ Γ⊑ x) = call↯ ∈Γ Γ⊑ x
114 110
 
115
-record Adv[_,_]≤_ {ℓ : Level} (πᵢ πᵣ : World ℓ) (ε : ℚ) :
111
+record _≃_ {ℓ : Level} (πᵢ πᵣ : World ℓ) :
116 112
     Set (lsuc (lsuc ℓ)) where
117 113
   Γᵣ : WorldType ℓ
118 114
   Γᵣ = World.Γ πᵣ
@@ -126,43 +119,38 @@ record Adv[_,_]≤_ {ℓ : Level} (πᵢ πᵣ : World ℓ) (ε : ℚ) :
126 119
   Σᵢ : WorldState Γᵢ
127 120
   Σᵢ = World.Σ πᵢ
128 121
   field
129
-    sim-gas : ℕ
130 122
     gas-map : ℕ → ℕ
131 123
     simulator : Simulator πᵢ πᵣ
132
-    invariant : (WorldState Γᵢ × WorldState Γᵣ) × Simulator.state simulator → Bool
133
-    base-case : invariant ⟨ ⟨ Σᵢ , Σᵣ ⟩ , Simulator.initial simulator ⟩ ≡ true
134
-    proof : (g : ℕ) → (O : Oracle Γᵣ) → ∀ {A} → (α : Action↓ Γᵣ A) →
135
-      (Σ : ((WorldState Γᵢ × WorldState Γᵣ) × Simulator.state simulator)) →
136
-      invariant Σ ≡ true → 
137
-      let
138
-        dᵢ = exec↓ (extract-oracle simulator O sim-gas)
139
-          (Actionᵣ⇒Actionᵢ simulator O (proj₂ Σ) sim-gas α)
140
-          (proj₁ (proj₁ Σ)) here g
141
-      in ?
142
-      
143
-
144
---Actionᵣ⇒Actionᵢ : ∀ {ℓ : Level} {πᵢ πᵣ : World ℓ} {A : Set ℓ} →
145
-
146
-
147
-
148
-_≃_ : {ℓ : Level} → (πᵢ πᵣ : World ℓ) → Set (lsuc (lsuc ℓ))
149
-πᵢ ≃ πᵣ = Adv[ πᵢ , πᵣ ]≤ 0
150
-
151
-private
152
-  +-≡0ˡ : ∀ {n m} → n + m ≡ 0 → n ≡ 0
153
-  +-≡0ˡ {zero} _ = refl
154
-  +-≡0ˡ {suc n} ()
155
-
156
-  ^≢0 : ∀ {n m} → (suc n) ^ m ≢ 0
157
-  ^≢0 {n} {zero} ()
158
-  ^≢0 {n} {suc m} n^sm≡0 = ^≢0 {n} {m} (+-≡0ˡ n^sm≡0)
159
-
160
-_≈_ : {ℓ : Level} → (πᵢ πᵣ : ℕ → World ℓ) → ℕ → Set (lsuc (lsuc ℓ))
161
-_≈_ πᵢ πᵣ κ = Adv[ πᵢ κ , πᵣ κ ]≤ (_÷_ 1 (2 ^ κ) {fromWitnessFalse (^≢0 {1} {κ})})
124
+    invariant : ((WorldState Γᵢ × Simulator.state simulator) × WorldState Γᵣ) → Bool
125
+    base-case : invariant ⟨ ⟨ Σᵢ , Simulator.initial simulator ⟩ , Σᵣ ⟩ ≡ true
126
+    proof : (g : ℕ) →
127
+      ∀ {S} →
128
+      (σ : S) →
129
+      (O : Oracle S Γᵣ) →
130
+      ∀ {A} →
131
+      (α : InterestingAction Γᵣ A) →
132
+      (Σ : (WorldState Γᵢ × Simulator.state simulator) × WorldState Γᵣ) →
133
+      invariant Σ ≡ true →
134
+        let
135
+          Dᵢ = exec⊤ (extract-oracle simulator O (gas-map g))
136
+            (Actionᵣ⇒Actionᵢ simulator O (gas-map g) (toAction α))
137
+            ⟨ ⟨ σ , proj₂ (proj₁ Σ) ⟩ , proj₁ (proj₁ Σ) ⟩ (gas-map g)
138
+          Dᵣ = exec⊤ O (toAction α) ⟨ σ , proj₂ Σ ⟩ g
139
+          Dₛ = dmap {B = Maybe ((WorldState Γᵢ × Simulator.state simulator) × WorldState Γᵣ)} (λ
140
+            { ⟨ abort      , _          ⟩ → nothing
141
+            ; ⟨ out-of-gas , _          ⟩ → nothing
142
+            ; ⟨ _          , abort      ⟩ → nothing
143
+            ; ⟨ _          , out-of-gas ⟩ → nothing
144
+            ; ⟨ result ⟨ _ , ⟨ ⟨ _ , σ ⟩ , Σᵢ ⟩ ⟩
145
+              , result ⟨ _ , ⟨ _ , Σᵣ       ⟩ ⟩ ⟩ →
146
+                just ⟨ ⟨ Σᵢ , σ ⟩ , Σᵣ ⟩
147
+            }) (Dᵢ * Dᵣ)
148
+        in
149
+        -- The results are indistinguishable.
150
+        (dmap (rmap (λ x → lift (proj₁ x))) Dᵢ Pr.≃ dmap (rmap (λ x → lift (proj₁ x))) Dᵣ) ×
151
+        -- The resulting environment states are indistinguishable.
152
+        (dmap (rmap (λ x → lift (proj₁ (proj₁ (proj₂ x))))) Dᵢ
153
+            Pr.≃
154
+         dmap (rmap (λ x → lift (proj₁ (proj₂ x)))) Dᵣ) ×
155
+        -- And any resulting system states are in the invariant.
156
+        (Pr[ (λ { nothing → ⊤; (just x) → T (invariant x) }) [ Dₛ ]]≡ 1)

+ 53
- 46
Yggdrasil/World.agda View File

@@ -1,11 +1,11 @@
1 1
 module Yggdrasil.World where
2 2
 
3
-open import Data.Bool using (Bool)
3
+open import Data.Bool using (Bool; true; false)
4 4
 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₁; 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)
@@ -16,6 +16,12 @@ open import Yggdrasil.List using (_∈_; here; there)
16 16
 data ⊤ {ℓ : Level} : Set ℓ where
17 17
   tt : ⊤
18 18
 
19
+data ⊥ {ℓ : Level} : Set ℓ where
20
+
21
+T : ∀ {ℓ} → Bool → Set ℓ
22
+T true = ⊤
23
+T false = ⊥
24
+
19 25
 record Query (ℓ : Level) : Set (lsuc ℓ) where
20 26
   constructor mkquery
21 27
   field
@@ -28,8 +34,7 @@ mknquery A B = mkquery A (λ _ → B)
28 34
 record Node (ℓ : Level) : Set (lsuc ℓ)
29 35
 record WorldType (ℓ : Level) : Set (lsuc ℓ)
30 36
 data Action↑ {ℓ : Level} (N : Node ℓ) : Set ℓ → Set (lsuc ℓ)
31
-data Action↓ {ℓ : Level} (Γ : WorldType ℓ) : Set ℓ → Set (lsuc ℓ)
32
-data Action {ℓ : Level} (Γ : WorldType ℓ) : Set ℓ → Set (lsuc ℓ)
37
+data Action⊤ {ℓ : Level} (S : Set ℓ) (Γ : WorldType ℓ) : Set ℓ → Set (lsuc ℓ)
33 38
 
34 39
 data WorldState {ℓ : Level} (Γ : WorldType ℓ) : Set (lsuc ℓ)
35 40
 data WorldStates {ℓ : Level} : List (WorldType ℓ) → Set (lsuc ℓ)
@@ -44,6 +49,7 @@ record Node ℓ where
44 49
 
45 50
 open Node
46 51
 
52
+
47 53
 record Call (ℓ : Level) (N : Node ℓ) : Set (lsuc ℓ) where
48 54
   inductive
49 55
   constructor call
@@ -80,24 +86,24 @@ data _⊑_ {ℓ : Level} : (Γ₁ Γ₂ : WorldType ℓ) → Set (lsuc ℓ) wher
80 86
 ⊑-right : ∀ {ℓ} {Γ₁ Γ₂ Γ₃ : WorldType ℓ} → Γ₂ ⊑ Γ₃ → Γ₁ ∈ chld (node Γ₂) → Γ₁ ⊑ Γ₃
81 87
 ⊑-right Γ⊑ ∈Γ = ⊑-trans (there ∈Γ here) Γ⊑
82 88
 
83
-data Action {ℓ} Γ where
84
-  _↑ : ∀ {A} → Action↓ {ℓ} Γ A → Action {ℓ} Γ A
85
-  abort : ∀ {A} → Action Γ A
86
-  dist  : ∀ {A} → Dist A → Action Γ A
87
-  call↯ : ∀ {Γ′} {f : Call ℓ (node Γ′)} → f ∈ (adv Γ′) → Γ′ ⊑ Γ → (x : Call.A f) →
88
-    Action Γ (Call.B f x)
89
-  _>>=_ : ∀ {A B} → Action Γ A → (A → Action Γ B) → Action Γ B
90
-
91
-data Action↓ {ℓ} Γ where
92
-  call↓ : ∀ {f} → f ∈ (hon Γ) → (x : Call.A f) → Action↓ Γ (Call.B f x)
89
+data Action⊤ {ℓ} S Γ where
90
+  read  : Action⊤ S Γ S
91
+  write : S → Action⊤ S Γ ⊤
92
+  call↓ : ∀ {f} → f ∈ (hon Γ) → (x : Call.A f) → Action⊤ S Γ (Call.B f x)
93
+  abort : ∀ {A} → Action⊤ S Γ A
94
+  dist  : ∀ {A} → Dist A → Action⊤ S Γ A
95
+  call↯ : ∀ {Γ′} {f : Call ℓ (node Γ′)} → f ∈ (adv Γ′) → Γ′ ⊑ Γ →
96
+    (x : Call.A f) → Action⊤ S Γ (Call.B f x)
97
+  _>>=_ : ∀ {A B} → Action⊤ S Γ A → (A → Action⊤ S Γ B) → Action⊤ S Γ B
93 98
 
94 99
 data Action↑ {ℓ} N where
95 100
   read  : Action↑ N (state N)
96 101
   write : state N → Action↑ N ⊤
102
+  call↓ : ∀ {Γ f} → f ∈ (hon Γ) → Γ ∈ chld N → (x : Call.A f) →
103
+    Action↑ N (Call.B f x)
97 104
   abort : ∀ {A} → Action↑ N A
98 105
   dist  : ∀ {A} → Dist A → Action↑ N A
99 106
   query : ∀ {q} → q ∈ qry N → (x : Query.A q) → Action↑ N (Query.B q x)
100
-  _↑_   : ∀ {Γ A} → Action↓ Γ A → Γ ∈ chld N → Action↑ N A
101 107
   _>>=_ : ∀ {A B} → Action↑ N A → (A → Action↑ N B) → Action↑ N B
102 108
 
103 109
 -- TODO: build full monad instances of all actions, and Dist -- once I figure
@@ -125,14 +131,17 @@ record World (ℓ : Level) : Set (lsuc ℓ) where
125 131
 data _∈↑_ {ℓ : Level} (q : Query ℓ) (Γ : WorldType ℓ) : Set (lsuc ℓ) where
126 132
   path : ∀ {Γ′} → Γ′ ⊑ Γ → q ∈ qry (node Γ′) → q ∈↑ Γ
127 133
 
128
-Oracle : ∀ {ℓ} → WorldType ℓ → Set (lsuc ℓ)
129
-Oracle Γ = ∀ {q} → q ∈↑ Γ → (x : Query.A q) → Action Γ (Query.B q x)
134
+Oracle : ∀ {ℓ} → Set ℓ → WorldType ℓ → Set (lsuc ℓ)
135
+Oracle S Γ = ∀ {q} → q ∈↑ Γ → (x : Query.A q) → Action⊤ S Γ (Query.B q x)
130 136
 
131
-record Strategy {ℓ : Level} (Γ : WorldType ℓ) (A : Set ℓ) : Set (lsuc ℓ) where
137
+record Strategy {ℓ : Level} (Γ : WorldType ℓ) (A : Set ℓ) {S : Set ℓ} : Set (lsuc ℓ) where
132 138
   constructor strat
133 139
   field
134
-    init : Action Γ A
135
-    oracle : Oracle Γ
140
+    state : S
141
+    init : Action⊤ S Γ A
142
+    oracle : Oracle S Γ
143
+
144
+
136 145
 
137 146
 get : ∀ {ℓ Γ₁ Γ₂} → Γ₁ ⊑ Γ₂ → WorldState {ℓ} Γ₂ → state (node Γ₁)
138 147
 get here (stnode Σ _) = Σ
@@ -162,41 +171,39 @@ rmap _ abort = abort
162 171
 rmap _ out-of-gas = out-of-gas
163 172
 rmap f (result x) = result (f x)
164 173
 
165
-exec : ∀ {ℓ Γ A} → Strategy {ℓ} Γ A → WorldState {ℓ} Γ → ℕ →
174
+exec : ∀ {ℓ S Γ A} → Strategy {ℓ} Γ A {S} → WorldState {ℓ} Γ → ℕ →
166 175
   Dist (Result (Lift (lsuc ℓ) A))
167
-exec : ∀ {ℓ Γ A} → Oracle Γ → Action Γ A → WorldState {ℓ} Γ → ℕ →
168
-  Dist (Result (A × WorldState {ℓ} Γ))
169
-exec↓ : ∀ {ℓ Γ₁ Γ₂ A} → Oracle Γ₁ → Action↓ Γ₂ A → WorldState {ℓ} Γ₁ →
170
-  Γ₂ ⊑ Γ₁ → ℕ → Dist (Result (A × WorldState {ℓ} Γ₁))
171
-exec↑ : ∀ {ℓ Γ₁ Γ₂ A} → Oracle Γ₁ → Action↑ (node Γ₂) A → WorldState {ℓ} Γ₁ →
172
-  Γ₂ ⊑ Γ₁ → ℕ → Dist (Result (A × WorldState {ℓ} Γ₁))
176
+exec⊤ : ∀ {ℓ S Γ A} → Oracle S Γ → Action⊤ S Γ A → S × WorldState {ℓ} Γ → ℕ →
177
+  Dist (Result (A × (S × WorldState {ℓ} Γ)))
178
+exec↑ : ∀ {ℓ S Γ₁ Γ₂ A} → Oracle S Γ₁ → Action↑ (node Γ₂) A →
179
+  (S × WorldState {ℓ} Γ₁) → Γ₂ ⊑ Γ₁ → ℕ → Dist (Result (A × (S × WorldState {ℓ} Γ₁)))
173 180
 
174 181
 -- NOTE: Gas is only used for termination here, it is NOT a computational model.
175
-exec (strat α O) Σ g = (exec O α Σ g) >>= (pure ∘ rmap (llift ∘ proj₁))
182
+exec (strat S α O) Σ g = (exec O α ⟨ S , Σ g) >>= (pure ∘ rmap (llift ∘ proj₁))
176 183
 
177
-exec O α                       Σ zero    = pure out-of-gas
178
-exec O (α ↑)                   Σ g       = exec↓ O α Σ here g
179
-exec O abort                   Σ g       = pure abort
180
-exec O (dist D)                Σ (suc g) = lift D >>= λ{
184
+exec⊤ O read                    Σ g       = pure (result ⟨ proj₁ Σ , Σ ⟩)
185
+exec⊤ O (write σ)               Σ g       = pure (result ⟨ tt , ⟨ σ , proj₂ Σ ⟩ ⟩)
186
+exec⊤ O (call↓ {f = f} ∈Γ x)    Σ g       = exec↑ O (Call.δ f x) Σ here g
187
+exec⊤ O abort                   Σ g       = pure abort
188
+exec⊤ O (dist D)                Σ g       = lift D >>= λ{
181 189
   (llift x) → pure (result ⟨ x , Σ ⟩ ) }
182
-exec O (call↯ {f = f} f∈ ⊑Γ x) Σ (suc g) = exec↑ O (Call.δ f x) Σ ⊑Γ g
183
-exec O (α >>= β)               Σ (suc g) = (exec O α Σ (suc g)) >>= λ{
184
-  (result ⟨ x , Σ′ ⟩) → exec O (β x) Σ′ g ;
190
+exec⊤ O (call↯ {f = f} f∈ ⊑Γ x) Σ g       = exec↑ O (Call.δ f x) Σ ⊑Γ g
191
+exec⊤ O (α >>= β)               Σ g       = (exec⊤ O α Σ g) >>= λ{
192
+  (result ⟨ x , Σ′ ⟩) → exec O (β x) Σ′ g ;
185 193
   abort               → pure abort        ;
186 194
   out-of-gas          → pure out-of-gas   }
187 195
 
188
-exec↓ _ _                    _ _  zero    = pure out-of-gas
189
-exec↓ O (call↓ {f = f} f∈ x) Σ ⊑Γ (suc g) = exec↑ O (Call.δ f x) Σ ⊑Γ g
190
-
191
-exec↑ O α                    Σ ⊑Γ zero    = pure out-of-gas
192
-exec↑ O read                 Σ ⊑Γ _       = pure (result ⟨ get ⊑Γ Σ , Σ ⟩)
193
-exec↑ O (write σ)            Σ ⊑Γ _       = pure (result ⟨ tt , set ⊑Γ Σ σ ⟩)
194
-exec↑ O abort                Σ ⊑Γ _       = pure abort
195
-exec↑ O (dist D)             Σ ⊑Γ _       = lift D >>=
196
+exec↑ O read                    Σ ⊑Γ g       = pure (result
197
+  ⟨ get ⊑Γ (proj₂ Σ) , Σ ⟩)
198
+exec↑ O (write σ)               Σ ⊑Γ g       = pure (result
199
+  ⟨ tt , ⟨ proj₁ Σ , set ⊑Γ (proj₂ Σ) σ ⟩ ⟩)
200
+exec↑ O abort                   Σ ⊑Γ g       = pure abort
201
+exec↑ O (dist D)                Σ ⊑Γ g       = lift D >>=
196 202
   λ{ (llift x) → pure (result ⟨ x , Σ ⟩) }
197
-exec↑ O (query {q = q} q∈ x) Σ ⊑Γ (suc g) = exec O (O (path ⊑Γ q∈) x) Σ g
198
-exec↑ O (α ↑ Γ′∈)            Σ ⊑Γ (suc g) = exec↓ O α Σ (⊑-right ⊑Γ Γ′∈) g
199
-exec↑ O (α >>= β)            Σ ⊑Γ (suc g) = (exec↑ O α Σ ⊑Γ (suc g))
203
+exec↑ O (query {q = q} q∈ x)    Σ ⊑Γ zero    = pure out-of-gas
204
+exec↑ O (query {q = q} q∈ x)    Σ ⊑Γ (suc g) = exec⊤ O (O (path ⊑Γ q∈) x) Σ g
205
+exec↑ O (call↓ {f = f} ∈Γ Γ∈ x) Σ ⊑Γ g       = exec↑ O (Call.δ f x) Σ (⊑-right ⊑Γ Γ∈) g
206
+exec↑ O (α >>= β)               Σ ⊑Γ g       = (exec↑ O α Σ ⊑Γ g)
200 207
   >>= λ{
201 208
     (result ⟨ x , Σ′ ⟩) → exec↑ O (β x) Σ′ ⊑Γ g ;
202 209
     abort               → pure abort            ;

Loading…
Cancel
Save