-- 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
  { OriginationOperation -> Address
ooOriginator :: Address
  -- ^ Originator of the contract.
  , OriginationOperation -> Maybe KeyHash
ooDelegate :: Maybe KeyHash
  -- ^ Optional delegate.
  , OriginationOperation -> Mutez
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
mkOriginationOperationHash OriginationOperation{..} =
  ByteString -> OperationHash
OperationHash (ByteString -> OperationHash) -> ByteString -> OperationHash
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
blake2b ByteString
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 :: ByteString
packedOperation =
      ByteString -> ByteString
BSL.toStrict (Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Word64 -> Put
putWord64be (Word64 -> Put) -> Word64 -> Put
forall a b. (a -> b) -> a -> b
$ Mutez -> Word64
unMutez Mutez
ooBalance)
      ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (KeyHash -> ByteString) -> Maybe KeyHash -> ByteString
forall a. (a -> ByteString) -> Maybe a -> ByteString
packMaybe (ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (KeyHash -> ByteString) -> KeyHash -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash -> ByteString
encodeKeyHashRaw) Maybe KeyHash
ooDelegate
      ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Instr (ContractInp cp st) (ContractOut st) -> ByteString
forall (inp :: [T]) (out :: [T]). Instr inp out -> ByteString
packCode' (Contract cp st -> Instr (ContractInp cp st) (ContractOut st)
forall (cp :: T) (st :: T). Contract cp st -> ContractCode cp st
cCode Contract cp st
ooContract)
      ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Value st -> ByteString
forall (t :: T). (SingI t, HasNoOp t) => Value t -> ByteString
encodeValue' Value st
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 :: (a -> ByteString) -> Maybe a -> ByteString
packMaybe _ Nothing = "\255"
    packMaybe f :: a -> ByteString
f (Just a :: a
a) = "\0" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> a -> ByteString
f a
a