;;;; backplane-dns-test.lisp

(defpackage #:backplane-dns/test
  (:use #:cl
        #:backplane-dns
        #:prove)
  (:import-from #:arrows
                #:->)
  (:import-from #:ip-utils
                #:ipv4-p #:ipv6-p))

(in-package #:backplane-dns/test)

(plan 20)

(defun ipv4-body (ip &key (domain "test.org"))
  `((:REQUEST . "change_ipv4")
    (:DOMAIN  . ,domain)
    (:IP      . ,ip)))

(defun ipv6-body (ip &key (domain "test.org"))
  `((:REQUEST . "change_ipv6")
    (:DOMAIN  . ,domain)
    (:IP      . ,ip)))

(defun sshfp-body (sshfps &key (domain "test.org"))
  `((:REQUEST . "change_sshfp")
    (:DOMAIN  . ,domain)
    (:SSHFP   . ,sshfps)))

(defun parse-request (body &key
                             (sender "host-tester@backplane.test")
                             (api-version "1")
                             (msg-id "1"))
  (backplane-server:parse-message sender :DNS api-version body msg-id))

(is-type (parse-request '())
         'backplane-dns:unknown-dns-request)

(is-type (parse-request '((:REQUEST . "oops")))
         'backplane-dns:unknown-dns-request)

(is-type (parse-request (ipv4-body "1.1.1.1"))
         'backplane-dns:request-change-ipv4)

(is-type (parse-request (ipv6-body "a::3"))
         'backplane-dns:request-change-ipv6)

(is-type (parse-request (sshfp-body (list "123")))
         'backplane-dns:request-change-sshfp)

(defclass simple-test-store (backplane-dns-store:dns-store)
  ((ops :initform '() :reader ops)))

(defmethod backplane-dns-store:set-ipv4 ((store simple-test-store) domain name ip)
  (with-slots (ops) store
    (setf ops (cons (cons :set-ipv4 ip) ops))
    t))

(defmethod backplane-dns-store:set-ipv6 ((store simple-test-store) domain name ip)
  (with-slots (ops) store
    (setf ops (cons (cons :set-ipv6 ip) ops))
    t))

(defmethod backplane-dns-store:set-sshfp ((store simple-test-store) domain name sshfp)
  (with-slots (ops) store
    (setf ops (cons (cons :set-sshfp sshfp) ops))
    t))

(is-type (let ((backplane-dns:*dns-store* (make-instance 'simple-test-store)))
           (backplane-server:handle-message (parse-request (ipv4-body "1.1.1.1"))))
         'backplane-server:result/success)

(is-type (let ((backplane-dns:*dns-store* (make-instance 'simple-test-store)))
           (backplane-server:handle-message (parse-request (ipv6-body "1:1::1"))))
         'backplane-server:result/success)

(is-type (let ((backplane-dns:*dns-store* (make-instance 'simple-test-store)))
           (backplane-server:handle-message (parse-request (sshfp-body '("fake-key")))))
         'backplane-server:result/success)

(let ((backplane-dns:*dns-store* (make-instance 'simple-test-store))
      (ip "1.1.1.1"))
  (is (progn (backplane-server:handle-message (parse-request (ipv4-body ip)))
             (car (ops backplane-dns:*dns-store*)))
      (cons :set-ipv4 ip)))

(let ((backplane-dns:*dns-store* (make-instance 'simple-test-store))
      (ip "aa::1"))
  (is (progn (backplane-server:handle-message (parse-request (ipv6-body ip)))
             (car (ops backplane-dns:*dns-store*)))
      (cons :set-ipv6 ip)))

(let ((backplane-dns:*dns-store* (make-instance 'simple-test-store))
      (sshfp '("1 2 aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")))
  (is (progn (backplane-server:handle-message (parse-request (sshfp-body sshfp)))
             (car (ops backplane-dns:*dns-store*)))
      (cons :set-sshfp sshfp)))

(defclass verifying-test-store (backplane-dns-store:dns-store)
  ((ops :initform '() :reader ops)))

(defmethod backplane-dns-store:set-ipv4 ((store verifying-test-store) domain name ip)
  (if (not (ipv4-p ip))
      (error 'backplane-dns-store:invalid-ip
             :msg "invalid ipv4")
      (with-slots (ops) store
        (setf ops (cons (cons :set-ipv4 ip) ops))
        t)))

(defmethod backplane-dns-store:set-ipv6 ((store verifying-test-store) domain name ip)
  (if (not (ipv6-p ip))
      (error 'backplane-dns-store:invalid-ip
             :msg "invalid ipv6")
      (with-slots (ops) store
        (setf ops (cons (cons :set-ipv6 ip) ops))
        t)))

(defmethod backplane-dns-store:set-sshfp ((store verifying-test-store) domain name sshfp)
  (let ((new-sshfp (mapcar #'backplane-dns-store:sshfp-p sshfp)))
    (with-slots (ops) store
        (setf ops (cons (cons :set-sshfp new-sshfp) ops))
      t)))

(is-type (let ((backplane-dns:*dns-store* (make-instance 'verifying-test-store)))
           (backplane-server:handle-message (parse-request (ipv4-body "1.1.1.1"))))
         'backplane-server:result/success)

(is-type (let ((backplane-dns:*dns-store* (make-instance 'verifying-test-store)))
           (backplane-server:handle-message (parse-request (ipv6-body "1:1::1"))))
         'backplane-server:result/success)

(is-type (let ((backplane-dns:*dns-store* (make-instance 'verifying-test-store)))
           (backplane-server:handle-message (parse-request (sshfp-body '("1 2 aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")))))
         'backplane-server:result/success)

(is-type (let ((backplane-dns:*dns-store* (make-instance 'verifying-test-store)))
           (backplane-server:handle-message (parse-request (ipv4-body "1.1:1.1"))))
         'backplane-server:result/error)

(is-type (let ((backplane-dns:*dns-store* (make-instance 'verifying-test-store)))
           (backplane-server:handle-message (parse-request (ipv6-body "1:1.:1"))))
         'backplane-server:result/error)

(is-type (let ((backplane-dns:*dns-store* (make-instance 'verifying-test-store)))
           (backplane-server:handle-message (parse-request (sshfp-body '("oops")))))
         'backplane-server:result/error)

(is-type (let ((backplane-dns:*dns-store* (make-instance 'verifying-test-store)))
           (backplane-server:handle-message (parse-request (sshfp-body '("1 2 aaaaaaaaaaaaaaaaaaaaaaaaaaaaa")))))
         'backplane-server:result/error)

(is-type (let ((backplane-dns:*dns-store* (make-instance 'verifying-test-store)))
           (backplane-server:handle-message (parse-request (sshfp-body '("10 2 aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")))))
         'backplane-server:result/error)

(is-type (let ((backplane-dns:*dns-store* (make-instance 'verifying-test-store)))
           (backplane-server:handle-message (parse-request (sshfp-body '("1 0 aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")))))
         'backplane-server:result/error)

(finalize)