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

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

module Network.Polkadot.Rpc.State where

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

import           Network.Polkadot.Rpc.Types (ReadProof, RuntimeVersion,
                                             StorageChangeSet)

-- | Perform a call to a builtin on the chain.
call :: JsonRpc m
     => Text
     -- ^ Call method
     -> HexString
     -- ^ Call data
     -> Maybe HexString
     -- ^ Block hash or nothing for head
     -> m HexString
{-# INLINE call #-}
call :: forall (m :: * -> *).
JsonRpc m =>
Text -> HexString -> Maybe HexString -> m HexString
call = Text -> Text -> HexString -> Maybe HexString -> m HexString
forall a. Remote m a => Text -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"state_call"

-- | Retrieves the keys with prefix of a specific child storage.
getChildKeys :: JsonRpc m
             => HexString
             -- ^ Child storage key
             -> HexString
             -- ^ Child definition
             -> Int
             -- ^ Child type
             -> HexString
             -- ^ Key
             -> Maybe HexString
             -- ^ Block hash or nothing for head
             -> m [HexString]
{-# INLINE getChildKeys #-}
getChildKeys :: forall (m :: * -> *).
JsonRpc m =>
HexString
-> HexString
-> Int
-> HexString
-> Maybe HexString
-> m [HexString]
getChildKeys = Text
-> HexString
-> HexString
-> Int
-> HexString
-> Maybe HexString
-> m [HexString]
forall a. Remote m a => Text -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"state_getChildKeys"

-- | Retrieves the child storage for a key.
getChildStorage :: JsonRpc m
                => HexString
                -- ^ Child storage key
                -> HexString
                -- ^ Child definition
                -> Int
                -- ^ Child type
                -> HexString
                -- ^ Key
                -> Maybe HexString
                -- ^ Block hash or nothing for head
                -> m HexString
{-# INLINE getChildStorage #-}
getChildStorage :: forall (m :: * -> *).
JsonRpc m =>
HexString
-> HexString -> Int -> HexString -> Maybe HexString -> m HexString
getChildStorage = Text
-> HexString
-> HexString
-> Int
-> HexString
-> Maybe HexString
-> m HexString
forall a. Remote m a => Text -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"state_getChildStorage"

-- | Retrieves the child storage hash.
getChildStorageHash :: JsonRpc m
                    => HexString
                    -- ^ Child storage key
                    -> HexString
                    -- ^ Child definition
                    -> Int
                    -- ^ Child type
                    -> HexString
                    -- ^ Key
                    -> Maybe HexString
                    -- ^ Block hash or nothing for head
                    -> m HexString
{-# INLINE getChildStorageHash #-}
getChildStorageHash :: forall (m :: * -> *).
JsonRpc m =>
HexString
-> HexString -> Int -> HexString -> Maybe HexString -> m HexString
getChildStorageHash = Text
-> HexString
-> HexString
-> Int
-> HexString
-> Maybe HexString
-> m HexString
forall a. Remote m a => Text -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"state_getChildStorageHash"

-- | Retrieves the child storage size.
getChildStorageSize :: JsonRpc m
                    => HexString
                    -- ^ Child storage key
                    -> HexString
                    -- ^ Child definition
                    -> Int
                    -- ^ Child type
                    -> HexString
                    -- ^ Key
                    -> Maybe HexString
                    -- ^ Block hash or nothing for head
                    -> m Int
{-# INLINE getChildStorageSize #-}
getChildStorageSize :: forall (m :: * -> *).
JsonRpc m =>
HexString
-> HexString -> Int -> HexString -> Maybe HexString -> m Int
getChildStorageSize = Text
-> HexString
-> HexString
-> Int
-> HexString
-> Maybe HexString
-> m Int
forall a. Remote m a => Text -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"state_getChildStorageSize"

-- | Retrieves the keys with a certain prefix.
getKeys :: JsonRpc m
        => HexString
        -- ^ Key
        -> Maybe HexString
        -- ^ Block hash or nothing for head
        -> m [HexString]
{-# INLINE getKeys #-}
getKeys :: forall (m :: * -> *).
JsonRpc m =>
HexString -> Maybe HexString -> m [HexString]
getKeys = Text -> HexString -> Maybe HexString -> m [HexString]
forall a. Remote m a => Text -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"state_getKeys"

-- | Returns the runtime metadata.
getMetadata :: JsonRpc m => m HexString
{-# INLINE getMetadata #-}
getMetadata :: forall (m :: * -> *). JsonRpc m => m HexString
getMetadata = Text -> m HexString
forall a. Remote m a => Text -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"state_getMetadata"

-- | Returns proof of storage entries at a specific block state.
getReadProof :: JsonRpc m
             => [HexString]
             -- ^ Keys
             -> Maybe HexString
             -- ^ Block hash or nothing for head
             -> m ReadProof
{-# INLINE getReadProof #-}
getReadProof :: forall (m :: * -> *).
JsonRpc m =>
[HexString] -> Maybe HexString -> m ReadProof
getReadProof = Text -> [HexString] -> Maybe HexString -> m ReadProof
forall a. Remote m a => Text -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"state_getReadProof"

-- | Get runtime version.
getRuntimeVersion :: JsonRpc m
                  => Maybe HexString
                  -- ^ Block hash or nothing for head
                  -> m RuntimeVersion
{-# INLINE getRuntimeVersion #-}
getRuntimeVersion :: forall (m :: * -> *).
JsonRpc m =>
Maybe HexString -> m RuntimeVersion
getRuntimeVersion = Text -> Maybe HexString -> m RuntimeVersion
forall a. Remote m a => Text -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"state_getRuntimeVersion"

-- | Retrieves the storage for a key.
getStorage :: JsonRpc m
           => HexString
           -- ^ Key
           -> Maybe HexString
           -- ^ Block hash or nothing for head
           -> m HexString
{-# INLINE getStorage #-}
getStorage :: forall (m :: * -> *).
JsonRpc m =>
HexString -> Maybe HexString -> m HexString
getStorage = Text -> HexString -> Maybe HexString -> m HexString
forall a. Remote m a => Text -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"state_getStorage"

-- | Retrieves the storage hash.
getStorageHash :: JsonRpc m
               => HexString
               -- ^ Key
               -> Maybe HexString
               -- ^ Block hash or nothing for head
               -> m HexString
{-# INLINE getStorageHash #-}
getStorageHash :: forall (m :: * -> *).
JsonRpc m =>
HexString -> Maybe HexString -> m HexString
getStorageHash = Text -> HexString -> Maybe HexString -> m HexString
forall a. Remote m a => Text -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"state_getStorageHash"

-- | Retrieves the storage size.
getStorageSize :: JsonRpc m
               => HexString
               -- ^ Key
               -> Maybe HexString
               -- ^ Block hash or nothing for head
               -> m Int
{-# INLINE getStorageSize #-}
getStorageSize :: forall (m :: * -> *).
JsonRpc m =>
HexString -> Maybe HexString -> m Int
getStorageSize = Text -> HexString -> Maybe HexString -> m Int
forall a. Remote m a => Text -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"state_getStorageSize"

-- | Query historical storage entries (by key) starting from a start block.
queryStorage :: JsonRpc m
             => [HexString]
             -- ^ Storage keys
             -> HexString
             -- ^ From block hash
             -> Maybe HexString
             -- ^ To block hash
             -> m [StorageChangeSet]
{-# INLINE queryStorage #-}
queryStorage :: forall (m :: * -> *).
JsonRpc m =>
[HexString] -> HexString -> Maybe HexString -> m [StorageChangeSet]
queryStorage = Text
-> [HexString]
-> HexString
-> Maybe HexString
-> m [StorageChangeSet]
forall a. Remote m a => Text -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"state_queryStorage"

-- | Query storage entries (by key) starting at block hash given as the second parameter.
queryStorageAt :: JsonRpc m
               => [HexString]
               -- ^ Storage keys
               -> Maybe HexString
               -- ^ Block hash or nothing for head
               -> m [StorageChangeSet]
{-# INLINE queryStorageAt #-}
queryStorageAt :: forall (m :: * -> *).
JsonRpc m =>
[HexString] -> Maybe HexString -> m [StorageChangeSet]
queryStorageAt = Text -> [HexString] -> Maybe HexString -> m [StorageChangeSet]
forall a. Remote m a => Text -> a
forall (m :: * -> *) a. (JsonRpc m, Remote m a) => Text -> a
remote Text
"state_queryStorageAt"