-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Hedgehog.Gen.Michelson.Typed
  ( genBigMap
  , genEpAddress
  , genValueBigMap
  , genValueChestAndKey
  , genValueInt
  , genValueKeyHash
  , genValueList
  , genValueMap
  , genValueMutez
  , genValueNat
  , genValuePair
  , genValueSet
  , genValueString
  , genValueTimestamp
  , genValueUnit

  , genValue
  , genValue'

  , genSimpleInstr
  ) where

import Control.Exception qualified as Ex
import Data.Singletons (Sing)
import Hedgehog (GenBase, MonadGen)
import Hedgehog.Gen qualified as Gen
import Hedgehog.Range (Range)
import Hedgehog.Range qualified as Range

import Hedgehog.Gen.Michelson.Untyped (genEpName)
import Hedgehog.Gen.Tezos.Address
import Hedgehog.Gen.Tezos.Core (genChainId, genMutez, genTimestamp)
import Hedgehog.Gen.Tezos.Crypto (genKeyHash, genPublicKey, genSignature)
import Hedgehog.Gen.Tezos.Crypto.BLS12381 (genBls12381Fr, genBls12381G1, genBls12381G2)
import Morley.Michelson.Text (mkMText)
import Morley.Michelson.Typed
  (Instr(DROP, FAILWITH, PUSH, SWAP, Seq, UNIT), SingT(..), T(..), Value'(..), mkVLam, toVal)
import Morley.Michelson.Typed.Entrypoints (EpAddress(..), unsafeSepcCallRoot)
import Morley.Michelson.Typed.Haskell.Value (BigMap(..), BigMapId(..), ToT, WellTypedToT)
import Morley.Michelson.Typed.Scope
import Morley.Michelson.Typed.Value (RemFail(..))
import Morley.Tezos.Address (Constrained(..), TxRollupL2Address(..))
import Morley.Tezos.Core (Mutez, Timestamp)
import Morley.Tezos.Crypto (parseHash)
import Morley.Tezos.Crypto.BLS12381 qualified as BLS

import Hedgehog.Gen.Tezos.Crypto.Timelock (genChestAndKey)
import Hedgehog.Range.Defaults

genBigMap
  :: forall k v m.
     (MonadGen m, Ord k, WellTypedToT k, WellTypedToT v, Comparable (ToT k))
  => Range Length -> m k -> m v -> m (BigMap k v)
genBigMap :: forall k v (m :: * -> *).
(MonadGen m, Ord k, WellTypedToT k, WellTypedToT v,
 Comparable (ToT k)) =>
Range Length -> m k -> m v -> m (BigMap k v)
genBigMap Range Length
rangeLen m k
genK m v
genV =
  Maybe (BigMapId k v) -> Map k v -> BigMap k v
forall k v. Maybe (BigMapId k v) -> Map k v -> BigMap k v
BigMap
    (Maybe (BigMapId k v) -> Map k v -> BigMap k v)
-> m (Maybe (BigMapId k v)) -> m (Map k v -> BigMap k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (BigMapId k v) -> m (Maybe (BigMapId k v))
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe ((Natural -> BigMapId k v) -> m Natural -> m (BigMapId k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Natural -> BigMapId k v
forall {k} {k1} (k2 :: k) (v :: k1). Natural -> BigMapId k2 v
BigMapId m Natural
forall (m :: * -> *). MonadGen m => m Natural
genBigMapId)
    m (Map k v -> BigMap k v) -> m (Map k v) -> m (BigMap k v)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Int -> m (k, v) -> m (Map k v)
forall (m :: * -> *) k v.
(MonadGen m, Ord k) =>
Range Int -> m (k, v) -> m (Map k v)
Gen.map (Length -> Int
unLength (Length -> Int) -> Range Length -> Range Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Length
rangeLen) ((k -> v -> (k, v)) -> m k -> m v -> m (k, v)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) m k
genK m v
genV)

genValueMap
  :: forall (k :: T) (v :: T) m instr.
     (MonadGen m, WellTyped k, WellTyped v, Comparable k)
  => Range Length -> m (Value' instr k) -> m (Value' instr v) -> m (Value' instr ('TMap k v))
genValueMap :: forall (k :: T) (v :: T) (m :: * -> *) (instr :: [T] -> [T] -> *).
(MonadGen m, WellTyped k, WellTyped v, Comparable k) =>
Range Length
-> m (Value' instr k)
-> m (Value' instr v)
-> m (Value' instr ('TMap k v))
genValueMap Range Length
len m (Value' instr k)
genKey m (Value' instr v)
genVal =
  Map (Value' instr k) (Value' instr v) -> Value' instr ('TMap k v)
forall (k :: T) (v :: T) (instr :: [T] -> [T] -> *).
(SingI k, SingI v, Comparable k) =>
Map (Value' instr k) (Value' instr v) -> Value' instr ('TMap k v)
VMap (Map (Value' instr k) (Value' instr v) -> Value' instr ('TMap k v))
-> m (Map (Value' instr k) (Value' instr v))
-> m (Value' instr ('TMap k v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int
-> m (Value' instr k, Value' instr v)
-> m (Map (Value' instr k) (Value' instr v))
forall (m :: * -> *) k v.
(MonadGen m, Ord k) =>
Range Int -> m (k, v) -> m (Map k v)
Gen.map (Length -> Int
unLength (Length -> Int) -> Range Length -> Range Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Length
len) ((Value' instr k
 -> Value' instr v -> (Value' instr k, Value' instr v))
-> m (Value' instr k)
-> m (Value' instr v)
-> m (Value' instr k, Value' instr v)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) m (Value' instr k)
genKey m (Value' instr v)
genVal)

genValueBigMap
  :: forall (k :: T) (v :: T) m instr.
     (MonadGen m, WellTyped k, WellTyped v, HasNoBigMap v, Comparable k)
  => Range Length -> m (Value' instr k) -> m (Value' instr v) -> m (Value' instr ('TBigMap k v))
genValueBigMap :: forall (k :: T) (v :: T) (m :: * -> *) (instr :: [T] -> [T] -> *).
(MonadGen m, WellTyped k, WellTyped v, HasNoBigMap v,
 Comparable k) =>
Range Length
-> m (Value' instr k)
-> m (Value' instr v)
-> m (Value' instr ('TBigMap k v))
genValueBigMap Range Length
len m (Value' instr k)
genKey m (Value' instr v)
genVal =
  Maybe Natural
-> Map (Value' instr k) (Value' instr v)
-> Value' instr ('TBigMap k v)
forall (k :: T) (v :: T) (instr :: [T] -> [T] -> *).
(SingI k, SingI v, Comparable k, HasNoBigMap v) =>
Maybe Natural
-> Map (Value' instr k) (Value' instr v)
-> Value' instr ('TBigMap k v)
VBigMap
    (Maybe Natural
 -> Map (Value' instr k) (Value' instr v)
 -> Value' instr ('TBigMap k v))
-> m (Maybe Natural)
-> m (Map (Value' instr k) (Value' instr v)
      -> Value' instr ('TBigMap k v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Natural -> m (Maybe Natural)
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe m Natural
forall (m :: * -> *). MonadGen m => m Natural
genBigMapId
    m (Map (Value' instr k) (Value' instr v)
   -> Value' instr ('TBigMap k v))
-> m (Map (Value' instr k) (Value' instr v))
-> m (Value' instr ('TBigMap k v))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Int
-> m (Value' instr k, Value' instr v)
-> m (Map (Value' instr k) (Value' instr v))
forall (m :: * -> *) k v.
(MonadGen m, Ord k) =>
Range Int -> m (k, v) -> m (Map k v)
Gen.map (Length -> Int
unLength (Length -> Int) -> Range Length -> Range Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Length
len) ((Value' instr k
 -> Value' instr v -> (Value' instr k, Value' instr v))
-> m (Value' instr k)
-> m (Value' instr v)
-> m (Value' instr k, Value' instr v)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) m (Value' instr k)
genKey m (Value' instr v)
genVal)

genEpAddress :: (MonadGen m, GenBase m ~ Identity) => m EpAddress
genEpAddress :: forall (m :: * -> *).
(MonadGen m, GenBase m ~ Identity) =>
m EpAddress
genEpAddress = Address -> EpName -> EpAddress
EpAddress' (Address -> EpName -> EpAddress)
-> m Address -> m (EpName -> EpAddress)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Address
forall (m :: * -> *). MonadGen m => m Address
genAddress m (EpName -> EpAddress) -> m EpName -> m EpAddress
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m EpName
forall (m :: * -> *).
(MonadGen m, GenBase m ~ Identity) =>
m EpName
genEpName

genValueKeyHash :: MonadGen m => m (Value' instr 'TKeyHash)
genValueKeyHash :: forall (m :: * -> *) (instr :: [T] -> [T] -> *).
MonadGen m =>
m (Value' instr 'TKeyHash)
genValueKeyHash = KeyHash -> Value' instr 'TKeyHash
forall (instr :: [T] -> [T] -> *).
KeyHash -> Value' instr 'TKeyHash
VKeyHash (KeyHash -> Value' instr 'TKeyHash)
-> m KeyHash -> m (Value' instr 'TKeyHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m KeyHash
forall (m :: * -> *). MonadGen m => m KeyHash
genKeyHash

genValueMutez :: MonadGen m => Range Mutez -> m (Value' instr 'TMutez)
genValueMutez :: forall (m :: * -> *) (instr :: [T] -> [T] -> *).
MonadGen m =>
Range Mutez -> m (Value' instr 'TMutez)
genValueMutez = (Mutez -> Value' instr 'TMutez)
-> m Mutez -> m (Value' instr 'TMutez)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Mutez -> Value' instr 'TMutez
forall (instr :: [T] -> [T] -> *). Mutez -> Value' instr 'TMutez
VMutez (m Mutez -> m (Value' instr 'TMutez))
-> (Range Mutez -> m Mutez)
-> Range Mutez
-> m (Value' instr 'TMutez)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range Mutez -> m Mutez
forall (m :: * -> *). MonadGen m => Range Mutez -> m Mutez
genMutez

genValueInt :: MonadGen m => Range (Value' instr 'TInt) -> m (Value' instr 'TInt)
genValueInt :: forall (m :: * -> *) (instr :: [T] -> [T] -> *).
MonadGen m =>
Range (Value' instr 'TInt) -> m (Value' instr 'TInt)
genValueInt Range (Value' instr 'TInt)
range = Integer -> Value' instr 'TInt
forall (instr :: [T] -> [T] -> *). Integer -> Value' instr 'TInt
VInt (Integer -> Value' instr 'TInt)
-> m Integer -> m (Value' instr 'TInt)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Integer -> m Integer
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Value' instr 'TInt -> Integer
forall (instr :: [T] -> [T] -> *). Value' instr 'TInt -> Integer
unVal (Value' instr 'TInt -> Integer)
-> Range (Value' instr 'TInt) -> Range Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range (Value' instr 'TInt)
range)
  where
    unVal :: Value' instr 'TInt -> Integer
    unVal :: forall (instr :: [T] -> [T] -> *). Value' instr 'TInt -> Integer
unVal (VInt Integer
val) = Integer
val

genValueNat :: MonadGen m => Range (Value' instr 'TNat) -> m (Value' instr 'TNat)
genValueNat :: forall (m :: * -> *) (instr :: [T] -> [T] -> *).
MonadGen m =>
Range (Value' instr 'TNat) -> m (Value' instr 'TNat)
genValueNat Range (Value' instr 'TNat)
range = Natural -> Value' instr 'TNat
forall (instr :: [T] -> [T] -> *). Natural -> Value' instr 'TNat
VNat (Natural -> Value' instr 'TNat)
-> m Natural -> m (Value' instr 'TNat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Natural -> m Natural
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Value' instr 'TNat -> Natural
forall (instr :: [T] -> [T] -> *). Value' instr 'TNat -> Natural
unVal (Value' instr 'TNat -> Natural)
-> Range (Value' instr 'TNat) -> Range Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range (Value' instr 'TNat)
range)
  where
    unVal :: Value' instr 'TNat -> Natural
    unVal :: forall (instr :: [T] -> [T] -> *). Value' instr 'TNat -> Natural
unVal (VNat Natural
val) = Natural
val

genValueString :: MonadGen f => Range Length -> f (Value' instr 'TString)
genValueString :: forall (f :: * -> *) (instr :: [T] -> [T] -> *).
MonadGen f =>
Range Length -> f (Value' instr 'TString)
genValueString Range Length
rangeLen =
  MText -> Value' instr 'TString
forall (instr :: [T] -> [T] -> *). MText -> Value' instr 'TString
VString (MText -> Value' instr 'TString)
-> (String -> MText) -> String -> Value' instr 'TString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Text MText -> MText
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe(Either Text MText -> MText)
-> (String -> Either Text MText) -> String -> MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text MText
mkMText (Text -> Either Text MText)
-> (String -> Text) -> String -> Either Text MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString (String -> Value' instr 'TString)
-> f String -> f (Value' instr 'TString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> f Char -> f String
forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m String
Gen.string (Length -> Int
unLength (Length -> Int) -> Range Length -> Range Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Length
rangeLen) f Char
forall (m :: * -> *). MonadGen m => m Char
Gen.alphaNum

genValueBytes :: MonadGen f => Range Length -> f (Value' instr 'TBytes)
genValueBytes :: forall (f :: * -> *) (instr :: [T] -> [T] -> *).
MonadGen f =>
Range Length -> f (Value' instr 'TBytes)
genValueBytes Range Length
rangeLen = ByteString -> Value' instr 'TBytes
forall (instr :: [T] -> [T] -> *).
ByteString -> Value' instr 'TBytes
VBytes (ByteString -> Value' instr 'TBytes)
-> f ByteString -> f (Value' instr 'TBytes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> f ByteString
forall (m :: * -> *). MonadGen m => Range Int -> m ByteString
Gen.bytes (Length -> Int
unLength (Length -> Int) -> Range Length -> Range Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Length
rangeLen)

genValueList
  :: (MonadGen m, SingI a) => Range Length -> m (Value' instr a) -> m (Value' instr ('TList a))
genValueList :: forall (m :: * -> *) (a :: T) (instr :: [T] -> [T] -> *).
(MonadGen m, SingI a) =>
Range Length -> m (Value' instr a) -> m (Value' instr ('TList a))
genValueList Range Length
rangeLen m (Value' instr a)
genA = [Value' instr a] -> Value' instr ('TList a)
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
[Value' instr t1] -> Value' instr ('TList t1)
VList ([Value' instr a] -> Value' instr ('TList a))
-> m [Value' instr a] -> m (Value' instr ('TList a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> m (Value' instr a) -> m [Value' instr a]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Length -> Int
unLength (Length -> Int) -> Range Length -> Range Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Length
rangeLen) m (Value' instr a)
genA

genValueSet
  :: (MonadGen m, Comparable a, SingI a)
  => Range Length -> m (Value' instr a) -> m (Value' instr ('TSet a))
genValueSet :: forall (m :: * -> *) (a :: T) (instr :: [T] -> [T] -> *).
(MonadGen m, Comparable a, SingI a) =>
Range Length -> m (Value' instr a) -> m (Value' instr ('TSet a))
genValueSet Range Length
rangeLen m (Value' instr a)
genA = Set (Value' instr a) -> Value' instr ('TSet a)
forall (t1 :: T) (instr :: [T] -> [T] -> *).
(SingI t1, Comparable t1) =>
Set (Value' instr t1) -> Value' instr ('TSet t1)
VSet (Set (Value' instr a) -> Value' instr ('TSet a))
-> m (Set (Value' instr a)) -> m (Value' instr ('TSet a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> m (Value' instr a) -> m (Set (Value' instr a))
forall (m :: * -> *) a.
(MonadGen m, Ord a) =>
Range Int -> m a -> m (Set a)
Gen.set (Length -> Int
unLength (Length -> Int) -> Range Length -> Range Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Length
rangeLen) m (Value' instr a)
genA

genValueUnit :: Applicative m => m (Value' instr 'TUnit)
genValueUnit :: forall (m :: * -> *) (instr :: [T] -> [T] -> *).
Applicative m =>
m (Value' instr 'TUnit)
genValueUnit = Value' instr 'TUnit -> m (Value' instr 'TUnit)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value' instr 'TUnit
forall (instr :: [T] -> [T] -> *). Value' instr 'TUnit
VUnit

genValuePair
  :: MonadGen m => m (Value' instr a) -> m (Value' instr b) -> m (Value' instr ('TPair a b))
genValuePair :: forall (m :: * -> *) (instr :: [T] -> [T] -> *) (a :: T) (b :: T).
MonadGen m =>
m (Value' instr a)
-> m (Value' instr b) -> m (Value' instr ('TPair a b))
genValuePair m (Value' instr a)
genA m (Value' instr b)
genB = (Value' instr a, Value' instr b) -> Value' instr ('TPair a b)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair ((Value' instr a, Value' instr b) -> Value' instr ('TPair a b))
-> (Value' instr a
    -> Value' instr b -> (Value' instr a, Value' instr b))
-> Value' instr a
-> Value' instr b
-> Value' instr ('TPair a b)
forall a b c. SuperComposition a b c => a -> b -> c
... (,) (Value' instr a -> Value' instr b -> Value' instr ('TPair a b))
-> m (Value' instr a)
-> m (Value' instr b -> Value' instr ('TPair a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Value' instr a)
genA m (Value' instr b -> Value' instr ('TPair a b))
-> m (Value' instr b) -> m (Value' instr ('TPair a b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Value' instr b)
genB

genValueTimestamp :: MonadGen m => Range Timestamp -> m (Value' instr 'TTimestamp)
genValueTimestamp :: forall (m :: * -> *) (instr :: [T] -> [T] -> *).
MonadGen m =>
Range Timestamp -> m (Value' instr 'TTimestamp)
genValueTimestamp = (Timestamp -> Value' instr 'TTimestamp)
-> m Timestamp -> m (Value' instr 'TTimestamp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Timestamp -> Value' instr 'TTimestamp
forall (instr :: [T] -> [T] -> *).
Timestamp -> Value' instr 'TTimestamp
VTimestamp (m Timestamp -> m (Value' instr 'TTimestamp))
-> (Range Timestamp -> m Timestamp)
-> Range Timestamp
-> m (Value' instr 'TTimestamp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range Timestamp -> m Timestamp
forall (m :: * -> *). MonadGen m => Range Timestamp -> m Timestamp
genTimestamp

genValueTicket
  :: (MonadGen m, Comparable a)
  => Range TicketAmount -> m (Value' instr a) -> m (Value' instr ('TTicket a))
genValueTicket :: forall (m :: * -> *) (a :: T) (instr :: [T] -> [T] -> *).
(MonadGen m, Comparable a) =>
Range TicketAmount
-> m (Value' instr a) -> m (Value' instr ('TTicket a))
genValueTicket Range TicketAmount
range m (Value' instr a)
genVal = Address -> Value' instr a -> Natural -> Value' instr ('TTicket a)
forall (arg :: T) (instr :: [T] -> [T] -> *).
Comparable arg =>
Address
-> Value' instr arg -> Natural -> Value' instr ('TTicket arg)
VTicket (Address -> Value' instr a -> Natural -> Value' instr ('TTicket a))
-> (KindedAddress 'AddressKindContract -> Address)
-> KindedAddress 'AddressKindContract
-> Value' instr a
-> Natural
-> Value' instr ('TTicket a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KindedAddress 'AddressKindContract -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress (KindedAddress 'AddressKindContract
 -> Value' instr a -> Natural -> Value' instr ('TTicket a))
-> m (KindedAddress 'AddressKindContract)
-> m (Value' instr a -> Natural -> Value' instr ('TTicket a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (KindedAddress 'AddressKindContract)
forall (m :: * -> *).
MonadGen m =>
m (KindedAddress 'AddressKindContract)
genContractAddress m (Value' instr a -> Natural -> Value' instr ('TTicket a))
-> m (Value' instr a) -> m (Natural -> Value' instr ('TTicket a))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Value' instr a)
genVal
  m (Natural -> Value' instr ('TTicket a))
-> m Natural -> m (Value' instr ('TTicket a))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Natural -> m Natural
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (TicketAmount -> Natural
unTicketAmount (TicketAmount -> Natural) -> Range TicketAmount -> Range Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range TicketAmount
range)

genValueChestAndKey :: MonadGen m => m (Value' instr 'TChest, Value' instr 'TChestKey)
genValueChestAndKey :: forall (m :: * -> *) (instr :: [T] -> [T] -> *).
MonadGen m =>
m (Value' instr 'TChest, Value' instr 'TChestKey)
genValueChestAndKey = (Chest -> Value' instr 'TChest)
-> (ChestKey -> Value' instr 'TChestKey)
-> (Chest, ChestKey)
-> (Value' instr 'TChest, Value' instr 'TChestKey)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Chest -> Value' instr 'TChest
forall (instr :: [T] -> [T] -> *). Chest -> Value' instr 'TChest
VChest ChestKey -> Value' instr 'TChestKey
forall (instr :: [T] -> [T] -> *).
ChestKey -> Value' instr 'TChestKey
VChestKey ((Chest, ChestKey)
 -> (Value' instr 'TChest, Value' instr 'TChestKey))
-> m (Chest, ChestKey)
-> m (Value' instr 'TChest, Value' instr 'TChestKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Chest, ChestKey)
forall (m :: * -> *). MonadGen m => m (Chest, ChestKey)
genChestAndKey

genValue
  :: forall t m.
      (MonadGen m, GenBase m ~ Identity, HasNoOp t, WellTyped t)
  => m (Value' Instr t)
genValue :: forall (t :: T) (m :: * -> *).
(MonadGen m, GenBase m ~ Identity, HasNoOp t, WellTyped t) =>
m (Value' Instr t)
genValue = Sing t -> m (Value' Instr t)
forall (m :: * -> *) (t :: T).
(MonadGen m, GenBase m ~ Identity, HasNoOp t, WellTyped t) =>
Sing t -> m (Value' Instr t)
genValue' (forall {k} (a :: k). SingI a => Sing a
forall (a :: T). SingI a => Sing a
sing @t)

-- | Generate a simple instruction.
-- Ideally instruction generator should produce instructions containing
-- all possible primitive instructions.
-- In our case we consider only a few primitive instructions and
-- pick one from a hardcoded list. Hence we call it "simple".
-- Another limitation is that input stack and output stack types must be
-- identical and non-empty.
genSimpleInstr :: (MonadGen m, inp ~ (x ': xs), SingI x) => m (Instr inp inp)
genSimpleInstr :: forall (m :: * -> *) (inp :: [T]) (x :: T) (xs :: [T]).
(MonadGen m, inp ~ (x : xs), SingI x) =>
m (Instr inp inp)
genSimpleInstr = [Instr inp (x : xs)] -> m (Instr inp (x : xs))
forall (m :: * -> *) a. MonadGen m => [a] -> m a
Gen.element
  [ Instr inp ('TUnit : x : xs)
forall {inp :: [T]} {out :: [T]} (s :: [T]).
(inp ~ s, out ~ ('TUnit : s)) =>
Instr inp out
UNIT Instr inp ('TUnit : x : xs)
-> Instr ('TUnit : x : xs) (x : xs) -> Instr inp (x : xs)
forall (inp :: [T]) (b :: [T]) (out :: [T]).
Instr inp b -> Instr b out -> Instr inp out
`Seq` Instr ('TUnit : x : xs) (x : xs)
forall (a :: T) (s :: [T]) (out :: [T]).
(SingI a, ConstantScope a) =>
Instr (a : s) out
FAILWITH
  , Value' Instr 'TInt -> Instr inp ('TInt : x : xs)
forall {inp :: [T]} {out :: [T]} (t :: T) (s :: [T]).
(inp ~ s, out ~ (t : s), ConstantScope t) =>
Value' Instr t -> Instr inp out
PUSH (Integer -> Value' Instr 'TInt
forall (instr :: [T] -> [T] -> *). Integer -> Value' instr 'TInt
VInt Integer
5) Instr inp ('TInt : x : xs)
-> Instr ('TInt : x : xs) (x : xs) -> Instr inp (x : xs)
forall (inp :: [T]) (b :: [T]) (out :: [T]).
Instr inp b -> Instr b out -> Instr inp out
`Seq` Instr ('TInt : x : xs) (x : xs)
forall (a :: T) (out :: [T]). Instr (a : out) out
DROP
  , Instr inp ('TUnit : x : xs)
forall {inp :: [T]} {out :: [T]} (s :: [T]).
(inp ~ s, out ~ ('TUnit : s)) =>
Instr inp out
UNIT Instr inp ('TUnit : x : xs)
-> Instr ('TUnit : x : xs) (x : 'TUnit : xs)
-> Instr inp (x : 'TUnit : xs)
forall (inp :: [T]) (b :: [T]) (out :: [T]).
Instr inp b -> Instr b out -> Instr inp out
`Seq` Instr ('TUnit : x : xs) (x : 'TUnit : xs)
forall (a :: T) (b :: T) (s :: [T]). Instr (a : b : s) (b : a : s)
SWAP Instr inp (x : 'TUnit : xs)
-> Instr (x : 'TUnit : xs) ('TUnit : x : xs)
-> Instr inp ('TUnit : x : xs)
forall (inp :: [T]) (b :: [T]) (out :: [T]).
Instr inp b -> Instr b out -> Instr inp out
`Seq` Instr (x : 'TUnit : xs) ('TUnit : x : xs)
forall (a :: T) (b :: T) (s :: [T]). Instr (a : b : s) (b : a : s)
SWAP Instr inp ('TUnit : x : xs)
-> Instr ('TUnit : x : xs) (x : xs) -> Instr inp (x : xs)
forall (inp :: [T]) (b :: [T]) (out :: [T]).
Instr inp b -> Instr b out -> Instr inp out
`Seq` Instr ('TUnit : x : xs) (x : xs)
forall (a :: T) (out :: [T]). Instr (a : out) out
DROP
  ]

genBigMapId :: MonadGen m => m Natural
genBigMapId :: forall (m :: * -> *). MonadGen m => m Natural
genBigMapId = Range Natural -> m Natural
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Natural -> Natural -> Range Natural
forall a. a -> a -> Range a
Range.constant Natural
0 Natural
100000000)

genValue'
  :: (MonadGen m, GenBase m ~ Identity, HasNoOp t, WellTyped t)
  => Sing t -> m (Value' Instr t)
genValue' :: forall (m :: * -> *) (t :: T).
(MonadGen m, GenBase m ~ Identity, HasNoOp t, WellTyped t) =>
Sing t -> m (Value' Instr t)
genValue' = \case
  Sing t
SingT t
STKey -> PublicKey -> Value' Instr 'TKey
forall (instr :: [T] -> [T] -> *). PublicKey -> Value' instr 'TKey
VKey (PublicKey -> Value' Instr 'TKey)
-> m PublicKey -> m (Value' Instr 'TKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m PublicKey
forall (m :: * -> *). MonadGen m => m PublicKey
genPublicKey
  Sing t
SingT t
STUnit -> m (Value' Instr t)
forall (m :: * -> *) (instr :: [T] -> [T] -> *).
Applicative m =>
m (Value' instr 'TUnit)
genValueUnit
  Sing t
SingT t
STSignature -> Signature -> Value' Instr 'TSignature
forall (instr :: [T] -> [T] -> *).
Signature -> Value' instr 'TSignature
VSignature (Signature -> Value' Instr 'TSignature)
-> m Signature -> m (Value' Instr 'TSignature)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Signature
forall (m :: * -> *). MonadGen m => m Signature
genSignature
  Sing t
SingT t
STChainId -> ChainId -> Value' Instr 'TChainId
forall (instr :: [T] -> [T] -> *).
ChainId -> Value' instr 'TChainId
VChainId (ChainId -> Value' Instr 'TChainId)
-> m ChainId -> m (Value' Instr 'TChainId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ChainId
forall (m :: * -> *). MonadGen m => m ChainId
genChainId
  STOption Sing n
st -> [m (Value' Instr ('TOption n))] -> m (Value' Instr ('TOption n))
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice
    [ Value' Instr ('TOption n) -> m (Value' Instr ('TOption n))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value' Instr ('TOption n) -> m (Value' Instr ('TOption n)))
-> Value' Instr ('TOption n) -> m (Value' Instr ('TOption n))
forall a b. (a -> b) -> a -> b
$ Maybe (Value' Instr n) -> Value' Instr ('TOption n)
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
Maybe (Value' instr t1) -> Value' instr ('TOption t1)
VOption Maybe (Value' Instr n)
forall a. Maybe a
Nothing
    , Maybe (Value' Instr n) -> Value' Instr ('TOption n)
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
Maybe (Value' instr t1) -> Value' instr ('TOption t1)
VOption (Maybe (Value' Instr n) -> Value' Instr ('TOption n))
-> (Value' Instr n -> Maybe (Value' Instr n))
-> Value' Instr n
-> Value' Instr ('TOption n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value' Instr n -> Maybe (Value' Instr n)
forall a. a -> Maybe a
Just (Value' Instr n -> Value' Instr ('TOption n))
-> m (Value' Instr n) -> m (Value' Instr ('TOption n))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing n -> m (Value' Instr n)
forall (m :: * -> *) (t :: T).
(MonadGen m, GenBase m ~ Identity, HasNoOp t, WellTyped t) =>
Sing t -> m (Value' Instr t)
genValue' Sing n
st
    ]
  STList (STPair Sing n1
SingT n1
STBls12381G1 Sing n2
SingT n2
STBls12381G2) -> m (Value' Instr t)
forall (m :: * -> *).
MonadGen m =>
m (Value' Instr ('TList $ 'TPair 'TBls12381G1 'TBls12381G2))
genBls12Pairing
  STList Sing n
st -> Range Length -> m (Value' Instr n) -> m (Value' Instr ('TList n))
forall (m :: * -> *) (a :: T) (instr :: [T] -> [T] -> *).
(MonadGen m, SingI a) =>
Range Length -> m (Value' instr a) -> m (Value' instr ('TList a))
genValueList Range Length
forall a. Default a => a
def (m (Value' Instr n) -> m (Value' Instr ('TList n)))
-> m (Value' Instr n) -> m (Value' Instr ('TList n))
forall a b. (a -> b) -> a -> b
$ Sing n -> m (Value' Instr n)
forall (m :: * -> *) (t :: T).
(MonadGen m, GenBase m ~ Identity, HasNoOp t, WellTyped t) =>
Sing t -> m (Value' Instr t)
genValue' Sing n
st
  STSet Sing n
st -> Range Length -> m (Value' Instr n) -> m (Value' Instr ('TSet n))
forall (m :: * -> *) (a :: T) (instr :: [T] -> [T] -> *).
(MonadGen m, Comparable a, SingI a) =>
Range Length -> m (Value' instr a) -> m (Value' instr ('TSet a))
genValueSet Range Length
forall a. Default a => a
def (m (Value' Instr n) -> m (Value' Instr ('TSet n)))
-> m (Value' Instr n) -> m (Value' Instr ('TSet n))
forall a b. (a -> b) -> a -> b
$ Sing n -> m (Value' Instr n)
forall (m :: * -> *) (t :: T).
(MonadGen m, GenBase m ~ Identity, HasNoOp t, WellTyped t) =>
Sing t -> m (Value' Instr t)
genValue' Sing n
st
  STContract Sing n
SingT n
STUnit -> Address
-> SomeEntrypointCallT 'TUnit -> Value' Instr ('TContract 'TUnit)
forall (arg :: T) (instr :: [T] -> [T] -> *).
(SingI arg, HasNoOp arg) =>
Address -> SomeEntrypointCallT arg -> Value' instr ('TContract arg)
VContract (Address
 -> SomeEntrypointCallT 'TUnit -> Value' Instr ('TContract 'TUnit))
-> m Address
-> m (SomeEntrypointCallT 'TUnit
      -> Value' Instr ('TContract 'TUnit))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Address
forall (m :: * -> *). MonadGen m => m Address
genAddress m (SomeEntrypointCallT 'TUnit -> Value' Instr ('TContract 'TUnit))
-> m (SomeEntrypointCallT 'TUnit)
-> m (Value' Instr ('TContract 'TUnit))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SomeEntrypointCallT 'TUnit -> m (SomeEntrypointCallT 'TUnit)
forall (f :: * -> *) a. Applicative f => a -> f a
pure SomeEntrypointCallT 'TUnit
forall (param :: T).
ParameterScope param =>
SomeEntrypointCallT param
unsafeSepcCallRoot
  STContract Sing n
_ -> Address -> SomeEntrypointCallT n -> Value' Instr ('TContract n)
forall (arg :: T) (instr :: [T] -> [T] -> *).
(SingI arg, HasNoOp arg) =>
Address -> SomeEntrypointCallT arg -> Value' instr ('TContract arg)
VContract (Address -> SomeEntrypointCallT n -> Value' Instr ('TContract n))
-> m Address
-> m (SomeEntrypointCallT n -> Value' Instr ('TContract n))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (KindedAddress 'AddressKindContract -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress (KindedAddress 'AddressKindContract -> Address)
-> m (KindedAddress 'AddressKindContract) -> m Address
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (KindedAddress 'AddressKindContract)
forall (m :: * -> *).
MonadGen m =>
m (KindedAddress 'AddressKindContract)
genContractAddress) m (SomeEntrypointCallT n -> Value' Instr ('TContract n))
-> m (SomeEntrypointCallT n) -> m (Value' Instr ('TContract n))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SomeEntrypointCallT n -> m (SomeEntrypointCallT n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure SomeEntrypointCallT n
forall (param :: T).
ParameterScope param =>
SomeEntrypointCallT param
unsafeSepcCallRoot
  STTicket Sing n
s -> Range TicketAmount
-> m (Value' Instr n) -> m (Value' Instr ('TTicket n))
forall (m :: * -> *) (a :: T) (instr :: [T] -> [T] -> *).
(MonadGen m, Comparable a) =>
Range TicketAmount
-> m (Value' instr a) -> m (Value' instr ('TTicket a))
genValueTicket Range TicketAmount
forall a. Default a => a
def (m (Value' Instr n) -> m (Value' Instr ('TTicket n)))
-> m (Value' Instr n) -> m (Value' Instr ('TTicket n))
forall a b. (a -> b) -> a -> b
$ Sing n -> m (Value' Instr n)
forall (m :: * -> *) (t :: T).
(MonadGen m, GenBase m ~ Identity, HasNoOp t, WellTyped t) =>
Sing t -> m (Value' Instr t)
genValue' Sing n
s
  STPair Sing n1
SingT n1
STChestKey Sing n2
SingT n2
STChest -> (Value' Instr 'TChestKey, Value' Instr 'TChest)
-> Value' Instr ('TPair 'TChestKey 'TChest)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair ((Value' Instr 'TChestKey, Value' Instr 'TChest)
 -> Value' Instr ('TPair 'TChestKey 'TChest))
-> ((Chest, ChestKey)
    -> (Value' Instr 'TChestKey, Value' Instr 'TChest))
-> (Chest, ChestKey)
-> Value' Instr ('TPair 'TChestKey 'TChest)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChestKey -> Value' Instr 'TChestKey)
-> (Chest -> Value' Instr 'TChest)
-> (ChestKey, Chest)
-> (Value' Instr 'TChestKey, Value' Instr 'TChest)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ChestKey -> Value' Instr 'TChestKey
forall (instr :: [T] -> [T] -> *).
ChestKey -> Value' instr 'TChestKey
VChestKey Chest -> Value' Instr 'TChest
forall (instr :: [T] -> [T] -> *). Chest -> Value' instr 'TChest
VChest ((ChestKey, Chest)
 -> (Value' Instr 'TChestKey, Value' Instr 'TChest))
-> ((Chest, ChestKey) -> (ChestKey, Chest))
-> (Chest, ChestKey)
-> (Value' Instr 'TChestKey, Value' Instr 'TChest)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Chest, ChestKey) -> (ChestKey, Chest)
forall a b. (a, b) -> (b, a)
swap ((Chest, ChestKey) -> Value' Instr ('TPair 'TChestKey 'TChest))
-> m (Chest, ChestKey)
-> m (Value' Instr ('TPair 'TChestKey 'TChest))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Chest, ChestKey)
forall (m :: * -> *). MonadGen m => m (Chest, ChestKey)
genChestAndKey
  STPair Sing n1
l Sing n2
r -> (Value' Instr n1, Value' Instr n2) -> Value' Instr ('TPair n1 n2)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair ((Value' Instr n1, Value' Instr n2) -> Value' Instr ('TPair n1 n2))
-> m (Value' Instr n1, Value' Instr n2)
-> m (Value' Instr ('TPair n1 n2))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (Value' Instr n1
 -> Value' Instr n2 -> (Value' Instr n1, Value' Instr n2))
-> m (Value' Instr n1)
-> m (Value' Instr n2 -> (Value' Instr n1, Value' Instr n2))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing n1 -> m (Value' Instr n1)
forall (m :: * -> *) (t' :: T).
(MonadGen m, GenBase m ~ Identity, WellTyped t') =>
Sing t' -> m (Value' Instr t')
genNoOpValue Sing n1
l m (Value' Instr n2 -> (Value' Instr n1, Value' Instr n2))
-> m (Value' Instr n2) -> m (Value' Instr n1, Value' Instr n2)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sing n2 -> m (Value' Instr n2)
forall (m :: * -> *) (t' :: T).
(MonadGen m, GenBase m ~ Identity, WellTyped t') =>
Sing t' -> m (Value' Instr t')
genNoOpValue Sing n2
r)
  STOr Sing n1
l Sing n2
r -> Either (Value' Instr n1) (Value' Instr n2)
-> Value' Instr ('TOr n1 n2)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(SingI l, SingI r) =>
Either (Value' instr l) (Value' instr r) -> Value' instr ('TOr l r)
VOr (Either (Value' Instr n1) (Value' Instr n2)
 -> Value' Instr ('TOr n1 n2))
-> m (Either (Value' Instr n1) (Value' Instr n2))
-> m (Value' Instr ('TOr n1 n2))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [m (Either (Value' Instr n1) (Value' Instr n2))]
-> m (Either (Value' Instr n1) (Value' Instr n2))
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice
    [ Value' Instr n1 -> Either (Value' Instr n1) (Value' Instr n2)
forall a b. a -> Either a b
Left (Value' Instr n1 -> Either (Value' Instr n1) (Value' Instr n2))
-> m (Value' Instr n1)
-> m (Either (Value' Instr n1) (Value' Instr n2))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing n1 -> m (Value' Instr n1)
forall (m :: * -> *) (t' :: T).
(MonadGen m, GenBase m ~ Identity, WellTyped t') =>
Sing t' -> m (Value' Instr t')
genNoOpValue Sing n1
l
    , Value' Instr n2 -> Either (Value' Instr n1) (Value' Instr n2)
forall a b. b -> Either a b
Right (Value' Instr n2 -> Either (Value' Instr n1) (Value' Instr n2))
-> m (Value' Instr n2)
-> m (Either (Value' Instr n1) (Value' Instr n2))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing n2 -> m (Value' Instr n2)
forall (m :: * -> *) (t' :: T).
(MonadGen m, GenBase m ~ Identity, WellTyped t') =>
Sing t' -> m (Value' Instr t')
genNoOpValue Sing n2
r
    ]
  -- It's quite hard to generate proper lambda of given type, so it always returns FAILWITH.
  -- Such implementation is sufficient for now.
  STLambda{} -> Value' Instr ('TLambda n1 n2) -> m (Value' Instr ('TLambda n1 n2))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value' Instr ('TLambda n1 n2)
 -> m (Value' Instr ('TLambda n1 n2)))
-> Value' Instr ('TLambda n1 n2)
-> m (Value' Instr ('TLambda n1 n2))
forall a b. (a -> b) -> a -> b
$ (IsNotInView => RemFail Instr '[n1] '[n2])
-> Value' Instr ('TLambda n1 n2)
forall (inp :: T) (out :: T) (instr :: [T] -> [T] -> *).
(SingI inp, SingI out,
 forall (i :: [T]) (o :: [T]). Show (instr i o),
 forall (i :: [T]) (o :: [T]). Eq (instr i o),
 forall (i :: [T]) (o :: [T]). NFData (instr i o)) =>
(IsNotInView => RemFail instr '[inp] '[out])
-> Value' instr ('TLambda inp out)
mkVLam ((IsNotInView => RemFail Instr '[n1] '[n2])
 -> Value' Instr ('TLambda n1 n2))
-> (IsNotInView => RemFail Instr '[n1] '[n2])
-> Value' Instr ('TLambda n1 n2)
forall a b. (a -> b) -> a -> b
$ (forall (o' :: [T]). Instr '[n1] o') -> RemFail Instr '[n1] '[n2]
forall {k} (instr :: k -> k -> *) (i :: k) (o :: k).
(forall (o' :: k). instr i o') -> RemFail instr i o
RfAlwaysFails ((forall (o' :: [T]). Instr '[n1] o') -> RemFail Instr '[n1] '[n2])
-> (forall (o' :: [T]). Instr '[n1] o')
-> RemFail Instr '[n1] '[n2]
forall a b. (a -> b) -> a -> b
$ Instr '[n1] '[ 'TUnit, n1]
-> Instr '[ 'TUnit, n1] o' -> Instr '[n1] o'
forall (inp :: [T]) (b :: [T]) (out :: [T]).
Instr inp b -> Instr b out -> Instr inp out
Seq Instr '[n1] '[ 'TUnit, n1]
forall {inp :: [T]} {out :: [T]} (s :: [T]).
(inp ~ s, out ~ ('TUnit : s)) =>
Instr inp out
UNIT Instr '[ 'TUnit, n1] o'
forall (a :: T) (s :: [T]) (out :: [T]).
(SingI a, ConstantScope a) =>
Instr (a : s) out
FAILWITH
  STMap Sing n1
k Sing n2
v -> Range Length
-> m (Value' Instr n1)
-> m (Value' Instr n2)
-> m (Value' Instr ('TMap n1 n2))
forall (k :: T) (v :: T) (m :: * -> *) (instr :: [T] -> [T] -> *).
(MonadGen m, WellTyped k, WellTyped v, Comparable k) =>
Range Length
-> m (Value' instr k)
-> m (Value' instr v)
-> m (Value' instr ('TMap k v))
genValueMap Range Length
forall a. Default a => a
def (Sing n1 -> m (Value' Instr n1)
forall (m :: * -> *) (t' :: T).
(MonadGen m, GenBase m ~ Identity, WellTyped t') =>
Sing t' -> m (Value' Instr t')
genNoOpValue Sing n1
k) (Sing n2 -> m (Value' Instr n2)
forall (m :: * -> *) (t' :: T).
(MonadGen m, GenBase m ~ Identity, WellTyped t') =>
Sing t' -> m (Value' Instr t')
genNoOpValue Sing n2
v)
  STBigMap Sing n1
k Sing n2
v -> Range Length
-> m (Value' Instr n1)
-> m (Value' Instr n2)
-> m (Value' Instr ('TBigMap n1 n2))
forall (k :: T) (v :: T) (m :: * -> *) (instr :: [T] -> [T] -> *).
(MonadGen m, WellTyped k, WellTyped v, HasNoBigMap v,
 Comparable k) =>
Range Length
-> m (Value' instr k)
-> m (Value' instr v)
-> m (Value' instr ('TBigMap k v))
genValueBigMap Range Length
forall a. Default a => a
def (Sing n1 -> m (Value' Instr n1)
forall (m :: * -> *) (t' :: T).
(MonadGen m, GenBase m ~ Identity, WellTyped t') =>
Sing t' -> m (Value' Instr t')
genNoOpValue Sing n1
k) (Sing n2 -> m (Value' Instr n2)
forall (m :: * -> *) (t' :: T).
(MonadGen m, GenBase m ~ Identity, WellTyped t') =>
Sing t' -> m (Value' Instr t')
genNoOpValue Sing n2
v)
  Sing t
SingT t
STInt -> Range (Value' Instr 'TInt) -> m (Value' Instr 'TInt)
forall (m :: * -> *) (instr :: [T] -> [T] -> *).
MonadGen m =>
Range (Value' instr 'TInt) -> m (Value' instr 'TInt)
genValueInt Range (Value' Instr 'TInt)
forall a. Default a => a
def
  Sing t
SingT t
STNat -> Range (Value' Instr 'TNat) -> m (Value' Instr 'TNat)
forall (m :: * -> *) (instr :: [T] -> [T] -> *).
MonadGen m =>
Range (Value' instr 'TNat) -> m (Value' instr 'TNat)
genValueNat Range (Value' Instr 'TNat)
forall a. Default a => a
def
  Sing t
SingT t
STString -> Range Length -> m (Value' Instr 'TString)
forall (f :: * -> *) (instr :: [T] -> [T] -> *).
MonadGen f =>
Range Length -> f (Value' instr 'TString)
genValueString Range Length
forall a. Default a => a
def
  Sing t
SingT t
STBytes -> Range Length -> m (Value' Instr 'TBytes)
forall (f :: * -> *) (instr :: [T] -> [T] -> *).
MonadGen f =>
Range Length -> f (Value' instr 'TBytes)
genValueBytes Range Length
forall a. Default a => a
def
  Sing t
SingT t
STMutez -> Range Mutez -> m (Value' Instr 'TMutez)
forall (m :: * -> *) (instr :: [T] -> [T] -> *).
MonadGen m =>
Range Mutez -> m (Value' instr 'TMutez)
genValueMutez Range Mutez
forall a. Default a => a
def
  Sing t
SingT t
STKeyHash -> m (Value' Instr t)
forall (m :: * -> *) (instr :: [T] -> [T] -> *).
MonadGen m =>
m (Value' instr 'TKeyHash)
genValueKeyHash
  Sing t
SingT t
STTxRollupL2Address ->
    TxRollupL2Address -> Value' Instr 'TTxRollupL2Address
forall (instr :: [T] -> [T] -> *).
TxRollupL2Address -> Value' instr 'TTxRollupL2Address
VTxRollupL2Address (TxRollupL2Address -> Value' Instr 'TTxRollupL2Address)
-> (Text -> TxRollupL2Address)
-> Text
-> Value' Instr 'TTxRollupL2Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHashL2 -> TxRollupL2Address
TxRollupL2Address
    (KeyHashL2 -> TxRollupL2Address)
-> (Text -> KeyHashL2) -> Text -> TxRollupL2Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either CryptoParseError KeyHashL2 -> KeyHashL2
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either CryptoParseError KeyHashL2 -> KeyHashL2)
-> (Text -> Either CryptoParseError KeyHashL2) -> Text -> KeyHashL2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either CryptoParseError KeyHashL2
forall (kind :: HashKind).
AllHashTags kind =>
Text -> Either CryptoParseError (Hash kind)
parseHash (Text -> Value' Instr 'TTxRollupL2Address)
-> m Text -> m (Value' Instr 'TTxRollupL2Address)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> m Text
forall (m :: * -> *) a. MonadGen m => [a] -> m a
Gen.element
      -- TODO [#839]: implement BLS public key generation
      [ Text
"tz4UJqedFMBS7FjAqvZojJMPNd59MLm2hkuc"
      , Text
"tz4Y7kRVfDH2XGQtjc19ppJqejL4CBVmxHED"
      , Text
"tz4LVHYD4P4T5NHCuwJbxQvwVURF62seE3Qa"
      , Text
"tz4MwL5iRbyHvVxH9N69GCeDmYCqbQtewr7R"
      , Text
"tz4AZhg8GuahEs2Uo7dFZxVZwEgNKirtYMhY"
      , Text
"tz4D77UuwdqbmDd7Xh9VNbFRjDiqWbBeWqud"
      , Text
"tz4SYR9zvak9GohAEENUjPk7zAQo46wo6vNE"
      , Text
"tz4UWDSphLswG5xtBwGnodCGL7FBzN21EKSQ"
      , Text
"tz49e42Nbrc15PuT7RgkGqC6Xi3w5jEzEzH1"
      , Text
"tz4F1Nd91Fc3BUCxTCnFaccjnn2hH4W3Bd8X"
      , Text
"tz4MVuy2j5GCjPZQg7cxadPiNWq2nsRA392Y"
      , Text
"tz4StvWhTeDnVpGspXKbfuhuVXhZ1jkAp7Yq"
      ]
  Sing t
SingT t
STBls12381Fr -> Bls12381Fr -> Value' Instr 'TBls12381Fr
forall (instr :: [T] -> [T] -> *).
Bls12381Fr -> Value' instr 'TBls12381Fr
VBls12381Fr (Bls12381Fr -> Value' Instr 'TBls12381Fr)
-> m Bls12381Fr -> m (Value' Instr 'TBls12381Fr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Bls12381Fr
forall (m :: * -> *). MonadGen m => m Bls12381Fr
genBls12381Fr
  Sing t
SingT t
STBls12381G1 -> Bls12381G1 -> Value' Instr 'TBls12381G1
forall (instr :: [T] -> [T] -> *).
Bls12381G1 -> Value' instr 'TBls12381G1
VBls12381G1 (Bls12381G1 -> Value' Instr 'TBls12381G1)
-> m Bls12381G1 -> m (Value' Instr 'TBls12381G1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Bls12381G1
forall (m :: * -> *). MonadGen m => m Bls12381G1
genBls12381G1
  Sing t
SingT t
STBls12381G2 -> Bls12381G2 -> Value' Instr 'TBls12381G2
forall (instr :: [T] -> [T] -> *).
Bls12381G2 -> Value' instr 'TBls12381G2
VBls12381G2 (Bls12381G2 -> Value' Instr 'TBls12381G2)
-> m Bls12381G2 -> m (Value' Instr 'TBls12381G2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Bls12381G2
forall (m :: * -> *). MonadGen m => m Bls12381G2
genBls12381G2
  -- Note that we also have a special case for a list of BLS12 pairings
  Sing t
SingT t
STTimestamp -> Range Timestamp -> m (Value' Instr 'TTimestamp)
forall (m :: * -> *) (instr :: [T] -> [T] -> *).
MonadGen m =>
Range Timestamp -> m (Value' instr 'TTimestamp)
genValueTimestamp Range Timestamp
forall a. Default a => a
def
  Sing t
SingT t
STAddress -> EpAddress -> Value' Instr 'TAddress
forall (instr :: [T] -> [T] -> *).
EpAddress -> Value' instr 'TAddress
VAddress (EpAddress -> Value' Instr 'TAddress)
-> m EpAddress -> m (Value' Instr 'TAddress)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m EpAddress
forall (m :: * -> *).
(MonadGen m, GenBase m ~ Identity) =>
m EpAddress
genEpAddress
  Sing t
SingT t
STBool -> Bool -> Value' Instr 'TBool
forall (instr :: [T] -> [T] -> *). Bool -> Value' instr 'TBool
VBool (Bool -> Value' Instr 'TBool) -> m Bool -> m (Value' Instr 'TBool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Bool
forall (m :: * -> *). MonadGen m => m Bool
Gen.bool
  Sing t
SingT t
STChest -> Chest -> Value' Instr 'TChest
forall (instr :: [T] -> [T] -> *). Chest -> Value' instr 'TChest
VChest (Chest -> Value' Instr 'TChest)
-> ((Chest, ChestKey) -> Chest)
-> (Chest, ChestKey)
-> Value' Instr 'TChest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Chest, ChestKey) -> Chest
forall a b. (a, b) -> a
fst ((Chest, ChestKey) -> Value' Instr 'TChest)
-> m (Chest, ChestKey) -> m (Value' Instr 'TChest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Chest, ChestKey)
forall (m :: * -> *). MonadGen m => m (Chest, ChestKey)
genChestAndKey
  Sing t
SingT t
STChestKey -> ChestKey -> Value' Instr 'TChestKey
forall (instr :: [T] -> [T] -> *).
ChestKey -> Value' instr 'TChestKey
VChestKey (ChestKey -> Value' Instr 'TChestKey)
-> ((Chest, ChestKey) -> ChestKey)
-> (Chest, ChestKey)
-> Value' Instr 'TChestKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Chest, ChestKey) -> ChestKey
forall a b. (a, b) -> b
snd ((Chest, ChestKey) -> Value' Instr 'TChestKey)
-> m (Chest, ChestKey) -> m (Value' Instr 'TChestKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Chest, ChestKey)
forall (m :: * -> *). MonadGen m => m (Chest, ChestKey)
genChestAndKey
  Sing t
SingT t
STNever -> m (Value' Instr t)
forall (m :: * -> *) a. MonadGen m => m a
Gen.discard
  STSaplingState Sing n
_ -> Text -> m (Value' Instr t)
forall a. HasCallStack => Text -> a
error Text
"genValue': Cannot generate `sapling_state` value."
  STSaplingTransaction Sing n
_ -> Text -> m (Value' Instr t)
forall a. HasCallStack => Text -> a
error Text
"genValue': Cannot generate `sapling_transaction` value."
  where
    genNoOpValue
      :: (MonadGen m, GenBase m ~ Identity, WellTyped t')
      => Sing t' -> m (Value' Instr t')
    genNoOpValue :: forall (m :: * -> *) (t' :: T).
(MonadGen m, GenBase m ~ Identity, WellTyped t') =>
Sing t' -> m (Value' Instr t')
genNoOpValue Sing t'
st = case Sing t' -> OpPresence t'
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing t'
st of
      OpPresence t'
OpAbsent -> Sing t' -> m (Value' Instr t')
forall (m :: * -> *) (t :: T).
(MonadGen m, GenBase m ~ Identity, HasNoOp t, WellTyped t) =>
Sing t -> m (Value' Instr t)
genValue' Sing t'
st
      OpPresence t'
_ -> m (Value' Instr t')
forall (m :: * -> *) a. MonadGen m => m a
Gen.discard

    genBls12Pairing
      :: MonadGen m
      => m (Value' Instr ('TList $ 'TPair 'TBls12381G1 'TBls12381G2))
    genBls12Pairing :: forall (m :: * -> *).
MonadGen m =>
m (Value' Instr ('TList $ 'TPair 'TBls12381G1 'TBls12381G2))
genBls12Pairing = [(Int,
  m (Value' Instr ('TList $ 'TPair 'TBls12381G1 'TBls12381G2)))]
-> m (Value' Instr ('TList $ 'TPair 'TBls12381G1 'TBls12381G2))
forall (m :: * -> *) a. MonadGen m => [(Int, m a)] -> m a
Gen.frequency
      [ -- random pairing (likely incorrect one)
        ( Int
1
        , ([(Bls12381G1, Bls12381G2)]
 -> Value' Instr ('TList $ 'TPair 'TBls12381G1 'TBls12381G2))
-> m [(Bls12381G1, Bls12381G2)]
-> m (Value' Instr ('TList $ 'TPair 'TBls12381G1 'TBls12381G2))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Bls12381G1, Bls12381G2)]
-> Value' Instr ('TList $ 'TPair 'TBls12381G1 'TBls12381G2)
forall a. IsoValue a => a -> Value (ToT a)
toVal (m [(Bls12381G1, Bls12381G2)]
 -> m (Value' Instr ('TList $ 'TPair 'TBls12381G1 'TBls12381G2)))
-> m [(Bls12381G1, Bls12381G2)]
-> m (Value' Instr ('TList $ 'TPair 'TBls12381G1 'TBls12381G2))
forall a b. (a -> b) -> a -> b
$ Range Int
-> m (Bls12381G1, Bls12381G2) -> m [(Bls12381G1, Bls12381G2)]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
10) (m (Bls12381G1, Bls12381G2) -> m [(Bls12381G1, Bls12381G2)])
-> m (Bls12381G1, Bls12381G2) -> m [(Bls12381G1, Bls12381G2)]
forall a b. (a -> b) -> a -> b
$
            (,) (Bls12381G1 -> Bls12381G2 -> (Bls12381G1, Bls12381G2))
-> m Bls12381G1 -> m (Bls12381G2 -> (Bls12381G1, Bls12381G2))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Bls12381G1
forall (m :: * -> *). MonadGen m => m Bls12381G1
genBls12381G1 m (Bls12381G2 -> (Bls12381G1, Bls12381G2))
-> m Bls12381G2 -> m (Bls12381G1, Bls12381G2)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Bls12381G2
forall (m :: * -> *). MonadGen m => m Bls12381G2
genBls12381G2
        )
      , -- correct pairing case
        ( Int
1
        , do
            Bls12381G1
g1 <- m Bls12381G1
forall (m :: * -> *). MonadGen m => m Bls12381G1
genBls12381G1
            Bls12381G2
g2 <- m Bls12381G2
forall (m :: * -> *). MonadGen m => m Bls12381G2
genBls12381G2
            let pairing :: [(Bls12381G1, Bls12381G2)]
pairing = [(Bls12381G1
g1, Bls12381G2
g2), (Bls12381G1
g1, Bls12381G2 -> Bls12381G2
forall a. CurveObject a => a -> a
BLS.negate Bls12381G2
g2)]
            Bool
-> m (Value' Instr ('TList $ 'TPair 'TBls12381G1 'TBls12381G2))
-> m (Value' Instr ('TList $ 'TPair 'TBls12381G1 'TBls12381G2))
forall a. HasCallStack => Bool -> a -> a
Ex.assert ([(Bls12381G1, Bls12381G2)] -> Bool
BLS.checkPairing [(Bls12381G1, Bls12381G2)]
pairing) (m (Value' Instr ('TList $ 'TPair 'TBls12381G1 'TBls12381G2))
 -> m (Value' Instr ('TList $ 'TPair 'TBls12381G1 'TBls12381G2)))
-> m (Value' Instr ('TList $ 'TPair 'TBls12381G1 'TBls12381G2))
-> m (Value' Instr ('TList $ 'TPair 'TBls12381G1 'TBls12381G2))
forall a b. (a -> b) -> a -> b
$
              Value' Instr ('TList $ 'TPair 'TBls12381G1 'TBls12381G2)
-> m (Value' Instr ('TList $ 'TPair 'TBls12381G1 'TBls12381G2))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Bls12381G1, Bls12381G2)]
-> Value (ToT [(Bls12381G1, Bls12381G2)])
forall a. IsoValue a => a -> Value (ToT a)
toVal [(Bls12381G1, Bls12381G2)]
pairing)
        )
      ]