{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
module Network.Polkadot.Metadata.V12 where
import Codec.Scale (Decode, Encode, Generic)
import Data.Aeson (Options (fieldLabelModifier),
defaultOptions)
import Data.Aeson.TH (deriveJSON)
import Data.Char (toLower)
import Data.Text (Text)
import Data.Word (Word8)
import qualified GHC.Generics as GHC (Generic)
import Lens.Micro (_head, over)
import qualified Network.Polkadot.Metadata.V11 as V11
type ExtrinsicMetadata = V11.ExtrinsicMetadata
type StorageMetadata = V11.StorageMetadata
type FunctionMetadata = V11.FunctionMetadata
type EventMetadata = V11.EventMetadata
type ModuleConstantMetadata = V11.ModuleConstantMetadata
type ErrorMetadata = V11.ErrorMetadata
type MapType = V11.MapType
type DoubleMapType = V11.DoubleMapType
type StorageHasher = V11.StorageHasher
type StorageEntryModifier = V11.StorageEntryModifier
data ModuleMetadata = ModuleMetadata
{ ModuleMetadata -> Text
moduleName :: !Text
, ModuleMetadata -> Maybe StorageMetadata
moduleStorage :: !(Maybe StorageMetadata)
, ModuleMetadata -> Maybe [FunctionMetadata]
moduleCalls :: !(Maybe [FunctionMetadata])
, ModuleMetadata -> Maybe [EventMetadata]
moduleEvents :: !(Maybe [EventMetadata])
, ModuleMetadata -> [ModuleConstantMetadata]
moduleConstants :: ![ModuleConstantMetadata]
, ModuleMetadata -> [ErrorMetadata]
moduleErrors :: ![ErrorMetadata]
, ModuleMetadata -> Word8
moduleIndex :: !Word8
} deriving (ModuleMetadata -> ModuleMetadata -> Bool
(ModuleMetadata -> ModuleMetadata -> Bool)
-> (ModuleMetadata -> ModuleMetadata -> Bool) -> Eq ModuleMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModuleMetadata -> ModuleMetadata -> Bool
== :: ModuleMetadata -> ModuleMetadata -> Bool
$c/= :: ModuleMetadata -> ModuleMetadata -> Bool
/= :: ModuleMetadata -> ModuleMetadata -> Bool
Eq, Int -> ModuleMetadata -> ShowS
[ModuleMetadata] -> ShowS
ModuleMetadata -> String
(Int -> ModuleMetadata -> ShowS)
-> (ModuleMetadata -> String)
-> ([ModuleMetadata] -> ShowS)
-> Show ModuleMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModuleMetadata -> ShowS
showsPrec :: Int -> ModuleMetadata -> ShowS
$cshow :: ModuleMetadata -> String
show :: ModuleMetadata -> String
$cshowList :: [ModuleMetadata] -> ShowS
showList :: [ModuleMetadata] -> ShowS
Show, All SListI (Code ModuleMetadata)
All SListI (Code ModuleMetadata) =>
(ModuleMetadata -> Rep ModuleMetadata)
-> (Rep ModuleMetadata -> ModuleMetadata) -> Generic ModuleMetadata
Rep ModuleMetadata -> ModuleMetadata
ModuleMetadata -> Rep ModuleMetadata
forall a.
All SListI (Code a) =>
(a -> Rep a) -> (Rep a -> a) -> Generic a
$cfrom :: ModuleMetadata -> Rep ModuleMetadata
from :: ModuleMetadata -> Rep ModuleMetadata
$cto :: Rep ModuleMetadata -> ModuleMetadata
to :: Rep ModuleMetadata -> ModuleMetadata
Generic, (forall x. ModuleMetadata -> Rep ModuleMetadata x)
-> (forall x. Rep ModuleMetadata x -> ModuleMetadata)
-> Generic ModuleMetadata
forall x. Rep ModuleMetadata x -> ModuleMetadata
forall x. ModuleMetadata -> Rep ModuleMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ModuleMetadata -> Rep ModuleMetadata x
from :: forall x. ModuleMetadata -> Rep ModuleMetadata x
$cto :: forall x. Rep ModuleMetadata x -> ModuleMetadata
to :: forall x. Rep ModuleMetadata x -> ModuleMetadata
GHC.Generic, Putter ModuleMetadata
Putter ModuleMetadata -> Encode ModuleMetadata
forall a. Putter a -> Encode a
$cput :: Putter ModuleMetadata
put :: Putter ModuleMetadata
Encode, Get ModuleMetadata
Get ModuleMetadata -> Decode ModuleMetadata
forall a. Get a -> Decode a
$cget :: Get ModuleMetadata
get :: Get ModuleMetadata
Decode)
$(deriveJSON (defaultOptions
{ fieldLabelModifier = over _head toLower . drop 6 }) ''ModuleMetadata)
data Metadata = Metadata
{ Metadata -> [ModuleMetadata]
modules :: ![ModuleMetadata]
, Metadata -> ExtrinsicMetadata
extrinsic :: !ExtrinsicMetadata
} deriving (Metadata -> Metadata -> Bool
(Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Bool) -> Eq Metadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Metadata -> Metadata -> Bool
== :: Metadata -> Metadata -> Bool
$c/= :: Metadata -> Metadata -> Bool
/= :: Metadata -> Metadata -> Bool
Eq, Int -> Metadata -> ShowS
[Metadata] -> ShowS
Metadata -> String
(Int -> Metadata -> ShowS)
-> (Metadata -> String) -> ([Metadata] -> ShowS) -> Show Metadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Metadata -> ShowS
showsPrec :: Int -> Metadata -> ShowS
$cshow :: Metadata -> String
show :: Metadata -> String
$cshowList :: [Metadata] -> ShowS
showList :: [Metadata] -> ShowS
Show, All SListI (Code Metadata)
All SListI (Code Metadata) =>
(Metadata -> Rep Metadata)
-> (Rep Metadata -> Metadata) -> Generic Metadata
Rep Metadata -> Metadata
Metadata -> Rep Metadata
forall a.
All SListI (Code a) =>
(a -> Rep a) -> (Rep a -> a) -> Generic a
$cfrom :: Metadata -> Rep Metadata
from :: Metadata -> Rep Metadata
$cto :: Rep Metadata -> Metadata
to :: Rep Metadata -> Metadata
Generic, (forall x. Metadata -> Rep Metadata x)
-> (forall x. Rep Metadata x -> Metadata) -> Generic Metadata
forall x. Rep Metadata x -> Metadata
forall x. Metadata -> Rep Metadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Metadata -> Rep Metadata x
from :: forall x. Metadata -> Rep Metadata x
$cto :: forall x. Rep Metadata x -> Metadata
to :: forall x. Rep Metadata x -> Metadata
GHC.Generic, Putter Metadata
Putter Metadata -> Encode Metadata
forall a. Putter a -> Encode a
$cput :: Putter Metadata
put :: Putter Metadata
Encode, Get Metadata
Get Metadata -> Decode Metadata
forall a. Get a -> Decode a
$cget :: Get Metadata
get :: Get Metadata
Decode)
$(deriveJSON defaultOptions ''Metadata)