-- 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 approximately, like
-- in 'smallTransferOpSize'.
module Michelson.Untyped.OpSize
  ( OpSize (..)
  , opSizeHardLimit
  , smallTransferOpSize

  , instrOpSize
  , expandedInstrsOpSize
  , valueOpSize
  ) where

import Fmt (Buildable(..))
import Prelude hiding (Ordering(..))

import Michelson.Interpret.Utils
import Michelson.Untyped.Aliases
import Michelson.Untyped.Annotation
import Michelson.Untyped.Contract
import Michelson.Untyped.Instr
import Michelson.Untyped.Type
import Michelson.Untyped.Value

-- | 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 Buildable OpSize where
  build :: OpSize -> Builder
build = Word -> Builder
forall p. Buildable p => p -> Builder
build (Word -> Builder) -> (OpSize -> Word) -> OpSize -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpSize -> Word
unOpSize

instance Semigroup OpSize where
  OpSize Word
a <> :: OpSize -> OpSize -> OpSize
<> OpSize 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 Word
0

-- | Maximal operation size allowed by Tezos production nodes.
opSizeHardLimit :: OpSize
opSizeHardLimit :: OpSize
opSizeHardLimit = Word -> OpSize
OpSize Word
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 Word
162

instrOpSize :: InstrAbstract ExpandedOp -> OpSize
instrOpSize :: InstrAbstract ExpandedOp -> OpSize
instrOpSize = (Word -> OpSize
OpSize Word
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 Word
n -> Word -> OpSize
forall i. Integral i => i -> OpSize
stackDepthOpSize Word
n
  InstrAbstract ExpandedOp
DROP -> OpSize
forall a. Monoid a => a
mempty
  DUP VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  DUPN VarAnn
va Word
n -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Word -> OpSize
forall i. Integral i => i -> OpSize
stackDepthOpSize Word
n
  InstrAbstract ExpandedOp
SWAP -> OpSize
forall a. Monoid a => a
mempty
  DIG Word
n -> Word -> OpSize
forall i. Integral i => i -> OpSize
stackDepthOpSize Word
n
  DUG Word
n -> Word -> OpSize
forall i. Integral i => i -> OpSize
stackDepthOpSize Word
n
  PUSH VarAnn
va Ty
t Value' ExpandedOp
v -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Ty -> OpSize
typeOpSize Ty
t OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Value' ExpandedOp -> OpSize
valueOpSize Value' ExpandedOp
v
  SOME TypeAnn
ta VarAnn
va -> TypeAnn -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize TypeAnn
ta VarAnn
va
  NONE TypeAnn
ta VarAnn
va Ty
t -> TypeAnn -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize TypeAnn
ta VarAnn
va OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Ty -> OpSize
typeOpSize Ty
t
  UNIT TypeAnn
ta VarAnn
va -> TypeAnn -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize TypeAnn
ta VarAnn
va
  IF_NONE [ExpandedOp]
l [ExpandedOp]
r -> [ExpandedOp] -> [ExpandedOp] -> OpSize
ifOpSize [ExpandedOp]
l [ExpandedOp]
r
  PAIR TypeAnn
ta VarAnn
va FieldAnn
fal FieldAnn
far -> TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize TypeAnn
ta VarAnn
va FieldAnn
fal FieldAnn
far
  UNPAIR VarAnn
va1 VarAnn
va2 FieldAnn
fal FieldAnn
far -> VarAnn -> VarAnn -> FieldAnn -> FieldAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va1 VarAnn
va2 FieldAnn
fal FieldAnn
far
  PAIRN VarAnn
va Word
n -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Word -> OpSize
forall i. Integral i => i -> OpSize
stackDepthOpSize Word
n
  UNPAIRN Word
n -> Word -> OpSize
forall i. Integral i => i -> OpSize
stackDepthOpSize Word
n
  CAR VarAnn
va FieldAnn
fa -> VarAnn -> FieldAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va FieldAnn
fa
  CDR VarAnn
va FieldAnn
fa -> VarAnn -> FieldAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va FieldAnn
fa
  LEFT TypeAnn
ta VarAnn
va FieldAnn
fal FieldAnn
far Ty
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
<> Ty -> OpSize
typeOpSize Ty
t
  RIGHT TypeAnn
ta VarAnn
va FieldAnn
fal FieldAnn
far Ty
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
<> Ty -> OpSize
typeOpSize Ty
t
  IF_LEFT [ExpandedOp]
l [ExpandedOp]
r -> [ExpandedOp] -> [ExpandedOp] -> OpSize
ifOpSize [ExpandedOp]
l [ExpandedOp]
r
  NIL TypeAnn
ta VarAnn
va Ty
t -> TypeAnn -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize TypeAnn
ta VarAnn
va OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Ty -> OpSize
typeOpSize Ty
t
  CONS VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  IF_CONS [ExpandedOp]
l [ExpandedOp]
r -> [ExpandedOp] -> [ExpandedOp] -> OpSize
ifOpSize [ExpandedOp]
l [ExpandedOp]
r
  SIZE VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  EMPTY_SET TypeAnn
ta VarAnn
va Ty
ct -> TypeAnn -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize TypeAnn
ta VarAnn
va OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Ty -> OpSize
innerOpSize Ty
ct
  EMPTY_MAP TypeAnn
ta VarAnn
va Ty
ct Ty
t -> TypeAnn -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize TypeAnn
ta VarAnn
va OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Ty -> OpSize
innerOpSize Ty
ct OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Ty -> OpSize
typeOpSize Ty
t
  EMPTY_BIG_MAP TypeAnn
ta VarAnn
va Ty
ct Ty
t -> TypeAnn -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize TypeAnn
ta VarAnn
va OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Ty -> OpSize
innerOpSize Ty
ct OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Ty -> OpSize
typeOpSize Ty
t
  MAP VarAnn
va [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 [ExpandedOp]
is -> [ExpandedOp] -> OpSize
subcodeOpSize [ExpandedOp]
is
  MEM VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  GET VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  GETN VarAnn
va Word
n -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Word -> OpSize
forall i. Integral i => i -> OpSize
stackDepthOpSize Word
n
  UPDATE VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  UPDATEN VarAnn
va Word
n -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Word -> OpSize
forall i. Integral i => i -> OpSize
stackDepthOpSize Word
n
  GET_AND_UPDATE VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  IF [ExpandedOp]
l [ExpandedOp]
r -> [ExpandedOp] -> [ExpandedOp] -> OpSize
ifOpSize [ExpandedOp]
l [ExpandedOp]
r
  LOOP [ExpandedOp]
is -> [ExpandedOp] -> OpSize
expandedInstrsOpSize [ExpandedOp]
is
  LOOP_LEFT [ExpandedOp]
is -> [ExpandedOp] -> OpSize
expandedInstrsOpSize [ExpandedOp]
is
  LAMBDA VarAnn
va Ty
ti Ty
to [ExpandedOp]
is ->
    VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Ty -> OpSize
typeOpSize Ty
ti OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Ty -> OpSize
typeOpSize Ty
to OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> [ExpandedOp] -> OpSize
expandedInstrsOpSize [ExpandedOp]
is
  EXEC VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  APPLY VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  DIP [ExpandedOp]
is -> [ExpandedOp] -> OpSize
subcodeOpSize [ExpandedOp]
is
  DIPN Word
n [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
  InstrAbstract ExpandedOp
FAILWITH -> OpSize
forall a. Monoid a => a
mempty
  CAST VarAnn
va Ty
t -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Ty -> OpSize
typeOpSize Ty
t
  RENAME VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  PACK VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  UNPACK TypeAnn
ta VarAnn
va Ty
t -> TypeAnn -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize TypeAnn
ta VarAnn
va OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Ty -> OpSize
typeOpSize Ty
t
  CONCAT VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  SLICE VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  ISNAT VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  ADD VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  SUB VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  MUL VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  EDIV VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  ABS VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  NEG VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  LSL VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  LSR VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  OR VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  AND VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  XOR VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  NOT VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  COMPARE VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  EQ VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  NEQ VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  LT VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  LE VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  GT VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  GE VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  INT VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  SELF VarAnn
va FieldAnn
fa -> VarAnn -> FieldAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va FieldAnn
fa
  CONTRACT VarAnn
va FieldAnn
fa Ty
t -> VarAnn -> FieldAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va FieldAnn
fa OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Ty -> OpSize
typeOpSize Ty
t
  TRANSFER_TOKENS VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  SET_DELEGATE VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  CREATE_CONTRACT VarAnn
va1 VarAnn
va2 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 VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  NOW VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  AMOUNT VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  BALANCE VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  VOTING_POWER VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  TOTAL_VOTING_POWER VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  CHECK_SIGNATURE VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  SHA256 VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  SHA512 VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  BLAKE2B VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  SHA3 VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  KECCAK VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  HASH_KEY VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  PAIRING_CHECK VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  SOURCE VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  SENDER VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  ADDRESS VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  CHAIN_ID VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  LEVEL VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  SELF_ADDRESS VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  InstrAbstract ExpandedOp
NEVER -> OpSize
forall a. Monoid a => a
mempty
  TICKET VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  READ_TICKET VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  SPLIT_TICKET VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  JOIN_TICKETS VarAnn
va -> VarAnn -> OpSize
forall x. AnnsOpSizeVararg x => x
annsOpSize VarAnn
va
  where
    subcodeOpSize :: [ExpandedOp] -> OpSize
subcodeOpSize [ExpandedOp]
is = ExpandedOp -> OpSize
expandedInstrOpSize ([ExpandedOp] -> ExpandedOp
SeqEx [ExpandedOp]
is)
    ifOpSize :: [ExpandedOp] -> [ExpandedOp] -> OpSize
ifOpSize [ExpandedOp]
l [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 i
n = Word -> OpSize
OpSize Word
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 InstrAbstract ExpandedOp
i -> InstrAbstract ExpandedOp -> OpSize
instrOpSize InstrAbstract ExpandedOp
i
  SeqEx [ExpandedOp]
is -> Word -> OpSize
OpSize Word
5 OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> [ExpandedOp] -> OpSize
expandedInstrsOpSize [ExpandedOp]
is
  WithSrcEx InstrCallStack
_ 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 Ty
cp FieldAnn
rootAnn) Ty
st [ExpandedOp]
is EntriesOrder
_) =
  Word -> OpSize
OpSize Word
16 OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> [FieldAnn] -> Ty -> OpSize
typeOpSize' [FieldAnn
rootAnn] Ty
cp OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Ty -> OpSize
typeOpSize Ty
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
. NonEmpty Word8 -> Int
forall t. Container t => t -> Int
length (NonEmpty Word8 -> Int) -> (i -> NonEmpty Word8) -> i -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> NonEmpty Word8
encodeZarithNumber (Integer -> NonEmpty Word8)
-> (i -> Integer) -> i -> NonEmpty Word8
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 Word
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 Integer
i -> Integer -> OpSize
forall i. Integral i => i -> OpSize
numOpSize Integer
i
  ValueString 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 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
  Value' ExpandedOp
ValueUnit -> OpSize
baseOpSize
  Value' ExpandedOp
ValueTrue -> OpSize
baseOpSize
  Value' ExpandedOp
ValueFalse -> OpSize
baseOpSize
  ValuePair Value' ExpandedOp
l 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 Value' ExpandedOp
x -> OpSize
baseOpSize OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Value' ExpandedOp -> OpSize
valueOpSize Value' ExpandedOp
x
  ValueRight Value' ExpandedOp
x -> OpSize
baseOpSize OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Value' ExpandedOp -> OpSize
valueOpSize Value' ExpandedOp
x
  ValueSome Value' ExpandedOp
x -> OpSize
baseOpSize OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Value' ExpandedOp -> OpSize
valueOpSize Value' ExpandedOp
x
  Value' ExpandedOp
ValueNone -> OpSize
baseOpSize
  Value' ExpandedOp
ValueNil -> OpSize
seqOpSize
  ValueSeq 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 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 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 Word
1
    seqOpSize :: OpSize
seqOpSize = Word -> OpSize
OpSize Word
4
    eltOpSize :: Elt ExpandedOp -> OpSize
eltOpSize (Elt Value' ExpandedOp
k Value' ExpandedOp
v) = Word -> OpSize
OpSize Word
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 :: Ty -> OpSize
typeOpSize :: Ty -> OpSize
typeOpSize = [FieldAnn] -> Ty -> OpSize
typeOpSize' []

typeOpSize' :: [FieldAnn] -> Ty -> OpSize
typeOpSize' :: [FieldAnn] -> Ty -> OpSize
typeOpSize' [FieldAnn]
anns (Ty T
t 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 =
  Word -> OpSize
OpSize Word
2 OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> case T
t of
    T
TKey -> OpSize
forall a. Monoid a => a
mempty
    T
TUnit -> OpSize
forall a. Monoid a => a
mempty
    T
TSignature -> OpSize
forall a. Monoid a => a
mempty
    T
TChainId -> OpSize
forall a. Monoid a => a
mempty
    TOption Ty
a -> Ty -> OpSize
typeOpSize Ty
a
    TList Ty
a -> Ty -> OpSize
typeOpSize Ty
a
    TSet Ty
a -> Ty -> OpSize
innerOpSize Ty
a
    T
TOperation -> OpSize
forall a. Monoid a => a
mempty
    TTicket Ty
a -> Ty -> OpSize
typeOpSize Ty
a
    TContract Ty
a -> Ty -> OpSize
typeOpSize Ty
a
    -- Nested variable annotations don't use any extra operation size.
    TPair FieldAnn
al FieldAnn
ar VarAnn
_ VarAnn
_ Ty
l Ty
r -> [FieldAnn] -> Ty -> OpSize
typeOpSize' [FieldAnn
al] Ty
l OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> [FieldAnn] -> Ty -> OpSize
typeOpSize' [FieldAnn
ar] Ty
r
    TOr FieldAnn
al FieldAnn
ar Ty
l Ty
r -> [FieldAnn] -> Ty -> OpSize
typeOpSize' [FieldAnn
al] Ty
l OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> [FieldAnn] -> Ty -> OpSize
typeOpSize' [FieldAnn
ar] Ty
r
    TLambda Ty
i Ty
o -> Ty -> OpSize
typeOpSize Ty
i OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Ty -> OpSize
typeOpSize Ty
o
    TMap Ty
k Ty
v -> Ty -> OpSize
innerOpSize Ty
k OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Ty -> OpSize
typeOpSize Ty
v
    TBigMap Ty
k Ty
v -> Ty -> OpSize
innerOpSize Ty
k OpSize -> OpSize -> OpSize
forall a. Semigroup a => a -> a -> a
<> Ty -> OpSize
typeOpSize Ty
v
    T
TInt -> OpSize
forall a. Monoid a => a
mempty
    T
TNat -> OpSize
forall a. Monoid a => a
mempty
    T
TString -> OpSize
forall a. Monoid a => a
mempty
    T
TBytes -> OpSize
forall a. Monoid a => a
mempty
    T
TMutez -> OpSize
forall a. Monoid a => a
mempty
    T
TBool -> OpSize
forall a. Monoid a => a
mempty
    T
TKeyHash -> OpSize
forall a. Monoid a => a
mempty
    T
TBls12381Fr -> OpSize
forall a. Monoid a => a
mempty
    T
TBls12381G1 -> OpSize
forall a. Monoid a => a
mempty
    T
TBls12381G2 -> OpSize
forall a. Monoid a => a
mempty
    T
TTimestamp -> OpSize
forall a. Monoid a => a
mempty
    T
TAddress -> OpSize
forall a. Monoid a => a
mempty
    T
TNever -> OpSize
forall a. Monoid a => a
mempty

innerOpSize :: Ty -> OpSize
innerOpSize :: Ty -> OpSize
innerOpSize (Ty T
_ TypeAnn
a) =
  (Word -> OpSize
OpSize Word
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 AnnotationSet
acc 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 AnnotationSet
acc [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 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
$ Int
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
+ Int
1)