91 lines
3.0 KiB
Racket
91 lines
3.0 KiB
Racket
#lang racket/base
|
|
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
|
;;; SPDX-FileCopyrightText: Copyright © 2021-2024 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?
|
|
SturdyRef-caveatChain
|
|
CaveatsField-caveats
|
|
validate
|
|
(all-from-out "schemas/sturdy.rkt"))
|
|
|
|
(require racket/match)
|
|
(require (only-in libb2 blake2s BLAKE2S_BLOCKLEN))
|
|
(require (only-in noise-protocol/hmac make-hmac))
|
|
(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 hmac-BLAKE2s (make-hmac blake2s BLAKE2S_BLOCKLEN))
|
|
|
|
(define (signature key data)
|
|
(subbytes (hmac-BLAKE2s key data) 0 KEY_LENGTH))
|
|
|
|
(define (mint oid key)
|
|
(SturdyRef (Parameters oid (signature key (sturdy-encode oid)) (CaveatsField-absent))))
|
|
|
|
(define (update-signature sig caveats)
|
|
(for/fold [(sig sig)] [(caveat (in-list caveats))]
|
|
(signature sig (sturdy-encode (->preserve caveat)))))
|
|
|
|
(define (attenuate-sturdy r . caveats)
|
|
(if (null? caveats)
|
|
r
|
|
(match r
|
|
[(SturdyRef (Parameters oid sig cs))
|
|
(SturdyRef (Parameters oid
|
|
(update-signature sig caveats)
|
|
(CaveatsField-present
|
|
(append (CaveatsField-caveats cs) caveats))))])))
|
|
|
|
(define (SturdyRef-valid? r key)
|
|
(match-define (SturdyRef (Parameters oid actual-sig cs)) r)
|
|
(define expected-sig (update-signature (signature key (sturdy-encode oid)) (CaveatsField-caveats cs)))
|
|
(equal? expected-sig actual-sig))
|
|
|
|
(define (SturdyRef-caveatChain r)
|
|
(CaveatsField-caveats (Parameters-caveats (SturdyRef-parameters r))))
|
|
|
|
(define (CaveatsField-caveats c)
|
|
(match c
|
|
[(CaveatsField-absent) '()]
|
|
[(CaveatsField-present cs) cs]
|
|
[(CaveatsField-invalid _) (error 'CaveatsField-caveats "Invalid caveats field")]))
|
|
|
|
(define (validate r key)
|
|
(when (not (SturdyRef-valid? r key))
|
|
(error 'validate "Invalid SturdyRef"))
|
|
r)
|