module Michelson.OpSize
( OpSize (..)
, opSizeHardLimit
, smallTransferOpSize
, instrOpSize
, expandedInstrsOpSize
, valueOpSize
) where
import Prelude hiding (Ordering(..))
import Michelson.Interpret.Pack
import Michelson.Untyped
newtype OpSize = OpSize { unOpSize :: Word }
deriving (Show, Eq, Ord)
instance Semigroup OpSize where
OpSize a <> OpSize b = OpSize (a + b)
instance Monoid OpSize where
mempty = OpSize 0
opSizeHardLimit :: OpSize
opSizeHardLimit = OpSize 16384
smallTransferOpSize :: OpSize
smallTransferOpSize = OpSize 162
instrOpSize :: InstrAbstract ExpandedOp -> OpSize
instrOpSize = (OpSize 2 <>) . \case
EXT{} -> mempty
DROPN n -> stackDepthOpSize n
DROP -> mempty
DUP va -> annsOpSize va
SWAP -> mempty
DIG n -> stackDepthOpSize n
DUG n -> stackDepthOpSize n
PUSH va t v -> annsOpSize va <> typeOpSize t <> valueOpSize v
SOME ta va -> annsOpSize ta va
NONE ta va t -> annsOpSize ta va <> typeOpSize t
UNIT ta va -> annsOpSize ta va
IF_NONE l r -> ifOpSize l r
PAIR ta va fal far -> annsOpSize ta va fal far
CAR va fa -> annsOpSize va fa
CDR va fa -> annsOpSize va fa
LEFT ta va fal far t -> annsOpSize ta va fal far <> typeOpSize t
RIGHT ta va fal far t -> annsOpSize ta va fal far <> typeOpSize t
IF_LEFT l r -> ifOpSize l r
NIL ta va t -> annsOpSize ta va <> typeOpSize t
CONS va -> annsOpSize va
IF_CONS l r -> ifOpSize l r
SIZE va -> annsOpSize va
EMPTY_SET ta va ct -> annsOpSize ta va <> comparableOpSize ct
EMPTY_MAP ta va ct t -> annsOpSize ta va <> comparableOpSize ct <> typeOpSize t
EMPTY_BIG_MAP ta va ct t -> annsOpSize ta va <> comparableOpSize ct <> typeOpSize t
MAP va is -> annsOpSize va <> subcodeOpSize is
ITER is -> annsOpSize <> subcodeOpSize is
MEM va -> annsOpSize va
GET va -> annsOpSize va
UPDATE va -> annsOpSize va
IF l r -> ifOpSize l r
LOOP is -> expandedInstrsOpSize is
LOOP_LEFT is -> expandedInstrsOpSize is
LAMBDA va ti to is ->
annsOpSize va <> typeOpSize ti <> typeOpSize to <> expandedInstrsOpSize is
EXEC va -> annsOpSize va
APPLY va -> annsOpSize va
DIP is -> subcodeOpSize is
DIPN n is -> stackDepthOpSize n <> subcodeOpSize is
FAILWITH -> mempty
CAST va t -> annsOpSize va <> typeOpSize t
RENAME va -> annsOpSize va
PACK va -> annsOpSize va
UNPACK ta va t -> annsOpSize ta va <> typeOpSize t
CONCAT va -> annsOpSize va
SLICE va -> annsOpSize va
ISNAT va -> annsOpSize va
ADD va -> annsOpSize va
SUB va -> annsOpSize va
MUL va -> annsOpSize va
EDIV va -> annsOpSize va
ABS va -> annsOpSize va
NEG va -> annsOpSize va
LSL va -> annsOpSize va
LSR va -> annsOpSize va
OR va -> annsOpSize va
AND va -> annsOpSize va
XOR va -> annsOpSize va
NOT va -> annsOpSize va
COMPARE va -> annsOpSize va
EQ va -> annsOpSize va
NEQ va -> annsOpSize va
LT va -> annsOpSize va
LE va -> annsOpSize va
GT va -> annsOpSize va
GE va -> annsOpSize va
INT va -> annsOpSize va
SELF va -> annsOpSize va
CONTRACT va fa t -> annsOpSize va fa <> typeOpSize t
TRANSFER_TOKENS va -> annsOpSize va
SET_DELEGATE va -> annsOpSize va
CREATE_CONTRACT va1 va2 c -> annsOpSize va1 va2 <> contractOpSize c
IMPLICIT_ACCOUNT va -> annsOpSize va
NOW va -> annsOpSize va
AMOUNT va -> annsOpSize va
BALANCE va -> annsOpSize va
CHECK_SIGNATURE va -> annsOpSize va
SHA256 va -> annsOpSize va
SHA512 va -> annsOpSize va
BLAKE2B va -> annsOpSize va
HASH_KEY va -> annsOpSize va
STEPS_TO_QUOTA va -> annsOpSize va
SOURCE va -> annsOpSize va
SENDER va -> annsOpSize va
ADDRESS va -> annsOpSize va
CHAIN_ID va -> annsOpSize va
where
subcodeOpSize is = expandedInstrOpSize (SeqEx is)
ifOpSize l r = expandedInstrOpSize (SeqEx l) <> expandedInstrOpSize (SeqEx r)
stackDepthOpSize n = OpSize 1 <> numOpSize n
expandedInstrOpSize :: ExpandedOp -> OpSize
expandedInstrOpSize = \case
PrimEx i -> instrOpSize i
SeqEx is -> OpSize 5 <> expandedInstrsOpSize is
WithSrcEx _ i -> expandedInstrOpSize i
expandedInstrsOpSize :: [ExpandedOp] -> OpSize
expandedInstrsOpSize = foldMap expandedInstrOpSize
contractOpSize :: Contract -> OpSize
contractOpSize (Contract cp st is) =
OpSize 16 <> typeOpSize cp <> typeOpSize st <> expandedInstrsOpSize is
numOpSize :: Integral i => i -> OpSize
numOpSize = OpSize . fromIntegral . length . encodeIntPayload . fromIntegral
valueOpSize :: Value -> OpSize
valueOpSize = (OpSize 1 <>) . \case
ValueInt i -> numOpSize i
ValueString s -> (seqOpSize <>) . OpSize . fromIntegral $ length s
ValueBytes (InternalByteString b) -> (seqOpSize <>) . OpSize . fromIntegral $ length b
ValueUnit -> baseOpSize
ValueTrue -> baseOpSize
ValueFalse -> baseOpSize
ValuePair l r -> baseOpSize <> valueOpSize l <> valueOpSize r
ValueLeft x -> baseOpSize <> valueOpSize x
ValueRight x -> baseOpSize <> valueOpSize x
ValueSome x -> baseOpSize <> valueOpSize x
ValueNone -> baseOpSize
ValueNil -> seqOpSize
ValueSeq l -> seqOpSize <> foldMap valueOpSize l
ValueMap m -> seqOpSize <> foldMap eltOpSize m
ValueLambda m -> seqOpSize <> foldMap expandedInstrOpSize m
where
baseOpSize = OpSize 1
seqOpSize = OpSize 4
eltOpSize (Elt k v) = OpSize 2 <> valueOpSize k <> valueOpSize v
typeOpSize :: Type -> OpSize
typeOpSize = typeOpSize' []
typeOpSize' :: [FieldAnn] -> Type -> OpSize
typeOpSize' anns (Type t ta) =
tOpSize t <> annsOpSize ta anns
tOpSize :: T -> OpSize
tOpSize = \case
Tc ct -> ctOpSize ct
TKey -> baseOpSize
TUnit -> baseOpSize
TSignature -> baseOpSize
TChainId -> baseOpSize
TOption a -> baseOpSize <> typeOpSize a
TList a -> baseOpSize <> typeOpSize a
TSet a -> baseOpSize <> comparableOpSize a
TOperation -> baseOpSize
TContract a -> baseOpSize <> typeOpSize a
TPair al ar l r -> baseOpSize <> typeOpSize' [al] l <> typeOpSize' [ar] r
TOr al ar l r -> baseOpSize <> typeOpSize' [al] l <> typeOpSize' [ar] r
TLambda i o -> baseOpSize <> typeOpSize i <> typeOpSize o
TMap k v -> baseOpSize <> comparableOpSize k <> typeOpSize v
TBigMap k v -> baseOpSize <> comparableOpSize k <> typeOpSize v
where
baseOpSize = OpSize 2
comparableOpSize :: Comparable -> OpSize
comparableOpSize (Comparable ct a) =
ctOpSize ct <> annsOpSize a
ctOpSize :: CT -> OpSize
ctOpSize _ = OpSize 2
annsOpSize :: AnnsOpSizeVararg x => x
annsOpSize = annsOpSizeVararg []
class AnnsOpSizeVararg x where
annsOpSizeVararg :: [SomeAnn] -> x
instance AnnsOpSizeVararg x => AnnsOpSizeVararg (Annotation t -> x) where
annsOpSizeVararg acc an = annsOpSizeVararg (convAnn an : acc)
instance AnnsOpSizeVararg x => AnnsOpSizeVararg ([Annotation t] -> x) where
annsOpSizeVararg acc an = annsOpSizeVararg (map convAnn an <> acc)
instance AnnsOpSizeVararg OpSize where
annsOpSizeVararg = annsOpSizeImpl
annsOpSizeImpl :: [SomeAnn] -> OpSize
annsOpSizeImpl anns = case filter (/= noAnn) anns of
[] -> mempty
as -> OpSize . fromIntegral $ 3 * (length as + 1)