{-# LANGUAGE GADTs           #-}
{-# LANGUAGE RecordWildCards #-}

-- |
-- Module      :  Network.Polkadot.Storage.Key
-- Copyright   :  Aleksandr Krupenkin 2016-2024
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  portable
--
-- When you use the Substrate RPC to access a storage item,
-- you only need to provide the key associated with that item.
--

module Network.Polkadot.Storage.Key where

import           Codec.Scale                   (encode)
import           Codec.Scale.Class             (Encode (..))
import           Control.Arrow                 ((&&&))
import           Data.ByteString               (ByteString)
import           Data.Digest.Blake2            (blake2_128, blake2_256)
import           Data.Digest.XXHash            (xxhash)
import           Data.Text                     (Text)
import           Data.Text.Encoding            (encodeUtf8)

import           Network.Polkadot.Metadata.V11 (DoubleMapType (..),
                                                MapType (..),
                                                StorageHasher (..))
import           Network.Polkadot.Metadata.V13 (NMapType (..),
                                                StorageEntryMetadata (..),
                                                StorageEntryType (..))

-- | General type wrapper for SCALE encodable storage index argument.
data Argument where
    Argument :: Encode a => a -> Argument
        -- ^ Wrapped type should be encodable.

instance Encode Argument where
    put :: Putter Argument
put Argument
arg = case Argument
arg of Argument a
a -> Putter a
forall a. Encode a => Putter a
put a
a

-- | Hasher is a function that hash given argument.
type Hasher = Argument -> ByteString

-- | Entry type describe storage prefix for different storage entity types.
data StorageEntry
    = PlainEntry ByteString
    -- ^ Simple storage type without arguments.
    | MapEntry (Argument -> ByteString)
    -- ^ Mapping with hashing for arguments.
    | DoubleMapEntry (Argument -> Argument -> ByteString)
    -- ^ Double map with two different hashers.
    | NMapEntry ([Argument] -> ByteString)
    -- ^ Map with array of hashers.

instance Show StorageEntry where
    show :: StorageEntry -> String
show (PlainEntry ByteString
_)     = String
"PlainEntry"
    show (MapEntry Argument -> ByteString
_)       = String
"MapEntry"
    show (DoubleMapEntry Argument -> Argument -> ByteString
_) = String
"DoubleMapEntry"
    show (NMapEntry [Argument] -> ByteString
_)      = String
"NMapEntry"

-- | Create storage key generator from metadata description.
newEntry :: Text
         -- ^ Storage prefix (module name).
         -> StorageEntryMetadata
         -- ^ Storage key metadata, includes entry type, name, etc.
         -> StorageEntry
         -- ^ Storage key generator.
newEntry :: Text -> StorageEntryMetadata -> StorageEntry
newEntry Text
prefix StorageEntryMetadata
meta = case StorageEntryMetadata -> StorageEntryType
entryType StorageEntryMetadata
meta of
    Plain Type
_ -> ByteString -> StorageEntry
PlainEntry ByteString
plainKey
    Map MapType{Bool
Type
StorageHasher
mapHasher :: StorageHasher
mapKey :: Type
mapValue :: Type
mapLinked :: Bool
mapHasher :: MapType -> StorageHasher
mapKey :: MapType -> Type
mapValue :: MapType -> Type
mapLinked :: MapType -> Bool
..} -> (Argument -> ByteString) -> StorageEntry
MapEntry (StorageHasher -> Argument -> ByteString
mapCodec StorageHasher
mapHasher)
    DoubleMap DoubleMapType{Type
StorageHasher
doubleMapHasher :: StorageHasher
doubleMapKey1 :: Type
doubleMapKey2 :: Type
doubleMapValue :: Type
doubleMapKey2Hasher :: StorageHasher
doubleMapHasher :: DoubleMapType -> StorageHasher
doubleMapKey1 :: DoubleMapType -> Type
doubleMapKey2 :: DoubleMapType -> Type
doubleMapValue :: DoubleMapType -> Type
doubleMapKey2Hasher :: DoubleMapType -> StorageHasher
..} -> (Argument -> Argument -> ByteString) -> StorageEntry
DoubleMapEntry (StorageHasher
-> StorageHasher -> Argument -> Argument -> ByteString
dMapCodec StorageHasher
doubleMapHasher StorageHasher
doubleMapKey2Hasher)
    NMap NMapType{[Type]
[StorageHasher]
Type
nmapKeyVec :: [Type]
nmapHashers :: [StorageHasher]
nmapValue :: Type
nmapKeyVec :: NMapType -> [Type]
nmapHashers :: NMapType -> [StorageHasher]
nmapValue :: NMapType -> Type
..} -> ([Argument] -> ByteString) -> StorageEntry
NMapEntry [Argument] -> ByteString
forall a. HasCallStack => a
undefined  -- TODO
  where
    method :: Text
method = StorageEntryMetadata -> Text
entryName StorageEntryMetadata
meta
    -- To calculate the key for a simple Storage Value,
    -- take the TwoX 128 hash of the name of the module that contains the Storage Value
    -- and append to it the TwoX 128 hash of the name of the Storage Value itself.
    plainKey :: ByteString
plainKey = Integer -> ByteString -> ByteString
forall bitLength.
Integral bitLength =>
bitLength -> ByteString -> ByteString
xxhash Integer
128 (Text -> ByteString
encodeUtf8 Text
prefix) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Integer -> ByteString -> ByteString
forall bitLength.
Integral bitLength =>
bitLength -> ByteString -> ByteString
xxhash Integer
128 (Text -> ByteString
encodeUtf8 Text
method)
    -- Like Storage Values, the keys for Storage Maps are equal to the TwoX 128 hash
    -- of the name of the module that contains the map prepended to the TwoX 128 hash
    -- of the name of the Storage Map itself.
    mapCodec :: StorageHasher -> Argument -> ByteString
mapCodec StorageHasher
h1 Argument
arg1 = ByteString
plainKey ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> StorageHasher -> Argument -> ByteString
getHasher StorageHasher
h1 Argument
arg1
    dMapCodec :: StorageHasher
-> StorageHasher -> Argument -> Argument -> ByteString
dMapCodec StorageHasher
h1 StorageHasher
h2 Argument
arg1 Argument
arg2 = StorageHasher -> Argument -> ByteString
mapCodec StorageHasher
h1 Argument
arg1 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> StorageHasher -> Argument -> ByteString
getHasher StorageHasher
h2 Argument
arg2

getHasher :: StorageHasher -> Hasher
getHasher :: StorageHasher -> Argument -> ByteString
getHasher StorageHasher
Blake2_128       = ByteString -> ByteString
blake2_128 (ByteString -> ByteString)
-> (Argument -> ByteString) -> Argument -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Argument -> ByteString
forall a ba. (Encode a, ByteArray ba) => a -> ba
encode
getHasher StorageHasher
Blake2_256       = ByteString -> ByteString
blake2_256 (ByteString -> ByteString)
-> (Argument -> ByteString) -> Argument -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Argument -> ByteString
forall a ba. (Encode a, ByteArray ba) => a -> ba
encode
getHasher StorageHasher
Blake2_128Concat = (ByteString -> ByteString -> ByteString)
-> (ByteString, ByteString) -> ByteString
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
(<>) ((ByteString, ByteString) -> ByteString)
-> (Argument -> (ByteString, ByteString)) -> Argument -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString
blake2_128 (ByteString -> ByteString)
-> (ByteString -> ByteString)
-> ByteString
-> (ByteString, ByteString)
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')
&&& ByteString -> ByteString
forall a. a -> a
id) (ByteString -> (ByteString, ByteString))
-> (Argument -> ByteString) -> Argument -> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Argument -> ByteString
forall a ba. (Encode a, ByteArray ba) => a -> ba
encode
getHasher StorageHasher
Twox128          = Integer -> ByteString -> ByteString
forall bitLength.
Integral bitLength =>
bitLength -> ByteString -> ByteString
xxhash Integer
128 (ByteString -> ByteString)
-> (Argument -> ByteString) -> Argument -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Argument -> ByteString
forall a ba. (Encode a, ByteArray ba) => a -> ba
encode
getHasher StorageHasher
Twox256          = Integer -> ByteString -> ByteString
forall bitLength.
Integral bitLength =>
bitLength -> ByteString -> ByteString
xxhash Integer
256 (ByteString -> ByteString)
-> (Argument -> ByteString) -> Argument -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Argument -> ByteString
forall a ba. (Encode a, ByteArray ba) => a -> ba
encode
getHasher StorageHasher
Twox64Concat     = (ByteString -> ByteString -> ByteString)
-> (ByteString, ByteString) -> ByteString
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
(<>) ((ByteString, ByteString) -> ByteString)
-> (Argument -> (ByteString, ByteString)) -> Argument -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> ByteString -> ByteString
forall bitLength.
Integral bitLength =>
bitLength -> ByteString -> ByteString
xxhash Integer
64 (ByteString -> ByteString)
-> (ByteString -> ByteString)
-> ByteString
-> (ByteString, ByteString)
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')
&&& ByteString -> ByteString
forall a. a -> a
id) (ByteString -> (ByteString, ByteString))
-> (Argument -> ByteString) -> Argument -> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Argument -> ByteString
forall a ba. (Encode a, ByteArray ba) => a -> ba
encode
getHasher StorageHasher
Identity         = Argument -> ByteString
forall a ba. (Encode a, ByteArray ba) => a -> ba
encode