{-# LANGUAGE TupleSections    #-}
{-# LANGUAGE TypeApplications #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

module PlutusLedgerApi.Test.V1.Data.Value where

-- TODO: import a new PlutusLedgerApi.Data.V1 module instead
import PlutusLedgerApi.V1.Data.Value
import PlutusTx.Builtins hiding (error)
--
import PlutusTx.Data.AssocMap qualified as AssocMap
import PlutusTx.List qualified as ListTx

import PlutusCore.Generators.QuickCheck.Utils (multiSplit0, uniqueVectorOf)

import Data.ByteString.Base16 qualified as Base16
import Data.ByteString.Char8 qualified as BS8
import Data.Coerce
import Test.QuickCheck

-- | Convert a list representation of a 'Value' to the 'Value'.
listsToValue :: [(CurrencySymbol, [(TokenName, Integer)])] -> Value
listsToValue :: [(CurrencySymbol, [(TokenName, Integer)])] -> Value
listsToValue = Map CurrencySymbol (Map TokenName Integer) -> 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 a. (ToData k, ToData a) => [(k, a)] -> Map k a
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]
ListTx.map (([(TokenName, Integer)] -> Map TokenName Integer)
-> (CurrencySymbol, [(TokenName, Integer)])
-> (CurrencySymbol, Map TokenName Integer)
forall a b. (a -> b) -> (CurrencySymbol, a) -> (CurrencySymbol, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(TokenName, Integer)] -> Map TokenName Integer
forall k a. (ToData k, ToData a) => [(k, a)] -> Map k a
AssocMap.unsafeFromList)

-- | Convert a 'Value' to its list representation.
valueToLists :: Value -> [(CurrencySymbol, [(TokenName, Integer)])]
valueToLists :: Value -> [(CurrencySymbol, [(TokenName, Integer)])]
valueToLists = ((CurrencySymbol, Map TokenName Integer)
 -> (CurrencySymbol, [(TokenName, Integer)]))
-> [(CurrencySymbol, Map TokenName Integer)]
-> [(CurrencySymbol, [(TokenName, Integer)])]
forall a b. (a -> b) -> [a] -> [b]
ListTx.map ((Map TokenName Integer -> [(TokenName, Integer)])
-> (CurrencySymbol, Map TokenName Integer)
-> (CurrencySymbol, [(TokenName, Integer)])
forall a b. (a -> b) -> (CurrencySymbol, a) -> (CurrencySymbol, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map TokenName Integer -> [(TokenName, Integer)]
forall k a.
(UnsafeFromData k, UnsafeFromData a) =>
Map k a -> [(k, a)]
AssocMap.toList) ([(CurrencySymbol, Map TokenName Integer)]
 -> [(CurrencySymbol, [(TokenName, Integer)])])
-> (Value -> [(CurrencySymbol, Map TokenName Integer)])
-> Value
-> [(CurrencySymbol, [(TokenName, Integer)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map CurrencySymbol (Map TokenName Integer)
-> [(CurrencySymbol, Map TokenName Integer)]
forall k a.
(UnsafeFromData k, UnsafeFromData a) =>
Map k a -> [(k, a)]
AssocMap.toList (Map CurrencySymbol (Map TokenName Integer)
 -> [(CurrencySymbol, Map TokenName Integer)])
-> (Value -> Map CurrencySymbol (Map TokenName Integer))
-> Value
-> [(CurrencySymbol, Map TokenName Integer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Map CurrencySymbol (Map TokenName Integer)
getValue

-- | Return how many candidates to randomly choose from to fill the given number of cells. For
-- example, if we only need to fill a single cell, we choose from 6 different candidates, and if we
-- need to fill 5 cells, we choose from 11 candidates.
--
-- >>> map (\i -> (i, toCellCandidatesNumber i)) [1..13]
-- [(1,6),(2,6),(3,6),(4,8),(5,11),(6,14),(7,18),(8,22),(9,27),(10,31),(11,36),(12,41),(13,46)]
toCellCandidatesNumber :: Int -> Int
toCellCandidatesNumber :: Int -> Int
toCellCandidatesNumber Int
i = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
6 (Int -> Int) -> (Double -> Int) -> Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
floor @Double (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
1.5

-- | Generate a 'BuiltinByteString' by picking one of the predetermined ones, given a number of
-- cells to fill (see 'toCellCandidatesNumber'). The idea is that we want to occasionally generate
-- the same 'CurrencySymbol' or 'TokenName' for different 'Value's to have decent test coverage,
-- hence to make name clashing more likely we pick from a predetermined set of
-- 'BuiltinByteString's. Otherwise the chance of generating the same 'BuiltinByteString' for two
-- different 'Value's would be virtually zero.
genShortHex :: Int -> Gen BuiltinByteString
genShortHex :: Int -> Gen BuiltinByteString
genShortHex Int
i =
    ByteString -> BuiltinByteString
ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin (ByteString -> BuiltinByteString)
-> (Int -> ByteString) -> Int -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode (ByteString -> ByteString)
-> (Int -> ByteString) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS8.pack (String -> ByteString) -> (Int -> String) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> BuiltinByteString) -> Gen Int -> Gen BuiltinByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> Gen Int
forall a. HasCallStack => [a] -> Gen a
elements [Int
0 .. Int -> Int
toCellCandidatesNumber Int
i]

-- | Annotate each element of the give list with a @name@, given a function turning
-- 'BuiltinByteString' into names.
uniqueNames :: Eq name => (BuiltinByteString -> name) -> [b] -> Gen [(name, b)]
uniqueNames :: forall name b.
Eq name =>
(BuiltinByteString -> name) -> [b] -> Gen [(name, b)]
uniqueNames BuiltinByteString -> name
wrap [b]
ys = do
    let len :: Int
len = [b] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [b]
ys
    -- We always generate unique 'CurrencySymbol's within a single 'Value' and 'TokenName' within a
    -- single 'CurrencySymbol', because functions over 'Value' don't handle duplicated names anyway.
    -- Note that we can generate the same 'TokenName' within different 'CurrencySymbol's within the
    -- same 'Value'.
    [name]
xs <- Int -> Gen name -> Gen [name]
forall a. Eq a => Int -> Gen a -> Gen [a]
uniqueVectorOf Int
len (Gen name -> Gen [name]) -> Gen name -> Gen [name]
forall a b. (a -> b) -> a -> b
$ BuiltinByteString -> name
wrap (BuiltinByteString -> name) -> Gen BuiltinByteString -> Gen name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen BuiltinByteString
genShortHex Int
len
    [(name, b)] -> Gen [(name, b)]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(name, b)] -> Gen [(name, b)]) -> [(name, b)] -> Gen [(name, b)]
forall a b. (a -> b) -> a -> b
$ [name] -> [b] -> [(name, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [name]
xs [b]
ys

-- | The value of a 'TokenName' in a 'Value'.
newtype FaceValue = FaceValue
    { FaceValue -> Integer
unFaceValue :: Integer
    }

instance Arbitrary FaceValue where
    -- We want to generate zeroes often, because there's a lot of corner cases associated with them
    -- and all non-zero numbers are handled pretty much the same anyway, so there isn't much point
    -- in diversifying them as much as possible.
    arbitrary :: Gen FaceValue
arbitrary = [(Int, Gen FaceValue)] -> Gen FaceValue
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
        [ (Int
2, FaceValue -> Gen FaceValue
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FaceValue -> Gen FaceValue) -> FaceValue -> Gen FaceValue
forall a b. (a -> b) -> a -> b
$ Integer -> FaceValue
FaceValue Integer
0)
        , (Int
1, Integer -> FaceValue
FaceValue (Integer -> FaceValue) -> (Int -> Integer) -> Int -> FaceValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> FaceValue) -> Gen Int -> Gen FaceValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary @Int)
        ]

-- | A wrapper for satisfying an @Arbitrary a@ constraint without implementing an 'Arbitrary'
-- instance for @a@.
newtype NoArbitrary a = NoArbitrary
    { forall a. NoArbitrary a -> a
unNoArbitrary :: a
    }

-- | 'arbitrary' throws, 'shrink' neither throws nor shrinks.
instance Arbitrary (NoArbitrary a) where
    arbitrary :: Gen (NoArbitrary a)
arbitrary = String -> Gen (NoArbitrary a)
forall a. HasCallStack => String -> a
error String
"No such 'Arbitrary' instance"
    shrink :: NoArbitrary a -> [NoArbitrary a]
shrink NoArbitrary a
_ = []

instance Arbitrary Value where
    arbitrary :: Gen Value
arbitrary = do
        -- Generate values for all of the 'TokenName's in the final 'Value' and split them into a
        -- list of lists.
        [[Integer]]
faceValues <- Double -> [Integer] -> Gen [[Integer]]
forall a. Double -> [a] -> Gen [[a]]
multiSplit0 Double
0.2 ([Integer] -> Gen [[Integer]])
-> ([FaceValue] -> [Integer]) -> [FaceValue] -> Gen [[Integer]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FaceValue -> Integer) -> [FaceValue] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map FaceValue -> Integer
unFaceValue ([FaceValue] -> Gen [[Integer]])
-> Gen [FaceValue] -> Gen [[Integer]]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Gen [FaceValue]
forall a. Arbitrary a => Gen a
arbitrary
        -- Generate 'TokenName's and 'CurrencySymbol's.
        [(CurrencySymbol, [(TokenName, Integer)])]
currencies <- (BuiltinByteString -> CurrencySymbol)
-> [[(TokenName, Integer)]]
-> Gen [(CurrencySymbol, [(TokenName, Integer)])]
forall name b.
Eq name =>
(BuiltinByteString -> name) -> [b] -> Gen [(name, b)]
uniqueNames BuiltinByteString -> CurrencySymbol
CurrencySymbol ([[(TokenName, Integer)]]
 -> Gen [(CurrencySymbol, [(TokenName, Integer)])])
-> Gen [[(TokenName, Integer)]]
-> Gen [(CurrencySymbol, [(TokenName, Integer)])]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ([Integer] -> Gen [(TokenName, Integer)])
-> [[Integer]] -> Gen [[(TokenName, Integer)]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((BuiltinByteString -> TokenName)
-> [Integer] -> Gen [(TokenName, Integer)]
forall name b.
Eq name =>
(BuiltinByteString -> name) -> [b] -> Gen [(name, b)]
uniqueNames BuiltinByteString -> TokenName
TokenName) [[Integer]]
faceValues
        Value -> Gen Value
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Gen Value) -> Value -> Gen Value
forall a b. (a -> b) -> a -> b
$ [(CurrencySymbol, [(TokenName, Integer)])] -> Value
listsToValue [(CurrencySymbol, [(TokenName, Integer)])]
currencies

    shrink :: Value -> [Value]
shrink
        = ([(CurrencySymbol, [(TokenName, Integer)])] -> Value)
-> [[(CurrencySymbol, [(TokenName, Integer)])]] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map [(CurrencySymbol, [(TokenName, Integer)])] -> Value
listsToValue
        ([[(CurrencySymbol, [(TokenName, Integer)])]] -> [Value])
-> (Value -> [[(CurrencySymbol, [(TokenName, Integer)])]])
-> Value
-> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(NoArbitrary CurrencySymbol, [(NoArbitrary TokenName, Integer)])]
 -> [[(NoArbitrary CurrencySymbol,
       [(NoArbitrary TokenName, Integer)])]])
-> [(CurrencySymbol, [(TokenName, Integer)])]
-> [[(CurrencySymbol, [(TokenName, Integer)])]]
forall a b. Coercible a b => a -> b
coerce (forall a. Arbitrary a => a -> [a]
shrink @[(NoArbitrary CurrencySymbol, [(NoArbitrary TokenName, Integer)])])
        ([(CurrencySymbol, [(TokenName, Integer)])]
 -> [[(CurrencySymbol, [(TokenName, Integer)])]])
-> (Value -> [(CurrencySymbol, [(TokenName, Integer)])])
-> Value
-> [[(CurrencySymbol, [(TokenName, Integer)])]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> [(CurrencySymbol, [(TokenName, Integer)])]
valueToLists