{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TemplateHaskell            #-}

-- |
-- Module      :  Network.Polkadot.Rpc.Types
-- Copyright   :  Aleksandr Krupenkin 2016-2024
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  portable
--
-- Polkadot JSON-RPC types.
--

module Network.Polkadot.Rpc.Types where

import           Data.Aeson               (FromJSON (..),
                                           Options (fieldLabelModifier),
                                           ToJSON (..), Value (String),
                                           defaultOptions)
import           Data.Aeson.TH            (deriveJSON)
import           Data.ByteArray.HexString (HexString)
import           Data.Char                (toLower)
import           Data.Text                (Text)
import           Data.Word                (Word32, Word64, Word8)
import           GHC.Generics             (Generic)
import           Lens.Micro               (_head, over)
import           Numeric                  (readHex, showHex)

-- | The role the node is running as.
data NodeRole = Full
    | LightClient
    | Authority
    | Sentry
    deriving (NodeRole -> NodeRole -> Bool
(NodeRole -> NodeRole -> Bool)
-> (NodeRole -> NodeRole -> Bool) -> Eq NodeRole
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeRole -> NodeRole -> Bool
== :: NodeRole -> NodeRole -> Bool
$c/= :: NodeRole -> NodeRole -> Bool
/= :: NodeRole -> NodeRole -> Bool
Eq, (forall x. NodeRole -> Rep NodeRole x)
-> (forall x. Rep NodeRole x -> NodeRole) -> Generic NodeRole
forall x. Rep NodeRole x -> NodeRole
forall x. NodeRole -> Rep NodeRole x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NodeRole -> Rep NodeRole x
from :: forall x. NodeRole -> Rep NodeRole x
$cto :: forall x. Rep NodeRole x -> NodeRole
to :: forall x. Rep NodeRole x -> NodeRole
Generic, Int -> NodeRole -> ShowS
[NodeRole] -> ShowS
NodeRole -> String
(Int -> NodeRole -> ShowS)
-> (NodeRole -> String) -> ([NodeRole] -> ShowS) -> Show NodeRole
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeRole -> ShowS
showsPrec :: Int -> NodeRole -> ShowS
$cshow :: NodeRole -> String
show :: NodeRole -> String
$cshowList :: [NodeRole] -> ShowS
showList :: [NodeRole] -> ShowS
Show)

$(deriveJSON defaultOptions ''NodeRole)

-- | Type op a chain.
data ChainType = Development
    | Local
    | Live
    | Custom Text
    deriving (ChainType -> ChainType -> Bool
(ChainType -> ChainType -> Bool)
-> (ChainType -> ChainType -> Bool) -> Eq ChainType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChainType -> ChainType -> Bool
== :: ChainType -> ChainType -> Bool
$c/= :: ChainType -> ChainType -> Bool
/= :: ChainType -> ChainType -> Bool
Eq, (forall x. ChainType -> Rep ChainType x)
-> (forall x. Rep ChainType x -> ChainType) -> Generic ChainType
forall x. Rep ChainType x -> ChainType
forall x. ChainType -> Rep ChainType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChainType -> Rep ChainType x
from :: forall x. ChainType -> Rep ChainType x
$cto :: forall x. Rep ChainType x -> ChainType
to :: forall x. Rep ChainType x -> ChainType
Generic, Int -> ChainType -> ShowS
[ChainType] -> ShowS
ChainType -> String
(Int -> ChainType -> ShowS)
-> (ChainType -> String)
-> ([ChainType] -> ShowS)
-> Show ChainType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChainType -> ShowS
showsPrec :: Int -> ChainType -> ShowS
$cshow :: ChainType -> String
show :: ChainType -> String
$cshowList :: [ChainType] -> ShowS
showList :: [ChainType] -> ShowS
Show)

instance FromJSON ChainType where
    parseJSON :: Value -> Parser ChainType
parseJSON (String Text
v) = ChainType -> Parser ChainType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (ChainType -> Parser ChainType) -> ChainType -> Parser ChainType
forall a b. (a -> b) -> a -> b
$ case Text
v of
        Text
"Development" -> ChainType
Development
        Text
"Local"       -> ChainType
Local
        Text
"Live"        -> ChainType
Live
        Text
custom_name   -> Text -> ChainType
Custom Text
custom_name
    parseJSON Value
_ = String -> Parser ChainType
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"ChainType should be a JSON String"

instance ToJSON ChainType where
    toJSON :: ChainType -> Value
toJSON (Custom Text
v) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
v
    toJSON ChainType
v          = String -> Value
forall a. ToJSON a => a -> Value
toJSON (ChainType -> String
forall a. Show a => a -> String
show ChainType
v)

-- | System health struct returned by the RPC
data Health = Health
    { Health -> Int
healthPeers           :: Int
    -- ^ Number of connected peers.
    , Health -> Bool
healthIsSyncing       :: Bool
    -- ^ Is the node syncing.
    , Health -> Bool
healthShouldHavePeers :: Bool
    -- ^ Should this node have any peers.
    }
    deriving (Health -> Health -> Bool
(Health -> Health -> Bool)
-> (Health -> Health -> Bool) -> Eq Health
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Health -> Health -> Bool
== :: Health -> Health -> Bool
$c/= :: Health -> Health -> Bool
/= :: Health -> Health -> Bool
Eq, (forall x. Health -> Rep Health x)
-> (forall x. Rep Health x -> Health) -> Generic Health
forall x. Rep Health x -> Health
forall x. Health -> Rep Health x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Health -> Rep Health x
from :: forall x. Health -> Rep Health x
$cto :: forall x. Rep Health x -> Health
to :: forall x. Rep Health x -> Health
Generic, Int -> Health -> ShowS
[Health] -> ShowS
Health -> String
(Int -> Health -> ShowS)
-> (Health -> String) -> ([Health] -> ShowS) -> Show Health
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Health -> ShowS
showsPrec :: Int -> Health -> ShowS
$cshow :: Health -> String
show :: Health -> String
$cshowList :: [Health] -> ShowS
showList :: [Health] -> ShowS
Show)

$(deriveJSON (defaultOptions
    { fieldLabelModifier = over _head toLower . drop 6 }) ''Health)

-- | Network Peer information.
data PeerInfo = PeerInfo
    { PeerInfo -> Text
peerInfoPeerId          :: Text
    -- ^ Peer ID
    , PeerInfo -> [NodeRole]
peerInfoRoles           :: [NodeRole]
    -- ^ Roles
    , PeerInfo -> Int
peerInfoProtocolVersion :: Int
    -- ^ Protocol version.
    , PeerInfo -> Text
peerInfoBestHash        :: Text
    -- ^ Peer best block hash
    , PeerInfo -> Int
peerInfoBestNumber      :: Int
    -- ^ Peer best block number
    }
    deriving (PeerInfo -> PeerInfo -> Bool
(PeerInfo -> PeerInfo -> Bool)
-> (PeerInfo -> PeerInfo -> Bool) -> Eq PeerInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PeerInfo -> PeerInfo -> Bool
== :: PeerInfo -> PeerInfo -> Bool
$c/= :: PeerInfo -> PeerInfo -> Bool
/= :: PeerInfo -> PeerInfo -> Bool
Eq, (forall x. PeerInfo -> Rep PeerInfo x)
-> (forall x. Rep PeerInfo x -> PeerInfo) -> Generic PeerInfo
forall x. Rep PeerInfo x -> PeerInfo
forall x. PeerInfo -> Rep PeerInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PeerInfo -> Rep PeerInfo x
from :: forall x. PeerInfo -> Rep PeerInfo x
$cto :: forall x. Rep PeerInfo x -> PeerInfo
to :: forall x. Rep PeerInfo x -> PeerInfo
Generic, Int -> PeerInfo -> ShowS
[PeerInfo] -> ShowS
PeerInfo -> String
(Int -> PeerInfo -> ShowS)
-> (PeerInfo -> String) -> ([PeerInfo] -> ShowS) -> Show PeerInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PeerInfo -> ShowS
showsPrec :: Int -> PeerInfo -> ShowS
$cshow :: PeerInfo -> String
show :: PeerInfo -> String
$cshowList :: [PeerInfo] -> ShowS
showList :: [PeerInfo] -> ShowS
Show)

$(deriveJSON (defaultOptions
    { fieldLabelModifier = over _head toLower . drop 8 }) ''PeerInfo)

-- | Executes a call to a contract.
data ContractCall = ContractCall
    { ContractCall -> HexString
callOrigin    :: HexString
    , ContractCall -> HexString
callDest      :: HexString
    , ContractCall -> Integer
callValue     :: Integer
    , ContractCall -> Integer
callGasLimit  :: Integer
    , ContractCall -> HexString
callInputData :: HexString
    }
    deriving (ContractCall -> ContractCall -> Bool
(ContractCall -> ContractCall -> Bool)
-> (ContractCall -> ContractCall -> Bool) -> Eq ContractCall
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ContractCall -> ContractCall -> Bool
== :: ContractCall -> ContractCall -> Bool
$c/= :: ContractCall -> ContractCall -> Bool
/= :: ContractCall -> ContractCall -> Bool
Eq, (forall x. ContractCall -> Rep ContractCall x)
-> (forall x. Rep ContractCall x -> ContractCall)
-> Generic ContractCall
forall x. Rep ContractCall x -> ContractCall
forall x. ContractCall -> Rep ContractCall x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ContractCall -> Rep ContractCall x
from :: forall x. ContractCall -> Rep ContractCall x
$cto :: forall x. Rep ContractCall x -> ContractCall
to :: forall x. Rep ContractCall x -> ContractCall
Generic, Int -> ContractCall -> ShowS
[ContractCall] -> ShowS
ContractCall -> String
(Int -> ContractCall -> ShowS)
-> (ContractCall -> String)
-> ([ContractCall] -> ShowS)
-> Show ContractCall
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContractCall -> ShowS
showsPrec :: Int -> ContractCall -> ShowS
$cshow :: ContractCall -> String
show :: ContractCall -> String
$cshowList :: [ContractCall] -> ShowS
showList :: [ContractCall] -> ShowS
Show)

$(deriveJSON (defaultOptions
    { fieldLabelModifier = over _head toLower . drop 4 }) ''ContractCall)

-- | A result of execution of a contract.
data ContractExecResult = SuccessExec
    { ContractExecResult -> Word8
execStatus :: Word8
    -- ^ Status code returned by contract.
    , ContractExecResult -> Maybe HexString
execData   :: Maybe HexString
    -- ^ Output data returned by contract. Can be empty.
    }
    | ExecResultError
    deriving (ContractExecResult -> ContractExecResult -> Bool
(ContractExecResult -> ContractExecResult -> Bool)
-> (ContractExecResult -> ContractExecResult -> Bool)
-> Eq ContractExecResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ContractExecResult -> ContractExecResult -> Bool
== :: ContractExecResult -> ContractExecResult -> Bool
$c/= :: ContractExecResult -> ContractExecResult -> Bool
/= :: ContractExecResult -> ContractExecResult -> Bool
Eq, (forall x. ContractExecResult -> Rep ContractExecResult x)
-> (forall x. Rep ContractExecResult x -> ContractExecResult)
-> Generic ContractExecResult
forall x. Rep ContractExecResult x -> ContractExecResult
forall x. ContractExecResult -> Rep ContractExecResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ContractExecResult -> Rep ContractExecResult x
from :: forall x. ContractExecResult -> Rep ContractExecResult x
$cto :: forall x. Rep ContractExecResult x -> ContractExecResult
to :: forall x. Rep ContractExecResult x -> ContractExecResult
Generic, Int -> ContractExecResult -> ShowS
[ContractExecResult] -> ShowS
ContractExecResult -> String
(Int -> ContractExecResult -> ShowS)
-> (ContractExecResult -> String)
-> ([ContractExecResult] -> ShowS)
-> Show ContractExecResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContractExecResult -> ShowS
showsPrec :: Int -> ContractExecResult -> ShowS
$cshow :: ContractExecResult -> String
show :: ContractExecResult -> String
$cshowList :: [ContractExecResult] -> ShowS
showList :: [ContractExecResult] -> ShowS
Show)

$(deriveJSON (defaultOptions
    { fieldLabelModifier = over _head toLower . drop 4 }) ''ContractExecResult)

-- | ReadProof struct returned by RPC.
data ReadProof = ReadProof
    { ReadProof -> HexString
readProofAt    :: HexString
    -- ^ Block hash used to generate the proof.
    , ReadProof -> [HexString]
readProofProof :: [HexString]
    -- ^ A proof used to prove that storage entries are included in the storage trie.
    }
    deriving (ReadProof -> ReadProof -> Bool
(ReadProof -> ReadProof -> Bool)
-> (ReadProof -> ReadProof -> Bool) -> Eq ReadProof
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReadProof -> ReadProof -> Bool
== :: ReadProof -> ReadProof -> Bool
$c/= :: ReadProof -> ReadProof -> Bool
/= :: ReadProof -> ReadProof -> Bool
Eq, (forall x. ReadProof -> Rep ReadProof x)
-> (forall x. Rep ReadProof x -> ReadProof) -> Generic ReadProof
forall x. Rep ReadProof x -> ReadProof
forall x. ReadProof -> Rep ReadProof x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReadProof -> Rep ReadProof x
from :: forall x. ReadProof -> Rep ReadProof x
$cto :: forall x. Rep ReadProof x -> ReadProof
to :: forall x. Rep ReadProof x -> ReadProof
Generic, Int -> ReadProof -> ShowS
[ReadProof] -> ShowS
ReadProof -> String
(Int -> ReadProof -> ShowS)
-> (ReadProof -> String)
-> ([ReadProof] -> ShowS)
-> Show ReadProof
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReadProof -> ShowS
showsPrec :: Int -> ReadProof -> ShowS
$cshow :: ReadProof -> String
show :: ReadProof -> String
$cshowList :: [ReadProof] -> ShowS
showList :: [ReadProof] -> ShowS
Show)

$(deriveJSON (defaultOptions
    { fieldLabelModifier = over _head toLower . drop 9 }) ''ReadProof)

-- | Runtime version.
-- This should not be thought of as classic Semver (major/minor/tiny).
-- This triplet have different semantics and mis-interpretation could cause problems.
-- In particular: bug fixes should result in an increment of `spec_version` and possibly `authoring_version`,
-- absolutely not `impl_version` since they change the semantics of the runtime.
data RuntimeVersion = RuntimeVersion
    { RuntimeVersion -> Text
runtimeSpecName           :: Text
    -- ^ Identifies the different Substrate runtimes.
    , RuntimeVersion -> Text
runtimeImplName           :: Text
    -- ^ Name of the implementation of the spec.
    , RuntimeVersion -> Word32
runtimeAuthoringVersion   :: Word32
    -- ^ `authoring_version` is the version of the authorship interface.
    , RuntimeVersion -> Word32
runtimeSpecVersion        :: Word32
    -- ^ Version of the runtime specification.
    , RuntimeVersion -> Word32
runtimeImplVersion        :: Word32
    -- ^ Version of the implementation of the specification.
    , RuntimeVersion -> [(HexString, Word32)]
runtimeApis               :: [(HexString, Word32)]
    -- ^ List of supported API "features" along with their versions.
    , RuntimeVersion -> Word32
runtimeTransactionVersion :: Word32
    -- ^ All existing dispatches are fully compatible when this number doesn't change.
    }
    deriving (RuntimeVersion -> RuntimeVersion -> Bool
(RuntimeVersion -> RuntimeVersion -> Bool)
-> (RuntimeVersion -> RuntimeVersion -> Bool) -> Eq RuntimeVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RuntimeVersion -> RuntimeVersion -> Bool
== :: RuntimeVersion -> RuntimeVersion -> Bool
$c/= :: RuntimeVersion -> RuntimeVersion -> Bool
/= :: RuntimeVersion -> RuntimeVersion -> Bool
Eq, (forall x. RuntimeVersion -> Rep RuntimeVersion x)
-> (forall x. Rep RuntimeVersion x -> RuntimeVersion)
-> Generic RuntimeVersion
forall x. Rep RuntimeVersion x -> RuntimeVersion
forall x. RuntimeVersion -> Rep RuntimeVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RuntimeVersion -> Rep RuntimeVersion x
from :: forall x. RuntimeVersion -> Rep RuntimeVersion x
$cto :: forall x. Rep RuntimeVersion x -> RuntimeVersion
to :: forall x. Rep RuntimeVersion x -> RuntimeVersion
Generic, Int -> RuntimeVersion -> ShowS
[RuntimeVersion] -> ShowS
RuntimeVersion -> String
(Int -> RuntimeVersion -> ShowS)
-> (RuntimeVersion -> String)
-> ([RuntimeVersion] -> ShowS)
-> Show RuntimeVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RuntimeVersion -> ShowS
showsPrec :: Int -> RuntimeVersion -> ShowS
$cshow :: RuntimeVersion -> String
show :: RuntimeVersion -> String
$cshowList :: [RuntimeVersion] -> ShowS
showList :: [RuntimeVersion] -> ShowS
Show)

$(deriveJSON (defaultOptions
    { fieldLabelModifier = over _head toLower . drop 7 }) ''RuntimeVersion)

-- | Type of supported offchain storages.
--
-- 1: persistent storage is non-revertible and not fork-aware;
-- 2: local storage is revertible and fork-aware.
type StorageKind = Word8

-- | Storage changes.
data StorageChangeSet = StorageChangeSet
    { StorageChangeSet -> HexString
storageBlock   :: HexString
    -- ^ Block hash.
    , StorageChangeSet -> [(HexString, Maybe HexString)]
storageChanges :: [(HexString, Maybe HexString)]
    -- ^ A list of changes.
    }

$(deriveJSON (defaultOptions
    { fieldLabelModifier = over _head toLower . drop 7 }) ''StorageChangeSet)

-- | Numeric range of transaction weight.
type Weight = Word64

-- | Generalized group of dispatch types.
data DispatchClass = Normal
    | Operational
    | Mandatory
    deriving (DispatchClass -> DispatchClass -> Bool
(DispatchClass -> DispatchClass -> Bool)
-> (DispatchClass -> DispatchClass -> Bool) -> Eq DispatchClass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DispatchClass -> DispatchClass -> Bool
== :: DispatchClass -> DispatchClass -> Bool
$c/= :: DispatchClass -> DispatchClass -> Bool
/= :: DispatchClass -> DispatchClass -> Bool
Eq, (forall x. DispatchClass -> Rep DispatchClass x)
-> (forall x. Rep DispatchClass x -> DispatchClass)
-> Generic DispatchClass
forall x. Rep DispatchClass x -> DispatchClass
forall x. DispatchClass -> Rep DispatchClass x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DispatchClass -> Rep DispatchClass x
from :: forall x. DispatchClass -> Rep DispatchClass x
$cto :: forall x. Rep DispatchClass x -> DispatchClass
to :: forall x. Rep DispatchClass x -> DispatchClass
Generic, Int -> DispatchClass -> ShowS
[DispatchClass] -> ShowS
DispatchClass -> String
(Int -> DispatchClass -> ShowS)
-> (DispatchClass -> String)
-> ([DispatchClass] -> ShowS)
-> Show DispatchClass
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DispatchClass -> ShowS
showsPrec :: Int -> DispatchClass -> ShowS
$cshow :: DispatchClass -> String
show :: DispatchClass -> String
$cshowList :: [DispatchClass] -> ShowS
showList :: [DispatchClass] -> ShowS
Show)

$(deriveJSON defaultOptions ''DispatchClass)

-- | Some information related to a dispatchable that can be queried from the runtime.
data RuntimeDispatchInfo = RuntimeDispatchInfo
    { RuntimeDispatchInfo -> Weight
dispatchWeight     :: Weight
    -- ^ Weight of this dispatch.
    , RuntimeDispatchInfo -> DispatchClass
dispatchClass      :: DispatchClass
    -- ^ Class of this dispatch.
    , RuntimeDispatchInfo -> Integer
dispatchPartialFee :: Integer
    -- ^ The partial inclusion fee of this dispatch.
    }
    deriving (RuntimeDispatchInfo -> RuntimeDispatchInfo -> Bool
(RuntimeDispatchInfo -> RuntimeDispatchInfo -> Bool)
-> (RuntimeDispatchInfo -> RuntimeDispatchInfo -> Bool)
-> Eq RuntimeDispatchInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RuntimeDispatchInfo -> RuntimeDispatchInfo -> Bool
== :: RuntimeDispatchInfo -> RuntimeDispatchInfo -> Bool
$c/= :: RuntimeDispatchInfo -> RuntimeDispatchInfo -> Bool
/= :: RuntimeDispatchInfo -> RuntimeDispatchInfo -> Bool
Eq, (forall x. RuntimeDispatchInfo -> Rep RuntimeDispatchInfo x)
-> (forall x. Rep RuntimeDispatchInfo x -> RuntimeDispatchInfo)
-> Generic RuntimeDispatchInfo
forall x. Rep RuntimeDispatchInfo x -> RuntimeDispatchInfo
forall x. RuntimeDispatchInfo -> Rep RuntimeDispatchInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RuntimeDispatchInfo -> Rep RuntimeDispatchInfo x
from :: forall x. RuntimeDispatchInfo -> Rep RuntimeDispatchInfo x
$cto :: forall x. Rep RuntimeDispatchInfo x -> RuntimeDispatchInfo
to :: forall x. Rep RuntimeDispatchInfo x -> RuntimeDispatchInfo
Generic, Int -> RuntimeDispatchInfo -> ShowS
[RuntimeDispatchInfo] -> ShowS
RuntimeDispatchInfo -> String
(Int -> RuntimeDispatchInfo -> ShowS)
-> (RuntimeDispatchInfo -> String)
-> ([RuntimeDispatchInfo] -> ShowS)
-> Show RuntimeDispatchInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RuntimeDispatchInfo -> ShowS
showsPrec :: Int -> RuntimeDispatchInfo -> ShowS
$cshow :: RuntimeDispatchInfo -> String
show :: RuntimeDispatchInfo -> String
$cshowList :: [RuntimeDispatchInfo] -> ShowS
showList :: [RuntimeDispatchInfo] -> ShowS
Show)

$(deriveJSON (defaultOptions
    { fieldLabelModifier = over _head toLower . drop 8 }) ''RuntimeDispatchInfo)

-- | Auxiliary data associated with an imported block result.
data ImportedAux = ImportedAux
    { ImportedAux -> Bool
auxHeaderOnly                 :: Bool
    -- ^ Only the header has been imported. Block body verification was skipped.
    , ImportedAux -> Bool
auxClearJustificationRequests :: Bool
    -- ^ Clear all pending justification requests.
    , ImportedAux -> Bool
auxNeedsJustification         :: Bool
    -- ^ Request a justification for the given block.
    , ImportedAux -> Bool
auxBadJustification           :: Bool
    -- ^ Received a bad justification.
    , ImportedAux -> Bool
auxNeedsFinalityProof         :: Bool
    -- ^ Request a finality proof for the given block.
    , ImportedAux -> Bool
auxIsNewBest                  :: Bool
    -- ^ Whether the block that was imported is the new best block.
    }
    deriving (ImportedAux -> ImportedAux -> Bool
(ImportedAux -> ImportedAux -> Bool)
-> (ImportedAux -> ImportedAux -> Bool) -> Eq ImportedAux
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ImportedAux -> ImportedAux -> Bool
== :: ImportedAux -> ImportedAux -> Bool
$c/= :: ImportedAux -> ImportedAux -> Bool
/= :: ImportedAux -> ImportedAux -> Bool
Eq, (forall x. ImportedAux -> Rep ImportedAux x)
-> (forall x. Rep ImportedAux x -> ImportedAux)
-> Generic ImportedAux
forall x. Rep ImportedAux x -> ImportedAux
forall x. ImportedAux -> Rep ImportedAux x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ImportedAux -> Rep ImportedAux x
from :: forall x. ImportedAux -> Rep ImportedAux x
$cto :: forall x. Rep ImportedAux x -> ImportedAux
to :: forall x. Rep ImportedAux x -> ImportedAux
Generic, Int -> ImportedAux -> ShowS
[ImportedAux] -> ShowS
ImportedAux -> String
(Int -> ImportedAux -> ShowS)
-> (ImportedAux -> String)
-> ([ImportedAux] -> ShowS)
-> Show ImportedAux
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImportedAux -> ShowS
showsPrec :: Int -> ImportedAux -> ShowS
$cshow :: ImportedAux -> String
show :: ImportedAux -> String
$cshowList :: [ImportedAux] -> ShowS
showList :: [ImportedAux] -> ShowS
Show)

$(deriveJSON (defaultOptions
    { fieldLabelModifier = over _head toLower . drop 3 }) ''ImportedAux)

data CreatedBlock = CreatedBlock
    { CreatedBlock -> HexString
createdBlockHash :: HexString
    , CreatedBlock -> ImportedAux
createdBlockAux  :: ImportedAux
    }
    deriving (CreatedBlock -> CreatedBlock -> Bool
(CreatedBlock -> CreatedBlock -> Bool)
-> (CreatedBlock -> CreatedBlock -> Bool) -> Eq CreatedBlock
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreatedBlock -> CreatedBlock -> Bool
== :: CreatedBlock -> CreatedBlock -> Bool
$c/= :: CreatedBlock -> CreatedBlock -> Bool
/= :: CreatedBlock -> CreatedBlock -> Bool
Eq, (forall x. CreatedBlock -> Rep CreatedBlock x)
-> (forall x. Rep CreatedBlock x -> CreatedBlock)
-> Generic CreatedBlock
forall x. Rep CreatedBlock x -> CreatedBlock
forall x. CreatedBlock -> Rep CreatedBlock x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreatedBlock -> Rep CreatedBlock x
from :: forall x. CreatedBlock -> Rep CreatedBlock x
$cto :: forall x. Rep CreatedBlock x -> CreatedBlock
to :: forall x. Rep CreatedBlock x -> CreatedBlock
Generic, Int -> CreatedBlock -> ShowS
[CreatedBlock] -> ShowS
CreatedBlock -> String
(Int -> CreatedBlock -> ShowS)
-> (CreatedBlock -> String)
-> ([CreatedBlock] -> ShowS)
-> Show CreatedBlock
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreatedBlock -> ShowS
showsPrec :: Int -> CreatedBlock -> ShowS
$cshow :: CreatedBlock -> String
show :: CreatedBlock -> String
$cshowList :: [CreatedBlock] -> ShowS
showList :: [CreatedBlock] -> ShowS
Show)

$(deriveJSON (defaultOptions
    { fieldLabelModifier = over _head toLower . drop 12 }) ''CreatedBlock)

-- | Generic header digest.
data Digest = Digest
    { Digest -> [HexString]
digestLogs :: ![HexString]
    -- ^ A list of logs in the digest.
    }
    deriving (Digest -> Digest -> Bool
(Digest -> Digest -> Bool)
-> (Digest -> Digest -> Bool) -> Eq Digest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Digest -> Digest -> Bool
== :: Digest -> Digest -> Bool
$c/= :: Digest -> Digest -> Bool
/= :: Digest -> Digest -> Bool
Eq, (forall x. Digest -> Rep Digest x)
-> (forall x. Rep Digest x -> Digest) -> Generic Digest
forall x. Rep Digest x -> Digest
forall x. Digest -> Rep Digest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Digest -> Rep Digest x
from :: forall x. Digest -> Rep Digest x
$cto :: forall x. Rep Digest x -> Digest
to :: forall x. Rep Digest x -> Digest
Generic, Int -> Digest -> ShowS
[Digest] -> ShowS
Digest -> String
(Int -> Digest -> ShowS)
-> (Digest -> String) -> ([Digest] -> ShowS) -> Show Digest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Digest -> ShowS
showsPrec :: Int -> Digest -> ShowS
$cshow :: Digest -> String
show :: Digest -> String
$cshowList :: [Digest] -> ShowS
showList :: [Digest] -> ShowS
Show)

-- | Hex-encoded block number.
newtype BlockNumber = BlockNumber { BlockNumber -> Integer
unBlockNumber :: Integer }
  deriving (BlockNumber -> BlockNumber -> Bool
(BlockNumber -> BlockNumber -> Bool)
-> (BlockNumber -> BlockNumber -> Bool) -> Eq BlockNumber
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockNumber -> BlockNumber -> Bool
== :: BlockNumber -> BlockNumber -> Bool
$c/= :: BlockNumber -> BlockNumber -> Bool
/= :: BlockNumber -> BlockNumber -> Bool
Eq, Eq BlockNumber
Eq BlockNumber =>
(BlockNumber -> BlockNumber -> Ordering)
-> (BlockNumber -> BlockNumber -> Bool)
-> (BlockNumber -> BlockNumber -> Bool)
-> (BlockNumber -> BlockNumber -> Bool)
-> (BlockNumber -> BlockNumber -> Bool)
-> (BlockNumber -> BlockNumber -> BlockNumber)
-> (BlockNumber -> BlockNumber -> BlockNumber)
-> Ord BlockNumber
BlockNumber -> BlockNumber -> Bool
BlockNumber -> BlockNumber -> Ordering
BlockNumber -> BlockNumber -> BlockNumber
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BlockNumber -> BlockNumber -> Ordering
compare :: BlockNumber -> BlockNumber -> Ordering
$c< :: BlockNumber -> BlockNumber -> Bool
< :: BlockNumber -> BlockNumber -> Bool
$c<= :: BlockNumber -> BlockNumber -> Bool
<= :: BlockNumber -> BlockNumber -> Bool
$c> :: BlockNumber -> BlockNumber -> Bool
> :: BlockNumber -> BlockNumber -> Bool
$c>= :: BlockNumber -> BlockNumber -> Bool
>= :: BlockNumber -> BlockNumber -> Bool
$cmax :: BlockNumber -> BlockNumber -> BlockNumber
max :: BlockNumber -> BlockNumber -> BlockNumber
$cmin :: BlockNumber -> BlockNumber -> BlockNumber
min :: BlockNumber -> BlockNumber -> BlockNumber
Ord, Int -> BlockNumber -> ShowS
[BlockNumber] -> ShowS
BlockNumber -> String
(Int -> BlockNumber -> ShowS)
-> (BlockNumber -> String)
-> ([BlockNumber] -> ShowS)
-> Show BlockNumber
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockNumber -> ShowS
showsPrec :: Int -> BlockNumber -> ShowS
$cshow :: BlockNumber -> String
show :: BlockNumber -> String
$cshowList :: [BlockNumber] -> ShowS
showList :: [BlockNumber] -> ShowS
Show)

instance FromJSON BlockNumber where
    parseJSON :: Value -> Parser BlockNumber
parseJSON = (String -> BlockNumber) -> Parser String -> Parser BlockNumber
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> BlockNumber
BlockNumber (Integer -> BlockNumber)
-> (String -> Integer) -> String -> BlockNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer, String) -> Integer
forall a b. (a, b) -> a
fst ((Integer, String) -> Integer)
-> (String -> (Integer, String)) -> String -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Integer, String)] -> (Integer, String)
forall a. HasCallStack => [a] -> a
head ([(Integer, String)] -> (Integer, String))
-> (String -> [(Integer, String)]) -> String -> (Integer, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(Integer, String)]
forall a. (Eq a, Num a) => ReadS a
readHex (String -> [(Integer, String)])
-> ShowS -> String -> [(Integer, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2) (Parser String -> Parser BlockNumber)
-> (Value -> Parser String) -> Value -> Parser BlockNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON

instance ToJSON BlockNumber where
    toJSON :: BlockNumber -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value)
-> (BlockNumber -> String) -> BlockNumber -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"0x" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> (BlockNumber -> String) -> BlockNumber -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> ShowS) -> String -> Integer -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> ShowS
forall a. Integral a => a -> ShowS
showHex String
"" (Integer -> String)
-> (BlockNumber -> Integer) -> BlockNumber -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockNumber -> Integer
unBlockNumber

$(deriveJSON (defaultOptions
    { fieldLabelModifier = over _head toLower . drop 6 }) ''Digest)

-- | Abstraction over a block header for a substrate chain.
data Header = Header
    { Header -> HexString
headerParentHash     :: HexString
    -- ^ The parent hash.
    , Header -> BlockNumber
headerNumber         :: BlockNumber
    -- ^ The block number.
    , Header -> HexString
headerStateRoot      :: HexString
    -- ^ The state trie merkle root
    , Header -> HexString
headerExtrinsicsRoot :: HexString
    -- ^ The merkle root of the extrinsics.
    , Header -> Digest
headerDigest         :: Digest
    -- ^ A chain-specific digest of data useful for light clients or referencing auxiliary data.
    }
    deriving (Header -> Header -> Bool
(Header -> Header -> Bool)
-> (Header -> Header -> Bool) -> Eq Header
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Header -> Header -> Bool
== :: Header -> Header -> Bool
$c/= :: Header -> Header -> Bool
/= :: Header -> Header -> Bool
Eq, (forall x. Header -> Rep Header x)
-> (forall x. Rep Header x -> Header) -> Generic Header
forall x. Rep Header x -> Header
forall x. Header -> Rep Header x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Header -> Rep Header x
from :: forall x. Header -> Rep Header x
$cto :: forall x. Rep Header x -> Header
to :: forall x. Rep Header x -> Header
Generic, Int -> Header -> ShowS
[Header] -> ShowS
Header -> String
(Int -> Header -> ShowS)
-> (Header -> String) -> ([Header] -> ShowS) -> Show Header
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Header -> ShowS
showsPrec :: Int -> Header -> ShowS
$cshow :: Header -> String
show :: Header -> String
$cshowList :: [Header] -> ShowS
showList :: [Header] -> ShowS
Show)

$(deriveJSON (defaultOptions
    { fieldLabelModifier = over _head toLower . drop 6 }) ''Header)

-- | Abstraction over a substrate block.
data Block = Block
    { Block -> Header
blockHeader     :: !Header
    -- ^ The block header.
    , Block -> [HexString]
blockExtrinsics :: ![HexString]
    -- ^ The accompanying extrinsics.
    }
    deriving (Block -> Block -> Bool
(Block -> Block -> Bool) -> (Block -> Block -> Bool) -> Eq Block
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Block -> Block -> Bool
== :: Block -> Block -> Bool
$c/= :: Block -> Block -> Bool
/= :: Block -> Block -> Bool
Eq, (forall x. Block -> Rep Block x)
-> (forall x. Rep Block x -> Block) -> Generic Block
forall x. Rep Block x -> Block
forall x. Block -> Rep Block x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Block -> Rep Block x
from :: forall x. Block -> Rep Block x
$cto :: forall x. Rep Block x -> Block
to :: forall x. Rep Block x -> Block
Generic, Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
(Int -> Block -> ShowS)
-> (Block -> String) -> ([Block] -> ShowS) -> Show Block
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Block -> ShowS
showsPrec :: Int -> Block -> ShowS
$cshow :: Block -> String
show :: Block -> String
$cshowList :: [Block] -> ShowS
showList :: [Block] -> ShowS
Show)

$(deriveJSON (defaultOptions
    { fieldLabelModifier = over _head toLower . drop 5 }) ''Block)

-- | Abstraction over a substrate block and justification.
data SignedBlock = SignedBlock
    { SignedBlock -> Block
signedBlock         :: !Block
    -- ^ Full block.
    , SignedBlock -> Maybe HexString
signedJustification :: !(Maybe HexString)
    -- ^ Block justification.
    }
    deriving (SignedBlock -> SignedBlock -> Bool
(SignedBlock -> SignedBlock -> Bool)
-> (SignedBlock -> SignedBlock -> Bool) -> Eq SignedBlock
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SignedBlock -> SignedBlock -> Bool
== :: SignedBlock -> SignedBlock -> Bool
$c/= :: SignedBlock -> SignedBlock -> Bool
/= :: SignedBlock -> SignedBlock -> Bool
Eq, (forall x. SignedBlock -> Rep SignedBlock x)
-> (forall x. Rep SignedBlock x -> SignedBlock)
-> Generic SignedBlock
forall x. Rep SignedBlock x -> SignedBlock
forall x. SignedBlock -> Rep SignedBlock x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SignedBlock -> Rep SignedBlock x
from :: forall x. SignedBlock -> Rep SignedBlock x
$cto :: forall x. Rep SignedBlock x -> SignedBlock
to :: forall x. Rep SignedBlock x -> SignedBlock
Generic, Int -> SignedBlock -> ShowS
[SignedBlock] -> ShowS
SignedBlock -> String
(Int -> SignedBlock -> ShowS)
-> (SignedBlock -> String)
-> ([SignedBlock] -> ShowS)
-> Show SignedBlock
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SignedBlock -> ShowS
showsPrec :: Int -> SignedBlock -> ShowS
$cshow :: SignedBlock -> String
show :: SignedBlock -> String
$cshowList :: [SignedBlock] -> ShowS
showList :: [SignedBlock] -> ShowS
Show)

$(deriveJSON (defaultOptions
    { fieldLabelModifier = over _head toLower . drop 6 }) ''SignedBlock)