-- Hoogle documentation, generated by Haddock -- See Hoogle, http://www.haskell.org/hoogle/ -- | Developer tools for the Michelson Language -- -- A library to make writing smart contracts in Michelson — the smart -- contract language of the Tezos blockchain — pleasant and effective. @package morley @version 0.3.0 -- | Commonly used parts of regular Prelude. module Lorentz.Prelude -- | Application operator. This operator is redundant, since ordinary -- application (f x) means the same as (f $ x). -- However, $ has low, right-associative binding precedence, so it -- sometimes allows parentheses to be omitted; for example: -- -- 
--   f $ g $ h x  =  f (g (h x))
--
-- -- It is also useful in higher-order situations, such as map -- ($ 0) xs, or zipWith ($) fs xs. -- -- Note that ($) is levity-polymorphic in its result type, so -- that foo $ True where foo :: Bool -> Int# is well-typed ($) :: () => (a -> b) -> a -> b infixr 0 $ -- | Infix application. -- -- 
--   f :: Either String $ Maybe Int
--   =
--   f :: Either String (Maybe Int)
--
type ($) (f :: k -> k1) (a :: k) = f a infixr 2 $ -- | The Eq class defines equality (==) and inequality -- (/=). All the basic datatypes exported by the Prelude -- are instances of Eq, and Eq may be derived for any -- datatype whose constituents are also instances of Eq. -- -- The Haskell Report defines no laws for Eq. However, == -- is customarily expected to implement an equivalence relationship where -- two values comparing equal are indistinguishable by "public" -- functions, with a "public" function being one not allowing to see -- implementation details. For example, for a type representing -- non-normalised natural numbers modulo 100, a "public" function doesn't -- make the difference between 1 and 201. It is expected to have the -- following properties: -- -- -- -- Minimal complete definition: either == or /=. class Eq a -- | The Ord class is used for totally ordered datatypes. -- -- Instances of Ord can be derived for any user-defined datatype -- whose constituent types are in Ord. The declared order of the -- constructors in the data declaration determines the ordering in -- derived Ord instances. The Ordering datatype allows a -- single comparison to determine the precise ordering of two objects. -- -- The Haskell Report defines no laws for Ord. However, -- <= is customarily expected to implement a non-strict partial -- order and have the following properties: -- -- -- -- Note that the following operator interactions are expected to hold: -- --
    --
  1. x >= y = y <= x
    2. --
  2. x < y = x <= y && x /= y
    3. --
  3. x > y = y < x
    4. --
  4. x < y = compare x y == LT
    5. --
  5. x > y = compare x y == GT
    6. --
  6. x == y = compare x y == EQ
    7. --
  7. min x y == if x <= y then x else y = True
    8. --
  8. max x y == if x >= y then x else y = True
    9. --
-- -- Minimal complete definition: either compare or <=. -- Using compare can be more efficient for complex types. class Eq a => Ord a -- | The Bounded class is used to name the upper and lower limits of -- a type. Ord is not a superclass of Bounded since types -- that are not totally ordered may also have upper and lower bounds. -- -- The Bounded class may be derived for any enumeration type; -- minBound is the first constructor listed in the data -- declaration and maxBound is the last. Bounded may also -- be derived for single-constructor datatypes whose constituent types -- are in Bounded. class Bounded a minBound :: Bounded a => a maxBound :: Bounded a => a -- | The class of semigroups (types with an associative binary operation). -- -- Instances should satisfy the associativity law: -- -- class Semigroup a -- | An associative operation. (<>) :: Semigroup a => a -> a -> a -- | Reduce a non-empty list with <> -- -- The default definition should be sufficient, but this can be -- overridden for efficiency. sconcat :: Semigroup a => NonEmpty a -> a -- | Repeat a value n times. -- -- Given that this works on a Semigroup it is allowed to fail if -- you request 0 or fewer repetitions, and the default definition will do -- so. -- -- By making this a member of the class, idempotent semigroups and -- monoids can upgrade this to execute in O(1) by picking -- stimes = stimesIdempotent or stimes = -- stimesIdempotentMonoid respectively. stimes :: (Semigroup a, Integral b) => b -> a -> a infixr 6 <> -- | The class of monoids (types with an associative binary operation that -- has an identity). Instances should satisfy the following laws: -- -- -- -- The method names refer to the monoid of lists under concatenation, but -- there are many other instances. -- -- Some types can be viewed as a monoid in more than one way, e.g. both -- addition and multiplication on numbers. In such cases we often define -- newtypes and make those instances of Monoid, e.g. -- Sum and Product. -- -- NOTE: Semigroup is a superclass of Monoid since -- base-4.11.0.0. class Semigroup a => Monoid a -- | Identity of mappend mempty :: Monoid a => a -- | An associative operation -- -- NOTE: This method is redundant and has the default -- implementation mappend = '(<>)' since -- base-4.11.0.0. mappend :: Monoid a => a -> a -> a -- | Fold a list using the monoid. -- -- For most types, the default definition for mconcat will be -- used, but the function is included in the class definition so that an -- optimized version can be provided for specific types. mconcat :: Monoid a => [a] -> a -- | Representable types of kind *. This class is derivable in GHC -- with the DeriveGeneric flag on. -- -- A Generic instance must satisfy the following laws: -- -- 
--   from . to ≡ id
--   to . from ≡ id
--
class Generic a -- | A space efficient, packed, unboxed Unicode text type. data Text fromString :: IsString a => String -> a -- | undefined that leaves a warning in code on every usage. undefined :: HasCallStack => a -- | Functions to check whether two values are equal if their types have -- parameters and it's not statically known whether they these parameters -- have the same types. module Michelson.EqParam -- | Suppose you have a data type X with parameter a and -- you have two values: `x1 :: X a1` and `x2 :: X a2`. You can't compare -- them using ==, because they have different types. However, you -- can compare them using eqParam1 as long as both parameters are -- Typeable. eqParam1 :: forall a1 a2 t. (Typeable a1, Typeable a2, Eq (t a1)) => t a1 -> t a2 -> Bool -- | Version of eqParam1 for types with 2 parameters. eqParam2 :: forall a1 a2 b1 b2 t. (Typeable a1, Typeable a2, Typeable b1, Typeable b2, Eq (t a1 b2)) => t a1 b1 -> t a2 b2 -> Bool -- | Version of eqParam1 for types with 3 parameters. eqParam3 :: forall a1 a2 b1 b2 c1 c2 t. (Typeable a1, Typeable a2, Typeable b1, Typeable b2, Typeable c1, Typeable c2, Eq (t a1 b1 c1)) => t a1 b1 c1 -> t a2 b2 c2 -> Bool module Michelson.ErrorPos mkPos :: Int -> Pos newtype Pos Pos :: Word -> Pos data SrcPos SrcPos :: Pos -> Pos -> SrcPos srcPos :: Word -> Word -> SrcPos data InstrCallStack InstrCallStack :: LetCallStack -> SrcPos -> InstrCallStack [icsCallStack] :: InstrCallStack -> LetCallStack [icsSrcPos] :: InstrCallStack -> SrcPos type LetCallStack = [LetName] newtype LetName LetName :: Text -> LetName instance Data.Data.Data Michelson.ErrorPos.InstrCallStack instance GHC.Generics.Generic Michelson.ErrorPos.InstrCallStack instance GHC.Show.Show Michelson.ErrorPos.InstrCallStack instance GHC.Classes.Ord Michelson.ErrorPos.InstrCallStack instance GHC.Classes.Eq Michelson.ErrorPos.InstrCallStack instance GHC.Generics.Generic Michelson.ErrorPos.LetName instance Data.Data.Data Michelson.ErrorPos.LetName instance GHC.Show.Show Michelson.ErrorPos.LetName instance GHC.Classes.Ord Michelson.ErrorPos.LetName instance GHC.Classes.Eq Michelson.ErrorPos.LetName instance Data.Data.Data Michelson.ErrorPos.SrcPos instance GHC.Generics.Generic Michelson.ErrorPos.SrcPos instance GHC.Show.Show Michelson.ErrorPos.SrcPos instance GHC.Classes.Ord Michelson.ErrorPos.SrcPos instance GHC.Classes.Eq Michelson.ErrorPos.SrcPos instance Data.Data.Data Michelson.ErrorPos.Pos instance GHC.Generics.Generic Michelson.ErrorPos.Pos instance GHC.Show.Show Michelson.ErrorPos.Pos instance GHC.Classes.Ord Michelson.ErrorPos.Pos instance GHC.Classes.Eq Michelson.ErrorPos.Pos instance Data.Default.Class.Default Michelson.ErrorPos.InstrCallStack instance Data.Aeson.Types.ToJSON.ToJSON Michelson.ErrorPos.InstrCallStack instance Data.Aeson.Types.FromJSON.FromJSON Michelson.ErrorPos.InstrCallStack instance Data.Aeson.Types.ToJSON.ToJSON Michelson.ErrorPos.LetName instance Data.Aeson.Types.FromJSON.FromJSON Michelson.ErrorPos.LetName instance Data.Default.Class.Default Michelson.ErrorPos.SrcPos instance Data.Aeson.Types.ToJSON.ToJSON Michelson.ErrorPos.SrcPos instance Data.Aeson.Types.FromJSON.FromJSON Michelson.ErrorPos.SrcPos instance Data.Default.Class.Default Michelson.ErrorPos.Pos instance Data.Aeson.Types.ToJSON.ToJSON Michelson.ErrorPos.Pos instance Data.Aeson.Types.FromJSON.FromJSON Michelson.ErrorPos.Pos -- | Custom exceptions that can happen during parsing. module Michelson.Parser.Error data CustomParserException UnknownTypeException :: CustomParserException StringLiteralException :: StringLiteralParserException -> CustomParserException OddNumberBytesException :: CustomParserException ProhibitedLetType :: Text -> CustomParserException data StringLiteralParserException InvalidEscapeSequence :: Char -> StringLiteralParserException InvalidChar :: Char -> StringLiteralParserException -- | A non-empty collection of ParseErrors equipped with -- PosState that allows to pretty-print the errors efficiently and -- correctly. data ParseErrorBundle s e data ParserException ParserException :: ParseErrorBundle Text CustomParserException -> ParserException instance GHC.Classes.Eq Michelson.Parser.Error.ParserException instance GHC.Show.Show Michelson.Parser.Error.CustomParserException instance GHC.Classes.Ord Michelson.Parser.Error.CustomParserException instance Data.Data.Data Michelson.Parser.Error.CustomParserException instance GHC.Classes.Eq Michelson.Parser.Error.CustomParserException instance GHC.Show.Show Michelson.Parser.Error.StringLiteralParserException instance GHC.Classes.Ord Michelson.Parser.Error.StringLiteralParserException instance Data.Data.Data Michelson.Parser.Error.StringLiteralParserException instance GHC.Classes.Eq Michelson.Parser.Error.StringLiteralParserException instance GHC.Show.Show Michelson.Parser.Error.ParserException instance GHC.Exception.Type.Exception Michelson.Parser.Error.ParserException instance Formatting.Buildable.Buildable Michelson.Parser.Error.ParserException instance Text.Megaparsec.Error.ShowErrorComponent Michelson.Parser.Error.CustomParserException instance Text.Megaparsec.Error.ShowErrorComponent Michelson.Parser.Error.StringLiteralParserException module Michelson.Printer.Util -- | Generalize converting a type into a Text.PrettyPrint.Leijen.Text.Doc. -- Used to pretty print Michelson code and define Fmt.Buildable -- instances. class RenderDoc a renderDoc :: RenderDoc a => a -> Doc -- | Whether a value can be represented in Michelson code. Normally either -- all values of some type are renderable or not renderable. However, in -- case of instructions we have extra instructions which should not be -- rendered. Note: it's not suficcient to just return mempty for -- such instructions, because sometimes we want to print lists of -- instructions and we need to ignore them complete (to avoid putting -- redundant separators). isRenderable :: RenderDoc a => a -> Bool -- | Convert Doc to Text with a line width of 80. printDoc :: Doc -> Text -- | Generic way to render the different op types that get passed to a -- contract. renderOps :: RenderDoc op => Bool -> NonEmpty op -> Doc renderOpsList :: RenderDoc op => Bool -> [op] -> Doc -- | Create a specific number of spaces. spaces :: Int -> Doc -- | Wrap documents in parentheses if there are two or more in the list. wrapInParens :: NonEmpty Doc -> Doc -- | Turn something that is instance of RenderDoc into a -- Builder. It's formatted the same way as printDoc formats -- docs. buildRenderDoc :: RenderDoc a => a -> Builder -- | Testing utility functions used by testing framework itself or intended -- to be used by test writers. module Michelson.Test.Util leftToShowPanic :: (Show e, HasCallStack) => Either e a -> a leftToPrettyPanic :: (Buildable e, HasCallStack) => Either e a -> a -- | A Property that always failes with given message. failedProp :: Text -> Property -- | A Property that always succeeds. succeededProp :: Property -- | The Property holds on `Left a`. qcIsLeft :: Show b => Either a b -> Property -- | The Property holds on `Right b`. qcIsRight :: Show a => Either a b -> Property -- | Strings compliant with Michelson constraints. -- -- When writting a Michelson contract, you can only mention characters -- with codes from [32 .. 126] range in string literals. Same -- restriction applies to string literals passed to alphanet.sh. -- -- However, Michelson allows some control sequences: "n". You -- have to write it exactly in this form, and internally it will be -- transformed to line feed character (this behaviour can be observed -- when looking at Packed data). -- -- See tests for examples of good and bad strings. module Michelson.Text -- | Michelson string value. -- -- This is basically a mere text with limits imposed by the language: -- http://tezos.gitlab.io/zeronet/whitedoc/michelson.html#constants -- Although, this document seems to be not fully correct, and thus we -- applied constraints deduced empirically. -- -- You construct an item of this type using one of the following ways: -- -- -- -- 
--   >>> [mt|Some text|]
--   MTextUnsafe { unMText = "Some text" }
--
-- -- newtype MText MTextUnsafe :: Text -> MText [unMText] :: MText -> Text -- | Wrap a Haskell text into MText, performing necessary checks. -- -- You can use e.g. '\n' character directly in supplied -- argument, but attempt to use other bad characters like '\r' -- will cause failure. mkMText :: Text -> Either Text MText -- | Contruct MText from a Haskell text, failing if provided Haskell -- text is invalid Michelson string. mkMTextUnsafe :: HasCallStack => Text -> MText -- | Construct MText from a Haskell text, eliminating all characters -- which should not appear in Michelson strings. Characters which can be -- displayed normally via escaping are preserved. mkMTextCut :: Text -> MText -- | Print MText for Michelson code, with all unusual characters -- escaped. writeMText :: MText -> Text takeMText :: Int -> MText -> MText dropMText :: Int -> MText -> MText -- | Constraint on literals appearing in Michelson contract code. isMChar :: Char -> Bool -- | Parser used in mt quasi quoter. qqMText :: String -> Either Text String -- | QuasyQuoter for constructing Michelson strings. -- -- Validity of result will be checked at compile time. Note: -- -- mt :: QuasiQuoter -- | A type error asking to use MText instead of -- ErrorMessage. type family DoNotUseTextError instance Formatting.Buildable.Buildable Michelson.Text.MText instance Universum.Container.Class.Container Michelson.Text.MText instance GHC.Base.Monoid Michelson.Text.MText instance GHC.Base.Semigroup Michelson.Text.MText instance Data.Data.Data Michelson.Text.MText instance GHC.Classes.Ord Michelson.Text.MText instance GHC.Classes.Eq Michelson.Text.MText instance GHC.Show.Show Michelson.Text.MText instance Universum.String.Conversion.ToText Michelson.Text.MText instance Test.QuickCheck.Arbitrary.Arbitrary Michelson.Text.MText instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Text.MText instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Text.MText instance (TypeError ...) => Data.String.IsString Michelson.Text.MText module Michelson.Typed.Haskell.Instr.Helpers -- | Which branch to choose in generic tree representation: left, straight -- or right. S is used when there is one constructor with one -- field (something newtype-like). -- -- The reason why we need S can be explained by this example: data -- A = A1 B | A2 Integer data B = B Bool Now we may search for A1 -- constructor or B constructor. Without S in both cases path will -- be the same ([L]). data Branch L :: Branch S :: Branch R :: Branch -- | Path to a leaf (some field or constructor) in generic tree -- representation. type Path = [Branch] -- | Split a record into two pieces. class RSplit (l :: [k]) (r :: [k]) rsplit :: forall f. RSplit l r => Rec f (l ++ r) -> (Rec f l, Rec f r) instance forall k (r :: [k]). Michelson.Typed.Haskell.Instr.Helpers.RSplit '[] r instance forall k (ls :: [k]) (r :: [k]) (l :: k). Michelson.Typed.Haskell.Instr.Helpers.RSplit ls r => Michelson.Typed.Haskell.Instr.Helpers.RSplit (l : ls) r -- | Michelson annotations in untyped model. module Michelson.Untyped.Annotation newtype Annotation tag Annotation :: Text -> Annotation tag pattern WithAnn :: Annotation tag -> Annotation tag type TypeAnn = Annotation TypeTag type FieldAnn = Annotation FieldTag type VarAnn = Annotation VarTag -- | Typeclass for printing annotations, renderAnn prints empty -- prefix in case of noAnn. -- -- Such functionality is required in case when instruction has two -- annotations of the same type, former is empty and the latter is not. -- So that `PAIR noAnn noAnn noAnn %kek` is printed as `PAIR % %kek` class RenderAnn t renderAnn :: RenderAnn t => t -> Doc noAnn :: Annotation a ann :: Text -> Annotation a unifyAnn :: Annotation tag -> Annotation tag -> Maybe (Annotation tag) ifAnnUnified :: Annotation tag -> Annotation tag -> Bool disjoinVn :: VarAnn -> (VarAnn, VarAnn) convAnn :: Annotation tag1 -> Annotation tag2 instance forall k (tag :: k). Data.Aeson.Types.ToJSON.ToJSON (Michelson.Untyped.Annotation.Annotation tag) instance forall k (tag :: k). Data.Aeson.Types.FromJSON.FromJSON (Michelson.Untyped.Annotation.Annotation tag) instance forall k (tag :: k). Data.String.IsString (Michelson.Untyped.Annotation.Annotation tag) instance forall k (tag :: k). GHC.Generics.Generic (Michelson.Untyped.Annotation.Annotation tag) instance GHC.Base.Functor Michelson.Untyped.Annotation.Annotation instance forall k (tag :: k). (Data.Typeable.Internal.Typeable tag, Data.Typeable.Internal.Typeable k) => Data.Data.Data (Michelson.Untyped.Annotation.Annotation tag) instance forall k (tag :: k). GHC.Classes.Eq (Michelson.Untyped.Annotation.Annotation tag) instance Michelson.Untyped.Annotation.RenderAnn Michelson.Untyped.Annotation.TypeAnn instance Michelson.Untyped.Annotation.RenderAnn Michelson.Untyped.Annotation.FieldAnn instance Michelson.Untyped.Annotation.RenderAnn Michelson.Untyped.Annotation.VarAnn instance Michelson.Printer.Util.RenderDoc Michelson.Untyped.Annotation.VarAnn instance Formatting.Buildable.Buildable Michelson.Untyped.Annotation.VarAnn instance GHC.Base.Semigroup Michelson.Untyped.Annotation.VarAnn instance GHC.Base.Monoid Michelson.Untyped.Annotation.VarAnn instance Michelson.Printer.Util.RenderDoc Michelson.Untyped.Annotation.FieldAnn instance Formatting.Buildable.Buildable Michelson.Untyped.Annotation.FieldAnn instance Michelson.Printer.Util.RenderDoc Michelson.Untyped.Annotation.TypeAnn instance Formatting.Buildable.Buildable Michelson.Untyped.Annotation.TypeAnn instance GHC.Show.Show (Michelson.Untyped.Annotation.Annotation Michelson.Untyped.Annotation.VarTag) instance GHC.Show.Show (Michelson.Untyped.Annotation.Annotation Michelson.Untyped.Annotation.FieldTag) instance GHC.Show.Show (Michelson.Untyped.Annotation.Annotation Michelson.Untyped.Annotation.TypeTag) instance forall k (tag :: k). Data.Default.Class.Default (Michelson.Untyped.Annotation.Annotation tag) -- | Michelson types represented in untyped model. module Michelson.Untyped.Type data Type Type :: T -> TypeAnn -> Type -- | Implicit Parameter type which can be used in contract code TypeParameter :: Type -- | Implicit Storage type which can be used in contract code TypeStorage :: Type data Comparable Comparable :: CT -> TypeAnn -> Comparable compToType :: Comparable -> Type typeToComp :: Type -> Maybe Comparable data T Tc :: CT -> T TKey :: T TUnit :: T TSignature :: T TOption :: FieldAnn -> Type -> T TList :: Type -> T TSet :: Comparable -> T TOperation :: T TContract :: Type -> T TPair :: FieldAnn -> FieldAnn -> Type -> Type -> T TOr :: FieldAnn -> FieldAnn -> Type -> Type -> T TLambda :: Type -> Type -> T TMap :: Comparable -> Type -> T TBigMap :: Comparable -> Type -> T data CT CInt :: CT CNat :: CT CString :: CT CBytes :: CT CMutez :: CT CBool :: CT CKeyHash :: CT CTimestamp :: CT CAddress :: CT pattern Tint :: T pattern Tnat :: T pattern Tstring :: T pattern Tbytes :: T pattern Tmutez :: T pattern Tbool :: T pattern Tkey_hash :: T pattern Ttimestamp :: T pattern Taddress :: T tint :: T tnat :: T tstring :: T tbytes :: T tmutez :: T tbool :: T tkeyHash :: T ttimestamp :: T taddress :: T isAtomicType :: Type -> Bool isKey :: Type -> Bool isSignature :: Type -> Bool isComparable :: Type -> Bool isMutez :: Type -> Bool isKeyHash :: Type -> Bool isBool :: Type -> Bool isString :: Type -> Bool isInteger :: Type -> Bool isTimestamp :: Type -> Bool isNat :: Type -> Bool isInt :: Type -> Bool isBytes :: Type -> Bool instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Untyped.Type.CT instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Untyped.Type.CT instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Untyped.Type.T instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Untyped.Type.T instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Untyped.Type.Comparable instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Untyped.Type.Comparable instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Untyped.Type.Type instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Untyped.Type.Type instance GHC.Generics.Generic Michelson.Untyped.Type.Type instance Data.Data.Data Michelson.Untyped.Type.Type instance GHC.Show.Show Michelson.Untyped.Type.Type instance GHC.Classes.Eq Michelson.Untyped.Type.Type instance GHC.Generics.Generic Michelson.Untyped.Type.T instance Data.Data.Data Michelson.Untyped.Type.T instance GHC.Show.Show Michelson.Untyped.Type.T instance GHC.Classes.Eq Michelson.Untyped.Type.T instance GHC.Generics.Generic Michelson.Untyped.Type.Comparable instance Data.Data.Data Michelson.Untyped.Type.Comparable instance GHC.Show.Show Michelson.Untyped.Type.Comparable instance GHC.Classes.Eq Michelson.Untyped.Type.Comparable instance GHC.Generics.Generic Michelson.Untyped.Type.CT instance GHC.Enum.Bounded Michelson.Untyped.Type.CT instance GHC.Enum.Enum Michelson.Untyped.Type.CT instance Data.Data.Data Michelson.Untyped.Type.CT instance GHC.Show.Show Michelson.Untyped.Type.CT instance GHC.Classes.Ord Michelson.Untyped.Type.CT instance GHC.Classes.Eq Michelson.Untyped.Type.CT instance Michelson.Printer.Util.RenderDoc Michelson.Untyped.Type.Type instance Michelson.Printer.Util.RenderDoc Michelson.Untyped.Type.T instance Formatting.Buildable.Buildable Michelson.Untyped.Type.Type instance Formatting.Buildable.Buildable Michelson.Untyped.Type.T instance Michelson.Printer.Util.RenderDoc Michelson.Untyped.Type.Comparable instance Formatting.Buildable.Buildable Michelson.Untyped.Type.Comparable instance Michelson.Printer.Util.RenderDoc Michelson.Untyped.Type.CT instance Formatting.Buildable.Buildable Michelson.Untyped.Type.CT module Michelson.Untyped.Ext -- | Implementation-specific instructions embedded in a NOP -- primitive, which mark a specific point during a contract's -- typechecking or execution. -- -- These instructions are not allowed to modify the contract's stack, but -- may impose additional constraints that can cause a contract to report -- errors in type-checking or testing. -- -- Additionaly, some implementation-specific language features such as -- type-checking of LetMacros are implemented using this -- mechanism (specifically FN and FN_END). data ExtInstrAbstract op -- | Matches current stack against a type-pattern STACKTYPE :: StackTypePattern -> ExtInstrAbstract op -- | A typed stack function (push and pop a TcExtFrame) FN :: Text -> StackFn -> [op] -> ExtInstrAbstract op -- | Copy the current stack and run an inline assertion on it UTEST_ASSERT :: TestAssert op -> ExtInstrAbstract op -- | Print a comment with optional embedded StackRefs UPRINT :: PrintComment -> ExtInstrAbstract op -- | A reference into the stack. newtype StackRef StackRef :: Natural -> StackRef newtype PrintComment PrintComment :: [Either Text StackRef] -> PrintComment [unUPrintComment] :: PrintComment -> [Either Text StackRef] data TestAssert op TestAssert :: Text -> PrintComment -> [op] -> TestAssert op [tassName] :: TestAssert op -> Text [tassComment] :: TestAssert op -> PrintComment [tassInstrs] :: TestAssert op -> [op] newtype Var Var :: Text -> Var -- | A type-variable or a type-constant data TyVar VarID :: Var -> TyVar TyCon :: Type -> TyVar -- | A stack pattern-match data StackTypePattern StkEmpty :: StackTypePattern StkRest :: StackTypePattern StkCons :: TyVar -> StackTypePattern -> StackTypePattern -- | A stack function that expresses the type signature of a -- LetMacro data StackFn StackFn :: Maybe (Set Var) -> StackTypePattern -> StackTypePattern -> StackFn [quantifiedVars] :: StackFn -> Maybe (Set Var) [inPattern] :: StackFn -> StackTypePattern [outPattern] :: StackFn -> StackTypePattern -- | Get the set of variables in a stack pattern varSet :: StackTypePattern -> Set Var -- | Convert StackTypePattern to a list of types. Also returns -- Bool which is True if the pattern is a fixed list of -- types and False if it's a pattern match on the head of the -- stack. stackTypePatternToList :: StackTypePattern -> ([TyVar], Bool) instance Data.Aeson.Types.ToJSON.ToJSON op => Data.Aeson.Types.ToJSON.ToJSON (Michelson.Untyped.Ext.TestAssert op) instance Data.Aeson.Types.FromJSON.FromJSON op => Data.Aeson.Types.FromJSON.FromJSON (Michelson.Untyped.Ext.TestAssert op) instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Untyped.Ext.TyVar instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Untyped.Ext.TyVar instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Untyped.Ext.Var instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Untyped.Ext.Var instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Untyped.Ext.StackFn instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Untyped.Ext.StackFn instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Untyped.Ext.StackRef instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Untyped.Ext.StackRef instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Untyped.Ext.StackTypePattern instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Untyped.Ext.StackTypePattern instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Untyped.Ext.PrintComment instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Untyped.Ext.PrintComment instance Data.Aeson.Types.ToJSON.ToJSON op => Data.Aeson.Types.ToJSON.ToJSON (Michelson.Untyped.Ext.ExtInstrAbstract op) instance Data.Aeson.Types.FromJSON.FromJSON op => Data.Aeson.Types.FromJSON.FromJSON (Michelson.Untyped.Ext.ExtInstrAbstract op) instance GHC.Base.Functor Michelson.Untyped.Ext.ExtInstrAbstract instance GHC.Generics.Generic (Michelson.Untyped.Ext.ExtInstrAbstract op) instance Data.Data.Data op => Data.Data.Data (Michelson.Untyped.Ext.ExtInstrAbstract op) instance GHC.Show.Show op => GHC.Show.Show (Michelson.Untyped.Ext.ExtInstrAbstract op) instance GHC.Classes.Eq op => GHC.Classes.Eq (Michelson.Untyped.Ext.ExtInstrAbstract op) instance GHC.Generics.Generic (Michelson.Untyped.Ext.TestAssert op) instance Data.Data.Data op => Data.Data.Data (Michelson.Untyped.Ext.TestAssert op) instance GHC.Base.Functor Michelson.Untyped.Ext.TestAssert instance GHC.Show.Show op => GHC.Show.Show (Michelson.Untyped.Ext.TestAssert op) instance GHC.Classes.Eq op => GHC.Classes.Eq (Michelson.Untyped.Ext.TestAssert op) instance GHC.Generics.Generic Michelson.Untyped.Ext.PrintComment instance Data.Data.Data Michelson.Untyped.Ext.PrintComment instance GHC.Show.Show Michelson.Untyped.Ext.PrintComment instance GHC.Classes.Eq Michelson.Untyped.Ext.PrintComment instance GHC.Generics.Generic Michelson.Untyped.Ext.StackFn instance Data.Data.Data Michelson.Untyped.Ext.StackFn instance GHC.Show.Show Michelson.Untyped.Ext.StackFn instance GHC.Classes.Eq Michelson.Untyped.Ext.StackFn instance GHC.Generics.Generic Michelson.Untyped.Ext.StackTypePattern instance Data.Data.Data Michelson.Untyped.Ext.StackTypePattern instance GHC.Show.Show Michelson.Untyped.Ext.StackTypePattern instance GHC.Classes.Eq Michelson.Untyped.Ext.StackTypePattern instance GHC.Generics.Generic Michelson.Untyped.Ext.TyVar instance Data.Data.Data Michelson.Untyped.Ext.TyVar instance GHC.Show.Show Michelson.Untyped.Ext.TyVar instance GHC.Classes.Eq Michelson.Untyped.Ext.TyVar instance GHC.Generics.Generic Michelson.Untyped.Ext.Var instance Data.Data.Data Michelson.Untyped.Ext.Var instance GHC.Classes.Ord Michelson.Untyped.Ext.Var instance GHC.Show.Show Michelson.Untyped.Ext.Var instance GHC.Classes.Eq Michelson.Untyped.Ext.Var instance GHC.Generics.Generic Michelson.Untyped.Ext.StackRef instance Data.Data.Data Michelson.Untyped.Ext.StackRef instance GHC.Show.Show Michelson.Untyped.Ext.StackRef instance GHC.Classes.Eq Michelson.Untyped.Ext.StackRef instance Michelson.Printer.Util.RenderDoc op => Michelson.Printer.Util.RenderDoc (Michelson.Untyped.Ext.ExtInstrAbstract op) instance Formatting.Buildable.Buildable op => Formatting.Buildable.Buildable (Michelson.Untyped.Ext.ExtInstrAbstract op) instance Formatting.Buildable.Buildable code => Formatting.Buildable.Buildable (Michelson.Untyped.Ext.TestAssert code) instance Formatting.Buildable.Buildable Michelson.Untyped.Ext.PrintComment instance Formatting.Buildable.Buildable Michelson.Untyped.Ext.StackFn instance Formatting.Buildable.Buildable Michelson.Untyped.Ext.StackTypePattern instance Formatting.Buildable.Buildable Michelson.Untyped.Ext.TyVar instance Formatting.Buildable.Buildable Michelson.Untyped.Ext.Var instance Formatting.Buildable.Buildable Michelson.Untyped.Ext.StackRef -- | Michelson contract in untyped model. module Michelson.Untyped.Contract type Parameter = Type type Storage = Type data Contract' op Contract :: Parameter -> Storage -> [op] -> Contract' op [para] :: Contract' op -> Parameter [stor] :: Contract' op -> Storage [code] :: Contract' op -> [op] instance Data.Aeson.Types.ToJSON.ToJSON op => Data.Aeson.Types.ToJSON.ToJSON (Michelson.Untyped.Contract.Contract' op) instance Data.Aeson.Types.FromJSON.FromJSON op => Data.Aeson.Types.FromJSON.FromJSON (Michelson.Untyped.Contract.Contract' op) instance GHC.Generics.Generic (Michelson.Untyped.Contract.Contract' op) instance Data.Data.Data op => Data.Data.Data (Michelson.Untyped.Contract.Contract' op) instance GHC.Base.Functor Michelson.Untyped.Contract.Contract' instance GHC.Show.Show op => GHC.Show.Show (Michelson.Untyped.Contract.Contract' op) instance GHC.Classes.Eq op => GHC.Classes.Eq (Michelson.Untyped.Contract.Contract' op) instance Michelson.Printer.Util.RenderDoc op => Michelson.Printer.Util.RenderDoc (Michelson.Untyped.Contract.Contract' op) instance Michelson.Printer.Util.RenderDoc op => Formatting.Buildable.Buildable (Michelson.Untyped.Contract.Contract' op) -- | Module, providing CT and T data types, representing -- Michelson language types without annotations. module Michelson.Typed.T data CT CInt :: CT CNat :: CT CString :: CT CBytes :: CT CMutez :: CT CBool :: CT CKeyHash :: CT CTimestamp :: CT CAddress :: CT -- | Michelson language type with annotations stripped off. data T Tc :: CT -> T TKey :: T TUnit :: T TSignature :: T TOption :: T -> T TList :: T -> T TSet :: CT -> T TOperation :: T TContract :: T -> T TPair :: T -> T -> T TOr :: T -> T -> T TLambda :: T -> T -> T TMap :: CT -> T -> T TBigMap :: CT -> T -> T instance GHC.Show.Show Michelson.Typed.T.T instance GHC.Classes.Eq Michelson.Typed.T.T -- | Module, providing singleton boilerplate for T and CT -- data types. -- -- Some functions from Data.Singletons are provided alternative version -- here. Some instances which are usually generated with TH are manually -- implemented as they require some specific constraints, namely -- Typeable and/or Converge, not provided in instances -- generated by TH. module Michelson.Typed.Sing -- | The singleton kind-indexed data family. data family Sing (a :: k) :: Type -- | Version of withSomeSing with Typeable constraint -- provided to processing function. -- -- Required for not to erase these useful constraints when doing -- conversion from value of type T to its singleton -- representation. withSomeSingT :: T -> (forall (a :: T). (Typeable a, SingI a) => Sing a -> r) -> r -- | Version of withSomeSing with Typeable constraint -- provided to processing function. -- -- Required for not to erase this useful constraint when doing conversion -- from value of type CT to its singleton representation. withSomeSingCT :: CT -> (forall (a :: CT). (SingI a, Typeable a) => Sing a -> r) -> r -- | Version of fromSing specialized for use with data instance -- Sing :: T -> Type which requires Typeable constraint -- for some of its constructors fromSingT :: Sing (a :: T) -> T fromSingCT :: Sing (a :: CT) -> CT instance Data.Singletons.Internal.SingKind Michelson.Typed.T.T instance Data.Singletons.Internal.SingKind Michelson.Untyped.Type.CT instance Data.Singletons.Internal.SingI 'Michelson.Untyped.Type.CInt instance Data.Singletons.Internal.SingI 'Michelson.Untyped.Type.CNat instance Data.Singletons.Internal.SingI 'Michelson.Untyped.Type.CString instance Data.Singletons.Internal.SingI 'Michelson.Untyped.Type.CBytes instance Data.Singletons.Internal.SingI 'Michelson.Untyped.Type.CMutez instance Data.Singletons.Internal.SingI 'Michelson.Untyped.Type.CBool instance Data.Singletons.Internal.SingI 'Michelson.Untyped.Type.CKeyHash instance Data.Singletons.Internal.SingI 'Michelson.Untyped.Type.CTimestamp instance Data.Singletons.Internal.SingI 'Michelson.Untyped.Type.CAddress instance (Data.Singletons.Internal.SingI t, Data.Typeable.Internal.Typeable t) => Data.Singletons.Internal.SingI ('Michelson.Typed.T.Tc t) instance Data.Singletons.Internal.SingI 'Michelson.Typed.T.TKey instance Data.Singletons.Internal.SingI 'Michelson.Typed.T.TUnit instance Data.Singletons.Internal.SingI 'Michelson.Typed.T.TSignature instance (Data.Singletons.Internal.SingI a, Data.Typeable.Internal.Typeable a) => Data.Singletons.Internal.SingI ('Michelson.Typed.T.TOption a) instance (Data.Singletons.Internal.SingI a, Data.Typeable.Internal.Typeable a) => Data.Singletons.Internal.SingI ('Michelson.Typed.T.TList a) instance (Data.Singletons.Internal.SingI a, Data.Typeable.Internal.Typeable a) => Data.Singletons.Internal.SingI ('Michelson.Typed.T.TSet a) instance Data.Singletons.Internal.SingI 'Michelson.Typed.T.TOperation instance (Data.Singletons.Internal.SingI a, Data.Typeable.Internal.Typeable a) => Data.Singletons.Internal.SingI ('Michelson.Typed.T.TContract a) instance (Data.Singletons.Internal.SingI a, Data.Typeable.Internal.Typeable a, Data.Typeable.Internal.Typeable b, Data.Singletons.Internal.SingI b) => Data.Singletons.Internal.SingI ('Michelson.Typed.T.TPair a b) instance (Data.Singletons.Internal.SingI a, Data.Typeable.Internal.Typeable a, Data.Typeable.Internal.Typeable b, Data.Singletons.Internal.SingI b) => Data.Singletons.Internal.SingI ('Michelson.Typed.T.TOr a b) instance (Data.Singletons.Internal.SingI a, Data.Typeable.Internal.Typeable a, Data.Typeable.Internal.Typeable b, Data.Singletons.Internal.SingI b) => Data.Singletons.Internal.SingI ('Michelson.Typed.T.TLambda a b) instance (Data.Singletons.Internal.SingI a, Data.Typeable.Internal.Typeable a, Data.Typeable.Internal.Typeable b, Data.Singletons.Internal.SingI b) => Data.Singletons.Internal.SingI ('Michelson.Typed.T.TMap a b) instance (Data.Singletons.Internal.SingI a, Data.Typeable.Internal.Typeable a, Data.Typeable.Internal.Typeable b, Data.Singletons.Internal.SingI b) => Data.Singletons.Internal.SingI ('Michelson.Typed.T.TBigMap a b) -- | Module, containing restrictions imposed by instruction or value scope. module Michelson.Typed.Scope type AllowBigMap t = FailOnBigMapFound (BadBigMapPair t) -- | Constraint which ensures that bigmap does not appear in a given type. class (ContainsBigMap t ~ 'False) => HasNoBigMap t -- | Constraint which ensures that operation type does not appear in a -- given type. -- -- Not just a type alias in order to be able to partially apply it (e.g. -- in Each). class (ContainsOp t ~ 'False) => HasNoOp t type ForbidBigMap t = FailOnBigMapFound (ContainsBigMap t) -- | This is like HasNoOp, it raises a more human-readable error -- when t type is concrete, but you cannot easily extract a -- proof of no-operation-presence from it. -- -- Use it in our eDSL. type ForbidOp t = FailOnOperationFound (ContainsOp t) data BigMapPresence (t :: T) BigMapPresent :: BigMapPresence BigMapAbsent :: BigMapPresence -- | Whether the type contains TOperation, with proof. data OpPresence (t :: T) OpPresent :: OpPresence OpAbsent :: OpPresence -- | Constraint which ensures, that t can be used as type of -- contract storage so it optionally has bigmap only on the left of its -- toplevel pair type BigMapConstraint t = BadBigMapPair t ~ 'False -- | Check at runtime whether the given type contains TOperation. checkOpPresence :: Sing (ty :: T) -> OpPresence ty -- | Check at runtime whether the given type contains TBigMap. checkBigMapPresence :: Sing (ty :: T) -> BigMapPresence ty checkBigMapConstraint :: forall t a. (SingI t, AllowBigMap t) => (BigMapConstraint t => a) -> a -- | Check at runtime that the given type does not contain -- TOperation. opAbsense :: Sing (t :: T) -> Maybe (Dict $ HasNoOp t) -- | Check at runtime that the given type does not containt TBigMap bigMapAbsense :: Sing (t :: T) -> Maybe (Dict $ HasNoBigMap t) -- | Reify HasNoOp contraint from ForbidOp. forbiddenOp :: forall t a. (SingI t, ForbidOp t) => (HasNoOp t => a) -> a forbiddenBigMap :: forall t a. (SingI t, ForbidBigMap t) => (HasNoBigMap t => a) -> a -- | Check at runtime that the given type optionally has bigmap only on the -- left of its toplevel pair, which is actuall constraint for bigmap -- appearance in the storage bigMapConstrained :: Sing (t :: T) -> Maybe (Dict $ BigMapConstraint t) instance (Michelson.Typed.Scope.ContainsBigMap t Data.Type.Equality.~ 'GHC.Types.False) => Michelson.Typed.Scope.HasNoBigMap t instance (Michelson.Typed.Scope.ContainsOp t Data.Type.Equality.~ 'GHC.Types.False) => Michelson.Typed.Scope.HasNoOp t -- | Module, providing Notes t data type, which holds annotations -- for a given type t. -- -- Annotation type Notes t is a tree, each leaf is either a star -- (*) or a constructor holding some annotation data for a given -- type t. Star corresponds to the case when given Michelson -- type contains no annotations. -- -- This module also provides type class Converge along with some -- utility functions which are used to combine two annotations trees -- a and b into a new one c in such a way that -- c can be obtained from both a and b by -- replacing some * leafs with type or/and field annotations. module Michelson.Typed.Annotation -- | Data type, holding annotation data for a given Michelson type -- t or * in case no data is provided for the tree. -- -- There is a little semantical duplication between data type -- constructors. Semantics behind NStar constructor are exactly -- same as semantics behind N constructor with relevant -- Notes' constructor be given all default values (which means all -- annotations are empty). -- -- Constructor NStar is given as a tiny optimization to allow -- handling no-annotation case completely for free (see converge -- and mkNotes functions). data Notes t N :: Notes' t -> Notes t NStar :: Notes t -- | Data type, holding annotation data for a given Michelson type -- t. -- -- Each constructor corresponds to exactly one constructor of T -- and holds all type and field annotations that can be attributed to a -- Michelson type corrspoding to t. data Notes' t [NTc] :: TypeAnn -> Notes' ( 'Tc ct) [NTKey] :: TypeAnn -> Notes' 'TKey [NTUnit] :: TypeAnn -> Notes' 'TUnit [NTSignature] :: TypeAnn -> Notes' 'TSignature [NTOption] :: TypeAnn -> FieldAnn -> Notes t -> Notes' ( 'TOption t) [NTList] :: TypeAnn -> Notes t -> Notes' ( 'TList t) [NTSet] :: TypeAnn -> TypeAnn -> Notes' ( 'TSet ct) [NTOperation] :: TypeAnn -> Notes' 'TOperation [NTContract] :: TypeAnn -> Notes t -> Notes' ( 'TContract t) [NTPair] :: TypeAnn -> FieldAnn -> FieldAnn -> Notes p -> Notes q -> Notes' ( 'TPair p q) [NTOr] :: TypeAnn -> FieldAnn -> FieldAnn -> Notes p -> Notes q -> Notes' ( 'TOr p q) [NTLambda] :: TypeAnn -> Notes p -> Notes q -> Notes' ( 'TLambda p q) [NTMap] :: TypeAnn -> TypeAnn -> Notes v -> Notes' ( 'TMap k v) [NTBigMap] :: TypeAnn -> TypeAnn -> Notes v -> Notes' ( 'TBigMap k v) data AnnConvergeError [AnnConvergeError] :: forall (tag :: Type). (Buildable (Annotation tag), Show (Annotation tag), Typeable tag) => Annotation tag -> Annotation tag -> AnnConvergeError -- | Same as converge' but works with Notes data type. converge :: Notes t -> Notes t -> Either AnnConvergeError (Notes t) -- | Converge two type or field notes (which may be wildcards). convergeAnns :: forall (tag :: Type). (Buildable (Annotation tag), Show (Annotation tag), Typeable tag) => Annotation tag -> Annotation tag -> Either AnnConvergeError (Annotation tag) -- | Helper function for work with Notes data type. -- -- 
--   notesCase f g notes
--
-- -- is equivalent to -- -- 
--   case notes of
--     NStar -> f
--     N v -> g v
--
notesCase :: r -> (Notes' t -> r) -> Notes t -> r -- | Check whether given annotations object is *. isStar :: Notes t -> Bool -- | Checks whether given notes n can be immediately converted to -- star and returns either NStar or N n. -- -- Given n :: Notes' t can be immediately converted to star iff -- all nested (sn :: Notes t) == NStar and for each annotation -- an: an == def. mkNotes :: Notes' t -> Notes t orAnn :: Annotation t -> Annotation t -> Annotation t instance GHC.Classes.Eq (Michelson.Typed.Annotation.Notes t) instance GHC.Show.Show (Michelson.Typed.Annotation.Notes p) instance GHC.Show.Show (Michelson.Typed.Annotation.Notes' t) instance GHC.Classes.Eq (Michelson.Typed.Annotation.Notes' t) instance GHC.Show.Show Michelson.Typed.Annotation.AnnConvergeError instance GHC.Classes.Eq Michelson.Typed.Annotation.AnnConvergeError instance Formatting.Buildable.Buildable Michelson.Typed.Annotation.AnnConvergeError -- | Untyped Michelson values (i. e. type of a value is not statically -- known). module Michelson.Untyped.Value data Value' op ValueInt :: Integer -> Value' op ValueString :: MText -> Value' op ValueBytes :: InternalByteString -> Value' op ValueUnit :: Value' op ValueTrue :: Value' op ValueFalse :: Value' op ValuePair :: Value' op -> Value' op -> Value' op ValueLeft :: Value' op -> Value' op ValueRight :: Value' op -> Value' op ValueSome :: Value' op -> Value' op ValueNone :: Value' op ValueNil :: Value' op -- | A sequence of elements: can be a list or a set. We can't distinguish -- lists and sets during parsing. ValueSeq :: (NonEmpty $ Value' op) -> Value' op ValueMap :: (NonEmpty $ Elt op) -> Value' op ValueLambda :: NonEmpty op -> Value' op data Elt op Elt :: Value' op -> Value' op -> Elt op -- | ByteString does not have an instance for ToJSON and FromJSON, to avoid -- orphan type class instances, make a new type wrapper around it. newtype InternalByteString InternalByteString :: ByteString -> InternalByteString unInternalByteString :: InternalByteString -> ByteString instance Data.Aeson.Types.ToJSON.ToJSON op => Data.Aeson.Types.ToJSON.ToJSON (Michelson.Untyped.Value.Elt op) instance Data.Aeson.Types.FromJSON.FromJSON op => Data.Aeson.Types.FromJSON.FromJSON (Michelson.Untyped.Value.Elt op) instance Data.Aeson.Types.ToJSON.ToJSON op => Data.Aeson.Types.ToJSON.ToJSON (Michelson.Untyped.Value.Value' op) instance Data.Aeson.Types.FromJSON.FromJSON op => Data.Aeson.Types.FromJSON.FromJSON (Michelson.Untyped.Value.Value' op) instance GHC.Generics.Generic (Michelson.Untyped.Value.Elt op) instance Data.Data.Data op => Data.Data.Data (Michelson.Untyped.Value.Elt op) instance GHC.Base.Functor Michelson.Untyped.Value.Elt instance GHC.Show.Show op => GHC.Show.Show (Michelson.Untyped.Value.Elt op) instance GHC.Classes.Eq op => GHC.Classes.Eq (Michelson.Untyped.Value.Elt op) instance GHC.Generics.Generic (Michelson.Untyped.Value.Value' op) instance Data.Data.Data op => Data.Data.Data (Michelson.Untyped.Value.Value' op) instance GHC.Base.Functor Michelson.Untyped.Value.Value' instance GHC.Show.Show op => GHC.Show.Show (Michelson.Untyped.Value.Value' op) instance GHC.Classes.Eq op => GHC.Classes.Eq (Michelson.Untyped.Value.Value' op) instance GHC.Show.Show Michelson.Untyped.Value.InternalByteString instance GHC.Classes.Eq Michelson.Untyped.Value.InternalByteString instance Data.Data.Data Michelson.Untyped.Value.InternalByteString instance Michelson.Printer.Util.RenderDoc op => Michelson.Printer.Util.RenderDoc (Michelson.Untyped.Value.Value' op) instance Michelson.Printer.Util.RenderDoc op => Michelson.Printer.Util.RenderDoc (Michelson.Untyped.Value.Elt op) instance Michelson.Printer.Util.RenderDoc op => Formatting.Buildable.Buildable (Michelson.Untyped.Value.Value' op) instance Michelson.Printer.Util.RenderDoc op => Formatting.Buildable.Buildable (Michelson.Untyped.Value.Elt op) instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Untyped.Value.InternalByteString instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Untyped.Value.InternalByteString -- | Core primitive Tezos types. module Tezos.Core -- | Mutez is a wrapper over integer data type. 1 mutez is 1 token (μTz). data Mutez -- | Safely create Mutez checking for overflow. mkMutez :: Word64 -> Maybe Mutez -- | Partial function for Mutez creation, it's pre-condition is that -- the argument must not exceed the maximal Mutez value. unsafeMkMutez :: HasCallStack => Word64 -> Mutez -- | Safely create Mutez. -- -- This is recommended way to create Mutez from a numeric -- literal; you can't construct all valid Mutez values using -- this function but for small values it works neat. -- -- Warnings displayed when trying to construct invalid Natural or -- Word literal are hardcoded for these types in GHC -- implementation, so we can only exploit these existing rules. toMutez :: Word32 -> Mutez -- | Addition of Mutez values. Returns Nothing in case of -- overflow. addMutez :: Mutez -> Mutez -> Maybe Mutez -- | Partial addition of Mutez, should be used only if you're sure -- there'll be no overflow. unsafeAddMutez :: HasCallStack => Mutez -> Mutez -> Mutez -- | Subtraction of Mutez values. Returns Nothing when the -- subtrahend is greater than the minuend, and Just otherwise. subMutez :: Mutez -> Mutez -> Maybe Mutez -- | Partial subtraction of Mutez, should be used only if you're -- sure there'll be no underflow. unsafeSubMutez :: HasCallStack => Mutez -> Mutez -> Mutez -- | Multiplication of Mutez and an integral number. Returns -- Nothing in case of overflow. mulMutez :: Integral a => Mutez -> a -> Maybe Mutez -- | Euclidian division of two Mutez values. divModMutez :: Mutez -> Mutez -> Maybe (Word64, Mutez) -- | Euclidian division of Mutez and a number. divModMutezInt :: Integral a => Mutez -> a -> Maybe (Mutez, Mutez) -- | Time in the real world. Use the functions below to convert it to/from -- Unix time in seconds. newtype Timestamp Timestamp :: POSIXTime -> Timestamp [unTimestamp] :: Timestamp -> POSIXTime timestampToSeconds :: Integral a => Timestamp -> a timestampFromSeconds :: Integral a => a -> Timestamp timestampFromUTCTime :: UTCTime -> Timestamp -- | Add given amount of seconds to a Timestamp. timestampPlusSeconds :: Timestamp -> Integer -> Timestamp -- | Display timestamp in human-readable way as used by Michelson. Uses UTC -- timezone, though maybe we should take it as an argument. formatTimestamp :: Timestamp -> Text -- | Parse textual representation of Timestamp. parseTimestamp :: Text -> Maybe Timestamp -- | Return current time as Timestamp. getCurrentTime :: IO Timestamp instance Data.Aeson.Types.ToJSON.ToJSON Tezos.Core.Timestamp instance Data.Aeson.Types.FromJSON.FromJSON Tezos.Core.Timestamp instance Data.Aeson.Types.ToJSON.ToJSON Tezos.Core.Mutez instance Data.Aeson.Types.FromJSON.FromJSON Tezos.Core.Mutez instance GHC.Generics.Generic Tezos.Core.Timestamp instance Data.Data.Data Tezos.Core.Timestamp instance GHC.Classes.Ord Tezos.Core.Timestamp instance GHC.Classes.Eq Tezos.Core.Timestamp instance GHC.Show.Show Tezos.Core.Timestamp instance Formatting.Buildable.Buildable Tezos.Core.Mutez instance GHC.Enum.Enum Tezos.Core.Mutez instance GHC.Generics.Generic Tezos.Core.Mutez instance Data.Data.Data Tezos.Core.Mutez instance GHC.Classes.Ord Tezos.Core.Mutez instance GHC.Classes.Eq Tezos.Core.Mutez instance GHC.Show.Show Tezos.Core.Mutez instance Formatting.Buildable.Buildable Tezos.Core.Timestamp instance GHC.Enum.Bounded Tezos.Core.Mutez -- | Cryptographic primitives used in Tezos. module Tezos.Crypto -- | ED25519 public cryptographic key. newtype PublicKey PublicKey :: PublicKey -> PublicKey [unPublicKey] :: PublicKey -> PublicKey -- | ED25519 secret cryptographic key. data SecretKey -- | ED25519 cryptographic signature. newtype Signature Signature :: Signature -> Signature [unSignature] :: Signature -> Signature -- | b58check of a public key. newtype KeyHash KeyHash :: ByteString -> KeyHash [unKeyHash] :: KeyHash -> ByteString -- | Deterministicaly generate a secret key from seed. detSecretKey :: ByteString -> SecretKey -- | Create a public key from a secret key. toPublic :: SecretKey -> PublicKey -- | Error that can happen during parsing of cryptographic primitive types. data CryptoParseError CryptoParseWrongBase58Check :: CryptoParseError CryptoParseWrongTag :: !ByteString -> CryptoParseError CryptoParseCryptoError :: CryptoError -> CryptoParseError formatPublicKey :: PublicKey -> Text mformatPublicKey :: PublicKey -> MText parsePublicKey :: Text -> Either CryptoParseError PublicKey mkPublicKey :: ByteArrayAccess ba => ba -> Either Text PublicKey formatSecretKey :: SecretKey -> Text parseSecretKey :: Text -> Either CryptoParseError SecretKey formatSignature :: Signature -> Text mformatSignature :: Signature -> MText parseSignature :: Text -> Either CryptoParseError Signature mkSignature :: ByteArrayAccess ba => ba -> Either Text Signature formatKeyHash :: KeyHash -> Text mformatKeyHash :: KeyHash -> MText parseKeyHash :: Text -> Either CryptoParseError KeyHash -- | Sign a message using the secret key. sign :: SecretKey -> ByteString -> Signature -- | Check that a sequence of bytes has been signed with a given key. checkSignature :: PublicKey -> Signature -> ByteString -> Bool -- | Compute the b58check of a public key hash. hashKey :: PublicKey -> KeyHash -- | Compute a cryptographic hash of a bytestring using the Blake2b_256 -- cryptographic hash function. It's used by the BLAKE2B instruction in -- Michelson. blake2b :: ByteString -> ByteString -- | Compute a cryptographic hash of a bytestring using the Blake2b_160 -- cryptographic hash function. blake2b160 :: ByteString -> ByteString -- | Compute a cryptographic hash of a bytestring using the Sha256 -- cryptographic hash function. sha256 :: ByteString -> ByteString -- | Compute a cryptographic hash of a bytestring using the Sha512 -- cryptographic hash function. sha512 :: ByteString -> ByteString -- | Encode a bytestring in Base58Check format. encodeBase58Check :: ByteString -> Text -- | Decode a bytestring from Base58Check format. decodeBase58Check :: Text -> Maybe ByteString data B58CheckWithPrefixError B58CheckWithPrefixWrongPrefix :: ByteString -> B58CheckWithPrefixError B58CheckWithPrefixWrongEncoding :: B58CheckWithPrefixError -- | Parse a base58check encoded value expecting some prefix. If the actual -- prefix matches the expected one, it's stripped of and the resulting -- payload is returned. decodeBase58CheckWithPrefix :: ByteString -> Text -> Either B58CheckWithPrefixError ByteString instance GHC.Show.Show Tezos.Crypto.B58CheckWithPrefixError instance GHC.Classes.Eq Tezos.Crypto.CryptoParseError instance GHC.Show.Show Tezos.Crypto.CryptoParseError instance GHC.Classes.Ord Tezos.Crypto.KeyHash instance GHC.Classes.Eq Tezos.Crypto.KeyHash instance GHC.Show.Show Tezos.Crypto.KeyHash instance GHC.Classes.Eq Tezos.Crypto.Signature instance GHC.Show.Show Tezos.Crypto.Signature instance GHC.Classes.Eq Tezos.Crypto.SecretKey instance GHC.Show.Show Tezos.Crypto.SecretKey instance GHC.Classes.Eq Tezos.Crypto.PublicKey instance GHC.Show.Show Tezos.Crypto.PublicKey instance Formatting.Buildable.Buildable Tezos.Crypto.CryptoParseError instance Test.QuickCheck.Arbitrary.Arbitrary Tezos.Crypto.KeyHash instance Formatting.Buildable.Buildable Tezos.Crypto.KeyHash instance Data.Aeson.Types.ToJSON.ToJSON Tezos.Crypto.KeyHash instance Data.Aeson.Types.FromJSON.FromJSON Tezos.Crypto.KeyHash instance Test.QuickCheck.Arbitrary.Arbitrary Tezos.Crypto.Signature instance Formatting.Buildable.Buildable Tezos.Crypto.Signature instance Data.Aeson.Types.ToJSON.ToJSON Tezos.Crypto.Signature instance Data.Aeson.Types.FromJSON.FromJSON Tezos.Crypto.Signature instance Test.QuickCheck.Arbitrary.Arbitrary Tezos.Crypto.SecretKey instance Formatting.Buildable.Buildable Tezos.Crypto.SecretKey instance Test.QuickCheck.Arbitrary.Arbitrary Tezos.Crypto.PublicKey instance Formatting.Buildable.Buildable Tezos.Crypto.PublicKey instance Data.Aeson.Types.ToJSON.ToJSON Tezos.Crypto.PublicKey instance Data.Aeson.Types.FromJSON.FromJSON Tezos.Crypto.PublicKey -- | Address in Tezos. module Tezos.Address -- | Data type corresponding to address structure in Tezos. data Address -- | tz address which is a hash of a public key. KeyAddress :: !KeyHash -> Address -- | KT address which corresponds to a callable contract. It's a -- hash of origination command. TODO: we should probably have a -- Hash type. ContractAddress :: !ByteString -> Address -- | Smart constructor for KeyAddress. mkKeyAddress :: PublicKey -> Address -- | Smart constructor for ContractAddress. Its argument is -- serialized origination operation. -- -- Note: it's quite unsafe to pass ByteString, because we can pass -- some garbage which is not a serialized origination operation, but this -- operation includes contract itself and necessary types are defined in -- *. So we have to serialize this data outside this module and -- pass it here as a ByteString. Alternatively we could add some -- constraint, but it would be almost as unsafe as passing a -- ByteString. For this reason we add Raw suffix to this -- function and provide a safer function in Instr. We may -- reconsider it later. mkContractAddressRaw :: ByteString -> Address formatAddress :: Address -> Text mformatAddress :: Address -> MText -- | Parse an address from its human-readable textual representation used -- by Tezos (e. g. "tz1faswCTDciRzE4oJ9jn2Vm2dvjeyA9fUzU"). Or fail if -- it's invalid. parseAddress :: Text -> Either ParseAddressError Address -- | Partial version of parseAddress which assumes that the address -- is correct. Can be used in tests. unsafeParseAddress :: HasCallStack => Text -> Address instance GHC.Classes.Eq Tezos.Address.ParseAddressError instance GHC.Show.Show Tezos.Address.ParseAddressError instance GHC.Classes.Eq Tezos.Address.ParseContractAddressError instance GHC.Show.Show Tezos.Address.ParseContractAddressError instance GHC.Classes.Ord Tezos.Address.Address instance GHC.Classes.Eq Tezos.Address.Address instance GHC.Show.Show Tezos.Address.Address instance Formatting.Buildable.Buildable Tezos.Address.ParseAddressError instance Formatting.Buildable.Buildable Tezos.Address.ParseContractAddressError instance Formatting.Buildable.Buildable Tezos.Address.Address instance Data.Aeson.Types.ToJSON.ToJSON Tezos.Address.Address instance Data.Aeson.Types.ToJSON.ToJSONKey Tezos.Address.Address instance Data.Aeson.Types.FromJSON.FromJSON Tezos.Address.Address instance Data.Aeson.Types.FromJSON.FromJSONKey Tezos.Address.Address instance Test.QuickCheck.Arbitrary.Arbitrary Tezos.Address.Address -- | Michelson instructions in untyped model. module Michelson.Untyped.Instr -- | Michelson instruction with abstract parameter op. This -- parameter is necessary, because at different stages of our pipeline it -- will be different. Initially it can contain macros and non-flattened -- instructions, but then it contains only vanilla Michelson -- instructions. data InstrAbstract op EXT :: ExtInstrAbstract op -> InstrAbstract op DROP :: InstrAbstract op DUP :: VarAnn -> InstrAbstract op SWAP :: InstrAbstract op PUSH :: VarAnn -> Type -> Value' op -> InstrAbstract op SOME :: TypeAnn -> VarAnn -> FieldAnn -> InstrAbstract op NONE :: TypeAnn -> VarAnn -> FieldAnn -> Type -> InstrAbstract op UNIT :: TypeAnn -> VarAnn -> InstrAbstract op IF_NONE :: [op] -> [op] -> InstrAbstract op PAIR :: TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op CAR :: VarAnn -> FieldAnn -> InstrAbstract op CDR :: VarAnn -> FieldAnn -> InstrAbstract op LEFT :: TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> Type -> InstrAbstract op RIGHT :: TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> Type -> InstrAbstract op IF_LEFT :: [op] -> [op] -> InstrAbstract op NIL :: TypeAnn -> VarAnn -> Type -> InstrAbstract op CONS :: VarAnn -> InstrAbstract op IF_CONS :: [op] -> [op] -> InstrAbstract op SIZE :: VarAnn -> InstrAbstract op EMPTY_SET :: TypeAnn -> VarAnn -> Comparable -> InstrAbstract op EMPTY_MAP :: TypeAnn -> VarAnn -> Comparable -> Type -> InstrAbstract op MAP :: VarAnn -> [op] -> InstrAbstract op ITER :: [op] -> InstrAbstract op MEM :: VarAnn -> InstrAbstract op GET :: VarAnn -> InstrAbstract op UPDATE :: InstrAbstract op IF :: [op] -> [op] -> InstrAbstract op LOOP :: [op] -> InstrAbstract op LOOP_LEFT :: [op] -> InstrAbstract op LAMBDA :: VarAnn -> Type -> Type -> [op] -> InstrAbstract op EXEC :: VarAnn -> InstrAbstract op DIP :: [op] -> InstrAbstract op FAILWITH :: InstrAbstract op CAST :: VarAnn -> Type -> InstrAbstract op RENAME :: VarAnn -> InstrAbstract op PACK :: VarAnn -> InstrAbstract op UNPACK :: VarAnn -> Type -> InstrAbstract op CONCAT :: VarAnn -> InstrAbstract op SLICE :: VarAnn -> InstrAbstract op ISNAT :: VarAnn -> InstrAbstract op ADD :: VarAnn -> InstrAbstract op SUB :: VarAnn -> InstrAbstract op MUL :: VarAnn -> InstrAbstract op EDIV :: VarAnn -> InstrAbstract op ABS :: VarAnn -> InstrAbstract op NEG :: InstrAbstract op LSL :: VarAnn -> InstrAbstract op LSR :: VarAnn -> InstrAbstract op OR :: VarAnn -> InstrAbstract op AND :: VarAnn -> InstrAbstract op XOR :: VarAnn -> InstrAbstract op NOT :: VarAnn -> InstrAbstract op COMPARE :: VarAnn -> InstrAbstract op EQ :: VarAnn -> InstrAbstract op NEQ :: VarAnn -> InstrAbstract op LT :: VarAnn -> InstrAbstract op GT :: VarAnn -> InstrAbstract op LE :: VarAnn -> InstrAbstract op GE :: VarAnn -> InstrAbstract op INT :: VarAnn -> InstrAbstract op SELF :: VarAnn -> InstrAbstract op CONTRACT :: VarAnn -> Type -> InstrAbstract op TRANSFER_TOKENS :: VarAnn -> InstrAbstract op SET_DELEGATE :: VarAnn -> InstrAbstract op CREATE_ACCOUNT :: VarAnn -> VarAnn -> InstrAbstract op CREATE_CONTRACT :: VarAnn -> VarAnn -> Contract' op -> InstrAbstract op IMPLICIT_ACCOUNT :: VarAnn -> InstrAbstract op NOW :: VarAnn -> InstrAbstract op AMOUNT :: VarAnn -> InstrAbstract op BALANCE :: VarAnn -> InstrAbstract op CHECK_SIGNATURE :: VarAnn -> InstrAbstract op SHA256 :: VarAnn -> InstrAbstract op SHA512 :: VarAnn -> InstrAbstract op BLAKE2B :: VarAnn -> InstrAbstract op HASH_KEY :: VarAnn -> InstrAbstract op STEPS_TO_QUOTA :: VarAnn -> InstrAbstract op SOURCE :: VarAnn -> InstrAbstract op SENDER :: VarAnn -> InstrAbstract op ADDRESS :: VarAnn -> InstrAbstract op newtype Op Op :: Instr -> Op [unOp] :: Op -> Instr type Instr = InstrAbstract Op data ExpandedOp PrimEx :: ExpandedInstr -> ExpandedOp SeqEx :: [ExpandedOp] -> ExpandedOp WithSrcEx :: InstrCallStack -> ExpandedOp -> ExpandedOp type ExpandedInstr = InstrAbstract ExpandedOp type InstrExtU = ExtInstrAbstract Op type ExpandedInstrExtU = ExtInstrAbstract ExpandedOp -- | Flatten all SeqEx in ExpandedOp. This function is mostly -- for testing. It returns instructions with the same logic, but they are -- not strictly equivalent, because they are serialized differently -- (grouping instructions into sequences affects the way they are -- PACK'ed). -- -- Note: it does not return a list of Instr because this type is -- not used anywhere and should probably be removed. flattenExpandedOp :: ExpandedOp -> [ExpandedInstr] -- | Data necessary to originate a contract. data OriginationOperation OriginationOperation :: !KeyHash -> !Maybe KeyHash -> !Bool -> !Bool -> !Mutez -> !Value' ExpandedOp -> !Contract' ExpandedOp -> OriginationOperation -- | Manager of the contract. [ooManager] :: OriginationOperation -> !KeyHash -- | Optional delegate. [ooDelegate] :: OriginationOperation -> !Maybe KeyHash -- | Whether the contract is spendable. [ooSpendable] :: OriginationOperation -> !Bool -- | Whether the contract is delegatable. [ooDelegatable] :: OriginationOperation -> !Bool -- | Initial balance of the contract. [ooBalance] :: OriginationOperation -> !Mutez -- | Initial storage value of the contract. [ooStorage] :: OriginationOperation -> !Value' ExpandedOp -- | The contract itself. [ooContract] :: OriginationOperation -> !Contract' ExpandedOp -- | Compute address of a contract from its origination operation. -- -- TODO [TM-62] It's certainly imprecise, real Tezos implementation -- doesn't use JSON, but we don't need precise format yet, so we just use -- some serialization format (JSON because we have necessary instances -- already). mkContractAddress :: OriginationOperation -> Address instance GHC.Generics.Generic Michelson.Untyped.Instr.OriginationOperation instance GHC.Show.Show Michelson.Untyped.Instr.OriginationOperation instance Formatting.Buildable.Buildable Michelson.Untyped.Instr.Op instance Michelson.Printer.Util.RenderDoc Michelson.Untyped.Instr.Op instance GHC.Generics.Generic Michelson.Untyped.Instr.Op instance GHC.Classes.Eq Michelson.Untyped.Instr.Op instance GHC.Show.Show Michelson.Untyped.Instr.Op instance GHC.Generics.Generic Michelson.Untyped.Instr.ExpandedOp instance Data.Data.Data Michelson.Untyped.Instr.ExpandedOp instance GHC.Classes.Eq Michelson.Untyped.Instr.ExpandedOp instance GHC.Show.Show Michelson.Untyped.Instr.ExpandedOp instance GHC.Generics.Generic (Michelson.Untyped.Instr.InstrAbstract op) instance Data.Data.Data op => Data.Data.Data (Michelson.Untyped.Instr.InstrAbstract op) instance GHC.Base.Functor Michelson.Untyped.Instr.InstrAbstract instance GHC.Show.Show op => GHC.Show.Show (Michelson.Untyped.Instr.InstrAbstract op) instance GHC.Classes.Eq op => GHC.Classes.Eq (Michelson.Untyped.Instr.InstrAbstract op) instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Untyped.Instr.OriginationOperation instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Untyped.Instr.OriginationOperation instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Untyped.Instr.Op instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Untyped.Instr.Op instance Michelson.Printer.Util.RenderDoc Michelson.Untyped.Instr.ExpandedOp instance Formatting.Buildable.Buildable Michelson.Untyped.Instr.ExpandedOp instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Untyped.Instr.ExpandedOp instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Untyped.Instr.ExpandedOp instance Michelson.Printer.Util.RenderDoc op => Michelson.Printer.Util.RenderDoc (Michelson.Untyped.Instr.InstrAbstract op) instance (Michelson.Printer.Util.RenderDoc op, Formatting.Buildable.Buildable op) => Formatting.Buildable.Buildable (Michelson.Untyped.Instr.InstrAbstract op) instance Data.Aeson.Types.ToJSON.ToJSON op => Data.Aeson.Types.ToJSON.ToJSON (Michelson.Untyped.Instr.InstrAbstract op) instance Data.Aeson.Types.FromJSON.FromJSON op => Data.Aeson.Types.FromJSON.FromJSON (Michelson.Untyped.Instr.InstrAbstract op) -- | Some simple aliases for Michelson types. module Michelson.Untyped.Aliases type Contract = Contract' ExpandedOp type Value = Value' ExpandedOp type ExpandedExtInstr = ExtInstrAbstract ExpandedOp module Michelson.Untyped module Michelson.Typed.Extract data TypeConvergeError TypeConvergeError :: T -> T -> TypeConvergeError TParameterConvergeError :: TypeConvergeError TStorageConvergeError :: TypeConvergeError -- | Extracts Notes t type from Type and corresponding -- singleton. extractNotes :: Type -> Sing t -> Either TypeConvergeError (Notes t) -- | Extracts T type from Type. fromUType :: HasCallStack => Type -> T mkUType :: Sing x -> Notes x -> Type -- | Converts from T to Type. toUType :: T -> Type instance GHC.Classes.Eq Michelson.Typed.Extract.TypeConvergeError instance GHC.Show.Show Michelson.Typed.Extract.TypeConvergeError instance Formatting.Buildable.Buildable Michelson.Typed.Extract.TypeConvergeError -- | Types printing. -- -- Moved in a separate module, because we print via converting to untyped -- T type to avoid duplication. module Michelson.Typed.Print -- | Format type stack in a pretty way. buildStack :: [T] -> Builder instance Formatting.Buildable.Buildable Michelson.Typed.T.T -- | Module, containing CValue data type which represents Michelson -- comparable values. module Michelson.Typed.CValue -- | Representation of comparable value in Michelson language. -- -- By specification, we're allowed to compare only following types: int, -- nat, string, bytes, mutez, bool, key_hash, timestamp, address. -- -- Only these values can be used as map keys or set elements. data CValue t [CvInt] :: Integer -> CValue 'CInt [CvNat] :: Natural -> CValue 'CNat [CvString] :: MText -> CValue 'CString [CvBytes] :: ByteString -> CValue 'CBytes [CvMutez] :: Mutez -> CValue 'CMutez [CvBool] :: Bool -> CValue 'CBool [CvKeyHash] :: KeyHash -> CValue 'CKeyHash [CvTimestamp] :: Timestamp -> CValue 'CTimestamp [CvAddress] :: Address -> CValue 'CAddress instance GHC.Show.Show (Michelson.Typed.CValue.CValue t) instance GHC.Classes.Eq (Michelson.Typed.CValue.CValue t) instance GHC.Classes.Ord (Michelson.Typed.CValue.CValue t) -- | Module, containing data types for Michelson value. module Michelson.Typed.Value -- | Representation of Michelson value. -- -- Type parameter instr stands for Michelson instruction type, -- i.e. data type to represent an instruction of language. data Value' instr t [VC] :: CValue t -> Value' instr ( 'Tc t) [VKey] :: PublicKey -> Value' instr 'TKey [VUnit] :: Value' instr 'TUnit [VSignature] :: Signature -> Value' instr 'TSignature [VOption] :: forall t instr. Maybe (Value' instr t) -> Value' instr ( 'TOption t) [VList] :: forall t instr. [Value' instr t] -> Value' instr ( 'TList t) [VSet] :: forall t instr. Set (CValue t) -> Value' instr ( 'TSet t) [VOp] :: Operation' instr -> Value' instr 'TOperation [VContract] :: forall p instr. Address -> Value' instr ( 'TContract p) [VPair] :: forall l r instr. (Value' instr l, Value' instr r) -> Value' instr ( 'TPair l r) [VOr] :: forall l r instr. Either (Value' instr l) (Value' instr r) -> Value' instr ( 'TOr l r) [VLam] :: forall inp out instr. (Show (instr '[inp] '[out]), Eq (instr '[inp] '[out])) => instr (inp : '[]) (out : '[]) -> Value' instr ( 'TLambda inp out) [VMap] :: forall k v instr. Map (CValue k) (Value' instr v) -> Value' instr ( 'TMap k v) [VBigMap] :: forall k v instr. Map (CValue k) (Value' instr v) -> Value' instr ( 'TBigMap k v) type ContractInp1 param st = 'TPair param st type ContractInp param st = '[ContractInp1 param st] type ContractOut1 st = 'TPair ( 'TList 'TOperation) st type ContractOut st = '[ContractOut1 st] data CreateAccount CreateAccount :: !KeyHash -> !Maybe KeyHash -> !Bool -> !Mutez -> CreateAccount [caManager] :: CreateAccount -> !KeyHash [caDelegate] :: CreateAccount -> !Maybe KeyHash [caSpendable] :: CreateAccount -> !Bool [caBalance] :: CreateAccount -> !Mutez data CreateContract instr cp st CreateContract :: !KeyHash -> !Maybe KeyHash -> !Bool -> !Bool -> !Mutez -> !Value' instr st -> !instr (ContractInp cp st) (ContractOut st) -> CreateContract instr cp st [ccManager] :: CreateContract instr cp st -> !KeyHash [ccDelegate] :: CreateContract instr cp st -> !Maybe KeyHash [ccSpendable] :: CreateContract instr cp st -> !Bool [ccDelegatable] :: CreateContract instr cp st -> !Bool [ccBalance] :: CreateContract instr cp st -> !Mutez [ccStorageVal] :: CreateContract instr cp st -> !Value' instr st [ccContractCode] :: CreateContract instr cp st -> !instr (ContractInp cp st) (ContractOut st) -- | Representation of comparable value in Michelson language. -- -- By specification, we're allowed to compare only following types: int, -- nat, string, bytes, mutez, bool, key_hash, timestamp, address. -- -- Only these values can be used as map keys or set elements. data CValue t [CvInt] :: Integer -> CValue 'CInt [CvNat] :: Natural -> CValue 'CNat [CvString] :: MText -> CValue 'CString [CvBytes] :: ByteString -> CValue 'CBytes [CvMutez] :: Mutez -> CValue 'CMutez [CvBool] :: Bool -> CValue 'CBool [CvKeyHash] :: KeyHash -> CValue 'CKeyHash [CvTimestamp] :: Timestamp -> CValue 'CTimestamp [CvAddress] :: Address -> CValue 'CAddress -- | Data type, representing operation, list of which is returned by -- Michelson contract (according to calling convention). -- -- These operations are to be further executed against system state after -- the contract execution. data Operation' instr [OpTransferTokens] :: (Typeable p, SingI p, HasNoOp p) => TransferTokens instr p -> Operation' instr [OpSetDelegate] :: SetDelegate -> Operation' instr [OpCreateAccount] :: CreateAccount -> Operation' instr [OpCreateContract] :: (Show (instr (ContractInp cp st) (ContractOut st)), SingI cp, SingI st, Typeable instr, Typeable cp, Typeable st, HasNoOp cp, HasNoOp st) => CreateContract instr cp st -> Operation' instr data SetDelegate SetDelegate :: !Maybe KeyHash -> SetDelegate [sdMbKeyHash] :: SetDelegate -> !Maybe KeyHash data TransferTokens instr p TransferTokens :: !Value' instr p -> !Mutez -> !Value' instr ( 'TContract p) -> TransferTokens instr p [ttContractParameter] :: TransferTokens instr p -> !Value' instr p [ttAmount] :: TransferTokens instr p -> !Mutez [ttContract] :: TransferTokens instr p -> !Value' instr ( 'TContract p) instance GHC.Classes.Eq (Michelson.Typed.Value.TransferTokens instr p) instance GHC.Show.Show (Michelson.Typed.Value.TransferTokens instr p) instance GHC.Classes.Eq Michelson.Typed.Value.CreateAccount instance GHC.Show.Show Michelson.Typed.Value.CreateAccount instance GHC.Classes.Eq Michelson.Typed.Value.SetDelegate instance GHC.Show.Show Michelson.Typed.Value.SetDelegate instance GHC.Show.Show (Michelson.Typed.Value.Operation' instr) instance GHC.Show.Show (Michelson.Typed.Value.CreateContract instr cp st) instance GHC.Classes.Eq (Michelson.Typed.Value.CreateContract instr cp st) instance GHC.Show.Show (Michelson.Typed.Value.Value' instr t) instance GHC.Classes.Eq (Michelson.Typed.Value.Value' instr t) instance Formatting.Buildable.Buildable (Michelson.Typed.Value.Operation' instr) instance GHC.Classes.Eq (Michelson.Typed.Value.Operation' instr) instance Formatting.Buildable.Buildable (Michelson.Typed.Value.TransferTokens instr p) instance Formatting.Buildable.Buildable (Michelson.Typed.Value.CreateContract instr cp st) instance Formatting.Buildable.Buildable Michelson.Typed.Value.CreateAccount instance Formatting.Buildable.Buildable Michelson.Typed.Value.SetDelegate -- | Module, containing type classes for operating with Michelson values in -- the context of polymorphic stack type operations. module Michelson.Typed.Polymorphic class EDivOp (n :: CT) (m :: CT) where { type family EDivOpRes n m :: CT; type family EModOpRes n m :: CT; } evalEDivOp :: EDivOp n m => CValue n -> CValue m -> Value' instr ( 'TOption ( 'TPair ( 'Tc (EDivOpRes n m)) ( 'Tc (EModOpRes n m)))) class MemOp (c :: T) where { type family MemOpKey c :: CT; } evalMem :: MemOp c => CValue (MemOpKey c) -> Value' cp c -> Bool class MapOp (c :: T) where { type family MapOpInp c :: T; type family MapOpRes c :: T -> T; } mapOpToList :: MapOp c => Value' instr c -> [Value' instr (MapOpInp c)] mapOpFromList :: MapOp c => Value' instr c -> [Value' instr b] -> Value' instr (MapOpRes c b) class IterOp (c :: T) where { type family IterOpEl c :: T; } iterOpDetachOne :: IterOp c => Value' instr c -> (Maybe (Value' instr (IterOpEl c)), Value' instr c) class SizeOp (c :: T) evalSize :: SizeOp c => Value' cp c -> Int class GetOp (c :: T) where { type family GetOpKey c :: CT; type family GetOpVal c :: T; } evalGet :: GetOp c => CValue (GetOpKey c) -> Value' cp c -> Maybe (Value' cp (GetOpVal c)) class UpdOp (c :: T) where { type family UpdOpKey c :: CT; type family UpdOpParams c :: T; } evalUpd :: UpdOp c => CValue (UpdOpKey c) -> Value' cp (UpdOpParams c) -> Value' cp c -> Value' cp c class SliceOp (c :: T) evalSlice :: SliceOp c => Natural -> Natural -> Value' cp c -> Maybe (Value' cp c) class ConcatOp (c :: T) evalConcat :: ConcatOp c => Value' cp c -> Value' cp c -> Value' cp c evalConcat' :: ConcatOp c => [Value' cp c] -> Value' cp c instance Michelson.Typed.Polymorphic.EDivOp 'Michelson.Untyped.Type.CInt 'Michelson.Untyped.Type.CInt instance Michelson.Typed.Polymorphic.EDivOp 'Michelson.Untyped.Type.CInt 'Michelson.Untyped.Type.CNat instance Michelson.Typed.Polymorphic.EDivOp 'Michelson.Untyped.Type.CNat 'Michelson.Untyped.Type.CInt instance Michelson.Typed.Polymorphic.EDivOp 'Michelson.Untyped.Type.CNat 'Michelson.Untyped.Type.CNat instance Michelson.Typed.Polymorphic.EDivOp 'Michelson.Untyped.Type.CMutez 'Michelson.Untyped.Type.CMutez instance Michelson.Typed.Polymorphic.EDivOp 'Michelson.Untyped.Type.CMutez 'Michelson.Untyped.Type.CNat instance Michelson.Typed.Polymorphic.SliceOp ('Michelson.Typed.T.Tc 'Michelson.Untyped.Type.CString) instance Michelson.Typed.Polymorphic.SliceOp ('Michelson.Typed.T.Tc 'Michelson.Untyped.Type.CBytes) instance Michelson.Typed.Polymorphic.ConcatOp ('Michelson.Typed.T.Tc 'Michelson.Untyped.Type.CString) instance Michelson.Typed.Polymorphic.ConcatOp ('Michelson.Typed.T.Tc 'Michelson.Untyped.Type.CBytes) instance Michelson.Typed.Polymorphic.GetOp ('Michelson.Typed.T.TBigMap k v) instance Michelson.Typed.Polymorphic.GetOp ('Michelson.Typed.T.TMap k v) instance Michelson.Typed.Polymorphic.UpdOp ('Michelson.Typed.T.TMap k v) instance Michelson.Typed.Polymorphic.UpdOp ('Michelson.Typed.T.TBigMap k v) instance Michelson.Typed.Polymorphic.UpdOp ('Michelson.Typed.T.TSet a) instance Michelson.Typed.Polymorphic.SizeOp ('Michelson.Typed.T.Tc 'Michelson.Untyped.Type.CString) instance Michelson.Typed.Polymorphic.SizeOp ('Michelson.Typed.T.Tc 'Michelson.Untyped.Type.CBytes) instance Michelson.Typed.Polymorphic.SizeOp ('Michelson.Typed.T.TSet a) instance Michelson.Typed.Polymorphic.SizeOp ('Michelson.Typed.T.TList a) instance Michelson.Typed.Polymorphic.SizeOp ('Michelson.Typed.T.TMap k v) instance Michelson.Typed.Polymorphic.IterOp ('Michelson.Typed.T.TMap k v) instance Michelson.Typed.Polymorphic.IterOp ('Michelson.Typed.T.TList e) instance Michelson.Typed.Polymorphic.IterOp ('Michelson.Typed.T.TSet e) instance Michelson.Typed.Polymorphic.MapOp ('Michelson.Typed.T.TMap k v) instance Michelson.Typed.Polymorphic.MapOp ('Michelson.Typed.T.TList e) instance Michelson.Typed.Polymorphic.MemOp ('Michelson.Typed.T.TSet e) instance Michelson.Typed.Polymorphic.MemOp ('Michelson.Typed.T.TMap k v) instance Michelson.Typed.Polymorphic.MemOp ('Michelson.Typed.T.TBigMap k v) -- | Module, containing some boilerplate for support of arithmetic -- operations in Michelson language. module Michelson.Typed.Arith -- | Class for binary arithmetic operation. -- -- Takes binary operation marker as op parameter, types of left -- operand n and right operand m. class ArithOp aop (n :: CT) (m :: CT) where { -- | Type family ArithRes denotes the type resulting from -- computing operation op from operands of types n and -- m. -- -- For instance, adding integer to natural produces integer, which is -- reflected in following instance of type family: ArithRes Add CNat -- CInt = CInt. type family ArithRes aop n m :: CT; } -- | Evaluate arithmetic operation on given operands. evalOp :: ArithOp aop n m => proxy aop -> CValue n -> CValue m -> Either (ArithError (CValue n) (CValue m)) (CValue (ArithRes aop n m)) -- | Marker data type for add operation. class UnaryArithOp aop (n :: CT) where { type family UnaryArithRes aop n :: CT; } evalUnaryArithOp :: UnaryArithOp aop n => proxy aop -> CValue n -> CValue (UnaryArithRes aop n) -- | Represents an arithmetic error of the operation. data ArithError n m MutezArithError :: ArithErrorType -> n -> m -> ArithError n m ShiftArithError :: ArithErrorType -> n -> m -> ArithError n m -- | Denotes the error type occured in the arithmetic operation. data ArithErrorType AddOverflow :: ArithErrorType MulOverflow :: ArithErrorType SubUnderflow :: ArithErrorType LslOverflow :: ArithErrorType LsrUnderflow :: ArithErrorType data Add data Sub data Mul data Abs data Neg data Or data And data Xor data Not data Lsl data Lsr data Compare data Eq' data Neq data Lt data Gt data Le data Ge instance (GHC.Classes.Ord n, GHC.Classes.Ord m) => GHC.Classes.Ord (Michelson.Typed.Arith.ArithError n m) instance (GHC.Classes.Eq n, GHC.Classes.Eq m) => GHC.Classes.Eq (Michelson.Typed.Arith.ArithError n m) instance (GHC.Show.Show n, GHC.Show.Show m) => GHC.Show.Show (Michelson.Typed.Arith.ArithError n m) instance GHC.Classes.Ord Michelson.Typed.Arith.ArithErrorType instance GHC.Classes.Eq Michelson.Typed.Arith.ArithErrorType instance GHC.Show.Show Michelson.Typed.Arith.ArithErrorType instance Michelson.Typed.Arith.UnaryArithOp Michelson.Typed.Arith.Ge 'Michelson.Untyped.Type.CInt instance Michelson.Typed.Arith.UnaryArithOp Michelson.Typed.Arith.Le 'Michelson.Untyped.Type.CInt instance Michelson.Typed.Arith.UnaryArithOp Michelson.Typed.Arith.Gt 'Michelson.Untyped.Type.CInt instance Michelson.Typed.Arith.UnaryArithOp Michelson.Typed.Arith.Lt 'Michelson.Untyped.Type.CInt instance Michelson.Typed.Arith.UnaryArithOp Michelson.Typed.Arith.Neq 'Michelson.Untyped.Type.CInt instance Michelson.Typed.Arith.UnaryArithOp Michelson.Typed.Arith.Eq' 'Michelson.Untyped.Type.CInt instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Compare 'Michelson.Untyped.Type.CBool 'Michelson.Untyped.Type.CBool instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Compare 'Michelson.Untyped.Type.CAddress 'Michelson.Untyped.Type.CAddress instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Compare 'Michelson.Untyped.Type.CNat 'Michelson.Untyped.Type.CNat instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Compare 'Michelson.Untyped.Type.CInt 'Michelson.Untyped.Type.CInt instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Compare 'Michelson.Untyped.Type.CString 'Michelson.Untyped.Type.CString instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Compare 'Michelson.Untyped.Type.CBytes 'Michelson.Untyped.Type.CBytes instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Compare 'Michelson.Untyped.Type.CTimestamp 'Michelson.Untyped.Type.CTimestamp instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Compare 'Michelson.Untyped.Type.CMutez 'Michelson.Untyped.Type.CMutez instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Compare 'Michelson.Untyped.Type.CKeyHash 'Michelson.Untyped.Type.CKeyHash instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Lsr 'Michelson.Untyped.Type.CNat 'Michelson.Untyped.Type.CNat instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Lsl 'Michelson.Untyped.Type.CNat 'Michelson.Untyped.Type.CNat instance Michelson.Typed.Arith.UnaryArithOp Michelson.Typed.Arith.Not 'Michelson.Untyped.Type.CInt instance Michelson.Typed.Arith.UnaryArithOp Michelson.Typed.Arith.Not 'Michelson.Untyped.Type.CNat instance Michelson.Typed.Arith.UnaryArithOp Michelson.Typed.Arith.Not 'Michelson.Untyped.Type.CBool instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Xor 'Michelson.Untyped.Type.CNat 'Michelson.Untyped.Type.CNat instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Xor 'Michelson.Untyped.Type.CBool 'Michelson.Untyped.Type.CBool instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.And 'Michelson.Untyped.Type.CInt 'Michelson.Untyped.Type.CNat instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.And 'Michelson.Untyped.Type.CNat 'Michelson.Untyped.Type.CNat instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.And 'Michelson.Untyped.Type.CBool 'Michelson.Untyped.Type.CBool instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Or 'Michelson.Untyped.Type.CNat 'Michelson.Untyped.Type.CNat instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Or 'Michelson.Untyped.Type.CBool 'Michelson.Untyped.Type.CBool instance Michelson.Typed.Arith.UnaryArithOp Michelson.Typed.Arith.Neg 'Michelson.Untyped.Type.CInt instance Michelson.Typed.Arith.UnaryArithOp Michelson.Typed.Arith.Neg 'Michelson.Untyped.Type.CNat instance Michelson.Typed.Arith.UnaryArithOp Michelson.Typed.Arith.Abs 'Michelson.Untyped.Type.CInt instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Mul 'Michelson.Untyped.Type.CNat 'Michelson.Untyped.Type.CInt instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Mul 'Michelson.Untyped.Type.CInt 'Michelson.Untyped.Type.CNat instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Mul 'Michelson.Untyped.Type.CNat 'Michelson.Untyped.Type.CNat instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Mul 'Michelson.Untyped.Type.CInt 'Michelson.Untyped.Type.CInt instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Mul 'Michelson.Untyped.Type.CNat 'Michelson.Untyped.Type.CMutez instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Mul 'Michelson.Untyped.Type.CMutez 'Michelson.Untyped.Type.CNat instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Sub 'Michelson.Untyped.Type.CNat 'Michelson.Untyped.Type.CInt instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Sub 'Michelson.Untyped.Type.CInt 'Michelson.Untyped.Type.CNat instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Sub 'Michelson.Untyped.Type.CNat 'Michelson.Untyped.Type.CNat instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Sub 'Michelson.Untyped.Type.CInt 'Michelson.Untyped.Type.CInt instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Sub 'Michelson.Untyped.Type.CTimestamp 'Michelson.Untyped.Type.CInt instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Sub 'Michelson.Untyped.Type.CTimestamp 'Michelson.Untyped.Type.CTimestamp instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Sub 'Michelson.Untyped.Type.CMutez 'Michelson.Untyped.Type.CMutez instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Add 'Michelson.Untyped.Type.CNat 'Michelson.Untyped.Type.CInt instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Add 'Michelson.Untyped.Type.CInt 'Michelson.Untyped.Type.CNat instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Add 'Michelson.Untyped.Type.CNat 'Michelson.Untyped.Type.CNat instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Add 'Michelson.Untyped.Type.CInt 'Michelson.Untyped.Type.CInt instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Add 'Michelson.Untyped.Type.CTimestamp 'Michelson.Untyped.Type.CInt instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Add 'Michelson.Untyped.Type.CInt 'Michelson.Untyped.Type.CTimestamp instance Michelson.Typed.Arith.ArithOp Michelson.Typed.Arith.Add 'Michelson.Untyped.Type.CMutez 'Michelson.Untyped.Type.CMutez instance (GHC.Show.Show n, GHC.Show.Show m) => Formatting.Buildable.Buildable (Michelson.Typed.Arith.ArithError n m) instance Formatting.Buildable.Buildable Michelson.Typed.Arith.ArithErrorType -- | Utilities related to Alternative. module Util.Alternative -- | This function is the same as some except that it returns -- NonEmpty, because some is guaranteed to return non-empty -- list, but it's not captured in types. someNE :: Alternative f => f a -> f (NonEmpty a) module Util.Default permute2Def :: (Default a, Default b, Monad f, Alternative f) => f a -> f b -> f (a, b) permute3Def :: (Default a, Default b, Default c, Monad f, Alternative f) => f a -> f b -> f c -> f (a, b, c) -- | A class for types with a default value. class Default a -- | The default value for this type. def :: Default a => a -- | Generic-related utils. module Util.Generic -- | Rebuild a list into a binary tree of exactly the same form which -- Generic uses to represent datatypes. -- -- Along with the original list you have to provide constructor for -- intermediate nodes - it accepts zero-based index of the leftmost -- element of the right tree and merged trees themselves. mkGenericTree :: (Int -> a -> a -> a) -> NonEmpty a -> a mkGenericTreeVec :: HasCallStack => (a -> b) -> (Int -> b -> b -> b) -> Vector a -> b module Util.IO readFileUtf8 :: FilePath -> IO Text writeFileUtf8 :: Print text => FilePath -> text -> IO () withEncoding :: Handle -> TextEncoding -> IO () -> IO () -- | Change the character encoding of the given Handle to transliterate on -- unsupported characters instead of throwing an exception. hSetTranslit :: Handle -> IO () -- | Missing instances from libraries. module Util.Instances instance Data.Default.Class.Default GHC.Natural.Natural instance Formatting.Buildable.Buildable GHC.Natural.Natural module Util.Lens -- | For datatype with "myNyan" field it will create "myNyanL" lens. postfixLFields :: LensRules -- | TxData type and associated functionality. module Michelson.Runtime.TxData -- | Data associated with a particular transaction. data TxData TxData :: !Address -> !Value -> !Mutez -> TxData [tdSenderAddress] :: TxData -> !Address [tdParameter] :: TxData -> !Value [tdAmount] :: TxData -> !Mutez tdSenderAddressL :: Lens' TxData Address tdParameterL :: Lens' TxData Value tdAmountL :: Lens' TxData Mutez instance GHC.Classes.Eq Michelson.Runtime.TxData.TxData instance GHC.Show.Show Michelson.Runtime.TxData.TxData -- | Additional functionality for named package. module Util.Named (.!) :: Name name -> a -> NamedF Identity a name (.?) :: Name name -> Maybe a -> NamedF Maybe a name (<.!>) :: Functor m => Name name -> m a -> m (NamedF Identity a name) (<.?>) :: Functor m => Name name -> m (Maybe a) -> m (NamedF Maybe a name) type family NamedInner n instance GHC.Classes.Eq a => GHC.Classes.Eq (Named.Internal.NamedF Data.Functor.Identity.Identity a name) instance Control.Lens.Wrapped.Wrapped (Named.Internal.NamedF Data.Functor.Identity.Identity a name) instance Control.Lens.Wrapped.Wrapped (Named.Internal.NamedF GHC.Maybe.Maybe a name) instance (GHC.Show.Show a, GHC.TypeLits.KnownSymbol name) => GHC.Show.Show (Named.Internal.NamedF Data.Functor.Identity.Identity a name) -- | Type-nat utilities. -- -- We take Peano numbers as base for operations because they make it much -- easer to prove things to compiler. Their performance does not seem to -- introduce a problem, because we use nats primarily along with stack -- which is a linked list with similar performance characteristics. -- -- Many of things we introduce here are covered in type-natural -- package, but unfortunatelly it does not work with GHC 8.6 at the -- moment of writing this module. We use Vinyl as source of Peano -- Nat for now. module Util.Peano -- | A convenient alias. -- -- We are going to use Peano numbers for type-dependent logic and -- normal Nats in user API, need to distinguish them somehow. type Peano = Nat type family ToPeano (n :: Nat) :: Nat type family Length l class KnownPeano (n :: Nat) peanoVal :: KnownPeano n => proxy n -> Natural peanoVal' :: forall n. KnownPeano n => Natural -- | The singleton kind-indexed data family. data family Sing (a :: k) :: Type type family At (n :: Peano) s -- | Comparison of type-level naturals, as a function. -- -- It is as lazy on the list argument as possible - there is no need to -- know the whole list if the natural argument is small enough. This -- property is important if we want to be able to extract reusable parts -- of code which are aware only of relevant part of stack. type family IsLongerThan (l :: [k]) (a :: Nat) :: Bool -- | Comparison of type-level naturals, as a constraint. type LongerThan l a = IsLongerThan l a ~ 'True -- | Comparison of type-level naturals, raises human-readable compile error -- when does not hold. -- -- This is for in eDSL use only, GHC cannot reason about such constraint. type family RequireLongerThan (l :: [k]) (a :: Nat) :: Constraint -- | Derive LongerThan from RequireLongerThan. requiredLongerThan :: forall l a r. RequireLongerThan l a => (LongerThan l a => r) -> r instance GHC.Classes.Eq (Data.Singletons.Internal.Sing n) instance Util.Peano.KnownPeano 'Data.Vinyl.TypeLevel.Z instance Util.Peano.KnownPeano a => Util.Peano.KnownPeano ('Data.Vinyl.TypeLevel.S a) instance Data.Singletons.Internal.SingI 'Data.Vinyl.TypeLevel.Z instance Data.Singletons.Internal.SingI n => Data.Singletons.Internal.SingI ('Data.Vinyl.TypeLevel.S n) -- | Module, containing data types for Michelson value. module Michelson.Typed.Instr -- | Representation of Michelson instruction or sequence of instructions. -- -- Each Michelson instruction is represented by exactly one constructor -- of this data type. Sequence of instructions is represented with use of -- Seq constructor in following way: SWAP; DROP ; DUP; -- -> SWAP Instr DROP Instr DUP. Special case -- where there are no instructions is represented by constructor -- Nop, e.g. IF_NONE {} { SWAP; DROP; } -> -- IF_NONE Nop (SWAP Instr DROP). -- -- Type parameter inp states for input stack type. That is, type -- of the stack that is required for operation to execute. -- -- Type parameter out states for output stack type or type of -- stack that will be left after instruction's execution. data Instr (inp :: [T]) (out :: [T]) [Seq] :: Instr a b -> Instr b c -> Instr a c -- | Nop operation. Missing in Michelson spec, added to parse construction -- like `IF {} { SWAP; DROP; }`. [Nop] :: Instr s s [Ext] :: ExtInstr s -> Instr s s -- | Nested wrapper is going to wrap a sequence of instructions with { }. -- It is crucial because serialisation of a contract depends on precise -- structure of its code. [Nested] :: Instr inp out -> Instr inp out [DROP] :: Instr (a : s) s [DUP] :: Instr (a : s) (a : (a : s)) [SWAP] :: Instr (a : (b : s)) (b : (a : s)) [PUSH] :: forall t s. (SingI t, HasNoOp t, HasNoBigMap t) => Value' Instr t -> Instr s (t : s) [SOME] :: Instr (a : s) ( 'TOption a : s) [NONE] :: forall a s. SingI a => Instr s ( 'TOption a : s) [UNIT] :: Instr s ( 'TUnit : s) [IF_NONE] :: Instr s s' -> Instr (a : s) s' -> Instr ( 'TOption a : s) s' [PAIR] :: Instr (a : (b : s)) ( 'TPair a b : s) [CAR] :: Instr ( 'TPair a b : s) (a : s) [CDR] :: Instr ( 'TPair a b : s) (b : s) [LEFT] :: forall b a s. SingI b => Instr (a : s) ( 'TOr a b : s) [RIGHT] :: forall a b s. SingI a => Instr (b : s) ( 'TOr a b : s) [IF_LEFT] :: Instr (a : s) s' -> Instr (b : s) s' -> Instr ( 'TOr a b : s) s' [NIL] :: SingI p => Instr s ( 'TList p : s) [CONS] :: Instr (a : ( 'TList a : s)) ( 'TList a : s) [IF_CONS] :: Instr (a : ( 'TList a : s)) s' -> Instr s s' -> Instr ( 'TList a : s) s' [SIZE] :: SizeOp c => Instr (c : s) ( 'Tc 'CNat : s) [EMPTY_SET] :: (Typeable e, SingI e) => Instr s ( 'TSet e : s) [EMPTY_MAP] :: (Typeable a, Typeable b, SingI a, SingI b) => Instr s ( 'TMap a b : s) [MAP] :: MapOp c => Instr (MapOpInp c : s) (b : s) -> Instr (c : s) (MapOpRes c b : s) [ITER] :: IterOp c => Instr (IterOpEl c : s) s -> Instr (c : s) s [MEM] :: MemOp c => Instr ( 'Tc (MemOpKey c) : (c : s)) ( 'Tc 'CBool : s) [GET] :: GetOp c => Instr ( 'Tc (GetOpKey c) : (c : s)) ( 'TOption (GetOpVal c) : s) [UPDATE] :: UpdOp c => Instr ( 'Tc (UpdOpKey c) : (UpdOpParams c : (c : s))) (c : s) [IF] :: Instr s s' -> Instr s s' -> Instr ( 'Tc 'CBool : s) s' [LOOP] :: Instr s ( 'Tc 'CBool : s) -> Instr ( 'Tc 'CBool : s) s [LOOP_LEFT] :: Instr (a : s) ( 'TOr a b : s) -> Instr ( 'TOr a b : s) (b : s) [LAMBDA] :: forall i o s. Each [Typeable, SingI] [i, o] => Value' Instr ( 'TLambda i o) -> Instr s ( 'TLambda i o : s) [EXEC] :: Instr (t1 : ( 'TLambda t1 t2 : s)) (t2 : s) [DIP] :: Instr a c -> Instr (b : a) (b : c) [FAILWITH] :: (Typeable a, SingI a) => Instr (a : s) t [CAST] :: forall a s. SingI a => Instr (a : s) (a : s) [RENAME] :: Instr (a : s) (a : s) [PACK] :: (SingI a, HasNoOp a, HasNoBigMap a) => Instr (a : s) ( 'Tc 'CBytes : s) [UNPACK] :: (SingI a, HasNoOp a, HasNoBigMap a) => Instr ( 'Tc 'CBytes : s) ( 'TOption a : s) [CONCAT] :: ConcatOp c => Instr (c : (c : s)) (c : s) [CONCAT'] :: ConcatOp c => Instr ( 'TList c : s) (c : s) [SLICE] :: SliceOp c => Instr ( 'Tc 'CNat : ( 'Tc 'CNat : (c : s))) ( 'TOption c : s) [ISNAT] :: Instr ( 'Tc 'CInt : s) ( 'TOption ( 'Tc 'CNat) : s) [ADD] :: (ArithOp Add n m, Typeable n, Typeable m) => Instr ( 'Tc n : ( 'Tc m : s)) ( 'Tc (ArithRes Add n m) : s) [SUB] :: (ArithOp Sub n m, Typeable n, Typeable m) => Instr ( 'Tc n : ( 'Tc m : s)) ( 'Tc (ArithRes Sub n m) : s) [MUL] :: (ArithOp Mul n m, Typeable n, Typeable m) => Instr ( 'Tc n : ( 'Tc m : s)) ( 'Tc (ArithRes Mul n m) : s) [EDIV] :: EDivOp n m => Instr ( 'Tc n : ( 'Tc m : s)) ( 'TOption ( 'TPair ( 'Tc (EDivOpRes n m)) ( 'Tc (EModOpRes n m))) : s) [ABS] :: UnaryArithOp Abs n => Instr ( 'Tc n : s) ( 'Tc (UnaryArithRes Abs n) : s) [NEG] :: UnaryArithOp Neg n => Instr ( 'Tc n : s) ( 'Tc (UnaryArithRes Neg n) : s) [LSL] :: (ArithOp Lsl n m, Typeable n, Typeable m) => Instr ( 'Tc n : ( 'Tc m : s)) ( 'Tc (ArithRes Lsl n m) : s) [LSR] :: (ArithOp Lsr n m, Typeable n, Typeable m) => Instr ( 'Tc n : ( 'Tc m : s)) ( 'Tc (ArithRes Lsr n m) : s) [OR] :: (ArithOp Or n m, Typeable n, Typeable m) => Instr ( 'Tc n : ( 'Tc m : s)) ( 'Tc (ArithRes Or n m) : s) [AND] :: (ArithOp And n m, Typeable n, Typeable m) => Instr ( 'Tc n : ( 'Tc m : s)) ( 'Tc (ArithRes And n m) : s) [XOR] :: (ArithOp Xor n m, Typeable n, Typeable m) => Instr ( 'Tc n : ( 'Tc m : s)) ( 'Tc (ArithRes Xor n m) : s) [NOT] :: UnaryArithOp Not n => Instr ( 'Tc n : s) ( 'Tc (UnaryArithRes Not n) : s) [COMPARE] :: (ArithOp Compare n m, Typeable n, Typeable m) => Instr ( 'Tc n : ( 'Tc m : s)) ( 'Tc (ArithRes Compare n m) : s) [EQ] :: UnaryArithOp Eq' n => Instr ( 'Tc n : s) ( 'Tc (UnaryArithRes Eq' n) : s) [NEQ] :: UnaryArithOp Neq n => Instr ( 'Tc n : s) ( 'Tc (UnaryArithRes Neq n) : s) [LT] :: UnaryArithOp Lt n => Instr ( 'Tc n : s) ( 'Tc (UnaryArithRes Lt n) : s) [GT] :: UnaryArithOp Gt n => Instr ( 'Tc n : s) ( 'Tc (UnaryArithRes Gt n) : s) [LE] :: UnaryArithOp Le n => Instr ( 'Tc n : s) ( 'Tc (UnaryArithRes Le n) : s) [GE] :: UnaryArithOp Ge n => Instr ( 'Tc n : s) ( 'Tc (UnaryArithRes Ge n) : s) [INT] :: Instr ( 'Tc 'CNat : s) ( 'Tc 'CInt : s) [SELF] :: forall (cp :: T) s. Instr s ( 'TContract cp : s) [CONTRACT] :: (SingI p, Typeable p) => Notes p -> Instr ( 'Tc 'CAddress : s) ( 'TOption ( 'TContract p) : s) [TRANSFER_TOKENS] :: (Typeable p, SingI p, HasNoOp p, HasNoBigMap p) => Instr (p : ( 'Tc 'CMutez : ( 'TContract p : s))) ( 'TOperation : s) [SET_DELEGATE] :: Instr ( 'TOption ( 'Tc 'CKeyHash) : s) ( 'TOperation : s) [CREATE_ACCOUNT] :: Instr ( 'Tc 'CKeyHash : ( 'TOption ( 'Tc 'CKeyHash) : ( 'Tc 'CBool : ( 'Tc 'CMutez : s)))) ( 'TOperation : ( 'Tc 'CAddress : s)) [CREATE_CONTRACT] :: (Each [Typeable, SingI, HasNoOp] [p, g], HasNoBigMap p, BigMapConstraint g) => Instr '[ 'TPair p g] '[ 'TPair ( 'TList 'TOperation) g] -> Instr ( 'Tc 'CKeyHash : ( 'TOption ( 'Tc 'CKeyHash) : ( 'Tc 'CBool : ( 'Tc 'CBool : ( 'Tc 'CMutez : (g : s)))))) ( 'TOperation : ( 'Tc 'CAddress : s)) [IMPLICIT_ACCOUNT] :: Instr ( 'Tc 'CKeyHash : s) ( 'TContract 'TUnit : s) [NOW] :: Instr s ( 'Tc 'CTimestamp : s) [AMOUNT] :: Instr s ( 'Tc 'CMutez : s) [BALANCE] :: Instr s ( 'Tc 'CMutez : s) [CHECK_SIGNATURE] :: Instr ( 'TKey : ( 'TSignature : ( 'Tc 'CBytes : s))) ( 'Tc 'CBool : s) [SHA256] :: Instr ( 'Tc 'CBytes : s) ( 'Tc 'CBytes : s) [SHA512] :: Instr ( 'Tc 'CBytes : s) ( 'Tc 'CBytes : s) [BLAKE2B] :: Instr ( 'Tc 'CBytes : s) ( 'Tc 'CBytes : s) [HASH_KEY] :: Instr ( 'TKey : s) ( 'Tc 'CKeyHash : s) [STEPS_TO_QUOTA] :: Instr s ( 'Tc 'CNat : s) [SOURCE] :: Instr s ( 'Tc 'CAddress : s) [SENDER] :: Instr s ( 'Tc 'CAddress : s) [ADDRESS] :: Instr ( 'TContract a : s) ( 'Tc 'CAddress : s) data ExtInstr s TEST_ASSERT :: TestAssert s -> ExtInstr s PRINT :: PrintComment s -> ExtInstr s -- | A reference into the stack of a given type. data StackRef (st :: [T]) -- | Keeps 0-based index to a stack element counting from the top. [StackRef] :: (KnownPeano idx, LongerThan st idx) => Sing (idx :: Peano) -> StackRef st -- | Create a stack reference, performing checks at compile time. mkStackRef :: forall (gn :: Nat) st n. (n ~ ToPeano gn, SingI n, KnownPeano n, RequireLongerThan st n) => StackRef st -- | A print format with references into the stack newtype PrintComment (st :: [T]) PrintComment :: [Either Text (StackRef st)] -> PrintComment [unPrintComment] :: PrintComment -> [Either Text (StackRef st)] data TestAssert (s :: [T]) [TestAssert] :: Typeable out => Text -> PrintComment inp -> Instr inp ( 'Tc 'CBool : out) -> TestAssert inp type Contract cp st = Instr (ContractInp cp st) (ContractOut st) instance GHC.Show.Show (Michelson.Typed.Instr.ExtInstr s) instance GHC.Base.Monoid (Michelson.Typed.Instr.PrintComment st) instance GHC.Base.Semigroup (Michelson.Typed.Instr.PrintComment st) instance GHC.Generics.Generic (Michelson.Typed.Instr.PrintComment st) instance GHC.Show.Show (Michelson.Typed.Instr.PrintComment st) instance GHC.Classes.Eq (Michelson.Typed.Instr.PrintComment st) instance GHC.Show.Show (Michelson.Typed.Instr.Instr inp out) instance GHC.Show.Show (Michelson.Typed.Instr.TestAssert s) instance Data.String.IsString (Michelson.Typed.Instr.PrintComment st) instance GHC.Classes.Eq (Michelson.Typed.Instr.StackRef st) instance GHC.Show.Show (Michelson.Typed.Instr.StackRef st) module Michelson.Typed.Aliases type Value = Value' Instr type Operation = Operation' Instr -- | Conversions between haskell types/values and Michelson ones. module Michelson.Typed.Haskell.Value -- | Isomorphism between Michelson primitive values and plain Haskell -- types. class IsoCValue a where { -- | Type function that converts a regular Haskell type into a comparable -- type (which has kind CT). type family ToCT a :: CT; } -- | Converts a single Haskell value into CVal representation. toCVal :: IsoCValue a => a -> CValue (ToCT a) -- | Converts a CVal value into a single Haskell value. fromCVal :: IsoCValue a => CValue (ToCT a) -> a -- | Isomorphism between Michelson values and plain Haskell types. -- -- Default implementation of this typeclass converts ADTs to Michelson -- "pair"s and "or"s. class IsoValue a where { -- | Type function that converts a regular Haskell type into a T -- type. type family ToT a :: T; type ToT a = GValueType (Rep a); } -- | Converts a Haskell structure into Value representation. toVal :: IsoValue a => a -> Value (ToT a) -- | Converts a Haskell structure into Value representation. toVal :: (IsoValue a, Generic a, GIsoValue (Rep a), ToT a ~ GValueType (Rep a)) => a -> Value (ToT a) -- | Converts a Value into Haskell type. fromVal :: IsoValue a => Value (ToT a) -> a -- | Converts a Value into Haskell type. fromVal :: (IsoValue a, Generic a, GIsoValue (Rep a), ToT a ~ GValueType (Rep a)) => Value (ToT a) -> a -- | Implements ADT conversion to Michelson value. -- -- Thanks to Generic, Michelson representation will be a balanced tree; -- this reduces average access time in general case. -- -- A drawback of such approach is that, in theory, in new GHC version -- generified representation may change; however, chances are small and I -- (martoon) believe that contract versions will change much faster -- anyway. class GIsoValue (x :: Type -> Type) where { type family GValueType x :: T; } -- | Type function to convert a Haskell stack type to T-based one. type family ToTs (ts :: [Type]) :: [T] -- | Overloaded version of ToT to work on Haskell and T -- types. type family ToT' (t :: k) :: T -- | Overloaded version of ToTs to work on Haskell and T -- stacks. type family ToTs' (t :: [k]) :: [T] -- | A useful property which holds for all CT types. type IsComparable c = ToT c ~ 'Tc (ToCT c) -- | Since Contract name is used to designate contract code, lets -- call analogy of TContract type as follows. newtype ContractAddr (cp :: Type) ContractAddr :: Address -> ContractAddr [unContractAddress] :: ContractAddr -> Address newtype BigMap k v BigMap :: Map k v -> BigMap k v [unBigMap] :: BigMap k v -> Map k v instance GHC.Classes.Ord k => GHC.Base.Monoid (Michelson.Typed.Haskell.Value.BigMap k v) instance GHC.Classes.Ord k => GHC.Base.Semigroup (Michelson.Typed.Haskell.Value.BigMap k v) instance Data.Default.Class.Default (Michelson.Typed.Haskell.Value.BigMap k v) instance (GHC.Show.Show k, GHC.Show.Show v) => GHC.Show.Show (Michelson.Typed.Haskell.Value.BigMap k v) instance (GHC.Classes.Eq k, GHC.Classes.Eq v) => GHC.Classes.Eq (Michelson.Typed.Haskell.Value.BigMap k v) instance Michelson.Typed.Haskell.Value.IsoValue a => Michelson.Typed.Haskell.Value.IsoValue (Data.Functor.Identity.Identity a) instance Michelson.Typed.Haskell.Value.IsoValue a => Michelson.Typed.Haskell.Value.IsoValue (Named.Internal.NamedF Data.Functor.Identity.Identity a name) instance Michelson.Typed.Haskell.Value.IsoValue a => Michelson.Typed.Haskell.Value.IsoValue (Named.Internal.NamedF GHC.Maybe.Maybe a name) instance Michelson.Typed.Haskell.Value.IsoValue GHC.Integer.Type.Integer instance Michelson.Typed.Haskell.Value.IsoValue GHC.Natural.Natural instance Michelson.Typed.Haskell.Value.IsoValue Michelson.Text.MText instance Michelson.Text.DoNotUseTextError => Michelson.Typed.Haskell.Value.IsoValue Data.Text.Internal.Text instance Michelson.Typed.Haskell.Value.IsoValue GHC.Types.Bool instance Michelson.Typed.Haskell.Value.IsoValue Data.ByteString.Internal.ByteString instance Michelson.Typed.Haskell.Value.IsoValue Tezos.Core.Mutez instance Michelson.Typed.Haskell.Value.IsoValue Tezos.Crypto.KeyHash instance Michelson.Typed.Haskell.Value.IsoValue Tezos.Core.Timestamp instance Michelson.Typed.Haskell.Value.IsoValue Tezos.Address.Address instance Michelson.Typed.Haskell.Value.IsoValue Tezos.Crypto.PublicKey instance Michelson.Typed.Haskell.Value.IsoValue Tezos.Crypto.Signature instance Michelson.Typed.Haskell.Value.IsoValue () instance Michelson.Typed.Haskell.Value.IsoValue a => Michelson.Typed.Haskell.Value.IsoValue [a] instance Michelson.Typed.Haskell.Value.IsoValue a => Michelson.Typed.Haskell.Value.IsoValue (GHC.Maybe.Maybe a) instance (Michelson.Typed.Haskell.Value.IsoValue l, Michelson.Typed.Haskell.Value.IsoValue r) => Michelson.Typed.Haskell.Value.IsoValue (Data.Either.Either l r) instance (Michelson.Typed.Haskell.Value.IsoValue a, Michelson.Typed.Haskell.Value.IsoValue b) => Michelson.Typed.Haskell.Value.IsoValue (a, b) instance (GHC.Classes.Ord c, Michelson.Typed.Haskell.Value.IsoCValue c) => Michelson.Typed.Haskell.Value.IsoValue (Data.Set.Internal.Set c) instance (GHC.Classes.Ord k, Michelson.Typed.Haskell.Value.IsoCValue k, Michelson.Typed.Haskell.Value.IsoValue v) => Michelson.Typed.Haskell.Value.IsoValue (Data.Map.Internal.Map k v) instance Michelson.Typed.Haskell.Value.IsoValue Michelson.Typed.Aliases.Operation instance (Michelson.Typed.Haskell.Value.IsoValue a, Michelson.Typed.Haskell.Value.IsoValue b, Michelson.Typed.Haskell.Value.IsoValue c) => Michelson.Typed.Haskell.Value.IsoValue (a, b, c) instance (Michelson.Typed.Haskell.Value.IsoValue a, Michelson.Typed.Haskell.Value.IsoValue b, Michelson.Typed.Haskell.Value.IsoValue c, Michelson.Typed.Haskell.Value.IsoValue d) => Michelson.Typed.Haskell.Value.IsoValue (a, b, c, d) instance (Michelson.Typed.Haskell.Value.IsoValue a, Michelson.Typed.Haskell.Value.IsoValue b, Michelson.Typed.Haskell.Value.IsoValue c, Michelson.Typed.Haskell.Value.IsoValue d, Michelson.Typed.Haskell.Value.IsoValue e) => Michelson.Typed.Haskell.Value.IsoValue (a, b, c, d, e) instance (Michelson.Typed.Haskell.Value.IsoValue a, Michelson.Typed.Haskell.Value.IsoValue b, Michelson.Typed.Haskell.Value.IsoValue c, Michelson.Typed.Haskell.Value.IsoValue d, Michelson.Typed.Haskell.Value.IsoValue e, Michelson.Typed.Haskell.Value.IsoValue f) => Michelson.Typed.Haskell.Value.IsoValue (a, b, c, d, e, f) instance (Michelson.Typed.Haskell.Value.IsoValue a, Michelson.Typed.Haskell.Value.IsoValue b, Michelson.Typed.Haskell.Value.IsoValue c, Michelson.Typed.Haskell.Value.IsoValue d, Michelson.Typed.Haskell.Value.IsoValue e, Michelson.Typed.Haskell.Value.IsoValue f, Michelson.Typed.Haskell.Value.IsoValue g) => Michelson.Typed.Haskell.Value.IsoValue (a, b, c, d, e, f, g) instance Michelson.Typed.Haskell.Value.IsoValue (Michelson.Typed.Haskell.Value.ContractAddr cp) instance (GHC.Classes.Ord k, Michelson.Typed.Haskell.Value.IsoCValue k, Michelson.Typed.Haskell.Value.IsoValue v) => Michelson.Typed.Haskell.Value.IsoValue (Michelson.Typed.Haskell.Value.BigMap k v) instance Michelson.Typed.Haskell.Value.IsoValue a => Michelson.Typed.Haskell.Value.GIsoValue (GHC.Generics.Rec0 a) instance Michelson.Typed.Haskell.Value.GIsoValue x => Michelson.Typed.Haskell.Value.GIsoValue (GHC.Generics.M1 t i x) instance (Michelson.Typed.Haskell.Value.GIsoValue x, Michelson.Typed.Haskell.Value.GIsoValue y) => Michelson.Typed.Haskell.Value.GIsoValue (x GHC.Generics.:+: y) instance (Michelson.Typed.Haskell.Value.GIsoValue x, Michelson.Typed.Haskell.Value.GIsoValue y) => Michelson.Typed.Haskell.Value.GIsoValue (x GHC.Generics.:*: y) instance Michelson.Typed.Haskell.Value.GIsoValue GHC.Generics.U1 instance Michelson.Typed.Haskell.Value.IsoCValue GHC.Integer.Type.Integer instance Michelson.Typed.Haskell.Value.IsoCValue GHC.Natural.Natural instance Michelson.Typed.Haskell.Value.IsoCValue Michelson.Text.MText instance Michelson.Text.DoNotUseTextError => Michelson.Typed.Haskell.Value.IsoCValue Data.Text.Internal.Text instance Michelson.Typed.Haskell.Value.IsoCValue GHC.Types.Bool instance Michelson.Typed.Haskell.Value.IsoCValue Data.ByteString.Internal.ByteString instance Michelson.Typed.Haskell.Value.IsoCValue Tezos.Core.Mutez instance Michelson.Typed.Haskell.Value.IsoCValue Tezos.Address.Address instance Michelson.Typed.Haskell.Value.IsoCValue Tezos.Crypto.KeyHash instance Michelson.Typed.Haskell.Value.IsoCValue Tezos.Core.Timestamp -- | Instructions working on product types derived from Haskell ones. module Michelson.Typed.Haskell.Instr.Product -- | Constraint for instrGetField. type InstrGetFieldC dt name = (IsoValue dt, Generic dt, GInstrGet name (Rep dt) (LnrBranch (GetNamed name dt)) (LnrFieldType (GetNamed name dt)), GValueType (Rep dt) ~ ToT dt) -- | Constraint for instrSetField. type InstrSetFieldC dt name = (IsoValue dt, Generic dt, GInstrSetField name (Rep dt) (LnrBranch (GetNamed name dt)) (LnrFieldType (GetNamed name dt)), GValueType (Rep dt) ~ ToT dt) -- | Constraint for instrConstruct. type InstrConstructC dt = (IsoValue dt, Generic dt, GInstrConstruct (Rep dt), GValueType (Rep dt) ~ ToT dt) -- | Make an instruction which accesses given field of the given datatype. instrGetField :: forall dt name st. InstrGetFieldC dt name => Label name -> Instr (ToT dt : st) (ToT (GetFieldType dt name) : st) -- | For given complex type dt and its field fieldTy -- update the field value. instrSetField :: forall dt name st. InstrSetFieldC dt name => Label name -> Instr (ToT (GetFieldType dt name) : (ToT dt : st)) (ToT dt : st) -- | For given complex type dt and its field fieldTy -- update the field value. instrConstruct :: forall dt st. InstrConstructC dt => Rec (FieldConstructor st) (ConstructorFieldTypes dt) -> Instr st (ToT dt : st) -- | Get type of field by datatype it is contained in and field name. type GetFieldType dt name = LnrFieldType (GetNamed name dt) -- | Types of all fields in a datatype. type ConstructorFieldTypes dt = GFieldTypes (Rep dt) -- | Way to construct one of the fields in a complex datatype. newtype FieldConstructor (st :: [k]) (field :: Type) FieldConstructor :: Instr (ToTs' st) (ToT field : ToTs' st) -> FieldConstructor instance Michelson.Typed.Haskell.Value.IsoValue Michelson.Typed.Haskell.Instr.Product.MyType2 instance GHC.Generics.Generic Michelson.Typed.Haskell.Instr.Product.MyType2 instance Michelson.Typed.Haskell.Instr.Product.GInstrConstruct x => Michelson.Typed.Haskell.Instr.Product.GInstrConstruct (GHC.Generics.M1 t i x) instance (Michelson.Typed.Haskell.Instr.Product.GInstrConstruct x, Michelson.Typed.Haskell.Instr.Product.GInstrConstruct y, Michelson.Typed.Haskell.Instr.Helpers.RSplit (Michelson.Typed.Haskell.Instr.Product.GFieldTypes x) (Michelson.Typed.Haskell.Instr.Product.GFieldTypes y)) => Michelson.Typed.Haskell.Instr.Product.GInstrConstruct (x GHC.Generics.:*: y) instance Michelson.Typed.Haskell.Instr.Product.GInstrConstruct GHC.Generics.U1 instance ((TypeError ...), Michelson.Typed.Haskell.Value.GIsoValue x, Michelson.Typed.Haskell.Value.GIsoValue y) => Michelson.Typed.Haskell.Instr.Product.GInstrConstruct (x GHC.Generics.:+: y) instance Michelson.Typed.Haskell.Value.IsoValue a => Michelson.Typed.Haskell.Instr.Product.GInstrConstruct (GHC.Generics.Rec0 a) instance Michelson.Typed.Haskell.Instr.Product.GInstrSetField name x path f => Michelson.Typed.Haskell.Instr.Product.GInstrSetField name (GHC.Generics.M1 t i x) path f instance (Michelson.Typed.Haskell.Value.IsoValue f, Michelson.Typed.Haskell.Value.ToT f Data.Type.Equality.~ Michelson.Typed.Haskell.Value.ToT f') => Michelson.Typed.Haskell.Instr.Product.GInstrSetField name (GHC.Generics.Rec0 f) '[] f' instance (Michelson.Typed.Haskell.Instr.Product.GInstrSetField name x path f, Michelson.Typed.Haskell.Value.GIsoValue y) => Michelson.Typed.Haskell.Instr.Product.GInstrSetField name (x GHC.Generics.:*: y) ('Michelson.Typed.Haskell.Instr.Helpers.L : path) f instance (Michelson.Typed.Haskell.Instr.Product.GInstrSetField name y path f, Michelson.Typed.Haskell.Value.GIsoValue x) => Michelson.Typed.Haskell.Instr.Product.GInstrSetField name (x GHC.Generics.:*: y) ('Michelson.Typed.Haskell.Instr.Helpers.R : path) f instance Michelson.Typed.Haskell.Instr.Product.GInstrGet name x path f => Michelson.Typed.Haskell.Instr.Product.GInstrGet name (GHC.Generics.M1 t i x) path f instance (Michelson.Typed.Haskell.Value.IsoValue f, Michelson.Typed.Haskell.Value.ToT f Data.Type.Equality.~ Michelson.Typed.Haskell.Value.ToT f') => Michelson.Typed.Haskell.Instr.Product.GInstrGet name (GHC.Generics.Rec0 f) '[] f' instance (Michelson.Typed.Haskell.Instr.Product.GInstrGet name x path f, Michelson.Typed.Haskell.Value.GIsoValue y) => Michelson.Typed.Haskell.Instr.Product.GInstrGet name (x GHC.Generics.:*: y) ('Michelson.Typed.Haskell.Instr.Helpers.L : path) f instance (Michelson.Typed.Haskell.Instr.Product.GInstrGet name y path f, Michelson.Typed.Haskell.Value.GIsoValue x) => Michelson.Typed.Haskell.Instr.Product.GInstrGet name (x GHC.Generics.:*: y) ('Michelson.Typed.Haskell.Instr.Helpers.R : path) f module Michelson.Typed.Convert convertContract :: forall param store. (SingI param, SingI store) => Contract param store -> Contract instrToOps :: Instr inp out -> [ExpandedOp] -- | Convert a typed Val to an untyped Value. -- -- For full isomorphism type of the given Val should not contain -- TOperation - a compile error will be raised otherwise. You can -- analyse its presence with checkOpPresence function. untypeValue :: forall t. (SingI t, HasNoOp t) => Value' Instr t -> Value instance Data.Typeable.Internal.Typeable s => GHC.Classes.Eq (Michelson.Typed.Instr.ExtInstr s) instance GHC.Classes.Eq (Michelson.Typed.Instr.Instr inp out) instance Data.Typeable.Internal.Typeable s => GHC.Classes.Eq (Michelson.Typed.Instr.TestAssert s) -- | Ingridients that we use in our test suite. module Util.Test.Ingredients -- | This is the default set of ingredients extended with the -- antXMLRunner which is used to generate xml reports for CI. ourIngredients :: [Ingredient] -- | General type utilities. module Util.Type type family IsElem (a :: k) (l :: [k]) :: Bool module Util.TypeTuple.Class -- | Building a record from tuple. -- -- It differs from similar typeclass in FromTuple module in that -- it allows type inference outside-in - knowing desired Rec you -- know which tuple should be provided - this improves error messages -- when constructing concrete Rec objects. class RecFromTuple r where { type family IsoRecTuple r :: Type; } recFromTuple :: RecFromTuple r => IsoRecTuple r -> r -- | Template haskell generator for RecFromTuple, in a separate -- module because of staging restrictions. module Util.TypeTuple.TH -- | Produce RecFromTuple instance for tuple of the given length. deriveRecFromTuple :: Word -> Q [Dec] module Util.TypeTuple.Instances instance forall u (f :: u -> *). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[]) instance forall u (f :: u -> *) (x :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u) (x7 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6, x7]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u) (x7 :: u) (x8 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6, x7, x8]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u) (x7 :: u) (x8 :: u) (x9 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6, x7, x8, x9]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u) (x7 :: u) (x8 :: u) (x9 :: u) (x10 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6, x7, x8, x9, x10]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u) (x7 :: u) (x8 :: u) (x9 :: u) (x10 :: u) (x11 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u) (x7 :: u) (x8 :: u) (x9 :: u) (x10 :: u) (x11 :: u) (x12 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u) (x7 :: u) (x8 :: u) (x9 :: u) (x10 :: u) (x11 :: u) (x12 :: u) (x13 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u) (x7 :: u) (x8 :: u) (x9 :: u) (x10 :: u) (x11 :: u) (x12 :: u) (x13 :: u) (x14 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14]) instance forall u (f :: u -> *) (x1 :: u) (x2 :: u) (x3 :: u) (x4 :: u) (x5 :: u) (x6 :: u) (x7 :: u) (x8 :: u) (x9 :: u) (x10 :: u) (x11 :: u) (x12 :: u) (x13 :: u) (x14 :: u) (x15 :: u). Util.TypeTuple.Class.RecFromTuple (Data.Vinyl.Core.Rec f '[x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15]) -- | Conversions between tuples and list-like types. module Util.TypeTuple -- | Building a record from tuple. -- -- It differs from similar typeclass in FromTuple module in that -- it allows type inference outside-in - knowing desired Rec you -- know which tuple should be provided - this improves error messages -- when constructing concrete Rec objects. class RecFromTuple r where { type family IsoRecTuple r :: Type; } recFromTuple :: RecFromTuple r => IsoRecTuple r -> r -- | Instructions working on sum types derived from Haskell ones. module Michelson.Typed.Haskell.Instr.Sum type InstrWrapC dt name = (IsoValue dt, Generic dt, GInstrWrap (Rep dt) (LnrBranch (GetNamed name dt)) (LnrFieldType (GetNamed name dt)), GValueType (Rep dt) ~ ToT dt) type InstrCaseC dt inp out = (IsoValue dt, GInstrCase (Rep dt), GValueType (Rep dt) ~ ToT dt) type InstrUnwrapC dt name = (IsoValue dt, Generic dt, GInstrUnwrap (Rep dt) (LnrBranch (GetNamed name dt)) (CtorOnlyField name dt), GValueType (Rep dt) ~ ToT dt) -- | Wrap given element into a constructor with the given name. -- -- Mentioned constructor must have only one field. -- -- Since labels interpretable by OverloadedLabels extension cannot -- start with capital latter, prepend constructor name with letter "c" -- (see examples below). instrWrap :: forall dt name st. InstrWrapC dt name => Label name -> Instr (AppendCtorField (GetCtorField dt name) st) (ToT dt : st) -- | Wrap a haskell value into a constructor with the given name. -- -- This is symmetric to instrWrap. hsWrap :: forall dt name. InstrWrapC dt name => Label name -> ExtractCtorField (GetCtorField dt name) -> dt -- | Pattern-match on the given datatype. instrCase :: forall dt out inp. InstrCaseC dt inp out => Rec (CaseClause inp out) (CaseClauses dt) -> Instr (ToT dt : inp) out -- | Lift an instruction to case clause. -- -- You should write out constructor name corresponding to the clause -- explicitly. Prefix constructor name with "c" letter, otherwise your -- label will not be recognized by Haskell parser. Passing constructor -- name can be circumvented but doing so is not recomended as mentioning -- contructor name improves readability and allows avoiding some -- mistakes. (//->) :: Label ("c" `AppendSymbol` ctor) -> Instr (AppendCtorField x inp) out -> CaseClause inp out ( 'CaseClauseParam ctor x) infixr 8 //-> -- | Unwrap a constructor with the given name. -- -- Rules which apply to instrWrap function work here as well. -- Although, unlike instrWrap, this function does not work for -- nullary constructors. instrUnwrapUnsafe :: forall dt name st. InstrUnwrapC dt name => Label name -> Instr (ToT dt : st) (ToT (CtorOnlyField name dt) : st) -- | Try to unwrap a constructor with the given name. hsUnwrap :: forall dt name. InstrUnwrapC dt name => Label name -> dt -> Maybe (CtorOnlyField name dt) -- | In what different case branches differ - related constructor name and -- input stack type which the branch starts with. data CaseClauseParam CaseClauseParam :: Symbol -> CtorField -> CaseClauseParam -- | Type information about single case clause. data CaseClause (inp :: [T]) (out :: [T]) (param :: CaseClauseParam) [CaseClause] :: Instr (AppendCtorField x inp) out -> CaseClause inp out ( 'CaseClauseParam ctor x) -- | List of CaseClauseParams required to pattern match on the given -- type. type CaseClauses a = GCaseClauses (Rep a) -- | We support only two scenarious - constructor with one field and -- without fields. Nonetheless, it's not that sad since for sum types we -- can't even assign names to fields if there are many (the style guide -- prohibits partial records). data CtorField OneField :: Type -> CtorField NoFields :: CtorField -- | Get something as field of the given constructor. type family ExtractCtorField (cf :: CtorField) -- | Push field to stack, if any. type family AppendCtorField (cf :: CtorField) (l :: [k]) :: [k] -- | To use AppendCtorField not only here for T-based stacks, -- but also later in Lorentz with Type-based stacks we need the -- following property. type AppendCtorFieldAxiom (cf :: CtorField) (st :: [Type]) = ToTs (AppendCtorField cf st) ~ AppendCtorField cf (ToTs st) -- | Proof of AppendCtorFieldAxiom. appendCtorFieldAxiom :: (AppendCtorFieldAxiom ( 'OneField Word) '[Int], AppendCtorFieldAxiom 'NoFields '[Int]) => Dict (AppendCtorFieldAxiom cf st) -- | Get type of constructor fields (one or zero) referred by given -- datatype and name. type GetCtorField dt ctor = LnrFieldType (GetNamed ctor dt) -- | Expect referred constructor to have only one field (in form of -- constraint) and extract its type. type CtorHasOnlyField ctor dt f = GetCtorField dt ctor ~ 'OneField f -- | Expect referred constructor to have only one field (otherwise compile -- error is raised) and extract its type. type CtorOnlyField name dt = RequireOneField name (GetCtorField dt name) data MyCompoundType instance Michelson.Typed.Haskell.Value.IsoValue Michelson.Typed.Haskell.Instr.Sum.MyEnum instance GHC.Generics.Generic Michelson.Typed.Haskell.Instr.Sum.MyEnum instance Michelson.Typed.Haskell.Value.IsoValue Michelson.Typed.Haskell.Instr.Sum.MyCompoundType instance GHC.Generics.Generic Michelson.Typed.Haskell.Instr.Sum.MyCompoundType instance Michelson.Typed.Haskell.Value.IsoValue Michelson.Typed.Haskell.Instr.Sum.MyType' instance GHC.Generics.Generic Michelson.Typed.Haskell.Instr.Sum.MyType' instance Michelson.Typed.Haskell.Value.IsoValue Michelson.Typed.Haskell.Instr.Sum.MyType instance GHC.Generics.Generic Michelson.Typed.Haskell.Instr.Sum.MyType instance Michelson.Typed.Haskell.Instr.Sum.GInstrUnwrap x path e => Michelson.Typed.Haskell.Instr.Sum.GInstrUnwrap (GHC.Generics.D1 i x) path e instance (Michelson.Typed.Haskell.Instr.Sum.GInstrUnwrap x path e, Michelson.Typed.Haskell.Value.GIsoValue y, Data.Singletons.Internal.SingI (Michelson.Typed.Haskell.Value.GValueType y)) => Michelson.Typed.Haskell.Instr.Sum.GInstrUnwrap (x GHC.Generics.:+: y) ('Michelson.Typed.Haskell.Instr.Helpers.L : path) e instance (Michelson.Typed.Haskell.Instr.Sum.GInstrUnwrap y path e, Michelson.Typed.Haskell.Value.GIsoValue x, Data.Singletons.Internal.SingI (Michelson.Typed.Haskell.Value.GValueType x)) => Michelson.Typed.Haskell.Instr.Sum.GInstrUnwrap (x GHC.Generics.:+: y) ('Michelson.Typed.Haskell.Instr.Helpers.R : path) e instance Michelson.Typed.Haskell.Value.IsoValue e => Michelson.Typed.Haskell.Instr.Sum.GInstrUnwrap (GHC.Generics.C1 c (GHC.Generics.S1 i (GHC.Generics.Rec0 e))) '[ 'Michelson.Typed.Haskell.Instr.Helpers.S] e instance (path Data.Type.Equality.~ (x : xs), Michelson.Typed.Haskell.Instr.Sum.GInstrUnwrap (GHC.Generics.Rep sub) path e, GHC.Generics.Generic sub, Michelson.Typed.Haskell.Value.GIsoValue (GHC.Generics.Rep sub), Michelson.Typed.Haskell.Value.IsoValue sub, Michelson.Typed.Haskell.Value.GValueType (GHC.Generics.Rep sub) Data.Type.Equality.~ Michelson.Typed.Haskell.Value.ToT sub) => Michelson.Typed.Haskell.Instr.Sum.GInstrUnwrap (GHC.Generics.C1 c (GHC.Generics.S1 i (GHC.Generics.Rec0 sub))) ('Michelson.Typed.Haskell.Instr.Helpers.S : x : xs) e instance Michelson.Typed.Haskell.Instr.Sum.GInstrCaseBranch ctor x => Michelson.Typed.Haskell.Instr.Sum.GInstrCase (GHC.Generics.C1 ('GHC.Generics.MetaCons ctor _1 _2) x) instance (Michelson.Typed.Haskell.Value.GIsoValue x, Michelson.Typed.Haskell.Value.GIsoValue y, (TypeError ...)) => Michelson.Typed.Haskell.Instr.Sum.GInstrCaseBranch ctor (x GHC.Generics.:*: y) instance Michelson.Typed.Haskell.Instr.Sum.GInstrCaseBranch ctor x => Michelson.Typed.Haskell.Instr.Sum.GInstrCaseBranch ctor (GHC.Generics.S1 i x) instance Michelson.Typed.Haskell.Value.IsoValue a => Michelson.Typed.Haskell.Instr.Sum.GInstrCaseBranch ctor (GHC.Generics.Rec0 a) instance Michelson.Typed.Haskell.Instr.Sum.GInstrCaseBranch ctor GHC.Generics.U1 instance Michelson.Typed.Haskell.Instr.Sum.GInstrCase x => Michelson.Typed.Haskell.Instr.Sum.GInstrCase (GHC.Generics.D1 i x) instance (Michelson.Typed.Haskell.Instr.Sum.GInstrCase x, Michelson.Typed.Haskell.Instr.Sum.GInstrCase y, Michelson.Typed.Haskell.Instr.Helpers.RSplit (Michelson.Typed.Haskell.Instr.Sum.GCaseClauses x) (Michelson.Typed.Haskell.Instr.Sum.GCaseClauses y)) => Michelson.Typed.Haskell.Instr.Sum.GInstrCase (x GHC.Generics.:+: y) instance Michelson.Typed.Haskell.Instr.Sum.GInstrWrap x path e => Michelson.Typed.Haskell.Instr.Sum.GInstrWrap (GHC.Generics.D1 i x) path e instance (Michelson.Typed.Haskell.Instr.Sum.GInstrWrap x path e, Michelson.Typed.Haskell.Value.GIsoValue y, Data.Singletons.Internal.SingI (Michelson.Typed.Haskell.Value.GValueType y)) => Michelson.Typed.Haskell.Instr.Sum.GInstrWrap (x GHC.Generics.:+: y) ('Michelson.Typed.Haskell.Instr.Helpers.L : path) e instance (Michelson.Typed.Haskell.Instr.Sum.GInstrWrap y path e, Michelson.Typed.Haskell.Value.GIsoValue x, Data.Singletons.Internal.SingI (Michelson.Typed.Haskell.Value.GValueType x)) => Michelson.Typed.Haskell.Instr.Sum.GInstrWrap (x GHC.Generics.:+: y) ('Michelson.Typed.Haskell.Instr.Helpers.R : path) e instance Michelson.Typed.Haskell.Value.IsoValue e => Michelson.Typed.Haskell.Instr.Sum.GInstrWrap (GHC.Generics.C1 c (GHC.Generics.S1 i (GHC.Generics.Rec0 e))) '[ 'Michelson.Typed.Haskell.Instr.Helpers.S] ('Michelson.Typed.Haskell.Instr.Sum.OneField e) instance (path Data.Type.Equality.~ (x : xs), Michelson.Typed.Haskell.Instr.Sum.GInstrWrap (GHC.Generics.Rep sub) path e, GHC.Generics.Generic sub, Michelson.Typed.Haskell.Value.GIsoValue (GHC.Generics.Rep sub), Michelson.Typed.Haskell.Value.IsoValue sub, Michelson.Typed.Haskell.Value.GValueType (GHC.Generics.Rep sub) Data.Type.Equality.~ Michelson.Typed.Haskell.Value.ToT sub) => Michelson.Typed.Haskell.Instr.Sum.GInstrWrap (GHC.Generics.C1 c (GHC.Generics.S1 i (GHC.Generics.Rec0 sub))) ('Michelson.Typed.Haskell.Instr.Helpers.S : x : xs) e instance Michelson.Typed.Haskell.Instr.Sum.GInstrWrap (GHC.Generics.C1 c GHC.Generics.U1) '[ 'Michelson.Typed.Haskell.Instr.Helpers.S] 'Michelson.Typed.Haskell.Instr.Sum.NoFields module Michelson.Typed.Haskell.Instr -- | Haskell-Michelson conversions. module Michelson.Typed.Haskell newtype BigMap k v BigMap :: Map k v -> BigMap k v [unBigMap] :: BigMap k v -> Map k v -- | Since Contract name is used to designate contract code, lets -- call analogy of TContract type as follows. newtype ContractAddr (cp :: Type) ContractAddr :: Address -> ContractAddr [unContractAddress] :: ContractAddr -> Address -- | A useful property which holds for all CT types. type IsComparable c = ToT c ~ 'Tc (ToCT c) -- | Overloaded version of ToTs to work on Haskell and T -- stacks. type family ToTs' (t :: [k]) :: [T] -- | Overloaded version of ToT to work on Haskell and T -- types. type family ToT' (t :: k) :: T -- | Type function to convert a Haskell stack type to T-based one. type family ToTs (ts :: [Type]) :: [T] -- | Isomorphism between Michelson values and plain Haskell types. -- -- Default implementation of this typeclass converts ADTs to Michelson -- "pair"s and "or"s. class IsoValue a where { -- | Type function that converts a regular Haskell type into a T -- type. type family ToT a :: T; type ToT a = GValueType (Rep a); } -- | Converts a Haskell structure into Value representation. toVal :: IsoValue a => a -> Value (ToT a) -- | Converts a Haskell structure into Value representation. toVal :: (IsoValue a, Generic a, GIsoValue (Rep a), ToT a ~ GValueType (Rep a)) => a -> Value (ToT a) -- | Converts a Value into Haskell type. fromVal :: IsoValue a => Value (ToT a) -> a -- | Converts a Value into Haskell type. fromVal :: (IsoValue a, Generic a, GIsoValue (Rep a), ToT a ~ GValueType (Rep a)) => Value (ToT a) -> a -- | Isomorphism between Michelson primitive values and plain Haskell -- types. class IsoCValue a where { -- | Type function that converts a regular Haskell type into a comparable -- type (which has kind CT). type family ToCT a :: CT; } -- | Converts a single Haskell value into CVal representation. toCVal :: IsoCValue a => a -> CValue (ToCT a) -- | Converts a CVal value into a single Haskell value. fromCVal :: IsoCValue a => CValue (ToCT a) -> a -- | Constraint for instrConstruct. type InstrConstructC dt = (IsoValue dt, Generic dt, GInstrConstruct (Rep dt), GValueType (Rep dt) ~ ToT dt) -- | Types of all fields in a datatype. type ConstructorFieldTypes dt = GFieldTypes (Rep dt) -- | Way to construct one of the fields in a complex datatype. newtype FieldConstructor (st :: [k]) (field :: Type) FieldConstructor :: Instr (ToTs' st) (ToT field : ToTs' st) -> FieldConstructor -- | Constraint for instrSetField. type InstrSetFieldC dt name = (IsoValue dt, Generic dt, GInstrSetField name (Rep dt) (LnrBranch (GetNamed name dt)) (LnrFieldType (GetNamed name dt)), GValueType (Rep dt) ~ ToT dt) -- | Constraint for instrGetField. type InstrGetFieldC dt name = (IsoValue dt, Generic dt, GInstrGet name (Rep dt) (LnrBranch (GetNamed name dt)) (LnrFieldType (GetNamed name dt)), GValueType (Rep dt) ~ ToT dt) -- | Get type of field by datatype it is contained in and field name. type GetFieldType dt name = LnrFieldType (GetNamed name dt) -- | Make an instruction which accesses given field of the given datatype. instrGetField :: forall dt name st. InstrGetFieldC dt name => Label name -> Instr (ToT dt : st) (ToT (GetFieldType dt name) : st) -- | For given complex type dt and its field fieldTy -- update the field value. instrSetField :: forall dt name st. InstrSetFieldC dt name => Label name -> Instr (ToT (GetFieldType dt name) : (ToT dt : st)) (ToT dt : st) -- | For given complex type dt and its field fieldTy -- update the field value. instrConstruct :: forall dt st. InstrConstructC dt => Rec (FieldConstructor st) (ConstructorFieldTypes dt) -> Instr st (ToT dt : st) type InstrUnwrapC dt name = (IsoValue dt, Generic dt, GInstrUnwrap (Rep dt) (LnrBranch (GetNamed name dt)) (CtorOnlyField name dt), GValueType (Rep dt) ~ ToT dt) -- | List of CaseClauseParams required to pattern match on the given -- type. type CaseClauses a = GCaseClauses (Rep a) -- | Type information about single case clause. data CaseClause (inp :: [T]) (out :: [T]) (param :: CaseClauseParam) [CaseClause] :: Instr (AppendCtorField x inp) out -> CaseClause inp out ( 'CaseClauseParam ctor x) -- | In what different case branches differ - related constructor name and -- input stack type which the branch starts with. data CaseClauseParam CaseClauseParam :: Symbol -> CtorField -> CaseClauseParam type InstrCaseC dt inp out = (IsoValue dt, GInstrCase (Rep dt), GValueType (Rep dt) ~ ToT dt) data MyCompoundType type InstrWrapC dt name = (IsoValue dt, Generic dt, GInstrWrap (Rep dt) (LnrBranch (GetNamed name dt)) (LnrFieldType (GetNamed name dt)), GValueType (Rep dt) ~ ToT dt) -- | Expect referred constructor to have only one field (otherwise compile -- error is raised) and extract its type. type CtorOnlyField name dt = RequireOneField name (GetCtorField dt name) -- | Expect referred constructor to have only one field (in form of -- constraint) and extract its type. type CtorHasOnlyField ctor dt f = GetCtorField dt ctor ~ 'OneField f -- | Get type of constructor fields (one or zero) referred by given -- datatype and name. type GetCtorField dt ctor = LnrFieldType (GetNamed ctor dt) -- | To use AppendCtorField not only here for T-based stacks, -- but also later in Lorentz with Type-based stacks we need the -- following property. type AppendCtorFieldAxiom (cf :: CtorField) (st :: [Type]) = ToTs (AppendCtorField cf st) ~ AppendCtorField cf (ToTs st) -- | Push field to stack, if any. type family AppendCtorField (cf :: CtorField) (l :: [k]) :: [k] -- | Get something as field of the given constructor. type family ExtractCtorField (cf :: CtorField) -- | We support only two scenarious - constructor with one field and -- without fields. Nonetheless, it's not that sad since for sum types we -- can't even assign names to fields if there are many (the style guide -- prohibits partial records). data CtorField OneField :: Type -> CtorField NoFields :: CtorField -- | Proof of AppendCtorFieldAxiom. appendCtorFieldAxiom :: (AppendCtorFieldAxiom ( 'OneField Word) '[Int], AppendCtorFieldAxiom 'NoFields '[Int]) => Dict (AppendCtorFieldAxiom cf st) -- | Wrap given element into a constructor with the given name. -- -- Mentioned constructor must have only one field. -- -- Since labels interpretable by OverloadedLabels extension cannot -- start with capital latter, prepend constructor name with letter "c" -- (see examples below). instrWrap :: forall dt name st. InstrWrapC dt name => Label name -> Instr (AppendCtorField (GetCtorField dt name) st) (ToT dt : st) -- | Wrap a haskell value into a constructor with the given name. -- -- This is symmetric to instrWrap. hsWrap :: forall dt name. InstrWrapC dt name => Label name -> ExtractCtorField (GetCtorField dt name) -> dt -- | Pattern-match on the given datatype. instrCase :: forall dt out inp. InstrCaseC dt inp out => Rec (CaseClause inp out) (CaseClauses dt) -> Instr (ToT dt : inp) out -- | Lift an instruction to case clause. -- -- You should write out constructor name corresponding to the clause -- explicitly. Prefix constructor name with "c" letter, otherwise your -- label will not be recognized by Haskell parser. Passing constructor -- name can be circumvented but doing so is not recomended as mentioning -- contructor name improves readability and allows avoiding some -- mistakes. (//->) :: Label ("c" `AppendSymbol` ctor) -> Instr (AppendCtorField x inp) out -> CaseClause inp out ( 'CaseClauseParam ctor x) infixr 8 //-> -- | Unwrap a constructor with the given name. -- -- Rules which apply to instrWrap function work here as well. -- Although, unlike instrWrap, this function does not work for -- nullary constructors. instrUnwrapUnsafe :: forall dt name st. InstrUnwrapC dt name => Label name -> Instr (ToT dt : st) (ToT (CtorOnlyField name dt) : st) -- | Try to unwrap a constructor with the given name. hsUnwrap :: forall dt name. InstrUnwrapC dt name => Label name -> dt -> Maybe (CtorOnlyField name dt) module Michelson.Typed module Michelson.TypeCheck.Types -- | Data type holding type information for stack (Heterogeneous Stack -- Type). -- -- This data type is used along with instruction data type Instr -- to carry information about its input and output stack types. -- -- That is, if there is value instr :: Instr inp out, along with -- this instr one may carry inpHST :: HST inp and -- outHST :: HST out which will contain whole information about -- input and output stack types for instr. -- -- Data type HST is very similar to Data.Vinyl.Rec, but -- is specialized for a particular purpose. In particular, definition of -- HST (t1 ': t2 ': ... tn ': '[]) requires constraints -- (Typeable t1, Typeable t2, ..., Typeable tn) as well as -- constraints (Typeable '[ t1 ], Typeable '[ t1, t2 ], ...). -- These applications of Typeable class are required for -- convenient usage of type encoded by HST ts with some -- functions from Data.Typeable. -- -- Data type HST (Heterogeneous Stack Type) is a heterogenuous -- list of triples. First element of triple is a type singleton which is -- due to main motivation behind HST, namely for it to be used -- as representation of Instr type data for pattern-matching. -- Second element of triple is a structure, holding field and type -- annotations for a given type. Third element of triple is an optional -- variable annotation for the stack element. data HST (ts :: [T]) [SNil] :: HST '[] [::&] :: (Typeable xs, Typeable x, SingI x) => (Sing x, Notes x, VarAnn) -> HST xs -> HST (x : xs) infixr 7 ::& -- | Append a type to HST, assuming that notes and annotations for -- this type are unknown. (-:&) :: (Typeable xs, Typeable x, SingI x) => Sing x -> HST xs -> HST (x : xs) infixr 7 -:& -- | No-argument type wrapper for HST data type. data SomeHST [SomeHST] :: Typeable ts => HST ts -> SomeHST -- | This data type keeps part of type check result - instruction and -- corresponding output stack. data SomeInstrOut inp -- | Type-check result with concrete output stack, most common case. -- -- Output stack type is wrapped inside the type and Typeable -- constraint is provided to allow convenient unwrapping. [:::] :: Typeable out => Instr inp out -> HST out -> SomeInstrOut inp -- | Type-check result which matches against arbitrary output stack. -- Information about annotations in the output stack is absent. -- -- This case is only possible when the corresponding code terminates with -- FAILWITH instruction in all possible executions. The opposite -- may be not true though (example: you push always-failing lambda and -- immediatelly execute it - stack type is known). [AnyOutInstr] :: (forall out. Instr inp out) -> SomeInstrOut inp infix 9 ::: -- | Data type keeping the whole type check result: instruction and type -- representations of instruction's input and output. data SomeInstr inp [:/] :: HST inp -> SomeInstrOut inp -> SomeInstr inp infix 8 :/ -- | Data type, holding strictly-typed Michelson value along with its type -- singleton. data SomeValue [::::] :: (SingI t, Typeable t) => Value t -> (Sing t, Notes t) -> SomeValue data SomeContract [SomeContract] :: (Each [Typeable, SingI, HasNoOp] [st, cp], HasNoBigMap cp, BigMapConstraint st) => Contract cp st -> HST (ContractInp cp st) -> HST (ContractOut st) -> SomeContract -- | Data type, holding strictly-typed Michelson value along with its type -- singleton. data SomeCValue [:--:] :: (SingI t, Typeable t) => CValue t -> Sing t -> SomeCValue -- | Set of variables defined in a let-block. data BoundVars BoundVars :: Map Var Type -> Maybe SomeHST -> BoundVars -- | State for type checking nop type TcExtFrames = [BoundVars] noBoundVars :: BoundVars instance GHC.Show.Show Michelson.TypeCheck.Types.SomeHST instance GHC.Show.Show Michelson.TypeCheck.Types.SomeContract instance GHC.Show.Show (Michelson.Typed.Instr.ExtInstr inp) => GHC.Show.Show (Michelson.TypeCheck.Types.SomeInstr inp) instance GHC.Show.Show (Michelson.Typed.Instr.ExtInstr inp) => GHC.Show.Show (Michelson.TypeCheck.Types.SomeInstrOut inp) instance GHC.Classes.Eq Michelson.TypeCheck.Types.SomeHST instance GHC.Show.Show (Michelson.TypeCheck.Types.HST ts) instance GHC.Classes.Eq (Michelson.TypeCheck.Types.HST ts) module Michelson.TypeCheck.Error -- | Data type that represents various errors which are related to type -- system. These errors are used to specify info about type check errors -- in TCError data type. data TCTypeError -- | Annotation unify error AnnError :: AnnConvergeError -> TCTypeError -- | Notes extraction error ExtractionTypeMismatch :: TypeConvergeError -> TCTypeError -- | Type equality error TypeEqError :: T -> T -> TCTypeError -- | Stacks equality error StackEqError :: [T] -> [T] -> TCTypeError -- | Error that happens when some instruction doesn't have support for some -- types UnsupportedTypes :: [T] -> TCTypeError -- | Error that happens when we meet unknown type UnknownType :: T -> TCTypeError -- | Type check error data TCError TCFailedOnInstr :: ExpandedInstr -> SomeHST -> Text -> InstrCallStack -> Maybe TCTypeError -> TCError TCFailedOnValue :: Value -> T -> Text -> InstrCallStack -> Maybe TCTypeError -> TCError TCContractError :: Text -> Maybe TCTypeError -> TCError TCUnreachableCode :: InstrCallStack -> NonEmpty ExpandedOp -> TCError TCExtError :: SomeHST -> InstrCallStack -> ExtError -> TCError -- | Various type errors possible when checking Morley extension commands data ExtError LengthMismatch :: StackTypePattern -> ExtError VarError :: Text -> StackFn -> ExtError TypeMismatch :: StackTypePattern -> Int -> TCTypeError -> ExtError TyVarMismatch :: Var -> Type -> StackTypePattern -> Int -> TCTypeError -> ExtError StkRestMismatch :: StackTypePattern -> SomeHST -> SomeHST -> TCTypeError -> ExtError TestAssertError :: Text -> ExtError InvalidStackReference :: StackRef -> StackSize -> ExtError newtype StackSize StackSize :: Natural -> StackSize instance GHC.Classes.Eq Michelson.TypeCheck.Error.TCError instance GHC.Classes.Eq Michelson.TypeCheck.Error.ExtError instance GHC.Classes.Eq Michelson.TypeCheck.Error.StackSize instance GHC.Show.Show Michelson.TypeCheck.Error.StackSize instance GHC.Classes.Eq Michelson.TypeCheck.Error.TCTypeError instance GHC.Show.Show Michelson.TypeCheck.Error.TCTypeError instance Formatting.Buildable.Buildable Michelson.TypeCheck.Error.TCError instance Formatting.Buildable.Buildable Michelson.Untyped.Instr.ExpandedInstr => GHC.Show.Show Michelson.TypeCheck.Error.TCError instance Formatting.Buildable.Buildable Michelson.Untyped.Instr.ExpandedInstr => GHC.Exception.Type.Exception Michelson.TypeCheck.Error.TCError instance Formatting.Buildable.Buildable Michelson.TypeCheck.Error.ExtError instance Formatting.Buildable.Buildable Michelson.TypeCheck.Error.TCTypeError module Michelson.TypeCheck.TypeCheck type TcInstrHandler = forall inp. Typeable inp => ExpandedInstr -> HST inp -> TypeCheckInstr (SomeInstr inp) type TcOriginatedContracts = Map Address Type type TcResult inp = Either TCError (SomeInstr inp) -- | The typechecking state data TypeCheckEnv TypeCheckEnv :: TcExtFrames -> Type -> TcOriginatedContracts -> TypeCheckEnv [tcExtFrames] :: TypeCheckEnv -> TcExtFrames [tcContractParam] :: TypeCheckEnv -> Type [tcContracts] :: TypeCheckEnv -> TcOriginatedContracts type TypeCheck a = ExceptT TCError (State TypeCheckEnv) a runTypeCheck :: Type -> TcOriginatedContracts -> TypeCheck a -> Either TCError a type TypeCheckInstr a = ReaderT InstrCallStack (ExceptT TCError (State TypeCheckEnv)) a -- | Run type checker as if it worked isolated from other world - no access -- to environment of the current contract is allowed. -- -- Use this function for test purposes only. runTypeCheckTest :: TypeCheck a -> Either TCError a tcContractParamL :: Lens' TypeCheckEnv Type tcContractsL :: Lens' TypeCheckEnv TcOriginatedContracts tcExtFramesL :: Lens' TypeCheckEnv TcExtFrames module Michelson.TypeCheck.Helpers onLeft :: Either a c -> (a -> b) -> Either b c -- | Function which derives special annotations for CDR / CAR instructions. deriveSpecialVN :: VarAnn -> FieldAnn -> VarAnn -> VarAnn -- | Function which derives special annotations for PAIR instruction. -- -- Namely, it does following transformation: PAIR % -- % [ p.a int : p.b int : .. ] ~ [ p -- (pair (int %a) (int %b) : .. ] -- -- All relevant cases (e.g. PAIR %myf % ) are handled -- as they should be according to spec. deriveSpecialFNs :: FieldAnn -> FieldAnn -> VarAnn -> VarAnn -> (VarAnn, FieldAnn, FieldAnn) -- | Append suffix to variable annotation (if it's not empty) deriveVN :: VarAnn -> VarAnn -> VarAnn -- | Function which extracts annotations for or type (for left and -- right parts). -- -- It extracts field/type annotations and also auto-generates variable -- annotations if variable annotation is not provided as second argument. deriveNsOr :: Notes ( 'TOr a b) -> VarAnn -> (Notes a, Notes b, VarAnn, VarAnn) -- | Function which extracts annotations for option t type. -- -- It extracts field/type annotations and also auto-generates variable -- annotation for Some case if it is not provided as second -- argument. deriveNsOption :: Notes ( 'TOption a) -> VarAnn -> (Notes a, VarAnn) convergeHSTEl :: (Sing t, Notes t, VarAnn) -> (Sing t, Notes t, VarAnn) -> Either AnnConvergeError (Sing t, Notes t, VarAnn) -- | Combine annotations from two given stack types convergeHST :: HST ts -> HST ts -> Either AnnConvergeError (HST ts) -- | Extract singleton for each single type of the given stack. hstToTs :: HST st -> [T] -- | Check whether the given stack types are equal. eqHST :: forall as bs. (Typeable as, Typeable bs) => HST as -> HST bs -> Either TCTypeError (as :~: bs) -- | Check whether the given stack has size 1 and its only element matches -- the given type. This function is a specialized version of -- eqHST. eqHST1 :: forall t st. (Typeable st, Typeable t, SingI t) => HST st -> Either TCTypeError (st :~: '[t]) lengthHST :: HST xs -> Natural -- | Check whether elements go in strictly ascending order and return the -- original list (to keep only one pass on the original list). ensureDistinctAsc :: (Ord b, Show a) => (a -> b) -> [a] -> Either Text [a] -- | Function eqType is a simple wrapper around -- Data.Typeable.eqT suited for use within Either -- TCTypeError a applicative. eqType :: forall (a :: T) (b :: T). Each [Typeable, SingI] [a, b] => Either TCTypeError (a :~: b) checkEqT :: forall (a :: T) (b :: T) ts m. (Each [Typeable, SingI] [a, b], Typeable ts, MonadReader InstrCallStack m, MonadError TCError m) => ExpandedInstr -> HST ts -> Text -> m (a :~: b) checkEqHST :: forall (a :: [T]) (b :: [T]) ts m. (Typeable a, Typeable b, Typeable ts, MonadReader InstrCallStack m, MonadError TCError m) => HST a -> HST b -> ExpandedInstr -> HST ts -> Text -> m (a :~: b) onTypeCheckInstrAnnErr :: (MonadReader InstrCallStack m, MonadError TCError m, Typeable ts) => ExpandedInstr -> HST ts -> Text -> Either AnnConvergeError a -> m a onTypeCheckInstrTypeErr :: (MonadReader InstrCallStack m, MonadError TCError m, Typeable ts) => ExpandedInstr -> HST ts -> Text -> Either TypeConvergeError a -> m a onTypeCheckInstrErr :: (MonadReader InstrCallStack m, MonadError TCError m) => ExpandedInstr -> SomeHST -> Text -> Either TCTypeError a -> m a typeCheckInstrErr :: (MonadReader InstrCallStack m, MonadError TCError m) => ExpandedInstr -> SomeHST -> Text -> m a typeCheckImpl :: forall inp. Typeable inp => TcInstrHandler -> [ExpandedOp] -> HST inp -> TypeCheckInstr (SomeInstr inp) -- | Check whether typed and untyped types converge compareTypes :: forall t. (Typeable t, SingI t) => (Sing t, Notes t) -> Type -> Either TCTypeError () -- | Generic implementation for MEMeration memImpl :: forall (q :: CT) (c :: T) ts inp m. (MonadReader InstrCallStack m, MonadError TCError m, Typeable ts, Typeable (MemOpKey c), SingI (MemOpKey c), MemOp c, inp ~ ( 'Tc q : (c : ts))) => ExpandedInstr -> HST inp -> VarAnn -> m (SomeInstr inp) getImpl :: forall c getKey rs inp m. (GetOp c, Typeable (GetOpKey c), Typeable (GetOpVal c), SingI (GetOpVal c), SingI (GetOpKey c), inp ~ (getKey : (c : rs)), MonadReader InstrCallStack m, MonadError TCError m) => ExpandedInstr -> HST (getKey : (c : rs)) -> Sing (GetOpVal c) -> Notes (GetOpVal c) -> VarAnn -> m (SomeInstr inp) updImpl :: forall c updKey updParams rs inp m. (UpdOp c, Typeable (UpdOpKey c), SingI (UpdOpKey c), Typeable (UpdOpParams c), SingI (UpdOpParams c), inp ~ (updKey : (updParams : (c : rs))), MonadReader InstrCallStack m, MonadError TCError m) => ExpandedInstr -> HST (updKey : (updParams : (c : rs))) -> m (SomeInstr inp) sliceImpl :: (SliceOp c, Typeable c, inp ~ ( 'Tc 'CNat : ( 'Tc 'CNat : (c : rs))), Monad m) => HST inp -> VarAnn -> m (SomeInstr inp) concatImpl :: (ConcatOp c, Typeable c, inp ~ (c : (c : rs)), MonadReader InstrCallStack m, MonadError TCError m) => HST inp -> VarAnn -> m (SomeInstr inp) concatImpl' :: (ConcatOp c, Typeable c, inp ~ ( 'TList c : rs), Monad m) => HST inp -> VarAnn -> m (SomeInstr inp) sizeImpl :: (SizeOp c, inp ~ (c : rs), Monad m) => HST inp -> VarAnn -> m (SomeInstr inp) -- | Helper function to construct instructions for binary arithmetic -- operations. arithImpl :: (Typeable (ArithRes aop n m), SingI (ArithRes aop n m), Typeable ( 'Tc (ArithRes aop n m) : s), inp ~ ( 'Tc n : ( 'Tc m : s)), Monad t) => Instr inp ( 'Tc (ArithRes aop n m) : s) -> HST inp -> VarAnn -> t (SomeInstr inp) addImpl :: forall a b inp rs m. (Typeable rs, Each [Typeable, SingI] [a, b], inp ~ ( 'Tc a : ( 'Tc b : rs)), MonadReader InstrCallStack m, MonadError TCError m) => Sing a -> Sing b -> HST inp -> VarAnn -> m (SomeInstr inp) subImpl :: forall a b inp rs m. (Typeable rs, Each [Typeable, SingI] [a, b], inp ~ ( 'Tc a : ( 'Tc b : rs)), MonadReader InstrCallStack m, MonadError TCError m) => Sing a -> Sing b -> HST inp -> VarAnn -> m (SomeInstr inp) mulImpl :: forall a b inp rs m. (Typeable rs, Each [Typeable, SingI] [a, b], inp ~ ( 'Tc a : ( 'Tc b : rs)), MonadReader InstrCallStack m, MonadError TCError m) => Sing a -> Sing b -> HST inp -> VarAnn -> m (SomeInstr inp) edivImpl :: forall a b inp rs m. (Typeable rs, Each [Typeable, SingI] [a, b], inp ~ ( 'Tc a : ( 'Tc b : rs)), MonadReader InstrCallStack m, MonadError TCError m) => Sing a -> Sing b -> HST inp -> VarAnn -> m (SomeInstr inp) compareImpl :: forall a b inp rs m. (Typeable rs, Each [Typeable, SingI] [a, b], inp ~ ( 'Tc a : ( 'Tc b : rs)), MonadReader InstrCallStack m, MonadError TCError m) => Sing a -> Sing b -> HST inp -> VarAnn -> m (SomeInstr inp) -- | Helper function to construct instructions for binary arithmetic -- operations. unaryArithImpl :: (Typeable (UnaryArithRes aop n), SingI (UnaryArithRes aop n), Typeable ( 'Tc (UnaryArithRes aop n) : s), inp ~ ( 'Tc n : s), Monad t) => Instr inp ( 'Tc (UnaryArithRes aop n) : s) -> HST inp -> VarAnn -> t (SomeInstr inp) module Michelson.TypeCheck.Value -- | Function typeCheckValImpl converts a single Michelson value -- given in representation from Michelson.Type module to -- representation in strictly typed GADT. -- -- As a third argument, typeCheckValImpl accepts expected type -- of value. -- -- Type checking algorithm pattern-matches on parse value representation, -- expected type t and constructs Val t value. -- -- If there was no match on a given pair of value and expected type, that -- is interpreted as input of wrong type and type check finishes with -- error. typeCheckValImpl :: TcInstrHandler -> Value -> (Sing t, Notes t) -> TypeCheckInstr SomeValue typeCheckCValue :: Value' op -> CT -> Either (Value' op, TCTypeError) SomeCValue -- | Type-checking of Morley extension. module Michelson.TypeCheck.Ext typeCheckExt :: forall s. Typeable s => TypeCheckListHandler s -> ExpandedExtInstr -> HST s -> TypeCheckInstr (SomeInstr s) -- | Module, providing functions for conversion from instruction and value -- representation from Michelson.Type module to strictly-typed -- GADT-based representation from Michelson.Value module. -- -- This conversion is labeled as type check because that's what we are -- obliged to do on our way. -- -- Type check algorithm relies on the property of Michelson language that -- each instruction on a given input stack type produces a definite -- output stack type. Michelson contract defines concrete types for -- storage and parameter, from which input stack type is deduced. Then -- this type is being combined with each subsequent instruction, -- producing next stack type after each application. -- -- Function typeCheck takes list of instructions and returns -- value of type Instr inp out along with HST inp and -- HST out all wrapped into SomeInstr data type. This -- wrapping is done to satsify Haskell type system (which has no support -- for dependent types). Functions typeCheckInstr, -- typeCheckValue behave similarly. -- -- When a recursive call is made within typeCheck, -- typeCheckInstr or typeCheckValue, result of a call -- is unwrapped from SomeInstr and type information from HST -- inp and HST out is being used to assert that recursive -- call returned instruction of expected type (error is thrown -- otherwise). module Michelson.TypeCheck.Instr typeCheckContract :: TcOriginatedContracts -> Contract -> Either TCError SomeContract -- | Function typeCheckValue converts a single Michelson value -- given in representation from Michelson.Type module to -- representation in strictly typed GADT. -- -- As a second argument, typeCheckValue accepts expected type of -- value. -- -- Type checking algorithm pattern-matches on parse value representation, -- expected type t and constructs Val t value. -- -- If there was no match on a given pair of value and expected type, that -- is interpreted as input of wrong type and type check finishes with -- error. typeCheckValue :: Value -> (Sing t, Notes t) -> TypeCheckInstr SomeValue -- | Like typeCheckValue, but returns value of a desired type. typeVerifyValue :: forall t. (Typeable t, SingI t) => Value -> TypeCheckInstr (Value t) -- | Function typeCheckList converts list of Michelson -- instructions given in representation from Michelson.Type -- module to representation in strictly typed GADT. -- -- Types are checked along the way which is neccessary to construct a -- strictly typed value. -- -- As a second argument, typeCheckList accepts input stack type -- representation. typeCheckList :: Typeable inp => [ExpandedOp] -> HST inp -> TypeCheck (SomeInstr inp) module Michelson.TypeCheck typeCheckContract :: TcOriginatedContracts -> Contract -> Either TCError SomeContract -- | Function typeCheckValue converts a single Michelson value -- given in representation from Michelson.Type module to -- representation in strictly typed GADT. -- -- As a second argument, typeCheckValue accepts expected type of -- value. -- -- Type checking algorithm pattern-matches on parse value representation, -- expected type t and constructs Val t value. -- -- If there was no match on a given pair of value and expected type, that -- is interpreted as input of wrong type and type check finishes with -- error. typeCheckValue :: Value -> (Sing t, Notes t) -> TypeCheckInstr SomeValue -- | Like typeCheckValue, but returns value of a desired type. typeVerifyValue :: forall t. (Typeable t, SingI t) => Value -> TypeCheckInstr (Value t) -- | Function typeCheckList converts list of Michelson -- instructions given in representation from Michelson.Type -- module to representation in strictly typed GADT. -- -- Types are checked along the way which is neccessary to construct a -- strictly typed value. -- -- As a second argument, typeCheckList accepts input stack type -- representation. typeCheckList :: Typeable inp => [ExpandedOp] -> HST inp -> TypeCheck (SomeInstr inp) typeCheckCValue :: Value' op -> CT -> Either (Value' op, TCTypeError) SomeCValue typeCheckExt :: forall s. Typeable s => TypeCheckListHandler s -> ExpandedExtInstr -> HST s -> TypeCheckInstr (SomeInstr s) -- | Function eqType is a simple wrapper around -- Data.Typeable.eqT suited for use within Either -- TCTypeError a applicative. eqType :: forall (a :: T) (b :: T). Each [Typeable, SingI] [a, b] => Either TCTypeError (a :~: b) -- | Check whether typed and untyped types converge compareTypes :: forall t. (Typeable t, SingI t) => (Sing t, Notes t) -> Type -> Either TCTypeError () -- | Global blockchain state (emulated). module Michelson.Runtime.GState -- | State of a contract with code. data ContractState ContractState :: !Mutez -> !Value -> !Contract -> ContractState -- | Amount of mutez owned by this contract. [csBalance] :: ContractState -> !Mutez -- | Storage value associated with this contract. [csStorage] :: ContractState -> !Value -- | Contract itself (untyped). [csContract] :: ContractState -> !Contract -- | State of an arbitrary address. data AddressState -- | For contracts without code we store only its balance. ASSimple :: !Mutez -> AddressState -- | For contracts with code we store more state represented by -- ContractState. ASContract :: !ContractState -> AddressState -- | Extract balance from AddressState. asBalance :: AddressState -> Mutez -- | Persistent data passed to Morley contracts which can be updated as -- result of contract execution. data GState GState :: Map Address AddressState -> GState -- | All known addresses and their state. [gsAddresses] :: GState -> Map Address AddressState -- | Initially these addresses have a lot of money. genesisAddresses :: NonEmpty Address -- | KeyHash of genesis address. genesisKeyHashes :: NonEmpty KeyHash -- | One of genesis addresses. genesisAddress :: Address -- | More genesis addresses -- -- We know size of genesisAddresses, so it is safe to use -- !! genesisAddress1 :: Address -- | More genesis addresses -- -- We know size of genesisAddresses, so it is safe to use -- !! genesisAddress2 :: Address -- | More genesis addresses -- -- We know size of genesisAddresses, so it is safe to use -- !! genesisAddress3 :: Address genesisAddress4 :: Address genesisAddress5 :: Address genesisAddress6 :: Address -- | One of genesis key hashes. genesisKeyHash :: KeyHash -- | Initial GState. It's supposed to be used if no GState is -- provided. It puts plenty of money on each genesis address. initGState :: GState -- | Read GState from a file. readGState :: FilePath -> IO GState -- | Write GState to a file. writeGState :: FilePath -> GState -> IO () -- | Updates that can be applied to GState. data GStateUpdate GSAddAddress :: !Address -> !AddressState -> GStateUpdate GSSetStorageValue :: !Address -> !Value -> GStateUpdate GSSetBalance :: !Address -> !Mutez -> GStateUpdate data GStateUpdateError GStateAddressExists :: !Address -> GStateUpdateError GStateUnknownAddress :: !Address -> GStateUpdateError GStateNotContract :: !Address -> GStateUpdateError -- | Apply GStateUpdate to GState. applyUpdate :: GStateUpdate -> GState -> Either GStateUpdateError GState -- | Apply a list of GStateUpdates to GState. applyUpdates :: [GStateUpdate] -> GState -> Either GStateUpdateError GState -- | Retrive all contracts stored in GState extractAllContracts :: GState -> TcOriginatedContracts instance GHC.Show.Show Michelson.Runtime.GState.GStateUpdateError instance GHC.Classes.Eq Michelson.Runtime.GState.GStateUpdate instance GHC.Show.Show Michelson.Runtime.GState.GStateUpdate instance GHC.Show.Show Michelson.Runtime.GState.GStateParseError instance Formatting.Buildable.Buildable Michelson.Runtime.GState.GStateUpdateError instance Formatting.Buildable.Buildable Michelson.Runtime.GState.GStateUpdate instance GHC.Exception.Type.Exception Michelson.Runtime.GState.GStateParseError instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Runtime.GState.GState instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Runtime.GState.GState instance GHC.Show.Show Michelson.Runtime.GState.GState instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Runtime.GState.AddressState instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Runtime.GState.AddressState instance GHC.Classes.Eq Michelson.Runtime.GState.AddressState instance GHC.Generics.Generic Michelson.Runtime.GState.AddressState instance GHC.Show.Show Michelson.Runtime.GState.AddressState instance Formatting.Buildable.Buildable Michelson.Runtime.GState.AddressState instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Runtime.GState.ContractState instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Runtime.GState.ContractState instance GHC.Classes.Eq Michelson.Runtime.GState.ContractState instance GHC.Generics.Generic Michelson.Runtime.GState.ContractState instance GHC.Show.Show Michelson.Runtime.GState.ContractState instance Formatting.Buildable.Buildable Michelson.Runtime.GState.ContractState -- | Utilities for arbitrary data generation in property tests. module Michelson.Test.Gen -- | Minimal (earliest) timestamp used for Arbitrary (CValue -- 'CTimestamp) minTimestamp :: Timestamp -- | Maximal (latest) timestamp used for Arbitrary (CValue -- 'CTimestamp) maxTimestamp :: Timestamp -- | Median of minTimestamp and maxTimestamp. Useful for -- testing (exactly half of generated dates will be before and after this -- date). midTimestamp :: Timestamp instance Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Typed.CValue.CValue 'Michelson.Untyped.Type.CKeyHash) instance Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Typed.CValue.CValue 'Michelson.Untyped.Type.CMutez) instance Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Typed.CValue.CValue 'Michelson.Untyped.Type.CInt) instance Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Typed.CValue.CValue a) => Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Typed.Value.Value' instr ('Michelson.Typed.T.Tc a)) instance Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Typed.Value.Value' instr a) => Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Typed.Value.Value' instr ('Michelson.Typed.T.TList a)) instance Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Typed.Value.Value' instr 'Michelson.Typed.T.TUnit) instance (Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Typed.Value.Value' instr a), Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Typed.Value.Value' instr b)) => Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Typed.Value.Value' instr ('Michelson.Typed.T.TPair a b)) instance Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Typed.CValue.CValue 'Michelson.Untyped.Type.CTimestamp) instance Test.QuickCheck.Arbitrary.Arbitrary Tezos.Core.Mutez instance Test.QuickCheck.Arbitrary.Arbitrary Tezos.Core.Timestamp module Michelson.Printer -- | Generalize converting a type into a Text.PrettyPrint.Leijen.Text.Doc. -- Used to pretty print Michelson code and define Fmt.Buildable -- instances. class RenderDoc a renderDoc :: RenderDoc a => a -> Doc -- | Whether a value can be represented in Michelson code. Normally either -- all values of some type are renderable or not renderable. However, in -- case of instructions we have extra instructions which should not be -- rendered. Note: it's not suficcient to just return mempty for -- such instructions, because sometimes we want to print lists of -- instructions and we need to ignore them complete (to avoid putting -- redundant separators). isRenderable :: RenderDoc a => a -> Bool -- | Convert Doc to Text with a line width of 80. printDoc :: Doc -> Text -- | Convert an untyped contract into a textual representation which will -- be accepted by the OCaml reference client. printUntypedContract :: RenderDoc op => Contract' op -> Text -- | Convert a typed contract into a textual representation which will be -- accepted by the OCaml reference client. printTypedContract :: (SingI p, SingI s) => Contract p s -> Text module Michelson.Macro data CadrStruct A :: CadrStruct D :: CadrStruct data PairStruct F :: (VarAnn, FieldAnn) -> PairStruct P :: PairStruct -> PairStruct -> PairStruct -- | Built-in Michelson Macros defined by the specification data Macro CASE :: NonEmpty [ParsedOp] -> Macro TAG :: Natural -> NonEmpty Type -> Macro VIEW :: [ParsedOp] -> Macro VOID :: [ParsedOp] -> Macro CMP :: ParsedInstr -> VarAnn -> Macro IFX :: ParsedInstr -> [ParsedOp] -> [ParsedOp] -> Macro IFCMP :: ParsedInstr -> VarAnn -> [ParsedOp] -> [ParsedOp] -> Macro FAIL :: Macro PAPAIR :: PairStruct -> TypeAnn -> VarAnn -> Macro UNPAIR :: PairStruct -> Macro CADR :: [CadrStruct] -> VarAnn -> FieldAnn -> Macro SET_CADR :: [CadrStruct] -> VarAnn -> FieldAnn -> Macro MAP_CADR :: [CadrStruct] -> VarAnn -> FieldAnn -> [ParsedOp] -> Macro DIIP :: Integer -> [ParsedOp] -> Macro DUUP :: Integer -> VarAnn -> Macro ASSERT :: Macro ASSERTX :: ParsedInstr -> Macro ASSERT_CMP :: ParsedInstr -> Macro ASSERT_NONE :: Macro ASSERT_SOME :: Macro ASSERT_LEFT :: Macro ASSERT_RIGHT :: Macro IF_SOME :: [ParsedOp] -> [ParsedOp] -> Macro IF_RIGHT :: [ParsedOp] -> [ParsedOp] -> Macro -- | A programmer-defined macro data LetMacro LetMacro :: Text -> StackFn -> [ParsedOp] -> LetMacro [lmName] :: LetMacro -> Text [lmSig] :: LetMacro -> StackFn [lmExpr] :: LetMacro -> [ParsedOp] type ParsedValue = Value' ParsedOp type ParsedInstr = InstrAbstract ParsedOp -- | Unexpanded instructions produced directly by the ops parser, -- which contains primitive Michelson Instructions, inline-able macros -- and sequences data ParsedOp -- | Primitive Michelson instruction Prim :: ParsedInstr -> SrcPos -> ParsedOp -- | Built-in Michelson macro defined by the specification Mac :: Macro -> SrcPos -> ParsedOp -- | User-defined macro with instructions to be inlined LMac :: LetMacro -> SrcPos -> ParsedOp -- | A sequence of instructions Seq :: [ParsedOp] -> SrcPos -> ParsedOp type ParsedUTestAssert = TestAssert ParsedOp type ParsedUExtInstr = ExtInstrAbstract ParsedOp -- | Expand all macros in parsed contract. expandContract :: Contract' ParsedOp -> Contract expandValue :: ParsedValue -> Value mapLeaves :: [(VarAnn, FieldAnn)] -> PairStruct -> PairStruct expand :: LetCallStack -> ParsedOp -> ExpandedOp expandList :: [ParsedOp] -> [ExpandedOp] expandMacro :: InstrCallStack -> Macro -> [ExpandedOp] expandPapair :: InstrCallStack -> PairStruct -> TypeAnn -> VarAnn -> [ExpandedOp] expandUnpapair :: InstrCallStack -> PairStruct -> [ExpandedOp] expandCadr :: InstrCallStack -> [CadrStruct] -> VarAnn -> FieldAnn -> [ExpandedOp] expandSetCadr :: InstrCallStack -> [CadrStruct] -> VarAnn -> FieldAnn -> [ExpandedOp] expandMapCadr :: InstrCallStack -> [CadrStruct] -> VarAnn -> FieldAnn -> [ParsedOp] -> [ExpandedOp] instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Macro.Macro instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Macro.Macro instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Macro.CadrStruct instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Macro.CadrStruct instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Macro.PairStruct instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Macro.PairStruct instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Macro.LetMacro instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Macro.LetMacro instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Macro.ParsedOp instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Macro.ParsedOp instance GHC.Generics.Generic Michelson.Macro.LetMacro instance Data.Data.Data Michelson.Macro.LetMacro instance GHC.Show.Show Michelson.Macro.LetMacro instance GHC.Classes.Eq Michelson.Macro.LetMacro instance GHC.Generics.Generic Michelson.Macro.ParsedOp instance Data.Data.Data Michelson.Macro.ParsedOp instance GHC.Show.Show Michelson.Macro.ParsedOp instance GHC.Classes.Eq Michelson.Macro.ParsedOp instance GHC.Generics.Generic Michelson.Macro.Macro instance Data.Data.Data Michelson.Macro.Macro instance GHC.Show.Show Michelson.Macro.Macro instance GHC.Classes.Eq Michelson.Macro.Macro instance GHC.Generics.Generic Michelson.Macro.CadrStruct instance Data.Data.Data Michelson.Macro.CadrStruct instance GHC.Show.Show Michelson.Macro.CadrStruct instance GHC.Classes.Eq Michelson.Macro.CadrStruct instance GHC.Generics.Generic Michelson.Macro.PairStruct instance Data.Data.Data Michelson.Macro.PairStruct instance GHC.Show.Show Michelson.Macro.PairStruct instance GHC.Classes.Eq Michelson.Macro.PairStruct instance Formatting.Buildable.Buildable Michelson.Macro.LetMacro instance Michelson.Printer.Util.RenderDoc Michelson.Macro.ParsedOp instance Formatting.Buildable.Buildable Michelson.Macro.ParsedOp instance Formatting.Buildable.Buildable Michelson.Macro.Macro instance Formatting.Buildable.Buildable Michelson.Macro.CadrStruct instance Formatting.Buildable.Buildable Michelson.Macro.PairStruct module Michelson.Let -- | A programmer-defined type-synonym data LetType LetType :: Text -> Type -> LetType [ltName] :: LetType -> Text [ltSig] :: LetType -> Type -- | A programmer-defined constant data LetValue LetValue :: Text -> Type -> Value' ParsedOp -> LetValue [lvName] :: LetValue -> Text [lvSig] :: LetValue -> Type [lvVal] :: LetValue -> Value' ParsedOp instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Let.LetType instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Let.LetType instance Data.Aeson.Types.ToJSON.ToJSON Michelson.Let.LetValue instance Data.Aeson.Types.FromJSON.FromJSON Michelson.Let.LetValue instance GHC.Show.Show Michelson.Let.LetType instance GHC.Classes.Eq Michelson.Let.LetType instance GHC.Show.Show Michelson.Let.LetValue instance GHC.Classes.Eq Michelson.Let.LetValue -- | Core parser types module Michelson.Parser.Types type Parser = ReaderT LetEnv (Parsec CustomParserException Text) -- | The environment containing lets from the let-block data LetEnv LetEnv :: Map Text LetMacro -> Map Text LetValue -> Map Text LetType -> LetEnv [letMacros] :: LetEnv -> Map Text LetMacro [letValues] :: LetEnv -> Map Text LetValue [letTypes] :: LetEnv -> Map Text LetType noLetEnv :: LetEnv instance GHC.Classes.Eq Michelson.Parser.Types.LetEnv instance GHC.Show.Show Michelson.Parser.Types.LetEnv instance Data.Default.Class.Default a => Data.Default.Class.Default (Michelson.Parser.Types.Parser a) module Michelson.Parser.Lexer lexeme :: Parser a -> Parser a mSpace :: Parser () symbol :: Tokens Text -> Parser () symbol' :: Text -> Parser () string' :: (MonadParsec e s f, Tokens s ~ Text) => Text -> f Text parens :: Parser a -> Parser a braces :: Parser a -> Parser a brackets :: Parser a -> Parser a brackets' :: Parser a -> Parser a semicolon :: Parser () comma :: Parser () varID :: Parser Var module Michelson.Parser.Helpers -- | Make a parser from a string mkParser :: (a -> Text) -> a -> Parser a sepEndBy1 :: MonadPlus m => m a -> m sep -> m (NonEmpty a) -- | endBy2 p sep parses two or more occurrences of p, -- separated by sep. sepBy2 :: MonadPlus m => m a -> m sep -> m (NonEmpty a) -- | Apply given parser and return default value if it fails. parseDef :: Default a => Parser a -> Parser a -- | Parsing of untyped Michelson values. module Michelson.Parser.Value -- | Parse untyped ParsedValue. Take instruction parser as argument -- to avoid cyclic dependencies between modules, hence ' in its name. value' :: Parser ParsedOp -> Parser ParsedValue mkLetVal :: Map Text LetValue -> Parser LetValue stringLiteral :: Parser ParsedValue bytesLiteral :: Parser (Value' op) intLiteral :: Parser (Value' op) module Michelson.Parser.Annotations noteV :: Parser VarAnn noteF :: Parser FieldAnn noteFDef :: Parser FieldAnn noteTDef :: Parser TypeAnn noteVDef :: Parser VarAnn notesTVF :: Parser (TypeAnn, VarAnn, FieldAnn) notesTVF2 :: Parser (TypeAnn, VarAnn, (FieldAnn, FieldAnn)) notesTV :: Parser (TypeAnn, VarAnn) notesVF :: Parser (VarAnn, FieldAnn) fieldType :: Default a => Parser a -> Parser (a, TypeAnn) permute2Def :: (Default a, Default b, Monad f, Alternative f) => f a -> f b -> f (a, b) permute3Def :: (Default a, Default b, Default c, Monad f, Alternative f) => f a -> f b -> f c -> f (a, b, c) -- | Parsing of Michelson types. module Michelson.Parser.Type -- | Parse untyped Michelson Type (i. e. one with annotations). type_ :: Parser Type -- | Parse only explicit Type, Parameter and Storage -- are prohibited explicitType :: Parser Type comparable :: Parser Comparable -- | Parsing logic for extra instructions (Morley extensions) module Michelson.Parser.Ext extInstr :: Parser [ParsedOp] -> Parser ParsedUExtInstr stackType :: Parser StackTypePattern printComment :: Parser PrintComment -- | Parsing of Michelson instructions. module Michelson.Parser.Instr -- | Parser for primitive Michelson instruction (no macros and extensions). primInstr :: Parser (Contract' ParsedOp) -> Parser ParsedOp -> Parser ParsedInstr -- | Parse a sequence of instructions. ops' :: Parser ParsedOp -> Parser [ParsedOp] mapOp :: Parser ParsedOp -> Parser ParsedInstr pairOp :: Parser ParsedInstr cmpOp :: Parser ParsedInstr -- | Parsing of built-in Michelson macros. module Michelson.Parser.Macro macro :: Parser ParsedOp -> Parser Macro pairMac :: Parser Macro ifCmpMac :: Parser ParsedOp -> Parser Macro mapCadrMac :: Parser ParsedOp -> Parser Macro -- | Parsing of let blocks module Michelson.Parser.Let -- | let block parser letBlock :: Parser ParsedOp -> Parser LetEnv mkLetMac :: Map Text LetMacro -> Parser LetMacro letType :: Parser LetType module Michelson.Parser type Parser = ReaderT LetEnv (Parsec CustomParserException Text) -- | Michelson contract with let definitions program :: Parsec CustomParserException Text (Contract' ParsedOp) value :: Parser ParsedValue data CustomParserException UnknownTypeException :: CustomParserException StringLiteralException :: StringLiteralParserException -> CustomParserException OddNumberBytesException :: CustomParserException ProhibitedLetType :: Text -> CustomParserException -- | A non-empty collection of ParseErrors equipped with -- PosState that allows to pretty-print the errors efficiently and -- correctly. data ParseErrorBundle s e data ParserException ParserException :: ParseErrorBundle Text CustomParserException -> ParserException data StringLiteralParserException InvalidEscapeSequence :: Char -> StringLiteralParserException InvalidChar :: Char -> StringLiteralParserException -- | Parse with empty environment parseNoEnv :: Parser a -> String -> Text -> Either (ParseErrorBundle Text CustomParserException) a -- | Parses code block after "code" keyword of a contract. -- -- This function is part of the module API, its semantics should not -- change. codeEntry :: Parser [ParsedOp] -- | Parse untyped Michelson Type (i. e. one with annotations). type_ :: Parser Type -- | Parse only explicit Type, Parameter and Storage -- are prohibited explicitType :: Parser Type letType :: Parser LetType stringLiteral :: Parser ParsedValue bytesLiteral :: Parser (Value' op) intLiteral :: Parser (Value' op) printComment :: Parser PrintComment -- | Module, carrying logic of UNPACK instruction. -- -- This is nearly symmetric to adjacent Pack.hs module. -- -- When implementing this the following sources were used: -- -- module Michelson.Interpret.Unpack -- | Any decoding error. newtype UnpackError UnpackError :: Text -> UnpackError [unUnpackError] :: UnpackError -> Text -- | Deserialize bytes into the given value. Suitable for UNPACK -- operation only. unpackValue :: (SingI t, HasNoOp t, HasNoBigMap t) => UnpackEnv -> LByteString -> Either UnpackError (Value t) -- | Like unpackValue, for strict byte array. unpackValue' :: (SingI t, HasNoOp t, HasNoBigMap t) => UnpackEnv -> ByteString -> Either UnpackError (Value t) data UnpackEnv UnpackEnv :: TcOriginatedContracts -> UnpackEnv [ueContracts] :: UnpackEnv -> TcOriginatedContracts instance GHC.Classes.Eq Michelson.Interpret.Unpack.UnpackError instance GHC.Show.Show Michelson.Interpret.Unpack.UnpackError instance Formatting.Buildable.Buildable Michelson.Interpret.Unpack.UnpackError -- | Module, carrying logic of PACK instruction. -- -- This is nearly symmetric to adjacent Unpack.hs module. module Michelson.Interpret.Pack -- | Serialize a value given to PACK instruction. packValue :: (SingI t, HasNoOp t, HasNoBigMap t) => Value t -> LByteString -- | Same as packValue, for strict bytestring. packValue' :: (SingI t, HasNoOp t, HasNoBigMap t) => Value t -> ByteString -- | Module, containing function to interpret Michelson instructions -- against given context and input stack. module Michelson.Interpret -- | Environment for contract execution. data ContractEnv ContractEnv :: !Timestamp -> !RemainingSteps -> !Mutez -> TcOriginatedContracts -> !Address -> !Address -> !Address -> !Mutez -> ContractEnv -- | Timestamp of the block whose validation triggered this execution. [ceNow] :: ContractEnv -> !Timestamp -- | Number of steps after which execution unconditionally terminates. [ceMaxSteps] :: ContractEnv -> !RemainingSteps -- | Current amount of mutez of the current contract. [ceBalance] :: ContractEnv -> !Mutez -- | Mapping from existing contracts' addresses to their executable -- representation. [ceContracts] :: ContractEnv -> TcOriginatedContracts -- | Address of the interpreted contract. [ceSelf] :: ContractEnv -> !Address -- | The contract that initiated the current transaction. [ceSource] :: ContractEnv -> !Address -- | The contract that initiated the current internal transaction. [ceSender] :: ContractEnv -> !Address -- | Amount of the current transaction. [ceAmount] :: ContractEnv -> !Mutez data InterpreterState InterpreterState :: MorleyLogs -> RemainingSteps -> InterpreterState [isMorleyLogs] :: InterpreterState -> MorleyLogs [isRemainingSteps] :: InterpreterState -> RemainingSteps -- | Represents `[FAILED]` state of a Michelson program. Contains value -- that was on top of the stack when FAILWITH was called. data MichelsonFailed [MichelsonFailedWith] :: (Typeable t, SingI t) => Value t -> MichelsonFailed [MichelsonArithError] :: (Typeable n, Typeable m) => ArithError (CValue n) (CValue m) -> MichelsonFailed [MichelsonGasExhaustion] :: MichelsonFailed [MichelsonFailedTestAssert] :: Text -> MichelsonFailed newtype RemainingSteps RemainingSteps :: Word64 -> RemainingSteps data SomeItStack [SomeItStack] :: ExtInstr inp -> Rec Value inp -> SomeItStack type EvalOp a = ExceptT MichelsonFailed (ReaderT ContractEnv (State InterpreterState)) a -- | Morley interpreter state newtype MorleyLogs MorleyLogs :: [Text] -> MorleyLogs [unMorleyLogs] :: MorleyLogs -> [Text] noMorleyLogs :: MorleyLogs interpret :: Contract cp st -> Value cp -> Value st -> ContractEnv -> ContractReturn st -- | Emulate multiple calls of a contract. interpretRepeated :: Contract cp st -> [Value cp] -> Value st -> ContractEnv -> ContractReturn st type ContractReturn st = (Either MichelsonFailed ([Operation], Value st), InterpreterState) -- | Interpret a contract without performing any side effects. interpretUntyped :: Contract -> Value -> Value -> ContractEnv -> Either InterpretUntypedError InterpretUntypedResult data InterpretUntypedError RuntimeFailure :: (MichelsonFailed, MorleyLogs) -> InterpretUntypedError IllTypedContract :: TCError -> InterpretUntypedError IllTypedParam :: TCError -> InterpretUntypedError IllTypedStorage :: TCError -> InterpretUntypedError UnexpectedParamType :: TCTypeError -> InterpretUntypedError UnexpectedStorageType :: TCTypeError -> InterpretUntypedError data InterpretUntypedResult [InterpretUntypedResult] :: (Typeable st, SingI st, HasNoOp st) => {iurOps :: [Operation], iurNewStorage :: Value st, iurNewState :: InterpreterState} -> InterpretUntypedResult -- | Function to change amount of remaining steps stored in State monad runInstr :: Instr inp out -> Rec Value inp -> EvalOp (Rec Value out) runInstrNoGas :: forall a b. Instr a b -> Rec Value a -> EvalOp (Rec Value b) -- | Unpacks given raw data into a typed value. runUnpack :: forall t. (SingI t, HasNoOp t, HasNoBigMap t) => TcOriginatedContracts -> ByteString -> Either UnpackError (Value t) instance GHC.Show.Show Michelson.Interpret.InterpreterState instance GHC.Num.Num Michelson.Interpret.RemainingSteps instance Formatting.Buildable.Buildable Michelson.Interpret.RemainingSteps instance GHC.Classes.Ord Michelson.Interpret.RemainingSteps instance GHC.Classes.Eq Michelson.Interpret.RemainingSteps instance GHC.Show.Show Michelson.Interpret.RemainingSteps instance GHC.Generics.Generic Michelson.Interpret.InterpretUntypedError instance Formatting.Buildable.Buildable Michelson.Interpret.MorleyLogs instance Data.Default.Class.Default Michelson.Interpret.MorleyLogs instance GHC.Show.Show Michelson.Interpret.MorleyLogs instance GHC.Classes.Eq Michelson.Interpret.MorleyLogs instance GHC.Show.Show Michelson.Interpret.MichelsonFailed instance GHC.Show.Show Michelson.Interpret.InterpretUntypedError instance GHC.Show.Show Michelson.Interpret.InterpretUntypedResult instance Formatting.Buildable.Buildable Michelson.Interpret.InterpretUntypedError instance GHC.Classes.Eq Michelson.Interpret.MichelsonFailed instance Formatting.Buildable.Buildable Michelson.Interpret.MichelsonFailed -- | Utility functions for unit testing. module Michelson.Test.Unit type ContractReturn st = (Either MichelsonFailed ([Operation], Value st), InterpreterState) -- | Type for contract execution validation. -- -- It's a function which is supplied with contract execution output -- (failure or new storage with operation list). -- -- Function returns a property which type is designated by type variable -- prop and might be Property or Expectation or -- anything else relevant. type ContractPropValidator st prop = ContractReturn st -> prop -- | Contract's property tester against given input. Takes contract -- environment, initial storage and parameter, interprets contract on -- this input and invokes validation function. contractProp :: (IsoValue param, IsoValue storage, ToT param ~ cp, ToT storage ~ st) => Contract cp st -> ContractPropValidator st prop -> ContractEnv -> param -> storage -> prop -- | Version of contractProp which takes Val as arguments -- instead of regular Haskell values. contractPropVal :: Contract cp st -> ContractPropValidator st prop -> ContractEnv -> Value cp -> Value st -> prop contractRepeatedProp :: (IsoValue param, IsoValue storage, ToT param ~ cp, ToT storage ~ st) => Contract cp st -> ContractPropValidator st prop -> ContractEnv -> [param] -> storage -> prop contractRepeatedPropVal :: Contract cp st -> ContractPropValidator st prop -> ContractEnv -> [Value cp] -> Value st -> prop -- | Dummy data to be used in tests where it's not essential. module Michelson.Test.Dummy -- | Dummy timestamp, can be used to specify current NOW value or -- maybe something else. dummyNow :: Timestamp -- | Dummy value for maximal number of steps a contract can make. -- Intentionally quite large, because most likely if you use dummy value -- you don't want the interpreter to stop due to gas exhaustion. On the -- other hand, it probably still prevents the interpreter from working -- for eternity. dummyMaxSteps :: RemainingSteps -- | Dummy ContractEnv with some reasonable hardcoded values. You -- can override values you are interested in using record update syntax. dummyContractEnv :: ContractEnv -- | OriginationOperation with most data hardcoded to some -- reasonable values. Contract and initial values must be passed -- explicitly, because otherwise it hardly makes sense. dummyOrigination :: Value -> Contract -> OriginationOperation -- | Interpreter and typechecker of a contract in Morley language. module Michelson.Runtime -- | Originate a contract. Returns the address of the originated contract. originateContract :: FilePath -> OriginationOperation -> ("verbose" :! Bool) -> IO Address -- | Run a contract. The contract is originated first (if it's not already) -- and then we pretend that we send a transaction to it. runContract :: Maybe Timestamp -> Word64 -> Mutez -> FilePath -> Value -> Contract -> TxData -> ("verbose" :! Bool) -> ("dryRun" :! Bool) -> IO () -- | Send a transaction to given address with given parameters. transfer :: Maybe Timestamp -> Word64 -> FilePath -> Address -> TxData -> ("verbose" :! Bool) -> ("dryRun" :? Bool) -> IO () -- | Parse a contract from Text. parseContract :: Maybe FilePath -> Text -> Either ParserException (Contract' ParsedOp) -- | Parse a contract from Text and expand macros. parseExpandContract :: Maybe FilePath -> Text -> Either ParserException Contract -- | Read and parse a contract from give path or stdin (if the -- argument is Nothing). The contract is not expanded. readAndParseContract :: Maybe FilePath -> IO (Contract' ParsedOp) -- | Read a contract using readAndParseContract, expand and flatten. -- The contract is not type checked. prepareContract :: Maybe FilePath -> IO Contract typeCheckWithDb :: FilePath -> Contract -> IO (Either TCError SomeContract) -- | State of a contract with code. data ContractState ContractState :: !Mutez -> !Value -> !Contract -> ContractState -- | Amount of mutez owned by this contract. [csBalance] :: ContractState -> !Mutez -- | Storage value associated with this contract. [csStorage] :: ContractState -> !Value -- | Contract itself (untyped). [csContract] :: ContractState -> !Contract -- | State of an arbitrary address. data AddressState -- | For contracts without code we store only its balance. ASSimple :: !Mutez -> AddressState -- | For contracts with code we store more state represented by -- ContractState. ASContract :: !ContractState -> AddressState -- | Data associated with a particular transaction. data TxData TxData :: !Address -> !Value -> !Mutez -> TxData [tdSenderAddress] :: TxData -> !Address [tdParameter] :: TxData -> !Value [tdAmount] :: TxData -> !Mutez -- | Operations executed by interpreter. In our model one Michelson's -- operation (operation type in Michelson) corresponds to 0 or 1 -- interpreter operation. -- -- Note: Address is not part of TxData, because -- TxData is supposed to be provided by the user, while -- Address can be computed by our code. data InterpreterOp -- | Originate a contract. OriginateOp :: !OriginationOperation -> InterpreterOp -- | Send a transaction to given address which is assumed to be the address -- of an originated contract. TransferOp :: Address -> TxData -> InterpreterOp -- | Result of a single execution of interpreter. data InterpreterRes InterpreterRes :: !GState -> [InterpreterOp] -> ![GStateUpdate] -> [(Address, InterpretUntypedResult)] -> !Maybe Address -> !RemainingSteps -> InterpreterRes -- | New GState. [_irGState] :: InterpreterRes -> !GState -- | List of operations to be added to the operations queue. [_irOperations] :: InterpreterRes -> [InterpreterOp] -- | Updates applied to GState. [_irUpdates] :: InterpreterRes -> ![GStateUpdate] -- | During execution a contract can print logs and in the end it returns a -- pair. All logs and returned values are kept until all called contracts -- are executed. In the end they are printed. [_irInterpretResults] :: InterpreterRes -> [(Address, InterpretUntypedResult)] -- | As soon as transfer operation is encountered, this address is set to -- its input. [_irSourceAddress] :: InterpreterRes -> !Maybe Address -- | Now much gas all remaining executions can consume. [_irRemainingSteps] :: InterpreterRes -> !RemainingSteps -- | Errors that can happen during contract interpreting. Type parameter -- a determines how contracts will be represented in these -- errors, e.g. Address data InterpreterError' a -- | The interpreted contract hasn't been originated. IEUnknownContract :: !a -> InterpreterError' a -- | Interpretation of Michelson contract failed. IEInterpreterFailed :: !a -> !InterpretUntypedError -> InterpreterError' a -- | A contract is already originated. IEAlreadyOriginated :: !a -> !ContractState -> InterpreterError' a -- | Sender address is unknown. IEUnknownSender :: !a -> InterpreterError' a -- | Manager address is unknown. IEUnknownManager :: !a -> InterpreterError' a -- | Sender doesn't have enough funds. IENotEnoughFunds :: !a -> !Mutez -> InterpreterError' a -- | Failed to apply updates to GState. IEFailedToApplyUpdates :: !GStateUpdateError -> InterpreterError' a -- | A contract is ill-typed. IEIllTypedContract :: !TCError -> InterpreterError' a type InterpreterError = InterpreterError' Address -- | Implementation of interpreter outside IO. It reads operations, -- interprets them one by one and updates state accordingly. Each -- operation from the passed list is fully interpreted before the next -- one is considered. interpreterPure :: Timestamp -> RemainingSteps -> GState -> [InterpreterOp] -> Either InterpreterError InterpreterRes irInterpretResults :: Lens' InterpreterRes [(Address, InterpretUntypedResult)] irUpdates :: Lens' InterpreterRes [GStateUpdate] instance GHC.Show.Show a => GHC.Show.Show (Michelson.Runtime.InterpreterError' a) instance Formatting.Buildable.Buildable a => Formatting.Buildable.Buildable (Michelson.Runtime.InterpreterError' a) instance (Data.Typeable.Internal.Typeable a, GHC.Show.Show a, Formatting.Buildable.Buildable a) => GHC.Exception.Type.Exception (Michelson.Runtime.InterpreterError' a) instance GHC.Base.Semigroup Michelson.Runtime.InterpreterRes instance GHC.Show.Show Michelson.Runtime.InterpreterRes instance GHC.Show.Show Michelson.Runtime.InterpreterOp -- | Utilities for integrational testing. Example tests can be found in the -- 'morley-test' test suite. module Michelson.Test.Integrational -- | Data associated with a particular transaction. data TxData TxData :: !Address -> !Value -> !Mutez -> TxData [tdSenderAddress] :: TxData -> !Address [tdParameter] :: TxData -> !Value [tdAmount] :: TxData -> !Mutez -- | One of genesis addresses. genesisAddress :: Address -- | More genesis addresses -- -- We know size of genesisAddresses, so it is safe to use -- !! genesisAddress1 :: Address -- | More genesis addresses -- -- We know size of genesisAddresses, so it is safe to use -- !! genesisAddress2 :: Address -- | More genesis addresses -- -- We know size of genesisAddresses, so it is safe to use -- !! genesisAddress3 :: Address genesisAddress4 :: Address genesisAddress5 :: Address genesisAddress6 :: Address -- | Validator for integrational testing. If an error is expected, it -- should be Left with validator for errors. Otherwise it should -- check final global state and its updates. type IntegrationalValidator = Either (InterpreterError -> Bool) SuccessValidator -- | Validator for integrational testing that expects successful execution. type SuccessValidator = (InternalState -> GState -> [GStateUpdate] -> Either ValidationError ()) -- | A monad inside which integrational tests can be described using -- do-notation. type IntegrationalScenarioM = StateT InternalState (Except ValidationError) type IntegrationalScenario = IntegrationalScenarioM Validated data ValidationError UnexpectedInterpreterError :: IntegrationalInterpreterError -> ValidationError UnexpectedTypeCheckError :: TCError -> ValidationError ExpectingInterpreterToFail :: ValidationError IncorrectUpdates :: ValidationError -> [GStateUpdate] -> ValidationError IncorrectStorageUpdate :: AddressName -> Text -> ValidationError InvalidStorage :: AddressName -> ExpectedStorage -> Text -> ValidationError InvalidBalance :: AddressName -> ExpectedBalance -> Text -> ValidationError CustomError :: Text -> ValidationError -- | Integrational test that executes given operations and validates them -- using given validator. It can fail using Expectation -- capability. It starts with initGState and some reasonable dummy -- values for gas limit and current timestamp. You can update blockchain -- state by performing some operations. integrationalTestExpectation :: IntegrationalScenario -> Expectation -- | Integrational test similar to integrationalTestExpectation. It -- can fail using Property capability. It can be used with -- QuickCheck's forAll to make a property-based test with -- arbitrary data. integrationalTestProperty :: IntegrationalScenario -> Property -- | Originate a contract with given initial storage and balance. Its -- address is returned. originate :: Contract -> Text -> Value -> Mutez -> IntegrationalScenarioM Address -- | Transfer tokens to given address. transfer :: TxData -> Address -> IntegrationalScenarioM () -- | Execute all operations that were added to the scenarion since last -- validate call. If validator fails, the execution will be -- aborted. validate :: IntegrationalValidator -> IntegrationalScenario -- | Make all further interpreter calls (which are triggered by the -- validate function) use given gas limit. setMaxSteps :: RemainingSteps -> IntegrationalScenarioM () -- | Make all further interpreter calls (which are triggered by the -- validate function) use given timestamp as the current one. setNow :: Timestamp -> IntegrationalScenarioM () -- | Pretend that given address initiates all the transfers within the code -- block (i.e. SENDER instruction will return this address). withSender :: Address -> IntegrationalScenarioM a -> IntegrationalScenarioM a -- | Compose two success validators. -- -- For example: -- -- expectBalance bal addr composeValidators -- expectStorageUpdateConst addr2 ValueUnit composeValidators :: SuccessValidator -> SuccessValidator -> SuccessValidator -- | Compose a list of success validators. composeValidatorsList :: [SuccessValidator] -> SuccessValidator -- | SuccessValidator that always passes. expectAnySuccess :: SuccessValidator -- | Check that storage value is updated for given address. Takes a -- predicate that is used to check the value. -- -- It works even if updates are not filtered (i. e. a value can be -- updated more than once). expectStorageUpdate :: Address -> (Value -> Either ValidationError ()) -> SuccessValidator -- | Like expectStorageUpdate, but expects a constant. expectStorageUpdateConst :: Address -> Value -> SuccessValidator -- | Check that eventually address has some particular balance. expectBalance :: Address -> Mutez -> SuccessValidator -- | Check that eventually address has some particular storage value. expectStorageConst :: Address -> Value -> SuccessValidator -- | Check that interpreter failed due to gas exhaustion. expectGasExhaustion :: InterpreterError -> Bool -- | Expect that interpretation of contract with given address ended with -- [FAILED]. expectMichelsonFailed :: (MichelsonFailed -> Bool) -> Address -> InterpreterError -> Bool instance GHC.Show.Show Michelson.Test.Integrational.ValidationError instance GHC.Show.Show Michelson.Test.Integrational.AddressName instance GHC.Show.Show Michelson.Test.Integrational.ExpectedBalance instance GHC.Show.Show Michelson.Test.Integrational.ExpectedStorage instance Formatting.Buildable.Buildable Michelson.Test.Integrational.ValidationError instance GHC.Exception.Type.Exception Michelson.Test.Integrational.ValidationError instance Formatting.Buildable.Buildable Michelson.Test.Integrational.AddressName -- | Re-exports typed Value, CValue, some core types, some helpers and -- defines aliases for constructors of typed values. module Lorentz.Value type Value = Value' Instr -- | Isomorphism between Michelson values and plain Haskell types. -- -- Default implementation of this typeclass converts ADTs to Michelson -- "pair"s and "or"s. class IsoValue a where { -- | Type function that converts a regular Haskell type into a T -- type. type family ToT a :: T; type ToT a = GValueType (Rep a); } -- | Converts a Haskell structure into Value representation. toVal :: IsoValue a => a -> Value (ToT a) -- | Converts a Haskell structure into Value representation. toVal :: (IsoValue a, Generic a, GIsoValue (Rep a), ToT a ~ GValueType (Rep a)) => a -> Value (ToT a) -- | Converts a Value into Haskell type. fromVal :: IsoValue a => Value (ToT a) -> a -- | Converts a Value into Haskell type. fromVal :: (IsoValue a, Generic a, GIsoValue (Rep a), ToT a ~ GValueType (Rep a)) => Value (ToT a) -> a -- | Isomorphism between Michelson primitive values and plain Haskell -- types. class IsoCValue a where { -- | Type function that converts a regular Haskell type into a comparable -- type (which has kind CT). type family ToCT a :: CT; } -- | Converts a single Haskell value into CVal representation. toCVal :: IsoCValue a => a -> CValue (ToCT a) -- | Converts a CVal value into a single Haskell value. fromCVal :: IsoCValue a => CValue (ToCT a) -> a -- | Representation of comparable value in Michelson language. -- -- By specification, we're allowed to compare only following types: int, -- nat, string, bytes, mutez, bool, key_hash, timestamp, address. -- -- Only these values can be used as map keys or set elements. data CValue t [CvInt] :: Integer -> CValue 'CInt [CvNat] :: Natural -> CValue 'CNat [CvString] :: MText -> CValue 'CString [CvBytes] :: ByteString -> CValue 'CBytes [CvMutez] :: Mutez -> CValue 'CMutez [CvBool] :: Bool -> CValue 'CBool [CvKeyHash] :: KeyHash -> CValue 'CKeyHash [CvTimestamp] :: Timestamp -> CValue 'CTimestamp [CvAddress] :: Address -> CValue 'CAddress -- | Invariant: Jn# and Jp# are used iff value doesn't fit in -- S# -- -- Useful properties resulting from the invariants: -- -- data Integer -- | Type representing arbitrary-precision non-negative integers. -- -- 
--   >>> 2^100 :: Natural
--   1267650600228229401496703205376
--
-- -- Operations whose result would be negative throw -- (Underflow :: ArithException), -- -- 
--   >>> -1 :: Natural
--   *** Exception: arithmetic underflow
--
data Natural -- | Michelson string value. -- -- This is basically a mere text with limits imposed by the language: -- http://tezos.gitlab.io/zeronet/whitedoc/michelson.html#constants -- Although, this document seems to be not fully correct, and thus we -- applied constraints deduced empirically. -- -- You construct an item of this type using one of the following ways: -- -- -- -- 
--   >>> [mt|Some text|]
--   MTextUnsafe { unMText = "Some text" }
--
-- -- data MText data Bool False :: Bool True :: Bool -- | A space-efficient representation of a Word8 vector, supporting -- many efficient operations. -- -- A ByteString contains 8-bit bytes, or by using the operations -- from Data.ByteString.Char8 it can be interpreted as containing -- 8-bit characters. data ByteString -- | Data type corresponding to address structure in Tezos. data Address -- | Mutez is a wrapper over integer data type. 1 mutez is 1 token (μTz). data Mutez -- | Time in the real world. Use the functions below to convert it to/from -- Unix time in seconds. data Timestamp -- | b58check of a public key. data KeyHash -- | ED25519 public cryptographic key. data PublicKey -- | ED25519 cryptographic signature. data Signature -- | A set of values a. data Set a -- | A Map from keys k to values a. data Map k a newtype BigMap k v BigMap :: Map k v -> BigMap k v [unBigMap] :: BigMap k v -> Map k v type Operation = Operation' Instr -- | The Maybe type encapsulates an optional value. A value of type -- Maybe a either contains a value of type a -- (represented as Just a), or it is empty (represented -- as Nothing). Using Maybe is a good way to deal with -- errors or exceptional cases without resorting to drastic measures such -- as error. -- -- The Maybe type is also a monad. It is a simple kind of error -- monad, where all errors are represented by Nothing. A richer -- error monad can be built using the Either type. data Maybe a Nothing :: Maybe a Just :: a -> Maybe a type List = [] -- | Since Contract name is used to designate contract code, lets -- call analogy of TContract type as follows. newtype ContractAddr (cp :: Type) ContractAddr :: Address -> ContractAddr [unContractAddress] :: ContractAddr -> Address -- | Safely create Mutez. -- -- This is recommended way to create Mutez from a numeric -- literal; you can't construct all valid Mutez values using -- this function but for small values it works neat. -- -- Warnings displayed when trying to construct invalid Natural or -- Word literal are hardcoded for these types in GHC -- implementation, so we can only exploit these existing rules. toMutez :: Word32 -> Mutez -- | QuasyQuoter for constructing Michelson strings. -- -- Validity of result will be checked at compile time. Note: -- -- mt :: QuasiQuoter -- | A class for types with a default value. class Default a -- | The default value for this type. def :: Default a => a -- | Type families from Arith lifted to Haskell types. module Lorentz.Arith -- | Lifted AithOp. class (ArithOp aop (ToCT n) (ToCT m), IsComparable n, IsComparable m, Typeable (ToCT n), Typeable (ToCT m), ToT (ArithResHs aop n m) ~ 'Tc (ArithRes aop (ToCT n) (ToCT m))) => ArithOpHs (aop :: Type) (n :: Type) (m :: Type) where { type family ArithResHs aop n m :: Type; } -- | Lifted UnaryAithOp. class (UnaryArithOp aop (ToCT n), IsComparable n, Typeable (ToCT n), ToT (UnaryArithResHs aop n) ~ 'Tc (UnaryArithRes aop (ToCT n))) => UnaryArithOpHs (aop :: Type) (n :: Type) where { type family UnaryArithResHs aop n :: Type; } instance Lorentz.Arith.UnaryArithOpHs Michelson.Typed.Arith.Abs GHC.Integer.Type.Integer instance Lorentz.Arith.UnaryArithOpHs Michelson.Typed.Arith.Neg GHC.Integer.Type.Integer instance Lorentz.Arith.UnaryArithOpHs Michelson.Typed.Arith.Neg GHC.Natural.Natural instance Lorentz.Arith.UnaryArithOpHs Michelson.Typed.Arith.Not GHC.Integer.Type.Integer instance Lorentz.Arith.UnaryArithOpHs Michelson.Typed.Arith.Not GHC.Natural.Natural instance Lorentz.Arith.UnaryArithOpHs Michelson.Typed.Arith.Not GHC.Types.Bool instance Lorentz.Arith.UnaryArithOpHs Michelson.Typed.Arith.Eq' GHC.Integer.Type.Integer instance Lorentz.Arith.UnaryArithOpHs Michelson.Typed.Arith.Neq GHC.Integer.Type.Integer instance Lorentz.Arith.UnaryArithOpHs Michelson.Typed.Arith.Lt GHC.Integer.Type.Integer instance Lorentz.Arith.UnaryArithOpHs Michelson.Typed.Arith.Gt GHC.Integer.Type.Integer instance Lorentz.Arith.UnaryArithOpHs Michelson.Typed.Arith.Le GHC.Integer.Type.Integer instance Lorentz.Arith.UnaryArithOpHs Michelson.Typed.Arith.Ge GHC.Integer.Type.Integer instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Add GHC.Natural.Natural GHC.Integer.Type.Integer instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Add GHC.Integer.Type.Integer GHC.Natural.Natural instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Add GHC.Natural.Natural GHC.Natural.Natural instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Add GHC.Integer.Type.Integer GHC.Integer.Type.Integer instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Add Tezos.Core.Timestamp GHC.Integer.Type.Integer instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Add GHC.Integer.Type.Integer Tezos.Core.Timestamp instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Add Tezos.Core.Mutez Tezos.Core.Mutez instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Sub GHC.Natural.Natural GHC.Integer.Type.Integer instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Sub GHC.Integer.Type.Integer GHC.Natural.Natural instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Sub GHC.Natural.Natural GHC.Natural.Natural instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Sub GHC.Integer.Type.Integer GHC.Integer.Type.Integer instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Sub Tezos.Core.Timestamp GHC.Integer.Type.Integer instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Sub Tezos.Core.Timestamp Tezos.Core.Timestamp instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Sub Tezos.Core.Mutez Tezos.Core.Mutez instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Mul GHC.Natural.Natural GHC.Integer.Type.Integer instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Mul GHC.Integer.Type.Integer GHC.Natural.Natural instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Mul GHC.Natural.Natural GHC.Natural.Natural instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Mul GHC.Integer.Type.Integer GHC.Integer.Type.Integer instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Mul GHC.Natural.Natural Tezos.Core.Mutez instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Mul Tezos.Core.Mutez GHC.Natural.Natural instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Or GHC.Natural.Natural GHC.Natural.Natural instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Or GHC.Types.Bool GHC.Types.Bool instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.And GHC.Integer.Type.Integer GHC.Natural.Natural instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.And GHC.Natural.Natural GHC.Natural.Natural instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.And GHC.Types.Bool GHC.Types.Bool instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Xor GHC.Natural.Natural GHC.Natural.Natural instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Xor GHC.Types.Bool GHC.Types.Bool instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Lsl GHC.Natural.Natural GHC.Natural.Natural instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Lsr GHC.Natural.Natural GHC.Natural.Natural instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Compare GHC.Types.Bool GHC.Types.Bool instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Compare Tezos.Address.Address Tezos.Address.Address instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Compare GHC.Natural.Natural GHC.Natural.Natural instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Compare GHC.Integer.Type.Integer GHC.Integer.Type.Integer instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Compare Michelson.Text.MText Michelson.Text.MText instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Compare Data.ByteString.Internal.ByteString Data.ByteString.Internal.ByteString instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Compare Tezos.Core.Timestamp Tezos.Core.Timestamp instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Compare Tezos.Core.Mutez Tezos.Core.Mutez instance Lorentz.Arith.ArithOpHs Michelson.Typed.Arith.Compare Tezos.Crypto.KeyHash Tezos.Crypto.KeyHash -- | Type families from Polymorphic lifted to Haskell types. module Lorentz.Polymorphic -- | Lifted MemOpKey. class (MemOp (ToT c), ToT (MemOpKeyHs c) ~ 'Tc (MemOpKey (ToT c))) => MemOpHs c where { type family MemOpKeyHs c :: Type; } -- | Lifted MapOp. class (MapOp (ToT c), ToT (MapOpInpHs c) ~ MapOpInp (ToT c), ToT (MapOpResHs c ()) ~ MapOpRes (ToT c) (ToT ())) => MapOpHs c where { type family MapOpInpHs c :: Type; type family MapOpResHs c :: Type -> Type; } -- | Lifted IterOp. class (IterOp (ToT c), ToT (IterOpElHs c) ~ IterOpEl (ToT c)) => IterOpHs c where { type family IterOpElHs c :: Type; } -- | Lifted SizeOp. -- -- This could be just a constraint alias, but to avoid T types -- appearance in error messages we make a full type class with concrete -- instances. class SizeOp (ToT c) => SizeOpHs c -- | Lifted UpdOp. class (UpdOp (ToT c), ToT (UpdOpKeyHs c) ~ 'Tc (UpdOpKey (ToT c)), ToT (UpdOpParamsHs c) ~ UpdOpParams (ToT c)) => UpdOpHs c where { type family UpdOpKeyHs c :: Type; type family UpdOpParamsHs c :: Type; } -- | Lifted GetOp. class (GetOp (ToT c), ToT (GetOpKeyHs c) ~ 'Tc (GetOpKey (ToT c)), ToT (GetOpValHs c) ~ GetOpVal (ToT c)) => GetOpHs c where { type family GetOpKeyHs c :: Type; type family GetOpValHs c :: Type; } -- | Lifted ConcatOp. class ConcatOp (ToT c) => ConcatOpHs c -- | Lifted SliceOp. class SliceOp (ToT c) => SliceOpHs c -- | Lifted EDivOp. class (EDivOp (ToCT n) (ToCT m), IsComparable n, IsComparable m, ToT (EDivOpResHs n m) ~ 'Tc (EDivOpRes (ToCT n) (ToCT m)), ToT (EModOpResHs n m) ~ 'Tc (EModOpRes (ToCT n) (ToCT m))) => EDivOpHs n m where { type family EDivOpResHs n m :: Type; type family EModOpResHs n m :: Type; } -- | A useful property which holds for reasonable MapOp instances. -- -- It's a separate thing from MapOpHs because it mentions -- b type parameter. type family IsoMapOpRes c b instance Lorentz.Polymorphic.EDivOpHs GHC.Integer.Type.Integer GHC.Integer.Type.Integer instance Lorentz.Polymorphic.EDivOpHs GHC.Integer.Type.Integer GHC.Natural.Natural instance Lorentz.Polymorphic.EDivOpHs GHC.Natural.Natural GHC.Integer.Type.Integer instance Lorentz.Polymorphic.EDivOpHs GHC.Natural.Natural GHC.Natural.Natural instance Lorentz.Polymorphic.EDivOpHs Tezos.Core.Mutez Tezos.Core.Mutez instance Lorentz.Polymorphic.EDivOpHs Tezos.Core.Mutez GHC.Natural.Natural instance Lorentz.Polymorphic.SliceOpHs Michelson.Text.MText instance Lorentz.Polymorphic.SliceOpHs Data.ByteString.Internal.ByteString instance Lorentz.Polymorphic.ConcatOpHs Michelson.Text.MText instance Lorentz.Polymorphic.ConcatOpHs Data.ByteString.Internal.ByteString instance Michelson.Typed.Haskell.Value.IsComparable k => Lorentz.Polymorphic.GetOpHs (Data.Map.Internal.Map k v) instance Michelson.Typed.Haskell.Value.IsComparable k => Lorentz.Polymorphic.GetOpHs (Michelson.Typed.Haskell.Value.BigMap k v) instance Michelson.Typed.Haskell.Value.IsComparable k => Lorentz.Polymorphic.UpdOpHs (Data.Map.Internal.Map k v) instance Michelson.Typed.Haskell.Value.IsComparable k => Lorentz.Polymorphic.UpdOpHs (Michelson.Typed.Haskell.Value.BigMap k v) instance Michelson.Typed.Haskell.Value.IsComparable a => Lorentz.Polymorphic.UpdOpHs (Data.Set.Internal.Set a) instance Lorentz.Polymorphic.SizeOpHs Michelson.Text.MText instance Lorentz.Polymorphic.SizeOpHs Data.ByteString.Internal.ByteString instance Lorentz.Polymorphic.SizeOpHs (Data.Set.Internal.Set a) instance Lorentz.Polymorphic.SizeOpHs [a] instance Lorentz.Polymorphic.SizeOpHs (Data.Map.Internal.Map k v) instance Michelson.Typed.Haskell.Value.IsComparable k => Lorentz.Polymorphic.IterOpHs (Data.Map.Internal.Map k v) instance Lorentz.Polymorphic.IterOpHs [e] instance Michelson.Typed.Haskell.Value.IsComparable e => Lorentz.Polymorphic.IterOpHs (Data.Set.Internal.Set e) instance Michelson.Typed.Haskell.Value.IsComparable k => Lorentz.Polymorphic.MapOpHs (Data.Map.Internal.Map k v) instance Lorentz.Polymorphic.MapOpHs [e] instance Michelson.Typed.Haskell.Value.IsComparable e => Lorentz.Polymorphic.MemOpHs (Data.Set.Internal.Set e) instance Michelson.Typed.Haskell.Value.IsComparable k => Lorentz.Polymorphic.MemOpHs (Data.Map.Internal.Map k v) instance Michelson.Typed.Haskell.Value.IsComparable k => Lorentz.Polymorphic.MemOpHs (Michelson.Typed.Haskell.Value.BigMap k v) module Lorentz.Constraints type CanHaveBigMap a = AllowBigMap (ToT a) -- | Gathers constraints, commonly required for values. type KnownValue a = (Typeable (ToT a), SingI (ToT a)) type KnownCValue a = (IsoValue a, Typeable (ToCT a), SingI (ToCT a)) -- | Ensure given type does not contain "operation". type NoOperation a = ForbidOp (ToT a) type NoBigMap a = ForbidBigMap (ToT a) -- | Foundation of Lorentz development. module Lorentz.Base -- | Alias for instruction which hides inner types representation via -- T. newtype (inp :: [Type]) :-> (out :: [Type]) I :: Instr (ToTs inp) (ToTs out) -> (:->) [unI] :: (:->) -> Instr (ToTs inp) (ToTs out) infixr 1 :-> -- | Alias for :->, seems to make signatures more readable -- sometimes. -- -- Let's someday decide which one of these two should remain. type (%>) = (:->) infixr 1 %> type (&) (a :: Type) (b :: [Type]) = a : b infixr 2 & (#) :: (a :-> b) -> (b :-> c) -> a :-> c -- | For use outside of Lorentz. compileLorentz :: (inp :-> out) -> Instr (ToTs inp) (ToTs out) -- | Version of compileLorentz specialized to instruction -- corresponding to contract code. compileLorentzContract :: forall cp st. (NoOperation cp, NoOperation st, NoBigMap cp, CanHaveBigMap st) => Contract cp st -> Instr '[ToT (cp, st)] '[ToT ([Operation], st)] printLorentzContract :: forall cp st. (SingI (ToT cp), SingI (ToT st), NoOperation cp, NoOperation st, NoBigMap cp, CanHaveBigMap st) => Contract cp st -> LText type ContractOut st = '[([Operation], st)] type Contract cp st = '[(cp, st)] :-> ContractOut st type Lambda i o = '[i] :-> '[o] instance GHC.Classes.Eq (inp Lorentz.Base.:-> out) instance GHC.Show.Show (inp Lorentz.Base.:-> out) instance Michelson.Typed.Haskell.Value.IsoValue (Lorentz.Base.Lambda inp out) module Lorentz.Instr nop :: s :-> s drop :: (a & s) :-> s dup :: (a & s) :-> (a & (a & s)) swap :: (a & (b & s)) :-> (b & (a & s)) push :: forall t s. (KnownValue t, NoOperation t, NoBigMap t, IsoValue t) => t -> s :-> (t & s) some :: (a & s) :-> (Maybe a & s) none :: forall a s. KnownValue a => s :-> (Maybe a & s) unit :: s :-> (() & s) ifNone :: (s :-> s') -> ((a & s) :-> s') -> (Maybe a & s) :-> s' pair :: (a & (b & s)) :-> ((a, b) & s) car :: ((a, b) & s) :-> (a & s) cdr :: ((a, b) & s) :-> (b & s) left :: forall a b s. KnownValue b => (a & s) :-> (Either a b & s) right :: forall a b s. KnownValue a => (b & s) :-> (Either a b & s) ifLeft :: ((a & s) :-> s') -> ((b & s) :-> s') -> (Either a b & s) :-> s' nil :: KnownValue p => s :-> (List p & s) cons :: (a & (List a & s)) :-> (List a & s) size :: SizeOpHs c => (c & s) :-> (Natural & s) emptySet :: KnownCValue e => s :-> (Set e & s) emptyMap :: (KnownCValue k, KnownValue v) => s :-> (Map k v & s) map :: (MapOpHs c, IsoMapOpRes c b) => ((MapOpInpHs c & s) :-> (b & s)) -> (c & s) :-> (MapOpResHs c b & s) iter :: IterOpHs c => ((IterOpElHs c & s) :-> s) -> (c & s) :-> s mem :: MemOpHs c => (MemOpKeyHs c & (c & s)) :-> (Bool & s) get :: GetOpHs c => (GetOpKeyHs c & (c & s)) :-> (Maybe (GetOpValHs c) & s) update :: UpdOpHs c => (UpdOpKeyHs c & (UpdOpParamsHs c & (c & s))) :-> (c & s) -- | Helper instruction. -- -- Checks whether given key present in the storage and fails if it is. -- This instruction leaves stack intact. failingWhenPresent :: forall c k s v st e. (MemOpHs c, k ~ MemOpKeyHs c, KnownValue e, st ~ (k & (v & (c & s)))) => (forall s0. (k : s0) :-> (e : s0)) -> st :-> st -- | Like update, but throw an error on attempt to overwrite -- existing entry. updateNew :: forall c k s e. (UpdOpHs c, MemOpHs c, k ~ UpdOpKeyHs c, k ~ MemOpKeyHs c, KnownValue e) => (forall s0. (k : s0) :-> (e : s0)) -> (k & (UpdOpParamsHs c & (c & s))) :-> (c & s) if_ :: (s :-> s') -> (s :-> s') -> (Bool & s) :-> s' ifCons :: ((a & (List a & s)) :-> s') -> (s :-> s') -> (List a & s) :-> s' loop :: (s :-> (Bool & s)) -> (Bool & s) :-> s loopLeft :: ((a & s) :-> (Either a b & s)) -> (Either a b & s) :-> (b & s) lambda :: (KnownValue i, KnownValue o) => Lambda i o -> s :-> (Lambda i o & s) exec :: (a & (Lambda a b & s)) :-> (b & s) dip :: forall a s s'. (s :-> s') -> (a & s) :-> (a & s') failWith :: KnownValue a => (a & s) :-> t -- | Fail with a given message. failText :: MText -> s :-> t -- | Fail with a given message and the top of the current stack. failTagged :: KnownValue a => MText -> (a & s) :-> t -- | Fail with the given Haskell value. failUsing :: (IsoValue a, KnownValue a, NoOperation a, NoBigMap a) => a -> s :-> t -- | Fail, providing a reference to the place in the code where this -- function is called. -- -- Like error in Haskell code, this instruction is for internal -- errors only. failUnexpected :: HasCallStack => MText -> s :-> t cast :: KnownValue a => (a & s) :-> (a & s) pack :: forall a s. (KnownValue a, NoOperation a, NoBigMap a) => (a & s) :-> (ByteString & s) unpack :: forall a s. (KnownValue a, NoOperation a, NoBigMap a) => (ByteString & s) :-> (Maybe a & s) concat :: ConcatOpHs c => (c & (c & s)) :-> (c & s) concat' :: ConcatOpHs c => (List c & s) :-> (c & s) slice :: SliceOpHs c => (Natural & (Natural & (c & s))) :-> (Maybe c & s) isNat :: (Integer & s) :-> (Maybe Natural & s) add :: ArithOpHs Add n m => (n & (m & s)) :-> (ArithResHs Add n m & s) sub :: ArithOpHs Sub n m => (n & (m & s)) :-> (ArithResHs Sub n m & s) rsub :: ArithOpHs Sub n m => (m & (n & s)) :-> (ArithResHs Sub n m & s) mul :: ArithOpHs Mul n m => (n & (m & s)) :-> (ArithResHs Mul n m & s) ediv :: EDivOpHs n m => (n & (m & s)) :-> (Maybe (EDivOpResHs n m, EModOpResHs n m) & s) abs :: UnaryArithOpHs Abs n => (n & s) :-> (UnaryArithResHs Abs n & s) neg :: UnaryArithOpHs Neg n => (n & s) :-> (UnaryArithResHs Neg n & s) lsl :: ArithOpHs Lsl n m => (n & (m & s)) :-> (ArithResHs Lsl n m & s) lsr :: ArithOpHs Lsr n m => (n & (m & s)) :-> (ArithResHs Lsr n m & s) or :: ArithOpHs Or n m => (n & (m & s)) :-> (ArithResHs Or n m & s) and :: ArithOpHs And n m => (n & (m & s)) :-> (ArithResHs And n m & s) xor :: ArithOpHs Xor n m => (n & (m & s)) :-> (ArithResHs Xor n m & s) not :: UnaryArithOpHs Not n => (n & s) :-> (UnaryArithResHs Not n & s) compare :: ArithOpHs Compare n m => (n & (m & s)) :-> (ArithResHs Compare n m & s) eq0 :: UnaryArithOpHs Eq' n => (n & s) :-> (UnaryArithResHs Eq' n & s) neq0 :: UnaryArithOpHs Neq n => (n & s) :-> (UnaryArithResHs Neq n & s) lt0 :: UnaryArithOpHs Lt n => (n & s) :-> (UnaryArithResHs Lt n & s) gt0 :: UnaryArithOpHs Gt n => (n & s) :-> (UnaryArithResHs Gt n & s) le0 :: UnaryArithOpHs Le n => (n & s) :-> (UnaryArithResHs Le n & s) ge0 :: UnaryArithOpHs Ge n => (n & s) :-> (UnaryArithResHs Ge n & s) int :: (Natural & s) :-> (Integer & s) self :: forall cp s. s :-> (ContractAddr cp & s) contract :: KnownValue p => (Address & s) :-> (Maybe (ContractAddr p) & s) transferTokens :: forall p s. (KnownValue p, NoOperation p, NoBigMap p) => (p & (Mutez & (ContractAddr p & s))) :-> (Operation & s) setDelegate :: (Maybe KeyHash & s) :-> (Operation & s) createAccount :: (KeyHash & (Maybe KeyHash & (Bool & (Mutez & s)))) :-> (Operation & (Address & s)) createContract :: forall p g s. (KnownValue p, NoOperation p, KnownValue g, NoOperation g, NoBigMap p, CanHaveBigMap g) => ('[(p, g)] :-> '[(List Operation, g)]) -> (KeyHash & (Maybe KeyHash & (Bool & (Bool & (Mutez & (g & s)))))) :-> (Operation & (Address & s)) implicitAccount :: (KeyHash & s) :-> (ContractAddr () & s) now :: s :-> (Timestamp & s) amount :: s :-> (Mutez & s) balance :: s :-> (Mutez & s) checkSignature :: (PublicKey & (Signature & (ByteString & s))) :-> (Bool & s) sha256 :: (ByteString & s) :-> (ByteString & s) sha512 :: (ByteString & s) :-> (ByteString & s) blake2B :: (ByteString & s) :-> (ByteString & s) hashKey :: (PublicKey & s) :-> (KeyHash & s) stepsToQuota :: s :-> (Natural & s) -- | Warning: Using source is considered a bad practice. Consider -- using sender instead until further investigation source :: s :-> (Address & s) sender :: s :-> (Address & s) address :: (ContractAddr a & s) :-> (Address & s) class LorentzFunctor (c :: Type -> Type) lmap :: (LorentzFunctor c, KnownValue b) => ((a : s) :-> (b : s)) -> (c a : s) :-> (c b : s) instance Lorentz.Instr.LorentzFunctor GHC.Maybe.Maybe -- | Referenced-by-type versions of some instructions. -- -- They allow to "dip" into stack or copy elements of stack referring -- them by type. Their use is justified, because in most cases there is -- only one element of each type of stack, and in cases when this does -- not hold (e.g. entry point with multiple parameters of the same type), -- it might be a good idea to wrap those types into a newtype or to use -- primitives from named package. -- -- This module is experimental, i.e. everything here should work but may -- be removed in favor of better development practices. -- -- Each instruction is followed with usage example. module Lorentz.Referenced -- | Duplicate an element of stack referring it by type. -- -- If stack contains multiple entries of this type, compile error is -- raised. dupT :: forall a st. DupT st a st => st :-> (a : st) -- | Dip repeatedly until element of the given type is on top of the stack. -- -- If stack contains multiple entries of this type, compile error is -- raised. dipT :: forall a inp dinp dout out. DipT inp a inp dinp dout out => (dinp :-> dout) -> inp :-> out -- | Remove element with the given type from the stack. dropT :: forall a inp dinp dout out. (DipT inp a inp dinp dout out, dinp ~ (a : dout)) => inp :-> out instance ((TypeError ...), dipInp Data.Type.Equality.~ (TypeError ...), out Data.Type.Equality.~ (TypeError ...)) => Lorentz.Referenced.DipT origSt a '[] dipInp dipOut out instance (Data.Type.Bool.If (Util.Type.IsElem a st) (TypeError ...) (() :: Constraint), dipInp Data.Type.Equality.~ (a : st), dipOut Data.Type.Equality.~ out) => Lorentz.Referenced.DipT origSt a (a : st) dipInp dipOut out instance (Lorentz.Referenced.DipT origSt a st dipInp dipOut out, out1 Data.Type.Equality.~ (b : out)) => Lorentz.Referenced.DipT origSt a (b : st) dipInp dipOut out1 instance (TypeError ...) => Lorentz.Referenced.DupT origSt a '[] instance Data.Type.Bool.If (Util.Type.IsElem a st) (TypeError ...) (() :: Constraint) => Lorentz.Referenced.DupT origSt a (a : st) instance Lorentz.Referenced.DupT origSt a st => Lorentz.Referenced.DupT origSt a (b : st) -- | Utilities used for contracts discovery. -- -- All the discovery logic resides in 'lorentz-discover' executable. module Lorentz.Discover -- | Defined for values representing a contract. class IsContract c toUntypedContract :: IsContract c => c -> Contract -- | Information about a contract required for contracts registry. data ExportedContractInfo ExportedContractInfo :: Text -> ExportedContractDecl -> ExportedContractInfo [eciModuleName] :: ExportedContractInfo -> Text [eciContractDecl] :: ExportedContractInfo -> ExportedContractDecl -- | Contract names, for Haskell and for humans. data ExportedContractDecl ExportedContractDecl :: Text -> Text -> ExportedContractDecl -- | Identifier of a contract, e.g. "auction". [ecdName] :: ExportedContractDecl -> Text -- | Name of a contract as is appears in Haskell code. [ecdVar] :: ExportedContractDecl -> Text isHaskellModule :: FilePath -> Bool haskellExportsParser :: Parsec Void Text [ExportedContractInfo] instance GHC.Classes.Eq Lorentz.Discover.ExportedContractInfo instance GHC.Show.Show Lorentz.Discover.ExportedContractInfo instance GHC.Classes.Eq Lorentz.Discover.ExportedContractDecl instance GHC.Show.Show Lorentz.Discover.ExportedContractDecl instance Lorentz.Discover.IsContract Michelson.Untyped.Aliases.Contract instance (Data.Singletons.Internal.SingI cp, Data.Singletons.Internal.SingI st) => Lorentz.Discover.IsContract (Michelson.Typed.Instr.Contract cp st) instance (Data.Singletons.Internal.SingI (Michelson.Typed.Haskell.Value.ToT cp), Data.Singletons.Internal.SingI (Michelson.Typed.Haskell.Value.ToT st), Lorentz.Constraints.NoOperation cp, Lorentz.Constraints.NoOperation st, Lorentz.Constraints.NoBigMap cp, Lorentz.Constraints.CanHaveBigMap st) => Lorentz.Discover.IsContract (Lorentz.Base.Contract cp st) -- | Identity transformations between different Haskell types. module Lorentz.Coercions -- | Whether two types have the same Michelson representation. type Coercible_ a b = ToT a ~ ToT b -- | Convert between values of types that have the same representation. coerce_ :: Coercible_ a b => (a & s) :-> (b & s) -- | Specialized version of coerce_ to unwrap a haskell newtype. coerceUnwrap :: Coercible_ newtyp (Unwrapped newtyp) => (newtyp : s) :-> (Unwrapped newtyp : s) -- | Specialized version of coerce_ to wrap into a haskell newtype. coerceWrap :: Coercible_ newtyp (Unwrapped newtyp) => (Unwrapped newtyp : s) :-> (newtyp : s) -- | Lift given value to a named value. toNamed :: Label name -> (a : s) :-> (NamedF Identity a name : s) -- | Unpack named value. fromNamed :: Label name -> (NamedF Identity a name : s) :-> (a : s) -- | Wrapped provides isomorphisms to wrap and unwrap newtypes or -- data types with one constructor. class Wrapped s where { type family Unwrapped s :: Type; } -- | An isomorphism between s and a. -- -- If your type has a Generic instance, _Wrapped' will -- default to _GWrapped', and you can choose to not override it -- with your own definition. _Wrapped' :: Wrapped s => Iso' s (Unwrapped s) -- | Common Michelson macros defined using Lorentz syntax. module Lorentz.Macro type IfCmpXConstraints a b op = (Typeable a, Typeable b, ArithOpHs Compare a b, UnaryArithOpHs op (ArithResHs Compare a b), UnaryArithResHs op (ArithResHs Compare a b) ~ Bool) eq :: (ArithOpHs Compare n m, UnaryArithOpHs Eq' (ArithResHs Compare n m)) => (n & (m & s)) :-> (UnaryArithResHs Eq' (ArithResHs Compare n m) & s) neq :: (ArithOpHs Compare n m, UnaryArithOpHs Neq (ArithResHs Compare n m)) => (n & (m & s)) :-> (UnaryArithResHs Neq (ArithResHs Compare n m) & s) lt :: (ArithOpHs Compare n m, UnaryArithOpHs Lt (ArithResHs Compare n m)) => (n & (m & s)) :-> (UnaryArithResHs Lt (ArithResHs Compare n m) & s) gt :: (ArithOpHs Compare n m, UnaryArithOpHs Gt (ArithResHs Compare n m)) => (n & (m & s)) :-> (UnaryArithResHs Gt (ArithResHs Compare n m) & s) le :: (ArithOpHs Compare n m, UnaryArithOpHs Le (ArithResHs Compare n m)) => (n & (m & s)) :-> (UnaryArithResHs Le (ArithResHs Compare n m) & s) ge :: (ArithOpHs Compare n m, UnaryArithOpHs Ge (ArithResHs Compare n m)) => (n & (m & s)) :-> (UnaryArithResHs Ge (ArithResHs Compare n m) & s) ifEq0 :: IfCmp0Constraints a Eq' => (s :-> s') -> (s :-> s') -> (a & s) :-> s' ifGe0 :: IfCmp0Constraints a Ge => (s :-> s') -> (s :-> s') -> (a & s) :-> s' ifGt0 :: IfCmp0Constraints a Gt => (s :-> s') -> (s :-> s') -> (a & s) :-> s' ifLe0 :: IfCmp0Constraints a Le => (s :-> s') -> (s :-> s') -> (a & s) :-> s' ifLt0 :: IfCmp0Constraints a Lt => (s :-> s') -> (s :-> s') -> (a & s) :-> s' ifNeq0 :: IfCmp0Constraints a Neq => (s :-> s') -> (s :-> s') -> (a & s) :-> s' ifEq :: IfCmpXConstraints a b Eq' => (s :-> s') -> (s :-> s') -> (a & (b & s)) :-> s' ifGe :: IfCmpXConstraints a b Ge => (s :-> s') -> (s :-> s') -> (a & (b & s)) :-> s' ifGt :: IfCmpXConstraints a b Gt => (s :-> s') -> (s :-> s') -> (a & (b & s)) :-> s' ifLe :: IfCmpXConstraints a b Le => (s :-> s') -> (s :-> s') -> (a & (b & s)) :-> s' ifLt :: IfCmpXConstraints a b Lt => (s :-> s') -> (s :-> s') -> (a & (b & s)) :-> s' ifNeq :: IfCmpXConstraints a b Neq => (s :-> s') -> (s :-> s') -> (a & (b & s)) :-> s' -- | Analog of the FAIL macro in Michelson. Its usage is discouraged -- because it doesn't carry any information about failure. -- | Warning: fail_ remains in code fail_ :: a :-> c assert :: MText -> (Bool & s) :-> s assertEq0 :: IfCmp0Constraints a Eq' => MText -> (a & s) :-> s assertNeq0 :: IfCmp0Constraints a Neq => MText -> (a & s) :-> s assertLt0 :: IfCmp0Constraints a Lt => MText -> (a & s) :-> s assertGt0 :: IfCmp0Constraints a Gt => MText -> (a & s) :-> s assertLe0 :: IfCmp0Constraints a Le => MText -> (a & s) :-> s assertGe0 :: IfCmp0Constraints a Ge => MText -> (a & s) :-> s assertEq :: IfCmpXConstraints a b Eq' => MText -> (a & (b & s)) :-> s assertNeq :: IfCmpXConstraints a b Neq => MText -> (a & (b & s)) :-> s assertLt :: IfCmpXConstraints a b Lt => MText -> (a & (b & s)) :-> s assertGt :: IfCmpXConstraints a b Gt => MText -> (a & (b & s)) :-> s assertLe :: IfCmpXConstraints a b Le => MText -> (a & (b & s)) :-> s assertGe :: IfCmpXConstraints a b Ge => MText -> (a & (b & s)) :-> s assertNone :: MText -> (Maybe a & s) :-> s assertSome :: MText -> (Maybe a & s) :-> (a & s) assertLeft :: MText -> (Either a b & s) :-> (a & s) assertRight :: MText -> (Either a b & s) :-> (b & s) assertUsing :: (IsoValue a, KnownValue a, NoOperation a, NoBigMap a) => a -> (Bool & s) :-> s -- | DII+P macro. For example, `dipX @3` is DIIIP. dipX :: forall (n :: Nat) inp out s s'. (DipX (ToPeano n) (Above (ToPeano n) inp) s s', (Above (ToPeano n) inp ++ s) ~ inp, (Above (ToPeano n) inp ++ s') ~ out) => (s :-> s') -> inp :-> out -- | Custom Lorentz macro that drops element with given index (starting -- from 0) from the stack. dropX :: forall (n :: Nat) a inp out s s'. (DipX (ToPeano n) (Above (ToPeano n) inp) s s', (Above (ToPeano n) inp ++ s) ~ inp, (Above (ToPeano n) inp ++ s') ~ out, s ~ (a : s')) => inp :-> out -- | Duplicate the top of the stack n times. -- -- For example, `cloneX @3` has type `a & s :-> a & a & a -- & a & s`. cloneX :: forall (n :: Nat) a s. CloneX (ToPeano n) a s => (a & s) :-> CloneXT (ToPeano n) a s -- | DUU+P macro. For example, `duupX @3` is DUUUP, it -- puts the 3-rd (starting from 1) element to the top of the stack. duupX :: forall (n :: Nat) inp. DuupX (ToPeano n) inp (At (ToPeano (n - 1)) inp) => inp :-> (At (ToPeano (n - 1)) inp & inp) -- | Move item with given index (starting from 0) to the top of the stack. -- -- TODO: probably it can be implemented more efficiently, so if we ever -- want to optimize gas consumption we can rewrite it. It only makes -- sense if it's applied to a relatively large index. elevateX :: forall (n :: Nat) inp out s a. (DuupX (ToPeano (1 + n)) inp a, DipX (ToPeano (n + 1)) (Above (ToPeano (n + 1)) (a : inp)) (a : s) s, (a : (Above (ToPeano n) inp ++ s)) ~ out, a ~ At (ToPeano n) inp, (Above (ToPeano (n + 1)) (a : inp) ++ (a : s)) ~ (a : inp), (Above (ToPeano (n + 1)) (a : inp) ++ s) ~ (a : (Above (ToPeano n) inp ++ s)), ((1 + n) - 1) ~ n) => inp :-> out caar :: (((a, b1), b2) & s) :-> (a & s) cadr :: (((a, b1), b2) & s) :-> (b1 & s) cdar :: ((a1, (a2, b)) & s) :-> (a2 & s) cddr :: ((a1, (a2, b)) & s) :-> (b & s) ifRight :: ((b & s) :-> s') -> ((a & s) :-> s') -> (Either a b & s) :-> s' ifSome :: ((a & s) :-> s') -> (s :-> s') -> (Maybe a & s) :-> s' mapCar :: ((a & s) :-> (a1 & s)) -> ((a, b) & s) :-> ((a1, b) & s) mapCdr :: ((b & ((a, b) & s)) :-> (b1 & ((a, b) & s))) -> ((a, b) & s) :-> ((a, b1) & s) papair :: (a & (b & (c & s))) :-> (((a, b), c) & s) ppaiir :: (a & (b & (c & s))) :-> ((a, (b, c)) & s) unpair :: ((a, b) & s) :-> (a & (b & s)) setCar :: ((a, b1) & (b2 & s)) :-> ((b2, b1) & s) setCdr :: ((a, b1) & (b2 & s)) :-> ((a, b2) & s) -- | Insert given element into set. -- -- This is a separate function from updateMap because stacks -- they operate with differ in length. setInsert :: IsComparable e => (e & (Set e & s)) :-> (Set e & s) -- | Insert given element into map. mapInsert :: (MapInstrs map, IsComparable k) => (k : (v : (map k v : s))) :-> (map k v : s) -- | Insert given element into set, ensuring that it does not overwrite any -- existing entry. -- -- As first argument accepts container name. setInsertNew :: (IsComparable e, KnownValue err) => (forall s0. (e : s0) :-> (err : s0)) -> (e & (Set e & s)) :-> (Set e & s) -- | Insert given element into map, ensuring that it does not overwrite any -- existing entry. -- -- As first argument accepts container name (for error message). mapInsertNew :: (MapInstrs map, IsComparable k, KnownValue e) => (forall s0. (k : s0) :-> (e : s0)) -> (k : (v : (map k v : s))) :-> (map k v : s) -- | Delete element from the map. deleteMap :: forall k v s. (MapInstrs map, IsComparable k, KnownValue k, KnownValue v) => (k : (map k v : s)) :-> (map k v : s) -- | Delete given element from the set. setDelete :: IsComparable e => (e & (Set e & s)) :-> (Set e & s) -- | view type synonym as described in A1. data View (a :: Type) (r :: Type) View :: a -> ContractAddr (a, Maybe r) -> View [viewParam] :: View -> a [viewCallbackTo] :: View -> ContractAddr (a, Maybe r) -- | void type synonym as described in A1. data Void_ (a :: Type) (b :: Type) Void_ :: a -> Lambda b b -> Void_ -- | Entry point argument. [voidParam] :: Void_ -> a -- | Type of result reported via failWith. [voidResProxy] :: Void_ -> Lambda b b -- | Newtype over void result type used in tests to distinguish successful -- void result from other errors. -- -- Usage example: lExpectFailWith (== VoidResult roleMaster)` newtype VoidResult r VoidResult :: r -> VoidResult r [unVoidResult] :: VoidResult r -> r view_ :: (KnownValue a, KnownValue r, NoOperation (a, r), NoBigMap (a, r)) => (forall s0. ((a, storage) & s0) :-> (r : s0)) -> (View a r & (storage & s)) :-> ((List Operation, storage) & s) void_ :: forall a b s s' anything. KnownValue b => ((a & s) :-> (b & s')) -> (Void_ a b & s) :-> anything mkVoid :: forall b a. a -> Void_ a b instance Michelson.Typed.Haskell.Value.IsoValue r => Michelson.Typed.Haskell.Value.IsoValue (Lorentz.Macro.VoidResult r) instance GHC.Classes.Eq r => GHC.Classes.Eq (Lorentz.Macro.VoidResult r) instance Michelson.Typed.Haskell.Value.IsoValue a => Michelson.Typed.Haskell.Value.IsoValue (Lorentz.Macro.Void_ a b) instance GHC.Generics.Generic (Lorentz.Macro.Void_ a b) instance Michelson.Typed.Haskell.Value.IsoValue a => Michelson.Typed.Haskell.Value.IsoValue (Lorentz.Macro.View a r) instance GHC.Generics.Generic (Lorentz.Macro.View a r) instance Lorentz.Macro.MapInstrs Data.Map.Internal.Map instance Lorentz.Macro.MapInstrs Michelson.Typed.Haskell.Value.BigMap instance Lorentz.Macro.DuupX ('Data.Vinyl.TypeLevel.S 'Data.Vinyl.TypeLevel.Z) (a Lorentz.Base.& xs) a instance Lorentz.Macro.DuupX ('Data.Vinyl.TypeLevel.S n) xs a => Lorentz.Macro.DuupX ('Data.Vinyl.TypeLevel.S ('Data.Vinyl.TypeLevel.S n)) (x Lorentz.Base.& xs) a instance Lorentz.Macro.CloneX 'Data.Vinyl.TypeLevel.Z a s instance Lorentz.Macro.CloneX n a s => Lorentz.Macro.CloneX ('Data.Vinyl.TypeLevel.S n) a s instance Lorentz.Macro.DipX 'Data.Vinyl.TypeLevel.Z '[] s s' instance Lorentz.Macro.DipX n h s s' => Lorentz.Macro.DipX ('Data.Vinyl.TypeLevel.S n) (a : h) s s' -- | Reimplementation of some syntax sugar. -- -- You need the following module pragmas to make it work smoothly: module Lorentz.Rebinded -- | Aliases for '(#)' used by do-blocks. (>>) :: (a :-> b) -> (b :-> c) -> a :-> c -- | Lift a value. pure :: Applicative f => a -> f a -- | Inject a value into the monadic type. return :: Monad m => a -> m a -- | Defines semantics of if ... then ... else ... construction. ifThenElse :: Condition st arg argl argr -> (argl :-> o) -> (argr :-> o) -> arg :-> o -- | Predicate for if ... then .. else ... construction, defines a -- kind of operation applied to the top elements of the current stack. data Condition st arg argl argr [Holds] :: Condition s (Bool : s) s s [IsSome] :: Condition s (Maybe a : s) (a : s) s [IsNone] :: Condition s (Maybe a : s) s (a : s) [IsLeft] :: Condition s (Either l r : s) (l : s) (r : s) [IsRight] :: Condition s (Either l r : s) (r : s) (l : s) [IsCons] :: Condition s ([a] : s) (a : ([a] : s)) s [IsNil] :: Condition s ([a] : s) s (a : ([a] : s)) [IsZero] :: (UnaryArithOpHs Eq' a, UnaryArithResHs Eq' a ~ Bool) => Condition s (a : s) s s [IsNotZero] :: (UnaryArithOpHs Eq' a, UnaryArithResHs Eq' a ~ Bool) => Condition s (a : s) s s [IsEq] :: IfCmpXConstraints a b Eq' => Condition s (a : (b : s)) s s [IsNeq] :: IfCmpXConstraints a b Neq => Condition s (a : (b : s)) s s [IsLt] :: IfCmpXConstraints a b Lt => Condition s (a : (b : s)) s s [IsGt] :: IfCmpXConstraints a b Gt => Condition s (a : (b : s)) s s [IsLe] :: IfCmpXConstraints a b Le => Condition s (a : (b : s)) s s [IsGe] :: IfCmpXConstraints a b Ge => Condition s (a : (b : s)) s s -- | Conversion from an Integer. An integer literal represents the -- application of the function fromInteger to the appropriate -- value of type Integer, so such literals have type -- (Num a) => a. fromInteger :: Num a => Integer -> a fromString :: IsString a => String -> a fromLabel :: IsLabel x a => a module Lorentz.Ext stackRef :: forall (gn :: Nat) st n. (n ~ ToPeano gn, SingI n, KnownPeano n, RequireLongerThan st n) => PrintComment st printComment :: PrintComment (ToTs s) -> s :-> s testAssert :: Typeable (ToTs out) => Text -> PrintComment (ToTs inp) -> (inp :-> (Bool & out)) -> inp :-> inp stackType :: forall s. s :-> s module Lorentz.ADT -- | Allows field access and modification. type HasField dt fname = (InstrGetFieldC dt fname, InstrSetFieldC dt fname) -- | Like HasField, but allows constrainting field type. type HasFieldOfType dt fname fieldTy = (HasField dt fname, GetFieldType dt fname ~ fieldTy) -- | Shortcut for multiple HasFieldOfType constraints. type family HasFieldsOfType (dt :: Type) (fs :: [NamedField]) :: Constraint -- | A pair of field name and type. data NamedField NamedField :: Symbol -> Type -> NamedField type n := ty = 'NamedField n ty -- | Extract a field of a datatype replacing the value of this datatype -- with the extracted field. -- -- For this and the following functions you have to specify field name -- which is either record name or name attached with (:!) -- operator. toField :: forall dt name st. InstrGetFieldC dt name => Label name -> (dt & st) :-> (GetFieldType dt name & st) -- | Like toField, but leaves field named. toFieldNamed :: forall dt name st. InstrGetFieldC dt name => Label name -> (dt & st) :-> ((name :! GetFieldType dt name) & st) -- | Extract a field of a datatype, leaving the original datatype on stack. getField :: forall dt name st. InstrGetFieldC dt name => Label name -> (dt & st) :-> (GetFieldType dt name & (dt : st)) -- | Like getField, but leaves field named. getFieldNamed :: forall dt name st. InstrGetFieldC dt name => Label name -> (dt & st) :-> ((name :! GetFieldType dt name) & (dt : st)) -- | Set a field of a datatype. setField :: forall dt name st. InstrSetFieldC dt name => Label name -> (GetFieldType dt name : (dt : st)) :-> (dt : st) -- | Apply given modifier to a datatype field. modifyField :: forall dt name st. (InstrGetFieldC dt name, InstrSetFieldC dt name) => Label name -> (forall st0. (GetFieldType dt name : st0) :-> (GetFieldType dt name : st0)) -> (dt & st) :-> (dt & st) -- | Make up a datatype. You provide a pack of individual fields -- constructors. -- -- Each element of the accepted record should be an instruction wrapped -- with fieldCtor function. This instruction will have access to -- the stack at the moment of calling construct. Instructions -- have to output fields of the built datatype, one per instruction; -- instructions order is expected to correspond to the order of fields in -- the datatype. construct :: forall dt st. (InstrConstructC dt, RMap (ConstructorFieldTypes dt)) => Rec (FieldConstructor st) (ConstructorFieldTypes dt) -> st :-> (dt & st) -- | Version of construct which accepts tuple of field constructors. constructT :: forall dt fctors st. (InstrConstructC dt, RMap (ConstructorFieldTypes dt), fctors ~ Rec (FieldConstructor st) (ConstructorFieldTypes dt), RecFromTuple fctors) => IsoRecTuple fctors -> st :-> (dt & st) -- | Lift an instruction to field constructor. fieldCtor :: (st :-> (f & st)) -> FieldConstructor st f -- | Wrap entry in constructor. Useful for sum types. wrap_ :: forall dt name st. InstrWrapC dt name => Label name -> AppendCtorField (GetCtorField dt name) st :-> (dt & st) -- | Pattern match on the given sum type. -- -- You have to provide a Rec containing case branches. To -- construct a case branch use /-> operator. case_ :: forall dt out inp. (InstrCaseC dt inp out, RMap (CaseClauses dt)) => Rec (CaseClauseL inp out) (CaseClauses dt) -> (dt & inp) :-> out -- | Like case_, accepts a tuple of clauses, which may be more -- convenient. caseT :: forall dt out inp clauses. (InstrCaseC dt inp out, RMap (CaseClauses dt), RecFromTuple clauses, clauses ~ Rec (CaseClauseL inp out) (CaseClauses dt)) => IsoRecTuple clauses -> (dt & inp) :-> out -- | Lift an instruction to case clause. -- -- You should write out constructor name corresponding to the clause -- explicitly. Prefix constructor name with "c" letter, otherwise your -- label will not be recognized by Haskell parser. Passing constructor -- name can be circumvented but doing so is not recomended as mentioning -- contructor name improves readability and allows avoiding some -- mistakes. (/->) :: Label ("c" `AppendSymbol` ctor) -> (AppendCtorField x inp :-> out) -> CaseClauseL inp out ( 'CaseClauseParam ctor x) infixr 0 /-> -- | A record is parameterized by a universe u, an interpretation -- f and a list of rows rs. The labels or indices of -- the record are given by inhabitants of the kind u; the type -- of values at any label r :: u is given by its interpretation -- f r :: *. data Rec (a :: u -> Type) (b :: [u]) :: forall u. () => u -> Type -> [u] -> Type [RNil] :: forall u (a :: u -> Type) (b :: [u]). () => Rec a ([] :: [u]) [:&] :: forall u (a :: u -> Type) (b :: [u]) (r :: u) (rs :: [u]). () => !a r -> !Rec a rs -> Rec a (r : rs) infixr 7 :& -- | Infix notation for the type of a named parameter. type (:!) (name :: Symbol) a = NamedF Identity a name -- | Infix notation for the type of an optional named parameter. type (:?) (name :: Symbol) a = NamedF Maybe a name -- | arg unwraps a named parameter with the specified name. One way -- to use it is to match on arguments with -XViewPatterns: -- -- 
--   fn (arg #t -> t) (arg #f -> f) = ...
--
-- -- This way, the names of parameters can be inferred from the patterns: -- no type signature for fn is required. In case a type -- signature for fn is provided, the parameters must come in the -- same order: -- -- 
--   fn :: "t" :! Integer -> "f" :! Integer -> ...
--   fn (arg #t -> t) (arg #f -> f) = ... -- ok
--   fn (arg #f -> f) (arg #t -> t) = ... -- does not typecheck
--
arg :: () => Name name -> (name :! a) -> a -- | Impementation of Store - object incapsulating multiple -- BigMaps. -- -- This module also provides template for the contract storage - -- StorageSkeleton. -- -- We represent Store as big_map bytes (a | b | ...). -- -- Key of this map is formed as (index, orig_key), where -- index is zero-based index of emulated map, orig_key -- is key of this emulated map. -- -- Value of this map is just a union of emulated map's values. module Lorentz.Store -- | Gathers multple BigMaps under one object. -- -- Type argument of this datatype stands for a "map template" - a -- datatype with multiple constructors, each containing an object of type -- |-> and corresponding to single virtual BigMap. It's -- also possible to parameterize it with a larger type which is a sum of -- types satisfying the above property. -- -- Inside it keeps only one BigMap thus not violating Michelson -- limitations. -- -- See examples below. newtype Store a Store :: BigMap ByteString a -> Store a [unStore] :: Store a -> BigMap ByteString a -- | Describes one virtual big map. data k |-> v type GetStoreKey store name = MSKey (GetStore name store) type GetStoreValue store name = MSValue (GetStore name store) storeMem :: forall store name s. StoreMemC store name => Label name -> (GetStoreKey store name : (Store store : s)) :-> (Bool : s) storeGet :: forall store name s. StoreGetC store name => Label name -> (GetStoreKey store name : (Store store : s)) :-> (Maybe (GetStoreValue store name) : s) storeInsert :: forall store name s. StoreInsertC store name => Label name -> (GetStoreKey store name : (GetStoreValue store name : (Store store : s))) :-> (Store store : s) -- | Insert a key-value pair, but fail if it will overwrite some existing -- entry. storeInsertNew :: forall store name err s. (StoreInsertC store name, KnownSymbol name, KnownValue err) => Label name -> (forall s0. (GetStoreKey store name : s0) :-> (err : s0)) -> (GetStoreKey store name : (GetStoreValue store name : (Store store : s))) :-> (Store store : s) storeDelete :: forall store name s. StoreDeleteC store name => Label name -> (GetStoreKey store name : (Store store : s)) :-> (Store store : s) type StoreMemC store name = StoreOpC store name type StoreGetC store name = (StoreOpC store name, InstrUnwrapC store name, SingI (ToT (GetStoreValue store name)), CtorHasOnlyField name store (GetStoreKey store name |-> GetStoreValue store name)) type StoreInsertC store name = (StoreOpC store name, InstrWrapC store name, CtorHasOnlyField name store (GetStoreKey store name |-> GetStoreValue store name)) type StoreDeleteC store name = (StoreOpC store name, SingI (ToT store)) -- | This constraint can be used if a function needs to work with -- big store, but needs to know only about some part(s) of it. -- -- It can use all Store operations for a particular name, key and value -- without knowing whole template. type HasStore name key value store = (StoreGetC store name, StoreInsertC store name, StoreDeleteC store name, GetStoreKey store name ~ key, GetStoreValue store name ~ value, StorePieceC store name key value) -- | Write down all sensisble constraints which given store -- satisfies and apply them to constrained. -- -- This store should have |-> datatype in its immediate fields, -- no deep inspection is performed. type HasStoreForAllIn store constrained = GForAllHasStore constrained (Rep store) -- | Contract storage with big_map. -- -- Due to Michelson constraints it is the only possible layout containing -- big_map. data StorageSkeleton storeTemplate other StorageSkeleton :: Store storeTemplate -> other -> StorageSkeleton storeTemplate other [sMap] :: StorageSkeleton storeTemplate other -> Store storeTemplate [sFields] :: StorageSkeleton storeTemplate other -> other -- | Unpack StorageSkeleton into a pair. storageUnpack :: (StorageSkeleton store fields : s) :-> ((Store store, fields) : s) -- | Pack a pair into StorageSkeleton. storagePack :: ((Store store, fields) : s) :-> (StorageSkeleton store fields : s) storageMem :: forall store name fields s. StoreMemC store name => Label name -> (GetStoreKey store name : (StorageSkeleton store fields : s)) :-> (Bool : s) storageGet :: forall store name fields s. StoreGetC store name => Label name -> (GetStoreKey store name : (StorageSkeleton store fields : s)) :-> (Maybe (GetStoreValue store name) : s) storageInsert :: forall store name fields s. StoreInsertC store name => Label name -> (GetStoreKey store name : (GetStoreValue store name : (StorageSkeleton store fields : s))) :-> (StorageSkeleton store fields : s) -- | Insert a key-value pair, but fail if it will overwrite some existing -- entry. storageInsertNew :: forall store name fields err s. (StoreInsertC store name, KnownSymbol name, KnownValue err) => Label name -> (forall s0. (GetStoreKey store name : s0) :-> (err : s0)) -> (GetStoreKey store name : (GetStoreValue store name : (StorageSkeleton store fields : s))) :-> (StorageSkeleton store fields : s) storageDelete :: forall store name fields s. StoreDeleteC store name => Label name -> (GetStoreKey store name : (StorageSkeleton store fields : s)) :-> (StorageSkeleton store fields : s) -- | Lift a key-value pair to Store. -- -- Further you can use Monoid instance of Store to make -- up large stores. storePiece :: forall name store key value. StorePieceC store name key value => Label name -> key -> value -> Store store -- | Get a value from store by key. -- -- It expects map to be consistent, otherwise call to this function fails -- with error. storeLookup :: forall name store key value ctorIdx. (key ~ GetStoreKey store name, value ~ GetStoreValue store name, ctorIdx ~ MSCtorIdx (GetStore name store), IsoValue key, KnownValue key, HasNoOp (ToT key), HasNoBigMap (ToT key), KnownNat ctorIdx, InstrUnwrapC store name, Generic store, CtorOnlyField name store ~ (key |-> value)) => Label name -> key -> Store store -> Maybe value type StorePieceC store name key value = (key ~ GetStoreKey store name, value ~ GetStoreValue store name, IsoValue key, KnownValue key, HasNoOp (ToT key), HasNoBigMap (ToT key), KnownNat (MSCtorIdx (GetStore name store)), InstrWrapC store name, Generic store, ExtractCtorField (GetCtorField store name) ~ (key |-> value)) instance (Michelson.Typed.Haskell.Value.IsoValue storeTemplate, Michelson.Typed.Haskell.Value.IsoValue other) => Michelson.Typed.Haskell.Value.IsoValue (Lorentz.Store.StorageSkeleton storeTemplate other) instance Data.Default.Class.Default other => Data.Default.Class.Default (Lorentz.Store.StorageSkeleton storeTemplate other) instance GHC.Generics.Generic (Lorentz.Store.StorageSkeleton storeTemplate other) instance (GHC.Show.Show storeTemplate, GHC.Show.Show other) => GHC.Show.Show (Lorentz.Store.StorageSkeleton storeTemplate other) instance (GHC.Classes.Eq storeTemplate, GHC.Classes.Eq other) => GHC.Classes.Eq (Lorentz.Store.StorageSkeleton storeTemplate other) instance Michelson.Typed.Haskell.Value.IsoValue Lorentz.Store.MyStoreTemplateBig instance GHC.Generics.Generic Lorentz.Store.MyStoreTemplateBig instance Michelson.Typed.Haskell.Value.IsoValue Lorentz.Store.MyStoreTemplate3 instance GHC.Generics.Generic Lorentz.Store.MyStoreTemplate3 instance Michelson.Typed.Haskell.Value.IsoValue Lorentz.Store.MyNatural instance Michelson.Typed.Haskell.Value.IsoCValue Lorentz.Store.MyNatural instance GHC.Generics.Generic Lorentz.Store.MyNatural instance Michelson.Typed.Haskell.Value.IsoValue Lorentz.Store.MyStoreTemplate2 instance GHC.Generics.Generic Lorentz.Store.MyStoreTemplate2 instance Michelson.Typed.Haskell.Value.IsoValue Lorentz.Store.MyStoreTemplate instance GHC.Generics.Generic Lorentz.Store.MyStoreTemplate instance forall k1 (k2 :: k1) v. Michelson.Typed.Haskell.Value.IsoValue v => Michelson.Typed.Haskell.Value.IsoValue (k2 Lorentz.Store.|-> v) instance forall k1 (k2 :: k1) v. GHC.Generics.Generic (k2 Lorentz.Store.|-> v) instance Michelson.Typed.Haskell.Value.IsoValue a => Michelson.Typed.Haskell.Value.IsoValue (Lorentz.Store.Store a) instance GHC.Base.Monoid (Lorentz.Store.Store a) instance GHC.Base.Semigroup (Lorentz.Store.Store a) instance Data.Default.Class.Default (Lorentz.Store.Store a) instance GHC.Show.Show a => GHC.Show.Show (Lorentz.Store.Store a) instance GHC.Classes.Eq a => GHC.Classes.Eq (Lorentz.Store.Store a) -- | Advanced errors. module Lorentz.Errors -- | Constraints on an object you can fail with. type IsError err = (IsoValue err, KnownValue err, NoOperation err, NoBigMap err) -- | An error indicating a normal failure caused by such user input. type LorentzUserError e = (ErrorTag, e) -- | Pseudo-getter for error within LorentzUserError. unLorentzUserError :: LorentzUserError e -> e -- | Signature of userFailWith. type UserFailInstr e name s s' = (InstrWrapC e name, KnownSymbol name) => Label name -> AppendCtorField (GetCtorField e name) s :-> s' -- | Fail with given error, picking argument for error from the top of the -- stack if any required. Error will be wrapped into -- LorentzUserError (i.e. an error tag will be attached to the -- error data). -- -- Consider the following practice: once error datatype for your contract -- is defined, create a specialization of this function to the error -- type. userFailWith :: forall err name s s'. (Typeable (ToT err), SingI (ToT err)) => UserFailInstr err name s s' instance Michelson.Typed.Haskell.Value.IsoValue Lorentz.Errors.ErrorTag instance (TypeError ...) => Data.String.IsString Lorentz.Errors.ErrorTag instance GHC.Classes.Ord Lorentz.Errors.ErrorTag instance GHC.Classes.Eq Lorentz.Errors.ErrorTag instance GHC.Show.Show Lorentz.Errors.ErrorTag module Lorentz -- | Functions to import contracts to be used in tests. module Michelson.Test.Import readContract :: forall cp st. Each [Typeable, SingI] [cp, st] => FilePath -> Text -> Either ImportContractError (Contract, Contract cp st) -- | Import contract and use it in the spec. Both versions of contract are -- passed to the callback function (untyped and typed). -- -- If contract's import failed, a spec with single failing expectation -- will be generated (so tests will run unexceptionally, but a failing -- result will notify about problem). specWithContract :: (Each [Typeable, SingI] [cp, st], HasCallStack) => FilePath -> ((Contract, Contract cp st) -> Spec) -> Spec -- | Like specWithContract, but for Lorentz types. specWithContractL :: (Each [Typeable, SingI] [ToT cp, ToT st], HasCallStack) => FilePath -> ((Contract, Contract cp st) -> Spec) -> Spec -- | A version of specWithContract which passes only the typed -- representation of the contract. specWithTypedContract :: (Each [Typeable, SingI] [cp, st], HasCallStack) => FilePath -> (Contract cp st -> Spec) -> Spec specWithUntypedContract :: FilePath -> (Contract -> Spec) -> Spec -- | Import contract from a given file path. -- -- This function reads file, parses and type checks a contract. Within -- the typechecking we assume that no contracts are originated, otherwise -- a type checking error will be caused. -- -- This function may throw IOException and -- ImportContractError. importContract :: forall cp st. Each [Typeable, SingI] [cp, st] => FilePath -> IO (Contract, Contract cp st) importUntypedContract :: FilePath -> IO Contract -- | Error type for importContract function. data ImportContractError ICEUnexpectedParamType :: !Type -> !Type -> ImportContractError ICEUnexpectedStorageType :: !Type -> !Type -> ImportContractError ICEParse :: !ParserException -> ImportContractError ICETypeCheck :: !TCError -> ImportContractError instance GHC.Classes.Eq Michelson.Test.Import.ImportContractError instance GHC.Show.Show Michelson.Test.Import.ImportContractError instance Formatting.Buildable.Buildable Michelson.Test.Import.ImportContractError instance GHC.Exception.Type.Exception Michelson.Test.Import.ImportContractError -- | Module containing some utilities for testing Michelson contracts using -- Haskell testing frameworks (hspec and QuickCheck in particular). It's -- Morley testing EDSL. module Michelson.Test -- | Import contract and use it in the spec. Both versions of contract are -- passed to the callback function (untyped and typed). -- -- If contract's import failed, a spec with single failing expectation -- will be generated (so tests will run unexceptionally, but a failing -- result will notify about problem). specWithContract :: (Each [Typeable, SingI] [cp, st], HasCallStack) => FilePath -> ((Contract, Contract cp st) -> Spec) -> Spec -- | Like specWithContract, but for Lorentz types. specWithContractL :: (Each [Typeable, SingI] [ToT cp, ToT st], HasCallStack) => FilePath -> ((Contract, Contract cp st) -> Spec) -> Spec -- | A version of specWithContract which passes only the typed -- representation of the contract. specWithTypedContract :: (Each [Typeable, SingI] [cp, st], HasCallStack) => FilePath -> (Contract cp st -> Spec) -> Spec specWithUntypedContract :: FilePath -> (Contract -> Spec) -> Spec importUntypedContract :: FilePath -> IO Contract type ContractReturn st = (Either MichelsonFailed ([Operation], Value st), InterpreterState) -- | Type for contract execution validation. -- -- It's a function which is supplied with contract execution output -- (failure or new storage with operation list). -- -- Function returns a property which type is designated by type variable -- prop and might be Property or Expectation or -- anything else relevant. type ContractPropValidator st prop = ContractReturn st -> prop -- | Contract's property tester against given input. Takes contract -- environment, initial storage and parameter, interprets contract on -- this input and invokes validation function. contractProp :: (IsoValue param, IsoValue storage, ToT param ~ cp, ToT storage ~ st) => Contract cp st -> ContractPropValidator st prop -> ContractEnv -> param -> storage -> prop -- | Version of contractProp which takes Val as arguments -- instead of regular Haskell values. contractPropVal :: Contract cp st -> ContractPropValidator st prop -> ContractEnv -> Value cp -> Value st -> prop contractRepeatedProp :: (IsoValue param, IsoValue storage, ToT param ~ cp, ToT storage ~ st) => Contract cp st -> ContractPropValidator st prop -> ContractEnv -> [param] -> storage -> prop contractRepeatedPropVal :: Contract cp st -> ContractPropValidator st prop -> ContractEnv -> [Value cp] -> Value st -> prop -- | Validator for integrational testing. If an error is expected, it -- should be Left with validator for errors. Otherwise it should -- check final global state and its updates. type IntegrationalValidator = Either (InterpreterError -> Bool) SuccessValidator -- | Validator for integrational testing that expects successful execution. type SuccessValidator = (InternalState -> GState -> [GStateUpdate] -> Either ValidationError ()) type IntegrationalScenario = IntegrationalScenarioM Validated -- | A monad inside which integrational tests can be described using -- do-notation. type IntegrationalScenarioM = StateT InternalState (Except ValidationError) -- | Integrational test that executes given operations and validates them -- using given validator. It can fail using Expectation -- capability. It starts with initGState and some reasonable dummy -- values for gas limit and current timestamp. You can update blockchain -- state by performing some operations. integrationalTestExpectation :: IntegrationalScenario -> Expectation -- | Integrational test similar to integrationalTestExpectation. It -- can fail using Property capability. It can be used with -- QuickCheck's forAll to make a property-based test with -- arbitrary data. integrationalTestProperty :: IntegrationalScenario -> Property -- | Originate a contract with given initial storage and balance. Its -- address is returned. originate :: Contract -> Text -> Value -> Mutez -> IntegrationalScenarioM Address -- | Transfer tokens to given address. transfer :: TxData -> Address -> IntegrationalScenarioM () -- | Execute all operations that were added to the scenarion since last -- validate call. If validator fails, the execution will be -- aborted. validate :: IntegrationalValidator -> IntegrationalScenario -- | Make all further interpreter calls (which are triggered by the -- validate function) use given gas limit. setMaxSteps :: RemainingSteps -> IntegrationalScenarioM () -- | Make all further interpreter calls (which are triggered by the -- validate function) use given timestamp as the current one. setNow :: Timestamp -> IntegrationalScenarioM () -- | Compose two success validators. -- -- For example: -- -- expectBalance bal addr composeValidators -- expectStorageUpdateConst addr2 ValueUnit composeValidators :: SuccessValidator -> SuccessValidator -> SuccessValidator -- | Compose a list of success validators. composeValidatorsList :: [SuccessValidator] -> SuccessValidator -- | SuccessValidator that always passes. expectAnySuccess :: SuccessValidator -- | Check that storage value is updated for given address. Takes a -- predicate that is used to check the value. -- -- It works even if updates are not filtered (i. e. a value can be -- updated more than once). expectStorageUpdate :: Address -> (Value -> Either ValidationError ()) -> SuccessValidator -- | Like expectStorageUpdate, but expects a constant. expectStorageUpdateConst :: Address -> Value -> SuccessValidator -- | Check that eventually address has some particular balance. expectBalance :: Address -> Mutez -> SuccessValidator -- | Check that eventually address has some particular storage value. expectStorageConst :: Address -> Value -> SuccessValidator -- | Check that interpreter failed due to gas exhaustion. expectGasExhaustion :: InterpreterError -> Bool -- | Expect that interpretation of contract with given address ended with -- [FAILED]. expectMichelsonFailed :: (MichelsonFailed -> Bool) -> Address -> InterpreterError -> Bool -- | Data associated with a particular transaction. data TxData TxData :: !Address -> !Value -> !Mutez -> TxData [tdSenderAddress] :: TxData -> !Address [tdParameter] :: TxData -> !Value [tdAmount] :: TxData -> !Mutez -- | One of genesis addresses. genesisAddress :: Address -- | A Property that always failes with given message. failedProp :: Text -> Property -- | A Property that always succeeds. succeededProp :: Property -- | The Property holds on `Left a`. qcIsLeft :: Show b => Either a b -> Property -- | The Property holds on `Right b`. qcIsRight :: Show a => Either a b -> Property -- | Dummy ContractEnv with some reasonable hardcoded values. You -- can override values you are interested in using record update syntax. dummyContractEnv :: ContractEnv -- | Minimal (earliest) timestamp used for Arbitrary (CValue -- 'CTimestamp) minTimestamp :: Timestamp -- | Maximal (latest) timestamp used for Arbitrary (CValue -- 'CTimestamp) maxTimestamp :: Timestamp -- | Median of minTimestamp and maxTimestamp. Useful for -- testing (exactly half of generated dates will be before and after this -- date). midTimestamp :: Timestamp module Util.Test.Arbitrary -- | Run given generator deterministically. runGen :: Int -> Gen a -> a instance Test.QuickCheck.Arbitrary.Arbitrary Michelson.Untyped.Value.InternalByteString instance Test.QuickCheck.Arbitrary.Arbitrary Michelson.Untyped.Ext.Var instance Test.QuickCheck.Arbitrary.Arbitrary Michelson.Untyped.Ext.TyVar instance Test.QuickCheck.Arbitrary.Arbitrary Michelson.Untyped.Ext.StackTypePattern instance Test.QuickCheck.Arbitrary.Arbitrary Michelson.Untyped.Aliases.ExpandedExtInstr instance Test.QuickCheck.Arbitrary.ADT.ToADTArbitrary Michelson.ErrorPos.Pos instance Test.QuickCheck.Arbitrary.Arbitrary Michelson.ErrorPos.Pos instance Test.QuickCheck.Arbitrary.ADT.ToADTArbitrary Michelson.ErrorPos.SrcPos instance Test.QuickCheck.Arbitrary.Arbitrary Michelson.ErrorPos.SrcPos instance Test.QuickCheck.Arbitrary.ADT.ToADTArbitrary Michelson.ErrorPos.LetName instance Test.QuickCheck.Arbitrary.Arbitrary Michelson.ErrorPos.LetName instance Test.QuickCheck.Arbitrary.ADT.ToADTArbitrary Michelson.ErrorPos.InstrCallStack instance Test.QuickCheck.Arbitrary.Arbitrary Michelson.ErrorPos.InstrCallStack instance Test.QuickCheck.Arbitrary.ADT.ToADTArbitrary Michelson.Untyped.Instr.ExpandedOp instance Test.QuickCheck.Arbitrary.Arbitrary Michelson.Untyped.Instr.ExpandedOp instance Test.QuickCheck.Arbitrary.ADT.ToADTArbitrary Tezos.Core.Mutez instance Test.QuickCheck.Arbitrary.ADT.ToADTArbitrary Michelson.Untyped.Annotation.TypeAnn instance Test.QuickCheck.Arbitrary.Arbitrary Michelson.Untyped.Annotation.TypeAnn instance Test.QuickCheck.Arbitrary.ADT.ToADTArbitrary Michelson.Untyped.Annotation.FieldAnn instance Test.QuickCheck.Arbitrary.Arbitrary Michelson.Untyped.Annotation.FieldAnn instance Test.QuickCheck.Arbitrary.ADT.ToADTArbitrary Michelson.Untyped.Annotation.VarAnn instance Test.QuickCheck.Arbitrary.Arbitrary Michelson.Untyped.Annotation.VarAnn instance (Test.QuickCheck.Arbitrary.Arbitrary op, Test.QuickCheck.Arbitrary.ADT.ToADTArbitrary op) => Test.QuickCheck.Arbitrary.ADT.ToADTArbitrary (Michelson.Untyped.Contract.Contract' op) instance Test.QuickCheck.Arbitrary.Arbitrary op => Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Untyped.Contract.Contract' op) instance (Test.QuickCheck.Arbitrary.Arbitrary op, Test.QuickCheck.Arbitrary.ADT.ToADTArbitrary op, Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Untyped.Ext.ExtInstrAbstract op)) => Test.QuickCheck.Arbitrary.ADT.ToADTArbitrary (Michelson.Untyped.Instr.InstrAbstract op) instance (Test.QuickCheck.Arbitrary.Arbitrary op, Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Untyped.Ext.ExtInstrAbstract op)) => Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Untyped.Instr.InstrAbstract op) instance (Test.QuickCheck.Arbitrary.Arbitrary op, Test.QuickCheck.Arbitrary.ADT.ToADTArbitrary op) => Test.QuickCheck.Arbitrary.ADT.ToADTArbitrary (Michelson.Untyped.Value.Value' op) instance Test.QuickCheck.Arbitrary.Arbitrary op => Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Untyped.Value.Value' op) instance (Test.QuickCheck.Arbitrary.Arbitrary op, Test.QuickCheck.Arbitrary.ADT.ToADTArbitrary op) => Test.QuickCheck.Arbitrary.ADT.ToADTArbitrary (Michelson.Untyped.Value.Elt op) instance Test.QuickCheck.Arbitrary.Arbitrary op => Test.QuickCheck.Arbitrary.Arbitrary (Michelson.Untyped.Value.Elt op) instance Test.QuickCheck.Arbitrary.ADT.ToADTArbitrary Michelson.Untyped.Type.Type instance Test.QuickCheck.Arbitrary.Arbitrary Michelson.Untyped.Type.Type instance Test.QuickCheck.Arbitrary.ADT.ToADTArbitrary Michelson.Untyped.Type.T instance Test.QuickCheck.Arbitrary.Arbitrary Michelson.Untyped.Type.T instance Test.QuickCheck.Arbitrary.ADT.ToADTArbitrary Michelson.Untyped.Type.CT instance Test.QuickCheck.Arbitrary.Arbitrary Michelson.Untyped.Type.CT instance Test.QuickCheck.Arbitrary.ADT.ToADTArbitrary Michelson.Untyped.Type.Comparable instance Test.QuickCheck.Arbitrary.Arbitrary Michelson.Untyped.Type.Comparable -- | Mirrors Integrational module in a Lorentz way. module Lorentz.Test.Integrational -- | Data associated with a particular transaction. data TxData TxData :: !Address -> !Value -> !Mutez -> TxData [tdSenderAddress] :: TxData -> !Address [tdParameter] :: TxData -> !Value [tdAmount] :: TxData -> !Mutez -- | Initially these addresses have a lot of money. genesisAddresses :: NonEmpty Address -- | One of genesis addresses. genesisAddress :: Address -- | More genesis addresses -- -- We know size of genesisAddresses, so it is safe to use -- !! genesisAddress1 :: Address -- | More genesis addresses -- -- We know size of genesisAddresses, so it is safe to use -- !! genesisAddress2 :: Address -- | More genesis addresses -- -- We know size of genesisAddresses, so it is safe to use -- !! genesisAddress3 :: Address genesisAddress4 :: Address genesisAddress5 :: Address genesisAddress6 :: Address -- | Validator for integrational testing. If an error is expected, it -- should be Left with validator for errors. Otherwise it should -- check final global state and its updates. type IntegrationalValidator = Either (InterpreterError -> Bool) SuccessValidator -- | Validator for integrational testing that expects successful execution. type SuccessValidator = (InternalState -> GState -> [GStateUpdate] -> Either ValidationError ()) -- | A monad inside which integrational tests can be described using -- do-notation. type IntegrationalScenarioM = StateT InternalState (Except ValidationError) type IntegrationalScenario = IntegrationalScenarioM Validated data ValidationError UnexpectedInterpreterError :: IntegrationalInterpreterError -> ValidationError UnexpectedTypeCheckError :: TCError -> ValidationError ExpectingInterpreterToFail :: ValidationError IncorrectUpdates :: ValidationError -> [GStateUpdate] -> ValidationError IncorrectStorageUpdate :: AddressName -> Text -> ValidationError InvalidStorage :: AddressName -> ExpectedStorage -> Text -> ValidationError InvalidBalance :: AddressName -> ExpectedBalance -> Text -> ValidationError CustomError :: Text -> ValidationError -- | Integrational test that executes given operations and validates them -- using given validator. It can fail using Expectation -- capability. It starts with initGState and some reasonable dummy -- values for gas limit and current timestamp. You can update blockchain -- state by performing some operations. integrationalTestExpectation :: IntegrationalScenario -> Expectation -- | Integrational test similar to integrationalTestExpectation. It -- can fail using Property capability. It can be used with -- QuickCheck's forAll to make a property-based test with -- arbitrary data. integrationalTestProperty :: IntegrationalScenario -> Property -- | Like originate, but for Lorentz contracts. lOriginate :: (SingI (ToT cp), SingI (ToT st), HasNoOp (ToT st), IsoValue st) => Contract cp st -> Text -> st -> Mutez -> IntegrationalScenarioM (ContractAddr cp) -- | Originate a contract with empty balance and default storage. lOriginateEmpty :: (SingI (ToT cp), SingI (ToT st), HasNoOp (ToT st), IsoValue st, Default st) => Contract cp st -> Text -> IntegrationalScenarioM (ContractAddr cp) -- | Similar to transfer, for Lorentz values. lTransfer :: (SingI (ToT cp), HasNoOp (ToT cp), IsoValue cp) => ("from" :! Address) -> ("to" :! ContractAddr cp) -> Mutez -> cp -> IntegrationalScenarioM () -- | Call a contract without caring about source address and money. lCall :: (SingI (ToT cp), HasNoOp (ToT cp), IsoValue cp) => ContractAddr cp -> cp -> IntegrationalScenarioM () -- | Execute all operations that were added to the scenarion since last -- validate call. If validator fails, the execution will be -- aborted. validate :: IntegrationalValidator -> IntegrationalScenario -- | Make all further interpreter calls (which are triggered by the -- validate function) use given gas limit. setMaxSteps :: RemainingSteps -> IntegrationalScenarioM () -- | Make all further interpreter calls (which are triggered by the -- validate function) use given timestamp as the current one. setNow :: Timestamp -> IntegrationalScenarioM () -- | Pretend that given address initiates all the transfers within the code -- block (i.e. SENDER instruction will return this address). withSender :: Address -> IntegrationalScenarioM a -> IntegrationalScenarioM a -- | Compose two success validators. -- -- For example: -- -- expectBalance bal addr composeValidators -- expectStorageUpdateConst addr2 ValueUnit composeValidators :: SuccessValidator -> SuccessValidator -> SuccessValidator -- | Compose a list of success validators. composeValidatorsList :: [SuccessValidator] -> SuccessValidator -- | SuccessValidator that always passes. expectAnySuccess :: SuccessValidator -- | Similar to expectStorageUpdate, for Lorentz values. lExpectStorageUpdate :: (IsoValue st, Each [Typeable, SingI, HasNoOp] '[ToT st], HasCallStack) => ContractAddr cp -> (st -> Either ValidationError ()) -> SuccessValidator -- | Like expectBalance, for Lorentz values. lExpectBalance :: ContractAddr cp -> Mutez -> SuccessValidator -- | Similar to expectStorageConst, for Lorentz values. lExpectStorageConst :: (IsoValue st, Each '[SingI, HasNoOp] '[ToT st]) => ContractAddr cp -> st -> SuccessValidator -- | Expect that interpretation of contract with given address ended with -- [FAILED]. lExpectMichelsonFailed :: (MichelsonFailed -> Bool) -> ContractAddr cp -> InterpreterError -> Bool -- | Expect contract to fail with FAILWITH instruction and provided -- value to match against the given predicate. lExpectFailWith :: forall e. (Typeable (ToT e), IsoValue e) => (e -> Bool) -> InterpreterError -> Bool -- | Expect contract to fail with given LorentzUserError error. lExpectUserError :: forall e. (Typeable (ToT e), IsoValue e) => (e -> Bool) -> InterpreterError -> Bool -- | Version of lExpectStorageUpdate specialized to "consumer" -- contract (see contractConsumer). lExpectConsumerStorage :: (st ~ [cp], IsoValue st, Each [Typeable, SingI, HasNoOp] '[ToT st]) => ContractAddr cp -> (st -> Either ValidationError ()) -> SuccessValidator -- | Assuming that "consumer" contract receives a value from View, -- expect this view return value to be the given one. -- -- Despite consumer stores parameters it was called with in reversed -- order, this function cares about it, so you should provide a list of -- expected values in the same order in which the corresponding events -- were happenning. lExpectViewConsumerStorage :: (st ~ [cp], cp ~ (arg, Maybe res), Eq res, Buildable res, IsoValue st, Each [Typeable, SingI, HasNoOp] '[ToT st]) => ContractAddr cp -> [res] -> SuccessValidator module Lorentz.Test -- | Import contract and use it in the spec. Both versions of contract are -- passed to the callback function (untyped and typed). -- -- If contract's import failed, a spec with single failing expectation -- will be generated (so tests will run unexceptionally, but a failing -- result will notify about problem). specWithContract :: (Each [Typeable, SingI] [cp, st], HasCallStack) => FilePath -> ((Contract, Contract cp st) -> Spec) -> Spec -- | A version of specWithContract which passes only the typed -- representation of the contract. specWithTypedContract :: (Each [Typeable, SingI] [cp, st], HasCallStack) => FilePath -> (Contract cp st -> Spec) -> Spec specWithUntypedContract :: FilePath -> (Contract -> Spec) -> Spec type ContractReturn st = (Either MichelsonFailed ([Operation], Value st), InterpreterState) -- | Type for contract execution validation. -- -- It's a function which is supplied with contract execution output -- (failure or new storage with operation list). -- -- Function returns a property which type is designated by type variable -- prop and might be Property or Expectation or -- anything else relevant. type ContractPropValidator st prop = ContractReturn st -> prop -- | Contract's property tester against given input. Takes contract -- environment, initial storage and parameter, interprets contract on -- this input and invokes validation function. contractProp :: (IsoValue param, IsoValue storage, ToT param ~ cp, ToT storage ~ st) => Contract cp st -> ContractPropValidator st prop -> ContractEnv -> param -> storage -> prop -- | Version of contractProp which takes Val as arguments -- instead of regular Haskell values. contractPropVal :: Contract cp st -> ContractPropValidator st prop -> ContractEnv -> Value cp -> Value st -> prop contractRepeatedProp :: (IsoValue param, IsoValue storage, ToT param ~ cp, ToT storage ~ st) => Contract cp st -> ContractPropValidator st prop -> ContractEnv -> [param] -> storage -> prop contractRepeatedPropVal :: Contract cp st -> ContractPropValidator st prop -> ContractEnv -> [Value cp] -> Value st -> prop -- | Validator for integrational testing. If an error is expected, it -- should be Left with validator for errors. Otherwise it should -- check final global state and its updates. type IntegrationalValidator = Either (InterpreterError -> Bool) SuccessValidator -- | Validator for integrational testing that expects successful execution. type SuccessValidator = (InternalState -> GState -> [GStateUpdate] -> Either ValidationError ()) type IntegrationalScenario = IntegrationalScenarioM Validated -- | A monad inside which integrational tests can be described using -- do-notation. type IntegrationalScenarioM = StateT InternalState (Except ValidationError) data ValidationError UnexpectedInterpreterError :: IntegrationalInterpreterError -> ValidationError UnexpectedTypeCheckError :: TCError -> ValidationError ExpectingInterpreterToFail :: ValidationError IncorrectUpdates :: ValidationError -> [GStateUpdate] -> ValidationError IncorrectStorageUpdate :: AddressName -> Text -> ValidationError InvalidStorage :: AddressName -> ExpectedStorage -> Text -> ValidationError InvalidBalance :: AddressName -> ExpectedBalance -> Text -> ValidationError CustomError :: Text -> ValidationError -- | Integrational test that executes given operations and validates them -- using given validator. It can fail using Expectation -- capability. It starts with initGState and some reasonable dummy -- values for gas limit and current timestamp. You can update blockchain -- state by performing some operations. integrationalTestExpectation :: IntegrationalScenario -> Expectation -- | Integrational test similar to integrationalTestExpectation. It -- can fail using Property capability. It can be used with -- QuickCheck's forAll to make a property-based test with -- arbitrary data. integrationalTestProperty :: IntegrationalScenario -> Property -- | Like originate, but for Lorentz contracts. lOriginate :: (SingI (ToT cp), SingI (ToT st), HasNoOp (ToT st), IsoValue st) => Contract cp st -> Text -> st -> Mutez -> IntegrationalScenarioM (ContractAddr cp) -- | Originate a contract with empty balance and default storage. lOriginateEmpty :: (SingI (ToT cp), SingI (ToT st), HasNoOp (ToT st), IsoValue st, Default st) => Contract cp st -> Text -> IntegrationalScenarioM (ContractAddr cp) -- | Similar to transfer, for Lorentz values. lTransfer :: (SingI (ToT cp), HasNoOp (ToT cp), IsoValue cp) => ("from" :! Address) -> ("to" :! ContractAddr cp) -> Mutez -> cp -> IntegrationalScenarioM () -- | Call a contract without caring about source address and money. lCall :: (SingI (ToT cp), HasNoOp (ToT cp), IsoValue cp) => ContractAddr cp -> cp -> IntegrationalScenarioM () -- | Execute all operations that were added to the scenarion since last -- validate call. If validator fails, the execution will be -- aborted. validate :: IntegrationalValidator -> IntegrationalScenario -- | Make all further interpreter calls (which are triggered by the -- validate function) use given gas limit. setMaxSteps :: RemainingSteps -> IntegrationalScenarioM () -- | Make all further interpreter calls (which are triggered by the -- validate function) use given timestamp as the current one. setNow :: Timestamp -> IntegrationalScenarioM () -- | Pretend that given address initiates all the transfers within the code -- block (i.e. SENDER instruction will return this address). withSender :: Address -> IntegrationalScenarioM a -> IntegrationalScenarioM a -- | Compose two success validators. -- -- For example: -- -- expectBalance bal addr composeValidators -- expectStorageUpdateConst addr2 ValueUnit composeValidators :: SuccessValidator -> SuccessValidator -> SuccessValidator -- | Compose a list of success validators. composeValidatorsList :: [SuccessValidator] -> SuccessValidator -- | SuccessValidator that always passes. expectAnySuccess :: SuccessValidator -- | Similar to expectStorageUpdate, for Lorentz values. lExpectStorageUpdate :: (IsoValue st, Each [Typeable, SingI, HasNoOp] '[ToT st], HasCallStack) => ContractAddr cp -> (st -> Either ValidationError ()) -> SuccessValidator -- | Like expectBalance, for Lorentz values. lExpectBalance :: ContractAddr cp -> Mutez -> SuccessValidator -- | Similar to expectStorageConst, for Lorentz values. lExpectStorageConst :: (IsoValue st, Each '[SingI, HasNoOp] '[ToT st]) => ContractAddr cp -> st -> SuccessValidator -- | Expect that interpretation of contract with given address ended with -- [FAILED]. lExpectMichelsonFailed :: (MichelsonFailed -> Bool) -> ContractAddr cp -> InterpreterError -> Bool -- | Expect contract to fail with FAILWITH instruction and provided -- value to match against the given predicate. lExpectFailWith :: forall e. (Typeable (ToT e), IsoValue e) => (e -> Bool) -> InterpreterError -> Bool -- | Expect contract to fail with given LorentzUserError error. lExpectUserError :: forall e. (Typeable (ToT e), IsoValue e) => (e -> Bool) -> InterpreterError -> Bool -- | Version of lExpectStorageUpdate specialized to "consumer" -- contract (see contractConsumer). lExpectConsumerStorage :: (st ~ [cp], IsoValue st, Each [Typeable, SingI, HasNoOp] '[ToT st]) => ContractAddr cp -> (st -> Either ValidationError ()) -> SuccessValidator -- | Assuming that "consumer" contract receives a value from View, -- expect this view return value to be the given one. -- -- Despite consumer stores parameters it was called with in reversed -- order, this function cares about it, so you should provide a list of -- expected values in the same order in which the corresponding events -- were happenning. lExpectViewConsumerStorage :: (st ~ [cp], cp ~ (arg, Maybe res), Eq res, Buildable res, IsoValue st, Each [Typeable, SingI, HasNoOp] '[ToT st]) => ContractAddr cp -> [res] -> SuccessValidator -- | Data associated with a particular transaction. data TxData TxData :: !Address -> !Value -> !Mutez -> TxData [tdSenderAddress] :: TxData -> !Address [tdParameter] :: TxData -> !Value [tdAmount] :: TxData -> !Mutez -- | Initially these addresses have a lot of money. genesisAddresses :: NonEmpty Address -- | One of genesis addresses. genesisAddress :: Address -- | More genesis addresses -- -- We know size of genesisAddresses, so it is safe to use -- !! genesisAddress1 :: Address -- | More genesis addresses -- -- We know size of genesisAddresses, so it is safe to use -- !! genesisAddress2 :: Address -- | More genesis addresses -- -- We know size of genesisAddresses, so it is safe to use -- !! genesisAddress3 :: Address genesisAddress4 :: Address genesisAddress5 :: Address genesisAddress6 :: Address -- | A Property that always failes with given message. failedProp :: Text -> Property -- | A Property that always succeeds. succeededProp :: Property -- | The Property holds on `Left a`. qcIsLeft :: Show b => Either a b -> Property -- | The Property holds on `Right b`. qcIsRight :: Show a => Either a b -> Property -- | Dummy ContractEnv with some reasonable hardcoded values. You -- can override values you are interested in using record update syntax. dummyContractEnv :: ContractEnv -- | Minimal (earliest) timestamp used for Arbitrary (CValue -- 'CTimestamp) minTimestamp :: Timestamp -- | Maximal (latest) timestamp used for Arbitrary (CValue -- 'CTimestamp) maxTimestamp :: Timestamp -- | Median of minTimestamp and maxTimestamp. Useful for -- testing (exactly half of generated dates will be before and after this -- date). midTimestamp :: Timestamp