-- 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
  , dummySelf
  , dummyContractState
  ) where

import Data.Default (def)

import Morley.Michelson.Interpret (ContractEnv'(..), RemainingSteps)
import Morley.Michelson.Runtime.GState
  (BigMapCounter, ContractState(..), 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
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

dummySelf :: ContractAddress
dummySelf :: ContractAddress
dummySelf = [ta|KT1AEseqMV6fk2vtvQCVyA7ZCaxv7cpxtXdB|]

-- | Dummy 'ContractEnv' with some reasonable hardcoded values. You
-- can override values you are interested in using record update
-- syntax.
dummyContractEnv :: Applicative m => ContractEnv' m
dummyContractEnv :: forall (m :: * -> *). Applicative m => ContractEnv' m
dummyContractEnv = ContractEnv
  { ceNow :: Timestamp
ceNow = Timestamp
dummyNow
  , ceMaxSteps :: RemainingSteps
ceMaxSteps = RemainingSteps
dummyMaxSteps
  , ceBalance :: Mutez
ceBalance = [tz|100u|]
  , ceContracts :: ContractAddress -> m (Maybe ContractState)
ceContracts = m (Maybe ContractState)
-> ContractAddress -> m (Maybe ContractState)
forall a b. a -> b -> a
const (m (Maybe ContractState)
 -> ContractAddress -> m (Maybe ContractState))
-> m (Maybe ContractState)
-> ContractAddress
-> m (Maybe ContractState)
forall a b. (a -> b) -> a -> b
$ Maybe ContractState -> m (Maybe ContractState)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ContractState
forall a. Maybe a
Nothing
  , ceSelf :: ContractAddress
ceSelf = ContractAddress
dummySelf
  , ceSource :: L1Address
ceSource = KindedAddress 'AddressKindImplicit -> L1Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained KindedAddress 'AddressKindImplicit
genesisAddress
  , ceSender :: L1Address
ceSender = KindedAddress 'AddressKindImplicit -> L1Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained KindedAddress 'AddressKindImplicit
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
  , ceMetaWrapper :: forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
ceMetaWrapper = Instr i o -> Instr i o
forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
forall a. a -> a
id
  }

-- | '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
  { ooOriginator :: KindedAddress 'AddressKindImplicit
ooOriginator = KindedAddress 'AddressKindImplicit
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 ContractAlias
ooAlias = Maybe ContractAlias
forall a. Maybe a
Nothing
  }

-- | Construct dummy 'ContractState' for the given parameter type. This can be
-- useful with @runCode@. The state constructed doesn't have any views, and uses
-- @unit@ for storage.
dummyContractState :: T.ParameterScope t => T.ParamNotes t -> ContractState
dummyContractState :: forall (t :: T). ParameterScope t => ParamNotes t -> ContractState
dummyContractState ParamNotes t
notes = ContractState
  { csContract :: Contract t 'TUnit
csContract = T.Contract
      { cCode :: ContractCode' Instr t 'TUnit
cCode = (IsNotInView => Instr (ContractInp t 'TUnit) (ContractOut 'TUnit))
-> ContractCode' Instr t 'TUnit
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
(IsNotInView => instr (ContractInp cp st) (ContractOut st))
-> ContractCode' instr cp st
T.mkContractCode ((IsNotInView => Instr (ContractInp t 'TUnit) (ContractOut 'TUnit))
 -> ContractCode' Instr t 'TUnit)
-> (IsNotInView =>
    Instr (ContractInp t 'TUnit) (ContractOut 'TUnit))
-> ContractCode' Instr t 'TUnit
forall a b. (a -> b) -> a -> b
$ Instr (ContractInp t 'TUnit) '[ 'TUnit]
forall {inp :: [T]} {out :: [T]} (a :: T) (b :: T) (s :: [T]).
(inp ~ ('TPair a b : s), out ~ (b : s)) =>
Instr inp out
T.CDR Instr (ContractInp t 'TUnit) '[ 'TUnit]
-> Instr '[ 'TUnit] (ContractOut 'TUnit)
-> Instr (ContractInp t 'TUnit) (ContractOut 'TUnit)
forall (a :: [T]) (c :: [T]) (b :: [T]).
Instr a b -> Instr b c -> Instr a c
T.:# Instr '[ 'TUnit] '[ 'TList 'TOperation, 'TUnit]
forall {inp :: [T]} {out :: [T]} (p :: T) (s :: [T]).
(inp ~ s, out ~ ('TList p : s), SingI p) =>
Instr inp out
T.NIL Instr '[ 'TUnit] '[ 'TList 'TOperation, 'TUnit]
-> Instr '[ 'TList 'TOperation, 'TUnit] (ContractOut 'TUnit)
-> Instr '[ 'TUnit] (ContractOut 'TUnit)
forall (a :: [T]) (c :: [T]) (b :: [T]).
Instr a b -> Instr b c -> Instr a c
T.:# Instr '[ 'TList 'TOperation, 'TUnit] (ContractOut 'TUnit)
forall {inp :: [T]} {out :: [T]} (a :: T) (b :: T) (s :: [T]).
(inp ~ (a : b : s), out ~ ('TPair a b : s)) =>
Instr inp out
T.PAIR
      , cParamNotes :: ParamNotes t
cParamNotes = ParamNotes t
notes
      , cStoreNotes :: Notes 'TUnit
cStoreNotes = Notes 'TUnit
forall (t :: T). SingI t => Notes t
T.starNotes
      , cEntriesOrder :: EntriesOrder
cEntriesOrder = EntriesOrder
forall a. Default a => a
def
      , cViews :: ViewsSet' Instr 'TUnit
cViews = ViewsSet' Instr 'TUnit
forall a. Default a => a
def
      }
  , csDelegate :: Maybe KeyHash
csDelegate = Maybe KeyHash
forall a. Maybe a
Nothing
  , csBalance :: Mutez
csBalance = [tz|100u|]
  , csStorage :: Value 'TUnit
csStorage = Value 'TUnit
forall (instr :: [T] -> [T] -> *). Value' instr 'TUnit
T.VUnit
  }