web3 0.8.4.0 → 0.9.0.0

raw patch · 80 files changed

+4593/−1236 lines, 80 filesdep +attoparsecdep +base58stringdep +errorsdep ~hspecPVP ok

version bump matches the API change (PVP)

Dependencies added: attoparsec, base58string, errors, http-media, http-types, network, servant, servant-client, tar, unordered-containers, websockets

Dependency ranges changed: hspec

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−0
• README.md +5/−4
• examples/polkadot/Main.hs +24/−0
• examples/token/Main.hs +2/−1
• src/Crypto/Ecdsa/Signature.hs +97/−0
• src/Crypto/Ecdsa/Utils.hs +46/−0
• src/Crypto/Ethereum.hs +5/−4
• src/Crypto/Ethereum/Keyfile.hs +19/−12
• src/Crypto/Ethereum/Signature.hs +11/−84
• src/Crypto/Ethereum/Utils.hs +6/−38
• src/Data/Solidity/Prim/Address.hs +4/−3
• src/Network/Ethereum.hs +32/−0
• src/Network/Ethereum/Account/Default.hs +2/−2
• src/Network/Ethereum/Account/LocalKey.hs +2/−2
• src/Network/Ethereum/Account/Personal.hs +2/−2
• src/Network/Ethereum/Api/Provider.hs +0/−86
• src/Network/Ethereum/Contract/Event/Common.hs +24/−27
• src/Network/Ethereum/Contract/Event/MultiFilter.hs +57/−80
• src/Network/Ethereum/Contract/Event/SingleFilter.hs +42/−64
• src/Network/Ethereum/Contract/TH.hs +1/−1
• src/Network/Ethereum/Web3.hs +0/−44
• src/Network/Ipfs/Api/Bitswap.hs +41/−0
• src/Network/Ipfs/Api/Block.hs +39/−0
• src/Network/Ipfs/Api/Bootstrap.hs +34/−0
• src/Network/Ipfs/Api/Cid.hs +44/−0
• src/Network/Ipfs/Api/Config.hs +40/−0
• src/Network/Ipfs/Api/Core.hs +88/−0
• src/Network/Ipfs/Api/Dag.hs +40/−0
• src/Network/Ipfs/Api/Dht.hs +41/−0
• src/Network/Ipfs/Api/Files.hs +74/−0
• src/Network/Ipfs/Api/Internal.hs +100/−0
• src/Network/Ipfs/Api/Internal/Call.hs +58/−0
• src/Network/Ipfs/Api/Internal/Stream.hs +41/−0
• src/Network/Ipfs/Api/Key.hs +48/−0
• src/Network/Ipfs/Api/Log.hs +42/−0
• src/Network/Ipfs/Api/Object.hs +81/−0
• src/Network/Ipfs/Api/Pin.hs +29/−0
• src/Network/Ipfs/Api/Pubsub.hs +39/−0
• src/Network/Ipfs/Api/Repo.hs +37/−0
• src/Network/Ipfs/Api/Stats.hs +28/−0
• src/Network/Ipfs/Api/Swarm.hs +49/−0
• src/Network/Ipfs/Api/Types.hs +823/−0
• src/Network/Ipfs/Api/Types/Stream.hs +154/−0
• src/Network/Ipfs/Client.hs +47/−0
• src/Network/JsonRpc/TinyClient.hs +39/−27
• src/Network/Polkadot/Api/Account.hs +28/−0
• src/Network/Polkadot/Api/Author.hs +78/−0
• src/Network/Polkadot/Api/Babe.hs +26/−0
• src/Network/Polkadot/Api/Chain.hs +49/−0
• src/Network/Polkadot/Api/Childstate.hs +69/−0
• src/Network/Polkadot/Api/Contracts.hs +54/−0
• src/Network/Polkadot/Api/Engine.hs +42/−0
• src/Network/Polkadot/Api/Grandpa.hs +26/−0
• src/Network/Polkadot/Api/Offchain.hs +42/−0
• src/Network/Polkadot/Api/Payment.hs +30/−0
• src/Network/Polkadot/Api/Rpc.hs +25/−0
• src/Network/Polkadot/Api/State.hs +184/−0
• src/Network/Polkadot/Api/System.hs +97/−0
• src/Network/Polkadot/Api/Types.hs +270/−0
• src/Network/Web3.hs +20/−0
• src/Network/Web3/Provider.hs +132/−0
• stack.yaml +1/−2
• test/Network/Ethereum/Test/ComplexStorageSpec.hs +151/−0
• test/Network/Ethereum/Test/ERC20Spec.hs +36/−0
• test/Network/Ethereum/Test/LinearizationSpec.hs +193/−0
• test/Network/Ethereum/Test/LocalAccountSpec.hs +51/−0
• test/Network/Ethereum/Test/RegistrySpec.hs +33/−0
• test/Network/Ethereum/Test/SimpleStorageSpec.hs +202/−0
• test/Network/Ethereum/Test/Utils.hs +80/−0
• test/Network/Ethereum/Web3/Test/ComplexStorageSpec.hs +0/−152
• test/Network/Ethereum/Web3/Test/ERC20Spec.hs +0/−24
• test/Network/Ethereum/Web3/Test/LinearizationSpec.hs +0/−189
• test/Network/Ethereum/Web3/Test/LocalAccountSpec.hs +0/−52
• test/Network/Ethereum/Web3/Test/RegistrySpec.hs +0/−32
• test/Network/Ethereum/Web3/Test/SimpleStorageSpec.hs +0/−203
• test/Network/Ethereum/Web3/Test/Utils.hs +0/−81
• test/Network/Ipfs/Api/Test/Key.hs +47/−0
• unit/Crypto/Ethereum/Test/SignatureSpec.hs +1/−1
• unit/Data/Solidity/Test/AddressSpec.hs +1/−1
• web3.cabal +174/−18

@@ -1,6 +1,20 @@ # Changelog All notable changes to this project will be documented in this file. +## [0.9.0.0] 2020-05-24+### Added+- Experimental IPFS REST API client+- Experimental Polkadot JSON-RPC API client++### Changed+- Web3 abstraction moved to `Network.Web3`+- Ethereum entry point renamed `Network.Ethereum.Web3` -> `Network.Ethereum`+- Split from common ECDSA staff from `Crypto.Ethereum` to `Crypto.Ecdsa`+- Ethereum related tests moved to `Network.Ethereum.Test`++### Removed+- Support for build on LTS-11, LTS-12, LTS-13+ ## [0.8.4.0] 2020-05-03 ### Added - Tuple support for `pragma experimental ABIEncoderV2`

@@ -1,7 +1,7 @@-Ethereum API for Haskell-========================+Web3 API for Haskell+==================== -The Haskell Ethereum API which implements the [Generic JSON RPC](https://github.com/ethereum/wiki/wiki/JSON-RPC).+This library implements Haskell API client for popular Web3 platforms.  [![Documentation Status](https://readthedocs.org/projects/hs-web3/badge/?version=latest)](https://hs-web3.readthedocs.io/en/latest/?badge=latest) [![Build Status](https://travis-ci.org/airalab/hs-web3.svg?branch=master)](https://travis-ci.org/airalab/hs-web3)@@ -25,7 +25,8 @@ module Main where  -- Basic imports-import           Network.Ethereum.Web3+import           Network.Ethereum+import           Network.Web3  -- Eth API support import qualified Network.Ethereum.Api.Eth   as Eth

@@ -0,0 +1,24 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import           Control.Monad.IO.Class      (liftIO)++import qualified Network.Polkadot.Api.Chain  as Chain+import qualified Network.Polkadot.Api.State  as State+import qualified Network.Polkadot.Api.System as System+import           Network.Web3.Provider       (Provider (..), runWeb3')++main :: IO ()+main = do+    result <- runWeb3' (WsProvider "127.0.0.1" 9944) $ do+        name <- System.name+        liftIO . putStrLn $ "System name: " ++ show name++        best <- Chain.getBlockHash Nothing+        liftIO . putStrLn $ "Best hash: " ++ show best++        State.getRuntimeVersion best++    case result of+      Left err      -> error (show err)+      Right version -> putStrLn (show version)

@@ -6,8 +6,9 @@ import           Text.Printf              (printf)  import           Lens.Micro               ((.~))+import           Network.Ethereum         hiding (name) import           Network.Ethereum.Account-import           Network.Ethereum.Web3    hiding (name)+import           Network.Web3  import           ERC20 

@@ -0,0 +1,97 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      :  Crypto.Ecdsa.Signature+-- Copyright   :  Alexander Krupenkin 2018+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- Recoverable ECC signature support.+--++module Crypto.Ecdsa.Signature+    (+      sign+    , pack+    , unpack+    ) where++import           Control.Monad               (when)+import           Crypto.Hash                 (SHA256)+import           Crypto.Number.Generate      (generateBetween)+import           Crypto.Number.ModArithmetic (inverse)+import           Crypto.Number.Serialize     (i2osp, os2ip)+import           Crypto.PubKey.ECC.ECDSA     (PrivateKey (..))+import           Crypto.PubKey.ECC.Prim      (pointMul)+import           Crypto.PubKey.ECC.Types     (CurveCommon (ecc_g, ecc_n),+                                              Point (..), common_curve)+import           Crypto.Random               (MonadRandom, withDRG)+import           Crypto.Random.HmacDrbg      (HmacDrbg, initialize)+import           Data.Bits                   (xor, (.|.))+import           Data.ByteArray              (ByteArray, ByteArrayAccess, Bytes,+                                              convert, singleton, takeView,+                                              view)+import qualified Data.ByteArray              as BA (unpack)+import           Data.Monoid                 ((<>))+import           Data.Word                   (Word8)++import           Crypto.Ecdsa.Utils          (exportKey)++-- | Sign arbitrary data by given private key.+--+-- /WARNING:/ Vulnerable to timing attacks.+sign :: ByteArrayAccess bin+     => PrivateKey+     -> bin+     -> (Integer, Integer, Word8)+sign pk bin = fst $ withDRG hmac_drbg $ ecsign pk (os2ip truncated)+  where+    hmac_drbg :: HmacDrbg SHA256+    hmac_drbg = initialize $ exportKey pk <> truncated+    truncated = convert $ takeView bin 32 :: Bytes++ecsign :: MonadRandom m+       => PrivateKey+       -> Integer+       -> m (Integer, Integer, Word8)+ecsign pk@(PrivateKey curve d) z = do+    k <- generateBetween 0 (n - 1)+    case trySign k of+        Nothing  -> ecsign pk z+        Just rsv -> return rsv+  where+    n = ecc_n (common_curve curve)+    g = ecc_g (common_curve curve)+    recoveryParam x y r = fromIntegral $+        fromEnum (odd y) .|. if x /= r then 2 else 0+    trySign k = do+        (kpX, kpY) <- case pointMul curve k g of+            PointO    -> Nothing+            Point x y -> return (x, y)+        let r = kpX `mod` n+        kInv <- inverse k n+        let s = kInv * (z + r * d) `mod` n+        when (r == 0 || s == 0) Nothing+        -- Recovery param+        let v = recoveryParam kpX kpY r+        -- Use complement of s if it > n / 2+        let (s', v') | s > n `div` 2 = (n - s, v `xor` 1)+                     | otherwise = (s, v)+        return $ (r, s', v' + 27)++-- | Unpack recoverable signature from byte array.+--+-- Input array should have 65 byte length.+unpack :: ByteArrayAccess rsv => rsv -> (Integer, Integer, Word8)+unpack vrs = (r, s, v)+  where+    r = os2ip (view vrs 1 33)+    s = os2ip (view vrs 33 65)+    v = head (BA.unpack vrs)++-- | Pack recoverable signature as byte array (65 byte length).+pack :: ByteArray rsv => (Integer, Integer, Word8) -> rsv+pack (r, s, v) = i2osp r <> i2osp s <> singleton v

@@ -0,0 +1,46 @@+-- |+-- Module      :  Crypto.Ecdsa.Utils+-- Copyright   :  Alexander Krupenkin 2018+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- ECDSA module helper functions.+--++module Crypto.Ecdsa.Utils where++import           Crypto.Number.Serialize    (i2osp, os2ip)+import           Crypto.PubKey.ECC.ECDSA    (PrivateKey (..), PublicKey (..))+import           Crypto.PubKey.ECC.Generate (generateQ)+import           Crypto.PubKey.ECC.Types    (CurveName (SEC_p256k1), Point (..),+                                             getCurveByName)+import           Data.ByteArray             (ByteArray, ByteArrayAccess)+import           Data.Monoid                ((<>))++-- | Import ECDSA private key from byte array.+--+-- Input array should have 32 byte length.+importKey :: ByteArrayAccess privateKey => privateKey -> PrivateKey+{-# INLINE importKey #-}+importKey = PrivateKey (getCurveByName SEC_p256k1) . os2ip++-- | Export private key to byte array (32 byte length).+exportKey :: ByteArray privateKey => PrivateKey -> privateKey+{-# INLINE exportKey #-}+exportKey (PrivateKey _ key) = i2osp key++-- | Get public key appropriate to private key.+--+-- /WARNING:/ Vulnerable to timing attacks.+derivePubKey :: PrivateKey -> PublicKey+{-# INLINE derivePubKey #-}+derivePubKey (PrivateKey curve p) = PublicKey curve (generateQ curve p)++-- | Export public key to byte array (64 byte length).+exportPubKey :: ByteArray publicKey => PublicKey -> publicKey+{-# INLINE exportPubKey #-}+exportPubKey (PublicKey _ (Point x y)) = i2osp x <> i2osp y+exportPubKey (PublicKey _ PointO)      = mempty

@@ -7,12 +7,12 @@ -- Stability   :  experimental -- Portability :  unportable ----- Ethereum ECC support module.+-- Ethereum cryptography primitives. --  module Crypto.Ethereum     (-    -- * Ethereum crypto key ops+    -- * ECDSA crypto key ops       PrivateKey     , PublicKey     , importKey@@ -22,9 +22,10 @@     , signMessage      -- * Hash function-    , sha3+    , keccak256     ) where +import           Crypto.Ecdsa.Utils        (derivePubKey, importKey) import           Crypto.Ethereum.Signature (signMessage)-import           Crypto.Ethereum.Utils     (derivePubKey, importKey, sha3)+import           Crypto.Ethereum.Utils     (keccak256) import           Crypto.PubKey.ECC.ECDSA   (PrivateKey, PublicKey)

@@ -10,7 +10,7 @@ -- Stability   :  experimental -- Portability :  portable ----- Web3 Secret Storage implementation.+-- Ethereum Secret Storage implementation. -- Spec https://github.com/ethereum/wiki/wiki/Web3-Secret-Storage-Definition. -- @@ -44,25 +44,32 @@ import           Data.UUID.Types          (UUID) import           Data.UUID.Types.Internal (buildFromBytes) -import           Crypto.Ethereum.Utils    (sha3)+import           Crypto.Ethereum.Utils    (keccak256) import           Data.ByteArray.HexString (HexString)  -- | Key derivation function parameters and salt. data Kdf = Pbkdf2 !Pbkdf2.Parameters !HexString-         | Scrypt !Scrypt.Parameters !HexString+    | Scrypt !Scrypt.Parameters !HexString  -- | Cipher parameters. data Cipher = Aes128Ctr-    { cipherIv :: !(IV AES128), cipherText :: !HexString }+    { cipherIv   :: !(IV AES128)+    , cipherText :: !HexString+    }  -- | Secret Storage representation on memory. data EncryptedKey = EncryptedKey-  { encryptedKeyId      :: !UUID        -- ^ Random key ID-  , encryptedKeyVersion :: !Int         -- ^ Version (suppoted version 3 only)-  , encryptedKeyCipher  :: !Cipher      -- ^ Cipher (supported AES-128-CTR only)-  , encryptedKeyKdf     :: !Kdf         -- ^ Key derivation function-  , encryptedKeyMac     :: !HexString   -- ^ MAC-  }+    { encryptedKeyId      :: !UUID+    -- ^ Random key ID+    , encryptedKeyVersion :: !Int+    -- ^ Version (suppoted version 3 only)+    , encryptedKeyCipher  :: !Cipher+    -- ^ Cipher (supported AES-128-CTR only)+    , encryptedKeyKdf     :: !Kdf+    -- ^ Key derivation function+    , encryptedKeyMac     :: !HexString+    -- ^ MAC+    }  instance Eq EncryptedKey where     a == b = encryptedKeyId a == encryptedKeyId b@@ -195,7 +202,7 @@     cipher = throwCryptoError $ cipherInit (BA.take 16 derivedKey) :: AES128     derivedKey = deriveKey encryptedKeyKdf password     ciphertext = cipherText encryptedKeyCipher-    mac = sha3 (BA.drop 16 derivedKey <> ciphertext)+    mac = keccak256 (BA.drop 16 derivedKey <> ciphertext)     iv  = cipherIv encryptedKeyCipher  -- | Encrypt Ethereum private key.@@ -213,7 +220,7 @@     let derivedKey = deriveKey kdf password         cipher = throwCryptoError $ cipherInit (BA.take 16 derivedKey) :: AES128         ciphertext = ctrCombine cipher iv privateKey-        mac = sha3 (BA.drop 16 derivedKey <> ciphertext)+        mac = keccak256 (BA.drop 16 derivedKey <> ciphertext)     uuid <- randomUUID     return $ EncryptedKey uuid 3 (Aes128Ctr iv $ convert ciphertext) kdf mac   where

@@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-}  -- |--- Module      :  Crypto.Ethereum+-- Module      :  Crypto.Ecdsa.Signature -- Copyright   :  Alexander Krupenkin 2018 -- License     :  BSD3 --@@ -9,7 +9,7 @@ -- Stability   :  experimental -- Portability :  portable ----- Recoverable ECC signature support.+-- Recoverable Ethereum signature support. --  module Crypto.Ethereum.Signature@@ -17,35 +17,18 @@       hashMessage     , signMessage     , signTransaction-    , pack-    , unpack     ) where -import           Control.Monad               (when)-import           Crypto.Hash                 (Digest, Keccak_256 (..), SHA256,-                                              hashWith)-import           Crypto.Number.Generate      (generateBetween)-import           Crypto.Number.ModArithmetic (inverse)-import           Crypto.Number.Serialize     (i2osp, os2ip)-import           Crypto.PubKey.ECC.ECDSA     (PrivateKey (..))-import           Crypto.PubKey.ECC.Prim      (pointMul)-import           Crypto.PubKey.ECC.Types     (CurveCommon (ecc_g, ecc_n),-                                              Point (..), common_curve)-import           Crypto.Random               (MonadRandom, withDRG)-import           Crypto.Random.HmacDrbg      (HmacDrbg, initialize)-import           Data.Bits                   (xor, (.|.))-import           Data.ByteArray              (ByteArray, ByteArrayAccess,-                                              convert, singleton, takeView,-                                              view)-import qualified Data.ByteArray              as BA (length, unpack)-import           Data.ByteString.Builder     (intDec, toLazyByteString)-import qualified Data.ByteString.Lazy        as LBS (toStrict)-import           Data.Monoid                 ((<>))-import           Data.Word                   (Word8)+import           Crypto.Hash             (Digest, Keccak_256 (..), hashWith)+import           Crypto.PubKey.ECC.ECDSA (PrivateKey (..))+import           Data.ByteArray          (ByteArray, ByteArrayAccess, convert)+import qualified Data.ByteArray          as BA (length)+import           Data.ByteString.Builder (intDec, toLazyByteString)+import qualified Data.ByteString.Lazy    as LBS (toStrict)+import           Data.Monoid             ((<>))+import           Data.Word               (Word8) -import           Crypto.Ethereum.Utils       (exportKey)-import           Data.ByteArray.HexString    (HexString)-import           Data.Solidity.Prim.Address  (Address)+import           Crypto.Ecdsa.Signature  (pack, sign)  -- | Make Ethereum standard signature. --@@ -84,59 +67,3 @@   where     unsigned = encode Nothing     signed = sign key (hashWith Keccak_256 unsigned)---- | Sign arbitrary data by given private key.------ /WARNING:/ Vulnerable to timing attacks.-sign :: ByteArrayAccess bin-     => PrivateKey-     -> bin-     -> (Integer, Integer, Word8)-sign pk bin = fst $ withDRG hmac_drbg $ ecsign pk (os2ip truncated)-  where-    hmac_drbg :: HmacDrbg SHA256-    hmac_drbg = initialize $ exportKey pk <> truncated-    truncated = convert $ takeView bin 32 :: HexString--ecsign :: MonadRandom m-       => PrivateKey-       -> Integer-       -> m (Integer, Integer, Word8)-ecsign pk@(PrivateKey curve d) z = do-    k <- generateBetween 0 (n - 1)-    case trySign k of-        Nothing  -> ecsign pk z-        Just rsv -> return rsv-  where-    n = ecc_n (common_curve curve)-    g = ecc_g (common_curve curve)-    recoveryParam x y r = fromIntegral $-        fromEnum (odd y) .|. if x /= r then 2 else 0-    trySign k = do-        (kpX, kpY) <- case pointMul curve k g of-            PointO    -> Nothing-            Point x y -> return (x, y)-        let r = kpX `mod` n-        kInv <- inverse k n-        let s = kInv * (z + r * d) `mod` n-        when (r == 0 || s == 0) Nothing-        -- Recovery param-        let v = recoveryParam kpX kpY r-        -- Use complement of s if it > n / 2-        let (s', v') | s > n `div` 2 = (n - s, v `xor` 1)-                     | otherwise = (s, v)-        return $ (r, s', v' + 27)---- | Unpack recoverable signature from byte array.------ Input array should have 65 byte length.-unpack :: ByteArrayAccess rsv => rsv -> (Integer, Integer, Word8)-unpack vrs = (r, s, v)-  where-    r = os2ip (view vrs 1 33)-    s = os2ip (view vrs 33 65)-    v = head (BA.unpack vrs)---- | Pack recoverable signature as byte array (65 byte length).-pack :: ByteArray rsv => (Integer, Integer, Word8) -> rsv-pack (r, s, v) = i2osp r <> i2osp s <> singleton v

@@ -7,47 +7,15 @@ -- Stability   :  experimental -- Portability :  portable ----- EC cryptography on Secp256k1 curve.+-- Ethereum crypto module helper functions. --  module Crypto.Ethereum.Utils where -import           Crypto.Hash                (Keccak_256 (..), hashWith)-import           Crypto.Number.Serialize    (i2osp, os2ip)-import           Crypto.PubKey.ECC.ECDSA    (PrivateKey (..), PublicKey (..))-import           Crypto.PubKey.ECC.Generate (generateQ)-import           Crypto.PubKey.ECC.Types    (CurveName (SEC_p256k1), Point (..),-                                             getCurveByName)-import           Data.ByteArray             (ByteArray, ByteArrayAccess,-                                             convert)-import           Data.Monoid                ((<>))---- | Import Ethereum private key from byte array.------ Input array should have 32 byte length.-importKey :: ByteArrayAccess privateKey => privateKey -> PrivateKey-{-# INLINE importKey #-}-importKey = PrivateKey (getCurveByName SEC_p256k1) . os2ip---- | Export private key to byte array (32 byte length).-exportKey :: ByteArray privateKey => PrivateKey -> privateKey-{-# INLINE exportKey #-}-exportKey (PrivateKey _ key) = i2osp key---- | Get public key appropriate to private key.------ /WARNING:/ Vulnerable to timing attacks.-derivePubKey :: PrivateKey -> PublicKey-{-# INLINE derivePubKey #-}-derivePubKey (PrivateKey curve p) = PublicKey curve (generateQ curve p)---- | Export public key to byte array (64 byte length).-exportPubKey :: ByteArray publicKey => PublicKey -> publicKey-{-# INLINE exportPubKey #-}-exportPubKey (PublicKey _ (Point x y)) = i2osp x <> i2osp y-exportPubKey (PublicKey _ PointO)      = mempty+import           Crypto.Hash    (Keccak_256 (..), hashWith)+import           Data.ByteArray (ByteArray, ByteArrayAccess, convert)  -- | Keccak 256 hash function.-sha3 :: (ByteArrayAccess bin, ByteArray bout) => bin -> bout-{-# INLINE sha3 #-}-sha3 = convert . hashWith Keccak_256+keccak256 :: (ByteArrayAccess bin, ByteArray bout) => bin -> bout+{-# INLINE keccak256 #-}+keccak256 = convert . hashWith Keccak_256

@@ -49,7 +49,8 @@ import           Generics.SOP             (Generic) import qualified GHC.Generics             as GHC (Generic) -import           Crypto.Ethereum.Utils    (exportPubKey, sha3)+import           Crypto.Ecdsa.Utils       (exportPubKey)+import           Crypto.Ethereum.Utils    (keccak256) import           Data.ByteArray.HexString (HexString, fromBytes, toBytes,                                            toText) import           Data.Solidity.Abi        (AbiGet (..), AbiPut (..),@@ -95,7 +96,7 @@         Left e  -> error $ "Impossible error: " ++ e   where     toAddress :: HexString -> HexString-    toAddress = BA.drop 12 . sha3+    toAddress = BA.drop 12 . keccak256  -- | Decode address from hex string fromHexString :: HexString -> Either String Address@@ -113,7 +114,7 @@ toChecksum :: ByteString -> ByteString toChecksum addr = ("0x" <>) . C8.pack $ zipWith ($) upcaseVector lower   where-    upcaseVector = (>>= fourthBits) . BS.unpack . BS.take 20 $ sha3 (C8.pack lower)+    upcaseVector = (>>= fourthBits) . BS.unpack . BS.take 20 $ keccak256 (C8.pack lower)     fourthBits n = bool id C.toUpper <$> [n .&. 0x80 /= 0, n .&. 0x08 /= 0]     lower = drop 2 . fmap C.toLower . C8.unpack $ addr 

@@ -0,0 +1,32 @@+-- |+-- Module      :  Network.Ethereum+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unportable+--+-- TODO+--++module Network.Ethereum+    (+    -- * Basic transaction sending+      module Account++    -- * Basic EVM event listening+    , EventAction(..)+    , event++    -- * Primitive Solidity data types+    , module Prim++    -- * Metric unit system+    , module Unit+    ) where++import           Data.Solidity.Prim              as Prim+import           Network.Ethereum.Account        as Account+import           Network.Ethereum.Contract.Event (EventAction (..), event)+import           Network.Ethereum.Unit           as Unit

@@ -17,6 +17,7 @@  module Network.Ethereum.Account.Default where +import           Control.Exception                 (TypeError (..)) import           Control.Monad.Catch               (throwM) import           Control.Monad.State.Strict        (get, runStateT) import           Control.Monad.Trans               (MonadTrans (..))@@ -34,7 +35,6 @@ import qualified Network.Ethereum.Api.Eth          as Eth (accounts, call,                                                            estimateGas,                                                            sendTransaction)-import           Network.Ethereum.Api.Provider     (Web3Error (ParserFail)) import           Network.Ethereum.Api.Types        (Call (callData, callFrom, callGas)) import           Network.Ethereum.Contract.Method  (Method (..)) @@ -71,4 +71,4 @@             Eth.call params _block         case decode res of             Right r -> return r-            Left e  -> lift $ throwM (ParserFail e)+            Left e  -> lift (throwM $ TypeError e)

@@ -19,6 +19,7 @@  module Network.Ethereum.Account.LocalKey where +import           Control.Exception                 (TypeError (..)) import           Control.Monad.Catch               (throwM) import           Control.Monad.State.Strict        (get, runStateT) import           Control.Monad.Trans               (lift)@@ -41,7 +42,6 @@ import qualified Network.Ethereum.Api.Eth          as Eth (call, estimateGas,                                                            getTransactionCount,                                                            sendRawTransaction)-import           Network.Ethereum.Api.Provider     (Web3Error (ParserFail)) import           Network.Ethereum.Api.Types        (Call (..)) import           Network.Ethereum.Chain            (foundation) import           Network.Ethereum.Contract.Method  (selector)@@ -95,4 +95,4 @@         res <- lift $ Eth.call params _block         case decode res of             Right r -> return r-            Left e  -> lift $ throwM (ParserFail e)+            Left e  -> lift (throwM $ TypeError e)

@@ -19,6 +19,7 @@  module Network.Ethereum.Account.Personal where +import           Control.Exception                 (TypeError (..)) import           Control.Monad.Catch               (throwM) import           Control.Monad.State.Strict        (get, runStateT) import           Control.Monad.Trans               (lift)@@ -37,7 +38,6 @@ import qualified Network.Ethereum.Api.Eth          as Eth (call, estimateGas) import           Network.Ethereum.Api.Personal     (Passphrase) import qualified Network.Ethereum.Api.Personal     as Personal (sendTransaction)-import           Network.Ethereum.Api.Provider     (Web3Error (ParserFail)) import           Network.Ethereum.Api.Types        (Call (callData, callFrom, callGas)) import           Network.Ethereum.Contract.Method  (selector) @@ -83,4 +83,4 @@                 res <- lift $ Eth.call params block                 case decode res of                     Right r -> return r-                    Left e  -> lift $ throwM (ParserFail e)+                    Left e  -> lift (throwM $ TypeError e)

@@ -1,86 +0,0 @@-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}---- |--- Module      :  Network.Ethereum.Api.Provider--- Copyright   :  Alexander Krupenkin 2016-2018--- License     :  BSD3------ Maintainer  :  mail@akru.me--- Stability   :  experimental--- Portability :  portable------ Web3 service provider.-----module Network.Ethereum.Api.Provider where--import           Control.Concurrent.Async   (Async, async)-import           Control.Exception          (Exception, try)-import           Control.Monad.Catch        (MonadThrow)-import           Control.Monad.IO.Class     (MonadIO (..))-import           Control.Monad.State        (MonadState (..))-import           Control.Monad.Trans.State  (StateT, evalStateT)-import           Data.Default               (Default (..))-import           GHC.Generics               (Generic)-import           Lens.Micro.Mtl             ((.=))-import           Network.HTTP.Client        (Manager)--import           Network.JsonRpc.TinyClient (JsonRpc, JsonRpcClient,-                                             defaultSettings, jsonRpcManager)---- | Any communication with Ethereum node wrapped with 'Web3' monad-newtype Web3 a = Web3 { unWeb3 :: StateT JsonRpcClient IO a }-    deriving (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadState JsonRpcClient)--instance JsonRpc Web3---- | Some peace of error response-data Web3Error-  = JsonRpcFail !String-  -- ^ JSON-RPC communication error-  | ParserFail  !String-  -- ^ Error in parser state-  | UserFail    !String-  -- ^ Common head for user errors-  deriving (Show, Eq, Generic)--instance Exception Web3Error----TODO: Change to `HttpProvider ServerUri | IpcProvider FilePath` to support IPC--- | Web3 Provider-data Provider = HttpProvider String-  deriving (Show, Eq, Generic)--instance Default Provider where-  def = HttpProvider "http://localhost:8545"---- | 'Web3' monad runner, using the supplied Manager-runWeb3With :: MonadIO m-            => Manager-            -> Provider-            -> Web3 a-            -> m (Either Web3Error a)-runWeb3With manager provider f =-    runWeb3' provider $ jsonRpcManager .= manager >> f---- | 'Web3' monad runner-runWeb3' :: MonadIO m-         => Provider-         -> Web3 a-         -> m (Either Web3Error a)-runWeb3' (HttpProvider uri) f = do-    cfg <- defaultSettings uri-    liftIO . try . flip evalStateT cfg . unWeb3 $ f---- | 'Web3' runner for default provider-runWeb3 :: MonadIO m-        => Web3 a-        -> m (Either Web3Error a)-{-# INLINE runWeb3 #-}-runWeb3 = runWeb3' def---- | Fork 'Web3' with the same 'Provider' and 'Manager'-forkWeb3 :: Web3 a -> Web3 (Async a)-forkWeb3 f = liftIO . async . evalStateT (unWeb3 f) =<< get

@@ -21,31 +21,30 @@  module Network.Ethereum.Contract.Event.Common  where -import           Control.Concurrent            (threadDelay)-import           Control.Exception             (Exception, throwIO)-import           Control.Monad.IO.Class        (liftIO)-import           Data.Either                   (lefts, rights)+import           Control.Concurrent         (threadDelay)+import           Control.Exception          (Exception, throwIO)+import           Control.Monad.IO.Class     (liftIO)+import           Data.Either                (lefts, rights) -import           Data.Solidity.Event           (DecodeEvent (..))-import qualified Network.Ethereum.Api.Eth      as Eth-import           Network.Ethereum.Api.Provider (Web3)-import           Network.Ethereum.Api.Types    (Change (..), DefaultBlock (..),-                                                Filter (..), Quantity)+import           Data.Solidity.Event        (DecodeEvent (..))+import qualified Network.Ethereum.Api.Eth   as Eth+import           Network.Ethereum.Api.Types (Change (..), DefaultBlock (..),+                                             Filter (..), Quantity)+import           Network.JsonRpc.TinyClient (JsonRpc (..))  -- | Event callback control response data EventAction = ContinueEvent-                 -- ^ Continue to listen events-                 | TerminateEvent-                 -- ^ Terminate event listener-  deriving (Show, Eq)+    | TerminateEvent+    deriving (Show, Eq)  -data FilterChange a =-  FilterChange { filterChangeRawChange :: Change-               , filterChangeEvent     :: a-               }+data FilterChange a = FilterChange+    { filterChangeRawChange :: Change+    , filterChangeEvent     :: a+    } -data EventParseFailure = EventParseFailure String deriving (Show)+data EventParseFailure = EventParseFailure String+    deriving (Show)  instance Exception EventParseFailure @@ -59,24 +58,22 @@   in if ls /= [] then throwIO (EventParseFailure $ show ls) else pure rs  -data FilterStreamState e =-  FilterStreamState { fssCurrentBlock  :: Quantity-                    , fssInitialFilter :: Filter e-                    , fssWindowSize    :: Integer-                    }+data FilterStreamState e = FilterStreamState+    { fssCurrentBlock  :: Quantity+    , fssInitialFilter :: Filter e+    , fssWindowSize    :: Integer+    }   -- | Coerce a 'DefaultBlock' into a numerical block number.-mkBlockNumber :: DefaultBlock -> Web3 Quantity+mkBlockNumber :: JsonRpc m => DefaultBlock -> m Quantity mkBlockNumber bm = case bm of   BlockWithNumber bn -> return bn   Earliest           -> return 0   _                  -> Eth.blockNumber  -pollTillBlockProgress-  :: Quantity-  -> Web3 Quantity+pollTillBlockProgress :: JsonRpc m => Quantity -> m Quantity pollTillBlockProgress currentBlock = do   bn <- Eth.blockNumber   if currentBlock >= bn

@@ -21,7 +21,7 @@ -- Stability   :  experimental -- Portability :  unportable ----- Support for parallel multiple event filters.+-- Parallel multiple event filters. --  module  Network.Ethereum.Contract.Event.MultiFilter@@ -34,13 +34,11 @@      -- * With geth filters     , multiEvent-    , multiEvent'-    , multiEventMany'+    , multiEventMany      -- * Without geth filters     , multiEventNoFilter-    , multiEventNoFilter'-    , multiEventManyNoFilter'+    , multiEventManyNoFilter      -- * Re-exports     , Handlers@@ -49,7 +47,6 @@     ) where  import           Control.Concurrent                     (threadDelay)-import           Control.Concurrent.Async               (Async) import           Control.Monad                          (forM, void, when) import           Control.Monad.IO.Class                 (MonadIO (..)) import           Control.Monad.Trans.Class              (lift)@@ -83,10 +80,10 @@  import           Data.Solidity.Event                    (DecodeEvent (..)) import qualified Network.Ethereum.Api.Eth               as Eth-import           Network.Ethereum.Api.Provider          (Web3, forkWeb3) import           Network.Ethereum.Api.Types             (Change (..),                                                          DefaultBlock (..),                                                          Filter (..), Quantity)+import Network.JsonRpc.TinyClient (JsonRpc(..)) import           Network.Ethereum.Contract.Event.Common  --------------------------------------------------------------------------------@@ -122,34 +119,19 @@ multiEvent   :: ( PollFilters es      , QueryAllLogs es-     , MapHandlers Web3 es (WithChange es)-#if MIN_VERSION_vinyl(0,10,0)-     , RPureConstrained HasLogIndex (WithChange es)-#else-     , AllAllSat '[HasLogIndex] (WithChange es)-#endif-     , RecApplicative (WithChange es)-     )-  => MultiFilter es-  -> Handlers es (ReaderT Change Web3 EventAction)-  -> Web3 (Async ())-multiEvent fltrs = forkWeb3 . multiEvent' fltrs--multiEvent'-  :: ( PollFilters es-     , QueryAllLogs es-     , MapHandlers Web3 es (WithChange es)+     , MapHandlers m es (WithChange es) #if MIN_VERSION_vinyl(0,10,0)      , RPureConstrained HasLogIndex (WithChange es) #else      , AllAllSat '[HasLogIndex] (WithChange es) #endif      , RecApplicative (WithChange es)+     , JsonRpc m      )   => MultiFilter es-  -> Handlers es (ReaderT Change Web3 EventAction)-  -> Web3 ()-multiEvent' fltrs = multiEventMany' fltrs 0+  -> Handlers es (ReaderT Change m EventAction)+  -> m ()+multiEvent fltrs = multiEventMany fltrs 0  data MultiFilterStreamState es =   MultiFilterStreamState { mfssCurrentBlock       :: Quantity@@ -158,22 +140,23 @@                          }  -multiEventMany'+multiEventMany   :: ( PollFilters es      , QueryAllLogs es-     , MapHandlers Web3 es (WithChange es)+     , MapHandlers m es (WithChange es) #if MIN_VERSION_vinyl(0,10,0)      , RPureConstrained HasLogIndex (WithChange es) #else      , AllAllSat '[HasLogIndex] (WithChange es) #endif      , RecApplicative (WithChange es)+     , JsonRpc m      )   => MultiFilter es   -> Integer-  -> Handlers es (ReaderT Change Web3 EventAction)-  -> Web3 ()-multiEventMany' fltrs window handlers = do+  -> Handlers es (ReaderT Change m EventAction)+  -> m ()+multiEventMany fltrs window handlers = do     start <- mkBlockNumber $ minStartBlock fltrs     let initState =           MultiFilterStreamState { mfssCurrentBlock = start@@ -194,15 +177,18 @@       let pollTo = minEndBlock fltrs'       void $ reduceMultiEventStream (pollMultiFilter fIds pollTo) handlers -multiFilterStream-  :: MultiFilterStreamState es-  -> MachineT Web3 k (MultiFilter es)+multiFilterStream :: JsonRpc m+                  => MultiFilterStreamState es+                  -> MachineT m k (MultiFilter es) multiFilterStream initialPlan = do   unfoldPlan initialPlan $ \s -> do     end <- lift . mkBlockNumber . minEndBlock . mfssInitialMultiFilter $ initialPlan     filterPlan end s   where-    filterPlan :: Quantity -> MultiFilterStreamState es -> PlanT k (MultiFilter es) Web3 (MultiFilterStreamState es)+    filterPlan :: JsonRpc m+               => Quantity+               -> MultiFilterStreamState es+               -> PlanT k (MultiFilter es) m (MultiFilterStreamState es)     filterPlan end initialState@MultiFilterStreamState{..} = do       if mfssCurrentBlock > end         then stop@@ -228,7 +214,7 @@   WithChange (e : es) = FilterChange e : WithChange es  class QueryAllLogs (es :: [*]) where-  queryAllLogs :: MultiFilter es -> Web3 [Field (WithChange es)]+    queryAllLogs :: JsonRpc m => MultiFilter es -> m [Field (WithChange es)]  instance QueryAllLogs '[] where   queryAllLogs NilFilters = pure []@@ -315,7 +301,7 @@  -- | 'playLogs' streams the 'filterStream' and calls eth_getLogs on these 'Filter' objects. playMultiLogs-  :: forall es k.+  :: forall es k m.      ( QueryAllLogs es #if MIN_VERSION_vinyl(0,10,0)      , RPureConstrained HasLogIndex (WithChange es)@@ -323,26 +309,27 @@      , AllAllSat '[HasLogIndex] (WithChange es) #endif      , RecApplicative (WithChange es)+     , JsonRpc m      )   => MultiFilterStreamState es-  -> MachineT Web3 k [Field (WithChange es)]+  -> MachineT m k [Field (WithChange es)] playMultiLogs s = fmap sortChanges $      multiFilterStream s   ~> autoM queryAllLogs  data TaggedFilterIds (es :: [*]) where-  TaggedFilterNil :: TaggedFilterIds '[]-  TaggedFilterCons :: Tagged e Quantity -> TaggedFilterIds es -> TaggedFilterIds (e : es)+    TaggedFilterNil :: TaggedFilterIds '[]+    TaggedFilterCons :: Tagged e Quantity -> TaggedFilterIds es -> TaggedFilterIds (e : es)  class PollFilters (es :: [*]) where-  openMultiFilter :: MultiFilter es -> Web3 (TaggedFilterIds es)-  checkMultiFilter :: TaggedFilterIds es -> Web3 [Field (WithChange es)]-  closeMultiFilter :: TaggedFilterIds es -> Web3 ()+    openMultiFilter :: JsonRpc m => MultiFilter es -> m (TaggedFilterIds es)+    checkMultiFilter :: JsonRpc m => TaggedFilterIds es -> m [Field (WithChange es)]+    closeMultiFilter :: JsonRpc m => TaggedFilterIds es -> m ()  instance PollFilters '[] where-  openMultiFilter _ = pure TaggedFilterNil-  checkMultiFilter _ = pure []-  closeMultiFilter _ = pure ()+    openMultiFilter _ = pure TaggedFilterNil+    checkMultiFilter _ = pure []+    closeMultiFilter _ = pure ()  instance forall e i ni es.   ( DecodeEvent i ni e@@ -375,13 +362,13 @@ #else      , AllAllSat '[HasLogIndex] (WithChange es) #endif+     , JsonRpc m      )   => TaggedFilterIds es   -> DefaultBlock-  -> MachineT Web3 k [Field (WithChange es)]+  -> MachineT m k [Field (WithChange es)] pollMultiFilter is = construct . pollPlan is   where-    -- pollPlan :: TaggedFilterIds es -> DefaultBlock -> PlanT k [Field (Map (TyCon1 FilterChange) es)] Web3 ()     pollPlan (fIds :: TaggedFilterIds es) end = do       bn <- lift $ Eth.blockNumber       if BlockWithNumber bn > end@@ -396,53 +383,39 @@  -------------------------------------------------------------------------------- - multiEventNoFilter   :: ( QueryAllLogs es-     , MapHandlers Web3 es (WithChange es)-#if MIN_VERSION_vinyl(0,10,0)-     , RPureConstrained HasLogIndex (WithChange es)-#else-     , AllAllSat '[HasLogIndex] (WithChange es)-#endif-     , RecApplicative (WithChange es)-     )-  => MultiFilter es-  -> Handlers es (ReaderT Change Web3 EventAction)-  -> Web3 (Async ())-multiEventNoFilter fltrs = forkWeb3 . multiEventNoFilter' fltrs--multiEventNoFilter'-  :: ( QueryAllLogs es-     , MapHandlers Web3 es (WithChange es)+     , MapHandlers m es (WithChange es) #if MIN_VERSION_vinyl(0,10,0)      , RPureConstrained HasLogIndex (WithChange es) #else      , AllAllSat '[HasLogIndex] (WithChange es) #endif      , RecApplicative (WithChange es)+     , JsonRpc m      )   => MultiFilter es-  -> Handlers es (ReaderT Change Web3 EventAction)-  -> Web3 ()-multiEventNoFilter' fltrs = multiEventManyNoFilter' fltrs 0+  -> Handlers es (ReaderT Change m EventAction)+  -> m ()+multiEventNoFilter fltrs = multiEventManyNoFilter fltrs 0  -multiEventManyNoFilter'+multiEventManyNoFilter   :: ( QueryAllLogs es-     , MapHandlers Web3 es (WithChange es)+     , MapHandlers m es (WithChange es) #if MIN_VERSION_vinyl(0,10,0)      , RPureConstrained HasLogIndex (WithChange es) #else      , AllAllSat '[HasLogIndex] (WithChange es) #endif      , RecApplicative (WithChange es)+     , JsonRpc m      )   => MultiFilter es   -> Integer-  -> Handlers es (ReaderT Change Web3 EventAction)-  -> Web3 ()-multiEventManyNoFilter' fltrs window handlers = do+  -> Handlers es (ReaderT Change m EventAction)+  -> m ()+multiEventManyNoFilter fltrs window handlers = do     start <- mkBlockNumber $ minStartBlock fltrs     let initState =           MultiFilterStreamState { mfssCurrentBlock = start@@ -467,15 +440,18 @@                                                           }           in void $ reduceMultiEventStream (playNewMultiLogs pollingFilterState) handlers -newMultiFilterStream-  :: MultiFilterStreamState es-  -> MachineT Web3 k (MultiFilter es)+newMultiFilterStream :: JsonRpc m+                     => MultiFilterStreamState es+                     -> MachineT m k (MultiFilter es) newMultiFilterStream initialPlan = do   unfoldPlan initialPlan $ \s -> do     let end = minEndBlock . mfssInitialMultiFilter $ initialPlan     filterPlan end s   where-    filterPlan :: DefaultBlock -> MultiFilterStreamState es -> PlanT k (MultiFilter es) Web3 (MultiFilterStreamState es)+    filterPlan :: JsonRpc m+               => DefaultBlock+               -> MultiFilterStreamState es+               -> PlanT k (MultiFilter es) m (MultiFilterStreamState es)     filterPlan end initialState@MultiFilterStreamState{..} = do       if BlockWithNumber mfssCurrentBlock > end         then stop@@ -489,7 +465,7 @@           filterPlan end initialState { mfssCurrentBlock = newestBlockNumber + 1 }  playNewMultiLogs-  :: forall es k.+  :: forall es k m.      ( QueryAllLogs es #if MIN_VERSION_vinyl(0,10,0)      , RPureConstrained HasLogIndex (WithChange es)@@ -497,9 +473,10 @@      , AllAllSat '[HasLogIndex] (WithChange es) #endif      , RecApplicative (WithChange es)+     , JsonRpc m      )   => MultiFilterStreamState es-  -> MachineT Web3 k [Field (WithChange es)]+  -> MachineT m k [Field (WithChange es)] playNewMultiLogs s = fmap sortChanges $      newMultiFilterStream s   ~> autoM queryAllLogs

@@ -19,21 +19,18 @@ -- Stability   :  experimental -- Portability :  unportable ----- Simple contract event filter support.+-- Contract event filters. --  module Network.Ethereum.Contract.Event.SingleFilter     (       event-    , event'-    , eventMany'+    , eventMany     , eventNoFilter-    , eventNoFilter'-    , eventManyNoFilter'+    , eventManyNoFilter     ) where  import           Control.Concurrent                     (threadDelay)-import           Control.Concurrent.Async               (Async) import           Control.Monad                          (forM, void, when) import           Control.Monad.IO.Class                 (MonadIO (..)) import           Control.Monad.Trans.Class              (lift)@@ -48,38 +45,31 @@  import           Data.Solidity.Event                    (DecodeEvent (..)) import qualified Network.Ethereum.Api.Eth               as Eth-import           Network.Ethereum.Api.Provider          (Web3, forkWeb3) import           Network.Ethereum.Api.Types             (Change (..),                                                          DefaultBlock (..),                                                          Filter (..), Quantity) import           Network.Ethereum.Contract.Event.Common---- | Run 'event\'' one block at a time.-event :: DecodeEvent i ni e-      => Filter e-      -> (e -> ReaderT Change Web3 EventAction)-      -> Web3 (Async ())-event fltr = forkWeb3 . event' fltr+import           Network.JsonRpc.TinyClient             (JsonRpc (..)) --- | Same as 'event', but does not immediately spawn a new thread.-event' :: DecodeEvent i ni e+-- | Run one block at a time.+event :: (DecodeEvent i ni e, JsonRpc m)        => Filter e-       -> (e -> ReaderT Change Web3 EventAction)-       -> Web3 ()-event' fltr = eventMany' fltr 0+       -> (e -> ReaderT Change m EventAction)+       -> m ()+event fltr = eventMany fltr 0 --- | 'eventMany\'' take s a filter, a window size, and a handler.+-- | 'eventMany' take s a filter, a window size, and a handler. -- -- It runs the handler over the results of 'eventLogs' results using -- 'reduceEventStream'. If no 'TerminateEvent' action is thrown and -- the toBlock is not yet reached, it then transitions to polling. ---eventMany' :: DecodeEvent i ni e+eventMany :: (DecodeEvent i ni e, JsonRpc m)            => Filter e            -> Integer-           -> (e -> ReaderT Change Web3 EventAction)-           -> Web3 ()-eventMany' fltr window handler = do+           -> (e -> ReaderT Change m EventAction)+           -> m ()+eventMany fltr window handler = do     start <- mkBlockNumber $ filterFromBlock fltr     let initState = FilterStreamState { fssCurrentBlock = start                                       , fssInitialFilter = fltr@@ -127,22 +117,21 @@             return ((,) act <$> changeBlockNumber filterChangeRawChange)  -- | 'playLogs' streams the 'filterStream' and calls eth_getLogs on these 'Filter' objects.-playOldLogs-  :: DecodeEvent i ni e-  => FilterStreamState e-  -> MachineT Web3 k [FilterChange e]+playOldLogs :: (DecodeEvent i ni e, JsonRpc m)+            => FilterStreamState e+            -> MachineT m k [FilterChange e] playOldLogs s = filterStream s           ~> autoM Eth.getLogs           ~> autoM (liftIO . mkFilterChanges)  -- | Polls a filter from the given filterId until the target toBlock is reached.-pollFilter :: forall i ni e k . DecodeEvent i ni e+pollFilter :: forall i ni e k m . (DecodeEvent i ni e, JsonRpc m)            => Quantity            -> DefaultBlock-           -> MachineT Web3 k [FilterChange e]+           -> MachineT m k [FilterChange e] pollFilter i = construct . pollPlan i   where-    pollPlan :: Quantity -> DefaultBlock -> PlanT k [FilterChange e] Web3 ()+    pollPlan :: Quantity -> DefaultBlock -> PlanT k [FilterChange e] m ()     pollPlan fid end = do       bn <- lift $ Eth.blockNumber       if BlockWithNumber bn > end@@ -162,11 +151,12 @@ -- which cover this filter in intervals of size `windowSize`. The machine -- halts whenever the `fromBlock` of a spanning filter either (1) excedes then -- initial filter's `toBlock` or (2) is greater than the chain head's block number.-filterStream :: FilterStreamState e-             -> MachineT Web3 k (Filter e)+filterStream :: JsonRpc m+             => FilterStreamState e+             -> MachineT m k (Filter e) filterStream initialPlan = unfoldPlan initialPlan filterPlan   where-    filterPlan :: FilterStreamState e -> PlanT k (Filter e) Web3 (FilterStreamState e)+    filterPlan :: JsonRpc m => FilterStreamState e -> PlanT k (Filter e) m (FilterStreamState e)     filterPlan initialState@FilterStreamState{..} = do       end <- lift . mkBlockNumber $ filterToBlock fssInitialFilter       if fssCurrentBlock > end@@ -181,29 +171,18 @@  -------------------------------------------------------------------------------- --- | Run 'event\'' one block at a time.-eventNoFilter-  :: DecodeEvent i ni e-  => Filter e-  -> (e -> ReaderT Change Web3 EventAction)-  -> Web3 (Async ())-eventNoFilter fltr = forkWeb3 . event' fltr---- | Same as 'event', but does not immediately spawn a new thread.-eventNoFilter'-  :: DecodeEvent i ni e-  => Filter e-  -> (e -> ReaderT Change Web3 EventAction)-  -> Web3 ()-eventNoFilter' fltr = eventManyNoFilter' fltr 0+eventNoFilter :: (DecodeEvent i ni e, JsonRpc m)+              => Filter e+              -> (e -> ReaderT Change m EventAction)+              -> m ()+eventNoFilter fltr = eventManyNoFilter fltr 0 -eventManyNoFilter'-  :: DecodeEvent i ni e-  => Filter e-  -> Integer-  -> (e -> ReaderT Change Web3 EventAction)-  -> Web3 ()-eventManyNoFilter' fltr window handler = do+eventManyNoFilter :: (DecodeEvent i ni e, JsonRpc m)+                  => Filter e+                  -> Integer+                  -> (e -> ReaderT Change m EventAction)+                  -> m ()+eventManyNoFilter fltr window handler = do     start <- mkBlockNumber $ filterFromBlock fltr     let initState = FilterStreamState { fssCurrentBlock = start                                       , fssInitialFilter = fltr@@ -228,21 +207,20 @@           in void $ reduceEventStream (playNewLogs pollingFilterState) handler  -- | 'playLogs' streams the 'filterStream' and calls eth_getLogs on these 'Filter' objects.-playNewLogs-  :: DecodeEvent i ni e-  => FilterStreamState e-  -> MachineT Web3 k [FilterChange e]+playNewLogs :: (DecodeEvent i ni e, JsonRpc m)+            => FilterStreamState e+            -> MachineT m k [FilterChange e] playNewLogs s =      newFilterStream s   ~> autoM Eth.getLogs   ~> autoM (liftIO . mkFilterChanges) -newFilterStream-  :: FilterStreamState e-  -> MachineT Web3 k (Filter e)+newFilterStream :: JsonRpc m+                => FilterStreamState e+                -> MachineT m k (Filter e) newFilterStream initialState = unfoldPlan initialState filterPlan   where-    filterPlan :: FilterStreamState e -> PlanT k (Filter e) Web3 (FilterStreamState e)+    filterPlan :: JsonRpc m => FilterStreamState e -> PlanT k (Filter e) m (FilterStreamState e)     filterPlan s@FilterStreamState{..} = do       if BlockWithNumber fssCurrentBlock > filterToBlock fssInitialFilter         then stop

@@ -239,7 +239,7 @@           [funD' 'selector [] [|const mIdent|]]         ]   where mIdent    = T.unpack (methodId $ fun {funName = T.replace "'" "" name})-        dataName  = mkName (toUpperFirst (T.unpack $ name <> "Data"))+        dataName  = mkName (toUpperFirst (T.unpack $ T.dropWhile (== '_') name <> "Data"))         fnName    = mkName (toLowerFirst (T.unpack name))         bangInput = fmap funBangType inputs         derivingD = [''Show, ''Eq, ''Ord, ''GHC.Generic]

@@ -1,44 +0,0 @@--- |--- Module      :  Network.Ethereum.Web3--- Copyright   :  Alexander Krupenkin 2016-2018--- License     :  BSD3------ Maintainer  :  mail@akru.me--- Stability   :  experimental--- Portability :  unportable------ An Ethereum node offers a RPC interface. This interface gives Ðapp’s--- access to the Ethereum blockchain and functionality that the node provides,--- such as compiling smart contract code. It uses a subset of the JSON-RPC 2.0--- specification (no support for notifications or named parameters) as serialisation--- protocol and is available over HTTP and IPC (unix domain sockets on linux/OSX--- and named pipe’s on Windows).------ Web3 Haskell library currently use JSON-RPC over HTTP to access node functionality.-----module Network.Ethereum.Web3-    (-    -- * Base monad for any Ethereum node communication-      Web3-    , runWeb3--    -- * Basic transaction sending-    , module Account--    -- * Basic event listening-    , EventAction(..)-    , event--    -- * Primitive data types-    , module Prim--    -- * Metric unit system-    , module Unit-    ) where--import           Data.Solidity.Prim              as Prim-import           Network.Ethereum.Account        as Account-import           Network.Ethereum.Api.Provider   (Web3, runWeb3)-import           Network.Ethereum.Contract.Event (EventAction (..), event)-import           Network.Ethereum.Unit           as Unit

@@ -0,0 +1,41 @@+-- |+-- Module      :  Network.Ipfs.Api.Bitswap+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unknown+--+-- Api calls with `bitswap` prefix.+--++module Network.Ipfs.Api.Bitswap where++import           Control.Monad.IO.Class         (MonadIO (..))+import           Data.Text                      (Text)++import           Network.Ipfs.Api.Internal      (_bitswapLedger,+                                                 _bitswapReprovide,+                                                 _bitswapStat, _bitswapWL)+import           Network.Ipfs.Api.Internal.Call (call)+import           Network.Ipfs.Api.Types         (BitswapLedgerObj,+                                                 BitswapStatObj, BitswapWLObj,+                                                 ReprovideReturnType)+import           Network.Ipfs.Client            (IpfsT)++-- | 'Show some diagnostic information on the bitswap agent.+stat :: MonadIO m => IpfsT m BitswapStatObj+stat = call _bitswapStat++-- | Show blocks currently on the wantlist.+wl :: MonadIO m => IpfsT m BitswapWLObj+wl = call _bitswapWL++-- | Show the current ledger for a peer.+ledger :: MonadIO m => Text -> IpfsT m BitswapLedgerObj+ledger = call . _bitswapLedger++-- | Trigger reprovider.+reprovide :: MonadIO m => IpfsT m ReprovideReturnType+reprovide = call _bitswapReprovide

@@ -0,0 +1,39 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      :  Network.Ipfs.Api.Block+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unknown+--+-- Api calls with `block` prefix.+--++module Network.Ipfs.Api.Block where++import           Control.Monad.IO.Class         (MonadIO)+import           Data.Aeson                     (decode)+import           Data.Text                      (Text)+import           Network.HTTP.Client            (responseBody)++import           Network.Ipfs.Api.Internal      (_blockGet, _blockStat)+import           Network.Ipfs.Api.Internal.Call (call, multipartCall)+import           Network.Ipfs.Api.Types         (BlockObj, BlockReturnType)+import           Network.Ipfs.Client            (IpfsT)++-- | Get a raw IPFS block.+get :: MonadIO m => Text -> IpfsT m BlockReturnType+get = call . _blockGet++-- | Store input as an IPFS block.+put :: MonadIO m => Text -> IpfsT m (Maybe BlockObj)+put = fmap decodeResponse . multipartCall "block/put"+  where+    decodeResponse = decode . responseBody++-- | Print information of a raw IPFS block.+stat :: MonadIO m => Text -> IpfsT m BlockObj+stat = call . _blockStat

@@ -0,0 +1,34 @@+-- |+-- Module      :  Network.Ipfs.Api.Bootstrap+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unknown+--+-- Api calls with `bootstrap` prefix.+--++module Network.Ipfs.Api.Bootstrap where++import           Control.Monad.IO.Class         (MonadIO)+import           Data.Text                      (Text)++import           Network.Ipfs.Api.Internal      (_bootstrapAdd, _bootstrapList,+                                                 _bootstrapRM)+import           Network.Ipfs.Api.Internal.Call (call)+import           Network.Ipfs.Api.Types         (BootstrapObj)+import           Network.Ipfs.Client            (IpfsT)++-- | Add peers to the bootstrap list.+add :: MonadIO m => Text -> IpfsT m BootstrapObj+add = call . _bootstrapAdd . Just++-- | Show peers in the bootstrap list.+list :: MonadIO m => IpfsT m BootstrapObj+list = call _bootstrapList++-- | Remove peers from the bootstrap list.+rm :: MonadIO m => Text -> IpfsT m BootstrapObj+rm = call . _bootstrapRM . Just

@@ -0,0 +1,44 @@+-- |+-- Module      :  Network.Ipfs.Api.Cid+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unknown+--+-- Api calls with `cid` prefix.+--++module Network.Ipfs.Api.Cid where++import           Control.Monad.IO.Class         (MonadIO)+import           Data.Text                      (Text)++import           Network.Ipfs.Api.Internal      (_cidBase32, _cidBases,+                                                 _cidCodecs, _cidFormat,+                                                 _cidHashes)+import           Network.Ipfs.Api.Internal.Call (call)+import           Network.Ipfs.Api.Types         (CidBasesObj, CidCodecsObj,+                                                 CidHashesObj, CidObj)+import           Network.Ipfs.Client            (IpfsT)++-- | List available multibase encodings.+bases :: MonadIO m => IpfsT m [CidBasesObj]+bases = call _cidBases++-- | List available CID codecs.+codecs :: MonadIO m => IpfsT m [CidCodecsObj]+codecs = call _cidCodecs++-- | List available multihashes.+hashes :: MonadIO m => IpfsT m [CidHashesObj]+hashes = call _cidHashes++-- | Convert CIDs to Base32 CID version 1.+base32 :: MonadIO m => Text -> IpfsT m CidObj+base32 = call . _cidBase32++-- | Format and convert a CID in various useful ways.+format :: MonadIO m => Text -> IpfsT m CidObj+format = call . _cidFormat

@@ -0,0 +1,40 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      :  Network.Ipfs.Api.Config+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unknown+--+-- Api calls with `config` prefix.+--++module Network.Ipfs.Api.Config where++import           Control.Monad.IO.Class         (MonadIO)+import           Data.Text                      (Text)+import           Network.HTTP.Client            (responseStatus)+import           Network.HTTP.Types             (Status (..))++import           Network.Ipfs.Api.Internal      (_configGet, _configSet)+import           Network.Ipfs.Api.Internal.Call (call, multipartCall)+import           Network.Ipfs.Api.Types         (ConfigObj)+import           Network.Ipfs.Client            (IpfsT)+++-- | Get ipfs config values.+get :: MonadIO m => Text -> IpfsT m ConfigObj+get = call . _configGet++-- | Set ipfs config values.+set :: MonadIO m => Text -> Maybe Text -> IpfsT m ConfigObj+set key = call . _configSet key++-- | Replace the config with the file at <filePath>.+replace :: MonadIO m => Text -> IpfsT m Bool+replace = fmap isSuccess . multipartCall "config/replace"+  where+    isSuccess = (== 200) . statusCode . responseStatus

@@ -0,0 +1,88 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      :  Network.Ipfs.Api.Core+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unknown+--+-- Core IPFS API calls.+--++module Network.Ipfs.Api.Core where++import qualified Codec.Archive.Tar                as Tar+import           Control.Monad.IO.Class           (MonadIO (..))+import           Data.Aeson                       (decode)+import           Data.ByteString.Lazy             (fromStrict)+import           Data.Text                        (Text)+import           Data.Text.Encoding               (encodeUtf8)+import           Network.HTTP.Client              (responseBody)+import           Servant.API.ContentTypes         (NoContent)++import           Network.Ipfs.Api.Internal        (_cat, _dns, _get, _id,+                                                   _idPeer, _ls, _shutdown,+                                                   _version)+import           Network.Ipfs.Api.Internal.Call   (call, multipartCall,+                                                   streamCall)+import           Network.Ipfs.Api.Internal.Stream (_ping, _refs, _refsLocal)+import           Network.Ipfs.Api.Types           (AddObj, CatReturnType,+                                                   DnsObj, IdObj, LsObj,+                                                   VersionObj)+import           Network.Ipfs.Client              (IpfsT)++-- | Show IPFS object data.+cat :: MonadIO m => Text -> IpfsT m CatReturnType+cat = call . _cat++-- | Add a file or directory to ipfs.+add :: MonadIO m => Text -> IpfsT m (Maybe AddObj)+add = fmap decodeResponse . multipartCall "add"+  where+    decodeResponse = decode . responseBody++-- | List directory contents for Unix filesystem objects.+ls :: MonadIO m => Text -> IpfsT m LsObj+ls = call . _ls++-- | Download IPFS objects.+get :: MonadIO m => Text -> IpfsT m Text+get hash = do+    ret <- call $ _get hash+    do liftIO $ Tar.unpack "getResponseDirectory" . Tar.read . fromStrict $ encodeUtf8 ret+       pure "The content has been stored in getResponseDirectory."++-- | Show ipfs version information.+version :: MonadIO m => IpfsT m VersionObj+version = call _version++-- | Show ipfs node id info.+id :: MonadIO m => IpfsT m IdObj+id = call _id++-- | Show ipfs node id info of the given peerId.+idPeer :: MonadIO m => Text -> IpfsT m IdObj+idPeer = call . _idPeer++-- | Resolve DNS links.+dns :: MonadIO m => Text -> IpfsT m DnsObj+dns = call . _dns++-- | List links (references) from an object.+refs :: MonadIO m => Text -> m ()+refs = streamCall . _refs++-- | List all local references.+refsLocal :: MonadIO m => m ()+refsLocal = streamCall _refsLocal++-- | Send echo request packets to IPFS hosts.+ping :: MonadIO m => Text -> m ()+ping = streamCall . _ping++-- | Shut down the ipfs daemon.+shutdown :: MonadIO m => IpfsT m NoContent+shutdown = call _shutdown

@@ -0,0 +1,40 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      :  Network.Ipfs.Api.Dag+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unknown+--+-- Api calls with `dag` prefix.+--++module Network.Ipfs.Api.Dag where++import           Control.Monad.IO.Class         (MonadIO)+import           Data.Aeson                     (decode)+import           Data.Text                      (Text)+import           Network.HTTP.Client            (responseBody)++import           Network.Ipfs.Api.Internal      (_dagGet, _dagResolve)+import           Network.Ipfs.Api.Internal.Call (call, multipartCall)+import           Network.Ipfs.Api.Types         (DagPutObj, DagResolveObj,+                                                 DagReturnType)+import           Network.Ipfs.Client            (IpfsT)++-- | Get a dag node from ipfs.+get :: MonadIO m => Text -> IpfsT m DagReturnType+get = call . _dagGet++-- | Resolve ipld block.+resolve :: MonadIO m => Text -> IpfsT m DagResolveObj+resolve = call . _dagResolve++-- | Add a dag node to ipfs.+put :: MonadIO m => Text -> IpfsT m (Maybe DagPutObj)+put = fmap decodeResponse . multipartCall "dag/put"+  where+    decodeResponse = decode . responseBody

@@ -0,0 +1,41 @@+-- |+-- Module      :  Network.Ipfs.Api.Dht+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unknown+--+-- Api calls with `dht` prefix.+--++module Network.Ipfs.Api.Dht where++import           Control.Monad.IO.Class           (MonadIO)+import           Data.Text                        (Text)++import           Network.Ipfs.Api.Internal.Call   (streamCall)+import           Network.Ipfs.Api.Internal.Stream (_dhtFindPeer, _dhtFindProvs,+                                                   _dhtGet, _dhtProvide,+                                                   _dhtQuery)++-- | Find the multiaddresses associated with the given peerId.+findPeer :: MonadIO m => Text -> m ()+findPeer = streamCall . _dhtFindPeer++-- | Find peers that can provide a specific value, given a key.+findProvs :: MonadIO m => Text -> m ()+findProvs = streamCall . _dhtFindProvs++-- | Given a key, query the routing system for its best value.+get :: MonadIO m => Text -> m ()+get cid = streamCall $ _dhtGet cid++-- | Announce to the network that you are providing given values.+provide :: MonadIO m => Text -> m ()+provide = streamCall . _dhtProvide++-- | Find the closest Peer IDs to a given peerID by querying the DHT.+query :: MonadIO m => Text -> m ()+query = streamCall . _dhtQuery

@@ -0,0 +1,74 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      :  Network.Ipfs.Api.Files+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unknown+--+-- Api calls with `files` prefix.+--++module Network.Ipfs.Api.Files where++import           Control.Monad.IO.Class         (MonadIO)+import           Data.Text                      (Text, pack)+import           Network.HTTP.Client            (responseStatus)+import           Network.HTTP.Types             (Status (..))+import           Servant.API.ContentTypes       (NoContent)++import           Network.Ipfs.Api.Internal      (_filesChcid, _filesCp,+                                                 _filesFlush, _filesLs,+                                                 _filesMkdir, _filesMv,+                                                 _filesRead, _filesRm,+                                                 _filesStat)+import           Network.Ipfs.Api.Internal.Call (call, multipartCall)+import           Network.Ipfs.Api.Types         (FilesFlushObj, FilesLsObj,+                                                 FilesReadType, FilesStatObj)+import           Network.Ipfs.Client            (IpfsT)++-- | Change the cid version or hash function of the root node of a given mfsPath.+chcidVer :: MonadIO m => Text -> Int -> IpfsT m NoContent+chcidVer mfsPath = call . _filesChcid (Just mfsPath) . Just++-- | Copy files into mfs.+cp :: MonadIO m => Text -> Text -> IpfsT m NoContent+cp src = call . _filesCp (Just src) . Just++-- | Flush a given path's data to disk.+flush :: MonadIO m => Text -> IpfsT m FilesFlushObj+flush = call . _filesFlush . Just++-- | List directories in the local mutable namespace.+ls :: MonadIO m => Text -> IpfsT m FilesLsObj+ls = call . _filesLs . Just++-- | Make directories.+mkdir :: MonadIO m => Text -> IpfsT m NoContent+mkdir = call . _filesMkdir . Just++-- | Move files.+mv :: MonadIO m => Text -> Text -> IpfsT m NoContent+mv src = call . _filesMv (Just src) . Just++-- | Read a file in a given mfs.+read :: MonadIO m => Text -> IpfsT m FilesReadType+read = call . _filesRead . Just++-- | Display file status.+stat :: MonadIO m => Text -> IpfsT m FilesStatObj+stat = call . _filesStat . Just++-- | Remove a file.+filesRm :: MonadIO m => Text -> IpfsT m NoContent+filesRm = call . flip _filesRm (Just True) . Just++-- | Write to a mutable file in a given filesystem.+write :: MonadIO m => Text -> Text -> Bool -> IpfsT m Bool+write mfsPath filePath toTruncate = isSuccess <$> multipartCall uri filePath+  where+    uri = "files/write?arg=" <> mfsPath <> "&create=true" <> "&truncate=" <> (pack $ show toTruncate)+    isSuccess = (200 ==) . statusCode . responseStatus

@@ -0,0 +1,100 @@+-- |+-- Module      :  Network.Ipfs.Api.Internal+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- IPFS API internals.+--++module Network.Ipfs.Api.Internal where++import           Data.Proxy             (Proxy (..))+import           Data.Text              (Text)+import           Servant.API+import           Servant.Client         (ClientM, client)++import           Network.Ipfs.Api.Types++_ipfsApi :: Proxy IpfsApi+_ipfsApi = Proxy++_cat :: Text -> ClientM CatReturnType+_ls :: Text -> ClientM LsObj+_get :: Text -> ClientM GetReturnType+_swarmPeers :: ClientM SwarmPeersObj+_swarmConnect :: Maybe Text -> ClientM SwarmObj+_swarmDisconnect :: Maybe Text -> ClientM SwarmObj+_swarmFilters :: ClientM SwarmObj+_swarmFilterAdd :: Maybe Text -> ClientM SwarmObj+_swarmFilterRm :: Maybe Text -> ClientM SwarmObj+_bitswapStat :: ClientM BitswapStatObj+_bitswapWL :: ClientM BitswapWLObj+_bitswapLedger :: Text -> ClientM BitswapLedgerObj+_bitswapReprovide :: ClientM ReprovideReturnType+_cidBases :: ClientM [CidBasesObj]+_cidCodecs :: ClientM [CidCodecsObj]+_cidHashes :: ClientM [CidHashesObj]+_cidBase32 :: Text -> ClientM CidObj+_cidFormat :: Text -> ClientM CidObj+_blockGet :: Text -> ClientM BlockReturnType+_blockStat :: Text -> ClientM BlockObj+_dagGet :: Text -> ClientM DagReturnType+_dagResolve :: Text -> ClientM DagResolveObj+_configGet :: Text -> ClientM ConfigObj+_configSet :: Text -> Maybe Text -> ClientM ConfigObj+_objectData :: Text -> ClientM ObjectReturnType+_objectNew :: ClientM ObjectObj+_objectGetLinks :: Text -> ClientM ObjectLinksObj+_objectAddLink :: Text -> Maybe Text -> Maybe Text -> ClientM ObjectLinksObj+_objectRmLink :: Text -> Maybe Text -> ClientM ObjectLinksObj+_objectGet :: Text -> ClientM ObjectGetObj+_objectDiff :: Text -> Maybe Text -> ClientM ObjectDiffObj+_objectStat :: Text -> ClientM ObjectStatObj+_pinAdd :: Text -> ClientM PinObj+_pinRemove :: Text -> ClientM PinObj+_bootstrapAdd :: Maybe Text -> ClientM BootstrapObj+_bootstrapList :: ClientM BootstrapObj+_bootstrapRM :: Maybe Text -> ClientM BootstrapObj+_statsBw :: ClientM StatsBwObj+_statsRepo :: ClientM StatsRepoObj+_version :: ClientM VersionObj+_id :: ClientM IdObj+_idPeer :: Text -> ClientM IdObj+_dns :: Text -> ClientM DnsObj+_pubsubLs :: ClientM PubsubObj+_pubsubPeers :: ClientM PubsubObj+_pubsubPublish :: Text -> Maybe Text -> ClientM NoContent+_logLs :: ClientM LogLsObj+_logLevel :: Text -> Maybe Text -> ClientM LogLevelObj+_repoVersion :: ClientM RepoVersionObj+_repoFsck :: ClientM RepoFsckObj+_keyGen :: Text -> (Maybe Text) -> ClientM KeyDetailsObj+_keyList :: ClientM KeyObj+_keyRename :: Text -> (Maybe Text) -> ClientM KeyRenameObj+_keyRm :: Text -> ClientM KeyObj+_filesChcid :: Maybe Text -> Maybe Int -> ClientM NoContent+_filesCp :: Maybe Text -> Maybe Text -> ClientM NoContent+_filesFlush :: Maybe Text -> ClientM FilesFlushObj+_filesLs :: Maybe Text -> ClientM FilesLsObj+_filesMkdir :: Maybe Text -> ClientM NoContent+_filesMv :: Maybe Text -> Maybe Text -> ClientM NoContent+_filesRead :: Maybe Text -> ClientM FilesReadType+_filesRm :: Maybe Text -> Maybe Bool -> ClientM NoContent+_filesStat :: Maybe Text -> ClientM FilesStatObj+_shutdown :: ClientM NoContent++_cat :<|> _ls :<|> _get :<|> _swarmPeers :<|> _swarmConnect :<|> _swarmDisconnect :<|>+  _swarmFilters :<|> _swarmFilterAdd :<|> _swarmFilterRm :<|>  _bitswapStat :<|> _bitswapWL :<|> _bitswapLedger :<|>+  _bitswapReprovide :<|> _cidBases :<|> _cidCodecs :<|> _cidHashes :<|> _cidBase32 :<|> _cidFormat :<|>+  _blockGet  :<|> _blockStat :<|> _dagGet :<|> _dagResolve :<|> _configGet :<|>+  _configSet :<|> _objectData :<|> _objectNew :<|> _objectGetLinks :<|> _objectAddLink :<|> _objectRmLink :<|>+  _objectGet :<|> _objectDiff :<|> _objectStat :<|> _pinAdd :<|> _pinRemove :<|> _bootstrapAdd :<|>+  _bootstrapList :<|> _bootstrapRM :<|> _statsBw :<|> _statsRepo :<|> _version :<|> _id :<|> _idPeer :<|>+  _dns :<|> _pubsubLs :<|> _pubsubPeers :<|> _pubsubPublish :<|> _logLs :<|> _logLevel :<|> _repoVersion :<|>+  _repoFsck :<|> _keyGen :<|> _keyList :<|> _keyRename :<|> _keyRm :<|> _filesChcid :<|> _filesCp :<|>+  _filesFlush :<|> _filesLs :<|> _filesMkdir :<|> _filesMv :<|> _filesRead :<|> _filesRm :<|> _filesStat :<|>+  _shutdown = client _ipfsApi

@@ -0,0 +1,58 @@+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE TypeOperators              #-}++-- |+-- Module      :  Network.Ipfs.Api.Internal.Call+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unknown+--+-- Module containing IPFS API call functions.+--++module Network.Ipfs.Api.Internal.Call where++import           Control.Monad.Except+import           Control.Monad.Reader+import           Data.ByteString.Lazy                  (ByteString)+import           Data.Text                             (Text, pack, unpack)+import           Network.HTTP.Client                   as Net hiding (Proxy)+import           Network.HTTP.Client.MultipartFormData+import           Servant.Client+import qualified Servant.Client.Streaming              as S+import           Servant.Types.SourceT                 (SourceT (..), foreach)++import           Network.Ipfs.Client                   (IpfsT)++-- | Regular Call function.+call :: MonadIO m => ClientM a -> IpfsT m a+call func = do+  (manager', url, _) <- ask+  resp <- liftIO (runClientM func (mkClientEnv manager' url))+  case resp of+    Left l  -> throwError l+    Right r -> return r++-- | Call function for ‘multipart/form-data’.+multipartCall :: MonadIO m => Text -> Text -> IpfsT m (Net.Response ByteString)+multipartCall funcUri filePath = do+    (reqManager, _, url) <- ask+    req <- liftIO $ parseRequest $ unpack (pack url <> "/" <> funcUri )+    liftIO $ flip httpLbs reqManager =<< formDataBody form req+  where+    form = [ partFileSource "file" $ unpack filePath ]++-- | Call function for Streams.+streamCall :: (MonadIO m, Show a) => S.ClientM (SourceT IO a) -> m ()+streamCall func = liftIO $ do+    manager' <- newManager defaultManagerSettings+    S.withClientM func (S.mkClientEnv manager' (BaseUrl Http "localhost" 5001 "/api/v0")) $ \e -> case e of+        Left err -> putStrLn $ "Error: " ++ show err+        Right rs -> foreach fail print rs

@@ -0,0 +1,41 @@+-- |+-- Module      :  Network.Ipfs.Api.Internal.Stream+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- Ipfs Stream API provider.+--++module Network.Ipfs.Api.Internal.Stream where++import qualified Data.ByteString.Lazy.Char8    ()+import           Data.Proxy+import           Data.Text+import           Network.HTTP.Client           ()+import           Servant.API+import           Servant.Client.Streaming      as S++import           Network.Ipfs.Api.Types.Stream++_ipfsStreamApi :: Proxy IpfsStreamApi+_ipfsStreamApi =  Proxy++_ping :: Text -> ClientM (SourceIO PingObj)+_dhtFindPeer :: Text -> ClientM (SourceIO DhtObj)+_dhtFindProvs :: Text -> ClientM (SourceIO DhtObj)+_dhtGet :: Text -> ClientM (SourceIO DhtObj)+_dhtProvide :: Text -> ClientM (SourceIO DhtObj)+_dhtQuery :: Text -> ClientM (SourceIO DhtObj)+_logTail :: ClientM (SourceIO LogReturnType)+_repoGc :: ClientM (SourceIO RepoGcObj)+_repoVerify :: ClientM (SourceIO RepoVerifyObj)+_refs :: Text -> ClientM (SourceIO RefsObj)+_refsLocal :: ClientM (SourceIO RefsObj)+_pubsubSubscribe :: Text -> ClientM (SourceIO PubsubSubObj)++_ping :<|> _dhtFindPeer :<|> _dhtFindProvs :<|> _dhtGet :<|> _dhtProvide :<|> _dhtQuery :<|>+  _logTail :<|> _repoGc :<|> _repoVerify :<|> _refs :<|> _refsLocal :<|> _pubsubSubscribe = client _ipfsStreamApi

@@ -0,0 +1,48 @@+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE TypeOperators              #-}++-- |+-- Module      :  Network.Ipfs.Api.Key+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unknown+--+-- Api calls with `key` prefix.+--++module Network.Ipfs.Api.Key where++import           Control.Monad.IO.Class         (MonadIO)+import           Data.Text                      (Text)++import           Network.Ipfs.Api.Internal      (_keyGen, _keyList, _keyRename,+                                                 _keyRm)+import           Network.Ipfs.Api.Internal.Call (call)+import           Network.Ipfs.Api.Types         (KeyDetailsObj, KeyObj,+                                                 KeyRenameObj)+import           Network.Ipfs.Client            (IpfsT)+++-- | 'List all local keypairs.+list :: MonadIO m => IpfsT m KeyObj+list = call _keyList++-- | Create a new keypair.+gen :: MonadIO m => Text -> Text -> IpfsT m KeyDetailsObj+gen name = call . _keyGen name . Just++-- | Rename a keypair.+rename :: MonadIO m => Text -> Text -> IpfsT m KeyRenameObj+rename was = call . _keyRename was . Just++-- | Remove a keypair.+rm :: MonadIO m => Text -> IpfsT m KeyObj+rm = call . _keyRm+

@@ -0,0 +1,42 @@+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE TypeOperators              #-}++-- |+-- Module      :  Network.Ipfs.Api.Log+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unknown+--+-- Api calls with `log` prefix.+--++module Network.Ipfs.Api.Log where++import           Control.Monad.IO.Class           (MonadIO)+import           Data.Text                        (Text)++import           Network.Ipfs.Api.Internal        (_logLevel, _logLs)+import           Network.Ipfs.Api.Internal.Call   (call, streamCall)+import           Network.Ipfs.Api.Internal.Stream (_logTail)+import           Network.Ipfs.Api.Types           (LogLevelObj, LogLsObj)+import           Network.Ipfs.Client              (IpfsT)+++-- | Change the logging level.+level :: MonadIO m => Text -> Text -> IpfsT m LogLevelObj+level subsystem = call . _logLevel subsystem . Just++-- | Read the event log.+tail :: MonadIO m => m ()+tail = streamCall _logTail++-- | List the logging subsystems.+ls :: MonadIO m => IpfsT m LogLsObj+ls = call _logLs

@@ -0,0 +1,81 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      :  Network.Ipfs.Api.Object+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unknown+--+-- Api calls with `object` prefix.+--++module Network.Ipfs.Api.Object where++import           Control.Monad.IO.Class         (MonadIO)+import           Data.Aeson                     (decode)+import           Data.Text                      (Text)+import           Network.HTTP.Client            (responseBody)++import           Network.Ipfs.Api.Internal      (_objectAddLink, _objectData,+                                                 _objectDiff, _objectGet,+                                                 _objectGetLinks, _objectNew,+                                                 _objectRmLink, _objectStat)+import           Network.Ipfs.Api.Internal.Call (call, multipartCall)+import           Network.Ipfs.Api.Types         (ObjectDiffObj, ObjectGetObj,+                                                 ObjectLinksObj, ObjectObj,+                                                 ObjectReturnType,+                                                 ObjectStatObj)+import           Network.Ipfs.Client            (IpfsT)++-- | Output the raw bytes of an IPFS object.+object :: MonadIO m => Text -> IpfsT m ObjectReturnType+object = call . _objectData++-- | Create a new object from an ipfs template.+new :: MonadIO m => IpfsT m ObjectObj+new = call _objectNew++-- | Output the links pointed to by the specified object.+getLinks :: MonadIO m => Text -> IpfsT m ObjectLinksObj+getLinks = call . _objectGetLinks++-- | Add a Merkle-link to the given object and return the hash of the result.+addLink :: MonadIO m => Text -> Text -> Text -> IpfsT m ObjectLinksObj+addLink hash name = call . _objectAddLink hash (Just name) . Just++-- | Remove a Merkle-link from the given object and return the hash of the result.+rmLink :: MonadIO m => Text -> Text -> IpfsT m ObjectLinksObj+rmLink key = call . _objectRmLink key . Just++-- | Append data to what already exists in the data segment in the given object.+appendData :: MonadIO m => Text -> Text -> IpfsT m (Maybe ObjectLinksObj)+appendData key = fmap decodeResponse . multipartCall ("object/patch/append-data?arg=" <> key)+  where+    decodeResponse = decode . responseBody++-- | Set the data field of an IPFS object.+setData :: MonadIO m => Text -> Text -> IpfsT m (Maybe ObjectLinksObj)+setData key = fmap decodeResponse . multipartCall ("object/patch/set-data?arg=" <> key)+  where+    decodeResponse = decode . responseBody++-- | Get and serialize the DAG node named by key.+get :: MonadIO m => Text -> IpfsT m ObjectGetObj+get = call . _objectGet++-- | 'Display the diff between two ipfs objects.+diff :: MonadIO m => Text -> Text -> IpfsT m ObjectDiffObj+diff firstKey = call . _objectDiff firstKey . Just++-- | Store input as a DAG object, print its key.+put :: MonadIO m => Text -> IpfsT m (Maybe ObjectObj)+put = fmap decodeResponse . multipartCall "object/put"+  where+    decodeResponse = decode . responseBody++-- | Get stats for the DAG node named by key.+objectStat :: MonadIO m => Text -> IpfsT m ObjectStatObj+objectStat = call . _objectStat

@@ -0,0 +1,29 @@+-- |+-- Module      :  Network.Ipfs.Api.Pin+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unknown+--+-- Api calls with `pin` prefix.+--++module Network.Ipfs.Api.Pin where++import           Control.Monad.IO.Class         (MonadIO)+import           Data.Text                      (Text)++import           Network.Ipfs.Api.Internal      (_pinAdd, _pinRemove)+import           Network.Ipfs.Api.Internal.Call (call)+import           Network.Ipfs.Api.Types         (PinObj)+import           Network.Ipfs.Client            (IpfsT)++-- | Pin objects to local storage.+add :: MonadIO m => Text -> IpfsT m PinObj+add = call . _pinAdd++-- | Remove pinned objects from local storage.+remove :: MonadIO m => Text -> IpfsT m PinObj+remove = call . _pinRemove

@@ -0,0 +1,39 @@+-- |+-- Module      :  Network.Ipfs.Api.Pubsub+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unknown+--+-- Api calls with `pubsub` prefix.+--++module Network.Ipfs.Api.Pubsub where++import           Control.Monad.IO.Class         (MonadIO)+import           Data.Text                      (Text)+import           Servant.API.ContentTypes       (NoContent)++import           Network.Ipfs.Api.Internal      (_pubsubLs, _pubsubPeers,+                                                 _pubsubPublish)+import           Network.Ipfs.Api.Internal.Call (call)+import           Network.Ipfs.Api.Types         (PubsubObj)+import           Network.Ipfs.Client            (IpfsT)++-- | List subscribed topics by name.+ls :: MonadIO m => IpfsT m PubsubObj+ls = call _pubsubLs++-- | List peers we are currently pubsubbing with.+peers :: MonadIO m => IpfsT m PubsubObj+peers = call _pubsubPeers++-- | Publish a message to a given pubsub topic.+publish :: MonadIO m => Text -> Text -> IpfsT m NoContent+publish topic = call . _pubsubPublish topic . Just++-- | Subscribe to messages on a given topic.+--subscribe :: Text -> m ()+--subscribe = pubsubCall . _pubsubSubscribe

@@ -0,0 +1,37 @@+-- |+-- Module      :  Network.Ipfs.Api.Repo+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unknown+--+-- Api calls with `repo` prefix.+--++module Network.Ipfs.Api.Repo where++import           Control.Monad.IO.Class           (MonadIO)++import           Network.Ipfs.Api.Internal        (_repoFsck, _repoVersion)+import           Network.Ipfs.Api.Internal.Call   (call, streamCall)+import           Network.Ipfs.Api.Internal.Stream (_repoGc, _repoVerify)+import           Network.Ipfs.Api.Types           (RepoFsckObj, RepoVersionObj)+import           Network.Ipfs.Client              (IpfsT)++-- | Show the repo version.+version :: MonadIO m => IpfsT m RepoVersionObj+version = call _repoVersion++-- | Remove repo lockfiles.+fsck :: MonadIO m => IpfsT m RepoFsckObj+fsck = call _repoFsck++-- | Perform a garbage collection sweep on the repo.+gc :: MonadIO m => m ()+gc = streamCall _repoGc++-- | Verify all blocks in repo are not corrupted.+repoVerify :: MonadIO m => m ()+repoVerify = streamCall _repoVerify

@@ -0,0 +1,28 @@+-- |+-- Module      :  Network.Ipfs.Api.Stats+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unknown+--+-- Api calls with `stats` prefix.+--++module Network.Ipfs.Api.Stats where++import           Control.Monad.IO.Class         (MonadIO)++import           Network.Ipfs.Api.Internal      (_statsBw, _statsRepo)+import           Network.Ipfs.Api.Internal.Call (call)+import           Network.Ipfs.Api.Types         (StatsBwObj, StatsRepoObj)+import           Network.Ipfs.Client            (IpfsT)++-- | IPFS bandwidth information.+bw :: MonadIO m => IpfsT m StatsBwObj+bw = call _statsBw++-- | Get stats for the currently used repo.+repo :: MonadIO m => IpfsT m StatsRepoObj+repo = call _statsRepo

@@ -0,0 +1,49 @@+-- |+-- Module      :  Network.Ipfs.Api.Swarm+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unknown+--+-- Api calls with `swarm` prefix.+--++module Network.Ipfs.Api.Swarm where++import           Control.Monad.IO.Class         (MonadIO)+import           Data.Text                      (Text)++import           Network.Ipfs.Api.Internal      (_swarmConnect,+                                                 _swarmDisconnect,+                                                 _swarmFilterAdd,+                                                 _swarmFilterRm, _swarmFilters,+                                                 _swarmPeers)+import           Network.Ipfs.Api.Internal.Call (call)+import           Network.Ipfs.Api.Types         (SwarmObj, SwarmPeersObj)+import           Network.Ipfs.Client            (IpfsT)++-- | List peers with open connections.+swarmPeers :: MonadIO m => IpfsT m SwarmPeersObj+swarmPeers = call _swarmPeers++-- | Open connection to a given address. 'peerId' has to be of the format - /ipfs/id+connect :: MonadIO m => Text -> IpfsT m SwarmObj+connect = call . _swarmConnect . Just++-- | Close connection to a given address. 'peerId' has to be of the format - /ipfs/id+disconnect :: MonadIO m => Text -> IpfsT m SwarmObj+disconnect = call . _swarmDisconnect . Just++-- | Manipulate address filters.+filters :: MonadIO m => IpfsT m SwarmObj+filters = call _swarmFilters++-- | Add an address filter. 'peerId' has to be of the format - /ip4/{IP addr of peer}/ipcidr/{ip network prefix}+filterAdd :: MonadIO m => Text -> IpfsT m SwarmObj+filterAdd = call . _swarmFilterAdd . Just++-- | Remove an address filter.+filterRm :: MonadIO m => Text -> IpfsT m SwarmObj+filterRm = call . _swarmFilterRm . Just

@@ -0,0 +1,823 @@+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE TypeOperators         #-}++-- |+-- Module      :  Network.Ipfs.Api.Types+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- IPFS API types.+--++module Network.Ipfs.Api.Types where++import           Control.Arrow              (left)+import           Control.Monad+import           Data.Aeson+import           Data.ByteString.Lazy       (toStrict)+import qualified Data.ByteString.Lazy.Char8 ()+import qualified Data.HashMap.Strict        as H+import           Data.Int+import           Data.Text                  (Text)+import qualified Data.Text.Encoding         as TextS+import           Data.Typeable+import           Network.HTTP.Client        ()+import qualified Network.HTTP.Media         as M ((//))+import           Servant.API++type CatReturnType = Text+type ReprovideReturnType = Text+type GetReturnType = Text+type BlockReturnType = Text+type DagReturnType = Text+type ObjectReturnType = Text+type FilesReadType = Text++data DirLink = DirLink+    { dlName        :: Text+    , dlHash        :: Text+    , dlSize        :: Int64+    , dlContentType :: Int+    , dlTarget      :: Text+    }+    deriving (Show, Eq)++data DirObj = DirObj+    { dirHash :: Text+    , links   :: [DirLink]+    }+    deriving (Show, Eq)++data AddObj = AddObj+    { name :: Text+    , hash :: Text+    , size :: Text+    }+    deriving (Show, Eq)++instance FromJSON AddObj where+    parseJSON (Object o) =+        AddObj  <$> o .: "Name"+                <*> o .: "Hash"+                <*> o .: "Size"++    parseJSON _ = mzero++data LsObj = LsObj+    { objs :: [DirObj]+    }+    deriving (Show, Eq)++data SwarmStreamObj = SwarmStreamObj+    { protocol :: Text+    }+    deriving (Show, Eq)++data SwarmPeerObj = SwarmPeerObj+    { address   :: Text+    , direction :: Int+    , latency   :: Text+    , muxer     :: Text+    , peer      :: Text+    , streams   :: Maybe [SwarmStreamObj]+    }+    deriving (Show, Eq)++data SwarmPeersObj = SwarmPeersObj+    { peers :: [SwarmPeerObj]+    }+    deriving (Show, Eq)++data SwarmObj = SwarmObj+    { strings :: [Text]+    }+    deriving (Show, Eq)++data WantlistObj = WantlistObj+    { forSlash :: Text+    }+    deriving (Show, Eq)++data BitswapStatObj = BitswapStatObj+    { blocksReceived   :: Int64+    , blocksSent       :: Int64+    , dataReceived     :: Int64+    , dataSent         :: Int64+    , dupBlksReceived  :: Int64+    , dupDataReceived  :: Int64+    , messagesReceived :: Int64+    , bitswapPeers     :: [Text]+    , provideBufLen    :: Int+    , wantlist         :: [WantlistObj]+    }+    deriving (Show, Eq)++data BitswapWLObj = BitswapWLObj+    { bitswapKeys :: [WantlistObj]+    }+    deriving (Show, Eq)++data BitswapLedgerObj = BitswapLedgerObj+    { exchanged  :: Int64+    , ledgerPeer :: Text+    , recv       :: Int64+    , sent       :: Int64+    , value      :: Double+    }+    deriving (Show, Eq)++data CidBasesObj = CidBasesObj+    { baseCode :: Int+    , baseName :: Text+    }+    deriving (Show, Eq)++data CidCodecsObj = CidCodecsObj+    { codecCode :: Int+    , codecName :: Text+    }+    deriving (Show, Eq)++data CidHashesObj = CidHashesObj+    { multihashCode :: Int+    , multihashName :: Text+    }+    deriving (Show, Eq)++data CidObj = CidObj+    { cidStr    :: Text+    , errorMsg  :: Text+    , formatted :: Text+    }+    deriving (Show, Eq)++data BlockObj = BlockObj+    { key       :: Text+    , blockSize :: Int+    }+    deriving (Show, Eq)++data DagCidObj = DagCidObj+    { cidSlash :: Text+    }+    deriving (Show, Eq)++data DagResolveObj = DagResolveObj+    { cid     :: DagCidObj+    , remPath :: Text+    }+    deriving (Show, Eq)++data DagPutObj = DagPutObj+    { putCid :: DagCidObj+    }+    deriving (Show, Eq)++data ConfigObj = ConfigObj+    { configKey   :: Text+    , configValue :: Text+    }+    deriving (Show, Eq)++data ObjectLinkObj = ObjectLinkObj+    { linkHash :: Text+    , linkName :: Text+    , linkSize :: Int64+    }+    deriving (Show, Eq)++data ObjectObj = ObjectObj+    { newObjectHash :: Text+    }+    deriving (Show, Eq)++data ObjectLinksObj = WithLinks+    { objectHash  :: Text+    , objectLinks :: [ObjectLinkObj]+    }+    | WithoutLinks+    { objectHash :: Text+    }+    deriving (Show, Eq)++data ObjectGetObj = ObjectGetObj+    { objectName     :: Text+    , objectGetLinks :: [ObjectLinkObj]+    }+    deriving (Show, Eq)++data ObjectStatObj = ObjectStatObj+    { objBlockSize   :: Int+    , cumulativeSize :: Int+    , dataSize       :: Int+    , objHash        :: Text+    , linksSize      :: Int+    , numLinks       :: Int+    }+    deriving (Show, Eq)++data DiffObj = DiffObj+    { diffSlash :: Text+    }+    deriving (Show, Eq)++data ObjectChangeObj = ObjectChangeObj+    { after    :: Maybe DiffObj+    , before   :: DiffObj+    , path     :: Text+    , diffType :: Int+    }+    deriving (Show, Eq)++data ObjectDiffObj = ObjectDiffObj+    { changes :: [ObjectChangeObj]+    }+    deriving (Show, Eq)++data PinObj = WithoutProgress+    { pins :: [Text]+    }+    | WithProgress+    { pins     :: [Text]+    , progress :: Int+    }+    deriving (Show, Eq)++data BootstrapObj = BootstrapObj+    { bootstrapPeers :: [Text]+    }+    deriving (Show, Eq)++data StatsBwObj = StatsBwObj+    { rateIn   :: Double+    , rateOut  :: Double+    , totalIn  :: Int64+    , totalOut :: Int64+    }+    deriving (Show, Eq)++data StatsRepoObj = StatsRepoObj+    { numObjects  :: Int64+    , repoPath    :: Text+    , repoSize    :: Int64+    , storageMax  :: Int64+    , repoVersion :: Text+    }+    deriving (Show, Eq)++data VersionObj = VersionObj+    { commit  :: Text+    , golang  :: Text+    , repo    :: Text+    , system  :: Text+    , version :: Text+    }+    deriving (Show, Eq)++data IdObj = IdObj+    { addresses       :: [Text]+    , agentVersion    :: Text+    , id              :: Text+    , protocolVersion :: Text+    , publicKey       :: Text+    }+    deriving (Show, Eq)++data DnsObj = DnsObj+    { dnsPath :: Text+    }+    deriving (Show, Eq)++data PubsubObj = PubsubObj+    { pubsubStrings :: [Text]+    }+    deriving (Show, Eq)++data LogLsObj = LogLsObj+    { logLsStrings :: [Text]+    }+    deriving (Show, Eq)++data LogLevelObj = LogLevelObj+    { message :: Text+    }+    deriving (Show, Eq)++data RepoVersionObj = RepoVersionObj+    { repoVer :: Text+    }+    deriving (Show, Eq)++data RepoFsckObj = RepoFsckObj+    { repoMessage :: Text+    }+    deriving (Show, Eq)++data KeyDetailsObj = KeyDetailsObj+    { keyId   :: Text+    , keyName :: Text+    }+    deriving (Show, Eq)++data KeyObj = KeyObj+    { keys :: [KeyDetailsObj]+    }+    deriving (Show, Eq)++data KeyRenameObj = KeyRenameObj+    { peerId    :: Text+    , now       :: Text+    , overwrite :: Bool+    , was       :: Text+    }+    deriving (Show, Eq)++data FilesStatObj = FilesStatObj+    { fileObjectHash       :: Text+    , objectSize           :: Int+    , cumulativeObjectSize :: Int+    , blocks               :: Int+    , objectType           :: Text+    }+    deriving (Show, Eq)++data FilesEntryObj = FilesEntryObj+    { entryName :: Text+    , entryType :: Int+    , entrySize :: Int+    , entryHash :: Text+    }+    deriving (Show, Eq)++data FilesLsObj = FilesLsObj+    { enteries :: [FilesEntryObj]+    }+    deriving (Show, Eq)++data FilesFlushObj = FilesFlushObj+    { fileCid :: Text+    }+    deriving (Show, Eq)++instance FromJSON DirLink where+    parseJSON (Object o) =+        DirLink  <$> o .: "Name"+                 <*> o .: "Hash"+                 <*> o .: "Size"+                 <*> o .: "Type"+                 <*> o .: "Target"++    parseJSON _ = mzero++instance FromJSON DirObj where+    parseJSON (Object o) =+        DirObj  <$> o .: "Hash"+                <*> o .: "Links"++    parseJSON _ = mzero++instance FromJSON LsObj where+    parseJSON (Object o) =+        LsObj  <$> o .: "Objects"++    parseJSON _ = mzero+++instance FromJSON SwarmStreamObj where+    parseJSON (Object o) =+        SwarmStreamObj  <$> o .: "Protocol"++    parseJSON _ = mzero++instance FromJSON SwarmPeerObj where+    parseJSON (Object o) =+        SwarmPeerObj  <$> o .: "Addr"+                      <*> o .: "Direction"+                      <*> o .: "Latency"+                      <*> o .: "Muxer"+                      <*> o .: "Peer"+                      <*> o .: "Streams"++    parseJSON _ = mzero++instance FromJSON SwarmPeersObj where+    parseJSON (Object o) =+        SwarmPeersObj  <$> o .: "Peers"++    parseJSON _ = mzero+++instance FromJSON SwarmObj where+    parseJSON (Object o) =+        SwarmObj  <$> o .: "Strings"++    parseJSON _ = mzero++instance FromJSON WantlistObj where+    parseJSON (Object o) =+        WantlistObj  <$> o .: "/"++    parseJSON _ = mzero++instance FromJSON BitswapStatObj where+    parseJSON (Object o) =+        BitswapStatObj  <$> o .: "BlocksReceived"+                        <*> o .: "BlocksSent"+                        <*> o .: "DataReceived"+                        <*> o .: "DataSent"+                        <*> o .: "DupBlksReceived"+                        <*> o .: "DupDataReceived"+                        <*> o .: "MessagesReceived"+                        <*> o .: "Peers"+                        <*> o .: "ProvideBufLen"+                        <*> o .: "Wantlist"++    parseJSON _ = mzero+++instance FromJSON BitswapWLObj where+    parseJSON (Object o) =+        BitswapWLObj  <$> o .: "Keys"++    parseJSON _ = mzero++instance FromJSON BitswapLedgerObj where+    parseJSON (Object o) =+        BitswapLedgerObj  <$> o .: "Exchanged"+                          <*> o .: "Peer"+                          <*> o .: "Recv"+                          <*> o .: "Sent"+                          <*> o .: "Value"++    parseJSON _ = mzero++instance FromJSON CidBasesObj where+    parseJSON (Object o) =+        CidBasesObj  <$> o .: "Code"+                     <*> o .: "Name"++    parseJSON _ = mzero++instance FromJSON CidCodecsObj where+    parseJSON (Object o) =+        CidCodecsObj  <$> o .: "Code"+                      <*> o .: "Name"++    parseJSON _ = mzero++instance FromJSON CidHashesObj where+    parseJSON (Object o) =+        CidHashesObj  <$> o .: "Code"+                      <*> o .: "Name"++    parseJSON _ = mzero++instance FromJSON CidObj where+    parseJSON (Object o) =+        CidObj  <$> o .: "CidStr"+                <*> o .: "ErrorMsg"+                <*> o .: "Formatted"++    parseJSON _ = mzero++instance FromJSON BlockObj where+    parseJSON (Object o) =+        BlockObj  <$> o .: "Key"+                  <*> o .: "Size"++    parseJSON _ = mzero++instance FromJSON DagCidObj where+    parseJSON (Object o) =+        DagCidObj  <$> o .: "/"++    parseJSON _ = mzero++instance FromJSON DagResolveObj where+    parseJSON (Object o) =+        DagResolveObj  <$> o .: "Cid"+                       <*> o .: "RemPath"++    parseJSON _ = mzero++instance FromJSON DagPutObj where+    parseJSON (Object o) =+        DagPutObj  <$> o .: "Cid"++    parseJSON _ = mzero++instance FromJSON ConfigObj where+    parseJSON (Object o) =+        ConfigObj  <$> o .: "Key"+                   <*> o .: "Value"++    parseJSON _ = mzero++instance FromJSON ObjectLinkObj where+    parseJSON (Object o) =+        ObjectLinkObj  <$> o .: "Hash"+                       <*> o .: "Name"+                       <*> o .: "Size"++    parseJSON _ = mzero++instance FromJSON ObjectObj where+    parseJSON (Object o) =+        ObjectObj  <$> o .: "Hash"++    parseJSON _ = mzero++instance FromJSON ObjectLinksObj where+    parseJSON (Object v) =+        case H.lookup "Links" v of+            Just (_) -> WithLinks <$> v .: "Hash"+                                  <*> v .: "Links"++            Nothing ->+                case H.lookup "Hash" v of+                      Just (_) -> WithoutLinks <$> v .: "Hash"+                      Nothing  -> mzero++    parseJSON _ = mzero++instance FromJSON ObjectGetObj where+    parseJSON (Object o) =+        ObjectGetObj  <$> o .: "Data"+                      <*> o .: "Links"++    parseJSON _ = mzero++instance FromJSON ObjectStatObj where+    parseJSON (Object o) =+        ObjectStatObj  <$> o .: "BlockSize"+                       <*> o .: "CumulativeSize"+                       <*> o .: "DataSize"+                       <*> o .: "Hash"+                       <*> o .: "LinksSize"+                       <*> o .: "NumLinks"++    parseJSON _ = mzero++instance FromJSON ObjectChangeObj where+    parseJSON (Object o) =+        ObjectChangeObj  <$> o .: "After"+                         <*> o .: "Before"+                         <*> o .: "Path"+                         <*> o .: "Type"++    parseJSON _ = mzero++instance FromJSON DiffObj where+    parseJSON (Object o) =+        DiffObj  <$> o .: "/"++    parseJSON _ = mzero++instance FromJSON ObjectDiffObj where+    parseJSON (Object o) =+        ObjectDiffObj  <$> o .: "Changes"++    parseJSON _ = mzero++instance FromJSON PinObj where+    parseJSON (Object v) =+        case H.lookup "Progress" v of+            Just (_) -> WithProgress <$> v .: "Pins"+                                     <*> v .: "Progress"++            Nothing ->+                case H.lookup "Pins" v of+                      Just (_) -> WithoutProgress <$> v .: "Pins"+                      Nothing  -> mzero++    parseJSON _ = mzero++instance FromJSON BootstrapObj where+    parseJSON (Object o) =+        BootstrapObj  <$> o .: "Peers"++    parseJSON _ = mzero++instance FromJSON StatsBwObj where+    parseJSON (Object o) =+        StatsBwObj  <$> o .: "RateIn"+                    <*> o .: "RateOut"+                    <*> o .: "TotalIn"+                    <*> o .: "TotalOut"++    parseJSON _ = mzero++instance FromJSON StatsRepoObj where+    parseJSON (Object o) =+        StatsRepoObj  <$> o .: "NumObjects"+                      <*> o .: "RepoPath"+                      <*> o .: "RepoSize"+                      <*> o .: "StorageMax"+                      <*> o .: "Version"++    parseJSON _ = mzero++instance FromJSON VersionObj where+    parseJSON (Object o) =+        VersionObj  <$> o .: "Commit"+                    <*> o .: "Golang"+                    <*> o .: "Repo"+                    <*> o .: "System"+                    <*> o .: "Version"++    parseJSON _ = mzero++instance FromJSON IdObj where+    parseJSON (Object o) =+        IdObj  <$> o .: "Addresses"+               <*> o .: "AgentVersion"+               <*> o .: "ID"+               <*> o .: "ProtocolVersion"+               <*> o .: "PublicKey"++    parseJSON _ = mzero++instance FromJSON DnsObj where+    parseJSON (Object o) =+        DnsObj  <$> o .: "Path"++    parseJSON _ = mzero++instance FromJSON PubsubObj where+    parseJSON (Object o) =+        PubsubObj  <$> o .: "Strings"++    parseJSON _ = mzero++instance FromJSON LogLsObj where+    parseJSON (Object o) =+        LogLsObj  <$> o .: "Strings"++    parseJSON _ = mzero++instance FromJSON LogLevelObj where+    parseJSON (Object o) =+        LogLevelObj  <$> o .: "Message"++    parseJSON _ = mzero++instance FromJSON RepoVersionObj where+    parseJSON (Object o) =+        RepoVersionObj  <$> o .: "Version"++    parseJSON _ = mzero++instance FromJSON RepoFsckObj where+    parseJSON (Object o) =+        RepoFsckObj  <$> o .: "Message"++    parseJSON _ = mzero+++instance FromJSON KeyDetailsObj where+    parseJSON (Object o) =+        KeyDetailsObj <$> o .: "Id"+                      <*> o .: "Name"++    parseJSON _ = mzero++instance FromJSON KeyObj where+    parseJSON (Object o) =+        KeyObj  <$> o .: "Keys"++    parseJSON _ = mzero++instance FromJSON KeyRenameObj where+    parseJSON (Object o) =+        KeyRenameObj  <$> o .: "Id"+                      <*> o .: "Now"+                      <*> o .: "Overwrite"+                      <*> o .: "Was"++    parseJSON _ = mzero++instance FromJSON FilesStatObj where+    parseJSON (Object o) =+        FilesStatObj  <$> o .: "Hash"+                      <*> o .: "Size"+                      <*> o .: "CumulativeSize"+                      <*> o .: "Blocks"+                      <*> o .: "Type"++    parseJSON _ = mzero++instance FromJSON FilesEntryObj where+    parseJSON (Object o) =+        FilesEntryObj  <$> o .: "Name"+                       <*> o .: "Type"+                       <*> o .: "Size"+                       <*> o .: "Hash"++    parseJSON _ = mzero++instance FromJSON FilesLsObj where+    parseJSON (Object o) =+        FilesLsObj  <$> o .: "Entries"++    parseJSON _ = mzero++instance FromJSON FilesFlushObj where+    parseJSON (Object o) =+        FilesFlushObj  <$> o .: "Cid"++    parseJSON _ = mzero++-- | Defining a content type same as PlainText without charset+data IpfsText deriving Typeable++instance Servant.API.Accept IpfsText where+    contentType _ = "text" M.// "plain"++-- | @left show . TextS.decodeUtf8' . toStrict@+instance MimeUnrender IpfsText Text where+    mimeUnrender _ = left show . TextS.decodeUtf8' . toStrict+++-- | Defining a content type same as IpfsJSON+data IpfsJSON deriving Typeable++instance Servant.API.Accept IpfsJSON where+    contentType _ = "application" M.// "json"++-- | @left show . TextS.decodeUtf8' . toStrict@+instance MimeUnrender IpfsJSON Text where+    mimeUnrender _ = left show . TextS.decodeUtf8' . toStrict++type IpfsApi = "cat" :> Capture "arg" Text :> Get '[IpfsText] CatReturnType+            :<|> "ls" :> Capture "arg" Text :> Get '[JSON] LsObj+            :<|> "get" :> Capture "arg" Text :> Get '[IpfsText] GetReturnType+            :<|> "swarm" :> "peers" :> Get '[JSON] SwarmPeersObj+            :<|> "swarm" :> "connect" :> QueryParam "arg" Text :> Get '[JSON] SwarmObj+            :<|> "swarm" :> "disconnect" :> QueryParam "arg" Text :> Get '[JSON] SwarmObj+            :<|> "swarm" :> "filters" :> Get '[JSON] SwarmObj+            :<|> "swarm" :> "filters" :> "add" :> QueryParam "arg" Text :> Get '[JSON] SwarmObj+            :<|> "swarm" :> "filters" :> "rm" :> QueryParam "arg" Text :> Get '[JSON] SwarmObj+            :<|> "bitswap" :> "stat" :> Get '[JSON] BitswapStatObj+            :<|> "bitswap" :> "wantlist" :> Get '[JSON] BitswapWLObj+            :<|> "bitswap" :> "ledger" :> Capture "peerId" Text :> Get '[JSON] BitswapLedgerObj+            :<|> "bitswap" :> "reprovide" :> Get '[IpfsText] ReprovideReturnType+            :<|> "cid" :> "bases" :> Get '[JSON] [CidBasesObj]+            :<|> "cid" :> "codecs" :> Get '[JSON] [CidCodecsObj]+            :<|> "cid" :> "hashes" :> Get '[JSON] [CidHashesObj]+            :<|> "cid" :> "base32" :> Capture "cid" Text :> Get '[JSON] CidObj+            :<|> "cid" :> "format" :> Capture "cid" Text :> Get '[JSON] CidObj+            :<|> "block" :> "get" :> Capture "key" Text :> Get '[IpfsText] BlockReturnType+            :<|> "block" :> "stat" :> Capture "key" Text :> Get '[JSON] BlockObj+            :<|> "dag" :> "get" :> Capture "ref" Text :> Get '[IpfsJSON] DagReturnType+            :<|> "dag" :> "resolve" :> Capture "ref" Text :> Get '[JSON] DagResolveObj+            :<|> "config" :> Capture "ref" Text :> Get '[JSON] ConfigObj+            :<|> "config" :> Capture "arg" Text :> QueryParam "arg" Text :> Get '[JSON] ConfigObj+            :<|> "object" :> "data" :> Capture "ref" Text :> Get '[IpfsText] ObjectReturnType+            :<|> "object" :> "new" :> Get '[JSON] ObjectObj+            :<|> "object" :> "links" :>  Capture "ref" Text :> Get '[JSON] ObjectLinksObj+            :<|> "object" :> "patch" :> "add-link" :> Capture "arg" Text+                :> QueryParam "arg" Text :> QueryParam "arg" Text :> Get '[JSON] ObjectLinksObj+            :<|> "object" :> "patch" :> "rm-link" :> Capture "arg" Text+                :> QueryParam "arg" Text :> Get '[JSON] ObjectLinksObj+            :<|> "object" :> "get" :> Capture "arg" Text :> Get '[JSON] ObjectGetObj+            :<|> "object" :> "diff" :> Capture "arg" Text :> QueryParam "arg" Text :> Get '[JSON] ObjectDiffObj+            :<|> "object" :> "stat" :> Capture "arg" Text :> Get '[JSON] ObjectStatObj+            :<|> "pin" :> "add" :> Capture "arg" Text :> Get '[JSON] PinObj+            :<|> "pin" :> "rm" :> Capture "arg" Text :> Get '[JSON] PinObj+            :<|> "bootstrap" :> "add" :> QueryParam "arg" Text :> Get '[JSON] BootstrapObj+            :<|> "bootstrap" :> "list" :> Get '[JSON] BootstrapObj+            :<|> "bootstrap" :> "rm" :> QueryParam "arg" Text :> Get '[JSON] BootstrapObj+            :<|> "stats" :> "bw" :> Get '[JSON] StatsBwObj+            :<|> "stats" :> "repo" :> Get '[JSON] StatsRepoObj+            :<|> "version" :> Get '[JSON] VersionObj+            :<|> "id" :> Get '[JSON] IdObj+            :<|> "id" :> Capture "arg" Text :> Get '[JSON] IdObj+            :<|> "dns" :> Capture "arg" Text :> Get '[JSON] DnsObj+            :<|> "pubsub" :> "ls" :>  Get '[JSON] PubsubObj+            :<|> "pubsub" :> "peers" :>  Get '[JSON] PubsubObj+            :<|> "pubsub" :> "pub" :> Capture "arg" Text :> QueryParam "arg" Text :> Get '[JSON] NoContent+            :<|> "log" :> "ls" :>  Get '[JSON] LogLsObj+            :<|> "log" :> "level" :> Capture "arg" Text :> QueryParam "arg" Text :> Get '[JSON] LogLevelObj+            :<|> "repo" :> "version" :>  Get '[JSON] RepoVersionObj+            :<|> "repo" :> "fsck" :>  Get '[JSON] RepoFsckObj+            :<|> "key" :> "gen" :> Capture "arg" Text :> QueryParam "type" Text :> Get '[JSON] KeyDetailsObj+            :<|> "key" :> "list" :>  Get '[JSON] KeyObj+            :<|> "key" :> "rename" :> Capture "arg" Text :> QueryParam "arg" Text :> Get '[JSON] KeyRenameObj+            :<|> "key" :> "rm" :> Capture "arg" Text :> Get '[JSON] KeyObj+            :<|> "files" :> "chcid" :> QueryParam "arg" Text :> QueryParam "cid-version" Int :> Get '[JSON] NoContent+            :<|> "files" :> "cp" :> QueryParam "arg" Text :> QueryParam "arg" Text :> Get '[JSON] NoContent+            :<|> "files" :> "flush" :> QueryParam "arg" Text :> Get '[JSON] FilesFlushObj+            :<|> "files" :> "ls" :> QueryParam "arg" Text :> Get '[JSON] FilesLsObj+            :<|> "files" :> "mkdir" :> QueryParam "arg" Text :> Get '[JSON] NoContent+            :<|> "files" :> "mv" :> QueryParam "arg" Text :> QueryParam "arg" Text :> Get '[JSON] NoContent+            :<|> "files" :> "read" :> QueryParam "arg" Text :> Get '[IpfsText] FilesReadType+            :<|> "files" :> "rm" :> QueryParam "arg" Text :> QueryParam "recursive" Bool :> Get '[JSON] NoContent+            :<|> "files" :> "stat" :> QueryParam "arg" Text :> Get '[JSON] FilesStatObj+            :<|> "shutdown" :> Get '[JSON] NoContent

@@ -0,0 +1,154 @@+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE TypeOperators         #-}++-- |+-- Module      :  Network.Ipfs.Api.Types.Stream+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- Ipfs Stream API types.+--++module Network.Ipfs.Api.Types.Stream where++import           Control.Monad+import           Data.Aeson+import qualified Data.ByteString.Lazy.Char8 ()+import           Data.Int+import           Data.Text+import           Network.HTTP.Client        ()+import           Servant.API++import           Network.Ipfs.Api.Types     (IpfsText)++type LogReturnType = Text++data PingObj = PingObj+    { success :: Bool+    , text    :: Text+    , time    :: Int64+    }+    deriving (Show, Eq)++data ResponseObj = ResponseObj+    { addrs :: Maybe [Text]+    , id    :: Text+    }+    deriving (Show, Eq)++data DhtObj = DhtObj+    { extra     :: Text+    , addrid    :: Text+    , responses :: Maybe [ResponseObj]+    , addrType  :: Int+    }+    deriving (Show, Eq)++data RepoKeyObj = RepoKeyObj+    { repoSlash :: Text+    }+    deriving (Show, Eq)++data RepoGcObj = RepoGcObj+    { repoKey :: RepoKeyObj+    }+    deriving (Show, Eq)++data RepoVerifyObj = RepoVerifyObj+    { msg      :: Text+    , progress :: Int+    }+    deriving (Show, Eq)++data RefsObj = RefsObj+    { error :: Text+    , ref   :: Text+    }+    deriving (Show, Eq)++data PubsubSubObj = PubsubSubObj+    { mssgdata :: Text+    , from     :: Text+    , seqno    :: Text+    , topicIDs :: [Text]+    }+    deriving (Show, Eq)++instance FromJSON PingObj where+    parseJSON (Object o) =+        PingObj  <$> o .: "Success"+                 <*> o .: "Text"+                 <*> o .: "Time"++    parseJSON _ = mzero++instance FromJSON DhtObj where+    parseJSON (Object o) =+        DhtObj   <$> o .: "Extra"+                 <*> o .: "ID"+                 <*> o .: "Responses"+                 <*> o .: "Type"++    parseJSON _ = mzero++instance FromJSON ResponseObj where+    parseJSON (Object o) =+        ResponseObj  <$> o .: "Addrs"+                     <*> o .: "ID"++    parseJSON _ = mzero++instance FromJSON RepoKeyObj where+    parseJSON (Object o) =+        RepoKeyObj  <$> o .: "/"++    parseJSON _ = mzero++instance FromJSON RepoGcObj where+    parseJSON (Object o) =+        RepoGcObj  <$> o .: "Key"++    parseJSON _ = mzero++instance FromJSON RepoVerifyObj where+    parseJSON (Object o) =+        RepoVerifyObj <$> o .: "Msg"+                      <*> o .: "Progress"++    parseJSON _ = mzero++instance FromJSON RefsObj where+    parseJSON (Object o) =+        RefsObj  <$> o .: "Err"+                 <*> o .: "Ref"++    parseJSON _ = mzero++instance FromJSON PubsubSubObj where+    parseJSON (Object o) =+        PubsubSubObj   <$> o .: "data"+                       <*> o .: "from"+                       <*> o .: "seqno"+                       <*> o .: "topicIDs"++    parseJSON _ = mzero++type IpfsStreamApi = "ping" :> Capture "arg" Text :> StreamGet NewlineFraming JSON ( SourceIO PingObj )+                :<|> "dht" :> "findpeer" :> Capture "arg" Text :> StreamGet NewlineFraming JSON ( SourceIO DhtObj )+                :<|> "dht" :> "findprovs" :> Capture "arg" Text :> StreamGet NewlineFraming JSON ( SourceIO DhtObj )+                :<|> "dht" :> "get" :> Capture "arg" Text :> StreamGet NewlineFraming JSON ( SourceIO DhtObj )+                :<|> "dht" :> "provide" :> Capture "arg" Text :> StreamGet NewlineFraming JSON ( SourceIO DhtObj )+                :<|> "dht" :> "query" :>  Capture "arg" Text :>  StreamGet NewlineFraming JSON ( SourceIO DhtObj )+                :<|> "log" :> "tail" :>  StreamGet NewlineFraming IpfsText ( SourceIO LogReturnType)+                :<|> "repo" :> "gc" :>  StreamGet NewlineFraming JSON ( SourceIO RepoGcObj)+                :<|> "repo" :> "verify" :>  StreamGet NewlineFraming JSON ( SourceIO RepoVerifyObj)+                :<|> "refs" :> Capture "arg" Text :> StreamGet NewlineFraming JSON (SourceIO RefsObj)+                :<|> "refs" :> "local" :> StreamGet NewlineFraming JSON (SourceIO RefsObj)+                :<|> "pubsub" :> "sub" :>  Capture "arg" Text :>  StreamGet NewlineFraming JSON ( SourceIO PubsubSubObj )

@@ -0,0 +1,47 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- |+-- Module      :  Network.Ipfs.Client+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unknown+--+-- IPFS daemon HTTP client.+--++module Network.Ipfs.Client where++import           Control.Monad.Except+import           Control.Monad.Reader+import           Network.HTTP.Client  as Net hiding (Proxy)+import           Servant.Client++newtype IpfsT m a = IpfsT { unIpfs :: ReaderT (Manager, BaseUrl, String) (ExceptT ClientError m) a }+  deriving ( Functor+           , Applicative+           , Monad+           , MonadIO+           , MonadReader (Manager, BaseUrl, String)+           , MonadError ClientError+           )++instance MonadTrans IpfsT where+  lift = IpfsT . lift . lift++type Ipfs a = IpfsT IO a++-- | 'IpfsT' monad runner.+runIpfs' :: BaseUrl -> Ipfs a -> IO ()+runIpfs' url ipfs = do+  manager' <- liftIO $ newManager defaultManagerSettings+  ret <- runExceptT (runReaderT (unIpfs ipfs) (manager', url, showBaseUrl url))+  case ret of+    Left err -> putStrLn $ "Error: " ++ show err+    Right _  -> putStr ""++-- | 'IpfsT' monad runner with default arguments.+runIpfs :: Ipfs a -> IO ()+runIpfs = runIpfs' (BaseUrl Http "localhost" 5001 "/api/v0")

@@ -53,10 +53,8 @@     , MethodName      -- * JSON-RPC client settings-    , JsonRpcClient+    , JsonRpcClient(..)     , defaultSettings-    , jsonRpcServer-    , jsonRpcManager      -- * Error handling     , JsonRpcException(..)@@ -68,49 +66,55 @@ import           Control.Monad           ((<=<)) import           Control.Monad.Catch     (MonadThrow (..)) import           Control.Monad.IO.Class  (MonadIO (..))-import           Control.Monad.State     (MonadState)+import           Control.Monad.State     (MonadState, get) import           Crypto.Number.Generate  (generateMax) import           Data.Aeson              (FromJSON (..), ToJSON (..),                                           Value (String), eitherDecode, encode,                                           object, withObject, (.:), (.:?), (.=)) import           Data.ByteString.Lazy    (ByteString) import           Data.Text               (Text, unpack)-import           Lens.Micro.Mtl          (use)-import           Lens.Micro.TH           (makeLenses) import           Network.HTTP.Client     (Manager, RequestBody (RequestBodyLBS),                                           httpLbs, method, newManager,                                           parseRequest, requestBody,                                           requestHeaders, responseBody) import           Network.HTTP.Client.TLS (tlsManagerSettings)+import qualified Network.WebSockets      as WS (Connection, receiveData,+                                                sendTextData)  -- | JSON-RPC monad constrait. type JsonRpcM m = (MonadIO m, MonadThrow m, MonadState JsonRpcClient m)  -- | JSON-RPC client state vars.-data JsonRpcClient = JsonRpcClient-    { _jsonRpcManager :: !Manager    -- ^ HTTP connection manager.-    , _jsonRpcServer  :: !String     -- ^ Remote server URI.+data JsonRpcClient = JsonRpcHttpClient+    { jsonRpcManager :: Manager+    -- ^ HTTP connection manager.+    , jsonRpcServer  :: String+    -- ^ Remote server URI.     }--$(makeLenses ''JsonRpcClient)+    | JsonRpcWsClient+    { jsonRpcWsConnection :: WS.Connection+    -- ^ WebSocket connection.+    }  -- | Create default 'JsonRpcClient' settings. defaultSettings :: MonadIO m                 => String           -- ^ JSON-RPC server URI                 -> m JsonRpcClient-defaultSettings srv = liftIO $ JsonRpcClient+defaultSettings srv = liftIO $ JsonRpcHttpClient   <$> newManager tlsManagerSettings   <*> pure srv  instance Show JsonRpcClient where-    show JsonRpcClient{..} = "JsonRpcClient<" ++ _jsonRpcServer ++ ">"+    show JsonRpcHttpClient{..} = "<JSON-RPC HTTP Client>"+    show JsonRpcWsClient{..} = "<JSON-RPC WebSocket Client>"  -- | JSON-RPC request. data Request = Request     { rqMethod :: !Text     , rqId     :: !Int     , rqParams :: !Value-    } deriving (Eq, Show)+    }+    deriving (Eq, Show)  instance ToJSON Request where     toJSON rq = object [ "jsonrpc" .= String "2.0"@@ -122,7 +126,8 @@ -- | JSON-RPC response. data Response = Response     { rsResult :: !(Either RpcError Value)-    } deriving (Eq, Show)+    }+    deriving (Eq, Show)  instance FromJSON Response where     parseJSON =@@ -135,7 +140,8 @@     { errCode    :: !Int     , errMessage :: !Text     , errData    :: !(Maybe Value)-    } deriving Eq+    }+    deriving Eq  instance Show RpcError where     show (RpcError code msg dat) =@@ -148,8 +154,7 @@                        <*> v .: "message"                        <*> v .:? "data" -data JsonRpcException-    = ParsingException String+data JsonRpcException = ParsingException String     | CallException RpcError     deriving (Show, Eq) @@ -184,15 +189,22 @@   where     maxInt = toInteger (maxBound :: Int)     connection body = do-        serverUri <- use jsonRpcServer-        request <- parseRequest serverUri-        let request' = request-                     { requestBody = RequestBodyLBS body-                     , requestHeaders = [("Content-Type", "application/json")]-                     , method = "POST"-                     }-        manager <- use jsonRpcManager-        responseBody <$> liftIO (httpLbs request' manager)+        jsonRpcInstance <- get+        case jsonRpcInstance of+            JsonRpcHttpClient{..} -> do+                request <- parseRequest jsonRpcServer+                let request' = request {+                      requestBody = RequestBodyLBS body+                    , requestHeaders = [("Content-Type", "application/json")]+                    , method = "POST"+                    }+                responseBody <$> liftIO (httpLbs request' jsonRpcManager)++            JsonRpcWsClient{..} -> liftIO $ do+                WS.sendTextData jsonRpcWsConnection body+                WS.receiveData jsonRpcWsConnection++  decodeResponse :: (MonadThrow m, FromJSON a)                => ByteString

@@ -0,0 +1,28 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      :  Network.Polkadot.Api.Account+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- Polkadot RPC methods with `account` prefix.+--++module Network.Polkadot.Api.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"

@@ -0,0 +1,78 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      :  Network.Polkadot.Api.Author+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- Polkadot RPC methods with `author` prefix.+--++module Network.Polkadot.Api.Author where++import           Data.Text                  (Text)++import           Data.ByteArray.HexString   (HexString)+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"

@@ -0,0 +1,26 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      :  Network.Polkadot.Api.Babe+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- Polkadot RPC methods with `babe` prefix.+--++module Network.Polkadot.Api.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"

@@ -0,0 +1,49 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      :  Network.Polkadot.Api.Chain+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- Polkadot RPC methods with `chain` prefix.+--++module Network.Polkadot.Api.Chain where++import           Data.ByteArray.HexString   (HexString)+import           Network.JsonRpc.TinyClient (JsonRpc (..))+import           Network.Polkadot.Api.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"

@@ -0,0 +1,69 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      :  Network.Polkadot.Api.Childstate+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- Polkadot RPC methods with `childstate` prefix.+--++module Network.Polkadot.Api.Childstate where++import           Data.Text                  (Text)++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"

@@ -0,0 +1,54 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      :  Network.Polkadot.Api.Contracts+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- Polkadot RPC methods with `contracts` prefix.+--++module Network.Polkadot.Api.Contracts where++import           Data.Text                  (Text)++import           Data.ByteArray.HexString   (HexString)+import           Network.JsonRpc.TinyClient (JsonRpc (..))+import           Network.Polkadot.Api.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"

@@ -0,0 +1,42 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      :  Network.Polkadot.Api.Engine+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- Polkadot RPC methods with `engine` prefix.+--++module Network.Polkadot.Api.Engine where++import           Data.ByteArray.HexString   (HexString)+import           Network.JsonRpc.TinyClient (JsonRpc (..))+import           Network.Polkadot.Api.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"

@@ -0,0 +1,26 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      :  Network.Polkadot.Api.Grandpa+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- Polkadot RPC methods with `grandpa` prefix.+--++module Network.Polkadot.Api.Grandpa where++import           Data.Aeson                 (Object)+import           Data.Text                  (Text)++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"

@@ -0,0 +1,42 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      :  Network.Polkadot.Api.Offchain+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- Polkadot RPC methods with `offchain` prefix.+--++module Network.Polkadot.Api.Offchain where++import           Data.ByteArray.HexString   (HexString)+import           Network.JsonRpc.TinyClient (JsonRpc (..))+import           Network.Polkadot.Api.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"

@@ -0,0 +1,30 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      :  Network.Polkadot.Api.Payment+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- Polkadot RPC methods with `payment` prefix.+--++module Network.Polkadot.Api.Payment where++import           Data.ByteArray.HexString   (HexString)+import           Network.JsonRpc.TinyClient (JsonRpc (..))+import           Network.Polkadot.Api.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"

@@ -0,0 +1,25 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      :  Network.Polkadot.Api.Rpc+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- Polkadot RPC methods with `rpc` prefix.+--++module Network.Polkadot.Api.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"

@@ -0,0 +1,184 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      :  Network.Polkadot.Api.State+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- Polkadot RPC methods with `state` prefix.+--++module Network.Polkadot.Api.State where++import           Data.Text                  (Text)++import           Data.ByteArray.HexString   (HexString)+import           Network.JsonRpc.TinyClient (JsonRpc (..))+import           Network.Polkadot.Api.Types (Metadata, 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 Metadata+{-# 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"

@@ -0,0 +1,97 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      :  Network.Polkadot.Api.System+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- Polkadot RPC methods with `system` prefix.+--++module Network.Polkadot.Api.System where++import           Data.Aeson                 (Object)+import           Data.Text                  (Text)++import           Network.JsonRpc.TinyClient (JsonRpc (..))+import           Network.Polkadot.Api.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"

@@ -0,0 +1,270 @@+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE TemplateHaskell            #-}++-- |+-- Module      :  Network.Polkadot.Api.Types+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- Polkadot JSON-RPC types.+--++module Network.Polkadot.Api.Types where++import           Data.Aeson               (FromJSON (..),+                                           Options (fieldLabelModifier),+                                           ToJSON (..), Value (String),+                                           defaultOptions)+import           Data.Aeson.TH            (deriveJSON)+import           Data.Text                (Text)+import           Data.Word                (Word32, Word64, Word8)+import           GHC.Generics             (Generic)++import           Data.ByteArray.HexString (HexString)+import           Data.String.Extra        (toLowerFirst)++-- | 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 = toLowerFirst . 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 = toLowerFirst . 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 = toLowerFirst . 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 = toLowerFirst . drop 4 }) ''ContractExecResult)++type Metadata = Value++-- | 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 = toLowerFirst . 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 = toLowerFirst . 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 = toLowerFirst . 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 = toLowerFirst . 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 = toLowerFirst . drop 3 }) ''ImportedAux)++data CreatedBlock = CreatedBlock+    { createdBlockHash :: HexString+    , createdBlockAux  :: ImportedAux+    }+    deriving (Eq, Generic, Show)++$(deriveJSON (defaultOptions+    { fieldLabelModifier = toLowerFirst . drop 12 }) ''CreatedBlock)++-- | Abstraction over a block header for a substrate chain.+data Header = Header+    { headerParentHash     :: HexString+    -- ^ The parent hash.+    , headerNumber         :: Int+    -- ^ The block number.+    , headerStateRoot      :: HexString+    -- ^ The state trie merkle root+    , headerExtrinsicsRoot :: HexString+    -- ^ The merkle root of the extrinsics.+    , headerDigest         :: HexString+    -- ^ A chain-specific digest of data useful for light clients or referencing auxiliary data.+    }+    deriving (Eq, Generic, Show)++$(deriveJSON (defaultOptions+    { fieldLabelModifier = toLowerFirst . drop 5 }) ''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 = toLowerFirst . 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 = toLowerFirst . drop 6 }) ''SignedBlock)

@@ -0,0 +1,20 @@+-- |+-- Module      :  Network.Web3+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unportable+--+-- Client library for Third Generation of Web.+--++module Network.Web3+    (+    -- * Web3 library uses JSON-RPC over WebSocket/HTTP(S) to access node functionality.+      Web3+    , runWeb3+    ) where++import           Network.Web3.Provider (Web3, runWeb3)

@@ -0,0 +1,132 @@+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE RecordWildCards            #-}++-- |+-- Module      :  Network.Web3.Provider+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  portable+--+-- Web3 service provider.+--++module Network.Web3.Provider where++import           Control.Concurrent.Async   (Async, async)+import           Control.Exception          (Exception, try)+import           Control.Monad.Catch        (MonadThrow)+import           Control.Monad.IO.Class     (MonadIO (..))+import           Control.Monad.State        (MonadState (..))+import           Control.Monad.Trans.State  (StateT, evalStateT, withStateT)+import           Data.Default               (Default (..))+import           Data.Text                  (Text)+import           GHC.Generics               (Generic)+import           Network.HTTP.Client        (Manager)+import qualified Network.Socket             as S+import qualified Network.WebSockets         as WS (Connection,+                                                   defaultConnectionOptions,+                                                   newClientConnection,+                                                   sendClose)+import qualified Network.WebSockets.Stream  as Stream++import           Network.JsonRpc.TinyClient (JsonRpc, JsonRpcClient (..),+                                             defaultSettings, jsonRpcManager)++-- | Any communication with node wrapped with 'Web3' monad+newtype Web3 a = Web3 { unWeb3 :: StateT JsonRpcClient IO a }+    deriving (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadState JsonRpcClient)++instance JsonRpc Web3++-- | Some peace of error response+data Web3Error = JsonRpcFail !String+    | ParserFail !String+    | UserFail !String+    deriving (Show, Eq, Generic)++instance Exception Web3Error++--TODO: Change to `HttpProvider ServerUri | IpcProvider FilePath` to support IPC+-- | Web3 Provider+data Provider = HttpProvider String+    | WsProvider String Int+    deriving (Show, Eq, Generic)++-- | Default Provider URI+instance Default Provider where+  def = HttpProvider "http://localhost:8545"++-- | 'Web3' monad runner, using the supplied Manager+runWeb3With :: MonadIO m+            => Manager+            -> Provider+            -> Web3 a+            -> m (Either Web3Error a)+runWeb3With manager provider f = do+    runWeb3' provider Web3 { unWeb3 = withStateT changeManager $ unWeb3 f}+    where+      changeManager jRpcClient = case jRpcClient of+        JsonRpcHttpClient{..} -> jRpcClient { jsonRpcManager = manager }+        JsonRpcWsClient{..}   -> jRpcClient++-- | 'Web3' monad runner+runWeb3' :: MonadIO m+         => Provider+         -> Web3 a+         -> m (Either Web3Error a)+runWeb3' (HttpProvider uri) f = do+    cfg <- defaultSettings uri+    liftIO . try . flip evalStateT cfg . unWeb3 $ f++runWeb3' (WsProvider host port) f = do+    connection <- liftIO $ getConnection host port "/"+    let currentClient = JsonRpcWsClient { jsonRpcWsConnection = connection }+    response <- liftIO $ try . flip evalStateT currentClient . unWeb3 $ f+    liftIO $ WS.sendClose connection ("Bye-" :: Text)+    return response++-- | 'Web3' runner for default Http provider+runWeb3 :: MonadIO m+        => Web3 a+        -> m (Either Web3Error a)+{-# INLINE runWeb3 #-}+runWeb3 = runWeb3' def++-- | Fork 'Web3' with the same 'Provider' and 'Manager'+forkWeb3 :: Web3 a -> Web3 (Async a)+forkWeb3 f = liftIO . async . evalStateT (unWeb3 f) =<< get++-- | Returns a WebSocket Connection Instance+getConnection :: String           -- ^ Host+              -> Int              -- ^ Port+              -> String           -- ^ Path+              -> IO WS.Connection+{-# INLINE getConnection #-}+getConnection host port path = do+    -- Create and connect socket+    let hints = S.defaultHints+                    {S.addrSocketType = S.Stream}++        -- Correct host and path.+        fullHost = if port == 80 then host else (host ++ ":" ++ show port)+        path0     = if null path then "/" else path++    addr:_ <- S.getAddrInfo (Just hints) (Just host) (Just $ show port)+    sock      <- S.socket (S.addrFamily addr) S.Stream S.defaultProtocol+    S.setSocketOption sock S.NoDelay 1++    -- Connect WebSocket and run client++    res <-  ( S.connect sock (S.addrAddress addr) >>+            Stream.makeSocketStream sock) >>=+              (\stream ->+                    WS.newClientConnection stream fullHost+                    path0 WS.defaultConnectionOptions [] )+    return res

@@ -1,5 +1,5 @@ # Resolver to choose a 'specific' stackage snapshot or a compiler version.-resolver: lts-15.10+resolver: lts-15.13  # User packages to be built. packages:@@ -9,7 +9,6 @@ extra-deps: - relapse-1.0.0.0@sha256:b89ea23189e07f377be4e2a4deccf3d6ba7f547ed8ad77e27b35d78801efd81c - vinyl-0.12.1@sha256:03f5e246fae2434250987bbfe708015dc6e23f60c20739c34738acde1383b96c-- time-1.8.0.4@sha256:3f6eddf238b828eb4f82683acce1c3afe64784f0d20114239b738c123316c85c  # Dependencies bounds pvp-bounds: both

@@ -0,0 +1,151 @@+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns        #-}+{-# LANGUAGE OverloadedLists       #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE QuasiQuotes           #-}+{-# LANGUAGE TemplateHaskell       #-}++-- |+-- Module      :  Network.Ethereum.Test.ComplexStorageSpec+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unportable+--+-- ComplexStorage is a Solidity contract which has global variables of+-- several different types. The point of this test is to test the encoding+-- of a complicated Solidity tuple, consisting of dynamically and statically+-- sized components.+--++module Network.Ethereum.Test.ComplexStorageSpec where++import           Control.Concurrent.Async     (async, wait)+import           Control.Concurrent.MVar      (newEmptyMVar, putMVar, takeMVar)+import           Control.Monad.IO.Class       (liftIO)+import           Data.Default                 (def)++import           Network.Ethereum             hiding (convert)+import           Network.Ethereum.Api.Types   (Filter (..))+import           Network.Ethereum.Contract    (new)+import           Network.Ethereum.Contract.TH+import           Network.Ethereum.Test.Utils+++import           Test.Hspec++[abiFrom|test/contracts/ComplexStorage.json|]++deploy :: IO Address+deploy = do+    Just address <- web3 $ withAccount () $ withParam id $ new ComplexStorageContract+    putStrLn $ "ComplexStorage: " ++ show address+    return address++spec :: Spec+spec = deploy `before` complexStorageSpec++complexStorageSpec :: SpecWith Address+complexStorageSpec = do+  describe "can interact with a ComplexStorage contract" $ do+        -- todo: these should ideally be arbitrary!+        let sUint   = 1+            sInt    = -1+            sBool   = True+            sInt224 = 221+            sBools   = [True, False]+            sInts    = [1, 1, -3]+            sString  = "hello"+            sBytes16 = "\x12\x34\x56\x78\x12\x34\x56\x78\x12\x34\x56\x78\x12\x34\x56\x78"+            sByte2sElem = "\x12\x34"+            sByte2sVec = [sByte2sElem, sByte2sElem, sByte2sElem, sByte2sElem]+            sByte2s = [sByte2sVec, sByte2sVec]++        it "can set the values of a ComplexStorage and validate them with an event" $ \storage -> do+            let fltr = (def :: Filter ValsSet) { filterAddress = Just [storage] }+            -- kick off listening for the ValsSet event+            vals <- newEmptyMVar+            fiber <- async . web3 $+                event fltr $ \vs -> do+                    liftIO $ putMVar vals vs+                    pure TerminateEvent+            -- kick off tx+            _ <- contract storage $ setValues+                                    sUint+                                    sInt+                                    sBool+                                    sInt224+                                    sBools+                                    sInts+                                    sString+                                    sBytes16+                                    sByte2s+            -- wait for its ValsSet event+            wait fiber+            (ValsSet vsA vsB vsC vsD vsE vsF vsG vsH vsI) <- takeMVar vals+            vsA `shouldBe` sUint+            vsB `shouldBe` sInt+            vsC `shouldBe` sBool+            vsD `shouldBe` sInt224+            vsE `shouldBe` sBools+            vsF `shouldBe` sInts+            vsG `shouldBe` sString+            vsH `shouldBe` sBytes16+            vsI `shouldBe` sByte2s++        it "can verify that it set the values correctly" $ \storage -> do+            -- Write a values+            _ <- contract storage $ setValues+                                    sUint+                                    sInt+                                    sBool+                                    sInt224+                                    sBools+                                    sInts+                                    sString+                                    sBytes16+                                    sByte2s+            -- Read a couple of values+            (uintVal', intVal', boolVal', int224Val', boolsVal, intsVal, stringVal', bytes16Val', bytes2s)+                <- contract storage $ (,,,,,,,,)+                    <$> uintVal+                    <*> intVal+                    <*> boolVal+                    <*> int224Val+                    <*> boolVectorVal 0+                    <*> intListVal 0+                    <*> stringVal+                    <*> bytes16Val+                    <*> bytes2VectorListVal 0 0++            uintVal'    `shouldBe` sUint+            intVal'     `shouldBe` sInt+            boolVal'    `shouldBe` sBool+            int224Val'  `shouldBe` sInt224+            boolsVal    `shouldBe` True+            intsVal     `shouldBe` head sInts+            stringVal'  `shouldBe` sString+            bytes16Val' `shouldBe` sBytes16+            bytes2s     `shouldBe` sByte2sElem++        it "can decode a complicated value correctly" $ \storage -> do+            -- Write a values+            _ <- contract storage $ setValues+                                    sUint+                                    sInt+                                    sBool+                                    sInt224+                                    sBools+                                    sInts+                                    sString+                                    sBytes16+                                    sByte2s+            -- Read a all values+            allVals <- contract storage getVals+            allVals `shouldBe` (sUint, sInt, sBool, sInt224, sBools, sInts, sString, sBytes16, sByte2s)

@@ -0,0 +1,36 @@+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE QuasiQuotes           #-}++-- |+-- Module      :  Network.Ethereum.Test.ERC20Spec+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unportable+--+--++module Network.Ethereum.Test.ERC20Spec where++import           Test.Hspec++import           Network.Ethereum             (Account, UIntN)+import           Network.Ethereum.Contract.TH (abiFrom)+import           Network.JsonRpc.TinyClient   (JsonRpc)++[abiFrom|examples/token/ERC20.json|]++-- this spec is just to test compilation+spec :: Spec+spec = return ()++getBalance :: (JsonRpc m, Account p t, Functor (t m))+           => t m (UIntN 256)+getBalance = balanceOf "0x1234567890123456789011234567890234567890"

@@ -0,0 +1,193 @@+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE LambdaCase            #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns        #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE QuasiQuotes           #-}+{-# LANGUAGE RecordWildCards       #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TemplateHaskell       #-}+{-# LANGUAGE TypeApplications      #-}++-- Module      :  Network.Ethereum.Test.LinearizationSpec+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unportable+--++module Network.Ethereum.Test.LinearizationSpec where++import           Control.Concurrent              (forkIO)+import           Control.Concurrent.Async        (forConcurrently_)+import           Control.Concurrent.MVar+import           Control.Concurrent.STM          (atomically)+import           Control.Concurrent.STM.TQueue   (TQueue, flushTQueue,+                                                  newTQueueIO, writeTQueue)+import           Control.Monad                   (void)+import           Control.Monad.IO.Class          (MonadIO (..))+import           Control.Monad.Trans.Reader      (ReaderT, ask)+import           Data.Default+import           Data.Either+import           Data.List                       (sort)+import           Data.Maybe                      (fromJust)+import           System.Random                   (randomRIO)+import           Test.Hspec++import           Network.Ethereum+import qualified Network.Ethereum.Api.Eth        as Eth+import           Network.Ethereum.Api.Types      (Change (..), Filter (..),+                                                  TxReceipt, unQuantity)+import           Network.Ethereum.Contract       (new)+import           Network.Ethereum.Contract.Event+import           Network.Ethereum.Contract.TH    (abiFrom)+import           Network.Ethereum.Test.Utils+import           Network.Web3++[abiFrom|test/contracts/Linearization.json|]++deploy :: IO Address+deploy = do+    Just address <- web3 $ withAccount () $ withParam id $ new LinearizationContract+    putStrLn $ "Linearization: " ++ show address+    return address++spec :: Spec+spec = do+    deploy `before` linearizationSpec+    deploy `before` floodSpec++floodCount :: Int+floodCount = 200++linearizationSpec :: SpecWith Address+linearizationSpec =+    describe "can bundle and linearize events" $ do+        it "can call e12" $ \linearization -> do+            var <- monitorE1OrE2 linearization+            _ <- contract linearization e12+            res <- takeMVar var+            res `shouldSatisfy` isLeft++        it "can call e21" $ \linearization -> do+            -- wait on the next block+            web3 Eth.blockNumber >>= \bn -> awaitBlock (bn + 1)+            var <- monitorE1OrE2 linearization+            _ <- contract linearization e21+            res <- takeMVar var+            res `shouldSatisfy` isRight++singleFlood :: forall m. (MonadIO m) => Address -> m TxReceipt+singleFlood linearization = liftIO $ do+    rando :: Int <- randomRIO (1, 4)+    contract linearization $+        case rando of+            1 -> e1+            2 -> e2+            3 -> e3+            4 -> e4+            _ -> error "got a number outside of (1,4) after randomR (1,4)"++floodSpec :: SpecWith Address+floodSpec = describe "can correctly demonstrate the difference between `multiEvent` and multiple `event`s" $ do+    it "properly linearizes with `multiEvent` when flooded and doesn't with multiple `event`s" $ \linearization -> do+        multiQ <- monitorAllFourMulti linearization+        parQ <- monitorAllFourPar linearization+        -- to let the filter settle so we dont block indefinitely on missing events?+        sleepBlocks 10++        -- flood em and wait for all to finish+        liftIO . forConcurrently_ [1..floodCount] . const $ singleFlood linearization++        -- to let the event listeners catch up+        sleepBlocks 10++        -- wait for all multiEvents to be received and flush em out+        multiReceivedEvents <- liftIO . atomically $ flushTQueue multiQ+        parReceivedEvents <- liftIO . atomically $ flushTQueue parQ++        -- did we get at least 1/4 of the events? (this is a gotcha when flooding, sometimes nonces get repeated)+        length multiReceivedEvents `shouldSatisfy` (>= (floodCount `div` 4))+        length parReceivedEvents `shouldSatisfy` (>= (floodCount `div` 4))++        -- did both listeners see the same amount of events?+        length multiReceivedEvents `shouldBe` length parReceivedEvents++        -- the events pushed into the multi TQueue should already be sorted if they happened in the right order+        sort multiReceivedEvents `shouldBe` multiReceivedEvents+        -- the events pushed into the TQueue should not be sorted if they didnt come in in the right order+        sort parReceivedEvents `shouldNotBe` parReceivedEvents++monitorE1OrE2 :: Address -> IO (MVar (Either E1 E2))+monitorE1OrE2 addr = do+    var <- newEmptyMVar+    let fltr1 = (def :: Filter E1) { filterAddress = Just [addr] }+        fltr2 = (def :: Filter E2) { filterAddress = Just [addr] }+        filters = fltr1 :? fltr2 :? NilFilters+        handler1 ev1 = do+            liftIO $ putMVar var (Left ev1)+            return TerminateEvent+        handler2 ev2 = do+            liftIO $ putMVar var (Right ev2)+            return TerminateEvent+        handlers = H handler1 :& H handler2 :& RNil+    _ <- web3 $ multiEvent filters handlers+    return var++data EventTag = ETE1+    | ETE2+    | ETE3+    | ETE4+    deriving (Eq, Read, Show)++instance {-# OVERLAPPING #-} Ord (EventTag, Integer, Integer) where+    (_, b1, t1) `compare` (_, b2, t2) =+        let bCmp = b1 `compare` b2+        in if bCmp == EQ then t1 `compare` t2+                         else bCmp++monitorAllFourMulti :: Address+                    -> IO (TQueue (EventTag, Integer, Integer))+monitorAllFourMulti addr = do+    q <- newTQueueIO+    let f :: forall a. Default (Filter a) => Filter a+        f = defFilter addr+        h = enqueueingHandler q+        filters = f @E1 :? f @E2 :? f @E3 :? f @E4 :? NilFilters+        handlers = h ETE1 :& h ETE2 :& h ETE3 :& h ETE4 :& RNil+    void . web3 $ multiEvent filters handlers+    return q++monitorAllFourPar :: Address+                  -> IO (TQueue (EventTag, Integer, Integer))+monitorAllFourPar addr = do+    q <- newTQueueIO+    let f :: forall a. Default (Filter a) => Filter a+        f = defFilter addr+        h = enqueueingHandler q+        unH (H h) = h++    void . forkIO . web3 $ event (f @E1) (unH $ h ETE1)+    void . forkIO . web3 $ event (f @E2) (unH $ h ETE2)+    void . forkIO . web3 $ event (f @E3) (unH $ h ETE3)+    void . forkIO . web3 $ event (f @E4) (unH $ h ETE4)+    return q++defFilter :: forall a. Default (Filter a) => Address -> Filter a+defFilter addr = (def :: Filter a) { filterAddress = Just [addr] }++enqueueingHandler :: forall a. TQueue (EventTag, Integer, Integer)+                  -> EventTag+                  -> Handler (ReaderT Change Web3 EventAction) a+enqueueingHandler q tag = H . const $ do+    Change{..} <- ask+    let bn = unQuantity $ fromJust changeBlockNumber+        li = unQuantity $ fromJust changeLogIndex+    liftIO . atomically $ writeTQueue q (tag, bn, li)+    return ContinueEvent

@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings #-}++-- Module      :  Network.Ethereum.Test.LocalAccountSpec+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unportable+--+-- Simple local account transaction test.+--++module Network.Ethereum.Test.LocalAccountSpec where++import           Lens.Micro                  ((.~))+import           Lens.Micro.Mtl              ((.=))+import           Test.Hspec++import           Crypto.Ecdsa.Utils          (derivePubKey, importKey)+import           Data.ByteArray.HexString    (HexString)+import           Data.Solidity.Prim.Address  (fromPubKey)+import           Network.Ethereum.Account    (LocalKey (..), send, to, value,+                                              withAccount, withParam)+import           Network.Ethereum.Api.Eth    (getBalance)+import           Network.Ethereum.Api.Types  (DefaultBlock (Pending))+import           Network.Ethereum.Test.Utils (web3)+import           Network.Ethereum.Unit       (Ether, toWei)++spec :: Spec+spec = describe "Local account transactions" $ do+    it "should send value" $ do+        let key = "0x0102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f20" :: HexString+            local = LocalKey (importKey key) 420123+            localAddress = fromPubKey (derivePubKey $ importKey key)+            dest = "0x0000000000000000000000000000000000000042"++        -- Prepare+        web3 $ withAccount () $+            withParam (to .~ localAddress) $ do+                value .= (1 :: Ether)+                send ()++        balance <- web3 $ do+            withAccount local $+                withParam (to .~ dest) $ do+                    value .= (0.5 :: Ether)+                    send ()+            getBalance dest Pending++        fromIntegral balance `shouldBe` toWei (0.5 :: Ether)

@@ -0,0 +1,33 @@+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedLists       #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE QuasiQuotes           #-}+{-# LANGUAGE TemplateHaskell       #-}++module Network.Ethereum.Test.RegistrySpec where++import           Data.Default                 (def)+import           Test.Hspec                   (Spec)++import           Network.Ethereum             (EventAction (TerminateEvent),+                                               event)+import           Network.Ethereum.Api.Types   (Filter)+import           Network.Ethereum.Contract.TH (abiFrom)+import           Network.Web3                 (Web3)++[abiFrom|test/contracts/Registry.json|]++-- this spec is just to test compilation+spec :: Spec+spec = return ()++monitor :: Web3 ()+monitor = do+  let fltr1 = def :: Filter A+      fltr2 = def :: Filter B+  event fltr1 $ \_ -> pure TerminateEvent+  event fltr2 $ \_ -> pure TerminateEvent+  pure ()

@@ -0,0 +1,202 @@+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE LambdaCase            #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns        #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE QuasiQuotes           #-}+{-# LANGUAGE RecordWildCards       #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TemplateHaskell       #-}++-- Module      :  Network.Ethereum.Test.SimpleStorageSpec+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unportable+--+-- SimpleStorage is a Solidity contract which stores a uint256.+-- The point of this test is to test function calls to update and+-- read the value, as well as an event monitor.+--++module Network.Ethereum.Test.SimpleStorageSpec where++import           Control.Concurrent.Async     (wait)+import           Control.Concurrent.MVar+import           Control.Monad.IO.Class       (liftIO)+import           Control.Monad.Trans.Class    (lift)+import           Control.Monad.Trans.Reader   (ask)+import           Data.Default                 (def)+import           Data.List                    (sort)+import           Data.Monoid                  ((<>))+import           Lens.Micro                   ((.~))+import           Test.Hspec++import           Network.Ethereum+import qualified Network.Ethereum.Api.Eth     as Eth+import           Network.Ethereum.Api.Types+import           Network.Ethereum.Contract    (new)+import           Network.Ethereum.Contract.TH+import           Network.Web3+import           Network.Web3.Provider        (forkWeb3)++import           Network.Ethereum.Test.Utils++[abiFrom|test/contracts/SimpleStorage.json|]++unEvT_CountSet :: EvT_CountSet -> UIntN 256+unEvT_CountSet (EvT_CountSet n) = n++deploy :: IO Address+deploy = do+    Just address <- web3 $ withAccount () $ withParam id $ new SimpleStorageContract+    putStrLn $ "SimpleStorage: " ++ show address+    return address++spec :: Spec+spec = deploy `before` do+  interactions+  events++interactions :: SpecWith Address+interactions = describe "can interact with a SimpleStorage contract" $ do+    -- todo: this should ideally be arbitrary!+    let theValue = 12345++    it "can set the value of a SimpleStorage contract and read the value back" $ \storage -> do+        _ <- contract storage $ setCount theValue++        now <- web3 Eth.blockNumber+        let later = now + 3+        awaitBlock later++        v <- contract storage count+        v `shouldBe` theValue++    it "can set transaction gas limit" $ \storage -> do+        TxReceipt{..} <- contract storage $ withParam (gasLimit .~ 500000) $ setCount theValue+        Just Transaction{..} <- web3 $ Eth.getTransactionByHash receiptTransactionHash+        txGas `shouldBe` 500000++    it "can estimate transaction gas limit" $ \storage -> do+        TxReceipt{..} <- contract storage $ setCount theValue+        Just Transaction{..} <- web3 $ Eth.getTransactionByHash receiptTransactionHash+        txGas `shouldBe` 42822++events :: SpecWith Address+events = do+    describe "can interact with a SimpleStorage contract across block intervals" $ do+        it "can stream events starting and ending in the future, unbounded" $ \storage -> do+            var <- newMVar []+            let theSets = [1, 2, 3]+            putStrLn "Setting up the filter..."+            fiber <- web3 $ do+                let fltr = (def :: Filter EvT_CountSet) { filterAddress = Just [storage] }+                forkWeb3 $ processUntil' var fltr ((3 ==) . length)+            putStrLn "Setting the values..."+            setValues storage theSets+            wait fiber+            putStrLn "Filter caught 3 values..."+            vals <- takeMVar var+            sort (unEvT_CountSet <$> vals) `shouldBe` sort theSets++        it "can stream events starting and ending in the future, bounded" $ \storage -> do+            var <- newMVar []+            let theSets = [13, 14, 15]+            start <- web3 Eth.blockNumber+            let later = BlockWithNumber (start + 3)+                latest = BlockWithNumber (start + 8)+                fltr = (def :: Filter EvT_CountSet) { filterAddress = Just [storage]+                                                    , filterFromBlock = later+                                                    , filterToBlock = latest+                                                    }+            putStrLn "Setting up the filter..."+            fiber <- web3 $+                forkWeb3 $ processUntil' var fltr ((3 ==) . length)+            awaitBlock (start + 3)+            putStrLn "Setting the values..."+            setValues storage theSets+            wait fiber+            putStrLn "Filter caught 3 values..."+            vals <- takeMVar var+            sort (unEvT_CountSet <$> vals) `shouldBe` init (sort theSets)++        it "can stream events starting in the past and ending in the future" $ \storage -> do+            var <- newMVar []+            blockNumberVar <- newEmptyMVar+            let theSets1 = [7, 8, 9]+                theSets2 = [10, 11, 12]+            start <- web3 Eth.blockNumber+            let fltr = (def :: Filter EvT_CountSet) { filterAddress = Just [storage] }+            fiber <- web3 $ do+                forkWeb3 $ processUntil var fltr ((3 ==) . length) (liftIO . putMVar blockNumberVar . changeBlockNumber)+            putStrLn "Running first transactions as past transactions..."+            setValues storage theSets1+            wait fiber+            putStrLn "All past transactions succeeded... "+            Just end <- takeMVar blockNumberVar+            awaitBlock $ end + 1  -- make past transactions definitively in past+            var' <- newMVar []+            fiber' <- web3 $ do+                let fltr' = (def :: Filter EvT_CountSet) { filterAddress = Just [storage]+                                                        , filterFromBlock = BlockWithNumber start}+                forkWeb3 $ processUntil' var' fltr' ((6 ==) . length)+            putStrLn "Setting more values"+            setValues storage theSets2+            wait fiber'+            putStrLn "All new values have ben set"+            vals <- takeMVar var'+            sort (unEvT_CountSet <$> vals) `shouldBe` sort (theSets1 <> theSets2)++    it "can stream events starting and ending in the past, bounded" $ \storage -> do+        var <- newMVar []+        let theSets = [4, 5, 6]+        start <- web3 Eth.blockNumber+        blockNumberVar <- newEmptyMVar+        let fltr = (def :: Filter EvT_CountSet) { filterAddress = Just [storage] }+        putStrLn "Setting up filter for past transactions..."+        fiber <- web3 $ do+          forkWeb3 $ processUntil var fltr ((3 ==) . length) (liftIO . putMVar blockNumberVar . changeBlockNumber)+        putStrLn "Setting values"+        setValues storage theSets+        wait fiber+        putStrLn "All values have been set"+        Just end <- takeMVar blockNumberVar+        var' <- newMVar []+        let fltr' = fltr { filterFromBlock = BlockWithNumber start+                         , filterToBlock = BlockWithNumber end+                         }+        awaitBlock $ end + 1  -- make it definitively in the past+        web3 $ processUntil' var' fltr' ((3 ==) . length)+        vals <- takeMVar var'+        sort (unEvT_CountSet <$> vals) `shouldBe` sort theSets++processUntil :: MVar [EvT_CountSet]+             -> Filter EvT_CountSet+             -> ([EvT_CountSet] -> Bool)  -- TODO: make it work for any event+             -> (Change -> Web3 ())+             -> Web3 ()+processUntil var fltr predicate action = do+  event fltr $ \(ev :: EvT_CountSet) -> do+    newV <- liftIO $ modifyMVar var $ \v -> return (ev:v, ev:v)+    if predicate newV+        then do+          change <- ask+          lift $ action change+          return TerminateEvent+        else return ContinueEvent++processUntil' :: MVar [EvT_CountSet]+              -> Filter EvT_CountSet+              -> ([EvT_CountSet] -> Bool)+              -> Web3 ()+processUntil' var fltr predicate = processUntil var fltr predicate (const $ return ())++setValues :: Address -> [UIntN 256] -> IO ()+setValues storage = mapM_ (contract storage . setCount)

@@ -0,0 +1,80 @@+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Network.Ethereum.Test.Utils where++import           Control.Concurrent         (threadDelay)+import           Control.Exception          (SomeException, catch)+import           Control.Monad.IO.Class     (liftIO)+import           Data.Maybe                 (fromMaybe)+import           Data.Ratio                 (numerator)+import           Data.Time.Clock.POSIX      (getPOSIXTime)+import           Lens.Micro                 ((.~))+import           Network.HTTP.Client        (Manager, defaultManagerSettings,+                                             managerConnCount,+                                             managerRawConnection,+                                             managerRetryableException,+                                             newManager)+import           System.Environment         (lookupEnv)+import           System.IO.Unsafe           (unsafePerformIO)++import           Data.Solidity.Prim.Address (Address)+import           Network.Ethereum.Account   (DefaultAccount, to, withAccount,+                                             withParam)+import           Network.Ethereum.Api.Eth   (accounts, blockNumber)+import           Network.Ethereum.Api.Types (Quantity)+import           Network.Web3.Provider      (Provider (..), Web3, runWeb3With)++-- shared manager used throughout the helpers here to prevent hammering geth from ruining everything+-- this also retrys on ALL exceptions, including ConnectionResetByPeer and stuff like that+sharedManager :: Manager+sharedManager = unsafePerformIO $ newManager defaultManagerSettings+    { managerConnCount = 5+    , managerRetryableException = const False+    , managerRawConnection = fixRawConnection retryOpenConnection+    }++    where retryOpenConnection = threadDelay 500000 >> managerRawConnection defaultManagerSettings+          fixRawConnection f = f `catch` (\(_ :: SomeException) -> fixRawConnection f)+{-# NOINLINE sharedManager #-}++rpcUri :: IO String+rpcUri = liftIO (fromMaybe "http://localhost:8545" <$> lookupEnv "WEB3_PROVIDER")++contract :: Address+         -> DefaultAccount Web3 a+         -> IO a+contract a = web3 . withAccount () . withParam (to .~ a)++web3 :: Web3 a -> IO a+web3 ma = do+    provider <- HttpProvider <$> rpcUri+    v <- runWeb3With sharedManager provider ma+    case v of+        Left e   -> print e >> threadDelay 1000000 >> web3 ma+        Right v' -> return v'++withAccounts :: ([Address] -> IO a) -> IO a+withAccounts f = web3 accounts >>= f++withPrimaryEthereumAccount :: IO Address+withPrimaryEthereumAccount = withAccounts (pure . head)++sleepSeconds :: Int -> IO ()+sleepSeconds = threadDelay . (* 1000000)++microtime :: IO Integer+microtime = numerator . toRational . (* 1000000) <$> getPOSIXTime++awaitBlock :: Quantity -> IO ()+awaitBlock bn = do+    bn' <- web3 blockNumber+    -- putStrLn $ "awaiting block " ++ show bn ++ ", currently " ++ show bn'+    if bn' >= bn+        then return ()+        else threadDelay 1000000 >> awaitBlock bn++sleepBlocks :: Int -> IO ()+sleepBlocks n = do+    now <- web3 blockNumber+    awaitBlock $ now + fromIntegral n

@@ -1,152 +0,0 @@-{-# LANGUAGE DataKinds             #-}-{-# LANGUAGE DeriveGeneric         #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NamedFieldPuns        #-}-{-# LANGUAGE OverloadedLists       #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE QuasiQuotes           #-}-{-# LANGUAGE TemplateHaskell       #-}---- |--- Module      :  Network.Ethereum.Web3.Test.ComplexStorageSpec--- Copyright   :  Alexander Krupenkin 2016--- License     :  BSD3------ Maintainer  :  mail@akru.me--- Stability   :  experimental--- Portability :  unportable------ ComplexStorage is a Solidity contract which has global variables of--- several different types. The point of this test is to test the encoding--- of a complicated Solidity tuple, consisting of dynamically and statically--- sized components.-----module Network.Ethereum.Web3.Test.ComplexStorageSpec where--import           Control.Concurrent.Async         (wait)-import           Control.Concurrent.MVar          (newEmptyMVar, putMVar,-                                                   takeMVar)-import           Control.Monad.IO.Class           (liftIO)-import           Data.Default                     (def)--import           Network.Ethereum.Api.Types       (Filter (..))-import           Network.Ethereum.Contract        (new)-import           Network.Ethereum.Contract.TH-import           Network.Ethereum.Web3            hiding (convert)-import           Network.Ethereum.Web3.Test.Utils---import           Test.Hspec--[abiFrom|test/contracts/ComplexStorage.json|]--deploy :: IO Address-deploy = do-    Just address <- web3 $ withAccount () $ withParam id $ new ComplexStorageContract-    putStrLn $ "ComplexStorage: " ++ show address-    return address--spec :: Spec-spec = deploy `before` complexStorageSpec--complexStorageSpec :: SpecWith Address-complexStorageSpec = do-  describe "can interact with a ComplexStorage contract" $ do-        -- todo: these should ideally be arbitrary!-        let sUint   = 1-            sInt    = -1-            sBool   = True-            sInt224 = 221-            sBools   = [True, False]-            sInts    = [1, 1, -3]-            sString  = "hello"-            sBytes16 = "\x12\x34\x56\x78\x12\x34\x56\x78\x12\x34\x56\x78\x12\x34\x56\x78"-            sByte2sElem = "\x12\x34"-            sByte2sVec = [sByte2sElem, sByte2sElem, sByte2sElem, sByte2sElem]-            sByte2s = [sByte2sVec, sByte2sVec]--        it "can set the values of a ComplexStorage and validate them with an event" $ \storage -> do-            let fltr = (def :: Filter ValsSet) { filterAddress = Just [storage] }-            -- kick off listening for the ValsSet event-            vals <- newEmptyMVar-            fiber <- web3 $-                event fltr $ \vs -> do-                    liftIO $ putMVar vals vs-                    pure TerminateEvent-            -- kick off tx-            _ <- contract storage $ setValues-                                    sUint-                                    sInt-                                    sBool-                                    sInt224-                                    sBools-                                    sInts-                                    sString-                                    sBytes16-                                    sByte2s-            -- wait for its ValsSet event-            wait fiber-            (ValsSet vsA vsB vsC vsD vsE vsF vsG vsH vsI) <- takeMVar vals-            vsA `shouldBe` sUint-            vsB `shouldBe` sInt-            vsC `shouldBe` sBool-            vsD `shouldBe` sInt224-            vsE `shouldBe` sBools-            vsF `shouldBe` sInts-            vsG `shouldBe` sString-            vsH `shouldBe` sBytes16-            vsI `shouldBe` sByte2s--        it "can verify that it set the values correctly" $ \storage -> do-            -- Write a values-            _ <- contract storage $ setValues-                                    sUint-                                    sInt-                                    sBool-                                    sInt224-                                    sBools-                                    sInts-                                    sString-                                    sBytes16-                                    sByte2s-            -- Read a couple of values-            (uintVal', intVal', boolVal', int224Val', boolsVal, intsVal, stringVal', bytes16Val', bytes2s)-                <- contract storage $ (,,,,,,,,)-                    <$> uintVal-                    <*> intVal-                    <*> boolVal-                    <*> int224Val-                    <*> boolVectorVal 0-                    <*> intListVal 0-                    <*> stringVal-                    <*> bytes16Val-                    <*> bytes2VectorListVal 0 0--            uintVal'    `shouldBe` sUint-            intVal'     `shouldBe` sInt-            boolVal'    `shouldBe` sBool-            int224Val'  `shouldBe` sInt224-            boolsVal    `shouldBe` True-            intsVal     `shouldBe` head sInts-            stringVal'  `shouldBe` sString-            bytes16Val' `shouldBe` sBytes16-            bytes2s     `shouldBe` sByte2sElem--        it "can decode a complicated value correctly" $ \storage -> do-            -- Write a values-            _ <- contract storage $ setValues-                                    sUint-                                    sInt-                                    sBool-                                    sInt224-                                    sBools-                                    sInts-                                    sString-                                    sBytes16-                                    sByte2s-            -- Read a all values-            allVals <- contract storage getVals-            allVals `shouldBe` (sUint, sInt, sBool, sInt224, sBools, sInts, sString, sBytes16, sByte2s)

@@ -1,24 +0,0 @@-{-# LANGUAGE DataKinds             #-}-{-# LANGUAGE DeriveGeneric         #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE QuasiQuotes           #-}-module Network.Ethereum.Web3.Test.ERC20Spec where--import           Test.Hspec--import           Network.Ethereum.Contract.TH (abiFrom)-import           Network.Ethereum.Web3        (Account, UIntN)-import           Network.JsonRpc.TinyClient   (JsonRpc)--[abiFrom|examples/token/ERC20.json|]---- this spec is just to test compilation-spec :: Spec-spec = return ()--getBalance :: (JsonRpc m, Account p t, Functor (t m))-           => t m (UIntN 256)-getBalance = balanceOf "0x1234567890123456789011234567890234567890"

@@ -1,189 +0,0 @@-{-# LANGUAGE DataKinds             #-}-{-# LANGUAGE DeriveGeneric         #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE KindSignatures        #-}-{-# LANGUAGE LambdaCase            #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NamedFieldPuns        #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE QuasiQuotes           #-}-{-# LANGUAGE RecordWildCards       #-}-{-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE TemplateHaskell       #-}-{-# LANGUAGE TypeApplications      #-}---- Module      :  Network.Ethereum.Web3.Test.LinearizationSpec--- Copyright   :  Alexander Krupenkin 2016--- License     :  BSD3------ Maintainer  :  mail@akru.me--- Stability   :  experimental--- Portability :  unportable-----module Network.Ethereum.Web3.Test.LinearizationSpec where--import           Control.Concurrent               (forkIO)-import           Control.Concurrent.Async         (forConcurrently_)-import           Control.Concurrent.MVar-import           Control.Concurrent.STM           (atomically)-import           Control.Concurrent.STM.TQueue    (TQueue, flushTQueue,-                                                   newTQueueIO, writeTQueue)-import           Control.Monad                    (void)-import           Control.Monad.IO.Class           (MonadIO (..))-import           Control.Monad.Trans.Reader       (ReaderT, ask)-import           Data.Default-import           Data.Either-import           Data.List                        (sort)-import           Data.Maybe                       (fromJust)-import           System.Random                    (randomRIO)-import           Test.Hspec--import qualified Network.Ethereum.Api.Eth         as Eth-import           Network.Ethereum.Api.Types       (Change (..), Filter (..),-                                                   TxReceipt, unQuantity)-import           Network.Ethereum.Contract        (new)-import           Network.Ethereum.Contract.Event-import           Network.Ethereum.Contract.TH     (abiFrom)-import           Network.Ethereum.Web3-import           Network.Ethereum.Web3.Test.Utils--[abiFrom|test/contracts/Linearization.json|]--deploy :: IO Address-deploy = do-    Just address <- web3 $ withAccount () $ withParam id $ new LinearizationContract-    putStrLn $ "Linearization: " ++ show address-    return address--spec :: Spec-spec = do-    deploy `before` linearizationSpec-    deploy `before` floodSpec--floodCount :: Int-floodCount = 200--linearizationSpec :: SpecWith Address-linearizationSpec =-    describe "can bundle and linearize events" $ do-        it "can call e12" $ \linearization -> do-            var <- monitorE1OrE2 linearization-            _ <- contract linearization e12-            res <- takeMVar var-            res `shouldSatisfy` isLeft--        it "can call e21" $ \linearization -> do-            -- wait on the next block-            web3 Eth.blockNumber >>= \bn -> awaitBlock (bn + 1)-            var <- monitorE1OrE2 linearization-            _ <- contract linearization e21-            res <- takeMVar var-            res `shouldSatisfy` isRight--singleFlood :: forall m. (MonadIO m) => Address -> m TxReceipt-singleFlood linearization = liftIO $ do-    rando :: Int <- randomRIO (1, 4)-    contract linearization $-        case rando of-            1 -> e1-            2 -> e2-            3 -> e3-            4 -> e4-            _ -> error "got a number outside of (1,4) after randomR (1,4)"--floodSpec :: SpecWith Address-floodSpec = describe "can correctly demonstrate the difference between `multiEvent` and multiple `event'`s" $ do-    it "properly linearizes with `multiEvent` when flooded and doesn't with multiple `event`s" $ \linearization -> do-        multiQ <- monitorAllFourMulti linearization-        parQ <- monitorAllFourPar linearization-        -- to let the filter settle so we dont block indefinitely on missing events?-        sleepBlocks 10--        -- flood em and wait for all to finish-        liftIO . forConcurrently_ [1..floodCount] . const $ singleFlood linearization--        -- to let the event listeners catch up-        sleepBlocks 10--        -- wait for all multiEvents to be received and flush em out-        multiReceivedEvents <- liftIO . atomically $ flushTQueue multiQ-        parReceivedEvents <- liftIO . atomically $ flushTQueue parQ--        -- did we get at least 1/4 of the events? (this is a gotcha when flooding, sometimes nonces get repeated)-        length multiReceivedEvents `shouldSatisfy` (>= (floodCount `div` 4))-        length parReceivedEvents `shouldSatisfy` (>= (floodCount `div` 4))--        -- did both listeners see the same amount of events?-        length multiReceivedEvents `shouldBe` length parReceivedEvents--        -- the events pushed into the multi TQueue should already be sorted if they happened in the right order-        sort multiReceivedEvents `shouldBe` multiReceivedEvents-        -- the events pushed into the TQueue should not be sorted if they didnt come in in the right order-        sort parReceivedEvents `shouldNotBe` parReceivedEvents--monitorE1OrE2 :: Address -> IO (MVar (Either E1 E2))-monitorE1OrE2 addr = do-    var <- newEmptyMVar-    let fltr1 = (def :: Filter E1) { filterAddress = Just [addr] }-        fltr2 = (def :: Filter E2) { filterAddress = Just [addr] }-        filters = fltr1 :? fltr2 :? NilFilters-        handler1 ev1 = do-            liftIO $ putMVar var (Left ev1)-            return TerminateEvent-        handler2 ev2 = do-            liftIO $ putMVar var (Right ev2)-            return TerminateEvent-        handlers = H handler1 :& H handler2 :& RNil-    _ <- web3 $ multiEvent filters handlers-    return var--data EventTag = ETE1 | ETE2 | ETE3 | ETE4-    deriving (Eq, Read, Show)--instance {-# OVERLAPPING #-} Ord (EventTag, Integer, Integer) where-    (_, b1, t1) `compare` (_, b2, t2) =-        let bCmp = b1 `compare` b2-        in if bCmp == EQ then t1 `compare` t2-                         else bCmp--monitorAllFourMulti :: Address-                    -> IO (TQueue (EventTag, Integer, Integer))-monitorAllFourMulti addr = do-    q <- newTQueueIO-    let f :: forall a. Default (Filter a) => Filter a-        f = defFilter addr-        h = enqueueingHandler q-        filters = f @E1 :? f @E2 :? f @E3 :? f @E4 :? NilFilters-        handlers = h ETE1 :& h ETE2 :& h ETE3 :& h ETE4 :& RNil-    void . web3 $ multiEvent filters handlers-    return q--monitorAllFourPar :: Address-                  -> IO (TQueue (EventTag, Integer, Integer))-monitorAllFourPar addr = do-    q <- newTQueueIO-    let f :: forall a. Default (Filter a) => Filter a-        f = defFilter addr-        h = enqueueingHandler q-        unH (H h) = h--    void . forkIO . web3 $ event' (f @E1) (unH $ h ETE1)-    void . forkIO . web3 $ event' (f @E2) (unH $ h ETE2)-    void . forkIO . web3 $ event' (f @E3) (unH $ h ETE3)-    void . forkIO . web3 $ event' (f @E4) (unH $ h ETE4)-    return q--defFilter :: forall a. Default (Filter a) => Address -> Filter a-defFilter addr = (def :: Filter a) { filterAddress = Just [addr] }--enqueueingHandler :: forall a. TQueue (EventTag, Integer, Integer)-                  -> EventTag-                  -> Handler (ReaderT Change Web3 EventAction) a-enqueueingHandler q tag = H . const $ do-    Change{..} <- ask-    let bn = unQuantity $ fromJust changeBlockNumber-        li = unQuantity $ fromJust changeLogIndex-    liftIO . atomically $ writeTQueue q (tag, bn, li)-    return ContinueEvent

@@ -1,52 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- Module      :  Network.Ethereum.Web3.Test.LocalAccountSpec--- Copyright   :  Alexander Krupenkin 2018--- License     :  BSD3------ Maintainer  :  mail@akru.me--- Stability   :  experimental--- Portability :  unportable------ Simple local account transaction test.-----module Network.Ethereum.Web3.Test.LocalAccountSpec where--import           Lens.Micro                       ((.~))-import           Lens.Micro.Mtl                   ((.=))-import           Test.Hspec--import           Crypto.Ethereum.Utils            (derivePubKey, importKey)-import           Data.ByteArray.HexString         (HexString)-import           Data.Solidity.Prim.Address       (fromPubKey)-import           Network.Ethereum.Account         (LocalKey (..), send, to,-                                                   value, withAccount,-                                                   withParam)-import           Network.Ethereum.Api.Eth         (getBalance)-import           Network.Ethereum.Api.Types       (DefaultBlock (Pending))-import           Network.Ethereum.Unit            (Ether, toWei)-import           Network.Ethereum.Web3.Test.Utils (web3)--spec :: Spec-spec = describe "Local account transactions" $ do-    it "should send value" $ do-        let key = "0x0102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f20" :: HexString-            local = LocalKey (importKey key) 420123-            localAddress = fromPubKey (derivePubKey $ importKey key)-            dest = "0x0000000000000000000000000000000000000042"--        -- Prepare-        web3 $ withAccount () $-            withParam (to .~ localAddress) $ do-                value .= (1 :: Ether)-                send ()--        balance <- web3 $ do-            withAccount local $-                withParam (to .~ dest) $ do-                    value .= (0.5 :: Ether)-                    send ()-            getBalance dest Pending--        fromIntegral balance `shouldBe` toWei (0.5 :: Ether)

@@ -1,32 +0,0 @@-{-# LANGUAGE DataKinds             #-}-{-# LANGUAGE DeriveGeneric         #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedLists       #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE QuasiQuotes           #-}-{-# LANGUAGE TemplateHaskell       #-}--module Network.Ethereum.Web3.Test.RegistrySpec where--import           Data.Default                 (def)-import           Test.Hspec                   (Spec)--import           Network.Ethereum.Api.Types   (Filter)-import           Network.Ethereum.Contract.TH (abiFrom)-import           Network.Ethereum.Web3        (EventAction (TerminateEvent),-                                               Web3, event)--[abiFrom|test/contracts/Registry.json|]---- this spec is just to test compilation-spec :: Spec-spec = return ()--monitor :: Web3 ()-monitor = do-  let fltr1 = def :: Filter A-      fltr2 = def :: Filter B-  event fltr1 $ \_ -> pure TerminateEvent-  event fltr2 $ \_ -> pure TerminateEvent-  pure ()

@@ -1,203 +0,0 @@-{-# LANGUAGE DataKinds             #-}-{-# LANGUAGE DeriveGeneric         #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE KindSignatures        #-}-{-# LANGUAGE LambdaCase            #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NamedFieldPuns        #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE QuasiQuotes           #-}-{-# LANGUAGE RecordWildCards       #-}-{-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE TemplateHaskell       #-}---- Module      :  Network.Ethereum.Web3.Test.SimpleStorageSpec--- Copyright   :  Alexander Krupenkin 2016--- License     :  BSD3------ Maintainer  :  mail@akru.me--- Stability   :  experimental--- Portability :  unportable------ SimpleStorage is a Solidity contract which stores a uint256.--- The point of this test is to test function calls to update and--- read the value, as well as an event monitor.-----module Network.Ethereum.Web3.Test.SimpleStorageSpec where--import           Control.Concurrent.Async         (wait)-import           Control.Concurrent.MVar-import           Control.Monad.IO.Class           (liftIO)-import           Control.Monad.Trans.Class        (lift)-import           Control.Monad.Trans.Reader       (ask)-import           Data.Default                     (def)-import           Data.List                        (sort)-import           Data.Monoid                      ((<>))-import           Lens.Micro                       ((.~))-import           Test.Hspec--import qualified Network.Ethereum.Api.Eth         as Eth-import           Network.Ethereum.Api.Provider    (forkWeb3)-import           Network.Ethereum.Api.Types-import           Network.Ethereum.Contract        (new)-import           Network.Ethereum.Contract.Event  (event')-import           Network.Ethereum.Contract.TH-import           Network.Ethereum.Web3---import           Network.Ethereum.Web3.Test.Utils--[abiFrom|test/contracts/SimpleStorage.json|]--unEvT_CountSet :: EvT_CountSet -> UIntN 256-unEvT_CountSet (EvT_CountSet n) = n--deploy :: IO Address-deploy = do-    Just address <- web3 $ withAccount () $ withParam id $ new SimpleStorageContract-    putStrLn $ "SimpleStorage: " ++ show address-    return address--spec :: Spec-spec = deploy `before` do-  interactions-  events--interactions :: SpecWith Address-interactions = describe "can interact with a SimpleStorage contract" $ do-    -- todo: this should ideally be arbitrary!-    let theValue = 12345--    it "can set the value of a SimpleStorage contract and read the value back" $ \storage -> do-        _ <- contract storage $ setCount theValue--        now <- web3 Eth.blockNumber-        let later = now + 3-        awaitBlock later--        v <- contract storage count-        v `shouldBe` theValue--    it "can set transaction gas limit" $ \storage -> do-        TxReceipt{..} <- contract storage $ withParam (gasLimit .~ 500000) $ setCount theValue-        Just Transaction{..} <- web3 $ Eth.getTransactionByHash receiptTransactionHash-        txGas `shouldBe` 500000--    it "can estimate transaction gas limit" $ \storage -> do-        TxReceipt{..} <- contract storage $ setCount theValue-        Just Transaction{..} <- web3 $ Eth.getTransactionByHash receiptTransactionHash-        txGas `shouldBe` 42822--events :: SpecWith Address-events = do-    describe "can interact with a SimpleStorage contract across block intervals" $ do-        it "can stream events starting and ending in the future, unbounded" $ \storage -> do-            var <- newMVar []-            let theSets = [1, 2, 3]-            putStrLn "Setting up the filter..."-            fiber <- web3 $ do-                let fltr = (def :: Filter EvT_CountSet) { filterAddress = Just [storage] }-                forkWeb3 $ processUntil' var fltr ((3 ==) . length)-            putStrLn "Setting the values..."-            setValues storage theSets-            wait fiber-            putStrLn "Filter caught 3 values..."-            vals <- takeMVar var-            sort (unEvT_CountSet <$> vals) `shouldBe` sort theSets--        it "can stream events starting and ending in the future, bounded" $ \storage -> do-            var <- newMVar []-            let theSets = [13, 14, 15]-            start <- web3 Eth.blockNumber-            let later = BlockWithNumber (start + 3)-                latest = BlockWithNumber (start + 8)-                fltr = (def :: Filter EvT_CountSet) { filterAddress = Just [storage]-                                                    , filterFromBlock = later-                                                    , filterToBlock = latest-                                                    }-            putStrLn "Setting up the filter..."-            fiber <- web3 $-                forkWeb3 $ processUntil' var fltr ((3 ==) . length)-            awaitBlock (start + 3)-            putStrLn "Setting the values..."-            setValues storage theSets-            wait fiber-            putStrLn "Filter caught 3 values..."-            vals <- takeMVar var-            sort (unEvT_CountSet <$> vals) `shouldBe` init (sort theSets)--        it "can stream events starting in the past and ending in the future" $ \storage -> do-            var <- newMVar []-            blockNumberVar <- newEmptyMVar-            let theSets1 = [7, 8, 9]-                theSets2 = [10, 11, 12]-            start <- web3 Eth.blockNumber-            let fltr = (def :: Filter EvT_CountSet) { filterAddress = Just [storage] }-            fiber <- web3 $ do-                forkWeb3 $ processUntil var fltr ((3 ==) . length) (liftIO . putMVar blockNumberVar . changeBlockNumber)-            putStrLn "Running first transactions as past transactions..."-            setValues storage theSets1-            wait fiber-            putStrLn "All past transactions succeeded... "-            Just end <- takeMVar blockNumberVar-            awaitBlock $ end + 1  -- make past transactions definitively in past-            var' <- newMVar []-            fiber' <- web3 $ do-                let fltr' = (def :: Filter EvT_CountSet) { filterAddress = Just [storage]-                                                        , filterFromBlock = BlockWithNumber start}-                forkWeb3 $ processUntil' var' fltr' ((6 ==) . length)-            putStrLn "Setting more values"-            setValues storage theSets2-            wait fiber'-            putStrLn "All new values have ben set"-            vals <- takeMVar var'-            sort (unEvT_CountSet <$> vals) `shouldBe` sort (theSets1 <> theSets2)--    it "can stream events starting and ending in the past, bounded" $ \storage -> do-        var <- newMVar []-        let theSets = [4, 5, 6]-        start <- web3 Eth.blockNumber-        blockNumberVar <- newEmptyMVar-        let fltr = (def :: Filter EvT_CountSet) { filterAddress = Just [storage] }-        putStrLn "Setting up filter for past transactions..."-        fiber <- web3 $ do-          forkWeb3 $ processUntil var fltr ((3 ==) . length) (liftIO . putMVar blockNumberVar . changeBlockNumber)-        putStrLn "Setting values"-        setValues storage theSets-        wait fiber-        putStrLn "All values have been set"-        Just end <- takeMVar blockNumberVar-        var' <- newMVar []-        let fltr' = fltr { filterFromBlock = BlockWithNumber start-                         , filterToBlock = BlockWithNumber end-                         }-        awaitBlock $ end + 1  -- make it definitively in the past-        web3 $ processUntil' var' fltr' ((3 ==) . length)-        vals <- takeMVar var'-        sort (unEvT_CountSet <$> vals) `shouldBe` sort theSets--processUntil :: MVar [EvT_CountSet]-             -> Filter EvT_CountSet-             -> ([EvT_CountSet] -> Bool)  -- TODO: make it work for any event-             -> (Change -> Web3 ())-             -> Web3 ()-processUntil var fltr predicate action = do-  event' fltr $ \(ev :: EvT_CountSet) -> do-    newV <- liftIO $ modifyMVar var $ \v -> return (ev:v, ev:v)-    if predicate newV-        then do-          change <- ask-          lift $ action change-          return TerminateEvent-        else return ContinueEvent--processUntil' :: MVar [EvT_CountSet]-              -> Filter EvT_CountSet-              -> ([EvT_CountSet] -> Bool)-              -> Web3 ()-processUntil' var fltr predicate = processUntil var fltr predicate (const $ return ())--setValues :: Address -> [UIntN 256] -> IO ()-setValues storage = mapM_ (contract storage . setCount)

@@ -1,81 +0,0 @@-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Network.Ethereum.Web3.Test.Utils where--import           Control.Concurrent            (threadDelay)-import           Control.Exception             (SomeException, catch)-import           Control.Monad.IO.Class        (liftIO)-import           Data.Maybe                    (fromMaybe)-import           Data.Ratio                    (numerator)-import           Data.Time.Clock.POSIX         (getPOSIXTime)-import           Lens.Micro                    ((.~))-import           Network.HTTP.Client           (Manager, defaultManagerSettings,-                                                managerConnCount,-                                                managerRawConnection,-                                                managerRetryableException,-                                                newManager)-import           System.Environment            (lookupEnv)-import           System.IO.Unsafe              (unsafePerformIO)--import           Data.Solidity.Prim.Address    (Address)-import           Network.Ethereum.Account      (DefaultAccount, to, withAccount,-                                                withParam)-import           Network.Ethereum.Api.Eth      (accounts, blockNumber)-import           Network.Ethereum.Api.Provider (Provider (..), Web3,-                                                runWeb3With)-import           Network.Ethereum.Api.Types    (Quantity)---- shared manager used throughout the helpers here to prevent hammering geth from ruining everything--- this also retrys on ALL exceptions, including ConnectionResetByPeer and stuff like that-sharedManager :: Manager-sharedManager = unsafePerformIO $ newManager defaultManagerSettings-    { managerConnCount = 5-    , managerRetryableException = const False-    , managerRawConnection = fixRawConnection retryOpenConnection-    }--    where retryOpenConnection = threadDelay 500000 >> managerRawConnection defaultManagerSettings-          fixRawConnection f = f `catch` (\(_ :: SomeException) -> fixRawConnection f)-{-# NOINLINE sharedManager #-}--rpcUri :: IO String-rpcUri = liftIO (fromMaybe "http://localhost:8545" <$> lookupEnv "WEB3_PROVIDER")--contract :: Address-         -> DefaultAccount Web3 a-         -> IO a-contract a = web3 . withAccount () . withParam (to .~ a)--web3 :: Web3 a -> IO a-web3 ma = do-    provider <- HttpProvider <$> rpcUri-    v <- runWeb3With sharedManager provider ma-    case v of-        Left e   -> print e >> threadDelay 1000000 >> web3 ma-        Right v' -> return v'--withAccounts :: ([Address] -> IO a) -> IO a-withAccounts f = web3 accounts >>= f--withPrimaryEthereumAccount :: IO Address-withPrimaryEthereumAccount = withAccounts (pure . head)--sleepSeconds :: Int -> IO ()-sleepSeconds = threadDelay . (* 1000000)--microtime :: IO Integer-microtime = numerator . toRational . (* 1000000) <$> getPOSIXTime--awaitBlock :: Quantity -> IO ()-awaitBlock bn = do-    bn' <- web3 blockNumber-    -- putStrLn $ "awaiting block " ++ show bn ++ ", currently " ++ show bn'-    if bn' >= bn-        then return ()-        else threadDelay 1000000 >> awaitBlock bn--sleepBlocks :: Int -> IO ()-sleepBlocks n = do-    now <- web3 blockNumber-    awaitBlock $ now + fromIntegral n

@@ -0,0 +1,47 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      :  Network.Ipfs.Api.Test.Key+-- Copyright   :  Alexander Krupenkin 2016+-- License     :  BSD3+--+-- Maintainer  :  mail@akru.me+-- Stability   :  experimental+-- Portability :  unknown+--+-- Key IPFS API testing module.+--++module Network.Ipfs.Api.Test.Key where++import           Control.Exception      ()+import           Control.Monad.Trans+import           Test.Hspec++import qualified Network.Ipfs.Api.Key   as Key+import           Network.Ipfs.Api.Types (KeyDetailsObj (..), KeyObj (..))+import           Network.Ipfs.Client    (runIpfs)++main :: IO ()+main = hspec $ do+  describe "keyGen" $ do+    it "should return the given key name in its response" $ runIpfs $ do+      res <- Key.gen "TestA" "rsa"+      liftIO $ keyName res `shouldBe` "TestA"++    it "KeyDetailsObj returned by KeyGen should be present in the KeyObj's list returned returned by KeyList" $+        runIpfs $ do+            resGen <- Key.gen "TestB" "rsa"+            resList <- Key.list+            liftIO $ keys resList `shouldContain` [resGen]++  describe "keyRm" $ do+    it "should return the given key name in its response" $ runIpfs $ do+      res <- Key.rm "TestA"+      liftIO $ (keyName $ Prelude.head $ keys res) `shouldBe` "TestA"++    it "KeyDetailsObj returned by KeyRm should not be present in the KeyObj's list returned returned by KeyList" $+        runIpfs $ do+            resRm <- Key.rm "TestB"+            resList <- Key.list+            liftIO $ keys resList `shouldNotContain` keys resRm

@@ -6,9 +6,9 @@ import           Test.Hspec import           Test.Hspec.QuickCheck +import           Crypto.Ecdsa.Utils           (importKey) import           Crypto.Ethereum.Signature    (hashMessage, signMessage,                                                signTransaction)-import           Crypto.Ethereum.Utils        (importKey) import           Data.ByteArray.HexString     (HexString) import           Data.Solidity.Prim.Address   (fromPubKey) import           Network.Ethereum.Api.Types   (Call (..))

@@ -7,7 +7,7 @@ import           Data.Monoid                ((<>)) import           Test.Hspec -import           Crypto.Ethereum.Utils      (derivePubKey, importKey)+import           Crypto.Ecdsa.Utils         (derivePubKey, importKey) import           Data.ByteArray.HexString   (HexString) import           Data.Solidity.Prim.Address 

@@ -1,15 +1,15 @@-cabal-version: 2.4+cabal-version: 2.2  -- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: 52f53efab4c596377b85d0718660446c92da89530ee76214df53a18a0fdd589d+-- hash: 916c1e312da75f2dfe78e0e6a6613adc7b6a4e68a1da8d57e82be1facc937203  name:           web3-version:        0.8.4.0-synopsis:       Ethereum API for Haskell-description:    Web3 is a Haskell client library for Ethereum+version:        0.9.0.0+synopsis:       Web3 API for Haskell.+description:    Client library for Third Generation of Web. category:       Network homepage:       https://github.com/airalab/hs-web3#readme bug-reports:    https://github.com/airalab/hs-web3/issues@@ -26,6 +26,7 @@     examples/token/ERC20.hs     examples/token/ERC20.json     examples/token/Main.hs+    examples/polkadot/Main.hs     test/contracts/Registry.json     test/contracts/SimpleStorage.json     test/contracts/ComplexStorage.json@@ -47,6 +48,8 @@  library   exposed-modules:+      Crypto.Ecdsa.Signature+      Crypto.Ecdsa.Utils       Crypto.Ethereum       Crypto.Ethereum.Keyfile       Crypto.Ethereum.Signature@@ -70,6 +73,7 @@       Data.Solidity.Prim.Tuple.TH       Data.String.Extra       Language.Solidity.Abi+      Network.Ethereum       Network.Ethereum.Account       Network.Ethereum.Account.Class       Network.Ethereum.Account.Default@@ -80,7 +84,6 @@       Network.Ethereum.Api.Eth       Network.Ethereum.Api.Net       Network.Ethereum.Api.Personal-      Network.Ethereum.Api.Provider       Network.Ethereum.Api.Types       Network.Ethereum.Api.Web3       Network.Ethereum.Chain@@ -96,8 +99,46 @@       Network.Ethereum.Ens.Registry       Network.Ethereum.Transaction       Network.Ethereum.Unit-      Network.Ethereum.Web3+      Network.Ipfs.Api.Bitswap+      Network.Ipfs.Api.Block+      Network.Ipfs.Api.Bootstrap+      Network.Ipfs.Api.Cid+      Network.Ipfs.Api.Config+      Network.Ipfs.Api.Core+      Network.Ipfs.Api.Dag+      Network.Ipfs.Api.Dht+      Network.Ipfs.Api.Files+      Network.Ipfs.Api.Internal+      Network.Ipfs.Api.Internal.Call+      Network.Ipfs.Api.Internal.Stream+      Network.Ipfs.Api.Key+      Network.Ipfs.Api.Log+      Network.Ipfs.Api.Object+      Network.Ipfs.Api.Pin+      Network.Ipfs.Api.Pubsub+      Network.Ipfs.Api.Repo+      Network.Ipfs.Api.Stats+      Network.Ipfs.Api.Swarm+      Network.Ipfs.Api.Types+      Network.Ipfs.Api.Types.Stream+      Network.Ipfs.Client       Network.JsonRpc.TinyClient+      Network.Polkadot.Api.Account+      Network.Polkadot.Api.Author+      Network.Polkadot.Api.Babe+      Network.Polkadot.Api.Chain+      Network.Polkadot.Api.Childstate+      Network.Polkadot.Api.Contracts+      Network.Polkadot.Api.Engine+      Network.Polkadot.Api.Grandpa+      Network.Polkadot.Api.Offchain+      Network.Polkadot.Api.Payment+      Network.Polkadot.Api.Rpc+      Network.Polkadot.Api.State+      Network.Polkadot.Api.System+      Network.Polkadot.Api.Types+      Network.Web3+      Network.Web3.Provider   other-modules:       Paths_web3   autogen-modules:@@ -109,16 +150,22 @@       OneTuple >=0.2.1 && <0.3     , aeson >=1.2.2.0 && <1.5     , async >=2.1.1.1 && <2.3+    , attoparsec >=0.13.2.1 && <0.14     , base >4.10 && <4.14+    , base58string >=0.10.0 && <0.11     , basement >=0.0.4 && <0.1     , bytestring >=0.10.8.1 && <0.11     , cereal >=0.5.4.0 && <0.6     , cryptonite >=0.23 && <0.27     , data-default >=0.7.1.1 && <0.8+    , errors >=2.2 && <2.4     , exceptions >=0.8.3 && <0.11     , generics-sop >=0.3.1.0 && <0.6+    , hspec >=2.4 && <2.8     , http-client >=0.5.7.1 && <0.7     , http-client-tls >=0.3.5.1 && <0.4+    , http-media >=0.7 && <0.8.1+    , http-types >=0.12 && <0.14     , machines >=0.6.3 && <0.8     , memory >=0.14.11 && <0.16     , microlens >=0.4.8.1 && <0.5@@ -126,14 +173,20 @@     , microlens-mtl >=0.1.11.0 && <0.3     , microlens-th >=0.4.1.1 && <0.5     , mtl >=2.2.1 && <2.3+    , network >=2.6 && <3.2     , parsec >=3.1.11 && <3.2     , relapse >=1.0.0.0 && <2.0+    , servant >=0.13 && <0.17+    , servant-client >=0.13 && <0.17     , tagged >=0.8.5 && <0.9+    , tar >=0.5 && <0.6     , template-haskell >=2.12 && <2.16     , text >=1.2.2.2 && <1.3     , transformers >=0.5.2.0 && <0.6+    , unordered-containers >=0.2 && <0.3     , uuid-types >=1.0.3 && <1.1     , vinyl >=0.5.3 && <0.13+    , websockets >=0.11 && <0.13   if flag(debug)     ghc-options: -ddump-splices   if flag(compiler)@@ -157,13 +210,16 @@   type: exitcode-stdio-1.0   main-is: Spec.hs   other-modules:-      Network.Ethereum.Web3.Test.ComplexStorageSpec-      Network.Ethereum.Web3.Test.ERC20Spec-      Network.Ethereum.Web3.Test.LinearizationSpec-      Network.Ethereum.Web3.Test.LocalAccountSpec-      Network.Ethereum.Web3.Test.RegistrySpec-      Network.Ethereum.Web3.Test.SimpleStorageSpec-      Network.Ethereum.Web3.Test.Utils+      Network.Ethereum.Test.ComplexStorageSpec+      Network.Ethereum.Test.ERC20Spec+      Network.Ethereum.Test.LinearizationSpec+      Network.Ethereum.Test.LocalAccountSpec+      Network.Ethereum.Test.RegistrySpec+      Network.Ethereum.Test.SimpleStorageSpec+      Network.Ethereum.Test.Utils+      Network.Ipfs.Api.Test.Key+      Crypto.Ecdsa.Signature+      Crypto.Ecdsa.Utils       Crypto.Ethereum       Crypto.Ethereum.Keyfile       Crypto.Ethereum.Signature@@ -187,6 +243,7 @@       Data.Solidity.Prim.Tuple.TH       Data.String.Extra       Language.Solidity.Abi+      Network.Ethereum       Network.Ethereum.Account       Network.Ethereum.Account.Class       Network.Ethereum.Account.Default@@ -197,7 +254,6 @@       Network.Ethereum.Api.Eth       Network.Ethereum.Api.Net       Network.Ethereum.Api.Personal-      Network.Ethereum.Api.Provider       Network.Ethereum.Api.Types       Network.Ethereum.Api.Web3       Network.Ethereum.Chain@@ -213,8 +269,46 @@       Network.Ethereum.Ens.Registry       Network.Ethereum.Transaction       Network.Ethereum.Unit-      Network.Ethereum.Web3+      Network.Ipfs.Api.Bitswap+      Network.Ipfs.Api.Block+      Network.Ipfs.Api.Bootstrap+      Network.Ipfs.Api.Cid+      Network.Ipfs.Api.Config+      Network.Ipfs.Api.Core+      Network.Ipfs.Api.Dag+      Network.Ipfs.Api.Dht+      Network.Ipfs.Api.Files+      Network.Ipfs.Api.Internal+      Network.Ipfs.Api.Internal.Call+      Network.Ipfs.Api.Internal.Stream+      Network.Ipfs.Api.Key+      Network.Ipfs.Api.Log+      Network.Ipfs.Api.Object+      Network.Ipfs.Api.Pin+      Network.Ipfs.Api.Pubsub+      Network.Ipfs.Api.Repo+      Network.Ipfs.Api.Stats+      Network.Ipfs.Api.Swarm+      Network.Ipfs.Api.Types+      Network.Ipfs.Api.Types.Stream+      Network.Ipfs.Client       Network.JsonRpc.TinyClient+      Network.Polkadot.Api.Account+      Network.Polkadot.Api.Author+      Network.Polkadot.Api.Babe+      Network.Polkadot.Api.Chain+      Network.Polkadot.Api.Childstate+      Network.Polkadot.Api.Contracts+      Network.Polkadot.Api.Engine+      Network.Polkadot.Api.Grandpa+      Network.Polkadot.Api.Offchain+      Network.Polkadot.Api.Payment+      Network.Polkadot.Api.Rpc+      Network.Polkadot.Api.State+      Network.Polkadot.Api.System+      Network.Polkadot.Api.Types+      Network.Web3+      Network.Web3.Provider       Paths_web3   hs-source-dirs:       test@@ -224,12 +318,15 @@       OneTuple >=0.2.1 && <0.3     , aeson >=1.2.2.0 && <1.5     , async >=2.1.1.1 && <2.3+    , attoparsec >=0.13.2.1 && <0.14     , base >4.10 && <4.14+    , base58string >=0.10.0 && <0.11     , basement >=0.0.4 && <0.1     , bytestring >=0.10.8.1 && <0.11     , cereal >=0.5.4.0 && <0.6     , cryptonite >=0.23 && <0.27     , data-default >=0.7.1.1 && <0.8+    , errors >=2.2 && <2.4     , exceptions >=0.8.3 && <0.11     , generics-sop >=0.3.1.0 && <0.6     , hspec >=2.4.4 && <2.8@@ -238,6 +335,8 @@     , hspec-expectations >=0.8.2 && <0.9     , http-client >=0.5.7.1 && <0.7     , http-client-tls >=0.3.5.1 && <0.4+    , http-media >=0.7 && <0.8.1+    , http-types >=0.12 && <0.14     , machines >=0.6.3 && <0.8     , memory >=0.14.11 && <0.16     , microlens >=0.4.8.1 && <0.5@@ -245,18 +344,24 @@     , microlens-mtl >=0.1.11.0 && <0.3     , microlens-th >=0.4.1.1 && <0.5     , mtl >=2.2.1 && <2.3+    , network >=2.6 && <3.2     , parsec >=3.1.11 && <3.2     , random >=1.1 && <1.2     , relapse >=1.0.0.0 && <2.0+    , servant >=0.13 && <0.17+    , servant-client >=0.13 && <0.17     , split >=0.2.3 && <0.3     , stm >=2.4.4 && <2.6     , tagged >=0.8.5 && <0.9+    , tar >=0.5 && <0.6     , template-haskell >=2.12 && <2.16     , text >=1.2.2.2 && <1.3     , time >=1.6.0 && <1.11     , transformers >=0.5.2.0 && <0.6+    , unordered-containers >=0.2 && <0.3     , uuid-types >=1.0.3 && <1.1     , vinyl >=0.5.3 && <0.13+    , websockets >=0.11 && <0.13   if flag(debug)     ghc-options: -ddump-splices   if flag(compiler)@@ -291,6 +396,8 @@       Network.Ethereum.Contract.Test.THSpec       Network.Ethereum.Web3.Test.EventSpec       Network.Ethereum.Web3.Test.MethodDumpSpec+      Crypto.Ecdsa.Signature+      Crypto.Ecdsa.Utils       Crypto.Ethereum       Crypto.Ethereum.Keyfile       Crypto.Ethereum.Signature@@ -314,6 +421,7 @@       Data.Solidity.Prim.Tuple.TH       Data.String.Extra       Language.Solidity.Abi+      Network.Ethereum       Network.Ethereum.Account       Network.Ethereum.Account.Class       Network.Ethereum.Account.Default@@ -324,7 +432,6 @@       Network.Ethereum.Api.Eth       Network.Ethereum.Api.Net       Network.Ethereum.Api.Personal-      Network.Ethereum.Api.Provider       Network.Ethereum.Api.Types       Network.Ethereum.Api.Web3       Network.Ethereum.Chain@@ -340,8 +447,46 @@       Network.Ethereum.Ens.Registry       Network.Ethereum.Transaction       Network.Ethereum.Unit-      Network.Ethereum.Web3+      Network.Ipfs.Api.Bitswap+      Network.Ipfs.Api.Block+      Network.Ipfs.Api.Bootstrap+      Network.Ipfs.Api.Cid+      Network.Ipfs.Api.Config+      Network.Ipfs.Api.Core+      Network.Ipfs.Api.Dag+      Network.Ipfs.Api.Dht+      Network.Ipfs.Api.Files+      Network.Ipfs.Api.Internal+      Network.Ipfs.Api.Internal.Call+      Network.Ipfs.Api.Internal.Stream+      Network.Ipfs.Api.Key+      Network.Ipfs.Api.Log+      Network.Ipfs.Api.Object+      Network.Ipfs.Api.Pin+      Network.Ipfs.Api.Pubsub+      Network.Ipfs.Api.Repo+      Network.Ipfs.Api.Stats+      Network.Ipfs.Api.Swarm+      Network.Ipfs.Api.Types+      Network.Ipfs.Api.Types.Stream+      Network.Ipfs.Client       Network.JsonRpc.TinyClient+      Network.Polkadot.Api.Account+      Network.Polkadot.Api.Author+      Network.Polkadot.Api.Babe+      Network.Polkadot.Api.Chain+      Network.Polkadot.Api.Childstate+      Network.Polkadot.Api.Contracts+      Network.Polkadot.Api.Engine+      Network.Polkadot.Api.Grandpa+      Network.Polkadot.Api.Offchain+      Network.Polkadot.Api.Payment+      Network.Polkadot.Api.Rpc+      Network.Polkadot.Api.State+      Network.Polkadot.Api.System+      Network.Polkadot.Api.Types+      Network.Web3+      Network.Web3.Provider       Paths_web3   hs-source-dirs:       unit@@ -351,12 +496,15 @@       OneTuple >=0.2.1 && <0.3     , aeson >=1.2.2.0 && <1.5     , async >=2.1.1.1 && <2.3+    , attoparsec >=0.13.2.1 && <0.14     , base >4.10 && <4.14+    , base58string >=0.10.0 && <0.11     , basement >=0.0.4 && <0.1     , bytestring >=0.10.8.1 && <0.11     , cereal >=0.5.4.0 && <0.6     , cryptonite >=0.23 && <0.27     , data-default >=0.7.1.1 && <0.8+    , errors >=2.2 && <2.4     , exceptions >=0.8.3 && <0.11     , generics-sop >=0.3.1.0 && <0.6     , hspec >=2.4.4 && <2.8@@ -365,6 +513,8 @@     , hspec-expectations >=0.8.2 && <0.9     , http-client >=0.5.7.1 && <0.7     , http-client-tls >=0.3.5.1 && <0.4+    , http-media >=0.7 && <0.8.1+    , http-types >=0.12 && <0.14     , machines >=0.6.3 && <0.8     , memory >=0.14.11 && <0.16     , microlens >=0.4.8.1 && <0.5@@ -372,14 +522,20 @@     , microlens-mtl >=0.1.11.0 && <0.3     , microlens-th >=0.4.1.1 && <0.5     , mtl >=2.2.1 && <2.3+    , network >=2.6 && <3.2     , parsec >=3.1.11 && <3.2     , relapse >=1.0.0.0 && <2.0+    , servant >=0.13 && <0.17+    , servant-client >=0.13 && <0.17     , tagged >=0.8.5 && <0.9+    , tar >=0.5 && <0.6     , template-haskell >=2.12 && <2.16     , text >=1.2.2.2 && <1.3     , transformers >=0.5.2.0 && <0.6+    , unordered-containers >=0.2 && <0.3     , uuid-types >=1.0.3 && <1.1     , vinyl >=0.5.3 && <0.13+    , websockets >=0.11 && <0.13   if flag(debug)     ghc-options: -ddump-splices   if flag(compiler)