module Morley.Michelson.Typed.Operation
( OperationHash (..)
, OriginationOperation (..)
, TransferOperation (..)
, SetDelegateOperation (..)
, 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 (EpName)
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 (ParameterScope, StorageScope)
import Morley.Tezos.Address (Address(ContractAddress), ContractHash(..), GlobalCounter(..))
import Morley.Tezos.Core (Mutez(..))
import Morley.Tezos.Crypto (KeyHash, blake2b, blake2b160)
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)
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
data OriginationOperation =
forall cp st.
(StorageScope st, ParameterScope cp) =>
OriginationOperation
{ OriginationOperation -> Address
ooOriginator :: Address
, OriginationOperation -> Maybe KeyHash
ooDelegate :: Maybe KeyHash
, OriginationOperation -> Mutez
ooBalance :: Mutez
, ()
ooStorage :: Value st
, ()
ooContract :: Contract cp st
, OriginationOperation -> GlobalCounter
ooCounter :: GlobalCounter
}
deriving stock instance Show OriginationOperation
mkOriginationOperationHash :: OriginationOperation -> OperationHash
mkOriginationOperationHash :: OriginationOperation -> OperationHash
mkOriginationOperationHash OriginationOperation{Maybe KeyHash
Mutez
GlobalCounter
Address
Contract cp st
Value st
ooCounter :: GlobalCounter
ooContract :: Contract cp st
ooStorage :: Value st
ooBalance :: Mutez
ooDelegate :: Maybe KeyHash
ooOriginator :: Address
ooCounter :: OriginationOperation -> GlobalCounter
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
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
$ (Integral Word63, Integral Word64,
CheckIntSubType Word63 Word64) =>
Word63 -> Word64
forall a b. (Integral a, Integral b, CheckIntSubType a b) => a -> b
fromIntegral @Word63 @Word64 (Word63 -> Word64) -> Word63 -> Word64
forall a b. (a -> b) -> a -> b
$ Mutez -> Word63
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' Instr cp st -> ByteString
forall a. ToExpression a => a -> ByteString
toBinary' (Contract cp st -> ContractCode' Instr cp st
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ContractCode' instr 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
mkContractAddress
:: OperationHash
-> GlobalCounter
-> Address
mkContractAddress :: OperationHash -> GlobalCounter -> Address
mkContractAddress (OperationHash ByteString
opHash) (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
$ Word64 -> Put
putWord64be Word64
counter)
data TransferOperation = TransferOperation
{ TransferOperation -> Address
toDestination :: Address
, TransferOperation -> TxData
toTxData :: TxData
, TransferOperation -> GlobalCounter
toCounter :: GlobalCounter
} deriving stock (Int -> TransferOperation -> ShowS
[TransferOperation] -> ShowS
TransferOperation -> String
(Int -> TransferOperation -> ShowS)
-> (TransferOperation -> String)
-> ([TransferOperation] -> ShowS)
-> Show TransferOperation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransferOperation] -> ShowS
$cshowList :: [TransferOperation] -> ShowS
show :: TransferOperation -> String
$cshow :: TransferOperation -> String
showsPrec :: Int -> TransferOperation -> ShowS
$cshowsPrec :: Int -> TransferOperation -> ShowS
Show)
mkTransferOperationHash
:: ParameterScope t
=> Address
-> Value t
-> EpName
-> Mutez
-> OperationHash
mkTransferOperationHash :: Address -> Value t -> EpName -> Mutez -> OperationHash
mkTransferOperationHash Address
to Value t
param EpName
epName Mutez
amount =
ByteString -> OperationHash
OperationHash (ByteString -> OperationHash) -> ByteString -> OperationHash
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
blake2b ByteString
packedOperation
where
packedOperation :: ByteString
packedOperation =
ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
(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
$ (Integral Word63, Integral Word64,
CheckIntSubType Word63 Word64) =>
Word63 -> Word64
forall a b. (Integral a, Integral b, CheckIntSubType a b) => a -> b
fromIntegral @Word63 @Word64 (Word63 -> Word64) -> Word63 -> Word64
forall a b. (a -> b) -> a -> b
$ Mutez -> Word63
unMutez Mutez
amount)
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (Value 'TAddress -> ByteString
forall a. ToExpression a => a -> ByteString
toBinary (Value 'TAddress -> ByteString) -> Value 'TAddress -> ByteString
forall a b. (a -> b) -> a -> b
$ EpAddress -> Value (ToT EpAddress)
forall a. IsoValue a => a -> Value (ToT a)
toVal (Address -> EpName -> EpAddress
EpAddress Address
to EpName
epName))
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Value t -> ByteString
forall a. ToExpression a => a -> ByteString
toBinary Value t
param
data SetDelegateOperation = SetDelegateOperation
{ SetDelegateOperation -> Address
sdoContract :: Address
, SetDelegateOperation -> Maybe KeyHash
sdoDelegate :: Maybe KeyHash
, SetDelegateOperation -> GlobalCounter
sdoCounter :: GlobalCounter
} deriving stock Int -> SetDelegateOperation -> ShowS
[SetDelegateOperation] -> ShowS
SetDelegateOperation -> String
(Int -> SetDelegateOperation -> ShowS)
-> (SetDelegateOperation -> String)
-> ([SetDelegateOperation] -> ShowS)
-> Show SetDelegateOperation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetDelegateOperation] -> ShowS
$cshowList :: [SetDelegateOperation] -> ShowS
show :: SetDelegateOperation -> String
$cshow :: SetDelegateOperation -> String
showsPrec :: Int -> SetDelegateOperation -> ShowS
$cshowsPrec :: Int -> SetDelegateOperation -> ShowS
Show
mkDelegationOperationHash :: SetDelegateOperation -> OperationHash
mkDelegationOperationHash :: SetDelegateOperation -> OperationHash
mkDelegationOperationHash SetDelegateOperation{Maybe KeyHash
GlobalCounter
Address
sdoCounter :: GlobalCounter
sdoDelegate :: Maybe KeyHash
sdoContract :: Address
sdoCounter :: SetDelegateOperation -> GlobalCounter
sdoDelegate :: SetDelegateOperation -> Maybe KeyHash
sdoContract :: SetDelegateOperation -> Address
..} =
ByteString -> OperationHash
OperationHash (ByteString -> OperationHash) -> ByteString -> OperationHash
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
blake2b ByteString
packedOperation
where
packedOperation :: ByteString
packedOperation = (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
sdoDelegate