Skip to content

Commit

Permalink
Aeson 2.2 (#17)
Browse files Browse the repository at this point in the history
* resolve some compiler warnings

* require aeson-2.2

* drop support for GHC <9

* Update ethereum.cabal
  • Loading branch information
larskuhtz authored Oct 11, 2023
1 parent 86e65e7 commit 7119860
Show file tree
Hide file tree
Showing 9 changed files with 37 additions and 35 deletions.
14 changes: 7 additions & 7 deletions ethereum.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -125,11 +125,11 @@ library

, Numeric.Checked
build-depends:
, base >=4.11 && <5
, aeson >=1.4.5 && <2.2
, base >=4.15 && <5
, aeson >=2.2
, base16-bytestring >=0.1
, binary >=0.8
, bytestring >=0.10
, bytestring >=0.10.12
, exceptions >=0.10
, hashable >=1.2
, hashes >=0.2.3
Expand Down Expand Up @@ -167,10 +167,10 @@ test-suite ethereum-tests
build-depends:
, ethereum
, QuickCheck >=2.14
, aeson >=1.4.5 && <2.2
, base >=4.11 && <5
, aeson >=2.2
, base >=4.15 && <5
, base16-bytestring >=0.1
, bytestring >=0.10
, bytestring >=0.10.12
, quickcheck-instances >=0.3
, raw-strings-qq >=1.1
, tasty >=1.3
Expand Down Expand Up @@ -200,6 +200,6 @@ benchmark ethhash
main-is: Main.hs
build-depends:
, ethereum
, base >=4.11 && <5
, base >=4.15 && <5
, clock >=0.8

2 changes: 1 addition & 1 deletion src/Ethereum/Block.hs
Original file line number Diff line number Diff line change
Expand Up @@ -102,7 +102,7 @@ instance ToJSON RpcBlock where
{-# INLINE toEncoding #-}
{-# INLINE toJSON #-}

blockProperties :: KeyValue kv => RpcBlock -> [kv]
blockProperties :: KeyValue e kv => RpcBlock -> [kv]
blockProperties b =
[ "difficulty" .= _hdrDifficulty (_rpcBlockHeader b)
, "extraData" .= _hdrExtraData (_rpcBlockHeader b)
Expand Down
2 changes: 1 addition & 1 deletion src/Ethereum/Header.hs
Original file line number Diff line number Diff line change
Expand Up @@ -97,7 +97,7 @@ blockHash = BlockHash . keccak256 . putRlpByteString
--
-- The JSON serialization also includes the block hash.
--
consensusHeaderProperties :: KeyValue kv => ConsensusHeader -> [kv]
consensusHeaderProperties :: KeyValue e kv => ConsensusHeader -> [kv]
consensusHeaderProperties o =
[ "parentHash" .= _hdrParentHash o
, "sha3Uncles" .= _hdrOmmersHash o
Expand Down
8 changes: 0 additions & 8 deletions src/Ethereum/Misc.hs
Original file line number Diff line number Diff line change
Expand Up @@ -132,19 +132,11 @@ import Numeric.Checked
-- Backward compatibility with bytestring <0.10.10

useAsCStringLenBS :: BS.ShortByteString -> (CStringLen -> IO a) -> IO a
#if ! MIN_VERSION_bytestring(0,10,10)
useAsCStringLenBS = B.useAsCStringLen . BS.fromShort
#else
useAsCStringLenBS = BS.useAsCStringLen
#endif
{-# INLINE useAsCStringLenBS #-}

packCStringLenBS :: CStringLen -> IO BS.ShortByteString
#if ! MIN_VERSION_bytestring(0,10,10)
packCStringLenBS = fmap BS.toShort . B.packCStringLen
#else
packCStringLenBS = BS.packCStringLen
#endif
{-# INLINE packCStringLenBS #-}

-- -------------------------------------------------------------------------- --
Expand Down
3 changes: 0 additions & 3 deletions src/Ethereum/RLP.hs
Original file line number Diff line number Diff line change
Expand Up @@ -53,9 +53,6 @@ module Ethereum.RLP

import Control.Applicative
import Control.Monad
#if ! MIN_VERSION_base(4,13,0)
import Control.Monad.Fail (MonadFail)
#endif

import qualified Data.Binary.Get as BI
import Data.Binary.Get hiding (Get, label)
Expand Down
9 changes: 5 additions & 4 deletions src/Ethereum/Receipt.hs
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}

-- |
-- Module: Ethereum.Receipt
Expand Down Expand Up @@ -91,7 +92,7 @@ instance FromJSON LogEntry where
<*> o .: "data"
{-# INLINE parseJSON #-}

logEntryProperties :: KeyValue kv => LogEntry -> [kv]
logEntryProperties :: KeyValue e kv => LogEntry -> [kv]
logEntryProperties r =
[ "address" .= _logEntryAddress r
, "data" .= _logEntryData r
Expand Down Expand Up @@ -180,7 +181,7 @@ instance FromJSON RpcLogEntry where
-- "transactionIndex": "0x11"
-- }
--
rpcLogEntryProperties :: KeyValue kv => RpcLogEntry -> [kv]
rpcLogEntryProperties :: KeyValue e kv => RpcLogEntry -> [kv]
rpcLogEntryProperties r =
[ "address" .= _rpcLogEntryAddress r
, "blockHash" .= _rpcLogEntryBlockHash r
Expand Down Expand Up @@ -280,7 +281,7 @@ instance FromJSON Receipt where
<*> o .: "logs"
{-# INLINE parseJSON #-}

receiptProperties :: KeyValue kv => Receipt -> [kv]
receiptProperties :: KeyValue e kv => Receipt -> [kv]
receiptProperties o =
[ "status" .= _receiptStatus o
, "cumulativeGasUsed" .= _receiptGasUsed o
Expand Down Expand Up @@ -388,7 +389,7 @@ instance FromJSON RpcReceipt where
-- "transactionIndex": "0x11"
-- }
--
rpcReceiptProperties :: KeyValue kv => RpcReceipt -> [kv]
rpcReceiptProperties :: KeyValue e kv => RpcReceipt -> [kv]
rpcReceiptProperties r =
[ "blockHash" .= _rpcReceiptBlockHash r
, "blockNumber" .= _rpcReceiptBlockNumber r
Expand Down
2 changes: 1 addition & 1 deletion src/Ethereum/Receipt/ReceiptProof.hs
Original file line number Diff line number Diff line change
Expand Up @@ -234,7 +234,7 @@ instance FromJSON ReceiptProofValidation where
<*> o .: "receipt"
{-# INLINE parseJSON #-}

receiptProofValidationProperties :: KeyValue kv => ReceiptProofValidation -> [kv]
receiptProofValidationProperties :: KeyValue e kv => ReceiptProofValidation -> [kv]
receiptProofValidationProperties o =
[ "root" .= _receiptProofValidationRoot o
, "depth" .= _receiptProofValidationDepth o
Expand Down
2 changes: 1 addition & 1 deletion src/Ethereum/Transaction.hs
Original file line number Diff line number Diff line change
Expand Up @@ -218,7 +218,7 @@ instance ToJSON Transaction where
{-# INLINE toEncoding #-}
{-# INLINE toJSON #-}

transactionProperties :: KeyValue kv => Transaction -> [kv]
transactionProperties :: KeyValue e kv => Transaction -> [kv]
transactionProperties r@MessageCall{} =
[ "nonce" .= _transactionNonce r
, "gasPrice" .= _transactionGasPrice r
Expand Down
30 changes: 21 additions & 9 deletions test/Test/Ethereum/Receipt.hs
Original file line number Diff line number Diff line change
Expand Up @@ -55,6 +55,11 @@ import Test.Utils
-- getBlockReceipts :: BlockHash -> IO [(TransactionIndex, Receipt)]
-- getBlockReceipts _ = return []

unsafeDecodeStrict' :: HasCallStack => FromJSON a => B8.ByteString -> a
unsafeDecodeStrict' x = case eitherDecodeStrict' x of
Right result -> result
Left e -> error $ "Test.Ethereum.Receipt.unsafeDecodeStrict: unexpected decoding failure: " <> show e

-- -------------------------------------------------------------------------- --
-- Tests

Expand Down Expand Up @@ -87,7 +92,7 @@ proofTest i = do
assertEqual "proof root matches root in header" expectedRoot (_proofRoot proof)
assertEqual "proof value matches receipt at given index" rlpValue (_proofValue proof)
where
Right rs = eitherDecodeStrict' @[RpcReceipt] $ B8.pack getReceipts
rs = unsafeDecodeStrict' @[RpcReceipt] $ B8.pack getReceipts
expectedRoot = dj "0x5eced534b3d84d3d732ddbc714f5fd51d98a941b28182b6efe6df3a0fe90004b"
value = L.find (\x -> _rpcReceiptTransactionIndex x == TransactionIndex i) rs
rlpValue = putRlpByteString . fromRpcReceipt <$> value
Expand Down Expand Up @@ -124,10 +129,12 @@ receiptProofTest i = do
0 (_receiptProofValidationWeight result)
return ()
where
Right rs = eitherDecodeStrict' @[RpcReceipt] $ B8.pack getReceipts
rs = unsafeDecodeStrict' @[RpcReceipt] $ B8.pack getReceipts
expectedRoot = dj "0xb3b20624f8f0f86eb50dd04688409e5cea4bd02d700bf6e79e9384d47d6a5a35"
Just value = L.find (\x -> _rpcReceiptTransactionIndex x == TransactionIndex i) rs
Right block = eitherDecodeStrict' @RpcBlock $ B8.pack getBlock
value = case L.find (\x -> _rpcReceiptTransactionIndex x == TransactionIndex i) rs of
Just v -> v
Nothing -> error "Test.Ethereum.Receipt.receiptProofTest: _rpcReceiptTransactionIndex failed unexpectedly"
block = unsafeDecodeStrict' @RpcBlock $ B8.pack getBlock
hdr = _rpcBlockHeader block

-- -------------------------------------------------------------------------- --
Expand All @@ -144,20 +151,25 @@ roundtripTests = testGroup "Encoding tests"
where

-- receipt
Right rpcReceipt = eitherDecodeStrict' $ B8.pack getReceipt_0
rpcReceipt = unsafeDecodeStrict' $ B8.pack getReceipt_0
receipt = fromRpcReceipt rpcReceipt
receiptBytes = B16.encode (putRlpByteString receipt)
receiptJsonString = BL8.unpack $ encode receipt

-- receipt proof
Right rs = eitherDecodeStrict' @[RpcReceipt] $ B8.pack getReceipts
Right block = eitherDecodeStrict' @RpcBlock $ B8.pack getBlock
rs = unsafeDecodeStrict' @[RpcReceipt] $ B8.pack getReceipts
block = unsafeDecodeStrict' @RpcBlock $ B8.pack getBlock
hdr = _rpcBlockHeader block
Right proof = rpcReceiptProof hdr [] rs (TransactionIndex 28)
proof = case rpcReceiptProof hdr [] rs (TransactionIndex 28) of
Right p -> p
Left e -> error $ "Test.Ethereum.Receipt.roundtrip: unexpected failure: " <> show e
proofBytes = B16.encode (putRlpByteString proof)

-- receipt proof validation
Right val = validateReceiptProof proof
val = case validateReceiptProof proof of
Right v -> v
Left e -> error $ "Test.Ethereum.Receipt.roundtrip: unexpected failure: " <> show e

valString = BL8.unpack $ encode val

-- -------------------------------------------------------------------------- --
Expand Down

0 comments on commit 7119860

Please sign in to comment.