Browse Source

Attempt to move closer to actual proofs.

tabularasa
Thomas Kerber 6 months ago
parent
commit
18797eea39
Signed by: Thomas Kerber <t.kerber@ed.ac.uk> GPG Key ID: 8489B911F9ED617B
4 changed files with 96 additions and 18 deletions
  1. 77
    3
      Yggdrasil/Examples/SecureChannel.agda
  2. 7
    2
      Yggdrasil/Probability.agda
  3. 1
    1
      Yggdrasil/Security.agda
  4. 11
    12
      Yggdrasil/World.agda

+ 77
- 3
Yggdrasil/Examples/SecureChannel.agda View File

@@ -3,7 +3,8 @@ module Yggdrasil.Examples.SecureChannel where
3 3
 open import Data.Bool using (Bool; true; false; if_then_else_; _∧_)
4 4
 open import Data.List using (List; []; _∷_; any)
5 5
 open import Data.Maybe using (Maybe; just; nothing)
6
-open import Data.Nat using (_*_)
6
+open import Data.Nat using (_*_; zero; suc)
7
+open import Data.Empty using (⊥-elim)
7 8
 open import Data.Product using (_×_) renaming (_,_ to ⟨_,_⟩)
8 9
 open import Level using (Level; Lift; lift)
9 10
 open import Relation.Binary.PropositionalEquality using (refl)
@@ -177,7 +178,80 @@ secure {ℓ} M C PK L l pk?= c?= m?= = record
177 178
     }
178 179
   ; base-case  = refl
179 180
   ; proof      = λ
180
-    { g σ O (call↓ ∈Γ x)    Σ inv → ⟨ ? , ⟨ ? , ? ⟩ ⟩
181
-    ; g σ O (call↯ ∈Γ Γ⊑ x) Σ inv → ⟨ ? , ⟨ ? , ? ⟩ ⟩
181
+    { g σ O (call↓ here tt) ⟨
182
+        ⟨ stnode (just m) [] , lift true ⟩ ,
183
+        stnode (just pk′) (
184
+          stnode (just ⟨ pk , log ⟩) [] ∷
185
+          stnode (just c) [] ∷
186
+          [])
187
+      ⟩ inv → ⟨ ? , ⟨ ? , ? ⟩ ⟩ 
188
+    ; g σ O (call↓ here tt) ⟨
189
+        ⟨ stnode nothing [] , lift false ⟩ ,
190
+        stnode nothing (
191
+          stnode nothing [] ∷
192
+          stnode nothing [] ∷
193
+          [])
194
+      ⟩ inv → ⟨ ? , ⟨ ? , ? ⟩ ⟩ 
195
+    ; zero σ O (call↓ (there here) m) ⟨
196
+        ⟨ stnode (just m′) [] , lift true ⟩ ,
197
+        stnode (just pk′) (
198
+          stnode (just ⟨ pk , log ⟩) [] ∷
199
+          stnode (just c) [] ∷
200
+          [])
201
+      ⟩ inv → ⟨ ? , ⟨ ? , ? ⟩ ⟩ 
202
+    ; (suc g) σ O (call↓ (there here) m) ⟨
203
+        ⟨ stnode (just m′) [] , lift true ⟩ ,
204
+        stnode (just pk′) (
205
+          stnode (just ⟨ pk , log ⟩) [] ∷
206
+          stnode (just c) [] ∷
207
+          [])
208
+      ⟩ inv → ⟨ ? , ⟨ ? , ? ⟩ ⟩ 
209
+    ; g σ O (call↓ (there here) m) ⟨
210
+        ⟨ stnode nothing [] , lift false ⟩ ,
211
+        stnode nothing (
212
+          stnode nothing [] ∷
213
+          stnode nothing [] ∷
214
+          [])
215
+      ⟩ inv → ⟨ ? , ⟨ ? , ? ⟩ ⟩ 
216
+    ; g σ O _ ⟨ ⟨ stnode nothing [] , lift true ⟩ , _ ⟩ inv → ⊥-elim ?
217
+    ; g σ O _ ⟨
218
+        ⟨ stnode _ [] , lift true ⟩ ,
219
+        stnode nothing _
220
+      ⟩ ()
221
+    ; g σ O _ ⟨
222
+        ⟨ stnode _ [] , lift true ⟩ ,
223
+        stnode _ (stnode nothing [] ∷ _)
224
+      ⟩ ()
225
+    ; g σ O _ ⟨
226
+        ⟨ stnode _ [] , lift true ⟩ ,
227
+        stnode _ (
228
+          stnode _ [] ∷
229
+          stnode nothing [] ∷
230
+          [])
231
+      ⟩ ()
232
+    ; g σ O _ ⟨ ⟨ stnode (just _) [] , lift false ⟩ , _ ⟩ inv → ⊥-elim ?
233
+    ; g σ O _ ⟨
234
+        ⟨ stnode _ [] , lift false ⟩ ,
235
+        stnode (just _) _
236
+      ⟩ ()
237
+    ; g σ O _ ⟨
238
+        ⟨ stnode _ [] , lift false ⟩ ,
239
+        stnode _ (stnode (just _) [] ∷ _)
240
+      ⟩ ()
241
+    ; g σ O _ ⟨
242
+        ⟨ stnode _ [] , lift false ⟩ ,
243
+        stnode _ (
244
+          stnode _ [] ∷
245
+          stnode (just _) [] ∷
246
+          [])
247
+      ⟩ ()
248
+    ; g σ O (call↓ (there (there ())) x) Σ inv
249
+    ; g σ O (call↯ () here x) Σ inv
250
+    ; g σ O (call↯ () (there here here) x) Σ inv
251
+    ; g σ O (call↯ () (there (there here) here) x) Σ inv
252
+    ; g σ O (call↯ ∈Γ (there (there (there ())) here) x) Σ inv
253
+    ; g σ O (call↯ ∈Γ (there here (there () Γ⊑)) x) Σ inv
254
+    ; g σ O (call↯ ∈Γ (there (there here) (there () Γ⊑)) x) Σ inv
255
+    ; g σ O (call↯ ∈Γ (there (there (there ())) (there x₂ Γ⊑)) x) Σ inv
182 256
     }
183 257
   }

+ 7
- 2
Yggdrasil/Probability.agda View File

@@ -54,11 +54,16 @@ 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
+_>>=′_ : ∀ {ℓ A B} → Dist {ℓ} A → (A → Dist {ℓ}  B) → Dist {ℓ} B
58
+pure x >>=′ y = y x
59
+sample >>=′ y = sample >>= y
60
+(a >>= b) >>=′ y = (a >>= b) >>= y
61
+
57 62
 dmap : ∀ {ℓ A B} → (A → B) → Dist {ℓ} A → Dist {ℓ} B
58
-dmap f d = d >>= (λ x → pure (f x))
63
+dmap f d = d >>= (λ x → pure (f x))
59 64
 
60 65
 _*_ : ∀ {ℓ A B} → Dist {ℓ} A → Dist {ℓ} B → Dist {ℓ} (A × B)
61
-a * b = a >>= (λ x → b >>= (λ y → pure ⟨ x , y ⟩))
66
+a * b = a >>= (λ x → b >>= (λ y → pure ⟨ x , y ⟩))
62 67
 
63 68
 lift : {ℓ₁ ℓ₂ : Level} {A : Set ℓ₁} → Dist A → Dist (Lift ℓ₂ A)
64 69
 lift (pure x) = pure (llift x)

+ 1
- 1
Yggdrasil/Security.agda View File

@@ -17,7 +17,7 @@ open import Relation.Binary.PropositionalEquality using (_≡_; _≢_; refl; con
17 17
 open import Relation.Nullary.Decidable using (True; fromWitnessFalse)
18 18
 open import Yggdrasil.List using (_∈_; here; there; with-proof; map≡-implies-∈≡)
19 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[_[_]]≡_)
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

+ 11
- 12
Yggdrasil/World.agda View File

@@ -10,7 +10,7 @@ open import Data.Sum using (_⊎_; inj₁; inj₂)
10 10
 open import Function using (_∘_)
11 11
 open import Relation.Binary.PropositionalEquality using (_≡_; _≢_; refl)
12 12
 open import Level using (Level; Lift) renaming (suc to lsuc; lift to llift)
13
-open import Yggdrasil.Probability using (Dist; pure; _>>=_; lift)
13
+open import Yggdrasil.Probability using (Dist; pure; _>>=_; lift)
14 14
 open import Yggdrasil.List using (_∈_; here; there)
15 15
 
16 16
 data ⊤ {ℓ : Level} : Set ℓ where
@@ -179,32 +179,31 @@ exec↑ : ∀ {ℓ S Γ₁ Γ₂ A} → Oracle S Γ₁ → Action↑ (node Γ₂
179 179
   (S × WorldState {ℓ} Γ₁) → Γ₂ ⊑ Γ₁ → ℕ → Dist (Result (A × (S × WorldState {ℓ} Γ₁)))
180 180
 
181 181
 -- NOTE: Gas is only used for termination here, it is NOT a computational model.
182
-exec (strat S α O) Σ g = (exec⊤ O α ⟨ S , Σ ⟩ g) >>= (pure ∘ rmap (llift ∘ proj₁))
182
+exec (strat S α O) Σ g = (exec⊤ O α ⟨ S , Σ ⟩ g) >>= (pure ∘ rmap (llift ∘ proj₁))
183 183
 
184 184
 exec⊤ O read                    Σ g       = pure (result ⟨ proj₁ Σ , Σ ⟩)
185 185
 exec⊤ O (write σ)               Σ g       = pure (result ⟨ tt , ⟨ σ , proj₂ Σ ⟩ ⟩)
186 186
 exec⊤ O (call↓ {f = f} ∈Γ x)    Σ g       = exec↑ O (Call.δ f x) Σ here g
187 187
 exec⊤ O abort                   Σ g       = pure abort
188
-exec⊤ O (dist D)                Σ g       = lift D >>= λ{
188
+exec⊤ O (dist D)                Σ g       = lift D >>= λ{
189 189
   (llift x) → pure (result ⟨ x , Σ ⟩ ) }
190 190
 exec⊤ O (call↯ {f = f} f∈ ⊑Γ x) Σ g       = exec↑ O (Call.δ f x) Σ ⊑Γ g
191
-exec⊤ O (α >>= β)               Σ g       = (exec⊤ O α Σ g) >>= λ{
191
+exec⊤ O (α >>= β)               Σ g       = (exec⊤ O α Σ g) >>= λ{
192 192
   (result ⟨ x , Σ′ ⟩) → exec⊤ O (β x) Σ′ g ;
193
-  abort               → pure abort        ;
194
-  out-of-gas          → pure out-of-gas   }
193
+  abort               → pure abort         ;
194
+  out-of-gas          → pure out-of-gas    }
195 195
 
196 196
 exec↑ O read                    Σ ⊑Γ g       = pure (result
197 197
   ⟨ get ⊑Γ (proj₂ Σ) , Σ ⟩)
198 198
 exec↑ O (write σ)               Σ ⊑Γ g       = pure (result
199 199
   ⟨ tt , ⟨ proj₁ Σ , set ⊑Γ (proj₂ Σ) σ ⟩ ⟩)
200 200
 exec↑ O abort                   Σ ⊑Γ g       = pure abort
201
-exec↑ O (dist D)                Σ ⊑Γ g       = lift D >>=
201
+exec↑ O (dist D)                Σ ⊑Γ g       = lift D >>=
202 202
   λ{ (llift x) → pure (result ⟨ x , Σ ⟩) }
203 203
 exec↑ O (query {q = q} q∈ x)    Σ ⊑Γ zero    = pure out-of-gas
204 204
 exec↑ O (query {q = q} q∈ x)    Σ ⊑Γ (suc g) = exec⊤ O (O (path ⊑Γ q∈) x) Σ g
205 205
 exec↑ O (call↓ {f = f} ∈Γ Γ∈ x) Σ ⊑Γ g       = exec↑ O (Call.δ f x) Σ (⊑-right ⊑Γ Γ∈) g
206
-exec↑ O (α >>= β)               Σ ⊑Γ g       = (exec↑ O α Σ ⊑Γ g)
207
-  >>= λ{
208
-    (result ⟨ x , Σ′ ⟩) → exec↑ O (β x) Σ′ ⊑Γ g ;
209
-    abort               → pure abort            ;
210
-    out-of-gas          → pure out-of-gas       }
206
+exec↑ O (α >>= β)               Σ ⊑Γ g       = (exec↑ O α Σ ⊑Γ g) >>=′ λ{
207
+  (result ⟨ x , Σ′ ⟩) → exec↑ O (β x) Σ′ ⊑Γ g ;
208
+  abort               → pure abort            ;
209
+  out-of-gas          → pure out-of-gas       }

Loading…
Cancel
Save