Arbitrary.hs

-- Arbitrary.hs: QuickCheck instances
-- Copyright © 2014-2015  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 Control.Monad (liftM)
import qualified Data.ByteString.Lazy as BL
import qualified Data.List.NonEmpty as NE
import Data.Maybe (fromMaybe)
import Network.URI (nullURI, parseURI)
import Test.QuickCheck (Arbitrary(..), choose, elements, frequency, getPositive, listOf1, 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 = liftM Signature arbitrary

instance Arbitrary UserId where
    arbitrary = liftM UserId arbitrary

--

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 -}, udss, oss]
        where
            sct = liftM SigCreationTime arbitrary
            set = liftM SigExpirationTime arbitrary
            ec = liftM ExportableCertification arbitrary
            ts = arbitrary >>= \tl -> arbitrary >>= \ta -> return (TrustSignature tl ta)
            re = liftM RegularExpression arbitrary
            ket = liftM KeyExpirationTime arbitrary
            psa = liftM PreferredSymmetricAlgorithms arbitrary
            rk = arbitrary >>= \rcs -> arbitrary >>= \pka -> arbitrary >>= \tof -> return (RevocationKey rcs pka tof)
            i = liftM Issuer arbitrary
            nd = arbitrary >>= \nfs -> arbitrary >>= \nn -> arbitrary >>= \nv -> return (NotationData nfs nn nv)
            phas = liftM PreferredHashAlgorithms arbitrary
            pcas = liftM PreferredCompressionAlgorithms arbitrary
            ksps = liftM KeyServerPreferences arbitrary
            pks = liftM PreferredKeyServer arbitrary
            puid = liftM PrimaryUserId arbitrary
            purl = liftM (PolicyURL . URL . fromMaybe nullURI . parseURI) arbitrary
            kfs = liftM KeyFlags arbitrary
            suid = liftM SignersUserId arbitrary
            rfr = arbitrary >>= \rc -> arbitrary >>= \rr -> return (ReasonForRevocation rc rr)
            fs = liftM Features arbitrary
            st = arbitrary >>= \pka -> arbitrary >>= \ha -> arbitrary >>= \sh -> return (SignatureTarget pka ha sh)
            es = liftM EmbeddedSignature arbitrary -- FIXME: figure out why EmbeddedSignature fails to serialize properly
            udss = choose (100,110) >>= \a -> arbitrary >>= \b -> return (UserDefinedSigSub a b)
            oss = choose (111,127) >>= \a -> arbitrary >>= \b -> return (OtherSigSub a b) -- FIXME: more comprehensive range

--

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

instance Arbitrary EightOctetKeyId where
    arbitrary = liftM (EightOctetKeyId . BL.pack) (vector 8)

instance Arbitrary TwentyOctetFingerprint where
    arbitrary = liftM (TwentyOctetFingerprint . BL.pack) (vector 20)

instance Arbitrary MPI where
    arbitrary = liftM (MPI . getPositive) arbitrary

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 = liftM RClOther (choose (2,7))

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

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 = liftM KSPOther (choose (2,63))

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 = liftM FeatureOther (choose (8,63))

instance Arbitrary ThirtyTwoBitTimeStamp where
    arbitrary = liftM ThirtyTwoBitTimeStamp arbitrary

instance Arbitrary ThirtyTwoBitDuration where
    arbitrary = liftM ThirtyTwoBitDuration arbitrary

-- FIXME: this should be elsewhere
instance Arbitrary a => Arbitrary (NE.NonEmpty a) where
    arbitrary = NE.fromList `liftM` listOf1 arbitrary