test: negative regression tests for the P0 crypto-auth and rollback fixes

ober

e21d491f1d5a2476c42302de78be1eb9d54b9627

diff --git a/test/test-all.ss b/test/test-all.ss
index 95e40f3..a474db4 100644
--- a/test/test-all.ss
+++ b/test/test-all.ss
@@ -714,7 +714,8 @@
          (hashtable-set! file-link "FileProperties" file-properties)
          (proton-drive-decrypt-content-session-key
            (dummy-drive-key "node")
-           file-link)))
+           file-link
+           (dummy-drive-key "address"))))
 
 (check-error-contains "raw Drive content block decrypt fails closed"
        "disabled"
@@ -828,27 +829,243 @@
 (check "revision block decrypt verifies encrypted hash first"
        (let* ([encrypted (string->utf8 "encrypted-block")]
               [block (make-hashtable equal-hash equal?)]
+              [file-key (dummy-drive-key "file")]
+              [address-key (dummy-drive-key "address")]
               [key (make-proton-drive-content-session-key
                      "openpgp"
                      (string->utf8 "session-key")
                      "test")])
          (hashtable-set! block "Index" 1)
          (hashtable-set! block "Hash" (proton-drive-content-hash/base64 encrypted))
-         (let ([old-decryptor (proton-drive-current-content-block-decryptor)])
+         (hashtable-set! block "EncSignature" "good-enc-signature")
+         (let ([old-decryptor (proton-drive-current-content-block-decryptor)]
+               [old-verifier (proton-drive-current-block-signature-verifier)])
            (dynamic-wind
              (lambda ()
                (proton-drive-current-content-block-decryptor
                  (lambda (content-key encrypted-block)
                    (and (eq? content-key key)
                         encrypted-block
-                        (string->utf8 "plain-block")))))
+                        (string->utf8 "plain-block"))))
+               (proton-drive-current-block-signature-verifier
+                 (lambda (ak fk sig pt) (string=? sig "good-enc-signature"))))
              (lambda ()
                (string=?
                  (utf8->string
-                   (proton-drive-decrypt-revision-block key block encrypted))
+                   (proton-drive-decrypt-revision-block
+                     key block encrypted file-key address-key))
                  "plain-block"))
-             (lambda ()
-               (proton-drive-current-content-block-decryptor old-decryptor))))))
+              (lambda ()
+                (proton-drive-current-content-block-decryptor old-decryptor)
+                (proton-drive-current-block-signature-verifier old-verifier))))))
+
+(check "read path rejects block whose EncSignature is tampered"
+       (let* ([block (make-hashtable equal-hash equal?)]
+              [plaintext (string->utf8 "plain-block")]
+              [file-key (dummy-drive-key "file")]
+              [address-key (dummy-drive-key "address")]
+              [good-sig "good-enc-signature"]
+              [old-verifier (proton-drive-current-block-signature-verifier)])
+         (hashtable-set! block "Index" 1)
+         (hashtable-set! block "EncSignature" "tampered-enc-signature")
+         (dynamic-wind
+           (lambda ()
+             (proton-drive-current-block-signature-verifier
+               (lambda (ak fk sig pt)
+                 (and (eq? ak address-key)
+                      (eq? fk file-key)
+                      (test-bytevector=? pt plaintext)
+                      (string=? sig good-sig)))))
+           (lambda ()
+             (and (test-raises?
+                    (lambda ()
+                      (proton-drive-verify-block-signature!
+                        address-key file-key block plaintext)))
+                  (begin
+                    (hashtable-set! block "EncSignature" good-sig)
+                    (eq? #t
+                         (proton-drive-verify-block-signature!
+                           address-key file-key block plaintext)))))
+           (lambda ()
+             (proton-drive-current-block-signature-verifier old-verifier)))))
+
+(check "read path rejects block whose EncSignature is missing"
+       (let* ([block (make-hashtable equal-hash equal?)]
+              [plaintext (string->utf8 "plain-block")]
+              [old-verifier (proton-drive-current-block-signature-verifier)])
+         (hashtable-set! block "Index" 2)
+         (dynamic-wind
+           (lambda ()
+             (proton-drive-current-block-signature-verifier
+               (lambda (ak fk sig pt) #t)))
+           (lambda ()
+             (test-raises?
+               (lambda ()
+                 (proton-drive-verify-block-signature!
+                   (dummy-drive-key "address")
+                   (dummy-drive-key "file")
+                   block
+                   plaintext))))
+           (lambda ()
+             (proton-drive-current-block-signature-verifier old-verifier)))))
+
+(check "read path rejects revision manifest with reordered or dropped blocks"
+       (let* ([mk-block
+               (lambda (hash-bytes index)
+                 (let ([b (make-hashtable equal-hash equal?)])
+                   (hashtable-set! b "Index" index)
+                   (hashtable-set! b "Hash" (u8vector->base64-string hash-bytes))
+                   b))]
+              [block1 (mk-block #vu8(1 1 1 1) 1)]
+              [block2 (mk-block #vu8(2 2 2 2) 2)]
+              [correct (list block1 block2)]
+              [reordered (list block2 block1)]
+              [dropped (list block2)]
+              [expected-data (proton-drive-manifest-signature-data correct)]
+              [revision (make-hashtable equal-hash equal?)]
+              [address-key (dummy-drive-key "address")]
+              [old-verifier (proton-drive-current-manifest-signature-verifier)])
+         (hashtable-set! revision "ManifestSignature" "manifest-sig")
+         (dynamic-wind
+           (lambda ()
+             (proton-drive-current-manifest-signature-verifier
+               (lambda (ak sig data)
+                 (and (string=? sig "manifest-sig")
+                      (test-bytevector=? data expected-data)))))
+           (lambda ()
+             (and (test-raises?
+                    (lambda ()
+                      (proton-drive-verify-manifest-signature!
+                        address-key revision reordered)))
+                  (test-raises?
+                    (lambda ()
+                      (proton-drive-verify-manifest-signature!
+                        address-key revision dropped)))
+                  (eq? #t
+                       (proton-drive-verify-manifest-signature!
+                         address-key revision correct))))
+           (lambda ()
+             (proton-drive-current-manifest-signature-verifier old-verifier)))))
+
+(check "read path rejects revision manifest with missing ManifestSignature"
+       (let* ([revision (make-hashtable equal-hash equal?)]
+              [block
+               (let ([b (make-hashtable equal-hash equal?)])
+                 (hashtable-set! b "Index" 1)
+                 (hashtable-set! b "Hash" (u8vector->base64-string #vu8(1 1 1 1)))
+                 b)]
+              [old-verifier (proton-drive-current-manifest-signature-verifier)])
+         (dynamic-wind
+           (lambda ()
+             (proton-drive-current-manifest-signature-verifier
+               (lambda (ak sig data) #t)))
+           (lambda ()
+             (test-raises?
+               (lambda ()
+                 (proton-drive-verify-manifest-signature!
+                   (dummy-drive-key "address")
+                   revision
+                   (list block)))))
+           (lambda ()
+             (proton-drive-current-manifest-signature-verifier old-verifier)))))
+
+(check "content session key decrypt verifies packet signature before decrypting"
+       (let* ([file-properties (make-hashtable equal-hash equal?)]
+              [file-link (make-hashtable equal-hash equal?)]
+              [node-key (dummy-drive-key "node")]
+              [address-key (dummy-drive-key "address")]
+              [good-sig "good-packet-sig"]
+              [session-key
+               (make-proton-drive-content-session-key "openpgp" #vu8(9 9) "test")]
+              [old-verifier
+               (proton-drive-current-content-key-packet-signature-verifier)]
+              [old-decryptor (proton-drive-current-content-session-key-decryptor)])
+         (hashtable-set! file-properties "ContentKeyPacket" "AQID")
+         (hashtable-set! file-properties "ContentKeyPacketSignature" "tampered-packet-sig")
+         (hashtable-set! file-link "FileProperties" file-properties)
+         (dynamic-wind
+           (lambda ()
+             (proton-drive-current-content-key-packet-signature-verifier
+               (lambda (ak packet sig)
+                 (and (eq? ak address-key)
+                      (bytevector? packet)
+                      (string=? sig good-sig))))
+             (proton-drive-current-content-session-key-decryptor
+               (lambda (nk packet sig) session-key)))
+           (lambda ()
+             (and (test-raises?
+                    (lambda ()
+                      (proton-drive-decrypt-content-session-key
+                        node-key file-link address-key)))
+                  (begin
+                    (hashtable-set! file-properties "ContentKeyPacketSignature" good-sig)
+                    (eq? (proton-drive-decrypt-content-session-key
+                           node-key file-link address-key)
+                         session-key))))
+           (lambda ()
+             (proton-drive-current-content-key-packet-signature-verifier old-verifier)
+             (proton-drive-current-content-session-key-decryptor old-decryptor)))))
+
+(check "content key packet signature verification rejects missing signature"
+       (test-raises?
+         (lambda ()
+           (proton-drive-verify-content-key-packet-signature!
+             (dummy-drive-key "address")
+             #vu8(1 2 3)
+             ""))))
+
+(check "storage URL validation accepts allow-listed https host"
+       (string=?
+         (proton-drive-assert-storage-url-allowed!
+           "https://storage.proton.me/blocks/1")
+         "https://storage.proton.me/blocks/1"))
+
+(check-error-contains "block download rejects http storage URL before sending token"
+       "https"
+       (proton-drive-get-block-bytes
+         "http://storage.proton.me/blocks/1"
+         "secret-storage-token"))
+
+(check-error-contains "block download rejects non-allowlisted storage host before sending token"
+       "allow-listed"
+       (proton-drive-get-block-bytes
+         "https://evil.example.com/blocks/1"
+         "secret-storage-token"))
+
+(check-error-contains "block upload rejects http storage URL before sending token"
+       "https"
+       (proton-drive-upload-block
+         "http://storage.proton.me/blocks/1"
+         "secret-storage-token"
+         (string->utf8 "encrypted-block")))
+
+(check-error-contains "block upload rejects non-allowlisted storage host before sending token"
+       "allow-listed"
+       (proton-drive-upload-block
+         "https://evil.example.com/blocks/1"
+         "secret-storage-token"
+         (string->utf8 "encrypted-block")))
+
+(check "drive status records signature and storage URL enforcement"
+       (let* ([caps (hashtable-ref (proton-drive-status) "ImplementedCapabilities" '())])
+         (and (member "content-key-packet-signature-enforcement" caps)
+              (member "drive-block-signature-enforcement" caps)
+              (member "revision-manifest-signature-enforcement" caps)
+              (member "storage-url-allowlist-enforcement" caps))))
+
+(check "S3 manifest generation rollback is rejected against stored high-water mark"
+       (let* ([mark-file (string-append s3-test-root "/generation-mark.json")]
+              [fresh (jdrive-s3-empty-manifest)]
+              [stale (jdrive-s3-empty-manifest)]
+              [newer (jdrive-s3-empty-manifest)])
+         (hashtable-set! fresh "Generation" 7)
+         (jdrive-s3-record-manifest-generation! mark-file fresh)
+         (hashtable-set! stale "Generation" 3)
+         (hashtable-set! newer "Generation" 9)
+         (and (test-raises?
+                (lambda ()
+                  (jdrive-s3-assert-manifest-generation-fresh! mark-file stale)))
+              (eq? (jdrive-s3-assert-manifest-generation-fresh! mark-file newer) newer))))
 
 (define sample-child-links
   (hashtable-ref