diff --git a/Network/Haskoin/Node/HeaderTree.hs b/Network/Haskoin/Node/HeaderTree.hs --- a/Network/Haskoin/Node/HeaderTree.hs +++ b/Network/Haskoin/Node/HeaderTree.hs @@ -52,6 +52,7 @@ import Data.List (find, maximumBy, sort) import Data.Maybe (fromMaybe, isNothing, listToMaybe, mapMaybe) +import Data.Serialize (decode, encode) import Data.String.Conversions (cs) import Data.Word (Word32) import Database.Esqueleto (Esqueleto, Value, asc, @@ -87,7 +88,7 @@ type MinWork = Word32 shortHash :: BlockHash -> ShortHash -shortHash = decode' . BS.take 8 . getHash256 . getBlockHash +shortHash = fromRight . decode . BS.take 8 . getHash256 . getBlockHash nodeHeader :: NodeBlock -> BlockHeader nodeHeader = getNodeHeader . nodeBlockHeader @@ -418,7 +419,7 @@ -- | Returns the proof of work of a block header as an Integer number. headerPOW :: BlockHeader -> Integer -headerPOW = bsToInteger . BS.reverse . encode' . headerHash +headerPOW = bsToInteger . BS.reverse . encode . headerHash -- | Returns the work represented by this block. Work is defined as the number -- of tries needed to solve a block in the average case with respect to the diff --git a/Network/Haskoin/Node/HeaderTree/Types.hs b/Network/Haskoin/Node/HeaderTree/Types.hs --- a/Network/Haskoin/Node/HeaderTree/Types.hs +++ b/Network/Haskoin/Node/HeaderTree/Types.hs @@ -1,11 +1,12 @@ module Network.Haskoin.Node.HeaderTree.Types where +import Data.Serialize (decode, encode) +import Data.String (fromString) import Data.Word (Word32, Word64) import Database.Persist (PersistField (..), PersistValue (..), SqlType (..)) import Database.Persist.Sql (PersistFieldSql (..)) import Network.Haskoin.Block -import Network.Haskoin.Util type BlockHeight = Word32 type ShortHash = Word64 @@ -18,9 +19,11 @@ {- SQL database backend for HeaderTree -} instance PersistField NodeHeader where - toPersistValue = PersistByteString . encode' . getNodeHeader - fromPersistValue (PersistByteString bs) = maybeToEither - "Could not decode block header" $ NodeHeader <$> decodeToMaybe bs + toPersistValue = PersistByteString . encode . getNodeHeader + fromPersistValue (PersistByteString bs) = + case decode bs of + Right x -> Right (NodeHeader x) + Left e -> Left (fromString e) fromPersistValue _ = Left "Invalid persistent block header" instance PersistFieldSql NodeHeader where diff --git a/Network/Haskoin/Node/Peer.hs b/Network/Haskoin/Node/Peer.hs --- a/Network/Haskoin/Node/Peer.hs +++ b/Network/Haskoin/Node/Peer.hs @@ -38,6 +38,7 @@ keys, lookup, unionWith) import Data.Maybe (fromMaybe, isJust, listToMaybe) +import Data.Serialize (decode, encode) import Data.String.Conversions (cs) import Data.Text (Text, pack) import Data.Time.Clock (diffUTCTime, getCurrentTime) @@ -252,7 +253,7 @@ -- exit (not recurse). Otherwise, we go into an infinite loop here. unless (BS.null headerBytes) $ do -- Introspection required to know the length of the payload - case decodeToEither headerBytes of + case decode headerBytes of Left err -> lift . lift $ misbehaving pid ph moderateDoS $ unwords [ "Could not decode message header:", err , "Bytes:", cs (encodeHex headerBytes) @@ -261,7 +262,7 @@ $(logDebug) $ formatPid pid ph $ unwords [ "Received message header of type", show cmd ] payloadBytes <- BL.toStrict <$> CB.take (fromIntegral len) - case decodeToEither $ headerBytes `BS.append` payloadBytes of + case decode $ headerBytes `BS.append` payloadBytes of Left err -> lift . lift $ misbehaving pid ph moderateDoS $ unwords [ "Could not decode message payload:", err ] Right msg -> lift $ processMessage pid ph msg @@ -419,7 +420,7 @@ -- | Encode message that are being sent to the remote host. encodeMessage :: MonadLoggerIO m => Conduit Message (NodeT m) BS.ByteString -encodeMessage = awaitForever $ yield . encode' +encodeMessage = awaitForever $ yield . encode peerPing :: (MonadLoggerIO m, MonadBaseControl IO m) => PeerId diff --git a/haskoin-node.cabal b/haskoin-node.cabal --- a/haskoin-node.cabal +++ b/haskoin-node.cabal @@ -1,5 +1,5 @@ name: haskoin-node -version: 0.3.1 +version: 0.4.0 synopsis: Implementation of a Bitoin node. description: @@ -51,9 +51,9 @@ build-depends: aeson >= 0.7 && < 0.12 , async >= 2.0 && < 2.2 , base >= 4.8 && < 5 - , binary >= 0.7 && < 0.9 , bytestring >= 0.10 && < 0.11 , concurrent-extra >= 0.7 && < 0.8 + , cereal >= 0.5 && < 0.6 , conduit >= 1.2 && < 1.3 , conduit-extra >= 1.1 && < 1.2 , containers >= 0.5 && < 0.6 @@ -64,7 +64,7 @@ , exceptions >= 0.8 && < 0.9 , haskoin-core >= 0.3 && < 0.5 , largeword >= 1.2.4 && < 1.3 - , lifted-async >= 0.2 && < 0.9 + , lifted-async >= 0.2 && < 0.10 , lifted-base >= 0.2 && < 0.3 , monad-control >= 1.0 && < 1.1 , monad-logger >= 0.3 && < 0.4 @@ -76,7 +76,7 @@ , random >= 1.0 && < 1.2 , stm >= 2.4 && < 2.5 , stm-chans >= 3.0 && < 3.1 - , stm-conduit >= 2.5 && < 2.8 + , stm-conduit >= 2.5 && < 2.9 , string-conversions >= 0.4 && < 0.5 , text >= 0.11 && < 1.3 , time >= 1.4 && < 1.7 diff --git a/tests/Network/Haskoin/Node/Units.hs b/tests/Network/Haskoin/Node/Units.hs --- a/tests/Network/Haskoin/Node/Units.hs +++ b/tests/Network/Haskoin/Node/Units.hs @@ -243,12 +243,10 @@ mockBlock :: NodeBlock -> Word32 -> Word32 -> NodeBlock mockBlock parent chain n = nodeBlock parent chain bh where - bh = BlockHeader - { blockVersion = blockVersion $ nodeHeader parent - , prevBlock = nodeHash parent - , merkleRoot = z - , blockTimestamp = nodeTimestamp parent + 600 - , blockBits = blockBits $ nodeHeader parent - , bhNonce = n - } - z = "0000000000000000000000000000000000000000000000000000000000000000" + bh = createBlockHeader + (blockVersion $ nodeHeader parent) + (nodeHash parent) + "0000000000000000000000000000000000000000000000000000000000000000" + (nodeTimestamp parent + 600) + (blockBits $ nodeHeader parent) + n