{-# LANGUAGE RecordWildCards #-}

-- |
-- Module      :  Network.Polkadot.Storage
-- Copyright   :  Aleksandr Krupenkin 2016-2024
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  portable
--
-- Substrate uses a simple key-value data store implemented as a database-backed,
-- modified Merkle tree.
--
-- Blockchains that are built with Substrate expose a remote procedure call (RPC)
-- server that can be used to query runtime storage.
--

module Network.Polkadot.Storage where

import           Cases                         (camelize)
import           Control.Arrow                 ((&&&))
import           Data.ByteArray                (convert)
import           Data.ByteArray.HexString      (HexString)
import           Data.Char                     (toLower)
import           Data.Map.Strict               (Map)
import qualified Data.Map.Strict               as Map (fromList, lookup)
import           Data.Maybe                    (mapMaybe)
import           Data.Text                     (Text)
import qualified Data.Text                     as T (cons, head, tail)

import           Network.Polkadot.Metadata.V13 (Metadata (modules),
                                                ModuleMetadata (..),
                                                StorageEntryMetadata (..),
                                                StorageMetadata (..))
import           Network.Polkadot.Storage.Key  (Argument, StorageEntry (..),
                                                newEntry)

-- | Runtime storage is a set of named modules.
type Storage = Map Text ModuleStorage

-- | Each module store data in a set of named entries.
type ModuleStorage = Map Text StorageEntry

-- | Create 'Storage' abstraction from runtime metadata.
fromMetadata :: Metadata
             -- ^ Runtime metadata (latest version).
             -> Storage
             -- ^ Storage entities.
fromMetadata :: Metadata -> Storage
fromMetadata = [(Text, ModuleStorage)] -> Storage
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, ModuleStorage)] -> Storage)
-> (Metadata -> [(Text, ModuleStorage)]) -> Metadata -> Storage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleMetadata -> Maybe (Text, ModuleStorage))
-> [ModuleMetadata] -> [(Text, ModuleStorage)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ModuleMetadata -> Maybe (Text, ModuleStorage)
go ([ModuleMetadata] -> [(Text, ModuleStorage)])
-> (Metadata -> [ModuleMetadata])
-> Metadata
-> [(Text, ModuleStorage)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> [ModuleMetadata]
modules
  where
    toLowerFirst :: Text -> Text
toLowerFirst = (Char -> Text -> Text) -> (Char, Text) -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Char -> Text -> Text
T.cons ((Char, Text) -> Text) -> (Text -> (Char, Text)) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char
toLower (Char -> Char) -> (Text -> Char) -> Text -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Char
Text -> Char
T.head (Text -> Char) -> (Text -> Text) -> Text -> (Char, Text)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& HasCallStack => Text -> Text
Text -> Text
T.tail)
    go :: ModuleMetadata -> Maybe (Text, ModuleStorage)
go ModuleMetadata{[ModuleConstantMetadata]
[ErrorMetadata]
Maybe [FunctionMetadata]
Maybe [EventMetadata]
Maybe StorageMetadata
Word8
Text
moduleName :: Text
moduleStorage :: Maybe StorageMetadata
moduleCalls :: Maybe [FunctionMetadata]
moduleEvents :: Maybe [EventMetadata]
moduleConstants :: [ModuleConstantMetadata]
moduleErrors :: [ErrorMetadata]
moduleIndex :: Word8
moduleName :: ModuleMetadata -> Text
moduleStorage :: ModuleMetadata -> Maybe StorageMetadata
moduleCalls :: ModuleMetadata -> Maybe [FunctionMetadata]
moduleEvents :: ModuleMetadata -> Maybe [EventMetadata]
moduleConstants :: ModuleMetadata -> [ModuleConstantMetadata]
moduleErrors :: ModuleMetadata -> [ErrorMetadata]
moduleIndex :: ModuleMetadata -> Word8
..} = do
        StorageMetadata Text
prefix [StorageEntryMetadata]
items <- Maybe StorageMetadata
moduleStorage
        let section :: Text
section = Text -> Text
camelize Text
moduleName
            toEntry :: StorageEntryMetadata -> (Text, StorageEntry)
toEntry meta :: StorageEntryMetadata
meta@StorageEntryMetadata{[Text]
Text
HexString
StorageEntryModifier
StorageEntryType
entryName :: Text
entryModifier :: StorageEntryModifier
entryType :: StorageEntryType
entryFallback :: HexString
entryDocumentation :: [Text]
entryName :: StorageEntryMetadata -> Text
entryModifier :: StorageEntryMetadata -> StorageEntryModifier
entryType :: StorageEntryMetadata -> StorageEntryType
entryFallback :: StorageEntryMetadata -> HexString
entryDocumentation :: StorageEntryMetadata -> [Text]
..} =
                (Text -> Text
toLowerFirst Text
entryName, Text -> StorageEntryMetadata -> StorageEntry
newEntry Text
prefix StorageEntryMetadata
meta)
        (Text, ModuleStorage) -> Maybe (Text, ModuleStorage)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Text
toLowerFirst Text
section, [(Text, StorageEntry)] -> ModuleStorage
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, StorageEntry)] -> ModuleStorage)
-> [(Text, StorageEntry)] -> ModuleStorage
forall a b. (a -> b) -> a -> b
$ (StorageEntryMetadata -> (Text, StorageEntry))
-> [StorageEntryMetadata] -> [(Text, StorageEntry)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StorageEntryMetadata -> (Text, StorageEntry)
toEntry [StorageEntryMetadata]
items)

-- | Create storage key for given parameters.
storageKey :: Storage
           -- ^ Storage entities.
           -> Text
           -- ^ Module name.
           -> Text
           -- ^ Storage method name.
           -> [Argument]
           -- ^ Arguments (for mappings).
           -> Maybe HexString
           -- ^ Raw storage key. If module or method was not found
           -- or wrong number of arguments - returns 'Nothing'.
storageKey :: Storage -> Text -> Text -> [Argument] -> Maybe HexString
storageKey Storage
store Text
section Text
method [Argument]
args = ByteString -> HexString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (ByteString -> HexString) -> Maybe ByteString -> Maybe HexString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    StorageEntry
entry <- Text -> ModuleStorage -> Maybe StorageEntry
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
method (ModuleStorage -> Maybe StorageEntry)
-> Maybe ModuleStorage -> Maybe StorageEntry
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Storage -> Maybe ModuleStorage
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
section Storage
store
    case StorageEntry
entry of
      PlainEntry ByteString
x     -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
x
      MapEntry Argument -> ByteString
f       -> case [Argument]
args of
                            [Argument
a] -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Argument -> ByteString
f Argument
a)
                            [Argument]
_   -> Maybe ByteString
forall a. Maybe a
Nothing
      DoubleMapEntry Argument -> Argument -> ByteString
f -> case [Argument]
args of
                            [Argument
a, Argument
b] -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Argument -> Argument -> ByteString
f Argument
a Argument
b)
                            [Argument]
_      -> Maybe ByteString
forall a. Maybe a
Nothing