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

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

module Morley.Michelson.Runtime.Dummy
  ( dummyNow
  , dummyLevel
  , dummyMaxSteps
  , dummyVotingPowers
  , dummyBigMapCounter
  , dummyContractEnv
  , dummyGlobalCounter
  , dummyOrigination
  , dummyMinBlockTime
  ) where

import Data.Default (def)

import Morley.Michelson.Interpret (ContractEnv(..), RemainingSteps)
import Morley.Michelson.Runtime.GState (BigMapCounter, dummyVotingPowers, genesisAddress)
import Morley.Michelson.Typed (ParameterScope, StorageScope)
import Morley.Michelson.Typed qualified as T
import Morley.Michelson.Typed.Operation (OriginationOperation(..))
import Morley.Tezos.Address (GlobalCounter(..))
import Morley.Tezos.Core (Timestamp(..), dummyChainId, tz)

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

dummyLevel :: Natural
dummyLevel :: Natural
dummyLevel = Natural
4000

dummyMinBlockTime :: Natural
dummyMinBlockTime :: Natural
dummyMinBlockTime = Natural
1

-- | 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 = RemainingSteps
100500

dummyBigMapCounter :: BigMapCounter
dummyBigMapCounter :: BigMapCounter
dummyBigMapCounter = BigMapCounter
0

dummyGlobalCounter :: GlobalCounter
dummyGlobalCounter :: GlobalCounter
dummyGlobalCounter = GlobalCounter
0

-- | Dummy 'ContractEnv' with some reasonable hardcoded values. You
-- can override values you are interested in using record update
-- syntax.
dummyContractEnv :: ContractEnv
dummyContractEnv :: ContractEnv
dummyContractEnv = ContractEnv :: Timestamp
-> RemainingSteps
-> Mutez
-> Map Address AddressState
-> Address
-> Address
-> Address
-> Mutez
-> VotingPowers
-> ChainId
-> Maybe OperationHash
-> Natural
-> ErrorSrcPos
-> Natural
-> ContractEnv
ContractEnv
  { ceNow :: Timestamp
ceNow = Timestamp
dummyNow
  , ceMaxSteps :: RemainingSteps
ceMaxSteps = RemainingSteps
dummyMaxSteps
  , ceBalance :: Mutez
ceBalance = [tz|100u|]
  , ceContracts :: Map Address AddressState
ceContracts = Map Address AddressState
forall a. Monoid a => a
mempty
  , ceSelf :: Address
ceSelf = Address
genesisAddress
  , ceSource :: Address
ceSource = Address
genesisAddress
  , ceSender :: Address
ceSender = Address
genesisAddress
  , ceAmount :: Mutez
ceAmount = [tz|100u|]
  , ceVotingPowers :: VotingPowers
ceVotingPowers = VotingPowers
dummyVotingPowers
  , ceChainId :: ChainId
ceChainId = ChainId
dummyChainId
  , ceOperationHash :: Maybe OperationHash
ceOperationHash = Maybe OperationHash
forall a. Maybe a
Nothing
  , ceLevel :: Natural
ceLevel = Natural
dummyLevel
  , ceErrorSrcPos :: ErrorSrcPos
ceErrorSrcPos = ErrorSrcPos
forall a. Default a => a
def
  , ceMinBlockTime :: Natural
ceMinBlockTime = Natural
dummyMinBlockTime
  }

-- | 'OriginationOperation' with most data hardcoded to some
-- reasonable values. Contract and initial values must be passed
-- explicitly, because otherwise it hardly makes sense.
dummyOrigination
  :: (ParameterScope cp, StorageScope st)
  => T.Value st
  -> T.Contract cp st
  -> GlobalCounter
  -> OriginationOperation
dummyOrigination :: forall (cp :: T) (st :: T).
(ParameterScope cp, StorageScope st) =>
Value st -> Contract cp st -> GlobalCounter -> OriginationOperation
dummyOrigination Value st
storage Contract cp st
contract GlobalCounter
counter = OriginationOperation :: forall (cp :: T) (st :: T).
(StorageScope st, ParameterScope cp) =>
Address
-> Maybe KeyHash
-> Mutez
-> Value st
-> Contract cp st
-> GlobalCounter
-> Maybe Alias
-> OriginationOperation
OriginationOperation
  { ooOriginator :: Address
ooOriginator = Address
genesisAddress
  , ooDelegate :: Maybe KeyHash
ooDelegate = Maybe KeyHash
forall a. Maybe a
Nothing
  , ooBalance :: Mutez
ooBalance = [tz|100u|]
  , ooStorage :: Value st
ooStorage = Value st
storage
  , ooContract :: Contract cp st
ooContract = Contract cp st
contract
  , ooCounter :: GlobalCounter
ooCounter = GlobalCounter
counter
  , ooAlias :: Maybe Alias
ooAlias = Maybe Alias
forall a. Maybe a
Nothing
  }