;;;; Copyright (C) 2020 Julien Lepiller <julien@lepiller.eu>

;;;; 

;;;; This library is free software; you can redistribute it and/or

;;;; modify it under the terms of the GNU Lesser General Public

;;;; License as published by the Free Software Foundation; either

;;;; version 3 of the License, or (at your option) any later version.

;;;; 

;;;; This library is distributed in the hope that it will be useful,

;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of

;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

;;;; Lesser General Public License for more details.

;;;; 

;;;; You should have received a copy of the GNU Lesser General Public

;;;; License along with this library; if not, write to the Free Software

;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

;;;; 

(define-module (tests asn1)

  #:use-module (srfi srfi-64)

  #:use-module (ice-9 format)

  #:use-module (rnrs bytevectors)

  #:use-module (http-signature asn1))

(define (bv-equal? bv1 bv2)

  (if (equal? (bytevector-length bv1) (bytevector-length bv2))

    (let loop ((pos 0))

      (if (= pos (bytevector-length bv1))

          #t

          (if (equal? (bytevector-u8-ref bv1 pos) (bytevector-u8-ref bv2 pos))

            (loop (+ pos 1))

            #f)))

    #f))

(test-begin "asn1")

(test-assert "asn1 bool decoding #f"

  (equal?

    (decode-asn1 #vu8(#x01 #x01 #x00) asn1:bool)

    #f))

(test-assert "asn1 bool decoding #t"

  (equal?

    (decode-asn1 #vu8(#x01 #x01 #x51) asn1:bool)

    #t))

(test-assert "asn1 integer decoding"

  (and

    (bv-equal? (decode-asn1 #vu8(#x02 #x00) asn1:int-bv) #vu8())

    (bv-equal? (decode-asn1 #vu8(#x02 #x02 #x01 #x50) asn1:int-bv) #vu8(#x01 #x50))))

(test-assert "asn1 bit string decoding"

  (and

    (bv-equal? (decode-asn1 #vu8(#x03 #x00) asn1:bitstring) #vu8())

    (bv-equal? (decode-asn1 #vu8(#x03 #x02 #x01 #x50) asn1:bitstring) #vu8(#x01 #x50))))

(test-assert "asn1 bit string constructed decoding"

  (and

    (bv-equal? (decode-asn1 #vu8(#x23 #x80 #x03 #x03 #x00 #x0a #x3b

                                           #x03 #x05 #x04 #x5f #x29 #x1c #xd0

                                           #x00 #x00)

                            asn1:bitstring)

               #vu8(#x00 #x0a #x3b #x04 #x5f #x29 #x1c #xd0))

    (bv-equal? (decode-asn1 #vu8(#x23 #x80 #x03 #x00

                                           #x23 #x80 #x03 #x01 #x5f

                                                     #x03 #x01 #x1e

                                                     #x00 #x00

                                           #x03 #x02 #x5e #x22

                                           #x00 #x00)

                            asn1:bitstring)

               #vu8(#x5f #x1e #x5e #x22))))

(test-assert "asn1 octet string decoding"

  (and

    (bv-equal? (decode-asn1 #vu8(#x04 #x00) asn1:octetstring) #vu8())

    (bv-equal? (decode-asn1 #vu8(#x04 #x02 #x01 #x50) asn1:octetstring) #vu8(#x01 #x50))))

(test-assert "asn1 octet string constructed decoding"

  (and

    (bv-equal? (decode-asn1 #vu8(#x24 #x80 #x04 #x03 #x00 #x0a #x3b

                                           #x04 #x05 #x04 #x5f #x29 #x1c #xd0

                                           #x00 #x00)

                            asn1:octetstring)

               #vu8(#x00 #x0a #x3b #x04 #x5f #x29 #x1c #xd0))

    (bv-equal? (decode-asn1 #vu8(#x24 #x80 #x04 #x00

                                           #x24 #x80 #x04 #x01 #x5f

                                                     #x04 #x01 #x1e

                                                     #x00 #x00

                                           #x04 #x02 #x5e #x22

                                           #x00 #x00)

                            asn1:octetstring)

               #vu8(#x5f #x1e #x5e #x22))))

(test-assert "asn1 null decoding"

  (equal?

    (decode-asn1 #vu8(#x05 #x00) asn1:null)

    #nil))

(test-assert "asn1 sequence decoding"

  (map equal?

       (decode-asn1 #vu8(#x30 #x0f #x01 #x01 #x50

                                   #x01 #x01 #x01

                                   #x01 #x01 #x00

                                   #x01 #x01 #xff

                                   #x01 #x01 #x00)

         (asn1:sequence asn1:bool asn1:bool asn1:bool asn1:bool asn1:bool))

       (list #t #t #f #t #f)))

(test-assert "asn1 object identifier decoding"

  (map equal?

       (decode-asn1 #vu8(#x06 #x03 #x88 #x37 #x03) asn1:object-identifier)

       '(2 999 3)))

(test-assert "asn1 bool encoding #t"

  (bv-equal? (encode-asn1 asn1:bool #t) #vu8(#x01 #x01 #xff)))

(test-assert "asn1 bool encoding #f"

  (bv-equal? (encode-asn1 asn1:bool #f) #vu8(#x01 #x01 #x00)))

(test-assert "asn1 int encoding"

  (and

    (bv-equal? (encode-asn1 asn1:int-bv #vu8()) #vu8(#x02 #x00))

    (bv-equal? (encode-asn1 asn1:int-bv #vu8(#x5e #x11)) #vu8(#x02 #x02 #x5e #x11))))

(test-assert "asn1 bit string encoding"

  (and

    (bv-equal? (encode-asn1 asn1:bitstring #vu8()) #vu8(#x03 #x00))

    (bv-equal? (encode-asn1 asn1:bitstring #vu8(#x5e #x11)) #vu8(#x03 #x02 #x5e #x11))))

(test-assert "asn1 octet string encoding"

  (and

    (bv-equal? (encode-asn1 asn1:octetstring #vu8()) #vu8(#x04 #x00))

    (bv-equal? (encode-asn1 asn1:octetstring #vu8(#x5e #x11)) #vu8(#x04 #x02 #x5e #x11))))

(test-assert "asn1 null encoding"

  (bv-equal? (encode-asn1 asn1:null #nil) #vu8(#x05 #x00)))

(test-assert "asn1 object identifier encoding"

  (bv-equal? (encode-asn1 asn1:object-identifier '(2 999 3))

             #vu8(#x06 #x03 #x88 #x37 #x03)))

(test-assert "asn1 sequence encoding"

  (bv-equal? (encode-asn1 (asn1:sequence asn1:bool asn1:int-bv asn1:bool)

                          '(#t #vu8(#x5e #x5e #x5e) #f))

             #vu8(#x30 #x0b #x01 #x01 #xff

                            #x02 #x3 #x5e #x5e #x5e

                            #x01 #x01 #x00)))

(test-end "asn1")