{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- | Shared QuickCheck generators for wallet types.
--
-- Our convention is to let each test module define its own @Arbitrary@ orphans.
-- This module allows for code-reuse where desired, by providing generators.
module Cardano.Wallet.Gen
    ( genMnemonic
    , genPercentage
    , shrinkPercentage
    , genLegacyAddress
    , genBlockHeader
    , genChainPoint
    , genSlot
    , genActiveSlotCoefficient
    , shrinkActiveSlotCoefficient
    , genSlotNo
    , shrinkSlotNo
    , genNestedTxMetadata
    , genSimpleTxMetadata
    , shrinkTxMetadata
    , genScript
    , genScriptCosigners
    , genScriptTemplate
    , genScriptTemplateEntry
    , genMockXPub
    , genNatural
    ) where

import Prelude

import Cardano.Address.Derivation
    ( XPub, xpubFromBytes )
import Cardano.Address.Script
    ( Cosigner (..), Script (..), ScriptTemplate (..) )
import Cardano.Api
    ( TxMetadata (..)
    , TxMetadataJsonSchema (..)
    , TxMetadataValue (..)
    , metadataFromJson
    )
import Cardano.Mnemonic
    ( ConsistentEntropy, EntropySize, Mnemonic, entropyToMnemonic )
import Cardano.Wallet.Api.Types
    ( ApiScriptTemplateEntry (..), XPubOrSelf (..) )
import Cardano.Wallet.Primitive.AddressDiscovery.Shared
    ( retrieveAllCosigners )
import Cardano.Wallet.Primitive.Types
    ( ActiveSlotCoefficient (..)
    , BlockHeader (..)
    , ChainPoint (..)
    , Slot
    , SlotNo (..)
    , WithOrigin (..)
    )
import Cardano.Wallet.Primitive.Types.Address
    ( Address (..) )
import Cardano.Wallet.Primitive.Types.Hash
    ( Hash (..) )
import Cardano.Wallet.Primitive.Types.ProtocolMagic
    ( ProtocolMagic (..) )
import Cardano.Wallet.Unsafe
    ( unsafeFromHex, unsafeMkEntropy, unsafeMkPercentage )
import Data.Aeson
    ( ToJSON (..) )
import Data.ByteArray.Encoding
    ( Base (..), convertToBase )
import Data.List
    ( sortOn )
import Data.List.Extra
    ( nubOrdOn )
import Data.Maybe
    ( fromMaybe )
import Data.Proxy
    ( Proxy (..) )
import Data.Quantity
    ( Percentage (..), Quantity (..) )
import Data.Ratio
    ( denominator, numerator, (%) )
import Data.Text
    ( Text )
import Data.Word
    ( Word32 )
import GHC.TypeLits
    ( natVal )
import Numeric.Natural
    ( Natural )
import Test.QuickCheck
    ( Arbitrary (..)
    , Gen
    , Positive (..)
    , UnicodeString (..)
    , arbitrarySizedNatural
    , choose
    , elements
    , frequency
    , listOf
    , listOf1
    , oneof
    , resize
    , scale
    , shrinkList
    , shrinkMap
    , sized
    , sublistOf
    , suchThat
    , vector
    , vectorOf
    )

import qualified Cardano.Byron.Codec.Cbor as CBOR
import qualified Codec.CBOR.Write as CBOR
import qualified Data.Aeson as Aeson
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as B8
import qualified Data.HashMap.Strict as HM
import qualified Data.Map as Map
import qualified Data.Text as T
import qualified Data.Text.Encoding as T

-- | Generates an arbitrary mnemonic of a size according to the type parameter.
--
-- E.g:
-- >>> arbitrary = SomeMnemonic <$> genMnemonic @12
genMnemonic
    :: forall mw ent csz.
     ( ConsistentEntropy ent mw csz
     , EntropySize mw ~ ent
     )
    => Gen (Mnemonic mw)
genMnemonic :: Gen (Mnemonic mw)
genMnemonic = do
        let n :: Int
n = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy ent -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy ent -> Integer) -> Proxy ent -> Integer
forall a b. (a -> b) -> a -> b
$ Proxy (EntropySize mw)
forall k (t :: k). Proxy t
Proxy @(EntropySize mw)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
        ByteString
bytes <- [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> Gen [Word8] -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [Word8]
forall a. Arbitrary a => Int -> Gen [a]
vector Int
n
        let ent :: Entropy (EntropySize mw)
ent = ByteString -> Entropy (EntropySize mw)
forall (ent :: Nat) (csz :: Nat).
(HasCallStack, ValidEntropySize ent, ValidChecksumSize ent csz) =>
ByteString -> Entropy ent
unsafeMkEntropy @(EntropySize mw) ByteString
bytes
        Mnemonic mw -> Gen (Mnemonic mw)
forall (m :: * -> *) a. Monad m => a -> m a
return (Mnemonic mw -> Gen (Mnemonic mw))
-> Mnemonic mw -> Gen (Mnemonic mw)
forall a b. (a -> b) -> a -> b
$ Entropy ent -> Mnemonic mw
forall (mw :: Nat) (ent :: Nat) (csz :: Nat).
(ValidMnemonicSentence mw, ValidEntropySize ent,
 ValidChecksumSize ent csz, ent ~ EntropySize mw,
 mw ~ MnemonicWords ent) =>
Entropy ent -> Mnemonic mw
entropyToMnemonic Entropy ent
Entropy (EntropySize mw)
ent

genPercentage :: Gen Percentage
genPercentage :: Gen Percentage
genPercentage = HasCallStack => Rational -> Percentage
Rational -> Percentage
unsafeMkPercentage (Rational -> Percentage)
-> (Double -> Rational) -> Double -> Percentage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Rational
forall a. Fractional a => Rational -> a
fromRational (Rational -> Rational)
-> (Double -> Rational) -> Double -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Percentage) -> Gen Double -> Gen Percentage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Double
genDouble
  where
    genDouble :: Gen Double
    genDouble :: Gen Double
genDouble = (Double, Double) -> Gen Double
forall a. Random a => (a, a) -> Gen a
choose (Double
0, Double
1)

shrinkPercentage :: Percentage -> [Percentage]
shrinkPercentage :: Percentage -> [Percentage]
shrinkPercentage Percentage
x = HasCallStack => Rational -> Percentage
Rational -> Percentage
unsafeMkPercentage (Rational -> Percentage) -> [Rational] -> [Percentage]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ((Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
q) (Integer -> Rational) -> [Integer] -> [Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> [Integer]
forall a. Arbitrary a => a -> [a]
shrink Integer
p) [Rational] -> [Rational] -> [Rational]
forall a. [a] -> [a] -> [a]
++ ((Integer -> Rational) -> [Integer] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map (Integer
p Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
%) ([Integer] -> [Rational])
-> ([Integer] -> [Integer]) -> [Integer] -> [Rational]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
filter (Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0) ([Integer] -> [Rational]) -> [Integer] -> [Rational]
forall a b. (a -> b) -> a -> b
$ Integer -> [Integer]
forall a. Arbitrary a => a -> [a]
shrink Integer
q)
  where
    p :: Integer
p = Rational -> Integer
forall a. Ratio a -> a
numerator (Rational -> Integer) -> Rational -> Integer
forall a b. (a -> b) -> a -> b
$ Percentage -> Rational
getPercentage Percentage
x
    q :: Integer
q = Rational -> Integer
forall a. Ratio a -> a
denominator (Rational -> Integer) -> Rational -> Integer
forall a b. (a -> b) -> a -> b
$ Percentage -> Rational
getPercentage Percentage
x

genLegacyAddress
    :: Maybe ProtocolMagic
    -> Gen Address
genLegacyAddress :: Maybe ProtocolMagic -> Gen Address
genLegacyAddress Maybe ProtocolMagic
pm = do
    ByteString
bytes <- [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> Gen [Word8] -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [Word8]
forall a. Arbitrary a => Int -> Gen [a]
vector Int
64
    let (Just XPub
key) = ByteString -> Maybe XPub
xpubFromBytes ByteString
bytes
    Address -> Gen Address
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Address -> Gen Address) -> Address -> Gen Address
forall a b. (a -> b) -> a -> b
$ ByteString -> Address
Address
        (ByteString -> Address) -> ByteString -> Address
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString
CBOR.toStrictByteString
        (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ XPub -> [Encoding] -> Encoding
CBOR.encodeAddress XPub
key
        ([Encoding] -> Encoding) -> [Encoding] -> Encoding
forall a b. (a -> b) -> a -> b
$ [Encoding]
-> (ProtocolMagic -> [Encoding])
-> Maybe ProtocolMagic
-> [Encoding]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Encoding -> [Encoding]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> [Encoding])
-> (ProtocolMagic -> Encoding) -> ProtocolMagic -> [Encoding]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtocolMagic -> Encoding
CBOR.encodeProtocolMagicAttr) Maybe ProtocolMagic
pm

--
-- Slotting
--


-- | Don't generate /too/ large slots
genSlotNo :: Gen SlotNo
genSlotNo :: Gen SlotNo
genSlotNo = Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> (Word32 -> Word64) -> Word32 -> SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> SlotNo) -> Gen Word32 -> Gen SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arbitrary Word32 => Gen Word32
forall a. Arbitrary a => Gen a
arbitrary @Word32

shrinkSlotNo :: SlotNo -> [SlotNo]
shrinkSlotNo :: SlotNo -> [SlotNo]
shrinkSlotNo (SlotNo Word64
x) = (Word64 -> SlotNo) -> [Word64] -> [SlotNo]
forall a b. (a -> b) -> [a] -> [b]
map Word64 -> SlotNo
SlotNo ([Word64] -> [SlotNo]) -> [Word64] -> [SlotNo]
forall a b. (a -> b) -> a -> b
$ Word64 -> [Word64]
forall a. Arbitrary a => a -> [a]
shrink Word64
x

genChainPoint :: Gen ChainPoint
genChainPoint :: Gen ChainPoint
genChainPoint = [(Int, Gen ChainPoint)] -> Gen ChainPoint
forall a. [(Int, Gen a)] -> Gen a
frequency
    [ ( Int
1, ChainPoint -> Gen ChainPoint
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChainPoint
ChainPointAtGenesis)  -- "common" but not "very common"
    , (Int
40, BlockHeader -> ChainPoint
toChainPoint (BlockHeader -> ChainPoint) -> Gen BlockHeader -> Gen ChainPoint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SlotNo -> Gen BlockHeader
genBlockHeader (SlotNo -> Gen BlockHeader) -> Gen SlotNo -> Gen BlockHeader
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Gen SlotNo
genSlotNo))
    ]
  where
    toChainPoint :: BlockHeader -> ChainPoint
toChainPoint (BlockHeader SlotNo
slot Quantity "block" Word32
_ Hash "BlockHeader"
h Maybe (Hash "BlockHeader")
_) = SlotNo -> Hash "BlockHeader" -> ChainPoint
ChainPoint SlotNo
slot Hash "BlockHeader"
h

genSlot :: Gen Slot
genSlot :: Gen Slot
genSlot = [(Int, Gen Slot)] -> Gen Slot
forall a. [(Int, Gen a)] -> Gen a
frequency
    [ ( Int
1, Slot -> Gen Slot
forall (f :: * -> *) a. Applicative f => a -> f a
pure Slot
forall t. WithOrigin t
Origin)
    , (Int
40, SlotNo -> Slot
forall t. t -> WithOrigin t
At (SlotNo -> Slot) -> Gen SlotNo -> Gen Slot
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SlotNo
genSlotNo)
    ]

genBlockHeader :: SlotNo -> Gen BlockHeader
genBlockHeader :: SlotNo -> Gen BlockHeader
genBlockHeader SlotNo
sl = do
        SlotNo
-> Quantity "block" Word32
-> Hash "BlockHeader"
-> Maybe (Hash "BlockHeader")
-> BlockHeader
BlockHeader SlotNo
sl (SlotNo -> Quantity "block" Word32
mockBlockHeight SlotNo
sl) (Hash "BlockHeader" -> Maybe (Hash "BlockHeader") -> BlockHeader)
-> Gen (Hash "BlockHeader")
-> Gen (Maybe (Hash "BlockHeader") -> BlockHeader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Hash "BlockHeader")
forall (tag :: Symbol). Gen (Hash tag)
genHash Gen (Maybe (Hash "BlockHeader") -> BlockHeader)
-> Gen (Maybe (Hash "BlockHeader")) -> Gen BlockHeader
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Hash "BlockHeader" -> Maybe (Hash "BlockHeader")
forall a. a -> Maybe a
Just (Hash "BlockHeader" -> Maybe (Hash "BlockHeader"))
-> Gen (Hash "BlockHeader") -> Gen (Maybe (Hash "BlockHeader"))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Hash "BlockHeader")
forall (tag :: Symbol). Gen (Hash tag)
genHash)
      where
        mockBlockHeight :: SlotNo -> Quantity "block" Word32
        mockBlockHeight :: SlotNo -> Quantity "block" Word32
mockBlockHeight = Word32 -> Quantity "block" Word32
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Word32 -> Quantity "block" Word32)
-> (SlotNo -> Word32) -> SlotNo -> Quantity "block" Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word32) -> (SlotNo -> Word64) -> SlotNo -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotNo -> Word64
unSlotNo

        genHash :: Gen (Hash tag)
genHash = [Hash tag] -> Gen (Hash tag)
forall a. [a] -> Gen a
elements
            [ ByteString -> Hash tag
forall (tag :: Symbol). ByteString -> Hash tag
Hash (ByteString -> Hash tag) -> ByteString -> Hash tag
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
forall b. (HasCallStack, ByteArray b) => ByteString -> b
unsafeFromHex
                ByteString
"aac1308b9868af89c396b08ff6f3cfea8e0859c94d1b3bc834baeaaff8645448"
            , ByteString -> Hash tag
forall (tag :: Symbol). ByteString -> Hash tag
Hash (ByteString -> Hash tag) -> ByteString -> Hash tag
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
forall b. (HasCallStack, ByteArray b) => ByteString -> b
unsafeFromHex
                ByteString
"d93b27cc7bb6fd2fe6ee42de5328c13606bb714a78475a41335207d2afd6026e"
            , ByteString -> Hash tag
forall (tag :: Symbol). ByteString -> Hash tag
Hash (ByteString -> Hash tag) -> ByteString -> Hash tag
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
forall b. (HasCallStack, ByteArray b) => ByteString -> b
unsafeFromHex
                ByteString
"63b8828e2eadc3f14b9b691fa9df76139a9c9b13a12ec862b324cc5a88f9fcc5"
            ]

genActiveSlotCoefficient :: Gen ActiveSlotCoefficient
genActiveSlotCoefficient :: Gen ActiveSlotCoefficient
genActiveSlotCoefficient = Double -> ActiveSlotCoefficient
ActiveSlotCoefficient (Double -> ActiveSlotCoefficient)
-> Gen Double -> Gen ActiveSlotCoefficient
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Double, Double) -> Gen Double
forall a. Random a => (a, a) -> Gen a
choose (Double
0.001, Double
1.0)

shrinkActiveSlotCoefficient :: ActiveSlotCoefficient -> [ActiveSlotCoefficient]
shrinkActiveSlotCoefficient :: ActiveSlotCoefficient -> [ActiveSlotCoefficient]
shrinkActiveSlotCoefficient (ActiveSlotCoefficient Double
f)
        | Double
f Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1 = [ActiveSlotCoefficient
1]
        | Bool
otherwise = []

sizedMetadataValue :: Int -> Gen Aeson.Value
sizedMetadataValue :: Int -> Gen Value
sizedMetadataValue Int
0 =
    [Gen Value] -> Gen Value
forall a. [Gen a] -> Gen a
oneof
        [ Int -> Value
forall a. ToJSON a => a -> Value
toJSON (Int -> Value) -> Gen Int -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arbitrary Int => Gen Int
forall a. Arbitrary a => Gen a
arbitrary @Int
        , Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (ByteString -> Text) -> ByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"0x"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
base16 (ByteString -> Value) -> Gen ByteString -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
genByteString
        , Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Gen Text -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
genTxMetaText
        ]
sizedMetadataValue Int
n =
    [Gen Value] -> Gen Value
forall a. [Gen a] -> Gen a
oneof
        [ Int -> Gen Value
sizedMetadataValue Int
0
        , [Gen Value] -> Gen Value
forall a. [Gen a] -> Gen a
oneof
            [ HashMap Text Value -> Value
forall a. ToJSON a => a -> Value
toJSON (HashMap Text Value -> Value)
-> ([(Text, Value)] -> HashMap Text Value)
-> [(Text, Value)]
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Value)] -> HashMap Text Value
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(Text, Value)] -> Value) -> Gen [(Text, Value)] -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [(Text, Value)] -> Gen [(Text, Value)]
forall a. Int -> Gen a -> Gen a
resize Int
n
                (Gen (Text, Value) -> Gen [(Text, Value)]
forall a. Gen a -> Gen [a]
listOf (Gen (Text, Value) -> Gen [(Text, Value)])
-> Gen (Text, Value) -> Gen [(Text, Value)]
forall a b. (a -> b) -> a -> b
$ (,)
                    (Text -> Value -> (Text, Value))
-> Gen Text -> Gen (Value -> (Text, Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
genTxMetaText
                    Gen (Value -> (Text, Value)) -> Gen Value -> Gen (Text, Value)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Gen Value
sizedMetadataValue (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                )
            , [Value] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Value] -> Value) -> Gen [Value] -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [Value] -> Gen [Value]
forall a. Int -> Gen a -> Gen a
resize Int
n
                (Gen Value -> Gen [Value]
forall a. Gen a -> Gen [a]
listOf (Gen Value -> Gen [Value]) -> Gen Value -> Gen [Value]
forall a b. (a -> b) -> a -> b
$ Int -> Gen Value
sizedMetadataValue (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                )
            ]
        ]

base16 :: BS.ByteString -> Text
base16 :: ByteString -> Text
base16 = ByteString -> Text
T.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> ByteString -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
Base16

genByteString :: Gen BS.ByteString
genByteString :: Gen ByteString
genByteString = String -> ByteString
B8.pack (String -> ByteString) -> Gen String -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
64) Gen Int -> (Int -> Gen String) -> Gen String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Gen String
forall a. Arbitrary a => Int -> Gen [a]
vector)

shrinkByteString :: BS.ByteString -> [BS.ByteString]
shrinkByteString :: ByteString -> [ByteString]
shrinkByteString ByteString
bs
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1    = []
    | Bool
otherwise = [ Int -> ByteString -> ByteString
BS.take (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) ByteString
bs, Int -> ByteString -> ByteString
BS.drop (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) ByteString
bs ]
  where
    n :: Int
n = ByteString -> Int
BS.length ByteString
bs

genTxMetaText :: Gen Text
genTxMetaText :: Gen Text
genTxMetaText =
    Gen Text
genUnchecked Gen Text -> (Text -> Bool) -> Gen Text
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` Text -> Bool
hasValidEncodedLength
  where
    genUnchecked :: Gen Text
    genUnchecked :: Gen Text
genUnchecked = String -> Text
T.pack (String -> Text)
-> (UnicodeString -> String) -> UnicodeString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnicodeString -> String
getUnicodeString (UnicodeString -> Text) -> Gen UnicodeString -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int) -> Gen UnicodeString -> Gen UnicodeString
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
64) Gen UnicodeString
forall a. Arbitrary a => Gen a
arbitrary

    -- The UT8-encoded length of a metadata text value must not be greater
    -- than 64 bytes:
    hasValidEncodedLength :: Text -> Bool
    hasValidEncodedLength :: Text -> Bool
hasValidEncodedLength Text
t = Bool -> Bool -> Bool
(&&)
        (Int
encodedLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>   Int
0)
        (Int
encodedLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
64)
      where
        encodedLength :: Int
        encodedLength :: Int
encodedLength = ByteString -> Int
BS.length (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
t

shrinkTxMetaText :: Text -> [Text]
shrinkTxMetaText :: Text -> [Text]
shrinkTxMetaText
    = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null)
    ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnicodeString -> Text)
-> (Text -> UnicodeString) -> Text -> [Text]
forall a b. Arbitrary a => (a -> b) -> (b -> a) -> b -> [b]
shrinkMap (String -> Text
T.pack (String -> Text)
-> (UnicodeString -> String) -> UnicodeString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnicodeString -> String
getUnicodeString) (String -> UnicodeString
UnicodeString (String -> UnicodeString)
-> (Text -> String) -> Text -> UnicodeString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)

-- | Generates a 'TxMetadata' with arbitrary levels of nesting.
genNestedTxMetadata :: Gen TxMetadata
genNestedTxMetadata :: Gen TxMetadata
genNestedTxMetadata = do
    let (Int
maxBreadth, Int
maxDepth) = (Int
3, Int
3)
    [Value]
d <- (Int -> Int) -> Gen [Value] -> Gen [Value]
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
maxBreadth) (Gen [Value] -> Gen [Value]) -> Gen [Value] -> Gen [Value]
forall a b. (a -> b) -> a -> b
$ Gen Value -> Gen [Value]
forall a. Gen a -> Gen [a]
listOf1 (Int -> Gen Value
sizedMetadataValue Int
maxDepth)
    [Word]
i <- Int -> Gen Word -> Gen [Word]
forall a. Int -> Gen a -> Gen [a]
vectorOf @Word ([Value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
d) Gen Word
forall a. Arbitrary a => Gen a
arbitrary
    let json :: Value
json = HashMap Word Value -> Value
forall a. ToJSON a => a -> Value
toJSON (HashMap Word Value -> Value) -> HashMap Word Value -> Value
forall a b. (a -> b) -> a -> b
$ [(Word, Value)] -> HashMap Word Value
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(Word, Value)] -> HashMap Word Value)
-> [(Word, Value)] -> HashMap Word Value
forall a b. (a -> b) -> a -> b
$ [Word] -> [Value] -> [(Word, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word]
i [Value]
d
    case TxMetadataJsonSchema
-> Value -> Either TxMetadataJsonError TxMetadata
metadataFromJson TxMetadataJsonSchema
TxMetadataJsonNoSchema Value
json of
        Left TxMetadataJsonError
e -> String -> Gen TxMetadata
forall a. HasCallStack => String -> a
error (String -> Gen TxMetadata) -> String -> Gen TxMetadata
forall a b. (a -> b) -> a -> b
$ TxMetadataJsonError -> String
forall a. Show a => a -> String
show TxMetadataJsonError
e String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show (Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode Value
json)
        Right TxMetadata
metadata -> TxMetadata -> Gen TxMetadata
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxMetadata
metadata

-- | Generates a 'TxMetadata' containing only simple values, without nesting.
genSimpleTxMetadata :: Gen TxMetadata
genSimpleTxMetadata :: Gen TxMetadata
genSimpleTxMetadata = Map Word64 TxMetadataValue -> TxMetadata
TxMetadata (Map Word64 TxMetadataValue -> TxMetadata)
-> Gen (Map Word64 TxMetadataValue) -> Gen TxMetadata
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (Word64 -> TxMetadataValue -> Map Word64 TxMetadataValue
forall k a. k -> a -> Map k a
Map.singleton (Word64 -> TxMetadataValue -> Map Word64 TxMetadataValue)
-> Gen Word64
-> Gen (TxMetadataValue -> Map Word64 TxMetadataValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary Gen (TxMetadataValue -> Map Word64 TxMetadataValue)
-> Gen TxMetadataValue -> Gen (Map Word64 TxMetadataValue)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen TxMetadataValue
genSimpleTxMetadataValue)

genSimpleTxMetadataValue :: Gen TxMetadataValue
genSimpleTxMetadataValue :: Gen TxMetadataValue
genSimpleTxMetadataValue = [Gen TxMetadataValue] -> Gen TxMetadataValue
forall a. [Gen a] -> Gen a
oneof
    [ Integer -> TxMetadataValue
TxMetaNumber (Integer -> TxMetadataValue)
-> (Int -> Integer) -> Int -> TxMetadataValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> TxMetadataValue) -> Gen Int -> Gen TxMetadataValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arbitrary Int => Gen Int
forall a. Arbitrary a => Gen a
arbitrary @Int
    , ByteString -> TxMetadataValue
TxMetaBytes (ByteString -> TxMetadataValue)
-> Gen ByteString -> Gen TxMetadataValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
genByteString
    , Text -> TxMetadataValue
TxMetaText (Text -> TxMetadataValue) -> Gen Text -> Gen TxMetadataValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
genTxMetaText
    ]

shrinkTxMetadata :: TxMetadata -> [TxMetadata]
shrinkTxMetadata :: TxMetadata -> [TxMetadata]
shrinkTxMetadata (TxMetadata Map Word64 TxMetadataValue
m) = Map Word64 TxMetadataValue -> TxMetadata
TxMetadata (Map Word64 TxMetadataValue -> TxMetadata)
-> ([(Word64, TxMetadataValue)] -> Map Word64 TxMetadataValue)
-> [(Word64, TxMetadataValue)]
-> TxMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Word64, TxMetadataValue)] -> Map Word64 TxMetadataValue
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    ([(Word64, TxMetadataValue)] -> TxMetadata)
-> [[(Word64, TxMetadataValue)]] -> [TxMetadata]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Word64, TxMetadataValue) -> [(Word64, TxMetadataValue)])
-> [(Word64, TxMetadataValue)] -> [[(Word64, TxMetadataValue)]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList (Word64, TxMetadataValue) -> [(Word64, TxMetadataValue)]
forall t. (t, TxMetadataValue) -> [(t, TxMetadataValue)]
shrinkTxMetadataEntry (Map Word64 TxMetadataValue -> [(Word64, TxMetadataValue)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Word64 TxMetadataValue
m)
  where
    shrinkTxMetadataEntry :: (t, TxMetadataValue) -> [(t, TxMetadataValue)]
shrinkTxMetadataEntry (t
k, TxMetadataValue
v) = (t
k,) (TxMetadataValue -> (t, TxMetadataValue))
-> [TxMetadataValue] -> [(t, TxMetadataValue)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxMetadataValue -> [TxMetadataValue]
shrinkTxMetadataValue TxMetadataValue
v

shrinkTxMetadataValue :: TxMetadataValue -> [TxMetadataValue]
shrinkTxMetadataValue :: TxMetadataValue -> [TxMetadataValue]
shrinkTxMetadataValue (TxMetaMap [(TxMetadataValue, TxMetadataValue)]
xs) =
    [(TxMetadataValue, TxMetadataValue)] -> TxMetadataValue
TxMetaMap ([(TxMetadataValue, TxMetadataValue)] -> TxMetadataValue)
-> ([(TxMetadataValue, TxMetadataValue)]
    -> [(TxMetadataValue, TxMetadataValue)])
-> [(TxMetadataValue, TxMetadataValue)]
-> TxMetadataValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TxMetadataValue, TxMetadataValue) -> TxMetadataValue)
-> [(TxMetadataValue, TxMetadataValue)]
-> [(TxMetadataValue, TxMetadataValue)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (TxMetadataValue, TxMetadataValue) -> TxMetadataValue
forall a b. (a, b) -> a
fst ([(TxMetadataValue, TxMetadataValue)]
 -> [(TxMetadataValue, TxMetadataValue)])
-> ([(TxMetadataValue, TxMetadataValue)]
    -> [(TxMetadataValue, TxMetadataValue)])
-> [(TxMetadataValue, TxMetadataValue)]
-> [(TxMetadataValue, TxMetadataValue)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TxMetadataValue, TxMetadataValue) -> TxMetadataValue)
-> [(TxMetadataValue, TxMetadataValue)]
-> [(TxMetadataValue, TxMetadataValue)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn (TxMetadataValue, TxMetadataValue) -> TxMetadataValue
forall a b. (a, b) -> a
fst ([(TxMetadataValue, TxMetadataValue)] -> TxMetadataValue)
-> [[(TxMetadataValue, TxMetadataValue)]] -> [TxMetadataValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((TxMetadataValue, TxMetadataValue)
 -> [(TxMetadataValue, TxMetadataValue)])
-> [(TxMetadataValue, TxMetadataValue)]
-> [[(TxMetadataValue, TxMetadataValue)]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList (TxMetadataValue, TxMetadataValue)
-> [(TxMetadataValue, TxMetadataValue)]
shrinkPair [(TxMetadataValue, TxMetadataValue)]
xs
  where
    shrinkPair :: (TxMetadataValue, TxMetadataValue)
-> [(TxMetadataValue, TxMetadataValue)]
shrinkPair (TxMetadataValue
k,TxMetadataValue
v) =
        ((TxMetadataValue
k,) (TxMetadataValue -> (TxMetadataValue, TxMetadataValue))
-> [TxMetadataValue] -> [(TxMetadataValue, TxMetadataValue)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxMetadataValue -> [TxMetadataValue]
shrinkTxMetadataValue TxMetadataValue
v) [(TxMetadataValue, TxMetadataValue)]
-> [(TxMetadataValue, TxMetadataValue)]
-> [(TxMetadataValue, TxMetadataValue)]
forall a. [a] -> [a] -> [a]
++
        ((,TxMetadataValue
v) (TxMetadataValue -> (TxMetadataValue, TxMetadataValue))
-> [TxMetadataValue] -> [(TxMetadataValue, TxMetadataValue)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxMetadataValue -> [TxMetadataValue]
shrinkTxMetadataValue TxMetadataValue
k)
shrinkTxMetadataValue (TxMetaList [TxMetadataValue]
xs) =
    [TxMetadataValue] -> TxMetadataValue
TxMetaList ([TxMetadataValue] -> TxMetadataValue)
-> [[TxMetadataValue]] -> [TxMetadataValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([TxMetadataValue] -> Bool)
-> [[TxMetadataValue]] -> [[TxMetadataValue]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ([TxMetadataValue] -> Bool) -> [TxMetadataValue] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TxMetadataValue] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ((TxMetadataValue -> [TxMetadataValue])
-> [TxMetadataValue] -> [[TxMetadataValue]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList TxMetadataValue -> [TxMetadataValue]
shrinkTxMetadataValue [TxMetadataValue]
xs)
shrinkTxMetadataValue (TxMetaNumber Integer
i) = Integer -> TxMetadataValue
TxMetaNumber (Integer -> TxMetadataValue) -> [Integer] -> [TxMetadataValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> [Integer]
forall a. Arbitrary a => a -> [a]
shrink Integer
i
shrinkTxMetadataValue (TxMetaBytes ByteString
b) = ByteString -> TxMetadataValue
TxMetaBytes (ByteString -> TxMetadataValue)
-> [ByteString] -> [TxMetadataValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> [ByteString]
shrinkByteString ByteString
b
shrinkTxMetadataValue (TxMetaText Text
s) = Text -> TxMetadataValue
TxMetaText (Text -> TxMetadataValue) -> [Text] -> [TxMetadataValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
shrinkTxMetaText Text
s

genNatural :: Gen Natural
genNatural :: Gen Natural
genNatural = Gen Natural
forall a. Integral a => Gen a
arbitrarySizedNatural

genScript :: [a] -> Gen (Script a)
genScript :: [a] -> Gen (Script a)
genScript [a]
elems = (Int -> Int) -> Gen (Script a) -> Gen (Script a)
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
3) (Gen (Script a) -> Gen (Script a))
-> Gen (Script a) -> Gen (Script a)
forall a b. (a -> b) -> a -> b
$ (Int -> Gen (Script a)) -> Gen (Script a)
forall a. (Int -> Gen a) -> Gen a
sized Int -> Gen (Script a)
scriptTree
    where
        scriptTree :: Int -> Gen (Script a)
scriptTree Int
0 = [Gen (Script a)] -> Gen (Script a)
forall a. [Gen a] -> Gen a
oneof
            [ a -> Script a
forall elem. elem -> Script elem
RequireSignatureOf (a -> Script a) -> Gen a -> Gen (Script a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> Gen a
forall a. [a] -> Gen a
elements [a]
elems
            , Natural -> Script a
forall elem. Natural -> Script elem
ActiveFromSlot (Natural -> Script a) -> Gen Natural -> Gen (Script a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Natural
genNatural
            , Natural -> Script a
forall elem. Natural -> Script elem
ActiveUntilSlot (Natural -> Script a) -> Gen Natural -> Gen (Script a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Natural
genNatural
            ]
        scriptTree Int
n = do
            Positive Int
m <- Gen (Positive Int)
forall a. Arbitrary a => Gen a
arbitrary
            let n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            [Script a]
scripts' <- Int -> Gen (Script a) -> Gen [Script a]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
m (Int -> Gen (Script a)
scriptTree Int
n')
            Word8
atLeast <- (Word8, Word8) -> Gen Word8
forall a. Random a => (a, a) -> Gen a
choose (Word8
1, Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m)
            [Script a] -> Gen (Script a)
forall a. [a] -> Gen a
elements
                [ [Script a] -> Script a
forall elem. [Script elem] -> Script elem
RequireAllOf [Script a]
scripts'
                , [Script a] -> Script a
forall elem. [Script elem] -> Script elem
RequireAnyOf [Script a]
scripts'
                , Word8 -> [Script a] -> Script a
forall elem. Word8 -> [Script elem] -> Script elem
RequireSomeOf Word8
atLeast [Script a]
scripts'
                ]

genScriptCosigners :: Gen (Script Cosigner)
genScriptCosigners :: Gen (Script Cosigner)
genScriptCosigners = do
    Word8
numOfCosigners <- (Word8, Word8) -> Gen Word8
forall a. Random a => (a, a) -> Gen a
choose (Word8
1,Word8
10)
    [Cosigner] -> Gen (Script Cosigner)
forall a. [a] -> Gen (Script a)
genScript ([Cosigner] -> Gen (Script Cosigner))
-> [Cosigner] -> Gen (Script Cosigner)
forall a b. (a -> b) -> a -> b
$ Word8 -> Cosigner
Cosigner (Word8 -> Cosigner) -> [Word8] -> [Cosigner]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word8
0..Word8
numOfCosigners]

genScriptTemplate :: Gen ScriptTemplate
genScriptTemplate :: Gen ScriptTemplate
genScriptTemplate = do
    Script Cosigner
script <- Gen (Script Cosigner)
genScriptCosigners Gen (Script Cosigner)
-> (Script Cosigner -> Bool) -> Gen (Script Cosigner)
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Bool -> Bool
not (Bool -> Bool)
-> (Script Cosigner -> Bool) -> Script Cosigner -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Cosigner] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Cosigner] -> Bool)
-> (Script Cosigner -> [Cosigner]) -> Script Cosigner -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script Cosigner -> [Cosigner]
retrieveAllCosigners)
    let scriptCosigners :: [Cosigner]
scriptCosigners = Script Cosigner -> [Cosigner]
retrieveAllCosigners Script Cosigner
script
    [Cosigner]
cosignersSubset <- [Cosigner] -> Gen [Cosigner]
forall a. [a] -> Gen [a]
sublistOf [Cosigner]
scriptCosigners Gen [Cosigner] -> ([Cosigner] -> Bool) -> Gen [Cosigner]
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Bool -> Bool
not (Bool -> Bool) -> ([Cosigner] -> Bool) -> [Cosigner] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Cosigner] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
    [XPub]
xpubs <- Int -> Gen XPub -> Gen [XPub]
forall a. Int -> Gen a -> Gen [a]
vectorOf ([Cosigner] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Cosigner]
cosignersSubset) Gen XPub
genMockXPub
    ScriptTemplate -> Gen ScriptTemplate
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScriptTemplate -> Gen ScriptTemplate)
-> ScriptTemplate -> Gen ScriptTemplate
forall a b. (a -> b) -> a -> b
$ Map Cosigner XPub -> Script Cosigner -> ScriptTemplate
ScriptTemplate ([(Cosigner, XPub)] -> Map Cosigner XPub
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Cosigner, XPub)] -> Map Cosigner XPub)
-> [(Cosigner, XPub)] -> Map Cosigner XPub
forall a b. (a -> b) -> a -> b
$ [Cosigner] -> [XPub] -> [(Cosigner, XPub)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Cosigner]
cosignersSubset [XPub]
xpubs) Script Cosigner
script

genScriptTemplateEntry :: Gen ApiScriptTemplateEntry
genScriptTemplateEntry :: Gen ApiScriptTemplateEntry
genScriptTemplateEntry = do
    Script Cosigner
script <- Gen (Script Cosigner)
genScriptCosigners Gen (Script Cosigner)
-> (Script Cosigner -> Bool) -> Gen (Script Cosigner)
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Bool -> Bool
not (Bool -> Bool)
-> (Script Cosigner -> Bool) -> Script Cosigner -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Cosigner] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Cosigner] -> Bool)
-> (Script Cosigner -> [Cosigner]) -> Script Cosigner -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script Cosigner -> [Cosigner]
retrieveAllCosigners)
    let scriptCosigners :: [Cosigner]
scriptCosigners = Script Cosigner -> [Cosigner]
retrieveAllCosigners Script Cosigner
script
    [Cosigner]
cosignersSubset <- [Cosigner] -> Gen [Cosigner]
forall a. [a] -> Gen [a]
sublistOf [Cosigner]
scriptCosigners Gen [Cosigner] -> ([Cosigner] -> Bool) -> Gen [Cosigner]
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Bool -> Bool
not (Bool -> Bool) -> ([Cosigner] -> Bool) -> [Cosigner] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Cosigner] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
    [XPubOrSelf]
xpubsOrSelf <- Int -> Gen XPubOrSelf -> Gen [XPubOrSelf]
forall a. Int -> Gen a -> Gen [a]
vectorOf ([Cosigner] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Cosigner]
cosignersSubset) Gen XPubOrSelf
genXPubOrSelf
    ApiScriptTemplateEntry -> Gen ApiScriptTemplateEntry
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiScriptTemplateEntry -> Gen ApiScriptTemplateEntry)
-> ApiScriptTemplateEntry -> Gen ApiScriptTemplateEntry
forall a b. (a -> b) -> a -> b
$ Map Cosigner XPubOrSelf
-> Script Cosigner -> ApiScriptTemplateEntry
ApiScriptTemplateEntry ([(Cosigner, XPubOrSelf)] -> Map Cosigner XPubOrSelf
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Cosigner, XPubOrSelf)] -> Map Cosigner XPubOrSelf)
-> [(Cosigner, XPubOrSelf)] -> Map Cosigner XPubOrSelf
forall a b. (a -> b) -> a -> b
$ [Cosigner] -> [XPubOrSelf] -> [(Cosigner, XPubOrSelf)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Cosigner]
cosignersSubset [XPubOrSelf]
xpubsOrSelf) Script Cosigner
script

genMockXPub :: Gen XPub
genMockXPub :: Gen XPub
genMockXPub = XPub -> Maybe XPub -> XPub
forall a. a -> Maybe a -> a
fromMaybe XPub
forall a. a
impossible (Maybe XPub -> XPub) -> ([Word8] -> Maybe XPub) -> [Word8] -> XPub
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe XPub
xpubFromBytes (ByteString -> Maybe XPub)
-> ([Word8] -> ByteString) -> [Word8] -> Maybe XPub
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> XPub) -> Gen [Word8] -> Gen XPub
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Word8]
genBytes
  where
    genBytes :: Gen [Word8]
genBytes = Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
64 Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
    impossible :: a
impossible = String -> a
forall a. HasCallStack => String -> a
error String
"incorrect length in genMockXPub"

genXPubOrSelf :: Gen XPubOrSelf
genXPubOrSelf :: Gen XPubOrSelf
genXPubOrSelf =
    [Gen XPubOrSelf] -> Gen XPubOrSelf
forall a. [Gen a] -> Gen a
oneof [XPub -> XPubOrSelf
SomeAccountKey (XPub -> XPubOrSelf) -> Gen XPub -> Gen XPubOrSelf
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen XPub
genMockXPub, XPubOrSelf -> Gen XPubOrSelf
forall (f :: * -> *) a. Applicative f => a -> f a
pure XPubOrSelf
Self]