summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--CHANGELOG.md7
-rw-r--r--haskoin-core.cabal7
-rw-r--r--src/Network/Haskoin/Network/Common.hs80
-rw-r--r--src/Network/Haskoin/Network/Message.hs6
-rw-r--r--src/Network/Haskoin/Test/Network.hs5
-rw-r--r--test/Network/Haskoin/NetworkSpec.hs2
6 files changed, 58 insertions, 49 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 7a7ccb0..4352b6c 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -4,6 +4,13 @@ All notable changes to this project will be documented in this file.
The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/)
and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.html).
+## 0.9.2
+### Removed
+- Disable unnecessary `-O2` optimisation added in previous version.
+
+### Added
+- Allow decoding unknown P2P messages.
+
## 0.9.1
### Added
- Add a function to produce a structured signature over a transaction.
diff --git a/haskoin-core.cabal b/haskoin-core.cabal
index 461c368..37b34da 100644
--- a/haskoin-core.cabal
+++ b/haskoin-core.cabal
@@ -1,13 +1,13 @@
cabal-version: 1.12
--- This file has been generated from package.yaml by hpack version 0.31.1.
+-- This file has been generated from package.yaml by hpack version 0.31.2.
--
-- see: https://github.com/sol/hpack
--
--- hash: 571964654e85fdc471bd843a2c43a1debee35c14aca24a8cdba815efd5c09736
+-- hash: f8c182a15da9f3c4eb348dd84d0794720d0b89acf7981b7a317785f2e4196c96
name: haskoin-core
-version: 0.9.1
+version: 0.9.2
synopsis: Bitcoin & Bitcoin Cash library for Haskell
description: Haskoin Core is a complete Bitcoin and Bitcoin Cash library of functions and data types for Haskell developers.
category: Bitcoin, Finance, Network
@@ -80,7 +80,6 @@ library
Paths_haskoin_core
hs-source-dirs:
src
- ghc-options: -O2
build-depends:
QuickCheck
, aeson
diff --git a/src/Network/Haskoin/Network/Common.hs b/src/Network/Haskoin/Network/Common.hs
index 6a59e5a..be8aab6 100644
--- a/src/Network/Haskoin/Network/Common.hs
+++ b/src/Network/Haskoin/Network/Common.hs
@@ -332,15 +332,15 @@ reject cmd code reason =
Reject cmd code (VarString reason) B.empty
instance Serialize Reject where
-
- get = S.get >>= \(VarString bs) -> case stringToCommand bs of
- Just cmd -> Reject cmd <$> S.get <*> S.get <*> maybeData
- _ -> fail $ unwords
- ["Reason get: Invalid message command" ,cs bs]
+ get =
+ S.get >>= \(VarString bs) ->
+ Reject (stringToCommand bs) <$> S.get <*> S.get <*> maybeData
where
- maybeData = isEmpty >>= \done ->
- if done then return B.empty else getByteString 32
-
+ maybeData =
+ isEmpty >>= \done ->
+ if done
+ then return B.empty
+ else getByteString 32
put (Reject cmd code reason dat) = do
put $ VarString $ commandToString cmd
put code
@@ -481,6 +481,7 @@ data MessageCommand
| MCMempool
| MCReject
| MCSendHeaders
+ | MCOther ByteString
deriving (Eq)
instance Show MessageCommand where
@@ -489,51 +490,45 @@ instance Show MessageCommand where
instance Read MessageCommand where
readPrec = do
String str <- lexP
- maybe pfail return (stringToCommand (cs str))
+ return (stringToCommand (cs str))
instance Serialize MessageCommand where
- get = go =<< getByteString 12
+ get = go <$> getByteString 12
where
go bs =
let str = unpackCommand bs
- in case stringToCommand str of
- Just cmd -> return cmd
- Nothing -> fail $ cs $
- "get MessageCommand: Invalid command: " <> str
+ in stringToCommand str
put mc = putByteString $ packCommand $ commandToString mc
instance IsString MessageCommand where
- fromString str =
- fromMaybe
- (error ("Could not recognize message command " <> str))
- (stringToCommand (cs str))
+ fromString str = stringToCommand (cs str)
-- | Read a 'MessageCommand' from its string representation.
-stringToCommand :: ByteString -> Maybe MessageCommand
+stringToCommand :: ByteString -> MessageCommand
stringToCommand str = case str of
- "version" -> Just MCVersion
- "verack" -> Just MCVerAck
- "addr" -> Just MCAddr
- "inv" -> Just MCInv
- "getdata" -> Just MCGetData
- "notfound" -> Just MCNotFound
- "getblocks" -> Just MCGetBlocks
- "getheaders" -> Just MCGetHeaders
- "tx" -> Just MCTx
- "block" -> Just MCBlock
- "merkleblock" -> Just MCMerkleBlock
- "headers" -> Just MCHeaders
- "getaddr" -> Just MCGetAddr
- "filterload" -> Just MCFilterLoad
- "filteradd" -> Just MCFilterAdd
- "filterclear" -> Just MCFilterClear
- "ping" -> Just MCPing
- "pong" -> Just MCPong
- "alert" -> Just MCAlert
- "mempool" -> Just MCMempool
- "reject" -> Just MCReject
- "sendheaders" -> Just MCSendHeaders
- _ -> Nothing
+ "version" -> MCVersion
+ "verack" -> MCVerAck
+ "addr" -> MCAddr
+ "inv" -> MCInv
+ "getdata" -> MCGetData
+ "notfound" -> MCNotFound
+ "getblocks" -> MCGetBlocks
+ "getheaders" -> MCGetHeaders
+ "tx" -> MCTx
+ "block" -> MCBlock
+ "merkleblock" -> MCMerkleBlock
+ "headers" -> MCHeaders
+ "getaddr" -> MCGetAddr
+ "filterload" -> MCFilterLoad
+ "filteradd" -> MCFilterAdd
+ "filterclear" -> MCFilterClear
+ "ping" -> MCPing
+ "pong" -> MCPong
+ "alert" -> MCAlert
+ "mempool" -> MCMempool
+ "reject" -> MCReject
+ "sendheaders" -> MCSendHeaders
+ _ -> MCOther str
-- | Convert a 'MessageCommand' to its string representation.
commandToString :: MessageCommand -> ByteString
@@ -560,6 +555,7 @@ commandToString mc = case mc of
MCMempool -> "mempool"
MCReject -> "reject"
MCSendHeaders -> "sendheaders"
+ MCOther c -> c
-- | Pack a string 'MessageCommand' so that it is exactly 12-bytes long.
packCommand :: ByteString -> ByteString
diff --git a/src/Network/Haskoin/Network/Message.hs b/src/Network/Haskoin/Network/Message.hs
index 00e0a60..71c8f4f 100644
--- a/src/Network/Haskoin/Network/Message.hs
+++ b/src/Network/Haskoin/Network/Message.hs
@@ -18,6 +18,7 @@ module Network.Haskoin.Network.Message
) where
import Control.Monad (unless)
+import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Serialize (Serialize, encode, get,
put)
@@ -90,6 +91,7 @@ data Message
| MMempool
| MReject !Reject
| MSendHeaders
+ | MOther !ByteString !ByteString
deriving (Eq, Show)
-- | Get 'MessageCommand' assocated with a message.
@@ -117,6 +119,7 @@ msgType MMempool = MCMempool
msgType (MReject _) = MCReject
msgType MSendHeaders = MCSendHeaders
msgType MGetAddr = MCGetAddr
+msgType (MOther c _) = MCOther c
-- | Deserializer for network messages.
getMessage :: Network -> Get Message
@@ -149,7 +152,7 @@ getMessage net = do
MCPong -> MPong <$> get
MCAlert -> MAlert <$> get
MCReject -> MReject <$> get
- _ -> fail $ "get: Invalid command " ++ show cmd
+ MCOther c -> MOther c <$> getByteString (fromIntegral len)
else case cmd of
MCGetAddr -> return MGetAddr
MCVerAck -> return MVerAck
@@ -185,6 +188,7 @@ putMessage net msg = do
MMempool -> (MCMempool, BS.empty)
MReject m -> (MCReject, encode m)
MSendHeaders -> (MCSendHeaders, BS.empty)
+ MOther c p -> (MCOther c, p)
chk = checkSum32 payload
len = fromIntegral $ BS.length payload
header = MessageHeader (getNetworkMagic net) cmd len chk
diff --git a/src/Network/Haskoin/Test/Network.hs b/src/Network/Haskoin/Test/Network.hs
index 4349108..6a2cb2d 100644
--- a/src/Network/Haskoin/Test/Network.hs
+++ b/src/Network/Haskoin/Test/Network.hs
@@ -9,6 +9,7 @@ Portability : POSIX
module Network.Haskoin.Test.Network where
import qualified Data.ByteString as BS (empty, pack)
+import qualified Data.ByteString.Char8 as C8
import Data.Word (Word16, Word32)
import Network.Haskoin.Network
import Network.Haskoin.Test.Crypto
@@ -149,7 +150,8 @@ arbitraryFilterAdd = FilterAdd <$> arbitraryBS
-- | Arbitrary 'MessageCommand'.
arbitraryMessageCommand :: Gen MessageCommand
-arbitraryMessageCommand =
+arbitraryMessageCommand = do
+ ASCIIString str <- arbitrary
elements
[ MCVersion
, MCVerAck
@@ -170,4 +172,5 @@ arbitraryMessageCommand =
, MCPing
, MCPong
, MCAlert
+ , MCOther (C8.take 12 (C8.pack (filter (/= '\NUL') str)))
]
diff --git a/test/Network/Haskoin/NetworkSpec.hs b/test/Network/Haskoin/NetworkSpec.hs
index 923f999..2d5ee60 100644
--- a/test/Network/Haskoin/NetworkSpec.hs
+++ b/test/Network/Haskoin/NetworkSpec.hs
@@ -39,7 +39,7 @@ spec = do
it "encodes and decodes addr" $ property $ forAll arbitraryAddr1 cerealID
it "encodes and decodes alert" $ property $ forAll arbitraryAlert cerealID
it "encodes and decodes reject" $
- property $forAll arbitraryReject cerealID
+ property $ forAll arbitraryReject cerealID
it "encodes and decodes getdata" $
property $ forAll arbitraryGetData cerealID
it "encodes and decodes notfound" $