From 520b0b241f7e108771b0b0fd274a7c329f65ce1c Mon Sep 17 00:00:00 2001 From: Philippe Laprade Date: Sat, 2 Sep 2023 08:56:02 +0200 Subject: [PATCH] Utilities for testing Marshal and MarshalJSON classes (#415) * Adding tools for performing Marshal and MarshalJSON identity tests * New dependency on data-default * Renamed some arbitrary (test) functions for clarity --- CHANGELOG.md | 8 ++ haskoin-core.cabal | 4 +- package.yaml | 3 +- src/Haskoin/Util/Arbitrary/Keys.hs | 12 +- src/Haskoin/Util/Arbitrary/Util.hs | 163 +++++++++++++---------- test/Haskoin/AddressSpec.hs | 19 ++- test/Haskoin/BlockSpec.hs | 63 ++++----- test/Haskoin/Crypto/HashSpec.hs | 35 ++--- test/Haskoin/Crypto/Keys/ExtendedSpec.hs | 82 ++++++------ test/Haskoin/Crypto/KeysSpec.hs | 29 +++- test/Haskoin/NetworkSpec.hs | 54 ++++---- test/Haskoin/ScriptSpec.hs | 94 +++++++------ test/Haskoin/TransactionSpec.hs | 60 ++++----- test/Haskoin/UtilSpec.hs | 10 ++ 14 files changed, 358 insertions(+), 278 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 26acb981..661d635a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,14 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.html). +## [1.0.3] - 2023-09-02 + +### Changed + +- New dependency on data-default +- Renamed some arbitrary (test) functions for clarity +- Reworked the identity testing tool to include Marshal and MarshalJSON classes + ## [1.0.2] - 2023-08-04 ### Fixed diff --git a/haskoin-core.cabal b/haskoin-core.cabal index c8a652cc..3ba18977 100644 --- a/haskoin-core.cabal +++ b/haskoin-core.cabal @@ -5,7 +5,7 @@ cabal-version: 1.12 -- see: https://github.com/sol/hpack name: haskoin-core -version: 1.0.2 +version: 1.0.3 synopsis: Bitcoin & Bitcoin Cash library for Haskell description: Please see the README on GitHub at category: Bitcoin, Finance, Network @@ -118,6 +118,7 @@ library , conduit >=1.3.1.2 , containers >=0.6.2.1 , cryptonite >=0.26 + , data-default >=0.7.1.1 , deepseq >=1.4.4.0 , entropy >=0.4.1.5 , hashable >=1.3.0.0 @@ -175,6 +176,7 @@ test-suite spec , conduit >=1.3.1.2 , containers >=0.6.2.1 , cryptonite >=0.26 + , data-default >=0.7.1.1 , deepseq >=1.4.4.0 , entropy >=0.4.1.5 , hashable >=1.3.0.0 diff --git a/package.yaml b/package.yaml index 39e627da..74a5c7a4 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: haskoin-core -version: 1.0.2 +version: 1.0.3 synopsis: Bitcoin & Bitcoin Cash library for Haskell description: Please see the README on GitHub at category: Bitcoin, Finance, Network @@ -31,6 +31,7 @@ dependencies: - containers >= 0.6.2.1 - cryptonite >= 0.26 - deepseq >= 1.4.4.0 + - data-default >= 0.7.1.1 - entropy >= 0.4.1.5 - hashable >= 1.3.0.0 - hspec >= 2.7.1 diff --git a/src/Haskoin/Util/Arbitrary/Keys.hs b/src/Haskoin/Util/Arbitrary/Keys.hs index 78c94126..9023ca05 100644 --- a/src/Haskoin/Util/Arbitrary/Keys.hs +++ b/src/Haskoin/Util/Arbitrary/Keys.hs @@ -24,6 +24,10 @@ import Test.QuickCheck arbitraryPrivateKey :: Gen PrivateKey arbitraryPrivateKey = wrapSecKey <$> arbitrary <*> arbitrary +-- | Arbitrary public key, either compressed or not. +arbitraryPublicKey :: Ctx -> Gen PublicKey +arbitraryPublicKey ctx = snd <$> arbitraryKeyPair ctx + -- | Arbitrary keypair, both either compressed or not. arbitraryKeyPair :: Ctx -> Gen (PrivateKey, PublicKey) arbitraryKeyPair ctx = do @@ -43,9 +47,13 @@ arbitraryXPrvKey = <*> arbitraryHash256 <*> arbitrary +-- | Arbitrary extended public key. +arbitraryXPubKey :: Ctx -> Gen XPubKey +arbitraryXPubKey ctx = snd <$> arbitraryXKeyPair ctx + -- | Arbitrary extended public key with its corresponding private key. -arbitraryXPubKey :: Ctx -> Gen (XPrvKey, XPubKey) -arbitraryXPubKey ctx = (\k -> (k, deriveXPubKey ctx k)) <$> arbitraryXPrvKey +arbitraryXKeyPair :: Ctx -> Gen (XPrvKey, XPubKey) +arbitraryXKeyPair ctx = (\k -> (k, deriveXPubKey ctx k)) <$> arbitraryXPrvKey {- Custom derivations -} diff --git a/src/Haskoin/Util/Arbitrary/Util.hs b/src/Haskoin/Util/Arbitrary/Util.hs index cfd56b8d..482f567b 100644 --- a/src/Haskoin/Util/Arbitrary/Util.hs +++ b/src/Haskoin/Util/Arbitrary/Util.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} -- | @@ -18,17 +19,16 @@ module Haskoin.Util.Arbitrary.Util arbitraryMaybe, arbitraryNetwork, arbitraryUTCTime, - SerialBox (..), - JsonBox (..), - NetBox (..), ReadBox (..), + JsonBox (..), + MarshalJsonBox (..), + SerialBox (..), + MarshalBox (..), + IdentityTests (..), testIdentity, testSerial, testRead, testJson, - testNetJson, - arbitraryNetData, - genNetData, ) where @@ -42,14 +42,17 @@ import qualified Data.ByteString.Short as BSS import Data.Bytes.Get import Data.Bytes.Put import Data.Bytes.Serial +import Data.Default import qualified Data.Map.Strict as Map import Data.Proxy import Data.Time.Clock (UTCTime (..)) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import qualified Data.Typeable as T import Data.Word (Word32) +import Haskoin.Crypto (Ctx) import Haskoin.Network.Constants import Haskoin.Network.Data +import Haskoin.Util import Test.Hspec (Spec, describe, shouldBe, shouldSatisfy) import Test.Hspec.QuickCheck (prop) import Test.QuickCheck @@ -98,10 +101,8 @@ arbitraryNetwork = elements allNets -- Helpers for creating Serial and JSON Identity tests -data SerialBox - = forall a. - (Show a, Eq a, T.Typeable a, Serial a) => - SerialBox (Gen a) +instance Show Ctx where + show _ = "Ctx" data ReadBox = forall a. @@ -113,30 +114,68 @@ data JsonBox (Show a, Eq a, T.Typeable a, A.ToJSON a, A.FromJSON a) => JsonBox (Gen a) -data NetBox +data MarshalJsonBox + = forall s a. + (Show a, Show s, Eq a, T.Typeable a, MarshalJSON s a) => + MarshalJsonBox (Gen (s, a)) + +data SerialBox = forall a. - (Show a, Eq a, T.Typeable a) => - NetBox - ( Network -> a -> A.Value, - Network -> a -> A.Encoding, - Network -> A.Value -> A.Parser a, - Gen (Network, a) - ) - -testIdentity :: [SerialBox] -> [ReadBox] -> [JsonBox] -> [NetBox] -> Spec -testIdentity serialVals readVals jsonVals netVals = do - describe "Binary Encoding" $ - forM_ serialVals $ - \(SerialBox g) -> testSerial g + (Show a, Eq a, T.Typeable a, Serial a) => + SerialBox (Gen a) + +data MarshalBox + = forall s a. + (Show a, Show s, Eq a, T.Typeable a, Marshal s a) => + MarshalBox (Gen (s, a)) + +data IdentityTests = IdentityTests + { readTests :: [ReadBox], + jsonTests :: [JsonBox], + marshalJsonTests :: [MarshalJsonBox], + serialTests :: [SerialBox], + marshalTests :: [MarshalBox] + } + +instance Default IdentityTests where + def = + IdentityTests + { readTests = [], + jsonTests = [], + marshalJsonTests = [], + serialTests = [], + marshalTests = [] + } + +testIdentity :: IdentityTests -> Spec +testIdentity t = do describe "Read/Show Encoding" $ - forM_ readVals $ + forM_ t.readTests $ \(ReadBox g) -> testRead g describe "Data.Aeson Encoding" $ - forM_ jsonVals $ + forM_ t.jsonTests $ \(JsonBox g) -> testJson g - describe "Data.Aeson Encoding with Network" $ - forM_ netVals $ - \(NetBox (j, e, p, g)) -> testNetJson j e p g + describe "MarshalJSON Encoding" $ + forM_ t.marshalJsonTests $ + \(MarshalJsonBox g) -> testMarshalJson g + describe "Binary Encoding" $ + forM_ t.serialTests $ + \(SerialBox g) -> testSerial g + describe "Marshal Encoding" $ + forM_ t.marshalTests $ + \(MarshalBox g) -> testMarshal g + +-- | Generate Read/Show identity tests +testRead :: + (Eq a, Read a, Show a, T.Typeable a) => Gen a -> Spec +testRead gen = + prop ("read/show identity for " <> name) $ + forAll gen $ + \x -> (read . show) x `shouldBe` x + where + name = show $ T.typeRep $ proxy gen + proxy :: Gen a -> Proxy a + proxy = const Proxy -- | Generate binary identity tests testSerial :: @@ -153,16 +192,19 @@ testSerial gen = proxy :: Gen a -> Proxy a proxy = const Proxy --- | Generate Read/Show identity tests -testRead :: - (Eq a, Read a, Show a, T.Typeable a) => Gen a -> Spec -testRead gen = - prop ("read/show identity for " <> name) $ - forAll gen $ - \x -> (read . show) x `shouldBe` x +-- | Generate Marshal identity tests +testMarshal :: + (Eq a, Show a, Show s, T.Typeable a, Marshal s a) => + Gen (s, a) -> + Spec +testMarshal gen = do + prop ("Marshal marshalPut/marshalGet identity for " <> name) $ + forAll gen $ \(s, a) -> do + (unmarshal s . marshal s) a `shouldBe` Right a + (unmarshalLazy s . marshalLazy s) a `shouldBe` a where name = show $ T.typeRep $ proxy gen - proxy :: Gen a -> Proxy a + proxy :: Gen (s, a) -> Proxy a proxy = const Proxy -- | Generate Data.Aeson identity tests @@ -182,40 +224,25 @@ testJson gen = do (A.decode . A.encodingToLazyByteString . A.toEncoding) (toMap x) == Just (toMap x) --- | Generate Data.Aeson identity tests for type that need the @Network@ -testNetJson :: - (Eq a, Show a, T.Typeable a) => - (Network -> a -> A.Value) -> - (Network -> a -> A.Encoding) -> - (Network -> A.Value -> A.Parser a) -> - Gen (Network, a) -> +-- | Generate MarshalJSON identity tests +testMarshalJson :: + (Eq a, Show a, Show s, T.Typeable a, MarshalJSON s a) => + Gen (s, a) -> Spec -testNetJson j e p g = do - prop ("Data.Aeson toJSON/fromJSON identity (with network) for " <> name) $ - forAll g $ - \(net, x) -> dec net (encVal net x) `shouldBe` Just x - prop ("Data.Aeson toEncoding/fromJSON identity (with network) for " <> name) $ - forAll g $ - \(net, x) -> dec net (encEnc net x) `shouldBe` Just x +testMarshalJson gen = do + prop ("MarshalJSON marshalValue/unmarshalValue identity for " <> name) $ + forAll gen $ + \(s, a) -> a `shouldSatisfy` marshalJsonID s + prop ("MarshalJSON marshalEncoding/unmarshalValue identity for " <> name) $ + forAll gen $ + \(s, a) -> a `shouldSatisfy` marshalEncodingID s where - encVal net = A.encode . toMap . j net - encEnc net = A.encodingToLazyByteString . toMapE . e net - dec net = A.parseMaybe (p net) . fromMap <=< A.decode - name = show $ T.typeRep $ proxy j - proxy :: (Network -> a -> A.Value) -> Proxy a + name = show $ T.typeRep $ proxy gen + proxy :: Gen (s, a) -> Proxy a proxy = const Proxy - -arbitraryNetData :: (Arbitrary a) => Gen (Network, a) -arbitraryNetData = do - net <- arbitraryNetwork - x <- arbitrary - return (net, x) - -genNetData :: Gen a -> Gen (Network, a) -genNetData gen = do - net <- arbitraryNetwork - x <- gen - return (net, x) + marshalJsonID s a = + A.parseMaybe (unmarshalValue s) (marshalValue s a) == Just a + marshalEncodingID s a = unmarshalJSON s (marshalJSON s a) == Just a toMap :: a -> Map.Map String a toMap = Map.singleton "object" diff --git a/test/Haskoin/AddressSpec.hs b/test/Haskoin/AddressSpec.hs index ae9297de..6a04a66e 100644 --- a/test/Haskoin/AddressSpec.hs +++ b/test/Haskoin/AddressSpec.hs @@ -5,6 +5,7 @@ module Haskoin.AddressSpec (spec) where import Data.ByteString (ByteString) import Data.ByteString qualified as B +import Data.Default (def) import Data.Maybe (fromJust, isJust) import Data.Text (Text) import Data.Text qualified as T @@ -19,19 +20,17 @@ import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck -serialVals :: [SerialBox] -serialVals = [SerialBox arbitraryAddressAll] - -readVals :: [ReadBox] -readVals = [ReadBox arbitraryAddressAll] - -netVals :: [NetBox] -netVals = - [NetBox (marshalValue, marshalEncoding, unmarshalValue, arbitraryNetAddress)] +identityTests :: IdentityTests +identityTests = + def + { readTests = [ReadBox arbitraryAddressAll], + serialTests = [SerialBox arbitraryAddressAll], + marshalJsonTests = [MarshalJsonBox arbitraryNetAddress] + } spec :: Spec spec = prepareContext $ \ctx -> do - testIdentity serialVals readVals [] netVals + testIdentity identityTests describe "Address properties" $ do prop "encodes and decodes base58 bytestring" $ forAll arbitraryBS $ \bs -> diff --git a/test/Haskoin/BlockSpec.hs b/test/Haskoin/BlockSpec.hs index 9f22092a..75e4f3df 100644 --- a/test/Haskoin/BlockSpec.hs +++ b/test/Haskoin/BlockSpec.hs @@ -9,6 +9,7 @@ where import Control.Monad import Control.Monad.State.Strict +import Data.Default (def) import Data.Either (fromRight) import Data.Maybe (fromJust) import Data.String (fromString) @@ -28,36 +29,36 @@ import Test.Hspec.QuickCheck import Test.QuickCheck import Text.Printf (printf) -serialVals :: Ctx -> [SerialBox] -serialVals ctx = - [ SerialBox (flip arbitraryBlock ctx =<< arbitraryNetwork), - SerialBox arbitraryBlockHash, - SerialBox arbitraryBlockHeader, - SerialBox arbitraryGetBlocks, - SerialBox arbitraryGetHeaders, - SerialBox arbitraryHeaders, - SerialBox arbitraryMerkleBlock, - SerialBox arbitraryBlockNode - ] - -readVals :: Ctx -> [ReadBox] -readVals ctx = - [ ReadBox (flip arbitraryBlock ctx =<< arbitraryNetwork), - ReadBox arbitraryBlockHash, - ReadBox arbitraryBlockHeader, - ReadBox arbitraryGetBlocks, - ReadBox arbitraryGetHeaders, - ReadBox arbitraryHeaders, - ReadBox arbitraryMerkleBlock, - ReadBox arbitraryBlockNode - ] - -jsonVals :: Ctx -> [JsonBox] -jsonVals ctx = - [ JsonBox (flip arbitraryBlock ctx =<< arbitraryNetwork), - JsonBox arbitraryBlockHash, - JsonBox arbitraryBlockHeader - ] +identityTests :: Ctx -> IdentityTests +identityTests ctx = + def + { readTests = + [ ReadBox (flip arbitraryBlock ctx =<< arbitraryNetwork), + ReadBox arbitraryBlockHash, + ReadBox arbitraryBlockHeader, + ReadBox arbitraryGetBlocks, + ReadBox arbitraryGetHeaders, + ReadBox arbitraryHeaders, + ReadBox arbitraryMerkleBlock, + ReadBox arbitraryBlockNode, + ReadBox arbitraryHeaderMemory + ], + jsonTests = + [ JsonBox (flip arbitraryBlock ctx =<< arbitraryNetwork), + JsonBox arbitraryBlockHash, + JsonBox arbitraryBlockHeader + ], + serialTests = + [ SerialBox (flip arbitraryBlock ctx =<< arbitraryNetwork), + SerialBox arbitraryBlockHash, + SerialBox arbitraryBlockHeader, + SerialBox arbitraryGetBlocks, + SerialBox arbitraryGetHeaders, + SerialBox arbitraryHeaders, + SerialBox arbitraryMerkleBlock, + SerialBox arbitraryBlockNode + ] + } myTime :: Timestamp myTime = 1499083075 @@ -74,7 +75,7 @@ chain net bh i = do spec :: Spec spec = prepareContext $ \ctx -> do - testIdentity (serialVals ctx) (readVals ctx) (jsonVals ctx) [] + testIdentity $ identityTests ctx describe "blockchain headers" $ do it "gets best block on bchRegTest" $ let net = bchRegTest diff --git a/test/Haskoin/Crypto/HashSpec.hs b/test/Haskoin/Crypto/HashSpec.hs index 60541bf4..d20c6cf7 100644 --- a/test/Haskoin/Crypto/HashSpec.hs +++ b/test/Haskoin/Crypto/HashSpec.hs @@ -14,6 +14,7 @@ import Data.ByteString.Short qualified as Short import Data.Bytes.Get import Data.Bytes.Put import Data.Bytes.Serial +import Data.Default (def) import Data.Maybe (fromJust) import Data.String (fromString) import Data.String.Conversions @@ -28,27 +29,27 @@ import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck -serialVals :: [SerialBox] -serialVals = - [ SerialBox arbitraryBS, - SerialBox arbitraryHash160, - SerialBox arbitraryHash256, - SerialBox arbitraryHash512 - ] - -readVals :: [ReadBox] -readVals = - [ ReadBox arbitraryBS, - ReadBox arbitraryBSS, - ReadBox arbitraryHash160, - ReadBox arbitraryHash256, - ReadBox arbitraryHash512 - ] +identityTests :: IdentityTests +identityTests = + def + { readTests = + [ ReadBox arbitraryHash160, + ReadBox arbitraryHash256, + ReadBox arbitraryHash512, + ReadBox arbitraryCheckSum32 + ], + serialTests = + [ SerialBox arbitraryHash160, + SerialBox arbitraryHash256, + SerialBox arbitraryHash512, + SerialBox arbitraryCheckSum32 + ] + } spec :: Spec spec = describe "Hash" $ do - testIdentity serialVals readVals [] [] + testIdentity identityTests describe "Property Tests" $ do prop "join512( split512(h) ) == h" $ forAll arbitraryHash256 $ diff --git a/test/Haskoin/Crypto/Keys/ExtendedSpec.hs b/test/Haskoin/Crypto/Keys/ExtendedSpec.hs index 5789cc60..8940a249 100644 --- a/test/Haskoin/Crypto/Keys/ExtendedSpec.hs +++ b/test/Haskoin/Crypto/Keys/ExtendedSpec.hs @@ -13,6 +13,7 @@ import Data.ByteString.Lazy.Char8 qualified as B8 import Data.Bytes.Get import Data.Bytes.Put import Data.Bytes.Serial +import Data.Default (def) import Data.Either (isLeft) import Data.Maybe (fromJust, isJust, isNothing) import Data.String (fromString) @@ -29,51 +30,44 @@ import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck hiding ((.&.)) -serialVals :: [SerialBox] -serialVals = - [ SerialBox arbitraryDerivPath, - SerialBox arbitraryHardPath, - SerialBox arbitrarySoftPath - ] - -readVals :: Ctx -> [ReadBox] -readVals ctx = - [ ReadBox arbitraryDerivPath, - ReadBox arbitraryHardPath, - ReadBox arbitrarySoftPath, - ReadBox arbitraryXPrvKey, - ReadBox (snd <$> arbitraryXPubKey ctx), - ReadBox arbitraryParsedPath, - ReadBox arbitraryBip32PathIndex - ] - -jsonVals :: [JsonBox] -jsonVals = - [ JsonBox arbitraryDerivPath, - JsonBox arbitraryHardPath, - JsonBox arbitrarySoftPath, - JsonBox arbitraryParsedPath - ] - -netVals :: Ctx -> [NetBox] -netVals ctx = - [ NetBox - ( marshalValue, - marshalEncoding, - unmarshalValue, - genNetData arbitraryXPrvKey - ), - NetBox - ( marshalValue . (,ctx), - marshalEncoding . (,ctx), - unmarshalValue . (,ctx), - genNetData (snd <$> arbitraryXPubKey ctx) - ) - ] +identityTests :: Ctx -> IdentityTests +identityTests ctx = + def + { readTests = + [ ReadBox arbitraryXPrvKey, + ReadBox (arbitraryXPubKey ctx), + ReadBox arbitraryDerivPath, + ReadBox arbitraryHardPath, + ReadBox arbitrarySoftPath, + ReadBox arbitraryParsedPath, + ReadBox arbitraryBip32PathIndex + ], + jsonTests = + [ JsonBox arbitraryDerivPath, + JsonBox arbitraryHardPath, + JsonBox arbitrarySoftPath, + JsonBox arbitraryParsedPath + ], + marshalJsonTests = + [ MarshalJsonBox $ (,) <$> arbitraryNetwork <*> arbitraryXPrvKey, + MarshalJsonBox $ + (,) <$> ((,ctx) <$> arbitraryNetwork) <*> arbitraryXPubKey ctx + ], + serialTests = + [ SerialBox arbitraryDerivPath, + SerialBox arbitraryHardPath, + SerialBox arbitrarySoftPath + ], + marshalTests = + [ MarshalBox $ (,) <$> arbitraryNetwork <*> arbitraryXPrvKey, + MarshalBox $ + (,) <$> ((,ctx) <$> arbitraryNetwork) <*> arbitraryXPubKey ctx + ] + } spec :: Spec spec = prepareContext $ \ctx -> do - testIdentity serialVals (readVals ctx) jsonVals (netVals ctx) + testIdentity $ identityTests ctx describe "Custom identity tests" $ do prop "encodes and decodes extended private key" $ forAll arbitraryNetwork $ \net -> @@ -82,7 +76,7 @@ spec = prepareContext $ \ctx -> do prop "encodes and decodes extended public key" $ forAll arbitraryNetwork $ \net -> forAll (arbitraryXPubKey ctx) $ - customCerealID (marshalGet (net, ctx)) (marshalPut (net, ctx)) . snd + customCerealID (marshalGet (net, ctx)) (marshalPut (net, ctx)) describe "bip32 subkey derivation vector 1" $ vectorSpec ctx m1 vector1 describe "bip32 subkey derivation vector 2" $ vectorSpec ctx m2 vector2 describe "bip32 subkey derivation vector 3" $ vectorSpec ctx m3 vector3 @@ -122,7 +116,7 @@ spec = prepareContext $ \ctx -> do forAll arbitraryXPrvKey $ \k -> xPrvImport net (xPrvExport net k) == Just k prop "exports and imports extended public key" $ - forAll (arbitraryXPubKey ctx) $ \(_, k) -> + forAll (arbitraryXPubKey ctx) $ \k -> xPubImport net ctx (xPubExport net ctx k) == Just k pubKeyOfSubKeyIsSubKeyOfPubKey :: Ctx -> XPrvKey -> Word32 -> Bool diff --git a/test/Haskoin/Crypto/KeysSpec.hs b/test/Haskoin/Crypto/KeysSpec.hs index 9cc93836..c5907089 100644 --- a/test/Haskoin/Crypto/KeysSpec.hs +++ b/test/Haskoin/Crypto/KeysSpec.hs @@ -14,6 +14,7 @@ import Data.ByteString.Char8 qualified as C import Data.Bytes.Get import Data.Bytes.Put import Data.Bytes.Serial +import Data.Default (def) import Data.Maybe import Data.Serialize qualified as S import Data.String (fromString) @@ -30,16 +31,30 @@ import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck +identityTests :: Ctx -> IdentityTests +identityTests ctx = + def + { readTests = + [ ReadBox (arbitrary :: Gen SecKey), + ReadBox arbitraryPrivateKey, + ReadBox (arbitraryPublicKey ctx) + ], + marshalJsonTests = + [ MarshalJsonBox $ (,) <$> arbitraryNetwork <*> arbitraryPrivateKey, + MarshalJsonBox ((,) ctx <$> arbitraryPublicKey ctx) + ], + serialTests = + [ SerialBox arbitraryPrivateKey + ], + marshalTests = + [ MarshalBox ((,) ctx <$> arbitraryPublicKey ctx) + ] + } + spec :: Spec spec = prepareContext $ \ctx -> do describe "Key pair property checks" $ do - testNetJson - marshalValue - marshalEncoding - unmarshalValue - $ (,) - <$> arbitraryNetwork - <*> fmap fst (arbitraryKeyPair ctx) + testIdentity $ identityTests ctx prop "Public key is canonical" $ forAll (arbitraryKeyPair ctx) (isCanonicalPubKey ctx . snd) prop "Key pair key show . read identity" $ diff --git a/test/Haskoin/NetworkSpec.hs b/test/Haskoin/NetworkSpec.hs index 31d14e8b..6c7edf40 100644 --- a/test/Haskoin/NetworkSpec.hs +++ b/test/Haskoin/NetworkSpec.hs @@ -7,6 +7,7 @@ module Haskoin.NetworkSpec (spec) where import Data.Bytes.Get import Data.Bytes.Put import Data.Bytes.Serial +import Data.Default (def) import Data.Maybe (fromJust) import Data.Text (Text) import Data.Word (Word32) @@ -22,34 +23,37 @@ import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck -serialVals :: [SerialBox] -serialVals = - [ SerialBox arbitraryVarInt, - SerialBox arbitraryVarString, - SerialBox arbitraryNetworkAddress, - SerialBox arbitraryInvType, - SerialBox arbitraryInvVector, - SerialBox arbitraryInv1, - SerialBox arbitraryVersion, - SerialBox arbitraryAddr1, - SerialBox arbitraryAlert, - SerialBox arbitraryReject, - SerialBox arbitraryRejectCode, - SerialBox arbitraryGetData, - SerialBox arbitraryNotFound, - SerialBox arbitraryPing, - SerialBox arbitraryPong, - SerialBox arbitraryMessageCommand, - SerialBox arbitraryMessageHeader, - SerialBox arbitraryBloomFlags, - SerialBox arbitraryBloomFilter, - SerialBox arbitraryFilterLoad, - SerialBox arbitraryFilterAdd - ] +identityTests :: IdentityTests +identityTests = + def + { serialTests = + [ SerialBox arbitraryVarInt, + SerialBox arbitraryVarString, + SerialBox arbitraryNetworkAddress, + SerialBox arbitraryInvType, + SerialBox arbitraryInvVector, + SerialBox arbitraryInv1, + SerialBox arbitraryVersion, + SerialBox arbitraryAddr1, + SerialBox arbitraryAlert, + SerialBox arbitraryReject, + SerialBox arbitraryRejectCode, + SerialBox arbitraryGetData, + SerialBox arbitraryNotFound, + SerialBox arbitraryPing, + SerialBox arbitraryPong, + SerialBox arbitraryMessageCommand, + SerialBox arbitraryMessageHeader, + SerialBox arbitraryBloomFlags, + SerialBox arbitraryBloomFilter, + SerialBox arbitraryFilterLoad, + SerialBox arbitraryFilterAdd + ] + } spec :: Spec spec = prepareContext $ \ctx -> do - testIdentity serialVals [] [] [] + testIdentity identityTests describe "Custom identity tests" $ do prop "Data.Serialize Encoding for type Message" $ forAll arbitraryNetwork $ \net -> diff --git a/test/Haskoin/ScriptSpec.hs b/test/Haskoin/ScriptSpec.hs index 03bc604d..848eb924 100644 --- a/test/Haskoin/ScriptSpec.hs +++ b/test/Haskoin/ScriptSpec.hs @@ -2,7 +2,6 @@ {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TupleSections #-} module Haskoin.ScriptSpec (spec) where @@ -13,6 +12,7 @@ import Data.ByteString qualified as B import Data.Bytes.Get import Data.Bytes.Put import Data.Bytes.Serial +import Data.Default (def) import Data.Either import Data.List import Data.Maybe @@ -34,50 +34,60 @@ import Test.Hspec.QuickCheck import Test.QuickCheck import Text.Read -serialVals :: [SerialBox] -serialVals = - [ SerialBox arbitraryScriptOp, - SerialBox arbitraryScript - ] - -readVals :: Ctx -> [ReadBox] -readVals ctx = - [ ReadBox arbitrarySigHash, - ReadBox arbitrarySigHashFlag, - ReadBox arbitraryScript, - ReadBox arbitraryPushDataType, - ReadBox arbitraryScriptOp, - ReadBox ((`arbitraryScriptOutput` ctx) =<< arbitraryNetwork) - ] - -jsonVals :: Ctx -> [JsonBox] -jsonVals ctx = - [ JsonBox $ - fmap (marshalValue ctx) $ - arbitraryNetwork >>= flip arbitraryScriptOutput ctx, - JsonBox arbitraryOutPoint, - JsonBox arbitrarySigHash, - JsonBox $ - fmap (marshalValue ctx . fst) $ - arbitraryNetwork >>= flip arbitrarySigInput ctx - ] - -netVals :: Ctx -> [NetBox] -netVals ctx = - [ NetBox - ( marshalValue . (,ctx), - marshalEncoding . (,ctx), - unmarshalValue . (,ctx), - do - net <- arbitraryNetwork - (_, _, txsig) <- arbitraryTxSignature net ctx - return (net, txsig) - ) - ] +identityTests :: Ctx -> IdentityTests +identityTests ctx = + def + { readTests = + [ ReadBox arbitrarySigHash, + ReadBox arbitrarySigHashFlag, + ReadBox arbitraryScript, + ReadBox arbitraryPushDataType, + ReadBox arbitraryScriptOp, + ReadBox ((`arbitraryScriptOutput` ctx) =<< arbitraryNetwork), + ReadBox ((`arbitraryScriptInput` ctx) =<< arbitraryNetwork) + ], + jsonTests = + [ JsonBox arbitraryScript, + JsonBox arbitraryOutPoint, + JsonBox arbitrarySigHash + ], + marshalJsonTests = + [ MarshalJsonBox $ do + n <- arbitraryNetwork + (_, _, ts) <- arbitraryTxSignature n ctx + return ((n, ctx), ts), + MarshalJsonBox $ do + n <- arbitraryNetwork + o <- arbitraryScriptOutput n ctx + return (ctx, o), + MarshalJsonBox $ do + n <- arbitraryNetwork + (i, _) <- arbitrarySigInput n ctx + return (ctx, i) + ], + serialTests = + [ SerialBox arbitraryScriptOp, + SerialBox arbitraryScript + ], + marshalTests = + [ MarshalBox $ do + n <- arbitraryNetwork + (_, _, ts) <- arbitraryTxSignature n ctx + return ((n, ctx), ts), + MarshalBox $ do + n <- arbitraryNetwork + o <- arbitraryScriptOutput n ctx + return (ctx, o), + MarshalBox $ do + n <- arbitraryNetwork + i <- arbitraryScriptInput n ctx + return ((n, ctx), i) + ] + } spec :: Spec spec = prepareContext $ \ctx -> do - testIdentity serialVals (readVals ctx) (jsonVals ctx) (netVals ctx) + testIdentity $ identityTests ctx describe "btc scripts" $ props btc ctx describe "bch scripts" $ props bch ctx describe "multi signatures" $ diff --git a/test/Haskoin/TransactionSpec.hs b/test/Haskoin/TransactionSpec.hs index c2400b0d..f87a4cc8 100644 --- a/test/Haskoin/TransactionSpec.hs +++ b/test/Haskoin/TransactionSpec.hs @@ -12,6 +12,7 @@ import Data.ByteString qualified as B import Data.Bytes.Get import Data.Bytes.Put import Data.Bytes.Serial +import Data.Default (def) import Data.Either import Data.Maybe import Data.String (fromString) @@ -31,39 +32,38 @@ import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck -serialVals :: Ctx -> [SerialBox] -serialVals ctx = - [ SerialBox $ flip arbitraryTx ctx =<< arbitraryNetwork, - SerialBox $ flip arbitraryWitnessTx ctx =<< arbitraryNetwork, - SerialBox $ flip arbitraryLegacyTx ctx =<< arbitraryNetwork, - SerialBox $ flip arbitraryTxIn ctx =<< arbitraryNetwork, - SerialBox $ flip arbitraryTxOut ctx =<< arbitraryNetwork, - SerialBox arbitraryOutPoint - ] - -readVals :: Ctx -> [ReadBox] -readVals ctx = - [ ReadBox arbitraryTxHash, - ReadBox $ flip arbitraryTx ctx =<< arbitraryNetwork, - ReadBox $ flip arbitraryTxIn ctx =<< arbitraryNetwork, - ReadBox $ flip arbitraryTxOut ctx =<< arbitraryNetwork, - ReadBox arbitraryOutPoint - ] - -jsonVals :: Ctx -> [JsonBox] -jsonVals ctx = - [ JsonBox arbitraryTxHash, - JsonBox $ flip arbitraryTx ctx =<< arbitraryNetwork, - JsonBox $ flip arbitraryWitnessTx ctx =<< arbitraryNetwork, - JsonBox $ flip arbitraryLegacyTx ctx =<< arbitraryNetwork, - JsonBox $ flip arbitraryTxIn ctx =<< arbitraryNetwork, - JsonBox $ flip arbitraryTxOut ctx =<< arbitraryNetwork, - JsonBox arbitraryOutPoint - ] +identityTests :: Ctx -> IdentityTests +identityTests ctx = + def + { readTests = + [ ReadBox arbitraryTxHash, + ReadBox $ flip arbitraryTx ctx =<< arbitraryNetwork, + ReadBox $ flip arbitraryTxIn ctx =<< arbitraryNetwork, + ReadBox $ flip arbitraryTxOut ctx =<< arbitraryNetwork, + ReadBox arbitraryOutPoint + ], + jsonTests = + [ JsonBox arbitraryTxHash, + JsonBox $ flip arbitraryTx ctx =<< arbitraryNetwork, + JsonBox $ flip arbitraryWitnessTx ctx =<< arbitraryNetwork, + JsonBox $ flip arbitraryLegacyTx ctx =<< arbitraryNetwork, + JsonBox $ flip arbitraryTxIn ctx =<< arbitraryNetwork, + JsonBox $ flip arbitraryTxOut ctx =<< arbitraryNetwork, + JsonBox arbitraryOutPoint + ], + serialTests = + [ SerialBox $ flip arbitraryTx ctx =<< arbitraryNetwork, + SerialBox $ flip arbitraryWitnessTx ctx =<< arbitraryNetwork, + SerialBox $ flip arbitraryLegacyTx ctx =<< arbitraryNetwork, + SerialBox $ flip arbitraryTxIn ctx =<< arbitraryNetwork, + SerialBox $ flip arbitraryTxOut ctx =<< arbitraryNetwork, + SerialBox arbitraryOutPoint + ] + } spec :: Spec spec = prepareContext $ \ctx -> do - testIdentity (serialVals ctx) (readVals ctx) (jsonVals ctx) [] + testIdentity $ identityTests ctx describe "Transaction properties" $ do prop "decode and encode txid" $ forAll arbitraryTxHash $ diff --git a/test/Haskoin/UtilSpec.hs b/test/Haskoin/UtilSpec.hs index f0a3896c..5cd959f5 100644 --- a/test/Haskoin/UtilSpec.hs +++ b/test/Haskoin/UtilSpec.hs @@ -7,6 +7,7 @@ import Data.Aeson.Encoding (encodingToLazyByteString) import Data.Aeson.Types (Parser, parse) import Data.ByteString (ByteString) import Data.ByteString qualified as B +import Data.Default (def) import Data.Either (fromLeft, fromRight, isLeft, isRight) import Data.Foldable (toList) import Data.List (permutations) @@ -21,9 +22,18 @@ import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck (forAll) +identityTests :: IdentityTests +identityTests = + def + { readTests = + [ ReadBox arbitraryNetwork + ] + } + spec :: Spec spec = describe "utility functions" $ do + testIdentity identityTests prop "bsToInteger . integerToBS" getPutInteger prop "decodeHex . encodeHex" $ forAll arbitraryBS fromToHex prop "compare updateIndex with Data.Sequence" testUpdateIndex