Trivial (but practical) 1/n-XOR secret sharing

secret-sharing.rkt

#lang racket/base
;; Trivial (but practical) 1/n-XOR secret sharing

(require racl)
(require rackunit)
(require (only-in net/base64 base64-encode))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Utilities

(define (bytes-xor buf key)
  (define result (make-bytes (bytes-length buf)))
  (for ((b (in-bytes buf))
        (k (in-bytes key))
        (i (in-naturals)))
    (bytes-set! result i (bitwise-xor b k)))
  result)

(check-equal? (bytes-xor (bytes 0 0 0) (bytes 1 2 3)) (bytes 1 2 3))
(check-equal? (bytes-xor (bytes 1 2 3) (bytes 1 2 3)) (bytes 0 0 0))
(check-equal? (bytes-xor (bytes 1 2 3) (bytes 2 3 4)) (bytes 3 1 7))

(define (subsets-of-size n vs)
  (cond
   [(zero? n) '(())]
   [(null? vs) #f]
   [else (define r1 (or (subsets-of-size n (cdr vs)) '()))
         (define r2 (let ((raw (subsets-of-size (- n 1) (cdr vs))))
                      (if raw
                          (map (lambda (xs) (cons (car vs) xs)) raw)
                          '())))
         (append r1 r2)]))

(check-equal? (subsets-of-size 0 '(1 2 3 4 5))
              '(()))

(check-equal? (subsets-of-size 1 '(1 2 3 4 5))
              '((5) (4) (3) (2) (1)))

(check-equal? (subsets-of-size 3 '(1 2 3 4 5))
              '((3 4 5) (2 4 5) (2 3 5) (2 3 4) (1 4 5) (1 3 5) (1 3 4) (1 2 5) (1 2 4) (1 2 3)))

(check-equal? (subsets-of-size 5 '(1 2 3 4 5))
              '((1 2 3 4 5)))

(check-equal? (subsets-of-size 6 '(1 2 3 4 5))
              '())

(define (iota n)
  (for/list ((i (in-range n))) i))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Basic secret sharing

(define (fresh-key)
  (random-bytes crypto_secretbox_KEYBYTES))

(define (simple-split-secret secret n)
  (define secret-length (bytes-length secret))
  (define base-parts (for/list ((i (in-range (- n 1)))) (random-bytes secret-length)))
  (define final-part (foldl bytes-xor secret base-parts))
  (cons final-part base-parts))

(define (simple-combine-secret parts)
  (foldl bytes-xor (make-bytes (bytes-length (car parts)) 0) parts))

(check-equal? (simple-combine-secret (simple-split-secret #"hello" 4)) #"hello")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Trivial derived thresholded sharing

(define (simple-split-secret/threshold secret n t [names (iota n)])
  (for/fold ((shares (hash))) ((subset (subsets-of-size t (iota n))))
    (define subset-names (map (lambda (i) (list-ref names i)) subset))
    (for/fold ((shares shares))
        ((name subset-names)
         (part (simple-split-secret secret t)))
      (hash-set shares name (cons (list part subset-names) (hash-ref shares name '()))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Formatting of messages

(define (format-messages split-results)
  (for/list (((name parts) (in-hash split-results)))
    (define threshold (length (cadr (car parts))))
    (define option-strs
      (apply string-append
             (for/list ((part parts))
               (string-append "\n----------------------------------------\n"
                              "Group:\n"
                              (apply string-append
                                     (for/list ((who (cadr part)))
                                       (format " - ~a\n" who)))
                              "Your portion:\n"
                              (bytes->string/latin-1 (base64-encode (car part)))
                              ))))
    (string-append (format
"
===========================================================================
To: ~a
Subject: Your portion of a shared secret

Hello ~a,

You have been sent part of a secret. You will need to combine your
part with ~a other people's parts in order to reveal the secret.

Keep the contents of this message secret! Don't share it with others
until you're ready.

You can choose any of the following groups. If you can convince all
the members of one group to share their corresponding portions of the
secret with you, you can recover the secret. Any of the groups will
do; they all yield the same secret once a quorum is reached.
"
name name (- threshold 1)) option-strs)))

(for ((m (format-messages (simple-split-secret/threshold
                           #"This is the secret code"
                           4 3 '(alice@example.com
                                 bob@example.com
                                 charlie@example.com
                                 delia@example.com)))))
  (display m))