From e85760e6d6db5b3bcb19e2b9795d6cc9e84bf966 Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonyg@leastfixedpoint.com>
Date: Fri, 4 Jun 2021 00:05:04 +0200
Subject: [PATCH] syndicate/sturdy.rkt

---
 syndicate/info.rkt   |  1 +
 syndicate/sturdy.rkt | 64 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 65 insertions(+)
 create mode 100644 syndicate/sturdy.rkt

diff --git a/syndicate/info.rkt b/syndicate/info.rkt
index a41d18d..831c91c 100644
--- a/syndicate/info.rkt
+++ b/syndicate/info.rkt
@@ -7,6 +7,7 @@
 
                "auxiliary-macro-context"
                "preserves"
+               "sha"
                "struct-defaults"
 
 	       ;; "data-lib"
diff --git a/syndicate/sturdy.rkt b/syndicate/sturdy.rkt
new file mode 100644
index 0000000..664ad46
--- /dev/null
+++ b/syndicate/sturdy.rkt
@@ -0,0 +1,64 @@
+#lang racket/base
+;; Basically Macaroons [1] in a Dataspace context
+;;
+;; [1]: Birgisson, Arnar, Joe Gibbs Politz, Úlfar Erlingsson, Ankur
+;; Taly, Michael Vrable, and Mark Lentczner. “Macaroons: Cookies with
+;; Contextual Caveats for Decentralized Authorization in the Cloud.”
+;; In Network and Distributed System Security Symposium. San Diego,
+;; California: Internet Society, 2014.
+
+(provide KEY_LENGTH
+         new-key
+         sturdy-encode
+         sturdy-decode
+         mint
+         attenuate
+         SturdyRef-valid?
+         validate
+         (all-from-out "schemas/gen/sturdy.rkt"))
+
+(require racket/match)
+(require (only-in sha hmac-sha256))
+(require (only-in racket/random crypto-random-bytes))
+(require preserves)
+(require "schemas/gen/sturdy.rkt")
+
+(define KEY_LENGTH 16) ;; 128 bits
+
+(define (new-key) (crypto-random-bytes KEY_LENGTH))
+
+(define (embedded-not-allowed _)
+  (error 'embedded-not-allowed "Embedded Ref not permitted in SturdyRef"))
+
+(define (sturdy-encode v)
+  (preserve->bytes v
+                   #:canonicalizing? #t
+                   #:encode-embedded embedded-not-allowed
+                   #:write-annotations? #f))
+
+(define (sturdy-decode bs)
+  (bytes->preserve bs
+                   #:read-syntax? #f
+                   #:decode-embedded embedded-not-allowed))
+
+(define (mint oid key)
+  (SturdyRef oid '() (hmac-sha256 key (sturdy-encode oid))))
+
+(define (attenuate r . attenuation)
+  (match-define (SturdyRef oid caveatChain sig) r)
+  (SturdyRef oid
+             (append caveatChain (list attenuation))
+             (hmac-sha256 sig (sturdy-encode (Attenuation->preserves attenuation)))))
+
+(define (SturdyRef-valid? r key)
+  (match-define (SturdyRef oid caveatChain actual-sig) r)
+  (define expected-sig
+    (for/fold [(sig (hmac-sha256 key (sturdy-encode oid)))]
+              [(attenuation (in-list caveatChain))]
+      (hmac-sha256 sig (sturdy-encode (Attenuation->preserves attenuation)))))
+  (equal? expected-sig actual-sig))
+
+(define (validate r key)
+  (when (not (SturdyRef-valid? r key))
+    (error 'validate "Invalid SturdyRef"))
+  r)