Arbitrary.hs

-- Arbitrary.hs: QuickCheck instances
-- Copyright © 2014-2018  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.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
      , udss
      , oss
      , ifp
      ] {-, es -}
    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
      ifp =
        choose (4, 5) >>= \v ->
          fmap
            (IssuerFingerprint v)
            (if v == 4
               then arbitrary
               else fmap (TwentyOctetFingerprint . BL.pack) (vector 32))
      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, EdDSA]

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