module Cardano.Wallet.Primitive.Types.TokenPolicy.Gen
    (
    -- * Generators and shrinkers
      genTokenName
    , genTokenNameLargeRange
    , genTokenPolicyId
    , genTokenPolicyIdLargeRange
    , shrinkTokenName
    , shrinkTokenPolicyId

    -- * Test values
    , testTokenNames
    , testTokenPolicyIds

    -- * Creation of test values
    , mkTokenName
    , mkTokenPolicyId

    ) where

import Prelude

import Cardano.Wallet.Primitive.Types.Hash
    ( Hash (..) )
import Cardano.Wallet.Primitive.Types.TokenPolicy
    ( TokenName (..), TokenPolicyId (..) )
import Data.Either
    ( fromRight )
import Data.Text.Class
    ( FromText (..) )
import Test.QuickCheck
    ( Gen, elements, sized, vector )

import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as B8
import qualified Data.Text as T

--------------------------------------------------------------------------------
-- Token names chosen from a range that depends on the size parameter
--------------------------------------------------------------------------------

genTokenName :: Gen TokenName
genTokenName :: Gen TokenName
genTokenName = (Int -> Gen TokenName) -> Gen TokenName
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen TokenName) -> Gen TokenName)
-> (Int -> Gen TokenName) -> Gen TokenName
forall a b. (a -> b) -> a -> b
$ \Int
n -> [TokenName] -> Gen TokenName
forall a. [a] -> Gen a
elements ([TokenName] -> Gen TokenName) -> [TokenName] -> Gen TokenName
forall a b. (a -> b) -> a -> b
$ Int -> [TokenName] -> [TokenName]
forall a. Int -> [a] -> [a]
take (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
n) [TokenName]
testTokenNames

shrinkTokenName :: TokenName -> [TokenName]
shrinkTokenName :: TokenName -> [TokenName]
shrinkTokenName TokenName
i
    | TokenName
i TokenName -> TokenName -> Bool
forall a. Eq a => a -> a -> Bool
== TokenName
simplest = []
    | Bool
otherwise = [TokenName
simplest]
  where
    simplest :: TokenName
simplest = [TokenName] -> TokenName
forall a. [a] -> a
head [TokenName]
testTokenNames

--------------------------------------------------------------------------------
-- Token names chosen from a large range (to minimize the risk of collisions)
--------------------------------------------------------------------------------

genTokenNameLargeRange :: Gen TokenName
genTokenNameLargeRange :: Gen TokenName
genTokenNameLargeRange = ByteString -> TokenName
UnsafeTokenName (ByteString -> TokenName)
-> ([Word8] -> ByteString) -> [Word8] -> TokenName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> TokenName) -> Gen [Word8] -> Gen TokenName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [Word8]
forall a. Arbitrary a => Int -> Gen [a]
vector Int
32

--------------------------------------------------------------------------------
-- Token policy identifiers chosen from a range that depends on the size
-- parameter
--------------------------------------------------------------------------------

genTokenPolicyId :: Gen TokenPolicyId
genTokenPolicyId :: Gen TokenPolicyId
genTokenPolicyId = (Int -> Gen TokenPolicyId) -> Gen TokenPolicyId
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen TokenPolicyId) -> Gen TokenPolicyId)
-> (Int -> Gen TokenPolicyId) -> Gen TokenPolicyId
forall a b. (a -> b) -> a -> b
$ \Int
n -> [TokenPolicyId] -> Gen TokenPolicyId
forall a. [a] -> Gen a
elements ([TokenPolicyId] -> Gen TokenPolicyId)
-> [TokenPolicyId] -> Gen TokenPolicyId
forall a b. (a -> b) -> a -> b
$ Int -> [TokenPolicyId] -> [TokenPolicyId]
forall a. Int -> [a] -> [a]
take (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
n) [TokenPolicyId]
testTokenPolicyIds

shrinkTokenPolicyId :: TokenPolicyId -> [TokenPolicyId]
shrinkTokenPolicyId :: TokenPolicyId -> [TokenPolicyId]
shrinkTokenPolicyId TokenPolicyId
i
    | TokenPolicyId
i TokenPolicyId -> TokenPolicyId -> Bool
forall a. Eq a => a -> a -> Bool
== TokenPolicyId
simplest = []
    | Bool
otherwise = [TokenPolicyId
simplest]
  where
    simplest :: TokenPolicyId
simplest = [TokenPolicyId] -> TokenPolicyId
forall a. [a] -> a
head [TokenPolicyId]
testTokenPolicyIds

--------------------------------------------------------------------------------
-- Token policy identifiers chosen from a large range (to minimize the risk of
-- collisions)
--------------------------------------------------------------------------------

genTokenPolicyIdLargeRange :: Gen TokenPolicyId
genTokenPolicyIdLargeRange :: Gen TokenPolicyId
genTokenPolicyIdLargeRange = Hash "TokenPolicy" -> TokenPolicyId
UnsafeTokenPolicyId (Hash "TokenPolicy" -> TokenPolicyId)
-> ([Word8] -> Hash "TokenPolicy") -> [Word8] -> TokenPolicyId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Hash "TokenPolicy"
forall (tag :: Symbol). ByteString -> Hash tag
Hash (ByteString -> Hash "TokenPolicy")
-> ([Word8] -> ByteString) -> [Word8] -> Hash "TokenPolicy"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> TokenPolicyId) -> Gen [Word8] -> Gen TokenPolicyId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [Word8]
forall a. Arbitrary a => Int -> Gen [a]
vector Int
28

--------------------------------------------------------------------------------
-- Internal utilities
--------------------------------------------------------------------------------

testTokenNames :: [TokenName]
testTokenNames :: [TokenName]
testTokenNames = Char -> TokenName
mkTokenName (Char -> TokenName) -> [Char] -> [TokenName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char
'A' .. Char
'Z']

testTokenPolicyIds :: [TokenPolicyId]
testTokenPolicyIds :: [TokenPolicyId]
testTokenPolicyIds = Char -> TokenPolicyId
mkTokenPolicyId (Char -> TokenPolicyId) -> [Char] -> [TokenPolicyId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
mkTokenPolicyIdValidChars

mkTokenName :: Char -> TokenName
mkTokenName :: Char -> TokenName
mkTokenName = ByteString -> TokenName
UnsafeTokenName (ByteString -> TokenName)
-> (Char -> ByteString) -> Char -> TokenName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Char -> ByteString
B8.snoc ByteString
"Token"

-- The set of characters that can be passed to the 'mkTokenPolicyId' function.
--
mkTokenPolicyIdValidChars :: [Char]
mkTokenPolicyIdValidChars :: [Char]
mkTokenPolicyIdValidChars = [Char
'0' .. Char
'9'] [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char
'A' .. Char
'F']

-- The input must be a character in the range [0-9] or [A-F].
--
mkTokenPolicyId :: Char -> TokenPolicyId
mkTokenPolicyId :: Char -> TokenPolicyId
mkTokenPolicyId Char
c
    = TokenPolicyId
-> Either TextDecodingError TokenPolicyId -> TokenPolicyId
forall b a. b -> Either a b -> b
fromRight TokenPolicyId
forall a. a
reportError
    (Either TextDecodingError TokenPolicyId -> TokenPolicyId)
-> Either TextDecodingError TokenPolicyId -> TokenPolicyId
forall a b. (a -> b) -> a -> b
$ Text -> Either TextDecodingError TokenPolicyId
forall a. FromText a => Text -> Either TextDecodingError a
fromText
    (Text -> Either TextDecodingError TokenPolicyId)
-> Text -> Either TextDecodingError TokenPolicyId
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack
    ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
tokenPolicyIdHexStringLength Char
c
  where
    reportError :: a
reportError = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$
        [Char]
"Unable to generate token policy id from character: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Char -> [Char]
forall a. Show a => a -> [Char]
show Char
c

tokenPolicyIdHexStringLength :: Int
tokenPolicyIdHexStringLength :: Int
tokenPolicyIdHexStringLength = Int
56