Origination.hs

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

-- | Functions to originate smart contracts via @tezos-client@ and node RPC.
module Morley.Client.Action.Origination
  ( originateContract
  , originateContracts
  , originateUntypedContract
  -- Lorentz version
  , lOriginateContract
  , lOriginateContracts

  -- * Large originations
  , originateLargeContracts
  , originateLargeContract
  , originateLargeUntypedContract
  -- Lorentz version
  , lOriginateLargeContracts
  , lOriginateLargeContract

  -- Datatypes for batch originations
  , LOriginationData (..)
  , OriginationData (..)
  ) where

import Data.Default (def)
import Lorentz qualified as L
import Lorentz.Constraints
import Morley.Client.Action.Common
import Morley.Client.Action.Operation
import Morley.Client.Action.Origination.Large
import Morley.Client.Action.Transaction (runTransactions)
import Morley.Client.Logging
import Morley.Client.RPC.Class
import Morley.Client.RPC.Error
import Morley.Client.RPC.Types
import Morley.Client.TezosClient
import Morley.Client.Types
import Morley.Michelson.TypeCheck (typeCheckContractAndStorage, typeCheckingWith)
import Morley.Michelson.Typed (Contract, IsoValue(..), SomeContractAndStorage(..), Value)
import Morley.Michelson.Typed.Scope
import Morley.Michelson.Untyped qualified as U
import Morley.Tezos.Address
import Morley.Tezos.Address.Alias
import Morley.Tezos.Core
import Morley.Util.Exception

-- | Originate given contracts with given initial storages. Returns
-- operation hash (or @Nothing@ in case empty list was provided)
-- and originated contracts' addresses.
originateContracts
  :: forall m env.
     ( HasTezosRpc m
     , HasTezosClient m
     , WithClientLog env m
     )
  => ImplicitAddressOrAlias
  -> [OriginationData]
  -> m (Maybe OperationHash, [ContractAddress])
originateContracts sender originations = do
  (opHash, res) <- runOperations sender (OpOriginate <$> originations)
  return (opHash, fromOrigination <$> res)
  where
    fromOrigination = \case
      OpOriginate r -> r
      _ -> error "Unexpectedly not origination"

-- | Originate single contract
originateContract
  :: forall m cp st env.
     ( HasTezosRpc m
     , HasTezosClient m
     , WithClientLog env m
     , StorageScope st
     , ParameterScope cp
     )
  => Bool
  -> ContractAlias
  -> ImplicitAddressOrAlias
  -> Mutez
  -> Contract cp st
  -> Value st
  -> Maybe Mutez
  -> m (OperationHash, ContractAddress)
originateContract odReplaceExisting odName sender' odBalance odContract odStorage odMbFee = do
  (hash, contracts) <- originateContracts sender' [OriginationData{..}]
  singleOriginatedContract hash contracts

-- | Originate a single untyped contract
originateUntypedContract
  :: forall m env.
     ( HasTezosRpc m
     , HasTezosClient m
     , WithClientLog env m
     )
  => Bool
  -> ContractAlias
  -> ImplicitAddressOrAlias
  -> Mutez
  -> U.Contract
  -> U.Value
  -> Maybe Mutez
  -> m (OperationHash, ContractAddress)
originateUntypedContract replaceExisting name sender' balance uContract initialStorage mbFee = do
  SomeContractAndStorage contract storage <-
    throwLeft . pure . typeCheckingWith def $
      typeCheckContractAndStorage uContract initialStorage
  originateContract replaceExisting name sender' balance contract storage mbFee

-- | Lorentz version of 'originateContracts'
lOriginateContracts
  :: forall m env.
     ( HasTezosRpc m
     , HasTezosClient m
     , WithClientLog env m
     )
  => ImplicitAddressOrAlias
  -> [LOriginationData]
  -> m (Maybe OperationHash, [ContractAddress])
lOriginateContracts sender' originations =
  originateContracts sender' $ map convertLOriginationData originations

-- | Originate single Lorentz contract
lOriginateContract
  :: forall m cp st vd env.
     ( HasTezosRpc m
     , HasTezosClient m
     , WithClientLog env m
     , NiceStorage st
     , NiceParameterFull cp
     )
  => Bool
  -> ContractAlias
  -> ImplicitAddressOrAlias
  -> Mutez
  -> L.Contract cp st vd
  -> st
  -> Maybe Mutez
  -> m (OperationHash, ContractAddress)
lOriginateContract lodReplaceExisting lodName sender' lodBalance lodContract lodStorage lodMbFee = do
  (hash, contracts) <- lOriginateContracts sender' [LOriginationData{..}]
  singleOriginatedContract @m hash contracts

--------------------------------------------------------------------------------
-- Large Originations
--------------------------------------------------------------------------------

-- | Automated multi-step origination process for contracts that don't fit into
-- the origination limit. See "Morley.Client.Action.Origination.Large".
originateLargeContracts
  :: forall m env.
     ( HasTezosRpc m
     , HasTezosClient m
     , WithClientLog env m
     )
  => ImplicitAddressOrAlias
  -> [OriginationData]
  -> m (Maybe OperationHash, [ContractAddress])
originateLargeContracts sender' largeOriginations = do
  senderAddress <- resolveAddress sender'
  -- calculate large contract originators
  let originators = map mkLargeOriginationData largeOriginations
  -- originate them. Note: we use the operation hash from here even tho the
  -- large contracts are originated in another one, because those happen in
  -- several different transactions.
  (opHash, originatorsAddr) <- originateContracts sender' $
    map (mkLargeOriginatorData senderAddress) originators
  -- run all the transactions needed (for each large contract originator)
  -- Note: it is not possible to run these all at once, because the node won't
  -- accept a transaction batch where the sum of the storage cost is over 16k,
  -- so here we need to run them one by one.
  mapM_ (runTransactions senderAddress . (: [])) . concat $
    zipWith mkLargeOriginatorTransactions originatorsAddr originators
  -- get the addresses of the originated large contracts back from the originators
  -- and remember their addresses with their aliases
  originatedContracts <- zipWithM retrieveLargeContracts originatorsAddr largeOriginations
  return (opHash, originatedContracts)

-- | Originate a single large contract
originateLargeContract
  :: forall m cp st env.
     ( HasTezosRpc m
     , HasTezosClient m
     , WithClientLog env m
     , StorageScope st
     , ParameterScope cp
     )
  => Bool
  -> ContractAlias
  -> ImplicitAddressOrAlias
  -> Mutez
  -> Contract cp st
  -> Value st
  -> Maybe Mutez
  -> m (OperationHash, ContractAddress)
originateLargeContract odReplaceExisting odName sender' odBalance odContract odStorage odMbFee = do
  (hash, contracts) <- originateLargeContracts sender' [OriginationData{..}]
  singleOriginatedContract @m hash contracts

-- | Originate a single untyped large contract
originateLargeUntypedContract
  :: forall m env.
     ( HasTezosRpc m
     , HasTezosClient m
     , WithClientLog env m
     )
  => Bool
  -> ContractAlias
  -> ImplicitAddressOrAlias
  -> Mutez
  -> U.Contract
  -> U.Value
  -> Maybe Mutez
  -> m (OperationHash, ContractAddress)
originateLargeUntypedContract replaceExisting name sender' balance uContract initialStorage mbFee = do
  SomeContractAndStorage contract storage <-
    throwLeft . pure . typeCheckingWith def $
      typeCheckContractAndStorage uContract initialStorage
  originateLargeContract replaceExisting name sender' balance contract storage mbFee

-- | Lorentz version of 'originateLargeContracts'
lOriginateLargeContracts
  :: forall m env.
     ( HasTezosRpc m
     , HasTezosClient m
     , WithClientLog env m
     )
  => ImplicitAddressOrAlias
  -> [LOriginationData]
  -> m (Maybe OperationHash, [ContractAddress])
lOriginateLargeContracts sender' originations =
  originateLargeContracts sender' $ map convertLOriginationData originations

-- | Originate a single large Lorentz contract
lOriginateLargeContract
  :: forall m cp st vd env.
     ( HasTezosRpc m
     , HasTezosClient m
     , WithClientLog env m
     , NiceStorage st
     , NiceParameterFull cp
     )
  => Bool
  -> ContractAlias
  -> ImplicitAddressOrAlias
  -> Mutez
  -> L.Contract cp st vd
  -> st
  -> Maybe Mutez
  -> m (OperationHash, ContractAddress)
lOriginateLargeContract lodReplaceExisting lodName sender' lodBalance lodContract lodStorage lodMbFee = do
  (hash, contracts) <- lOriginateLargeContracts sender' [LOriginationData{..}]
  singleOriginatedContract @m hash contracts

--------------------------------------------------------------------------------
-- Utilities
--------------------------------------------------------------------------------

-- | Lorentz version of 'OriginationData'
data LOriginationData = forall cp st vd. (NiceParameterFull cp, NiceStorage st)
  => LOriginationData
  { lodReplaceExisting :: Bool
  , lodName :: ContractAlias
  , lodBalance :: Mutez
  , lodContract :: L.Contract cp st vd
  , lodStorage :: st
  , lodMbFee :: Maybe Mutez
  }

convertLOriginationData :: LOriginationData -> OriginationData
convertLOriginationData LOriginationData {..} = case lodContract of
  (_ :: L.Contract cp st vd) ->
    withDict (niceStorageEvi @st) $
      withDict (niceParameterEvi @cp) $ OriginationData
        { odReplaceExisting = lodReplaceExisting
        , odName = lodName
        , odBalance = lodBalance
        , odContract = L.toMichelsonContract lodContract
        , odStorage = toVal lodStorage
        , odMbFee = lodMbFee
        }

-- | Checks that the origination result for a single contract is indeed one.
singleOriginatedContract
  :: forall m. HasTezosRpc m
  => Maybe OperationHash -> [ContractAddress]
  -> m (OperationHash, ContractAddress)
singleOriginatedContract mbHash contracts = case contracts of
  [addr] -> case mbHash of
    Just hash -> return (hash, addr)
    Nothing -> throwM $ RpcOriginatedNoContracts
  _ ->  throwM $ RpcOriginatedMoreContracts contracts