#lang racket/base
;;; SPDX-License-Identifier: LGPL-3.0-or-later
;;; SPDX-FileCopyrightText: Copyright © 2021 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
         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)