#lang racket/base
;;; SPDX-License-Identifier: LGPL-3.0-or-later
;;; SPDX-FileCopyrightText: Copyright © 2011-2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>

(require racket/match)
(require racket/port)
(require net/base64)

(require bitsyntax)
(require "crypto.rkt")
(require "keys/ssh-keys.rkt")
(require "ssh-message-types.rkt")

(require rackunit)

(provide (struct-out ed25519-private-key)
         (struct-out ed25519-public-key)

	 public-key->pieces
	 pieces->public-key

	 host-key-algorithm->keys
	 host-key-signature
	 verify-host-key-signature!

	 pieces->ssh-host-key
	 ssh-host-key->pieces)

(struct ed25519-private-key (q d) #:transparent)
(struct ed25519-public-key (q) #:transparent)

(define (bytes->private-key-pieces bs)
  (match (bytes->ssh-private-key bs)
    [(list pk-bytes sk-bytes _comment)
     (ed25519-private-key pk-bytes sk-bytes)]))

(define (pieces->private-key p)
  (match p
    [(ed25519-private-key q d)
     (datum->pk-key (list 'eddsa 'private 'ed25519 q d) 'rkt-private)]))

(define (public-key->pieces key)
  (match (pk-key->datum key 'rkt-public)
    [(list 'eddsa 'public 'ed25519 q)
     (ed25519-public-key q)]))

(define (pieces->public-key p)
  (match p
    [(ed25519-public-key q)
     (datum->pk-key (list 'eddsa 'public 'ed25519 q) 'rkt-public)]))

(define (host-key-algorithm->keys host-key-alg)
  (case host-key-alg
    ((ssh-ed25519) (values host-key-ed25519-private host-key-ed25519-public))
    (else (error 'host-key-algorithm->keys "Unsupported host-key-alg ~v" host-key-alg))))

(define (host-key-signature private-key host-key-alg exchange-hash)
  (case host-key-alg
    [(ssh-ed25519)
     (define signature (pk-sign private-key exchange-hash))
     (bit-string (#"ssh-ed25519" :: (t:string))
                 (signature :: (t:string)))]))

(define (verify-host-key-signature! public-key host-key-alg exchange-hash h-signature)
  ;; TODO: If we are *re*keying, worth checking here that the key hasn't *changed* either.
  (write `(TODO check-host-key!)) (newline) (flush-output) ;; actually check the identity TOFU/POP
  (case host-key-alg
    [(ssh-ed25519)
     (define signature (bit-string-case h-signature
                         ([ (= #"ssh-ed25519" :: (t:string #:pack))
                            (sig :: (t:string #:pack)) ]
                          sig)))
     (when (not (pk-verify public-key exchange-hash signature))
       (error 'verify-host-key-signature! "Signature mismatch"))]))

(define (pieces->ssh-host-key pieces)
  (match pieces
    [(ed25519-public-key q)
     (bit-string (#"ssh-ed25519" :: (t:string))
                 (q :: (t:string)))]))

(define (ssh-host-key->pieces blob)
  (bit-string-case blob
    ([ (= #"ssh-ed25519" :: (t:string #:pack))
       (q :: (t:string #:pack)) ]
     (ed25519-public-key q))))

;; TODO: proper store for keys

(define (load-private-key filename)
  (local-require (only-in racket/file file->bytes))
  (pieces->private-key (bytes->private-key-pieces (file->bytes filename))))

(define host-key-ed25519-private (load-private-key "test-host-keys/ssh_host_ed25519_key"))
(define host-key-ed25519-public (pk-key->public-only-key host-key-ed25519-private))

(check-equal? (pk-key->datum (pieces->public-key (public-key->pieces host-key-ed25519-public))
                             'SubjectPublicKeyInfo)
              (pk-key->datum host-key-ed25519-private 'SubjectPublicKeyInfo))