{-# LANGUAGE OverloadedStrings #-}

-- suite.hs: hOpenPGP test suite
-- Copyright © 2012-2018  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).

import Test.Tasty (defaultMain, testGroup, TestTree)
import Test.Tasty.HUnit (testCase, Assertion, assertFailure, assertEqual)
import Test.Tasty.QuickCheck as QC

import Data.Bifunctor (bimap)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Codec.Encryption.OpenPGP.Arbitrary ()
import Codec.Encryption.OpenPGP.Compression (decompressPkt, compressPkts)
import Codec.Encryption.OpenPGP.Expirations (isTKTimeValid)
import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint)
import Codec.Encryption.OpenPGP.KeyInfo (pkalgoAbbrev, pubkeySize)
import Codec.Encryption.OpenPGP.KeyringParser (parseTKs)
import Codec.Encryption.OpenPGP.KeySelection (parseFingerprint)
import Codec.Encryption.OpenPGP.SecretKey (decryptPrivateKey, encryptPrivateKey)
import Codec.Encryption.OpenPGP.Serialize (parsePkts)
import Codec.Encryption.OpenPGP.Signatures (verifyTKWith, verifySigWith, verifyAgainstKeys)
import Codec.Encryption.OpenPGP.Types
import Control.Error.Util (isRight)
import Control.Monad.Trans.Resource (ResourceT)
import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
import qualified Crypto.PubKey.RSA as RSA
import Data.Conduit.Serialization.Binary (conduitGet)
import Data.Conduit.OpenPGP.Compression (conduitCompress, conduitDecompress)
import Data.Conduit.OpenPGP.Decrypt (conduitDecrypt)
import Data.Conduit.OpenPGP.Keyring (conduitToTKs, conduitToTKsDropping, sinkKeyringMap)
import Data.Conduit.OpenPGP.Verify (conduitVerify)
import Data.IxSet.Typed ((@=), getOne)
import Data.Maybe (isJust)
import Data.Binary (get, put)
import Data.Binary.Get (runGetOrFail, Get)
import Data.Binary.Put (runPut)
import Data.Text (Text)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Text.PrettyPrint.Free (pretty)

import qualified Data.Conduit as DC
import qualified Data.Conduit.Binary as CB
import qualified Data.Conduit.List as CL

-- this needs a better name
runGet :: Get a -> BL.ByteString -> Either String a
runGet g bs = bimap (\(_,_,x) -> x) (\(_,_,x) -> x) (runGetOrFail g bs)

testSerialization :: FilePath -> Assertion
testSerialization fpr = do
    bs <- BL.readFile $ "tests/data/" ++ fpr
    let firstpass = runGet get bs
    case fmap unBlock firstpass of
        Left _ -> assertFailure $ "First pass failed on " ++ fpr
        Right [] -> assertFailure $ "First pass of " ++ fpr ++ " decoded to nothing."
        Right packs -> do let roundtrip = runPut $ put (Block packs)
                          let secondpass = runGet (get :: Get (Block Pkt)) roundtrip
                          if fmap unBlock secondpass == Right [] then
                              assertFailure $ "Second pass of " ++ fpr ++ " decoded to nothing."
                          else
                              assertEqual ("for " ++ fpr) firstpass secondpass

testCompression :: FilePath -> Assertion
testCompression fpr = do
    bs <- BL.readFile $ "tests/data/" ++ fpr
    let firstpass = fmap (concatMap decompressPkt . unBlock) . runGet get $ bs
    case firstpass of
        Left _ -> assertFailure $ "First pass failed on " ++ fpr
        Right [] -> assertFailure $ "First pass of " ++ fpr ++ " decoded to nothing."
        Right packs -> do let roundtrip = runPut $ put . Block $ [compressPkts ZIP packs]
                          let secondpass = fmap (concatMap decompressPkt . unBlock) . runGet get $ roundtrip
                          if secondpass == Right [] then
                              assertFailure $ "Second pass of " ++ fpr ++ " decoded to nothing."
                          else
                              assertEqual ("for " ++ fpr) firstpass secondpass

counter :: (Monad m) => DC.ConduitT a DC.Void m Int
counter = CL.fold (const . (1+)) 0

testConduitOutputLength :: FilePath -> DC.ConduitT B.ByteString b (ResourceT IO) () -> Int -> Assertion
testConduitOutputLength fpr c target = do
    len <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ fpr) DC..| c DC..| counter
    assertEqual ("expected length " ++ show target) target len

testPKAandSizeAndKeyIDandFingerprint :: FilePath -> String -> Assertion
testPKAandSizeAndKeyIDandFingerprint fpr kf = do
    bs <- BL.readFile $ "tests/data/" ++ fpr
    case runGet (get :: Get Pkt) bs of
        Left _ -> assertFailure $ "Decoding of " ++ fpr ++ " broke."
        Right (PublicKeyPkt pkp) -> do
                                       let pref = concat [pkalgoAbbrev (_pkalgo pkp), either (const "unknown") show (pubkeySize (_pubkey pkp)), ":", either (const "unknown") (show . pretty) (eightOctetKeyID pkp), "/"]
                                       assertEqual ("for " ++ fpr ++ " (spaceless)") (spaceless kf) (pref ++ show (pretty (fingerprint pkp)))
                                       assertEqual ("for " ++ fpr ++ " (spaced)") kf (pref ++ show (pretty (SpacedFingerprint (fingerprint pkp))))
        _ -> assertFailure "Expected public key, got something else."
    where
        spaceless = filter (/=' ')

testKeyringLookup :: FilePath -> String -> Bool -> Assertion
testKeyringLookup fpr eok expected = do
    kr <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ fpr) DC..| conduitGet get DC..| conduitToTKs DC..| sinkKeyringMap
    let key = getOne (kr @= (read eok :: EightOctetKeyId))
    assertEqual (eok ++ " in " ++ fpr) expected (isJust key)

testVerifyMessage :: FilePath -> FilePath -> [TwentyOctetFingerprint] -> Assertion
testVerifyMessage keyring message issuers = do
    kr <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ keyring) DC..| conduitGet get DC..| conduitToTKs DC..| sinkKeyringMap
    verification <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ message) DC..| conduitGet get DC..| conduitDecompress DC..| conduitVerify kr Nothing DC..| CL.consume
    let verification' = map (fmap (fingerprint . _verificationSigner)) verification
    assertEqual (keyring ++ " for " ++ message) (map Right issuers) verification'

testKeysSelfVerification :: Bool -> FilePath -> Assertion
testKeysSelfVerification expectsuccess keyfile = do
    ks <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ keyfile) DC..| conduitGet get DC..| conduitToTKs DC..| CL.consume
    let verifieds = mapM (verifyTKWith (verifySigWith (verifyAgainstKeys ks)) Nothing) ks
    assertEqual (keyfile ++ " self-verification") expectsuccess (isRight verifieds)

testKeysExpiration :: Bool -> FilePath -> Assertion
testKeysExpiration expectsuccess keyfile = do
    ks <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ keyfile) DC..| conduitGet get DC..| conduitToTKs DC..| CL.consume
    let Right verifieds = mapM (verifyTKWith (verifySigWith (verifyAgainstKeys ks)) Nothing) ks
        tvalid = all (isTKTimeValid (posixSecondsToUTCTime (realToFrac (1400000000 :: Integer)))) verifieds
    assertEqual (keyfile ++ " key expiration") expectsuccess tvalid

-- This needs a lot of work
testSymmetricEncryption :: FilePath -> FilePath -> BL.ByteString -> Assertion
testSymmetricEncryption encfile passfile cleartext = do
  passphrase <- BL.readFile $ "tests/data/" ++ passfile
  -- get parse tree
  pt <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ encfile) DC..| conduitGet get DC..| CL.consume
  -- assert parse tree has exactly two packets: skesk, encdata
  assertEqual "wrong number of packets" 2 (length pt)
  let skesk = fromPkt.head $ pt
      d = fromPkt.last $ pt
  -- FIXME: these assertions don't currently do anything properly,
  -- because haskell notices the _-prefixed accessor invocations below
  -- and the type system chokes before we hit them:
  assertEqual "first packet should be SKESK" SKESKType (packetType skesk)
  assertEqual "second packet should be encrypted data" SymEncIntegrityProtectedDataType (packetType d)
  decrypted <- DC.runConduitRes $ CL.sourceList pt DC..| conduitDecrypt (fakeCallback passphrase) DC..| CL.consume
  let payload = _literalDataPayload . fromPkt . head $ decrypted
  assertEqual ("cleartext for " ++ encfile) cleartext payload
      where
          fakeCallback :: BL.ByteString -> String -> IO BL.ByteString
          fakeCallback = const . return

testSecretKeyDecryption :: FilePath -> FilePath -> Assertion
testSecretKeyDecryption keyfile passfile = do
  passphrase <- BL.readFile $ "tests/data/" ++ passfile
  kr <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ keyfile) DC..| conduitGet get DC..| CL.consume
  let SecretKey pkp ska = fromPkt . head $ kr
      SUUnencrypted skey _ = decryptPrivateKey (pkp, ska) passphrase
  doPkeyAndSkeyMatch (_pubkey pkp) skey

-- FIXME: this should be reworked either with tasty-golden or some other form of sanity
testSecretKeyEncryption :: FilePath -> FilePath -> Assertion
testSecretKeyEncryption keyfile passfile = do
  passphrase <- BL.readFile $ "tests/data/" ++ passfile
  kr <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ keyfile) DC..| conduitGet get DC..| CL.consume
  gkr <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ "aes256-sha512.seckey") DC..| conduitGet get DC..| CL.consume
  let SecretKey pkp ska = fromPkt . head $ kr
      newska = encryptPrivateKey "\226~\197\a\202#\"G" (IV "\187\219\253I\236\204\t5D\196\NAK>;\202\185\t") ska passphrase
      newtruck = toPkt (SecretKey pkp newska):tail kr
  assertEqual "encrypted private key matches golden file" gkr newtruck

testParsePktsUtil :: FilePath -> Assertion
testParsePktsUtil fn = do
    let fpath = "tests/data/" ++ fn
    cp <- DC.runConduitRes $ CB.sourceFile fpath DC..| conduitGet get DC..| CL.consume
    pp <- parsePkts `fmap` BL.readFile fpath
    assertEqual "parsePkts utility function gives same results as conduit pipeline" cp pp

testParseTKsUtil :: FilePath -> Assertion
testParseTKsUtil fn = do
    let fpath = "tests/data/" ++ fn
    lbs <- BL.readFile fpath
    cp <- DC.runConduitRes $ CB.sourceLbs lbs DC..| conduitGet get DC..| conduitToTKs DC..| CL.consume
    let pt = parseTKs True . parsePkts $ lbs
    assertEqual "parsePkts utility function gives same results as conduit pipeline" cp pt

tests :: TestTree
tests = testGroup "Tests" [properties, unitTests]

unitTests :: TestTree
unitTests = testGroup "Unit Tests" [
  testGroup "Serialization group" [
     testCase "000001-006.public_key" (testSerialization "000001-006.public_key")
   , testCase "000002-013.user_id" (testSerialization "000002-013.user_id")
   , testCase "000003-002.sig" (testSerialization "000003-002.sig")
   , testCase "000004-012.ring_trust" (testSerialization "000004-012.ring_trust")
   , testCase "000005-002.sig" (testSerialization "000005-002.sig")
   , testCase "000006-012.ring_trust" (testSerialization "000006-012.ring_trust")
   , testCase "000007-002.sig" (testSerialization "000007-002.sig")
   , testCase "000008-012.ring_trust" (testSerialization "000008-012.ring_trust")
   , testCase "000009-002.sig" (testSerialization "000009-002.sig")
   , testCase "000010-012.ring_trust" (testSerialization "000010-012.ring_trust")
   , testCase "000011-002.sig" (testSerialization "000011-002.sig")
   , testCase "000012-012.ring_trust" (testSerialization "000012-012.ring_trust")
   , testCase "000013-014.public_subkey" (testSerialization "000013-014.public_subkey")
   , testCase "000014-002.sig" (testSerialization "000014-002.sig")
   , testCase "000015-012.ring_trust" (testSerialization "000015-012.ring_trust")
   , testCase "000016-006.public_key" (testSerialization "000016-006.public_key")
   , testCase "000017-002.sig" (testSerialization "000017-002.sig")
   , testCase "000018-012.ring_trust" (testSerialization "000018-012.ring_trust")
   , testCase "000019-013.user_id" (testSerialization "000019-013.user_id")
   , testCase "000020-002.sig" (testSerialization "000020-002.sig")
   , testCase "000021-012.ring_trust" (testSerialization "000021-012.ring_trust")
   , testCase "000022-002.sig" (testSerialization "000022-002.sig")
   , testCase "000023-012.ring_trust" (testSerialization "000023-012.ring_trust")
   , testCase "000024-014.public_subkey" (testSerialization "000024-014.public_subkey")
   , testCase "000025-002.sig" (testSerialization "000025-002.sig")
   , testCase "000026-012.ring_trust" (testSerialization "000026-012.ring_trust")
   , testCase "000027-006.public_key" (testSerialization "000027-006.public_key")
   , testCase "000028-002.sig" (testSerialization "000028-002.sig")
   , testCase "000029-012.ring_trust" (testSerialization "000029-012.ring_trust")
   , testCase "000030-013.user_id" (testSerialization "000030-013.user_id")
   , testCase "000031-002.sig" (testSerialization "000031-002.sig")
   , testCase "000032-012.ring_trust" (testSerialization "000032-012.ring_trust")
   , testCase "000033-002.sig" (testSerialization "000033-002.sig")
   , testCase "000034-012.ring_trust" (testSerialization "000034-012.ring_trust")
   , testCase "000035-006.public_key" (testSerialization "000035-006.public_key")
   , testCase "000036-013.user_id" (testSerialization "000036-013.user_id")
   , testCase "000037-002.sig" (testSerialization "000037-002.sig")
   , testCase "000038-012.ring_trust" (testSerialization "000038-012.ring_trust")
   , testCase "000039-002.sig" (testSerialization "000039-002.sig")
   , testCase "000040-012.ring_trust" (testSerialization "000040-012.ring_trust")
   , testCase "000041-017.attribute" (testSerialization "000041-017.attribute")
   , testCase "000042-002.sig" (testSerialization "000042-002.sig")
   , testCase "000043-012.ring_trust" (testSerialization "000043-012.ring_trust")
   , testCase "000044-014.public_subkey" (testSerialization "000044-014.public_subkey")
   , testCase "000045-002.sig" (testSerialization "000045-002.sig")
   , testCase "000046-012.ring_trust" (testSerialization "000046-012.ring_trust")
   , testCase "000047-005.secret_key" (testSerialization "000047-005.secret_key")
   , testCase "000048-013.user_id" (testSerialization "000048-013.user_id")
   , testCase "000049-002.sig" (testSerialization "000049-002.sig")
   , testCase "000050-012.ring_trust" (testSerialization "000050-012.ring_trust")
   , testCase "000051-007.secret_subkey" (testSerialization "000051-007.secret_subkey")
   , testCase "000052-002.sig" (testSerialization "000052-002.sig")
   , testCase "000053-012.ring_trust" (testSerialization "000053-012.ring_trust")
   , testCase "000054-005.secret_key" (testSerialization "000054-005.secret_key")
   , testCase "000055-002.sig" (testSerialization "000055-002.sig")
   , testCase "000056-012.ring_trust" (testSerialization "000056-012.ring_trust")
   , testCase "000057-013.user_id" (testSerialization "000057-013.user_id")
   , testCase "000058-002.sig" (testSerialization "000058-002.sig")
   , testCase "000059-012.ring_trust" (testSerialization "000059-012.ring_trust")
   , testCase "000060-007.secret_subkey" (testSerialization "000060-007.secret_subkey")
   , testCase "000061-002.sig" (testSerialization "000061-002.sig")
   , testCase "000062-012.ring_trust" (testSerialization "000062-012.ring_trust")
   , testCase "000063-005.secret_key" (testSerialization "000063-005.secret_key")
   , testCase "000064-002.sig" (testSerialization "000064-002.sig")
   , testCase "000065-012.ring_trust" (testSerialization "000065-012.ring_trust")
   , testCase "000066-013.user_id" (testSerialization "000066-013.user_id")
   , testCase "000067-002.sig" (testSerialization "000067-002.sig")
   , testCase "000068-012.ring_trust" (testSerialization "000068-012.ring_trust")
   , testCase "000069-005.secret_key" (testSerialization "000069-005.secret_key")
   , testCase "000070-013.user_id" (testSerialization "000070-013.user_id")
   , testCase "000071-002.sig" (testSerialization "000071-002.sig")
   , testCase "000072-012.ring_trust" (testSerialization "000072-012.ring_trust")
   , testCase "000073-017.attribute" (testSerialization "000073-017.attribute")
   , testCase "000074-002.sig" (testSerialization "000074-002.sig")
   , testCase "000075-012.ring_trust" (testSerialization "000075-012.ring_trust")
   , testCase "000076-007.secret_subkey" (testSerialization "000076-007.secret_subkey")
   , testCase "000077-002.sig" (testSerialization "000077-002.sig")
   , testCase "000078-012.ring_trust" (testSerialization "000078-012.ring_trust")
   , testCase "pubring.gpg" (testSerialization "pubring.gpg")
   , testCase "secring.gpg" (testSerialization "secring.gpg")
   , testCase "compressedsig.gpg" (testSerialization "compressedsig.gpg")
   , testCase "compressedsig-zlib.gpg" (testSerialization "compressedsig-zlib.gpg")
   , testCase "compressedsig-bzip2.gpg" (testSerialization "compressedsig-bzip2.gpg")
   , testCase "onepass_sig" (testSerialization "onepass_sig")
   , testCase "uncompressed-ops-dsa.gpg" (testSerialization "uncompressed-ops-dsa.gpg")
   , testCase "uncompressed-ops-rsa.gpg" (testSerialization "uncompressed-ops-rsa.gpg")
   , testCase "simple.seckey" (testSerialization "simple.seckey")
   , testCase "v3-genericcert.sig" (testSerialization "v3-genericcert.sig")
   , testCase "sigs-with-regexes" (testSerialization "sigs-with-regexes")
   , testCase "gnu-dummy-s2k-101-secret-key.gpg" (testSerialization "gnu-dummy-s2k-101-secret-key.gpg")
   , testCase "anibal-ed25519.gpg" (testSerialization "anibal-ed25519.gpg")
   , testCase "nist_p-256_key.gpg" (testSerialization "nist_p-256_key.gpg")
   , testCase "nist_p-256_secretkey.gpg" (testSerialization "nist_p-256_secretkey.gpg")
   ],
  testGroup "PKA/Size/KeyID/fingerprint group" [
     testCase "v3 key" (testPKAandSizeAndKeyIDandFingerprint "v3.key" "R1024:C7261095/CBD9 F412 6807 E405 CC2D  2712 1DF5 E86E")
   , testCase "v4 key" (testPKAandSizeAndKeyIDandFingerprint "000001-006.public_key" "R1248:D4D54EA16F87040E/421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E")
   , testCase "ECDSA key" (testPKAandSizeAndKeyIDandFingerprint "nist_p-256_key.gpg" "E256:F7708BADD6063224/174C CF12 C571 6D0E 527F  B50E F770 8BAD D606 3224")
   ],
  testGroup "Keyring group" [
     testCase "pubring 7732CF988A63EA86" (testKeyringLookup "pubring.gpg" "7732CF988A63EA86" True)
   , testCase "pubring 123456789ABCDEF0" (testKeyringLookup "pubring.gpg" "123456789ABCDEF0" False)
   , testCase "pubsub AD992E9C24399832" (testKeyringLookup "pubring.gpg" "AD992E9C24399832" True)
   , testCase "secring 7732CF988A63EA86" (testKeyringLookup "secring.gpg" "7732CF988A63EA86" True)
   , testCase "secring 123456789ABCDEF0" (testKeyringLookup "secring.gpg" "123456789ABCDEF0" False)
   , testCase "secsub AD992E9C24399832" (testKeyringLookup "secring.gpg" "AD992E9C24399832" True)
   -- FIXME: should count keys in rings
   ],
  testGroup "Message verification group" [
     testCase "uncompressed-ops-dsa" (testVerifyMessage "pubring.gpg" "uncompressed-ops-dsa.gpg" [fp "1EB2 0B2F 5A5C C3BE AFD6  E5CB 7732 CF98 8A63 EA86"])
   , testCase "uncompressed-ops-dsa-sha384" (testVerifyMessage "pubring.gpg" "uncompressed-ops-dsa-sha384.txt.gpg" [fp "1EB2 0B2F 5A5C C3BE AFD6  E5CB 7732 CF98 8A63 EA86"])
   , testCase "uncompressed-ops-rsa" (testVerifyMessage "pubring.gpg" "uncompressed-ops-rsa.gpg" [fp "CB79 3345 9F59 C70D F1C3  FBEE DEDC 3ECF 689A F56D"])
   , testCase "compressedsig" (testVerifyMessage "pubring.gpg" "compressedsig.gpg" [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"])
   , testCase "compressedsig-zlib" (testVerifyMessage "pubring.gpg" "compressedsig-zlib.gpg" [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"])
   , testCase "compressedsig-bzip2" (testVerifyMessage "pubring.gpg" "compressedsig-bzip2.gpg" [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"])
   ],
  testGroup "Certificate verification group" [
     testCase "userid" (testVerifyMessage "pubring.gpg" "minimized.gpg" [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"])
   , testCase "subkey" (testVerifyMessage "pubring.gpg" "subkey.gpg" [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"])
   , testCase "primary key binding" (testVerifyMessage "signing-subkey.gpg" "primary-binding.gpg" [fp "ED1B D216 F70E 5D5F 4444  48F9 B830 F2C4 83A9 9AE5"])
   , testCase "attribute" (testVerifyMessage "pubring.gpg" "uat.gpg" [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"])
   , testCase "primary key revocation" (testVerifyMessage "pubring.gpg" "prikey-rev.gpg" [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"])
   , testCase "subkey revocation" (testVerifyMessage "pubring.gpg" "subkey-rev.gpg" [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"])
   , testCase "6F87040E" (testVerifyMessage "pubring.gpg" "6F87040E.pubkey" [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E", fp "CB79 3345 9F59 C70D F1C3  FBEE DEDC 3ECF 689A F56D", fp "AF95 E4D7 BAC5 21EE 9740  BED7 5E9F 1523 4132 62DC"])
   , testCase "6F87040E-cr" (testVerifyMessage "pubring.gpg" "6F87040E-cr.pubkey" [fp "AF95 E4D7 BAC5 21EE 9740  BED7 5E9F 1523 4132 62DC", fp "AF95 E4D7 BAC5 21EE 9740  BED7 5E9F 1523 4132 62DC", fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E", fp "CB79 3345 9F59 C70D F1C3  FBEE DEDC 3ECF 689A F56D", fp "AF95 E4D7 BAC5 21EE 9740  BED7 5E9F 1523 4132 62DC"])
   , testCase "simple RSA secret key" (testVerifyMessage "pubring.gpg" "simple.seckey" [fp "421F 28FE AAD2 22F8 56C8  FFD5 D4D5 4EA1 6F87 040E"])
   , testCase "simple ECDSA public key" (testVerifyMessage "ecdsa-key-without-ecdh.pubkey" "ecdsa-key-without-ecdh.pubkey" [fp "174C CF12 C571 6D0E 527F  B50E F770 8BAD D606 3224"])
   ],
  testGroup "Key verification group" [
      testCase "6F87040E pubkey" (testKeysSelfVerification True "6F87040E.pubkey")
   ,  testCase "revoked pubkey" (testKeysSelfVerification False "revoked.pubkey")
   ,  testCase "expired pubkey" (testKeysSelfVerification True "expired.pubkey")
   ,  testCase "nist_p-256 pubkey" (testKeysSelfVerification True "nist_p-256_key.gpg")
   ],
  testGroup "Key expiration group" [
      testCase "6F87040E pubkey" (testKeysExpiration True "6F87040E.pubkey")
   ,  testCase "expired pubkey" (testKeysExpiration False "expired.pubkey")
   ,  testCase "nist_p-256 pubkey" (testKeysExpiration True "nist_p-256_key.gpg")
   ],
  testGroup "Compression group" [
     testCase "compressedsig.gpg" (testCompression "compressedsig.gpg")
   , testCase "compressedsig-zlib.gpg" (testCompression "compressedsig-zlib.gpg")
   , testCase "compressedsig-bzip2.gpg" (testCompression "compressedsig-bzip2.gpg")
   ],
  testGroup "Conduit length group" [
     testCase "conduitCompress (ZIP)" (testConduitOutputLength "pubring.gpg" (cgp DC..| conduitCompress ZIP) 1)
   , testCase "conduitCompress (Zlib)" (testConduitOutputLength "pubring.gpg" (cgp DC..| conduitCompress ZLIB) 1)
   , testCase "conduitCompress (BZip2)" (testConduitOutputLength "pubring.gpg" (cgp DC..| conduitCompress BZip2) 1)
   , testCase "conduitToTKs" (testConduitOutputLength "pubring.gpg" (cgp DC..| conduitToTKs) 4)
   , testCase "conduitToTKsDropping" (testConduitOutputLength "pubring.gpg" (cgp DC..| conduitToTKsDropping) 4)
   ],
  testGroup "Encrypted data" [
     testCase "Symmetric Encryption simple S2K SHA1 3DES, no MDC" (testSymmetricEncryption "encryption-sym-3des-s2k0.gpg" "symmetric-password.txt" "test\n")
   , testCase "Symmetric Encryption iterated-salted S2K SHA1 3DES, no MDC" (testSymmetricEncryption "encryption-sym-3des.gpg" "symmetric-password.txt" "test\n")
   , testCase "Symmetric Encryption simple S2K SHA1 3DES" (testSymmetricEncryption "encryption-sym-3des-mdc-s2k0.gpg" "symmetric-password.txt" "test\n")
   , testCase "Symmetric Encryption iterated-salted S2K SHA1 3DES" (testSymmetricEncryption "encryption-sym-3des-mdc.gpg" "symmetric-password.txt" "test\n")
   , testCase "Symmetric Encryption simple S2K SHA1 CAST5, no MDC" (testSymmetricEncryption "encryption-sym-cast5-s2k0.gpg" "symmetric-password.txt" "test\n")
   , testCase "Symmetric Encryption iterated-salted S2K SHA1 CAST5, no MDC" (testSymmetricEncryption "encryption-sym-cast5.gpg" "symmetric-password.txt" "test\n")
   , testCase "Symmetric Encryption simple S2K SHA1 CAST5" (testSymmetricEncryption "encryption-sym-cast5-mdc-s2k0.gpg" "symmetric-password.txt" "test\n")
   , testCase "Symmetric Encryption iterated-salted S2K SHA1 CAST5" (testSymmetricEncryption "encryption-sym-cast5-mdc.gpg" "symmetric-password.txt" "test\n")
   , testCase "Symmetric Encryption simple S2K SHA1 Blowfish, no MDC" (testSymmetricEncryption "encryption-sym-blowfish-s2k0.gpg" "symmetric-password.txt" "test\n")
   , testCase "Symmetric Encryption iterated-salted S2K SHA1 Blowfish, no MDC" (testSymmetricEncryption "encryption-sym-blowfish.gpg" "symmetric-password.txt" "test\n")
   , testCase "Symmetric Encryption simple S2K SHA1 Blowfish" (testSymmetricEncryption "encryption-sym-blowfish-mdc-s2k0.gpg" "symmetric-password.txt" "test\n")
   , testCase "Symmetric Encryption iterated-salted S2K SHA1 Blowfish" (testSymmetricEncryption "encryption-sym-blowfish-mdc.gpg" "symmetric-password.txt" "test\n")
   , testCase "Symmetric Encryption simple S2K SHA1 AES128" (testSymmetricEncryption "encryption-sym-aes128-s2k0.gpg" "symmetric-password.txt" "test\n")
   , testCase "Symmetric Encryption iterated-salted S2K SHA1 AES128" (testSymmetricEncryption "encryption-sym-aes128.gpg" "symmetric-password.txt" "test\n")
   , testCase "Symmetric Encryption simple S2K SHA1 AES192" (testSymmetricEncryption "encryption-sym-aes192-s2k0.gpg" "symmetric-password.txt" "test\n")
   , testCase "Symmetric Encryption iterated-salted S2K SHA1 AES192" (testSymmetricEncryption "encryption-sym-aes192.gpg" "symmetric-password.txt" "test\n")
   , testCase "Symmetric Encryption simple S2K SHA1 AES256" (testSymmetricEncryption "encryption-sym-aes256-s2k0.gpg" "symmetric-password.txt" "test\n")
   , testCase "Symmetric Encryption iterated-salted S2K SHA1 AES256" (testSymmetricEncryption "encryption-sym-aes256.gpg" "symmetric-password.txt" "test\n")
   , testCase "Symmetric Encryption simple S2K SHA1 Twofish" (testSymmetricEncryption "encryption-sym-twofish-s2k0.gpg" "symmetric-password.txt" "test\n")
   , testCase "Symmetric Encryption iterated-salted S2K SHA1 Twofish" (testSymmetricEncryption "encryption-sym-twofish.gpg" "symmetric-password.txt" "test\n")
   , testCase "Symmetric Encryption simple Camellia128" (testSymmetricEncryption "encryption-sym-camellia128-s2k0.gpg" "symmetric-password.txt" "test\n")
   , testCase "Symmetric Encryption iterated-salted Camellia128" (testSymmetricEncryption "encryption-sym-camellia128.gpg" "symmetric-password.txt" "test\n")
   , testCase "Symmetric Encryption iterated-salted Camellia192" (testSymmetricEncryption "encryption-sym-camellia192.gpg" "symmetric-password.txt" "test\n")
   , testCase "Symmetric Encryption iterated-salted Camellia256" (testSymmetricEncryption "encryption-sym-camellia256.gpg" "symmetric-password.txt" "test\n")
   ],
  testGroup "Encrypted secret keys" [
     testCase "SUSSHA1 CAST5 IteratedSalted SHA1 RSA" (testSecretKeyDecryption "simple.seckey" "pki-password.txt")
   , testCase "SUS16bit CAST5 IteratedSalted SHA1 RSA" (testSecretKeyDecryption "16bitcksum.seckey" "pki-password.txt")
   , testCase "SUSSHA1 AES256 IteratedSalted SHA512 RSA" (testSecretKeyDecryption "aes256-sha512.seckey" "pki-password.txt")
   , testCase "SUSSHA1 AES128 IteratedSalted SHA256 ECDSA" (testSecretKeyDecryption "nist_p-256_secretkey.gpg" "pki-password.txt")
   ],
  testGroup "Encrypting secret keys" [
     testCase "SUSSHA1 AES256 IteratedSalted SHA512 RSA" (testSecretKeyEncryption "unencrypted.seckey" "pki-password.txt")
   ],
  testGroup "Utility function group" [
     testCase "pubring as packets" (testParsePktsUtil "pubring.gpg")
   , testCase "pubring as TKs" (testParseTKsUtil "pubring.gpg")
   ]
 ]

properties :: TestTree
properties = testGroup "Properties" [qcProps]

qcProps :: TestTree
qcProps = testGroup "(checked by QuickCheck)"
  [ QC.testProperty "PKESK packet serialization-deserialization" $
    \pkesk -> Right (pkesk :: PKESK) == runGet get (runPut (put pkesk))
  , QC.testProperty "Signature packet serialization-deserialization" $
    \sig -> Right (sig :: Signature) == runGet get (runPut (put sig))
  , QC.testProperty "UserId packet serialization-deserialization" $
    \uid -> Right (uid :: UserId) == runGet get (runPut (put uid))
  ]

cgp :: DC.ConduitT B.ByteString Pkt (ResourceT IO) ()
cgp = conduitGet (get :: Get Pkt)

fp :: Text -> TwentyOctetFingerprint
fp = either error id . parseFingerprint

doPkeyAndSkeyMatch :: PKey -> SKey -> Assertion
doPkeyAndSkeyMatch (RSAPubKey (RSA_PublicKey rpub)) (RSAPrivateKey (RSA_PrivateKey rpriv)) = assertEqual "RSA private key matches RSA public key" rpub (RSA.private_pub rpriv)
doPkeyAndSkeyMatch (ECDSAPubKey (ECDSA_PublicKey ecpub)) (ECDSAPrivateKey (ECDSA_PrivateKey ecpriv)) = assertEqual "ECDSA private key curve matches ECDSA public key curve" (ECDSA.public_curve ecpub) (ECDSA.private_curve ecpriv)
doPkeyAndSkeyMatch _ _ = assertFailure "matching unimplemented"

main :: IO ()
main = defaultMain tests