-- | Dummy data to be used in tests where it's not essential.

module Michelson.Test.Dummy
  ( dummyNow
  , dummyMaxSteps
  , dummyContractEnv
  , dummyOrigination
  ) where

import Michelson.Interpret (ContractEnv(..), RemainingSteps)
import Michelson.Runtime.GState (genesisAddress)
import Michelson.Untyped
import Tezos.Core (Timestamp(..), dummyChainId, unsafeMkMutez)

-- | Dummy timestamp, can be used to specify current `NOW` value or
-- maybe something else.
dummyNow :: Timestamp
dummyNow :: Timestamp
dummyNow = POSIXTime -> Timestamp
Timestamp 100

-- | Dummy value for maximal number of steps a contract can
-- make. Intentionally quite large, because most likely if you use
-- dummy value you don't want the interpreter to stop due to gas
-- exhaustion. On the other hand, it probably still prevents the
-- interpreter from working for eternity.
dummyMaxSteps :: RemainingSteps
dummyMaxSteps :: RemainingSteps
dummyMaxSteps = 100500

-- | Dummy 'ContractEnv' with some reasonable hardcoded values. You
-- can override values you are interested in using record update
-- syntax.
dummyContractEnv :: ContractEnv
dummyContractEnv :: ContractEnv
dummyContractEnv = $WContractEnv :: Timestamp
-> RemainingSteps
-> Mutez
-> TcOriginatedContracts
-> Address
-> Address
-> Address
-> Mutez
-> ChainId
-> ContractEnv
ContractEnv
  { ceNow :: Timestamp
ceNow = Timestamp
dummyNow
  , ceMaxSteps :: RemainingSteps
ceMaxSteps = RemainingSteps
dummyMaxSteps
  , ceBalance :: Mutez
ceBalance = HasCallStack => Word64 -> Mutez
Word64 -> Mutez
unsafeMkMutez 100
  , ceContracts :: TcOriginatedContracts
ceContracts = TcOriginatedContracts
forall a. Monoid a => a
mempty
  , ceSelf :: Address
ceSelf = Address
genesisAddress
  , ceSource :: Address
ceSource = Address
genesisAddress
  , ceSender :: Address
ceSender = Address
genesisAddress
  , ceAmount :: Mutez
ceAmount = HasCallStack => Word64 -> Mutez
Word64 -> Mutez
unsafeMkMutez 100
  , ceChainId :: ChainId
ceChainId = ChainId
dummyChainId
  }

-- | 'OriginationOperation' with most data hardcoded to some
-- reasonable values. Contract and initial values must be passed
-- explicitly, because otherwise it hardly makes sense.
dummyOrigination ::
     Value
  -> Contract
  -> OriginationOperation
dummyOrigination :: Value -> Contract -> OriginationOperation
dummyOrigination storage :: Value
storage contract :: Contract
contract = $WOriginationOperation :: Address
-> Maybe KeyHash
-> Mutez
-> Value
-> Contract
-> OriginationOperation
OriginationOperation
  { ooOriginator :: Address
ooOriginator = Address
genesisAddress
  , ooDelegate :: Maybe KeyHash
ooDelegate = Maybe KeyHash
forall a. Maybe a
Nothing
  , ooBalance :: Mutez
ooBalance = HasCallStack => Word64 -> Mutez
Word64 -> Mutez
unsafeMkMutez 100
  , ooStorage :: Value
ooStorage = Value
storage
  , ooContract :: Contract
ooContract = Contract
contract
  }