{-# OPTIONS_GHC -Wno-orphans #-}

module PlutusLedgerApi.V1.Orphans.Value (
  -- * Specialized Value wrappers
  FeeValue (..),
  getFeeValue,
  UTxOValue (..),
  getUtxoValue,
  NonAdaValue (..),
  getNonAdaValue,
  MintValue (..),
  getMintValue,
) where

import Control.Monad (guard)
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.Coerce (coerce)
import Data.Set qualified as Set
import PlutusLedgerApi.Orphans.Common (getBlake2b244Hash)
import PlutusLedgerApi.V1 qualified as PLA
import PlutusLedgerApi.V1.Value qualified as Value
import PlutusTx.AssocMap qualified as AssocMap
import PlutusTx.Prelude qualified as PlutusTx
import Prettyprinter (Pretty)
import Test.QuickCheck (
  Arbitrary (arbitrary, shrink),
  Arbitrary1 (liftArbitrary, liftShrink),
  CoArbitrary,
  Function (function),
  Gen,
  NonEmptyList (NonEmpty),
  NonZero (NonZero),
  Positive (Positive),
  chooseBoundedIntegral,
  chooseInt,
  frequency,
  functionMap,
  getNonEmpty,
  getNonZero,
  getPositive,
  resize,
  scale,
  sized,
  vectorOf,
 )

-- | @since WIP
deriving via (Value.CurrencySymbol, Value.TokenName) instance Arbitrary Value.AssetClass

-- | @since WIP
deriving via (Value.CurrencySymbol, Value.TokenName) instance CoArbitrary Value.AssetClass

-- | @since WIP
instance Function Value.AssetClass where
  {-# INLINEABLE function #-}
  function :: forall b. (AssetClass -> b) -> AssetClass :-> b
function = (AssetClass -> (CurrencySymbol, TokenName))
-> ((CurrencySymbol, TokenName) -> AssetClass)
-> (AssetClass -> b)
-> AssetClass :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap AssetClass -> (CurrencySymbol, TokenName)
into (CurrencySymbol, TokenName) -> AssetClass
outOf
    where
      into :: Value.AssetClass -> (Value.CurrencySymbol, Value.TokenName)
      into :: AssetClass -> (CurrencySymbol, TokenName)
into = AssetClass -> (CurrencySymbol, TokenName)
forall a b. Coercible a b => a -> b
coerce
      outOf :: (Value.CurrencySymbol, Value.TokenName) -> Value.AssetClass
      outOf :: (CurrencySymbol, TokenName) -> AssetClass
outOf = (CurrencySymbol, TokenName) -> AssetClass
forall a b. Coercible a b => a -> b
coerce

-- | @since 1.0.0
deriving via Integer instance Arbitrary PLA.Lovelace

-- | @since 1.0.0
deriving via Integer instance CoArbitrary PLA.Lovelace

-- | @since 1.0.0
instance Function PLA.Lovelace where
  {-# INLINEABLE function #-}
  function :: forall b. (Lovelace -> b) -> Lovelace :-> b
function = (Lovelace -> Integer)
-> (Integer -> Lovelace) -> (Lovelace -> b) -> Lovelace :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Lovelace -> Integer
forall a b. Coercible a b => a -> b
coerce Integer -> Lovelace
PLA.Lovelace

{- | A 'CurrencySymbol' is either a BLAKE2b-244 hash or empty (representing the
Ada symbol). In a fully-fair generator, this makes it vanishingly unlikely
that the Ada symbol will be produced naturally (1 in 2^8^28 = 2^244) odds.
QuickCheck doesn't give us the ability to represent these odds faithfully:
thus, we merely make the Ada symbol as unlikely as we can. If you want to
ensure that the Ada symbol is covered by your tests, you need to make
dedicated tests for this. For this reason, we also don't shrink into the Ada
symbol (indeed, we don't shrink at all).

@since 1.0.0
-}
instance Arbitrary PLA.CurrencySymbol where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen CurrencySymbol
arbitrary =
    BuiltinByteString -> CurrencySymbol
PLA.CurrencySymbol
      (BuiltinByteString -> CurrencySymbol)
-> Gen BuiltinByteString -> Gen CurrencySymbol
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Gen BuiltinByteString)] -> Gen BuiltinByteString
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
        [ (Int
1, BuiltinByteString -> Gen BuiltinByteString
forall a. a -> Gen a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure BuiltinByteString
"")
        , (Int
forall a. Bounded a => a
maxBound, Blake2b244Hash -> BuiltinByteString
getBlake2b244Hash (Blake2b244Hash -> BuiltinByteString)
-> Gen Blake2b244Hash -> Gen BuiltinByteString
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Blake2b244Hash
forall a. Arbitrary a => Gen a
arbitrary)
        ]

-- | @since 1.0.0
deriving via PlutusTx.BuiltinByteString instance CoArbitrary PLA.CurrencySymbol

-- | @since 1.0.0
instance Function PLA.CurrencySymbol where
  {-# INLINEABLE function #-}
  function :: forall b. (CurrencySymbol -> b) -> CurrencySymbol :-> b
function = (CurrencySymbol -> BuiltinByteString)
-> (BuiltinByteString -> CurrencySymbol)
-> (CurrencySymbol -> b)
-> CurrencySymbol :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap CurrencySymbol -> BuiltinByteString
forall a b. Coercible a b => a -> b
coerce BuiltinByteString -> CurrencySymbol
PLA.CurrencySymbol

{- | A 'PLA.Value' suitable for 'PLA.TxOut'. Specifically:

* The `PLA.Value` is sorted by both keys (meaning 'PLA.CurrencySymbol' and
  'PLA.TokenName');
* There exists an Ada amount; and
* All amounts are positive.

= Note

This is designed to act as a modifier, and thus, we expose the constructor
even though it preserves invariants. If you use the constructor directly,
be /very/ certain that the Value being wrapped satisfies the invariants
described above: failing to do so means all guarantees of this type are off
the table.

@since 1.0.2
-}
newtype UTxOValue = UTxOValue PLA.Value
  deriving
    ( -- | @since 1.0.0
      UTxOValue -> UTxOValue -> Bool
(UTxOValue -> UTxOValue -> Bool)
-> (UTxOValue -> UTxOValue -> Bool) -> Eq UTxOValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UTxOValue -> UTxOValue -> Bool
== :: UTxOValue -> UTxOValue -> Bool
$c/= :: UTxOValue -> UTxOValue -> Bool
/= :: UTxOValue -> UTxOValue -> Bool
Eq
    )
    via PLA.Value
  deriving stock
    ( -- | @since 1.0.0
      Int -> UTxOValue -> ShowS
[UTxOValue] -> ShowS
UTxOValue -> String
(Int -> UTxOValue -> ShowS)
-> (UTxOValue -> String)
-> ([UTxOValue] -> ShowS)
-> Show UTxOValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UTxOValue -> ShowS
showsPrec :: Int -> UTxOValue -> ShowS
$cshow :: UTxOValue -> String
show :: UTxOValue -> String
$cshowList :: [UTxOValue] -> ShowS
showList :: [UTxOValue] -> ShowS
Show
    )

-- @since WIP
deriving via PLA.Value instance Pretty UTxOValue

-- | @since 1.0.2
instance Arbitrary UTxOValue where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen UTxOValue
arbitrary =
    Value -> UTxOValue
UTxOValue (Value -> UTxOValue) -> Gen Value -> Gen UTxOValue
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      Positive Integer
adaQuantity <- Gen (Positive Integer)
forall a. Arbitrary a => Gen a
arbitrary
      -- Set of non-Ada currency symbols
      Set CurrencySymbol
csSet <- [CurrencySymbol] -> Set CurrencySymbol
forall a. Ord a => [a] -> Set a
Set.fromList ([CurrencySymbol] -> Set CurrencySymbol)
-> Gen [CurrencySymbol] -> Gen (Set CurrencySymbol)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen CurrencySymbol -> Gen [CurrencySymbol]
forall a. Gen a -> Gen [a]
forall (f :: Type -> Type) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary (BuiltinByteString -> CurrencySymbol
PLA.CurrencySymbol (BuiltinByteString -> CurrencySymbol)
-> (Blake2b244Hash -> BuiltinByteString)
-> Blake2b244Hash
-> CurrencySymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blake2b244Hash -> BuiltinByteString
getBlake2b244Hash (Blake2b244Hash -> CurrencySymbol)
-> Gen Blake2b244Hash -> Gen CurrencySymbol
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Blake2b244Hash
forall a. Arbitrary a => Gen a
arbitrary)
      let cses :: [CurrencySymbol]
cses = Set CurrencySymbol -> [CurrencySymbol]
forall a. Set a -> [a]
Set.toList Set CurrencySymbol
csSet
      -- For each key, generate a set of token names that aren't Ada, and a
      -- positive value
      [(CurrencySymbol, [(TokenName, Integer)])]
table <- (CurrencySymbol -> Gen (CurrencySymbol, [(TokenName, Integer)]))
-> [CurrencySymbol]
-> Gen [(CurrencySymbol, [(TokenName, Integer)])]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Int -> Int)
-> Gen (CurrencySymbol, [(TokenName, Integer)])
-> Gen (CurrencySymbol, [(TokenName, Integer)])
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
8) (Gen (CurrencySymbol, [(TokenName, Integer)])
 -> Gen (CurrencySymbol, [(TokenName, Integer)]))
-> (CurrencySymbol -> Gen (CurrencySymbol, [(TokenName, Integer)]))
-> CurrencySymbol
-> Gen (CurrencySymbol, [(TokenName, Integer)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CurrencySymbol -> Gen (CurrencySymbol, [(TokenName, Integer)])
mkInner) [CurrencySymbol]
cses
      -- Jam the Ada value in there
      let table' :: [(CurrencySymbol, [(TokenName, Integer)])]
table' = (CurrencySymbol
Value.adaSymbol, [(TokenName
Value.adaToken, Integer
adaQuantity)]) (CurrencySymbol, [(TokenName, Integer)])
-> [(CurrencySymbol, [(TokenName, Integer)])]
-> [(CurrencySymbol, [(TokenName, Integer)])]
forall a. a -> [a] -> [a]
: [(CurrencySymbol, [(TokenName, Integer)])]
table
      Value -> Gen Value
forall a. a -> Gen a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Value -> Gen Value)
-> ([(CurrencySymbol, [(TokenName, Integer)])] -> Value)
-> [(CurrencySymbol, [(TokenName, Integer)])]
-> Gen Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Value
pruneZeros (Value -> Value)
-> ([(CurrencySymbol, [(TokenName, Integer)])] -> Value)
-> [(CurrencySymbol, [(TokenName, Integer)])]
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map CurrencySymbol (Map TokenName Integer) -> Value
Value.Value (Map CurrencySymbol (Map TokenName Integer) -> Value)
-> ([(CurrencySymbol, [(TokenName, Integer)])]
    -> Map CurrencySymbol (Map TokenName Integer))
-> [(CurrencySymbol, [(TokenName, Integer)])]
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CurrencySymbol, Map TokenName Integer)]
-> Map CurrencySymbol (Map TokenName Integer)
forall k v. [(k, v)] -> Map k v
AssocMap.unsafeFromList ([(CurrencySymbol, Map TokenName Integer)]
 -> Map CurrencySymbol (Map TokenName Integer))
-> ([(CurrencySymbol, [(TokenName, Integer)])]
    -> [(CurrencySymbol, Map TokenName Integer)])
-> [(CurrencySymbol, [(TokenName, Integer)])]
-> Map CurrencySymbol (Map TokenName Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CurrencySymbol, [(TokenName, Integer)])
 -> (CurrencySymbol, Map TokenName Integer))
-> [(CurrencySymbol, [(TokenName, Integer)])]
-> [(CurrencySymbol, Map TokenName Integer)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (([(TokenName, Integer)] -> Map TokenName Integer)
-> (CurrencySymbol, [(TokenName, Integer)])
-> (CurrencySymbol, Map TokenName Integer)
forall a b. (a -> b) -> (CurrencySymbol, a) -> (CurrencySymbol, b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [(TokenName, Integer)] -> Map TokenName Integer
forall k v. [(k, v)] -> Map k v
AssocMap.unsafeFromList) ([(CurrencySymbol, [(TokenName, Integer)])] -> Gen Value)
-> [(CurrencySymbol, [(TokenName, Integer)])] -> Gen Value
forall a b. (a -> b) -> a -> b
$ [(CurrencySymbol, [(TokenName, Integer)])]
table'
    where
      mkInner :: PLA.CurrencySymbol -> Gen (PLA.CurrencySymbol, [(PLA.TokenName, Integer)])
      mkInner :: CurrencySymbol -> Gen (CurrencySymbol, [(TokenName, Integer)])
mkInner CurrencySymbol
cs =
        (CurrencySymbol
cs,) ([(TokenName, Integer)]
 -> (CurrencySymbol, [(TokenName, Integer)]))
-> Gen [(TokenName, Integer)]
-> Gen (CurrencySymbol, [(TokenName, Integer)])
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> do
          -- Set of non-Ada token names
          Set TokenName
tnSet <- [TokenName] -> Set TokenName
forall a. Ord a => [a] -> Set a
Set.fromList ([TokenName] -> Set TokenName)
-> Gen [TokenName] -> Gen (Set TokenName)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TokenName -> Gen [TokenName]
forall a. Gen a -> Gen [a]
forall (f :: Type -> Type) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary Gen TokenName
genNonAdaTokenName
          let asList :: [TokenName]
asList = Set TokenName -> [TokenName]
forall a. Set a -> [a]
Set.toList Set TokenName
tnSet
          (TokenName -> Gen (TokenName, Integer))
-> [TokenName] -> Gen [(TokenName, Integer)]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (\TokenName
tn -> (TokenName
tn,) (Integer -> (TokenName, Integer))
-> (Positive Integer -> Integer)
-> Positive Integer
-> (TokenName, Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Positive Integer -> Integer
forall a. Positive a -> a
getPositive (Positive Integer -> (TokenName, Integer))
-> Gen (Positive Integer) -> Gen (TokenName, Integer)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Positive Integer)
forall a. Arbitrary a => Gen a
arbitrary) [TokenName]
asList
      genNonAdaTokenName :: Gen PLA.TokenName
      genNonAdaTokenName :: Gen TokenName
genNonAdaTokenName =
        BuiltinByteString -> TokenName
PLA.TokenName (BuiltinByteString -> TokenName)
-> ([Word8] -> BuiltinByteString) -> [Word8] -> TokenName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasToBuiltin a => a -> ToBuiltin a
PlutusTx.toBuiltin @ByteString (ByteString -> BuiltinByteString)
-> ([Word8] -> ByteString) -> [Word8] -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> TokenName) -> Gen [Word8] -> Gen TokenName
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> do
          Int
len <- (Int, Int) -> Gen Int
chooseInt (Int
1, Int
32)
          -- ASCII printable range
          Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
len (Gen Word8 -> Gen [Word8])
-> ((Word8, Word8) -> Gen Word8) -> (Word8, Word8) -> Gen [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8, Word8) -> Gen Word8
forall a. (Bounded a, Integral a) => (a, a) -> Gen a
chooseBoundedIntegral ((Word8, Word8) -> Gen [Word8]) -> (Word8, Word8) -> Gen [Word8]
forall a b. (a -> b) -> a -> b
$ (Word8
33, Word8
126)
  {-# INLINEABLE shrink #-}
  shrink :: UTxOValue -> [UTxOValue]
shrink (UTxOValue (Value.Value Map CurrencySymbol (Map TokenName Integer)
v)) =
    Value -> UTxOValue
UTxOValue (Value -> UTxOValue)
-> (Map CurrencySymbol (Map TokenName Integer) -> Value)
-> Map CurrencySymbol (Map TokenName Integer)
-> UTxOValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map CurrencySymbol (Map TokenName Integer) -> Value
Value.Value (Map CurrencySymbol (Map TokenName Integer) -> UTxOValue)
-> [Map CurrencySymbol (Map TokenName Integer)] -> [UTxOValue]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      -- To ensure we don't break anything, we shrink in only two ways:
      --
      -- 1. Dropping keys (outer or inner)
      -- 2. Shrinking amounts
      --
      -- To make this a bit easier on ourselves, we first 'unpack' the Value
      -- completely, shrink the resulting (nested) list, then 'repack'. As neither
      -- of these changes affect order or uniqueness, we're safe.
      let asList :: [(CurrencySymbol, [(TokenName, Integer)])]
asList = (Map TokenName Integer -> [(TokenName, Integer)])
-> (CurrencySymbol, Map TokenName Integer)
-> (CurrencySymbol, [(TokenName, Integer)])
forall a b. (a -> b) -> (CurrencySymbol, a) -> (CurrencySymbol, b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Map TokenName Integer -> [(TokenName, Integer)]
forall k v. Map k v -> [(k, v)]
AssocMap.toList ((CurrencySymbol, Map TokenName Integer)
 -> (CurrencySymbol, [(TokenName, Integer)]))
-> [(CurrencySymbol, Map TokenName Integer)]
-> [(CurrencySymbol, [(TokenName, Integer)])]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Map CurrencySymbol (Map TokenName Integer)
-> [(CurrencySymbol, Map TokenName Integer)]
forall k v. Map k v -> [(k, v)]
AssocMap.toList Map CurrencySymbol (Map TokenName Integer)
v
      [(CurrencySymbol, [(TokenName, Integer)])]
shrunk <- ((CurrencySymbol, [(TokenName, Integer)])
 -> [(CurrencySymbol, [(TokenName, Integer)])])
-> [(CurrencySymbol, [(TokenName, Integer)])]
-> [[(CurrencySymbol, [(TokenName, Integer)])]]
forall a. (a -> [a]) -> [a] -> [[a]]
forall (f :: Type -> Type) a.
Arbitrary1 f =>
(a -> [a]) -> f a -> [f a]
liftShrink (\(CurrencySymbol
cs, [(TokenName, Integer)]
inner) -> (CurrencySymbol
cs,) ([(TokenName, Integer)]
 -> (CurrencySymbol, [(TokenName, Integer)]))
-> [[(TokenName, Integer)]]
-> [(CurrencySymbol, [(TokenName, Integer)])]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ((TokenName, Integer) -> [(TokenName, Integer)])
-> [(TokenName, Integer)] -> [[(TokenName, Integer)]]
forall a. (a -> [a]) -> [a] -> [[a]]
forall (f :: Type -> Type) a.
Arbitrary1 f =>
(a -> [a]) -> f a -> [f a]
liftShrink (\(TokenName
tn, Integer
amount) -> (TokenName
tn,) (Integer -> (TokenName, Integer))
-> (Positive Integer -> Integer)
-> Positive Integer
-> (TokenName, Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Positive Integer -> Integer
forall a. Positive a -> a
getPositive (Positive Integer -> (TokenName, Integer))
-> [Positive Integer] -> [(TokenName, Integer)]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Positive Integer -> [Positive Integer]
forall a. Arbitrary a => a -> [a]
shrink (Integer -> Positive Integer
forall a. a -> Positive a
Positive Integer
amount)) [(TokenName, Integer)]
inner) [(CurrencySymbol, [(TokenName, Integer)])]
asList
      Map CurrencySymbol (Map TokenName Integer)
-> [Map CurrencySymbol (Map TokenName Integer)]
forall a. a -> [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Map CurrencySymbol (Map TokenName Integer)
 -> [Map CurrencySymbol (Map TokenName Integer)])
-> ([(CurrencySymbol, [(TokenName, Integer)])]
    -> Map CurrencySymbol (Map TokenName Integer))
-> [(CurrencySymbol, [(TokenName, Integer)])]
-> [Map CurrencySymbol (Map TokenName Integer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CurrencySymbol, Map TokenName Integer)]
-> Map CurrencySymbol (Map TokenName Integer)
forall k v. [(k, v)] -> Map k v
AssocMap.unsafeFromList ([(CurrencySymbol, Map TokenName Integer)]
 -> Map CurrencySymbol (Map TokenName Integer))
-> ([(CurrencySymbol, [(TokenName, Integer)])]
    -> [(CurrencySymbol, Map TokenName Integer)])
-> [(CurrencySymbol, [(TokenName, Integer)])]
-> Map CurrencySymbol (Map TokenName Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CurrencySymbol, [(TokenName, Integer)])
 -> (CurrencySymbol, Map TokenName Integer))
-> [(CurrencySymbol, [(TokenName, Integer)])]
-> [(CurrencySymbol, Map TokenName Integer)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (([(TokenName, Integer)] -> Map TokenName Integer)
-> (CurrencySymbol, [(TokenName, Integer)])
-> (CurrencySymbol, Map TokenName Integer)
forall a b. (a -> b) -> (CurrencySymbol, a) -> (CurrencySymbol, b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [(TokenName, Integer)] -> Map TokenName Integer
forall k v. [(k, v)] -> Map k v
AssocMap.unsafeFromList) ([(CurrencySymbol, [(TokenName, Integer)])]
 -> [Map CurrencySymbol (Map TokenName Integer)])
-> [(CurrencySymbol, [(TokenName, Integer)])]
-> [Map CurrencySymbol (Map TokenName Integer)]
forall a b. (a -> b) -> a -> b
$ [(CurrencySymbol, [(TokenName, Integer)])]
shrunk

-- | @since 1.0.0
deriving via PLA.Value instance CoArbitrary UTxOValue

-- | @since 1.0.0
instance Function UTxOValue where
  {-# INLINEABLE function #-}
  function :: forall b. (UTxOValue -> b) -> UTxOValue :-> b
function = (UTxOValue -> Value)
-> (Value -> UTxOValue) -> (UTxOValue -> b) -> UTxOValue :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap UTxOValue -> Value
forall a b. Coercible a b => a -> b
coerce Value -> UTxOValue
UTxOValue

-- | @since 1.0.0
getUtxoValue :: UTxOValue -> PLA.Value
getUtxoValue :: UTxOValue -> Value
getUtxoValue = UTxOValue -> Value
forall a b. Coercible a b => a -> b
coerce

{- | A 'PLA.Value' that contains zero Ada.

= Note

This is designed to act as a modifier, and thus, we expose the constructor
even though it preserves invariants. If you use the constructor directly,
be /very/ certain that the Value being wrapped satisfies the invariants
described above: failing to do so means all guarantees of this type are off
the table.

@since 1.0.0
-}
newtype NonAdaValue = NonAdaValue PLA.Value
  deriving
    ( -- | @since 1.0.0
      NonAdaValue -> NonAdaValue -> Bool
(NonAdaValue -> NonAdaValue -> Bool)
-> (NonAdaValue -> NonAdaValue -> Bool) -> Eq NonAdaValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NonAdaValue -> NonAdaValue -> Bool
== :: NonAdaValue -> NonAdaValue -> Bool
$c/= :: NonAdaValue -> NonAdaValue -> Bool
/= :: NonAdaValue -> NonAdaValue -> Bool
Eq
    )
    via PLA.Value
  deriving stock
    ( -- | @since 1.0.0
      Int -> NonAdaValue -> ShowS
[NonAdaValue] -> ShowS
NonAdaValue -> String
(Int -> NonAdaValue -> ShowS)
-> (NonAdaValue -> String)
-> ([NonAdaValue] -> ShowS)
-> Show NonAdaValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NonAdaValue -> ShowS
showsPrec :: Int -> NonAdaValue -> ShowS
$cshow :: NonAdaValue -> String
show :: NonAdaValue -> String
$cshowList :: [NonAdaValue] -> ShowS
showList :: [NonAdaValue] -> ShowS
Show
    )

-- | @since 1.0.0
instance Arbitrary NonAdaValue where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen NonAdaValue
arbitrary =
    Value -> NonAdaValue
NonAdaValue (Value -> NonAdaValue) -> Gen Value -> Gen NonAdaValue
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      -- Generate a set of currency symbols that aren't Ada
      Set CurrencySymbol
keySet <- [CurrencySymbol] -> Set CurrencySymbol
forall a. Ord a => [a] -> Set a
Set.fromList ([CurrencySymbol] -> Set CurrencySymbol)
-> Gen [CurrencySymbol] -> Gen (Set CurrencySymbol)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen CurrencySymbol -> Gen [CurrencySymbol]
forall a. Gen a -> Gen [a]
forall (f :: Type -> Type) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary (BuiltinByteString -> CurrencySymbol
PLA.CurrencySymbol (BuiltinByteString -> CurrencySymbol)
-> (Blake2b244Hash -> BuiltinByteString)
-> Blake2b244Hash
-> CurrencySymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blake2b244Hash -> BuiltinByteString
getBlake2b244Hash (Blake2b244Hash -> CurrencySymbol)
-> Gen Blake2b244Hash -> Gen CurrencySymbol
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Blake2b244Hash
forall a. Arbitrary a => Gen a
arbitrary)
      let keyList :: [CurrencySymbol]
keyList = Set CurrencySymbol -> [CurrencySymbol]
forall a. Set a -> [a]
Set.toList Set CurrencySymbol
keySet
      -- For each key, generate a set of token name keys that aren't Ada
      [(CurrencySymbol, [(TokenName, Integer)])]
keyVals <- (CurrencySymbol -> Gen (CurrencySymbol, [(TokenName, Integer)]))
-> [CurrencySymbol]
-> Gen [(CurrencySymbol, [(TokenName, Integer)])]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Int -> Int)
-> Gen (CurrencySymbol, [(TokenName, Integer)])
-> Gen (CurrencySymbol, [(TokenName, Integer)])
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
8) (Gen (CurrencySymbol, [(TokenName, Integer)])
 -> Gen (CurrencySymbol, [(TokenName, Integer)]))
-> (CurrencySymbol -> Gen (CurrencySymbol, [(TokenName, Integer)]))
-> CurrencySymbol
-> Gen (CurrencySymbol, [(TokenName, Integer)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CurrencySymbol -> Gen (CurrencySymbol, [(TokenName, Integer)])
mkInner) [CurrencySymbol]
keyList
      Value -> Gen Value
forall a. a -> Gen a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
        (Value -> Gen Value)
-> ([(CurrencySymbol, [(TokenName, Integer)])] -> Value)
-> [(CurrencySymbol, [(TokenName, Integer)])]
-> Gen Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Value
withZeroAda
        (Value -> Value)
-> ([(CurrencySymbol, [(TokenName, Integer)])] -> Value)
-> [(CurrencySymbol, [(TokenName, Integer)])]
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CurrencySymbol, [(TokenName, Integer)]) -> Value)
-> [(CurrencySymbol, [(TokenName, Integer)])] -> Value
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(CurrencySymbol
cs, [(TokenName, Integer)]
vals) -> ((TokenName, Integer) -> Value) -> [(TokenName, Integer)] -> Value
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((TokenName -> Integer -> Value) -> (TokenName, Integer) -> Value
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (CurrencySymbol -> TokenName -> Integer -> Value
Value.singleton CurrencySymbol
cs)) [(TokenName, Integer)]
vals)
        ([(CurrencySymbol, [(TokenName, Integer)])] -> Gen Value)
-> [(CurrencySymbol, [(TokenName, Integer)])] -> Gen Value
forall a b. (a -> b) -> a -> b
$ [(CurrencySymbol, [(TokenName, Integer)])]
keyVals
    where
      mkInner :: PLA.CurrencySymbol -> Gen (PLA.CurrencySymbol, [(PLA.TokenName, Integer)])
      mkInner :: CurrencySymbol -> Gen (CurrencySymbol, [(TokenName, Integer)])
mkInner CurrencySymbol
cs =
        (CurrencySymbol
cs,) ([(TokenName, Integer)]
 -> (CurrencySymbol, [(TokenName, Integer)]))
-> (NonEmptyList (TokenName, Integer) -> [(TokenName, Integer)])
-> NonEmptyList (TokenName, Integer)
-> (CurrencySymbol, [(TokenName, Integer)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (TokenName, Integer) -> [(TokenName, Integer)]
forall a. Set a -> [a]
Set.toList (Set (TokenName, Integer) -> [(TokenName, Integer)])
-> (NonEmptyList (TokenName, Integer) -> Set (TokenName, Integer))
-> NonEmptyList (TokenName, Integer)
-> [(TokenName, Integer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(TokenName, Integer)] -> Set (TokenName, Integer)
forall a. Ord a => [a] -> Set a
Set.fromList ([(TokenName, Integer)] -> Set (TokenName, Integer))
-> (NonEmptyList (TokenName, Integer) -> [(TokenName, Integer)])
-> NonEmptyList (TokenName, Integer)
-> Set (TokenName, Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyList (TokenName, Integer) -> [(TokenName, Integer)]
forall a. NonEmptyList a -> [a]
getNonEmpty (NonEmptyList (TokenName, Integer)
 -> (CurrencySymbol, [(TokenName, Integer)]))
-> Gen (NonEmptyList (TokenName, Integer))
-> Gen (CurrencySymbol, [(TokenName, Integer)])
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (TokenName, Integer) -> Gen (NonEmptyList (TokenName, Integer))
forall a. Gen a -> Gen (NonEmptyList a)
forall (f :: Type -> Type) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary ((,) (TokenName -> Integer -> (TokenName, Integer))
-> Gen TokenName -> Gen (Integer -> (TokenName, Integer))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TokenName
genNonAdaTokenName Gen (Integer -> (TokenName, Integer))
-> Gen Integer -> Gen (TokenName, Integer)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Gen Integer
forall a. Arbitrary a => Gen a
arbitrary)
      genNonAdaTokenName :: Gen PLA.TokenName
      genNonAdaTokenName :: Gen TokenName
genNonAdaTokenName = ([Word8] -> TokenName) -> Gen [Word8] -> Gen TokenName
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (BuiltinByteString -> TokenName
PLA.TokenName (BuiltinByteString -> TokenName)
-> ([Word8] -> BuiltinByteString) -> [Word8] -> TokenName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasToBuiltin a => a -> ToBuiltin a
PlutusTx.toBuiltin @ByteString (ByteString -> BuiltinByteString)
-> ([Word8] -> ByteString) -> [Word8] -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack) (Gen [Word8] -> Gen TokenName)
-> ((Int -> Gen [Word8]) -> Gen [Word8])
-> (Int -> Gen [Word8])
-> Gen TokenName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Gen [Word8]) -> Gen [Word8]
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen [Word8]) -> Gen TokenName)
-> (Int -> Gen [Word8]) -> Gen TokenName
forall a b. (a -> b) -> a -> b
$ \Int
size -> do
        Int
len <- Int -> Gen Int -> Gen Int
forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
size (Gen Int -> Gen Int)
-> ((Int, Int) -> Gen Int) -> (Int, Int) -> Gen Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Gen Int
chooseInt ((Int, Int) -> Gen Int) -> (Int, Int) -> Gen Int
forall a b. (a -> b) -> a -> b
$ (Int
1, Int
32)
        Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
len (Gen Word8 -> Gen [Word8])
-> ((Word8, Word8) -> Gen Word8) -> (Word8, Word8) -> Gen [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8, Word8) -> Gen Word8
forall a. (Bounded a, Integral a) => (a, a) -> Gen a
chooseBoundedIntegral ((Word8, Word8) -> Gen [Word8]) -> (Word8, Word8) -> Gen [Word8]
forall a b. (a -> b) -> a -> b
$ (Word8
33, Word8
126)
  {-# INLINEABLE shrink #-}
  -- Since we can't shrink keys anyway, we just borrow the stock shrinker
  shrink :: NonAdaValue -> [NonAdaValue]
shrink (NonAdaValue Value
v) = Value -> NonAdaValue
NonAdaValue (Value -> NonAdaValue) -> (Value -> Value) -> Value -> NonAdaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Value
withZeroAda (Value -> NonAdaValue) -> [Value] -> [NonAdaValue]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> [Value]
forall a. Arbitrary a => a -> [a]
shrink Value
v

-- | @since 1.0.0
deriving via PLA.Value instance CoArbitrary NonAdaValue

-- | @since 1.0.0
instance Function NonAdaValue where
  {-# INLINEABLE function #-}
  function :: forall b. (NonAdaValue -> b) -> NonAdaValue :-> b
function = (NonAdaValue -> Value)
-> (Value -> NonAdaValue)
-> (NonAdaValue -> b)
-> NonAdaValue :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap NonAdaValue -> Value
forall a b. Coercible a b => a -> b
coerce Value -> NonAdaValue
NonAdaValue

-- | @since 1.0.0
getNonAdaValue :: NonAdaValue -> PLA.Value
getNonAdaValue :: NonAdaValue -> Value
getNonAdaValue = NonAdaValue -> Value
forall a b. Coercible a b => a -> b
coerce

{- | This is the most general possible instance for 'PLA.Value'. In particular,
this can have zero values, and does not treat the Ada symbol or token name
specially.

@since 1.0.0
-}
instance Arbitrary PLA.Value where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen Value
arbitrary = Map CurrencySymbol (Map TokenName Integer) -> Value
PLA.Value (Map CurrencySymbol (Map TokenName Integer) -> Value)
-> Gen (Map CurrencySymbol (Map TokenName Integer)) -> Gen Value
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map TokenName Integer)
-> Gen (Map CurrencySymbol (Map TokenName Integer))
forall a. Gen a -> Gen (Map CurrencySymbol a)
forall (f :: Type -> Type) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary ((Int -> Int)
-> Gen (Map TokenName Integer) -> Gen (Map TokenName Integer)
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
4) Gen (Map TokenName Integer)
forall a. Arbitrary a => Gen a
arbitrary)
  {-# INLINEABLE shrink #-}
  shrink :: Value -> [Value]
shrink = (Map CurrencySymbol (Map TokenName Integer) -> Value)
-> [Map CurrencySymbol (Map TokenName Integer)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Map CurrencySymbol (Map TokenName Integer) -> Value
PLA.Value ([Map CurrencySymbol (Map TokenName Integer)] -> [Value])
-> (Value -> [Map CurrencySymbol (Map TokenName Integer)])
-> Value
-> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map CurrencySymbol (Map TokenName Integer)
-> [Map CurrencySymbol (Map TokenName Integer)]
forall a. Arbitrary a => a -> [a]
shrink (Map CurrencySymbol (Map TokenName Integer)
 -> [Map CurrencySymbol (Map TokenName Integer)])
-> (Value -> Map CurrencySymbol (Map TokenName Integer))
-> Value
-> [Map CurrencySymbol (Map TokenName Integer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Map CurrencySymbol (Map TokenName Integer)
PLA.getValue

-- | @since 1.0.0
deriving via
  (AssocMap.Map PLA.CurrencySymbol (AssocMap.Map PLA.TokenName Integer))
  instance
    CoArbitrary PLA.Value

-- | @since 1.0.0
instance Function PLA.Value where
  {-# INLINEABLE function #-}
  function :: forall b. (Value -> b) -> Value :-> b
function = (Value -> Map CurrencySymbol (Map TokenName Integer))
-> (Map CurrencySymbol (Map TokenName Integer) -> Value)
-> (Value -> b)
-> Value :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Value -> Map CurrencySymbol (Map TokenName Integer)
forall a b. Coercible a b => a -> b
coerce Map CurrencySymbol (Map TokenName Integer) -> Value
PLA.Value

{- | This instance can generate the Ada token name, with faithful odds. It is
limited to generating printable ASCII names, rather than the full UTF-8
range. We did this for two reasons:

1. For testing purposes, we should prioritize readability, hence our choice
   of a textual representation; and
2. It is difficult to work within the size limit (32 bytes) when generating
   UTF-8.

@since 1.0.0
-}
instance Arbitrary PLA.TokenName where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen TokenName
arbitrary =
    ([Word8] -> TokenName) -> Gen [Word8] -> Gen TokenName
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (BuiltinByteString -> TokenName
PLA.TokenName (BuiltinByteString -> TokenName)
-> ([Word8] -> BuiltinByteString) -> [Word8] -> TokenName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasToBuiltin a => a -> ToBuiltin a
PlutusTx.toBuiltin @ByteString (ByteString -> BuiltinByteString)
-> ([Word8] -> ByteString) -> [Word8] -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack) (Gen [Word8] -> Gen TokenName)
-> ((Int -> Gen [Word8]) -> Gen [Word8])
-> (Int -> Gen [Word8])
-> Gen TokenName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Gen [Word8]) -> Gen [Word8]
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen [Word8]) -> Gen TokenName)
-> (Int -> Gen [Word8]) -> Gen TokenName
forall a b. (a -> b) -> a -> b
$ \Int
size -> do
      -- We want the length to be size-dependent
      Int
len <- Int -> Gen Int -> Gen Int
forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
size (Gen Int -> Gen Int)
-> ((Int, Int) -> Gen Int) -> (Int, Int) -> Gen Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Gen Int
chooseInt ((Int, Int) -> Gen Int) -> (Int, Int) -> Gen Int
forall a b. (a -> b) -> a -> b
$ (Int
0, Int
32)
      -- But the bytes themselves should not be: the whole ASCII printable range
      -- should be available always
      Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
len (Gen Word8 -> Gen [Word8])
-> ((Word8, Word8) -> Gen Word8) -> (Word8, Word8) -> Gen [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8, Word8) -> Gen Word8
forall a. (Bounded a, Integral a) => (a, a) -> Gen a
chooseBoundedIntegral ((Word8, Word8) -> Gen [Word8]) -> (Word8, Word8) -> Gen [Word8]
forall a b. (a -> b) -> a -> b
$ (Word8
33, Word8
126)
  {-# INLINEABLE shrink #-}
  shrink :: TokenName -> [TokenName]
shrink TokenName
tn =
    BuiltinByteString -> TokenName
PLA.TokenName (BuiltinByteString -> TokenName)
-> (ByteString -> BuiltinByteString) -> ByteString -> TokenName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasToBuiltin a => a -> ToBuiltin a
PlutusTx.toBuiltin @ByteString (ByteString -> TokenName) -> [ByteString] -> [TokenName]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      let asList :: [Word8]
asList = ByteString -> [Word8]
BS.unpack (ByteString -> [Word8])
-> (TokenName -> ByteString) -> TokenName -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall arep. HasFromBuiltin arep => arep -> FromBuiltin arep
PlutusTx.fromBuiltin @PlutusTx.BuiltinByteString (BuiltinByteString -> ByteString)
-> (TokenName -> BuiltinByteString) -> TokenName -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenName -> BuiltinByteString
forall a b. Coercible a b => a -> b
coerce (TokenName -> [Word8]) -> TokenName -> [Word8]
forall a b. (a -> b) -> a -> b
$ TokenName
tn
      ByteString
bs <- [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> [[Word8]] -> [ByteString]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word8] -> [[Word8]]
forall a. Arbitrary a => a -> [a]
shrink [Word8]
asList
      Bool -> [()]
forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard ((Word8 -> Bool) -> ByteString -> Bool
BS.all (\Word8
w8 -> Word8
w8 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
33 Bool -> Bool -> Bool
&& Word8
w8 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
126) ByteString
bs)
      ByteString -> [ByteString]
forall a. a -> [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ByteString
bs

-- | @since 1.0.0
deriving via PlutusTx.BuiltinByteString instance CoArbitrary PLA.TokenName

-- | @since 1.0.0
instance Function PLA.TokenName where
  {-# INLINEABLE function #-}
  function :: forall b. (TokenName -> b) -> TokenName :-> b
function = (TokenName -> BuiltinByteString)
-> (BuiltinByteString -> TokenName)
-> (TokenName -> b)
-> TokenName :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap TokenName -> BuiltinByteString
forall a b. Coercible a b => a -> b
coerce BuiltinByteString -> TokenName
PLA.TokenName

-- Helpers

-- This is frankly a bizarre omission
instance Arbitrary1 NonEmptyList where
  {-# INLINEABLE liftArbitrary #-}
  liftArbitrary :: forall a. Gen a -> Gen (NonEmptyList a)
liftArbitrary Gen a
genInner =
    [a] -> NonEmptyList a
forall a. [a] -> NonEmptyList a
NonEmpty ([a] -> NonEmptyList a) -> Gen [a] -> Gen (NonEmptyList a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      a
x <- Gen a
genInner
      [a]
xs <- Gen a -> Gen [a]
forall a. Gen a -> Gen [a]
forall (f :: Type -> Type) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary Gen a
genInner
      [a] -> Gen [a]
forall a. a -> Gen a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([a] -> Gen [a]) -> [a] -> Gen [a]
forall a b. (a -> b) -> a -> b
$ a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
  {-# INLINEABLE liftShrink #-}
  liftShrink :: forall a. (a -> [a]) -> NonEmptyList a -> [NonEmptyList a]
liftShrink a -> [a]
shrinkInner (NonEmpty [a]
ell) =
    [a] -> NonEmptyList a
forall a. [a] -> NonEmptyList a
NonEmpty ([a] -> NonEmptyList a) -> [[a]] -> [NonEmptyList a]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> case [a]
ell of
      [] -> []
      (a
x : [a]
xs) -> (:) (a -> [a] -> [a]) -> [a] -> [[a] -> [a]]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a]
shrinkInner a
x [[a] -> [a]] -> [[a]] -> [[a]]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (a -> [a]) -> [a] -> [[a]]
forall a. (a -> [a]) -> [a] -> [[a]]
forall (f :: Type -> Type) a.
Arbitrary1 f =>
(a -> [a]) -> f a -> [f a]
liftShrink a -> [a]
shrinkInner [a]
xs

{- | A 'PLA.Value' containing only Ada, suitable for fees. Furthermore, the
Ada quantity is positive.

= Note

This is designed to act as a modifier, and thus, we expose the constructor
even though it preserves invariants. If you use the constructor directly,
be /very/ certain that the Value being wrapped satisfies the invariants
described above: failing to do so means all guarantees of this type are off
the table.

@since 1.0.0
-}
newtype FeeValue = FeeValue PLA.Value
  deriving
    ( -- | @since 1.0.0
      FeeValue -> FeeValue -> Bool
(FeeValue -> FeeValue -> Bool)
-> (FeeValue -> FeeValue -> Bool) -> Eq FeeValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FeeValue -> FeeValue -> Bool
== :: FeeValue -> FeeValue -> Bool
$c/= :: FeeValue -> FeeValue -> Bool
/= :: FeeValue -> FeeValue -> Bool
Eq
    )
    via PLA.Value
  deriving stock
    ( -- | @since 1.0.0
      Int -> FeeValue -> ShowS
[FeeValue] -> ShowS
FeeValue -> String
(Int -> FeeValue -> ShowS)
-> (FeeValue -> String) -> ([FeeValue] -> ShowS) -> Show FeeValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FeeValue -> ShowS
showsPrec :: Int -> FeeValue -> ShowS
$cshow :: FeeValue -> String
show :: FeeValue -> String
$cshowList :: [FeeValue] -> ShowS
showList :: [FeeValue] -> ShowS
Show
    )

-- | @since 1.0.0
instance Arbitrary FeeValue where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen FeeValue
arbitrary = Value -> FeeValue
FeeValue (Value -> FeeValue)
-> (Positive Integer -> Value) -> Positive Integer -> FeeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CurrencySymbol -> TokenName -> Integer -> Value
PLA.singleton CurrencySymbol
PLA.adaSymbol TokenName
PLA.adaToken (Integer -> Value)
-> (Positive Integer -> Integer) -> Positive Integer -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Positive Integer -> Integer
forall a. Positive a -> a
getPositive (Positive Integer -> FeeValue)
-> Gen (Positive Integer) -> Gen FeeValue
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Positive Integer)
forall a. Arbitrary a => Gen a
arbitrary
  {-# INLINEABLE shrink #-}
  shrink :: FeeValue -> [FeeValue]
shrink (FeeValue Value
v) =
    Value -> FeeValue
FeeValue (Value -> FeeValue) -> (Integer -> Value) -> Integer -> FeeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CurrencySymbol -> TokenName -> Integer -> Value
PLA.singleton CurrencySymbol
PLA.adaSymbol TokenName
PLA.adaToken (Integer -> FeeValue) -> [Integer] -> [FeeValue]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      let adaAmount :: Integer
adaAmount = Value -> CurrencySymbol -> TokenName -> Integer
Value.valueOf Value
v CurrencySymbol
PLA.adaSymbol TokenName
PLA.adaToken
      Positive Integer
adaAmount' <- Positive Integer -> [Positive Integer]
forall a. Arbitrary a => a -> [a]
shrink (Integer -> Positive Integer
forall a. a -> Positive a
Positive Integer
adaAmount)
      Integer -> [Integer]
forall a. a -> [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Integer
adaAmount'

-- | @since 1.0.0
deriving via PLA.Value instance CoArbitrary FeeValue

-- | @since 1.0.0
instance Function FeeValue where
  {-# INLINEABLE function #-}
  function :: forall b. (FeeValue -> b) -> FeeValue :-> b
function = (FeeValue -> Value)
-> (Value -> FeeValue) -> (FeeValue -> b) -> FeeValue :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap FeeValue -> Value
forall a b. Coercible a b => a -> b
coerce Value -> FeeValue
FeeValue

-- | @since 1.0.0
getFeeValue :: FeeValue -> PLA.Value
getFeeValue :: FeeValue -> Value
getFeeValue = FeeValue -> Value
forall a b. Coercible a b => a -> b
coerce

{- | Similar to 'NonAdaValue', but also does not have nonzero amounts.

= Note

This is designed to act as a modifier, and thus, we expose the constructor
even though it preserves invariants. If you use the constructor directly,
be /very/ certain that the Value being wrapped satisfies the invariants
described above: failing to do so means all guarantees of this type are off
the table.

@since 1.0.3
-}
newtype MintValue = MintValue PLA.Value
  deriving
    ( -- | @since 1.0.3
      MintValue -> MintValue -> Bool
(MintValue -> MintValue -> Bool)
-> (MintValue -> MintValue -> Bool) -> Eq MintValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MintValue -> MintValue -> Bool
== :: MintValue -> MintValue -> Bool
$c/= :: MintValue -> MintValue -> Bool
/= :: MintValue -> MintValue -> Bool
Eq
    )
    via PLA.Value
  deriving stock
    ( -- | @since 1.0.3
      Int -> MintValue -> ShowS
[MintValue] -> ShowS
MintValue -> String
(Int -> MintValue -> ShowS)
-> (MintValue -> String)
-> ([MintValue] -> ShowS)
-> Show MintValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MintValue -> ShowS
showsPrec :: Int -> MintValue -> ShowS
$cshow :: MintValue -> String
show :: MintValue -> String
$cshowList :: [MintValue] -> ShowS
showList :: [MintValue] -> ShowS
Show
    )

-- @since WIP
deriving via PLA.Value instance Pretty MintValue

-- | @since 1.0.3
instance Arbitrary MintValue where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen MintValue
arbitrary =
    Value -> MintValue
MintValue (Value -> MintValue) -> Gen Value -> Gen MintValue
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      -- Generate a set of currency symbols that aren't Ada
      Set CurrencySymbol
keySet <- [CurrencySymbol] -> Set CurrencySymbol
forall a. Ord a => [a] -> Set a
Set.fromList ([CurrencySymbol] -> Set CurrencySymbol)
-> Gen [CurrencySymbol] -> Gen (Set CurrencySymbol)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen CurrencySymbol -> Gen [CurrencySymbol]
forall a. Gen a -> Gen [a]
forall (f :: Type -> Type) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary (BuiltinByteString -> CurrencySymbol
PLA.CurrencySymbol (BuiltinByteString -> CurrencySymbol)
-> (Blake2b244Hash -> BuiltinByteString)
-> Blake2b244Hash
-> CurrencySymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blake2b244Hash -> BuiltinByteString
getBlake2b244Hash (Blake2b244Hash -> CurrencySymbol)
-> Gen Blake2b244Hash -> Gen CurrencySymbol
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Blake2b244Hash
forall a. Arbitrary a => Gen a
arbitrary)
      let keyList :: [CurrencySymbol]
keyList = Set CurrencySymbol -> [CurrencySymbol]
forall a. Set a -> [a]
Set.toList Set CurrencySymbol
keySet
      -- For each key, generate a set of token name keys that aren't Ada
      [(CurrencySymbol, [(TokenName, Integer)])]
keyVals <- (CurrencySymbol -> Gen (CurrencySymbol, [(TokenName, Integer)]))
-> [CurrencySymbol]
-> Gen [(CurrencySymbol, [(TokenName, Integer)])]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Int -> Int)
-> Gen (CurrencySymbol, [(TokenName, Integer)])
-> Gen (CurrencySymbol, [(TokenName, Integer)])
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
8) (Gen (CurrencySymbol, [(TokenName, Integer)])
 -> Gen (CurrencySymbol, [(TokenName, Integer)]))
-> (CurrencySymbol -> Gen (CurrencySymbol, [(TokenName, Integer)]))
-> CurrencySymbol
-> Gen (CurrencySymbol, [(TokenName, Integer)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CurrencySymbol -> Gen (CurrencySymbol, [(TokenName, Integer)])
mkInner) [CurrencySymbol]
keyList
      Value -> Gen Value
forall a. a -> Gen a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
        (Value -> Gen Value)
-> ([(CurrencySymbol, [(TokenName, Integer)])] -> Value)
-> [(CurrencySymbol, [(TokenName, Integer)])]
-> Gen Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Value
withZeroAda
        (Value -> Value)
-> ([(CurrencySymbol, [(TokenName, Integer)])] -> Value)
-> [(CurrencySymbol, [(TokenName, Integer)])]
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CurrencySymbol, [(TokenName, Integer)]) -> Value)
-> [(CurrencySymbol, [(TokenName, Integer)])] -> Value
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(CurrencySymbol
cs, [(TokenName, Integer)]
vals) -> ((TokenName, Integer) -> Value) -> [(TokenName, Integer)] -> Value
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((TokenName -> Integer -> Value) -> (TokenName, Integer) -> Value
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (CurrencySymbol -> TokenName -> Integer -> Value
Value.singleton CurrencySymbol
cs)) [(TokenName, Integer)]
vals)
        ([(CurrencySymbol, [(TokenName, Integer)])] -> Gen Value)
-> [(CurrencySymbol, [(TokenName, Integer)])] -> Gen Value
forall a b. (a -> b) -> a -> b
$ [(CurrencySymbol, [(TokenName, Integer)])]
keyVals
    where
      mkInner :: PLA.CurrencySymbol -> Gen (PLA.CurrencySymbol, [(PLA.TokenName, Integer)])
      mkInner :: CurrencySymbol -> Gen (CurrencySymbol, [(TokenName, Integer)])
mkInner CurrencySymbol
cs =
        (CurrencySymbol
cs,)
          ([(TokenName, Integer)]
 -> (CurrencySymbol, [(TokenName, Integer)]))
-> (NonEmptyList (TokenName, Integer) -> [(TokenName, Integer)])
-> NonEmptyList (TokenName, Integer)
-> (CurrencySymbol, [(TokenName, Integer)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (TokenName, Integer) -> [(TokenName, Integer)]
forall a. Set a -> [a]
Set.toList
          (Set (TokenName, Integer) -> [(TokenName, Integer)])
-> (NonEmptyList (TokenName, Integer) -> Set (TokenName, Integer))
-> NonEmptyList (TokenName, Integer)
-> [(TokenName, Integer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(TokenName, Integer)] -> Set (TokenName, Integer)
forall a. Ord a => [a] -> Set a
Set.fromList
          ([(TokenName, Integer)] -> Set (TokenName, Integer))
-> (NonEmptyList (TokenName, Integer) -> [(TokenName, Integer)])
-> NonEmptyList (TokenName, Integer)
-> Set (TokenName, Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyList (TokenName, Integer) -> [(TokenName, Integer)]
forall a. NonEmptyList a -> [a]
getNonEmpty
          (NonEmptyList (TokenName, Integer)
 -> (CurrencySymbol, [(TokenName, Integer)]))
-> Gen (NonEmptyList (TokenName, Integer))
-> Gen (CurrencySymbol, [(TokenName, Integer)])
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (TokenName, Integer) -> Gen (NonEmptyList (TokenName, Integer))
forall a. Gen a -> Gen (NonEmptyList a)
forall (f :: Type -> Type) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary ((,) (TokenName -> Integer -> (TokenName, Integer))
-> Gen TokenName -> Gen (Integer -> (TokenName, Integer))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TokenName
genNonAdaTokenName Gen (Integer -> (TokenName, Integer))
-> Gen Integer -> Gen (TokenName, Integer)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (NonZero Integer -> Integer
forall a. NonZero a -> a
getNonZero (NonZero Integer -> Integer)
-> Gen (NonZero Integer) -> Gen Integer
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NonZero Integer)
forall a. Arbitrary a => Gen a
arbitrary))
      genNonAdaTokenName :: Gen PLA.TokenName
      genNonAdaTokenName :: Gen TokenName
genNonAdaTokenName = ([Word8] -> TokenName) -> Gen [Word8] -> Gen TokenName
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (BuiltinByteString -> TokenName
PLA.TokenName (BuiltinByteString -> TokenName)
-> ([Word8] -> BuiltinByteString) -> [Word8] -> TokenName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasToBuiltin a => a -> ToBuiltin a
PlutusTx.toBuiltin @ByteString (ByteString -> BuiltinByteString)
-> ([Word8] -> ByteString) -> [Word8] -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack) (Gen [Word8] -> Gen TokenName)
-> ((Int -> Gen [Word8]) -> Gen [Word8])
-> (Int -> Gen [Word8])
-> Gen TokenName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Gen [Word8]) -> Gen [Word8]
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen [Word8]) -> Gen TokenName)
-> (Int -> Gen [Word8]) -> Gen TokenName
forall a b. (a -> b) -> a -> b
$ \Int
size -> do
        Int
len <- Int -> Gen Int -> Gen Int
forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
size (Gen Int -> Gen Int)
-> ((Int, Int) -> Gen Int) -> (Int, Int) -> Gen Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Gen Int
chooseInt ((Int, Int) -> Gen Int) -> (Int, Int) -> Gen Int
forall a b. (a -> b) -> a -> b
$ (Int
1, Int
32)
        Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
len (Gen Word8 -> Gen [Word8])
-> ((Word8, Word8) -> Gen Word8) -> (Word8, Word8) -> Gen [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8, Word8) -> Gen Word8
forall a. (Bounded a, Integral a) => (a, a) -> Gen a
chooseBoundedIntegral ((Word8, Word8) -> Gen [Word8]) -> (Word8, Word8) -> Gen [Word8]
forall a b. (a -> b) -> a -> b
$ (Word8
33, Word8
126)
  {-# INLINEABLE shrink #-}
  shrink :: MintValue -> [MintValue]
shrink (MintValue (Value.Value Map CurrencySymbol (Map TokenName Integer)
v)) =
    Value -> MintValue
MintValue (Value -> MintValue)
-> (Map CurrencySymbol (Map TokenName Integer) -> Value)
-> Map CurrencySymbol (Map TokenName Integer)
-> MintValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Value
withZeroAda (Value -> Value)
-> (Map CurrencySymbol (Map TokenName Integer) -> Value)
-> Map CurrencySymbol (Map TokenName Integer)
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map CurrencySymbol (Map TokenName Integer) -> Value
Value.Value (Map CurrencySymbol (Map TokenName Integer) -> MintValue)
-> [Map CurrencySymbol (Map TokenName Integer)] -> [MintValue]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      -- To ensure we don't break anything, we shrink in only two ways:
      --
      -- 1. Dropping keys (outer or inner)
      -- 2. Shrinking amounts
      --
      -- To make this a bit easier on ourselves, we first 'unpack' the Value
      -- completely, shrink the resulting (nested) list, then 'repack'. As neither
      -- of these changes affect order or uniqueness, we're safe.
      let asList :: [(CurrencySymbol, [(TokenName, Integer)])]
asList = (Map TokenName Integer -> [(TokenName, Integer)])
-> (CurrencySymbol, Map TokenName Integer)
-> (CurrencySymbol, [(TokenName, Integer)])
forall a b. (a -> b) -> (CurrencySymbol, a) -> (CurrencySymbol, b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Map TokenName Integer -> [(TokenName, Integer)]
forall k v. Map k v -> [(k, v)]
AssocMap.toList ((CurrencySymbol, Map TokenName Integer)
 -> (CurrencySymbol, [(TokenName, Integer)]))
-> [(CurrencySymbol, Map TokenName Integer)]
-> [(CurrencySymbol, [(TokenName, Integer)])]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Map CurrencySymbol (Map TokenName Integer)
-> [(CurrencySymbol, Map TokenName Integer)]
forall k v. Map k v -> [(k, v)]
AssocMap.toList Map CurrencySymbol (Map TokenName Integer)
v
      [(CurrencySymbol, [(TokenName, Integer)])]
shrunk <- ((CurrencySymbol, [(TokenName, Integer)])
 -> [(CurrencySymbol, [(TokenName, Integer)])])
-> [(CurrencySymbol, [(TokenName, Integer)])]
-> [[(CurrencySymbol, [(TokenName, Integer)])]]
forall a. (a -> [a]) -> [a] -> [[a]]
forall (f :: Type -> Type) a.
Arbitrary1 f =>
(a -> [a]) -> f a -> [f a]
liftShrink (\(CurrencySymbol
cs, [(TokenName, Integer)]
inner) -> (CurrencySymbol
cs,) ([(TokenName, Integer)]
 -> (CurrencySymbol, [(TokenName, Integer)]))
-> [[(TokenName, Integer)]]
-> [(CurrencySymbol, [(TokenName, Integer)])]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ((TokenName, Integer) -> [(TokenName, Integer)])
-> [(TokenName, Integer)] -> [[(TokenName, Integer)]]
forall a. (a -> [a]) -> [a] -> [[a]]
forall (f :: Type -> Type) a.
Arbitrary1 f =>
(a -> [a]) -> f a -> [f a]
liftShrink (\(TokenName
tn, Integer
amount) -> (TokenName
tn,) (Integer -> (TokenName, Integer))
-> (NonZero Integer -> Integer)
-> NonZero Integer
-> (TokenName, Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonZero Integer -> Integer
forall a. NonZero a -> a
getNonZero (NonZero Integer -> (TokenName, Integer))
-> [NonZero Integer] -> [(TokenName, Integer)]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> NonZero Integer -> [NonZero Integer]
forall a. Arbitrary a => a -> [a]
shrink (Integer -> NonZero Integer
forall a. a -> NonZero a
NonZero Integer
amount)) [(TokenName, Integer)]
inner) [(CurrencySymbol, [(TokenName, Integer)])]
asList
      Map CurrencySymbol (Map TokenName Integer)
-> [Map CurrencySymbol (Map TokenName Integer)]
forall a. a -> [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Map CurrencySymbol (Map TokenName Integer)
 -> [Map CurrencySymbol (Map TokenName Integer)])
-> ([(CurrencySymbol, [(TokenName, Integer)])]
    -> Map CurrencySymbol (Map TokenName Integer))
-> [(CurrencySymbol, [(TokenName, Integer)])]
-> [Map CurrencySymbol (Map TokenName Integer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CurrencySymbol, Map TokenName Integer)]
-> Map CurrencySymbol (Map TokenName Integer)
forall k v. [(k, v)] -> Map k v
AssocMap.unsafeFromList ([(CurrencySymbol, Map TokenName Integer)]
 -> Map CurrencySymbol (Map TokenName Integer))
-> ([(CurrencySymbol, [(TokenName, Integer)])]
    -> [(CurrencySymbol, Map TokenName Integer)])
-> [(CurrencySymbol, [(TokenName, Integer)])]
-> Map CurrencySymbol (Map TokenName Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CurrencySymbol, [(TokenName, Integer)])
 -> (CurrencySymbol, Map TokenName Integer))
-> [(CurrencySymbol, [(TokenName, Integer)])]
-> [(CurrencySymbol, Map TokenName Integer)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (([(TokenName, Integer)] -> Map TokenName Integer)
-> (CurrencySymbol, [(TokenName, Integer)])
-> (CurrencySymbol, Map TokenName Integer)
forall a b. (a -> b) -> (CurrencySymbol, a) -> (CurrencySymbol, b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [(TokenName, Integer)] -> Map TokenName Integer
forall k v. [(k, v)] -> Map k v
AssocMap.unsafeFromList) ([(CurrencySymbol, [(TokenName, Integer)])]
 -> [Map CurrencySymbol (Map TokenName Integer)])
-> [(CurrencySymbol, [(TokenName, Integer)])]
-> [Map CurrencySymbol (Map TokenName Integer)]
forall a b. (a -> b) -> a -> b
$ [(CurrencySymbol, [(TokenName, Integer)])]
shrunk

-- | @since 1.0.3
deriving via PLA.Value instance CoArbitrary MintValue

-- | @since 1.0.3
instance Function MintValue where
  {-# INLINEABLE function #-}
  function :: forall b. (MintValue -> b) -> MintValue :-> b
function = (MintValue -> Value)
-> (Value -> MintValue) -> (MintValue -> b) -> MintValue :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap MintValue -> Value
forall a b. Coercible a b => a -> b
coerce Value -> MintValue
MintValue

-- | @since 1.0.3
getMintValue :: MintValue -> Value.Value
getMintValue :: MintValue -> Value
getMintValue = MintValue -> Value
forall a b. Coercible a b => a -> b
coerce

withZeroAda :: Value.Value -> Value.Value
withZeroAda :: Value -> Value
withZeroAda = (CurrencySymbol -> TokenName -> Integer -> Value
Value.singleton CurrencySymbol
Value.adaSymbol TokenName
Value.adaToken Integer
0 Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<>)

pruneZeros :: Value.Value -> Value.Value
pruneZeros :: Value -> Value
pruneZeros (Value.Value Map CurrencySymbol (Map TokenName Integer)
assets) =
  Map CurrencySymbol (Map TokenName Integer) -> Value
Value.Value (Map CurrencySymbol (Map TokenName Integer) -> Value)
-> Map CurrencySymbol (Map TokenName Integer) -> Value
forall a b. (a -> b) -> a -> b
$
    [(CurrencySymbol, Map TokenName Integer)]
-> Map CurrencySymbol (Map TokenName Integer)
forall k v. [(k, v)] -> Map k v
AssocMap.unsafeFromList ([(CurrencySymbol, Map TokenName Integer)]
 -> Map CurrencySymbol (Map TokenName Integer))
-> [(CurrencySymbol, Map TokenName Integer)]
-> Map CurrencySymbol (Map TokenName Integer)
forall a b. (a -> b) -> a -> b
$
      ((CurrencySymbol, Map TokenName Integer) -> Bool)
-> [(CurrencySymbol, Map TokenName Integer)]
-> [(CurrencySymbol, Map TokenName Integer)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((CurrencySymbol, Map TokenName Integer) -> Bool)
-> (CurrencySymbol, Map TokenName Integer)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TokenName Integer -> Bool
forall k v. Map k v -> Bool
AssocMap.null (Map TokenName Integer -> Bool)
-> ((CurrencySymbol, Map TokenName Integer)
    -> Map TokenName Integer)
-> (CurrencySymbol, Map TokenName Integer)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CurrencySymbol, Map TokenName Integer) -> Map TokenName Integer
forall a b. (a, b) -> b
snd) ([(CurrencySymbol, Map TokenName Integer)]
 -> [(CurrencySymbol, Map TokenName Integer)])
-> [(CurrencySymbol, Map TokenName Integer)]
-> [(CurrencySymbol, Map TokenName Integer)]
forall a b. (a -> b) -> a -> b
$ -- After removing tokens now we may have empty currency list, so clear that as well
        Map CurrencySymbol (Map TokenName Integer)
-> [(CurrencySymbol, Map TokenName Integer)]
forall k v. Map k v -> [(k, v)]
AssocMap.toList ((Map TokenName Integer -> Maybe (Map TokenName Integer))
-> Map CurrencySymbol (Map TokenName Integer)
-> Map CurrencySymbol (Map TokenName Integer)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
AssocMap.mapMaybe ([(TokenName, Integer)] -> Maybe (Map TokenName Integer)
forall k v. [(k, v)] -> Maybe (Map k v)
assocMapNonEmpty ([(TokenName, Integer)] -> Maybe (Map TokenName Integer))
-> (Map TokenName Integer -> [(TokenName, Integer)])
-> Map TokenName Integer
-> Maybe (Map TokenName Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TokenName, Integer) -> Bool)
-> [(TokenName, Integer)] -> [(TokenName, Integer)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0) (Integer -> Bool)
-> ((TokenName, Integer) -> Integer)
-> (TokenName, Integer)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TokenName, Integer) -> Integer
forall a b. (a, b) -> b
snd) ([(TokenName, Integer)] -> [(TokenName, Integer)])
-> (Map TokenName Integer -> [(TokenName, Integer)])
-> Map TokenName Integer
-> [(TokenName, Integer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TokenName Integer -> [(TokenName, Integer)]
forall k v. Map k v -> [(k, v)]
AssocMap.toList) Map CurrencySymbol (Map TokenName Integer)
assets) -- Remove all zero tokens
  where
    assocMapNonEmpty :: [(k, v)] -> Maybe (AssocMap.Map k v)
    assocMapNonEmpty :: forall k v. [(k, v)] -> Maybe (Map k v)
assocMapNonEmpty [] = Maybe (Map k v)
forall a. Maybe a
Nothing
    assocMapNonEmpty [(k, v)]
lst = Map k v -> Maybe (Map k v)
forall a. a -> Maybe a
Just (Map k v -> Maybe (Map k v)) -> Map k v -> Maybe (Map k v)
forall a b. (a -> b) -> a -> b
$ [(k, v)] -> Map k v
forall k v. [(k, v)] -> Map k v
AssocMap.unsafeFromList [(k, v)]
lst