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

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

  -- * Operation hashing
  , OperationHash (..)
  , mkContractAddress

  ) where

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

import Michelson.Interpret.Pack (toBinary')
import Michelson.Typed.Aliases (Value)
import Michelson.Typed.Haskell.Value (IsoValue(..))
import Michelson.Typed.Instr (Contract(..), cCode)
import Michelson.Typed.Scope (ParameterScope, StorageScope)
import Tezos.Address
  (Address(ContractAddress), ContractHash(..), GlobalCounter(..), OriginationIndex(..))
import Tezos.Core (Mutez(..))
import Tezos.Crypto (KeyHash, blake2b, blake2b160)

-- | 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{Maybe KeyHash
Mutez
Address
Value st
Contract cp st
ooContract :: Contract cp st
ooStorage :: Value st
ooBalance :: Mutez
ooDelegate :: Maybe KeyHash
ooOriginator :: Address
ooContract :: ()
ooStorage :: ()
ooBalance :: OriginationOperation -> Mutez
ooDelegate :: OriginationOperation -> Maybe KeyHash
ooOriginator :: OriginationOperation -> Address
..} =
  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 (Value 'TKeyHash -> ByteString
forall a. ToExpression a => a -> ByteString
toBinary' (Value 'TKeyHash -> ByteString)
-> (KeyHash -> Value 'TKeyHash) -> KeyHash -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash -> Value 'TKeyHash
forall a. IsoValue a => a -> Value (ToT a)
toVal) Maybe KeyHash
ooDelegate
      ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ContractCode cp st -> ByteString
forall a. ToExpression a => a -> ByteString
toBinary' (Contract cp st -> ContractCode cp 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 a. ToExpression a => a -> ByteString
toBinary' 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 a -> ByteString
_ Maybe a
Nothing = ByteString
"\255"
    packMaybe a -> ByteString
f (Just a
a) = ByteString
"\0" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> a -> ByteString
f a
a

----------------------------------------------------------------------------
-- Operation hash
----------------------------------------------------------------------------

newtype OperationHash = OperationHash
  { OperationHash -> ByteString
unOperationHash :: ByteString
  }
  deriving stock (Int -> OperationHash -> ShowS
[OperationHash] -> ShowS
OperationHash -> String
(Int -> OperationHash -> ShowS)
-> (OperationHash -> String)
-> ([OperationHash] -> ShowS)
-> Show OperationHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OperationHash] -> ShowS
$cshowList :: [OperationHash] -> ShowS
show :: OperationHash -> String
$cshow :: OperationHash -> String
showsPrec :: Int -> OperationHash -> ShowS
$cshowsPrec :: Int -> OperationHash -> ShowS
Show, OperationHash -> OperationHash -> Bool
(OperationHash -> OperationHash -> Bool)
-> (OperationHash -> OperationHash -> Bool) -> Eq OperationHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OperationHash -> OperationHash -> Bool
$c/= :: OperationHash -> OperationHash -> Bool
== :: OperationHash -> OperationHash -> Bool
$c== :: OperationHash -> OperationHash -> Bool
Eq, Eq OperationHash
Eq OperationHash
-> (OperationHash -> OperationHash -> Ordering)
-> (OperationHash -> OperationHash -> Bool)
-> (OperationHash -> OperationHash -> Bool)
-> (OperationHash -> OperationHash -> Bool)
-> (OperationHash -> OperationHash -> Bool)
-> (OperationHash -> OperationHash -> OperationHash)
-> (OperationHash -> OperationHash -> OperationHash)
-> Ord OperationHash
OperationHash -> OperationHash -> Bool
OperationHash -> OperationHash -> Ordering
OperationHash -> OperationHash -> OperationHash
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OperationHash -> OperationHash -> OperationHash
$cmin :: OperationHash -> OperationHash -> OperationHash
max :: OperationHash -> OperationHash -> OperationHash
$cmax :: OperationHash -> OperationHash -> OperationHash
>= :: OperationHash -> OperationHash -> Bool
$c>= :: OperationHash -> OperationHash -> Bool
> :: OperationHash -> OperationHash -> Bool
$c> :: OperationHash -> OperationHash -> Bool
<= :: OperationHash -> OperationHash -> Bool
$c<= :: OperationHash -> OperationHash -> Bool
< :: OperationHash -> OperationHash -> Bool
$c< :: OperationHash -> OperationHash -> Bool
compare :: OperationHash -> OperationHash -> Ordering
$ccompare :: OperationHash -> OperationHash -> Ordering
$cp1Ord :: Eq OperationHash
Ord, (forall x. OperationHash -> Rep OperationHash x)
-> (forall x. Rep OperationHash x -> OperationHash)
-> Generic OperationHash
forall x. Rep OperationHash x -> OperationHash
forall x. OperationHash -> Rep OperationHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OperationHash x -> OperationHash
$cfrom :: forall x. OperationHash -> Rep OperationHash x
Generic)
  deriving anyclass (OperationHash -> ()
(OperationHash -> ()) -> NFData OperationHash
forall a. (a -> ()) -> NFData a
rnf :: OperationHash -> ()
$crnf :: OperationHash -> ()
NFData)

-- | Compute address of a contract from its origination operation, origination index and global counter.
--
-- However, in real Tezos encoding of the operation is more than just 'OriginationOperation'.
-- There an Operation has several more meta-fields plus a big sum-type of all possible operations.
--
-- See here: https://gitlab.com/tezos/tezos/-/blob/f57c50e3a657956d69a1699978de9873c98f0018/src/proto_006_PsCARTHA/lib_protocol/operation_repr.ml#L78
--
-- What is important is that one (big) Operation may lead to origination of multiple contracts. That
-- is why contract address is constructed from hash of the operation that originated and of index
-- of the contract's origination in the execution of that operation.
--
-- In other words, contract hash is calculated as the blake2b160 (20-byte) hash of
-- origination operation hash + int32 origination index + word64 global counter.
--
-- In Morley we do not yet support full encoding of Tezos Operations, therefore we choose
-- to generate contract addresses in a simplified manner.
--
-- Namely, we encode 'OriginationOperation' as we can and concat it with the origination index
-- and the global counter.
-- Then we take 'blake2b160' hash of the resulting bytes and consider it to be the contract's
-- address.
mkContractAddress
  :: OperationHash
  -> OriginationIndex
  -> GlobalCounter
  -> Address
mkContractAddress :: OperationHash -> OriginationIndex -> GlobalCounter -> Address
mkContractAddress (OperationHash ByteString
opHash) (OriginationIndex Int32
idx) (GlobalCounter Word64
counter) =
  ContractHash -> Address
ContractAddress
  (ContractHash -> Address) -> ContractHash -> Address
forall a b. (a -> b) -> a -> b
$ ByteString -> ContractHash
ContractHash
  (ByteString -> ContractHash) -> ByteString -> ContractHash
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
blake2b160
  (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
opHash ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
BSL.toStrict (Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Int32 -> Put
putInt32be Int32
idx Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
putWord64be Word64
counter)