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

module Morley.Michelson.Typed.Operation
  ( OperationHash (..)
  , OriginationOperation (..)
  , TransferOperation (..)
  , SetDelegateOperation (..)
  , EmitOperation (..)
  , mkContractAddress
  , mkOriginationOperationHash
  , mkTransferOperationHash
  , mkDelegationOperationHash
  ) where

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

import Morley.Michelson.Interpret.Pack (toBinary, toBinary')
import Morley.Michelson.Runtime.TxData (TxData)
import Morley.Michelson.Typed (Emit, EpName(..), Instr, unContractCode)
import Morley.Michelson.Typed.Aliases (Contract, Value)
import Morley.Michelson.Typed.Contract (cCode)
import Morley.Michelson.Typed.Entrypoints (EpAddress(..))
import Morley.Michelson.Typed.Haskell.Value (IsoValue(..))
import Morley.Michelson.Typed.Scope (PackedValScope, ParameterScope, StorageScope)
import Morley.Tezos.Address
import Morley.Tezos.Address.Alias
import Morley.Tezos.Core (Mutez(..))
import Morley.Tezos.Crypto (Hash(..), HashTag(..), KeyHash, blake2b, blake2b160)

newtype OperationHash = OperationHash
  { unOperationHash :: ByteString
  }
  deriving stock (Show, Eq, Ord, Generic)
  deriving anyclass (NFData)

-- | "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

----------------------------------------------------------------------------
-- Origination
----------------------------------------------------------------------------

-- | Data necessary to originate a contract.
data OriginationOperation =
  forall cp st kind.
  (StorageScope st, ParameterScope cp, L1AddressKind kind) =>
  OriginationOperation
  { ooOriginator :: KindedAddress kind
  -- ^ 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.
  , ooCounter :: GlobalCounter
  -- ^ The value of the global counter at the time the operation was created.
  -- We store it here so that the resulting addresses of @CREATE_CONTRACT@ and
  -- performing of origination operation are the same.
  , ooAlias :: Maybe ContractAlias
  -- ^ An alias to be associated with the originated contract's address.

  -- In Tezos each operation also has a special field called @counter@, see here:
  -- https://gitlab.com/tezos/tezos/-/blob/397dd233a10cc6df0df959e2a624c7947997dd0c/src/proto_006_PsCARTHA/lib_protocol/operation_repr.ml#L113-120

  -- This counter seems to be a part of global state of Tezos network. In fact, it may be observed
  -- in raw JSON representation of the operation in the network explorer.
  }

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 $ fromIntegral @Word63 @Word64 $ unMutez ooBalance)
      <> packMaybe (toBinary' . toVal) ooDelegate
      <> toBinary' (unContractCode $ cCode ooContract)
      <> toBinary' ooStorage

-- | Compute address of a contract from its origination operation 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
--
-- In other words, contract hash is calculated as the blake2b160 (20-byte) hash of
-- origination operation hash + 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 global counter.

-- Then we take 'blake2b160' hash of the resulting bytes and consider it to be the contract's
-- address.
mkContractAddress
  :: OperationHash
  -> GlobalCounter
  -> ContractAddress
mkContractAddress (OperationHash opHash) (GlobalCounter counter) =
  ContractAddress
  $ Hash HashContract
  $ blake2b160
  $ opHash <> BSL.toStrict (runPut $ putWord64be counter)

----------------------------------------------------------------------------
-- Transfer
----------------------------------------------------------------------------

-- | Data necessary to send a transaction to given address which is assumed to be the
-- address of an originated contract.
data TransferOperation = TransferOperation
  { toDestination :: Address
  , toTxData :: TxData
  , toCounter :: GlobalCounter
  } deriving stock (Show)

mkTransferOperationHash
  :: ParameterScope t
  => KindedAddress kind
  -> Value t
  -> EpName
  -> Mutez
  -> OperationHash
mkTransferOperationHash to param epName amount =
  OperationHash $ blake2b packedOperation
  where
    -- In Tezos, transfer operations are encoded as 4-tuple of
    -- (amount, destination, entrypoint, value)
    --
    -- See https://gitlab.com/tezos/tezos/-/blob/f57c50e3a657956d69a1699978de9873c98f0018/src/proto_006_PsCARTHA/lib_protocol/operation_repr.ml#L275-282
    packedOperation =
      BSL.toStrict $
        (runPut $ putWord64be $ fromIntegral @Word63 @Word64 $ unMutez amount)
        <> (toBinary $ toVal (EpAddress to epName))
        <> toBinary param

----------------------------------------------------------------------------
-- Set Delegate
----------------------------------------------------------------------------

-- | Set contract's delegate
data SetDelegateOperation = SetDelegateOperation
  { sdoContract :: L1Address
  -- ^ The contract we're setting delegate of
  , sdoDelegate :: Maybe KeyHash
  -- ^ The delegate we're setting
  , sdoCounter :: GlobalCounter
  } deriving stock Show

-- | Construct 'OperationHash' for a 'SetDelegateOperation'.
mkDelegationOperationHash :: SetDelegateOperation -> OperationHash
mkDelegationOperationHash SetDelegateOperation{..} =
  OperationHash $ blake2b packedOperation
  where
    -- In Tezos DelegationOperation is encoded as simply the delegation key hash
    --
    -- https://gitlab.com/tezos/tezos/-/blob/685227895f48a2564a9de3e1e179e7cd741d52fb/src/proto_010_PtGRANAD/lib_protocol/operation_repr.ml#L354
    packedOperation = packMaybe (toBinary' . toVal) sdoDelegate

data EmitOperation = forall t. PackedValScope t => EmitOperation
  { eoSource :: ContractAddress
  , eoEmit :: Emit Instr t
  }

deriving stock instance Show EmitOperation