diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,15 @@ # Changelog All notable changes to this project will be documented in this file. +## [0.8.3.0] 2019-01-09 +### Changed +- Cryptonite based ECC signer for messages and transactions, it removes secp256k1 dependency +- Fixed dependencies bounds for stackage LTS-13 + +## [0.8.2.1] 2018-11-19 +### Changed +- Fixed dependencies bounds for stackage distribution + ## [0.8.2.0] 2018-11-07 ### Changed - Gas estimation runs when gas limit is not set before diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -6,7 +6,7 @@ [![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) [![Hackage](https://img.shields.io/hackage/v/web3.svg)](http://hackage.haskell.org/package/web3) -[![LTS-12](http://stackage.org/package/web3/badge/lts-12)](http://stackage.org/lts-12/package/web3) +[![LTS-13](http://stackage.org/package/web3/badge/lts-13)](http://stackage.org/lts-13/package/web3) [![nightly](http://stackage.org/package/web3/badge/nightly)](http://stackage.org/nightly/package/web3) [![Code Triagers](https://www.codetriage.com/airalab/hs-web3/badges/users.svg)](https://www.codetriage.com/airalab/hs-web3) ![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg) diff --git a/cbits/solidity_lite.cpp b/cbits/solidity_lite.cpp deleted file mode 100644 --- a/cbits/solidity_lite.cpp +++ /dev/null @@ -1,99 +0,0 @@ -#include -#include -#include - -using namespace dev::solidity; -using namespace std; - -struct Solidity { - Solidity() : compiler(new CompilerStack) - {} - - ~Solidity() - { delete compiler; } - - CompilerStack * compiler; - map libs; -}; - -#ifdef __cplusplus -extern "C" -{ -#endif - -namespace dev { -namespace solidity { -namespace lite { - -void * create() -{ - return static_cast(new Solidity); -} - -void destroy(void * self) -{ - delete static_cast(self); -} - -int addSource(void * self, const char * name, const char * source) -{ - return static_cast(self)->compiler->addSource(name, source); -} - -int addLibrary(void * self, const char * name, const char * address) -{ - static_cast(self)->libs[name] = dev::h160(address); - return 0; -} - -int compile(void * self, int optimize) -{ - auto s = static_cast(self); - - s->compiler->setOptimiserSettings(optimize); - s->compiler->setLibraries(s->libs); - s->compiler->reset(true); - if (s->compiler->parseAndAnalyze()) - if (s->compiler->compile()) - return 0; - - return -1; -} - -char * c_string(const std::string &str) -{ - auto c_str = (char *) calloc(1, str.size()+1); - memcpy(c_str, str.c_str(), str.size()); - return c_str; -} - -char * abi(void * self, const char * name) -{ - auto abi_value = static_cast(self)->compiler->contractABI(name); - return c_string(abi_value.toStyledString()); -} - -char * binary(void * self, const char * name) -{ - auto bin_object = static_cast(self)->compiler->object(name); - return c_string(bin_object.toHex()); -} - -char * errors(void * self) -{ - auto compiler = static_cast(self)->compiler; - stringstream error_stream; - for (auto const& error: compiler->errors()) { - SourceReferenceFormatter fmt(error_stream, [&](string const& _source) -> Scanner const& { return compiler->scanner(_source); }); - fmt.printExceptionInformation(*error, (error->type() == Error::Type::Warning) ? "Warning" : "Error"); - } - return c_string(error_stream.str()); -} - -} // solidity -} // lite -} // dev - -#ifdef __cplusplus -} -#endif diff --git a/compiler/Language/Solidity/Compiler.hs b/compiler/Language/Solidity/Compiler.hs new file mode 100644 --- /dev/null +++ b/compiler/Language/Solidity/Compiler.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE CPP #-} +#ifdef SOLIDITY_COMPILER +{-# LANGUAGE RecordWildCards #-} +#endif + +-- | +-- Module : Language.Solidity.Compiler +-- Copyright : Alexander Krupenkin 2017 +-- License : BSD3 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Solidity compiler high-level bindings. +-- + +module Language.Solidity.Compiler where + +#ifdef SOLIDITY_COMPILER + +import Data.ByteString (ByteString) +import Data.Map (Map) +import Data.Semigroup (Semigroup (..)) +import qualified Language.Solidity.Compiler.Foreign as FFI +import System.IO.Unsafe (unsafePerformIO) + +-- | Input contract sources +data Sources = Sources + { sourceMap :: Map ByteString ByteString + -- ^ Source code map from contract name in keys + , libraries :: Map ByteString ByteString + -- ^ Library address map for linking + , optimization :: Bool + -- ^ Enable optimization? + } deriving (Eq, Show) + +instance Semigroup Sources where + a <> b = Sources (sourceMap a `mappend` sourceMap b) + (libraries a `mappend` libraries b) + (optimization a || optimization b) + +instance Monoid Sources where + mappend = (<>) + mempty = Sources mempty mempty False + +type Compiled = Map ByteString (ByteString, ByteString) + +-- | Compile Solidity contracts +compile :: Sources + -- ^ Contract sources + -> Either ByteString Compiled + -- ^ Error string or compiled contracts ABI and hex +{-# NOINLINE compile #-} +compile Sources{..} = unsafePerformIO $ + FFI.compile sourceMap libraries optimization + +#endif diff --git a/compiler/Language/Solidity/Compiler/Foreign.hsc b/compiler/Language/Solidity/Compiler/Foreign.hsc new file mode 100644 --- /dev/null +++ b/compiler/Language/Solidity/Compiler/Foreign.hsc @@ -0,0 +1,106 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ForeignFunctionInterface #-} + +-- | +-- Module : Language.Solidity.Compiler.Foreign +-- Copyright : Alexander Krupenkin 2017 +-- License : BSD3 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unportable +-- +-- Ethereum Solidity library FFI. +-- + +module Language.Solidity.Compiler.Foreign where + +#ifdef SOLIDITY_COMPILER +#include + +import Data.Map as M +import Data.ByteString.Char8 as BS +import Data.Typeable (Typeable) +import Foreign.C.String (CString, peekCString, withCString) +import Foreign.C.Types (CInt(..)) +import Foreign.Ptr (Ptr) +import Foreign (free) + +data Solidity + deriving Typeable + +foreign import ccall unsafe "create" c_create + :: IO (Ptr Solidity) +foreign import ccall unsafe "destroy" c_destroy + :: Ptr Solidity -> IO () +foreign import ccall unsafe "addSource" c_addSource + :: Ptr Solidity -> CString -> CString -> IO CInt +foreign import ccall unsafe "addLibrary" c_addLibrary + :: Ptr Solidity -> CString -> CString -> IO CInt +foreign import ccall unsafe "compile" c_compile + :: Ptr Solidity -> CInt -> IO CInt +foreign import ccall unsafe "abi" c_abi + :: Ptr Solidity -> CString -> IO CString +foreign import ccall unsafe "binary" c_binary + :: Ptr Solidity -> CString -> IO CString +foreign import ccall unsafe "errors" c_errors + :: Ptr Solidity -> IO CString + +withSolidity :: (Ptr Solidity -> IO a) -> IO a +{-# INLINE withSolidity #-} +withSolidity f = do + ptr <- c_create + r <- f ptr + c_destroy ptr + return r + +withCStringPair :: (CString -> CString -> IO a) -> (ByteString, ByteString) -> IO a +{-# INLINE withCStringPair #-} +withCStringPair f (a, b) = + withCString (BS.unpack a) $ \astr -> + withCString (BS.unpack b) $ \bstr -> + f astr bstr + +addSources :: Ptr Solidity -> Map ByteString ByteString -> IO () +{-# INLINE addSources #-} +addSources ptr = mapM_ (withCStringPair $ c_addSource ptr) . M.toList + +addLibraries :: Ptr Solidity -> Map ByteString ByteString -> IO () +{-# INLINE addLibraries #-} +addLibraries ptr = mapM_ (withCStringPair $ c_addLibrary ptr) . M.toList + +result :: Ptr Solidity -> ByteString -> IO (ByteString, ByteString) +result ptr name = + withCString (BS.unpack name) $ \cname -> do + abi <- c_abi ptr cname + bin <- c_binary ptr cname + res <- (,) <$> fmap BS.pack (peekCString abi) + <*> fmap BS.pack (peekCString bin) + free abi + free bin + return res + +errors :: Ptr Solidity -> IO ByteString +errors ptr = do + errs <- c_errors ptr + res <- BS.pack <$> peekCString errs + free errs + return res + +compile :: Map ByteString ByteString + -> Map ByteString ByteString + -> Bool + -> IO (Either ByteString (Map ByteString (ByteString, ByteString))) +compile srcs libs opt = + withSolidity $ \ptr -> do + addSources ptr srcs + addLibraries ptr libs + res <- c_compile ptr optI + let compiled = sequence $ M.mapWithKey (const . result ptr) srcs + if res < 0 + then Left <$> errors ptr + else Right <$> compiled + where optI | opt = 1 + | otherwise = 0 + +#endif diff --git a/compiler/cbits/solidity_lite.cpp b/compiler/cbits/solidity_lite.cpp new file mode 100644 --- /dev/null +++ b/compiler/cbits/solidity_lite.cpp @@ -0,0 +1,100 @@ +#include +#include +#include + +using namespace dev::solidity; +using namespace langutil; +using namespace std; + +struct Solidity { + Solidity() : compiler(new CompilerStack) + {} + + ~Solidity() + { delete compiler; } + + CompilerStack * compiler; + map libs; +}; + +#ifdef __cplusplus +extern "C" +{ +#endif + +namespace dev { +namespace solidity { +namespace lite { + +void * create() +{ + return static_cast(new Solidity); +} + +void destroy(void * self) +{ + delete static_cast(self); +} + +int addSource(void * self, const char * name, const char * source) +{ + return static_cast(self)->compiler->addSource(name, source); +} + +int addLibrary(void * self, const char * name, const char * address) +{ + static_cast(self)->libs[name] = dev::h160(address); + return 0; +} + +int compile(void * self, int optimize) +{ + auto s = static_cast(self); + + s->compiler->setOptimiserSettings(optimize); + s->compiler->setLibraries(s->libs); + s->compiler->reset(true); + if (s->compiler->parseAndAnalyze()) + if (s->compiler->compile()) + return 0; + + return -1; +} + +char * c_string(const std::string &str) +{ + auto c_str = (char *) calloc(1, str.size()+1); + memcpy(c_str, str.c_str(), str.size()); + return c_str; +} + +char * abi(void * self, const char * name) +{ + auto abi_value = static_cast(self)->compiler->contractABI(name); + return c_string(abi_value.toStyledString()); +} + +char * binary(void * self, const char * name) +{ + auto bin_object = static_cast(self)->compiler->object(name); + return c_string(bin_object.toHex()); +} + +char * errors(void * self) +{ + auto compiler = static_cast(self)->compiler; + stringstream error_stream; + for (auto const& error: compiler->errors()) { + SourceReferenceFormatter fmt(error_stream, [&](string const& _source) -> Scanner const& { return compiler->scanner(_source); }); + fmt.printExceptionInformation(*error, (error->type() == Error::Type::Warning) ? "Warning" : "Error"); + } + return c_string(error_stream.str()); +} + +} // solidity +} // lite +} // dev + +#ifdef __cplusplus +} +#endif diff --git a/src/Crypto/Ethereum.hs b/src/Crypto/Ethereum.hs --- a/src/Crypto/Ethereum.hs +++ b/src/Crypto/Ethereum.hs @@ -7,53 +7,24 @@ -- Stability : experimental -- Portability : unportable -- --- Ethereum ECDSA based on secp256k1 bindings. +-- Ethereum ECC support module. -- module Crypto.Ethereum ( - -- * Ethereum ECDSA sign/recover - hashMessage - , ecsign - , ecrecover - - -- * Re-export useful Secp256k1 functions - , SecKey + -- * Ethereum crypto key ops + PrivateKey + , PublicKey + , importKey , derivePubKey - )where -import Crypto.Hash (Keccak_256 (..), hashWith) -import Crypto.Secp256k1 (CompactRecSig, Msg, SecKey, - derivePubKey, exportCompactRecSig, - importCompactRecSig, msg, recover, - signRecMsg) -import Data.ByteArray (ByteArrayAccess, convert) -import Data.Maybe (fromJust) - -import Data.Solidity.Prim.Address (Address, fromPubKey) - --- | SHA3 hash of argument -hashMessage :: ByteArrayAccess ba => ba -> Msg -hashMessage = fromJust . msg . convert . hashWith Keccak_256 + -- * Digital Signature Algorithm + , signMessage --- | Sign message with Ethereum private key -ecsign :: ByteArrayAccess message - => SecKey - -- ^ Private key - -> message - -- ^ Message content - -> CompactRecSig - -- ^ Signature -ecsign key = exportCompactRecSig . signRecMsg key . hashMessage + -- * Hash function + , sha3 + ) where --- | Recover message signer Ethereum address -ecrecover :: ByteArrayAccess message - => CompactRecSig - -- ^ Signature - -> message - -- ^ Message content - -> Maybe Address - -- ^ Message signer address -ecrecover sig message = do - sig' <- importCompactRecSig sig - fromPubKey <$> recover sig' (hashMessage message) +import Crypto.Ethereum.Signature (signMessage) +import Crypto.Ethereum.Utils (derivePubKey, importKey, sha3) +import Crypto.PubKey.ECC.ECDSA (PrivateKey, PublicKey) diff --git a/src/Crypto/Ethereum/Keyfile.hs b/src/Crypto/Ethereum/Keyfile.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Ethereum/Keyfile.hs @@ -0,0 +1,230 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +-- | +-- Module : Crypto.Ethereum.Keyfile +-- Copyright : Alexander Krupenkin 2018 +-- License : BSD3 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Web3 Secret Storage implementation. +-- Spec https://github.com/ethereum/wiki/wiki/Web3-Secret-Storage-Definition. +-- + +module Crypto.Ethereum.Keyfile + ( + -- * Encrypted Ethereum private key + EncryptedKey(..) + , Cipher(..) + , Kdf(..) + + -- * Secret storage packers + , decrypt + , encrypt + ) where + +import Crypto.Cipher.AES (AES128) +import Crypto.Cipher.Types (IV, cipherInit, ctrCombine, makeIV) +import Crypto.Error (throwCryptoError) +import qualified Crypto.KDF.PBKDF2 as Pbkdf2 (Parameters (..), + fastPBKDF2_SHA256) +import qualified Crypto.KDF.Scrypt as Scrypt (Parameters (..), generate) +import Crypto.Random (MonadRandom (getRandomBytes)) +import Data.Aeson (FromJSON (..), ToJSON (..), Value, + object, withObject, (.:), (.=)) +import Data.Aeson.Types (Parser) +import Data.ByteArray (ByteArray, ByteArrayAccess, convert) +import qualified Data.ByteArray as BA (drop, take, unpack) +import Data.Maybe (fromJust) +import Data.Monoid ((<>)) +import Data.Text (Text) +import Data.UUID.Types (UUID) +import Data.UUID.Types.Internal (buildFromBytes) + +import Crypto.Ethereum.Utils (sha3) +import Data.ByteArray.HexString (HexString) + +-- | Key derivation function parameters and salt. +data Kdf = Pbkdf2 !Pbkdf2.Parameters !HexString + | Scrypt !Scrypt.Parameters !HexString + +-- | Cipher parameters. +data Cipher = Aes128Ctr + { 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 + } + +instance Eq EncryptedKey where + a == b = encryptedKeyId a == encryptedKeyId b + +instance Show EncryptedKey where + show EncryptedKey{..} = "EncryptedKey " ++ show encryptedKeyId + +instance FromJSON EncryptedKey where + parseJSON = encryptedKeyParser + +instance ToJSON EncryptedKey where + toJSON = encryptedKeyBuilder + +encryptedKeyBuilder :: EncryptedKey -> Value +encryptedKeyBuilder EncryptedKey{..} = object + [ "id" .= encryptedKeyId + , "version" .= encryptedKeyVersion + , "crypto" .= object + [ "cipher" .= cipherName encryptedKeyCipher + , "cipherparams" .= cipherParams encryptedKeyCipher + , "ciphertext" .= cipherText encryptedKeyCipher + , "kdf" .= kdfName encryptedKeyKdf + , "kdfparams" .= kdfParams encryptedKeyKdf + , "mac" .= encryptedKeyMac + ] + ] + where + cipherName :: Cipher -> Text + cipherName Aes128Ctr{..} = "aes-128-ctr" + + cipherParams :: Cipher -> Value + cipherParams Aes128Ctr{..} = object [ "iv" .= (convert cipherIv :: HexString) ] + + kdfName :: Kdf -> Text + kdfName = \case + Pbkdf2 _ _ -> "pbkdf2" + Scrypt _ _ -> "scrypt" + + kdfParams :: Kdf -> Value + kdfParams = \case + Pbkdf2 params salt -> + object [ "salt" .= salt + , "dklen" .= Pbkdf2.outputLength params + , "c" .= Pbkdf2.iterCounts params + ] + Scrypt params salt -> + object [ "salt" .= salt + , "dklen" .= Scrypt.outputLength params + , "p" .= Scrypt.p params + , "r" .= Scrypt.r params + , "n" .= Scrypt.n params + ] + +encryptedKeyParser :: Value -> Parser EncryptedKey +encryptedKeyParser = withObject "EncryptedKey" $ \v -> do + uuid <- v .: "id" + version <- v .: "version" + crypto <- v .: "crypto" + cipher <- parseCipher crypto + kdf <- parseKdf crypto + mac <- withObject "Crypto" (.: "mac") crypto + return $ EncryptedKey uuid version cipher kdf mac + +parseCipher :: Value -> Parser Cipher +parseCipher = withObject "Cipher" $ \v -> do + name <- v .: "cipher" + case name :: Text of + "aes-128-ctr" -> do + params <- v .: "cipherparams" + hexiv <- params .: "iv" + text <- v .: "ciphertext" + case makeIV (hexiv :: HexString) of + Just iv -> return (Aes128Ctr iv text) + Nothing -> fail $ "Unable to make IV from " ++ show hexiv + _ -> fail $ show name ++ " not implemented yet" + +parseKdf :: Value -> Parser Kdf +parseKdf = withObject "Kdf" $ \v -> do + name <- v .: "kdf" + params <- v .: "kdfparams" + dklen <- params .: "dklen" + salt <- params .: "salt" + case name :: Text of + "pbkdf2" -> do + iterations <- params .: "c" + prf <- params .: "prf" + case prf :: Text of + "hmac-sha256" -> return $ Pbkdf2 (Pbkdf2.Parameters iterations dklen) salt + _ -> fail $ show prf ++ " not implemented yet" + "scrypt" -> do + p <- params .: "p" + r <- params .: "r" + n <- params .: "n" + return $ Scrypt (Scrypt.Parameters n r p dklen) salt + _ -> fail $ show name ++ " not implemented yet" + +defaultKdf :: HexString -> Kdf +defaultKdf = Scrypt (Scrypt.Parameters n r p dklen) + where + dklen = 32 + n = 262144 + r = 1 + p = 8 + +deriveKey :: (ByteArrayAccess password, ByteArray ba) => Kdf -> password -> ba +deriveKey kdf password = + case kdf of + Pbkdf2 params salt -> Pbkdf2.fastPBKDF2_SHA256 params password salt + Scrypt params salt -> Scrypt.generate params password salt + + +-- | Decrypt Ethereum private key. +-- +-- Typically Web3 Secret Storage is JSON-encoded. 'EncryptedKey' data type has 'FromJSON' instance +-- to helps decode it from JSON-encoded string or file. +-- +-- @ +-- let decryptJSON pass = flip decrypt pass <=< decode +-- @ +-- +decrypt :: (ByteArrayAccess password, ByteArray privateKey) + => EncryptedKey + -> password + -> Maybe privateKey +decrypt EncryptedKey{..} password + | mac == encryptedKeyMac = Just (convert privateKey) + | otherwise = Nothing + where + privateKey = ctrCombine cipher iv ciphertext + cipher = throwCryptoError $ cipherInit (BA.take 16 derivedKey) :: AES128 + derivedKey = deriveKey encryptedKeyKdf password + ciphertext = cipherText encryptedKeyCipher + mac = sha3 (BA.drop 16 derivedKey <> ciphertext) + iv = cipherIv encryptedKeyCipher + +-- | Encrypt Ethereum private key. +-- +-- @ +-- let encryptJSON pass key = encode <$> encrypt key pass +-- @ +encrypt :: (ByteArray privateKey, ByteArrayAccess password, MonadRandom m) + => privateKey + -> password + -> m EncryptedKey +encrypt privateKey password = do + kdf <- defaultKdf <$> getRandomBytes 16 + iv <- randomIV + 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) + uuid <- randomUUID + return $ EncryptedKey uuid 3 (Aes128Ctr iv $ convert ciphertext) kdf mac + where + randomUUID = do + uuid <- getRandomBytes 16 + let bs = BA.unpack (uuid :: HexString) + return $ buildFromBytes 4 + (head bs) (bs !! 1) (bs !! 2) (bs !! 3) + (bs !! 4) (bs !! 5) (bs !! 6) (bs !! 7) + (bs !! 8) (bs !! 9) (bs !! 10) (bs !! 11) + (bs !! 12) (bs !! 13) (bs !! 14) (bs !! 15) + randomIV = do + iv <- getRandomBytes 16 + return $ fromJust $ makeIV (iv :: HexString) diff --git a/src/Crypto/Ethereum/Signature.hs b/src/Crypto/Ethereum/Signature.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Ethereum/Signature.hs @@ -0,0 +1,142 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Crypto.Ethereum +-- Copyright : Alexander Krupenkin 2018 +-- License : BSD3 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- Recoverable ECC signature support. +-- + +module Crypto.Ethereum.Signature + ( + 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.Ethereum.Utils (exportKey) +import Data.ByteArray.HexString (HexString) +import Data.Solidity.Prim.Address (Address) + +-- | Make Ethereum standard signature. +-- +-- The message is before enveloped as follows: +-- "\x19Ethereum Signed Message:\n" + message.length + message +-- +-- /WARNING:/ Vulnerable to timing attacks. +signMessage :: (ByteArrayAccess message, ByteArray rsv) + => PrivateKey + -> message + -> rsv +{-# INLINE signMessage #-} +signMessage pk = pack . sign pk . hashMessage + +-- | Ethereum standard hashed message. +-- +-- The data will be UTF-8 HEX decoded and enveloped as follows: +-- "\x19Ethereum Signed Message:\n" + message.length + message and hashed using keccak256. +hashMessage :: ByteArrayAccess message => message -> Digest Keccak_256 +hashMessage msg = hashWith Keccak_256 prefixed + where + len = LBS.toStrict . toLazyByteString . intDec . BA.length + prefixed = "\x19" <> "Ethereum Signed Message:\n" <> len msg <> convert msg + +-- | Sign Ethereum transaction. +-- +-- /WARNING:/ Vulnerable to timing attacks. +signTransaction :: ByteArray ba + => (Maybe (Integer, Integer, Word8) -> ba) + -- ^ Two way transaction packer (unsigned and signed) + -> PrivateKey + -- ^ Private key + -> ba + -- ^ Encoded transaction +signTransaction encode key = encode $ Just signed + 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 diff --git a/src/Crypto/Ethereum/Utils.hs b/src/Crypto/Ethereum/Utils.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Ethereum/Utils.hs @@ -0,0 +1,53 @@ +-- | +-- Module : Crypto.Ethereum.Utils +-- Copyright : Alexander Krupenkin 2018 +-- License : BSD3 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- EC cryptography on Secp256k1 curve. +-- + +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 + +-- | Keccak 256 hash function. +sha3 :: (ByteArrayAccess bin, ByteArray bout) => bin -> bout +{-# INLINE sha3 #-} +sha3 = convert . hashWith Keccak_256 diff --git a/src/Crypto/Random/HmacDrbg.hs b/src/Crypto/Random/HmacDrbg.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Random/HmacDrbg.hs @@ -0,0 +1,68 @@ +-- | +-- Module : Crypto.Random.HmacDrbg +-- Copyright : Alexander Krupenkin 2018 +-- License : BSD3 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : portable +-- +-- NIST standardized number-theoretically secure random number generator. +-- https://csrc.nist.gov/csrc/media/events/random-number-generation-workshop-2004/documents/hashblockcipherdrbg.pdf +-- +-- XXX: This algorithm requires reseed after 2^48 iterations. +-- +-- > Inspired by https://github.com/TomMD/DRBG and https://github.com/indutny/hmac-drbg. +-- + +module Crypto.Random.HmacDrbg + ( + HmacDrbg + , initialize + ) where + + +import Crypto.Hash (HashAlgorithm, digestFromByteString, + hashDigestSize) +import Crypto.MAC.HMAC (HMAC (..), hmac) +import Crypto.Random (DRG (..)) +import Data.ByteArray (ByteArray, convert, singleton) +import qualified Data.ByteArray as BA (null, take) +import qualified Data.ByteString as B (replicate) +import Data.Maybe (fromJust) +import Data.Monoid ((<>)) +import Data.Word (Word8) + +-- | HMAC Deterministic Random Bytes Generator. +newtype HmacDrbg a = HmacDrbg (HMAC a, HMAC a) + deriving Eq + +instance HashAlgorithm a => DRG (HmacDrbg a) where + randomBytesGenerate = generate + +update :: (ByteArray bin, HashAlgorithm a) + => bin + -> HmacDrbg a + -> HmacDrbg a +update input | BA.null input = go 0x00 + | otherwise = go 0x01 . go 0x00 + where + go :: HashAlgorithm a => Word8 -> HmacDrbg a -> HmacDrbg a + go c (HmacDrbg (k, v)) = let k' = hmac k (convert v <> singleton c <> input) + v' = hmac k' v + in HmacDrbg (k', v') + +-- | Initialize HMAC-DRBG by seed. +initialize :: (ByteArray seed, HashAlgorithm a) + => seed + -> HmacDrbg a +initialize = flip update $ HmacDrbg (hmac0 undefined 0x00, hmac0 undefined 0x01) + where + hmac0 :: HashAlgorithm a => a -> Word8 -> HMAC a + hmac0 a = HMAC . fromJust . digestFromByteString . B.replicate (hashDigestSize a) + +generate :: (HashAlgorithm a, ByteArray output) => Int -> HmacDrbg a -> (output, HmacDrbg a) +generate reqBytes (HmacDrbg (k, v)) = (output, HmacDrbg (k, vFinal)) + where + getV (u, rest) = let v' = hmac k u in (v', rest <> convert v') + (vFinal, output) = BA.take reqBytes <$> iterate getV (v, mempty) !! reqBytes diff --git a/src/Data/ByteArray/HexString.hs b/src/Data/ByteArray/HexString.hs --- a/src/Data/ByteArray/HexString.hs +++ b/src/Data/ByteArray/HexString.hs @@ -48,15 +48,13 @@ instance ToJSON HexString where toJSON = String . toText --- | Smart constructor which validates that all the text are actually --- have `0x` prefix, hexadecimal characters and length is even. +-- | Smart constructor which trims '0x' and validates length is even. hexString :: ByteArray ba => ba -> Either String HexString -hexString bs - | BA.take 2 bs == hexStart = HexString <$> bs' - | otherwise = Left "Hex string should start from '0x'" +hexString bs = HexString <$> convertFromBase Base16 bs' where hexStart = convert ("0x" :: ByteString) - bs' = convertFromBase Base16 (BA.drop 2 bs) + bs' | BA.take 2 bs == hexStart = BA.drop 2 bs + | otherwise = bs -- | Reads a raw bytes and converts to hex representation. fromBytes :: ByteArrayAccess ba => ba -> HexString diff --git a/src/Data/Solidity/Prim/Address.hs b/src/Data/Solidity/Prim/Address.hs --- a/src/Data/Solidity/Prim/Address.hs +++ b/src/Data/Solidity/Prim/Address.hs @@ -23,7 +23,7 @@ , toHexString , fromHexString - -- * Public key to @Address@ convertor + -- * Derive address from public key , fromPubKey -- * EIP55 Mix-case checksum address encoding @@ -32,12 +32,11 @@ ) where import Control.Monad ((<=<)) -import Crypto.Hash (Keccak_256 (..), hashWith) -import Crypto.Secp256k1 (PubKey, exportPubKey) +import Crypto.PubKey.ECC.ECDSA (PublicKey) import Data.Aeson (FromJSON (..), ToJSON (..)) import Data.Bits ((.&.)) import Data.Bool (bool) -import Data.ByteArray (convert, zero) +import Data.ByteArray (zero) import qualified Data.ByteArray as BA (drop) import Data.ByteString (ByteString) import qualified Data.ByteString as BS (take, unpack) @@ -50,6 +49,7 @@ import Generics.SOP (Generic) import qualified GHC.Generics as GHC (Generic) +import Crypto.Ethereum.Utils (exportPubKey, sha3) import Data.ByteArray.HexString (HexString, fromBytes, toBytes, toText) import Data.Solidity.Abi (AbiGet (..), AbiPut (..), @@ -88,14 +88,14 @@ toJSON = toJSON . toHexString -- | Derive address from secp256k1 public key -fromPubKey :: PubKey -> Address +fromPubKey :: PublicKey -> Address fromPubKey key = - case decode $ zero 12 <> BA.drop 12 (sha3 key) of + case decode $ zero 12 <> toAddress (exportPubKey key) of Right a -> a Left e -> error $ "Impossible error: " ++ e where - sha3 :: PubKey -> ByteString - sha3 = convert . hashWith Keccak_256 . BA.drop 1 . exportPubKey False + toAddress :: HexString -> HexString + toAddress = BA.drop 12 . sha3 -- | Decode address from hex string fromHexString :: HexString -> Either String Address @@ -113,7 +113,7 @@ toChecksum :: ByteString -> ByteString toChecksum addr = ("0x" <>) . C8.pack $ zipWith ($) upcaseVector lower where - upcaseVector = (>>= fourthBits) . BS.unpack . BS.take 20 . convert $ hashWith Keccak_256 (C8.pack lower) + upcaseVector = (>>= fourthBits) . BS.unpack . BS.take 20 $ sha3 (C8.pack lower) fourthBits n = bool id C.toUpper <$> [n .&. 0x80 /= 0, n .&. 0x08 /= 0] lower = drop 2 . fmap C.toLower . C8.unpack $ addr diff --git a/src/Data/Solidity/Prim/Int.hs b/src/Data/Solidity/Prim/Int.hs --- a/src/Data/Solidity/Prim/Int.hs +++ b/src/Data/Solidity/Prim/Int.hs @@ -51,7 +51,7 @@ toInteger = Basement.toInteger quotRem a b = (Basement.quot a b, Basement.rem a b) --- | Unsigned integer with fixed length in bits +-- | Unsigned integer with fixed length in bits. newtype UIntN (n :: Nat) = UIntN { unUIntN :: Word256 } deriving (Eq, Ord, Enum, Bits, Generic) @@ -91,7 +91,7 @@ instance (n <= 256) => AbiPut (UIntN n) where abiPut = putWord256 . unUIntN --- Signed integer with fixed length in bits +-- | Signed integer with fixed length in bits. newtype IntN (n :: Nat) = IntN { unIntN :: Word256 } deriving (Eq, Ord, Enum, Bits, Generic) @@ -131,9 +131,11 @@ instance (n <= 256) => AbiPut (IntN n) where abiPut = putWord256 . unIntN +-- | Serialize 256 bit unsigned integer. putWord256 :: Putter Word256 putWord256 (Word256 a3 a2 a1 a0) = put a3 >> put a2 >> put a1 >> put a0 +-- | Deserialize 256 bit unsigned integer. getWord256 :: Get Word256 getWord256 = Word256 <$> get <*> get <*> get <*> get diff --git a/src/Language/Solidity/Compiler.hs b/src/Language/Solidity/Compiler.hs deleted file mode 100644 --- a/src/Language/Solidity/Compiler.hs +++ /dev/null @@ -1,58 +0,0 @@ -{-# LANGUAGE CPP #-} -#ifdef SOLIDITY_COMPILER -{-# LANGUAGE RecordWildCards #-} -#endif - --- | --- Module : Language.Solidity.Compiler --- Copyright : Alexander Krupenkin 2017 --- License : BSD3 --- --- Maintainer : mail@akru.me --- Stability : experimental --- Portability : portable --- --- Solidity compiler high-level bindings. --- - -module Language.Solidity.Compiler where - -#ifdef SOLIDITY_COMPILER - -import Data.ByteString (ByteString) -import Data.Map (Map) -import Data.Semigroup (Semigroup (..)) -import qualified Language.Solidity.Compiler.Foreign as FFI -import System.IO.Unsafe (unsafePerformIO) - --- | Input contract sources -data Sources = Sources - { sourceMap :: Map ByteString ByteString - -- ^ Source code map from contract name in keys - , libraries :: Map ByteString ByteString - -- ^ Library address map for linking - , optimization :: Bool - -- ^ Enable optimization? - } deriving (Eq, Show) - -instance Semigroup Sources where - a <> b = Sources (sourceMap a `mappend` sourceMap b) - (libraries a `mappend` libraries b) - (optimization a || optimization b) - -instance Monoid Sources where - mappend = (<>) - mempty = Sources mempty mempty False - -type Compiled = Map ByteString (ByteString, ByteString) - --- | Compile Solidity contracts -compile :: Sources - -- ^ Contract sources - -> Either ByteString Compiled - -- ^ Error string or compiled contracts ABI and hex -{-# NOINLINE compile #-} -compile Sources{..} = unsafePerformIO $ - FFI.compile sourceMap libraries optimization - -#endif diff --git a/src/Language/Solidity/Compiler/Foreign.hsc b/src/Language/Solidity/Compiler/Foreign.hsc deleted file mode 100644 --- a/src/Language/Solidity/Compiler/Foreign.hsc +++ /dev/null @@ -1,106 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE ForeignFunctionInterface #-} - --- | --- Module : Language.Solidity.Compiler.Foreign --- Copyright : Alexander Krupenkin 2017 --- License : BSD3 --- --- Maintainer : mail@akru.me --- Stability : experimental --- Portability : unportable --- --- Ethereum Solidity library FFI. --- - -module Language.Solidity.Compiler.Foreign where - -#ifdef SOLIDITY_COMPILER -#include - -import Data.Map as M -import Data.ByteString.Char8 as BS -import Data.Typeable (Typeable) -import Foreign.C.String (CString, peekCString, withCString) -import Foreign.C.Types (CInt(..)) -import Foreign.Ptr (Ptr) -import Foreign (free) - -data Solidity - deriving Typeable - -foreign import ccall unsafe "create" c_create - :: IO (Ptr Solidity) -foreign import ccall unsafe "destroy" c_destroy - :: Ptr Solidity -> IO () -foreign import ccall unsafe "addSource" c_addSource - :: Ptr Solidity -> CString -> CString -> IO CInt -foreign import ccall unsafe "addLibrary" c_addLibrary - :: Ptr Solidity -> CString -> CString -> IO CInt -foreign import ccall unsafe "compile" c_compile - :: Ptr Solidity -> CInt -> IO CInt -foreign import ccall unsafe "abi" c_abi - :: Ptr Solidity -> CString -> IO CString -foreign import ccall unsafe "binary" c_binary - :: Ptr Solidity -> CString -> IO CString -foreign import ccall unsafe "errors" c_errors - :: Ptr Solidity -> IO CString - -withSolidity :: (Ptr Solidity -> IO a) -> IO a -{-# INLINE withSolidity #-} -withSolidity f = do - ptr <- c_create - r <- f ptr - c_destroy ptr - return r - -withCStringPair :: (CString -> CString -> IO a) -> (ByteString, ByteString) -> IO a -{-# INLINE withCStringPair #-} -withCStringPair f (a, b) = - withCString (BS.unpack a) $ \astr -> - withCString (BS.unpack b) $ \bstr -> - f astr bstr - -addSources :: Ptr Solidity -> Map ByteString ByteString -> IO () -{-# INLINE addSources #-} -addSources ptr = mapM_ (withCStringPair $ c_addSource ptr) . M.toList - -addLibraries :: Ptr Solidity -> Map ByteString ByteString -> IO () -{-# INLINE addLibraries #-} -addLibraries ptr = mapM_ (withCStringPair $ c_addLibrary ptr) . M.toList - -result :: Ptr Solidity -> ByteString -> IO (ByteString, ByteString) -result ptr name = - withCString (BS.unpack name) $ \cname -> do - abi <- c_abi ptr cname - bin <- c_binary ptr cname - res <- (,) <$> fmap BS.pack (peekCString abi) - <*> fmap BS.pack (peekCString bin) - free abi - free bin - return res - -errors :: Ptr Solidity -> IO ByteString -errors ptr = do - errs <- c_errors ptr - res <- BS.pack <$> peekCString errs - free errs - return res - -compile :: Map ByteString ByteString - -> Map ByteString ByteString - -> Bool - -> IO (Either ByteString (Map ByteString (ByteString, ByteString))) -compile srcs libs opt = - withSolidity $ \ptr -> do - addSources ptr srcs - addLibraries ptr libs - res <- c_compile ptr optI - let compiled = sequence $ M.mapWithKey (const . result ptr) srcs - if res < 0 - then Left <$> errors ptr - else Right <$> compiled - where optI | opt = 1 - | otherwise = 0 - -#endif diff --git a/src/Network/Ethereum/Account.hs b/src/Network/Ethereum/Account.hs --- a/src/Network/Ethereum/Account.hs +++ b/src/Network/Ethereum/Account.hs @@ -29,8 +29,8 @@ , Personal(..) -- * Local key account - , PrivateKeyAccount - , PrivateKey(..) + , LocalKeyAccount + , LocalKey(..) -- * Transaction paramitrization function and lenses , withParam @@ -43,12 +43,12 @@ ) where -import Network.Ethereum.Account.Class (Account (..)) -import Network.Ethereum.Account.Default (DefaultAccount) -import Network.Ethereum.Account.Internal (account, block, gasLimit, - gasPrice, to, value, - withParam) -import Network.Ethereum.Account.Personal (Personal (..), - PersonalAccount) -import Network.Ethereum.Account.PrivateKey (PrivateKey (..), - PrivateKeyAccount) +import Network.Ethereum.Account.Class (Account (..)) +import Network.Ethereum.Account.Default (DefaultAccount) +import Network.Ethereum.Account.Internal (account, block, gasLimit, + gasPrice, to, value, + withParam) +import Network.Ethereum.Account.LocalKey (LocalKey (..), + LocalKeyAccount) +import Network.Ethereum.Account.Personal (Personal (..), + PersonalAccount) diff --git a/src/Network/Ethereum/Account/LocalKey.hs b/src/Network/Ethereum/Account/LocalKey.hs new file mode 100644 --- /dev/null +++ b/src/Network/Ethereum/Account/LocalKey.hs @@ -0,0 +1,96 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeSynonymInstances #-} + +-- | +-- Module : Network.Ethereum.Account.LocalKey +-- Copyright : Alexander Krupenkin 2018 +-- Roy Blankman 2018 +-- License : BSD3 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unportable +-- +-- Using ECC for singing transactions locally, e.g. out of Ethereum node. +-- Transaction will send using 'eth_sendRawTransacion' JSON-RPC method. +-- + +module Network.Ethereum.Account.LocalKey where + +import Control.Monad.State.Strict (get, runStateT) +import Control.Monad.Trans (lift) +import Crypto.PubKey.ECC.ECDSA (PrivateKey) +import Data.ByteArray (convert) +import Data.ByteString (empty) +import Data.Default (Default (..)) +import Data.Monoid ((<>)) +import Data.Proxy (Proxy (..)) + +import Crypto.Ethereum (derivePubKey, importKey) +import Crypto.Ethereum.Signature (signTransaction) +import Data.Solidity.Abi.Codec (decode, encode) +import Data.Solidity.Prim.Address (fromPubKey) +import Network.Ethereum.Account.Class (Account (..)) +import Network.Ethereum.Account.Internal (AccountT (..), + CallParam (..), + defaultCallParam, getCall, + getReceipt) +import qualified Network.Ethereum.Api.Eth as Eth (call, estimateGas, + getTransactionCount, + sendRawTransaction) +import Network.Ethereum.Api.Types (Call (..)) +import Network.Ethereum.Chain (foundation) +import Network.Ethereum.Contract.Method (selector) +import Network.Ethereum.Transaction (encodeTransaction) + +-- | Local EOA params +data LocalKey = LocalKey + { localKeyPrivate :: !PrivateKey + , localKeyChainId :: !Integer + } deriving (Eq, Show) + +instance Default LocalKey where + def = LocalKey (importKey empty) foundation + +type LocalKeyAccount = AccountT LocalKey + +instance Account LocalKey LocalKeyAccount where + withAccount a = + fmap fst . flip runStateT (defaultCallParam a) . runAccountT + + send (args :: a) = do + CallParam{..} <- get + c <- getCall + + let dat = selector (Proxy :: Proxy a) <> encode args + address = fromPubKey (derivePubKey $ localKeyPrivate _account) + + nonce <- lift $ Eth.getTransactionCount address _block + let params = c { callFrom = Just address + , callNonce = Just nonce + , callData = Just $ convert dat } + + params' <- case callGas params of + Just _ -> return params + Nothing -> do + gasLimit <- lift $ Eth.estimateGas params + return $ params { callGas = Just gasLimit } + + let packer = encodeTransaction params' (localKeyChainId _account) + signed = signTransaction packer (localKeyPrivate _account) + lift $ getReceipt =<< Eth.sendRawTransaction signed + + call (args :: a) = do + CallParam{..} <- get + c <- getCall + let dat = selector (Proxy :: Proxy a) <> encode args + address = fromPubKey (derivePubKey $ localKeyPrivate _account) + params = c { callFrom = Just address, callData = Just $ convert dat } + + res <- lift $ Eth.call params _block + case decode res of + Right r -> return r + Left e -> fail e diff --git a/src/Network/Ethereum/Account/PrivateKey.hs b/src/Network/Ethereum/Account/PrivateKey.hs deleted file mode 100644 --- a/src/Network/Ethereum/Account/PrivateKey.hs +++ /dev/null @@ -1,130 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeSynonymInstances #-} - --- | --- Module : Network.Ethereum.Account.PrivateKey --- Copyright : Alexander Krupenkin 2018 --- Roy Blankman 2018 --- License : BSD3 --- --- Maintainer : mail@akru.me --- Stability : experimental --- Portability : unportable --- - -module Network.Ethereum.Account.PrivateKey where - -import Control.Monad.State.Strict (get, runStateT) -import Control.Monad.Trans (lift) -import Crypto.Secp256k1 (CompactRecSig (..), SecKey, - derivePubKey) -import Data.ByteArray (convert) -import Data.ByteString (ByteString) -import Data.ByteString.Short (fromShort) -import Data.Default (Default (..)) -import Data.Maybe (fromJust, fromMaybe) -import Data.Monoid (mempty, (<>)) -import Data.Proxy (Proxy (..)) -import Data.RLP (packRLP, rlpEncode) - -import Crypto.Ethereum (ecsign) -import Data.ByteArray.HexString (HexString, toBytes) -import Data.Solidity.Abi.Codec (decode, encode) -import Data.Solidity.Prim.Address (fromPubKey, toHexString) -import Network.Ethereum.Account.Class (Account (..)) -import Network.Ethereum.Account.Internal (AccountT (..), - CallParam (..), - defaultCallParam, getCall, - getReceipt) -import qualified Network.Ethereum.Api.Eth as Eth (call, estimateGas, - getTransactionCount, - sendRawTransaction) -import Network.Ethereum.Api.Types (Call (..), unQuantity) -import Network.Ethereum.Chain (foundation) -import Network.Ethereum.Contract.Method (selector) -import Network.Ethereum.Unit (Shannon, toWei) - --- | Local EOA params -data PrivateKey = PrivateKey - { privateKey :: !SecKey - , privateKeyChain :: !Integer - } deriving (Eq, Show) - -instance Default PrivateKey where - def = PrivateKey "" foundation - -type PrivateKeyAccount = AccountT PrivateKey - -instance Account PrivateKey PrivateKeyAccount where - withAccount a = - fmap fst . flip runStateT (defaultCallParam a) . runAccountT - - send (args :: a) = do - CallParam{..} <- get - c <- getCall - - let dat = selector (Proxy :: Proxy a) <> encode args - address = fromPubKey (derivePubKey $ privateKey _account) - - nonce <- lift $ Eth.getTransactionCount address _block - let params = c { callFrom = Just address - , callNonce = Just nonce - , callData = Just $ convert dat } - - params' <- case callGas params of - Just _ -> return params - Nothing -> do - gasLimit <- lift $ Eth.estimateGas params - return $ params { callGas = Just gasLimit } - - let signed = signTransaction params' (privateKeyChain _account) (privateKey _account) - lift $ getReceipt =<< Eth.sendRawTransaction signed - - call (args :: a) = do - CallParam{..} <- get - c <- getCall - let dat = selector (Proxy :: Proxy a) <> encode args - address = fromPubKey (derivePubKey $ privateKey _account) - params = c { callFrom = Just address, callData = Just $ convert dat } - - res <- lift $ Eth.call params _block - case decode res of - Right r -> return r - Left e -> fail e - -encodeTransaction :: Call - -> Either Integer (Integer, ByteString, ByteString) - -> HexString -encodeTransaction Call{..} vrs = do - let (to :: ByteString) = maybe mempty (toBytes . toHexString) callTo - (value :: Integer) = unQuantity $ fromJust callValue - (nonce :: Integer) = unQuantity $ fromJust callNonce - (gasPrice :: Integer) = maybe defaultGasPrice unQuantity callGasPrice - (gasLimit :: Integer) = unQuantity $ fromJust callGas - (input :: ByteString) = convert $ fromMaybe mempty callData - - rlp $ case vrs of - -- Unsigned transaction by EIP155 - Left chain_id -> (nonce, gasPrice, gasLimit, to, value, input, chain_id, mempty, mempty) - -- Signed transaction - Right (v, r, s) -> (nonce, gasPrice, gasLimit, to, value, input, v, s, r) - where - rlp = convert . packRLP . rlpEncode - defaultGasPrice = toWei (5 :: Shannon) - -signTransaction :: Call - -> Integer - -> SecKey - -> HexString -signTransaction c i key = encodeTransaction c $ Right (v', r, s) - where - unsigned = encodeTransaction c (Left i) - recSig = ecsign key unsigned - v = fromIntegral $ getCompactRecSigV recSig - r = fromShort $ getCompactRecSigR recSig - s = fromShort $ getCompactRecSigS recSig - v' = v + 35 + 2 * i -- Improved 'v' according to EIP155 diff --git a/src/Network/Ethereum/Chain.hs b/src/Network/Ethereum/Chain.hs --- a/src/Network/Ethereum/Chain.hs +++ b/src/Network/Ethereum/Chain.hs @@ -7,6 +7,7 @@ -- Stability : experimental -- Portability : unportable -- +-- Ethereum chain IDs. -- module Network.Ethereum.Chain where 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 @@ -193,7 +193,7 @@ , instanceD' nonIndexedName (conT ''Generic) [] , instanceD' nonIndexedName (conT ''AbiType) [funD' 'isDynamic [] [|const False|]] , instanceD' nonIndexedName (conT ''AbiGet) [] - , dataD' allName (recC allName (map (\(n, a) -> ((\(b,t) -> return (n,b,t)) <=< toBang <=< typeQ $ a)) allArgs)) derivingD + , dataD' allName (recC allName (map (\(n, a) -> (\(b,t) -> return (n,b,t)) <=< toBang <=< typeQ $ a) allArgs)) derivingD , instanceD' allName (conT ''Generic) [] , instanceD (cxt []) (pure $ ConT ''IndexedEvent `AppT` ConT indexedName `AppT` ConT nonIndexedName `AppT` ConT allName) diff --git a/src/Network/Ethereum/Transaction.hs b/src/Network/Ethereum/Transaction.hs new file mode 100644 --- /dev/null +++ b/src/Network/Ethereum/Transaction.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | +-- Module : Network.Ethereum.Transaction +-- Copyright : Alexander Krupenkin 2018 +-- Roy Blankman 2018 +-- License : BSD3 +-- +-- Maintainer : mail@akru.me +-- Stability : experimental +-- Portability : unportable +-- +-- Transaction managing utils. +-- + +module Network.Ethereum.Transaction where + +import Data.ByteArray (ByteArray, convert) +import Data.ByteString (ByteString, empty) +import Data.Maybe (fromJust, fromMaybe) +import Data.RLP (packRLP, rlpEncode) +import Data.Word (Word8) + +import Data.ByteArray.HexString (toBytes) +import Data.Solidity.Prim.Address (toHexString) +import Network.Ethereum.Api.Types (Call (..), Quantity (unQuantity)) +import Network.Ethereum.Unit (Shannon, toWei) + +-- | Ethereum transaction packer. +-- +-- Two way RLP encoding of Ethereum transaction: for unsigned and signed. +-- Packing scheme described in https://github.com/ethereum/EIPs/blob/master/EIPS/eip-155.md +encodeTransaction :: ByteArray ba + => Call + -- ^ Transaction call + -> Integer + -- ^ Chain ID + -> Maybe (Integer, Integer, Word8) + -- ^ Should contain signature when transaction signed + -> ba + -- ^ RLP encoded transaction +encodeTransaction Call{..} chain_id rsv = + let (to :: ByteString) = maybe mempty (toBytes . toHexString) callTo + (value :: Integer) = unQuantity $ fromJust callValue + (nonce :: Integer) = unQuantity $ fromJust callNonce + (gasPrice :: Integer) = maybe defaultGasPrice unQuantity callGasPrice + (gasLimit :: Integer) = unQuantity $ fromJust callGas + (input :: ByteString) = convert $ fromMaybe mempty callData + + in convert . packRLP $ case rsv of + -- Unsigned transaction by EIP155 + Nothing -> rlpEncode (nonce, gasPrice, gasLimit, to, value, input, chain_id, empty, empty) + -- Signed transaction + Just (r, s, v) -> + let v' = fromIntegral v + 8 + 2 * chain_id -- Improved 'v' according to EIP155 + in rlpEncode (nonce, gasPrice, gasLimit, to, value, input, v', r, s) + where + defaultGasPrice = toWei (10 :: Shannon) diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,5 +1,5 @@ # Resolver to choose a 'specific' stackage snapshot or a compiler version. -resolver: lts-12.19 +resolver: lts-13.2 # User packages to be built. packages: @@ -7,7 +7,6 @@ # Extra package dependencies extra-deps: -- secp256k1-haskell-0.1.4 - relapse-1.0.0.0 # Dependencies bounds @@ -21,6 +20,5 @@ - jsoncpp - solc - solc.dev - - secp256k1 - haskellPackages.hlint - - haskellPackages.stylish-haskell + #- haskellPackages.stylish-haskell diff --git a/test/Network/Ethereum/Web3/Test/ComplexStorageSpec.hs b/test/Network/Ethereum/Web3/Test/ComplexStorageSpec.hs --- a/test/Network/Ethereum/Web3/Test/ComplexStorageSpec.hs +++ b/test/Network/Ethereum/Web3/Test/ComplexStorageSpec.hs @@ -10,7 +10,7 @@ {-# LANGUAGE TemplateHaskell #-} -- | --- Module : Network.Ethereum.Web3.Test.ComplexStorage +-- Module : Network.Ethereum.Web3.Test.ComplexStorageSpec -- Copyright : Alexander Krupenkin 2016 -- License : BSD3 -- diff --git a/test/Network/Ethereum/Web3/Test/LinearizationSpec.hs b/test/Network/Ethereum/Web3/Test/LinearizationSpec.hs --- a/test/Network/Ethereum/Web3/Test/LinearizationSpec.hs +++ b/test/Network/Ethereum/Web3/Test/LinearizationSpec.hs @@ -13,7 +13,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} --- Module : Network.Ethereum.Web3.Test.SimpleStorage +-- Module : Network.Ethereum.Web3.Test.LinearizationSpec -- Copyright : Alexander Krupenkin 2016 -- License : BSD3 -- @@ -21,9 +21,6 @@ -- 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.LinearizationSpec where diff --git a/test/Network/Ethereum/Web3/Test/LocalAccountSpec.hs b/test/Network/Ethereum/Web3/Test/LocalAccountSpec.hs new file mode 100644 --- /dev/null +++ b/test/Network/Ethereum/Web3/Test/LocalAccountSpec.hs @@ -0,0 +1,52 @@ +{-# 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) diff --git a/test/Network/Ethereum/Web3/Test/SimpleStorageSpec.hs b/test/Network/Ethereum/Web3/Test/SimpleStorageSpec.hs --- a/test/Network/Ethereum/Web3/Test/SimpleStorageSpec.hs +++ b/test/Network/Ethereum/Web3/Test/SimpleStorageSpec.hs @@ -12,7 +12,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} --- Module : Network.Ethereum.Web3.Test.SimpleStorage +-- Module : Network.Ethereum.Web3.Test.SimpleStorageSpec -- Copyright : Alexander Krupenkin 2016 -- License : BSD3 -- diff --git a/unit/Crypto/Ethereum/Test/EcdsaSpec.hs b/unit/Crypto/Ethereum/Test/EcdsaSpec.hs deleted file mode 100644 --- a/unit/Crypto/Ethereum/Test/EcdsaSpec.hs +++ /dev/null @@ -1,32 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Crypto.Ethereum.Test.EcdsaSpec where - -import Crypto.Secp256k1 (SecKey, derivePubKey) -import Data.ByteArray (convert) -import Data.ByteString (ByteString, pack) -import Data.Serialize (decode) -import Test.Hspec -import Test.Hspec.QuickCheck - -import Crypto.Ethereum -import Data.ByteArray.HexString (HexString) -import Data.Solidity.Prim.Address (fromPubKey) - -spec :: Spec -spec = do - describe "Ethereum signatures" $ do - let key = "0102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f20" :: SecKey - address = fromPubKey (derivePubKey key) - message = "Hello World!" :: ByteString - sign = "0xd4a9620cd94387a31b9333935f1e76fbee8467c283d07c39c1606dc4e2af021e317293af09601dbb48f547e40f6b98fe8a67a23dcd1f7f8d054695a81521177001" :: HexString - sign' = either error id $ decode (convert sign) - - it "sign message by Ethereum private key" $ do - ecsign key message `shouldBe` sign' - - it "verify message by Ethereum public key" $ do - ecrecover sign' message `shouldBe` Just address - - prop "round robin sign/verify for random message" $ \chars -> - let msg = pack chars - in ecrecover (ecsign key msg) msg `shouldBe` Just address diff --git a/unit/Crypto/Ethereum/Test/KeyfileSpec.hs b/unit/Crypto/Ethereum/Test/KeyfileSpec.hs new file mode 100644 --- /dev/null +++ b/unit/Crypto/Ethereum/Test/KeyfileSpec.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE OverloadedStrings #-} +module Crypto.Ethereum.Test.KeyfileSpec where + +import Data.Aeson (eitherDecode) +import Data.ByteString (ByteString) +import qualified Data.ByteString.Lazy as L (ByteString) +import Data.UUID.Types (UUID) +import Test.Hspec + +import Crypto.Ethereum.Keyfile +import Data.ByteArray.HexString (HexString) + +pbkdf2_test_keyfile :: L.ByteString +pbkdf2_test_keyfile = "\ +\{\ +\ \"crypto\" : {\ +\ \"cipher\" : \"aes-128-ctr\",\ +\ \"cipherparams\" : {\ +\ \"iv\" : \"6087dab2f9fdbbfaddc31a909735c1e6\"\ +\ },\ +\ \"ciphertext\" : \"5318b4d5bcd28de64ee5559e671353e16f075ecae9f99c7a79a38af5f869aa46\",\ +\ \"kdf\" : \"pbkdf2\",\ +\ \"kdfparams\" : {\ +\ \"c\" : 262144,\ +\ \"dklen\" : 32,\ +\ \"prf\" : \"hmac-sha256\",\ +\ \"salt\" : \"ae3cd4e7013836a3df6bd7241b12db061dbe2c6785853cce422d148a624ce0bd\"\ +\ },\ +\ \"mac\" : \"517ead924a9d0dc3124507e3393d175ce3ff7c1e96529c6c555ce9e51205e9b2\"\ +\ },\ +\ \"id\" : \"3198bc9c-6672-5ab3-d995-4942343ae5b6\",\ +\ \"version\" : 3\ +\}" + +scrypt_test_keyfile :: L.ByteString +scrypt_test_keyfile = "\ +\{\ +\ \"crypto\" : {\ +\ \"cipher\" : \"aes-128-ctr\",\ +\ \"cipherparams\" : {\ +\ \"iv\" : \"83dbcc02d8ccb40e466191a123791e0e\"\ +\ },\ +\ \"ciphertext\" : \"d172bf743a674da9cdad04534d56926ef8358534d458fffccd4e6ad2fbde479c\",\ +\ \"kdf\" : \"scrypt\",\ +\ \"kdfparams\" : {\ +\ \"dklen\" : 32,\ +\ \"n\" : 262144,\ +\ \"r\" : 1,\ +\ \"p\" : 8,\ +\ \"salt\" : \"ab0c7876052600dd703518d6fc3fe8984592145b591fc8fb5c6d43190334ba19\"\ +\ },\ +\ \"mac\" : \"2103ac29920d71da29f15d75b4a16dbe95cfd7ff8faea1056c33131d846e3097\"\ +\ },\ +\ \"id\" : \"3198bc9c-6672-5ab3-d995-4942343ae5b6\",\ +\ \"version\" : 3\ +\}" + +test_uuid :: UUID +test_uuid = read "3198bc9c-6672-5ab3-d995-4942343ae5b6" + +test_pbkdf2_mac :: HexString +test_pbkdf2_mac = "517ead924a9d0dc3124507e3393d175ce3ff7c1e96529c6c555ce9e51205e9b2" + +test_scrypt_mac :: HexString +test_scrypt_mac = "2103ac29920d71da29f15d75b4a16dbe95cfd7ff8faea1056c33131d846e3097" + +test_password :: ByteString +test_password = "testpassword" + +test_private :: HexString +test_private = "7a28b5ba57c53603b0b07b56bba752f7784bf506fa95edc395f5cf6c7514fe9d" + +spec :: Spec +spec = do + describe "AES-128-CTR and PBKDF2-SHA-256" $ do + it "can decode keyfile" $ + case eitherDecode pbkdf2_test_keyfile of + Left e -> error e + Right ekey -> do + encryptedKeyId ekey `shouldBe` test_uuid + encryptedKeyMac ekey `shouldBe` test_pbkdf2_mac + + it "can decrypt keyfile" $ do + case eitherDecode pbkdf2_test_keyfile of + Left e -> error e + Right ekey -> decrypt ekey test_password `shouldBe` Just test_private + + describe "AES-128-CTR and Scrypt" $ do + it "can decode keyfile" $ + case eitherDecode scrypt_test_keyfile of + Left e -> error e + Right ekey -> do + encryptedKeyId ekey `shouldBe` test_uuid + encryptedKeyMac ekey `shouldBe` test_scrypt_mac + + it "can decrypt keyfile" $ + case eitherDecode scrypt_test_keyfile of + Left e -> error e + Right ekey -> decrypt ekey test_password `shouldBe` Just test_private diff --git a/unit/Crypto/Ethereum/Test/SignatureSpec.hs b/unit/Crypto/Ethereum/Test/SignatureSpec.hs new file mode 100644 --- /dev/null +++ b/unit/Crypto/Ethereum/Test/SignatureSpec.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE OverloadedStrings #-} +module Crypto.Ethereum.Test.SignatureSpec where + +import Data.ByteArray (convert) +import Data.Foldable (for_) +import Test.Hspec +import Test.Hspec.QuickCheck + +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 (..)) +import Network.Ethereum.Transaction (encodeTransaction) + +test_vector :: [(HexString, HexString, HexString)] +test_vector = [ + ("0xa8510b592963f52d2d8b3413ab5822111c68d45370f6104a869fe6e72c58952fe6b420115a9dfadaae2956ad761db2f113", "0x5cc3704a552b40515909a220d3cb91e850d4d6c6c0180424e433d00400612ed6", "0x3477bfac3621680c30cf3ad59da9288bc53e46773af4911592c6f3b2ba9029861fac19b0fa0cc543731133346eb817cd7f3aa4cabac5e613919567bc9704af861c"), + ("0x5680f1d195bbe2b0f1601a039ad23a6ad488c1f0949a68e84bffe398ad", "0xcaf03f0aa6862758e526dd76782a4afa7ad48533f00f8f9e8731d4a6b1656d9f", "0x659263cb4d54c653e5ef41550f959e15a71b01f19bce88750c8c3cad8ab293d12138db412f471df6c67575d49e9c25b6973a3405396a3e6985a3f391efee74751c"), + ("0x487f9a", "0xa13bf6fdb2e2a5790f4a80d822180c7851b227d16c1893de2359dc98b1e27756", "0x143da940f9e144218979074cfde306d0697b3ddaec4c5e464a5aa093733f957776ba158ec4492a6cdc9951c6e0c1b10040916cb503ad240ed3b76677f9ac4ad41c"), + ("0x958c2c5bafc5eb97004774f4c9b56aaecd37c06befac0042a93c67", "0x496b49cc02b63f927f2669a32dece10876e1a33dc0bd684f7643f849ecbe7c73", "0x34e768e959b89d305f16f796d0ff2da4e5923d6a6f33ba66b29471953e10be1a183743fb764f806ca8d97ad29dad94115d0368f374d5e085348267cc1c5bce411b"), + ("0x02e2", "0x0425c9ac326acac4b93ff871f22c1dfe69c05038c2ac5b9eadb7e09743baa603", "0xbf52108b598a02aeeea1f9ee84947300985953edcfd07351f038bfe0de4c62df5cf467caaa7a33c3c4ebdf4aeaf05b1f4674f6b82b27e87fbf8d2a0980e68f1d1b"), + ("0x74391586ff29f0638d7f7971640cefac3bfa3865ec5310e15a", "0x104432a31597e399f3f0f34e70b52a062feeb65aa3ad5383d2d7b90b0ab50126", "0x78c81fff1acdd1773badea5f35b0149e14b3dffe8de0e554b0edd80526acd55f1fc315b96afe5964df24f28b756f5651a6a52b2b9e0ffc87cda2a4a8f448a8951c"), + ("0xd3ba712ef9dd8f8b37d805a9d1c2b5ee92db66dda0fd8582d55cec1b2519d18dfff2333e29081e80544af7244f2f22", "0x330ee59f080c59252218d1245029d8689b48b021dcf2c438938264bbc61d05af", "0xcf96a0f05e40d05ebcedbff0af522a68e6c846e63b44245a1208592ddf03cc12136ad522656f08fd838c55ff78e093d387d23b30b88a57e467636e63c786e04e1c"), + ("0x1e99da3e7bb02e1f239bbf0b2ea113848673dd52da24c87f2f40", "0x52c58101fe861f9292fb6ad3df74551b5fb3feca9983b108645a5a9354bfbe99", "0x8eebcef599eb67e9379e7d6b074123628c1a65f1b754647704eb003fa61aff0a0e5c79fb022970fea80409e20a12bd4b8e1a79a787394a547fbc93c2d3c1e2dc1c"), + ("0x1e973d1b5b158acc7d710099700c793e702b215a1fa534317d5c44406000fc727c", "0x1280413acfcd88a97b759e72e60069a1dc4f0a595e815aad9a1a83fa73f81af2", "0x7a77a37f2f4378dab5a0ba7f55b858a2a116f885f2eeab30dcd0b6d1f7286fbb7cbdccbd52721ce68fbcf2448a2f450a6bc6bc7f0027906259821bb3800133181b"), + ("0x95da865540bd1336402a325a0435a920768f47d4b1ec0d89e0063f811872d1cb6423b5f4a4b931c9f41b216def", "0x0d537e54120ea923621225e3114b91a568a1abe7b7315b642017cad28cfad40b", "0xe04196529154ab89ceb598654f7d1ae178ecdcf73395aa8e8abb9200b504c39c58a93a6e502aaaddc2cbd712b436e9c9fb1010323927835ac54a7a77f11957f91c") + ] + +test_key :: HexString +test_key = "29461542faa1acbc968bcb332115e0537c023f8df416317602ca5d15ca12d02d" + +spec :: Spec +spec = do + describe "Ethereum ECDSA" $ do + it "can hash Ethereum prefixed message" $ for_ test_vector $ \(msg, msgHash, _) -> + convert (hashMessage msg) `shouldBe` msgHash + + it "can sign Ethereum prefixed message" $ for_ test_vector $ \(msg, _, msgSig) -> + signMessage (importKey test_key) msg `shouldBe` msgSig + + it "can create valid raw transaction" $ do + -- using same example as in this blog post: + -- https://medium.com/@codetractio/walkthrough-of-an-ethereum-improvement-proposal-eip-6fda3966d171 + let testCall = Call Nothing + (Just "0x3535353535353535353535353535353535353535") + (Just 21000) + (Just 20000000000) + (Just 1000000000000000000) + Nothing + (Just 9) + key = "4646464646464646464646464646464646464646464646464646464646464646" :: HexString + correctSignedTx = "f86c098504a817c800825208943535353535353535353535353535353535353535880de0b6b3a76400008025a028ef61340bd939bc2195fe537567866003e1a15d3c71ff63e1590620aa636276a067cbe9d8997f761aecb703304b3800ccf555c9f3dc64214b297fb1966a3b6d83" + signTransaction (encodeTransaction testCall 1) (importKey key) `shouldBe` (correctSignedTx :: HexString) + +{- + it "verify message by Ethereum public key" $ do + ecrecover sign' message `shouldBe` Just address + + prop "round robin sign/verify for random message" $ \chars -> + let msg = pack chars + in ecrecover (ecsign key msg) msg `shouldBe` Just address +-} + diff --git a/unit/Crypto/Random/Test/HmacDrbgSpec.hs b/unit/Crypto/Random/Test/HmacDrbgSpec.hs new file mode 100644 --- /dev/null +++ b/unit/Crypto/Random/Test/HmacDrbgSpec.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE OverloadedStrings #-} +-- Inspired by https://github.com/indutny/hmac-drbg +module Crypto.Random.Test.HmacDrbgSpec where + +import Crypto.Hash.Algorithms (SHA256) +import Crypto.Random (randomBytesGenerate) +import Data.ByteString (ByteString) +import Test.Hspec + +import Crypto.Random.HmacDrbg +import Data.ByteArray.HexString (HexString) + +spec :: Spec +spec = do + describe "HMAC-DRBG-SHA256" $ do + it "indutny/hmac-drbg test vectors" $ do + let doDrbg :: ByteString -> HexString + doDrbg seed = fst (randomBytesGenerate 32 (initialize seed) :: (HexString, HmacDrbg SHA256)) + + doDrbg "totally random0123456789secret noncemy drbg" + `shouldBe` "018ec5f8e08c41e5ac974eb129ac297c5388ee1864324fa13d9b15cf98d9a157" + + doDrbg "totally random0123456789secret nonce" + `shouldBe` "ed5d61ecf0ef38258e62f03bbb49f19f2cd07ba5145a840d83b134d5963b3633" diff --git a/unit/Data/Solidity/Test/AddressSpec.hs b/unit/Data/Solidity/Test/AddressSpec.hs --- a/unit/Data/Solidity/Test/AddressSpec.hs +++ b/unit/Data/Solidity/Test/AddressSpec.hs @@ -1,22 +1,23 @@ {-# LANGUAGE OverloadedStrings #-} module Data.Solidity.Test.AddressSpec where -import Crypto.Secp256k1 (SecKey, derivePubKey) import Data.ByteString (ByteString) import Data.ByteString.Char8 (unpack) import Data.Foldable (for_) import Data.Monoid ((<>)) import Test.Hspec +import Crypto.Ethereum.Utils (derivePubKey, importKey) +import Data.ByteArray.HexString (HexString) import Data.Solidity.Prim.Address spec :: Spec spec = do - describe "EIP55 Test Vectors" $ for_ checksummedAddrs (\addr -> - it (unpack addr <> " should be checksummed") $ verifyChecksum addr `shouldBe` True) + describe "EIP55 Test Vectors" $ for_ checksummedAddrs $ \addr -> + it (unpack addr <> " should be checksummed") $ verifyChecksum addr `shouldBe` True - describe "EIP55 Test Vectors Tampered" $ for_ unchecksummedAddrs (\addr -> - it (unpack addr <> " should not be checksummed") $ verifyChecksum addr `shouldBe` False) + describe "EIP55 Test Vectors Tampered" $ for_ unchecksummedAddrs $ \addr -> + it (unpack addr <> " should not be checksummed") $ verifyChecksum addr `shouldBe` False describe "Conversion from/to hex string" $ do it "should convert from/to on valid hex" $ do @@ -31,10 +32,10 @@ `shouldBe` Left "Incorrect address length: 1" - describe "Conversion from Secp256k1 keys" $ do - it "derivation from private key" $ do - let key = "0102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f20" :: SecKey - fromPubKey (derivePubKey key) + describe "Conversion from ECC keys" $ do + it "can derive address from public key" $ do + let key = "0x0102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f20" :: HexString + fromPubKey (derivePubKey $ importKey key) `shouldBe` "0x6370eF2f4Db3611D657b90667De398a2Cc2a370C" checksummedAddrs :: [ByteString] diff --git a/unit/Language/Solidity/Test/CompilerSpec.hs b/unit/Language/Solidity/Test/CompilerSpec.hs --- a/unit/Language/Solidity/Test/CompilerSpec.hs +++ b/unit/Language/Solidity/Test/CompilerSpec.hs @@ -11,18 +11,18 @@ import Language.Solidity.Compiler spec :: Spec -spec = describe "solidity" $ do +spec = describe "solidity compiler" $ do it "can compile empty contract" $ do compile (Sources [("A", "contract A {}")] [] True) - `shouldBe` Right [("A", ("[]\n", "6080604052348015600f57600080fd5b50603580601d6000396000f3006080604052600080fd00a165627a7a72305820613b8f0a4aab50fea86c1e4943bcddad6d753778395309a4e055efcda614b0690029"))] + `shouldBe` Right [("A", ("[]\n", "6080604052348015600f57600080fd5b50603580601d6000396000f3fe6080604052600080fdfea165627a7a7230582055975a3cf5eb9a652c2154ede405cdb2137a09e47088fb89162c336da0b415c40029"))] it "can handle broken contract" $ do compile (Sources [("Fail", "contract Fail {")] [] True) `shouldBe` Left "Fail:1:16: Error: Function, variable, struct or modifier declaration expected.\ncontract Fail {\n ^\n" it "can compile simple contract" $ do - compile (Sources [("SimpleStorage", "contract SimpleStorage { uint256 public a; function set(uint256 _a) { a = _a; } }")] [] True) - `shouldBe` Right [("SimpleStorage", ("[\n\t{\n\t\t\"constant\" : true,\n\t\t\"inputs\" : [],\n\t\t\"name\" : \"a\",\n\t\t\"outputs\" : \n\t\t[\n\t\t\t{\n\t\t\t\t\"name\" : \"\",\n\t\t\t\t\"type\" : \"uint256\"\n\t\t\t}\n\t\t],\n\t\t\"payable\" : false,\n\t\t\"stateMutability\" : \"view\",\n\t\t\"type\" : \"function\"\n\t},\n\t{\n\t\t\"constant\" : false,\n\t\t\"inputs\" : \n\t\t[\n\t\t\t{\n\t\t\t\t\"name\" : \"_a\",\n\t\t\t\t\"type\" : \"uint256\"\n\t\t\t}\n\t\t],\n\t\t\"name\" : \"set\",\n\t\t\"outputs\" : [],\n\t\t\"payable\" : false,\n\t\t\"stateMutability\" : \"nonpayable\",\n\t\t\"type\" : \"function\"\n\t}\n]\n", "608060405234801561001057600080fd5b5060dc8061001f6000396000f3006080604052600436106049576000357c0100000000000000000000000000000000000000000000000000000000900463ffffffff1680630dbe671f14604e57806360fe47b1146076575b600080fd5b348015605957600080fd5b50606060a0565b6040518082815260200191505060405180910390f35b348015608157600080fd5b50609e6004803603810190808035906020019092919050505060a6565b005b60005481565b80600081905550505600a165627a7a7230582053764f3cc73b0960abb0d97899a8133bee5eb98c131978821f7add85f33d4f2e0029"))] + compile (Sources [("SimpleStorage", "contract SimpleStorage { uint256 public a; function set(uint256 _a) public { a = _a; } }")] [] True) + `shouldBe` Right [("SimpleStorage", ("[\n\t{\n\t\t\"constant\" : true,\n\t\t\"inputs\" : [],\n\t\t\"name\" : \"a\",\n\t\t\"outputs\" : \n\t\t[\n\t\t\t{\n\t\t\t\t\"name\" : \"\",\n\t\t\t\t\"type\" : \"uint256\"\n\t\t\t}\n\t\t],\n\t\t\"payable\" : false,\n\t\t\"stateMutability\" : \"view\",\n\t\t\"type\" : \"function\"\n\t},\n\t{\n\t\t\"constant\" : false,\n\t\t\"inputs\" : \n\t\t[\n\t\t\t{\n\t\t\t\t\"name\" : \"_a\",\n\t\t\t\t\"type\" : \"uint256\"\n\t\t\t}\n\t\t],\n\t\t\"name\" : \"set\",\n\t\t\"outputs\" : [],\n\t\t\"payable\" : false,\n\t\t\"stateMutability\" : \"nonpayable\",\n\t\t\"type\" : \"function\"\n\t}\n]\n", "608060405234801561001057600080fd5b5060e38061001f6000396000f3fe6080604052600436106043576000357c0100000000000000000000000000000000000000000000000000000000900480630dbe671f14604857806360fe47b1146070575b600080fd5b348015605357600080fd5b50605a60a7565b6040518082815260200191505060405180910390f35b348015607b57600080fd5b5060a560048036036020811015609057600080fd5b810190808035906020019092919050505060ad565b005b60005481565b806000819055505056fea165627a7a7230582077f3d0f8c042c028ca18fb49065c0091b05c6b70dd5aee2b8a4388f7ecaa308f0029"))] #else diff --git a/unit/Network/Ethereum/Web3/Test/LocalAccountSpec.hs b/unit/Network/Ethereum/Web3/Test/LocalAccountSpec.hs deleted file mode 100644 --- a/unit/Network/Ethereum/Web3/Test/LocalAccountSpec.hs +++ /dev/null @@ -1,26 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Network.Ethereum.Web3.Test.LocalAccountSpec where - -import Crypto.Ethereum (SecKey) -import Test.Hspec - -import Network.Ethereum.Account.PrivateKey (signTransaction) -import Network.Ethereum.Api.Types (Call (..), Quantity (..)) - --- using same example as in this blog post: --- https://medium.com/@codetractio/walkthrough-of-an-ethereum-improvement-proposal-eip-6fda3966d171 -spec :: Spec -spec = describe "transaction signing" $ do - let testCall = Call Nothing - (Just "0x3535353535353535353535353535353535353535") - (Just . Quantity $ 21000) - (Just . Quantity $ 20000000000) - (Just . Quantity $ 1000000000000000000) - Nothing - (Just 9) - privKey = "4646464646464646464646464646464646464646464646464646464646464646" :: SecKey - correctSignedTx = "0xf86c098504a817c800825208943535353535353535353535353535353535353535880de0b6b3a76400008025a028ef61340bd939bc2195fe537567866003e1a15d3c71ff63e1590620aa636276a067cbe9d8997f761aecb703304b3800ccf555c9f3dc64214b297fb1966a3b6d83" - - it "can create valid raw transaction" $ - signTransaction testCall 1 privKey `shouldBe` correctSignedTx diff --git a/web3.cabal b/web3.cabal --- a/web3.cabal +++ b/web3.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 name: web3 -version: 0.8.2.1 +version: 0.8.3.0 license: BSD3 license-file: LICENSE copyright: (c) Alexander Krupenkin 2016 @@ -29,21 +29,25 @@ type: git location: https://github.com/airalab/hs-web3 -flag debug +flag compiler description: - Enable debug compiler options + Enable Solidity compiler default: False manual: True -flag solidity +flag debug description: - Enable Solidity compiler + Enable debug compiler options default: False manual: True library exposed-modules: Crypto.Ethereum + Crypto.Ethereum.Keyfile + Crypto.Ethereum.Signature + Crypto.Ethereum.Utils + Crypto.Random.HmacDrbg Data.ByteArray.HexString Data.Solidity.Abi Data.Solidity.Abi.Codec @@ -62,14 +66,12 @@ Data.Solidity.Prim.Tuple.TH Data.String.Extra Language.Solidity.Abi - Language.Solidity.Compiler - Language.Solidity.Compiler.Foreign Network.Ethereum.Account Network.Ethereum.Account.Class Network.Ethereum.Account.Default Network.Ethereum.Account.Internal + Network.Ethereum.Account.LocalKey Network.Ethereum.Account.Personal - Network.Ethereum.Account.PrivateKey Network.Ethereum.Account.Safe Network.Ethereum.Api.Eth Network.Ethereum.Api.Net @@ -88,6 +90,7 @@ Network.Ethereum.Ens Network.Ethereum.Ens.PublicResolver Network.Ethereum.Ens.Registry + Network.Ethereum.Transaction Network.Ethereum.Unit Network.Ethereum.Web3 Network.JsonRpc.TinyClient @@ -116,7 +119,7 @@ data-default >=0.7.1.1 && <0.8, exceptions >=0.8.3 && <0.11, generics-sop >=0.3.1.0 && <0.5, - http-client >=0.5.7.1 && <0.6, + http-client >=0.5.7.1 && <0.7, http-client-tls >=0.3.5.1 && <0.4, machines >=0.6.3 && <0.7, memory >=0.14.11 && <0.15, @@ -127,37 +130,93 @@ mtl >=2.2.1 && <2.3, parsec >=3.1.11 && <3.2, relapse >=1.0.0.0 && <2.0, - secp256k1-haskell >=0.1.4 && <0.2, tagged >=0.8.5 && <0.9, template-haskell >=2.11.1.0 && <2.15, text >=1.2.2.2 && <1.3, transformers >=0.5.2.0 && <0.6, - vinyl >=0.5.3 && <0.11 + uuid-types >=1.0.3 && <1.1, + vinyl >=0.5.3 && <0.12 if flag(debug) ghc-options: -ddump-splices - if flag(solidity) + if flag(compiler) cpp-options: -DSOLIDITY_COMPILER c-sources: - ./cbits/solidity_lite.cpp + ./compiler/cbits/solidity_lite.cpp + hs-source-dirs: compiler + other-modules: + Language.Solidity.Compiler + Language.Solidity.Compiler.Foreign extra-libraries: solidity - include-dirs: ./cbits + include-dirs: ./compiler/cbits build-depends: - containers >=0.5.11.0 && <0.6 + containers >=0.6.0.1 && <0.7 test-suite live type: exitcode-stdio-1.0 main-is: Spec.hs - hs-source-dirs: test + hs-source-dirs: test src 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 + Crypto.Ethereum + Crypto.Ethereum.Keyfile + Crypto.Ethereum.Signature + Crypto.Ethereum.Utils + Crypto.Random.HmacDrbg + Data.ByteArray.HexString + Data.Solidity.Abi + Data.Solidity.Abi.Codec + Data.Solidity.Abi.Generic + Data.Solidity.Event + Data.Solidity.Event.Internal + Data.Solidity.Prim + Data.Solidity.Prim.Address + Data.Solidity.Prim.Bool + Data.Solidity.Prim.Bytes + Data.Solidity.Prim.Int + Data.Solidity.Prim.List + Data.Solidity.Prim.String + Data.Solidity.Prim.Tagged + Data.Solidity.Prim.Tuple + Data.Solidity.Prim.Tuple.TH + Data.String.Extra + Language.Solidity.Abi + Network.Ethereum.Account + Network.Ethereum.Account.Class + Network.Ethereum.Account.Default + Network.Ethereum.Account.Internal + Network.Ethereum.Account.LocalKey + Network.Ethereum.Account.Personal + Network.Ethereum.Account.Safe + 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 + Network.Ethereum.Contract + Network.Ethereum.Contract.Event + Network.Ethereum.Contract.Event.Common + Network.Ethereum.Contract.Event.MultiFilter + Network.Ethereum.Contract.Event.SingleFilter + Network.Ethereum.Contract.Method + Network.Ethereum.Contract.TH + Network.Ethereum.Ens + Network.Ethereum.Ens.PublicResolver + Network.Ethereum.Ens.Registry + Network.Ethereum.Transaction + Network.Ethereum.Unit + Network.Ethereum.Web3 + Network.JsonRpc.TinyClient Paths_web3 default-language: Haskell2010 ghc-options: -funbox-strict-fields -Wduplicate-exports @@ -185,7 +244,7 @@ hspec-contrib >=0.4.0 && <0.6, hspec-discover >=2.4.4 && <2.7, hspec-expectations >=0.8.2 && <0.9, - http-client >=0.5.7.1 && <0.6, + http-client >=0.5.7.1 && <0.7, http-client-tls >=0.3.5.1 && <0.4, machines >=0.6.3 && <0.7, memory >=0.14.11 && <0.15, @@ -197,7 +256,6 @@ parsec >=3.1.11 && <3.2, random ==1.1.*, relapse >=1.0.0.0 && <2.0, - secp256k1-haskell >=0.1.4 && <0.2, split >=0.2.3 && <0.3, stm >=2.4.4 && <2.6, tagged >=0.8.5 && <0.9, @@ -205,22 +263,91 @@ text >=1.2.2.2 && <1.3, time >=1.6.0 && <1.9, transformers >=0.5.2.0 && <0.6, - vinyl >=0.5.3 && <0.11, - web3 -any + uuid-types >=1.0.3 && <1.1, + vinyl >=0.5.3 && <0.12 + + if flag(debug) + ghc-options: -ddump-splices + + if flag(compiler) + cpp-options: -DSOLIDITY_COMPILER + c-sources: + ./compiler/cbits/solidity_lite.cpp + hs-source-dirs: compiler + other-modules: + Language.Solidity.Compiler + Language.Solidity.Compiler.Foreign + extra-libraries: + solidity + include-dirs: ./compiler/cbits + build-depends: + containers >=0.6.0.1 && <0.7 test-suite unit type: exitcode-stdio-1.0 main-is: Spec.hs - hs-source-dirs: unit + hs-source-dirs: unit src other-modules: - Crypto.Ethereum.Test.EcdsaSpec + Crypto.Ethereum.Test.KeyfileSpec + Crypto.Ethereum.Test.SignatureSpec + Crypto.Random.Test.HmacDrbgSpec Data.Solidity.Test.AddressSpec Data.Solidity.Test.EncodingSpec Data.Solidity.Test.IntSpec Language.Solidity.Test.CompilerSpec Network.Ethereum.Web3.Test.EventSpec - Network.Ethereum.Web3.Test.LocalAccountSpec Network.Ethereum.Web3.Test.MethodDumpSpec + Crypto.Ethereum + Crypto.Ethereum.Keyfile + Crypto.Ethereum.Signature + Crypto.Ethereum.Utils + Crypto.Random.HmacDrbg + Data.ByteArray.HexString + Data.Solidity.Abi + Data.Solidity.Abi.Codec + Data.Solidity.Abi.Generic + Data.Solidity.Event + Data.Solidity.Event.Internal + Data.Solidity.Prim + Data.Solidity.Prim.Address + Data.Solidity.Prim.Bool + Data.Solidity.Prim.Bytes + Data.Solidity.Prim.Int + Data.Solidity.Prim.List + Data.Solidity.Prim.String + Data.Solidity.Prim.Tagged + Data.Solidity.Prim.Tuple + Data.Solidity.Prim.Tuple.TH + Data.String.Extra + Language.Solidity.Abi + Network.Ethereum.Account + Network.Ethereum.Account.Class + Network.Ethereum.Account.Default + Network.Ethereum.Account.Internal + Network.Ethereum.Account.LocalKey + Network.Ethereum.Account.Personal + Network.Ethereum.Account.Safe + 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 + Network.Ethereum.Contract + Network.Ethereum.Contract.Event + Network.Ethereum.Contract.Event.Common + Network.Ethereum.Contract.Event.MultiFilter + Network.Ethereum.Contract.Event.SingleFilter + Network.Ethereum.Contract.Method + Network.Ethereum.Contract.TH + Network.Ethereum.Ens + Network.Ethereum.Ens.PublicResolver + Network.Ethereum.Ens.Registry + Network.Ethereum.Transaction + Network.Ethereum.Unit + Network.Ethereum.Web3 + Network.JsonRpc.TinyClient Paths_web3 default-language: Haskell2010 ghc-options: -funbox-strict-fields -Wduplicate-exports @@ -248,7 +375,7 @@ hspec-contrib >=0.4.0 && <0.6, hspec-discover >=2.4.4 && <2.7, hspec-expectations >=0.8.2 && <0.9, - http-client >=0.5.7.1 && <0.6, + http-client >=0.5.7.1 && <0.7, http-client-tls >=0.3.5.1 && <0.4, machines >=0.6.3 && <0.7, memory >=0.14.11 && <0.15, @@ -259,10 +386,26 @@ mtl >=2.2.1 && <2.3, parsec >=3.1.11 && <3.2, relapse >=1.0.0.0 && <2.0, - secp256k1-haskell >=0.1.4 && <0.2, tagged >=0.8.5 && <0.9, template-haskell >=2.11.1.0 && <2.15, text >=1.2.2.2 && <1.3, transformers >=0.5.2.0 && <0.6, - vinyl >=0.5.3 && <0.11, - web3 -any + uuid-types >=1.0.3 && <1.1, + vinyl >=0.5.3 && <0.12 + + if flag(debug) + ghc-options: -ddump-splices + + if flag(compiler) + cpp-options: -DSOLIDITY_COMPILER + c-sources: + ./compiler/cbits/solidity_lite.cpp + hs-source-dirs: compiler + other-modules: + Language.Solidity.Compiler + Language.Solidity.Compiler.Foreign + extra-libraries: + solidity + include-dirs: ./compiler/cbits + build-depends: + containers >=0.6.0.1 && <0.7