Origination.hs

-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

module Michelson.Typed.Origination
  ( OriginationOperation(..)
  , mkOriginationOperationHash
  ) where

import Data.Binary.Put (putWord64be, runPut)
import qualified Data.ByteString.Lazy as BSL

import Michelson.Interpret.Pack (encodeKeyHashRaw, encodeValue', packCode')
import Michelson.Typed.Aliases (Value)
import Michelson.Typed.Instr (Contract(..), cCode)
import Michelson.Typed.Scope (ParameterScope, StorageScope)
import Tezos.Address (Address, OperationHash(..))
import Tezos.Core (Mutez(..))
import Tezos.Crypto (KeyHash, blake2b)

-- | Data necessary to originate a contract.
data OriginationOperation =
  forall cp st.
  (StorageScope st, ParameterScope cp) =>
  OriginationOperation
  { ooOriginator :: Address
  -- ^ Originator of the contract.
  , ooDelegate :: Maybe KeyHash
  -- ^ Optional delegate.
  , ooBalance :: Mutez
  -- ^ Initial balance of the contract.
  , ooStorage :: Value st
  -- ^ Initial storage value of the contract.
  , ooContract :: Contract cp st
  -- ^ The contract itself.
  }

deriving stock instance Show OriginationOperation

-- | Construct 'OperationHash' for an 'OriginationOperation'.
mkOriginationOperationHash :: OriginationOperation -> OperationHash
mkOriginationOperationHash OriginationOperation{..} =
  OperationHash $ blake2b packedOperation
  where
    -- In Tezos OriginationOperation is encoded as 4-tuple of
    -- (balance, optional delegate, code, storage)
    --
    -- See https://gitlab.com/tezos/tezos/-/blob/f57c50e3a657956d69a1699978de9873c98f0018/src/proto_006_PsCARTHA/lib_protocol/operation_repr.ml#L314
    -- and https://gitlab.com/tezos/tezos/-/blob/f57c50e3a657956d69a1699978de9873c98f0018/src/proto_006_PsCARTHA/lib_protocol/script_repr.ml#L68
    packedOperation =
      BSL.toStrict (runPut $ putWord64be $ unMutez ooBalance)
      <> packMaybe (BSL.toStrict . encodeKeyHashRaw) ooDelegate
      <> packCode' (cCode ooContract)
      <> encodeValue' ooStorage

    -- "optional" encoding in Tezos.
    --
    -- See https://gitlab.com/nomadic-labs/data-encoding/-/blob/2c2b795a37e7d76e3eaa861da9855f2098edc9b9/src/binary_writer.ml#L278-283
    packMaybe :: (a -> ByteString) -> Maybe a -> ByteString
    packMaybe _ Nothing = "\255"
    packMaybe f (Just a) = "\0" <> f a