Arbitrary.hs

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

{-# LANGUAGE CPP #-}

module Codec.Encryption.OpenPGP.Arbitrary () where

import Codec.Encryption.OpenPGP.Types
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 = fmap Signature arbitrary

instance Arbitrary UserId where
    arbitrary = fmap 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 = fmap SigCreationTime arbitrary
            set = fmap SigExpirationTime arbitrary
            ec = fmap ExportableCertification arbitrary
            ts = arbitrary >>= \tl -> arbitrary >>= \ta -> return (TrustSignature tl ta)
            re = fmap RegularExpression arbitrary
            ket = fmap KeyExpirationTime arbitrary
            psa = fmap PreferredSymmetricAlgorithms arbitrary
            rk = arbitrary >>= \rcs -> arbitrary >>= \pka -> arbitrary >>= \tof -> return (RevocationKey rcs pka tof)
            i = fmap Issuer arbitrary
            nd = arbitrary >>= \nfs -> arbitrary >>= \nn -> arbitrary >>= \nv -> return (NotationData nfs nn nv)
            phas = fmap PreferredHashAlgorithms arbitrary
            pcas = fmap PreferredCompressionAlgorithms arbitrary
            ksps = fmap KeyServerPreferences arbitrary
            pks = fmap PreferredKeyServer arbitrary
            puid = fmap PrimaryUserId arbitrary
            purl = fmap (PolicyURL . URL . fromMaybe nullURI . parseURI) arbitrary
            kfs = fmap KeyFlags arbitrary
            suid = fmap SignersUserId arbitrary
            rfr = arbitrary >>= \rc -> arbitrary >>= \rr -> return (ReasonForRevocation rc rr)
            fs = fmap Features arbitrary
            st = arbitrary >>= \pka -> arbitrary >>= \ha -> arbitrary >>= \sh -> return (SignatureTarget pka ha sh)
            es = fmap 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 = fmap (EightOctetKeyId . BL.pack) (vector 8)

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

instance Arbitrary MPI where
    arbitrary = fmap (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
                         , Camellia128
                         , Camellia192
                         , Camellia256
                         ]

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

instance Arbitrary NotationFlag where
    arbitrary = frequency [(9,hr),(1,onf)]
        where
            hr = return HumanReadable
            onf = fmap 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 = fmap 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 = fmap FeatureOther (choose (8,63))

instance Arbitrary ThirtyTwoBitTimeStamp where
    arbitrary = fmap ThirtyTwoBitTimeStamp arbitrary

instance Arbitrary ThirtyTwoBitDuration where
    arbitrary = fmap ThirtyTwoBitDuration arbitrary

instance Arbitrary NotationName where
    arbitrary = fmap NotationName arbitrary

instance Arbitrary NotationValue where
    arbitrary = fmap NotationValue arbitrary

#if !MIN_VERSION_QuickCheck(2,9,0)
-- FIXME: this should be elsewhere
instance Arbitrary a => Arbitrary (NE.NonEmpty a) where
    arbitrary = NE.fromList `fmap` listOf1 arbitrary
#endif