morley-1.19.2: src/Morley/AsRPC.hs
-- SPDX-FileCopyrightText: 2022 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA
-- | This module contains a type family for converting a type to its RPC representation,
-- and TemplateHaskell functions for deriving RPC representations for custom types.
module Morley.AsRPC
( TAsRPC
, HasRPCRepr(..)
, deriveRPCWithOptions
, DeriveRPCOptions(..)
, deriveRPC
-- * Conversions
, valueAsRPC
, replaceBigMapIds
, notesAsRPC
-- * Entailments
, rpcSingIEvi
, rpcHasNoOpEvi
, rpcHasNoBigMapEvi
, rpcHasNoNestedBigMapsEvi
, rpcHasNoContractEvi
, rpcStorageScopeEvi
) where
import Prelude hiding (Type)
import Prelude qualified
import Control.Lens.Plated (universe)
import Data.Constraint ((\\))
import Data.Default (Default(..))
import Data.Generics (everything, everywhere, mkQ, mkT)
import Data.List qualified as List ((\\))
import Data.Map qualified as Map
import Data.Singletons (Sing, withSingI)
import Data.Text qualified as T
import Data.Type.Equality ((:~:)(Refl))
import GHC.Generics qualified as G
import Language.Haskell.TH
(Con(InfixC, NormalC, RecC), Cxt, Dec(DataD, NewtypeD, TySynD, TySynInstD), Info(TyConI), Kind,
Loc(loc_module), Name, Q, TyLit(StrTyLit), TySynEqn(..), TyVarBndr(..), Type(..), conT, cxt,
instanceD, location, lookupTypeName, mkName, nameBase, normalB, ppr, reify, reifyInstances, valD,
varE, varP)
import Language.Haskell.TH qualified as TH
import Language.Haskell.TH.ReifyMany (reifyManyTyCons)
import Language.Haskell.TH.ReifyMany.Internal (decConcreteNames, unAppsT, unSigT)
import Morley.Michelson.Text (MText)
import Morley.Michelson.Typed
import Morley.Tezos.Address (Address)
import Morley.Tezos.Core (ChainId, Mutez, Timestamp)
import Morley.Tezos.Crypto
import Morley.Util.CustomGeneric
(GenericStrategy, customGeneric', deriveFullType, haskellBalanced,
mangleGenericStrategyConstructors, mangleGenericStrategyFields, reifyDataType)
import Morley.Util.Interpolate (itu)
import Morley.Util.Named hiding (Name)
import Morley.Util.StubbedProof (stubProof)
import Morley.Util.TH (isTypeAlias, lookupTypeNameOrFail)
{-# ANN module ("HLint: ignore Avoid lambda using `infix`" :: Text) #-}
{- $setup
>>> import Morley.Michelson.Typed
>>> import Morley.Michelson.Text (MText)
>>> import Data.Default (def)
>>> :{
-- mock definitions for doctests, mirroring those in Lorentz.
data FollowEntrypointFlag = FollowEntrypoint | NotFollowEntrypoint
class HasAnnotation a where
getAnnotation :: FollowEntrypointFlag -> Notes (ToT a)
annOptions :: ()
:}
-}
----------------------------------------------------------------------------
-- TAsRPC
----------------------------------------------------------------------------
{- | A type-level function that maps a Michelson type to its Tezos RPC representation.
For example, when we retrieve a contract's storage using the Tezos RPC,
all its @big_map@s will be replaced by @nat@, representing a big_map ID.
>>> :k! TAsRPC ('TBigMap 'TInt 'TString)
...
= 'TNat
>>> :k! TAsRPC ('TList ('TBigMap 'TInt 'TString))
...
= 'TList 'TNat
>>> :k! TAsRPC ('TPair 'TString ('TPair 'TAddress ('TBigMap 'TInt 'TString)))
...
= 'TPair 'TString ('TPair 'TAddress 'TNat)
NB: As far as we are aware, details of RPC representation of Michelson
types are not documented. We know empirically that @big_map@s are
represented as their ids, and are the only type with an explicitly
different representation.
Whether @TAsRPC@ needs to propagate into type parameters then depends on
whether a value can hold big_map values.
* Values of type @option a@, @list a@, @pair a b@, and @or a b@ can
contain big_map values, so their RPC representations are @option (TAsRPC a)@,
@list (TAsRPC a)@, @pair (TAsRPC a) (TAsRPC b)@ and @or (TAsRPC a) (TAsRPC b)@.
* The keys of a @map k v@ cannot be big_maps, but the values can, so its
RPC representation is @map k (TAsRPC v)@.
* Values of type @set a@ cannot contain big_maps, so its RPC
representation is just @set a@.
* Values of type @contract a@ cannot contain big_maps either, because
it's just a wrapper for an address and an entrypoint name, so its RPC
representation is just @contract a@. The same reasoning applies to
@ticket a@ and @lambda a b@.
-}
type TAsRPC :: T -> T
type family TAsRPC t where
TAsRPC 'TKey = 'TKey
TAsRPC 'TUnit = 'TUnit
TAsRPC 'TSignature = 'TSignature
TAsRPC 'TChainId = 'TChainId
TAsRPC ('TOption t) = 'TOption (TAsRPC t)
TAsRPC ('TList t) = 'TList (TAsRPC t)
TAsRPC ('TSet t) = 'TSet t
TAsRPC 'TOperation = 'TOperation
TAsRPC ('TContract t) = 'TContract t
TAsRPC ('TTicket t) = 'TTicket t
TAsRPC ('TPair t1 t2) = 'TPair (TAsRPC t1) (TAsRPC t2)
TAsRPC ('TOr t1 t2) = 'TOr (TAsRPC t1) (TAsRPC t2)
TAsRPC ('TLambda t1 t2) = 'TLambda t1 t2
TAsRPC ('TMap k v) = 'TMap k (TAsRPC v)
TAsRPC ('TBigMap _ _) = 'TNat
TAsRPC 'TInt = 'TInt
TAsRPC 'TNat = 'TNat
TAsRPC 'TString = 'TString
TAsRPC 'TBytes = 'TBytes
TAsRPC 'TMutez = 'TMutez
TAsRPC 'TBool = 'TBool
TAsRPC 'TKeyHash = 'TKeyHash
TAsRPC 'TTimestamp = 'TTimestamp
TAsRPC 'TAddress = 'TAddress
TAsRPC 'TNever = 'TNever
TAsRPC 'TBls12381Fr = 'TBls12381Fr
TAsRPC 'TBls12381G1 = 'TBls12381G1
TAsRPC 'TBls12381G2 = 'TBls12381G2
TAsRPC 'TChest = 'TChest
TAsRPC 'TChestKey = 'TChestKey
TAsRPC ('TSaplingState n) = ('TSaplingState n)
TAsRPC ('TSaplingTransaction n) = ('TSaplingTransaction n)
----------------------------------------------------------------------------
-- AsRPC
----------------------------------------------------------------------------
{- | A type-level function that maps a type to its Tezos RPC representation.
For example, when we retrieve a contract's storage using the Tezos RPC, all its 'BigMap's will be replaced
by 'BigMapId's.
So if a contract has a storage of type @T@, when we call the Tezos RPC
to retrieve it, we must deserialize the micheline expression to the type @AsRPC T@.
> AsRPC (BigMap Integer MText) ~ BigMapId Integer MText
> AsRPC [BigMap Integer MText] ~ [BigMapId Integer MText]
> AsRPC (MText, (Address, BigMap Integer MText)) ~ (MText, (Address, BigMapId Integer MText))
The following law must hold:
> TAsRPC (ToT t) ~ ToT (AsRPC t)
In other words, `ToT` and `AsRPC`/`TAsRPC` must be commutative.
@
Storage ----------(applying ToT)-------------> ToT Storage
| |
| |
| |
(applying AsRPC) (applying TAsRPC)
| |
| |
| |
| V
| TAsRPC (ToT Storage)
V ~
AsRPC Storage ------(applying ToT)-----------> ToT (AsRPC Storage)
@
This law ensures that we can go from some type @Storage@ to @AsRPC Storage@ by
composing @fromVal . valueAsRPC . toVal@.
@
Storage ------------(toVal)--------------> Value (ToT Storage)
| |
| |
| |
(fromVal . valueAsRPC . toVal) (valueAsRPC)
| |
| |
| |
| V
| Value (TAsRPC (ToT Storage))
V ~
AsRPC Storage <--------(fromVal)--------- Value (ToT (AsRPC Storage))
@
-}
class (TAsRPC (ToT t) ~ ToT (AsRPC t)) => HasRPCRepr (t :: Prelude.Type) where
type AsRPC t :: Prelude.Type
-- Morley types
-- Note: We don't recursively apply @AsRPC@ to @k@ or @v@ because
-- bigmaps cannot contain nested bigmaps.
-- If this constraint is ever lifted, we'll have to change this instance
-- to @BigMapId k (AsRPC v)@
instance HasRPCRepr (BigMap k v) where type AsRPC (BigMap k v) = BigMapId k v
instance HasRPCRepr (Value t) where type AsRPC (Value t) = Value (TAsRPC t)
instance HasRPCRepr Integer where type AsRPC Integer = Integer
instance HasRPCRepr Natural where type AsRPC Natural = Natural
instance HasRPCRepr MText where type AsRPC MText = MText
instance HasRPCRepr Bool where type AsRPC Bool = Bool
instance HasRPCRepr ByteString where type AsRPC ByteString = ByteString
instance HasRPCRepr Mutez where type AsRPC Mutez = Mutez
instance HasRPCRepr KeyHash where type AsRPC KeyHash = KeyHash
instance HasRPCRepr Timestamp where type AsRPC Timestamp = Timestamp
instance HasRPCRepr Address where type AsRPC Address = Address
instance HasRPCRepr EpAddress where type AsRPC EpAddress = EpAddress
instance HasRPCRepr PublicKey where type AsRPC PublicKey = PublicKey
instance HasRPCRepr Signature where type AsRPC Signature = Signature
instance HasRPCRepr ChainId where type AsRPC ChainId = ChainId
instance HasRPCRepr Bls12381Fr where type AsRPC Bls12381Fr = Bls12381Fr
instance HasRPCRepr Bls12381G1 where type AsRPC Bls12381G1 = Bls12381G1
instance HasRPCRepr Bls12381G2 where type AsRPC Bls12381G2 = Bls12381G2
instance HasRPCRepr () where type AsRPC () = ()
instance HasRPCRepr a => HasRPCRepr [a] where
type AsRPC [a] = [AsRPC a]
instance HasRPCRepr a => HasRPCRepr (Maybe a) where
type AsRPC (Maybe a) = Maybe (AsRPC a)
instance (HasRPCRepr l, HasRPCRepr r) => HasRPCRepr (Either l r) where
type AsRPC (Either l r) = Either (AsRPC l) (AsRPC r)
instance (HasRPCRepr a, HasRPCRepr b) => HasRPCRepr (a, b) where
type AsRPC (a, b) = (AsRPC a, AsRPC b)
instance HasRPCRepr (Set a) where
type AsRPC (Set a) = Set a
instance HasRPCRepr v => HasRPCRepr (Map k v) where
type AsRPC (Map k v) = Map k (AsRPC v)
instance HasRPCRepr Operation where
type AsRPC Operation = Operation
instance HasRPCRepr a => HasRPCRepr (Identity a) where
type AsRPC (Identity a) = Identity (AsRPC a)
instance HasRPCRepr a => HasRPCRepr (NamedF Identity a name) where
type AsRPC (NamedF Identity a name) = NamedF Identity (AsRPC a) name
instance HasRPCRepr a => HasRPCRepr (NamedF Maybe a name) where
type AsRPC (NamedF Maybe a name) = NamedF Maybe (AsRPC a) name
instance Each '[HasRPCRepr] '[a, b, c] => HasRPCRepr (a, b, c) where
type AsRPC (a, b, c) = (AsRPC a, AsRPC b, AsRPC c)
instance Each '[HasRPCRepr] '[a, b, c, d] => HasRPCRepr (a, b, c, d) where
type AsRPC (a, b, c, d) = (AsRPC a, AsRPC b, AsRPC c, AsRPC d)
instance Each '[HasRPCRepr] '[a, b, c, d, e] => HasRPCRepr (a, b, c, d, e) where
type AsRPC (a, b, c, d, e) = (AsRPC a, AsRPC b, AsRPC c, AsRPC d, AsRPC e)
instance Each '[HasRPCRepr] '[a, b, c, d, e, f] => HasRPCRepr (a, b, c, d, e, f) where
type AsRPC (a, b, c, d, e, f) = (AsRPC a, AsRPC b, AsRPC c, AsRPC d, AsRPC e, AsRPC f)
instance Each '[HasRPCRepr] '[a, b, c, d, e, f, g] => HasRPCRepr (a, b, c, d, e, f, g) where
type AsRPC (a, b, c, d, e, f, g) = (AsRPC a, AsRPC b, AsRPC c, AsRPC d, AsRPC e, AsRPC f, AsRPC g)
instance HasRPCRepr (ContractRef arg) where
type AsRPC (ContractRef arg) = ContractRef arg
instance HasRPCRepr Chest where
type AsRPC Chest = Chest
instance HasRPCRepr ChestKey where
type AsRPC ChestKey = ChestKey
----------------------------------------------------------------------------
-- Derive RPC repr
----------------------------------------------------------------------------
-- | 'deriveRPCWithOptions' using default 'DeriveRPCOptions'.
deriveRPC :: String -> Q [Dec]
deriveRPC typeStr = deriveRPCWithOptions typeStr def
-- | Options for 'deriveRPCWithOptions'.
data DeriveRPCOptions = DeriveRPCOptions
{ droRecursive :: Bool
-- ^ Recursively enumerate @data@, @newtype@ and @type@ declarations, and
-- derives an RPC representation for each type that doesn't yet have one.
-- @True@ by default.
, droRecursiveSkipTypes :: [String]
-- ^ List of types for which you _don't_ want an RPC representation to be
-- derived. This is ignored if @droRecursive@ is @False@.
, droHasAnnotation :: Bool
-- ^ Derive @HasAnnotation@. The class and its methods must be in scope,
-- otherwise a compilation error is raised. @True@ by default.
, droStrategy :: GenericStrategy
-- ^ Custom Generic deriving strategy. 'haskellBalanced' by default.
}
instance Default DeriveRPCOptions where
def = DeriveRPCOptions
{ droRecursive = True
, droRecursiveSkipTypes = []
, droHasAnnotation = True
, droStrategy = haskellBalanced
}
{- | Derive an RPC representation for a type, as well as instances for
'Generic', 'IsoValue', 'HasRPCRepr' and optionally @HasAnnotation@.
>>> :{
data ExampleStorage a b = ExampleStorage
{ esField1 :: Integer
, esField2 :: [BigMap Integer MText]
, esField3 :: a
}
deriving stock Generic
deriving anyclass IsoValue
--
deriveRPC "ExampleStorage"
:}
Will generate:
>>> :i ExampleStorageRPC
...
data ExampleStorageRPC a b
= ExampleStorageRPC {esField1RPC :: !(AsRPC Integer),
esField2RPC :: !(AsRPC [BigMap Integer MText]),
esField3RPC :: !(AsRPC a)}
...
instance forall a k (b :: k).
IsoValue (AsRPC a) =>
IsoValue (ExampleStorageRPC a b)
...
instance forall a k (b :: k). Generic (ExampleStorageRPC a b)
...
>>> :i HasRPCRepr
...
instance forall a k (b :: k).
HasRPCRepr a =>
HasRPCRepr (ExampleStorage a b)
...
>>> :i AsRPC
...
type instance forall k a (b :: k). AsRPC (ExampleStorage a b)
= ExampleStorageRPC a b
...
When 'droHasAnnotation' is @True@ (the default), it will also generate a
@HasAnnotation@ (from @Lorentz@) instance like:
>>> :i HasAnnotation
...
instance forall a k (b :: k).
With '[HasAnnotation, HasRPCRepr] (ExampleStorage a b) =>
HasAnnotation (ExampleStorageRPC a b)
...
Note that if the type doesn't contain type variables or only contains phantom
type variables, 'HasRPCRepr' constraint is omitted, as it would be redundant.
@HasAnnotation@ and its methods must be in scope.
Void types will generate a type synonym instead, e.g.
>>> :{
data MyVoidType
deriving stock Generic
deriving anyclass IsoValue
--
deriveRPC "MyVoidType"
:}
will produce
>>> :i AsRPC
...
type instance AsRPC MyVoidType = MyVoidTypeRPC
...
>>> :i MyVoidTypeRPC
...
type MyVoidTypeRPC = MyVoidType
...
When 'droRecursive' is @True@, recursively enumerate @data@, @newtype@ and
@type@ declarations, and derive an RPC representation for each type that doesn't
yet have one. This will however silently skip over void types that do not have
an 'IsoValue' instance, which is usually what you want, but be mindful of this.
You can also pass in a list of types for which you _don't_ want an RPC
representation to be derived in 'droRecursiveSkipTypes'. You may need this if
you're using non-void types that don't have an 'IsoValue' instance as phantom
types somewhere. The algorithm isn't smart enough to figure out those don't need
RPC representation and will try to derive it anyway.
>>> :{
data B = B deriving (Generic, IsoValue)
data C = C deriving (Generic, IsoValue)
data D = D deriving (Generic, IsoValue)
data E a = E deriving (Generic, IsoValue)
--
instance HasRPCRepr D where type AsRPC D = ()
--
data A = A B (E C) D deriving (Generic, IsoValue)
deriveRPCWithOptions "A" def{droRecursive=True, droRecursiveSkipTypes=["C"]}
:}
In this example, this will generate an RPC representation for @A@ and @B@,
>>> :i ARPC
...
data ARPC = ...
...
>>> :i BRPC
...
data BRPC = ...
...
but not for @C@ (because we explicitly said we don't want one) or @D@ (because
it already has one).
>>> :i CRPC
...
... Not in scope: ...
...
>>> :i DRPC
...
... Not in scope: ...
...
When using with @droRecursive = False@, if some types do not have 'HasRPCRepr',
'IsoValue' or 'Generic' instances, but need to, an error will be raised:
>>> :{
data B = B deriving (Generic, IsoValue)
data A = A B deriving (Generic, IsoValue)
--
deriveRPCWithOptions "A" def{droRecursive = False}
:}
...
... error:
... Type ... must implement 'HasRPCRepr'.
>>> :{
data B = B deriving (Generic, IsoValue)
data A = A B deriving (Generic, IsoValue)
--
deriveRPCWithOptions "B" def{droRecursive = False}
deriveRPCWithOptions "A" def{droRecursive = False}
:}
>>> :i AsRPC
...
type instance AsRPC B = BRPC ...
type instance AsRPC A = ARPC ...
...
This check isn't very smart, so it might miss some corner cases.
-}
deriveRPCWithOptions :: String -> DeriveRPCOptions -> Q [Dec]
deriveRPCWithOptions typeStr opts@DeriveRPCOptions{droRecursive}
| droRecursive = deriveManyRPCWithStrategy' typeStr opts
| otherwise = do
typeName <- lookupTypeNameOrFail typeStr
whenM (isTypeAlias typeName) $ fail $ typeStr <> " is a 'type' alias but not 'data' or 'newtype'."
deriveRPCWithStrategy' typeName False opts
deriveManyRPCWithStrategy' :: String -> DeriveRPCOptions -> Q [Dec]
deriveManyRPCWithStrategy' typeStr opts@DeriveRPCOptions{droRecursiveSkipTypes} = do
skipTypeNames <- traverse lookupTypeNameOrFail droRecursiveSkipTypes
typeName <- lookupTypeNameOrFail typeStr
whenM (isTypeAlias typeName) $ fail $ typeStr <> " is a 'type' alias but not 'data' or 'newtype'."
allTypeNames <- findWithoutInstance typeName
join <$> forM (allTypeNames List.\\ skipTypeNames) \name ->
deriveRPCWithStrategy' name (name /= typeName) opts
where
-- Recursively enumerate @data@, @newtype@ and @type@ declarations,
-- and returns the names of only @data@ and @newtype@ of those that
-- don't yet have an 'AsRPC' instance. Type aliases don't need instances
-- and respectively there is no need to derive 'AsRPC' for them.
findWithoutInstance :: Name -> Q [Name]
findWithoutInstance typeName =
fmap fst <$> flip reifyManyTyCons [typeName] \(name, dec) ->
ifM (hasRPCInstance name)
do pure (False, []) -- exclude, don't recurse further
do (, decConcreteNames dec) . not <$> isTypeAlias name
-- exclude type aliases, recurse further
hasRPCInstance :: Name -> Q Bool
hasRPCInstance typeName = do
deriveFullTypeFromName typeName >>= \case
Nothing ->
fail $ "Found a field with a type that is neither a 'data' nor a 'newtype' nor a 'type': "
<> show typeName
Just typ ->
not . null <$> reifyInstances ''AsRPC [typ]
-- Given a type name, return the corresponding type expression
-- (applied to any type variables, if necessary).
--
-- For example, assuming a data type like @data F a b = ...@ exists in the type environment,
-- then @deriveFullTypeFromName ''F@ will return the type expression @[t|F a b|]@.
--
-- Note that only @data@, @newtype@ and @type@ declarations are supported at the moment.
deriveFullTypeFromName :: Name -> Q (Maybe Type)
deriveFullTypeFromName typeName = do
typeInfo <- reify typeName
case typeInfo of
TyConI (DataD _ _ vars mKind _ _) -> Just <$> deriveFullType typeName mKind vars
TyConI (NewtypeD _ _ vars mKind _ _) -> Just <$> deriveFullType typeName mKind vars
TyConI (TySynD _ vars _) -> Just <$> deriveFullType typeName Nothing vars
_ -> pure Nothing
-- skipVoids is set to True when doing deriveManyRPC recursively, i.e. for types
-- not explicitly requested by the caller.
deriveRPCWithStrategy' :: Name -> Bool -> DeriveRPCOptions -> Q [Dec]
deriveRPCWithStrategy' typeName skipVoids DeriveRPCOptions{..} = do
(_, decCxt, mKind, tyVars, constructors) <- reifyDataType typeName
derivedType <- deriveFullType typeName mKind tyVars
let typeNameRPC = convertName typeName
derivedTypeRPC <- deriveFullType typeNameRPC mKind tyVars
if null constructors
then ifM ((skipVoids &&) . null <$> reifyInstances ''IsoValue [derivedType])
-- if a void type doesn't have an IsoValue instance, it's likely used as a
-- typelevel tag. Skip it. Otherwise, derive a trivial 'HasRPCRepr'
-- instance.
do pure []
do sequence
[ mkAsRPCInstance [] derivedType derivedTypeRPC
, pure $ TySynD typeNameRPC [] $ ConT typeName
]
else do
constructorsRPC <- traverse convertConstructor constructors
fieldTypes <- getFieldTypes constructors
forM_ fieldTypes checkInstanceForFieldTy
fieldTypesRPC <- getFieldTypes constructorsRPC
-- Note: we can't use `makeRep0Inline` to derive a `Rep` instance for `derivedTypeRPC`
-- It internally uses `reify` to lookup info about `derivedTypeRPC`, and because `derivedTypeRPC` hasn't
-- been spliced *yet*, the lookup fails.
-- So, instead, we fetch the `Rep` instance for `derivedType`, and
-- append "RPC" to the type/constructor/field names in its metadata.
--
-- If, for some reason, we find out that this approach doesn't work for some edge cases,
-- we should get rid of it and patch the @generic-deriving@ package to export a version of `makeRep0Inline`
-- that doesn't use `reify` (it should be easy enough).
repInstance <- reifyRepInstance typeName derivedType
currentModuleName <- loc_module <$> location
let repTypeRPC = convertRep currentModuleName repInstance tyVars
typeDecOfRPC <- mkTypeDeclaration typeName decCxt typeNameRPC tyVars mKind constructorsRPC
-- Slightly modify the deriving strategy so that the field/constructor
-- reordering function from original strategy acts on input field names in
-- RPC type after stripping RPC suffix. Fix for #811
let
gs' = mangleGenericStrategyFields dropRPCSuffix $
mangleGenericStrategyConstructors dropRPCSuffix droStrategy
mconcat <$> sequence
[ pure . one $ typeDecOfRPC
, one <$> mkAsRPCInstance fieldTypes derivedType derivedTypeRPC
, mkIsoValueInstance fieldTypesRPC derivedTypeRPC
, customGeneric' (Just repTypeRPC) typeNameRPC derivedTypeRPC constructorsRPC gs'
, annotationInstance fieldTypes derivedType derivedTypeRPC
]
where
checkInstanceForFieldTy fieldTy =
reifyInstances ''HasRPCRepr [fieldTy] >>= \case
[] | droRecursive -> pass
| otherwise
-> fail $ "Type '" <> show (ppr fieldTy) <> "' must implement 'HasRPCRepr'."
[TH.InstanceD _ cs (ConT n' `AppT` ty) _] | n' == ''HasRPCRepr -> do
let tyMap = Map.fromList $ filter isVarMapping $
zip (unSigT <$> unAppsT ty) (unSigT <$> unAppsT fieldTy)
isVarMapping = \case
(VarT{}, _) -> True
_ -> False
instantiatedConstraints =
map (everywhere (mkT substVar)) . concatMap getHasRPCReprTys $
everywhere (mkT unSigT) cs
getHasRPCReprTys = \case
ConT n `AppT` x | n == ''HasRPCRepr -> [x]
ConT n `AppT` (PromotedConsT `AppT` ConT n2 `AppT` PromotedNilT) `AppT` xs
| n == ''Each, n2 == ''HasRPCRepr -> flip unfoldr xs \case
PromotedNilT -> Nothing
PromotedConsT `AppT` x `AppT` xs' -> Just (x, xs')
_ -> Nothing
_ -> [] -- we could error here and above, but for safety we don't
substVar = \case
v@VarT{} | Just s <- Map.lookup v tyMap -> s
x -> x
forM_ instantiatedConstraints checkInstanceForFieldTy
[d] -> fail $ "Unexpected instance for " <> show (ppr fieldTy) <> ": " <> show (ppr d)
-- most likely fieldTy is a tyvar, if not, GHC will complain about
-- duplicate instances anyway
(_:_:_) -> pass
-- Given the field type @FieldType a b@, returns @AsRPC (FieldType a b)@.
convertFieldType :: Type -> Type
convertFieldType tp = ConT ''AsRPC `AppT` tp
convertNameStr :: String -> String
convertNameStr s = s <> "RPC"
dropRPCSuffix :: Text -> Text
dropRPCSuffix = fromMaybe (error "Unexpected field/constructor without RPC suffix") . T.stripSuffix "RPC"
convertName :: Name -> Name
convertName = mkName . convertNameStr . nameBase
-- Given the constructor
-- @C { f :: Int }@,
-- returns the constructor
-- @CRPC { fRPC :: AsRPC Int }@.
convertConstructor :: Con -> Q Con
convertConstructor = \case
RecC conName fields -> pure $
RecC
(convertName conName)
(fields <&> \(fieldName, fieldBang, fieldType) ->
(convertName fieldName, fieldBang, convertFieldType fieldType)
)
NormalC conName fields -> pure $
NormalC (convertName conName) (second convertFieldType <$> fields)
InfixC fieldType1 conName fieldType2 -> pure $
InfixC (second convertFieldType fieldType1) (convertName conName) (second convertFieldType fieldType2)
constr -> fail $ "Unsupported constructor for '" <> show typeName <> "': " <> show (ppr constr)
-- Get a list of all the unique types of all the fields of all the given constructors.
getFieldTypes :: [Con] -> Q [Type]
getFieldTypes constrs = ordNub . join <$> forM constrs \case
RecC _ fields -> pure $ fields <&> \(_, _, fieldType) -> fieldType
NormalC _ fields -> pure $ snd <$> fields
InfixC field1 _ field2 -> pure [snd field1, snd field2]
constr -> fail $ "Unsupported constructor for '" <> show typeName <> "': " <> show (ppr constr)
mkTypeDeclaration :: Name -> Cxt -> Name -> [TyVarBndr ()] -> Maybe Kind -> [Con] -> Q Dec
mkTypeDeclaration tyName decCxt typeNameRPC tyVars mKind constructorsRPC = do
typeInfo <- reify tyName
case typeInfo of
TyConI DataD {} -> pure $ DataD decCxt typeNameRPC tyVars mKind constructorsRPC []
TyConI NewtypeD {} -> (case constructorsRPC of
[con] -> pure $ NewtypeD decCxt typeNameRPC tyVars mKind con []
_ -> fail "Newtype has only one constructor")
_ -> fail $ "Only newtypes and data types are supported, but '" <>
show tyName <> "' is:\n" <> show (ppr typeInfo)
-- Traverse a 'Rep' type and:
--
-- 1. Inspect its metadata and append @RPC@ to the type/constructor/field names.
-- 2. Convert field types (e.g. @T@ becomes @AsRPC T@).
-- 3. Replace the Rep's module name with the name of the module of where this Q is being spliced.
convertRep :: String -> TySynEqn -> [TyVarBndr a] -> Type
convertRep currentModuleName (TySynEqn _tyVars lhs rhs) tvs = go rhs
where
varMap = Map.fromList $ zip lhsTvs $ tvs <&> \case
PlainTV vName _ -> vName
KindedTV vName _ _ -> vName
lhsTvs = everything (<>) (mempty `mkQ` (maybe mempty pure . varTName)) lhs
varTName = \case
VarT v -> Just v
_ -> Nothing
go :: Type -> Type
go = \case
-- Rename type name and module name
PromotedT t `AppT` LitT (StrTyLit tyName) `AppT` LitT (StrTyLit _moduleName)
| t == 'G.MetaData
-> PromotedT t `AppT` LitT (StrTyLit (convertNameStr tyName)) `AppT` LitT (StrTyLit currentModuleName)
-- Rename constructor names
PromotedT t `AppT` LitT (StrTyLit conName)
| t == 'G.MetaCons
-> PromotedT t `AppT` LitT (StrTyLit (convertNameStr conName))
-- Rename field names
PromotedT t `AppT` (PromotedT just `AppT` LitT (StrTyLit fieldName))
| t == 'G.MetaSel
-> PromotedT t `AppT` (PromotedT just `AppT` LitT (StrTyLit (convertNameStr fieldName)))
-- Replace field type @T@ with @AsRPC T@
ConT x `AppT` fieldType
| x == ''G.Rec0
-> ConT x `AppT` (convertFieldType $ replaceVars fieldType)
x `AppT` y -> go x `AppT` go y
x -> replaceVars x
replaceVars = \case
VarT v -> VarT $ fromMaybe v $ Map.lookup v varMap
x -> x
-- Lookup the generic 'Rep' type instance for the given type.
reifyRepInstance :: Name -> Type -> Q TySynEqn
reifyRepInstance name tp =
reifyInstances ''G.Rep [tp] >>= \case
[TySynInstD repInstance] -> pure repInstance
(_:_) -> fail $ "Found multiple instances of 'Generic' for '" <> show name <> "'."
[] -> fail $ "Type '" <> show name <> "' must implement 'Generic'."
-- Given the type @Foo a b = Foo (Bar a)@, generate an 'IsoValue' instance like:
--
-- > instance IsoValue (AsRPC (Bar a)) => IsoValue (FooRPC a b)
--
-- Note that if a type variable @t@ is a phantom type variable, then no @IsoValue (AsRPC t)@
-- constraint is generated for it.
mkIsoValueInstance :: [Type] -> Type -> Q [Dec]
mkIsoValueInstance fieldTypes tp =
one <$> instanceD constraints [t|IsoValue $(pure tp)|] []
where
constraints :: Q Cxt
constraints =
cxt $ filter hasTyVar fieldTypes <&> \fieldType ->
[t|IsoValue $(pure fieldType)|]
-- Given the type @Foo a b = Foo (Bar a)@, generate an 'HasRPCRepr' instance like:
--
-- > instance HasRPCRepr (Bar a) => HasRPCRepr (Foo a b) where
-- > type AsRPC (Foo a b) = FooRPC a b
--
-- Note that if a type variable @t@ is a phantom type variable, then no @HasRPCRepr@
-- constraint is generated for it.
mkAsRPCInstance :: [Type] -> Type -> Type -> Q Dec
mkAsRPCInstance fieldTypes tp tpRPC = do
typeInstance <- [d|type instance AsRPC $(pure tp) = $(pure tpRPC)|]
instanceD constraints [t|HasRPCRepr $(pure tp)|]
(pure <$> typeInstance)
where
constraints :: Q Cxt
constraints =
cxt $ filter hasTyVar fieldTypes <&> \fieldType ->
[t|HasRPCRepr $(pure fieldType)|]
-- When @HasAnnotation@ and its methods are in scope, given the type @ty@
-- where @AsRPC ty = tyRPC@, generate a @HasAnnotation@ instance like:
--
-- > instance With [HasAnnotation, HasRPCRepr] ty => HasAnnotation tyRPC where
-- > getAnnotation = notesAsRPC . getAnnotation @ty
-- > annOptions = annOptions @ty
--
-- Note that if @ty@ doesn't contain type variables or only contains phantom
-- type variables, 'HasRPCRepr' constraint is omitted, as it would be
-- redundant.
--
-- Will fail if @HasAnnotation@ or its methods are not in scope.
annotationInstance :: [Type] -> Type -> Type -> Q [Dec]
annotationInstance _ _ _ | not droHasAnnotation = pure []
annotationInstance fields (pure -> ty) (pure -> tyRPC) = pure <$> do
let noHasAnnError :: Text -> Q b
noHasAnnError reason =
-- NB: weird indentation is due to how GHC formats multiline TH
-- errors (it doesn't)
fail [itu|
#{reason}
Did you mean to derive 'HasAnnotation' instances? If not, use:
deriveRPCWithOptions "#{tyBase}" def{droHasAnnotation=False}
|]
where tyBase = nameBase typeName
hasAnnNm <- maybe (noHasAnnError "'HasAnnotation' is not in scope.") pure =<<
lookupTypeName "HasAnnotation"
methodNames <- reify hasAnnNm >>= \case
TH.ClassI (TH.ClassD _ _ _ _ decs) _ ->
pure $ flip mapMaybe decs \case
TH.SigD name _ -> Just name
_ -> Nothing
x -> noHasAnnError $
"Expected 'HasAnnotation' to be a class, but instead found " <> show (ppr x)
getAnnNm <- find (\nm -> nameBase nm == "getAnnotation") methodNames &
maybe (noHasAnnError "Did not find 'getAnnotation' method on 'HasAnnotation'") pure
annOptNm <- find (\nm -> nameBase nm == "annOptions") methodNames &
maybe (noHasAnnError "Did not find 'annOptions' method on 'HasAnnotation'") pure
let hasAnn = conT hasAnnNm
constraints
| any hasTyVar fields = [[t| With '[$hasAnn, HasRPCRepr] $ty |]]
| otherwise = [[t| $hasAnn $ty |]]
instanceD (sequence constraints) [t|$hasAnn $tyRPC|]
[ valD (varP getAnnNm) (normalB [|notesAsRPC . $(varE getAnnNm) @($ty)|]) []
, valD (varP annOptNm) (normalB [|$(varE annOptNm) @($ty)|]) []
]
-- Checks if the given type has any type variables.
hasTyVar :: Type -> Bool
hasTyVar ty =
flip any (universe ty) \case
VarT _ -> True
_ -> False
----------------------------------------------------------------------------
-- Conversions
----------------------------------------------------------------------------
-- | Replace all big_maps in a value with the respective big_map IDs.
--
-- Throws an error if it finds a big_map without an ID.
valueAsRPC :: HasCallStack => Value t -> Value (TAsRPC t)
valueAsRPC v = case v of
VKey {} -> v
VUnit {} -> v
VSignature {} -> v
VChainId {} -> v
VChest {} -> v
VChestKey {} -> v
VOption (vMaybe :: Maybe (Value elem)) ->
VOption (valueAsRPC <$> vMaybe) \\ rpcSingIEvi @elem
VList (vList :: [Value elem]) ->
VList (valueAsRPC <$> vList) \\ rpcSingIEvi @elem
VSet {} -> v
VOp {} -> v
VContract {} -> v
VTicket {} -> v
VPair (x, y) -> VPair (valueAsRPC x, valueAsRPC y)
VOr (vEither :: Either (Value l) (Value r)) ->
VOr (bimap valueAsRPC valueAsRPC vEither) \\ rpcSingIEvi @l \\ rpcSingIEvi @r
VLam {} -> v
VMap (vMap :: Map (Value k) (Value v)) ->
VMap (valueAsRPC <$> vMap) \\ rpcSingIEvi @v
VBigMap (Just bmId) _ -> VNat bmId
VBigMap Nothing _ ->
error $ unlines
[ "Expected all big_maps to have an ID, but at least one big_map didn't."
, "This is most likely a bug."
]
VInt {} -> v
VNat {} -> v
VString {} -> v
VBytes {} -> v
VMutez {} -> v
VBool {} -> v
VKeyHash {} -> v
VTimestamp {} -> v
VAddress {} -> v
VBls12381Fr {} -> v
VBls12381G1 {} -> v
VBls12381G2 {} -> v
-- | Replaces all bigmap IDs with their corresponding bigmap values.
-- This is the inverse of `valueAsRPC`.
replaceBigMapIds
:: forall t m. Monad m
=> (forall k v. (SingI k, SingI v) => Natural -> m (Value ('TBigMap k v)))
-- ^ A function for looking up a bigmap using its ID.
-> Sing t -> Value (TAsRPC t) -> m (Value t)
replaceBigMapIds findBigMapById = go
where
go :: forall t1. Sing t1 -> Value (TAsRPC t1) -> m (Value t1)
go s v = case (s, v) of
(STKey {}, _) -> pure v
(STUnit {}, _) -> pure v
(STSignature {}, _) -> pure v
(STChainId {}, _) -> pure v
(STChest {}, _) -> pure v
(STChestKey {}, _) -> pure v
(STOption sMaybe, VOption vMaybe) ->
withSingI sMaybe $
VOption <$> traverse (go sMaybe) vMaybe
(STList sList, VList vList) ->
withSingI sList $
VList <$> traverse (go sList) vList
(STSet {}, _) -> pure v
(STOperation {}, _) -> pure v
(STContract {}, _) -> pure v
(STTicket {}, _) -> pure v
(STPair sa sb, VPair (a, b)) -> do
a' <- go sa a
b' <- go sb b
pure $ VPair (a', b')
(STOr sl sr, VOr vEither) -> withSingI sl $ withSingI sr $
case vEither of
Right r -> VOr . Right <$> go sr r
Left l -> VOr . Left <$> go sl l
(STLambda {}, _) -> pure v
(STMap _ sv, VMap vList) ->
withSingI sv $
VMap <$> traverse (go sv) vList
(STBigMap sk sv, VNat bigMapId) -> withSingI sk $ withSingI sv $ findBigMapById bigMapId
(STInt {}, _) -> pure v
(STNat {}, _) -> pure v
(STString {}, _) -> pure v
(STBytes {}, _) -> pure v
(STMutez {}, _) -> pure v
(STBool {}, _) -> pure v
(STKeyHash {}, _) -> pure v
(STTimestamp {}, _) -> pure v
(STAddress {}, _) -> pure v
(STBls12381Fr {}, _) -> pure v
(STBls12381G1 {}, _) -> pure v
(STBls12381G2 {}, _) -> pure v
-- | Replace all @big_map@ annotations in a value with @nat@ annotations.
notesAsRPC :: Notes t -> Notes (TAsRPC t)
notesAsRPC notes = case notes of
NTKey {} -> notes
NTUnit {} -> notes
NTSignature {} -> notes
NTChainId {} -> notes
NTChest {} -> notes
NTChestKey {} -> notes
NTOption typeAnn elemNotes -> NTOption typeAnn $ notesAsRPC elemNotes
NTList typeAnn elemNotes -> NTList typeAnn $ notesAsRPC elemNotes
NTSet {} -> notes
NTOperation {} -> notes
NTContract {} -> notes
NTTicket {} -> notes
NTPair typeAnn fieldAnn1 fieldAnn2 varAnn1 varAnn2 notes1 notes2 ->
NTPair typeAnn fieldAnn1 fieldAnn2 varAnn1 varAnn2 (notesAsRPC notes1) (notesAsRPC notes2)
NTOr typeAnn fieldAnn1 fieldAnn2 notes1 notes2 ->
NTOr typeAnn fieldAnn1 fieldAnn2 (notesAsRPC notes1) (notesAsRPC notes2)
NTLambda {} -> notes
NTMap typeAnn keyAnns valueNotes -> NTMap typeAnn keyAnns (notesAsRPC valueNotes)
NTBigMap typeAnn _ _ -> NTNat typeAnn
NTInt {} -> notes
NTNat {} -> notes
NTString {} -> notes
NTBytes {} -> notes
NTMutez {} -> notes
NTBool {} -> notes
NTKeyHash {} -> notes
NTTimestamp {} -> notes
NTAddress {} -> notes
NTBls12381Fr {} -> notes
NTBls12381G1 {} -> notes
NTBls12381G2 {} -> notes
NTNever {} -> notes
NTSaplingState {} -> notes
NTSaplingTransaction {} -> notes
----------------------------------------------------------------------------
-- Entailments
----------------------------------------------------------------------------
-- | A proof that if a singleton exists for @t@,
-- then so it does for @TAsRPC t@.
rpcSingIEvi :: forall t. SingI t => Dict (SingI (TAsRPC t))
rpcSingIEvi = withSingI (rpcSing $ sing @t) Dict
rpcSing :: Sing t -> Sing (TAsRPC t)
rpcSing st = case st of
STKey -> st
STUnit {} -> st
STSignature {} -> st
STChainId {} -> st
STChest {} -> st
STChestKey {} -> st
STOption s -> STOption $ rpcSing s
STList s -> STList $ rpcSing s
STSet{} -> st
STOperation {} -> st
STContract {} -> st
STTicket {} -> st
STPair sa sb -> STPair (rpcSing sa) (rpcSing sb)
STOr sl sr -> STOr (rpcSing sl) (rpcSing sr)
STLambda {} -> st
STMap sk sv -> STMap sk (rpcSing sv)
STBigMap {} -> STNat
STInt {} -> st
STNat {} -> st
STString {} -> st
STBytes {} -> st
STMutez {} -> st
STBool {} -> st
STKeyHash {} -> st
STBls12381Fr {} -> st
STBls12381G1 {} -> st
STBls12381G2 {} -> st
STTimestamp {} -> st
STAddress {} -> st
STNever {} -> st
STSaplingState _ -> st
STSaplingTransaction _ -> st
-- | A proof that if @t@ is well-typed, then @TAsRPC t@ is also well-typed.
rpcWellTypedEvi :: forall t. WellTyped t => Dict (WellTyped (TAsRPC t))
rpcWellTypedEvi = rpcWellTypedEvi' $ sing @t
rpcWellTypedEvi' :: WellTyped t => Sing t -> Dict (WellTyped (TAsRPC t))
rpcWellTypedEvi' sng = case sng of
STKey -> Dict
STUnit {} -> Dict
STSignature {} -> Dict
STChainId {} -> Dict
STOption s -> Dict \\ rpcWellTypedEvi' s
STList s -> Dict \\ rpcWellTypedEvi' s
STSet s -> Dict \\ rpcWellTypedEvi' s
STOperation {} -> Dict
STContract s -> Dict \\ rpcWellTypedEvi' s
STTicket s -> Dict \\ rpcWellTypedEvi' s
STPair sa sb -> Dict \\ rpcWellTypedEvi' sa \\ rpcWellTypedEvi' sb
STOr sl sr -> Dict \\ rpcWellTypedEvi' sl \\ rpcWellTypedEvi' sr
STLambda sa sb -> Dict \\ rpcWellTypedEvi' sa \\ rpcWellTypedEvi' sb
STMap sk sv -> Dict \\ rpcWellTypedEvi' sk \\ rpcWellTypedEvi' sv
STBigMap sk sv -> Dict \\ rpcWellTypedEvi' sk \\ rpcWellTypedEvi' sv
STInt {} -> Dict
STNat {} -> Dict
STString {} -> Dict
STBytes {} -> Dict
STMutez {} -> Dict
STBool {} -> Dict
STKeyHash {} -> Dict
STBls12381Fr {} -> Dict
STBls12381G1 {} -> Dict
STBls12381G2 {} -> Dict
STTimestamp {} -> Dict
STAddress {} -> Dict
STChest {} -> Dict
STChestKey {} -> Dict
STNever {} -> Dict
STSaplingState _ -> Dict
STSaplingTransaction _ -> Dict
-- | A proof that if @t@ does not contain any operations, then neither does @TAsRPC t@.
rpcHasNoOpEvi :: forall (t :: T). (SingI t, ForbidOp t) => Dict (ForbidOp (TAsRPC t))
rpcHasNoOpEvi = Dict \\ rpcHasNoTEvi @t SPSOp
-- | A proof that @AsRPC (Value t)@ does not contain big_maps.
rpcHasNoBigMapEvi :: forall (t :: T). (SingI t, ForbidBigMap t) => Dict (ForbidBigMap (TAsRPC t))
rpcHasNoBigMapEvi = Dict \\ rpcHasNoTEvi @t SPSBigMap
-- | A proof that @AsRPC (Value t)@ does not contain nested big_maps.
rpcHasNoNestedBigMapsEvi
:: forall (t :: T). (SingI t, ForbidNestedBigMaps t) => Dict (ForbidNestedBigMaps (TAsRPC t))
rpcHasNoNestedBigMapsEvi = Dict \\ rpcHasNoTEvi @t SPSNestedBigMaps
-- | A proof that @AsRPC (Value t)@ does not contain some type defined by a predicate.
rpcHasNoTEvi
:: forall (t :: T) p.
(SingI t, ContainsT p t ~ 'False)
=> Sing p -> (ContainsT p (TAsRPC t) :~: 'False)
rpcHasNoTEvi sp = rpcHasNoTEvi' sp (sing @t)
rpcHasNoTEvi'
:: forall t p. (ContainsT p t ~ 'False)
=> Sing p -> Sing t -> ContainsT p (TAsRPC t) :~: 'False
rpcHasNoTEvi' ps ts = stubProof case ts of
STKey -> Refl
STUnit {} -> Refl
STSignature {} -> Refl
STChainId {} -> Refl
STChest {} -> Refl
STChestKey {} -> Refl
STOption s -> Refl \\ go s
STList s -> case ps of
SPSOp -> Refl \\ go s
SPSContract -> Refl \\ go s
SPSTicket -> Refl \\ go s
SPSBigMap -> Refl \\ go s
SPSNestedBigMaps -> Refl \\ go s
SPSSaplingState -> Refl \\ go s
STSet _ -> case ps of
SPSOp -> Refl
SPSContract -> Refl
SPSTicket -> Refl
SPSBigMap -> Refl
SPSNestedBigMaps -> Refl
SPSSaplingState -> Refl
STOperation {} -> case ps of
SPSContract -> Refl
SPSTicket -> Refl
SPSBigMap -> Refl
SPSNestedBigMaps -> Refl
SPSSaplingState -> Refl
STContract {} -> case ps of
SPSOp -> Refl
SPSTicket -> Refl
SPSBigMap -> Refl
SPSNestedBigMaps -> Refl
SPSSaplingState -> Refl
STTicket _ -> case ps of
SPSOp -> Refl
SPSContract -> Refl
SPSBigMap -> Refl
SPSNestedBigMaps -> Refl
SPSSaplingState -> Refl
STPair sa sb -> deMorganForbidT ps sa sb $ Refl \\ go sa \\ go sb
STOr sl sr -> deMorganForbidT ps sl sr $ Refl \\ go sl \\ go sr
STLambda {} -> Refl
STMap sk sv -> case ps of
SPSOp -> deMorganForbidT ps sk sv $ Refl \\ go sv
SPSContract -> deMorganForbidT ps sk sv $ Refl \\ go sv
SPSTicket -> deMorganForbidT ps sk sv $ Refl \\ go sv
SPSBigMap -> deMorganForbidT ps sk sv $ Refl \\ go sv
SPSNestedBigMaps -> deMorganForbidT ps sk sv $ Refl \\ go sv
SPSSaplingState -> deMorganForbidT ps sk sv $ Refl \\ go sv
STBigMap {} -> Refl
STInt {} -> Refl
STNat {} -> Refl
STString {} -> Refl
STBytes {} -> Refl
STMutez {} -> Refl
STBool {} -> Refl
STKeyHash {} -> Refl
STBls12381Fr {} -> Refl
STBls12381G1 {} -> Refl
STBls12381G2 {} -> Refl
STTimestamp {} -> Refl
STAddress {} -> Refl
STNever {} -> Refl
STSaplingState {} -> case ps of
SPSOp -> Refl
SPSTicket -> Refl
SPSContract -> Refl
SPSBigMap -> Refl
SPSNestedBigMaps -> Refl
STSaplingTransaction {} -> Refl
where
go :: (ContainsT p t' ~ 'False) => Sing t' -> ContainsT p (TAsRPC t') :~: 'False
go = rpcHasNoTEvi' ps
-- | A proof that if @t@ does not contain any contract values, then neither does @TAsRPC t@.
rpcHasNoContractEvi
:: forall (t :: T). (SingI t, ForbidContract t) => Dict (ForbidContract (TAsRPC t))
rpcHasNoContractEvi = Dict \\ rpcHasNoTEvi @t SPSContract
-- | A proof that if @t@ is a valid storage type, then so is @TAsRPC t@.
rpcStorageScopeEvi :: forall (t :: T). StorageScope t => Dict (StorageScope (TAsRPC t))
rpcStorageScopeEvi = Dict
\\ rpcSingIEvi @t
\\ rpcHasNoOpEvi @t
\\ rpcHasNoNestedBigMapsEvi @t
\\ rpcHasNoContractEvi @t
\\ rpcWellTypedEvi @t