72 lines
2.3 KiB
Racket
72 lines
2.3 KiB
Racket
#lang racket/base
|
|
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
|
;;; SPDX-FileCopyrightText: Copyright © 2021-2022 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
|
|
|
;; 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-sturdy
|
|
SturdyRef-valid?
|
|
validate
|
|
(all-from-out "schemas/sturdy.rkt"))
|
|
|
|
(require racket/match)
|
|
(require (only-in sha hmac-sha256))
|
|
(require (only-in racket/random crypto-random-bytes))
|
|
(require preserves)
|
|
(require preserves-schema)
|
|
(require "schemas/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 (signature key data)
|
|
(subbytes (hmac-sha256 key data) 0 KEY_LENGTH))
|
|
|
|
(define (mint oid key)
|
|
(SturdyRef oid '() (signature key (sturdy-encode oid))))
|
|
|
|
(define (attenuate-sturdy r . attenuation)
|
|
(match-define (SturdyRef oid caveatChain sig) r)
|
|
(SturdyRef oid
|
|
(append caveatChain (list attenuation))
|
|
(signature sig (sturdy-encode (->preserve attenuation)))))
|
|
|
|
(define (SturdyRef-valid? r key)
|
|
(match-define (SturdyRef oid caveatChain actual-sig) r)
|
|
(define expected-sig
|
|
(for/fold [(sig (signature key (sturdy-encode oid)))]
|
|
[(attenuation (in-list caveatChain))]
|
|
(signature sig (sturdy-encode (->preserve attenuation)))))
|
|
(equal? expected-sig actual-sig))
|
|
|
|
(define (validate r key)
|
|
(when (not (SturdyRef-valid? r key))
|
|
(error 'validate "Invalid SturdyRef"))
|
|
r)
|