Skip to content

Commit b2b417d

Browse files
ProofOfKeagsProofOfKeags
committed
wip fix tests
1 parent b21d743 commit b2b417d

15 files changed

+229
-126
lines changed

‎bitcoin.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -145,6 +145,7 @@ test-suite spec
145145
build-depends:
146146
HUnit >=1.6.0.0
147147
, QuickCheck >=2.13.2
148+
, aeson >=1.4.6.0
148149
, array >=0.5.4.0
149150
, base >=4.9 && <5
150151
, base16 >=0.3.0.1

‎hie.yaml

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
cradle:
2+
stack:
3+
- path: "./src"
4+
component: "bitcoin:lib"
5+
6+
- path: "./test"
7+
component: "bitcoin:test:spec"

‎package.yaml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -59,6 +59,7 @@ tests:
5959
verbatim:
6060
build-tool-depends: hspec-discover:hspec-discover
6161
dependencies:
62+
- aeson >= 1.4.6.0
6263
- base64 ^>= 0.4
6364
- bitcoin
6465
- hspec >= 2.7.1

‎src/Bitcoin/Util/Arbitrary.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -16,3 +16,4 @@ import Bitcoin.Util.Arbitrary.Network as X
1616
import Bitcoin.Util.Arbitrary.Script as X
1717
import Bitcoin.Util.Arbitrary.Transaction as X
1818
import Bitcoin.Util.Arbitrary.Util as X
19+

‎src/Bitcoin/Util/Arbitrary/Util.hs

Lines changed: 2 additions & 68 deletions
Original file line numberDiff line numberDiff line change
@@ -14,13 +14,10 @@ module Bitcoin.Util.Arbitrary.Util (
1414
arbitraryMaybe,
1515
arbitraryNetwork,
1616
arbitraryUTCTime,
17-
SerialBox (..),
18-
ReadBox (..),
19-
testIdentity,
20-
testSerial,
21-
testRead,
2217
arbitraryNetData,
2318
genNetData,
19+
toMap,
20+
fromMap,
2421
) where
2522

2623
import Bitcoin.Constants
@@ -94,69 +91,6 @@ arbitraryNetwork :: Gen Network
9491
arbitraryNetwork = elements allNets
9592

9693

97-
-- Helpers for creating Serial and JSON Identity tests
98-
99-
data SerialBox
100-
= forall a.
101-
(Show a, Eq a, T.Typeable a, Serial a) =>
102-
SerialBox (Gen a)
103-
104-
105-
data ReadBox
106-
= forall a.
107-
(Read a, Show a, Eq a, T.Typeable a) =>
108-
ReadBox (Gen a)
109-
110-
111-
-- data NetBox
112-
-- = forall a.
113-
-- (Show a, Eq a, T.Typeable a) =>
114-
-- NetBox
115-
-- ( Network -> a -> A.Value
116-
-- , Network -> a -> A.Encoding
117-
-- , Network -> A.Value -> A.Parser a
118-
-- , Gen (Network, a)
119-
-- )
120-
121-
testIdentity :: [SerialBox] -> [ReadBox] -> Spec
122-
testIdentity serialVals readVals = do
123-
describe "Binary Encoding" $
124-
forM_ serialVals $
125-
\(SerialBox g) -> testSerial g
126-
describe "Read/Show Encoding" $
127-
forM_ readVals $
128-
\(ReadBox g) -> testRead g
129-
130-
131-
-- | Generate binary identity tests
132-
testSerial ::
133-
(Eq a, Show a, T.Typeable a, Serial a) => Gen a -> Spec
134-
testSerial gen =
135-
prop ("Binary encoding/decoding identity for " <> name) $
136-
forAll gen $ \x -> do
137-
(runGetL deserialize . runPutL . serialize) x `shouldBe` x
138-
(runGetL deserialize . fromStrict . runPutS . serialize) x `shouldBe` x
139-
(runGetS deserialize . runPutS . serialize) x `shouldBe` Right x
140-
(runGetS deserialize . toStrict . runPutL . serialize) x `shouldBe` Right x
141-
where
142-
name = show $ T.typeRep $ proxy gen
143-
proxy :: Gen a -> Proxy a
144-
proxy = const Proxy
145-
146-
147-
-- | Generate Read/Show identity tests
148-
testRead ::
149-
(Eq a, Read a, Show a, T.Typeable a) => Gen a -> Spec
150-
testRead gen =
151-
prop ("read/show identity for " <> name) $
152-
forAll gen $
153-
\x -> (read . show) x `shouldBe` x
154-
where
155-
name = show $ T.typeRep $ proxy gen
156-
proxy :: Gen a -> Proxy a
157-
proxy = const Proxy
158-
159-
16094
arbitraryNetData :: Arbitrary a => Gen (Network, a)
16195
arbitraryNetData = do
16296
net <- arbitraryNetwork

‎stack.yaml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
resolver: lts-19.22
1+
resolver: lts-19.27
22
system-ghc: true
33
nix:
44
packages:

‎stack.yaml.lock

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -7,13 +7,13 @@ packages:
77
- completed:
88
hackage: fourmolu-0.8.2.0@sha256:2cc2e4b296897b14e937c6a22e1b9840699b2b7bf5021fbdc6f212376d44edb6,7469
99
pantry-tree:
10-
size: 143718
1110
sha256: e467a3bce53e6bbb71414a368369095eee13e423d093a5aff2cd128317362c3e
11+
size: 143718
1212
original:
1313
hackage: fourmolu-0.8.2.0
1414
snapshots:
1515
- completed:
16-
size: 619399
17-
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/22.yaml
18-
sha256: 5098594e71bdefe0c13e9e6236f12e3414ef91a2b89b029fd30e8fc8087f3a07
19-
original: lts-19.22
16+
sha256: 1ecad1f0bd2c27de88dbff6572446cfdf647c615d58a7e2e2085c6b7dfc04176
17+
size: 619403
18+
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/27.yaml
19+
original: lts-19.27

‎test/Bitcoin/AddressSpec.hs

Lines changed: 14 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,18 +1,26 @@
1+
{-# LANGUAGE GADTs #-}
12
{-# LANGUAGE OverloadedStrings #-}
23

34
module Bitcoin.AddressSpec (spec) where
45

5-
import Data.ByteString (ByteString)
6-
import qualified Data.ByteString as BS (append, empty, pack)
7-
import Data.Maybe (fromJust, isJust)
8-
import Data.Text (Text)
9-
import qualified Data.Text as T
106
import Bitcoin.Address
117
import Bitcoin.Constants
128
import Bitcoin.Data
139
import Bitcoin.Keys
1410
import Bitcoin.Util
1511
import Bitcoin.Util.Arbitrary
12+
import Bitcoin.UtilSpec
13+
import Data.Aeson
14+
import Data.Aeson.Types (Parser)
15+
import Data.ByteString (ByteString)
16+
import qualified Data.ByteString as BS (append, empty, pack)
17+
import Data.Bytes.Serial
18+
import Data.Foldable
19+
import Data.Maybe (fromJust, isJust)
20+
import Data.Proxy (Proxy (..))
21+
import Data.Text (Text)
22+
import qualified Data.Text as T
23+
import Data.Typeable (Typeable, typeRep)
1624
import Test.HUnit
1725
import Test.Hspec
1826
import Test.Hspec.QuickCheck
@@ -32,6 +40,7 @@ netVals =
3240
[NetBox (addrToJSON, addrToEncoding, addrFromJSON, arbitraryNetAddress)]
3341

3442

43+
3544
spec :: Spec
3645
spec = do
3746
testIdentity serialVals readVals [] netVals

‎test/Bitcoin/BlockSpec.hs

Lines changed: 7 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -4,18 +4,19 @@ module Bitcoin.BlockSpec (
44
spec,
55
) where
66

7-
import Control.Monad.State.Strict
7+
import Bitcoin.Block
8+
import Bitcoin.Constants
9+
import Bitcoin.Data
10+
import Bitcoin.Transaction
11+
import Bitcoin.Util.Arbitrary
12+
import Bitcoin.UtilSpec hiding (spec)
13+
import Control.Monad.Trans.State.Strict
814
import Data.Either (fromRight)
915
import Data.Maybe (fromJust)
1016
import Data.String (fromString)
1117
import Data.String.Conversions (cs)
1218
import Data.Text (Text)
1319
import Data.Word (Word32)
14-
import Bitcoin.Block
15-
import Bitcoin.Constants
16-
import Bitcoin.Data
17-
import Bitcoin.Transaction
18-
import Bitcoin.Util.Arbitrary
1920
import Test.HUnit hiding (State)
2021
import Test.Hspec
2122
import Test.Hspec.QuickCheck

‎test/Bitcoin/Crypto/HashSpec.hs

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,11 @@
22

33
module Bitcoin.Crypto.HashSpec (spec) where
44

5+
import Bitcoin.Block
6+
import Bitcoin.Crypto
7+
import Bitcoin.Util
8+
import Bitcoin.Util.Arbitrary
9+
import Bitcoin.UtilSpec hiding (spec)
510
import Data.Bits
611
import Data.ByteString (ByteString)
712
import Data.ByteString.Builder
@@ -16,10 +21,6 @@ import Data.String (fromString)
1621
import Data.String.Conversions
1722
import Data.Text (Text)
1823
import Data.Word
19-
import Bitcoin.Block
20-
import Bitcoin.Crypto
21-
import Bitcoin.Util
22-
import Bitcoin.Util.Arbitrary
2324
import Test.HUnit
2425
import Test.Hspec
2526
import Test.Hspec.QuickCheck

‎test/Bitcoin/NetworkSpec.hs

Lines changed: 7 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -2,20 +2,21 @@
22

33
module Bitcoin.NetworkSpec (spec) where
44

5-
import Data.Bytes.Get
6-
import Data.Bytes.Put
7-
import Data.Bytes.Serial
8-
import Data.Maybe (fromJust)
9-
import Data.Text (Text)
10-
import Data.Word (Word32)
115
import Bitcoin.Address
126
import Bitcoin.Constants
137
import Bitcoin.Keys
148
import Bitcoin.Network
159
import Bitcoin.Transaction
1610
import Bitcoin.Util
1711
import Bitcoin.Util.Arbitrary
12+
import Bitcoin.UtilSpec
1813
import Bitcoin.UtilSpec (customCerealID)
14+
import Data.Bytes.Get
15+
import Data.Bytes.Put
16+
import Data.Bytes.Serial
17+
import Data.Maybe (fromJust)
18+
import Data.Text (Text)
19+
import Data.Word (Word32)
1920
import Test.HUnit (Assertion, assertBool, assertEqual)
2021
import Test.Hspec
2122
import Test.Hspec.QuickCheck

‎test/Bitcoin/ScriptSpec.hs

Lines changed: 13 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,16 @@
22

33
module Bitcoin.ScriptSpec (spec) where
44

5+
import Bitcoin.Address
6+
import Bitcoin.Constants
7+
import Bitcoin.Data
8+
import Bitcoin.Keys
9+
import Bitcoin.Script
10+
import Bitcoin.Transaction
11+
import Bitcoin.Util
12+
import Bitcoin.Util.Arbitrary
13+
import Bitcoin.UtilSpec
14+
import Bitcoin.UtilSpec (readTestFile)
515
import Control.Monad
616
import Data.Aeson as A
717
import Data.ByteString (ByteString)
@@ -16,15 +26,6 @@ import Data.String
1626
import Data.String.Conversions (cs)
1727
import Data.Text (Text)
1828
import Data.Word
19-
import Bitcoin.Address
20-
import Bitcoin.Constants
21-
import Bitcoin.Data
22-
import Bitcoin.Keys
23-
import Bitcoin.Script
24-
import Bitcoin.Transaction
25-
import Bitcoin.Util
26-
import Bitcoin.Util.Arbitrary
27-
import Bitcoin.UtilSpec (readTestFile)
2829
import Test.HUnit as HUnit
2930
import Test.Hspec
3031
import Test.Hspec.QuickCheck
@@ -300,8 +301,8 @@ sigHashSpec net = do
300301

301302
testSigHashOne :: Network -> Tx -> Script -> Word64 -> Bool -> Property
302303
testSigHashOne net tx s val acp =
303-
not (null $ txIn tx) ==>
304-
if length (txIn tx) > length (txOut tx)
304+
not (null $ txIn tx)
305+
==> if length (txIn tx) > length (txOut tx)
305306
then res `shouldBe` one
306307
else res `shouldNotBe` one
307308
where
@@ -378,7 +379,7 @@ scriptSigSignatures =
378379
\41a2b1e401"
379380
-- Signature in input of txid
380381
-- fb0a1d8d34fa5537e461ac384bac761125e1bfa7fec286fa72511240fa66864d.
381-
-- Strange DER sizes, but in Blockchain. Now invalid as this Bitcoin
382+
-- Strange DER sizes, but in Blockchain. Now invalid as this Bitcoin
382383
-- library can only decode strict signatures.
383384
-- "3048022200002b83d59c1d23c08efd82ee0662fec23309c3adbcbd1f0b8695378d\
384385
-- \b4b14e736602220000334a96676e58b1bb01784cb7c556dd8ce1c220171904da22\

‎test/Bitcoin/Transaction/TaprootSpec.hs

Lines changed: 30 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -4,18 +4,6 @@
44

55
module Bitcoin.Transaction.TaprootSpec (spec) where
66

7-
import Control.Applicative ((<|>))
8-
import Control.Monad (zipWithM, (<=<))
9-
import Data.Aeson (FromJSON (parseJSON), withObject, (.:), (.:?))
10-
import Data.Aeson.Types (Parser)
11-
import qualified Data.ByteArray as BA
12-
import Data.ByteString (ByteString)
13-
import qualified Data.ByteString as BS
14-
import Data.Bytes.Get (runGetS)
15-
import Data.Bytes.Put (runPutS)
16-
import Data.Bytes.Serial (deserialize, serialize)
17-
import Data.Text (Text)
18-
import Data.Word (Word8)
197
import Bitcoin (
208
MAST (..),
219
PubKey,
@@ -39,10 +27,30 @@ import Bitcoin (
3927
verifyScriptPathData,
4028
)
4129
import Bitcoin.UtilSpec (readTestFile)
30+
import Control.Applicative ((<|>))
31+
import Control.Monad (zipWithM, (<=<))
32+
import Data.Aeson (FromJSON (parseJSON), withObject, (.:), (.:?))
33+
import Data.Aeson.Types (Parser)
34+
import qualified Data.ByteArray as BA
35+
import Data.ByteString (ByteString)
36+
import qualified Data.ByteString as BS
37+
import Data.Bytes.Get (runGetS)
38+
import Data.Bytes.Put (runPutS)
39+
import Data.Bytes.Serial (deserialize, serialize)
40+
import Data.Text (Text)
41+
import Data.Word (Word8)
4242
import Test.HUnit (assertBool, (@?=))
4343
import Test.Hspec (Spec, describe, it, runIO)
4444

4545

46+
-- | Hex encoding
47+
instance FromJSON XOnlyPubKey where
48+
parseJSON =
49+
withText "XOnlyPubKey" $
50+
either fail pure
51+
. (runGetS deserialize <=< maybe (Left "Unable to decode hex") Right . decodeHex)
52+
53+
4654
spec :: Spec
4755
spec = do
4856
TestVector{testScriptPubKey} <- runIO $ readTestFile "bip341.json"
@@ -139,7 +147,8 @@ instance FromJSON SpkGiven where
139147
<|> fail "Unable to parse scriptTree"
140148
parseScriptLeaf = withObject "ScriptTree leaf" $ \obj ->
141149
MASTLeaf
142-
<$> obj .: "leafVersion"
150+
<$> obj
151+
.: "leafVersion"
143152
<*> (obj .: "script" >>= hexScript)
144153
parseScriptBranch v =
145154
parseJSON v >>= \case
@@ -173,9 +182,11 @@ data SpkExpected = SpkExpected
173182
instance FromJSON SpkExpected where
174183
parseJSON = withObject "SpkExpected" $ \obj ->
175184
SpkExpected
176-
<$> obj .: "scriptPubKey"
185+
<$> obj
186+
.: "scriptPubKey"
177187
<*> (obj .:? "scriptPathControlBlocks" >>= (traverse . traverse) jsonHex)
178-
<*> obj .: "bip350Address"
188+
<*> obj
189+
.: "bip350Address"
179190

180191

181192
data TestScriptPubKey = TestScriptPubKey
@@ -189,8 +200,10 @@ instance FromJSON TestScriptPubKey where
189200
parseJSON = withObject "TestScriptPubKey" $ \obj ->
190201
TestScriptPubKey
191202
<$> (unSpkGiven <$> obj .: "given")
192-
<*> obj .: "intermediary"
193-
<*> obj .: "expected"
203+
<*> obj
204+
.: "intermediary"
205+
<*> obj
206+
.: "expected"
194207

195208

196209
newtype TestVector = TestVector

0 commit comments

Comments
 (0)