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

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

module PlutusLedgerApi.Test.V1.Value where

import PlutusLedgerApi.V1
import PlutusTx.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 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]
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 v. [(k, v)] -> Map k v
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 v. Map k v -> [(k, v)]
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 v. Map k v -> [(k, v)]
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