Arbitrary.hs

-- Arbitrary.hs: QuickCheck instances
-- Copyright © 2014  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).

module Codec.Encryption.OpenPGP.Arbitrary () where

import Codec.Encryption.OpenPGP.Types
import qualified Data.ByteString as B
import Test.QuickCheck (Arbitrary(..), choose, elements, frequency, getPositive, oneof, vector)
import Test.QuickCheck.Instances ()

instance Arbitrary PKESK where
    arbitrary = do pv <- arbitrary
                   eoki <- arbitrary
                   pka <- arbitrary
                   mpis <- arbitrary
                   return $ PKESK pv eoki pka mpis

instance Arbitrary Signature where
    arbitrary = arbitrary >>= return . Signature

instance Arbitrary UserId where
    arbitrary = arbitrary >>= return . UserId

--

instance Arbitrary SignaturePayload where
    arbitrary = frequency [(2,three),(3,four),(1,other)]
        where
            three = do
                st <- arbitrary
                w32 <- arbitrary
                eoki <- arbitrary
                pka <- arbitrary
                ha <- arbitrary
                w16 <- arbitrary
                mpis <- arbitrary
                return (SigV3 st w32 eoki pka ha w16 mpis)
            four = do
                st <- arbitrary
                pka <- arbitrary
                ha <- arbitrary
                has <- arbitrary
                uhas <- arbitrary
                w16 <- arbitrary
                mpis <- arbitrary
                return (SigV4 st pka ha has uhas w16 mpis)
            other = do
                v <- choose (5, maxBound)
                bs <- arbitrary
                return (SigVOther v bs)

instance Arbitrary SigSubPacket where
    arbitrary = do
        crit <- arbitrary
        pl <- arbitrary
        return (SigSubPacket crit pl)

instance Arbitrary SigSubPacketPayload where
    arbitrary = oneof [sct, set, ec, ts, re, ket, psa, rk, i, nd, phas, pcas, ksps, pks, puid, purl, kfs, suid, rfr, fs, st {-, es -}]
        where
            sct = arbitrary >>= return . SigCreationTime
            set = arbitrary >>= return . SigExpirationTime
            ec = arbitrary >>= return . ExportableCertification
            ts = arbitrary >>= \tl -> arbitrary >>= \ta -> return (TrustSignature tl ta)
            re = arbitrary >>= return . RegularExpression
            ket = arbitrary >>= return . KeyExpirationTime
            psa = arbitrary >>= return . PreferredSymmetricAlgorithms
            rk = arbitrary >>= \rcs -> arbitrary >>= \pka -> arbitrary >>= \tof -> return (RevocationKey rcs pka tof)
            i = arbitrary >>= return . Issuer
            nd = arbitrary >>= \nfs -> arbitrary >>= \nn -> arbitrary >>= \nv -> return (NotationData nfs nn nv)
            phas = arbitrary >>= return . PreferredHashAlgorithms
            pcas = arbitrary >>= return . PreferredCompressionAlgorithms
            ksps = arbitrary >>= return . KeyServerPreferences
            pks = arbitrary >>= return . PreferredKeyServer
            puid = arbitrary >>= return . PrimaryUserId
            purl = arbitrary >>= return . PolicyURL
            kfs = arbitrary >>= return . KeyFlags
            suid = arbitrary >>= return . SignersUserId
            rfr = arbitrary >>= \rc -> arbitrary >>= \rr -> return (ReasonForRevocation rc rr)
            fs = arbitrary >>= return . Features
            st = arbitrary >>= \pka -> arbitrary >>= \ha -> arbitrary >>= \sh -> return (SignatureTarget pka ha sh)
            es = arbitrary >>= return . EmbeddedSignature -- FIXME: figure out why EmbeddedSignature fails to serialize properly
            -- FIXME: finish this

--

instance Arbitrary PubKeyAlgorithm where
    arbitrary = elements [RSA, DSA, ECDH, ECDSA, DH]

instance Arbitrary EightOctetKeyId where
    arbitrary = vector 8 >>= return . EightOctetKeyId . B.pack

instance Arbitrary TwentyOctetFingerprint where
    arbitrary = vector 20 >>= return . TwentyOctetFingerprint . B.pack

instance Arbitrary MPI where
    arbitrary = arbitrary >>= return . MPI . getPositive

instance Arbitrary SigType where
    arbitrary = elements [BinarySig, CanonicalTextSig, StandaloneSig, GenericCert, PersonaCert, CasualCert, PositiveCert, SubkeyBindingSig, PrimaryKeyBindingSig, SignatureDirectlyOnAKey, KeyRevocationSig, SubkeyRevocationSig, CertRevocationSig, TimestampSig, ThirdPartyConfirmationSig]

instance Arbitrary HashAlgorithm where
    arbitrary = elements [DeprecatedMD5, SHA1, RIPEMD160, SHA256, SHA384, SHA512, SHA224]

instance Arbitrary SymmetricAlgorithm where
    arbitrary = elements [Plaintext, IDEA, TripleDES, CAST5, Blowfish, ReservedSAFER, ReservedDES, AES128, AES192, AES256, Twofish]

instance Arbitrary RevocationClass where
    arbitrary = frequency [(9,srk),(1,rco)]
        where
            srk = return SensitiveRK
            rco = choose (2,7) >>= return . RClOther

instance Arbitrary NotationFlag where
    arbitrary = frequency [(9,hr),(1,onf)]
        where
            hr = return HumanReadable
            onf = choose (1,31) >>= return . OtherNF

instance Arbitrary CompressionAlgorithm where
    arbitrary = elements [Uncompressed,ZIP,ZLIB,BZip2]

instance Arbitrary KSPFlag where
    arbitrary = frequency [(9,nm),(1,kspo)]
        where
            nm = return NoModify
            kspo = choose (2,63) >>= return . KSPOther

instance Arbitrary KeyFlag where
    arbitrary = elements [GroupKey, AuthKey, SplitKey, EncryptStorageKey, EncryptCommunicationsKey, SignDataKey, CertifyKeysKey]

instance Arbitrary RevocationCode where
    arbitrary = elements [NoReason, KeySuperseded, KeyMaterialCompromised, KeyRetiredAndNoLongerUsed, UserIdInfoNoLongerValid]

instance Arbitrary FeatureFlag where
    arbitrary = frequency [(9,md),(1,fo)]
        where
            md = return ModificationDetection
            fo = choose (8,63) >>= return . FeatureOther