From b78f7c78c3a6bcc2fddf3603336ccfc7c5e8ea50 Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Tue, 29 Aug 2017 05:36:11 -0400 Subject: Include derived file Arbitrary.hs in repo This allows the git repo to be used as a dependency for stack builds. --- Data/OpenPGP/Arbitrary.hs | 272 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 272 insertions(+) create mode 100644 Data/OpenPGP/Arbitrary.hs (limited to 'Data') diff --git a/Data/OpenPGP/Arbitrary.hs b/Data/OpenPGP/Arbitrary.hs new file mode 100644 index 0000000..48e43c9 --- /dev/null +++ b/Data/OpenPGP/Arbitrary.hs @@ -0,0 +1,272 @@ +{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-unused-imports #-} +module Data.OpenPGP.Arbitrary where +import Data.OpenPGP +import Data.OpenPGP.Internal +import Test.QuickCheck +import Test.QuickCheck.Instances +import Data.Word + +instance () => Arbitrary Packet where + arbitrary + = do x <- choose (0 :: Int, 13) + case x of + 0 -> do x1 <- arbitrary + x2 <- arbitrary + x3 <- arbitrary + x4 <- arbitrary + return (AsymmetricSessionKeyPacket x1 x2 x3 x4) + 1 -> do x1 <- arbitrary + x2 <- arbitrary + x3 <- arbitrary + x4 <- resize 10 (listOf arbitrary) + x5 <- resize 10 (listOf arbitrary) + x6 <- arbitrary + x7 <- arbitrary + version <- choose (2 :: Word8, 4) + case version of + 4 -> + return (signaturePacket 4 x1 x2 x3 x4 x5 x6 x7) + _ -> do + creation_time <- arbitrary + keyid <- vectorOf 16 (elements (['0'..'9'] ++ ['A'..'F'])) + return (signaturePacket version x1 x2 x3 [] [SignatureCreationTimePacket creation_time, IssuerPacket keyid] x6 x7) + 2 -> do x1 <- arbitrary + x2 <- arbitrary + x3 <- arbitrary + x4 <- arbitrary + return (SymmetricSessionKeyPacket x1 x2 x3 x4) + 3 -> do x1 <- arbitrary + x2 <- arbitrary + x3 <- arbitrary + x4 <- arbitrary + x5 <- arbitrary + x6 <- arbitrary + return (OnePassSignaturePacket x1 x2 x3 x4 x5 x6) + 4 -> do x1 <- arbitrary + x2 <- arbitrary + x3 <- arbitrary + x4 <- arbitrary + x5 <- arbitrary + x6 <- arbitrary + return (PublicKeyPacket x1 x2 x3 x4 x5 x6) + 5 -> do x1 <- arbitrary + x2 <- arbitrary + x3 <- arbitrary + x4 <- arbitrary + x5 <- arbitrary + x6 <- arbitrary + x7 <- arbitrary + x8 <- arbitrary + x9 <- arbitrary + return (SecretKeyPacket x1 x2 x3 x4 x5 x6 x7 x8 x9) + 6 -> do x1 <- arbitrary + x2 <- arbitrary + return (CompressedDataPacket x1 x2) + 7 -> return MarkerPacket + 8 -> do x1 <- arbitrary + x2 <- arbitrary + x3 <- arbitrary + x4 <- arbitrary + return (LiteralDataPacket x1 x2 x3 x4) + 9 -> do x1 <- arbitrary + return (TrustPacket x1) + 10 -> do x1 <- arbitrary + return (UserIDPacket x1) + 11 -> do x1 <- arbitrary + x2 <- arbitrary + return (EncryptedDataPacket x1 x2) + 12 -> do x1 <- arbitrary + return (ModificationDetectionCodePacket x1) + 13 -> do x1 <- arbitrary + x2 <- arbitrary + return (UnsupportedPacket x1 x2) + _ -> error "FATAL ERROR: Arbitrary instance, logic bug" + +instance () => Arbitrary S2K where + arbitrary + = do x <- choose (0 :: Int, 3) + case x of + 0 -> do x1 <- arbitrary + return (SimpleS2K x1) + 1 -> do x1 <- arbitrary + x2 <- arbitrary + return (SaltedS2K x1 x2) + 2 -> do x1 <- arbitrary + x2 <- arbitrary + x3 <- fmap decode_s2k_count arbitrary + return (IteratedSaltedS2K x1 x2 x3) + 3 -> do x1 <- suchThat arbitrary (`notElem` [0,1,3]) + x2 <- arbitrary + return (S2K x1 x2) + _ -> error "FATAL ERROR: Arbitrary instance, logic bug" + +instance () => Arbitrary HashAlgorithm where + arbitrary + = do x <- choose (0 :: Int, 7) + case x of + 0 -> return MD5 + 1 -> return SHA1 + 2 -> return RIPEMD160 + 3 -> return SHA256 + 4 -> return SHA384 + 5 -> return SHA512 + 6 -> return SHA224 + 7 -> do x1 <- suchThat arbitrary (`notElem` [01,02,03,08,09,10,11]) + return (HashAlgorithm x1) + _ -> error "FATAL ERROR: Arbitrary instance, logic bug" + +instance () => Arbitrary KeyAlgorithm where + arbitrary + = do x <- choose (0 :: Int, 8) + case x of + 0 -> return RSA + 1 -> return RSA_E + 2 -> return RSA_S + 3 -> return ELGAMAL + 4 -> return DSA + 5 -> return ECC + 6 -> return ECDSA + 7 -> return DH + 8 -> do x1 <- suchThat arbitrary (`notElem` [01,02,03,16,17,18,19,21]) + return (KeyAlgorithm x1) + _ -> error "FATAL ERROR: Arbitrary instance, logic bug" + +instance () => Arbitrary SymmetricAlgorithm where + arbitrary + = do x <- choose (0 :: Int, 9) + case x of + 0 -> return Unencrypted + 1 -> return IDEA + 2 -> return TripleDES + 3 -> return CAST5 + 4 -> return Blowfish + 5 -> return AES128 + 6 -> return AES192 + 7 -> return AES256 + 8 -> return Twofish + 9 -> do x1 <- suchThat arbitrary (`notElem` [00,01,02,03,04,07,08,09,10]) + return (SymmetricAlgorithm x1) + _ -> error "FATAL ERROR: Arbitrary instance, logic bug" + +instance () => Arbitrary CompressionAlgorithm where + arbitrary + = do x <- choose (0 :: Int, 4) + case x of + 0 -> return Uncompressed + 1 -> return ZIP + 2 -> return ZLIB + 3 -> return BZip2 + 4 -> do x1 <- suchThat arbitrary (`notElem` [0,1,2,3]) + return (CompressionAlgorithm x1) + _ -> error "FATAL ERROR: Arbitrary instance, logic bug" + +instance () => Arbitrary RevocationCode where + arbitrary + = do x <- choose (0 :: Int, 5) + case x of + 0 -> return NoReason + 1 -> return KeySuperseded + 2 -> return KeyCompromised + 3 -> return KeyRetired + 4 -> return UserIDInvalid + 5 -> do x1 <- suchThat arbitrary (`notElem` [00,01,02,03,32]) + return (RevocationCode x1) + _ -> error "FATAL ERROR: Arbitrary instance, logic bug" + +instance () => Arbitrary Message where + arbitrary + = do x1 <- arbitrary + return (Message x1) + +instance () => Arbitrary SignatureOver where + arbitrary + = do x <- choose (0 :: Int, 3) + case x of + 0 -> do x1 <- arbitrary + x2 <- arbitrary + return (DataSignature x1 x2) + 1 -> do x1 <- arbitrary + x2 <- arbitrary + return (KeySignature x1 x2) + 2 -> do x1 <- arbitrary + x2 <- arbitrary + x3 <- arbitrary + return (SubkeySignature x1 x2 x3) + 3 -> do x1 <- arbitrary + x2 <- arbitrary + x3 <- arbitrary + return (CertificationSignature x1 x2 x3) + _ -> error "FATAL ERROR: Arbitrary instance, logic bug" + +instance () => Arbitrary MPI where + arbitrary + = do x1 <- suchThat arbitrary (>=0) + return (MPI x1) + +instance () => Arbitrary SignatureSubpacket where + arbitrary + = do x <- choose (0 :: Int, 23) + case x of + 0 -> do x1 <- arbitrary + return (SignatureCreationTimePacket x1) + 1 -> do x1 <- arbitrary + return (SignatureExpirationTimePacket x1) + 2 -> do x1 <- arbitrary + return (ExportableCertificationPacket x1) + 3 -> do x1 <- arbitrary + x2 <- arbitrary + return (TrustSignaturePacket x1 x2) + 4 -> do x1 <- arbitrary + return (RegularExpressionPacket x1) + 5 -> do x1 <- arbitrary + return (RevocablePacket x1) + 6 -> do x1 <- arbitrary + return (KeyExpirationTimePacket x1) + 7 -> do x1 <- arbitrary + return (PreferredSymmetricAlgorithmsPacket x1) + 8 -> do x1 <- arbitrary + x2 <- arbitrary + x3 <- vectorOf 40 (elements (['0'..'9'] ++ ['A'..'F'])) + return (RevocationKeyPacket x1 x2 x3) + 9 -> do x1 <- vectorOf 16 (elements (['0'..'9'] ++ ['A'..'F'])) + return (IssuerPacket x1) + 10 -> do x1 <- arbitrary + x2 <- arbitrary + x3 <- arbitrary + return (NotationDataPacket x1 x2 x3) + 11 -> do x1 <- arbitrary + return (PreferredHashAlgorithmsPacket x1) + 12 -> do x1 <- arbitrary + return (PreferredCompressionAlgorithmsPacket x1) + 13 -> do x1 <- arbitrary + return (KeyServerPreferencesPacket x1) + 14 -> do x1 <- arbitrary + return (PreferredKeyServerPacket x1) + 15 -> do x1 <- arbitrary + return (PrimaryUserIDPacket x1) + 16 -> do x1 <- arbitrary + return (PolicyURIPacket x1) + 17 -> do x1 <- arbitrary + x2 <- arbitrary + x3 <- arbitrary + x4 <- arbitrary + x5 <- arbitrary + x6 <- arbitrary + x7 <- arbitrary + return (KeyFlagsPacket x1 x2 x3 x4 x5 x6 x7) + 18 -> do x1 <- arbitrary + return (SignerUserIDPacket x1) + 19 -> do x1 <- arbitrary + x2 <- arbitrary + return (ReasonForRevocationPacket x1 x2) + 20 -> do x1 <- arbitrary + return (FeaturesPacket x1) + 21 -> do x1 <- arbitrary + x2 <- arbitrary + x3 <- arbitrary + return (SignatureTargetPacket x1 x2 x3) + 22 -> do x1 <- suchThat arbitrary isSignaturePacket + return (EmbeddedSignaturePacket x1) + 23 -> do x1 <- arbitrary + return (UnsupportedSignatureSubpacket 105 x1) + _ -> error "FATAL ERROR: Arbitrary instance, logic bug" -- cgit v1.2.3