{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      :  Network.Polkadot.Rpc.Childstate
-- Copyright   :  Aleksandr Krupenkin 2016-2024
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  portable
--
-- Polkadot RPC methods with `childstate` prefix.
--

module Network.Polkadot.Rpc.Childstate where

import           Data.ByteArray.HexString   (HexString)
import           Network.JsonRpc.TinyClient (JsonRpc (..))

-- | Returns the keys with prefix from a child storage, leave empty to get all the keys.
getKeys :: JsonRpc m
        => HexString
        -- ^ Prefixed storage key
        -> HexString
        -- ^ Storage key
        -> Maybe HexString
        -- ^ Block hash
        -> m [HexString]
{-# INLINE getKeys #-}
getKeys :: forall (m :: * -> *).
JsonRpc m =>
HexString -> HexString -> Maybe HexString -> m [HexString]
getKeys = MethodName
-> HexString -> HexString -> Maybe HexString -> m [HexString]
forall a. Remote m a => MethodName -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => MethodName -> a
remote MethodName
"childstate_getKeys"

-- | Returns a child storage entry at a specific block state.
getStorage :: JsonRpc m
           => HexString
           -- ^ Prefixed storage key
           -> HexString
           -- ^ Storage key
           -> Maybe HexString
           -- ^ Block hash
           -> m (Maybe HexString)
{-# INLINE getStorage #-}
getStorage :: forall (m :: * -> *).
JsonRpc m =>
HexString -> HexString -> Maybe HexString -> m (Maybe HexString)
getStorage = MethodName
-> HexString -> HexString -> Maybe HexString -> m (Maybe HexString)
forall a. Remote m a => MethodName -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => MethodName -> a
remote MethodName
"childstate_getStorage"

-- | Returns the hash of a child storage entry at a block state
getStorageHash :: JsonRpc m
               => HexString
               -- ^ Prefixed storage key
               -> HexString
               -- ^ Storage key
               -> Maybe HexString
               -- ^ Block hash
               -> m (Maybe HexString)
{-# INLINE getStorageHash #-}
getStorageHash :: forall (m :: * -> *).
JsonRpc m =>
HexString -> HexString -> Maybe HexString -> m (Maybe HexString)
getStorageHash = MethodName
-> HexString -> HexString -> Maybe HexString -> m (Maybe HexString)
forall a. Remote m a => MethodName -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => MethodName -> a
remote MethodName
"childstate_getStorageHash"

-- | Returns the size of a child storage entry at a block state.
getStorageSize :: JsonRpc m
               => HexString
               -- ^ Prefixed storage key
               -> HexString
               -- ^ Storage key
               -> Maybe HexString
               -- ^ Block hash
               -> m (Maybe Int)
{-# INLINE getStorageSize #-}
getStorageSize :: forall (m :: * -> *).
JsonRpc m =>
HexString -> HexString -> Maybe HexString -> m (Maybe Int)
getStorageSize = MethodName
-> HexString -> HexString -> Maybe HexString -> m (Maybe Int)
forall a. Remote m a => MethodName -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => MethodName -> a
remote MethodName
"childstate_getStorageSize"