NetworkSpec.hs

{-# LANGUAGE OverloadedStrings #-}
module Network.Haskoin.NetworkSpec (spec) where

import           Data.Maybe                (fromJust)
import           Data.Serialize            as S
import           Data.Text                 (Text)
import           Data.Word                 (Word32)
import           Network.Haskoin.Address
import           Network.Haskoin.Constants
import           Network.Haskoin.Keys
import           Network.Haskoin.Network
import           Network.Haskoin.Test
import           Network.Haskoin.Util
import           Test.Hspec
import           Test.HUnit                (Assertion, assertBool)
import           Test.QuickCheck

spec :: Spec
spec = do
    let net = btc
    describe "bloom filters" $ do
        it "bloom filter vector 1" bloomFilter1
        it "bloom filter vector 2" bloomFilter2
        it "bloom filter vector 3" bloomFilter3
    describe "serialization of protocol types" $ do
        it "encodes and decodes varint" $
            property $ forAll arbitraryVarInt cerealID
        it "encodes and decodes varstring" $
            property $ forAll arbitraryVarString cerealID
        it "encodes and decodes network address" $
            property $ forAll arbitraryNetworkAddress cerealID
        it "encodes and decodes invtype" $
            property $ forAll arbitraryInvType cerealID
        it "encodes and decodes invvector" $
            property $ forAll arbitraryInvVector cerealID
        it "encodes and decodes inv" $ property $ forAll arbitraryInv1 cerealID
        it "encodes and decodes version" $
            property $ forAll arbitraryVersion cerealID
        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
        it "encodes and decodes getdata" $
            property $ forAll arbitraryGetData cerealID
        it "encodes and decodes notfound" $
            property $ forAll arbitraryNotFound cerealID
        it "encodes and decodes ping" $ property $ forAll arbitraryPing cerealID
        it "encodes and decodes pong" $ property $ forAll arbitraryPong cerealID
        it "encodes and decodes message command" $
            property $ forAll arbitraryMessageCommand cerealID
        it "encodes and decodes message header" $
            property $ forAll arbitraryMessageHeader cerealID
        it "encodes and decodes message" $
            property $
            forAll (arbitraryMessage net) $
            testPutGet (getMessage net) (putMessage net)
    describe "serialization of bloom types" $ do
        it "encodes and decodes bloom flags" $
            property $ forAll arbitraryBloomFlags cerealID
        it "encodes and decodes bloom filter" $
            property $ forAll arbitraryBloomFilter $ cerealID . lst3
        it "encodes and decodes filterload" $
            property $ forAll arbitraryFilterLoad cerealID
        it "encodes and decodes filteradd" $
            property $ forAll arbitraryFilterAdd cerealID

bloomFilter :: Word32 -> Text -> Assertion
bloomFilter n x = do
    assertBool "Bloom filter doesn't contain vector 1" $ bloomContains f1 v1
    assertBool "Bloom filter contains something it should not" $
        not $ bloomContains f1 v2
    assertBool "Bloom filter doesn't contain vector 3" $ bloomContains f3 v3
    assertBool "Bloom filter doesn't contain vector 4" $ bloomContains f4 v4
    assertBool "Bloom filter serialization is incorrect" $
        S.encode f4 == bs
  where
    f0 = bloomCreate 3 0.01 n BloomUpdateAll
    f1 = bloomInsert f0 v1
    f3 = bloomInsert f1 v3
    f4 = bloomInsert f3 v4
    v1 = fromJust $ decodeHex "99108ad8ed9bb6274d3980bab5a85c048f0950c8"
    v2 = fromJust $ decodeHex "19108ad8ed9bb6274d3980bab5a85c048f0950c8"
    v3 = fromJust $ decodeHex "b5a2c786d9ef4658287ced5914b37a1b4aa32eee"
    v4 = fromJust $ decodeHex "b9300670b4c5366e95b2699e8b18bc75e5f729c5"
    bs = fromJust $ decodeHex x

bloomFilter1 :: Assertion
bloomFilter1 = bloomFilter 0 "03614e9b050000000000000001"

bloomFilter2 :: Assertion
bloomFilter2 = bloomFilter 2147483649 "03ce4299050000000100008001"

bloomFilter3 :: Assertion
bloomFilter3 =
    assertBool "Bloom filter serialization is incorrect" $
        S.encode f2 == bs
  where
    f0 = bloomCreate 2 0.001 0 BloomUpdateAll
    f1 = bloomInsert f0 $ S.encode p
    f2 = bloomInsert f1 $ S.encode $ getAddrHash160 $ pubKeyAddr p
    k = fromJust $ fromWif btc "5Kg1gnAjaLfKiwhhPpGS3QfRg2m6awQvaj98JCZBZQ5SuS2F15C"
    p = derivePubKeyI k
    bs = fromJust $ decodeHex "038fc16b080000000000000001"

cerealID :: (Serialize a, Eq a) => a -> Bool
cerealID x = S.decode (S.encode x) == Right x

testPutGet :: Eq a => Get a -> Putter a -> a -> Bool
testPutGet g p a = runGet g (runPut (p a)) == Right a