diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,211 @@ + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + +TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + +1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + +2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + +3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + +4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + +5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + +6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + +7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + +8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + +9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + +END OF TERMS AND CONDITIONS + +APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + +Copyright 2016-2021 Aleksandr Krupenkin + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. + + NOTE + +Individual files contain the following tag instead of the full license +text. + + SPDX-License-Identifier: Apache-2.0 + +This enables machine processing of license information based on the SPDX +License Identifiers that are here available: http://spdx.org/licenses/ diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Network/Polkadot.hs b/src/Network/Polkadot.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot.hs @@ -0,0 +1,37 @@ +-- | +-- Module : Network.Polkadot +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unportable +-- +-- A scalable, interoperable & secure network protocol for the next web. +-- + +module Network.Polkadot + ( + -- * Query blockchain storage. + query + , Argument(..) + -- * Base types and codecs. + , module Scale + , module Primitives + , module Crypto + -- * Extrinsic sign & send functions. + , module Account + , module Extrinsic + , module Call + ) where + +import Codec.Scale as Scale +import Network.Polkadot.Account as Account hiding (AccountId) +import Network.Polkadot.Call as Call +import Network.Polkadot.Crypto as Crypto hiding (MultiAddress, + MultiSignature, + MultiSigner) +import Network.Polkadot.Extrinsic as Extrinsic +import Network.Polkadot.Primitives as Primitives +import Network.Polkadot.Query (query) +import Network.Polkadot.Storage.Key (Argument (..)) diff --git a/src/Network/Polkadot/Account.hs b/src/Network/Polkadot/Account.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Account.hs @@ -0,0 +1,112 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} + +-- | +-- Module : Network.Polkadot.Account +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Polkadot account types. +-- + +module Network.Polkadot.Account (Ss58Codec(..), IdentifyAccount(..)) where + +import Codec.Scale (decode, encode) +import Control.Monad ((<=<)) +import Data.BigNum (h256) +import Data.Bits (bit, shiftL, shiftR, (.&.), (.|.)) +import Data.ByteArray (cons, convert) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS (drop, length, pack, take) +import Data.ByteString.Base58 (bitcoinAlphabet, decodeBase58, + encodeBase58) +import Data.Digest.Blake2 (blake2_256, blake2_512) +import Data.Maybe (fromJust) +import Data.Word (Word16) + +import Network.Polkadot.Primitives (MultiSigner (..)) +import qualified Network.Polkadot.Primitives as P (AccountId) + +-- | Some type that is able to be collapsed into an account ID. +-- +-- It is not possible to recreate the original value from the account ID. +class IdentifyAccount a where + -- | The account ID that this can be transformed into. + type AccountId a + + -- | Transform into an account. + into_account :: a -> AccountId a + +instance IdentifyAccount MultiSigner where + type AccountId MultiSigner = P.AccountId + into_account (Ed25519Signer pub) = fromJust (h256 pub) + into_account (EcdsaSigner px pub) = fromJust (h256 $ blake2_256 $ cons px $ convert pub) + into_account Sr25519Signer = error "Sr25519 has no support yet" + +instance Show MultiSigner where + show = show . to_ss58check . into_account + +-- | Key that can be encoded to/from SS58. +-- +-- See +-- for information on the codec. +class Ss58Codec a where + -- | Some if the string is a properly encoded SS58Check address (default prefix). + from_ss58check :: ByteString -> Either String a + from_ss58check = from_ss58check_with_version 42 + + -- | Return the ss58-check string for this key (default prefix). + to_ss58check :: a -> ByteString + to_ss58check = to_ss58check_with_version 42 + + -- | Return the ss58-check string for this key. + to_ss58check_with_version :: Word16 -> a -> ByteString + + -- | Some if the string is a properly encoded SS58Check address (default prefix). + from_ss58check_with_version :: Word16 -> ByteString -> Either String a + +instance Ss58Codec P.AccountId where + from_ss58check_with_version v = decode <=< from_ss58check_with_version' v <=< from_base58 + to_ss58check_with_version v = to_base58 . to_ss58check_with_version' v . encode + +to_base58 :: ByteString -> ByteString +to_base58 = encodeBase58 bitcoinAlphabet + +from_base58 :: ByteString -> Either String ByteString +from_base58 = maybe (Left "Bad encoding") Right . decodeBase58 bitcoinAlphabet + +to_ss58check_with_version' :: Word16 -> ByteString -> ByteString +to_ss58check_with_version' v input = out <> ss58hash out + where + out = encode_version v <> input + +from_ss58check_with_version' :: Word16 -> ByteString -> Either String ByteString +from_ss58check_with_version' v input = versionGuard >> ss58hashGuard + where + checksumLen = 2 + versionLen | v < 64 = 1 + | otherwise = 2 + inputLen = BS.length input - checksumLen - versionLen + input' = BS.take inputLen (BS.drop versionLen input) + versionGuard + | encode_version v == BS.take versionLen input = return () + | otherwise = Left "Bad version" + ss58hashGuard + | ss58hash (BS.take (versionLen + inputLen) input) + == BS.drop (versionLen + inputLen) input = return input' + | otherwise = Left "Bad checksum" + +ss58hash :: ByteString -> ByteString +ss58hash = BS.take 2 . blake2_512 . ("SS58PRE" <>) + +encode_version :: Word16 -> ByteString +encode_version v + | v < 64 = BS.pack [fromIntegral v] + | otherwise = let first = bit 6 .|. ((v `shiftR` 2) .&. 63) + second = (v `shiftR` 8) .|. ((v .&. 3) `shiftL` 6) + in BS.pack (fromIntegral <$> [first, second]) diff --git a/src/Network/Polkadot/Call.hs b/src/Network/Polkadot/Call.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Call.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} + +-- | +-- Module : Network.Polkadot.Call +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unportable +-- +-- + +module Network.Polkadot.Call where + +import Codec.Scale (Decode, Encode, Generic, decode) +import Control.Monad.Fail (MonadFail) +import Data.List (findIndex) +import Data.Text (Text) +import Data.Word (Word8) +import qualified GHC.Generics as GHC (Generic) +import Network.JsonRpc.TinyClient (JsonRpc) + +import Network.Polkadot.Metadata (MetadataVersioned (V13), + metadata) +import Network.Polkadot.Metadata.V13 (moduleCalls, moduleName, + modules) +import Network.Polkadot.Metadata.V9 (functionName) +import Network.Polkadot.Rpc.State (getMetadata) + +-- | Call function of module using standard substrate extrionsic. +data Call a = Call !Word8 !Word8 !a + deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +-- | Create 'Call' type from text-encoded module and function. +new_call :: (Encode a, Decode a, JsonRpc m, MonadFail m) + => Text + -- ^ Module name. + -> Text + -- ^ Function name. + -> a + -- ^ Tuple of arguments. + -> m (Call a) +new_call modName funName args = do + Right (V13 meta) <- (fmap metadata . decode) <$> getMetadata + case findIndex ((modName ==) . moduleName) (modules meta) of + Nothing -> fail $ "module " <> show modName <> " not found" + Just modIx -> + case findIndex ((funName ==) . functionName) =<< moduleCalls (modules meta !! modIx) of + Nothing -> fail $ "function " <> show funName <> " not found" + Just funIx -> return $ Call (fromIntegral modIx) (fromIntegral funIx) args diff --git a/src/Network/Polkadot/Crypto.hs b/src/Network/Polkadot/Crypto.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Crypto.hs @@ -0,0 +1,162 @@ +{-# LANGUAGE TypeFamilies #-} + +-- | +-- Module : Network.Polkadot.Crypto +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Polkadot signing types and methods. +-- + +module Network.Polkadot.Crypto + ( Pair(..) + , Verify(..) + , MultiPair(..) + , Ed25519 + , Ecdsa + ) where + +import qualified Crypto.Ecdsa.Signature as Ecdsa (pack, sign) +import Crypto.Ecdsa.Utils as Ecdsa (derivePubKey, + exportPubKeyCompress, + importKey) +import Crypto.Error (CryptoFailable (..)) +import qualified Crypto.PubKey.ECC.ECDSA as Ecdsa (PrivateKey (..), + PublicKey (..)) +import qualified Crypto.PubKey.ECC.Generate as Ecdsa (generate) +import Crypto.PubKey.ECC.Types (CurveName (SEC_p256k1), + getCurveByName) +import qualified Crypto.PubKey.Ed25519 as Ed25519 (PublicKey, SecretKey, + generateSecretKey, + secretKey, sign, + toPublic) +import Data.BigNum (H256, H512, h256, h512) +import Data.ByteArray (ByteArrayAccess, uncons) +import qualified Data.ByteArray as BA (length) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS (last, take) +import Data.Maybe (fromJust) +import Data.Text (Text) +import Data.Word (Word8) + +import Network.Polkadot.Account (IdentifyAccount (..)) +import qualified Network.Polkadot.Primitives as P (MultiAddress (..), + MultiSignature (..), + MultiSigner (..)) + +-- | Class suitable for typical cryptographic PKI key pair type. +class Pair a where + -- | The type which is used to encode a public key. + type PublicKey a + -- | The type used to represent a signature. Can be created from a key pair and a message + -- and verified with the message and a public key. + type Signature a + -- | Generate new secure (random) key pair. + generate :: IO a + -- | Generate new key pair from the provided `seed`. + from_seed :: ByteArrayAccess ba => ba -> Either String a + -- | Generate key pair from given recovery phrase and password. + from_phrase :: Text -> Maybe Text -> Either String a + -- | Get a public key. + public :: a -> PublicKey a + -- | Sign a message. + sign :: ByteArrayAccess ba => a -> ba -> Signature a + +-- | Means of signature verification. +class Verify a where + -- | Verify a message. + verify :: (IdentifyAccount s, ByteArrayAccess ba) + => a + -- ^ Message signature. + -> ba + -- ^ Message content. + -> s + -- ^ Type of the signer. + -> Bool + -- ^ Returns `true` if signature is valid for the value. + +-- | Multiple cryptographic type support. +class Pair a => MultiPair a where + -- | Universal short representation of signer account. + type MultiAddress a + -- | Universal signer account identifier. + type MultiSigner a + -- | Universal signature representation. + type MultiSignature a + -- | Derive universal account address. + multi_address :: a -> MultiAddress a + -- | Derive universal signer account identifier. + multi_signer :: a -> MultiSigner a + -- | Sign message and derive universal signature. + multi_sign :: ByteArrayAccess ba => a -> ba -> MultiSignature a + +-- | Ed25519 cryptographic pair. +data Ed25519 = Ed25519 !Ed25519.PublicKey !Ed25519.SecretKey + deriving Eq + +instance Show Ed25519 where + show = ("Ed25519 " ++) . show . public + +instance Pair Ed25519 where + type PublicKey Ed25519 = H256 + type Signature Ed25519 = H512 + generate = do + sec <- Ed25519.generateSecretKey + return $ Ed25519 (Ed25519.toPublic sec) sec + from_seed seed = case Ed25519.secretKey seed of + CryptoPassed sec -> Right $ Ed25519 (Ed25519.toPublic sec) sec + CryptoFailed e -> Left (show e) + from_phrase = undefined + public (Ed25519 pub _) = fromJust $ h256 pub + sign (Ed25519 pub sec) input = ed25519_sign sec pub input + +-- | ECDSA cryptographic pair. +data Ecdsa = Ecdsa !Ecdsa.PublicKey !Ecdsa.PrivateKey + deriving Eq + +instance Show Ecdsa where + show = ("Ecdsa " ++) . show . public + +instance Pair Ecdsa where + type PublicKey Ecdsa = (Word8, H256) + type Signature Ecdsa = (H512, Word8) + generate = uncurry Ecdsa <$> Ecdsa.generate (getCurveByName SEC_p256k1) + from_seed seed + | BA.length seed == 32 = let sec = Ecdsa.importKey seed + in Right $ Ecdsa (Ecdsa.derivePubKey sec) sec + | otherwise = Left "Seed should be 32 byte length" + from_phrase = undefined + public (Ecdsa pub _) = pack $ uncons $ Ecdsa.exportPubKeyCompress pub + where + pack :: Maybe (Word8, ByteString) -> (Word8, H256) + pack (Just (px, key)) = (px, fromJust (h256 key)) + pack _ = error "impossible branch" + sign (Ecdsa _ sec) input = ecdsa_sign sec input + +ed25519_sign :: ByteArrayAccess a => Ed25519.SecretKey -> Ed25519.PublicKey -> a -> H512 +ed25519_sign sec pub = fromJust . h512 . Ed25519.sign sec pub + +ecdsa_sign :: ByteArrayAccess a => Ecdsa.PrivateKey -> a -> (H512, Word8) +ecdsa_sign sec input = (fromJust $ h512 $ BS.take 64 rsv, BS.last rsv) + where + rsv = Ecdsa.pack (Ecdsa.sign sec input) + +instance MultiPair Ed25519 where + type MultiSigner Ed25519 = P.MultiSigner + type MultiAddress Ed25519 = P.MultiAddress + type MultiSignature Ed25519 = P.MultiSignature + multi_signer = P.Ed25519Signer . public + multi_address = P.MaId . into_account . multi_signer + multi_sign = (P.Ed25519Signature .) . sign + +instance MultiPair Ecdsa where + type MultiSigner Ecdsa = P.MultiSigner + type MultiAddress Ecdsa = P.MultiAddress + type MultiSignature Ecdsa = P.MultiSignature + multi_signer = uncurry P.EcdsaSigner . public + multi_address = P.MaId . into_account . multi_signer + multi_sign = (uncurry P.EcdsaSignature .) . sign diff --git a/src/Network/Polkadot/Extrinsic.hs b/src/Network/Polkadot/Extrinsic.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Extrinsic.hs @@ -0,0 +1,129 @@ +{-# LANGUAGE FlexibleContexts #-} + +-- | +-- Module : Network.Polkadot.Extrinsic +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unportable +-- +-- Extrinsic is a piece of data from external world. +-- + +module Network.Polkadot.Extrinsic + ( Extrinsic + , SignedExtra + , sign_and_send + , mortal_max + , new_extra' + , new_extra + ) where + +import Codec.Scale (Compact (..), + Encode, + encode) +import Data.ByteArray.HexString (HexString) +import Data.Maybe (fromJust) +import Data.Text.Encoding (decodeUtf8) +import Network.JsonRpc.TinyClient (JsonRpc) + +import Network.Polkadot.Account (AccountId, + IdentifyAccount (..), + Ss58Codec (to_ss58check)) +import Network.Polkadot.Crypto (MultiPair (..)) +import Network.Polkadot.Extrinsic.Era (Era (..)) +import Network.Polkadot.Extrinsic.SignedExtension.System +import Network.Polkadot.Extrinsic.SignedExtension.TransactionPayment +import Network.Polkadot.Extrinsic.Unchecked (UncheckedExtrinsic, + sign_extrinsic) +import Network.Polkadot.Primitives (Balance, + Index) +import qualified Network.Polkadot.Primitives as P (MultiAddress, + MultiSignature) +import Network.Polkadot.Rpc.Account (nextIndex) +import Network.Polkadot.Rpc.Author (submitExtrinsic) +import Network.Polkadot.Rpc.Chain (getHeader) +import Network.Polkadot.Rpc.Types (headerNumber, + unBlockNumber) + +-- | Default Polkadot compatible extrinsic type. +type Extrinsic a = UncheckedExtrinsic a P.MultiAddress P.MultiSignature SignedExtra + +-- | Default Polkadot signed extra. +type SignedExtra = + ( CheckSpecVersion + , CheckTxVersion + , CheckGenesis + , CheckEra + , CheckNonce + , CheckWeight + , ChargeTransactionPayment + ) + +new_extra :: (Ss58Codec a, JsonRpc m) + => a + -- ^ Transaction sender address. + -> Balance + -- ^ Transaction tips, or set zero for no tips. + -> m SignedExtra + -- ^ Returns Polkadot transaction extra. +new_extra account_id tip = do + nonce <- fromIntegral <$> nextIndex ss58account + era <- mortal_max + return $ new_extra' era nonce tip + where + ss58account = decodeUtf8 $ to_ss58check account_id + +-- | Create signed extra from general data. +new_extra' :: Era + -- ^ Transaction mortality. + -> Index + -- ^ Transaction nonce value. + -> Balance + -- ^ Transaction tips, or set zero for no tips. + -> SignedExtra + -- ^ Returns Polkadot transaction extra. +new_extra' era nonce tip = + ( CheckSpecVersion + , CheckTxVersion + , CheckGenesis + , CheckEra era + , CheckNonce (Compact nonce) + , CheckWeight + , ChargeTransactionPayment (Compact tip) + ) + +-- | Create a mortal 'Era' with biggest lifetime period. +-- +-- Note: The assumption is runtime has `BlockHashCount` = 2400. This is common +-- for Polkadot runtimes. +mortal_max :: JsonRpc m => m Era +mortal_max = do + current <- (unBlockNumber . headerNumber . fromJust) <$> getHeader Nothing + return $ MortalEra 2048 $ fromIntegral (current - 1) + +-- | Sign extrinsic and send it using node RPC call. +sign_and_send :: ( MultiPair pair + , IdentifyAccount (MultiSigner pair) + , Ss58Codec (AccountId (MultiSigner pair)) + , Encode (MultiAddress pair) + , Encode (MultiSignature pair) + , Encode call + , JsonRpc m + ) + => pair + -- ^ Sender account pair. + -> call + -- ^ Runtime function to call. + -> Balance + -- ^ Tips for speedup transaction (set zero for no boost). + -> m HexString + -- ^ Transaction hash. +sign_and_send pair call tip = do + extra <- new_extra account_id tip + xt <- sign_extrinsic pair call extra + submitExtrinsic (encode xt) + where + account_id = into_account (multi_signer pair) diff --git a/src/Network/Polkadot/Extrinsic/Era.hs b/src/Network/Polkadot/Extrinsic/Era.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Extrinsic/Era.hs @@ -0,0 +1,92 @@ +-- | +-- Module : Network.Polkadot.Extrinsic.Era +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unportable +-- +-- An era to describe the longevity of a transaction. +-- + +module Network.Polkadot.Extrinsic.Era + ( Era(..) + , new_mortal_compact + , birth + , death + ) where + +import Codec.Scale.Class (Decode (..), Encode (..)) +import Codec.Scale.Core () +import Data.Bits (shiftL, shiftR, (.|.)) +import Data.Word (Word16, Word32, Word8, byteSwap16) + +-- | The era for an extrinsic, indicating either a mortal or immortal extrinsic. +data Era + = ImmortalEra + -- ^ The ImmortalEra for an extrinsic. + | MortalEra !Word32 !Word32 + -- ^ The MortalEra for an extrinsic, indicating period and phase. + -- + -- Period and phase are encoded: + -- - The period of validity from the block hash found in the signing material. + -- - The phase in the period that this transaction's lifetime begins (and, importantly, + -- implies which block hash is included in the signature material). If the `period` is + -- greater than 1 << 12, then it will be a factor of the times greater than 1 << 12 that + -- `period` is. + deriving (Eq, Ord, Show) + +instance Decode Era where + get = do + first <- get + case first :: Word8 of + 0 -> return ImmortalEra + _ -> decodeMortal first <$> get + where + decodeMortal :: Word8 -> Word8 -> Era + decodeMortal first second = + let first' = fromIntegral first + second' = fromIntegral second + in new_mortal_compact (first' + second' `shiftL` 8) + +instance Encode Era where + put ImmortalEra = put (0 :: Word8) + put (MortalEra period' phase') = put encoded + where + encoded :: Word16 + encoded = first .|. second + first = (1 `max` (trailing_zeros period - 1)) `min` 15 + second = (phase `div` quantizeFactor) `shiftL` 4 + quantizeFactor = max (period `shiftR` 12) 1 + period = fromIntegral period' + phase = fromIntegral phase' + +-- | Create a mortal 'Era' type from two bytes of data. +new_mortal_compact :: Word16 -> Era +new_mortal_compact raw = MortalEra period phase + where + era = fromIntegral $ byteSwap16 raw + + period = 2 `shiftL` (fromIntegral (era `rem` 16)) + quantizeFactor = max (period `shiftR` 12) 1 + phase = (era `shiftR` 4) * quantizeFactor + +trailing_zeros :: Integral a => a -> a +trailing_zeros = foldl zero 0 . takeWhile (> 0) . iterate (`div` 2) + where + zero a x + | x `mod` 2 == 0 = a + 1 + | otherwise = a + +-- | Get the block number of the start of the era whose properties this object +-- describes that `current` belongs to. +birth :: (Integral a, Integral b) => Era -> a -> b +birth ImmortalEra _ = 0 +birth (MortalEra period phase) current = fromIntegral $ + (max (fromIntegral current) phase - phase) `div` period * period + phase + +-- | Get the block number of the first block at which the era has ended. +death :: (Integral a, Integral b, Bounded b) => Era -> a -> b +death ImmortalEra _ = maxBound +death e@(MortalEra period _) current = fromIntegral $ birth e current + period diff --git a/src/Network/Polkadot/Extrinsic/Payload.hs b/src/Network/Polkadot/Extrinsic/Payload.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Extrinsic/Payload.hs @@ -0,0 +1,41 @@ +-- | +-- Module : Network.Polkadot.Extrinsic.Payload +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Extrinsic payload and payload signing methods. +-- + +module Network.Polkadot.Extrinsic.Payload where + +import Codec.Scale (encode) +import Codec.Scale.Class (Encode (..)) +import qualified Data.ByteString as BS (length) +import Data.Digest.Blake2 (blake2_256) +import Network.JsonRpc.TinyClient (JsonRpc) + +import Network.Polkadot.Crypto (MultiPair (MultiSignature, multi_sign)) +import Network.Polkadot.Extrinsic.SignedExtension (SignedExtension (..)) + +-- | A payload that has been signed for an unchecked extrinsics. +-- +-- Note that the payload that we sign to produce unchecked extrinsic signature +-- is going to be different than the `Payload` - so the thing the extrinsic +-- actually contains. +type Payload call extra = (call, extra) + +-- | Sign extrinsic's payload by multi-pair. +sign_payload :: (MultiPair a, Encode c, SignedExtension e, JsonRpc m) + => a + -> Payload c e + -> m (MultiSignature a) +sign_payload pair (call, extra) = do + additional <- additional_signed extra + let encoded = encode (call, extra, additional) + payload | BS.length encoded > 256 = blake2_256 encoded + | otherwise = encoded + return $ multi_sign pair payload diff --git a/src/Network/Polkadot/Extrinsic/SignedExtension.hs b/src/Network/Polkadot/Extrinsic/SignedExtension.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Extrinsic/SignedExtension.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} + +-- | +-- Module : Network.Polkadot.Extrinsic.SignedExtension +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Additional data that could be attached to the transaction. +-- + +module Network.Polkadot.Extrinsic.SignedExtension where + + +import Codec.Scale (Decode, Encode) +import Network.JsonRpc.TinyClient (JsonRpc) + +-- | Means by which a transaction may be extended. This type embodies both the data and the logic +-- that should be additionally associated with the transaction. It should be plain old data. +class (Encode a, Decode a, Encode (AdditionalSigned a), Decode (AdditionalSigned a)) + => SignedExtension a where + -- | Any additional data that will go into the signed payload. This may be created dynamically + -- from the transaction using the `additional_signed` function. + type AdditionalSigned a + + -- | Construct any additional data that should be in the signed payload of the transaction. Can + -- also perform any pre-signature-verification checks and return an error if needed. + additional_signed :: JsonRpc m => a -> m (AdditionalSigned a) + +instance SignedExtension () where + type AdditionalSigned () = () + additional_signed _ = return () + +instance (SignedExtension a, SignedExtension b) => SignedExtension (a, b) where + type AdditionalSigned (a, b) = (AdditionalSigned a, AdditionalSigned b) + additional_signed (a, b) = (,) + <$> additional_signed a + <*> additional_signed b + +instance (SignedExtension a, SignedExtension b, SignedExtension c) => SignedExtension (a, b, c) where + type AdditionalSigned (a, b, c) = (AdditionalSigned a, AdditionalSigned b, AdditionalSigned c) + additional_signed (a, b, c) = (,,) + <$> additional_signed a + <*> additional_signed b + <*> additional_signed c + +instance (SignedExtension a, SignedExtension b, SignedExtension c, SignedExtension d) => SignedExtension (a, b, c, d) where + type AdditionalSigned (a, b, c, d) = (AdditionalSigned a, AdditionalSigned b, AdditionalSigned c, AdditionalSigned d) + additional_signed (a, b, c, d) = (,,,) + <$> additional_signed a + <*> additional_signed b + <*> additional_signed c + <*> additional_signed d + +instance (SignedExtension a, SignedExtension b, SignedExtension c, SignedExtension d, SignedExtension e) => SignedExtension (a, b, c, d, e) where + type AdditionalSigned (a, b, c, d, e) = (AdditionalSigned a, AdditionalSigned b, AdditionalSigned c, AdditionalSigned d, AdditionalSigned e) + additional_signed (a, b, c, d, e) = (,,,,) + <$> additional_signed a + <*> additional_signed b + <*> additional_signed c + <*> additional_signed d + <*> additional_signed e + +instance (SignedExtension a, SignedExtension b, SignedExtension c, SignedExtension d, SignedExtension e, SignedExtension f) => SignedExtension (a, b, c, d, e, f) where + type AdditionalSigned (a, b, c, d, e, f) = (AdditionalSigned a, AdditionalSigned b, AdditionalSigned c, AdditionalSigned d, AdditionalSigned e, AdditionalSigned f) + additional_signed (a, b, c, d, e, f) = (,,,,,) + <$> additional_signed a + <*> additional_signed b + <*> additional_signed c + <*> additional_signed d + <*> additional_signed e + <*> additional_signed f + +instance (SignedExtension a, SignedExtension b, SignedExtension c, SignedExtension d, SignedExtension e, SignedExtension f, SignedExtension g) => SignedExtension (a, b, c, d, e, f, g) where + type AdditionalSigned (a, b, c, d, e, f, g) = (AdditionalSigned a, AdditionalSigned b, AdditionalSigned c, AdditionalSigned d, AdditionalSigned e, AdditionalSigned f, AdditionalSigned g) + additional_signed (a, b, c, d, e, f, g) = (,,,,,,) + <$> additional_signed a + <*> additional_signed b + <*> additional_signed c + <*> additional_signed d + <*> additional_signed e + <*> additional_signed f + <*> additional_signed g diff --git a/src/Network/Polkadot/Extrinsic/SignedExtension/System.hs b/src/Network/Polkadot/Extrinsic/SignedExtension/System.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Extrinsic/SignedExtension/System.hs @@ -0,0 +1,82 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeFamilies #-} + +-- | +-- Module : Network.Polkadot.Extrinsic.SignedExtension.System +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- A frame system signed extensions. +-- + +module Network.Polkadot.Extrinsic.SignedExtension.System where + +import Codec.Scale (Compact, Decode, + Encode, Generic) +import Data.BigNum (h256) +import Data.Maybe (fromJust) +import Data.Word (Word32) +import qualified GHC.Generics as GHC (Generic) + +import Network.Polkadot.Extrinsic.Era (Era, birth) +import Network.Polkadot.Extrinsic.SignedExtension (SignedExtension (..)) +import Network.Polkadot.Primitives (Hash, Index) +import Network.Polkadot.Rpc.Chain (getBlockHash, + getHeader) +import Network.Polkadot.Rpc.State (getRuntimeVersion) +import Network.Polkadot.Rpc.Types (RuntimeVersion (..), + headerNumber, + unBlockNumber) + +-- | Ensure the runtime version registered in the transaction is the same as at present. +data CheckSpecVersion = CheckSpecVersion + deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +instance SignedExtension CheckSpecVersion where + type AdditionalSigned CheckSpecVersion = Word32 + additional_signed _ = runtimeSpecVersion <$> getRuntimeVersion Nothing + +data CheckTxVersion = CheckTxVersion + deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +instance SignedExtension CheckTxVersion where + type AdditionalSigned CheckTxVersion = Word32 + additional_signed _ = runtimeTransactionVersion <$> getRuntimeVersion Nothing + +data CheckGenesis = CheckGenesis + deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +instance SignedExtension CheckGenesis where + type AdditionalSigned CheckGenesis = Hash + additional_signed _ = do + -- chain must have genesis block, fromJust is safe + (fromJust . (h256 =<<)) <$> getBlockHash (Just 0) + +newtype CheckEra = CheckEra Era + deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +instance SignedExtension CheckEra where + type AdditionalSigned CheckEra = Hash + additional_signed (CheckEra era) = do + -- chain must have top header, fromJust is safe here + current <- (unBlockNumber . headerNumber . fromJust) <$> getHeader Nothing + (fromJust . (h256 =<<)) <$> getBlockHash (Just $ birth era current) + +newtype CheckNonce = CheckNonce (Compact Index) + deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +instance SignedExtension CheckNonce where + type AdditionalSigned CheckNonce = () + additional_signed _ = return () + +data CheckWeight = CheckWeight + deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +instance SignedExtension CheckWeight where + type AdditionalSigned CheckWeight = () + additional_signed _ = return () diff --git a/src/Network/Polkadot/Extrinsic/SignedExtension/TransactionPayment.hs b/src/Network/Polkadot/Extrinsic/SignedExtension/TransactionPayment.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Extrinsic/SignedExtension/TransactionPayment.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeFamilies #-} + +-- | +-- Module : Network.Polkadot.Extrinsic.SignedExtension.TransactionPayment +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- A pallet-transaction-payment signed extension. +-- + +module Network.Polkadot.Extrinsic.SignedExtension.TransactionPayment where + +import Codec.Scale (Compact, Decode, + Encode, Generic) +import qualified GHC.Generics as GHC (Generic) + +import Network.Polkadot.Extrinsic.SignedExtension (SignedExtension (..)) +import Network.Polkadot.Primitives (Balance) + +-- | Require the transactor pay for themselves and maybe include a tip to +-- gain additional priority in the queue. +newtype ChargeTransactionPayment = ChargeTransactionPayment (Compact Balance) + deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +instance SignedExtension ChargeTransactionPayment where + type AdditionalSigned ChargeTransactionPayment = () + additional_signed _ = return () diff --git a/src/Network/Polkadot/Extrinsic/Unchecked.hs b/src/Network/Polkadot/Extrinsic/Unchecked.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Extrinsic/Unchecked.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | +-- Module : Network.Polkadot.Extrinsic.Unchecked +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unportable +-- +-- Extrinsic is a piece of data from external world. +-- + +module Network.Polkadot.Extrinsic.Unchecked + ( UncheckedExtrinsic (..) + , new_unsigned + , new_signed + , sign_extrinsic + ) where + +import Codec.Scale (encode) +import Codec.Scale.Class (Decode (..), + Encode (..)) +import Control.Arrow ((&&&)) +import Control.Monad (when) +import Data.Bits (clearBit, setBit, + testBit) +import Data.ByteArray.HexString (HexString) +import Data.ByteString (ByteString) +import Data.Word (Word8) +import Network.JsonRpc.TinyClient (JsonRpc) + +import Network.Polkadot.Crypto (MultiPair (..)) +import Network.Polkadot.Extrinsic.Payload (sign_payload) +import Network.Polkadot.Extrinsic.SignedExtension (SignedExtension) + +-- | Current version of the 'UncheckedExtrinsic' format. +extrinsic_version :: Word8 +extrinsic_version = 4 + +-- | A extrinsic right from the external world. This is unchecked and so +-- can contain a signature. +data UncheckedExtrinsic c a s e + = UncheckedExtrinsic + { extrinsicSignature :: !(Maybe (a, s, e)) + -- ^ The signature, address, number of extrinsics have come before from + -- the same signer and an era describing the longevity of this transaction, + -- if this is a signed extrinsic. + , extrinsicFunction :: !c + -- ^ The function that should be called. + } + +instance Encode c => Show (UncheckedExtrinsic c a b c) where + show (UncheckedExtrinsic _ call) = "UncheckedExtrinsic " ++ show encoded + where + encoded :: HexString + encoded = encode call + +instance (Encode c, Encode a, Encode s, Encode e) => Encode (UncheckedExtrinsic c a s e) where + put xt = put encoded + where + encoded :: ByteString + encoded = case xt of + UncheckedExtrinsic Nothing call + -> encode extrinsic_version <> encode call + UncheckedExtrinsic (Just s) call + -> encode (setBit extrinsic_version 7) <> encode s <> encode call + +instance (Decode c, Decode a, Decode s, Decode e) => Decode (UncheckedExtrinsic c a s e) where + get = do + (_v :: [()]) <- get + (signed, version) <- (flip testBit 7 &&& flip clearBit 7) <$> get + when (version /= extrinsic_version) $ fail "bad version" + UncheckedExtrinsic + <$> (if signed then fmap Just get else return Nothing) + <*> get + +-- | New instance of a signed extrinsic aka "transaction". +new_signed :: c -> a -> s -> e -> UncheckedExtrinsic c a s e +new_signed call address sig extra = UncheckedExtrinsic (Just (address, sig, extra)) call + +-- | New instance of an unsigned extrinsic aka "inherent". +new_unsigned :: f -> UncheckedExtrinsic f a b c +new_unsigned = UncheckedExtrinsic Nothing + +-- | Create and sign extrinsic by account. +sign_extrinsic :: (MultiPair a, Encode c, SignedExtension e, JsonRpc m) + => a + -- ^ Account to sign extrinsic. + -> c + -- ^ Function to call on runtime. + -> e + -- ^ Additional data to sign like nonce, blockhash, etc. + -> m (UncheckedExtrinsic c (MultiAddress a) (MultiSignature a) e) +sign_extrinsic a c e = do + sig <- sign_payload a (c, e) + return $ new_signed c (multi_address a) sig e diff --git a/src/Network/Polkadot/Metadata.hs b/src/Network/Polkadot/Metadata.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Metadata.hs @@ -0,0 +1,119 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TemplateHaskell #-} + +-- | +-- Module : Network.Polkadot.Metadata +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Node runtime type information. +-- + +module Network.Polkadot.Metadata where + +import Codec.Scale (Decode, Encode, + Generic) +import Data.Aeson (Options (constructorTagModifier, sumEncoding), + SumEncoding (ObjectWithSingleField), + defaultOptions) +import Data.Aeson.TH (deriveJSON) +import Data.Char (toLower) +import Data.Set (Set) +import qualified GHC.Generics as GHC (Generic) +import Lens.Micro (_head, over) + +import Network.Polkadot.Metadata.MagicNumber (MagicNumber (..)) +import Network.Polkadot.Metadata.Type (Type) +import Network.Polkadot.Metadata.Type.Discovery (runDiscovery) +import qualified Network.Polkadot.Metadata.V10 as V10 (Metadata (Metadata), + moduleName) +import qualified Network.Polkadot.Metadata.V11 as V11 (Metadata (Metadata), + moduleName) +import qualified Network.Polkadot.Metadata.V12 as V12 (Metadata (Metadata), + moduleName) +import qualified Network.Polkadot.Metadata.V13 as V13 (Metadata (Metadata), + moduleName) +import qualified Network.Polkadot.Metadata.V9 as V9 (Metadata (Metadata), + moduleName) + +-- | All supported metadata versions as enum. +-- +-- It could have troubles of decoding for metadata V9 because of hack: +-- https://github.com/polkadot-js/api/commit/a9211690be6b68ad6c6dad7852f1665cadcfa5b2 +data MetadataVersioned + = V0 | V1 | V2 | V3 | V4 | V5 | V6 | V7 | V8 -- Not defined + | V9 V9.Metadata + | V10 V10.Metadata + | V11 V11.Metadata + | V12 V12.Metadata + | V13 V13.Metadata + deriving (Eq, Show, Generic, GHC.Generic, Decode, Encode) + +$(deriveJSON (defaultOptions + { constructorTagModifier = over _head toLower, sumEncoding = ObjectWithSingleField }) ''MetadataVersioned) + +-- | The versioned runtime metadata as a decoded structure. +data Metadata = Metadata + { magicNumber :: MagicNumber + , metadata :: MetadataVersioned + } deriving (Eq, Show, Generic, GHC.Generic, Decode, Encode) + +$(deriveJSON defaultOptions ''Metadata) + +isV9 :: Metadata -> Bool +isV9 (Metadata _ (V9 _)) = True +isV9 _ = False + +isV10 :: Metadata -> Bool +isV10 (Metadata _ (V10 _)) = True +isV10 _ = False + +isV11 :: Metadata -> Bool +isV11 (Metadata _ (V11 _)) = True +isV11 _ = False + +isV12 :: Metadata -> Bool +isV12 (Metadata _ (V12 _)) = True +isV12 _ = False + +isV13 :: Metadata -> Bool +isV13 (Metadata _ (V13 _)) = True +isV13 _ = False + +isLatest :: Metadata -> Bool +{-# INLINE isLatest #-} +isLatest = isV13 + +toLatest :: Metadata -> V13.Metadata +toLatest (Metadata _ (V13 m)) = m +toLatest _ = undefined + +metadataTypes :: Metadata -> (Metadata, Set Type) +metadataTypes (Metadata _ (V9 (V9.Metadata modules))) = + let (modules', types) = runDiscovery V9.moduleName modules + in (Metadata MagicNumber (V9 (V9.Metadata modules')), types) + +metadataTypes (Metadata _ (V10 (V10.Metadata modules))) = + let (modules', types) = runDiscovery V10.moduleName modules + in (Metadata MagicNumber (V10 (V10.Metadata modules')), types) + +{- XXX: OOM compilation on my laptop +metadataTypes (Metadata _ (V11 (V11.Metadata modules extrinsics))) = + let (modules', types) = runDiscovery V11.moduleName modules + in (Metadata MagicNumber (V11 (V11.Metadata modules' extrinsics)), types) +-} + +metadataTypes (Metadata _ (V12 (V12.Metadata modules extrinsics))) = + let (modules', types) = runDiscovery V12.moduleName modules + in (Metadata MagicNumber (V12 (V12.Metadata modules' extrinsics)), types) + +metadataTypes (Metadata _ (V13 (V13.Metadata modules extrinsics))) = + let (modules', types) = runDiscovery V13.moduleName modules + in (Metadata MagicNumber (V13 (V13.Metadata modules' extrinsics)), types) + +metadataTypes m = (m, mempty) diff --git a/src/Network/Polkadot/Metadata/MagicNumber.hs b/src/Network/Polkadot/Metadata/MagicNumber.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Metadata/MagicNumber.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} + +-- | +-- Module : Network.Polkadot.Metadata.MagicNumber +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Metadata V9 data type. +-- + +module Network.Polkadot.Metadata.MagicNumber where + +import Codec.Scale.Class (Decode (..), Encode (..)) +import Codec.Scale.Core () +import Control.Monad (when) +import Data.Aeson (FromJSON (..), ToJSON (..), Value (Number)) +import Data.Word (Word32) + +-- | `meta`, reversed for Little Endian encoding +magic_number :: Word32 +magic_number = 0x6174656d + +-- | 32-bit prefix magic sentence. +data MagicNumber = MagicNumber + deriving (Eq, Show) + +instance Decode MagicNumber where + get = do + n <- get + when (n /= magic_number) $ + fail "Bad magic number" + return MagicNumber + +instance Encode MagicNumber where + put _ = put magic_number + +instance FromJSON MagicNumber where + parseJSON (Number n) = do + when (n /= fromIntegral magic_number) $ + fail "Bad magic number" + return MagicNumber + parseJSON _ = fail "Magic number should be a number" + +instance ToJSON MagicNumber where + toJSON _ = toJSON magic_number diff --git a/src/Network/Polkadot/Metadata/Type.hs b/src/Network/Polkadot/Metadata/Type.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Metadata/Type.hs @@ -0,0 +1,40 @@ +-- | +-- Module : Network.Polkadot.Metadata.Type +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Runtime metadata type and encoding. +-- + +module Network.Polkadot.Metadata.Type where + +import Codec.Scale.Class (Decode (..), + Encode (..)) +import Codec.Scale.Core () +import Data.Aeson (FromJSON (..), + ToJSON (..), + Value (String)) +import Data.Text (Text) + +import Network.Polkadot.Metadata.Type.Parser (sanitizeM) + +-- | Sanitized name for metadata type. +newtype Type = Type { unType :: Text } + deriving (Eq, Ord, Show) + +instance FromJSON Type where + parseJSON (String s) = return (Type s) + parseJSON _ = fail "Type should be a string" + +instance ToJSON Type where + toJSON = toJSON . unType + +instance Decode Type where + get = fmap Type (sanitizeM =<< get) + +instance Encode Type where + put = put . unType diff --git a/src/Network/Polkadot/Metadata/Type/Ast.hs b/src/Network/Polkadot/Metadata/Type/Ast.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Metadata/Type/Ast.hs @@ -0,0 +1,39 @@ +-- | +-- Module : Network.Polkadot.Metadata.Type.Ast +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Runtime metadata type AST. +-- + +module Network.Polkadot.Metadata.Type.Ast where + +import Data.Text (Text) + +-- | Qualified type parameter, e.g., as SomeTrait>::SomeType. +type QSelf = (TypeAst, TypeAst) + +-- | A segment of a path: an identifier and a set of argument types. +type PathSegment = (Text, Maybe [TypeAst]) + +-- | Simple Rust type AST is used for Metadata type representation. +data TypeAst + = Slice !TypeAst + -- ^ A variable-length slice ([T]). + | Tuple ![TypeAst] + -- ^ A tuple ((A, B, C, D,...)). + | Array !TypeAst !Int + -- ^ A fixed length array ([T; n]). + | Path { qself :: !(Maybe QSelf) + -- ^ Two types of as Trait>. + , segments :: ![PathSegment] + -- ^ A segment of a path: an identifier and a set of types. + } + -- ^ A "Path" is essentially Rust's notion of a name. It's represented as a sequence of identifiers, + -- along with a bunch of supporting information. A path (module::module::...::Type), optionally "qualified", + -- e.g., as SomeTrait>::SomeType. + deriving (Eq, Ord, Read, Show) diff --git a/src/Network/Polkadot/Metadata/Type/Discovery.hs b/src/Network/Polkadot/Metadata/Type/Discovery.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Metadata/Type/Discovery.hs @@ -0,0 +1,138 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +-- | +-- Module : Network.Polkadot.Metadata.Type.Discovery +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Runtime type discovery for generic metadata structures. +-- + +module Network.Polkadot.Metadata.Type.Discovery + ( DiscoveryContext + , Discovery(..) + , runDiscovery + , prefix + , types + ) where + +import Control.Monad.State.Class (MonadState (..)) +import Control.Monad.State.Strict (runState) +import Data.ByteArray.HexString (HexString) +import Data.Set (Set, insert) +import Data.Text (Text) +import Data.Word (Word8) +import Generics.SOP +import Lens.Micro.Extras (view) +import Lens.Micro.Mtl (use, (%=), (.=)) +import Lens.Micro.TH (makeLenses) + +import Network.Polkadot.Metadata.Type (Type (..)) + +-- | Contains information about types and current context. +data DiscoveryContext = DiscoveryContext + { _prefix :: !Text + , _types :: !(Set Type) + } deriving (Eq, Show) + +instance Semigroup DiscoveryContext where + (DiscoveryContext p a) <> (DiscoveryContext _ b) = DiscoveryContext p (a <> b) + +instance Monoid DiscoveryContext where + mempty = DiscoveryContext mempty mempty + +makeLenses ''DiscoveryContext + +-- | Collects information about runtime types. +class Discovery a where + -- | Discover metadata structure for type information. + discovery :: MonadState DiscoveryContext m + => a + -- ^ Input data structure that contains type information. + -> m a + -- ^ Returns the same structure wrapped with registry state monad. + +-- | Skip 'Word8' when found. +instance {-# OVERLAPPING #-} Discovery Word8 where + discovery = return + +-- | Skip 'HexString' when found. +instance {-# OVERLAPPING #-} Discovery HexString where + discovery = return + +-- | Skip 'Text' when found. +instance {-# OVERLAPPING #-} Discovery Text where + discovery = return + +-- | Register 'Type' when found. +instance {-# OVERLAPPING #-} Discovery Type where + discovery t = update . maybe t Type . flip typeOverlap t =<< use prefix + where + update x = types %= insert x >> return x + +-- | Type overlapping hacks +typeOverlap :: Text + -- ^ Module name + -> Type + -- ^ Module type + -> Maybe Text + -- ^ New type name +typeOverlap "Society" (Type "Vote") = Just "SocietyVote" +typeOverlap "Treasury" (Type "Proposal") = Just "TreasuryProposal" +typeOverlap "Assets" (Type "Balance") = Just "TAssetBalance" +typeOverlap "Assets" (Type "Compact") = Just "Compact" +typeOverlap "Assets" (Type "Approval") = Just "AssetApproval" +typeOverlap "Assets" (Type "ApprovalKey") = Just "AssetApprovalKey" +typeOverlap "Assets" (Type "DestroyWitness") = Just "AssetDestroyWitness" +typeOverlap "Identity" (Type "Judgement") = Just "IdentityJudgement" +typeOverlap "ElectionProviderMultiPhase" (Type "Phase") = Just "ElectionPhase" +typeOverlap a (Type "Judgement") = Just (a <> "Judgement") +typeOverlap a (Type "EquivocationProof") = Just (a <> "EquivocationProof") +typeOverlap _ _ = Nothing + + +-- | If input type is generic structure, let's go deep using generics. +instance (Generic a, GDiscovery (NS (NP I) (Code a))) => Discovery a where + discovery = fmap (to . SOP) . gdiscovery . unSOP . from + +-- | Generic version of 'Discovery' type class. +class GDiscovery a where + gdiscovery :: MonadState DiscoveryContext m => a -> m a + +-- | Discovery all constructors of the sum. +instance ( GDiscovery (NP I xs) + , GDiscovery (NS (NP I) xss) + ) => GDiscovery (NS (NP I) (xs ': xss)) where + gdiscovery (Z xs) = Z <$> gdiscovery xs + gdiscovery (S xs) = S <$> gdiscovery xs + +-- | Finish when constructors will end. +instance GDiscovery (NS (NP I) '[]) where + gdiscovery = return + +-- | Discovery all fileds of constructors. +instance (Discovery a, GDiscovery (NP I as)) => GDiscovery (NP I (a ': as)) where + gdiscovery (I a :* as) = do + a' <- discovery a + (I a' :*) <$> gdiscovery as + +-- | Finish when fileds will end. +instance GDiscovery (NP I '[]) where + gdiscovery = return + +-- | Discovery types and returns sanitized metadata and set of discovered types. +runDiscovery :: (Discovery a, Traversable t) => (a -> Text) -> t a -> (t a, Set Type) +runDiscovery p = fmap (view types) + . flip runState mempty + . mapM (\m -> prefix .= p m >> discovery m) diff --git a/src/Network/Polkadot/Metadata/Type/Parser.hs b/src/Network/Polkadot/Metadata/Type/Parser.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Metadata/Type/Parser.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Network.Polkadot.Metadata.Type.Parser +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- This module parse and cleanup raw types given from runtime, +-- drop traits, generics, etc. +-- + +module Network.Polkadot.Metadata.Type.Parser + ( fromText + , fromTextM + , toText + , sanitize + , sanitizeM + ) where + +import Control.Monad.Fail (MonadFail) +import Data.Text (Text, + intercalate, + pack, + replace, + strip) +import Text.Parsec (ParseError, + parse) + +import Network.Polkadot.Metadata.Type.Ast +import Network.Polkadot.Metadata.Type.ParserCombinators (type') + +allowed_boxes :: [Text] +allowed_boxes = + [ "BTreeMap" + , "BTreeSet" + , "Compact" + , "DoNotConstruct" + , "HashMap" + , "Int" + , "Linkage" + , "Result" + , "Option" + , "UInt" + , "Vec" + ] + +render_box :: Text -> Maybe [TypeAst] -> Text +render_box name Nothing = name +render_box name (Just args) + | any (== name) allowed_boxes = name <> "<" <> intercalate "," (toText <$> args) <> ">" + | name == "BoundedVec" = "Vec<" <> intercalate "," (toText <$> args) <> ">" + | name == "Box" = toText (head args) + | otherwise = name + +aliases :: Maybe QSelf -> PathSegment -> Text -> Text +aliases _ _ "Vec" = "Bytes" +aliases _ _ "Announcement" = "ProxyAnnouncement" +aliases _ _ "Status" = "BalanceStatus" +aliases (Just (q, _)) _ "Source" = toText q <> "Source" +aliases (Just (q, _)) _ "Target" = toText q <> "Target" +aliases _ _ a = a + +-- | Render Metadata type to text. +-- +-- This function strongly sanitize type identifiers and paths, +-- removes generics and other Rust related staff. +toText :: TypeAst -> Text +toText (Slice (Path Nothing [("u8", Nothing)])) = "Bytes" +toText (Slice t) = "[" <> toText t <> "]" +toText (Tuple [t]) = toText t +toText (Tuple ts) = "(" <> intercalate "," (toText <$> ts) <> ")" +toText (Array t n) = "[" <> toText t <> ";" <> pack (show n) <> "]" +toText (Path _ []) = "()" +toText (Path q xs) = aliases q (last xs) $ render_box name args + where name = fst (last xs) + args = snd (last xs) + +-- | Parse metadata type (general Rust type) from text. +fromText :: Text -> Either ParseError TypeAst +fromText = parse type' "Metadata Type" + . strip + . replace "\n" "" + . replace "\n " "" + +-- | This variant of `fromText` fails when error happens. +fromTextM :: MonadFail m => Text -> m TypeAst +fromTextM t = either (fail . ((show t ++ ": ") ++) . show) return $ fromText t + +-- | Cleanup type or return error when syntax failure. +sanitize :: Text -> Either ParseError Text +{-# INLINE sanitize #-} +sanitize = fmap toText . fromText + +-- | Cleanup type or throw fail call when syntax failure. +sanitizeM :: MonadFail m => Text -> m Text +{-# INLINE sanitizeM #-} +sanitizeM = fmap toText . fromTextM diff --git a/src/Network/Polkadot/Metadata/Type/ParserCombinators.hs b/src/Network/Polkadot/Metadata/Type/ParserCombinators.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Metadata/Type/ParserCombinators.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Network.Polkadot.Metadata.Type.ParserCombinators +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Parser combinators for the metadata type. +-- + +module Network.Polkadot.Metadata.Type.ParserCombinators where + +import Data.Functor.Identity (Identity) +import Data.Text (pack) +import Text.Parsec +import Text.Parsec.Text () + +import Network.Polkadot.Metadata.Type.Ast (PathSegment, QSelf, + TypeAst (..)) + +type' :: Stream s Identity Char => Parsec s () TypeAst +type' = choice + [ Slice <$> try slice + , Tuple <$> tuple + , Array <$> arrayT <*> arrayN + , Path <$> optionMaybe pathQself <*> path + ] + +slice :: Stream s Identity Char => Parsec s () TypeAst +slice = (string "[" <|> string "&[") *> type' <* char ']' + +tuple :: Stream s Identity Char => Parsec s () [TypeAst] +tuple = char '(' *> type' `sepBy1` comma <* char ')' + +arrayT :: Stream s Identity Char => Parsec s () TypeAst +arrayT = char '[' *> type' <* dotcomma + where dotcomma = try (string "; ") <|> string ";" + +arrayN :: Stream s Identity Char => Parsec s () Int +arrayN = read <$> manyTill digit (char ']') + +pathQself :: Stream s Identity Char => Parsec s () QSelf +pathQself = (char '<' *> qselfP <* char '>') <* string "::" + where qselfP = (,) <$> (type' <* string " as ") <*> type' + +path :: Stream s Identity Char => Parsec s () [PathSegment] +path = path' `sepBy` string "::" + where + path' = (,) <$> ident + <*> optionMaybe (char '<' *> type' `sepBy1` comma <* char '>') + ident = do + c <- letter + cs <- many (alphaNum <|> char '_') + return $ pack (c : cs) + +comma :: Stream s Identity Char => Parsec s () String +comma = try (string ", ") <|> string "," diff --git a/src/Network/Polkadot/Metadata/V10.hs b/src/Network/Polkadot/Metadata/V10.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Metadata/V10.hs @@ -0,0 +1,115 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TemplateHaskell #-} + +-- | +-- Module : Network.Polkadot.Metadata.V10 +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Metadata version 10 definitions. +-- + +module Network.Polkadot.Metadata.V10 where + +import Codec.Scale (Decode, Encode, Generic) +import Data.Aeson (Options (constructorTagModifier, fieldLabelModifier, sumEncoding), + SumEncoding (ObjectWithSingleField), + defaultOptions) +import Data.Aeson.TH (deriveJSON) +import Data.ByteArray.HexString (HexString) +import Data.Char (toLower) +import Data.Text (Text) +import qualified GHC.Generics as GHC (Generic) +import Lens.Micro (_head, over) + +import Network.Polkadot.Metadata.Type (Type) +import qualified Network.Polkadot.Metadata.V9 as V9 + +type StorageEntryModifier = V9.StorageEntryModifier +type FunctionMetadata = V9.FunctionMetadata +type EventMetadata = V9.EventMetadata +type ModuleConstantMetadata = V9.ModuleConstantMetadata +type ErrorMetadata = V9.ErrorMetadata + +data StorageHasher + = Blake2_128 + | Blake2_256 + | Blake2_128Concat + | Twox128 + | Twox256 + | Twox64Concat + deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON defaultOptions ''StorageHasher) + +data MapType = MapType + { mapHasher :: !StorageHasher + , mapKey :: !Type + , mapValue :: !Type + , mapLinked :: !Bool + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 3 }) ''MapType) + +data DoubleMapType = DoubleMapType + { doubleMapHasher :: !StorageHasher + , doubleMapKey1 :: !Type + , doubleMapKey2 :: !Type + , doubleMapValue :: !Type + , doubleMapKey2Hasher :: !StorageHasher + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 9 }) ''DoubleMapType) + +data StorageEntryType + = Plain !Type + | Map !MapType + | DoubleMap !DoubleMapType + deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { constructorTagModifier = over _head toLower, sumEncoding = ObjectWithSingleField }) ''StorageEntryType) + +data StorageEntryMetadata = StorageEntryMetadata + { entryName :: !Text + , entryModifier :: !StorageEntryModifier + , entryType :: !StorageEntryType + , entryFallback :: !HexString + , entryDocs :: ![Text] + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 5 }) ''StorageEntryMetadata) + +data StorageMetadata = StorageMetadata + { storagePrefix :: !Text + , storageItems :: ![StorageEntryMetadata] + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 7 }) ''StorageMetadata) + +data ModuleMetadata = ModuleMetadata + { moduleName :: !Text + , moduleStorage :: !(Maybe StorageMetadata) + , moduleCalls :: !(Maybe [FunctionMetadata]) + , moduleEvents :: !(Maybe [EventMetadata]) + , moduleConstants :: ![ModuleConstantMetadata] + , moduleErrors :: ![ErrorMetadata] + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 6 }) ''ModuleMetadata) + +data Metadata = Metadata + { modules :: ![ModuleMetadata] + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON defaultOptions ''Metadata) diff --git a/src/Network/Polkadot/Metadata/V11.hs b/src/Network/Polkadot/Metadata/V11.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Metadata/V11.hs @@ -0,0 +1,126 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TemplateHaskell #-} + +-- | +-- Module : Network.Polkadot.Metadata.V11 +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Metadata version 11 definitions. +-- + +module Network.Polkadot.Metadata.V11 where + +import Codec.Scale (Decode, Encode, Generic) +import Data.Aeson (Options (constructorTagModifier, fieldLabelModifier, sumEncoding), + SumEncoding (ObjectWithSingleField), + defaultOptions) +import Data.Aeson.TH (deriveJSON) +import Data.ByteArray.HexString (HexString) +import Data.Char (toLower) +import Data.Text (Text) +import Data.Word (Word8) +import qualified GHC.Generics as GHC (Generic) +import Lens.Micro (_head, over) + +import Network.Polkadot.Metadata.Type (Type) +import qualified Network.Polkadot.Metadata.V10 as V10 + +type StorageEntryModifier = V10.StorageEntryModifier +type FunctionMetadata = V10.FunctionMetadata +type EventMetadata = V10.EventMetadata +type ModuleConstantMetadata = V10.ModuleConstantMetadata +type ErrorMetadata = V10.ErrorMetadata + +data StorageHasher + = Blake2_128 + | Blake2_256 + | Blake2_128Concat + | Twox128 + | Twox256 + | Twox64Concat + | Identity + deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON defaultOptions ''StorageHasher) + +data MapType = MapType + { mapHasher :: !StorageHasher + , mapKey :: !Type + , mapValue :: !Type + , mapLinked :: !Bool + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 3 }) ''MapType) + +data DoubleMapType = DoubleMapType + { doubleMapHasher :: !StorageHasher + , doubleMapKey1 :: !Type + , doubleMapKey2 :: !Type + , doubleMapValue :: !Type + , doubleMapKey2Hasher :: !StorageHasher + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 9 }) ''DoubleMapType) + +data StorageEntryType + = Plain !Type + | Map !MapType + | DoubleMap !DoubleMapType + deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { constructorTagModifier = over _head toLower, sumEncoding = ObjectWithSingleField }) ''StorageEntryType) + +data StorageEntryMetadata = StorageEntryMetadata + { entryName :: !Text + , entryModifier :: !StorageEntryModifier + , entryType :: !StorageEntryType + , entryFallback :: !HexString + , entryDocs :: ![Text] + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 5 }) ''StorageEntryMetadata) + +data StorageMetadata = StorageMetadata + { storagePrefix :: !Text + , storageItems :: ![StorageEntryMetadata] + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 7 }) ''StorageMetadata) + +data ModuleMetadata = ModuleMetadata + { moduleName :: !Text + , moduleStorage :: !(Maybe StorageMetadata) + , moduleCalls :: !(Maybe [FunctionMetadata]) + , moduleEvents :: !(Maybe [EventMetadata]) + , moduleConstants :: ![ModuleConstantMetadata] + , moduleErrors :: ![ErrorMetadata] + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 6 }) ''ModuleMetadata) + +data ExtrinsicMetadata = ExtrinsicMetadata + { extrinsicVersion :: !Word8 + , extrinsicSignedExtensions :: ![Text] + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 9 }) ''ExtrinsicMetadata) + +data Metadata = Metadata + { modules :: ![ModuleMetadata] + , extrinsics :: !ExtrinsicMetadata + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON defaultOptions ''Metadata) diff --git a/src/Network/Polkadot/Metadata/V12.hs b/src/Network/Polkadot/Metadata/V12.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Metadata/V12.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TemplateHaskell #-} + +-- | +-- Module : Network.Polkadot.Metadata.V12 +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Metadata version 12 definitions. +-- + +module Network.Polkadot.Metadata.V12 where + +import Codec.Scale (Decode, Encode, Generic) +import Data.Aeson (Options (fieldLabelModifier), + defaultOptions) +import Data.Aeson.TH (deriveJSON) +import Data.Char (toLower) +import Data.Text (Text) +import Data.Word (Word8) +import qualified GHC.Generics as GHC (Generic) +import Lens.Micro (_head, over) + +import qualified Network.Polkadot.Metadata.V11 as V11 + +type ExtrinsicMetadata = V11.ExtrinsicMetadata +type StorageMetadata = V11.StorageMetadata +type FunctionMetadata = V11.FunctionMetadata +type EventMetadata = V11.EventMetadata +type ModuleConstantMetadata = V11.ModuleConstantMetadata +type ErrorMetadata = V11.ErrorMetadata +type MapType = V11.MapType +type DoubleMapType = V11.DoubleMapType +type StorageHasher = V11.StorageHasher +type StorageEntryModifier = V11.StorageEntryModifier + +data ModuleMetadata = ModuleMetadata + { moduleName :: !Text + , moduleStorage :: !(Maybe StorageMetadata) + , moduleCalls :: !(Maybe [FunctionMetadata]) + , moduleEvents :: !(Maybe [EventMetadata]) + , moduleConstants :: ![ModuleConstantMetadata] + , moduleErrors :: ![ErrorMetadata] + , moduleIndex :: !Word8 + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 6 }) ''ModuleMetadata) + +data Metadata = Metadata + { modules :: ![ModuleMetadata] + , extrinsic :: !ExtrinsicMetadata + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON defaultOptions ''Metadata) diff --git a/src/Network/Polkadot/Metadata/V13.hs b/src/Network/Polkadot/Metadata/V13.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Metadata/V13.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TemplateHaskell #-} + +-- | +-- Module : Network.Polkadot.Metadata.V13 +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Metadata version 13 definitions. +-- + +module Network.Polkadot.Metadata.V13 where + +import Codec.Scale (Decode, Encode, Generic) +import Data.Aeson (Options (constructorTagModifier, fieldLabelModifier, sumEncoding), + SumEncoding (ObjectWithSingleField), + defaultOptions) +import Data.Aeson.TH (deriveJSON) +import Data.ByteArray.HexString (HexString) +import Data.Char (toLower) +import Data.Text (Text) +import Data.Word (Word8) +import qualified GHC.Generics as GHC (Generic) +import Lens.Micro (_head, over) + +import Network.Polkadot.Metadata.Type (Type) +import qualified Network.Polkadot.Metadata.V12 as V12 + +type ExtrinsicMetadata = V12.ExtrinsicMetadata +type FunctionMetadata = V12.FunctionMetadata +type EventMetadata = V12.EventMetadata +type ModuleConstantMetadata = V12.ModuleConstantMetadata +type ErrorMetadata = V12.ErrorMetadata +type StorageHasher = V12.StorageHasher +type MapType = V12.MapType +type DoubleMapType = V12.DoubleMapType + +data NMapType = NMapType + { nmapKeyVec :: ![Type] + , nmapHashers :: ![StorageHasher] + , nmapValue :: !Type + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 4 }) ''NMapType) + +data StorageEntryType + = Plain !Type + | Map !MapType + | DoubleMap !DoubleMapType + | NMap !NMapType + deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { constructorTagModifier = over _head toLower, sumEncoding = ObjectWithSingleField }) ''StorageEntryType) + +data StorageEntryMetadata = StorageEntryMetadata + { entryName :: !Text + , entryModifier :: !V12.StorageEntryModifier + , entryType :: !StorageEntryType + , entryFallback :: !HexString + , entryDocumentation :: ![Text] + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 5 }) ''StorageEntryMetadata) + +data StorageMetadata = StorageMetadata + { storagePrefix :: !Text + , storageItems :: ![StorageEntryMetadata] + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 7 }) ''StorageMetadata) + +data ModuleMetadata = ModuleMetadata + { moduleName :: !Text + , moduleStorage :: !(Maybe StorageMetadata) + , moduleCalls :: !(Maybe [FunctionMetadata]) + , moduleEvents :: !(Maybe [EventMetadata]) + , moduleConstants :: ![ModuleConstantMetadata] + , moduleErrors :: ![ErrorMetadata] + , moduleIndex :: !Word8 + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 6 }) ''ModuleMetadata) + +data Metadata = Metadata + { modules :: ![ModuleMetadata] + , extrinsic :: !ExtrinsicMetadata + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON defaultOptions ''Metadata) diff --git a/src/Network/Polkadot/Metadata/V9.hs b/src/Network/Polkadot/Metadata/V9.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Metadata/V9.hs @@ -0,0 +1,157 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} + +-- | +-- Module : Network.Polkadot.Metadata.V9 +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Metadata version 9 definitions. +-- + +module Network.Polkadot.Metadata.V9 where + +import Codec.Scale (Decode, Encode, Generic) +import Data.Aeson (Options (constructorTagModifier, fieldLabelModifier, sumEncoding), + SumEncoding (ObjectWithSingleField), + defaultOptions) +import Data.Aeson.TH (deriveJSON) +import Data.ByteArray.HexString (HexString) +import Data.Char (toLower) +import Data.Text (Text) +import qualified GHC.Generics as GHC (Generic) +import Lens.Micro (_head, over) + +import Network.Polkadot.Metadata.Type (Type) + +data FunctionArgumentMetadata = FunctionArgumentMetadata + { argumentName :: !Text + , argumentType :: !Type + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 8 }) ''FunctionArgumentMetadata) + +data FunctionMetadata = FunctionMetadata + { functionName :: !Text + , functionArgs :: ![FunctionArgumentMetadata] + , functionDocs :: ![Text] + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 8 }) ''FunctionMetadata) + +data EventMetadata = EventMetadata + { eventName :: !Text + , eventArgs :: ![Type] + , eventDocs :: ![Text] + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 5 }) ''EventMetadata) + +data ModuleConstantMetadata = ModuleConstantMetadata + { constantName :: !Text + , constantType :: !Type + , constantValue :: !HexString + , constantDocs :: ![Text] + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 8 }) ''ModuleConstantMetadata) + +data ErrorMetadata = ErrorMetadata + { errorName :: !Text + , errorDocs :: ![Text] + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 5 }) ''ErrorMetadata) + +data StorageHasher + = Blake2_128 + | Blake2_256 + | Twox128 + | Twox256 + | Twox64Concat + deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON defaultOptions ''StorageHasher) + +data MapType = MapType + { mapHasher :: !StorageHasher + , mapKey :: !Type + , mapValue :: !Type + , mapLinked :: !Bool + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 3 }) ''MapType) + +data DoubleMapType = DoubleMapType + { doubleMapHasher :: !StorageHasher + , doubleMapKey1 :: !Type + , doubleMapKey2 :: !Type + , doubleMapValue :: !Type + , doubleMapKey2Hasher :: !StorageHasher + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 9 }) ''DoubleMapType) + +data StorageEntryType + = Plain !Type + | Map !MapType + | DoubleMap !DoubleMapType + deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { constructorTagModifier = over _head toLower, sumEncoding = ObjectWithSingleField }) ''StorageEntryType) + +data StorageEntryModifier = Optional | Default | Required + deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON defaultOptions ''StorageEntryModifier) + +data StorageEntryMetadata = StorageEntryMetadata + { entryName :: !Text + , entryModifier :: !StorageEntryModifier + , entryType :: !StorageEntryType + , entryFallback :: !HexString + , entryDocs :: ![Text] + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 5 }) ''StorageEntryMetadata) + +data StorageMetadata = StorageMetadata + { storagePrefix :: !Text + , storageItems :: ![StorageEntryMetadata] + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 7 }) ''StorageMetadata) + +data ModuleMetadata = ModuleMetadata + { moduleName :: !Text + , moduleStorage :: !(Maybe StorageMetadata) + , moduleCalls :: !(Maybe [FunctionMetadata]) + , moduleEvents :: !(Maybe [EventMetadata]) + , moduleConstants :: ![ModuleConstantMetadata] + , moduleErrors :: ![ErrorMetadata] + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 6 }) ''ModuleMetadata) + +data Metadata = Metadata + { modules :: ![ModuleMetadata] + } deriving (Eq, Show, Generic, GHC.Generic, Encode, Decode) + +$(deriveJSON defaultOptions ''Metadata) diff --git a/src/Network/Polkadot/Primitives.hs b/src/Network/Polkadot/Primitives.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Primitives.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +-- | +-- Module : Network.Polkadot.Primitives +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unportable +-- +-- Polkadot primitive data types. +-- + +module Network.Polkadot.Primitives where + +import Codec.Scale (Decode, Encode) +import Codec.Scale.Compact (Compact) +import Data.BigNum (H160, H256, H512, Word128) +import Data.ByteArray.HexString (HexString) +import Data.Word (Word32, Word64, Word8) +import qualified GHC.Generics as GHC (Generic) +import Generics.SOP (Generic) + +-- | The user account balance, 'u128' type. +type Balance = Word128 + +-- | Block numbers is up to 2^32. +type BlockNumber = Word32 + +-- | Time moment is 64bit. +type Moment = Word64 + +-- | Transaction nonce value. +type Index = Word32 + +-- | The type for looking up accounts. We don't expect more than 4 billion of them. +type AccountIndex = Word32 + +-- | The user account identifier type for the runtime. +type AccountId = H256 + +-- | The type for runtime hashes. +type Hash = H256 + +-- | Account balances. +data AccountData = AccountData + { balanceFree :: !Balance + , balanceReserved :: !Balance + , miscFrozen :: !Balance + , feeFrozen :: !Balance + } deriving (Eq, Ord, Show, GHC.Generic, Generic, Encode, Decode) + +-- | General account information. +data AccountInfo = AccountInfo + { accountNonce :: !Index + , accountConsumers :: !Word32 + , accountProviders :: !Word32 + , accountSufficients :: !Word32 + , accountData :: !AccountData + } deriving (Eq, Ord, Show, GHC.Generic, Generic, Encode, Decode) + +-- | Multiple signatures support type. +data MultiSignature + = Ed25519Signature !H512 + | Sr25519Signature !H512 + | EcdsaSignature !H512 !Word8 + deriving (Eq, Ord, Show, GHC.Generic, Generic, Encode, Decode) + +-- | Cryptographic key for any known crypto algorithm. +data MultiSigner + = Sr25519Signer + -- ^ sr25519 crypto has no support yet + | Ed25519Signer !H256 + -- ^ Ed25519 public key. + | EcdsaSigner !Word8 !H256 + -- ^ ECDSA public key. + deriving (Eq, Ord, GHC.Generic, Generic, Encode, Decode) + +-- | A multi-format address wrapper for on-chain accounts. +data MultiAddress + = MaId !AccountId + -- ^ It's an account ID (pubkey). + | MaIndex !(Compact AccountIndex) + -- ^ It's an account index. + | MaRaw !HexString + -- ^ It's some arbitrary raw bytes. + | MaAddress32 !H256 + -- ^ It's a 32 byte representation. + | MaAddress20 !H160 + -- ^ Its a 20 byte representation. + deriving (Eq, Ord, Show, GHC.Generic, Generic, Encode, Decode) diff --git a/src/Network/Polkadot/Query.hs b/src/Network/Polkadot/Query.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Query.hs @@ -0,0 +1,63 @@ +-- | +-- Module : Network.Polkadot.Query +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unportable +-- +-- Query storage for internal data. +-- + +module Network.Polkadot.Query where + +import Codec.Scale (Decode, decode) +import Data.ByteArray.HexString (HexString) +import Data.Text (Text) +import Network.JsonRpc.TinyClient (JsonRpc) + +import Network.Polkadot.Metadata (Metadata (Metadata), + metadataTypes, toLatest) +import Network.Polkadot.Rpc.State (getMetadata, getStorage) +import Network.Polkadot.Storage (Storage, fromMetadata, + storageKey) +import Network.Polkadot.Storage.Key (Argument) + +-- | Loads metadata from runtime and create storage type. +storage :: JsonRpc m => m (Either String Storage) +storage = (fmap go . decode) <$> getMetadata + where + go raw = let (meta, _) = metadataTypes raw in fromMetadata (toLatest meta) + +-- | Query data from blockchain via 'getStorage' RPC call. +query :: (JsonRpc m, Decode a) + => Text + -- ^ Module name. + -> Text + -- ^ Storage method name. + -> [Argument] + -- ^ Arguments (for mappings). + -> m (Either String a) + -- ^ Decoded storage item. +{-# INLINE query #-} +query = query' Nothing + +-- | Similar to 'query' but get block hash for query as an argument. +query' :: (JsonRpc m, Decode a) + => Maybe HexString + -- ^ Block hash for query ('Nothing' for best block). + -> Text + -- ^ Module name. + -> Text + -- ^ Storage method name. + -> [Argument] + -- ^ Arguments (for mappings). + -> m (Either String a) + -- ^ Decoded storage item. +query' blockHash section method args = go =<< storage + where + go (Right store) = case storageKey store section method args of + Just key -> decode <$> getStorage key blockHash + Nothing -> return (Left "Unable to find given section/method or wrong argument count") + go (Left err) = return (Left err) diff --git a/src/Network/Polkadot/Rpc/Account.hs b/src/Network/Polkadot/Rpc/Account.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Rpc/Account.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Network.Polkadot.Rpc.Account +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Polkadot RPC methods with `account` prefix. +-- + +module Network.Polkadot.Rpc.Account where + +import Data.Text (Text) +import Network.JsonRpc.TinyClient (JsonRpc (..)) + +-- | Retrieves the next accountIndex as available on the node. +nextIndex :: JsonRpc m + => Text + -- ^ AccountId + -> m Int +{-# INLINE nextIndex #-} +nextIndex = remote "account_nextIndex" diff --git a/src/Network/Polkadot/Rpc/Author.hs b/src/Network/Polkadot/Rpc/Author.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Rpc/Author.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Network.Polkadot.Rpc.Author +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Polkadot RPC methods with `author` prefix. +-- + +module Network.Polkadot.Rpc.Author where + +import Data.ByteArray.HexString (HexString) +import Data.Text (Text) +import Network.JsonRpc.TinyClient (JsonRpc (..)) + +-- | Returns true if the keystore has private keys for the given public key and key type. +hasKey :: JsonRpc m + => HexString + -- ^ Public key + -> Text + -- ^ Key type + -> m Bool +{-# INLINE hasKey #-} +hasKey = remote "author_hasKey" + +-- | Returns true if the keystore has private keys for the given session public keys. +hasSessionKeys :: JsonRpc m + => HexString + -- ^ Session keys + -> m Bool +{-# INLINE hasSessionKeys #-} +hasSessionKeys = remote "author_hasSessionKeys" + +-- | Insert a key into the keystore. +insertKey :: JsonRpc m + => Text + -- ^ Key type + -> Text + -- ^ Key secret URI + -> HexString + -- ^ Public key + -> m HexString +{-# INLINE insertKey #-} +insertKey = remote "author_insertKey" + +-- | Returns all pending extrinsics, potentially grouped by sender. +pendingExtrinsics :: JsonRpc m => m [HexString] +{-# INLINE pendingExtrinsics #-} +pendingExtrinsics = remote "author_pendingExtrinsics" + +-- | Remove given extrinsic from the pool and temporarily ban it to prevent reimporting. +removeExtrinsic :: JsonRpc m + => [HexString] + -- ^ Extrinsic or hash + -> m HexString +{-# INLINE removeExtrinsic #-} +removeExtrinsic = remote "author_removeExtrinsic" + +-- | Generate new session keys and returns the corresponding public keys. +rotateKeys :: JsonRpc m => m HexString +{-# INLINE rotateKeys #-} +rotateKeys = remote "author_rotateKeys" + +-- | Submit a fully formatted extrinsic for block inclusion. +submitExtrinsic :: JsonRpc m + => HexString + -- ^ Extrinsic + -> m HexString + -- ^ Hash +{-# INLINE submitExtrinsic #-} +submitExtrinsic = remote "author_submitExtrinsic" diff --git a/src/Network/Polkadot/Rpc/Babe.hs b/src/Network/Polkadot/Rpc/Babe.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Rpc/Babe.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Network.Polkadot.Rpc.Babe +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Polkadot RPC methods with `babe` prefix. +-- + +module Network.Polkadot.Rpc.Babe where + +import Data.Aeson (Object) +import Network.JsonRpc.TinyClient (JsonRpc (..)) + +-- | Returns data about which slots (primary or secondary) can be claimed +-- in the current epoch with the keys in the keystore. +epochAuthorship :: JsonRpc m => m Object +{-# INLINE epochAuthorship #-} +epochAuthorship = remote "babe_epochAuthorship" diff --git a/src/Network/Polkadot/Rpc/Chain.hs b/src/Network/Polkadot/Rpc/Chain.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Rpc/Chain.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Network.Polkadot.Rpc.Chain +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Polkadot RPC methods with `chain` prefix. +-- + +module Network.Polkadot.Rpc.Chain where + +import Data.ByteArray.HexString (HexString) +import Network.JsonRpc.TinyClient (JsonRpc (..)) + +import Network.Polkadot.Rpc.Types (Header, SignedBlock) + +-- | Get header and body of a relay chain block. +getBlock :: JsonRpc m + => Maybe HexString + -- ^ Block hash + -> m (Maybe SignedBlock) +{-# INLINE getBlock #-} +getBlock = remote "chain_getBlock" + +-- | Get the block hash for a specific block. +getBlockHash :: JsonRpc m + => Maybe Int + -- ^ Block number + -> m (Maybe HexString) +{-# INLINE getBlockHash #-} +getBlockHash = remote "chain_getBlockHash" + +-- | Get hash of the last finalized block in the canon chain. +getFinalizedHead :: JsonRpc m => m HexString +{-# INLINE getFinalizedHead #-} +getFinalizedHead = remote "chain_getFinalizedHead" + +-- | Retrieves the header for a specific block. +getHeader :: JsonRpc m + => Maybe HexString + -- ^ Block hash + -> m (Maybe Header) +{-# INLINE getHeader #-} +getHeader = remote "chain_getHeader" diff --git a/src/Network/Polkadot/Rpc/Childstate.hs b/src/Network/Polkadot/Rpc/Childstate.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Rpc/Childstate.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Network.Polkadot.Rpc.Childstate +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- 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 = remote "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 = remote "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 = remote "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 = remote "childstate_getStorageSize" diff --git a/src/Network/Polkadot/Rpc/Contracts.hs b/src/Network/Polkadot/Rpc/Contracts.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Rpc/Contracts.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Network.Polkadot.Rpc.Contracts +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Polkadot RPC methods with `contracts` prefix. +-- + +module Network.Polkadot.Rpc.Contracts where + +import Data.ByteArray.HexString (HexString) +import Data.Text (Text) +import Network.JsonRpc.TinyClient (JsonRpc (..)) + +import Network.Polkadot.Rpc.Types (ContractCall, ContractExecResult) + +-- | Executes a call to a contract. +call :: JsonRpc m + => ContractCall + -- ^ Contract call + -> Maybe HexString + -- ^ Block hash or nothing for head + -> m ContractExecResult +{-# INLINE call #-} +call = remote "contracts_call" + +-- | Returns the value under a specified storage key in a contract +getStorage :: JsonRpc m + => Text + -- ^ AccountId + -> HexString + -- ^ Storage key + -> Maybe HexString + -- ^ Block hash or nothing for head + -> m (Maybe HexString) +{-# INLINE getStorage #-} +getStorage = remote "contracts_getStorage" + +-- | Returns the projected time a given contract will be able to sustain paying its rent. +rentProjection :: JsonRpc m + => Text + -- ^ AccountId + -> Maybe HexString + -- ^ Block hash or nothing for head + -> m (Maybe Int) +{-# INLINE rentProjection #-} +rentProjection = remote "contracts_rentProjection" diff --git a/src/Network/Polkadot/Rpc/Engine.hs b/src/Network/Polkadot/Rpc/Engine.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Rpc/Engine.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Network.Polkadot.Rpc.Engine +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Polkadot RPC methods with `engine` prefix. +-- + +module Network.Polkadot.Rpc.Engine where + +import Data.ByteArray.HexString (HexString) +import Network.JsonRpc.TinyClient (JsonRpc (..)) + +import Network.Polkadot.Rpc.Types (CreatedBlock) + +-- | Instructs the manual-seal authorship task to create a new block. +createBlock :: JsonRpc m + => Bool + -- ^ Create empty + -> Bool + -- ^ Finalize + -> Maybe HexString + -- ^ Parent hash + -> m CreatedBlock +{-# INLINE createBlock #-} +createBlock = remote "engine_createBlock" + +-- | Instructs the manual-seal authorship task to finalize a block. +finalizeBlock :: JsonRpc m + => HexString + -- ^ Block hash + -> Maybe HexString + -- ^ Justification + -> m Bool +{-# INLINE finalizeBlock #-} +finalizeBlock = remote "engine_finalizeBlock" diff --git a/src/Network/Polkadot/Rpc/Grandpa.hs b/src/Network/Polkadot/Rpc/Grandpa.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Rpc/Grandpa.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Network.Polkadot.Rpc.Grandpa +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Polkadot RPC methods with `grandpa` prefix. +-- + +module Network.Polkadot.Rpc.Grandpa where + +import Data.Aeson (Object) +import Network.JsonRpc.TinyClient (JsonRpc (..)) + +-- | Returns the state of the current best round state as well as the ongoing background rounds. +roundState :: JsonRpc m => m Object +{-# INLINE roundState #-} +roundState = remote "grandpa_roundState" diff --git a/src/Network/Polkadot/Rpc/Offchain.hs b/src/Network/Polkadot/Rpc/Offchain.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Rpc/Offchain.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Network.Polkadot.Rpc.Offchain +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Polkadot RPC methods with `offchain` prefix. +-- + +module Network.Polkadot.Rpc.Offchain where + +import Data.ByteArray.HexString (HexString) +import Network.JsonRpc.TinyClient (JsonRpc (..)) + +import Network.Polkadot.Rpc.Types (StorageKind) + +-- | Get offchain local storage under given key and prefix. +localStorageGet :: JsonRpc m + => StorageKind + -- ^ Offchain storage kind + -> HexString + -- ^ Key + -> m (Maybe HexString) +{-# INLINE localStorageGet #-} +localStorageGet = remote "offchain_localStorageGet" + +-- | Set offchain local storage under given key and prefix +localStorageSet :: JsonRpc m + => StorageKind + -- ^ Offchain storage kind + -> HexString + -- ^ Key + -> HexString + -- ^ Value + -> m () +{-# INLINE localStorageSet #-} +localStorageSet = remote "offchain_localStorageSet" diff --git a/src/Network/Polkadot/Rpc/Payment.hs b/src/Network/Polkadot/Rpc/Payment.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Rpc/Payment.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Network.Polkadot.Rpc.Payment +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Polkadot RPC methods with `payment` prefix. +-- + +module Network.Polkadot.Rpc.Payment where + +import Data.ByteArray.HexString (HexString) +import Network.JsonRpc.TinyClient (JsonRpc (..)) + +import Network.Polkadot.Rpc.Types (RuntimeDispatchInfo) + +-- | Retrieves the fee information for an encoded extrinsic. +queryInfo :: JsonRpc m + => HexString + -- ^ Extrinsic + -> Maybe HexString + -- ^ Block hash or nothing for head block + -> m RuntimeDispatchInfo +{-# INLINE queryInfo #-} +queryInfo = remote "payment_queryInfo" diff --git a/src/Network/Polkadot/Rpc/Rpc.hs b/src/Network/Polkadot/Rpc/Rpc.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Rpc/Rpc.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Network.Polkadot.Rpc.Rpc +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Polkadot RPC methods with `rpc` prefix. +-- + +module Network.Polkadot.Rpc.Rpc where + +import Data.Aeson (Value) +import Network.JsonRpc.TinyClient (JsonRpc (..)) + +-- | Retrieves the list of RPC methods that are exposed by the node. +methods :: JsonRpc m => m Value +{-# INLINE methods #-} +methods = remote "rpc_methods" diff --git a/src/Network/Polkadot/Rpc/State.hs b/src/Network/Polkadot/Rpc/State.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Rpc/State.hs @@ -0,0 +1,184 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Network.Polkadot.Rpc.State +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- 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 = remote "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 = remote "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 = remote "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 = remote "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 = remote "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 = remote "state_getKeys" + +-- | Returns the runtime metadata. +getMetadata :: JsonRpc m => m HexString +{-# INLINE getMetadata #-} +getMetadata = remote "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 = remote "state_getReadProof" + +-- | Get runtime version. +getRuntimeVersion :: JsonRpc m + => Maybe HexString + -- ^ Block hash or nothing for head + -> m RuntimeVersion +{-# INLINE getRuntimeVersion #-} +getRuntimeVersion = remote "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 = remote "state_getStorage" + +-- | Retrieves the storage hash. +getStorageHash :: JsonRpc m + => HexString + -- ^ Key + -> Maybe HexString + -- ^ Block hash or nothing for head + -> m HexString +{-# INLINE getStorageHash #-} +getStorageHash = remote "state_getStorageHash" + +-- | Retrieves the storage size. +getStorageSize :: JsonRpc m + => HexString + -- ^ Key + -> Maybe HexString + -- ^ Block hash or nothing for head + -> m Int +{-# INLINE getStorageSize #-} +getStorageSize = remote "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 = remote "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 = remote "state_queryStorageAt" diff --git a/src/Network/Polkadot/Rpc/System.hs b/src/Network/Polkadot/Rpc/System.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Rpc/System.hs @@ -0,0 +1,97 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Network.Polkadot.Rpc.System +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Polkadot RPC methods with `system` prefix. +-- + +module Network.Polkadot.Rpc.System where + +import Data.Aeson (Object) +import Data.Text (Text) +import Network.JsonRpc.TinyClient (JsonRpc (..)) + +import Network.Polkadot.Rpc.Types (ChainType, Health, NodeRole, + PeerInfo) + +-- | Adds a reserved peer. +addReservedPeer :: JsonRpc m + => Text + -- ^ Peer URI + -> m Text +{-# INLINE addReservedPeer #-} +addReservedPeer = remote "system_addReservedPeer" + +-- | Retrieves the chain. +chain :: JsonRpc m => m Text +{-# INLINE chain #-} +chain = remote "system_chain" + +-- | Retrieves the chain type. +chainType :: JsonRpc m => m ChainType +{-# INLINE chainType #-} +chainType = remote "system_chainType" + +-- | Return health status of the node. +health :: JsonRpc m => m Health +{-# INLINE health #-} +health = remote "system_health" + +-- | The addresses include a trailing /p2p/ with the local PeerId, +-- and are thus suitable to be passed to addReservedPeer or as a bootnode address. +localListenAddresses :: JsonRpc m => m [Text] +{-# INLINE localListenAddresses #-} +localListenAddresses = remote "system_localListenAddresses" + +-- | Returns the base58-encoded PeerId of the node. +localPeerId :: JsonRpc m => m Text +{-# INLINE localPeerId #-} +localPeerId = remote "system_localPeerId" + +-- | Retrieves the node name. +name :: JsonRpc m => m Text +{-# INLINE name #-} +name = remote "system_name" + +-- | Returns current state of the network. +-- +-- Warning: This API isn't stable. +networkState :: JsonRpc m => m Object +{-# INLINE networkState #-} +networkState = remote "system_networkState" + +-- | Returns the roles the node is running as. +nodeRoles :: JsonRpc m => m [NodeRole] +{-# INLINE nodeRoles #-} +nodeRoles = remote "system_nodeRoles" + +-- | Returns the currently connected peers. +peers :: JsonRpc m => m [PeerInfo] +{-# INLINE peers #-} +peers = remote "system_peers" + +-- | Get a custom set of properties as a JSON object, defined in the chain spec. +properties :: JsonRpc m => m Object +{-# INLINE properties #-} +properties = remote "system_properties" + +-- | Remove a reserved peer. +removeReservedPeer :: JsonRpc m + => Text + -- ^ Peer URI + -> m Text +{-# INLINE removeReservedPeer #-} +removeReservedPeer = remote "system_removeReservedPeer" + +-- | Retrieves the version of the node. +version :: JsonRpc m => m Text +{-# INLINE version #-} +version = remote "system_version" diff --git a/src/Network/Polkadot/Rpc/Types.hs b/src/Network/Polkadot/Rpc/Types.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Rpc/Types.hs @@ -0,0 +1,289 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +-- | +-- Module : Network.Polkadot.Rpc.Types +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- 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 (Eq, Generic, Show) + +$(deriveJSON defaultOptions ''NodeRole) + +-- | Type op a chain. +data ChainType = Development + | Local + | Live + | Custom Text + deriving (Eq, Generic, Show) + +instance FromJSON ChainType where + parseJSON (String v) = return $ case v of + "Development" -> Development + "Local" -> Local + "Live" -> Live + custom_name -> Custom custom_name + parseJSON _ = fail "ChainType should be a JSON String" + +instance ToJSON ChainType where + toJSON (Custom v) = toJSON v + toJSON v = toJSON (show v) + +-- | System health struct returned by the RPC +data Health = Health + { healthPeers :: Int + -- ^ Number of connected peers. + , healthIsSyncing :: Bool + -- ^ Is the node syncing. + , healthShouldHavePeers :: Bool + -- ^ Should this node have any peers. + } + deriving (Eq, Generic, Show) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 6 }) ''Health) + +-- | Network Peer information. +data PeerInfo = PeerInfo + { peerInfoPeerId :: Text + -- ^ Peer ID + , peerInfoRoles :: [NodeRole] + -- ^ Roles + , peerInfoProtocolVersion :: Int + -- ^ Protocol version. + , peerInfoBestHash :: Text + -- ^ Peer best block hash + , peerInfoBestNumber :: Int + -- ^ Peer best block number + } + deriving (Eq, Generic, Show) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 8 }) ''PeerInfo) + +-- | Executes a call to a contract. +data ContractCall = ContractCall + { callOrigin :: HexString + , callDest :: HexString + , callValue :: Integer + , callGasLimit :: Integer + , callInputData :: HexString + } + deriving (Eq, Generic, Show) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 4 }) ''ContractCall) + +-- | A result of execution of a contract. +data ContractExecResult = SuccessExec + { execStatus :: Word8 + -- ^ Status code returned by contract. + , execData :: Maybe HexString + -- ^ Output data returned by contract. Can be empty. + } + | ExecResultError + deriving (Eq, Generic, Show) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 4 }) ''ContractExecResult) + +-- | ReadProof struct returned by RPC. +data ReadProof = ReadProof + { readProofAt :: HexString + -- ^ Block hash used to generate the proof. + , readProofProof :: [HexString] + -- ^ A proof used to prove that storage entries are included in the storage trie. + } + deriving (Eq, Generic, 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 + { runtimeSpecName :: Text + -- ^ Identifies the different Substrate runtimes. + , runtimeImplName :: Text + -- ^ Name of the implementation of the spec. + , runtimeAuthoringVersion :: Word32 + -- ^ `authoring_version` is the version of the authorship interface. + , runtimeSpecVersion :: Word32 + -- ^ Version of the runtime specification. + , runtimeImplVersion :: Word32 + -- ^ Version of the implementation of the specification. + , runtimeApis :: [(HexString, Word32)] + -- ^ List of supported API "features" along with their versions. + , runtimeTransactionVersion :: Word32 + -- ^ All existing dispatches are fully compatible when this number doesn't change. + } + deriving (Eq, Generic, 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 + { storageBlock :: HexString + -- ^ Block hash. + , 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 (Eq, Generic, Show) + +$(deriveJSON defaultOptions ''DispatchClass) + +-- | Some information related to a dispatchable that can be queried from the runtime. +data RuntimeDispatchInfo = RuntimeDispatchInfo + { dispatchWeight :: Weight + -- ^ Weight of this dispatch. + , dispatchClass :: DispatchClass + -- ^ Class of this dispatch. + , dispatchPartialFee :: Integer + -- ^ The partial inclusion fee of this dispatch. + } + deriving (Eq, Generic, Show) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 8 }) ''RuntimeDispatchInfo) + +-- | Auxiliary data associated with an imported block result. +data ImportedAux = ImportedAux + { auxHeaderOnly :: Bool + -- ^ Only the header has been imported. Block body verification was skipped. + , auxClearJustificationRequests :: Bool + -- ^ Clear all pending justification requests. + , auxNeedsJustification :: Bool + -- ^ Request a justification for the given block. + , auxBadJustification :: Bool + -- ^ Received a bad justification. + , auxNeedsFinalityProof :: Bool + -- ^ Request a finality proof for the given block. + , auxIsNewBest :: Bool + -- ^ Whether the block that was imported is the new best block. + } + deriving (Eq, Generic, Show) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 3 }) ''ImportedAux) + +data CreatedBlock = CreatedBlock + { createdBlockHash :: HexString + , createdBlockAux :: ImportedAux + } + deriving (Eq, Generic, Show) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 12 }) ''CreatedBlock) + +-- | Generic header digest. +data Digest = Digest + { digestLogs :: ![HexString] + -- ^ A list of logs in the digest. + } + deriving (Eq, Generic, Show) + +-- | Hex-encoded block number. +newtype BlockNumber = BlockNumber { unBlockNumber :: Integer } + deriving (Eq, Ord, Show) + +instance FromJSON BlockNumber where + parseJSON = fmap (BlockNumber . fst . head . readHex . drop 2) . parseJSON + +instance ToJSON BlockNumber where + toJSON = toJSON . ("0x" <>) . flip showHex "" . unBlockNumber + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 6 }) ''Digest) + +-- | Abstraction over a block header for a substrate chain. +data Header = Header + { headerParentHash :: HexString + -- ^ The parent hash. + , headerNumber :: BlockNumber + -- ^ The block number. + , headerStateRoot :: HexString + -- ^ The state trie merkle root + , headerExtrinsicsRoot :: HexString + -- ^ The merkle root of the extrinsics. + , headerDigest :: Digest + -- ^ A chain-specific digest of data useful for light clients or referencing auxiliary data. + } + deriving (Eq, Generic, Show) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 6 }) ''Header) + +-- | Abstraction over a substrate block. +data Block = Block + { blockHeader :: !Header + -- ^ The block header. + , blockExtrinsics :: ![HexString] + -- ^ The accompanying extrinsics. + } + deriving (Eq, Generic, Show) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 5 }) ''Block) + +-- | Abstraction over a substrate block and justification. +data SignedBlock = SignedBlock + { signedBlock :: !Block + -- ^ Full block. + , signedJustification :: !(Maybe HexString) + -- ^ Block justification. + } + deriving (Eq, Generic, Show) + +$(deriveJSON (defaultOptions + { fieldLabelModifier = over _head toLower . drop 6 }) ''SignedBlock) diff --git a/src/Network/Polkadot/Storage.hs b/src/Network/Polkadot/Storage.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Storage.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE RecordWildCards #-} + +-- | +-- Module : Network.Polkadot.Storage +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- 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 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 Text.AnimalCase (toCamelCase) + +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 = Map.fromList . mapMaybe go . modules + where + toLowerFirst = uncurry T.cons . (toLower . T.head &&& T.tail) + go ModuleMetadata{..} = do + StorageMetadata prefix items <- moduleStorage + let section = toCamelCase moduleName + toEntry meta@StorageEntryMetadata{..} = + (toLowerFirst entryName, newEntry prefix meta) + return (toLowerFirst section, Map.fromList $ fmap toEntry 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 store section method args = convert <$> do + entry <- Map.lookup method =<< Map.lookup section store + case entry of + PlainEntry x -> Just x + MapEntry f -> case args of + [a] -> Just (f a) + _ -> Nothing + DoubleMapEntry f -> case args of + [a, b] -> Just (f a b) + _ -> Nothing diff --git a/src/Network/Polkadot/Storage/Key.hs b/src/Network/Polkadot/Storage/Key.hs new file mode 100644 --- /dev/null +++ b/src/Network/Polkadot/Storage/Key.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RecordWildCards #-} + +-- | +-- Module : Network.Polkadot.Storage.Key +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- 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 arg = case arg of Argument a -> put 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 (PlainEntry _) = "PlainEntry" + show (MapEntry _) = "MapEntry" + show (DoubleMapEntry _) = "DoubleMapEntry" + show (NMapEntry _) = "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 prefix meta = case entryType meta of + Plain _ -> PlainEntry plainKey + Map MapType{..} -> MapEntry (mapCodec mapHasher) + DoubleMap DoubleMapType{..} -> DoubleMapEntry (dMapCodec doubleMapHasher doubleMapKey2Hasher) + NMap NMapType{..} -> NMapEntry undefined -- TODO + where + method = entryName 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 = xxhash 128 (encodeUtf8 prefix) <> xxhash 128 (encodeUtf8 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 h1 arg1 = plainKey <> getHasher h1 arg1 + dMapCodec h1 h2 arg1 arg2 = mapCodec h1 arg1 <> getHasher h2 arg2 + +getHasher :: StorageHasher -> Hasher +getHasher Blake2_128 = blake2_128 . encode +getHasher Blake2_256 = blake2_256 . encode +getHasher Blake2_128Concat = uncurry (<>) . (blake2_128 &&& id) . encode +getHasher Twox128 = xxhash 128 . encode +getHasher Twox256 = xxhash 256 . encode +getHasher Twox64Concat = uncurry (<>) . (xxhash 64 &&& id) . encode +getHasher Identity = encode diff --git a/tests/Network/Polkadot/Test/AccountSpec.hs b/tests/Network/Polkadot/Test/AccountSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Network/Polkadot/Test/AccountSpec.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + +-- | +-- Module : Network.Polkadot.Test.AccountSpec +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unportable +-- +-- + +module Network.Polkadot.Test.AccountSpec where + +import Data.ByteArray.HexString.TH (hex) +import Test.Hspec + +import Network.Polkadot.Account +import Network.Polkadot.Crypto + +spec :: Spec +spec = parallel $ do + let alice :: Ecdsa + Right alice = from_seed [hex|0x8beef718111d62174809fc2b332c14471f6038404c5cee7b33ac2573ba60ed06|] + let bob :: Ed25519 + Right bob = from_seed [hex|0xbd4e72a17a76b43ab59e7733cd0818d47c2e0ebcf88bfc5fb0192c8ee520c7d1|] + + describe "Public" $ do + it "Ecdsa" $ + show (public alice) `shouldBe` "(2,0xc96289d7426111e7ec5cbb90d7d201ab0b3d7ab17166826ae4ff27cb0c6d3f23)" + it "Ed25519" $ + show (public bob) `shouldBe` "0x8a016b9a1ca3709974ed7b1e1c79d6ed0f795899d212edc189cdb31318fec607" + + describe "Ss58Codec" $ do + it "Ecdsa" $ + to_ss58check (into_account $ multi_signer alice) + `shouldBe` "5EWfGfxVbLK2upe3Zfcqo9ZtALArwLgxkwcZaT3gMujmmFxU" + it "Ed25519" $ + to_ss58check (into_account $ multi_signer bob) + `shouldBe` "5FBetQhjRiJMfqqMU3f4cz8ho4majAPLzuZSdmxwxPtQTZ8V" diff --git a/tests/Network/Polkadot/Test/ExtrinsicSpec.hs b/tests/Network/Polkadot/Test/ExtrinsicSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Network/Polkadot/Test/ExtrinsicSpec.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + +-- | +-- Module : Network.Polkadot.Test.ExtrinsicSpec +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unportable +-- +-- + +module Network.Polkadot.Test.ExtrinsicSpec where + +import Codec.Scale (Compact (..), decode) +import Data.ByteArray.HexString.TH (hex) +import Test.Hspec + +import Network.Polkadot.Extrinsic.Era (Era (..), new_mortal_compact) + +spec :: Spec +spec = parallel $ do + describe "Era" $ do + it "decodes an Extrinsic Era with immortal" $ + decode [hex|0x00|] `shouldBe` Right ImmortalEra + + it "creates from an actual valid era" $ + new_mortal_compact 0xc503 `shouldBe` MortalEra 64 60 + + it "creates for an actual era (2)" $ + new_mortal_compact 0x8502 `shouldBe` MortalEra 64 40 + + it "creates form an actual era (3)" $ + new_mortal_compact 0x6502 `shouldBe` MortalEra 64 38 + + it "creates from a actual 100 block hash count" $ + new_mortal_compact 0xd607 `shouldBe` MortalEra 128 125 + + it "creates from a actual 2400 block hash count" $ + new_mortal_compact 0x9be3 `shouldBe` MortalEra 4096 3641 diff --git a/tests/Network/Polkadot/Test/MetadataSpec.hs b/tests/Network/Polkadot/Test/MetadataSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Network/Polkadot/Test/MetadataSpec.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + +-- | +-- Module : Network.Polkadot.Test.MetadataSpec +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unportable +-- +-- Polkadot metadata tests ported from: +-- https://github.com/polkadot-js/api/tree/master/packages/metadata/src/Metadata +-- + +module Network.Polkadot.Test.MetadataSpec where + +import Codec.Scale (decode, encode) +import Data.Aeson (eitherDecodeFileStrict, + parseJSON, toJSON) +import Data.ByteArray.HexString (HexString) +import Data.ByteArray.HexString.TH (hexFrom) +import Test.Hspec +import Test.Hspec.Expectations.Json (shouldBeJson) + +import Network.Polkadot.Metadata (Metadata, metadataTypes) +import Network.Polkadot.Metadata.MagicNumber (MagicNumber (..)) + +spec :: Spec +spec = parallel $ do + describe "MagicNumber codec" $ do + let empty_metadata = "0x6d65746109" :: HexString + wrong_version = "0x6d657461ff" :: HexString + wrong_magic = "0x6d64746110" :: HexString + + it "succeeds when the magic number matches" $ + let magic = decode empty_metadata + in magic `shouldBe` Right MagicNumber + + it "fails when the magic number mismatches" $ + let error_str = decode wrong_magic :: Either String Metadata + in error_str `shouldBe` Left "Failed reading: Bad magic number\nEmpty call stack\n" + + it "fails when version out of scope" $ + let error_str = decode wrong_version :: Either String Metadata + in error_str `shouldBe` Left "Failed reading: index out of enum constructors count: 241\nEmpty call stack\n" + + describe "Metadata V9" $ do + it "succeeds decode from hex and json" $ do + let (Right hex) = decode [hexFrom|tests/meta/v9.hex|] :: Either String Metadata + (meta, _) = metadataTypes hex + Right json <- eitherDecodeFileStrict "tests/meta/v9.json" + toJSON meta `shouldBeJson` json + + describe "Metadata V10" $ do + it "succeeds decode from hex and json" $ do + let (Right hex) = decode [hexFrom|tests/meta/v10.hex|] :: Either String Metadata + (meta, _) = metadataTypes hex + Right json <- eitherDecodeFileStrict "tests/meta/v10.json" + toJSON meta `shouldBeJson` json + +{- + describe "Metadata V12" $ do + it "succeeds decode from hex and json" $ do + let (Right hex) = decode [hexFrom|tests/meta/v12.hex|] :: Either String Metadata + (meta, _) = metadataTypes hex + Right json <- eitherDecodeFileStrict "tests/meta/v12.json" + toJSON meta `shouldBeJson` json + + describe "Metadata V13" $ do + it "succeeds decode from hex and json" $ do + let (Right hex) = decode [hexFrom|tests/meta/v13.hex|] :: Either String Metadata + (meta, _) = metadataTypes hex + Right json <- eitherDecodeFileStrict "tests/meta/v13.json" + toJSON meta `shouldBeJson` json +-} diff --git a/tests/Network/Polkadot/Test/StorageSpec.hs b/tests/Network/Polkadot/Test/StorageSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Network/Polkadot/Test/StorageSpec.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + +-- | +-- Module : Network.Polkadot.Test.StorageSpec +-- Copyright : Aleksandr Krupenkin 2016-2021 +-- License : Apache-2.0 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unportable +-- +-- + +module Network.Polkadot.Test.StorageSpec where + +import Codec.Scale (decode) +import Data.ByteArray.HexString.TH (hexFrom) +import Test.Hspec + +import Network.Polkadot.Metadata (Metadata, metadataTypes, toLatest) +import Network.Polkadot.Storage (fromMetadata) + +spec :: Spec +spec = parallel $ do + describe "Metadata Storage" $ do + it "decode and parse storage entries" $ do + let (Right hex) = decode [hexFrom|tests/meta/v13.hex|] :: Either String Metadata + (meta, _) = metadataTypes hex + show (fromMetadata (toLatest meta)) `shouldBe` "fromList [(\"assets\",fromList [(\"account\",DoubleMapEntry),(\"approvals\",NMapEntry),(\"asset\",MapEntry),(\"metadata\",MapEntry)]),(\"authorship\",fromList [(\"author\",PlainEntry),(\"didSetUncles\",PlainEntry),(\"uncles\",PlainEntry)]),(\"babe\",fromList [(\"authorVrfRandomness\",PlainEntry),(\"authorities\",PlainEntry),(\"currentSlot\",PlainEntry),(\"epochConfig\",PlainEntry),(\"epochIndex\",PlainEntry),(\"epochStart\",PlainEntry),(\"genesisSlot\",PlainEntry),(\"initialized\",PlainEntry),(\"lateness\",PlainEntry),(\"nextAuthorities\",PlainEntry),(\"nextEpochConfig\",PlainEntry),(\"nextRandomness\",PlainEntry),(\"pendingEpochConfigChange\",PlainEntry),(\"randomness\",PlainEntry),(\"segmentIndex\",PlainEntry),(\"underConstruction\",MapEntry)]),(\"balances\",fromList [(\"account\",MapEntry),(\"locks\",MapEntry),(\"reserves\",MapEntry),(\"storageVersion\",PlainEntry),(\"totalIssuance\",PlainEntry)]),(\"bounties\",fromList [(\"bounties\",MapEntry),(\"bountyApprovals\",PlainEntry),(\"bountyCount\",PlainEntry),(\"bountyDescriptions\",MapEntry)]),(\"contracts\",fromList [(\"accountCounter\",PlainEntry),(\"codeStorage\",MapEntry),(\"contractInfoOf\",MapEntry),(\"deletionQueue\",PlainEntry),(\"pristineCode\",MapEntry)]),(\"council\",fromList [(\"members\",PlainEntry),(\"prime\",PlainEntry),(\"proposalCount\",PlainEntry),(\"proposalOf\",MapEntry),(\"proposals\",PlainEntry),(\"voting\",MapEntry)]),(\"democracy\",fromList [(\"blacklist\",MapEntry),(\"cancellations\",MapEntry),(\"depositOf\",MapEntry),(\"lastTabledWasExternal\",PlainEntry),(\"locks\",MapEntry),(\"lowestUnbaked\",PlainEntry),(\"nextExternal\",PlainEntry),(\"preimages\",MapEntry),(\"publicPropCount\",PlainEntry),(\"publicProps\",PlainEntry),(\"referendumCount\",PlainEntry),(\"referendumInfoOf\",MapEntry),(\"storageVersion\",PlainEntry),(\"votingOf\",MapEntry)]),(\"electionProviderMultiPhase\",fromList [(\"currentPhase\",PlainEntry),(\"desiredTargets\",PlainEntry),(\"minimumUntrustedScore\",PlainEntry),(\"queuedSolution\",PlainEntry),(\"round\",PlainEntry),(\"signedSubmissionIndices\",PlainEntry),(\"signedSubmissionNextIndex\",PlainEntry),(\"signedSubmissionsMap\",MapEntry),(\"snapshot\",PlainEntry),(\"snapshotMetadata\",PlainEntry)]),(\"elections\",fromList [(\"candidates\",PlainEntry),(\"electionRounds\",PlainEntry),(\"members\",PlainEntry),(\"runnersUp\",PlainEntry),(\"voting\",MapEntry)]),(\"gilt\",fromList [(\"active\",MapEntry),(\"activeTotal\",PlainEntry),(\"queueTotals\",PlainEntry),(\"queues\",MapEntry)]),(\"grandpa\",fromList [(\"currentSetId\",PlainEntry),(\"nextForced\",PlainEntry),(\"pendingChange\",PlainEntry),(\"setIdSession\",MapEntry),(\"stalled\",PlainEntry),(\"state\",PlainEntry)]),(\"identity\",fromList [(\"identityOf\",MapEntry),(\"registrars\",PlainEntry),(\"subsOf\",MapEntry),(\"superOf\",MapEntry)]),(\"imOnline\",fromList [(\"authoredBlocks\",DoubleMapEntry),(\"heartbeatAfter\",PlainEntry),(\"keys\",PlainEntry),(\"receivedHeartbeats\",DoubleMapEntry)]),(\"indices\",fromList [(\"accounts\",MapEntry)]),(\"lottery\",fromList [(\"callIndices\",PlainEntry),(\"lottery\",PlainEntry),(\"lotteryIndex\",PlainEntry),(\"participants\",MapEntry),(\"tickets\",MapEntry),(\"ticketsCount\",PlainEntry)]),(\"mmr\",fromList [(\"nodes\",MapEntry),(\"numberOfLeaves\",PlainEntry),(\"rootHash\",PlainEntry)]),(\"multisig\",fromList [(\"calls\",MapEntry),(\"multisigs\",DoubleMapEntry)]),(\"offences\",fromList [(\"concurrentReportsIndex\",DoubleMapEntry),(\"reports\",MapEntry),(\"reportsByKindIndex\",MapEntry)]),(\"proxy\",fromList [(\"announcements\",MapEntry),(\"proxies\",MapEntry)]),(\"randomnessCollectiveFlip\",fromList [(\"randomMaterial\",PlainEntry)]),(\"recovery\",fromList [(\"activeRecoveries\",DoubleMapEntry),(\"proxy\",MapEntry),(\"recoverable\",MapEntry)]),(\"scheduler\",fromList [(\"agenda\",MapEntry),(\"lookup\",MapEntry),(\"storageVersion\",PlainEntry)]),(\"session\",fromList [(\"currentIndex\",PlainEntry),(\"disabledValidators\",PlainEntry),(\"keyOwner\",MapEntry),(\"nextKeys\",MapEntry),(\"queuedChanged\",PlainEntry),(\"queuedKeys\",PlainEntry),(\"validators\",PlainEntry)]),(\"society\",fromList [(\"bids\",PlainEntry),(\"candidates\",PlainEntry),(\"defender\",PlainEntry),(\"defenderVotes\",MapEntry),(\"founder\",PlainEntry),(\"head\",PlainEntry),(\"maxMembers\",PlainEntry),(\"members\",PlainEntry),(\"payouts\",MapEntry),(\"pot\",PlainEntry),(\"rules\",PlainEntry),(\"strikes\",MapEntry),(\"suspendedCandidates\",MapEntry),(\"suspendedMembers\",MapEntry),(\"votes\",DoubleMapEntry),(\"vouching\",MapEntry)]),(\"staking\",fromList [(\"activeEra\",PlainEntry),(\"bonded\",MapEntry),(\"bondedEras\",PlainEntry),(\"canceledSlashPayout\",PlainEntry),(\"chillThreshold\",PlainEntry),(\"counterForNominators\",PlainEntry),(\"counterForValidators\",PlainEntry),(\"currentEra\",PlainEntry),(\"currentPlannedSession\",PlainEntry),(\"earliestUnappliedSlash\",PlainEntry),(\"erasRewardPoints\",MapEntry),(\"erasStakers\",DoubleMapEntry),(\"erasStakersClipped\",DoubleMapEntry),(\"erasStartSessionIndex\",MapEntry),(\"erasTotalStake\",MapEntry),(\"erasValidatorPrefs\",DoubleMapEntry),(\"erasValidatorReward\",MapEntry),(\"forceEra\",PlainEntry),(\"historyDepth\",PlainEntry),(\"invulnerables\",PlainEntry),(\"ledger\",MapEntry),(\"maxNominatorsCount\",PlainEntry),(\"maxValidatorsCount\",PlainEntry),(\"minNominatorBond\",PlainEntry),(\"minValidatorBond\",PlainEntry),(\"minimumValidatorCount\",PlainEntry),(\"nominatorSlashInEra\",DoubleMapEntry),(\"nominators\",MapEntry),(\"payee\",MapEntry),(\"slashRewardFraction\",PlainEntry),(\"slashingSpans\",MapEntry),(\"spanSlash\",MapEntry),(\"storageVersion\",PlainEntry),(\"unappliedSlashes\",MapEntry),(\"validatorCount\",PlainEntry),(\"validatorSlashInEra\",DoubleMapEntry),(\"validators\",MapEntry)]),(\"sudo\",fromList [(\"key\",PlainEntry)]),(\"system\",fromList [(\"account\",MapEntry),(\"allExtrinsicsLen\",PlainEntry),(\"blockHash\",MapEntry),(\"blockWeight\",PlainEntry),(\"digest\",PlainEntry),(\"eventCount\",PlainEntry),(\"eventTopics\",MapEntry),(\"events\",PlainEntry),(\"executionPhase\",PlainEntry),(\"extrinsicCount\",PlainEntry),(\"extrinsicData\",MapEntry),(\"lastRuntimeUpgrade\",PlainEntry),(\"number\",PlainEntry),(\"parentHash\",PlainEntry),(\"upgradedToTripleRefCount\",PlainEntry),(\"upgradedToU32RefCount\",PlainEntry)]),(\"technicalCommittee\",fromList [(\"members\",PlainEntry),(\"prime\",PlainEntry),(\"proposalCount\",PlainEntry),(\"proposalOf\",MapEntry),(\"proposals\",PlainEntry),(\"voting\",MapEntry)]),(\"technicalMembership\",fromList [(\"members\",PlainEntry),(\"prime\",PlainEntry)]),(\"timestamp\",fromList [(\"didUpdate\",PlainEntry),(\"now\",PlainEntry)]),(\"tips\",fromList [(\"reasons\",MapEntry),(\"tips\",MapEntry)]),(\"transactionPayment\",fromList [(\"nextFeeMultiplier\",PlainEntry),(\"storageVersion\",PlainEntry)]),(\"transactionStorage\",fromList [(\"blockTransactions\",PlainEntry),(\"byteFee\",PlainEntry),(\"chunkCount\",MapEntry),(\"entryFee\",PlainEntry),(\"maxBlockTransactions\",PlainEntry),(\"maxTransactionSize\",PlainEntry),(\"proofChecked\",PlainEntry),(\"storagePeriod\",PlainEntry),(\"transactions\",MapEntry)]),(\"treasury\",fromList [(\"approvals\",PlainEntry),(\"proposalCount\",PlainEntry),(\"proposals\",MapEntry)]),(\"uniques\",fromList [(\"account\",NMapEntry),(\"asset\",DoubleMapEntry),(\"attribute\",NMapEntry),(\"class\",MapEntry),(\"classMetadataOf\",MapEntry),(\"instanceMetadataOf\",DoubleMapEntry)]),(\"vesting\",fromList [(\"vesting\",MapEntry)])]" diff --git a/tests/Spec.hs b/tests/Spec.hs new file mode 100644 --- /dev/null +++ b/tests/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/web3-polkadot.cabal b/web3-polkadot.cabal new file mode 100644 --- /dev/null +++ b/web3-polkadot.cabal @@ -0,0 +1,188 @@ +cabal-version: 1.12 +name: web3-polkadot +version: 1.0.0.0 +license: Apache-2.0 +license-file: LICENSE +copyright: (c) Aleksandr Krupenkin 2016-2021 +maintainer: mail@akru.me +author: Aleksandr Krupenkin +homepage: https://github.com/airalab/hs-web3#readme +bug-reports: https://github.com/airalab/hs-web3/issues +synopsis: Polkadot support for Haskell Web3 library. +description: Client library for Third Generation of Web. +category: Network +build-type: Simple + +source-repository head + type: git + location: https://github.com/airalab/hs-web3 + +library + exposed-modules: + Network.Polkadot + Network.Polkadot.Account + Network.Polkadot.Call + Network.Polkadot.Crypto + Network.Polkadot.Extrinsic + Network.Polkadot.Extrinsic.Era + Network.Polkadot.Extrinsic.Payload + Network.Polkadot.Extrinsic.SignedExtension + Network.Polkadot.Extrinsic.SignedExtension.System + Network.Polkadot.Extrinsic.SignedExtension.TransactionPayment + Network.Polkadot.Extrinsic.Unchecked + Network.Polkadot.Metadata + Network.Polkadot.Metadata.MagicNumber + Network.Polkadot.Metadata.Type + Network.Polkadot.Metadata.Type.Ast + Network.Polkadot.Metadata.Type.Discovery + Network.Polkadot.Metadata.Type.Parser + Network.Polkadot.Metadata.Type.ParserCombinators + Network.Polkadot.Metadata.V10 + Network.Polkadot.Metadata.V11 + Network.Polkadot.Metadata.V12 + Network.Polkadot.Metadata.V13 + Network.Polkadot.Metadata.V9 + Network.Polkadot.Primitives + Network.Polkadot.Query + Network.Polkadot.Rpc.Account + Network.Polkadot.Rpc.Author + Network.Polkadot.Rpc.Babe + Network.Polkadot.Rpc.Chain + Network.Polkadot.Rpc.Childstate + Network.Polkadot.Rpc.Contracts + Network.Polkadot.Rpc.Engine + Network.Polkadot.Rpc.Grandpa + Network.Polkadot.Rpc.Offchain + Network.Polkadot.Rpc.Payment + Network.Polkadot.Rpc.Rpc + Network.Polkadot.Rpc.State + Network.Polkadot.Rpc.System + Network.Polkadot.Rpc.Types + Network.Polkadot.Storage + Network.Polkadot.Storage.Key + + hs-source-dirs: src + other-modules: Paths_web3_polkadot + default-language: Haskell2010 + ghc-options: + -funbox-strict-fields -Wduplicate-exports -Whi-shadowing + -Widentities -Woverlapping-patterns -Wpartial-type-signatures + -Wunrecognised-pragmas -Wtyped-holes -Wincomplete-patterns + -Wincomplete-uni-patterns -Wmissing-fields -Wmissing-methods + -Wmissing-exported-signatures -Wmissing-monadfail-instances + -Wmissing-signatures -Wname-shadowing -Wunused-binds + -Wunused-top-binds -Wunused-local-binds -Wunused-pattern-binds + -Wunused-imports -Wunused-matches -Wunused-foralls -Wtabs + + build-depends: + aeson >1.2 && <1.6, + animalcase >0.1 && <0.2, + base >4.11 && <4.15, + base58-bytestring ==0.1.*, + bytestring >0.10 && <0.11, + containers >0.6 && <0.7, + cryptonite >0.22 && <0.30, + generics-sop >0.3 && <0.6, + jsonrpc-tinyclient ==1.0.*, + memory >0.14 && <0.16, + memory-hexstring ==1.0.*, + microlens >0.4 && <0.5, + microlens-mtl >0.2 && <0.3, + microlens-th >0.4 && <0.5, + mtl >2.2 && <2.3, + parsec >3.0 && <3.2, + scale ==1.0.*, + text >1.2 && <1.3, + web3-bignum ==1.0.*, + web3-crypto ==1.0.* + +test-suite tests + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: tests src + other-modules: + Network.Polkadot.Test.AccountSpec + Network.Polkadot.Test.ExtrinsicSpec + Network.Polkadot.Test.MetadataSpec + Network.Polkadot.Test.StorageSpec + Network.Polkadot + Network.Polkadot.Account + Network.Polkadot.Call + Network.Polkadot.Crypto + Network.Polkadot.Extrinsic + Network.Polkadot.Extrinsic.Era + Network.Polkadot.Extrinsic.Payload + Network.Polkadot.Extrinsic.SignedExtension + Network.Polkadot.Extrinsic.SignedExtension.System + Network.Polkadot.Extrinsic.SignedExtension.TransactionPayment + Network.Polkadot.Extrinsic.Unchecked + Network.Polkadot.Metadata + Network.Polkadot.Metadata.MagicNumber + Network.Polkadot.Metadata.Type + Network.Polkadot.Metadata.Type.Ast + Network.Polkadot.Metadata.Type.Discovery + Network.Polkadot.Metadata.Type.Parser + Network.Polkadot.Metadata.Type.ParserCombinators + Network.Polkadot.Metadata.V10 + Network.Polkadot.Metadata.V11 + Network.Polkadot.Metadata.V12 + Network.Polkadot.Metadata.V13 + Network.Polkadot.Metadata.V9 + Network.Polkadot.Primitives + Network.Polkadot.Query + Network.Polkadot.Rpc.Account + Network.Polkadot.Rpc.Author + Network.Polkadot.Rpc.Babe + Network.Polkadot.Rpc.Chain + Network.Polkadot.Rpc.Childstate + Network.Polkadot.Rpc.Contracts + Network.Polkadot.Rpc.Engine + Network.Polkadot.Rpc.Grandpa + Network.Polkadot.Rpc.Offchain + Network.Polkadot.Rpc.Payment + Network.Polkadot.Rpc.Rpc + Network.Polkadot.Rpc.State + Network.Polkadot.Rpc.System + Network.Polkadot.Rpc.Types + Network.Polkadot.Storage + Network.Polkadot.Storage.Key + Paths_web3_polkadot + + default-language: Haskell2010 + ghc-options: + -funbox-strict-fields -Wduplicate-exports -Whi-shadowing + -Widentities -Woverlapping-patterns -Wpartial-type-signatures + -Wunrecognised-pragmas -Wtyped-holes -Wincomplete-patterns + -Wincomplete-uni-patterns -Wmissing-fields -Wmissing-methods + -Wmissing-exported-signatures -Wmissing-monadfail-instances + -Wmissing-signatures -Wname-shadowing -Wunused-binds + -Wunused-top-binds -Wunused-local-binds -Wunused-pattern-binds + -Wunused-imports -Wunused-matches -Wunused-foralls -Wtabs -threaded + -rtsopts -with-rtsopts=-N + + build-depends: + aeson >1.2 && <1.6, + animalcase >0.1 && <0.2, + base >4.11 && <4.15, + base58-bytestring ==0.1.*, + bytestring >0.10 && <0.11, + containers >0.6 && <0.7, + cryptonite >0.22 && <0.30, + generics-sop >0.3 && <0.6, + hspec >=2.4.4 && <2.8, + hspec-contrib >=0.4.0 && <0.6, + hspec-discover >=2.4.4 && <2.8, + hspec-expectations >=0.8.2 && <0.9, + hspec-expectations-json >=1.0.0 && <1.1, + jsonrpc-tinyclient ==1.0.*, + memory >0.14 && <0.16, + memory-hexstring ==1.0.*, + microlens >0.4 && <0.5, + microlens-mtl >0.2 && <0.3, + microlens-th >0.4 && <0.5, + mtl >2.2 && <2.3, + parsec >3.0 && <3.2, + scale ==1.0.*, + text >1.2 && <1.3, + web3-bignum ==1.0.*, + web3-crypto ==1.0.*