Pass network explicitly and migrate tests to hspec

* No more setNetwork
* Test suite now migrated completely to hspec

CHANGELOG.md

@@ -18,6 +18,8 @@ and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.
 - Support for LTS Haskell 12.5.
 - New tests for various networks and new features.
 - Added `CHANGELOG.md` file.
+- Support for SegWit addresses.
+- Support for CashAddr addresses.
 
 ### Changed
 - Use of hpack `package.yaml` file to auto-generate Cabal file.

haskoin-core.cabal

@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 5ddb6bb753c470590debd2bd92138a01e493116359bbed51050cb4fc9de70921
+-- hash: c15f226b69c129df8ee665fec2652722d4a7d6b2e9d249a8c6b49e0b82c5ee0e
 
 name:           haskoin-core
 version:        1.0.0
@@ -20,16 +20,16 @@ build-type:     Simple
 cabal-version:  >= 2.0
 extra-source-files:
     CHANGELOG.md
+    data/forkid_script_tests.json
+    data/forkid_sighash.json
+    data/script_invalid.json
+    data/script_tests.json
+    data/script_valid.json
+    data/sig_nonstrict.json
+    data/sig_strict.json
+    data/sighash.json
+    data/tx_valid.json
     README.md
-    test/data/forkid_script_tests.json
-    test/data/forkid_sighash.json
-    test/data/script_invalid.json
-    test/data/script_tests.json
-    test/data/script_valid.json
-    test/data/sig_nonstrict.json
-    test/data/sig_strict.json
-    test/data/sighash.json
-    test/data/tx_valid.json
 
 source-repository head
   type: git
@@ -63,9 +63,6 @@ library
     , secp256k1
     , split
     , string-conversions
-    , test-framework
-    , test-framework-hunit
-    , test-framework-quickcheck2
     , time
     , unordered-containers
     , vector
@@ -114,132 +111,11 @@ library
       Paths_haskoin_core
   default-language: Haskell2010
 
-test-suite haskoin-core-bch-test
+test-suite haskoin-core-test
   type: exitcode-stdio-1.0
-  main-is: Main.hs
-  hs-source-dirs:
-      test/bch
-      test/common
-  ghc-options: -threaded -rtsopts -with-rtsopts=-N
-  build-depends:
-      HUnit
-    , QuickCheck
-    , aeson
-    , array
-    , base >=4.7 && <5
-    , base16-bytestring
-    , bytestring
-    , cereal
-    , conduit
-    , containers
-    , cryptonite
-    , deepseq
-    , entropy
-    , hashable
-    , haskoin-core
-    , hspec
-    , memory
-    , mtl
-    , murmur3
-    , network
-    , safe
-    , scientific
-    , secp256k1
-    , split
-    , string-conversions
-    , test-framework
-    , test-framework-hunit
-    , test-framework-quickcheck2
-    , time
-    , unordered-containers
-    , vector
-  other-modules:
-      Network.Haskoin.Script.Spec
-      Paths_haskoin_core
-  default-language: Haskell2010
-
-test-suite haskoin-core-btc-regtest
-  type: exitcode-stdio-1.0
-  main-is: Main.hs
-  hs-source-dirs:
-      test/btc-regtest
-  ghc-options: -threaded -rtsopts -with-rtsopts=-N
-  build-depends:
-      HUnit
-    , QuickCheck
-    , aeson
-    , array
-    , base >=4.7 && <5
-    , base16-bytestring
-    , bytestring
-    , cereal
-    , conduit
-    , containers
-    , cryptonite
-    , deepseq
-    , entropy
-    , hashable
-    , haskoin-core
-    , hspec
-    , memory
-    , mtl
-    , murmur3
-    , network
-    , safe
-    , scientific
-    , secp256k1
-    , split
-    , string-conversions
-    , test-framework
-    , test-framework-hunit
-    , test-framework-quickcheck2
-    , time
-    , unordered-containers
-    , vector
-  other-modules:
-      Paths_haskoin_core
-  default-language: Haskell2010
-
-test-suite haskoin-core-btc-test
-  type: exitcode-stdio-1.0
-  main-is: Main.hs
-  hs-source-dirs:
-      test/btc
-      test/common
-  ghc-options: -threaded -rtsopts -with-rtsopts=-N
-  build-depends:
-      HUnit
-    , QuickCheck
-    , aeson
-    , array
-    , base >=4.7 && <5
-    , base16-bytestring
-    , bytestring
-    , cereal
-    , conduit
-    , containers
-    , cryptonite
-    , deepseq
-    , entropy
-    , hashable
-    , haskoin-core
-    , hspec
-    , memory
-    , mtl
-    , murmur3
-    , network
-    , safe
-    , scientific
-    , secp256k1
-    , split
-    , string-conversions
-    , test-framework
-    , test-framework-hunit
-    , test-framework-quickcheck2
-    , time
-    , unordered-containers
-    , vector
+  main-is: Spec.hs
   other-modules:
+      Network.Haskoin.Block.Spec
       Network.Haskoin.Block.Tests
       Network.Haskoin.Block.Units
       Network.Haskoin.Cereal.Tests
@@ -256,11 +132,43 @@ test-suite haskoin-core-btc-test
       Network.Haskoin.Crypto.Units
       Network.Haskoin.Json.Tests
       Network.Haskoin.Network.Units
+      Network.Haskoin.Script.Spec
       Network.Haskoin.Script.Tests
       Network.Haskoin.Script.Units
       Network.Haskoin.Transaction.Tests
       Network.Haskoin.Transaction.Units
       Network.Haskoin.Util.Tests
-      Network.Haskoin.Script.Spec
       Paths_haskoin_core
+  hs-source-dirs:
+      test
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      HUnit
+    , QuickCheck
+    , aeson
+    , array
+    , base >=4.7 && <5
+    , base16-bytestring
+    , bytestring
+    , cereal
+    , conduit
+    , containers
+    , cryptonite
+    , deepseq
+    , entropy
+    , hashable
+    , haskoin-core
+    , hspec
+    , memory
+    , mtl
+    , murmur3
+    , network
+    , safe
+    , scientific
+    , secp256k1
+    , split
+    , string-conversions
+    , time
+    , unordered-containers
+    , vector
   default-language: Haskell2010

package.yaml

@@ -13,7 +13,7 @@ homepage: http://github.com/haskoin/haskoin#readme
 git: git://github.com/haskoin/haskoin.git
 bug-reports: http://github.com/haskoin/haskoin/issues
 extra-source-files:
-- test/data/*.json
+- data/*.json
 - README.md
 - CHANGELOG.md
 dependencies:
@@ -41,9 +41,6 @@ dependencies:
 - secp256k1
 - split
 - string-conversions
-- test-framework
-- test-framework-quickcheck2
-- test-framework-hunit
 - time
 - unordered-containers
 - vector
@@ -61,31 +58,9 @@ library:
   - Network.Haskoin.Constants
   - Network.Haskoin.Test
 tests:
-  haskoin-core-btc-test:
-    main: Main.hs
-    source-dirs:
-    - test/btc
-    - test/common
-    ghc-options:
-    - -threaded
-    - -rtsopts
-    - -with-rtsopts=-N
-    dependencies:
-    - haskoin-core
-  haskoin-core-btc-regtest:
-    main: Main.hs
-    source-dirs: test/btc-regtest
-    ghc-options:
-    - -threaded
-    - -rtsopts
-    - -with-rtsopts=-N
-    dependencies:
-    - haskoin-core
-  haskoin-core-bch-test:
-    main: Main.hs
-    source-dirs:
-    - test/bch
-    - test/common
+  haskoin-core-test:
+    main: Spec.hs
+    source-dirs: test
     ghc-options:
     - -threaded
     - -rtsopts

src/Network/Haskoin/Block/Genesis.hs

@@ -4,5 +4,5 @@ import Network.Haskoin.Block.Types
 import Network.Haskoin.Transaction.Genesis
 import Network.Haskoin.Constants
 
-genesisBlock :: Block
-genesisBlock = Block genesisHeader [genesisTx]
+genesisBlock :: Network -> Block
+genesisBlock net = Block (getGenesisHeader net) [genesisTx]

src/Network/Haskoin/Block/Headers.hs

@@ -19,10 +19,11 @@ import           Data.HashMap.Strict         (HashMap)
 import qualified Data.HashMap.Strict         as HashMap
 import           Data.List                   (sort, sortBy)
 import           Data.Maybe                  (fromMaybe, listToMaybe)
-import           Data.Serialize              (decode, encode)
-import           Data.Serialize              as Serialize (Serialize (..))
-import           Data.Serialize.Get          (getWord32le)
-import           Data.Serialize.Put          (putWord32le)
+import           Data.Serialize              as Serialize (Serialize (..),
+                                                           decode, encode, get,
+                                                           put)
+import           Data.Serialize.Get          (Get, getWord32le, runGet)
+import           Data.Serialize.Put          (Put, Putter, putWord32le, runPut)
 import           Data.Typeable               (Typeable)
 import           Data.Word                   (Word32, Word64)
 import           Network.Haskoin.Block.Types
@@ -49,22 +50,24 @@ data BlockNode
         }
     deriving (Show)
 
-instance Serialize BlockNode where
-    get = do
-        nodeHeader <- Serialize.get
-        nodeHeight <- getWord32le
-        nodeWork <- Serialize.get
-        if nodeHeader == genesisHeader
-            then return GenesisNode{..}
-            else do nodeSkip <- Serialize.get
-                    return BlockNode{..}
-    put bn = do
-        put $ nodeHeader bn
-        putWord32le $ nodeHeight bn
-        put $ nodeWork bn
-        case bn of
-            GenesisNode{} -> return ()
-            BlockNode{}   -> put $ nodeSkip bn
+getBlockNode :: Network -> Get BlockNode
+getBlockNode net = do
+    nodeHeader <- Serialize.get
+    nodeHeight <- getWord32le
+    nodeWork <- Serialize.get
+    if nodeHeader == getGenesisHeader net
+        then return GenesisNode{..}
+        else do nodeSkip <- Serialize.get
+                return BlockNode{..}
+
+putBlockNode :: Putter BlockNode
+putBlockNode bn = do
+    put $ nodeHeader bn
+    putWord32le $ nodeHeight bn
+    put $ nodeWork bn
+    case bn of
+        GenesisNode{} -> return ()
+        BlockNode{}   -> put $ nodeSkip bn
 
 
 instance NFData BlockNode where
@@ -90,7 +93,7 @@ instance NFData HeaderMemory where
 
 class Monad m => BlockHeaders m where
     addBlockHeader :: BlockNode -> m ()
-    getBlockHeader :: BlockHash -> m (Maybe BlockNode)
+    getBlockHeader :: Network -> BlockHash -> m (Maybe BlockNode)
     getBestBlockHeader :: m BlockNode
     setBestBlockHeader :: BlockNode -> m ()
     addBlockHeaders :: [BlockNode] -> m ()
@@ -98,7 +101,7 @@ class Monad m => BlockHeaders m where
 
 instance Monad m => BlockHeaders (StateT HeaderMemory m) where
     addBlockHeader = modify . addBlockHeaderMemory
-    getBlockHeader bh = getBlockHeaderMemory bh <$> State.get
+    getBlockHeader net bh = getBlockHeaderMemory net bh <$> State.get
     getBestBlockHeader = gets memoryBestHeader
     setBestBlockHeader bn = modify $ \s -> s { memoryBestHeader = bn }
 
@@ -107,10 +110,10 @@ addBlockHeaderMemory bn s@HeaderMemory{..} =
     let bm' = addBlockToMap bn memoryHeaderMap
     in s { memoryHeaderMap = bm' }
 
-getBlockHeaderMemory :: BlockHash -> HeaderMemory -> Maybe BlockNode
-getBlockHeaderMemory bh HeaderMemory{..} = do
+getBlockHeaderMemory :: Network -> BlockHash -> HeaderMemory -> Maybe BlockNode
+getBlockHeaderMemory net bh HeaderMemory{..} = do
     bs <- shortBlockHash bh `HashMap.lookup` memoryHeaderMap
-    eitherToMaybe . decode $ fromShort bs
+    eitherToMaybe . runGet (getBlockNode net) $ fromShort bs
 
 shortBlockHash :: BlockHash -> ShortBlockHash
 shortBlockHash = either error id . decode . BS.take 8 . encode
@@ -119,13 +122,14 @@ addBlockToMap :: BlockNode -> BlockMap -> BlockMap
 addBlockToMap node =
     HashMap.insert
     (shortBlockHash $ headerHash $ nodeHeader node)
-    (toShort $ encode node)
+    (toShort $ runPut $ putBlockNode node)
 
 getAncestor :: BlockHeaders m
-            => BlockHeight
+            => Network
+            -> BlockHeight
             -> BlockNode
             -> m (Maybe BlockNode)
-getAncestor height node
+getAncestor net height node
     | height > nodeHeight node = return Nothing
     | otherwise = go node
   where
@@ -144,10 +148,10 @@ getAncestor height node
                             )
                        )
                  then do walk' <- fromMaybe e1 <$>
-                             getBlockHeader (nodeSkip walk)
+                             getBlockHeader net (nodeSkip walk)
                          go walk'
                  else do walk' <- fromMaybe e2 <$>
-                             getBlockHeader (prevBlock (nodeHeader walk))
+                             getBlockHeader net (prevBlock (nodeHeader walk))
                          go walk'
         | otherwise = return $ Just walk
 
@@ -155,34 +159,37 @@ isGenesis :: BlockNode -> Bool
 isGenesis GenesisNode{} = True
 isGenesis BlockNode{}   = False
 
-initialChain :: HeaderMemory
-initialChain = HeaderMemory
-    { memoryHeaderMap = genesisMap
-    , memoryBestHeader = genesisNode
+initialChain :: Network -> HeaderMemory
+initialChain net = HeaderMemory
+    { memoryHeaderMap = genesisMap net
+    , memoryBestHeader = genesisNode net
     }
 
-genesisMap :: BlockMap
-genesisMap =
+genesisMap :: Network -> BlockMap
+genesisMap net =
     HashMap.singleton
-    (shortBlockHash $ headerHash genesisHeader)
-    (toShort $ encode genesisNode)
+        (shortBlockHash (headerHash (getGenesisHeader net)))
+        (toShort (runPut (putBlockNode (genesisNode net))))
 
-genesisNode :: BlockNode
-genesisNode = GenesisNode { nodeHeader = genesisHeader
-                          , nodeHeight = 0
-                          , nodeWork = headerWork genesisHeader
-                          }
+genesisNode :: Network -> BlockNode
+genesisNode net =
+    GenesisNode
+        { nodeHeader = getGenesisHeader net
+        , nodeHeight = 0
+        , nodeWork = headerWork (getGenesisHeader net)
+        }
 
 connectBlocks :: BlockHeaders m
-              => Timestamp       -- ^ current time
+              => Network
+              -> Timestamp       -- ^ current time
               -> [BlockHeader]
               -> m (Either String [BlockNode])
-connectBlocks _ [] = return $ Right []
-connectBlocks t bhs@(bh : _) = runExceptT $ do
+connectBlocks _ _ [] = return $ Right []
+connectBlocks net t bhs@(bh : _) = runExceptT $ do
     unless (chained bhs) $
         throwError "Blocks to connect do not form a chain"
-    par <- ExceptT $ parentBlock bh
-    pars <- lift $ getParents 10 par
+    par <- ExceptT $ parentBlock net bh
+    pars <- lift $ getParents net 10 par
     bb <- lift getBestBlockHeader
     bns@(bn : _) <- go par [] bb par pars bhs
     lift $ addBlockHeaders bns
@@ -195,7 +202,7 @@ connectBlocks t bhs@(bh : _) = runExceptT $ do
     skip lbh ls par
         | sh == nodeHeight lbh = return lbh
         | sh < nodeHeight lbh = do
-              skM <- lift $ getAncestor sh lbh
+              skM <- lift $ getAncestor net sh lbh
               case skM of
                   Just sk -> return sk
                   Nothing -> throwError $ "BUG: Could not get skip for block "
@@ -210,64 +217,68 @@ connectBlocks t bhs@(bh : _) = runExceptT $ do
     go _ acc _ _ _ [] = return acc
     go lbh acc bb par pars (h : hs) = do
         sk <- skip lbh acc par
-        bn <- ExceptT . return $ validBlock t bb par pars h sk
+        bn <- ExceptT . return $ validBlock net t bb par pars h sk
         go lbh (bn : acc) (chooseBest bn bb) bn (take 10 $ par : pars) hs
 
 parentBlock :: BlockHeaders m
-            => BlockHeader
+            => Network
+            -> BlockHeader
             -> m (Either String BlockNode)
-parentBlock bh = runExceptT $ do
-    parM <- lift $ getBlockHeader $ prevBlock bh
+parentBlock net bh = runExceptT $ do
+    parM <- lift $ getBlockHeader net $ prevBlock bh
     case parM of
         Nothing -> throwError $ "Parent block not found for " ++ show (prevBlock bh)
         Just par -> return par
 
-connectBlock :: BlockHeaders m
-             => Timestamp        -- ^ current time
-             -> BlockHeader
-             -> m (Either String BlockNode)
-connectBlock t bh = runExceptT $ do
-    par <- ExceptT $ parentBlock bh
-    pars <- lift $ getParents 10 par
-    skM <- lift $ getAncestor (skipHeight (nodeHeight par + 1)) par
+connectBlock ::
+       BlockHeaders m
+    => Network
+    -> Timestamp -- ^ current time
+    -> BlockHeader
+    -> m (Either String BlockNode)
+connectBlock net t bh = runExceptT $ do
+    par <- ExceptT $ parentBlock net bh
+    pars <- lift $ getParents net 10 par
+    skM <- lift $ getAncestor net (skipHeight (nodeHeight par + 1)) par
     sk <- case skM of
         Just sk -> return sk
         Nothing -> throwError $ "BUG: Could not get skip for block "
                    ++ show (headerHash $ nodeHeader par)
     bb <- lift getBestBlockHeader
-    bn <- ExceptT . return $ validBlock t bb par pars bh sk
+    bn <- ExceptT . return $ validBlock net t bb par pars bh sk
     let bb' = chooseBest bb bn
     lift $ addBlockHeader bn
     when (bb /= bb') . lift $ setBestBlockHeader bb'
     return bn
 
-validBlock :: Timestamp     -- ^ current time
+validBlock :: Network
+           -> Timestamp     -- ^ current time
            -> BlockNode     -- ^ best block
            -> BlockNode     -- ^ immediate parent
            -> [BlockNode]   -- ^ 10 parents above
            -> BlockHeader   -- ^ header to validate
            -> BlockNode     -- ^ skip
            -> Either String BlockNode
-validBlock t bb par pars bh sk = do
+validBlock net t bb par pars bh sk = do
     let mt = medianTime . map (blockTimestamp . nodeHeader) $ par : pars
         nt = blockTimestamp bh
         hh = headerHash bh
         nv = blockVersion bh
         ng = nodeHeight par + 1
         aw = nodeWork par + headerWork bh
-    unless (isValidPOW bh) $
+    unless (isValidPOW net bh) $
         Left $ "Proof of work failed: " ++ show (headerHash bh)
     unless (nt <= t + 2 * 60 * 60) $
         Left $ "Invalid header timestamp: " ++ show nt
     unless (nt >= mt) $
         Left $ "Block timestamp too early: " ++ show nt
-    unless (afterLastCP (nodeHeight bb) ng) $
+    unless (afterLastCP net (nodeHeight bb) ng) $
         Left $ "Rewriting pre-checkpoint chain: " ++ show ng
-    unless (validCP ng hh) $
+    unless (validCP net ng hh) $
         Left $ "Rejected checkpoint: " ++ show ng
-    unless (bip34 ng hh) $
+    unless (bip34 net ng hh) $
         Left $ "Rejected BIP-34 block: " ++ show hh
-    unless (validVersion ng nv) $
+    unless (validVersion net ng nv) $
         Left $ "Invalid block version: " ++ show nv
     return BlockNode { nodeHeader = bh
                      , nodeHeight = ng
@@ -290,104 +301,116 @@ invertLowestOne :: BlockHeight -> BlockHeight
 invertLowestOne height = height .&. (height - 1)
 
 getParents :: BlockHeaders m
-           => Int
+           => Network
+           -> Int
            -> BlockNode
            -> m [BlockNode]   -- ^ starting from closest parent
-getParents = getpars []
+getParents net = getpars []
   where
     getpars acc 0 _ = return $ reverse acc
     getpars acc _ GenesisNode{} = return $ reverse acc
     getpars acc n BlockNode{..} = do
-        parM <- getBlockHeader $ prevBlock nodeHeader
+        parM <- getBlockHeader net $ prevBlock nodeHeader
         case parM of
             Just bn -> getpars (bn : acc) (n - 1) bn
             Nothing -> error "BUG: All non-genesis blocks should have a parent"
 
 -- | Verify that checkpoint location is valid.
-validCP :: BlockHeight  -- ^ new child height
+validCP :: Network
+        -> BlockHeight  -- ^ new child height
         -> BlockHash    -- ^ new child hash
         -> Bool
-validCP height newChildHash =
-    case lookup height checkpoints of
+validCP net height newChildHash =
+    case lookup height (getCheckpoints net) of
         Just cpHash -> cpHash == newChildHash
         Nothing     -> True
 
-afterLastCP :: BlockHeight  -- ^ best height
+afterLastCP :: Network
+            -> BlockHeight  -- ^ best height
             -> BlockHeight  -- ^ new child height
             -> Bool
-afterLastCP bestHeight newChildHeight =
+afterLastCP net bestHeight newChildHeight =
     case lM of
         Just l  -> l < newChildHeight
         Nothing -> True
   where
-    lM = listToMaybe . reverse $
-         [ fst c | c <- checkpoints, fst c <= bestHeight ]
+    lM =
+        listToMaybe . reverse $
+        [fst c | c <- getCheckpoints net, fst c <= bestHeight]
 
-bip34 :: BlockHeight  -- ^ new child height
+bip34 :: Network
+      -> BlockHeight  -- ^ new child height
       -> BlockHash    -- ^ new child hash
       -> Bool
-bip34 height hash
-    | fst bip34Block == 0 = True
-    | fst bip34Block == height = snd bip34Block == hash
+bip34 net height hash
+    | fst (getBip34Block net) == 0 = True
+    | fst (getBip34Block net) == height = snd (getBip34Block net) == hash
     | otherwise = True
 
-validVersion :: BlockHeight  -- ^ new child height
+validVersion :: Network
+             -> BlockHeight  -- ^ new child height
              -> Word32       -- ^ new child version
              -> Bool
-validVersion height version
-    | version < 2 = height < fst bip34Block
-    | version < 3 = height < bip66Height
-    | version < 4 = height < bip65Height
+validVersion net height version
+    | version < 2 = height < fst (getBip34Block net)
+    | version < 3 = height < getBip66Height net
+    | version < 4 = height < getBip65Height net
     | otherwise = True
 
 -- | Find last block with normal, as opposed to minimum difficulty (for test
 -- networks).
-lastNoMinDiff :: BlockHeaders m => BlockNode -> m BlockNode
-lastNoMinDiff bn@BlockNode{..} = do
-    let i = nodeHeight `mod` diffInterval /= 0
-        c = encodeCompact powLimit
+lastNoMinDiff :: BlockHeaders m => Network -> BlockNode -> m BlockNode
+lastNoMinDiff net bn@BlockNode {..} = do
+    let i = nodeHeight `mod` diffInterval net /= 0
+        c = encodeCompact (getPowLimit net)
         l = blockBits nodeHeader == c
-        e1 = error $ "Could not get block header for parent of " ++
-             show (headerHash nodeHeader)
+        e1 =
+            error $
+            "Could not get block header for parent of " ++
+            show (headerHash nodeHeader)
     if i && l
-        then do bn' <- fromMaybe e1 <$> getBlockHeader (prevBlock nodeHeader)
-                lastNoMinDiff bn'
+        then do
+            bn' <- fromMaybe e1 <$> getBlockHeader net (prevBlock nodeHeader)
+            lastNoMinDiff net bn'
         else return bn
 
-lastNoMinDiff bn@GenesisNode{} = return bn
+lastNoMinDiff _ bn@GenesisNode{} = return bn
 
 -- | Returns the work required on a block header given the previous block. This
 -- coresponds to bitcoind function GetNextWorkRequired in main.cpp.
 nextWorkRequired :: BlockHeaders m
-                 => BlockNode
+                 => Network
+                 -> BlockNode
                  -> BlockHeader
                  -> m Word32
-nextWorkRequired par bh = do
+nextWorkRequired net par bh = do
     let mf = daa <|> eda <|> pow
     case mf of
-        Just f -> f par bh
+        Just f -> f net par bh
         Nothing ->
             error
                 "Could not get an appropriate difficulty calculation algorithm"
   where
-    daa = daaBlockHeight >>= \daaHeight -> do
+    daa = getDaaBlockHeight net >>= \daaHeight -> do
         guard (nodeHeight par + 1 >= daaHeight)
-        return nextDAAWorkRequired
-    eda = edaBlockHeight >>= \edaHeight -> do
+        return nextDaaWorkRequired
+    eda = getEdaBlockHeight net >>= \edaHeight -> do
         guard (nodeHeight par + 1 >= edaHeight)
-        return nextEDAWorkRequired
+        return nextEdaWorkRequired
     pow = return nextPOWWorkRequired
 
-nextEDAWorkRequired :: BlockHeaders m => BlockNode -> BlockHeader -> m Word32
-nextEDAWorkRequired par bh
-    | nodeHeight par + 1 `mod` diffInterval == 0 = nextWorkRequired par bh
-    | minDifficulty = return (encodeCompact powLimit)
-    | blockBits (nodeHeader par) == encodeCompact powLimit =
-        return (encodeCompact powLimit)
+nextEdaWorkRequired ::
+       BlockHeaders m => Network -> BlockNode -> BlockHeader -> m Word32
+nextEdaWorkRequired net par bh
+    | nodeHeight par + 1 `mod` diffInterval net == 0 =
+        nextWorkRequired net par bh
+    | minDifficulty = return (encodeCompact (getPowLimit net))
+    | blockBits (nodeHeader par) == encodeCompact (getPowLimit net) =
+        return (encodeCompact (getPowLimit net))
     | otherwise = do
-        par6 <- fromMaybe e1 <$> getAncestor (nodeHeight par - 6) par
-        pars <- getParents 10 par
-        pars6 <- getParents 10 par6
+        par6 <- fromMaybe e1 <$> getAncestor net (nodeHeight par - 6) par
+        pars <- getParents net 10 par
+        pars6 <- getParents net 10 par6
         let par6med =
                 medianTime $ map (blockTimestamp . nodeHeader) (par6 : pars6)
             parmed = medianTime $ map (blockTimestamp . nodeHeader) (par : pars)
@@ -397,99 +420,103 @@ nextEDAWorkRequired par bh
             else return $
                  let (diff, _) = decodeCompact (blockBits (nodeHeader par))
                      ndiff = diff + (diff `shiftR` 2)
-                 in if powLimit > ndiff
-                        then encodeCompact powLimit
-                        else encodeCompact ndiff
+                  in if getPowLimit net > ndiff
+                         then encodeCompact (getPowLimit net)
+                         else encodeCompact ndiff
   where
     minDifficulty =
-        blockTimestamp bh > blockTimestamp (nodeHeader par) + targetSpacing * 2
+        blockTimestamp bh >
+        blockTimestamp (nodeHeader par) + getTargetSpacing net * 2
     e1 = error "Could not get seventh ancestor of block"
 
-nextDAAWorkRequired :: BlockHeaders m => BlockNode -> BlockHeader -> m Word32
-nextDAAWorkRequired par bh
-    | minDifficulty = return (encodeCompact powLimit)
+nextDaaWorkRequired ::
+       BlockHeaders m => Network -> BlockNode -> BlockHeader -> m Word32
+nextDaaWorkRequired net par bh
+    | minDifficulty = return (encodeCompact (getPowLimit net))
     | otherwise = do
         let height = nodeHeight par
-        unless (height >= diffInterval) $
+        unless (height >= diffInterval net) $
             error "Block height below difficulty interval"
-        l <- getSuitableBlock par
-        par144 <- fromMaybe e1 <$> getAncestor (height - 144) par
-        f <- getSuitableBlock par144
-        let nextTarget = computeTarget f l
-        if nextTarget > powLimit
-            then return $ encodeCompact powLimit
+        l <- getSuitableBlock net par
+        par144 <- fromMaybe e1 <$> getAncestor net (height - 144) par
+        f <- getSuitableBlock net par144
+        let nextTarget = computeTarget net f l
+        if nextTarget > getPowLimit net
+            then return $ encodeCompact (getPowLimit net)
             else return $ encodeCompact nextTarget
   where
     e1 = error "Cannot get ancestor at parent - 144 height"
     minDifficulty =
-        blockTimestamp bh > blockTimestamp (nodeHeader par) + targetSpacing * 2
+        blockTimestamp bh >
+        blockTimestamp (nodeHeader par) + getTargetSpacing net * 2
 
-computeTarget :: BlockNode -> BlockNode -> Integer
-computeTarget f l =
-    let work = (nodeWork l - nodeWork f) * fromIntegral targetSpacing
+computeTarget :: Network -> BlockNode -> BlockNode -> Integer
+computeTarget net f l =
+    let work = (nodeWork l - nodeWork f) * fromIntegral (getTargetSpacing net)
         actualTimespan =
             blockTimestamp (nodeHeader l) - blockTimestamp (nodeHeader f)
         actualTimespan'
-            | actualTimespan > 288 * targetSpacing = 288 * targetSpacing
-            | actualTimespan < 72 * targetSpacing = 72 * targetSpacing
+            | actualTimespan > 288 * getTargetSpacing net =
+                288 * getTargetSpacing net
+            | actualTimespan < 72 * getTargetSpacing net =
+                72 * getTargetSpacing net
             | otherwise = actualTimespan
         work' = work `div` fromIntegral actualTimespan'
-    in 2 ^ (256 :: Integer) `div` work'
+     in 2 ^ (256 :: Integer) `div` work'
 
-getSuitableBlock :: BlockHeaders m => BlockNode -> m BlockNode
-getSuitableBlock par = do
+getSuitableBlock :: BlockHeaders m => Network -> BlockNode -> m BlockNode
+getSuitableBlock net par = do
     unless (nodeHeight par >= 3) $ error "Block height is less than three"
-    blocks <- (par :) <$> getParents 2 par
+    blocks <- (par :) <$> getParents net 2 par
     return $ sortBy (compare `on` blockTimestamp . nodeHeader) blocks !! 1
 
 -- | Returns the work required on a block header given the previous block. This
 -- coresponds to bitcoind function GetNextWorkRequired in main.cpp.
-nextPOWWorkRequired :: BlockHeaders m
-                 => BlockNode
-                 -> BlockHeader
-                 -> m Word32
-nextPOWWorkRequired par bh
-    | nodeHeight par + 1 `mod` diffInterval /= 0 =
-          if allowMinDifficultyBlocks
-          then if ht > pt + delta
-               then return $ encodeCompact powLimit
-               else do d <- lastNoMinDiff par
-                       return $ blockBits $ nodeHeader d
-          else return $ blockBits $ nodeHeader par
+nextPOWWorkRequired :: BlockHeaders m => Network -> BlockNode -> BlockHeader -> m Word32
+nextPOWWorkRequired net par bh
+    | nodeHeight par + 1 `mod` diffInterval net /= 0 =
+        if getAllowMinDifficultyBlocks net
+            then if ht > pt + delta
+                     then return $ encodeCompact (getPowLimit net)
+                     else do
+                         d <- lastNoMinDiff net par
+                         return $ blockBits $ nodeHeader d
+            else return $ blockBits $ nodeHeader par
     | otherwise = do
-          let rh = nodeHeight par - (diffInterval - 1)
-          a <- fromMaybe e1 <$> getAncestor rh par
-          let t = blockTimestamp $ nodeHeader a
-          return $ calcNextWork (nodeHeader par) t
+        let rh = nodeHeight par - (diffInterval net - 1)
+        a <- fromMaybe e1 <$> getAncestor net rh par
+        let t = blockTimestamp $ nodeHeader a
+        return $ calcNextWork net (nodeHeader par) t
   where
     e1 = error "Could not get ancestor for block header"
     pt = blockTimestamp $ nodeHeader par
     ht = blockTimestamp bh
-    delta = targetSpacing * 2
+    delta = getTargetSpacing net * 2
 
 -- | Computes the work required for the first block in a new retarget period.
-calcNextWork :: BlockHeader  -- ^ last block in previous retarget (parent)
+calcNextWork :: Network
+             -> BlockHeader  -- ^ last block in previous retarget (parent)
              -> Timestamp    -- ^ timestamp of first block in previous retarget
              -> Word32
-calcNextWork header time
-    | powNoRetargetting = blockBits header
-    | new > powLimit = encodeCompact powLimit
+calcNextWork net header time
+    | getPowNoRetargetting net = blockBits header
+    | new > getPowLimit net = encodeCompact (getPowLimit net)
     | otherwise = encodeCompact new
   where
     s = blockTimestamp header - time
-    n | s < targetTimespan `div` 4 = targetTimespan `div` 4
-      | s > targetTimespan * 4 = targetTimespan * 4
+    n | s < getTargetTimespan net `div` 4 = getTargetTimespan net `div` 4
+      | s > getTargetTimespan net * 4 = getTargetTimespan net * 4
       | otherwise = s
     l = fst $ decodeCompact $ blockBits header
-    new = l * fromIntegral n `div` fromIntegral targetTimespan
+    new = l * fromIntegral n `div` fromIntegral (getTargetTimespan net)
 
 -- | Returns True if the difficulty target (bits) of the header is valid and the
 -- proof of work of the header matches the advertised difficulty target. This
 -- function corresponds to the function CheckProofOfWork from bitcoind in
 -- main.cpp.
-isValidPOW :: BlockHeader -> Bool
-isValidPOW h
-    | target <= 0 || over || target > powLimit = False
+isValidPOW :: Network -> BlockHeader -> Bool
+isValidPOW net h
+    | target <= 0 || over || target > getPowLimit net = False
     | otherwise = blockPOW (headerHash h) <= fromIntegral target
   where
     (target, over) = decodeCompact $ blockBits h
@@ -508,8 +535,8 @@ headerWork bh = largestHash `div` (target + 1)
     largestHash = 1 `shiftL` 256
 
 -- | Number of blocks on average between difficulty cycles (2016 blocks).
-diffInterval :: Word32
-diffInterval = targetTimespan `div` targetSpacing
+diffInterval :: Network -> Word32
+diffInterval net = getTargetTimespan net `div` getTargetSpacing net
 
 -- | Compare two blocks to get the best.
 chooseBest :: BlockNode -> BlockNode -> BlockNode
@@ -521,8 +548,8 @@ chooseBest b1 b2 | nodeWork b1 == nodeWork b2 =
                  | otherwise = b2
 
 -- | Get list of blocks for a block locator.
-blockLocatorNodes :: BlockHeaders m => BlockNode -> m [BlockNode]
-blockLocatorNodes best =
+blockLocatorNodes :: BlockHeaders m => Network -> BlockNode -> m [BlockNode]
+blockLocatorNodes net best =
     reverse <$> go [] best 1
   where
     e1 = error "Could not get ancestor"
@@ -532,44 +559,48 @@ blockLocatorNodes best =
                  then n * 2
                  else 1
         in if nodeHeight bn < n'
-           then do a <- fromMaybe e1 <$> getAncestor 0 bn
+           then do a <- fromMaybe e1 <$> getAncestor net 0 bn
                    return $ a : loc'
            else do let h = nodeHeight bn - n'
-                   bn' <- fromMaybe e1 <$> getAncestor h bn
+                   bn' <- fromMaybe e1 <$> getAncestor net h bn
                    go loc' bn' n'
 
-blockLocator :: BlockHeaders m => BlockNode -> m BlockLocator
-blockLocator bn =
-    map (headerHash . nodeHeader) <$> blockLocatorNodes bn
+blockLocator :: BlockHeaders m => Network -> BlockNode -> m BlockLocator
+blockLocator net bn =
+    map (headerHash . nodeHeader) <$> blockLocatorNodes net bn
 
 -- | Become rich beyond your wildest dreams.
-mineBlock :: Word32 -> BlockHeader -> BlockHeader
-mineBlock seed h =
-    head [ j | i <- (+seed) <$> [0..maxBound],
-           let j = h{ bhNonce = i },
-               isValidPOW j ]
+mineBlock :: Network -> Word32 -> BlockHeader -> BlockHeader
+mineBlock net seed h =
+    head
+        [ j
+        | i <- (+ seed) <$> [0 .. maxBound]
+        , let j = h {bhNonce = i}
+        , isValidPOW net j
+        ]
 
 -- | Generate and append new blocks (mining). Only practical in regtest network.
-appendBlocks
-    :: Word32 -- ^ random seed
+appendBlocks ::
+       Network
+    -> Word32 -- ^ random seed
     -> BlockHeader
     -> Int
     -> [BlockHeader]
-appendBlocks _ _ 0 = []
-appendBlocks seed bh i =
-    bh' : appendBlocks seed bh' (i - 1)
+appendBlocks _ _ _ 0 = []
+appendBlocks net seed bh i =
+    bh' : appendBlocks net seed bh' (i - 1)
   where
-    bh' = mineBlock seed bh
+    bh' = mineBlock net seed bh
         { prevBlock = headerHash bh
           -- Just to make it different in every header
         , merkleRoot = sha256 $ encode seed
         }
 
-splitPoint :: BlockHeaders m => BlockNode -> BlockNode -> m BlockNode
-splitPoint l r = do
+splitPoint :: BlockHeaders m => Network -> BlockNode -> BlockNode -> m BlockNode
+splitPoint net l r = do
     let h = min (nodeHeight l) (nodeHeight r)
-    ll <- fromMaybe e <$> getAncestor h l
-    lr <- fromMaybe e <$> getAncestor h r
+    ll <- fromMaybe e <$> getAncestor net h l
+    lr <- fromMaybe e <$> getAncestor net h r
     f ll lr
   where
     e = error "BUG: Could not get ancestor at lowest height"
@@ -578,6 +609,6 @@ splitPoint l r = do
             then return lr
             else do
                 let h = nodeHeight ll - 1
-                pl <- fromMaybe e <$> getAncestor h ll
-                pr <- fromMaybe e <$> getAncestor h lr
+                pl <- fromMaybe e <$> getAncestor net h ll
+                pr <- fromMaybe e <$> getAncestor net h lr
                 f pl pr

src/Network/Haskoin/Block/Merkle.hs

@@ -159,15 +159,16 @@ traverseAndExtract height pos ntx flags hashes
 -- | Extracts the matching hashes from a partial merkle tree. This will return
 -- the list of transaction hashes that have been included (set to True) in
 -- a call to 'buildPartialMerkle'.
-extractMatches :: FlagBits -- ^ Flag bits (produced by buildPartialMerkle).
+extractMatches :: Network
+               -> FlagBits -- ^ Flag bits (produced by buildPartialMerkle).
                -> PartialMerkleTree -- ^ Partial merkle tree.
                -> Int -- ^ Number of transaction at height 0 (leaf nodes).
                -> Either String (MerkleRoot, [TxHash])
                -- ^ Merkle root and the list of matching transaction hashes.
-extractMatches flags hashes ntx
+extractMatches net flags hashes ntx
     | ntx == 0 = Left
         "extractMatches: number of transactions can not be 0"
-    | ntx > maxBlockSize `div` 60 = Left
+    | ntx > getMaxBlockSize net `div` 60 = Left
         "extractMatches: number of transactions excessively high"
     | length hashes > ntx = Left
         "extractMatches: More hashes provided than the number of transactions"
@@ -193,15 +194,15 @@ boolsToWord8 :: [Bool] -> Word8
 boolsToWord8 [] = 0
 boolsToWord8 xs = foldl setBit 0 (map snd $ filter fst $ zip xs [0..7])
 
-merkleBlockTxs :: MerkleBlock -> Either String [TxHash]
-merkleBlockTxs b =
+merkleBlockTxs :: Network -> MerkleBlock -> Either String [TxHash]
+merkleBlockTxs net b =
     let flags = mFlags b
         hs = mHashes b
         n = fromIntegral $ merkleTotalTxns b
         merkle = merkleRoot $ merkleHeader b
-    in do (root, ths) <- extractMatches flags hs n
+    in do (root, ths) <- extractMatches net flags hs n
           when (root /= merkle) $ Left "merkleBlockTxs: Merkle root incorrect"
           return ths
 
-testMerkleRoot :: MerkleBlock -> Bool
-testMerkleRoot = isRight . merkleBlockTxs
+testMerkleRoot :: Network -> MerkleBlock -> Bool
+testMerkleRoot net = isRight . merkleBlockTxs net

src/Network/Haskoin/Constants.hs

@@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -fno-cse -fno-full-laziness #-}
+{-# LANGUAGE DeriveGeneric     #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-|
   Network specific constants
@@ -12,63 +12,31 @@ module Network.Haskoin.Constants
 , bch
 , bchTest
 , bchRegTest
-  -- ** Functions
-, setBTC
-, setBTCtest
-, setBTCregTest
-, setBCH
-, setBCHtest
-, setBCHregTest
-, setNetwork
-, getNetwork
-  -- ** Network parameters
-, networkName
-, addrPrefix
-, scriptPrefix
-, secretPrefix
-, extPubKeyPrefix
-, extSecretPrefix
-, networkMagic
-, genesisHeader
-, maxBlockSize
-, maxSatoshi
-, haskoinUserAgent
-, defaultPort
-, allowMinDifficultyBlocks
-, powNoRetargetting
-, powLimit
-, bip34Block
-, bip65Height
-, bip66Height
-, targetTimespan
-, targetSpacing
-, checkpoints
-, bip44Coin
-, seeds
-, sigHashForkId
-, edaBlockHeight
-, daaBlockHeight
-, segWit
-, cashAddrPrefix
-, bech32Prefix
+, allNets
+, netByName
 ) where
 
 import           Control.Concurrent.MVar
+import           Control.DeepSeq
 import           Control.Monad
 import           Data.ByteString             (ByteString)
+import           Data.List
 import           Data.Maybe
 import           Data.String
 import           Data.Version
 import           Data.Word                   (Word32, Word64, Word8)
+import           GHC.Generics                (Generic)
 import           Network.Haskoin.Block.Types
 import           Paths_haskoin_core
 import           System.IO.Unsafe            (unsafePerformIO)
+import           Text.Read
 
 versionString :: IsString a => a
 versionString = fromString (showVersion version)
 
 data Network = Network
     { getNetworkName              :: !String
+    , getNetworkIdent             :: !String
     , getAddrPrefix               :: !Word8
     , getScriptPrefix             :: !Word8
     , getSecretPrefix             :: !Word8
@@ -92,150 +60,34 @@ data Network = Network
     , getBip44Coin                :: !Word32
     , getSeeds                    :: ![String]
     , getSigHashForkId            :: !(Maybe Word32)
-    , getEDABlockHeight           :: !(Maybe Word32)
-    , getDAABlockHeight           :: !(Maybe Word32)
+    , getEdaBlockHeight           :: !(Maybe Word32)
+    , getDaaBlockHeight           :: !(Maybe Word32)
     , getSegWit                   :: !Bool
     , getCashAddrPrefix           :: !(Maybe ByteString)
     , getBech32Prefix             :: !(Maybe ByteString)
-    } deriving (Eq)
+    } deriving (Eq, Generic)
 
-setBTC :: IO ()
-setBTC = setNetwork btc
+instance NFData Network
 
-setBTCtest :: IO ()
-setBTCtest = setNetwork btcTest
+instance Show Network where
+    show = getNetworkIdent
 
-setBTCregTest :: IO ()
-setBTCregTest = setNetwork btcRegTest
+instance Read Network where
+    readPrec = do
+        Ident str <- lexP
+        maybe pfail return (netByIdent str)
 
-setBCH :: IO ()
-setBCH = setNetwork bch
+netByName :: String -> Maybe Network
+netByName str = find ((== str) . getNetworkName) allNets
 
-setBCHtest :: IO ()
-setBCHtest = setNetwork bchTest
-
-setBCHregTest :: IO ()
-setBCHregTest = setNetwork bchRegTest
-
-setNetwork :: Network -> IO ()
-setNetwork net = do
-    success <- tryPutMVar networkMVar net
-    unless success $ error "The network has already been set"
-
-{-# NOINLINE networkMVar #-}
-networkMVar :: MVar Network
-networkMVar = unsafePerformIO newEmptyMVar
-
-{-# NOINLINE getNetwork #-}
-getNetwork :: Network
-getNetwork =
-    fromMaybe err $ unsafePerformIO $ tryTakeMVar networkMVar
-  where
-    err = error "Use Network.Haskoin.Constants.setNetwork"
-
-networkName :: String
-networkName = getNetworkName getNetwork
-
-addrPrefix :: Word8
-addrPrefix = getAddrPrefix getNetwork
-
-scriptPrefix :: Word8
-scriptPrefix = getScriptPrefix getNetwork
-
-secretPrefix :: Word8
-secretPrefix = getSecretPrefix getNetwork
-
-extPubKeyPrefix :: Word32
-extPubKeyPrefix = getExtPubKeyPrefix getNetwork
-
-extSecretPrefix :: Word32
-extSecretPrefix = getExtSecretPrefix getNetwork
-
-networkMagic :: Word32
-networkMagic = getNetworkMagic getNetwork
-
-genesisHeader :: BlockHeader
-genesisHeader = getGenesisHeader getNetwork
-
-maxBlockSize :: Int
-maxBlockSize = getMaxBlockSize getNetwork
-
-maxSatoshi :: Word64
-maxSatoshi = getMaxSatoshi getNetwork
-
-haskoinUserAgent :: ByteString
-haskoinUserAgent = getHaskoinUserAgent getNetwork
-
-defaultPort :: Int
-defaultPort = getDefaultPort getNetwork
-
-allowMinDifficultyBlocks :: Bool
-allowMinDifficultyBlocks = getAllowMinDifficultyBlocks getNetwork
-
-powNoRetargetting :: Bool
-powNoRetargetting = getPowNoRetargetting getNetwork
-
-powLimit :: Integer
-powLimit = getPowLimit getNetwork
-
--- | Version 2 blocks start here.
-bip34Block :: (BlockHeight, BlockHash)
-bip34Block = getBip34Block getNetwork
-
--- | Version 3 blocks start here.
-bip65Height :: BlockHeight
-bip65Height = getBip65Height getNetwork
-
--- | Version 4 blocks start here.
-bip66Height :: BlockHeight
-bip66Height = getBip66Height getNetwork
-
--- | Time between difficulty cycles (2 weeks on average).
-targetTimespan :: Word32
-targetTimespan = getTargetTimespan getNetwork
-
--- | Time between blocks (10 minutes per block).
-targetSpacing :: Word32
-targetSpacing = getTargetSpacing getNetwork
-
--- | Checkpoints to enfore.
-checkpoints :: [(Word32, BlockHash)]
-checkpoints = getCheckpoints getNetwork
-
--- | Bip44 coin derivation (m/44'/coin'/account'/internal/address/)
-bip44Coin :: Word32
-bip44Coin = getBip44Coin getNetwork
-
--- | DNS seeds.
-seeds :: [String]
-seeds = getSeeds getNetwork
-
--- | The Fork ID used for producing signatures on different networks.
-sigHashForkId :: Maybe Word32
-sigHashForkId = getSigHashForkId getNetwork
-
--- | EDA Block height. Used by Bitcoin Cash network.
-edaBlockHeight :: Maybe Word32
-edaBlockHeight = getEDABlockHeight getNetwork
-
--- | DAA Block height. Used by Bitcoin Cash network.
-daaBlockHeight :: Maybe Word32
-daaBlockHeight = getDAABlockHeight getNetwork
-
--- | Only connect to nodes advertising SegWit support.
-segWit :: Bool
-segWit = getSegWit getNetwork
-
-cashAddrPrefix :: Maybe ByteString
-cashAddrPrefix = getCashAddrPrefix getNetwork
-
-bech32Prefix :: Maybe ByteString
-bech32Prefix = getBech32Prefix getNetwork
+netByIdent :: String -> Maybe Network
+netByIdent str = find ((== str) . getNetworkIdent) allNets
 
 btc :: Network
 btc =
     Network
     { getNetworkName = "btc"
+    , getNetworkIdent = "btc"
     , getAddrPrefix = 0
     , getScriptPrefix = 5
     , getSecretPrefix = 128
@@ -306,8 +158,8 @@ btc =
           ]
     , getBip44Coin = 0
     , getSigHashForkId = Nothing
-    , getEDABlockHeight = Nothing
-    , getDAABlockHeight = Nothing
+    , getEdaBlockHeight = Nothing
+    , getDaaBlockHeight = Nothing
     , getSegWit = True
     , getCashAddrPrefix = Nothing
     , getBech32Prefix = Just "bc"
@@ -317,6 +169,7 @@ btcTest :: Network
 btcTest =
     Network
     { getNetworkName = "btc-test"
+    , getNetworkIdent = "btcTest"
     , getAddrPrefix = 111
     , getScriptPrefix = 196
     , getSecretPrefix = 239
@@ -359,8 +212,8 @@ btcTest =
           ]
     , getBip44Coin = 1
     , getSigHashForkId = Nothing
-    , getEDABlockHeight = Nothing
-    , getDAABlockHeight = Nothing
+    , getEdaBlockHeight = Nothing
+    , getDaaBlockHeight = Nothing
     , getSegWit = True
     , getCashAddrPrefix = Nothing
     , getBech32Prefix = Just "tb"
@@ -370,6 +223,7 @@ btcRegTest :: Network
 btcRegTest =
     Network
     { getNetworkName = "btc-regtest"
+    , getNetworkIdent = "btcRegTest"
     , getAddrPrefix = 111
     , getScriptPrefix = 196
     , getSecretPrefix = 239
@@ -404,8 +258,8 @@ btcRegTest =
     , getSeeds = ["localhost"]
     , getBip44Coin = 1
     , getSigHashForkId = Nothing
-    , getEDABlockHeight = Nothing
-    , getDAABlockHeight = Nothing
+    , getEdaBlockHeight = Nothing
+    , getDaaBlockHeight = Nothing
     , getSegWit = True
     , getCashAddrPrefix = Nothing
     , getBech32Prefix = Just "bcrt"
@@ -415,6 +269,7 @@ bch :: Network
 bch =
     Network
     { getNetworkName = "bch"
+    , getNetworkIdent = "bch"
     , getAddrPrefix = 0
     , getScriptPrefix = 5
     , getSecretPrefix = 128
@@ -489,8 +344,8 @@ bch =
           ]
     , getBip44Coin = 145
     , getSigHashForkId = Just 0
-    , getEDABlockHeight = Just 478559
-    , getDAABlockHeight = Just 404031
+    , getEdaBlockHeight = Just 478559
+    , getDaaBlockHeight = Just 404031
     , getSegWit = False
     , getCashAddrPrefix = Just "bitcoincash"
     , getBech32Prefix = Nothing
@@ -500,6 +355,7 @@ bchTest :: Network
 bchTest =
     Network
     { getNetworkName = "bch-test"
+    , getNetworkIdent = "bchTest"
     , getAddrPrefix = 111
     , getScriptPrefix = 196
     , getSecretPrefix = 239
@@ -549,8 +405,8 @@ bchTest =
           ]
     , getBip44Coin = 1
     , getSigHashForkId = Just 0
-    , getEDABlockHeight = Just 1155876
-    , getDAABlockHeight = Just 1188697
+    , getEdaBlockHeight = Just 1155876
+    , getDaaBlockHeight = Just 1188697
     , getSegWit = False
     , getCashAddrPrefix = Just "bchtest"
     , getBech32Prefix = Nothing
@@ -560,6 +416,7 @@ bchRegTest :: Network
 bchRegTest =
     Network
     { getNetworkName = "bch-regtest"
+    , getNetworkIdent = "bchRegTest"
     , getAddrPrefix = 111
     , getScriptPrefix = 196
     , getSecretPrefix = 239
@@ -597,9 +454,12 @@ bchRegTest =
     , getSeeds = ["localhost"]
     , getBip44Coin = 1
     , getSigHashForkId = Just 0
-    , getEDABlockHeight = Nothing
-    , getDAABlockHeight = Just 0
+    , getEdaBlockHeight = Nothing
+    , getDaaBlockHeight = Just 0
     , getSegWit = False
     , getCashAddrPrefix = Just "bchreg"
     , getBech32Prefix = Nothing
     }
+
+allNets :: [Network]
+allNets = [btc, bch, btcTest, bchTest, btcRegTest, bchRegTest]

src/Network/Haskoin/Crypto/Address.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveGeneric     #-}
 {-# LANGUAGE OverloadedStrings #-}
 module Network.Haskoin.Crypto.Address where
 
@@ -5,6 +6,7 @@ import           Control.Applicative
 import           Control.DeepSeq
 import           Control.Monad
 import           Data.Aeson                      as A
+import           Data.Aeson.Types
 import qualified Data.Array                      as Arr
 import           Data.Bits
 import           Data.ByteString                 (ByteString)
@@ -17,6 +19,7 @@ import           Data.Serialize                  as S
 import           Data.String
 import           Data.String.Conversions
 import           Data.Word
+import           GHC.Generics                    (Generic)
 import           Network.Haskoin.Constants
 import           Network.Haskoin.Crypto.Base58
 import           Network.Haskoin.Crypto.Bech32
@@ -28,110 +31,98 @@ import           Text.Read                       as R
 -- | Data type representing a Bitcoin address
 data Address
     -- | Public Key Hash Address
-    = PubKeyAddress { getAddrHash :: !Hash160 }
+    = PubKeyAddress { getAddrHash :: !Hash160
+                    , getAddrNet  :: !Network }
     -- | Script Hash Address
-    | ScriptAddress { getAddrHash :: !Hash160 }
+    | ScriptAddress { getAddrHash :: !Hash160
+                    , getAddrNet  :: !Network }
     -- | SegWit Public Key Hash Address
-    | WitnessPubKeyAddress { getAddrHash :: !Hash160 }
+    | WitnessPubKeyAddress { getAddrHash :: !Hash160
+                           , getAddrNet  :: !Network }
     -- | SegWit Script Hash Address
-    | WitnessScriptAddress { getScriptHash :: !Hash256 }
-    deriving (Eq, Ord)
+    | WitnessScriptAddress { getScriptHash :: !Hash256
+                           , getAddrNet    :: !Network }
+    deriving (Eq, Generic)
 
-base58get :: Get Address
-base58get = do
-        pfx <- getWord8
-        addr <- S.get
-        f pfx addr
-      where
-        f x a | x == addrPrefix   = return (PubKeyAddress a)
-              | x == scriptPrefix = return (ScriptAddress a)
-              | otherwise = fail "Does not recognize address prefix"
+instance NFData Address
+
+base58get :: Network -> Get Address
+base58get net = do
+    pfx <- getWord8
+    addr <- S.get
+    f pfx addr
+  where
+    f x a
+        | x == getAddrPrefix net = return (PubKeyAddress a net)
+        | x == getScriptPrefix net = return (ScriptAddress a net)
+        | otherwise = fail "Does not recognize address prefix"
 
 base58put :: Putter Address
-base58put (PubKeyAddress h) = do
-        putWord8 addrPrefix
+base58put (PubKeyAddress h net) = do
+        putWord8 (getAddrPrefix net)
         put h
-base58put (ScriptAddress h) = do
-        putWord8 scriptPrefix
+base58put (ScriptAddress h net) = do
+        putWord8 (getScriptPrefix net)
         put h
 
 instance Show Address where
     showsPrec d a =
         case addrToString a of
-            Just s -> showParen (d > 10) $ showString "Address " . shows s
+            Just s  -> shows s
             Nothing -> showString "InvalidAddress"
 
-instance Read Address where
-    readPrec = j <|> n
-      where
-        j =
-            parens $ do
-                R.Ident "Address" <- lexP
-                R.String str <- lexP
-                maybe pfail return $ stringToAddr $ cs str
-        n =
-            parens $ do
-                R.Ident "InvalidAddress" <- lexP
-                pfail
-
-instance IsString Address where
-    fromString =
-        fromMaybe e . stringToAddr . cs
-      where
-        e = error "Could not decode bitcoin address"
-
-instance NFData Address where
-    rnf (PubKeyAddress h) = rnf h
-    rnf (ScriptAddress h) = rnf h
-
-instance FromJSON Address where
-    parseJSON = withText "address" $ maybe mzero return . stringToAddr . cs
-
 instance ToJSON Address where
     toJSON =
         A.String .
         cs . fromMaybe (error "Could not encode address") . addrToString
 
+addrFromJSON :: Network -> Value -> Parser Address
+addrFromJSON net =
+    withText "address" $ \t ->
+        case stringToAddr net (cs t) of
+            Nothing -> fail "could not decode address"
+            Just x -> return x
+
 -- | Transforms an Address into an encoded String
 addrToString :: Address -> Maybe ByteString
-addrToString a@PubKeyAddress {getAddrHash = h}
-    | isNothing cashAddrPrefix =
+addrToString a@PubKeyAddress {getAddrHash = h, getAddrNet = net}
+    | isNothing (getCashAddrPrefix net) =
         return $ encodeBase58Check $ runPut $ base58put a
-    | otherwise = cashAddrEncode 0 (S.encode h)
-addrToString a@ScriptAddress {getAddrHash = h}
-    | isNothing cashAddrPrefix =
+    | otherwise = cashAddrEncode net 0 (S.encode h)
+addrToString a@ScriptAddress {getAddrHash = h, getAddrNet = net}
+    | isNothing (getCashAddrPrefix net) =
         return $ encodeBase58Check $ runPut $ base58put a
-    | otherwise = cashAddrEncode 1 (S.encode h)
-addrToString WitnessPubKeyAddress {getAddrHash = h} = do
-    hrp <- bech32Prefix
+    | otherwise = cashAddrEncode net 1 (S.encode h)
+addrToString WitnessPubKeyAddress {getAddrHash = h, getAddrNet = net} = do
+    hrp <- (getBech32Prefix net)
     segwitEncode hrp 0 (B.unpack (S.encode h))
-addrToString WitnessScriptAddress {getScriptHash = h} = do
-    hrp <- bech32Prefix
+addrToString WitnessScriptAddress {getScriptHash = h, getAddrNet = net} = do
+    hrp <- (getBech32Prefix net)
     segwitEncode hrp 0 (B.unpack (S.encode h))
 
 -- | Decodes an Address from an encoded String. This function can fail
 -- if the String is not properly encoded or its checksum fails.
-stringToAddr :: ByteString -> Maybe Address
-stringToAddr bs = b58 <|> cash <|> segwit
+stringToAddr :: Network -> ByteString -> Maybe Address
+stringToAddr net bs = cash <|> segwit <|> b58
   where
-    b58 = eitherToMaybe . runGet base58get =<< decodeBase58Check bs
-    cash = cashAddrDecode bs >>= \(ver, bs') -> case ver of
+    b58 = eitherToMaybe . runGet (base58get net) =<< decodeBase58Check bs
+    cash = cashAddrDecode net bs >>= \(ver, bs') -> case ver of
         0 -> do
             h <- eitherToMaybe (S.decode bs')
-            return $ PubKeyAddress h
+            return $ PubKeyAddress h net
         1 -> do
             h <- eitherToMaybe (S.decode bs')
-            return $ ScriptAddress h
+            return $ ScriptAddress h net
     segwit = do
-        hrp <- bech32Prefix
+        hrp <- getBech32Prefix net
         (ver, bs') <- segwitDecode hrp bs
         guard (ver == 0)
         let bs'' = B.pack bs'
         case B.length bs'' of
             20 -> do
                 h <- eitherToMaybe (S.decode bs'')
-                return $ WitnessPubKeyAddress h
+                return $ WitnessPubKeyAddress h net
             32 -> do
                 h <- eitherToMaybe (S.decode bs'')
-                return $ WitnessScriptAddress h
+                return $ WitnessScriptAddress h net
             _ -> Nothing

src/Network/Haskoin/Crypto/Bech32.hs

@@ -1,14 +1,7 @@
 {- Copied from reference implementation contributed by Marko Bencun -}
 module Network.Haskoin.Crypto.Bech32
-    ( bech32Encode
-    , bech32Decode
-    , toBase32
-    , toBase256
-    , segwitEncode
+    ( segwitEncode
     , segwitDecode
-    , Word5()
-    , word5
-    , fromWord5
     ) where
 
 import           Control.Monad         (guard)

src/Network/Haskoin/Crypto/CashAddr.hs

@@ -36,9 +36,9 @@ charset = "qpzry9x8gf2tvdw0s3jn54khce6mua7l"
 base32char :: Char -> Maybe Word8
 base32char = fmap fromIntegral . (`elemIndex` charset)
 
-cashAddrDecode :: CashAddr -> Maybe (CashVersion, ByteString)
-cashAddrDecode ca' = do
-    epfx <- cashAddrPrefix
+cashAddrDecode :: Network -> CashAddr -> Maybe (CashVersion, ByteString)
+cashAddrDecode net ca' = do
+    epfx <- getCashAddrPrefix net
     guard (B.length ca <= 90)
     guard (C.map toUpper ca' == ca' || ca == ca')
     let (cpfx', cdat) = C.breakEnd (== ':') ca
@@ -55,9 +55,9 @@ cashAddrDecode ca' = do
   where
     ca = C.map toLower ca'
 
-cashAddrEncode :: CashVersion -> ByteString -> Maybe CashAddr
-cashAddrEncode cv bs = do
-    pfx <- cashAddrPrefix
+cashAddrEncode :: Network -> CashVersion -> ByteString -> Maybe CashAddr
+cashAddrEncode net cv bs = do
+    pfx <- getCashAddrPrefix net
     ver <- encodeCashVersion cv
     len <- encodeCashLength (B.length bs)
     let vb = ver .|. len

src/Network/Haskoin/Crypto/ECDSA.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 -- | ECDSA Signatures
 module Network.Haskoin.Crypto.ECDSA
 ( SecretT
@@ -45,7 +46,7 @@ withSource :: Monad m => (Int -> m ByteString) -> SecretT m a -> m a
 withSource f m = do
     seed  <- f 32 -- Read 256 bits from the random source
     nonce <- f 16 -- Read 128 bits from the random source
-    let ws = hmacDRBGNew seed nonce haskoinUserAgent
+    let ws = hmacDRBGNew seed nonce "haskoin"
     S.evalStateT m (ws,f)
 
 -- | Generate a new random 'EC.SecKey' value from the 'SecretT' monad. This
@@ -54,7 +55,7 @@ withSource f m = do
 nextSecret :: Monad m => SecretT m EC.SecKey
 nextSecret = do
     (ws, f) <- S.get
-    let (ws', randM) = hmacDRBGGen ws 32 haskoinUserAgent
+    let (ws', randM) = hmacDRBGGen ws 32 "haskoin"
     case randM of
         (Just rand) -> do
             S.put (ws', f)
@@ -63,7 +64,7 @@ nextSecret = do
                 Nothing  -> nextSecret
         Nothing -> do
             seed <- lift $ f 32 -- Read 256 bits to re-seed the PRNG
-            let ws0 = hmacDRBGRsd ws' seed haskoinUserAgent
+            let ws0 = hmacDRBGRsd ws' seed "haskoin"
             S.put (ws0, f)
             nextSecret
 

src/Network/Haskoin/Crypto/ExtendedKeys.hs

@@ -26,6 +26,12 @@ module Network.Haskoin.Crypto.ExtendedKeys
 , xPubImport
 , xPrvImport
 , xPrvWif
+, putXPrvKey
+, putXPubKey
+, getXPrvKey
+, getXPubKey
+, xPubFromJSON
+, xPrvFromJSON
 
   -- Helpers
 , prvSubKeys
@@ -79,6 +85,7 @@ import           Data.Aeson                      as A (FromJSON, ToJSON,
                                                        Value (String),
                                                        parseJSON, toJSON,
                                                        withText)
+import           Data.Aeson.Types                (Parser)
 import           Data.Bits                       (clearBit, setBit, testBit)
 import           Data.ByteString                 (ByteString)
 import qualified Data.ByteString                 as BS
@@ -89,9 +96,10 @@ import           Data.Maybe                      (fromMaybe)
 import           Data.Monoid                     ((<>))
 import           Data.Serialize                  as S (Serialize, decode,
                                                        encode, get, put)
-import           Data.Serialize.Get              (Get, getWord32be, getWord8)
-import           Data.Serialize.Put              (Put, putWord32be, putWord8,
-                                                  runPut)
+import           Data.Serialize.Get              (Get, getWord32be, getWord8,
+                                                  runGet)
+import           Data.Serialize.Put              (Put, Putter, putWord32be,
+                                                  putWord8, runPut)
 import           Data.String                     (IsString, fromString)
 import           Data.String.Conversions         (cs)
 import           Data.Typeable                   (Typeable)
@@ -122,50 +130,36 @@ type KeyIndex = Word32
 -- is a node in a tree of key derivations. It has a depth in the tree, a
 -- parent node and an index to differentiate it from other siblings.
 data XPrvKey = XPrvKey
-    { xPrvDepth  :: !Word8     -- ^ Depth in the tree of key derivations.
-    , xPrvParent :: !Word32    -- ^ Fingerprint of the parent key.
-    , xPrvIndex  :: !KeyIndex  -- ^ Key derivation index.
+    { xPrvDepth  :: !Word8 -- ^ Depth in the tree of key derivations.
+    , xPrvParent :: !Word32 -- ^ Fingerprint of the parent key.
+    , xPrvIndex  :: !KeyIndex -- ^ Key derivation index.
     , xPrvChain  :: !ChainCode -- ^ Chain code.
-    , xPrvKey    :: !PrvKeyC   -- ^ The private key of this extended key node.
+    , xPrvKey    :: !PrvKeyC -- ^ The private key of this extended key node.
+    , xPrvNet    :: !Network
     } deriving (Eq)
 
 instance Ord XPrvKey where
     compare k1 k2 = xPrvExport k1 `compare` xPrvExport k2
 
 instance Show XPrvKey where
-    showsPrec d k = showParen (d > 10) $
-        showString "XPrvKey " . shows (xPrvExport k)
-
-instance Read XPrvKey where
-    readPrec =
-        parens $ do
-            R.Ident "XPrvKey" <- lexP
-            R.String str <- lexP
-            maybe pfail return $ xPrvImport $ cs str
-
-instance IsString XPrvKey where
-    fromString =
-        fromMaybe e . xPrvImport . cs
-      where
-        e = error "Could not decode extended private key"
+    showsPrec d k = shows (xPrvExport k)
 
 instance NFData XPrvKey where
-    rnf (XPrvKey d p i c k) =
-        rnf d `seq` rnf p `seq` rnf i `seq` rnf c `seq` rnf k
+    rnf (XPrvKey d p i c k n) =
+        rnf d `seq`
+        rnf p `seq` rnf i `seq` rnf c `seq` rnf k `seq` rnf n `seq` ()
 
 instance ToJSON XPrvKey where
     toJSON = A.String . cs . xPrvExport
 
-instance FromJSON XPrvKey where
-    parseJSON = withText "xprvkey" $ maybe mzero return . xPrvImport . cs
-
 -- | Data type representing an extended BIP32 public key.
 data XPubKey = XPubKey
-    { xPubDepth  :: !Word8     -- ^ Depth in the tree of key derivations.
-    , xPubParent :: !Word32    -- ^ Fingerprint of the parent key.
-    , xPubIndex  :: !KeyIndex  -- ^ Key derivation index.
+    { xPubDepth  :: !Word8 -- ^ Depth in the tree of key derivations.
+    , xPubParent :: !Word32 -- ^ Fingerprint of the parent key.
+    , xPubIndex  :: !KeyIndex -- ^ Key derivation index.
     , xPubChain  :: !ChainCode -- ^ Chain code.
-    , xPubKey    :: !PubKeyC   -- ^ The public key of this extended key node.
+    , xPubKey    :: !PubKeyC -- ^ The public key of this extended key node.
+    , xPubNet    :: !Network
     } deriving (Eq)
 
 instance Ord XPubKey where
@@ -175,33 +169,33 @@ instance Show XPubKey where
     showsPrec d k = showParen (d > 10) $
         showString "XPubKey " . shows (xPubExport k)
 
-instance Read XPubKey where
-    readPrec = parens $ do
-        R.Ident "XPubKey" <- lexP
-        R.String str <- lexP
-        maybe pfail return $ xPubImport $ cs str
-
-instance IsString XPubKey where
-    fromString =
-        fromMaybe e . xPubImport . cs
-      where
-        e = error "Could not import extended public key"
-
 instance NFData XPubKey where
-    rnf (XPubKey d p i c k) =
-        rnf d `seq` rnf p `seq` rnf i `seq` rnf c `seq` rnf k
+    rnf (XPubKey d p i c k n) =
+        rnf d `seq`
+        rnf p `seq` rnf i `seq` rnf c `seq` rnf k `seq` rnf n `seq` ()
 
 instance ToJSON XPubKey where
     toJSON = A.String . cs . xPubExport
 
-instance FromJSON XPubKey where
-    parseJSON = withText "xpubkey" $ maybe mzero return . xPubImport . cs
+xPubFromJSON :: Network -> Value -> Parser XPubKey
+xPubFromJSON net =
+    withText "xpub" $ \t ->
+        case xPubImport net (cs t) of
+            Nothing -> fail "could not read xpub"
+            Just x  -> return x
+
+xPrvFromJSON :: Network -> Value -> Parser XPrvKey
+xPrvFromJSON net =
+    withText "xprv" $ \t ->
+        case xPrvImport net (cs t) of
+            Nothing -> fail "could not read xprv"
+            Just x  -> return x
 
 -- | Build a BIP32 compatible extended private key from a bytestring. This will
 -- produce a root node (depth=0 and parent=0).
-makeXPrvKey :: ByteString -> XPrvKey
-makeXPrvKey bs =
-    XPrvKey 0 0 0 c k
+makeXPrvKey :: Network -> ByteString -> XPrvKey
+makeXPrvKey net bs =
+    XPrvKey 0 0 0 c k net
   where
     (p, c) = split512 $ hmac512 "Bitcoin seed" bs
     k     = maybe err makePrvKeyC (EC.secKey (encode p))
@@ -211,7 +205,7 @@ makeXPrvKey bs =
 -- will preserve the depth, parent, index and chaincode fields of the extended
 -- private keys.
 deriveXPubKey :: XPrvKey -> XPubKey
-deriveXPubKey (XPrvKey d p i c k) = XPubKey d p i c (derivePubKey k)
+deriveXPubKey (XPrvKey d p i c k n) = XPubKey d p i c (derivePubKey k) n
 
 -- | Compute a private, soft child key derivation. A private soft derivation
 -- will allow the equivalent extended public key to derive the public key for
@@ -227,14 +221,14 @@ prvSubKey :: XPrvKey  -- ^ Extended parent private key
           -> XPrvKey  -- ^ Extended child private key
 prvSubKey xkey child
     | child >= 0 && child < 0x80000000 =
-        XPrvKey (xPrvDepth xkey + 1) (xPrvFP xkey) child c k
+        XPrvKey (xPrvDepth xkey + 1) (xPrvFP xkey) child c k (xPrvNet xkey)
     | otherwise = error "Invalid child derivation index"
   where
-    pK     = xPubKey $ deriveXPubKey xkey
-    msg    = BS.append (encode pK) (encode child)
+    pK = xPubKey $ deriveXPubKey xkey
+    msg = BS.append (encode pK) (encode child)
     (a, c) = split512 $ hmac512 (encode $ xPrvChain xkey) msg
-    k      = fromMaybe err $ tweakPrvKeyC (xPrvKey xkey) a
-    err    = throw $ DerivationException "Invalid prvSubKey derivation"
+    k = fromMaybe err $ tweakPrvKeyC (xPrvKey xkey) a
+    err = throw $ DerivationException "Invalid prvSubKey derivation"
 
 -- | Compute a public, soft child key derivation. Given a parent key /M/
 -- and a derivation index /i/, this function will compute M\/i\/.
@@ -243,7 +237,7 @@ pubSubKey :: XPubKey  -- ^ Extended Parent public key
           -> XPubKey  -- ^ Extended child public key
 pubSubKey xKey child
     | child >= 0 && child < 0x80000000 =
-        XPubKey (xPubDepth xKey + 1) (xPubFP xKey) child c pK
+        XPubKey (xPubDepth xKey + 1) (xPubFP xKey) child c pK (xPubNet xKey)
     | otherwise = error "Invalid child derivation index"
   where
     msg    = BS.append (encode $ xPubKey xKey) (encode child)
@@ -262,7 +256,7 @@ hardSubKey :: XPrvKey  -- ^ Extended Parent private key
            -> XPrvKey  -- ^ Extended child private key
 hardSubKey xkey child
     | child >= 0 && child < 0x80000000 =
-        XPrvKey (xPrvDepth xkey + 1) (xPrvFP xkey) i c k
+        XPrvKey (xPrvDepth xkey + 1) (xPrvFP xkey) i c k (xPrvNet xkey)
     | otherwise = error "Invalid child derivation index"
   where
     i      = setBit child 31
@@ -315,69 +309,71 @@ xPubFP =
 
 -- | Computer the 'Address' of an extended public key.
 xPubAddr :: XPubKey -> Address
-xPubAddr = pubKeyAddr . xPubKey
+xPubAddr xkey = pubKeyAddr (xPubNet xkey) (xPubKey xkey)
 
 -- | Exports an extended private key to the BIP32 key export format (base 58).
 xPrvExport :: XPrvKey -> ByteString
-xPrvExport = encodeBase58Check . encode
+xPrvExport = encodeBase58Check . runPut . putXPrvKey
 
 -- | Exports an extended public key to the BIP32 key export format (base 58).
 xPubExport :: XPubKey -> ByteString
-xPubExport = encodeBase58Check . encode
+xPubExport = encodeBase58Check . runPut . putXPubKey
 
 -- | Decodes a BIP32 encoded extended private key. This function will fail if
 -- invalid base 58 characters are detected or if the checksum fails.
-xPrvImport :: ByteString -> Maybe XPrvKey
-xPrvImport = eitherToMaybe . decode <=< decodeBase58Check
+xPrvImport :: Network -> ByteString -> Maybe XPrvKey
+xPrvImport net = eitherToMaybe . runGet (getXPrvKey net) <=< decodeBase58Check
 
 -- | Decodes a BIP32 encoded extended public key. This function will fail if
 -- invalid base 58 characters are detected or if the checksum fails.
-xPubImport :: ByteString -> Maybe XPubKey
-xPubImport = eitherToMaybe . decode <=< decodeBase58Check
+xPubImport :: Network -> ByteString -> Maybe XPubKey
+xPubImport net = eitherToMaybe . runGet (getXPubKey net) <=< decodeBase58Check
 
 -- | Export an extended private key to WIF (Wallet Import Format).
 xPrvWif :: XPrvKey -> ByteString
-xPrvWif = toWif . xPrvKey
+xPrvWif xkey = toWif (xPrvNet xkey) (xPrvKey xkey)
 
-instance Serialize XPrvKey where
-
-    get = do
+getXPrvKey :: Network -> Get XPrvKey
+getXPrvKey net = do
         ver <- getWord32be
-        unless (ver == extSecretPrefix) $ fail
+        unless (ver == getExtSecretPrefix net) $ fail
             "Get: Invalid version for extended private key"
         XPrvKey <$> getWord8
                 <*> getWord32be
                 <*> getWord32be
                 <*> S.get
                 <*> getPadPrvKey
+                <*> pure net
 
-    put k = do
-        putWord32be  extSecretPrefix
+putXPrvKey :: Putter XPrvKey
+putXPrvKey k = do
+        putWord32be  $ getExtSecretPrefix (xPrvNet k)
         putWord8     $ xPrvDepth k
         putWord32be  $ xPrvParent k
         putWord32be  $ xPrvIndex k
         put          $ xPrvChain k
         putPadPrvKey $ xPrvKey k
 
-instance Serialize XPubKey where
-
-    get = do
+getXPubKey :: Network -> Get XPubKey
+getXPubKey net = do
         ver <- getWord32be
-        unless (ver == extPubKeyPrefix) $ fail
+        unless (ver == getExtPubKeyPrefix net) $ fail
             "Get: Invalid version for extended public key"
         XPubKey <$> getWord8
                 <*> getWord32be
                 <*> getWord32be
                 <*> S.get
                 <*> S.get
+                <*> pure net
 
-    put k = do
-        putWord32be extPubKeyPrefix
+putXPubKey :: Putter XPubKey
+putXPubKey k = do
+        putWord32be $ getExtPubKeyPrefix (xPubNet k)
         putWord8    $ xPubDepth k
         putWord32be $ xPubParent k
         putWord32be $ xPubIndex k
         put         $ xPubChain k
-        put $ xPubKey k
+        put         $ xPubKey k
 
 {- Derivation helpers -}
 
@@ -415,22 +411,24 @@ deriveAddrs k =
 -- | Derive a multisig address from a list of public keys, the number of
 -- required signatures (m) and a derivation index. The derivation type is a
 -- public, soft derivation.
-deriveMSAddr :: [XPubKey] -> Int -> KeyIndex -> (Address, RedeemScript)
-deriveMSAddr keys m i =
-    (p2shAddr rdm, rdm)
+deriveMSAddr :: Network -> [XPubKey] -> Int -> KeyIndex -> (Address, RedeemScript)
+deriveMSAddr net keys m i
+    | all ((== net) . xPubNet) keys = (p2shAddr net rdm, rdm)
+    | otherwise = error "Some extended public keys on the wrong network"
   where
     rdm = sortMulSig $ PayMulSig k m
-    k   = map (toPubKeyG . xPubKey . flip pubSubKey i) keys
+    k = map (toPubKeyG . xPubKey . flip pubSubKey i) keys
 
 -- | Cyclic list of all multisig addresses derived from a list of public keys,
 -- a number of required signatures (m) and starting from an offset index. The
 -- derivation type is a public, soft derivation.
-deriveMSAddrs :: [XPubKey] -> Int -> KeyIndex
+deriveMSAddrs :: Network -> [XPubKey] -> Int -> KeyIndex
               -> [(Address, RedeemScript, KeyIndex)]
-deriveMSAddrs keys m =
-    map f . cycleIndex
+deriveMSAddrs net keys m = map f . cycleIndex
   where
-    f i = let (a, rdm) = deriveMSAddr keys m i in (a, rdm, i)
+    f i =
+        let (a, rdm) = deriveMSAddr net keys m i
+         in (a, rdm, i)
 
 cycleIndex :: KeyIndex -> [KeyIndex]
 cycleIndex i
@@ -656,8 +654,8 @@ instance Show ParsedPath where
       where
         f =
             case p of
-                ParsedPrv d' -> "m" <> pathToStr d'
-                ParsedPub d' -> "M" <> pathToStr d'
+                ParsedPrv d'   -> "m" <> pathToStr d'
+                ParsedPub d'   -> "M" <> pathToStr d'
                 ParsedEmpty d' -> pathToStr d'
 
 instance Read ParsedPath where
@@ -729,8 +727,11 @@ parseHard = toHard . getParsedPath <=< parsePath
 parseSoft :: String -> Maybe SoftPath
 parseSoft = toSoft . getParsedPath <=< parsePath
 
-data XKey = XPrv { getXPrvKey :: !XPrvKey }
-          | XPub { getXPubKey :: !XPubKey }
+data XKey
+    = XPrv { getXKeyPrv :: !XPrvKey
+           , getXKeyNet :: !Network }
+    | XPub { getXKeyPub :: !XPubKey
+           , getXKeyNet :: !Network }
     deriving (Eq, Show)
 
 -- | Apply a parsed path to an extended key to derive the new key defined in the
@@ -739,27 +740,30 @@ data XKey = XPrv { getXPrvKey :: !XPrvKey }
 -- public key, and public derivations with a hard segment, return an error
 -- value.
 applyPath :: ParsedPath -> XKey -> Either String XKey
-applyPath path key = case (path, key) of
-    (ParsedPrv _, XPrv k)   -> return $ XPrv $ derivPrvF k
-    (ParsedPrv _, XPub _)   -> Left "applyPath: Invalid public key"
-    (ParsedPub _, XPrv k)   -> return $ XPub $ deriveXPubKey $ derivPrvF k
-    (ParsedPub _, XPub k)   -> derivPubFE >>= \f -> return $ XPub $ f k
+applyPath path key =
+    case (path, key) of
+        (ParsedPrv _, XPrv k n) -> return $ XPrv (derivPrvF k) n
+        (ParsedPrv _, XPub {}) -> Left "applyPath: Invalid public key"
+        (ParsedPub _, XPrv k n) -> return $ XPub (deriveXPubKey (derivPrvF k)) n
+        (ParsedPub _, XPub k n) -> derivPubFE >>= \f -> return $ XPub (f k) n
     -- For empty parsed paths, we take a hint from the provided key
-    (ParsedEmpty _, XPrv k) -> return $ XPrv $ derivPrvF k
-    (ParsedEmpty _, XPub k) -> derivPubFE >>= \f -> return $ XPub $ f k
+        (ParsedEmpty _, XPrv k n) -> return $ XPrv (derivPrvF k) n
+        (ParsedEmpty _, XPub k n) -> derivPubFE >>= \f -> return $ XPub (f k) n
   where
-    derivPrvF  = goPrv id $ getParsedPath path
+    derivPrvF = goPrv id $ getParsedPath path
     derivPubFE = goPubE id $ getParsedPath path
     -- Build the full private derivation function starting from the end
-    goPrv f p = case p of
-        next :| i -> goPrv (f . flip hardSubKey i) next
-        next :/ i -> goPrv (f . flip prvSubKey i) next
-        Deriv     -> f
+    goPrv f p =
+        case p of
+            next :| i -> goPrv (f . flip hardSubKey i) next
+            next :/ i -> goPrv (f . flip prvSubKey i) next
+            Deriv     -> f
     -- Build the full public derivation function starting from the end
-    goPubE f p = case p of
-        next :/ i -> goPubE (f . flip pubSubKey i) next
-        Deriv     -> Right f
-        _         -> Left "applyPath: Invalid hard derivation"
+    goPubE f p =
+        case p of
+            next :/ i -> goPubE (f . flip pubSubKey i) next
+            Deriv     -> Right f
+            _         -> Left "applyPath: Invalid hard derivation"
 
 {- Helpers for derivation paths and addresses -}
 
@@ -769,22 +773,34 @@ derivePathAddr key path = deriveAddr (derivePubPath path key)
 
 -- | Cyclic list of all addresses derived from a given parent path and starting
 -- from the given offset index.
-derivePathAddrs :: XPubKey -> SoftPath -> KeyIndex
-                -> [(Address, PubKeyC, KeyIndex)]
+derivePathAddrs ::
+       XPubKey -> SoftPath -> KeyIndex -> [(Address, PubKeyC, KeyIndex)]
 derivePathAddrs key path = deriveAddrs (derivePubPath path key)
 
 -- | Derive a multisig address from a given parent path. The number of required
 -- signatures (m in m of n) is also needed.
-derivePathMSAddr :: [XPubKey] -> SoftPath -> Int -> KeyIndex
-                 -> (Address, RedeemScript)
-derivePathMSAddr keys path = deriveMSAddr $ map (derivePubPath path) keys
+derivePathMSAddr ::
+       Network
+    -> [XPubKey]
+    -> SoftPath
+    -> Int
+    -> KeyIndex
+    -> (Address, RedeemScript)
+derivePathMSAddr net keys path =
+    deriveMSAddr net $ map (derivePubPath path) keys
 
 -- | Cyclic list of all multisig addresses derived from a given parent path and
 -- starting from the given offset index. The number of required signatures
 -- (m in m of n) is also needed.
-derivePathMSAddrs :: [XPubKey] -> SoftPath -> Int -> KeyIndex
-                  -> [(Address, RedeemScript, KeyIndex)]
-derivePathMSAddrs keys path = deriveMSAddrs $ map (derivePubPath path) keys
+derivePathMSAddrs ::
+       Network
+    -> [XPubKey]
+    -> SoftPath
+    -> Int
+    -> KeyIndex
+    -> [(Address, RedeemScript, KeyIndex)]
+derivePathMSAddrs net keys path =
+    deriveMSAddrs net $ map (derivePubPath path) keys
 
 {- Utilities for extended keys -}
 

src/Network/Haskoin/Crypto/Keys.hs

@@ -221,8 +221,8 @@ instance Serialize PubKeyU where
     put pk = putByteString $ EC.exportPubKey False $ pubKeyPoint pk
 
 -- | Computes an 'Address' from a public key
-pubKeyAddr :: Serialize (PubKeyI c) => PubKeyI c -> Address
-pubKeyAddr = PubKeyAddress . addressHash . encode
+pubKeyAddr :: Serialize (PubKeyI c) => Network -> PubKeyI c -> Address
+pubKeyAddr net k = PubKeyAddress (addressHash (encode k)) net
 
 -- | Tweak a compressed public key
 tweakPubKeyC :: PubKeyC -> Hash256 -> Maybe PubKeyC
@@ -243,70 +243,10 @@ tweakPubKeyC pub h =
 data PrvKeyI c = PrvKeyI
     { prvKeySecKey     :: !EC.SecKey
     , prvKeyCompressed :: !Bool
-    } deriving (Eq)
+    } deriving (Eq, Show, Read)
 
 instance NFData (PrvKeyI c) where
-    rnf (PrvKeyI s b) = s `seq` b `seq` ()
-
-instance Show PrvKey where
-    showsPrec d k = showParen (d > 10) $
-        showString "PrvKey " . shows (toWif k)
-
-instance Show PrvKeyC where
-    showsPrec d k = showParen (d > 10) $
-        showString "PrvKeyC " . shows (toWif k)
-
-instance Show PrvKeyU where
-    showsPrec d k = showParen (d > 10) $
-        showString "PrvKeyU " . shows (toWif k)
-
-instance Read PrvKey where
-    readPrec = parens $ do
-        Read.Ident "PrvKey" <- lexP
-        Read.String str <- lexP
-        maybe pfail return $ fromWif $ cs str
-
-instance Read PrvKeyC where
-    readPrec = parens $ do
-        Read.Ident "PrvKeyC" <- lexP
-        Read.String str <- lexP
-        key <- maybe pfail return $ fromWif $ cs str
-        case eitherPrvKey key of
-            Left _  -> pfail
-            Right k -> return k
-
-instance Read PrvKeyU where
-    readPrec = parens $ do
-        Read.Ident "PrvKeyU" <- lexP
-        Read.String str <- lexP
-        key <- maybe pfail return $ fromWif $ cs str
-        case eitherPrvKey key of
-            Left k  -> return k
-            Right _ -> pfail
-
-instance IsString PrvKey where
-    fromString str =
-        fromMaybe e $ fromWif $ cs str
-      where
-        e = error "Could not decode WIF"
-
-instance IsString PrvKeyC where
-    fromString str =
-        case eitherPrvKey key of
-            Left _  -> undefined
-            Right k -> k
-      where
-        key = fromMaybe e $ fromWif $ cs str
-        e = error "Could not decode WIF"
-
-instance IsString PrvKeyU where
-    fromString str =
-        case eitherPrvKey key of
-            Left k  -> k
-            Right _ -> undefined
-      where
-        key = fromMaybe e $ fromWif $ cs str
-        e = error "Could not decode WIF"
+    rnf (PrvKeyI k c) = k `seq` c `seq` ()
 
 type PrvKey = PrvKeyI Generic
 type PrvKeyC = PrvKeyI Compressed
@@ -367,11 +307,11 @@ prvKeyPutMonad (PrvKeyI k _) = putByteString $ EC.getSecKey k
 -- fail if the input string does not decode correctly as a base 58 string or if
 -- the checksum fails.
 -- <http://en.bitcoin.it/wiki/Wallet_import_format>
-fromWif :: ByteString -> Maybe PrvKey
-fromWif wif = do
+fromWif :: Network -> ByteString -> Maybe PrvKey
+fromWif net wif = do
     bs <- decodeBase58Check wif
     -- Check that this is a private key
-    guard (BS.head bs == secretPrefix)
+    guard (BS.head bs == getSecretPrefix net)
     case BS.length bs of
         -- Uncompressed format
         33 -> makePrvKeyG False <$> EC.secKey (BS.tail bs)
@@ -383,10 +323,9 @@ fromWif wif = do
         _  -> Nothing
 
 -- | Encodes a private key into WIF format
-toWif :: PrvKeyI c -> ByteString
-toWif (PrvKeyI k c) =
-    encodeBase58Check $
-    BS.cons secretPrefix $
+toWif :: Network -> PrvKeyI c -> ByteString
+toWif net (PrvKeyI k c) =
+    encodeBase58Check . BS.cons (getSecretPrefix net) $
     if c
         then EC.getSecKey k `BS.snoc` 0x01
         else EC.getSecKey k

src/Network/Haskoin/Network/Message.hs

@@ -2,17 +2,19 @@ module Network.Haskoin.Network.Message
 ( Message(..)
 , MessageHeader(..)
 , msgType
+, putMessage
+, getMessage
 ) where
 
 import           Control.DeepSeq                   (NFData, rnf)
 import           Control.Monad                     (unless)
 import qualified Data.ByteString                   as BS
 import           Data.Serialize                    (Serialize, encode, get, put)
-import           Data.Serialize.Get                (getByteString, getWord32be,
-                                                    getWord32le, isolate,
-                                                    lookAhead)
-import           Data.Serialize.Put                (putByteString, putWord32be,
-                                                    putWord32le)
+import           Data.Serialize.Get                (Get, getByteString,
+                                                    getWord32be, getWord32le,
+                                                    isolate, lookAhead)
+import           Data.Serialize.Put                (Putter, putByteString,
+                                                    putWord32be, putWord32le)
 import           Data.Word                         (Word32)
 import           Network.Haskoin.Block.Merkle
 import           Network.Haskoin.Block.Types
@@ -109,68 +111,73 @@ msgType MMempool         = "mempool"
 msgType (MReject _)      = "reject"
 msgType MSendHeaders     = "sendheaders"
 
-instance Serialize Message where
-    get = do
-        (MessageHeader mgc cmd len chk) <- get
-        bs <- lookAhead $ getByteString $ fromIntegral len
-        unless (mgc == networkMagic)
-            (fail $ "get: Invalid network magic bytes: " ++ show mgc)
-        unless (checkSum32 bs == chk)
-            (fail $ "get: Invalid message checksum: " ++ show chk)
-        if len > 0
-            then isolate (fromIntegral len) $ case cmd of
-                MCVersion     -> MVersion <$> get
-                MCAddr        -> MAddr <$> get
-                MCInv         -> MInv <$> get
-                MCGetData     -> MGetData <$> get
-                MCNotFound    -> MNotFound <$> get
-                MCGetBlocks   -> MGetBlocks <$> get
-                MCGetHeaders  -> MGetHeaders <$> get
-                MCTx          -> MTx <$> get
-                MCBlock       -> MBlock <$> get
-                MCMerkleBlock -> MMerkleBlock <$> get
-                MCHeaders     -> MHeaders <$> get
-                MCFilterLoad  -> MFilterLoad <$> get
-                MCFilterAdd   -> MFilterAdd <$> get
-                MCPing        -> MPing <$> get
-                MCPong        -> MPong <$> get
-                MCAlert       -> MAlert <$> get
-                MCReject      -> MReject <$> get
-                _             -> fail $ "get: Invalid command " ++ show cmd
-            else case cmd of
-                MCGetAddr     -> return MGetAddr
-                MCVerAck      -> return MVerAck
-                MCFilterClear -> return MFilterClear
-                MCMempool     -> return MMempool
-                MCSendHeaders -> return MSendHeaders
-                _             -> fail $ "get: Invalid command " ++ show cmd
-    put msg = do
-        let (cmd, payload) = case msg of
-                MVersion m     -> (MCVersion, encode m)
-                MVerAck        -> (MCVerAck, BS.empty)
-                MAddr m        -> (MCAddr, encode m)
-                MInv m         -> (MCInv, encode m)
-                MGetData m     -> (MCGetData, encode m)
-                MNotFound m    -> (MCNotFound, encode m)
-                MGetBlocks m   -> (MCGetBlocks, encode m)
-                MGetHeaders m  -> (MCGetHeaders, encode m)
-                MTx m          -> (MCTx, encode m)
-                MBlock m       -> (MCBlock, encode m)
-                MMerkleBlock m -> (MCMerkleBlock, encode m)
-                MHeaders m     -> (MCHeaders, encode m)
-                MGetAddr       -> (MCGetAddr, BS.empty)
-                MFilterLoad m  -> (MCFilterLoad, encode m)
-                MFilterAdd m   -> (MCFilterAdd, encode m)
-                MFilterClear   -> (MCFilterClear, BS.empty)
-                MPing m        -> (MCPing, encode m)
-                MPong m        -> (MCPong, encode m)
-                MAlert m       -> (MCAlert, encode m)
-                MMempool       -> (MCMempool, BS.empty)
-                MReject m      -> (MCReject, encode m)
-                MSendHeaders   -> (MCSendHeaders, BS.empty)
-            chk = checkSum32 payload
-            len = fromIntegral $ BS.length payload
-            header = MessageHeader networkMagic cmd len chk
-        put header
-        putByteString payload
+getMessage :: Network -> Get Message
+getMessage net = do
+    (MessageHeader mgc cmd len chk) <- get
+    bs <- lookAhead $ getByteString $ fromIntegral len
+    unless
+        (mgc == getNetworkMagic net)
+        (fail $ "get: Invalid network magic bytes: " ++ show mgc)
+    unless
+        (checkSum32 bs == chk)
+        (fail $ "get: Invalid message checksum: " ++ show chk)
+    if len > 0
+        then isolate (fromIntegral len) $
+             case cmd of
+                 MCVersion     -> MVersion <$> get
+                 MCAddr        -> MAddr <$> get
+                 MCInv         -> MInv <$> get
+                 MCGetData     -> MGetData <$> get
+                 MCNotFound    -> MNotFound <$> get
+                 MCGetBlocks   -> MGetBlocks <$> get
+                 MCGetHeaders  -> MGetHeaders <$> get
+                 MCTx          -> MTx <$> get
+                 MCBlock       -> MBlock <$> get
+                 MCMerkleBlock -> MMerkleBlock <$> get
+                 MCHeaders     -> MHeaders <$> get
+                 MCFilterLoad  -> MFilterLoad <$> get
+                 MCFilterAdd   -> MFilterAdd <$> get
+                 MCPing        -> MPing <$> get
+                 MCPong        -> MPong <$> get
+                 MCAlert       -> MAlert <$> get
+                 MCReject      -> MReject <$> get
+                 _             -> fail $ "get: Invalid command " ++ show cmd
+        else case cmd of
+                 MCGetAddr     -> return MGetAddr
+                 MCVerAck      -> return MVerAck
+                 MCFilterClear -> return MFilterClear
+                 MCMempool     -> return MMempool
+                 MCSendHeaders -> return MSendHeaders
+                 _             -> fail $ "get: Invalid command " ++ show cmd
 
+putMessage :: Network -> Putter Message
+putMessage net msg = do
+    let (cmd, payload) =
+            case msg of
+                MVersion m -> (MCVersion, encode m)
+                MVerAck -> (MCVerAck, BS.empty)
+                MAddr m -> (MCAddr, encode m)
+                MInv m -> (MCInv, encode m)
+                MGetData m -> (MCGetData, encode m)
+                MNotFound m -> (MCNotFound, encode m)
+                MGetBlocks m -> (MCGetBlocks, encode m)
+                MGetHeaders m -> (MCGetHeaders, encode m)
+                MTx m -> (MCTx, encode m)
+                MBlock m -> (MCBlock, encode m)
+                MMerkleBlock m -> (MCMerkleBlock, encode m)
+                MHeaders m -> (MCHeaders, encode m)
+                MGetAddr -> (MCGetAddr, BS.empty)
+                MFilterLoad m -> (MCFilterLoad, encode m)
+                MFilterAdd m -> (MCFilterAdd, encode m)
+                MFilterClear -> (MCFilterClear, BS.empty)
+                MPing m -> (MCPing, encode m)
+                MPong m -> (MCPong, encode m)
+                MAlert m -> (MCAlert, encode m)
+                MMempool -> (MCMempool, BS.empty)
+                MReject m -> (MCReject, encode m)
+                MSendHeaders -> (MCSendHeaders, BS.empty)
+        chk = checkSum32 payload
+        len = fromIntegral $ BS.length payload
+        header = MessageHeader (getNetworkMagic net) cmd len chk
+    put header
+    putByteString payload

src/Network/Haskoin/Script/Evaluator.hs

@@ -46,6 +46,7 @@ import           Data.Maybe                        (isJust, mapMaybe)
 import           Data.Serialize                    (decode, encode)
 import           Data.String.Conversions           (cs)
 import           Data.Word                         (Word32, Word64, Word8)
+import           Network.Haskoin.Constants
 import           Network.Haskoin.Crypto
 import           Network.Haskoin.Script.SigHash
 import           Network.Haskoin.Script.Types
@@ -786,23 +787,24 @@ runStack = stack
 
 -- | A wrapper around 'verifySig' which handles grabbing the hash type
 verifySigWithType ::
-       Tx -> Int -> Word64 -> [ScriptOp] -> TxSignature -> PubKey -> Bool
-verifySigWithType tx i val outOps txSig pubKey =
+       Network -> Tx -> Int -> Word64 -> [ScriptOp] -> TxSignature -> PubKey -> Bool
+verifySigWithType net tx i val outOps txSig pubKey =
     let outScript = Script outOps
-        h = txSigHash tx outScript val i (txSignatureSigHash txSig)
+        h = txSigHash net tx outScript val i (txSignatureSigHash txSig)
     in verifySig h (txSignature txSig) pubKey
 
 -- | Uses `evalScript` to check that the input script of a spending
 -- transaction satisfies the output script.
-verifySpend :: Tx     -- ^ The spending transaction
+verifySpend :: Network
+            -> Tx     -- ^ The spending transaction
             -> Int    -- ^ The input index
             -> Script -- ^ The output script we are spending
             -> Word64 -- ^ The value of the output script
             -> [Flag] -- ^ Evaluation flags
             -> Bool
-verifySpend tx i outscript val flags =
+verifySpend net tx i outscript val flags =
   let scriptSig = either err id . decode . scriptInput $ txIn tx !! i
-      verifyFcn = verifySigWithType tx i val
+      verifyFcn = verifySigWithType net tx i val
       err e = error $ "Could not decode scriptInput in verifySpend: " ++ e
   in evalScript scriptSig outscript verifyFcn flags
 

src/Network/Haskoin/Script/SigHash.hs

@@ -110,22 +110,24 @@ isSigHashUnknown =
 sigHashAddForkId :: SigHash -> Word32 -> SigHash
 sigHashAddForkId sh w = (fromIntegral w `shiftL` 8) .|. (sh .&. 0x000000ff)
 
-sigHashAddNetworkId :: SigHash -> SigHash
-sigHashAddNetworkId = (`sigHashAddForkId` fromMaybe 0 sigHashForkId)
+sigHashAddNetworkId :: Network -> SigHash -> SigHash
+sigHashAddNetworkId net =
+    (`sigHashAddForkId` fromMaybe 0 (getSigHashForkId net))
 
 sigHashGetForkId :: SigHash -> Word32
 sigHashGetForkId = fromIntegral . (`shiftR` 8)
 
 -- | Computes the hash that will be used for signing a transaction.
-txSigHash :: Tx      -- ^ Transaction to sign.
+txSigHash :: Network
+          -> Tx      -- ^ Transaction to sign.
           -> Script  -- ^ Output script that is being spent.
           -> Word64  -- ^ Value of the output being spent.
           -> Int     -- ^ Index of the input that is being signed.
           -> SigHash -- ^ What parts of the transaction should be signed.
           -> Hash256 -- ^ Result hash to be signed.
-txSigHash tx out v i sh
-    | hasForkIdFlag sh && isJust sigHashForkId =
-        txSigHashForkId tx out v i sh
+txSigHash net tx out v i sh
+    | hasForkIdFlag sh && isJust (getSigHashForkId net) =
+        txSigHashForkId net tx out v i sh
     | otherwise = do
         let newIn = buildInputs (txIn tx) fout i sh
         -- When SigSingle and input index > outputs, then sign integer 1
@@ -170,13 +172,14 @@ buildOutputs txos i sh
 -- | Computes the hash that will be used for signing a transaction. This
 -- function is used when the sigHashForkId flag is set.
 txSigHashForkId
-    :: Tx      -- ^ Transaction to sign.
+    :: Network
+    -> Tx      -- ^ Transaction to sign.
     -> Script  -- ^ Output script that is being spent.
     -> Word64  -- ^ Value of the output being spent.
     -> Int     -- ^ Index of the input that is being signed.
     -> SigHash -- ^ What parts of the transaction should be signed.
     -> Hash256 -- ^ Result hash to be signed.
-txSigHashForkId tx out v i sh =
+txSigHashForkId net tx out v i sh =
     doubleSHA256 . runPut $ do
         putWord32le $ txVersion tx
         put hashPrevouts
@@ -187,7 +190,7 @@ txSigHashForkId tx out v i sh =
         putWord32le $ txInSequence $ txIn tx !! i
         put hashOutputs
         putWord32le $ txLockTime tx
-        putWord32le $ fromIntegral $ sigHashAddNetworkId sh
+        putWord32le $ fromIntegral $ sigHashAddNetworkId net sh
   where
     hashPrevouts
         | not $ hasAnyoneCanPayFlag sh =
@@ -237,14 +240,14 @@ decodeTxLaxSig bs =
     TxSignature <$> decode (BS.init bs)
                 <*> return (fromIntegral $ BS.last bs)
 
-decodeTxStrictSig :: ByteString -> Either String TxSignature
-decodeTxStrictSig bs =
+decodeTxStrictSig :: Network -> ByteString -> Either String TxSignature
+decodeTxStrictSig net bs =
     case decodeStrictSig $ BS.init bs of
         Just sig -> do
             let sh = fromIntegral $ BS.last bs
             when (isSigHashUnknown sh) $
                 Left "Non-canonical signature: unknown hashtype byte"
-            when (isNothing sigHashForkId && hasForkIdFlag sh) $
+            when (isNothing (getSigHashForkId net) && hasForkIdFlag sh) $
                 Left "Non-canonical signature: invalid network for forkId"
             return $ TxSignature sig sh
         Nothing -> Left "Non-canonical signature: could not parse signature"

src/Network/Haskoin/Script/Standard.hs

@@ -48,6 +48,7 @@ import           Data.Function                  (on)
 import           Data.List                      (sortBy)
 import           Data.Serialize                 (decode, encode)
 import           Data.String.Conversions        (cs)
+import           Network.Haskoin.Constants
 import           Network.Haskoin.Crypto.Address
 import           Network.Haskoin.Crypto.Hash
 import           Network.Haskoin.Crypto.Keys
@@ -129,13 +130,13 @@ isDataCarrier _               = False
 
 -- | Computes a script address from a script output. This address can be used
 -- in a pay to script hash output.
-p2shAddr :: ScriptOutput -> Address
-p2shAddr = ScriptAddress . addressHash . encodeOutputBS
+p2shAddr :: Network -> ScriptOutput -> Address
+p2shAddr net out = ScriptAddress (addressHash (encodeOutputBS out)) net
 
 -- | Computes a script address from a script output for a
 -- pay-to-witness-script-hash output.
-p2wshAddr :: ScriptOutput -> Address
-p2wshAddr = WitnessScriptAddress . sha256 . encodeOutputBS
+p2wshAddr :: Network -> ScriptOutput -> Address
+p2wshAddr net out = WitnessScriptAddress (sha256 (encodeOutputBS out)) net
 
 -- | Sorts the public keys of a multisignature output in ascending order by
 -- comparing their serialized representations. This feature allows for easier
@@ -148,10 +149,10 @@ sortMulSig out = case out of
     _ -> error "Can only call orderMulSig on PayMulSig scripts"
 
 addressToOutput :: Address -> ScriptOutput
-addressToOutput (PubKeyAddress h)        = PayPKHash h
-addressToOutput (ScriptAddress h)        = PayScriptHash h
-addressToOutput (WitnessPubKeyAddress h) = PayWitnessPKHash h
-addressToOutput (WitnessScriptAddress h) = PayWitnessScriptHash h
+addressToOutput (PubKeyAddress h _)        = PayPKHash h
+addressToOutput (ScriptAddress h _)        = PayScriptHash h
+addressToOutput (WitnessPubKeyAddress h _) = PayWitnessPKHash h
+addressToOutput (WitnessScriptAddress h _) = PayWitnessScriptHash h
 
 -- | Get output script AST for an address.
 addressToScript :: Address -> Script
@@ -162,11 +163,11 @@ addressToScriptBS :: Address -> ByteString
 addressToScriptBS = encode . addressToScript
 
 -- | Encode an output script as an address if it has such representation.
-scriptToAddress :: Script -> Maybe Address
-scriptToAddress = eitherToMaybe . (outputAddress <=< decodeOutput)
+scriptToAddress :: Network -> Script -> Maybe Address
+scriptToAddress net = eitherToMaybe . (outputAddress net <=< decodeOutput)
 
-scriptToAddressBS :: ByteString -> Maybe Address
-scriptToAddressBS = eitherToMaybe . (outputAddress <=< decodeOutputBS)
+scriptToAddressBS :: Network -> ByteString -> Maybe Address
+scriptToAddressBS net = eitherToMaybe . (outputAddress net <=< decodeOutputBS)
 
 -- | Computes a 'Script' from a 'ScriptOutput'. The 'Script' is a list of
 -- 'ScriptOp' can can be used to build a 'Tx'.
@@ -258,20 +259,20 @@ scriptOpToInt s
     res = fromIntegral (BS.head $ encode s) - 0x50
 
 -- | Get the address of a `ScriptOutput`
-outputAddress :: ScriptOutput -> Either String Address
-outputAddress s = case s of
-    PayPKHash h            -> return $ PubKeyAddress h
-    PayScriptHash h        -> return $ ScriptAddress h
-    PayPK k                -> return $ pubKeyAddr k
-    PayWitnessPKHash h     -> return $ WitnessPubKeyAddress h
-    PayWitnessScriptHash h -> return $ WitnessScriptAddress h
+outputAddress :: Network -> ScriptOutput -> Either String Address
+outputAddress net s = case s of
+    PayPKHash h            -> return $ PubKeyAddress h net
+    PayScriptHash h        -> return $ ScriptAddress h net
+    PayPK k                -> return $ pubKeyAddr net k
+    PayWitnessPKHash h     -> return $ WitnessPubKeyAddress h net
+    PayWitnessScriptHash h -> return $ WitnessScriptAddress h net
     _                      -> Left "outputAddress: bad output script type"
 
 -- | Get the address of a `ScriptInput`
-inputAddress :: ScriptInput -> Either String Address
-inputAddress s = case s of
-    RegularInput (SpendPKHash _ key) -> return $ pubKeyAddr key
-    ScriptHashInput _ rdm -> return $ p2shAddr rdm
+inputAddress :: Network -> ScriptInput -> Either String Address
+inputAddress net s = case s of
+    RegularInput (SpendPKHash _ key) -> return $ pubKeyAddr net key
+    ScriptHashInput _ rdm -> return $ p2shAddr net rdm
     _ -> Left "inputAddress: bad input script type"
 
 -- | Data type describing standard transaction input scripts. Input scripts
@@ -338,12 +339,12 @@ encodeSimpleInput s =
     f TxSignatureEmpty = OP_0
     f ts               = opPushData $ encodeTxSig ts
 
-decodeSimpleInput :: Bool -> Script -> Either String SimpleInput
-decodeSimpleInput strict (Script ops) =
+decodeSimpleInput :: Network -> Bool -> Script -> Either String SimpleInput
+decodeSimpleInput net strict (Script ops) =
     maybeToEither errMsg $ matchPK ops <|> matchPKHash ops <|> matchMulSig ops
   where
     matchPK [op] = SpendPK <$> f op
-    matchPK _ = Nothing
+    matchPK _    = Nothing
     matchPKHash [op, OP_PUSHDATA pub _] =
         SpendPKHash <$> f op <*> eitherToMaybe (decode pub)
     matchPKHash _ = Nothing
@@ -357,7 +358,7 @@ decodeSimpleInput strict (Script ops) =
     f OP_0 = return TxSignatureEmpty
     f (OP_PUSHDATA "" OPCODE) = f OP_0
     f (OP_PUSHDATA bs _)
-        | strict = eitherToMaybe $ decodeTxStrictSig bs
+        | strict = eitherToMaybe $ decodeTxStrictSig net bs
         | otherwise = eitherToMaybe $ decodeTxLaxSig bs
     f _ = Nothing
     errMsg = "decodeInput: Could not decode script input"
@@ -374,31 +375,33 @@ encodeInputBS = encode . encodeInput
 
 -- | Decodes a 'ScriptInput' from a 'Script'. This function fails if the
 -- script can not be parsed as a standard script input.
-decodeInput :: Script -> Either String ScriptInput
-decodeInput = decodeInputGen False
+decodeInput :: Network -> Script -> Either String ScriptInput
+decodeInput net = decodeInputGen net False
 
 -- | Like 'decodeInput' but uses strict signature decoding
-decodeInputStrict :: Script -> Either String ScriptInput
-decodeInputStrict = decodeInputGen True
+decodeInputStrict :: Network -> Script -> Either String ScriptInput
+decodeInputStrict net = decodeInputGen net True
 
-decodeInputGen :: Bool -> Script -> Either String ScriptInput
-decodeInputGen strict s@(Script ops) = maybeToEither errMsg $
-    matchSimpleInput <|> matchPayScriptHash
+decodeInputGen :: Network -> Bool -> Script -> Either String ScriptInput
+decodeInputGen net strict s@(Script ops) =
+    maybeToEither errMsg $ matchSimpleInput <|> matchPayScriptHash
   where
-    matchSimpleInput = RegularInput <$> eitherToMaybe (decodeSimpleInput strict s)
-    matchPayScriptHash = case splitAt (length (scriptOps s) - 1) ops of
-        (is, [OP_PUSHDATA bs _]) -> do
-            rdm <- eitherToMaybe $ decodeOutputBS bs
-            inp <- eitherToMaybe $ decodeSimpleInput strict $ Script is
-            return $ ScriptHashInput inp rdm
-        _ -> Nothing
+    matchSimpleInput =
+        RegularInput <$> eitherToMaybe (decodeSimpleInput net strict s)
+    matchPayScriptHash =
+        case splitAt (length (scriptOps s) - 1) ops of
+            (is, [OP_PUSHDATA bs _]) -> do
+                rdm <- eitherToMaybe $ decodeOutputBS bs
+                inp <- eitherToMaybe $ decodeSimpleInput net strict $ Script is
+                return $ ScriptHashInput inp rdm
+            _ -> Nothing
     errMsg = "decodeInput: Could not decode script input"
 
 -- | Like 'decodeInput' but decodes from a ByteString
-decodeInputBS :: ByteString -> Either String ScriptInput
-decodeInputBS = decodeInput <=< decode
+decodeInputBS :: Network -> ByteString -> Either String ScriptInput
+decodeInputBS net = decodeInput net <=< decode
 
 -- | Like 'decodeInputStrict' but decodes from a ByteString
-decodeInputStrictBS :: ByteString -> Either String ScriptInput
-decodeInputStrictBS = decodeInputStrict <=< decode
+decodeInputStrictBS :: Network -> ByteString -> Either String ScriptInput
+decodeInputStrictBS net = decodeInputStrict net <=< decode
 

src/Network/Haskoin/Test/Block.hs

@@ -5,16 +5,17 @@ module Network.Haskoin.Test.Block where
 
 import           Network.Haskoin.Block.Merkle
 import           Network.Haskoin.Block.Types
+import           Network.Haskoin.Constants
 import           Network.Haskoin.Test.Crypto
 import           Network.Haskoin.Test.Network
 import           Network.Haskoin.Test.Transaction
 import           Test.QuickCheck
 
-arbitraryBlock :: Gen Block
-arbitraryBlock = do
+arbitraryBlock :: Network -> Gen Block
+arbitraryBlock net = do
     h   <- arbitraryBlockHeader
     c   <- choose (0,10)
-    txs <- vectorOf c arbitraryTx
+    txs <- vectorOf c (arbitraryTx net)
     return $ Block h txs
 
 arbitraryBlockHeader :: Gen BlockHeader

src/Network/Haskoin/Test/Crypto.hs

@@ -9,6 +9,7 @@ import           Data.Either                         (fromRight)
 import           Data.List                           (foldl')
 import           Data.Serialize                      (decode)
 import           Data.Word                           (Word32)
+import           Network.Haskoin.Constants
 import           Network.Haskoin.Crypto.Address
 import           Network.Haskoin.Crypto.ECDSA
 import           Network.Haskoin.Crypto.ExtendedKeys
@@ -66,18 +67,17 @@ arbitraryPubKeyU :: Gen (PrvKeyU, PubKeyU)
 arbitraryPubKeyU = (\k -> (k, derivePubKey k)) <$> arbitraryPrvKeyU
 
 -- | Arbitrary non-witness address (can be a pubkey or script hash address)
-arbitraryAddress :: Gen Address
-arbitraryAddress = oneof [ arbitraryPubKeyAddress
-                         , arbitraryScriptAddress
-                         ]
+arbitraryAddress :: Network -> Gen Address
+arbitraryAddress net =
+    oneof [arbitraryPubKeyAddress net, arbitraryScriptAddress net]
 
 -- | Arbitrary public key hash address
-arbitraryPubKeyAddress :: Gen Address
-arbitraryPubKeyAddress = PubKeyAddress <$> arbitraryHash160
+arbitraryPubKeyAddress :: Network -> Gen Address
+arbitraryPubKeyAddress net = PubKeyAddress <$> arbitraryHash160 <*> pure net
 
 -- | Arbitrary script hash address
-arbitraryScriptAddress :: Gen Address
-arbitraryScriptAddress = ScriptAddress <$> arbitraryHash160
+arbitraryScriptAddress :: Network -> Gen Address
+arbitraryScriptAddress net = ScriptAddress <$> arbitraryHash160 <*> pure net
 
 -- | Arbitrary message hash, private key, nonce and corresponding signature.
 -- The signature is generated with a random message, random private key and a
@@ -90,16 +90,15 @@ arbitrarySignature = do
     return (msg, key, sig)
 
 -- | Arbitrary extended private key.
-arbitraryXPrvKey :: Gen XPrvKey
-arbitraryXPrvKey = XPrvKey <$> arbitrary
-                           <*> arbitrary
-                           <*> arbitrary
-                           <*> arbitraryHash256
-                           <*> arbitraryPrvKeyC
+arbitraryXPrvKey :: Network -> Gen XPrvKey
+arbitraryXPrvKey net =
+    XPrvKey <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitraryHash256 <*>
+    arbitraryPrvKeyC <*>
+    pure net
 
 -- | Arbitrary extended public key with its corresponding private key.
-arbitraryXPubKey :: Gen (XPrvKey, XPubKey)
-arbitraryXPubKey = (\k -> (k, deriveXPubKey k)) <$> arbitraryXPrvKey
+arbitraryXPubKey :: Network -> Gen (XPrvKey, XPubKey)
+arbitraryXPubKey net = (\k -> (k, deriveXPubKey k)) <$> arbitraryXPrvKey net
 
 {- Custom derivations -}
 

src/Network/Haskoin/Test/Message.hs

@@ -3,6 +3,7 @@
 -}
 module Network.Haskoin.Test.Message where
 
+import           Network.Haskoin.Constants
 import           Network.Haskoin.Network.Message
 import           Network.Haskoin.Test.Block
 import           Network.Haskoin.Test.Crypto
@@ -19,8 +20,8 @@ arbitraryMessageHeader =
                   <*> arbitraryCheckSum32
 
 -- | Arbitrary Message
-arbitraryMessage :: Gen Message
-arbitraryMessage =
+arbitraryMessage :: Network -> Gen Message
+arbitraryMessage net =
     oneof
         [ MVersion <$> arbitraryVersion
         , return MVerAck
@@ -30,8 +31,8 @@ arbitraryMessage =
         , MNotFound <$> arbitraryNotFound
         , MGetBlocks <$> arbitraryGetBlocks
         , MGetHeaders <$> arbitraryGetHeaders
-        , MTx <$> arbitraryTx
-        , MBlock <$> arbitraryBlock
+        , MTx <$> arbitraryTx net
+        , MBlock <$> arbitraryBlock net
         , MMerkleBlock <$> arbitraryMerkleBlock
         , MHeaders <$> arbitraryHeaders
         , return MGetAddr

src/Network/Haskoin/Test/Script.hs

@@ -4,6 +4,7 @@
 module Network.Haskoin.Test.Script where
 
 import           Data.Word
+import           Network.Haskoin.Constants
 import           Network.Haskoin.Crypto
 import           Network.Haskoin.Script
 import           Network.Haskoin.Test.Crypto
@@ -194,13 +195,13 @@ arbitraryMSParam = do
     return (m, n)
 
 -- | Arbitrary ScriptOutput (Can by any valid type)
-arbitraryScriptOutput :: Gen ScriptOutput
-arbitraryScriptOutput =
+arbitraryScriptOutput :: Network -> Gen ScriptOutput
+arbitraryScriptOutput net =
     oneof
         [ arbitraryPKOutput
         , arbitraryPKHashOutput
         , arbitraryMSOutput
-        , arbitrarySHOutput
+        , arbitrarySHOutput net
         , arbitraryDCOutput
         ]
 
@@ -237,8 +238,9 @@ arbitraryMSCOutput = do
     return $ PayMulSig keys m
 
 -- | Arbitrary ScriptOutput of type PayScriptHash
-arbitrarySHOutput :: Gen ScriptOutput
-arbitrarySHOutput = PayScriptHash . getAddrHash <$> arbitraryScriptAddress
+arbitrarySHOutput :: Network -> Gen ScriptOutput
+arbitrarySHOutput net =
+    PayScriptHash . getAddrHash <$> arbitraryScriptAddress net
 
 -- | Arbitrary ScriptOutput of type DataCarrier
 arbitraryDCOutput :: Gen ScriptOutput

src/Network/Haskoin/Test/Transaction.hs

@@ -26,18 +26,18 @@ arbitraryTxHash :: Gen TxHash
 arbitraryTxHash = TxHash <$> arbitraryHash256
 
 -- | Arbitrary amount of Satoshi as Word64 (Between 1 and 21e14)
-arbitrarySatoshi :: Gen TestCoin
-arbitrarySatoshi = TestCoin <$> choose (1, maxSatoshi)
+arbitrarySatoshi :: Network -> Gen TestCoin
+arbitrarySatoshi net = TestCoin <$> choose (1, getMaxSatoshi net)
 
 -- | Arbitrary OutPoint
 arbitraryOutPoint :: Gen OutPoint
 arbitraryOutPoint = OutPoint <$> arbitraryTxHash <*> arbitrary
 
 -- | Arbitrary TxOut
-arbitraryTxOut :: Gen TxOut
-arbitraryTxOut =
-    TxOut <$> (getTestCoin <$> arbitrarySatoshi)
-          <*> (encodeOutputBS <$> arbitraryScriptOutput)
+arbitraryTxOut :: Network -> Gen TxOut
+arbitraryTxOut net =
+    TxOut <$> (getTestCoin <$> arbitrarySatoshi net)
+          <*> (encodeOutputBS <$> arbitraryScriptOutput net)
 
 -- | Arbitrary TxIn
 arbitraryTxIn :: Gen TxIn
@@ -46,29 +46,29 @@ arbitraryTxIn =
          <*> (encodeInputBS <$> arbitraryScriptInput)
          <*> arbitrary
 
-arbitraryTx :: Gen Tx
-arbitraryTx = oneof [arbitraryLegacyTx, arbitraryWitnessTx]
+arbitraryTx :: Network -> Gen Tx
+arbitraryTx net = oneof [arbitraryLegacyTx net, arbitraryWitnessTx net]
 
 -- | Arbitrary Legacy Tx
-arbitraryLegacyTx :: Gen Tx
-arbitraryLegacyTx = do
+arbitraryLegacyTx :: Network -> Gen Tx
+arbitraryLegacyTx net = do
     v    <- arbitrary
     ni   <- choose (0,5)
     no   <- choose (if ni == 0 then 2 else 0, 5) -- avoid witness case
     inps <- vectorOf ni arbitraryTxIn
-    outs <- vectorOf no arbitraryTxOut
+    outs <- vectorOf no (arbitraryTxOut net)
     let uniqueInps = nubBy (\a b -> prevOutput a == prevOutput b) inps
     t    <- arbitrary
     return $ Tx v uniqueInps outs [] t
 
 -- | Arbitrary Legacy Tx (Witness data is bogus)
-arbitraryWitnessTx :: Gen Tx
-arbitraryWitnessTx = do
+arbitraryWitnessTx :: Network -> Gen Tx
+arbitraryWitnessTx net = do
     v    <- arbitrary
     ni   <- choose (0,5)
     no   <- choose (0,5)
     inps <- vectorOf ni arbitraryTxIn
-    outs <- vectorOf no arbitraryTxOut
+    outs <- vectorOf no (arbitraryTxOut net)
     let uniqueInps = nubBy (\a b -> prevOutput a == prevOutput b) inps
     t    <- arbitrary
     w    <- vectorOf (length uniqueInps) (listOf arbitraryBS)
@@ -77,24 +77,24 @@ arbitraryWitnessTx = do
 -- | Arbitrary Tx containing only inputs of type SpendPKHash, SpendScriptHash
 -- (multisig) and outputs of type PayPKHash and PaySH. Only compressed
 -- public keys are used.
-arbitraryAddrOnlyTx :: Gen Tx
-arbitraryAddrOnlyTx = do
+arbitraryAddrOnlyTx :: Network -> Gen Tx
+arbitraryAddrOnlyTx net = do
     v    <- arbitrary
     ni   <- choose (0,5)
     no   <- choose (0,5)
     inps <- vectorOf ni arbitraryAddrOnlyTxIn
-    outs <- vectorOf no arbitraryAddrOnlyTxOut
+    outs <- vectorOf no (arbitraryAddrOnlyTxOut net)
     t    <- arbitrary
     return $ Tx v inps outs [] t
 
 -- | Like 'arbitraryAddrOnlyTx' without empty signatures in the inputs
-arbitraryAddrOnlyTxFull :: Gen Tx
-arbitraryAddrOnlyTxFull = do
+arbitraryAddrOnlyTxFull :: Network -> Gen Tx
+arbitraryAddrOnlyTxFull net = do
     v    <- arbitrary
     ni   <- choose (0,5)
     no   <- choose (0,5)
     inps <- vectorOf ni arbitraryAddrOnlyTxInFull
-    outs <- vectorOf no arbitraryAddrOnlyTxOut
+    outs <- vectorOf no (arbitraryAddrOnlyTxOut net)
     t    <- arbitrary
     return $ Tx v inps outs [] t
 
@@ -116,50 +116,50 @@ arbitraryAddrOnlyTxInFull = do
     return $ TxIn o (encodeInputBS inp) s
 
 -- | Arbitrary TxOut that can only be of type PayPKHash or PaySH
-arbitraryAddrOnlyTxOut :: Gen TxOut
-arbitraryAddrOnlyTxOut = do
-    v <- getTestCoin <$> arbitrarySatoshi
-    out <- oneof [ arbitraryPKHashOutput, arbitrarySHOutput ]
+arbitraryAddrOnlyTxOut :: Network -> Gen TxOut
+arbitraryAddrOnlyTxOut net = do
+    v <- getTestCoin <$> arbitrarySatoshi net
+    out <- oneof [ arbitraryPKHashOutput, arbitrarySHOutput net ]
     return $ TxOut v $ encodeOutputBS out
 
 -- | Arbitrary SigInput with the corresponding private keys used
 -- to generate the ScriptOutput or RedeemScript
-arbitrarySigInput :: Gen (SigInput, [PrvKey])
-arbitrarySigInput =
+arbitrarySigInput :: Network -> Gen (SigInput, [PrvKey])
+arbitrarySigInput net =
     oneof
-        [ arbitraryPKSigInput >>= \(si, k) -> return (si, [k])
-        , arbitraryPKHashSigInput  >>= \(si, k) -> return (si, [k])
-        , arbitraryMSSigInput
-        , arbitrarySHSigInput
+        [ arbitraryPKSigInput net >>= \(si, k) -> return (si, [k])
+        , arbitraryPKHashSigInput  net >>= \(si, k) -> return (si, [k])
+        , arbitraryMSSigInput net
+        , arbitrarySHSigInput net
         ]
 
 -- | Arbitrary SigInput with a ScriptOutput of type PayPK
-arbitraryPKSigInput :: Gen (SigInput, PrvKey)
-arbitraryPKSigInput = do
+arbitraryPKSigInput :: Network -> Gen (SigInput, PrvKey)
+arbitraryPKSigInput net = do
     k <- arbitraryPrvKey
     let out = PayPK $ derivePubKey k
-    val <- getTestCoin <$> arbitrarySatoshi
+    val <- getTestCoin <$> arbitrarySatoshi net
     op <- arbitraryOutPoint
     sh <- arbitraryValidSigHash
     return (SigInput out val op sh Nothing, k)
 
 -- | Arbitrary SigInput with a ScriptOutput of type PayPKHash
-arbitraryPKHashSigInput :: Gen (SigInput, PrvKey)
-arbitraryPKHashSigInput = do
+arbitraryPKHashSigInput :: Network -> Gen (SigInput, PrvKey)
+arbitraryPKHashSigInput net = do
     k <- arbitraryPrvKey
-    let out = PayPKHash $ getAddrHash $ pubKeyAddr $ derivePubKey k
-    val <- getTestCoin <$> arbitrarySatoshi
+    let out = PayPKHash $ getAddrHash $ pubKeyAddr net $ derivePubKey k
+    val <- getTestCoin <$> arbitrarySatoshi net
     op <- arbitraryOutPoint
     sh <- arbitraryValidSigHash
     return (SigInput out val op sh Nothing, k)
 
 -- | Arbitrary SigInput with a ScriptOutput of type PayMulSig
-arbitraryMSSigInput :: Gen (SigInput, [PrvKey])
-arbitraryMSSigInput = do
+arbitraryMSSigInput :: Network -> Gen (SigInput, [PrvKey])
+arbitraryMSSigInput net = do
     (m,n) <- arbitraryMSParam
     ks    <- vectorOf n arbitraryPrvKey
     let out = PayMulSig (map derivePubKey ks) m
-    val <- getTestCoin <$> arbitrarySatoshi
+    val <- getTestCoin <$> arbitrarySatoshi net
     op <- arbitraryOutPoint
     sh <- arbitraryValidSigHash
     perm <- choose (0,n-1)
@@ -167,51 +167,51 @@ arbitraryMSSigInput = do
     return (SigInput out val op sh Nothing, ksPerm)
 
 -- | Arbitrary SigInput with  ScriptOutput of type PaySH and a RedeemScript
-arbitrarySHSigInput :: Gen (SigInput, [PrvKey])
-arbitrarySHSigInput = do
+arbitrarySHSigInput :: Network -> Gen (SigInput, [PrvKey])
+arbitrarySHSigInput net = do
     (SigInput rdm val op sh _, ks) <- oneof
-        [ f <$> arbitraryPKSigInput
-        , f <$> arbitraryPKHashSigInput
-        , arbitraryMSSigInput
+        [ f <$> arbitraryPKSigInput net
+        , f <$> arbitraryPKHashSigInput net
+        , arbitraryMSSigInput net
         ]
-    let out = PayScriptHash $ getAddrHash $ p2shAddr rdm
+    let out = PayScriptHash $ getAddrHash $ p2shAddr net rdm
     return (SigInput out val op sh $ Just rdm, ks)
   where
     f (si, k) = (si, [k])
 
 -- | Arbitrary Tx (empty TxIn), SigInputs and PrvKeys that can be passed to
 -- signTx or detSignTx to fully sign the Tx.
-arbitrarySigningData :: Gen (Tx, [SigInput], [PrvKey])
-arbitrarySigningData = do
+arbitrarySigningData :: Network -> Gen (Tx, [SigInput], [PrvKey])
+arbitrarySigningData net = do
     v  <- arbitrary
     ni <- choose (1,5)
     no <- choose (1,5)
-    sigis <- vectorOf ni arbitrarySigInput
+    sigis <- vectorOf ni (arbitrarySigInput net)
     let uSigis = nubBy (\(a,_) (b,_) -> sigInputOP a == sigInputOP b) sigis
     inps <- forM uSigis $ \(s,_) -> do
         sq <- arbitrary
         return $ TxIn (sigInputOP s) BS.empty sq
-    outs <- vectorOf no arbitraryTxOut
+    outs <- vectorOf no (arbitraryTxOut net)
     l    <- arbitrary
     perm <- choose (0, length inps - 1)
     let tx   = Tx v (permutations inps !! perm) outs [] l
         keys = concatMap snd uSigis
     return (tx, map fst uSigis, keys)
 
-arbitraryEmptyTx :: Gen Tx
-arbitraryEmptyTx = do
+arbitraryEmptyTx :: Network -> Gen Tx
+arbitraryEmptyTx net = do
     v    <- arbitrary
     no   <- choose (1,5)
     ni   <- choose (1,5)
-    outs <- vectorOf no arbitraryTxOut
+    outs <- vectorOf no (arbitraryTxOut net)
     ops  <- vectorOf ni arbitraryOutPoint
     t    <- arbitrary
     s    <- arbitrary
     return $ Tx v (map (\op -> TxIn op BS.empty s) (nub ops)) outs [] t
 
-arbitraryPartialTxs :: Gen ([Tx], [(ScriptOutput, Word64, OutPoint, Int, Int)])
-arbitraryPartialTxs = do
-    tx <- arbitraryEmptyTx
+arbitraryPartialTxs :: Network -> Gen ([Tx], [(ScriptOutput, Word64, OutPoint, Int, Int)])
+arbitraryPartialTxs net = do
+    tx <- arbitraryEmptyTx net
     res <-
         forM (map prevOutput $ txIn tx) $ \op -> do
             (so, val, rdmM, prvs, m, n) <- arbitraryData
@@ -223,10 +223,10 @@ arbitraryPartialTxs = do
         sh <- arbitraryValidSigHash
         let sigi = SigInput so val op sh rdmM
         return . fromRight (error "Colud not decode transaction") $
-            signTx tx [sigi] [prv]
+            signTx net tx [sigi] [prv]
     arbitraryData = do
         (m, n) <- arbitraryMSParam
-        val <- getTestCoin <$> arbitrarySatoshi
+        val <- getTestCoin <$> arbitrarySatoshi net
         nPrv <- choose (m, n)
         keys <- vectorOf n arbitraryPubKey
         perm <- choose (0, length keys - 1)
@@ -235,7 +235,7 @@ arbitraryPartialTxs = do
         let so = PayMulSig pubKeys m
         elements
             [ (so, val, Nothing, prvKeys, m, n)
-            , ( PayScriptHash $ getAddrHash $ p2shAddr so
+            , ( PayScriptHash $ getAddrHash $ p2shAddr net so
               , val
               , Just so
               , prvKeys

src/Network/Haskoin/Transaction/Builder.hs

@@ -22,6 +22,7 @@ import           Data.Maybe                        (catMaybes, fromJust,
 import           Data.Serialize                    (encode)
 import           Data.String.Conversions           (cs)
 import           Data.Word                         (Word64)
+import           Network.Haskoin.Constants
 import           Network.Haskoin.Crypto
 import           Network.Haskoin.Network.Types
 import           Network.Haskoin.Script
@@ -199,11 +200,11 @@ guessMSSize (m, n)
 
 -- | Build a transaction by providing a list of outpoints as inputs
 -- and a list of recipients addresses and amounts as outputs.
-buildAddrTx :: [OutPoint] -> [(ByteString, Word64)] -> Either String Tx
-buildAddrTx xs ys =
+buildAddrTx :: Network -> [OutPoint] -> [(ByteString, Word64)] -> Either String Tx
+buildAddrTx net xs ys =
     buildTx xs =<< mapM f ys
   where
-    f (s, v) = case stringToAddr s of
+    f (s, v) = case stringToAddr net s of
         Just a -> return (addressToOutput a, v)
         _      -> Left $ "buildAddrTx: Invalid address " ++ cs s
 
@@ -256,29 +257,30 @@ instance FromJSON SigInput where
 -- | Sign a transaction by providing the 'SigInput' signing paramters and
 -- a list of private keys. The signature is computed deterministically as
 -- defined in RFC-6979.
-signTx :: Tx               -- ^ Transaction to sign
+signTx :: Network
+       -> Tx               -- ^ Transaction to sign
        -> [SigInput]       -- ^ SigInput signing parameters
        -> [PrvKey]         -- ^ List of private keys to use for signing
        -> Either String Tx -- ^ Signed transaction
-signTx otx sigis allKeys
+signTx net otx sigis allKeys
     | null ti   = Left "signTx: Transaction has no inputs"
     | otherwise = foldM go otx $ findSigInput sigis ti
   where
     ti = txIn otx
     go tx (sigi@(SigInput so _ _ _ rdmM), i) = do
-        keys <- sigKeys so rdmM allKeys
-        foldM (\t k -> signInput t i sigi k) tx keys
+        keys <- sigKeys net so rdmM allKeys
+        foldM (\t k -> signInput net t i sigi k) tx keys
 
 -- | Sign a single input in a transaction deterministically (RFC-6979).
-signInput :: Tx -> Int -> SigInput -> PrvKey -> Either String Tx
-signInput tx i (SigInput so val _ sh rdmM) key = do
+signInput :: Network -> Tx -> Int -> SigInput -> PrvKey -> Either String Tx
+signInput net tx i (SigInput so val _ sh rdmM) key = do
     let sig = TxSignature (signMsg msg key) sh
-    si <- buildInput tx i so val rdmM sig $ derivePubKey key
+    si <- buildInput net tx i so val rdmM sig $ derivePubKey key
     let ins = updateIndex i (txIn tx) (f si)
     return $ Tx (txVersion tx) ins (txOut tx) [] (txLockTime tx)
   where
-    f si x = x{ scriptInput = encodeInputBS si }
-    msg = txSigHash tx (encodeOutput $ fromMaybe so rdmM) val i sh
+    f si x = x {scriptInput = encodeInputBS si}
+    msg = txSigHash net tx (encodeOutput $ fromMaybe so rdmM) val i sh
 
 -- Order the SigInput with respect to the transaction inputs. This allow the
 -- users to provide the SigInput in any order. Users can also provide only a
@@ -293,26 +295,30 @@ findSigInput si ti =
 
 -- Find from the list of private keys which one is required to sign the
 -- provided ScriptOutput.
-sigKeys :: ScriptOutput -> Maybe RedeemScript -> [PrvKey]
-        -> Either String [PrvKey]
-sigKeys so rdmM keys =
+sigKeys ::
+       Network
+    -> ScriptOutput
+    -> Maybe RedeemScript
+    -> [PrvKey]
+    -> Either String [PrvKey]
+sigKeys net so rdmM keys =
     case (so, rdmM) of
         (PayPK p, Nothing) ->
-            return $ map fst $ maybeToList $ find ((== p) . snd) zipKeys
+            return . map fst . maybeToList $ find ((== p) . snd) zipKeys
         (PayPKHash h, Nothing) ->
-            return $
-            map fst $
-            maybeToList $ find ((== h) . getAddrHash . pubKeyAddr . snd) zipKeys
+            return . map fst . maybeToList $
+            find ((== h) . getAddrHash . pubKeyAddr net . snd) zipKeys
         (PayMulSig ps r, Nothing) ->
             return $ map fst $ take r $ filter ((`elem` ps) . snd) zipKeys
-        (PayScriptHash _, Just rdm) -> sigKeys rdm Nothing keys
+        (PayScriptHash _, Just rdm) -> sigKeys net rdm Nothing keys
         _ -> Left "sigKeys: Could not decode output script"
   where
     zipKeys = zip keys (map derivePubKey keys)
 
 -- Construct an input, given a signature and a public key
 buildInput ::
-       Tx
+       Network
+    -> Tx
     -> Int
     -> ScriptOutput
     -> Word64
@@ -320,36 +326,38 @@ buildInput ::
     -> TxSignature
     -> PubKey
     -> Either String ScriptInput
-buildInput tx i so val rdmM sig pub = case (so, rdmM) of
-    (PayPK _, Nothing) ->
-        return $ RegularInput $ SpendPK sig
-    (PayPKHash _, Nothing) ->
-        return $ RegularInput $ SpendPKHash sig pub
-    (PayMulSig msPubs r, Nothing) -> do
-        let mSigs = take r $ catMaybes $ matchTemplate allSigs msPubs f
-        return $ RegularInput $ SpendMulSig mSigs
-    (PayScriptHash _, Just rdm) -> do
-        inp  <- buildInput tx i rdm val Nothing sig pub
-        return $ ScriptHashInput (getRegularInput inp) rdm
-    _ -> Left "buildInput: Invalid output/redeem script combination"
+buildInput net tx i so val rdmM sig pub =
+    case (so, rdmM) of
+        (PayPK _, Nothing) -> return $ RegularInput $ SpendPK sig
+        (PayPKHash _, Nothing) -> return $ RegularInput $ SpendPKHash sig pub
+        (PayMulSig msPubs r, Nothing) -> do
+            let mSigs = take r $ catMaybes $ matchTemplate allSigs msPubs f
+            return $ RegularInput $ SpendMulSig mSigs
+        (PayScriptHash _, Just rdm) -> do
+            inp <- buildInput net tx i rdm val Nothing sig pub
+            return $ ScriptHashInput (getRegularInput inp) rdm
+        _ -> Left "buildInput: Invalid output/redeem script combination"
   where
-    scp     = scriptInput $ txIn tx !! i
-    allSigs = nub $ sig : case decodeInputBS scp of
-        Right (ScriptHashInput (SpendMulSig xs) _) -> xs
-        Right (RegularInput    (SpendMulSig xs))   -> xs
-        _                                          -> []
+    scp = scriptInput $ txIn tx !! i
+    allSigs =
+        nub $
+        sig :
+        case decodeInputBS net scp of
+            Right (ScriptHashInput (SpendMulSig xs) _) -> xs
+            Right (RegularInput (SpendMulSig xs))      -> xs
+            _                                          -> []
     out = encodeOutput so
-    f (TxSignature x sh) p = verifySig (txSigHash tx out val i sh) x p
+    f (TxSignature x sh) p = verifySig (txSigHash net tx out val i sh) x p
     f TxSignatureEmpty _   = False
 
 {- Merge multisig transactions -}
 
-mergeTxs :: [Tx] -> [(ScriptOutput, Word64, OutPoint)] -> Either String Tx
-mergeTxs txs os
+mergeTxs :: Network -> [Tx] -> [(ScriptOutput, Word64, OutPoint)] -> Either String Tx
+mergeTxs net txs os
     | null txs = error "Transaction list is empty"
     | length (nub emptyTxs) /= 1 = Left "Transactions do not match"
     | length txs == 1 = return $ head txs
-    | otherwise = foldM (mergeTxInput txs) (head emptyTxs) outs
+    | otherwise = foldM (mergeTxInput net txs) (head emptyTxs) outs
   where
     zipOp = zip (matchTemplate os (txIn $ head txs) f) [0..]
     outs = map (first $ (\(o,v,_) -> (o,v)) . fromJust) $ filter (isJust . fst) zipOp
@@ -359,8 +367,13 @@ mergeTxs txs os
     clearInput tx (_, i) =
         Tx (txVersion tx) (ins (txIn tx) i) (txOut tx) [] (txLockTime tx)
 
-mergeTxInput :: [Tx] -> Tx -> ((ScriptOutput, Word64), Int) -> Either String Tx
-mergeTxInput txs tx ((so, val), i) = do
+mergeTxInput ::
+       Network
+    -> [Tx]
+    -> Tx
+    -> ((ScriptOutput, Word64), Int)
+    -> Either String Tx
+mergeTxInput net txs tx ((so, val), i) = do
     -- Ignore transactions with empty inputs
     let ins = map (scriptInput . (!! i) . txIn) txs
     sigRes <- mapM extractSigs $ filter (not . BS.null) ins
@@ -381,57 +394,62 @@ mergeTxInput txs tx ((so, val), i) = do
                 return $ ScriptHashInput (getRegularInput si) rdm
             _ -> Left "Invalid output script type"
         _ -> Left "Invalid output script type"
-    extractSigs si = case decodeInputBS si of
+    extractSigs si = case decodeInputBS net si of
         Right (RegularInput (SpendMulSig sigs)) -> Right (sigs, Nothing)
         Right (ScriptHashInput (SpendMulSig sigs) rdm) -> Right (sigs, Just rdm)
         _ -> Left "Invalid script input type"
     f out (TxSignature x sh) p =
-        verifySig (txSigHash tx (encodeOutput out) val i sh) x p
+        verifySig (txSigHash net tx (encodeOutput out) val i sh) x p
     f _ TxSignatureEmpty _ = False
 
 {- Tx verification -}
 
 -- | Verify if a transaction is valid and all of its inputs are standard.
-verifyStdTx :: Tx -> [(ScriptOutput, Word64, OutPoint)] -> Bool
-verifyStdTx = verifyStdTxGen False
+verifyStdTx :: Network -> Tx -> [(ScriptOutput, Word64, OutPoint)] -> Bool
+verifyStdTx net = verifyStdTxGen net False
 
 -- | Like 'verifyStdTx' but using strict signature decoding
-verifyStdTxStrict :: Tx -> [(ScriptOutput, Word64, OutPoint)] -> Bool
-verifyStdTxStrict = verifyStdTxGen True
+verifyStdTxStrict :: Network -> Tx -> [(ScriptOutput, Word64, OutPoint)] -> Bool
+verifyStdTxStrict net = verifyStdTxGen net True
 
-verifyStdTxGen :: Bool -> Tx -> [(ScriptOutput, Word64, OutPoint)] -> Bool
-verifyStdTxGen strict tx xs =
-    not (null (txIn tx)) && all go (zip (matchTemplate xs (txIn tx) f) [0..])
+verifyStdTxGen :: Network -> Bool -> Tx -> [(ScriptOutput, Word64, OutPoint)] -> Bool
+verifyStdTxGen net strict tx xs =
+    not (null (txIn tx)) && all go (zip (matchTemplate xs (txIn tx) f) [0 ..])
   where
-    f (_,_,o) txin        = o == prevOutput txin
-    go (Just (so,val,_), i) = verifyStdInput strict tx i so val
-    go _                    = False
+    f (_, _, o) txin = o == prevOutput txin
+    go (Just (so, val, _), i) = verifyStdInput net strict tx i so val
+    go _                      = False
 
 -- | Verify if a transaction input is valid and standard.
-verifyStdInput :: Bool -> Tx -> Int -> ScriptOutput -> Word64 -> Bool
-verifyStdInput strict tx i = go (scriptInput $ txIn tx !! i)
+verifyStdInput :: Network -> Bool -> Tx -> Int -> ScriptOutput -> Word64 -> Bool
+verifyStdInput net strict tx i = go (scriptInput $ txIn tx !! i)
   where
-    dec = if strict then decodeInputStrictBS else decodeInputBS
+    dec =
+        if strict
+            then decodeInputStrictBS net
+            else decodeInputBS net
     go inp so val =
         case dec inp of
             Right (RegularInput (SpendPK (TxSignature sig sh))) ->
                 case so of
-                    PayPK pub -> verifySig (txSigHash tx out val i sh) sig pub
+                    PayPK pub ->
+                        verifySig (txSigHash net tx out val i sh) sig pub
                     _ -> False
             Right (RegularInput (SpendPKHash (TxSignature sig sh) pub)) ->
                 case so of
                     PayPKHash h ->
-                        pubKeyAddr pub == PubKeyAddress h &&
-                        verifySig (txSigHash tx out val i sh) sig pub
+                        pubKeyAddr net pub == PubKeyAddress h net &&
+                        verifySig (txSigHash net tx out val i sh) sig pub
                     _ -> False
             Right (RegularInput (SpendMulSig sigs)) ->
                 case so of
-                    PayMulSig pubs r -> countMulSig tx out val i pubs sigs == r
+                    PayMulSig pubs r ->
+                        countMulSig net tx out val i pubs sigs == r
                     _ -> False
             Right (ScriptHashInput si rdm) ->
                 case so of
                     PayScriptHash h ->
-                        p2shAddr rdm == ScriptAddress h &&
+                        p2shAddr net rdm == ScriptAddress h net &&
                         go (encodeInputBS $ RegularInput si) rdm val
                     _ -> False
             _ -> False
@@ -439,12 +457,12 @@ verifyStdInput strict tx i = go (scriptInput $ txIn tx !! i)
         out = encodeOutput so
 
 -- Count the number of valid signatures
-countMulSig :: Tx -> Script -> Word64 -> Int -> [PubKey] -> [TxSignature] -> Int
-countMulSig _ _ _ _ [] _  = 0
-countMulSig _ _ _ _ _  [] = 0
-countMulSig tx out val i (_:pubs) (TxSignatureEmpty:rest) =
-    countMulSig tx out val i pubs rest
-countMulSig tx out val i (pub:pubs) sigs@(TxSignature sig sh:rest)
-    | verifySig (txSigHash tx out val i sh) sig pub =
-         1 + countMulSig tx out val i pubs rest
-    | otherwise = countMulSig tx out val i pubs sigs
+countMulSig :: Network -> Tx -> Script -> Word64 -> Int -> [PubKey] -> [TxSignature] -> Int
+countMulSig _ _ _ _ _ [] _  = 0
+countMulSig _ _ _ _ _ _  [] = 0
+countMulSig net tx out val i (_:pubs) (TxSignatureEmpty:rest) =
+    countMulSig net tx out val i pubs rest
+countMulSig net tx out val i (pub:pubs) sigs@(TxSignature sig sh:rest)
+    | verifySig (txSigHash net tx out val i sh) sig pub =
+         1 + countMulSig net tx out val i pubs rest
+    | otherwise = countMulSig net tx out val i pubs sigs

src/Network/Haskoin/Transaction/Types.hs

@@ -251,7 +251,7 @@ data OutPoint = OutPoint
       -- | The position of the specific output in the transaction.
       -- The first output position is 0.
     , outPointIndex :: !Word32
-    } deriving (Show, Eq, Ord)
+    } deriving (Show, Read, Eq, Ord)
 
 instance NFData OutPoint where
     rnf (OutPoint h i) = rnf h `seq` rnf i

stack.yaml

@@ -1,6 +1,5 @@
-resolver: lts-12.5
+resolver: lts-12.7
 nix:
-  enable: true
   packages:
     - autoconf
     - automake

test/Network/Haskoin/Block/Spec.hs

@@ -0,0 +1,83 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Network.Haskoin.Block.Spec
+    ( spec
+    ) where
+import           Control.Monad.State.Strict
+import           Network.Haskoin.Block
+import           Network.Haskoin.Constants
+import           Test.Hspec
+
+myTime :: Timestamp
+myTime = 1499083075
+
+withChain :: Network -> State HeaderMemory a -> a
+withChain net f = evalState f (initialChain net)
+
+chain :: BlockHeaders m => Network -> BlockHeader -> Int -> m ()
+chain net bh i = do
+    bnsE <- connectBlocks net myTime bhs
+    either error (const $ return ()) bnsE
+  where
+    bhs = appendBlocks net 6 bh i
+
+spec :: Network -> Spec
+spec net = do
+    describe "blockchain headers" $ do
+        it "gets best block" $
+            let bb =
+                    withChain net $ do
+                        chain net (getGenesisHeader net) 100
+                        getBestBlockHeader
+             in nodeHeight bb `shouldBe` 100
+        it "builds a block locator" $
+            let net = bchRegTest
+                loc =
+                    withChain net $ do
+                        chain net (getGenesisHeader net) 100
+                        bb <- getBestBlockHeader
+                        blockLocatorNodes net bb
+                heights = map nodeHeight loc
+             in heights `shouldBe` [100,99 .. 90] <> [88, 84, 76, 60, 28, 0]
+        it "follows split chains" $
+            let bb = withChain net $ splitChain net >> getBestBlockHeader
+             in nodeHeight bb `shouldBe` 4035
+
+-- 0 → → 2015 → → → → → → → 4031
+--       ↓
+--       → → 2035 → → → → → → 4035*
+--           ↓
+--           → → 2185
+splitChain :: Network -> State HeaderMemory ()
+splitChain net = do
+    start <- go 1 (getGenesisHeader net) 2015
+    e 2015 (head start)
+    tail1 <- go 2 (nodeHeader $ head start) 2016
+    e 4031 (head tail1)
+    tail2 <- go 3 (nodeHeader $ head start) 20
+    e 2035 (head tail2)
+    tail3 <- go 4 (nodeHeader $ head tail2) 2000
+    e 4035 (head tail3)
+    tail4 <- go 5 (nodeHeader $ head tail2) 150
+    e 2185 (head tail4)
+    sp1 <- splitPoint net (head tail1) (head tail3)
+    unless (sp1 == head start) $
+        error $
+        "Split point wrong between blocks 4031 and 4035: " ++
+        show (nodeHeight sp1)
+    sp2 <- splitPoint net (head tail4) (head tail3)
+    unless (sp2 == head tail2) $
+        error $
+        "Split point wrong between blocks 2185 and 4035: " ++
+        show (nodeHeight sp2)
+  where
+    e n bn =
+        unless (nodeHeight bn == n) $
+        error $
+        "Node height " ++
+        show (nodeHeight bn) ++ " of first chunk should be " ++ show n
+    go seed start n = do
+        let bhs = appendBlocks net seed start n
+        bnE <- connectBlocks net myTime bhs
+        case bnE of
+            Right bn -> return bn
+            Left ex -> error ex

test/Network/Haskoin/Block/Tests.hs

@@ -1,36 +1,34 @@
-module Network.Haskoin.Block.Tests (tests) where
+module Network.Haskoin.Block.Tests (spec) where
 
 import           Data.Either                          (fromRight)
 import           Data.String                          (fromString)
 import           Data.String.Conversions              (cs)
 import           Network.Haskoin.Block
+import           Network.Haskoin.Constants
 import           Network.Haskoin.Test
 import           Network.Haskoin.Transaction
-import           Test.Framework
-import           Test.Framework.Providers.QuickCheck2
+import           Test.Hspec
 import           Test.QuickCheck
 
-tests :: [Test]
-tests =
-    [ testGroup
-          "Block hash tests"
-          [ testProperty "decode . encode block hash" $
+spec :: Network -> Spec
+spec net = do
+    describe "block hash" $ do
+        it "encodes and decodes block hash" $
+            property $
             forAll arbitraryBlockHash $ \h ->
                 hexToBlockHash (blockHashToHex h) == Just h
-          , testProperty "From string block hash" $
+        it "From string block hash" $
+            property $
             forAll arbitraryBlockHash $ \h ->
                 fromString (cs $ blockHashToHex h) == h
-          ]
-    , testGroup
-          "Merkle trees"
-          [ testProperty "Width of tree at maxmum height = 1" testTreeWidth
-          , testProperty "Width of tree at height 0 is # txns" testBaseWidth
-          , testProperty "extract . build partial merkle tree" $
+    describe "merkle trees" $ do
+        it "builds tree of right width at height 1" $ property testTreeWidth
+        it "builds tree of right width at height 0" $ property testBaseWidth
+        it "builds and extracts partial merkle tree" $
+            property $
             forAll
                 (listOf1 ((,) <$> arbitraryTxHash <*> arbitrary))
-                buildExtractTree
-          ]
-    ]
+                (buildExtractTree net)
 
 {- Merkle Trees -}
 
@@ -40,11 +38,11 @@ testTreeWidth i = i /= 0 ==> calcTreeWidth (abs i) (calcTreeHeight $ abs i) == 1
 testBaseWidth :: Int -> Property
 testBaseWidth i = i /= 0 ==> calcTreeWidth (abs i) 0 == abs i
 
-buildExtractTree :: [(TxHash, Bool)] -> Bool
-buildExtractTree txs =
+buildExtractTree :: Network -> [(TxHash, Bool)] -> Bool
+buildExtractTree net txs =
     r == buildMerkleRoot (map fst txs) && m == map fst (filter snd txs)
   where
     (f, h) = buildPartialMerkle txs
     (r, m) =
         fromRight (error "Could not extract matches from Merkle tree") $
-        extractMatches f h (length txs)
+        extractMatches net f h (length txs)

test/Network/Haskoin/Block/Units.hs

@@ -1,126 +1,119 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Network.Haskoin.Block.Units (tests) where
+module Network.Haskoin.Block.Units (spec) where
 
-import           Data.ByteString                (ByteString)
-import           Data.Maybe                     (fromJust)
+import           Data.ByteString             (ByteString)
+import           Data.Maybe                  (fromJust)
 import           Network.Haskoin.Block
 import           Network.Haskoin.Transaction
-import           Test.Framework                 (Test, testGroup)
-import           Test.Framework.Providers.HUnit (testCase)
-import           Test.HUnit                     (Assertion, assertBool,
-                                                 assertEqual)
+import           Test.Hspec
+import           Test.HUnit                  (Assertion, assertBool,
+                                              assertEqual)
 
-tests :: [Test]
-tests =
-    [ testGroup
-          "Merkle Roots"
-          (zipWith (curry mapMerkleVectors) merkleVectors [0 ..])
-    , testGroup
-          "Compact number representation"
-          [ testCase "Compact number representations" testCompact
-          , testCase
-                "Compact number representations from Bitcoin Core tests"
-                testCompactBitcoinCore
-          ]
-    ]
+spec :: Spec
+spec = do
+    describe "merkle roots" $
+        sequence_ $ zipWith (curry mapMerkleVectors) merkleVectors [0 ..]
+    describe "compact number representation" $ do
+        it "check local vectors" testCompact
+        it "check vectors from Bitcoin Core" testCompactBitcoinCore
 
 testCompact :: Assertion
 testCompact = do
-    assertEqual "Vector 1" 0x05123456 (encodeCompact 0x1234560000)
-    assertEqual "Vector 2" (0x1234560000, False) (decodeCompact 0x05123456)
-    assertEqual "Vector 3" 0x0600c0de (encodeCompact 0xc0de000000)
-    assertEqual "Vector 4" (0xc0de000000, False) (decodeCompact 0x0600c0de)
-    assertEqual "Vector 5" 0x05c0de00 (encodeCompact (-0x40de000000))
-    assertEqual "Vector 6" (-0x40de000000, False) (decodeCompact 0x05c0de00)
+    assertEqual "vector 1" 0x05123456 (encodeCompact 0x1234560000)
+    assertEqual "vector 2" (0x1234560000, False) (decodeCompact 0x05123456)
+    assertEqual "vector 3" 0x0600c0de (encodeCompact 0xc0de000000)
+    assertEqual "vector 4" (0xc0de000000, False) (decodeCompact 0x0600c0de)
+    assertEqual "vector 5" 0x05c0de00 (encodeCompact (-0x40de000000))
+    assertEqual "vector 6" (-0x40de000000, False) (decodeCompact 0x05c0de00)
 
 testCompactBitcoinCore :: Assertion
 testCompactBitcoinCore = do
-    assertEqual "Zero" (0, False) (decodeCompact 0x00000000)
+    assertEqual "zero" (0, False) (decodeCompact 0x00000000)
     assertEqual
-        "Zero (encode · decode)"
+        "zero (encode · decode)"
         0x00000000
         (encodeCompact . fst $ decodeCompact 0x00000000)
-    assertEqual "Rounds to zero" (0, False) (decodeCompact 0x00123456)
-    assertEqual "Rounds to zero" (0, False) (decodeCompact 0x01003456)
-    assertEqual "Rounds to zero" (0, False) (decodeCompact 0x02000056)
-    assertEqual "Rounds to zero" (0, False) (decodeCompact 0x03000000)
-    assertEqual "Rounds to zero" (0, False) (decodeCompact 0x04000000)
-    assertEqual "Rounds to zero" (0, False) (decodeCompact 0x00923456)
-    assertEqual "Rounds to zero" (0, False) (decodeCompact 0x01803456)
-    assertEqual "Rounds to zero" (0, False) (decodeCompact 0x02800056)
-    assertEqual "Rounds to zero" (0, False) (decodeCompact 0x03800000)
-    assertEqual "Rounds to zero" (0, False) (decodeCompact 0x04800000)
-    assertEqual "Vector 1 (decode)" (0x12, False) (decodeCompact 0x01123456)
+    assertEqual "rounds to zero" (0, False) (decodeCompact 0x00123456)
+    assertEqual "rounds to zero" (0, False) (decodeCompact 0x01003456)
+    assertEqual "rounds to zero" (0, False) (decodeCompact 0x02000056)
+    assertEqual "rounds to zero" (0, False) (decodeCompact 0x03000000)
+    assertEqual "rounds to zero" (0, False) (decodeCompact 0x04000000)
+    assertEqual "rounds to zero" (0, False) (decodeCompact 0x00923456)
+    assertEqual "rounds to zero" (0, False) (decodeCompact 0x01803456)
+    assertEqual "rounds to zero" (0, False) (decodeCompact 0x02800056)
+    assertEqual "rounds to zero" (0, False) (decodeCompact 0x03800000)
+    assertEqual "rounds to zero" (0, False) (decodeCompact 0x04800000)
+    assertEqual "vector 1 (decode)" (0x12, False) (decodeCompact 0x01123456)
     assertEqual
-        "Vector 1 (encode · decode)"
+        "vector 1 (encode · decode)"
         0x01120000
         (encodeCompact . fst $ decodeCompact 0x01123456)
     assertEqual "0x80 bit set" 0x02008000 (encodeCompact 0x80)
     assertEqual
-        "Vector 2 (negative) (decode)"
+        "vector 2 (negative) (decode)"
         (-0x7e, False)
         (decodeCompact 0x01fedcba)
     assertEqual
-        "Vector 2 (negative) (encode · decode)"
+        "vector 2 (negative) (encode · decode)"
         0x01fe0000
         (encodeCompact . fst $ decodeCompact 0x01fedcba)
-    assertEqual "Vector 3 (decode)" (0x1234, False) (decodeCompact 0x02123456)
+    assertEqual "vector 3 (decode)" (0x1234, False) (decodeCompact 0x02123456)
     assertEqual
-        "Vector 3 (encode · decode)"
+        "vector 3 (encode · decode)"
         0x02123400
         (encodeCompact . fst $ decodeCompact 0x02123456)
-    assertEqual "Vector 4 (decode)" (0x123456, False) (decodeCompact 0x03123456)
+    assertEqual "vector 4 (decode)" (0x123456, False) (decodeCompact 0x03123456)
     assertEqual
-        "Vector 4 (encode · decode)"
+        "vector 4 (encode · decode)"
         0x03123456
         (encodeCompact . fst $ decodeCompact 0x03123456)
     assertEqual
-        "Vector 5 (decode)"
+        "vector 5 (decode)"
         (0x12345600, False)
         (decodeCompact 0x04123456)
     assertEqual
-        "Vector 5 (encode · decode)"
+        "vector 5 (encode · decode)"
         0x04123456
         (encodeCompact . fst $ decodeCompact 0x04123456)
     assertEqual
-        "Vector 6 (decode)"
+        "vector 6 (decode)"
         (-0x12345600, False)
         (decodeCompact 0x04923456)
     assertEqual
-        "Vector 6 (encode · decode)"
+        "vector 6 (encode · decode)"
         0x04923456
         (encodeCompact . fst $ decodeCompact 0x04923456)
     assertEqual
-        "Vector 7 (decode)"
+        "vector 7 (decode)"
         (0x92340000, False)
         (decodeCompact 0x05009234)
     assertEqual
-        "Vector 7 (encode · decode)"
+        "vector 7 (encode · decode)"
         0x05009234
         (encodeCompact . fst $ decodeCompact 0x05009234)
     assertEqual
-        "Vector 8 (decode)"
+        "vector 8 (decode)"
         ( 0x1234560000000000000000000000000000000000000000000000000000000000
         , False)
         (decodeCompact 0x20123456)
     assertEqual
-        "Vector 8 (encode · decode)"
+        "vector 8 (encode · decode)"
         0x20123456
         (encodeCompact . fst $ decodeCompact 0x20123456)
-    assertBool "Vector 9 (decode) (overflow)" (snd $ decodeCompact 0xff123456)
+    assertBool "vector 9 (decode) (overflow)" (snd $ decodeCompact 0xff123456)
     assertBool
-        "Vector 9 (decode) (positive)"
+        "vector 9 (decode) (positive)"
         ((> 0) . fst $ decodeCompact 0xff123456)
 
-mapMerkleVectors :: ((ByteString, [ByteString]), Int) -> Test.Framework.Test
+mapMerkleVectors :: ((ByteString, [ByteString]), Int) -> Spec
 mapMerkleVectors (v, i) =
-    testCase name $ runMerkleVector v
+    it name $ runMerkleVector v
   where
-    name = "MerkleRoot vector " ++ show i
+    name = "merkle root vector " ++ show i
 
 runMerkleVector :: (ByteString, [ByteString]) -> Assertion
 runMerkleVector (r, hs) =
-    assertBool "    >  Merkle Vector" $
+    assertBool "merkle vector" $
         buildMerkleRoot (map f hs) == getTxHash (f r)
   where
     f = fromJust . hexToTxHash

test/Network/Haskoin/Cereal/Tests.hs

@@ -0,0 +1,108 @@
+module Network.Haskoin.Cereal.Tests (spec) where
+
+import           Data.Serialize
+import           Network.Haskoin.Constants
+import           Network.Haskoin.Crypto
+import           Network.Haskoin.Network
+import           Network.Haskoin.Test
+import           Network.Haskoin.Util
+import           Test.Hspec
+import           Test.QuickCheck
+
+spec :: Network -> Spec
+spec net = do
+    describe "serialization of keys and hashes" $ do
+        it "encodes and decodes bytestring" $
+            property $ forAll arbitraryBS testId
+        it "encodes and decodes hash160" $
+            property $ forAll arbitraryHash160 testId
+        it "encodes and decodes hash256" $
+            property $ forAll arbitraryHash256 testId
+        it "encodes and decodes hash512" $
+            property $ forAll arbitraryHash512 testId
+        it "encodes and decodes signature" $
+            property $ forAll arbitrarySignature $ testId . lst3
+        it "encodes and decodes public key" $
+            property $ forAll arbitraryPubKey $ testId . snd
+        it "encodes and decodes extended private key" $
+            property $
+            forAll (arbitraryXPrvKey net) $
+            testPutGet (getXPrvKey net) putXPrvKey
+    describe "serialization of protocol types" $ do
+        it "encodes and decodes varint" $
+            property $ forAll arbitraryVarInt testId
+        it "encodes and decodes varstring" $
+            property $ forAll arbitraryVarString testId
+        it "encodes and decodes network address" $
+            property $ forAll arbitraryNetworkAddress testId
+        it "encodes and decodes invtype" $
+            property $ forAll arbitraryInvType testId
+        it "encodes and decodes invvector" $
+            property $ forAll arbitraryInvVector testId
+        it "encodes and decodes inv" $ property $ forAll arbitraryInv1 testId
+        it "encodes and decodes version" $
+            property $ forAll arbitraryVersion testId
+        it "encodes and decodes addr" $ property $ forAll arbitraryAddr1 testId
+        it "encodes and decodes alert" $ property $ forAll arbitraryAlert testId
+        it "encodes and decodes reject" $
+            property $forAll arbitraryReject testId
+        it "encodes and decodes getdata" $
+            property $ forAll arbitraryGetData testId
+        it "encodes and decodes notfound" $
+            property $ forAll arbitraryNotFound testId
+        it "encodes and decodes ping" $ property $ forAll arbitraryPing testId
+        it "encodes and decodes pong" $ property $ forAll arbitraryPong testId
+        it "encodes and decodes message command" $
+            property $ forAll arbitraryMessageCommand testId
+        it "encodes and decodes message header" $
+            property $ forAll arbitraryMessageHeader testId
+        it "encodes and decodes message" $
+            property $
+            forAll (arbitraryMessage net) $
+            testPutGet (getMessage net) (putMessage net)
+    describe "serialization of script types" $ do
+        it "encodes and decodes script op" $
+            property $ forAll arbitraryScriptOp testId
+        it "encodes and decodes script" $
+            property $ forAll arbitraryScript testId
+    describe "serialization of transaction types" $ do
+        it "encodes and decodes tx input" $
+            property $ forAll arbitraryTxIn testId
+        it "encodes and decodes tx output" $
+            property $ forAll (arbitraryTxOut net) testId
+        it "encodes and decodes outpoint" $
+            property $ forAll arbitraryOutPoint testId
+        it "encodes and decodes transaction" $
+            property $ forAll (arbitraryTx net) testId
+        it "encodes and decodes witness transaction" $
+            property $ forAll (arbitraryWitnessTx net) testId
+        it "encodes and decodes legacy transaction" $
+            property $ forAll (arbitraryLegacyTx net) testId
+    describe "serialization of block types" $ do
+        it "encodes and decodes block" $
+            property $ forAll (arbitraryBlock net) testId
+        it "encodes and decodes block header" $
+            property $ forAll arbitraryBlockHeader testId
+        it "encodes and decodes getblocks" $
+            property $ forAll arbitraryGetBlocks testId
+        it "encodes and decodes getheaders" $
+            property $ forAll arbitraryGetHeaders testId
+        it "encodes and decdoes headers" $
+            property $ forAll arbitraryHeaders testId
+        it "encodes and decodes merklel block" $
+            property $ forAll arbitraryMerkleBlock testId
+    describe "serialization of bloom types" $ do
+        it "encodes and decodes bloom flags" $
+            property $ forAll arbitraryBloomFlags testId
+        it "encodes and decodes bloom filter" $
+            property $ forAll arbitraryBloomFilter $ testId . lst3
+        it "encodes and decodes filterload" $
+            property $ forAll arbitraryFilterLoad testId
+        it "encodes and decodes filteradd" $
+            property $ forAll arbitraryFilterAdd testId
+
+testId :: (Serialize a, Eq a) => a -> Bool
+testId x = decode (encode x) == Right x
+
+testPutGet :: Eq a => Get a -> Putter a -> a -> Bool
+testPutGet g p a = runGet g (runPut (p a)) == Right a

test/Network/Haskoin/Crypto/Base58/Tests.hs

@@ -0,0 +1,27 @@
+module Network.Haskoin.Crypto.Base58.Tests
+    ( spec
+    ) where
+
+import           Data.String               (fromString)
+import           Data.String.Conversions   (cs)
+import           Network.Haskoin.Constants
+import           Network.Haskoin.Crypto
+import           Network.Haskoin.Test
+import           Test.Hspec
+import           Test.QuickCheck
+
+spec :: Network -> Spec
+spec net =
+    describe "base58 addresses" $ do
+        it "encodes and decodes base58 bytestring" $
+            property $
+            forAll arbitraryBS $ \bs ->
+                decodeBase58 (encodeBase58 bs) == Just bs
+        it "encodes and decodes base58 bytestring with checksum" $
+            property $
+            forAll arbitraryBS $ \bs ->
+                decodeBase58Check (encodeBase58Check bs) == Just bs
+        it "encodes and decodes address" $
+            property $
+            forAll (arbitraryAddress net) $ \a ->
+                (stringToAddr net =<< addrToString a) == Just a

test/Network/Haskoin/Crypto/Base58/Units.hs

@@ -1,22 +1,20 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Network.Haskoin.Crypto.Base58.Units (tests) where
+module Network.Haskoin.Crypto.Base58.Units (spec) where
 
-import           Data.ByteString                (ByteString)
-import qualified Data.ByteString                as BS (append, empty, pack)
+import           Data.ByteString        (ByteString)
+import qualified Data.ByteString        as BS (append, empty, pack)
 import           Network.Haskoin.Crypto
-import           Test.Framework                 (Test, testGroup)
-import           Test.Framework.Providers.HUnit (testCase)
-import           Test.HUnit                     (Assertion, assertBool)
+import           Test.Hspec
+import           Test.HUnit             (Assertion, assertBool)
 
-tests :: [Test]
-tests =
-    [ testGroup "Test base58 encodings" $
-        zipWith (curry mapBase58Vec) vectors [0..]
-    ]
+spec :: Spec
+spec =
+    describe "base58 encodings" $
+    sequence_ $ zipWith (curry mapBase58Vec) vectors [0 ..]
 
-mapBase58Vec :: ((ByteString, ByteString, ByteString), Int) -> Test.Framework.Test
+mapBase58Vec :: ((ByteString, ByteString, ByteString), Int) -> Spec
 mapBase58Vec (v, i) =
-    testCase (unwords [ "Test base58 vector", show i ]) $ runVector v
+    it (unwords ["test base58 vector", show i]) $ runVector v
 
 runVector :: (ByteString, ByteString, ByteString) -> Assertion
 runVector (bs, e, chk) = do

test/Network/Haskoin/Crypto/ECDSA/Tests.hs

@@ -1,37 +1,35 @@
-module Network.Haskoin.Crypto.ECDSA.Tests (tests) where
+module Network.Haskoin.Crypto.ECDSA.Tests (spec) where
 
-import           Data.Bits                            (testBit)
-import qualified Data.ByteString                      as BS (index, length)
-import           Data.Serialize                       (encode)
+import           Data.Bits                 (testBit)
+import qualified Data.ByteString           as BS (index, length)
+import           Data.Serialize            (encode)
+import           Network.Haskoin.Constants
 import           Network.Haskoin.Crypto
 import           Network.Haskoin.Test
 import           Network.Haskoin.Util
-import           Test.Framework                       (Test, testGroup)
-import           Test.Framework.Providers.QuickCheck2 (testProperty)
+import           Test.Hspec
 import           Test.QuickCheck
 
-tests :: [Test]
-tests =
-    [ testGroup
-          "ECDSA signatures"
-          [ testProperty "Verify signature" $
+spec :: Network -> Spec
+spec net = do
+    describe "ecdsa signatures" $ do
+        it "verify signature" $
+            property $
             forAll arbitrarySignature $ \(msg, key, sig) ->
                 verifySig msg sig (derivePubKey key)
-          , testProperty "S component <= order/2" $
-            forAll arbitrarySignature $ isCanonicalHalfOrder . lst3
-          ]
-    , testGroup
-          "ECDSA Binary"
-          [ testProperty "Encoded signature is canonical" $
-            forAll arbitrarySignature $ testIsCanonical . lst3
-          , testProperty "decodeStrict . encode sig == id" $
+        it "s component ≤ order ÷ 2" $
+            property $ forAll arbitrarySignature $ isCanonicalHalfOrder . lst3
+    describe "ecdsa binary" $ do
+        it "encoded signature is canonical" $
+            property $ forAll arbitrarySignature $ testIsCanonical . lst3
+        it "decodeStrict . encode sig == id" $
+            property $
             forAll arbitrarySignature $
             (\s -> decodeStrictSig (encode s) == Just s) . lst3
-          , testProperty "decode . encode sig == id" $
+        it "decode . encode sig == id" $
+            property $
             forAll arbitrarySignature $
             (\s -> decodeLaxSig (encode s) == Just s) . lst3
-          ]
-    ]
 
 {- ECDSA Canonical -}
 

test/Network/Haskoin/Crypto/ExtendedKeys/Tests.hs

@@ -0,0 +1,61 @@
+module Network.Haskoin.Crypto.ExtendedKeys.Tests (spec) where
+
+import           Data.Bits                 ((.&.))
+import           Data.String               (fromString)
+import           Data.String.Conversions   (cs)
+import           Data.Word                 (Word32)
+import           Network.Haskoin.Constants
+import           Network.Haskoin.Crypto
+import           Network.Haskoin.Test
+import           Test.Hspec
+import           Test.QuickCheck hiding ((.&.))
+
+spec :: Network -> Spec
+spec net = do
+    describe "extended keys" $ do
+        it "computes pubkey of a subkey is subkey of the pubkey" $
+            property $
+            forAll (arbitraryXPrvKey net) pubKeyOfSubKeyIsSubKeyOfPubKey
+        it "exports and imports extended private key" $
+            property $
+            forAll (arbitraryXPrvKey net) $ \k ->
+                xPrvImport net (xPrvExport k) == Just k
+        it "exports and imports extended public key" $
+            property $
+            forAll (arbitraryXPubKey net) $ \(_, k) ->
+                xPubImport net (xPubExport k) == Just k
+        it "show and read derivation path" $
+            property $ forAll arbitraryDerivPath $ \p -> read (show p) == p
+        it "show and read hard derivation path" $
+            property $ forAll arbitraryHardPath $ \p -> read (show p) == p
+        it "show and read soft derivation path" $
+            property $ forAll arbitrarySoftPath $ \p -> read (show p) == p
+        it "from string derivation path" $
+            property $
+            forAll arbitraryDerivPath $ \p -> fromString (cs $ pathToStr p) == p
+        it "from string hard derivation path" $
+            property $
+            forAll arbitraryHardPath $ \p -> fromString (cs $ pathToStr p) == p
+        it "from string soft derivation path" $
+            property $
+            forAll arbitrarySoftPath $ \p -> fromString (cs $ pathToStr p) == p
+        it "from and to lists of derivation paths" $
+            property $
+            forAll arbitraryDerivPath $ \p -> listToPath (pathToList p) == p
+        it "from and to lists of hard derivation paths" $
+            property $
+            forAll arbitraryHardPath $ \p ->
+                toHard (listToPath $ pathToList p) == Just p
+        it "from and to lists of soft derivation paths" $
+            property $
+            forAll arbitrarySoftPath $ \p ->
+                toSoft (listToPath $ pathToList p) == Just p
+        it "read and show parsed path" $
+            property $ forAll arbitraryParsedPath $ \p -> read (show p) == p
+
+pubKeyOfSubKeyIsSubKeyOfPubKey :: XPrvKey -> Word32 -> Bool
+pubKeyOfSubKeyIsSubKeyOfPubKey k i =
+    deriveXPubKey (prvSubKey k i') == pubSubKey (deriveXPubKey k) i'
+  where
+    i' = fromIntegral $ i .&. 0x7fffffff -- make it a public derivation
+

test/Network/Haskoin/Crypto/ExtendedKeys/Units.hs

@@ -1,67 +1,63 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Network.Haskoin.Crypto.ExtendedKeys.Units (tests) where
+module Network.Haskoin.Crypto.ExtendedKeys.Units (spec) where
 
-import qualified Data.Aeson                     as Aeson (decode, encode)
-import           Data.ByteString                (ByteString)
-import qualified Data.ByteString.Lazy.Char8     as B8
-import           Data.Either                    (isLeft)
-import           Data.Maybe                     (fromJust, isJust, isNothing)
-import           Data.Serialize                 (encode)
-import           Data.String                    (fromString)
+import qualified Data.Aeson                 as Aeson (decode, encode)
+import           Data.ByteString            (ByteString)
+import qualified Data.ByteString.Lazy.Char8 as B8
+import           Data.Either                (isLeft)
+import           Data.Maybe                 (fromJust, isJust, isNothing)
+import           Data.Serialize             (encode, runPut)
+import           Data.String                (fromString)
+import           Network.Haskoin.Constants
 import           Network.Haskoin.Crypto
 import           Network.Haskoin.Util
-import           Test.Framework                 (Test, testGroup)
-import           Test.Framework.Providers.HUnit (testCase)
-import           Test.HUnit                     (Assertion, assertBool,
-                                                 assertEqual)
+import           Test.Hspec
+import           Test.HUnit                 (Assertion, assertBool, assertEqual)
 
-tests :: [Test]
-tests =
-    [ testGroup "BIP32 derivation vector 1"
-        [ testCase "Chain m" $ runXKeyVec (head xKeyVec)
-        , testCase "Chain m/0'" $ runXKeyVec (xKeyVec !! 1)
-        , testCase "Chain m/0'/1" $ runXKeyVec (xKeyVec !! 2)
-        , testCase "Chain m/0'/1/2'" $ runXKeyVec (xKeyVec !! 3)
-        , testCase "Chain m/0'/1/2'/2" $ runXKeyVec (xKeyVec !! 4)
-        , testCase "Chain m/0'/1/2'/2/1000000000" $
-            runXKeyVec (xKeyVec !! 5)
-        ]
-    , testGroup "BIP32 subkey derivation vector 2"
-        [ testCase "Chain m" $ runXKeyVec (head xKeyVec2)
-        , testCase "Chain m/0" $ runXKeyVec (xKeyVec2 !! 1)
-        , testCase "Chain m/0/2147483647'" $
-            runXKeyVec (xKeyVec2 !! 2)
-        , testCase "Chain m/0/2147483647'/1" $
-            runXKeyVec (xKeyVec2 !! 3)
-        , testCase "Chain m/0/2147483647'/1/2147483646'" $
-            runXKeyVec (xKeyVec2 !! 4)
-        , testCase "Chain m/0/2147483647'/1/2147483646'/2" $
-            runXKeyVec (xKeyVec2 !! 5)
-        ]
-    , testGroup "BIP32 subkey derivation using string path"
-        [ testGroup "Either Derivations" testApplyPath
-        , testGroup "Either Derivations" testBadApplyPath
-        , testGroup "Public Derivations" testDerivePubPath
-        , testGroup "Private Derivations" testDerivePrvPath
-        , testGroup "Path Parsing" testParsePath
-        , testGroup "FromJSON" testFromJsonPath
-        , testGroup "ToJSON" testToJsonPath
-        ]
-    ]
+spec :: Spec
+spec = do
+    describe "BIP32 derivation vector 1" $ do
+        it "chain m" $ runXKeyVec (head xKeyVec)
+        it "chain m/0'" $ runXKeyVec (xKeyVec !! 1)
+        it "chain m/0'/1" $ runXKeyVec (xKeyVec !! 2)
+        it "chain m/0'/1/2'" $ runXKeyVec (xKeyVec !! 3)
+        it "chain m/0'/1/2'/2" $ runXKeyVec (xKeyVec !! 4)
+        it "chain m/0'/1/2'/2/1000000000" $ runXKeyVec (xKeyVec !! 5)
+    describe "BIP32 subkey derivation vector 2" $ do
+        it "chain m" $ runXKeyVec (head xKeyVec2)
+        it "chain m/0" $ runXKeyVec (xKeyVec2 !! 1)
+        it "chain m/0/2147483647'" $ runXKeyVec (xKeyVec2 !! 2)
+        it "chain m/0/2147483647'/1" $ runXKeyVec (xKeyVec2 !! 3)
+        it "chain m/0/2147483647'/1/2147483646'" $ runXKeyVec (xKeyVec2 !! 4)
+        it "Chain m/0/2147483647'/1/2147483646'/2" $ runXKeyVec (xKeyVec2 !! 5)
+    describe "BIP32 subkey derivation using string path" $ do
+        it "either derivations" testApplyPath
+        it "either derivations" testBadApplyPath
+        it "dublic derivations" testDerivePubPath
+        it "private derivations" testDerivePrvPath
+        it "path parsing" testParsePath
+        it "from json" testFromJsonPath
+        it "to json" testToJsonPath
 
-testFromJsonPath :: [Test]
-testFromJsonPath = do
-    path <- jsonPathVectors
-    return $ testCase ("Path " ++ path) $
-        assertEqual path (Just [fromString path :: DerivPath])
-            (Aeson.decode $ B8.pack $ "[\"" ++ path ++ "\"]")
+testFromJsonPath :: Assertion
+testFromJsonPath =
+    sequence_ $ do
+        path <- jsonPathVectors
+        return $
+            assertEqual
+                path
+                (Just [fromString path :: DerivPath])
+                (Aeson.decode $ B8.pack $ "[\"" ++ path ++ "\"]")
 
-testToJsonPath :: [Test]
-testToJsonPath = do
-    path <- jsonPathVectors
-    return $ testCase ("Path " ++ path) $
-        assertEqual path (B8.pack $ "[\"" ++ path ++ "\"]")
-            (Aeson.encode [fromString path :: ParsedPath])
+testToJsonPath :: Assertion
+testToJsonPath =
+    sequence_ $ do
+        path <- jsonPathVectors
+        return $
+            assertEqual
+                path
+                (B8.pack $ "[\"" ++ path ++ "\"]")
+                (Aeson.encode [fromString path :: ParsedPath])
 
 jsonPathVectors :: [String]
 jsonPathVectors =
@@ -77,11 +73,11 @@ jsonPathVectors =
     , "M/1'/2'/3/4"
     ]
 
-testParsePath :: [Test]
-testParsePath = do
-    (path, t) <- parsePathVectors
-    return $ testCase ("Path " ++ path) $
-        assertBool path (t $ parsePath path)
+testParsePath :: Assertion
+testParsePath =
+    sequence_ $ do
+        (path, t) <- parsePathVectors
+        return $ assertBool path (t $ parsePath path)
 
 parsePathVectors :: [(String, Maybe ParsedPath -> Bool)]
 parsePathVectors =
@@ -105,32 +101,34 @@ parsePathVectors =
     , ("NaN", isNothing)
     ]
 
-testApplyPath :: [Test]
-testApplyPath = do
-    (key, path, final) <- applyPathVectors
-    return $ testCase ("Path " ++ path) $
-        assertEqual path final $
-            applyPath (fromJust $ parsePath path) key
+testApplyPath :: Assertion
+testApplyPath =
+    sequence_ $ do
+        (key, path, final) <- applyPathVectors
+        return $
+            assertEqual path final $ applyPath (fromJust $ parsePath path) key
 
-testBadApplyPath :: [Test]
-testBadApplyPath = do
-    (key, path) <- badApplyPathVectors
-    return $ testCase ("Path " ++ path) $
-        assertBool path $ isLeft $
-            applyPath (fromJust $ parsePath path) key
+testBadApplyPath :: Assertion
+testBadApplyPath =
+    sequence_ $ do
+        (key, path) <- badApplyPathVectors
+        return $
+            assertBool path $ isLeft $ applyPath (fromJust $ parsePath path) key
 
-testDerivePubPath :: [Test]
-testDerivePubPath = do
-    (key, path, final) <- derivePubPathVectors
-    return $ testCase ("Path " ++ path) $
-        assertEqual path final $
+testDerivePubPath :: Assertion
+testDerivePubPath =
+    sequence_ $ do
+        (key, path, final) <- derivePubPathVectors
+        return $
+            assertEqual path final $
             derivePubPath (fromString path :: SoftPath) key
 
-testDerivePrvPath :: [Test]
-testDerivePrvPath = do
-    (key, path, final) <- derivePrvPathVectors
-    return $ testCase ("Path " ++ path) $
-        assertEqual path final $
+testDerivePrvPath :: Assertion
+testDerivePrvPath =
+    sequence_ $ do
+        (key, path, final) <- derivePrvPathVectors
+        return $
+            assertEqual path final $
             derivePath (fromString path :: DerivPath) key
 
 derivePubPathVectors :: [(XPubKey, String, XPubKey)]
@@ -140,7 +138,7 @@ derivePubPathVectors =
     , ( xpub, "M/8/30/1", foldl pubSubKey xpub [8,30,1] )
     ]
   where
-    xprv = fromJust $ xPrvImport
+    xprv = fromJust $ xPrvImport btc
         "xprv9s21ZrQH143K46iDVRSyFfGfMgQjzC4BV3ZUfNbG7PHQrJjE53ofAn5gYkp6KQ\
         \WzGmb8oageSRxBY8s4rjr9VXPVp2HQDbwPt4H31Gg4LpB"
     xpub = deriveXPubKey xprv
@@ -165,48 +163,56 @@ derivePrvPathVectors =
       )
     ]
   where
-    xprv = fromJust $ xPrvImport
+    xprv = fromJust $ xPrvImport btc
         "xprv9s21ZrQH143K46iDVRSyFfGfMgQjzC4BV3ZUfNbG7PHQrJjE53ofAn5gYkp6KQ\
         \WzGmb8oageSRxBY8s4rjr9VXPVp2HQDbwPt4H31Gg4LpB"
 
 applyPathVectors :: [(XKey, String, Either String XKey)]
 applyPathVectors =
-    [ ( XPrv xprv, "m", Right $ XPrv xprv )
-    , ( XPrv xprv, "M", Right $ XPub xpub )
-    , ( XPrv xprv, "m/8'", Right $ XPrv $ hardSubKey xprv 8 )
-    , ( XPrv xprv, "M/8'", Right $ XPub $ deriveXPubKey $ hardSubKey xprv 8 )
-    , ( XPrv xprv, "m/8'/30/1"
-      , Right $ XPrv $ foldl prvSubKey (hardSubKey xprv 8) [30,1]
-      )
-    , ( XPrv xprv, "M/8'/30/1"
-      , Right $ XPub $
-          deriveXPubKey $ foldl prvSubKey (hardSubKey xprv 8) [30,1]
-      )
-    , ( XPrv xprv, "m/3/20"
-      , Right $ XPrv $ foldl prvSubKey xprv [3,20]
-      )
-    , ( XPrv xprv, "M/3/20"
-      , Right $ XPub $ deriveXPubKey $ foldl prvSubKey xprv [3,20]
-      )
-    , ( XPub xpub, "M/3/20"
-      , Right $ XPub $ deriveXPubKey $ foldl prvSubKey xprv [3,20]
-      )
+    [ (XPrv xprv btc, "m", Right (XPrv xprv btc))
+    , (XPrv xprv btc, "M", Right (XPub xpub btc))
+    , (XPrv xprv btc, "m/8'", Right (XPrv (hardSubKey xprv 8) btc))
+    , ( XPrv xprv btc
+      , "M/8'"
+      , Right (XPub (deriveXPubKey (hardSubKey xprv 8)) btc))
+    , ( XPrv xprv btc
+      , "m/8'/30/1"
+      , Right (XPrv (foldl prvSubKey (hardSubKey xprv 8) [30, 1]) btc))
+    , ( XPrv xprv btc
+      , "M/8'/30/1"
+      , Right
+            (XPub
+                 (deriveXPubKey (foldl prvSubKey (hardSubKey xprv 8) [30, 1]))
+                 btc))
+    , (XPrv xprv btc, "m/3/20", Right (XPrv (foldl prvSubKey xprv [3, 20]) btc))
+    , ( XPrv xprv btc
+      , "M/3/20"
+      , Right (XPub (deriveXPubKey (foldl prvSubKey xprv [3, 20])) btc))
+    , ( XPub xpub btc
+      , "M/3/20"
+      , Right (XPub (deriveXPubKey (foldl prvSubKey xprv [3, 20])) btc))
     ]
   where
-    xprv = fromJust $ xPrvImport
-        "xprv9s21ZrQH143K46iDVRSyFfGfMgQjzC4BV3ZUfNbG7PHQrJjE53ofAn5gYkp6KQ\
+    xprv =
+        fromJust $
+        xPrvImport
+            btc
+            "xprv9s21ZrQH143K46iDVRSyFfGfMgQjzC4BV3ZUfNbG7PHQrJjE53ofAn5gYkp6KQ\
         \WzGmb8oageSRxBY8s4rjr9VXPVp2HQDbwPt4H31Gg4LpB"
     xpub = deriveXPubKey xprv
 
 badApplyPathVectors :: [(XKey, String)]
-badApplyPathVectors = [
-    ( XPub xpub, "m/8'" )
-  , ( XPub xpub, "M/8'" )
-  , ( XPub xpub, "M/1/2/3'/4/5" )
-  ]
+badApplyPathVectors =
+    [ (XPub xpub btc, "m/8'")
+    , (XPub xpub btc, "M/8'")
+    , (XPub xpub btc, "M/1/2/3'/4/5")
+    ]
   where
-    xprv = fromJust $ xPrvImport
-        "xprv9s21ZrQH143K46iDVRSyFfGfMgQjzC4BV3ZUfNbG7PHQrJjE53ofAn5gYkp6KQ\
+    xprv =
+        fromJust $
+        xPrvImport
+            btc
+            "xprv9s21ZrQH143K46iDVRSyFfGfMgQjzC4BV3ZUfNbG7PHQrJjE53ofAn5gYkp6KQ\
         \WzGmb8oageSRxBY8s4rjr9VXPVp2HQDbwPt4H31Gg4LpB"
     xpub = deriveXPubKey xprv
 
@@ -217,16 +223,14 @@ runXKeyVec (v, m) = do
     assertBool "xPrvFP" $ encodeHex (encode $ xPrvFP m) == v !! 1
     assertBool "xPrvAddr" $
         addrToString (xPubAddr $ deriveXPubKey m) == Just (v !! 2)
-    assertBool "prvKey" $
-        encodeHex (encodePrvKey $ xPrvKey m) == v !! 3
+    assertBool "prvKey" $ encodeHex (encodePrvKey $ xPrvKey m) == v !! 3
     assertBool "xPrvWIF" $ xPrvWif m == v !! 4
     assertBool "pubKey" $
         encodeHex (encode $ xPubKey $ deriveXPubKey m) == v !! 5
-    assertBool "chain code" $
-        encodeHex (encode $ xPrvChain m) == v !! 6
+    assertBool "chain code" $ encodeHex (encode $ xPrvChain m) == v !! 6
     assertBool "Hex PubKey" $
-        encodeHex (encode $ deriveXPubKey m) == v !! 7
-    assertBool "Hex PrvKey" $ encodeHex (encode m) == v !! 8
+        encodeHex (runPut $ putXPubKey $ deriveXPubKey m) == v !! 7
+    assertBool "Hex PrvKey" $ encodeHex (runPut (putXPrvKey m)) == v !! 8
     assertBool "Base58 PubKey" $ xPubExport (deriveXPubKey m) == v !! 9
     assertBool "Base58 PrvKey" $ xPrvExport m == v !! 10
 
@@ -236,7 +240,7 @@ runXKeyVec (v, m) = do
 xKeyVec :: [([ByteString], XPrvKey)]
 xKeyVec = zip xKeyResVec $ foldl f [m] der
     where f acc d = acc ++ [d $ last acc]
-          m   = makeXPrvKey $ fromJust $ decodeHex m0
+          m   = makeXPrvKey btc $ fromJust $ decodeHex m0
           der = [ flip hardSubKey 0
                 , flip prvSubKey 1
                 , flip hardSubKey 2
@@ -247,7 +251,7 @@ xKeyVec = zip xKeyResVec $ foldl f [m] der
 xKeyVec2 :: [([ByteString], XPrvKey)]
 xKeyVec2 = zip xKeyResVec2 $ foldl f [m] der
     where f acc d = acc ++ [d $ last acc]
-          m   = makeXPrvKey $ fromJust $ decodeHex m1
+          m   = makeXPrvKey btc $ fromJust $ decodeHex m1
           der = [ flip prvSubKey 0
                 , flip hardSubKey 2147483647
                 , flip prvSubKey 1

test/Network/Haskoin/Crypto/Hash/Tests.hs

@@ -0,0 +1,46 @@
+module Network.Haskoin.Crypto.Hash.Tests (spec) where
+
+import           Data.Serialize            (encode)
+import           Data.String               (fromString)
+import           Data.String.Conversions
+import           Network.Haskoin.Block
+import           Network.Haskoin.Crypto
+import           Network.Haskoin.Test
+import           Network.Haskoin.Util      (encodeHex)
+import           Test.Hspec
+import           Test.QuickCheck
+
+spec :: Spec
+spec =
+    describe "hash" $ do
+        it "join512( split512(h) ) == h" $
+            property $
+            forAll arbitraryHash256 $ forAll arbitraryHash256 . joinSplit512
+        it "decodeCompact . encodeCompact i == i" $ property decEncCompact
+        it "from string 64-byte hash" $
+            property $
+            forAll arbitraryHash512 $ \h ->
+                fromString (cs $ encodeHex $ encode h) == h
+        it "from string 32-byte hash" $
+            property $
+            forAll arbitraryHash256 $ \h ->
+                fromString (cs $ encodeHex $ encode h) == h
+        it "from string 20-byte hash" $
+            property $
+            forAll arbitraryHash160 $ \h ->
+                fromString (cs $ encodeHex $ encode h) == h
+
+joinSplit512 :: Hash256 -> Hash256 -> Bool
+joinSplit512 a b = split512 (join512 (a, b)) == (a, b)
+
+-- After encoding and decoding, we may loose precision so the new result is >=
+-- to the old one.
+decEncCompact :: Integer -> Bool
+decEncCompact i
+    -- Integer completely fits inside the mantisse
+    | abs i <= 0x007fffff = decodeCompact (encodeCompact i) == (i, False)
+    -- Otherwise precision will be lost and the decoded result will
+    -- be smaller than the original number
+    | i >= 0              = fst (decodeCompact (encodeCompact i)) < i
+    | otherwise           = fst (decodeCompact (encodeCompact i)) > i
+

test/Network/Haskoin/Crypto/Hash/Units.hs

@@ -1,37 +1,35 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Network.Haskoin.Crypto.Hash.Units (tests) where
+module Network.Haskoin.Crypto.Hash.Units (spec) where
 
-import           Data.ByteString                (ByteString)
-import           Data.Maybe                     (fromJust)
+import           Data.ByteString        (ByteString)
+import           Data.Maybe             (fromJust)
 import           Network.Haskoin.Crypto
 import           Network.Haskoin.Util
-import           Test.Framework                 (Test, testGroup)
-import           Test.Framework.Providers.HUnit (testCase)
-import           Test.HUnit                     (Assertion, assertBool)
+import           Test.Hspec
+import           Test.HUnit             (Assertion, assertBool)
 
 -- Test vectors from NIST
 -- http://csrc.nist.gov/groups/STM/cavp/documents/drbg/drbgtestvectors.zip
 -- About 1/3 of HMAC DRBG SHA-256 test vectors are tested here
 
-tests :: [Test]
-tests =
-    [ testGroup "HMAC DRBG Suite 1" [mapDRBG t1]
-    , testGroup "HMAC DRBG Suite 2" [mapDRBG t2]
-    , testGroup "HMAC DRBG Suite 3" [mapDRBG t3]
-    , testGroup "HMAC DRBG Suite 4" [mapDRBG t4]
-    , testGroup "HMAC DRBG Suite 5 (Reseed)" [mapDRBGRsd r1]
-    , testGroup "HMAC DRBG Suite 6 (Reseed)" [mapDRBGRsd r2]
-    , testGroup "HMAC DRBG Suite 7 (Reseed)" [mapDRBGRsd r3]
-    , testGroup "HMAC DRBG Suite 8 (Reseed)" [mapDRBGRsd r4]
-    ]
+spec :: Spec
+spec = describe "HMAC DRBG" $ do
+    it "HMAC DRBG suite 1" $ sequence_ [mapDRBG t1]
+    it "HMAC DRBG suite 2" $ sequence_ [mapDRBG t2]
+    it "HMAC DRBG suite 3" $ sequence_ [mapDRBG t3]
+    it "HMAC DRBG suite 4" $ sequence_ [mapDRBG t4]
+    it "HMAC DRBG suite 5 (Reseed)" $ sequence_ [mapDRBGRsd r1]
+    it "HMAC DRBG suite 6 (Reseed)" $ sequence_ [mapDRBGRsd r2]
+    it "HMAC DRBG suite 7 (Reseed)" $ sequence_ [mapDRBGRsd r3]
+    it "HMAC DRBG suite 8 (Reseed)" $ sequence_ [mapDRBGRsd r4]
 
 type TestVector = [ByteString]
 
-mapDRBG :: [TestVector] -> Test.Framework.Test
-mapDRBG vs = testCase "HMAC DRBG Vectors" $ mapM_ testDRBG $ zip vs [0..]
+mapDRBG :: [TestVector] -> Assertion
+mapDRBG vs = mapM_ testDRBG $ zip vs [0..]
 
-mapDRBGRsd :: [TestVector] -> Test.Framework.Test
-mapDRBGRsd vs = testCase "HMAC DRBG Vectors" $ mapM_ testDRBGRsd $ zip vs [0..]
+mapDRBGRsd :: [TestVector] -> Assertion
+mapDRBGRsd vs = mapM_ testDRBGRsd $ zip vs [0..]
 
 testDRBG :: (TestVector, Int) -> Assertion
 testDRBG (s,i) = do

test/Network/Haskoin/Crypto/Keys/Tests.hs

@@ -0,0 +1,110 @@
+module Network.Haskoin.Crypto.Keys.Tests (spec) where
+
+import qualified Crypto.Secp256k1          as EC
+import qualified Data.ByteString           as BS
+import           Data.Serialize            (encode, runGet, runPut)
+import           Data.String               (fromString)
+import           Data.String.Conversions   (cs)
+import           Network.Haskoin.Constants
+import           Network.Haskoin.Crypto
+import           Network.Haskoin.Test
+import           Network.Haskoin.Util
+import           Test.Hspec
+import           Test.QuickCheck
+
+spec :: Network -> Spec
+spec net = do
+    describe "pubkey binary" $ do
+        it "is public key canonical" $
+            property $ forAll arbitraryPubKey (isCanonicalPubKey . snd)
+        it "makeKey . toKey" $ property makeToKey
+        it "makeKeyU . toKey" $ property makeToKeyU
+    describe "key formats" $ do
+        it "fromWif . toWif PrvKey" $
+            property $
+            forAll arbitraryPrvKey $ \pk ->
+                fromWif net (toWif net pk) == Just pk
+        it "constant 32-byte encoding PrvKey" $
+            property $ forAll arbitraryPrvKey binaryPrvKey
+    describe "key compression" $ do
+        it "compressed public key" $ property testCompressed
+        it "uncompressed public key" $ property testUnCompressed
+        it "compressed private key" $ property testPrivateCompressed
+        it "uncompressed private key" $ property testPrivateUnCompressed
+    describe "keys from and to strings" $ do
+        it "read and show public key" $
+            property $ forAll arbitraryPubKey $ \(_, k) -> read (show k) == k
+        it "read and show compressed public key" $
+            property $ forAll arbitraryPubKeyC $ \(_, k) -> read (show k) == k
+        it "read and show uncompressed public key" $
+            property $ forAll arbitraryPubKeyU $ \(_, k) -> read (show k) == k
+        it "read and show private key" $
+            property $ forAll arbitraryPrvKey $ \k -> read (show k) == k
+        it "read and show compressed private key" $
+            property $ forAll arbitraryPrvKeyC $ \k -> read (show k) == k
+        it "read and show uncompressed private key" $
+            property $ forAll arbitraryPrvKeyU $ \k -> read (show k) == k
+        it "from string public key" $
+            property $
+            forAll arbitraryPubKey $ \(_, k) ->
+                fromString (cs . encodeHex $ encode k) == k
+        it "from string compressed public key" $
+            property $
+            forAll arbitraryPubKeyC $ \(_, k) ->
+                fromString (cs . encodeHex $ encode k) == k
+        it "from string uncompressed public key" $
+            property $
+            forAll arbitraryPubKeyU $ \(_, k) ->
+                fromString (cs . encodeHex $ encode k) == k
+
+-- github.com/bitcoin/bitcoin/blob/master/src/script.cpp
+-- from function IsCanonicalPubKey
+isCanonicalPubKey :: PubKey -> Bool
+isCanonicalPubKey p = not $
+    -- Non-canonical public key: too short
+    (BS.length bs < 33) ||
+    -- Non-canonical public key: invalid length for uncompressed key
+    (BS.index bs 0 == 4 && BS.length bs /= 65) ||
+    -- Non-canonical public key: invalid length for compressed key
+    (BS.index bs 0 `elem` [2,3] && BS.length bs /= 33) ||
+    -- Non-canonical public key: compressed nor uncompressed
+    (BS.index bs 0 `notElem` [2,3,4])
+  where
+    bs = encode p
+
+makeToKey :: EC.SecKey -> Bool
+makeToKey i = prvKeySecKey (makePrvKey i) == i
+
+makeToKeyU :: EC.SecKey -> Bool
+makeToKeyU i = prvKeySecKey (makePrvKeyU i) == i
+
+{- Key formats -}
+
+binaryPrvKey :: PrvKey -> Bool
+binaryPrvKey k =
+    (Right k == runGet (prvKeyGetMonad f) (runPut $ prvKeyPutMonad k)) &&
+    (Just k == decodePrvKey f (encodePrvKey k))
+  where
+    f = makePrvKeyG (prvKeyCompressed k)
+
+{- Key Compression -}
+
+testCompressed :: EC.SecKey -> Bool
+testCompressed n =
+    pubKeyCompressed (derivePubKey $ makePrvKey n) &&
+    pubKeyCompressed (derivePubKey $ makePrvKeyG True n)
+
+testUnCompressed :: EC.SecKey -> Bool
+testUnCompressed n =
+    not (pubKeyCompressed $ derivePubKey $ makePrvKeyG False n) &&
+    not (pubKeyCompressed $ derivePubKey $ makePrvKeyU n)
+
+testPrivateCompressed :: EC.SecKey -> Bool
+testPrivateCompressed n =
+    prvKeyCompressed (makePrvKey n) &&
+    prvKeyCompressed (makePrvKeyC n)
+
+testPrivateUnCompressed :: EC.SecKey -> Bool
+testPrivateUnCompressed n =
+    not (prvKeyCompressed $ makePrvKeyG False n) &&
+    not (prvKeyCompressed $ makePrvKeyU n)

test/Network/Haskoin/Crypto/Mnemonic/Tests.hs

@@ -1,47 +1,37 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Network.Haskoin.Crypto.Mnemonic.Tests (tests) where
+module Network.Haskoin.Crypto.Mnemonic.Tests (spec) where
 
-import           Data.Bits                            (shiftR, (.&.))
-import qualified Data.ByteString                      as BS
-import qualified Data.ByteString.Char8                as C
-import           Data.Either                          (fromRight)
-import           Data.Serialize                       (Serialize, encode)
-import           Data.Word                            (Word32, Word64)
+import           Data.Bits              (shiftR, (.&.))
+import qualified Data.ByteString        as BS
+import qualified Data.ByteString.Char8  as C
+import           Data.Either            (fromRight)
+import           Data.Serialize         (Serialize, encode)
+import           Data.Word              (Word32, Word64)
 import           Network.Haskoin.Crypto
 import           Network.Haskoin.Test
-import           Test.Framework
-import           Test.Framework.Providers.QuickCheck2
-import           Test.QuickCheck                      (Arbitrary, Property,
-                                                       arbitrary, choose, (==>))
+import           Test.Hspec
+import           Test.QuickCheck        hiding ((.&.))
 
-tests :: [Test]
-tests =
-    [ testGroup "Encode mnemonic"
-        [ testProperty "128-bit entropy -> 12 words" toMnemonic128
-        , testProperty "160-bit entropy -> 18 words" toMnemonic160
-        , testProperty "256-bit entropy -> 24 words" toMnemonic256
-        , testProperty "512-bit entropy -> 48 words" toMnemonic512
-        , testProperty "n-bit entropy -> m words" toMnemonicVar
-        ]
-    , testGroup "Encode/Decode Mnemonic"
-        [ testProperty "128-bit entropy" fromToMnemonic128
-        , testProperty "160-bit entropy" fromToMnemonic160
-        , testProperty "256-bit entropy" fromToMnemonic256
-        , testProperty "512-bit entropy" fromToMnemonic512
-        , testProperty "n-bit entropy" fromToMnemonicVar
-        ]
-    , testGroup "Mnemonic to seed"
-        [ testProperty "128-bit entropy" mnemonicToSeed128
-        , testProperty "160-bit entropy" mnemonicToSeed160
-        , testProperty "256-bit entropy" mnemonicToSeed256
-        , testProperty "512-bit entropy" mnemonicToSeed512
-        , testProperty "n-bit entropy" mnemonicToSeedVar
-        ]
-    , testGroup "Get bits from ByteString"
-        [ testProperty "Byte count" getBitsByteCount
-        , testProperty "End bits" getBitsEndBits
-        ]
-    ]
+spec :: Spec
+spec = do
+    describe "mnemonic" $ do
+        it "generate 12 words" $ property toMnemonic128
+        it "generate 18 words" $ property toMnemonic160
+        it "generate 24 words" $ property toMnemonic256
+        it "generate 48 words" $ property toMnemonic512
+        it "generate any number of words" $ property toMnemonicVar
+        it "encode and decode 128-bit entropy" $ property fromToMnemonic128
+        it "encode and decode 160-bit entropy" $ property fromToMnemonic160
+        it "encode and decode 256-bit entropy" $ property fromToMnemonic256
+        it "encode and decode 512-bit entropy" $ property fromToMnemonic512
+        it "encode and decode n-bit entropy" $ property fromToMnemonicVar
+        it "convert 128-bit mnemonic to seed" $ property mnemonicToSeed128
+        it "convert 160-bit mnemonic to seed" $ property mnemonicToSeed160
+        it "convert 256-bit mnemonic to seed" $ property mnemonicToSeed256
+        it "convert 512-bit mnemonic to seed" $ property mnemonicToSeed512
+        it "convert n-bit mnemonic to seed" $ property mnemonicToSeedVar
+        it "get bits" $ property getBitsByteCount
+        it "get end bits" $ property getBitsEndBits
 
 binWordsToBS :: Serialize a => [a] -> BS.ByteString
 binWordsToBS = foldr f BS.empty

test/Network/Haskoin/Crypto/Mnemonic/Units.hs

@@ -1,72 +1,64 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Network.Haskoin.Crypto.Mnemonic.Units (tests) where
+module Network.Haskoin.Crypto.Mnemonic.Units (spec) where
 
-import           Data.ByteString                (ByteString)
-import qualified Data.ByteString                as BS
-import qualified Data.ByteString.Char8          as C
-import           Data.Either                    (fromRight)
-import           Data.List                      (isPrefixOf)
-import           Data.Maybe                     (fromJust)
-import           Data.String.Conversions        (cs)
+import           Data.ByteString         (ByteString)
+import qualified Data.ByteString         as BS
+import qualified Data.ByteString.Char8   as C
+import           Data.Either             (fromRight)
+import           Data.List               (isPrefixOf)
+import           Data.Maybe              (fromJust)
+import           Data.String.Conversions (cs)
 import           Network.Haskoin.Crypto
 import           Network.Haskoin.Util
-import           Test.Framework                 (Test, testGroup)
-import           Test.Framework.Providers.HUnit (testCase)
-import           Test.HUnit                     (assertBool, assertEqual)
+import           Test.Hspec
+import           Test.HUnit
 
-tests :: [Test]
-tests =
-    [ testGroup "Entropy to mnemonic sentence" toMnemonicTest
-    , testGroup "Mnemonic sentence to entropy" fromMnemonicTest
-    , testGroup "Mnemonic sentence to seed" mnemonicToSeedTest
-    , testGroup "Mnemonic sentence with invalid checksum" fromMnemonicInvalidTest
-    , testGroup "Empty mnemonic sentence is invalid" [emptyMnemonicTest]
-    ]
+spec :: Spec
+spec = describe "mnemonic units" $ do
+    it "entropy to mnemonic sentence" toMnemonicTest
+    it "mnemonic sentence to entropy" fromMnemonicTest
+    it "mnemonic sentence to seed" mnemonicToSeedTest
+    it "mnemonic sentence with invalid checksum" fromMnemonicInvalidTest
+    it "empty mnemonic sentence is invalid" $ sequence_ [emptyMnemonicTest]
 
-toMnemonicTest :: [Test]
-toMnemonicTest = zipWith f ents mss
+toMnemonicTest :: Assertion
+toMnemonicTest = sequence_ $ zipWith f ents mss
   where
-    f e m = g (cs e) . assertEqual "" m . h $ e
-    g = testCase
+    f e m = assertEqual "" m . h $ e
     h =
         fromRight (error "Could not decode mnemonic sentence") .
         toMnemonic . fromJust . decodeHex
 
-fromMnemonicTest :: [Test]
-fromMnemonicTest = zipWith f ents mss
+fromMnemonicTest :: Assertion
+fromMnemonicTest = sequence_ $ zipWith f ents mss
   where
-    f e = g (cs e) . assertEqual "" e . h
-    g = testCase
+    f e = assertEqual "" e . h
     h =
         encodeHex .
         fromRight (error "Could not decode mnemonic sentence") . fromMnemonic
 
-mnemonicToSeedTest :: [Test]
-mnemonicToSeedTest = zipWith f mss seeds
+mnemonicToSeedTest :: Assertion
+mnemonicToSeedTest = sequence_ $ zipWith f mss seeds
   where
-    f m s = g s . assertEqual "" s . h $ m
-    g = testCase . (++ "...") . cs . BS.take 50
+    f m s = assertEqual "" s . h $ m
     h =
         encodeHex .
         fromRight (error "Could not decode mnemonic seed") .
         mnemonicToSeed "TREZOR"
 
-fromMnemonicInvalidTest :: [Test]
-fromMnemonicInvalidTest = map f invalidMss
+fromMnemonicInvalidTest :: Assertion
+fromMnemonicInvalidTest = sequence_ $ map f invalidMss
   where
-    f m = g m . assertBool "" . h $ m
-    g m = let ms = length (C.words m)
-              msg = concat [ "[MS: ", show ms, "]"
-                           , cs (BS.take 50 m), "..." ]
-           in testCase msg
+    f m = assertBool "" . h $ m
     h m = case fromMnemonic m of
             Right _  -> False
             Left err -> "fromMnemonic: checksum failed:" `isPrefixOf` err
 
-emptyMnemonicTest :: Test
-emptyMnemonicTest = testCase "mnemonic sentence can not be empty" $
-    assertBool "" $ case fromMnemonic "" of
-        Right _  -> False
+emptyMnemonicTest :: Assertion
+emptyMnemonicTest =
+    assertBool "" $
+    case fromMnemonic "" of
+        Right _ -> False
         Left err -> "fromMnemonic: empty mnemonic" `isPrefixOf` err
 
 ents :: [ByteString]

test/Network/Haskoin/Crypto/Units.hs

@@ -1,18 +1,18 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Network.Haskoin.Crypto.Units (tests) where
+module Network.Haskoin.Crypto.Units (spec) where
 
-import           Control.Monad                  (replicateM_)
-import           Control.Monad.Trans            (liftIO)
-import qualified Crypto.Secp256k1               as EC (SecKey, exportCompactSig)
-import           Data.ByteString                (ByteString)
-import qualified Data.ByteString.Char8          as C (pack)
-import           Data.Maybe                     (fromJust, isJust, isNothing)
-import           Data.Serialize                 (encode)
+import           Control.Monad             (replicateM_)
+import           Control.Monad.Trans       (liftIO)
+import qualified Crypto.Secp256k1          as EC (SecKey, exportCompactSig)
+import           Data.ByteString           (ByteString)
+import qualified Data.ByteString.Char8     as C (pack)
+import           Data.Maybe                (fromJust, isJust, isNothing)
+import           Data.Serialize            (encode)
+import           Network.Haskoin.Constants
 import           Network.Haskoin.Crypto
 import           Network.Haskoin.Util
-import           Test.Framework                 (Test, testGroup)
-import           Test.Framework.Providers.HUnit (testCase)
-import           Test.HUnit                     (Assertion, assertBool)
+import           Test.Hspec
+import           Test.HUnit                (Assertion, assertBool)
 
 -- Unit tests copied from bitcoind implementation
 -- https://github.com/bitcoin/bitcoin/blob/master/src/test/key_tests.cpp
@@ -51,16 +51,16 @@ sigMsg =
     ]
 
 sec1 :: PrvKey
-sec1  = fromJust $ fromWif strSecret1
+sec1  = fromJust $ fromWif btc strSecret1
 
 sec2 :: PrvKey
-sec2  = fromJust $ fromWif strSecret2
+sec2  = fromJust $ fromWif btc strSecret2
 
 sec1C :: PrvKey
-sec1C = fromJust $ fromWif strSecret1C
+sec1C = fromJust $ fromWif btc strSecret1C
 
 sec2C :: PrvKey
-sec2C = fromJust $ fromWif strSecret2C
+sec2C = fromJust $ fromWif btc strSecret2C
 
 pub1 :: PubKey
 pub1  = derivePubKey sec1
@@ -74,35 +74,34 @@ pub1C = derivePubKey sec1C
 pub2C :: PubKey
 pub2C = derivePubKey sec2C
 
-tests :: [Test]
-tests =
-    [ testGroup "ECDSA PRNG unit tests"
-        [ testCase "genPrvKey produces unique keys" uniqueKeys
-        ]
-    , testGroup "bitcoind /src/test/key_tests.cpp" $
-        [ testCase "Decode Valid WIF" checkPrivkey
-        , testCase "Decode Invalid WIF" checkInvalidKey
-        , testCase "Decode MiniKey format" checkMiniKey
-        , testCase "Check private key compression" checkPrvKeyCompressed
-        , testCase "Check public key compression" checkKeyCompressed
-        , testCase "Check matching address" checkMatchingAddress
-        ] ++
-        map (\x -> testCase ("Check sig: " ++ show x) $ checkSignatures (doubleSHA256 x)) sigMsg
-    , testGroup "Trezor RFC 6979 Test Vectors"
-        [ testCase "RFC 6979 Test Vector 1" (testSigning $ head detVec)
-        , testCase "RFC 6979 Test Vector 2" (testSigning $ detVec !! 1)
-        , testCase "RFC 6979 Test Vector 3" (testSigning $ detVec !! 2)
-        , testCase "RFC 6979 Test Vector 4" (testSigning $ detVec !! 3)
-        , testCase "RFC 6979 Test Vector 5" (testSigning $ detVec !! 4)
-        , testCase "RFC 6979 Test Vector 6" (testSigning $ detVec !! 5)
-        , testCase "RFC 6979 Test Vector 7" (testSigning $ detVec !! 6)
-        , testCase "RFC 6979 Test Vector 8" (testSigning $ detVec !! 7)
-        , testCase "RFC 6979 Test Vector 9" (testSigning $ detVec !! 8)
-        , testCase "RFC 6979 Test Vector 10" (testSigning $ detVec !! 9)
-        , testCase "RFC 6979 Test Vector 11" (testSigning $ detVec !! 10)
-        , testCase "RFC 6979 Test Vector 12" (testSigning $ detVec !! 11)
-        ]
-    ]
+spec :: Spec
+spec = do
+    describe "ECDSA PRNG unit tests" $
+        it "genPrvKey produces unique keys" uniqueKeys
+    describe "bitcoind /src/test/key_tests.cpp" $ do
+        it "decode valid WIF" checkPrivkey
+        it "decode invalid WIF" checkInvalidKey
+        it "decode minikey format" checkMiniKey
+        it "check private key compression" checkPrvKeyCompressed
+        it "check public key compression" checkKeyCompressed
+        it "check matching address" checkMatchingAddress
+        mapM_
+            (\x ->
+                 it ("check sig: " ++ show x) $ checkSignatures (doubleSHA256 x))
+            sigMsg
+    describe "trezor RFC 6979 test vectors" $ do
+        it "RFC 6979 test vector 1" (testSigning $ head detVec)
+        it "RFC 6979 test vector 2" (testSigning $ detVec !! 1)
+        it "RFC 6979 test vector 3" (testSigning $ detVec !! 2)
+        it "RFC 6979 test vector 4" (testSigning $ detVec !! 3)
+        it "RFC 6979 test vector 5" (testSigning $ detVec !! 4)
+        it "RFC 6979 test vector 6" (testSigning $ detVec !! 5)
+        it "RFC 6979 test vector 7" (testSigning $ detVec !! 6)
+        it "RFC 6979 test vector 8" (testSigning $ detVec !! 7)
+        it "RFC 6979 test vector 9" (testSigning $ detVec !! 8)
+        it "RFC 6979 test vector 10" (testSigning $ detVec !! 9)
+        it "RFC 6979 test vector 11" (testSigning $ detVec !! 10)
+        it "RFC 6979 test vector 12" (testSigning $ detVec !! 11)
 
 {- ECDSA PRNG unit tests -}
 
@@ -120,14 +119,14 @@ uniqueKeys = do
 
 checkPrivkey :: Assertion
 checkPrivkey = do
-    assertBool "Key 1"  $ isJust $ fromWif strSecret1
-    assertBool "Key 2"  $ isJust $ fromWif strSecret2
-    assertBool "Key 1C" $ isJust $ fromWif strSecret1C
-    assertBool "Key 2C" $ isJust $ fromWif strSecret2C
+    assertBool "Key 1"  $ isJust $ fromWif btc strSecret1
+    assertBool "Key 2"  $ isJust $ fromWif btc strSecret2
+    assertBool "Key 1C" $ isJust $ fromWif btc strSecret1C
+    assertBool "Key 2C" $ isJust $ fromWif btc strSecret2C
 
 checkInvalidKey :: Assertion
 checkInvalidKey =
-    assertBool "Bad key" $ isNothing $ fromWif strAddressBad
+    assertBool "Bad key" $ isNothing $ fromWif btc strAddressBad
 
 checkMiniKey :: Assertion
 checkMiniKey =
@@ -156,10 +155,10 @@ checkKeyCompressed = do
 
 checkMatchingAddress :: Assertion
 checkMatchingAddress = do
-    assertBool "Key 1"  $ Just addr1  == addrToString (pubKeyAddr pub1)
-    assertBool "Key 2"  $ Just addr2  == addrToString (pubKeyAddr pub2)
-    assertBool "Key 1C" $ Just addr1C == addrToString (pubKeyAddr pub1C)
-    assertBool "Key 2C" $ Just addr2C == addrToString (pubKeyAddr pub2C)
+    assertBool "Key 1"  $ Just addr1  == addrToString (pubKeyAddr btc pub1)
+    assertBool "Key 2"  $ Just addr2  == addrToString (pubKeyAddr btc pub2)
+    assertBool "Key 1C" $ Just addr1C == addrToString (pubKeyAddr btc pub1C)
+    assertBool "Key 2C" $ Just addr2C == addrToString (pubKeyAddr btc pub2C)
 
 checkSignatures :: Hash256 -> Assertion
 checkSignatures h = do

test/Network/Haskoin/Json/Tests.hs

@@ -0,0 +1,50 @@
+module Network.Haskoin.Json.Tests
+    ( spec
+    ) where
+
+import           Data.Aeson
+import           Data.Aeson.Types
+import           Data.HashMap.Strict       (singleton)
+import           Network.Haskoin.Constants
+import           Network.Haskoin.Crypto
+import           Network.Haskoin.Test
+import           Test.Hspec
+import           Test.QuickCheck
+
+spec :: Network -> Spec
+spec net = do
+    describe "serialize & de-serialize haskoin types to json" $ do
+        it "encodes and decodes script output" $
+            forAll (arbitraryScriptOutput net) testID
+        it "encodes and decodes outpoint" $ forAll arbitraryOutPoint testID
+        it "encodes and decodes address" $
+            forAll (arbitraryAddress net) (testCustom (addrFromJSON net))
+        it "encodes and decodes transaction" $ forAll (arbitraryTx net) testID
+        it "encodes and decodes transaction hash" $
+            forAll arbitraryTxHash testID
+        it "encodes and decodes block hash" $ forAll arbitraryBlockHash testID
+        it "encodes and decodes sighash" $ forAll arbitrarySigHash testID
+        it "encodes and decodes siginput" $
+            forAll (arbitrarySigInput net) (testID . fst)
+        it "encodes and decodes public key" $
+            forAll arbitraryPubKey (testID . snd)
+        it "encodes and decodes compressed public key" $
+            forAll arbitraryPubKeyC (testID . snd)
+        it "encodes and decodes uncompressed public key" $
+            forAll arbitraryPubKeyU (testID . snd)
+        it "encodes and decodes extended private key" $
+            forAll (arbitraryXPrvKey net) (testCustom (xPrvFromJSON net))
+        it "encodes and decodes extended public key" $
+            forAll (arbitraryXPubKey net) (testCustom (xPubFromJSON net) . snd)
+        it "encodes and decodes derivation path" $
+            forAll arbitraryDerivPath testID
+        it "encodes and decodes parsed derivation path" $
+            forAll arbitraryParsedPath testID
+
+testID :: (FromJSON a, ToJSON a, Eq a) => a -> Bool
+testID x =
+    (decode . encode) (singleton ("object" :: String) x) ==
+    Just (singleton ("object" :: String) x)
+
+testCustom :: (ToJSON a, Eq a) => (Value -> Parser a) -> a -> Bool
+testCustom f x = parseMaybe f (toJSON x) == Just x

test/Network/Haskoin/Network/Units.hs

@@ -1,26 +1,23 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Network.Haskoin.Network.Units (tests) where
+module Network.Haskoin.Network.Units (spec) where
 
-import           Data.ByteString                (ByteString)
-import           Data.Maybe                     (fromJust)
-import           Data.Serialize                 (encode)
-import           Data.Word                      (Word32)
+import           Data.ByteString           (ByteString)
+import           Data.Maybe                (fromJust)
+import           Data.Serialize            (encode)
+import           Data.Word                 (Word32)
+import           Network.Haskoin.Constants
 import           Network.Haskoin.Crypto
 import           Network.Haskoin.Network
 import           Network.Haskoin.Util
-import           Test.Framework                 (Test, testGroup)
-import           Test.Framework.Providers.HUnit (testCase)
-import           Test.HUnit                     (Assertion, assertBool)
+import           Test.Hspec
+import           Test.HUnit                (Assertion, assertBool)
 
-tests :: [Test]
-tests =
-    [ -- Test cases come from bitcoind /src/test/bloom_tests.cpp
-      testGroup "Bloom Filters"
-        [ testCase "Bloom Filter Vector 1" bloomFilter1
-        , testCase "Bloom Filter Vector 2" bloomFilter2
-        , testCase "Bloom Filter Vector 3" bloomFilter3
-        ]
-    ]
+spec :: Spec
+spec = do
+    describe "bloom filters" $ do
+        it "bloom filter vector 1" bloomFilter1
+        it "bloom filter vector 2" bloomFilter2
+        it "bloom filter vector 3" bloomFilter3
 
 bloomFilter :: Word32 -> ByteString -> Assertion
 bloomFilter n x = do
@@ -55,7 +52,7 @@ bloomFilter3 =
   where
     f0 = bloomCreate 2 0.001 0 BloomUpdateAll
     f1 = bloomInsert f0 $ encode p
-    f2 = bloomInsert f1 $ encode $ getAddrHash $ pubKeyAddr p
-    k = fromJust $ fromWif "5Kg1gnAjaLfKiwhhPpGS3QfRg2m6awQvaj98JCZBZQ5SuS2F15C"
+    f2 = bloomInsert f1 $ encode $ getAddrHash $ pubKeyAddr btc p
+    k = fromJust $ fromWif btc "5Kg1gnAjaLfKiwhhPpGS3QfRg2m6awQvaj98JCZBZQ5SuS2F15C"
     p = derivePubKey k
     bs = fromJust $ decodeHex "038fc16b080000000000000001"

test/Network/Haskoin/Script/Spec.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Network.Haskoin.Script.Spec where
+module Network.Haskoin.Script.Spec (spec) where
 
 import           Control.Monad
 import qualified Crypto.Secp256k1            as EC
@@ -15,6 +15,7 @@ import           Data.Serialize
 import           Data.String
 import           Data.String.Conversions     (cs)
 import           Data.Word
+import           Network.Haskoin.Constants
 import           Network.Haskoin.Crypto
 import           Network.Haskoin.Script
 import           Network.Haskoin.Test
@@ -24,59 +25,55 @@ import           Test.Hspec
 import           Test.QuickCheck
 import           Text.Read
 
-spec :: Spec
-spec = do
-    standardSpec
-    strictSigSpec
-    scriptSpec
-    sigHashSpec
-    txSigHashSpec
+spec :: Network -> Spec
+spec net = do
+    describe "scripts" $ do
+        standardSpec net
+        strictSigSpec net
+        scriptSpec net
+        txSigHashForkIdSpec net
+        forkIdScriptSpec net
+    describe "sighash" $ do
+        sigHashSpec net
+        txSigHashSpec net
 
-forkIdSpec :: Spec
-forkIdSpec = do
-    txSigHashForkIdSpec
-    forkIdScriptSpec
+standardSpec :: Network -> Spec
+standardSpec net = do
+    it "has intToScriptOp . scriptOpToInt identity" $
+        property $
+        forAll arbitraryIntScriptOp $ \i ->
+            intToScriptOp <$> scriptOpToInt i `shouldBe` Right i
+    it "has decodeOutput . encodeOutput identity" $
+        property $
+        forAll (arbitraryScriptOutput net) $ \so ->
+            decodeOutput (encodeOutput so) `shouldBe` Right so
+    it "has decodeInput . encodeOutput identity" $
+        property $
+        forAll arbitraryScriptInput $ \si ->
+            decodeInput net (encodeInput si) `shouldBe` Right si
+    it "can sort multisig scripts" $
+        forAll arbitraryMSOutput $ \out ->
+            map encode (getOutputMulSigKeys (sortMulSig out)) `shouldSatisfy` \xs ->
+                xs == sort xs
+    it "can decode inputs with empty signatures" $ do
+        decodeInput net (Script [OP_0]) `shouldBe`
+            Right (RegularInput (SpendPK TxSignatureEmpty))
+        decodeInput net (Script [opPushData ""]) `shouldBe`
+            Right (RegularInput (SpendPK TxSignatureEmpty))
+        let pk =
+                derivePubKey $
+                makePrvKey $ fromJust $ EC.secKey $ BS.replicate 32 1
+        decodeInput net (Script [OP_0, opPushData $ encode pk]) `shouldBe`
+            Right (RegularInput (SpendPKHash TxSignatureEmpty pk))
+        decodeInput net (Script [OP_0, OP_0]) `shouldBe`
+            Right (RegularInput (SpendMulSig [TxSignatureEmpty]))
+        decodeInput net (Script [OP_0, OP_0, OP_0, OP_0]) `shouldBe`
+            Right (RegularInput (SpendMulSig $ replicate 3 TxSignatureEmpty))
 
-standardSpec :: Spec
-standardSpec =
-    describe "Network.Haskoin.Script.Standard" $ do
-        it "has intToScriptOp . scriptOpToInt identity" $
-            property $
-            forAll arbitraryIntScriptOp $ \i ->
-                intToScriptOp <$> scriptOpToInt i `shouldBe` Right i
-        it "has decodeOutput . encodeOutput identity" $
-            property $
-            forAll arbitraryScriptOutput $ \so ->
-                decodeOutput (encodeOutput so) `shouldBe` Right so
-        it "has decodeInput . encodeOutput identity" $
-            property $
-            forAll arbitraryScriptInput $ \si ->
-                decodeInput (encodeInput si) `shouldBe` Right si
-        it "can sort multisig scripts" $
-            forAll arbitraryMSOutput $ \out ->
-                map encode (getOutputMulSigKeys (sortMulSig out))
-                `shouldSatisfy`
-                \xs -> xs == sort xs
-        it "can decode inputs with empty signatures" $ do
-            decodeInput (Script [OP_0]) `shouldBe`
-                Right (RegularInput (SpendPK TxSignatureEmpty))
-            decodeInput (Script [opPushData ""]) `shouldBe`
-                Right (RegularInput (SpendPK TxSignatureEmpty))
-            let pk =
-                    derivePubKey $
-                    makePrvKey $ fromJust $ EC.secKey $ BS.replicate 32 1
-            decodeInput (Script [OP_0, opPushData $ encode pk]) `shouldBe`
-                Right (RegularInput (SpendPKHash TxSignatureEmpty pk))
-            decodeInput (Script [OP_0, OP_0]) `shouldBe`
-                Right (RegularInput (SpendMulSig [TxSignatureEmpty]))
-            decodeInput (Script [OP_0, OP_0, OP_0, OP_0]) `shouldBe`
-                Right
-                    (RegularInput (SpendMulSig $ replicate 3 TxSignatureEmpty))
-
-scriptSpec :: Spec
-scriptSpec =
-    describe "Network.Haskoin.Script Verifier" $
-    it "Can verify standard scripts from script_tests.json file" $ do
+scriptSpec :: Network -> Spec
+scriptSpec net =
+    when (getNetworkName net == "btc") $
+    it "can verify standard scripts from script_tests.json file" $ do
         xs <- readTestFile "script_tests" :: IO [J.Value]
         let vectorsA =
                 mapMaybe (J.decode . J.encode) xs :: [( String
@@ -91,7 +88,9 @@ scriptSpec =
                                                       , String
                                                       , String
                                                       , String)]
-            vectors = map (\(a,b,c,d,e) -> ([0],a,b,c,d,e)) vectorsA <> vectorsB
+            vectors =
+                map (\(a, b, c, d, e) -> ([0], a, b, c, d, e)) vectorsA <>
+                vectorsB
         length vectors `shouldBe` 86
         forM_ vectors $ \([val], siStr, soStr, flags, res, _)
           -- We can disable specific tests by adding a DISABLED flag in the data
@@ -108,6 +107,7 @@ scriptSpec =
                         decodeOutputBS scriptPubKey
                     ver =
                         verifyStdInput
+                            net
                             strict
                             (spendTx scriptPubKey 0 scriptSig)
                             0
@@ -115,12 +115,12 @@ scriptSpec =
                             (val * 100000000)
                 case res of
                     "OK" -> ver `shouldBe` True
-                    _    -> ver `shouldBe` False
+                    _ -> ver `shouldBe` False
 
-forkIdScriptSpec :: Spec
-forkIdScriptSpec =
-    describe "Network.Haskoin.Script ForkID Verifier" $
-    it "Can verify scripts from forkid_script_tests.json file" $ do
+forkIdScriptSpec :: Network -> Spec
+forkIdScriptSpec net =
+    when (isJust (getSigHashForkId net)) $
+    it "can verify scripts from forkid_script_tests.json file" $ do
         xs <- readTestFile "forkid_script_tests" :: IO [J.Value]
         let vectors =
                 mapMaybe (J.decode . J.encode) xs :: [( [Word64]
@@ -128,7 +128,7 @@ forkIdScriptSpec =
                                                       , String
                                                       , String
                                                       , String
-                                                      , String )]
+                                                      , String)]
         length vectors `shouldBe` 3
         forM_ vectors $ \([valBTC], siStr, soStr, _, res, _) -> do
             let val = valBTC * 100000000
@@ -139,6 +139,7 @@ forkIdScriptSpec =
                     decodeOutputBS scriptPubKey
                 ver =
                     verifyStdInput
+                        net
                         True -- Always strict
                         (spendTx scriptPubKey val scriptSig)
                         0
@@ -146,7 +147,7 @@ forkIdScriptSpec =
                         val
             case res of
                 "OK" -> ver `shouldBe` True
-                _    -> ver `shouldBe` False
+                _ -> ver `shouldBe` False
 
 creditTx :: BS.ByteString -> Word64 -> Tx
 creditTx scriptPubKey val =
@@ -186,25 +187,25 @@ replaceToken str = case readMaybe $ "OP_" <> str of
     Just opcode -> "0x" <> cs (encodeHex $ encode (opcode :: ScriptOp))
     _           -> str
 
-strictSigSpec :: Spec
-strictSigSpec =
-    describe "Network.Haskoin.Script Strict" $ do
+strictSigSpec :: Network -> Spec
+strictSigSpec net =
+    when (getNetworkName net == "btc") $ do
         it "can decode strict signatures" $ do
             xs <- readTestFile "sig_strict"
             let vectors = mapMaybe (decodeHex . cs) (xs :: [String])
             length vectors `shouldBe` 3
             forM_ vectors $ \sig ->
-                decodeTxStrictSig sig `shouldSatisfy` isRight
+                decodeTxStrictSig net sig `shouldSatisfy` isRight
         it "can detect non-strict signatures" $ do
             xs <- readTestFile "sig_nonstrict"
             let vectors = mapMaybe (decodeHex . cs) (xs :: [String])
             length vectors `shouldBe` 17
             forM_ vectors $ \sig ->
-                decodeTxStrictSig sig `shouldSatisfy` isLeft
+                decodeTxStrictSig net sig `shouldSatisfy` isLeft
 
-txSigHashSpec :: Spec
-txSigHashSpec =
-    describe "Network.Haskoin.Script txSigHash" $
+txSigHashSpec :: Network -> Spec
+txSigHashSpec net =
+    when (getNetworkName net == "btc") $
     it "can produce valid sighashes from sighash.json test vectors" $ do
         xs <- readTestFile "sighash" :: IO [J.Value]
         let vectors =
@@ -223,11 +224,11 @@ txSigHashSpec =
                 res =
                     eitherToMaybe . decode . BS.reverse =<<
                     decodeHex (cs resStr)
-            Just (txSigHash tx s 0 i sh) `shouldBe` res
+            Just (txSigHash net tx s 0 i sh) `shouldBe` res
 
-txSigHashForkIdSpec :: Spec
-txSigHashForkIdSpec =
-    describe "Network.Haskoin.Script txSigHashForkId" $
+txSigHashForkIdSpec :: Network -> Spec
+txSigHashForkIdSpec net =
+    when (getNetworkName net == "btc") $
     it "can produce valid sighashes from forkid_sighash.json test vectors" $ do
         xs <- readTestFile "forkid_sighash" :: IO [J.Value]
         let vectors =
@@ -245,79 +246,77 @@ txSigHashForkIdSpec =
                     eitherToMaybe . decode =<< decodeHex (cs scpStr)
                 sh = fromIntegral shI
                 res = eitherToMaybe . decode =<< decodeHex (cs resStr)
-            Just (txSigHashForkId tx s val i sh) `shouldBe` res
+            Just (txSigHashForkId net tx s val i sh) `shouldBe` res
 
-sigHashSpec :: Spec
-sigHashSpec =
-    describe "Network.Haskoin.Script.SigHash" $ do
-        it "can read . show a SigHash" $
-            property $
-            forAll arbitrarySigHash $ \sh -> read (show sh) `shouldBe` sh
-        it "can correctly show a SigHash" $ do
-            show (0x00 :: SigHash) `shouldBe` "SigHash " <> show 0x00
-            show (0x01 :: SigHash) `shouldBe` "SigHash " <> show 0x01
-            show (0xff :: SigHash) `shouldBe` "SigHash " <> show 0xff
-            show (0xabac3344 :: SigHash) `shouldBe` "SigHash " <>
-                show 0xabac3344
-        it "can add a forkid to a SigHash" $ do
-            0x00 `sigHashAddForkId` 0x00 `shouldBe` 0x00
-            0xff `sigHashAddForkId` 0x00ffffff `shouldBe` 0xffffffff
-            0xffff `sigHashAddForkId` 0x00aaaaaa `shouldBe` 0xaaaaaaff
-            0xffff `sigHashAddForkId` 0xaaaaaaaa `shouldBe` 0xaaaaaaff
-            0xffff `sigHashAddForkId` 0x00004444 `shouldBe` 0x004444ff
-            0xff01 `sigHashAddForkId` 0x44440000 `shouldBe` 0x44000001
-            0xff03 `sigHashAddForkId` 0x00550000 `shouldBe` 0x55000003
-        it "can extract a forkid from a sighash" $ do
-            sigHashGetForkId 0x00000000 `shouldBe` 0x00000000
-            sigHashGetForkId 0x80000000 `shouldBe` 0x00800000
-            sigHashGetForkId 0xffffffff `shouldBe` 0x00ffffff
-            sigHashGetForkId 0xabac3403 `shouldBe` 0x00abac34
-        it "can build some SigHash vectors" $ do
-            sigHashAll `shouldBe` 0x01
-            sigHashNone `shouldBe` 0x02
-            sigHashSingle `shouldBe` 0x03
-            setForkIdFlag sigHashAll `shouldBe` 0x41
-            setAnyoneCanPayFlag sigHashAll `shouldBe` 0x81
-            setAnyoneCanPayFlag (setForkIdFlag sigHashAll) `shouldBe` 0xc1
-        it "can test the SigHash flags" $ do
-            hasForkIdFlag sigHashAll `shouldBe` False
-            hasForkIdFlag (setForkIdFlag sigHashAll) `shouldBe` True
-            hasAnyoneCanPayFlag sigHashAll `shouldBe` False
-            hasAnyoneCanPayFlag (setAnyoneCanPayFlag sigHashAll) `shouldBe` True
-            isSigHashAll sigHashNone `shouldBe` False
-            isSigHashAll sigHashAll `shouldBe` True
-            isSigHashNone sigHashSingle `shouldBe` False
-            isSigHashNone sigHashNone `shouldBe` True
-            isSigHashSingle sigHashAll `shouldBe` False
-            isSigHashSingle sigHashSingle `shouldBe` True
-            isSigHashUnknown sigHashAll `shouldBe` False
-            isSigHashUnknown sigHashNone `shouldBe` False
-            isSigHashUnknown sigHashSingle `shouldBe` False
-            isSigHashUnknown 0x00 `shouldBe` True
-            isSigHashUnknown 0x04 `shouldBe` True
-        it "can decodeTxLaxSig . encode a TxSignature" $
-            property $
-            forAll arbitraryTxSignature $ \(_, _, ts) ->
-                decodeTxLaxSig (encodeTxSig ts) `shouldBe` Right ts
+sigHashSpec :: Network -> Spec
+sigHashSpec net = do
+    it "can read . show" $
+        property $ forAll arbitrarySigHash $ \sh -> read (show sh) `shouldBe` sh
+    it "can correctly show" $ do
+        show (0x00 :: SigHash) `shouldBe` "SigHash " <> show 0x00
+        show (0x01 :: SigHash) `shouldBe` "SigHash " <> show 0x01
+        show (0xff :: SigHash) `shouldBe` "SigHash " <> show 0xff
+        show (0xabac3344 :: SigHash) `shouldBe` "SigHash " <> show 0xabac3344
+    it "can add a forkid" $ do
+        0x00 `sigHashAddForkId` 0x00 `shouldBe` 0x00
+        0xff `sigHashAddForkId` 0x00ffffff `shouldBe` 0xffffffff
+        0xffff `sigHashAddForkId` 0x00aaaaaa `shouldBe` 0xaaaaaaff
+        0xffff `sigHashAddForkId` 0xaaaaaaaa `shouldBe` 0xaaaaaaff
+        0xffff `sigHashAddForkId` 0x00004444 `shouldBe` 0x004444ff
+        0xff01 `sigHashAddForkId` 0x44440000 `shouldBe` 0x44000001
+        0xff03 `sigHashAddForkId` 0x00550000 `shouldBe` 0x55000003
+    it "can extract a forkid" $ do
+        sigHashGetForkId 0x00000000 `shouldBe` 0x00000000
+        sigHashGetForkId 0x80000000 `shouldBe` 0x00800000
+        sigHashGetForkId 0xffffffff `shouldBe` 0x00ffffff
+        sigHashGetForkId 0xabac3403 `shouldBe` 0x00abac34
+    it "can build some vectors" $ do
+        sigHashAll `shouldBe` 0x01
+        sigHashNone `shouldBe` 0x02
+        sigHashSingle `shouldBe` 0x03
+        setForkIdFlag sigHashAll `shouldBe` 0x41
+        setAnyoneCanPayFlag sigHashAll `shouldBe` 0x81
+        setAnyoneCanPayFlag (setForkIdFlag sigHashAll) `shouldBe` 0xc1
+    it "can test flags" $ do
+        hasForkIdFlag sigHashAll `shouldBe` False
+        hasForkIdFlag (setForkIdFlag sigHashAll) `shouldBe` True
+        hasAnyoneCanPayFlag sigHashAll `shouldBe` False
+        hasAnyoneCanPayFlag (setAnyoneCanPayFlag sigHashAll) `shouldBe` True
+        isSigHashAll sigHashNone `shouldBe` False
+        isSigHashAll sigHashAll `shouldBe` True
+        isSigHashNone sigHashSingle `shouldBe` False
+        isSigHashNone sigHashNone `shouldBe` True
+        isSigHashSingle sigHashAll `shouldBe` False
+        isSigHashSingle sigHashSingle `shouldBe` True
+        isSigHashUnknown sigHashAll `shouldBe` False
+        isSigHashUnknown sigHashNone `shouldBe` False
+        isSigHashUnknown sigHashSingle `shouldBe` False
+        isSigHashUnknown 0x00 `shouldBe` True
+        isSigHashUnknown 0x04 `shouldBe` True
+    it "can decodeTxLaxSig . encode a TxSignature" $
+        property $
+        forAll arbitraryTxSignature $ \(_, _, ts) ->
+            decodeTxLaxSig (encodeTxSig ts) `shouldBe` Right ts
+    when (getNetworkName net == "btc") $
         it "can decodeTxStrictSig . encode a TxSignature" $
-            property $
-            forAll arbitraryTxSignature $ \(_, _, ts@(TxSignature _ sh)) ->
-                if isSigHashUnknown sh || hasForkIdFlag sh
-                    then decodeTxStrictSig (encodeTxSig ts) `shouldSatisfy`
-                         isLeft
-                    else decodeTxStrictSig (encodeTxSig ts) `shouldBe` Right ts
-        it "can produce the sighash one" $
-            property $
-            forAll arbitraryTx $ forAll arbitraryScript . testSigHashOne
+        property $
+        forAll arbitraryTxSignature $ \(_, _, ts@(TxSignature _ sh)) ->
+            if isSigHashUnknown sh || hasForkIdFlag sh
+                then decodeTxStrictSig net (encodeTxSig ts) `shouldSatisfy`
+                     isLeft
+                else decodeTxStrictSig net (encodeTxSig ts) `shouldBe` Right ts
+    it "can produce the sighash one" $
+        property $
+        forAll (arbitraryTx net) $ forAll arbitraryScript . testSigHashOne net
 
-testSigHashOne :: Tx -> Script -> Word64 -> Bool -> Property
-testSigHashOne tx s val acp =
+testSigHashOne :: Network -> Tx -> Script -> Word64 -> Bool -> Property
+testSigHashOne net tx s val acp =
     not (null $ txIn tx) ==>
     if length (txIn tx) > length (txOut tx)
         then res `shouldBe` one
         else res `shouldNotBe` one
   where
-    res = txSigHash tx s val (length (txIn tx) - 1) (f sigHashSingle)
+    res = txSigHash net tx s val (length (txIn tx) - 1) (f sigHashSingle)
     one = "0100000000000000000000000000000000000000000000000000000000000000"
     f =
         if acp
@@ -328,5 +327,5 @@ testSigHashOne tx s val acp =
 
 readTestFile :: J.FromJSON a => FilePath -> IO a
 readTestFile fp = do
-    bs <- BL.readFile $ "test/data/" <> fp <> ".json"
+    bs <- BL.readFile $ "data/" <> fp <> ".json"
     maybe (error $ "Could not read test file " <> fp) return $ J.decode bs

test/Network/Haskoin/Script/Tests.hs

@@ -1,54 +1,44 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Network.Haskoin.Script.Tests
-( tests
-, execScriptIO
-, testValid
-, testInvalid
-, runTests
+( spec
 ) where
 
 import           Control.Monad
-import qualified Data.Aeson                           as A
-import           Data.ByteString                      (ByteString)
-import qualified Data.ByteString                      as BS
-import qualified Data.ByteString.Char8                as C
-import qualified Data.ByteString.Lazy.Char8           as CL
-import           Data.Char                            (ord)
-import           Data.Either                          (fromRight)
-import           Data.Int                             (Int64)
-import           Data.List                            (isPrefixOf)
-import           Data.List.Split                      (splitOn)
-import           Data.Maybe                           (catMaybes, isNothing)
+import           Control.Monad.IO.Class
+import qualified Data.Aeson                  as A
+import           Data.ByteString             (ByteString)
+import qualified Data.ByteString             as BS
+import qualified Data.ByteString.Char8       as C
+import qualified Data.ByteString.Lazy.Char8  as CL
+import           Data.Char                   (ord)
+import           Data.Either                 (fromRight)
+import           Data.Int                    (Int64)
+import           Data.List                   (isPrefixOf)
+import           Data.List.Split             (splitOn)
+import           Data.Maybe                  (catMaybes, isNothing)
 import           Data.Serialize
 import           Data.Word
+import           Network.Haskoin.Constants
 import           Network.Haskoin.Script
 import           Network.Haskoin.Transaction
-import           Numeric                              (readHex)
-import           Test.Framework
-import           Test.Framework.Providers.HUnit
-import           Test.Framework.Providers.QuickCheck2
-import           Test.Framework.Runners.Console       (defaultMainWithArgs)
-import qualified Test.HUnit                           as HUnit
-import           Text.Read                            (readMaybe)
+import           Numeric                     (readHex)
+import           Test.Hspec
+import           Test.HUnit                  as HUnit
+import           Test.QuickCheck
+import           Text.Read                   (readMaybe)
 
-tests :: [Test]
-tests =
-    [ testGroup
-          "Integer Types"
-          [ testProperty "decodeInt . encodeInt Int" testEncodeInt
-          , testProperty "decodeFullInt . encodeInt Int" testEncodeInt64
-          , testProperty "cltvDecodeInt . encodeInt Int" testEncodeCltv
-          , testProperty "decodeBool . encodeBool Bool" testEncodeBool
-          ]
-    , testFile
-          "Canonical Valid Script Test Cases"
-          "test/data/script_valid.json"
-          True
-    , testFile
-          "Canonical Invalid Script Test Cases"
-          "test/data/script_invalid.json"
-          False
-    ]
+spec :: Spec
+spec = do
+    describe "integer types" $ do
+        it "decodeInt . encodeInt Int" $ property testEncodeInt
+        it "decodeFullInt . encodeInt Int" $ property testEncodeInt64
+        it "cltvDecodeInt . encodeInt Int" $ property testEncodeCltv
+        it "decodeBool . encodeBool Bool" $ property testEncodeBool
+    describe "script file tests" $ do
+        it "runs all canonical valid scripts" $
+            testFile "data/script_valid.json" True
+        it "runs all canonical invalid scripts" $
+            testFile "data/script_invalid.json" False
 
 {- Script Evaluation Primitives -}
 
@@ -146,30 +136,20 @@ parseScript scriptString = do
         parseOp = encodeBytes <$> readMaybe ("OP_" ++ tok)
         encodeBytes = BS.unpack . encode
 
-testFile :: String -> String -> Bool -> Test
-testFile groupLabel path expected =
-    buildTest $ do
-        dat <- CL.readFile path
+testFile :: String -> Bool -> Assertion
+testFile path expected =
+    do
+        dat <- liftIO $ CL.readFile path
         case A.decode dat :: Maybe [[String]] of
-            Nothing ->
-                return $
-                testCase groupLabel $
-                HUnit.assertFailure $ "can't read test file " ++ path
+            Nothing -> assertFailure $ "can't read test file " ++ path
             Just testDefs ->
-                return $
-                testGroup groupLabel $
-                map parseTest $ filterPureComments testDefs
+                mapM_ parseTest $ filterPureComments testDefs
   where
-    parseTest :: [String] -> Test
     parseTest s =
         case testParts s of
-            Nothing ->
-                testCase "can't parse test case" $
-                HUnit.assertFailure $ "json element " ++ show s
+            Nothing -> assertFailure $ "json element " ++ show s
             Just (sig, pubKey, flags, l) -> makeTest l sig pubKey flags
-    makeTest :: String -> String -> String -> String -> Test
     makeTest l sig pubKey flags =
-        testCase label' $
         case (parseScript sig, parseScript pubKey) of
             (Left e, _) ->
                 parseError $ "can't parse sig: " ++ show sig ++ " error: " ++ e
@@ -215,32 +195,6 @@ testParts l =
            else let [sig, pubKey, flags] = x
                 in Just (sig, pubKey, flags, comment)
 
--- repl utils
-
-execScriptIO :: String -> String -> String -> IO ()
-execScriptIO sig key flgs =
-    case (parseScript sig, parseScript key) of
-        (Left e, _) -> print $ "sig parse error: " ++ e
-        (_, Left e) -> print $ "key parse error: " ++ e
-        (Right scriptSig, Right scriptPubKey) ->
-            case execScript
-                     scriptSig
-                     scriptPubKey
-                     rejectSignature
-                     (parseFlags flgs) of
-                Left e -> putStrLn $ "error " ++ show e
-                Right p -> do
-                    putStrLn "successful execution"
-                    C.putStrLn $ dumpStack $ runStack p
-
-testValid :: Test
-testValid = testFile "Canonical Valid Script Test Cases"
-            "test/data/script_valid.json" True
-
-testInvalid :: Test
-testInvalid = testFile "Canonical Valid Script Test Cases"
-              "test/data/script_invalid.json" False
-
 -- | Maximum value of sequence number
 maxSeqNum :: Word32
 maxSeqNum = 0xffffffff -- Perhaps this should be moved to constants.
@@ -292,8 +246,4 @@ scriptPairTestExec scriptSig pubKey flags =
     let bsScriptSig = encode scriptSig
         bsPubKey = encode pubKey
         spendTx = buildSpendTx bsScriptSig (buildCreditTx bsPubKey)
-    in verifySpend spendTx 0 pubKey 0 flags
-
-runTests :: [Test] -> IO ()
-runTests ts = defaultMainWithArgs ts ["--hide-success"]
-
+    in verifySpend btc spendTx 0 pubKey 0 flags

test/Network/Haskoin/Script/Units.hs

@@ -1,33 +1,32 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Network.Haskoin.Script.Units (tests) where
+module Network.Haskoin.Script.Units (spec) where
 
-import           Data.ByteString                (ByteString)
-import           Data.Either                    (fromLeft, fromRight, isRight)
-import           Data.Maybe                     (fromJust)
-import           Data.Serialize                 (decode)
+import           Data.ByteString           (ByteString)
+import           Data.Either               (fromLeft, fromRight, isRight)
+import           Data.Maybe                (fromJust)
+import           Data.Serialize            (decode)
+import           Network.Haskoin.Constants
 import           Network.Haskoin.Crypto
 import           Network.Haskoin.Script
 import           Network.Haskoin.Util
-import           Test.Framework                 (Test, testGroup)
-import           Test.Framework.Providers.HUnit (testCase)
-import           Test.HUnit                     (Assertion, assertBool)
+import           Test.Hspec
+import           Test.HUnit                (Assertion, assertBool)
 
-tests :: [Test]
-tests =
-    [ testGroup "Multi Signatures"
-        (zipWith (curry mapMulSigVector) mulSigVectors [0..])
-    , testGroup "Signature decoding"
-        (zipWith (curry sigDecodeMap) scriptSigSignatures [0..])
-    ]
+spec :: Spec
+spec = do
+    describe "multi signatures" $
+        sequence_ $ zipWith (curry mapMulSigVector) mulSigVectors [0 ..]
+    describe "signature decoding" $
+        sequence_ $ zipWith (curry sigDecodeMap) scriptSigSignatures [0 ..]
 
-mapMulSigVector :: ((ByteString, ByteString), Int) -> Test.Framework.Test
+mapMulSigVector :: ((ByteString, ByteString), Int) -> Spec
 mapMulSigVector (v, i) =
-    testCase name $ runMulSigVector v
+    it name $ runMulSigVector v
   where
-    name = "MultiSignature vector " ++ show i
+    name = "check multisig vector " <> show i
 
 runMulSigVector :: (ByteString, ByteString) -> Assertion
-runMulSigVector (a, ops) = assertBool "    >  MultiSig Vector" $ Just a == b
+runMulSigVector (a, ops) = assertBool "multisig vector" $ Just a == b
   where
     s = do
         s <- decodeHex ops
@@ -35,11 +34,11 @@ runMulSigVector (a, ops) = assertBool "    >  MultiSig Vector" $ Just a == b
     b = do
         o <- s
         d <- eitherToMaybe $ decodeOutput o
-        addrToString $ p2shAddr d
+        addrToString $ p2shAddr btc d
 
-sigDecodeMap :: (ByteString, Int) -> Test.Framework.Test
+sigDecodeMap :: (ByteString, Int) -> Spec
 sigDecodeMap (_, i) =
-    testCase ("Signature " ++ show i) func
+    it ("check signature " ++ show i) func
   where
     func = testSigDecode $ scriptSigSignatures !! i
 

test/Network/Haskoin/Transaction/Tests.hs

@@ -1,66 +1,70 @@
-module Network.Haskoin.Transaction.Tests (tests) where
+module Network.Haskoin.Transaction.Tests (spec) where
 
-import qualified Data.ByteString                      as BS
-import           Data.Either                          (fromRight, isRight)
+import qualified Data.ByteString             as BS
+import           Data.Either                 (fromRight, isRight)
 import           Data.Maybe
-import           Data.Serialize                       (encode)
-import           Data.String                          (fromString)
-import           Data.String.Conversions              (cs)
-import           Data.Word                            (Word64)
+import           Data.Serialize              (encode)
+import           Data.String                 (fromString)
+import           Data.String.Conversions     (cs)
+import           Data.Word                   (Word64)
+import           Network.Haskoin.Constants
 import           Network.Haskoin.Crypto
 import           Network.Haskoin.Script
 import           Network.Haskoin.Test
 import           Network.Haskoin.Transaction
-import           Test.Framework
-import           Test.Framework.Providers.QuickCheck2
+import           Test.Hspec
 import           Test.QuickCheck
 
-tests :: [Test]
-tests =
-    [ testGroup
-          "Transaction tests"
-          [ testProperty "decode . encode Txid" $
+spec :: Network -> Spec
+spec net =
+    describe "transaction" $ do
+        it "decode and encode txid" $
+            property $
             forAll arbitraryTxHash $ \h -> hexToTxHash (txHashToHex h) == Just h
-          , testProperty "From string transaction id" $
+        it "from string transaction id" $
+            property $
             forAll arbitraryTxHash $ \h -> fromString (cs $ txHashToHex h) == h
-          ]
-    , testGroup
-          "Building Transactions"
-          [ testProperty "building address tx" $
-            forAll arbitraryAddress $ forAll arbitrarySatoshi . testBuildAddrTx
-          , testProperty "testing guessTxSize function" $
-            forAll arbitraryAddrOnlyTxFull testGuessSize
-          , testProperty "testing chooseCoins function" $
-            forAll (listOf arbitrarySatoshi) testChooseCoins
-          , testProperty "testing chooseMSCoins function" $
+        it "building address tx" $
+            property $
+            forAll (arbitraryAddress net) $
+            forAll (arbitrarySatoshi net) . testBuildAddrTx net
+        it "guess transaction size" $
+            property $ forAll (arbitraryAddrOnlyTxFull net) (testGuessSize net)
+        it "choose coins" $
+            property $ forAll (listOf (arbitrarySatoshi net)) testChooseCoins
+        it "choose multisig coins" $
+            property $
             forAll arbitraryMSParam $
-            forAll (listOf arbitrarySatoshi) . testChooseMSCoins
-          ]
-    , testGroup
-          "Signing Transactions"
-          [ testProperty "Sign and validate transactions" $
-            forAll arbitrarySigningData testDetSignTx
-          , testProperty "Merge partially signed transactions" $
-            forAll arbitraryPartialTxs testMergeTx
-          ]
-    ]
+            forAll (listOf (arbitrarySatoshi net)) . testChooseMSCoins
+        it "sign and validate transaction" $
+            property $ forAll (arbitrarySigningData net) (testDetSignTx net)
+        it "merge partially signed transactions" $
+            property $ forAll (arbitraryPartialTxs net) (testMergeTx net)
 
 {- Building Transactions -}
 
-testBuildAddrTx :: Address -> TestCoin -> Bool
-testBuildAddrTx a (TestCoin v) =
+testBuildAddrTx :: Network -> Address -> TestCoin -> Bool
+testBuildAddrTx net a (TestCoin v) =
     case a of
-        PubKeyAddress h -> Right (PayPKHash h) == out
-        ScriptAddress h -> Right (PayScriptHash h) == out
+        PubKeyAddress h net -> Right (PayPKHash h) == out
+        ScriptAddress h net -> Right (PayScriptHash h) == out
   where
-    tx = buildAddrTx [] [(fromMaybe (error "Could not convert address to string") (addrToString a), v)]
+    tx =
+        buildAddrTx
+            net
+            []
+            [ ( fromMaybe
+                    (error "Could not convert address to string")
+                    (addrToString a)
+              , v)
+            ]
     out =
         decodeOutputBS $
         scriptOutput $
         head $ txOut (fromRight (error "Could not build transaction") tx)
 
-testGuessSize :: Tx -> Bool
-testGuessSize tx
+testGuessSize :: Network -> Tx -> Bool
+testGuessSize net tx
     -- We compute an upper bound but it should be close enough to the real size
     -- We give 2 bytes of slack on every signature (1 on r and 1 on s)
  = guess >= len && guess <= len + 2 * delta
@@ -71,7 +75,7 @@ testGuessSize tx
     ins = map f $ txIn tx
     f i =
         fromRight (error "Could not decode input") $
-        decodeInputBS $ scriptInput i
+        decodeInputBS net $ scriptInput i
     pki = length $ filter isSpendPKHash ins
     msi = concatMap shData ins
     shData (ScriptHashInput _ (PayMulSig keys r)) = [(r, length keys)]
@@ -113,21 +117,21 @@ testChooseMSCoins (m, n) coins target byteFee nOut = nOut >= 0 ==>
 
 {- Signing Transactions -}
 
-testDetSignTx :: (Tx, [SigInput], [PrvKey]) -> Bool
-testDetSignTx (tx, sigis, prv) =
-    not (verifyStdTx tx verData) &&
-    not (verifyStdTx txSigP verData) && verifyStdTx txSigC verData
+testDetSignTx :: Network -> (Tx, [SigInput], [PrvKey]) -> Bool
+testDetSignTx net  (tx, sigis, prv) =
+    not (verifyStdTx net tx verData) &&
+    not (verifyStdTx net txSigP verData) && verifyStdTx net txSigC verData
   where
     txSigP =
         fromRight (error "Could not decode transaction") $
-        signTx tx sigis (tail prv)
+        signTx net tx sigis (tail prv)
     txSigC =
         fromRight (error "Could not decode transaction") $
-        signTx txSigP sigis [head prv]
+        signTx net txSigP sigis [head prv]
     verData = map (\(SigInput s v o _ _) -> (s, v, o)) sigis
 
-testMergeTx :: ([Tx], [(ScriptOutput, Word64, OutPoint, Int, Int)]) -> Bool
-testMergeTx (txs, os) = and
+testMergeTx :: Network -> ([Tx], [(ScriptOutput, Word64, OutPoint, Int, Int)]) -> Bool
+testMergeTx net (txs, os) = and
     [ isRight mergeRes
     , length (txIn mergedTx) == length os
     , if enoughSigs then isValid else not isValid
@@ -136,12 +140,12 @@ testMergeTx (txs, os) = and
     ]
   where
     outs = map (\(so, val, op, _, _) -> (so, val, op)) os
-    mergeRes = mergeTxs txs outs
+    mergeRes = mergeTxs net txs outs
     mergedTx = fromRight (error "Could not merge") mergeRes
-    isValid = verifyStdTx mergedTx outs
+    isValid = verifyStdTx net mergedTx outs
     enoughSigs = all (\(m,c) -> c >= m) sigMap
     sigMap = map (\((_,_,_,m,_), inp) -> (m, sigCnt inp)) $ zip os $ txIn mergedTx
-    sigCnt inp = case decodeInputBS $ scriptInput inp of
+    sigCnt inp = case decodeInputBS net $ scriptInput inp of
         Right (RegularInput (SpendMulSig sigs)) -> length sigs
         Right (ScriptHashInput (SpendMulSig sigs) _) -> length sigs
         _ -> error "Invalid input script type"

test/Network/Haskoin/Transaction/Units.hs

@@ -1,48 +1,48 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Network.Haskoin.Transaction.Units (tests, satoshiCoreTxTests) where
+module Network.Haskoin.Transaction.Units (spec) where
 
-import qualified Data.Aeson                     as Aeson
-import qualified Data.Aeson.Types               as Aeson.Types
-import           Data.ByteString                (ByteString)
-import qualified Data.ByteString                as BS
-import qualified Data.ByteString.Lazy           as BL
-import           Data.Either                    (fromLeft, fromRight, isLeft,
-                                                 isRight)
-import           Data.List                      (groupBy)
-import           Data.Maybe                     (fromJust, fromMaybe)
-import           Data.Serialize                 (decode, encode)
-import           Data.Serialize.Get             (getWord32le, runGet)
-import           Data.Serialize.Put             (putWord32le, runPut)
-import           Data.String.Conversions        (convertString)
-import qualified Data.Vector                    as V
-import           Data.Word                      (Word32, Word64)
-import           GHC.Exts                       (IsString (..))
+import           Control.Monad.IO.Class
+import qualified Data.Aeson                  as Aeson
+import qualified Data.Aeson.Types            as Aeson.Types
+import           Data.ByteString             (ByteString)
+import qualified Data.ByteString             as BS
+import qualified Data.ByteString.Lazy        as BL
+import           Data.Either                 (fromLeft, fromRight, isLeft,
+                                              isRight)
+import           Data.List                   (groupBy)
+import           Data.Maybe                  (fromJust, fromMaybe)
+import           Data.Serialize              (decode, encode)
+import           Data.Serialize.Get          (getWord32le, runGet)
+import           Data.Serialize.Put          (putWord32le, runPut)
+import           Data.String.Conversions     (convertString)
+import qualified Data.Vector                 as V
+import           Data.Word                   (Word32, Word64)
+import           GHC.Exts                    (IsString (..))
+import           Network.Haskoin.Constants
 import           Network.Haskoin.Script
 import           Network.Haskoin.Transaction
 import           Network.Haskoin.Util
-import           Safe                           (readMay)
-import           Test.Framework                 (Test, testGroup)
-import           Test.Framework.Providers.HUnit (testCase)
-import           Test.HUnit                     (Assertion, assertBool)
+import           Safe                        (readMay)
+import           Test.Hspec
+import           Test.HUnit                  (Assertion, assertBool)
 
-tests :: [Test]
-tests =
-    [ testGroup "Computing TxID from Tx"
-        ( zipWith (curry mapTxIDVec) txIDVec [0..] )
-    , testGroup "Build PKHash Transaction (generated from bitcoind)"
-        ( zipWith (curry mapPKHashVec) pkHashVec [0..] )
-    , testGroup "Verify transaction (bitcoind tx_valid.json)"
-        ( zipWith (curry mapVerifyVec) verifyVec [0..] )
-    , testCase "" tEncodeSatoshiCoreScriptPubKey
-    ]
+spec :: Spec
+spec =
+    describe "transaction unit tests" $ do
+        it "compute txid from tx" $
+            sequence_ $ zipWith (curry mapTxIDVec) txIDVec [0 ..]
+        it "build pkhash transaction (generated from bitcoind)" $
+            sequence_ $ zipWith (curry mapPKHashVec) pkHashVec [0 ..]
+        it "verify transaction (bitcoind tx_valid.json)" $
+            sequence_ $ zipWith (curry mapVerifyVec) verifyVec [0 ..]
+        it "encode satoshi core script pubkey" tEncodeSatoshiCoreScriptPubKey
+        satoshiCoreTxTests
 
-mapTxIDVec :: ((ByteString, ByteString), Int) -> Test.Framework.Test
-mapTxIDVec (v,i) = testCase name $ runTxIDVec v
-  where
-    name = "Compute TxID " ++ show i
+mapTxIDVec :: ((ByteString, ByteString), Int) -> Assertion
+mapTxIDVec (v,i) = runTxIDVec v
 
 runTxIDVec :: (ByteString, ByteString) -> Assertion
-runTxIDVec (tid, tx) = assertBool "TxID" $ txHashToHex (txHash txBS) == tid
+runTxIDVec (tid, tx) = assertBool "txid" $ txHashToHex (txHash txBS) == tid
   where
     txBS = fromJust $ either (const Nothing) return . decode =<< decodeHex tx
 
@@ -63,9 +63,8 @@ txIDVec =
     ]
 
 mapPKHashVec :: (([(ByteString, Word32)], [(ByteString, Word64)], ByteString), Int)
-            -> Test.Framework.Test
-mapPKHashVec (v, i) = testCase name $ runPKHashVec v
-    where name = "Build PKHash Tx " ++ show i
+            -> Assertion
+mapPKHashVec (v, i) = runPKHashVec v
 
 runPKHashVec :: ([(ByteString, Word32)], [(ByteString, Word64)], ByteString) -> Assertion
 runPKHashVec (xs, ys, res) =
@@ -73,21 +72,20 @@ runPKHashVec (xs, ys, res) =
   where
     tx =
         fromRight (error "Could not decode transaction") $
-        buildAddrTx (map f xs) ys
+        buildAddrTx btc (map f xs) ys
     f (tid, ix) = OutPoint (fromJust $ hexToTxHash tid) ix
 
 
 mapVerifyVec :: (SatoshiCoreTxTest, Int)
-             -> Test.Framework.Test
-mapVerifyVec (v@(SatoshiCoreTxTest d _ _), i) = testCase name $ runVerifyVec v i
-    where name = "Verify Tx " ++ show i ++ ", about: " ++ d
+             -> Assertion
+mapVerifyVec (v@(SatoshiCoreTxTest d _ _), i) = runVerifyVec v i
 
 runVerifyVec :: SatoshiCoreTxTest -> Int -> Assertion
 runVerifyVec (SatoshiCoreTxTest _ is bsTx) i =
-    assertBool name $ verifyStdTx tx outputsAndOutpoints
+    assertBool name $ verifyStdTx btc tx outputsAndOutpoints
   where
     name =
-        "    > Verify transaction " ++ show i ++ "bsTx: " ++ convertString bsTx
+        "verify transaction " ++ show i ++ "bsTx: " ++ convertString bsTx
     tx :: Tx
     tx = fromJust $ either (const Nothing) return . decode =<< decodeHex bsTx
     outputsAndOutpoints :: [(ScriptOutput, Word64, OutPoint)]
@@ -310,14 +308,12 @@ encodeSatoshiCoreScriptPubKey =
             Just i  -> encodeHex . encode . intToScriptOp $ i
             Nothing -> error $ "encodeSatoshiCoreScriptPubKey: " ++ s
 
-satoshiCoreTxTests :: IO [Test]
+satoshiCoreTxTests :: Spec
 satoshiCoreTxTests = do
-    txVec <- satoshiCoreTxVec
-    return
-        [ testGroup
-              "Verify transaction (bitcoind tx_valid.json) (using copied source json)"
-              (map mapVerifyVec . filter isCurrentlyPassing $ zip txVec [0 ..])
-        ]
+    it "verify transaction (bitcoind tx_valid.json) (using copied source json)" $ do
+        txVec <- satoshiCoreTxVec
+        sequence_ $
+            map mapVerifyVec . filter isCurrentlyPassing $ zip txVec [0 ..]
   where
     passingTests = [0 .. 5] ++ [8] ++ [11 .. 13] ++ [16 .. 18] ++ [20] ++ [52]
     isCurrentlyPassing (_, testNum) = testNum `elem` passingTests
@@ -326,7 +322,7 @@ satoshiCoreTxTests = do
 type TestComment = String
 satoshiCoreTxVec :: IO [SatoshiCoreTxTest]
 satoshiCoreTxVec = do
-    tx_validBS <- BL.readFile "test/data/tx_valid.json"
+    tx_validBS <- BL.readFile "data/tx_valid.json"
     let testsAndComments =
             fromMaybe (error "satoshiCoreTxVec, couldn't decode json") .
             Aeson.decode $
@@ -348,7 +344,7 @@ satoshiCoreTxVec = do
                 Data.List.groupBy
                     (\x y -> (isLeft x && isLeft y) || (isRight x && isRight y))
             takePairs (a:b:xs) = (a, b) : takePairs xs
-            takePairs _ = [] -- ugh, wish we were using a real parser.
+            takePairs _        = [] -- ugh, wish we were using a real parser.
             includeDescriptions (descriptionLines, tests') =
                 map updateDescription tests'
               where

test/Network/Haskoin/Util/Tests.hs

@@ -1,34 +1,26 @@
-module Network.Haskoin.Util.Tests (tests) where
+module Network.Haskoin.Util.Tests (spec) where
 
-import qualified Data.ByteString                      as BS
-import           Data.Either                          (fromLeft, fromRight,
-                                                       isLeft, isRight)
-import           Data.Foldable                        (toList)
-import           Data.List                            (permutations)
+import qualified Data.ByteString      as BS
+import           Data.Either          (fromLeft, fromRight, isLeft, isRight)
+import           Data.Foldable        (toList)
+import           Data.List            (permutations)
 import           Data.Maybe
-import qualified Data.Sequence                        as Seq
+import qualified Data.Sequence        as Seq
 import           Network.Haskoin.Test
 import           Network.Haskoin.Util
-import           Test.Framework
-import           Test.Framework.Providers.QuickCheck2
+import           Test.Hspec
 import           Test.QuickCheck
 
-tests :: [Test]
-tests =
-    [ testGroup
-          "Utility functions"
-          [ testProperty "bsToInteger . integerToBS" getPutInteger
-          , testProperty "decodeHex . encodeHex" $ forAll arbitraryBS fromToHex
-          , testProperty
-                "compare updateIndex with Data.Sequence"
-                testUpdateIndex
-          , testProperty "matchTemplate" testMatchTemplate
-          , testProperty
-                "testing matchTemplate with two lists"
-                testMatchTemplateLen
-          , testProperty "Testing Either helper functions" testEither
-          ]
-    ]
+spec :: Spec
+spec =
+    describe "utility functions" $ do
+        it "bsToInteger . integerToBS" $ property getPutInteger
+        it "decodeHex . encodeHex" $ property $ forAll arbitraryBS fromToHex
+        it "compare updateIndex with Data.Sequence" $ property $ testUpdateIndex
+        it "matchTemplate" $ property testMatchTemplate
+        it "testing matchTemplate with two lists" $
+            property testMatchTemplateLen
+        it "either helper functions" $ property testEither
 
 {- Various utilities -}
 

test/Spec.hs

@@ -0,0 +1,71 @@
+import           Network.Haskoin.Constants
+import           Test.Hspec
+
+-- Util tests
+import qualified Network.Haskoin.Util.Tests                (spec)
+
+-- Crypto tests
+import qualified Network.Haskoin.Crypto.Base58.Tests       (spec)
+import qualified Network.Haskoin.Crypto.Base58.Units       (spec)
+import qualified Network.Haskoin.Crypto.ECDSA.Tests        (spec)
+import qualified Network.Haskoin.Crypto.ExtendedKeys.Tests (spec)
+import qualified Network.Haskoin.Crypto.ExtendedKeys.Units (spec)
+import qualified Network.Haskoin.Crypto.Hash.Tests         (spec)
+import qualified Network.Haskoin.Crypto.Hash.Units         (spec)
+import qualified Network.Haskoin.Crypto.Keys.Tests         (spec)
+import qualified Network.Haskoin.Crypto.Mnemonic.Tests     (spec)
+import qualified Network.Haskoin.Crypto.Mnemonic.Units     (spec)
+import qualified Network.Haskoin.Crypto.Units              (spec)
+
+-- Network tests
+import qualified Network.Haskoin.Network.Units             (spec)
+
+-- Script tests
+import qualified Network.Haskoin.Script.Spec               (spec)
+import qualified Network.Haskoin.Script.Tests              (spec)
+import qualified Network.Haskoin.Script.Units              (spec)
+
+-- Transaction tests
+import qualified Network.Haskoin.Transaction.Tests         (spec)
+import qualified Network.Haskoin.Transaction.Units         (spec)
+
+-- Block tests
+import qualified Network.Haskoin.Block.Spec                (spec)
+import qualified Network.Haskoin.Block.Tests               (spec)
+import qualified Network.Haskoin.Block.Units               (spec)
+
+-- Json tests
+import qualified Network.Haskoin.Json.Tests                (spec)
+
+-- Binary tests
+import qualified Network.Haskoin.Cereal.Tests              (spec)
+
+main :: IO ()
+main = do
+  hspec $ do
+      Network.Haskoin.Script.Spec.spec btc
+      Network.Haskoin.Script.Spec.spec bch
+      Network.Haskoin.Block.Spec.spec bchRegTest
+      Network.Haskoin.Block.Spec.spec btcRegTest
+      Network.Haskoin.Block.Tests.spec btc
+      Network.Haskoin.Cereal.Tests.spec btc
+      Network.Haskoin.Crypto.Base58.Tests.spec btc
+      Network.Haskoin.Crypto.ExtendedKeys.Tests.spec btc
+      Network.Haskoin.Crypto.ExtendedKeys.Units.spec
+      Network.Haskoin.Crypto.Keys.Tests.spec btc
+      Network.Haskoin.Crypto.Units.spec
+      Network.Haskoin.Json.Tests.spec btc
+      Network.Haskoin.Network.Units.spec
+      Network.Haskoin.Script.Tests.spec
+      Network.Haskoin.Script.Units.spec
+      Network.Haskoin.Block.Units.spec
+      Network.Haskoin.Crypto.Base58.Units.spec
+      Network.Haskoin.Crypto.ECDSA.Tests.spec btc
+      Network.Haskoin.Crypto.Hash.Tests.spec
+      Network.Haskoin.Crypto.Hash.Units.spec
+      Network.Haskoin.Crypto.Mnemonic.Tests.spec
+      Network.Haskoin.Crypto.Mnemonic.Units.spec
+      Network.Haskoin.Transaction.Tests.spec btc
+      Network.Haskoin.Transaction.Units.spec
+      Network.Haskoin.Util.Tests.spec
+

test/bch/Main.hs

@@ -1,8 +0,0 @@
-import           Network.Haskoin.Constants
-import qualified Network.Haskoin.Script.Spec (forkIdSpec)
-import           Test.Hspec
-
-main :: IO ()
-main = do
-    setBCH
-    hspec Network.Haskoin.Script.Spec.forkIdSpec

test/btc-regtest/Main.hs

@@ -1,96 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-import           Control.Monad.State.Strict
-import           Network.Haskoin.Block
-import           Network.Haskoin.Constants
-import           Test.Framework                 as F
-import           Test.Framework.Providers.HUnit (testCase)
-import           Test.HUnit                     hiding (State)
-
-myTime :: Timestamp
-myTime = 1499083075
-
-withChain :: State HeaderMemory a -> a
-withChain f = evalState f initialChain
-
-chain :: BlockHeaders m => BlockHeader -> Int -> m ()
-chain bh i = do
-    bnsE <- connectBlocks myTime bhs
-    either error (const $ return ()) bnsE
-  where
-    bhs = appendBlocks 6 bh i
-
-main :: IO ()
-main = do
-    setBTCregTest
-    defaultMain [ testGroup "RegTest network" tests ]
-
-tests :: [F.Test]
-tests =
-    [ testCase "Get best block" bestBlock
-    , testCase "Build a block locator" buildLocator
-    , testCase "Split chain best block" splitBest
-    ]
-
-bestBlock :: Assertion
-bestBlock =
-    100 @=? nodeHeight bb
-  where
-    bb = withChain $ do
-        chain genesisHeader 100
-        getBestBlockHeader
-
-buildLocator :: Assertion
-buildLocator =
-    [100,99..90] ++ [88,84,76,60,28,0] @=? heights
-  where
-    heights = map nodeHeight loc
-    loc = withChain $ do
-        chain genesisHeader 100
-        bb <- getBestBlockHeader
-        blockLocatorNodes bb
-
-splitBest :: Assertion
-splitBest =
-    4035 @=? nodeHeight bb
-  where
-    bb = withChain $ splitChain >> getBestBlockHeader
-
--- 0 → → 2015 → → → → → → → 4031
---       ↓
---       → → 2035 → → → → → → 4035*
---           ↓
---           → → 2185
-splitChain :: State HeaderMemory ()
-splitChain = do
-    start <- go 1 genesisHeader 2015
-    e 2015 (head start)
-    tail1 <- go 2 (nodeHeader $ head start) 2016
-    e 4031 (head tail1)
-    tail2 <- go 3 (nodeHeader $ head start) 20
-    e 2035 (head tail2)
-    tail3 <- go 4 (nodeHeader $ head tail2) 2000
-    e 4035 (head tail3)
-    tail4 <- go 5 (nodeHeader $ head tail2) 150
-    e 2185 (head tail4)
-    sp1 <- splitPoint (head tail1) (head tail3)
-    unless (sp1 == head start) $
-        error $
-        "Split point wrong between blocks 4031 and 4035: " ++
-        show (nodeHeight sp1)
-    sp2 <- splitPoint (head tail4) (head tail3)
-    unless (sp2 == head tail2) $
-        error $
-        "Split point wrong between blocks 2185 and 4035: " ++
-        show (nodeHeight sp2)
-  where
-    e n bn =
-        unless (nodeHeight bn == n) $
-        error $
-        "Node height " ++
-        show (nodeHeight bn) ++ " of first chunk should be " ++ show n
-    go seed start n = do
-        let bhs = appendBlocks seed start n
-        bnE <- connectBlocks myTime bhs
-        case bnE of
-            Right bn -> return bn
-            Left ex -> error ex

test/btc/Main.hs

@@ -1,73 +0,0 @@
-import           Network.Haskoin.Constants
-import           Test.Framework
-import           Test.Hspec
-
--- Util tests
-import qualified Network.Haskoin.Util.Tests                (tests)
-
--- Crypto tests
-import qualified Network.Haskoin.Crypto.Base58.Tests       (tests)
-import qualified Network.Haskoin.Crypto.Base58.Units       (tests)
-import qualified Network.Haskoin.Crypto.ECDSA.Tests        (tests)
-import qualified Network.Haskoin.Crypto.ExtendedKeys.Tests (tests)
-import qualified Network.Haskoin.Crypto.ExtendedKeys.Units (tests)
-import qualified Network.Haskoin.Crypto.Hash.Tests         (tests)
-import qualified Network.Haskoin.Crypto.Hash.Units         (tests)
-import qualified Network.Haskoin.Crypto.Keys.Tests         (tests)
-import qualified Network.Haskoin.Crypto.Mnemonic.Tests     (tests)
-import qualified Network.Haskoin.Crypto.Mnemonic.Units     (tests)
-import qualified Network.Haskoin.Crypto.Units              (tests)
-
--- Network tests
-import qualified Network.Haskoin.Network.Units             (tests)
-
--- Script tests
-import qualified Network.Haskoin.Script.Spec               (spec)
-import qualified Network.Haskoin.Script.Tests              (tests)
-import qualified Network.Haskoin.Script.Units              (tests)
-
--- Transaction tests
-import qualified Network.Haskoin.Transaction.Tests         (tests)
-import qualified Network.Haskoin.Transaction.Units         (satoshiCoreTxTests,
-                                                            tests)
-
--- Block tests
-import qualified Network.Haskoin.Block.Tests               (tests)
-import qualified Network.Haskoin.Block.Units               (tests)
-
--- Json tests
-import qualified Network.Haskoin.Json.Tests                (tests)
-
--- Binary tests
-import qualified Network.Haskoin.Cereal.Tests              (tests)
-
-main :: IO ()
-main = do
-  setBTC
-  hspec Network.Haskoin.Script.Spec.spec
-  satoshiTxTests <- Network.Haskoin.Transaction.Units.satoshiCoreTxTests
-  defaultMain
-    (  Network.Haskoin.Json.Tests.tests
-    ++ Network.Haskoin.Cereal.Tests.tests
-    ++ Network.Haskoin.Util.Tests.tests
-    ++ Network.Haskoin.Crypto.ECDSA.Tests.tests
-    ++ Network.Haskoin.Crypto.Base58.Tests.tests
-    ++ Network.Haskoin.Crypto.Base58.Units.tests
-    ++ Network.Haskoin.Crypto.Hash.Tests.tests
-    ++ Network.Haskoin.Crypto.Hash.Units.tests
-    ++ Network.Haskoin.Crypto.Keys.Tests.tests
-    ++ Network.Haskoin.Crypto.ExtendedKeys.Tests.tests
-    ++ Network.Haskoin.Crypto.ExtendedKeys.Units.tests
-    ++ Network.Haskoin.Crypto.Mnemonic.Tests.tests
-    ++ Network.Haskoin.Crypto.Mnemonic.Units.tests
-    ++ Network.Haskoin.Crypto.Units.tests
-    ++ Network.Haskoin.Network.Units.tests
-    ++ Network.Haskoin.Script.Tests.tests
-    ++ Network.Haskoin.Script.Units.tests
-    ++ Network.Haskoin.Transaction.Tests.tests
-    ++ Network.Haskoin.Transaction.Units.tests
-    ++ satoshiTxTests
-    ++ Network.Haskoin.Block.Tests.tests
-    ++ Network.Haskoin.Block.Units.tests
-    )
-

test/btc/Network/Haskoin/Cereal/Tests.hs

@@ -1,73 +0,0 @@
-module Network.Haskoin.Cereal.Tests (tests) where
-
-import           Data.Serialize
-import           Network.Haskoin.Test
-import           Network.Haskoin.Util
-import           Test.Framework
-import           Test.Framework.Providers.QuickCheck2
-import           Test.QuickCheck
-
-tests :: [Test]
-tests =
-    [ testGroup "Binary encoding and decoding of utility types"
-        [ testProperty "ByteString" $ forAll arbitraryBS testId ]
-    , testGroup "Binary encoding and decoding of hash types"
-        [ testProperty "Hash160" $ forAll arbitraryHash160 testId
-        , testProperty "Hash256" $ forAll arbitraryHash256 testId
-        , testProperty "Hash512" $ forAll arbitraryHash512 testId
-        ]
-    , testGroup "Binary encoding and decoding of crypto types"
-        [ testProperty "Signature" $ forAll arbitrarySignature $ testId . lst3
-        , testProperty "PubKey" $ forAll arbitraryPubKey $ testId . snd
-        , testProperty "XPrvKey" $ forAll arbitraryXPrvKey testId
-        , testProperty "XPubKey" $ forAll arbitraryXPubKey $ testId . snd
-        ]
-    , testGroup "Binary encoding and decoding of protocol types"
-        [ testProperty "VarInt" $ forAll arbitraryVarInt testId
-        , testProperty "VarString" $ forAll arbitraryVarString testId
-        , testProperty "NetworkAddress" $ forAll arbitraryNetworkAddress testId
-        , testProperty "InvType" $ forAll arbitraryInvType testId
-        , testProperty "InvVector" $ forAll arbitraryInvVector testId
-        , testProperty "Inv" $ forAll arbitraryInv1 testId
-        , testProperty "Version" $ forAll arbitraryVersion testId
-        , testProperty "Addr" $ forAll arbitraryAddr1 testId
-        , testProperty "Alert" $ forAll arbitraryAlert testId
-        , testProperty "Reject" $ forAll arbitraryReject testId
-        , testProperty "GetData" $ forAll arbitraryGetData testId
-        , testProperty "NotFound" $ forAll arbitraryNotFound testId
-        , testProperty "Ping" $ forAll arbitraryPing testId
-        , testProperty "Pong" $ forAll arbitraryPong testId
-        , testProperty "MessageCommand" $ forAll arbitraryMessageCommand testId
-        , testProperty "MessageHeader" $ forAll arbitraryMessageHeader testId
-        , testProperty "Message" $ forAll arbitraryMessage testId
-        ]
-    , testGroup "Binary encoding and decoding of script types"
-        [ testProperty "ScriptOp" $ forAll arbitraryScriptOp testId
-        , testProperty "Script" $ forAll arbitraryScript testId
-        ]
-    , testGroup "Binary encoding and decoding of transaction types"
-        [ testProperty "TxIn" $ forAll arbitraryTxIn testId
-        , testProperty "TxOut" $ forAll arbitraryTxOut testId
-        , testProperty "OutPoint" $ forAll arbitraryOutPoint testId
-        , testProperty "Tx" $ forAll arbitraryTx testId
-        , testProperty "Tx" $ forAll arbitraryWitnessTx testId
-        , testProperty "Tx" $ forAll arbitraryLegacyTx testId
-        ]
-    , testGroup "Binary encoding and decoding of block types"
-        [ testProperty "Block" $ forAll arbitraryBlock testId
-        , testProperty "BlockHeader" $ forAll arbitraryBlockHeader testId
-        , testProperty "GetBlocks" $ forAll arbitraryGetBlocks testId
-        , testProperty "GetHeaders" $ forAll arbitraryGetHeaders testId
-        , testProperty "Headers" $ forAll arbitraryHeaders testId
-        , testProperty "MerkleBlock" $ forAll arbitraryMerkleBlock testId
-        ]
-    , testGroup "Binary encoding and decoding of bloom types"
-        [ testProperty "BloomFlags" $ forAll arbitraryBloomFlags testId
-        , testProperty "BloomFilter" $ forAll arbitraryBloomFilter $ testId . lst3
-        , testProperty "FilterLoad" $ forAll arbitraryFilterLoad testId
-        , testProperty "FilterAdd" $ forAll arbitraryFilterAdd testId
-        ]
-    ]
-
-testId :: (Serialize a, Eq a) => a -> Bool
-testId x = decode (encode x) == Right x

test/btc/Network/Haskoin/Crypto/Base58/Tests.hs

@@ -1,31 +0,0 @@
-module Network.Haskoin.Crypto.Base58.Tests (tests) where
-
-import           Data.String                          (fromString)
-import           Data.String.Conversions              (cs)
-import           Network.Haskoin.Crypto
-import           Network.Haskoin.Test
-import           Test.Framework
-import           Test.Framework.Providers.QuickCheck2
-import           Test.QuickCheck
-
-tests :: [Test]
-tests =
-    [ testGroup
-          "Address and Base58"
-          [ testProperty "decode58 . encode58 == id" $
-            forAll arbitraryBS $ \bs ->
-                decodeBase58 (encodeBase58 bs) == Just bs
-          , testProperty "decode58Chk . encode58Chk == id" $
-            forAll arbitraryBS $ \bs ->
-                decodeBase58Check (encodeBase58Check bs) == Just bs
-          , testProperty "stringToAddr . addrToString == id" $
-            forAll arbitraryAddress $ \a ->
-                (stringToAddr =<< addrToString a) == Just a
-          , testProperty "Read/Show address" $
-            forAll arbitraryAddress $ \a -> read (show a) == a
-          , testProperty "From string address" $
-            forAll arbitraryAddress $ \a ->
-                fmap (fromString . cs) (addrToString a) == Just a
-          ]
-    ]
-

test/btc/Network/Haskoin/Crypto/ExtendedKeys/Tests.hs

@@ -1,62 +0,0 @@
-module Network.Haskoin.Crypto.ExtendedKeys.Tests (tests) where
-
-import           Data.Bits                            ((.&.))
-import           Data.String                          (fromString)
-import           Data.String.Conversions              (cs)
-import           Data.Word                            (Word32)
-import           Network.Haskoin.Crypto
-import           Network.Haskoin.Test
-import           Test.Framework
-import           Test.Framework.Providers.QuickCheck2
-import           Test.QuickCheck                      (forAll)
-
-tests :: [Test]
-tests =
-    [ testGroup
-          "HDW Extended Keys"
-          [ testProperty "prvSubKey(k,c)*G = pubSubKey(k*G,c)" $
-            forAll arbitraryXPrvKey pubKeyOfSubKeyIsSubKeyOfPubKey
-          , testProperty "fromB58 . toB58 prvKey" $ forAll arbitraryXPrvKey $
-            \k -> xPrvImport (xPrvExport k) == Just k
-          , testProperty "fromB58 . toB58 pubKey" $ forAll arbitraryXPubKey $
-            \(_, k) -> xPubImport (xPubExport k) == Just k
-          ]
-    , testGroup
-          "From/To strings"
-          [ testProperty "Read/Show extended public key" $ forAll arbitraryXPubKey $
-            \(_, k) -> read (show k) == k
-          , testProperty "Read/Show extended private key" $ forAll arbitraryXPrvKey $
-            \k -> read (show k) == k
-          , testProperty "From string extended public key" $ forAll arbitraryXPubKey $
-            \(_, k) -> fromString (cs $ xPubExport k) == k
-          , testProperty "From string extended private key" $ forAll arbitraryXPrvKey $
-            \k -> fromString (cs $ xPrvExport k) == k
-          , testProperty "Read/Show derivation path" $ forAll arbitraryDerivPath $
-            \p -> read (show p) == p
-          , testProperty "Read/Show hard derivation path" $ forAll arbitraryHardPath $
-            \p -> read (show p) == p
-          , testProperty "Read/Show soft derivation path" $ forAll arbitrarySoftPath $
-            \p -> read (show p) == p
-          , testProperty "From string derivation path" $ forAll arbitraryDerivPath $
-            \p -> fromString (cs $ pathToStr p) == p
-          , testProperty "From string hard derivation path" $ forAll arbitraryHardPath $
-            \p -> fromString (cs $ pathToStr p) == p
-          , testProperty "From string soft derivation path" $ forAll arbitrarySoftPath $
-            \p -> fromString (cs $ pathToStr p) == p
-          , testProperty "listToPath . pathToList == id" $ forAll arbitraryDerivPath $
-            \p -> listToPath (pathToList p) == p
-          , testProperty "listToPath . pathToList == id (Hard)" $
-            forAll arbitraryHardPath $ \p -> toHard (listToPath $ pathToList p) == Just p
-          , testProperty "listToPath . pathToList == id (Soft)" $
-            forAll arbitrarySoftPath $ \p -> toSoft (listToPath $ pathToList p) == Just p
-          , testProperty "read . show == id (ParsedPath)" $
-            forAll arbitraryParsedPath $ \p -> read (show p) == p
-          ]
-    ]
-
-pubKeyOfSubKeyIsSubKeyOfPubKey :: XPrvKey -> Word32 -> Bool
-pubKeyOfSubKeyIsSubKeyOfPubKey k i =
-    deriveXPubKey (prvSubKey k i') == pubSubKey (deriveXPubKey k) i'
-  where
-    i' = fromIntegral $ i .&. 0x7fffffff -- make it a public derivation
-

test/btc/Network/Haskoin/Crypto/Hash/Tests.hs

@@ -1,42 +0,0 @@
-module Network.Haskoin.Crypto.Hash.Tests (tests) where
-
-import           Data.Serialize                       (encode)
-import           Data.String                          (fromString)
-import           Data.String.Conversions
-import           Network.Haskoin.Block
-import           Network.Haskoin.Crypto
-import           Network.Haskoin.Test
-import           Network.Haskoin.Util                 (encodeHex)
-import           Test.Framework
-import           Test.Framework.Providers.QuickCheck2
-import           Test.QuickCheck
-
-tests :: [Test]
-tests =
-    [ testGroup "Hash tests"
-        [ testProperty "join512( split512(h) ) == h" $
-          forAll arbitraryHash256 $ forAll arbitraryHash256 . joinSplit512
-        , testProperty "decodeCompact . encodeCompact i == i" decEncCompact
-        , testProperty "From string 64-byte hash" $ forAll arbitraryHash512 $
-          \h -> fromString (cs $ encodeHex $ encode h) == h
-        , testProperty "From string 32-byte hash" $ forAll arbitraryHash256 $
-          \h -> fromString (cs $ encodeHex $ encode h) == h
-        , testProperty "From string 20-byte hash" $ forAll arbitraryHash160 $
-          \h -> fromString (cs $ encodeHex $ encode h) == h
-        ]
-    ]
-
-joinSplit512 :: Hash256 -> Hash256 -> Bool
-joinSplit512 a b = split512 (join512 (a, b)) == (a, b)
-
--- After encoding and decoding, we may loose precision so the new result is >=
--- to the old one.
-decEncCompact :: Integer -> Bool
-decEncCompact i
-    -- Integer completely fits inside the mantisse
-    | abs i <= 0x007fffff = decodeCompact (encodeCompact i) == (i, False)
-    -- Otherwise precision will be lost and the decoded result will
-    -- be smaller than the original number
-    | i >= 0              = fst (decodeCompact (encodeCompact i)) < i
-    | otherwise           = fst (decodeCompact (encodeCompact i)) > i
-

test/btc/Network/Haskoin/Crypto/Keys/Tests.hs

@@ -1,120 +0,0 @@
-module Network.Haskoin.Crypto.Keys.Tests (tests) where
-
-import qualified Crypto.Secp256k1                     as EC
-import qualified Data.ByteString                      as BS
-import           Data.Serialize                       (encode, runGet, runPut)
-import           Data.String                          (fromString)
-import           Data.String.Conversions              (cs)
-import           Network.Haskoin.Crypto
-import           Network.Haskoin.Test
-import           Network.Haskoin.Util
-import           Test.Framework
-import           Test.Framework.Providers.QuickCheck2
-import           Test.QuickCheck
-
-tests :: [Test]
-tests =
-    [ testGroup
-          "PubKey Binary"
-          [ testProperty "is public key canonical" $
-            forAll arbitraryPubKey (isCanonicalPubKey . snd)
-          , testProperty "makeKey . toKey" makeToKey
-          , testProperty "makeKeyU . toKey" makeToKeyU
-          ]
-    , testGroup
-          "Key formats"
-          [ testProperty "fromWif . toWif PrvKey" $
-            forAll arbitraryPrvKey $ \pk -> fromWif (toWif pk) == Just pk
-          , testProperty "constant 32-byte encoding PrvKey" $
-            forAll arbitraryPrvKey binaryPrvKey
-          ]
-    , testGroup
-          "Key compression"
-          [ testProperty "Compressed public key" testCompressed
-          , testProperty "Uncompressed public key" testUnCompressed
-          , testProperty "Compressed private key" testPrivateCompressed
-          , testProperty "Uncompressed private key" testPrivateUnCompressed
-          ]
-    , testGroup
-          "From/To strings"
-          [ testProperty "Read/Show public key" $
-            forAll arbitraryPubKey $ \(_, k) -> read (show k) == k
-          , testProperty "Read/Show compressed public key" $
-            forAll arbitraryPubKeyC $ \(_, k) -> read (show k) == k
-          , testProperty "Read/Show uncompressed public key" $
-            forAll arbitraryPubKeyU $ \(_, k) -> read (show k) == k
-          , testProperty "Read/Show private key" $
-            forAll arbitraryPrvKey $ \k -> read (show k) == k
-          , testProperty "Read/Show compressed private key" $
-            forAll arbitraryPrvKeyC $ \k -> read (show k) == k
-          , testProperty "Read/Show uncompressed private key" $
-            forAll arbitraryPrvKeyU $ \k -> read (show k) == k
-          , testProperty "From string public key" $
-            forAll arbitraryPubKey $ \(_, k) ->
-                fromString (cs . encodeHex $ encode k) == k
-          , testProperty "From string compressed public key" $
-            forAll arbitraryPubKeyC $ \(_, k) ->
-                fromString (cs . encodeHex $ encode k) == k
-          , testProperty "From string uncompressed public key" $
-            forAll arbitraryPubKeyU $ \(_, k) ->
-                fromString (cs . encodeHex $ encode k) == k
-          , testProperty "From string private key" $
-            forAll arbitraryPrvKey $ \k -> fromString (cs $ toWif k) == k
-          , testProperty "From string compressed private key" $
-            forAll arbitraryPrvKeyC $ \k -> fromString (cs $ toWif k) == k
-          , testProperty "From string uncompressed private key" $
-            forAll arbitraryPrvKeyU $ \k -> fromString (cs $ toWif k) == k
-          ]
-    ]
-
--- github.com/bitcoin/bitcoin/blob/master/src/script.cpp
--- from function IsCanonicalPubKey
-isCanonicalPubKey :: PubKey -> Bool
-isCanonicalPubKey p = not $
-    -- Non-canonical public key: too short
-    (BS.length bs < 33) ||
-    -- Non-canonical public key: invalid length for uncompressed key
-    (BS.index bs 0 == 4 && BS.length bs /= 65) ||
-    -- Non-canonical public key: invalid length for compressed key
-    (BS.index bs 0 `elem` [2,3] && BS.length bs /= 33) ||
-    -- Non-canonical public key: compressed nor uncompressed
-    (BS.index bs 0 `notElem` [2,3,4])
-  where
-    bs = encode p
-
-makeToKey :: EC.SecKey -> Bool
-makeToKey i = prvKeySecKey (makePrvKey i) == i
-
-makeToKeyU :: EC.SecKey -> Bool
-makeToKeyU i = prvKeySecKey (makePrvKeyU i) == i
-
-{- Key formats -}
-
-binaryPrvKey :: PrvKey -> Bool
-binaryPrvKey k =
-    (Right k == runGet (prvKeyGetMonad f) (runPut $ prvKeyPutMonad k)) &&
-    (Just k == decodePrvKey f (encodePrvKey k))
-  where
-    f = makePrvKeyG (prvKeyCompressed k)
-
-{- Key Compression -}
-
-testCompressed :: EC.SecKey -> Bool
-testCompressed n =
-    pubKeyCompressed (derivePubKey $ makePrvKey n) &&
-    pubKeyCompressed (derivePubKey $ makePrvKeyG True n)
-
-testUnCompressed :: EC.SecKey -> Bool
-testUnCompressed n =
-    not (pubKeyCompressed $ derivePubKey $ makePrvKeyG False n) &&
-    not (pubKeyCompressed $ derivePubKey $ makePrvKeyU n)
-
-testPrivateCompressed :: EC.SecKey -> Bool
-testPrivateCompressed n =
-    prvKeyCompressed (makePrvKey n) &&
-    prvKeyCompressed (makePrvKeyC n)
-
-testPrivateUnCompressed :: EC.SecKey -> Bool
-testPrivateUnCompressed n =
-    not (prvKeyCompressed $ makePrvKeyG False n) &&
-    not (prvKeyCompressed $ makePrvKeyU n)

test/btc/Network/Haskoin/Json/Tests.hs

@@ -1,35 +0,0 @@
-module Network.Haskoin.Json.Tests (tests) where
-
-import           Data.Aeson
-import           Data.HashMap.Strict                  (singleton)
-import           Network.Haskoin.Test
-import           Test.Framework
-import           Test.Framework.Providers.QuickCheck2
-import           Test.QuickCheck
-
-tests :: [Test]
-tests =
-    [ testGroup
-          "Serialize & de-serialize haskoin types to JSON"
-          [ testProperty "ScriptOutput" $ forAll arbitraryScriptOutput testID
-          , testProperty "OutPoint" $ forAll arbitraryOutPoint testID
-          , testProperty "Address" $ forAll arbitraryAddress testID
-          , testProperty "Tx" $ forAll arbitraryTx testID
-          , testProperty "TxHash" $ forAll arbitraryTxHash testID
-          , testProperty "BlockHash" $ forAll arbitraryBlockHash testID
-          , testProperty "SigHash" $ forAll arbitrarySigHash testID
-          , testProperty "SigInput" $ forAll arbitrarySigInput (testID . fst)
-          , testProperty "PubKey" $ forAll arbitraryPubKey (testID . snd)
-          , testProperty "PubKeyC" $ forAll arbitraryPubKeyC (testID . snd)
-          , testProperty "PubKeyU" $ forAll arbitraryPubKeyU (testID . snd)
-          , testProperty "XPrvKey" $ forAll arbitraryXPrvKey testID
-          , testProperty "XPubKey" $ forAll arbitraryXPubKey (testID . snd)
-          , testProperty "DerivPath" $ forAll arbitraryDerivPath testID
-          , testProperty "ParsedPath" $ forAll arbitraryParsedPath testID
-          ]
-    ]
-
-testID :: (FromJSON a, ToJSON a, Eq a) => a -> Bool
-testID x =
-    (decode . encode) (singleton ("object" :: String) x) ==
-    Just (singleton ("object" :: String) x)