diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,14 @@ # Changelog All notable changes to this project will be documented in this file. +## [0.7.1.0] 2018-05-02 +### Added +- TxReceipt and Eth.getTransactionReceipt JSON-RPC method. +- Keyword escaper for TH generated names. + +### Changed +- Library dependencies bounds fixed for GHC 8.2.2-8.4.2 (stackage LTS + Nightly). + ## [0.7.0.0] 2018-04-22 ### Added - This CHANGELOG.md file for significant changes tracking. diff --git a/src/Network/Ethereum/ABI/Json.hs b/src/Network/Ethereum/ABI/Json.hs --- a/src/Network/Ethereum/ABI/Json.hs +++ b/src/Network/Ethereum/ABI/Json.hs @@ -83,7 +83,19 @@ -- ^ Event | DFallback { falPayable :: Bool } -- ^ Fallback function - deriving (Show, Eq, Ord) + deriving Show + +instance Eq Declaration where + (DConstructor a) == (DConstructor b) = length a == length b + (DFunction a _ _ _) == (DFunction b _ _ _) = a == b + (DEvent a _ _) == (DEvent b _ _) = a == b + (==) _ _ = True + +instance Ord Declaration where + compare (DConstructor a) (DConstructor b) = compare (length a) (length b) + compare (DFunction a _ _ _) (DFunction b _ _ _) = compare a b + compare (DEvent a _ _) (DEvent b _ _) = compare a b + compare _ _ = EQ $(deriveJSON (defaultOptions { sumEncoding = TaggedObject "type" "contents" diff --git a/src/Network/Ethereum/Contract/TH.hs b/src/Network/Ethereum/Contract/TH.hs --- a/src/Network/Ethereum/Contract/TH.hs +++ b/src/Network/Ethereum/Contract/TH.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} @@ -41,7 +40,7 @@ import Control.Monad (replicateM, (<=<)) import Data.Aeson (eitherDecode) import Data.Default (Default (..)) -import Data.List (groupBy, sortBy, uncons) +import Data.List (group, sort, uncons) import Data.Monoid ((<>)) import Data.Tagged (Tagged) import Data.Text (Text) @@ -96,11 +95,7 @@ -- | Simple data type declaration with one constructor dataD' :: Name -> ConQ -> [Name] -> DecQ dataD' name rec derive = -#if MIN_VERSION_template_haskell(2,12,0) dataD (cxt []) name [] Nothing [rec] [derivClause Nothing (conT <$> derive)] -#else - dataD (cxt []) name [] Nothing [rec] $ cxt (conT <$> derive) -#endif -- | Simple function declaration funD' :: Name -> [PatQ] -> ExpQ -> DecQ @@ -148,7 +143,7 @@ -- ^ Parameters -> Maybe [FunctionArg] -- ^ Results - -> Q [Dec] + -> DecsQ funWrapper c name dname args result = do a : _ : vars <- replicateM (length args + 2) (newName "t") let params = appsE $ conE dname : fmap varE vars @@ -177,7 +172,7 @@ Just xs -> let outs = fmap (typeQ . funArgType) xs in [t|Web3 $(foldl appT (tupleT (length xs)) outs)|] -mkDecl :: Declaration -> Q [Dec] +mkDecl :: Declaration -> DecsQ mkDecl ev@(DEvent name inputs anonymous) = sequence [ dataD' indexedName (normalC indexedName (map (toBang <=< tag) indexedArgs)) derivingD @@ -247,21 +242,35 @@ else (mkName . (++ "_") . (++) prefixStr . toUpperFirst . T.unpack $ h, ty) : go (i + 1) tail' escape :: [Declaration] -> [Declaration] -escape = concat . escapeNames . groupBy fnEq . sortBy fnCompare - where fnEq (DFunction n1 _ _ _) (DFunction n2 _ _ _) = n1 == n2 - fnEq _ _ = False - fnCompare (DFunction n1 _ _ _) (DFunction n2 _ _ _) = compare n1 n2 - fnCompare _ _ = GT +escape = escapeEqualNames . fmap escapeReservedNames -escapeNames :: [[Declaration]] -> [[Declaration]] -escapeNames = fmap go +escapeEqualNames :: [Declaration] -> [Declaration] +escapeEqualNames = concat . fmap go . group . sort where go [] = [] go (x : xs) = x : zipWith appendToName xs hats hats = [T.replicate n "'" | n <- [1..]] - appendToName dfn addition = dfn { funName = funName dfn <> addition } + appendToName d@(DFunction n _ _ _) a = d { funName = n <> a } + appendToName d _ = d +escapeReservedNames :: Declaration -> Declaration +escapeReservedNames d@(DFunction n _ _ _) + | isKeyword n = d { funName = n <> "'" } + | otherwise = d +escapeReservedNames d = d + +isKeyword :: Text -> Bool +isKeyword = flip elem [ "as", "case", "of", "class" + , "data", "family", "instance" + , "default", "deriving", "do" + , "forall", "foreign", "hiding" + , "if", "then", "else", "import" + , "infix", "infixl", "infixr" + , "let", "in", "mdo", "module" + , "newtype", "proc", "qualified" + , "rec", "type", "where"] + -- | ABI to declarations converter -quoteAbiDec :: String -> Q [Dec] +quoteAbiDec :: String -> DecsQ quoteAbiDec abi_string = case eitherDecode abi_lbs of Left e -> fail $ "Error: " ++ show e diff --git a/src/Network/Ethereum/Web3/Eth.hs b/src/Network/Ethereum/Web3/Eth.hs --- a/src/Network/Ethereum/Web3/Eth.hs +++ b/src/Network/Ethereum/Web3/Eth.hs @@ -169,9 +169,9 @@ getTransactionByBlockNumberAndIndex = remote "eth_getTransactionByBlockNumberAndIndex" -- | Returns the receipt of a transaction by transaction hash. --- TODO must create new type, TxReceipt --- getTransactionReceipt :: Text -> Web3 TxReceipt --- getTransactionReceipt = remote "getTransactionReceipt" +getTransactionReceipt :: TxHash -> Web3 (Maybe TxReceipt) +{-# INLINE getTransactionReceipt #-} +getTransactionReceipt = remote "eth_getTransactionReceipt" -- | Returns a list of addresses owned by client. accounts :: Web3 [Address] diff --git a/src/Network/Ethereum/Web3/Provider.hs b/src/Network/Ethereum/Web3/Provider.hs --- a/src/Network/Ethereum/Web3/Provider.hs +++ b/src/Network/Ethereum/Web3/Provider.hs @@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE CPP #-} -- | -- Module : Network.Ethereum.Web3.Provider @@ -27,7 +28,12 @@ import Data.Default (Default (..)) import GHC.Generics (Generic) import Network.HTTP.Client (Manager, newManager) + +#ifdef TLS_MANAGER import Network.HTTP.Client.TLS (tlsManagerSettings) +#else +import Network.HTTP.Client (defaultManagerSettings) +#endif import Network.JsonRpc.TinyClient (Remote, ServerUri) @@ -69,7 +75,12 @@ -- | 'Web3' monad runner runWeb3' :: MonadIO m => Provider -> Web3 a -> m (Either Web3Error a) runWeb3' provider f = do - manager <- liftIO $ newManager tlsManagerSettings + manager <- liftIO $ +#ifdef TLS_MANAGER + newManager tlsManagerSettings +#else + newManager defaultManagerSettings +#endif runWeb3With manager provider f -- | 'Web3' runner for default provider diff --git a/src/Network/Ethereum/Web3/Types.hs b/src/Network/Ethereum/Web3/Types.hs --- a/src/Network/Ethereum/Web3/Types.hs +++ b/src/Network/Ethereum/Web3/Types.hs @@ -35,6 +35,8 @@ import Network.Ethereum.ABI.Prim.Bytes (Bytes) import Network.Ethereum.Unit +type TxHash = Bytes + -- | Should be viewed as type to representing QUANTITY in Web3 JSON RPC docs -- -- When encoding QUANTITIES (integers, numbers): encode as hex, prefix with "0x", @@ -196,7 +198,33 @@ compare Earliest _ = LT compare a b = compare (Down b) (Down a) +-- | The Receipt of a Transaction +data TxReceipt = TxReceipt + { receiptTransactionHash :: !TxHash + -- ^ DATA, 32 Bytes - hash of the transaction. + , receiptTransactionIndex :: !Quantity + -- ^ QUANTITY - index of the transaction. + , receiptBlockHash :: !Bytes + -- ^ DATA, 32 Bytes - hash of the block where this transaction was in. null when its pending. + , receiptBlockNumber :: !BlockNumber + -- ^ QUANTITY - block number where this transaction was in. + , receiptCumulativeGasUsed :: !Quantity + -- ^ QUANTITY - The total amount of gas used when this transaction was executed in the block. + , receiptGasUsed :: !Quantity + -- ^ QUANTITY - The amount of gas used by this specific transaction alone. + , receiptContractAddress :: !(Maybe Address) + -- ^ DATA, 20 Bytes - The contract address created, if the transaction was a contract creation, otherwise null. + , receiptLogs :: ![Value] + -- ^ Array - Array of log objects, which this transaction generated. + , receiptLogsBloom :: !Bytes + -- ^ DATA, 256 Bytes - Bloom filter for light clients to quickly retrieve related logs. + , receiptStatus :: !Quantity + -- ^ QUANTITY either 1 (success) or 0 (failure) + } deriving (Show, Generic) +$(deriveJSON (defaultOptions + { fieldLabelModifier = toLowerFirst . drop 7 }) ''TxReceipt) + -- | Transaction information data Transaction = Transaction { txHash :: !Bytes @@ -270,5 +298,3 @@ $(deriveJSON (defaultOptions { fieldLabelModifier = toLowerFirst . drop 5 }) ''Block) - -type TxHash = Bytes diff --git a/web3.cabal b/web3.cabal --- a/web3.cabal +++ b/web3.cabal @@ -1,17 +1,17 @@ -name: web3 -version: 0.7.0.0 cabal-version: >=1.10 -build-type: Simple +name: web3 +version: 0.7.1.0 license: BSD3 license-file: LICENSE copyright: Alexander Krupenkin maintainer: mail@akru.me +author: Alexander Krupenkin homepage: https://github.com/airalab/hs-web3#readme synopsis: Ethereum API for Haskell description: Web3 is a Haskell client library for Ethereum category: Network -author: Alexander Krupenkin +build-type: Simple extra-source-files: README.md CHANGELOG.md @@ -30,6 +30,11 @@ type: git location: https://github.com/airalab/hs-web3 +flag tls + description: + Enable TLS support + default: False + library exposed-modules: Network.Ethereum.Web3 @@ -59,14 +64,27 @@ Network.Ethereum.Contract.Method Network.JsonRpc.TinyClient Data.String.Extra + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wduplicate-exports -Whi-shadowing -Widentities + -Wnoncanonical-monoid-instances -Woverlapping-patterns -Wtabs + -Wpartial-type-signatures -Wderiving-typeable + -Wunrecognised-pragmas -Wunticked-promoted-constructors + -Wtyped-holes -Wincomplete-patterns -Wincomplete-uni-patterns + -Wmissing-fields -Wmissing-methods -Wmissing-exported-signatures + -Wmissing-monadfail-instances -Wmissing-signatures -Wname-shadowing + -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances + -Wunused-binds -Wunused-top-binds -Wunused-local-binds + -Wunused-pattern-binds -Wunused-imports -Wunused-matches + -Wunused-foralls -Wunused-do-bind -Wwrong-do-bind + -Wtrustworthy-safe -Wwarnings-deprecations -Wdeferred-type-errors build-depends: - base >4.8 && <4.11, - template-haskell >=2.12.0.0 && <2.13, + base >4.9 && <4.12, + template-haskell >=2.12.0.0 && <2.14, data-default >=0.7.1.1 && <0.8, generics-sop >=0.3.2.0 && <0.4, transformers >=0.5.2.0 && <0.6, http-client >=0.5.12.1 && <0.6, - http-client-tls >=0.3.5.3 && <0.4, exceptions >=0.8.3 && <0.9, bytestring >=0.10.8.2 && <0.11, cryptonite ==0.25.*, @@ -77,22 +95,31 @@ memory >=0.14.16 && <0.15, cereal >=0.5.5.0 && <0.6, aeson >=1.2.4.0 && <1.3, - async >=2.1.1.1 && <2.2, + async >=2.1.1.1 && <2.3, text >=1.2.3.0 && <1.3, mtl >=2.2.2 && <2.3 - default-language: Haskell2010 - hs-source-dirs: src - ghc-options: -Wduplicate-exports -Whi-shadowing -Widentities -Wnoncanonical-monoid-instances -Woverlapping-patterns -Wtabs -Wpartial-type-signatures -Wderiving-typeable -Wunrecognised-pragmas -Wunticked-promoted-constructors -Wtyped-holes -Wincomplete-patterns -Wincomplete-uni-patterns -Wmissing-fields -Wmissing-methods -Wmissing-exported-signatures -Wmissing-monadfail-instances -Wmissing-signatures -Wname-shadowing -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances -Wunused-binds -Wunused-top-binds -Wunused-local-binds -Wunused-pattern-binds -Wunused-imports -Wunused-matches -Wunused-foralls -Wunused-do-bind -Wwrong-do-bind -Wtrustworthy-safe -Wwarnings-deprecations -Wdeferred-type-errors + + if flag(tls) + cpp-options: -DTLS_MANAGER + build-depends: + http-client-tls >=0.3.5.3 && <0.4 -test-suite unit +test-suite unit type: exitcode-stdio-1.0 main-is: Spec.hs + hs-source-dirs: unit + other-modules: + Network.Ethereum.Web3.Test.MethodDumpSpec + Network.Ethereum.Web3.Test.EncodingSpec + Network.Ethereum.Web3.Test.EventSpec + default-language: Haskell2010 + ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: - base >4.8 && <4.11, + base >4.9 && <4.12, hspec-expectations >=0.8.2 && <0.9, - hspec-discover >=2.4.8 && <2.5, - hspec-contrib >=0.4.0 && <0.5, - hspec >=2.4.8 && <2.5, + hspec-discover >=2.4.8 && <2.6, + hspec-contrib >=0.4.0 && <0.6, + hspec >=2.4.8 && <2.6, data-default >=0.7.1.1 && <0.8, generics-sop >=0.3.2.0 && <0.4, transformers >=0.5.2.0 && <0.6, @@ -103,42 +130,31 @@ time >=1.8.0.2 && <1.9, text >=1.2.3.0 && <1.3, web3 -any - default-language: Haskell2010 - hs-source-dirs: unit - other-modules: - Network.Ethereum.Web3.Test.MethodDumpSpec - Network.Ethereum.Web3.Test.EncodingSpec - Network.Ethereum.Web3.Test.EventSpec - ghc-options: -threaded -rtsopts -with-rtsopts=-N -test-suite live + +test-suite live type: exitcode-stdio-1.0 main-is: Spec.hs + hs-source-dirs: test + other-modules: + Network.Ethereum.Web3.Test.ComplexStorageSpec + Network.Ethereum.Web3.Test.SimpleStorageSpec + Network.Ethereum.Web3.Test.Utils + default-language: Haskell2010 + ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: - async >=2.1.1.1 && <2.2, - base >=4.10.1.0 && <4.11, - bytestring >=0.10.8.2 && <0.11, - data-default >=0.7.1.1 && <0.8, - hspec >=2.4.8 && <2.5, - hspec-contrib >=0.4.0 && <0.5, - hspec-discover >=2.4.8 && <2.5, + base >4.9 && <4.12, hspec-expectations >=0.8.2 && <0.9, - hspec-discover >=2.4.8 && <2.5, - hspec-contrib >=0.4.0 && <0.5, - hspec >=2.4.8 && <2.5, + hspec-discover >=2.4.8 && <2.6, + hspec-contrib >=0.4.0 && <0.6, + hspec >=2.4.8 && <2.6, transformers >=0.5.2.0 && <0.6, data-default >=0.7.1.1 && <0.8, bytestring >=0.10.8.2 && <0.11, memory >=0.14.16 && <0.15, + tagged >=0.8.5 && <0.9, split >=0.2.3.3 && <0.3, - text >=1.2.3.0 && <1.3, + async >=2.1.1.1 && <2.3, time >=1.8.0.2 && <1.9, text >=1.2.3.0 && <1.3, - web3 -any, - stm >=2.4.5.0 && <2.5 - default-language: Haskell2010 - hs-source-dirs: test - other-modules: - Network.Ethereum.Web3.Test.ComplexStorageSpec - Network.Ethereum.Web3.Test.SimpleStorageSpec - Network.Ethereum.Web3.Test.Utils - ghc-options: -threaded -rtsopts -with-rtsopts=-N + stm >=2.4.5.0 && <2.5, + web3 -any