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

-- | Measuring operation size.
--
-- When originating a contract or making a transfer, tezos node forms operation
-- which is submitted over network. Size of this operation depends on content
-- of originated contract or transfer parameter resp., and tezos has a hard
-- limit on operation size thus it has to be accounted.
--
-- Functions declared in this module allow assessing size of origination or
-- transfer operation with up to constant precision because it yet accounts only
-- for Michelson primitives participating in the operation.
-- Other stuff which affects op size include parameters which user passes to
-- origination or transfer themselves, for instance, amount of mutez carried
-- to the contract. ATM we don't have necessary primitives in Haskell to be
-- able to handle those parameters here, probably waiting for [TM-89].
-- Currently, we can assess overall transfer size only approximatelly, like
-- in 'smallTransferOpSize'.
module Michelson.OpSize
  ( OpSize (..)
  , opSizeHardLimit
  , smallTransferOpSize
  , instrOpSize
  , expandedInstrsOpSize
  , valueOpSize
  ) where

import Prelude hiding (Ordering(..))

import Michelson.Interpret.Pack
import Michelson.Untyped

-- | Operation size in bytes.
--
-- We use newtype wrapper because there are different units of measure
-- (another one is gas, and we don't want to confuse them).
newtype OpSize = OpSize { OpSize -> Word
unOpSize :: Word }
  deriving stock (Int -> OpSize -> ShowS
[OpSize] -> ShowS
OpSize -> String
(Int -> OpSize -> ShowS)
-> (OpSize -> String) -> ([OpSize] -> ShowS) -> Show OpSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpSize] -> ShowS
$cshowList :: [OpSize] -> ShowS
show :: OpSize -> String
$cshow :: OpSize -> String
showsPrec :: Int -> OpSize -> ShowS
$cshowsPrec :: Int -> OpSize -> ShowS
Show, OpSize -> OpSize -> Bool
(OpSize -> OpSize -> Bool)
-> (OpSize -> OpSize -> Bool) -> Eq OpSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpSize -> OpSize -> Bool
$c/= :: OpSize -> OpSize -> Bool
== :: OpSize -> OpSize -> Bool
$c== :: OpSize -> OpSize -> Bool
Eq, Eq OpSize
Eq OpSize =>
(OpSize -> OpSize -> Ordering)
-> (OpSize -> OpSize -> Bool)
-> (OpSize -> OpSize -> Bool)
-> (OpSize -> OpSize -> Bool)
-> (OpSize -> OpSize -> Bool)
-> (OpSize -> OpSize -> OpSize)
-> (OpSize -> OpSize -> OpSize)
-> Ord OpSize
OpSize -> OpSize -> Bool
OpSize -> OpSize -> Ordering
OpSize -> OpSize -> OpSize
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 :: OpSize -> OpSize -> OpSize
$cmin :: OpSize -> OpSize -> OpSize
max :: OpSize -> OpSize -> OpSize
$cmax :: OpSize -> OpSize -> OpSize
>= :: OpSize -> OpSize -> Bool
$c>= :: OpSize -> OpSize -> Bool
> :: OpSize -> OpSize -> Bool
$c> :: OpSize -> OpSize -> Bool
<= :: OpSize -> OpSize -> Bool
$c<= :: OpSize -> OpSize -> Bool
< :: OpSize -> OpSize -> Bool
$c< :: OpSize -> OpSize -> Bool
compare :: OpSize -> OpSize -> Ordering
$ccompare :: OpSize -> OpSize -> Ordering
$cp1Ord :: Eq OpSize
Ord)

instance Semigroup OpSize where
  OpSize a :: Word
a <> :: OpSize -> OpSize -> OpSize
<> OpSize b :: Word
b = Word -> OpSize
OpSize (Word
a Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
b)
instance Monoid OpSize where
  mempty :: OpSize
mempty = Word -> OpSize
OpSize 0

-- | Maximal operation size allowed by Tezos production nodes.
opSizeHardLimit :: OpSize
opSizeHardLimit :: OpSize
opSizeHardLimit = Word -> OpSize
OpSize 16384

-- | Base cost of any transfer of 0 mutez with no extra parameters.
-- (Add 'valueOpSize <param>' to it to get assessment of actual transfer op size)
smallTransferOpSize :: OpSize
smallTransferOpSize :: OpSize
smallTransferOpSize = Word -> OpSize
OpSize 162

instrOpSize :: InstrAbstract ExpandedOp -> OpSize
instrOpSize :: InstrAbstract ExpandedOp -> OpSize
instrOpSize = (Word -> OpSize
OpSize 2 OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<>) (OpSize -> OpSize)
-> (InstrAbstract ExpandedOp -> OpSize)
-> InstrAbstract ExpandedOp
-> OpSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
  EXT{} -> OpSize
forall a. Monoid a => a
mempty
  DROPN n :: Word
n -> Word -> OpSize
forall i. Integral i => i -> OpSize
stackDepthOpSize Word
n
  DROP -> OpSize
forall a. Monoid a => a
mempty
  DUP va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  SWAP -> OpSize
forall a. Monoid a => a
mempty
  DIG n :: Word
n -> Word -> OpSize
forall i. Integral i => i -> OpSize
stackDepthOpSize Word
n
  DUG n :: Word
n -> Word -> OpSize
forall i. Integral i => i -> OpSize
stackDepthOpSize Word
n
  PUSH va :: VarAnn
va t :: Type
t v :: Value' ExpandedOp
v -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Type -> OpSize
typeOpSize Type
t OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Value' ExpandedOp -> OpSize
valueOpSize Value' ExpandedOp
v
  SOME ta :: TypeAnn
ta va :: VarAnn
va -> TypeAnn -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize TypeAnn
ta VarAnn
va
  NONE ta :: TypeAnn
ta va :: VarAnn
va t :: Type
t -> TypeAnn -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize TypeAnn
ta VarAnn
va OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Type -> OpSize
typeOpSize Type
t
  UNIT ta :: TypeAnn
ta va :: VarAnn
va -> TypeAnn -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize TypeAnn
ta VarAnn
va
  IF_NONE l :: [ExpandedOp]
l r :: [ExpandedOp]
r -> [ExpandedOp] -> [ExpandedOp] -> OpSize
ifOpSize [ExpandedOp]
l [ExpandedOp]
r
  PAIR ta :: TypeAnn
ta va :: VarAnn
va fal :: FieldAnn
fal far :: FieldAnn
far -> TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize TypeAnn
ta VarAnn
va FieldAnn
fal FieldAnn
far
  CAR va :: VarAnn
va fa :: FieldAnn
fa -> VarAnn -> FieldAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va FieldAnn
fa
  CDR va :: VarAnn
va fa :: FieldAnn
fa -> VarAnn -> FieldAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va FieldAnn
fa
  LEFT ta :: TypeAnn
ta va :: VarAnn
va fal :: FieldAnn
fal far :: FieldAnn
far t :: Type
t -> TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize TypeAnn
ta VarAnn
va FieldAnn
fal FieldAnn
far OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Type -> OpSize
typeOpSize Type
t
  RIGHT ta :: TypeAnn
ta va :: VarAnn
va fal :: FieldAnn
fal far :: FieldAnn
far t :: Type
t -> TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize TypeAnn
ta VarAnn
va FieldAnn
fal FieldAnn
far OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Type -> OpSize
typeOpSize Type
t
  IF_LEFT l :: [ExpandedOp]
l r :: [ExpandedOp]
r -> [ExpandedOp] -> [ExpandedOp] -> OpSize
ifOpSize [ExpandedOp]
l [ExpandedOp]
r
  NIL ta :: TypeAnn
ta va :: VarAnn
va t :: Type
t -> TypeAnn -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize TypeAnn
ta VarAnn
va OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Type -> OpSize
typeOpSize Type
t
  CONS va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  IF_CONS l :: [ExpandedOp]
l r :: [ExpandedOp]
r -> [ExpandedOp] -> [ExpandedOp] -> OpSize
ifOpSize [ExpandedOp]
l [ExpandedOp]
r
  SIZE va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  EMPTY_SET ta :: TypeAnn
ta va :: VarAnn
va ct :: Type
ct -> TypeAnn -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize TypeAnn
ta VarAnn
va OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Type -> OpSize
innerOpSize Type
ct
  EMPTY_MAP ta :: TypeAnn
ta va :: VarAnn
va ct :: Type
ct t :: Type
t -> TypeAnn -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize TypeAnn
ta VarAnn
va OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Type -> OpSize
innerOpSize Type
ct OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Type -> OpSize
typeOpSize Type
t
  EMPTY_BIG_MAP ta :: TypeAnn
ta va :: VarAnn
va ct :: Type
ct t :: Type
t -> TypeAnn -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize TypeAnn
ta VarAnn
va OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Type -> OpSize
innerOpSize Type
ct OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Type -> OpSize
typeOpSize Type
t
  MAP va :: VarAnn
va is :: [ExpandedOp]
is -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> [ExpandedOp] -> OpSize
subcodeOpSize [ExpandedOp]
is
  ITER is :: [ExpandedOp]
is -> [ExpandedOp] -> OpSize
subcodeOpSize [ExpandedOp]
is
  MEM va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  GET va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  UPDATE va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  IF l :: [ExpandedOp]
l r :: [ExpandedOp]
r -> [ExpandedOp] -> [ExpandedOp] -> OpSize
ifOpSize [ExpandedOp]
l [ExpandedOp]
r
  LOOP is :: [ExpandedOp]
is -> [ExpandedOp] -> OpSize
expandedInstrsOpSize [ExpandedOp]
is
  LOOP_LEFT is :: [ExpandedOp]
is -> [ExpandedOp] -> OpSize
expandedInstrsOpSize [ExpandedOp]
is
  LAMBDA va :: VarAnn
va ti :: Type
ti to :: Type
to is :: [ExpandedOp]
is ->
    VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Type -> OpSize
typeOpSize Type
ti OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Type -> OpSize
typeOpSize Type
to OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> [ExpandedOp] -> OpSize
expandedInstrsOpSize [ExpandedOp]
is
  EXEC va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  APPLY va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  DIP is :: [ExpandedOp]
is -> [ExpandedOp] -> OpSize
subcodeOpSize [ExpandedOp]
is
  DIPN n :: Word
n is :: [ExpandedOp]
is -> Word -> OpSize
forall i. Integral i => i -> OpSize
stackDepthOpSize Word
n OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> [ExpandedOp] -> OpSize
subcodeOpSize [ExpandedOp]
is
  FAILWITH -> OpSize
forall a. Monoid a => a
mempty
  CAST va :: VarAnn
va t :: Type
t -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Type -> OpSize
typeOpSize Type
t
  RENAME va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  PACK va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  UNPACK ta :: TypeAnn
ta va :: VarAnn
va t :: Type
t -> TypeAnn -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize TypeAnn
ta VarAnn
va OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Type -> OpSize
typeOpSize Type
t
  CONCAT va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  SLICE va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  ISNAT va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  ADD va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  SUB va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  MUL va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  EDIV va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  ABS va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  NEG va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  LSL va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  LSR va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  OR va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  AND va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  XOR va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  NOT va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  COMPARE va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  EQ va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  NEQ va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  LT va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  LE va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  GT va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  GE va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  INT va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  SELF va :: VarAnn
va fa :: FieldAnn
fa -> VarAnn -> FieldAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va FieldAnn
fa
  CONTRACT va :: VarAnn
va fa :: FieldAnn
fa t :: Type
t -> VarAnn -> FieldAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va FieldAnn
fa OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Type -> OpSize
typeOpSize Type
t
  TRANSFER_TOKENS va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  SET_DELEGATE va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  CREATE_CONTRACT va1 :: VarAnn
va1 va2 :: VarAnn
va2 c :: Contract' ExpandedOp
c -> VarAnn -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va1 VarAnn
va2 OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Contract' ExpandedOp -> OpSize
contractOpSize Contract' ExpandedOp
c
  IMPLICIT_ACCOUNT va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  NOW va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  AMOUNT va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  BALANCE va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  CHECK_SIGNATURE va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  SHA256 va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  SHA512 va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  BLAKE2B va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  HASH_KEY va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  SOURCE va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  SENDER va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  ADDRESS va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  CHAIN_ID va :: VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  where
    subcodeOpSize :: [ExpandedOp] -> OpSize
subcodeOpSize is :: [ExpandedOp]
is = ExpandedOp -> OpSize
expandedInstrOpSize ([ExpandedOp] -> ExpandedOp
SeqEx [ExpandedOp]
is)
    ifOpSize :: [ExpandedOp] -> [ExpandedOp] -> OpSize
ifOpSize l :: [ExpandedOp]
l r :: [ExpandedOp]
r = ExpandedOp -> OpSize
expandedInstrOpSize ([ExpandedOp] -> ExpandedOp
SeqEx [ExpandedOp]
l) OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> ExpandedOp -> OpSize
expandedInstrOpSize ([ExpandedOp] -> ExpandedOp
SeqEx [ExpandedOp]
r)
    stackDepthOpSize :: i -> OpSize
stackDepthOpSize n :: i
n = Word -> OpSize
OpSize 1 OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> i -> OpSize
forall i. Integral i => i -> OpSize
numOpSize i
n

expandedInstrOpSize :: ExpandedOp -> OpSize
expandedInstrOpSize :: ExpandedOp -> OpSize
expandedInstrOpSize = \case
  PrimEx i :: InstrAbstract ExpandedOp
i -> InstrAbstract ExpandedOp -> OpSize
instrOpSize InstrAbstract ExpandedOp
i
  SeqEx is :: [ExpandedOp]
is -> Word -> OpSize
OpSize 5 OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> [ExpandedOp] -> OpSize
expandedInstrsOpSize [ExpandedOp]
is
  WithSrcEx _ i :: ExpandedOp
i -> ExpandedOp -> OpSize
expandedInstrOpSize ExpandedOp
i

expandedInstrsOpSize :: [ExpandedOp] -> OpSize
expandedInstrsOpSize :: [ExpandedOp] -> OpSize
expandedInstrsOpSize = (Element [ExpandedOp] -> OpSize) -> [ExpandedOp] -> OpSize
forall t m. (Container t, Monoid m) => (Element t -> m) -> t -> m
foldMap Element [ExpandedOp] -> OpSize
ExpandedOp -> OpSize
expandedInstrOpSize

contractOpSize :: Contract -> OpSize
contractOpSize :: Contract' ExpandedOp -> OpSize
contractOpSize (Contract (ParameterType cp :: Type
cp rootAnn :: RootAnn
rootAnn) st :: Type
st is :: [ExpandedOp]
is _) =
  Word -> OpSize
OpSize 16 OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> [FieldAnn] -> Type -> OpSize
typeOpSize' [RootAnn -> FieldAnn
forall k1 k2 (tag1 :: k1) (tag2 :: k2).
Annotation tag1 -> Annotation tag2
convAnn RootAnn
rootAnn] Type
cp OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Type -> OpSize
typeOpSize Type
st OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> [ExpandedOp] -> OpSize
expandedInstrsOpSize [ExpandedOp]
is

numOpSize :: Integral i => i -> OpSize
numOpSize :: i -> OpSize
numOpSize = Word -> OpSize
OpSize (Word -> OpSize) -> (i -> Word) -> i -> OpSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> (i -> Int) -> i -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LByteString -> Int
forall t. Container t => t -> Int
length (LByteString -> Int) -> (i -> LByteString) -> i -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> LByteString
encodeIntPayload (Integer -> LByteString) -> (i -> Integer) -> i -> LByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

valueOpSize :: Value -> OpSize
valueOpSize :: Value' ExpandedOp -> OpSize
valueOpSize = (Word -> OpSize
OpSize 1 OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<>) (OpSize -> OpSize)
-> (Value' ExpandedOp -> OpSize) -> Value' ExpandedOp -> OpSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
  ValueInt i :: Integer
i -> Integer -> OpSize
forall i. Integral i => i -> OpSize
numOpSize Integer
i
  ValueString s :: MText
s -> (OpSize
seqOpSize OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<>) (OpSize -> OpSize) -> (Int -> OpSize) -> Int -> OpSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> OpSize
OpSize (Word -> OpSize) -> (Int -> Word) -> Int -> OpSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> OpSize) -> Int -> OpSize
forall a b. (a -> b) -> a -> b
$ MText -> Int
forall t. Container t => t -> Int
length MText
s
  ValueBytes (InternalByteString b :: ByteString
b) -> (OpSize
seqOpSize OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<>) (OpSize -> OpSize) -> (Int -> OpSize) -> Int -> OpSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> OpSize
OpSize (Word -> OpSize) -> (Int -> Word) -> Int -> OpSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> OpSize) -> Int -> OpSize
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
forall t. Container t => t -> Int
length ByteString
b
  ValueUnit -> OpSize
baseOpSize
  ValueTrue -> OpSize
baseOpSize
  ValueFalse -> OpSize
baseOpSize
  ValuePair l :: Value' ExpandedOp
l r :: Value' ExpandedOp
r -> OpSize
baseOpSize OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Value' ExpandedOp -> OpSize
valueOpSize Value' ExpandedOp
l OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Value' ExpandedOp -> OpSize
valueOpSize Value' ExpandedOp
r
  ValueLeft x :: Value' ExpandedOp
x -> OpSize
baseOpSize OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Value' ExpandedOp -> OpSize
valueOpSize Value' ExpandedOp
x
  ValueRight x :: Value' ExpandedOp
x -> OpSize
baseOpSize OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Value' ExpandedOp -> OpSize
valueOpSize Value' ExpandedOp
x
  ValueSome x :: Value' ExpandedOp
x -> OpSize
baseOpSize OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Value' ExpandedOp -> OpSize
valueOpSize Value' ExpandedOp
x
  ValueNone -> OpSize
baseOpSize
  ValueNil -> OpSize
seqOpSize
  ValueSeq l :: NonEmpty $ Value' ExpandedOp
l -> OpSize
seqOpSize OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> (Element (NonEmpty $ Value' ExpandedOp) -> OpSize)
-> (NonEmpty $ Value' ExpandedOp) -> OpSize
forall t m. (Container t, Monoid m) => (Element t -> m) -> t -> m
foldMap Element (NonEmpty $ Value' ExpandedOp) -> OpSize
Value' ExpandedOp -> OpSize
valueOpSize NonEmpty $ Value' ExpandedOp
l
  ValueMap m :: NonEmpty $ Elt ExpandedOp
m -> OpSize
seqOpSize OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> (Element (NonEmpty $ Elt ExpandedOp) -> OpSize)
-> (NonEmpty $ Elt ExpandedOp) -> OpSize
forall t m. (Container t, Monoid m) => (Element t -> m) -> t -> m
foldMap Element (NonEmpty $ Elt ExpandedOp) -> OpSize
Elt ExpandedOp -> OpSize
eltOpSize NonEmpty $ Elt ExpandedOp
m
  ValueLambda m :: NonEmpty ExpandedOp
m -> OpSize
seqOpSize OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> (Element (NonEmpty ExpandedOp) -> OpSize)
-> NonEmpty ExpandedOp -> OpSize
forall t m. (Container t, Monoid m) => (Element t -> m) -> t -> m
foldMap Element (NonEmpty ExpandedOp) -> OpSize
ExpandedOp -> OpSize
expandedInstrOpSize NonEmpty ExpandedOp
m
  where
    baseOpSize :: OpSize
baseOpSize = Word -> OpSize
OpSize 1
    seqOpSize :: OpSize
seqOpSize = Word -> OpSize
OpSize 4
    eltOpSize :: Elt ExpandedOp -> OpSize
eltOpSize (Elt k :: Value' ExpandedOp
k v :: Value' ExpandedOp
v) = Word -> OpSize
OpSize 2 OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Value' ExpandedOp -> OpSize
valueOpSize Value' ExpandedOp
k OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Value' ExpandedOp -> OpSize
valueOpSize Value' ExpandedOp
v

typeOpSize :: Type -> OpSize
typeOpSize :: Type -> OpSize
typeOpSize = [FieldAnn] -> Type -> OpSize
typeOpSize' []

typeOpSize' :: [FieldAnn] -> Type -> OpSize
typeOpSize' :: [FieldAnn] -> Type -> OpSize
typeOpSize' anns :: [FieldAnn]
anns (Type t :: T
t ta :: TypeAnn
ta) =
  T -> OpSize
tOpSize T
t OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> TypeAnn -> [FieldAnn] -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize TypeAnn
ta [FieldAnn]
anns

tOpSize :: T -> OpSize
tOpSize :: T -> OpSize
tOpSize t :: T
t =
  Word -> OpSize
OpSize 2 OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> case T
t of
    TKey -> OpSize
forall a. Monoid a => a
mempty
    TUnit -> OpSize
forall a. Monoid a => a
mempty
    TSignature -> OpSize
forall a. Monoid a => a
mempty
    TChainId -> OpSize
forall a. Monoid a => a
mempty
    TOption a :: Type
a -> Type -> OpSize
typeOpSize Type
a
    TList a :: Type
a -> Type -> OpSize
typeOpSize Type
a
    TSet a :: Type
a -> Type -> OpSize
innerOpSize Type
a
    TOperation -> OpSize
forall a. Monoid a => a
mempty
    TContract a :: Type
a -> Type -> OpSize
typeOpSize Type
a
    TPair al :: FieldAnn
al ar :: FieldAnn
ar l :: Type
l r :: Type
r -> [FieldAnn] -> Type -> OpSize
typeOpSize' [FieldAnn
al] Type
l OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> [FieldAnn] -> Type -> OpSize
typeOpSize' [FieldAnn
ar] Type
r
    TOr al :: FieldAnn
al ar :: FieldAnn
ar l :: Type
l r :: Type
r -> [FieldAnn] -> Type -> OpSize
typeOpSize' [FieldAnn
al] Type
l OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> [FieldAnn] -> Type -> OpSize
typeOpSize' [FieldAnn
ar] Type
r
    TLambda i :: Type
i o :: Type
o -> Type -> OpSize
typeOpSize Type
i OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Type -> OpSize
typeOpSize Type
o
    TMap k :: Type
k v :: Type
v -> Type -> OpSize
innerOpSize Type
k OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Type -> OpSize
typeOpSize Type
v
    TBigMap k :: Type
k v :: Type
v -> Type -> OpSize
innerOpSize Type
k OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Type -> OpSize
typeOpSize Type
v
    TInt -> OpSize
forall a. Monoid a => a
mempty
    TNat -> OpSize
forall a. Monoid a => a
mempty
    TString -> OpSize
forall a. Monoid a => a
mempty
    TBytes -> OpSize
forall a. Monoid a => a
mempty
    TMutez -> OpSize
forall a. Monoid a => a
mempty
    TBool -> OpSize
forall a. Monoid a => a
mempty
    TKeyHash -> OpSize
forall a. Monoid a => a
mempty
    TTimestamp -> OpSize
forall a. Monoid a => a
mempty
    TAddress -> OpSize
forall a. Monoid a => a
mempty

innerOpSize :: Type -> OpSize
innerOpSize :: Type -> OpSize
innerOpSize (Type _ a :: TypeAnn
a) =
  (Word -> OpSize
OpSize 2) OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> TypeAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize TypeAnn
a

-- | Accepts an arbitrary number of 'TypeAnn' 'FieldAnn' and/or 'VarAnn' that
-- belong to the same entity and returns their total operation size.
--
-- Note that annotations which belong to the same entity (type or instruction)
-- __must be__ considered in aggregate using one call of this function and to be
-- specified in order. See 'AnnotationSet' for details.
annsOpSize :: AnnsOpSizeVararg x => x
annsOpSize :: x
annsOpSize = AnnotationSet -> x
forall x. AnnsOpSizeVararg x => AnnotationSet -> x
annsOpSizeVararg AnnotationSet
emptyAnnSet

class AnnsOpSizeVararg x where
  annsOpSizeVararg :: AnnotationSet -> x

instance (KnownAnnTag t, AnnsOpSizeVararg x) => AnnsOpSizeVararg (Annotation t -> x) where
  annsOpSizeVararg :: AnnotationSet -> Annotation t -> x
annsOpSizeVararg acc :: AnnotationSet
acc an :: Annotation t
an = AnnotationSet -> x
forall x. AnnsOpSizeVararg x => AnnotationSet -> x
annsOpSizeVararg (AnnotationSet
acc AnnotationSet -> AnnotationSet -> AnnotationSet
forall a. Semigroup a => a -> a -> a
<> Annotation t -> AnnotationSet
forall tag. KnownAnnTag tag => Annotation tag -> AnnotationSet
singleAnnSet Annotation t
an)

instance (KnownAnnTag t, AnnsOpSizeVararg x) => AnnsOpSizeVararg ([Annotation t] -> x) where
  annsOpSizeVararg :: AnnotationSet -> [Annotation t] -> x
annsOpSizeVararg acc :: AnnotationSet
acc ans :: [Annotation t]
ans = AnnotationSet -> x
forall x. AnnsOpSizeVararg x => AnnotationSet -> x
annsOpSizeVararg (AnnotationSet
acc AnnotationSet -> AnnotationSet -> AnnotationSet
forall a. Semigroup a => a -> a -> a
<> [Annotation t] -> AnnotationSet
forall tag. KnownAnnTag tag => [Annotation tag] -> AnnotationSet
singleGroupAnnSet [Annotation t]
ans)

instance AnnsOpSizeVararg OpSize where
  annsOpSizeVararg :: AnnotationSet -> OpSize
annsOpSizeVararg = AnnotationSet -> OpSize
annsOpSizeImpl

annsOpSizeImpl :: AnnotationSet -> OpSize
annsOpSizeImpl :: AnnotationSet -> OpSize
annsOpSizeImpl annSet :: AnnotationSet
annSet
  | AnnotationSet -> Bool
isNoAnnSet AnnotationSet
annSet = OpSize
forall a. Monoid a => a
mempty
  | Bool
otherwise = Word -> OpSize
OpSize (Word -> OpSize) -> (Int -> Word) -> Int -> OpSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> OpSize) -> Int -> OpSize
forall a b. (a -> b) -> a -> b
$ 3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (AnnotationSet -> Int
minAnnSetSize AnnotationSet
annSet Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)