packages feed

haskoin (empty) → 0.0.2

raw patch · 87 files changed

+11791/−0 lines, 87 filesdep +HUnitdep +QuickCheckdep +aesonsetup-changed

Dependencies added: HUnit, QuickCheck, aeson, base, binary, byteable, bytestring, conduit, conduit-extra, containers, cryptohash, either, mtl, pbkdf, split, test-framework, test-framework-hunit, test-framework-quickcheck2, text, text-icu, vector

Files

+ Network/Haskoin/Crypto.hs view
@@ -0,0 +1,231 @@+{-|+  This package provides the elliptic curve cryptography required for creating+  and validating bitcoin transactions. It also provides SHA-256 and RIPEMD-160+  hashing functions; as well as mnemonic keys from BIP-0039.+-}+module Network.Haskoin.Crypto+( +  -- *Elliptic Curve Keys+  +  -- **Public Keys+  PubKey(..)+, isValidPubKey+, isPubKeyU+, derivePubKey+, pubKeyAddr+, addPubKeys++  -- **Private Keys+, PrvKey(..)+, isValidPrvKey+, makePrvKey+, makePrvKeyU+, fromPrvKey+, isPrvKeyU+, addPrvKeys+, putPrvKey+, getPrvKey+, getPrvKeyU+, fromWIF+, toWIF++  -- *ECDSA+  -- **SecretT Monad+  -- | The SecretT monad is a monadic wrapper around  HMAC DRBG (deterministic+  -- random byte generator) using SHA-256. The implementation is provided in +  -- 'Network.Haskoin.Crypto.Hash' and the specification is defined in+  -- <http://csrc.nist.gov/publications/nistpubs/800-90A/SP800-90A.pdf>. The+  -- SecretT monad is used to generate random private keys and random nonces+  -- for ECDSA signatures.+, SecretT+, withSource+, devURandom+, devRandom+, genPrvKey++  -- **Signatures+  -- | Elliptic curve cryptography standards are defined in+  -- <http://www.secg.org/download/aid-780/sec1-v2.pdf>+, Signature+, signMsg+, detSignMsg+, verifySig+, isCanonicalHalfOrder++  -- * Big words+, Word512+, Word256+, Word160+, Word128++  -- *Hash functions+, Hash512+, Hash256+, Hash160+, CheckSum32+, hash512+, hash512BS+, hash256+, hash256BS+, hash160+, hash160BS+, doubleHash256+, doubleHash256BS+, chksum32+, hmac512+, hmac512BS+, hmac256+, hmac256BS+, split512+, join512+, murmurHash3++  -- *Number representations+, decodeCompact+, encodeCompact++  -- *Base58 and Addresses+, Address(..)+, base58ToAddr+, addrToBase58+, encodeBase58+, decodeBase58+, encodeBase58Check+, decodeBase58Check++  -- *Mnemonic keys (BIP-0039)+, WordList+, Entropy+, Mnemonic+, Passphrase+, Seed+, toMnemonic+, fromMnemonic+, mnemonicToSeed+, anyToSeed+, english++  -- *Extended Keys+, ChainCode++  -- **Extended Private Keys+, XPrvKey(..)+, makeXPrvKey+, xPrvIsPrime+, xPrvChild+, xPrvID+, xPrvFP+, xPrvExport+, xPrvImport+, xPrvWIF++  -- **Extended Public Keys+, XPubKey(..)+, deriveXPubKey+, xPubIsPrime+, xPubChild+, xPubID+, xPubFP+, xPubAddr+, xPubExport+, xPubImport++  -- **Child key derivations+, prvSubKey+, pubSubKey+, primeSubKey+, prvSubKeys+, pubSubKeys+, primeSubKeys++  -- ***Multisig derivations+, mulSigSubKey+, mulSigSubKeys++  -- *Derivation tree interoperability++  -- | To improve BIP32 wallet interoperability, a standard derivation tree+  -- is used. All accounts are generated through prime derivations from the+  -- master key. This ensures that the master key is not compromised if+  -- an account is compromised. Every account will generate receiving+  -- addresses from the non-prime subtree index 0 and internal change+  -- addresses from the non-prime subtree index 1. MasterKey, AccountKey+  -- and AddressKey types are defined to conform to the wallet interoperability+  -- format.++, KeyIndex++  -- **Master keys+, MasterKey(..)+, makeMasterKey+, loadMasterKey++  -- **Account keys+, AccPrvKey(..)+, AccPubKey(..)+, loadPrvAcc+, loadPubAcc+, accPrvKey+, accPubKey+, accPrvKeys+, accPubKeys++  -- **Address keys+, AddrPrvKey(..)+, AddrPubKey(..)+, addr+, extPrvKey+, extPubKey+, intPrvKey+, intPubKey+, extPrvKeys+, extPubKeys+, intPrvKeys+, intPubKeys+, extAddr+, intAddr+, extAddrs+, intAddrs+, extAddrs'+, intAddrs'++  -- ***Multisig address keys+, extMulSigKey+, intMulSigKey+, extMulSigKeys+, intMulSigKeys+, extMulSigAddr+, intMulSigAddr+, extMulSigAddrs+, intMulSigAddrs++  -- *Bloom filters+, BloomFilter+, BloomFlags(..)+, bloomCreate+, bloomInsert+, bloomContains+, bloomUpdateEmptyFull+, bloomIsValid++  -- *Partial merkle trees+, calcTreeHeight+, calcTreeWidth+, buildMerkleRoot+, calcHash+, buildPartialMerkle+, extractMatches++) where++import Network.Haskoin.Crypto.ECDSA+import Network.Haskoin.Crypto.Keys+import Network.Haskoin.Crypto.Hash+import Network.Haskoin.Crypto.Base58+import Network.Haskoin.Crypto.Mnemonic+import Network.Haskoin.Crypto.BigWord+import Network.Haskoin.Crypto.ExtendedKeys+import Network.Haskoin.Crypto.NormalizedKeys+import Network.Haskoin.Crypto.Merkle+import Network.Haskoin.Crypto.Bloom+
+ Network/Haskoin/Crypto/Base58.hs view
@@ -0,0 +1,131 @@+module Network.Haskoin.Crypto.Base58+( Address(..)+, addrToBase58+, base58ToAddr+, encodeBase58+, decodeBase58+, encodeBase58Check+, decodeBase58Check+) where++import Control.Monad (guard)+import Control.Applicative ((<$>),(<*>))++import Data.Char (ord)+import Data.Word (Word8)+import Data.Maybe (fromJust)+import Data.Aeson+    ( Value (String)+    , FromJSON+    , ToJSON+    , parseJSON+    , toJSON+    , withText +    )++import qualified Data.ByteString as BS+import qualified Data.Map.Strict as M+import qualified Data.Text as T++import Network.Haskoin.Crypto.Hash +import Network.Haskoin.Util ++b58String :: String+b58String = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"++b58Data :: BS.ByteString+b58Data = BS.pack $ map (fromIntegral . ord) b58String++b58Data' :: M.Map Word8 Int+b58Data' = M.fromList $ zip (BS.unpack b58Data) [0..57]++b58 :: Word8 -> Word8+b58 i = BS.index b58Data (fromIntegral i)++b58' :: Word8 -> Maybe Word8+b58' w = fromIntegral <$> M.lookup w b58Data'++encodeBase58I :: Integer -> BS.ByteString+encodeBase58I 0 = BS.pack [b58 0]+encodeBase58I i+    | i >= 0 = go BS.empty i+    | otherwise = error "encodeBase58 is not defined for negative Integers"+  where +    go acc 0 = acc+    go acc n = go (BS.cons (fromIntegral b) acc) q+      where +        (q,r) = n `quotRem` 58+        b     = b58 $ fromIntegral r++-- | Encode a bytestring to a base 58 representation.+encodeBase58 :: BS.ByteString -> BS.ByteString+encodeBase58 bs = BS.append l r+  where +    (z,b) = BS.span (== 0) bs+    l = BS.map b58 z -- preserve leading 0's+    r | BS.null b = BS.empty+      | otherwise = encodeBase58I $ bsToInteger b++-- | Decode a base 58 encoded bytestring. This can fail if the input bytestring+-- contains invalid base 58 characters such as 0,O,l,I+decodeBase58 :: BS.ByteString -> Maybe BS.ByteString+decodeBase58 bs = r >>= return . (BS.append prefix)+  where +    (z,b)  = BS.span (== (b58 0)) bs+    prefix = BS.map (fromJust . b58') z -- preserve leading 1's+    r | BS.null b = Just BS.empty+      | otherwise = integerToBS <$> foldl f (Just 0) (BS.unpack b)+    f i w  = do+        n <- fromIntegral <$> b58' w+        p <- i+        return $ p*58 + n++-- | Computes a checksum for the input bytestring and encodes the input and+-- the checksum to a base 58 representation.+encodeBase58Check :: BS.ByteString -> BS.ByteString+encodeBase58Check bs = encodeBase58 $ BS.append bs chk+  where +    chk = encode' $ chksum32 bs++-- | Decode a base 58 encoded bytestring that contains a checksum. This+-- function returns Nothing if the input bytestring contains invalid base 58+-- characters or if the checksum fails.+decodeBase58Check :: BS.ByteString -> Maybe BS.ByteString+decodeBase58Check bs = do+    rs <- decodeBase58 bs+    let (res,chk) = BS.splitAt ((BS.length rs) - 4) rs+    guard $ chk == (encode' $ chksum32 res)+    return res++-- |Data type representing a Bitcoin address+data Address +    -- | Public Key Hash Address+    = PubKeyAddress { getAddrHash :: Hash160 }+    -- | Script Hash Address+    | ScriptAddress { getAddrHash :: Hash160 }+       deriving (Eq, Show)++instance FromJSON Address where+    parseJSON = withText "Address not a string: " $ \a -> do+        let s = T.unpack a+        maybe (fail $ "Not a Bitcoin address: " ++ s) return $ base58ToAddr s++instance ToJSON Address where+    toJSON = String . T.pack . addrToBase58++-- | Transforms an Address into a base58 encoded String+addrToBase58 :: Address -> String+addrToBase58 addr = bsToString $ encodeBase58Check $ case addr of+    PubKeyAddress i -> BS.cons addrPrefix $ encode' i+    ScriptAddress i -> BS.cons scriptPrefix $ encode' i++-- | Decodes an Address from a base58 encoded String. This function can fail+-- if the String is not properly encoded as base58 or the checksum fails.+base58ToAddr :: String -> Maybe Address+base58ToAddr str = do+    val <- decodeBase58Check $ stringToBS str+    let f | BS.head val == addrPrefix   = Just PubKeyAddress+          | BS.head val == scriptPrefix = Just ScriptAddress+          | otherwise = Nothing+    f <*> decodeToMaybe (BS.tail val)+
+ Network/Haskoin/Crypto/BigWord.hs view
@@ -0,0 +1,313 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE EmptyDataDecls #-}+module Network.Haskoin.Crypto.BigWord+(+-- Useful type aliases+  Hash512+, Hash256+, Hash160+, Word512+, Word256+, Word160+, Word128+, FieldP+, FieldN++-- Data types+, BigWord(..)+, BigWordMod(..)++-- Functions+, toFieldN+, toFieldP+, toMod512+, toMod256+, toMod160+, toMod128+, inverseP+, inverseN+, quadraticResidue+, isIntegerValidKey+) where++import Data.Bits +    ( Bits+    , (.&.), (.|.), xor+    , complement+    , shift, shiftL, shiftR+    , bit, testBit, bitSize+    , popCount, isSigned+    )+import Data.Binary (Binary, get, put)+import Data.Binary.Get +    ( getWord64be+    , getWord32be+    , getWord8+    , getByteString+    , Get+    )+import Data.Binary.Put +    ( putWord64be+    , putWord32be+    , putWord8+    , putByteString+    )+import Control.Monad (unless, guard)+import Control.Applicative ((<$>))+import Data.Ratio (numerator, denominator)+import qualified Data.ByteString as BS (head, length)++import Network.Haskoin.Crypto.Curve +import Network.Haskoin.Crypto.NumberTheory +import Network.Haskoin.Util ++-- | Data type representing a 512 bit unsigned integer.+-- It is implemented as an Integer modulo 2^512.+type Word512 = BigWord Mod512+type Hash512 = Word512+-- | Data type representing a 256 bit unsigned integer.+-- It is implemented as an Integer modulo 2^256.+type Word256 = BigWord Mod256+type Hash256 = Word256+-- | Data type representing a 160 bit unsigned integer.+-- It is implemented as an Integer modulo 2^160.+type Word160 = BigWord Mod160+type Hash160 = Word160+-- | Data type representing a 128 bit unsigned integer.+-- It is implemented as an Integer modulo 2^128.+type Word128 = BigWord Mod128+-- | Data type representing an Integer modulo coordinate field order P.+type FieldP  = BigWord ModP+-- | Data type representing an Integer modulo curve order N. +type FieldN  = BigWord ModN++data Mod512+data Mod256 +data Mod160+data Mod128+data ModP+data ModN++newtype BigWord n = BigWord { getBigWordInteger :: Integer }+    deriving (Eq, Ord, Read, Show)++toFieldN :: BigWord n -> FieldN+toFieldN (BigWord i) = fromInteger i++toFieldP :: BigWord n -> FieldP+toFieldP (BigWord i) = fromInteger i++toMod512 :: BigWord n -> Word512+toMod512 (BigWord i) = fromInteger i++toMod256 :: BigWord n -> Word256+toMod256 (BigWord i) = fromInteger i++toMod160 :: BigWord n -> Word160+toMod160 (BigWord i) = fromInteger i++toMod128 :: BigWord n -> Word128+toMod128 (BigWord i) = fromInteger i++inverseP :: FieldP -> FieldP+inverseP (BigWord i) = fromInteger $ mulInverse i curveP++inverseN :: FieldN -> FieldN+inverseN (BigWord i) = fromInteger $ mulInverse i curveN++class BigWordMod a where +    rFromInteger :: Integer -> BigWord a+    rBitSize     :: BigWord a -> Int++instance BigWordMod Mod512 where+    rFromInteger i = BigWord $ i `mod` 2 ^ (512 :: Int)+    rBitSize     _ = 512++instance BigWordMod Mod256 where+    rFromInteger i = BigWord $ i `mod` 2 ^ (256 :: Int)+    rBitSize     _ = 256++instance BigWordMod Mod160 where+    rFromInteger i = BigWord $ i `mod` 2 ^ (160 :: Int)+    rBitSize     _ = 160++instance BigWordMod Mod128 where+    rFromInteger i = BigWord $ i `mod` 2 ^ (128 :: Int)+    rBitSize     _ = 128++instance BigWordMod ModP where+    rFromInteger i = BigWord $ i `mod` curveP+    rBitSize     _ = 256++instance BigWordMod ModN where+    rFromInteger i = BigWord $ i `mod` curveN+    rBitSize     _ = 256++instance BigWordMod n => Num (BigWord n) where+    fromInteger = rFromInteger+    (BigWord i1) + (BigWord i2) = fromInteger $ i1 + i2+    (BigWord i1) * (BigWord i2) = fromInteger $ i1 * i2+    negate (BigWord i) = fromInteger $ negate i+    abs r = r+    signum (BigWord i) = fromInteger $ signum i++instance BigWordMod n => Bits (BigWord n) where+    (BigWord i1) .&. (BigWord i2) = fromInteger $ i1 .&. i2+    (BigWord i1) .|. (BigWord i2) = fromInteger $ i1 .|. i2+    (BigWord i1) `xor` (BigWord i2) = fromInteger $ i1 `xor` i2+    complement (BigWord i) = fromInteger $ complement i+    shift (BigWord i) j = fromInteger $ shift i j+    bitSize = rBitSize+    testBit (BigWord i) = testBit i+    bit n = fromInteger $ bit n+    popCount (BigWord i) = popCount i+    isSigned _ = False++instance BigWordMod n => Bounded (BigWord n) where+    minBound = fromInteger 0+    maxBound = fromInteger (-1)+    +instance BigWordMod n => Real (BigWord n) where+    toRational (BigWord i) = toRational i++instance BigWordMod n => Enum (BigWord n) where+    succ r@(BigWord i)+        | r == maxBound = error "BigWord: tried to take succ of maxBound"+        | otherwise = fromInteger $ succ i+    pred r@(BigWord i) +        | r == minBound = error "BigWord: tried to take pred of minBound"+        | otherwise = fromInteger $ pred i+    toEnum i+        | toInteger i >= toInteger (minFrom r) && +          toInteger i <= toInteger (maxFrom r) = r+        | otherwise = error "BigWord: toEnum is outside of bounds"+      where +        r = fromInteger $ toEnum i+        minFrom :: BigWordMod a => BigWord a -> BigWord a+        minFrom _ = minBound+        maxFrom :: BigWordMod a => BigWord a -> BigWord a+        maxFrom _ = maxBound+    fromEnum (BigWord i) = fromEnum i++instance BigWordMod n => Integral (BigWord n) where+    (BigWord i1) `quot` (BigWord i2) = fromInteger $ i1 `quot` i2+    (BigWord i1) `rem` (BigWord i2) = fromInteger $ i1 `rem` i2+    (BigWord i1) `div` (BigWord i2) = fromInteger $ i1 `div` i2+    (BigWord i1) `mod` (BigWord i2) = fromInteger $ i1 `mod` i2+    (BigWord i1) `quotRem` (BigWord i2) = (fromInteger a, fromInteger b)+      where +        (a,b) = i1 `quotRem` i2+    (BigWord i1) `divMod` (BigWord i2) = (fromInteger a, fromInteger b)+      where +        (a,b) = i1 `divMod` i2+    toInteger (BigWord i) = i++{- Fractional is only defined for prime orders -}++instance Fractional (BigWord ModP) where+    recip = inverseP+    fromRational r = fromInteger (numerator r) / fromInteger (denominator r)++instance Fractional (BigWord ModN) where+    recip = inverseN+    fromRational r = fromInteger (numerator r) / fromInteger (denominator r)++{- Binary instances for serialization / deserialization -}++instance Binary (BigWord Mod512) where+    get = do+        a <- fromIntegral <$> (get :: Get Hash256)+        b <- fromIntegral <$> (get :: Get Hash256)+        return $ (a `shiftL` 256) + b++    put (BigWord i) = do+        put $ (fromIntegral (i `shiftR` 256) :: Hash256)+        put $ (fromIntegral i :: Hash256)++instance Binary (BigWord Mod256) where+    get = do+        a <- fromIntegral <$> getWord64be+        b <- fromIntegral <$> getWord64be+        c <- fromIntegral <$> getWord64be+        d <- fromIntegral <$> getWord64be+        return $ (a `shiftL` 192) + (b `shiftL` 128) + (c `shiftL` 64) + d++    put (BigWord i) = do+        putWord64be $ fromIntegral (i `shiftR` 192)+        putWord64be $ fromIntegral (i `shiftR` 128)+        putWord64be $ fromIntegral (i `shiftR` 64)+        putWord64be $ fromIntegral i++instance Binary (BigWord Mod160) where+    get = do+        a <- fromIntegral <$> getWord32be+        b <- fromIntegral <$> getWord64be+        c <- fromIntegral <$> getWord64be+        return $ (a `shiftL` 128) + (b `shiftL` 64) + c++    put (BigWord i) = do+        putWord32be $ fromIntegral (i `shiftR` 128)+        putWord64be $ fromIntegral (i `shiftR` 64)+        putWord64be $ fromIntegral i++instance Binary (BigWord Mod128) where+    get = do+        a <- fromIntegral <$> getWord64be+        b <- fromIntegral <$> getWord64be+        return $ (a `shiftL` 64) + b++    put (BigWord i) = do+        putWord64be $ fromIntegral (i `shiftR` 64)+        putWord64be $ fromIntegral i++-- DER encoding of a FieldN element as Integer+-- http://www.itu.int/ITU-T/studygroups/com17/languages/X.690-0207.pdf+instance Binary (BigWord ModN) where+    get = do+        t <- getWord8+        unless (t == 0x02) (fail $+            "Bad DER identifier byte " ++ (show t) ++ ". Expecting 0x02" )+        l <- getWord8+        unless (l <= 33) (fail $+            "Bad DER length " ++ (show l) ++ ". Expecting length <= 33" )+        i <- bsToInteger <$> getByteString (fromIntegral l)+        unless (isIntegerValidKey i) $ fail $ +            "Invalid fieldN element: " ++ (show i)+        return $ fromInteger i++    put (BigWord 0) = error "0 is an invalid FieldN element to serialize"+    put (BigWord i) = do+        putWord8 0x02 -- Integer type+        let b = integerToBS i+            l = fromIntegral $ BS.length b+        if BS.head b >= 0x80 +            then do+                putWord8 (l + 1)+                putWord8 0x00+            else do+                putWord8 l+        putByteString b++instance Binary (BigWord ModP) where++    -- Section 2.3.6 http://www.secg.org/download/aid-780/sec1-v2.pdf+    get = do+        (BigWord i) <- get :: Get Hash256+        unless (i < curveP) (fail $ "Get: Integer not in FieldP: " ++ (show i))+        return $ fromInteger i++    -- Section 2.3.7 http://www.secg.org/download/aid-780/sec1-v2.pdf+    put r = put $ toMod256 r+         ++-- curveP = 3 (mod 4), thus Lagrange solutions apply+-- http://en.wikipedia.org/wiki/Quadratic_residue+quadraticResidue :: FieldP -> [FieldP]+quadraticResidue x = guard (y^(2 :: Int) == x) >> [y, (-y)]+  where +    q = (curveP + 1) `div` 4+    y = x^q++isIntegerValidKey :: Integer -> Bool+isIntegerValidKey i = i > 0 && i < curveN+
+ Network/Haskoin/Crypto/Bloom.hs view
@@ -0,0 +1,108 @@+module Network.Haskoin.Crypto.Bloom +( BloomFilter(..)+, BloomFlags(..)+, bloomCreate+, bloomInsert+, bloomContains+, bloomUpdateEmptyFull+, bloomIsValid+) where++import Data.Word+import Data.Bits+import qualified Data.Foldable as F+import qualified Data.Sequence as S+import qualified Data.ByteString as BS++import Network.Haskoin.Crypto.Hash +import Network.Haskoin.Protocol++-- 20,000 items with fp rate < 0.1% or 10,000 items and <0.0001%+maxBloomSize :: Int+maxBloomSize = 36000++maxHashFuncs :: Word32+maxHashFuncs = 50++ln2Squared :: Double+ln2Squared = 0.4804530139182014246671025263266649717305529515945455++ln2 :: Double+ln2 = 0.6931471805599453094172321214581765680755001343602552++bitMask :: [Word8]+bitMask = [0x01, 0x02, 0x04, 0x08, 0x10, 0x20, 0x40, 0x80]++-- | Build a bloom filter that will provide the given false positive rate when+-- the given number of elements have been inserted. +bloomCreate :: Int          -- ^ Number of elements+            -> Double       -- ^ False positive rate+            -> Word32       +             -- ^ A random nonce (tweak) for the hash function. It should be+             -- a random number but the secureness of the random value is not+             -- of geat consequence.+            -> BloomFlags   -- ^ Bloom filter flags+            -> BloomFilter  -- ^ Bloom filter+bloomCreate numElem fpRate tweak flags =+    BloomFilter (S.replicate bloomSize 0) False False numHashF tweak flags+  where+    bloomSize = truncate $ (min a b) / 8+    a         = -1 / ln2Squared * (fromIntegral numElem) * log fpRate+    b         = fromIntegral $ maxBloomSize * 8+    numHashF  = truncate $ min c (fromIntegral maxHashFuncs)+    c         = (fromIntegral bloomSize) * 8 / (fromIntegral numElem) * ln2++bloomHash :: BloomFilter -> Word32 -> BS.ByteString -> Int+bloomHash bfilter hashNum bs =+    fromIntegral (murmurHash3 seed bs) `mod` (S.length (bloomData bfilter) * 8)+  where+    seed = hashNum * 0xfba4c795 + (bloomTweak bfilter)++-- | Insert arbitrary data into a bloom filter. Returns the new bloom filter+-- containing the new data.+bloomInsert :: BloomFilter    -- ^ Original bloom filter+            -> BS.ByteString  -- ^ New data to insert+            -> BloomFilter    -- ^ Bloom filter containing the new data+bloomInsert bfilter bs +    | bloomFull bfilter = bfilter+    | otherwise = bfilter { bloomData = newData, bloomEmpty = False }+  where+    idxs    = map (\i -> bloomHash bfilter i bs) [0..bloomHashFuncs bfilter - 1]+    upd s i = S.adjust (.|. bitMask !! (7 .&. i)) (i `shiftR` 3) s+    newData = foldl upd (bloomData bfilter) idxs++-- | Tests if some arbitrary data matches the filter. This can be either because+-- the data was inserted into the filter or because it is a false positive.+bloomContains :: BloomFilter    -- ^ Bloom filter +              -> BS.ByteString  +              -- ^ Data that will be checked against the given bloom filter+              -> Bool+              -- ^ Returns True if the data matches the filter+bloomContains bfilter bs+    | bloomFull bfilter  = True+    | bloomEmpty bfilter = False+    | otherwise         = and $ map isSet idxs+  where+    s       = bloomData bfilter+    idxs    = map (\i -> bloomHash bfilter i bs) [0..bloomHashFuncs bfilter - 1]+    isSet i = (S.index s (i `shiftR` 3)) .&. (bitMask !! (7 .&. i)) /= 0++-- TODO: Write bloomRelevantUpdate+-- bloomRelevantUpdate :: BloomFilter -> Tx -> Hash256 -> Maybe BloomFilter++-- | Sets the bloom filter empty flag to True if the filter is empty, and+-- the bloom filter full flag to True if the filter is full.+bloomUpdateEmptyFull :: BloomFilter -- ^ Bloom filter to update+                     -> BloomFilter -- ^ Filter with updated flags+bloomUpdateEmptyFull bfilter = +    bfilter { bloomEmpty = all (== 0x00) l, bloomFull = all (== 0xff) l }+  where+    l = F.toList $ bloomData bfilter++-- | Tests if a given bloom filter is valid.+bloomIsValid :: BloomFilter -- ^ Bloom filter to test+             -> Bool        -- ^ True if the given filter is valid+bloomIsValid bfilter =+    (S.length $ bloomData bfilter) <= maxBloomSize &&+    (bloomHashFuncs bfilter) <= maxHashFuncs+
+ Network/Haskoin/Crypto/Curve.hs view
@@ -0,0 +1,27 @@+module Network.Haskoin.Crypto.Curve+( pairG+, curveP+, curveN+, integerB+, integerA+) where++-- SECP256k1 curve parameters++pairG :: (Integer, Integer)+pairG = ( 0x79be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798       +        , 0X483ada7726a3c4655da4fbfc0e1108a8fd17b448a68554199c47d08ffb10d4b8 +        )++curveP :: Integer+curveP = 0xfffffffffffffffffffffffffffffffffffffffffffffffffffffffefffffc2f ++curveN :: Integer+curveN = 0xfffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141 ++integerB :: Integer+integerB = 7++integerA :: Integer+integerA = 0+
+ Network/Haskoin/Crypto/ECDSA.hs view
@@ -0,0 +1,214 @@+-- | ECDSA Signatures+module Network.Haskoin.Crypto.ECDSA+( SecretT+, Signature(..)+, withSource+, devURandom+, devRandom+, signMsg+, detSignMsg+, unsafeSignMsg+, verifySig+, genPrvKey+, isCanonicalHalfOrder+) where++import System.IO++import Control.Monad (liftM, guard, unless)+import Control.Monad.Trans (MonadTrans, lift)+import Control.Applicative (Applicative, (<*>), (<$>))+import qualified Control.Monad.State as S+    ( StateT+    , evalStateT+    , get, put+    )++import Data.Maybe (fromJust, fromMaybe)+import Data.Binary (Binary, get, put)+import Data.Binary.Put (putWord8, putByteString)+import Data.Binary.Get (getWord8)++import qualified Data.ByteString as BS +    ( ByteString+    , length+    , hGet+    , empty+    )+  +import Network.Haskoin.Util +import Network.Haskoin.Crypto.Hash +import Network.Haskoin.Crypto.Keys +import Network.Haskoin.Crypto.Point +import Network.Haskoin.Crypto.BigWord ++-- | Internal state of the 'SecretT' monad+type SecretState m = (WorkingState, (Int -> m BS.ByteString))++-- | StateT monad stack tracking the internal state of HMAC DRBG +-- pseudo random number generator using SHA-256. The 'SecretT' monad is+-- run with the 'withSource' function by providing it a source of entropy.+type SecretT m a = S.StateT (SecretState m) m a++-- | Run a 'SecretT' monad by providing it a source of entropy. You can+-- use 'devURandom', 'devRandom' or provide your own entropy source function.+withSource :: Monad m => (Int -> m BS.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 (stringToBS haskoinUserAgent)+    S.evalStateT m (ws,f)++-- | \/dev\/urandom entropy source. This is only available on machines+-- supporting it. This function is meant to be used together with 'withSource'.+devURandom :: Int -> IO BS.ByteString+devURandom i = withBinaryFile "/dev/urandom" ReadMode $ flip BS.hGet i++-- | \/dev\/random entropy source. This is only available on machines+-- supporting it. This function is meant to be used together with 'withSource'.+devRandom :: Int -> IO BS.ByteString+devRandom i = withBinaryFile "/dev/random" ReadMode $ flip BS.hGet i++-- | Generate a new random 'FieldN' value from the 'SecretT' monad. This will+-- invoke the HMAC DRBG routine. Of the internal entropy pool of the HMAC DRBG+-- was stretched too much, this function will reseed it.+nextSecret :: Monad m => SecretT m FieldN+nextSecret = do+    (ws,f) <- S.get+    let (ws',randM) = hmacDRBGGen ws 32 (stringToBS haskoinUserAgent)+    case randM of+        (Just rand) -> do+            S.put (ws',f)+            let randI = bsToInteger rand+            if isIntegerValidKey randI+                then return $ fromInteger randI+                else nextSecret+        Nothing -> do+            seed <- lift $ f 32 -- Read 256 bits to re-seed the PRNG+            let ws0 = hmacDRBGRsd ws' seed (stringToBS haskoinUserAgent)+            S.put (ws0,f)+            nextSecret++-- | Produce a new 'PrvKey' randomly from the 'SecretT' monad.+genPrvKey :: Monad m => SecretT m PrvKey+genPrvKey = liftM (fromJust . makePrvKey . toInteger) nextSecret+        +-- Section 3.2.1 http://www.secg.org/download/aid-780/sec1-v2.pdf+-- Produce a new private/public key pair from the 'SecretT' monad.+genKeyPair :: Monad m => SecretT m (FieldN, Point)+genKeyPair = do+    -- 3.2.1.1 +    d <- nextSecret+    -- 3.2.1.2+    let q = mulPoint d curveG+    -- 3.2.1.3+    return (d,q)++-- | Data type representing an ECDSA signature. +data Signature = +    Signature { sigR :: !FieldN +              , sigS :: !FieldN +              }+    deriving (Show, Eq)++-- Section 4.1.3 http://www.secg.org/download/aid-780/sec1-v2.pdf+-- | Safely sign a message inside the 'SecretT' monad. The 'SecretT' monad will+-- generate a new nonce for each signature.+signMsg :: Monad m => Hash256 -> PrvKey -> SecretT m Signature+signMsg _ (PrvKey  0) = error "signMsg: Invalid private key 0"+signMsg _ (PrvKeyU 0) = error "signMsg: Invalid private key 0"+signMsg h d = do+    -- 4.1.3.1+    (k,p) <- genKeyPair+    case unsafeSignMsg h (prvKeyFieldN d) (k,p) of+        (Just sig) -> return sig+        -- If signing failed, retry with a new nonce+        Nothing    -> signMsg h d++-- | Sign a message using ECDSA deterministic signatures as defined by+-- RFC 6979 <http://tools.ietf.org/html/rfc6979>+detSignMsg :: Hash256 -> PrvKey -> Signature+detSignMsg _ (PrvKey  0) = error "detSignMsg: Invalid private key 0"+detSignMsg _ (PrvKeyU 0) = error "detSignMsg: Invalid private key 0"+detSignMsg h d = go $ hmacDRBGNew (runPut' $ putPrvKey d) (encode' h) BS.empty+  where +    go ws = case hmacDRBGGen ws 32 BS.empty of+        (_, Nothing)  -> error "detSignMsg: No suitable K value found"+        (ws', Just k) -> +            let kI   = bsToInteger k+                p    = mulPoint (fromInteger kI) curveG+                sigM = unsafeSignMsg h (prvKeyFieldN d) (fromInteger kI,p)+                in if isIntegerValidKey kI+                       then fromMaybe (go ws') sigM+                       else go ws'+          +-- Signs a message by providing the nonce+-- Re-using the same nonce twice will expose the private keys+-- Use signMsg within the SecretT monad or detSignMsg instead+-- Section 4.1.3 http://www.secg.org/download/aid-780/sec1-v2.pdf+unsafeSignMsg :: Hash256 -> FieldN -> (FieldN, Point) -> Maybe Signature+unsafeSignMsg _ 0 _ = Nothing+unsafeSignMsg h d (k,p) = do+    -- 4.1.3.1 (4.1.3.2 not required)+    (x,_) <- getAffine p+    -- 4.1.3.3+    let r = toFieldN x+    guard (r /= 0)+    -- 4.1.3.4 / 4.1.3.5+    let e = toFieldN h+    -- 4.1.3.6+    let s' = (e + r*d)/k+        -- Canonicalize signatures: s <= order/2+        -- maxBound/2 = (maxBound+1)/2 = order/2 (because order is odd)+        s  = if s' > (maxBound `div` 2) then (-s') else s'+    guard (s /= 0)+    -- 4.1.3.7+    return $ Signature r s++-- Section 4.1.4 http://www.secg.org/download/aid-780/sec1-v2.pdf+-- | Verify an ECDSA signature+verifySig :: Hash256 -> Signature -> PubKey -> Bool+-- 4.1.4.1 (r and s can not be zero)+verifySig _ (Signature 0 _) _ = False+verifySig _ (Signature _ 0) _ = False+verifySig h (Signature r s) q = case getAffine p of+    Nothing      -> False+    -- 4.1.4.7 / 4.1.4.8+    (Just (x,_)) -> (toFieldN x) == r+  where +    -- 4.1.4.2 / 4.1.4.3+    e  = toFieldN h+    -- 4.1.4.4+    s' = inverseN s+    u1 = e*s'+    u2 = r*s'+    -- 4.1.4.5 (u1*G + u2*q)+    p  = shamirsTrick u1 curveG u2 (pubKeyPoint q)++-- | Returns True if the S component of a Signature is <= order/2.+-- Signatures need to pass this test to be canonical.+isCanonicalHalfOrder :: Signature -> Bool+isCanonicalHalfOrder (Signature _ s) = s <= maxBound `div` 2++instance Binary Signature where+    get = do+        t <- getWord8+        -- 0x30 is DER sequence type+        unless (t == 0x30) (fail $ +            "Bad DER identifier byte " ++ (show t) ++ ". Expecting 0x30")+        l <- getWord8+        -- Length = (33 + 1 identifier byte + 1 length byte) * 2+        unless (l <= 70) (fail $+            "Bad DER length " ++ (show t) ++ ". Expecting length <= 70")+        isolate (fromIntegral l) $ do+            Signature <$> get <*> get++    put (Signature 0 _) = error "0 is an invalid r value in a Signature"+    put (Signature _ 0) = error "0 is an invalid s value in a Signature"+    put (Signature r s) = do+        putWord8 0x30+        let c = runPut' $ put r >> put s+        putWord8 (fromIntegral $ BS.length c)+        putByteString c++
+ Network/Haskoin/Crypto/ExtendedKeys.hs view
@@ -0,0 +1,323 @@+module Network.Haskoin.Crypto.ExtendedKeys+( XPubKey(..)+, XPrvKey(..)+, ChainCode+, makeXPrvKey+, deriveXPubKey+, prvSubKey+, pubSubKey+, primeSubKey+, prvSubKeys+, pubSubKeys+, primeSubKeys+, mulSigSubKey+, mulSigSubKeys+, xPrvIsPrime+, xPubIsPrime+, xPrvChild+, xPubChild+, xPubID+, xPrvID+, xPubFP+, xPrvFP+, xPubAddr+, xPubExport+, xPrvExport+, xPubImport+, xPrvImport+, xPrvWIF+, cycleIndex+, cycleIndex'+) where++import Control.Monad +    ( guard+    , unless+    , when+    , liftM2+    )+import Data.Binary (Binary, get, put)+import Data.Binary.Get (Get, getWord8, getWord32be)+import Data.Binary.Put (Put, runPut, putWord8, putWord32be)+import Data.Word (Word8, Word32)+import Data.Bits +    ( shiftR+    , setBit+    , testBit+    , clearBit+    )+import Data.Maybe (mapMaybe)+import qualified Data.ByteString as BS +    ( ByteString+    , append+    )++import Network.Haskoin.Util+import Network.Haskoin.Crypto.Keys+import Network.Haskoin.Crypto.Hash+import Network.Haskoin.Crypto.Base58++{- See BIP32 for details: https://en.bitcoin.it/wiki/BIP_0032 -}++type ChainCode = Hash256++-- | Data type representing an extended BIP32 private key. An extended key+-- 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  :: !Word32    -- ^ Key derivation index.+    , xPrvChain  :: !ChainCode -- ^ Chain code.+    , xPrvKey    :: !PrvKey    -- ^ The private key of this extended key node.+    } deriving (Eq, Show, Read)++-- | 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  :: !Word32    -- ^ Key derivation index.+    , xPubChain  :: !ChainCode -- ^ Chain code.+    , xPubKey    :: !PubKey    -- ^ The public key of this extended key node.+    } deriving (Eq, Show, Read)++-- | Build a BIP32 compatible extended private key from a bytestring. This will+-- produce a root node (depth=0 and parent=0).+makeXPrvKey :: BS.ByteString -> Maybe XPrvKey+makeXPrvKey bs = do+    pk' <- makePrvKey $ fromIntegral pk+    return $ XPrvKey 0 0 0 c pk'+    where (pk,c) = split512 $ hmac512 (stringToBS "Bitcoin seed") bs++-- | Derive an extended public key from an extended private key. This function+-- 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)++-- | Compute a private, non-prime child key derivation. A private non-prime+-- derivation will allow the equivalent extended public key to derive the+-- public key for this child. Given a parent key /m/ and a derivation index /i/,+-- this function will compute m\/i\/. +--+-- Non-prime derivations allow for more flexibility such as read-only wallets.+-- However, care must be taken not the leak both the parent extended public+-- key and one of the extended child private keys as this would compromise the+-- extended parent private key.+prvSubKey :: XPrvKey       -- ^ Extended parent private key+          -> Word32        -- ^ Child derivation index+          -> Maybe XPrvKey -- ^ Extended child private key +prvSubKey xkey child = guardIndex child >> do+    k <- addPrvKeys (xPrvKey xkey) a+    return $ XPrvKey (xPrvDepth xkey + 1) (xPrvFP xkey) child c k+    where pK    = xPubKey $ deriveXPubKey xkey+          msg   = BS.append (encode' pK) (encode' child)+          (a,c) = split512 $ hmac512 (encode' $ xPrvChain xkey) msg++-- | Compute a public, non-prime child key derivation. Given a parent key /M/+-- and a derivation index /i/, this function will compute M\/i\/. +pubSubKey :: XPubKey       -- ^ Extended Parent public key+          -> Word32        -- ^ Child derivation index+          -> Maybe XPubKey -- ^ Extended child public key+pubSubKey xKey child = guardIndex child >> do+    pK <- addPubKeys (xPubKey xKey) a+    return $ XPubKey (xPubDepth xKey + 1) (xPubFP xKey) child c pK+    where msg   = BS.append (encode' $ xPubKey xKey) (encode' child)+          (a,c) = split512 $ hmac512 (encode' $ xPubChain xKey) msg++-- | Compute a prime child key derivation. Prime derivations can only be+-- computed for private keys. Prime derivations do not allow the parent +-- public key to derive the child public keys. However, they are safer as+-- a breach of the parent public key and child private keys does not lead+-- to a breach of the parent private key. Given a parent key /m/ and a+-- derivation index /i/, this function will compute m\/i'\/.+primeSubKey :: XPrvKey       -- ^ Extended Parent private key+            -> Word32        -- ^ Child derivation index+            -> Maybe XPrvKey -- ^ Extended child private key+primeSubKey xkey child = guardIndex child >> do+    k  <- addPrvKeys (xPrvKey xkey) a+    return $ XPrvKey (xPrvDepth xkey + 1) (xPrvFP xkey) i c k+    where i     = setBit child 31+          msg   = BS.append (bsPadPrvKey $ xPrvKey xkey) (encode' i)+          (a,c) = split512 $ hmac512 (encode' $ xPrvChain xkey) msg++-- | Cyclic list of all private non-prime child key derivations of a parent key+-- starting from an offset index.+prvSubKeys :: XPrvKey -> Word32 -> [(XPrvKey,Word32)]+prvSubKeys k i = mapMaybe f $ cycleIndex i+    where f j = liftM2 (,) (prvSubKey k j) (return j)++-- | Cyclic list of all public non-prime child key derivations of a parent key+-- starting from an offset index.+pubSubKeys :: XPubKey -> Word32 -> [(XPubKey,Word32)]+pubSubKeys k i = mapMaybe f $ cycleIndex i+    where f j = liftM2 (,) (pubSubKey k j) (return j)++-- | Cyclic list of all prime child key derivations of a parent key starting+-- from an offset index.+primeSubKeys :: XPrvKey -> Word32 -> [(XPrvKey,Word32)]+primeSubKeys k i = mapMaybe f $ cycleIndex i+    where f j = liftM2 (,) (primeSubKey k j) (return j)++-- | Compute a public, non-prime subkey derivation for all of the parent public+-- keys in the input. This function will succeed only if the child key+-- derivations for all the parent keys are valid. +--+-- This function is intended to be used in the context of multisignature+-- accounts. Parties exchanging their master public keys to create a+-- multisignature account can then individually generate all the receiving+-- multisignature addresses without further communication.+mulSigSubKey :: [XPubKey]       -- ^ List of extended parent public keys+             -> Word32          -- ^ Child key derivation index+             -> Maybe [XPubKey] -- ^ List of extended child public keys+mulSigSubKey pubs i = mapM (flip pubSubKey i) pubs++-- | Cyclic list of all public, non-prime multisig key derivations of a list+-- of parent keys starting from an offset index.+mulSigSubKeys :: [XPubKey] -> Word32 -> [([XPubKey],Word32)]+mulSigSubKeys pubs i = mapMaybe f $ cycleIndex i+    where f j = liftM2 (,) (mulSigSubKey pubs j) (return j)++cycleIndex :: Word32 -> [Word32]+cycleIndex i+    | i == 0         = cycle [0..0x7fffffff]+    | i < 0x80000000 = cycle $ [i..0x7fffffff] ++ [0..(i-1)]+    | otherwise      = error $ "cycleIndex: invalid index " ++ (show i)++-- Cycle in reverse+cycleIndex' :: Word32 -> [Word32]+cycleIndex' i+    | i == 0          = cycle $ 0 : [0x7fffffff,0x7ffffffe..1]+    | i == 0x7fffffff = cycle [0x7fffffff,0x7ffffffe..0]+    | i == 0x7ffffffe = cycle $ [0x7ffffffe,0x7ffffffd..0] ++ [0x7fffffff]+    | i < 0x80000000  = cycle $ [i,(i-1)..0] ++ [0x7fffffff,0x7ffffffe..(i+1)]+    | otherwise       = error $ "cycleIndex: invalid index " ++ (show i)++guardIndex :: Word32 -> Maybe ()+guardIndex child = guard $ child >= 0 && child < 0x80000000++-- | Returns True if the extended private key was derived through a prime+-- derivation.+xPrvIsPrime :: XPrvKey -> Bool+xPrvIsPrime k = testBit (xPrvIndex k) 31++-- | Returns True if the extended public key was derived through a prime+-- derivation.+xPubIsPrime :: XPubKey -> Bool+xPubIsPrime k = testBit (xPubIndex k) 31++-- | Returns the derivation index of this extended private key without the+-- prime bit set.+xPrvChild :: XPrvKey -> Word32+xPrvChild k = clearBit (xPrvIndex k) 31++-- | Returns the derivation index of this extended public key without the prime+-- bit set.+xPubChild :: XPubKey -> Word32+xPubChild k = clearBit (xPubIndex k) 31++-- | Computes the key identifier of an extended private key.+xPrvID :: XPrvKey -> Hash160+xPrvID = xPubID . deriveXPubKey++-- | Computes the key identifier of an extended public key.+xPubID :: XPubKey -> Hash160+xPubID = hash160 . hash256BS . encode' . xPubKey ++-- | Computes the key fingerprint of an extended private key.+xPrvFP :: XPrvKey -> Word32+xPrvFP = fromIntegral . (`shiftR` 128) . xPrvID++-- | Computes the key fingerprint of an extended public key.+xPubFP :: XPubKey -> Word32+xPubFP = fromIntegral . (`shiftR` 128) . xPubID++-- | Computer the 'Address' of an extended public key.+xPubAddr :: XPubKey -> Address+xPubAddr = pubKeyAddr . xPubKey++-- | Exports an extended private key to the BIP32 key export format (base 58).+xPrvExport :: XPrvKey -> String+xPrvExport = bsToString . encodeBase58Check . encode' ++-- | Exports an extended public key to the BIP32 key export format (base 58).+xPubExport :: XPubKey -> String+xPubExport = bsToString . encodeBase58Check . encode'++-- | Decodes a BIP32 encoded extended private key. This function will fail if+-- invalid base 58 characters are detected or if the checksum fails.+xPrvImport :: String -> Maybe XPrvKey+xPrvImport str = decodeToMaybe =<< (decodeBase58Check $ stringToBS str)++-- | Decodes a BIP32 encoded extended public key. This function will fail if+-- invalid base 58 characters are detected or if the checksum fails.+xPubImport :: String -> Maybe XPubKey+xPubImport str = decodeToMaybe =<< (decodeBase58Check $ stringToBS str)++-- | Export an extended private key to WIF (Wallet Import Format).+xPrvWIF :: XPrvKey -> String+xPrvWIF = toWIF . xPrvKey++instance Binary XPrvKey where++    get = do+        ver <- getWord32be+        unless (ver == extSecretPrefix) $ fail $+            "Get: Invalid version for extended private key"+        dep <- getWord8+        par <- getWord32be+        idx <- getWord32be+        chn <- get +        prv <- getPadPrvKey+        return $ XPrvKey dep par idx chn prv++    put k = do+        putWord32be  extSecretPrefix+        putWord8     $ xPrvDepth k+        putWord32be  $ xPrvParent k+        putWord32be  $ xPrvIndex k+        put          $ xPrvChain k+        putPadPrvKey $ xPrvKey k++instance Binary XPubKey where++    get = do+        ver <- getWord32be+        unless (ver == extPubKeyPrefix) $ fail $+            "Get: Invalid version for extended public key"+        dep <- getWord8+        par <- getWord32be+        idx <- getWord32be+        chn <- get +        pub <- get +        when (isPubKeyU pub) $ fail $+            "Invalid public key. Only compressed format is supported"+        return $ XPubKey dep par idx chn pub++    put k = do+        putWord32be extPubKeyPrefix+        putWord8    $ xPubDepth k+        putWord32be $ xPubParent k+        putWord32be $ xPubIndex k+        put         $ xPubChain k+        when (isPubKeyU (xPubKey k)) $ fail $+            "Only compressed public keys are supported"+        put $ xPubKey k+        +{- Utilities for extended keys -}++-- De-serialize HDW-specific private key+getPadPrvKey :: Get PrvKey+getPadPrvKey = do+    pad <- getWord8+    unless (pad == 0x00) $ fail $+        "Private key must be padded with 0x00"+    getPrvKey -- Compressed version++-- Serialize HDW-specific private key+putPadPrvKey :: PrvKey -> Put +putPadPrvKey p = putWord8 0x00 >> putPrvKey p++bsPadPrvKey :: PrvKey -> BS.ByteString+bsPadPrvKey = toStrictBS . runPut . putPadPrvKey +
+ Network/Haskoin/Crypto/Hash.hs view
@@ -0,0 +1,300 @@+-- | Hashing functions and HMAC DRBG definition+module Network.Haskoin.Crypto.Hash+( Hash512+, Hash256+, Hash160+, CheckSum32+, hash512+, hash256+, hash160+, hash512BS+, hash256BS+, hash160BS+, doubleHash256+, doubleHash256BS+, chksum32+, hmac512+, hmac512BS+, hmac256+, hmac256BS+, hmacDRBGNew+, hmacDRBGUpd+, hmacDRBGRsd+, hmacDRBGGen+, WorkingState+, murmurHash3+, split512+, join512+, decodeCompact+, encodeCompact+) where++import Control.Applicative ((<$>))+import Control.Monad (replicateM)++import Crypto.Hash +    ( Digest +    , SHA512+    , SHA256+    , RIPEMD160+    , hash+    )+import Crypto.MAC.HMAC (hmac)++import Data.Word (Word16, Word32)+import Data.Byteable (toBytes)+import Data.Binary (Binary, get, put)+import Data.Binary.Get (getWord32le)+import Data.Bits +    ( shiftL+    , shiftR+    , rotateL+    , xor+    , (.&.), (.|.)+    )++import qualified Data.ByteString as BS +    ( ByteString+    , null+    , append+    , cons+    , concat+    , take+    , empty+    , length+    , replicate+    , drop+    )++import Network.Haskoin.Util +import Network.Haskoin.Crypto.BigWord ++-- | Data type representing a 32 bit checksum+newtype CheckSum32 = CheckSum32 Word32 deriving (Show, Eq, Read)++instance Binary CheckSum32 where+    get = CheckSum32 <$> get+    put (CheckSum32 w) = put w++run512 :: BS.ByteString -> BS.ByteString+run512 = (toBytes :: Digest SHA512 -> BS.ByteString) . hash++run256 :: BS.ByteString -> BS.ByteString+run256 = (toBytes :: Digest SHA256 -> BS.ByteString) . hash++run160 :: BS.ByteString -> BS.ByteString+run160 = (toBytes :: Digest RIPEMD160 -> BS.ByteString) . hash++-- | Computes SHA-512.+hash512 :: BS.ByteString -> Hash512+hash512 bs = runGet' get (run512 bs)++-- | Computes SHA-512 and returns the result as a bytestring.+hash512BS :: BS.ByteString -> BS.ByteString+hash512BS bs = run512 bs++-- | Computes SHA-256.+hash256 :: BS.ByteString -> Hash256+hash256 bs = runGet' get (run256 bs)++-- | Computes SHA-256 and returns the result as a bytestring.+hash256BS :: BS.ByteString -> BS.ByteString+hash256BS bs = run256 bs++-- | Computes RIPEMD-160.+hash160 :: BS.ByteString -> Hash160+hash160 bs = runGet' get (run160 bs)++-- | Computes RIPEMD-160 and returns the result as a bytestring.+hash160BS :: BS.ByteString -> BS.ByteString+hash160BS bs = run160 bs++-- | Computes two rounds of SHA-256.+doubleHash256 :: BS.ByteString -> Hash256+doubleHash256 bs = runGet' get (run256 $ run256 bs)++-- | Computes two rounds of SHA-256 and returns the result as a bytestring.+doubleHash256BS :: BS.ByteString -> BS.ByteString+doubleHash256BS bs = run256 $ run256 bs++{- CheckSum -}++-- | Computes a 32 bit checksum.+chksum32 :: BS.ByteString -> CheckSum32+chksum32 bs = CheckSum32 $ fromIntegral $ (doubleHash256 bs) `shiftR` 224++{- HMAC -}++-- | Computes HMAC over SHA-512.+hmac512 :: BS.ByteString -> BS.ByteString -> Hash512+hmac512 key = decode' . (hmac512BS key)++-- | Computes HMAC over SHA-512 and return the result as a bytestring.+hmac512BS :: BS.ByteString -> BS.ByteString -> BS.ByteString+hmac512BS key msg = hmac hash512BS 128 key msg++-- | Computes HMAC over SHA-256.+hmac256 :: BS.ByteString -> BS.ByteString -> Hash256+hmac256 key = decode' . (hmac256BS key)++-- | Computes HMAC over SHA-256 and return the result as a bytestring.+hmac256BS :: BS.ByteString -> BS.ByteString -> BS.ByteString+hmac256BS key msg = hmac hash256BS 64 key msg++-- | Split a 'Hash512' into a pair of 'Hash256'.+split512 :: Hash512 -> (Hash256, Hash256)+split512 i = (fromIntegral $ i `shiftR` 256, fromIntegral i)++-- | Join a pair of 'Hash256' into a 'Hash512'.+join512 :: (Hash256, Hash256) -> Hash512+join512 (a,b) = ((toMod512 a) `shiftL` 256) + (toMod512 b)++-- | Decode the compact number used in the difficulty target of a block into an+-- Integer. +--+-- As described in the Satoshi reference implementation /src/bignum.h:+--+-- The "compact" format is a representation of a whole number N using an+-- unsigned 32bit number similar to a floating point format. The most+-- significant 8 bits are the unsigned exponent of base 256. This exponent can+-- be thought of as "number of bytes of N". The lower 23 bits are the mantissa.+-- Bit number 24 (0x800000) represents the sign of N. +--+-- >    N = (-1^sign) * mantissa * 256^(exponent-3)+decodeCompact :: Word32 -> Integer+decodeCompact c = +    if neg then (-res) else res+  where+    size = fromIntegral $ c `shiftR` 24+    neg  = (c .&. 0x00800000) /= 0+    wrd  = c .&. 0x007fffff+    res | size <= 3 = (toInteger wrd) `shiftR` (8*(3 - size))+        | otherwise = (toInteger wrd) `shiftL` (8*(size - 3))++-- | Encode an Integer to the compact number format used in the difficulty +-- target of a block.+encodeCompact :: Integer -> Word32+encodeCompact i +    | i < 0     = c3 .|. 0x00800000+    | otherwise = c3+  where+    posi = abs i+    s1 = BS.length $ integerToBS posi+    c1 | s1 < 3    = posi `shiftL` (8*(3 - s1))+       | otherwise = posi `shiftR` (8*(s1 - 3))+    (s2,c2) | c1 .&. 0x00800000 /= 0  = (s1 + 1, c1 `shiftR` 8)+            | otherwise               = (s1, c1)+    c3 = fromIntegral $ c2 .|. ((toInteger s2) `shiftL` 24)++{- 10.1.2 HMAC_DRBG with HMAC-SHA256+   http://csrc.nist.gov/publications/nistpubs/800-90A/SP800-90A.pdf +   Constants are based on recommentations in Appendix D section 2 (D.2)+-}++type WorkingState    = (BS.ByteString, BS.ByteString, Word16)+type AdditionalInput = BS.ByteString+type ProvidedData    = BS.ByteString+type EntropyInput    = BS.ByteString+type Nonce           = BS.ByteString+type PersString      = BS.ByteString++-- 10.1.2.2 HMAC DRBG Update FUnction+hmacDRBGUpd :: ProvidedData -> BS.ByteString -> BS.ByteString+            -> (BS.ByteString, BS.ByteString)+hmacDRBGUpd info k0 v0 +    | BS.null info = (k1,v1) -- 10.1.2.2.3+    | otherwise    = (k2,v2) -- 10.1.2.2.6+  where +    k1 = hmac256BS k0 $ v0 `BS.append` (0 `BS.cons` info) -- 10.1.2.2.1+    v1 = hmac256BS k1 v0                                  -- 10.1.2.2.2+    k2 = hmac256BS k1 $ v1 `BS.append` (1 `BS.cons` info) -- 10.1.2.2.4+    v2 = hmac256BS k2 v1                                  -- 10.1.2.2.5++-- 10.1.2.3 HMAC DRBG Instantiation+hmacDRBGNew :: EntropyInput -> Nonce -> PersString -> WorkingState+hmacDRBGNew seed nonce info +    | (BS.length seed + BS.length nonce) * 8 < 384  = error $+        "Entropy + nonce input length must be at least 384 bit"+    | (BS.length seed + BS.length nonce) * 8 > 1000 = error $+        "Entropy + nonce input length can not be greater than 1000 bit"+    | BS.length info * 8 > 256  = error $ +        "Maximum personalization string length is 256 bit"+    | otherwise                = (k1,v1,1)         -- 10.1.2.3.6+  where +    s        = BS.concat [seed, nonce, info] -- 10.1.2.3.1+    k0       = BS.replicate 32 0             -- 10.1.2.3.2+    v0       = BS.replicate 32 1             -- 10.1.2.3.3+    (k1,v1)  = hmacDRBGUpd s k0 v0           -- 10.1.2.3.4++-- 10.1.2.4 HMAC DRBG Reseeding+hmacDRBGRsd :: WorkingState -> EntropyInput -> AdditionalInput -> WorkingState+hmacDRBGRsd (k,v,_) seed info +    | BS.length seed * 8 < 256 = error $ +        "Entropy input length must be at least 256 bit"+    | BS.length seed * 8 > 1000 = error $ +        "Entropy input length can not be greater than 1000 bit"+    | otherwise   = (k0,v0,1)             -- 10.1.2.4.4+  where +    s       = seed `BS.append` info -- 10.1.2.4.1+    (k0,v0) = hmacDRBGUpd s k v     -- 10.1.2.4.2++-- 10.1.2.5 HMAC DRBG Generation+hmacDRBGGen :: WorkingState -> Word16 -> AdditionalInput+            -> (WorkingState, Maybe BS.ByteString)+hmacDRBGGen (k0,v0,c0) bytes info +    | bytes * 8 > 7500 = error "Maximum bits per request is 7500"+    | c0 > 10000       = ((k0,v0,c0), Nothing)  -- 10.1.2.5.1+    | otherwise        = ((k2,v3,c1), Just res) -- 10.1.2.5.8+  where +    (k1,v1) | BS.null info = (k0,v0) +            | otherwise    = hmacDRBGUpd info k0 v0   -- 10.1.2.5.2+    (tmp,v2) = go (fromIntegral bytes) k1 v1 BS.empty -- 10.1.2.5.3/4+    res      = BS.take (fromIntegral bytes) tmp       -- 10.1.2.5.5+    (k2,v3)  = hmacDRBGUpd info k1 v2                 -- 10.1.2.5.6+    c1       = c0 + 1                                 -- 10.1.2.5.7+    go l k v acc | BS.length acc >= l = (acc,v)+                 | otherwise = let vn = hmac256BS k v +                                   in go l k vn (acc `BS.append` vn)++{- MurmurHash3 -}+    +-- | MurmurHash3 (x86_32). For more details, see+-- http://code.google.com/p/smhasher/source/browse/trunk/MurmurHash3.cpp+-- This code is used in the bloom filters of SPV nodes.+murmurHash3 :: Word32 -> BS.ByteString -> Word32+murmurHash3 nHashSeed bs = h8+  where+    -- Block and tail sizes+    nBlocks = BS.length bs `div` 4+    nTail   = BS.length bs `mod` 4+    -- Data objects+    blocks  = runGet' (replicateM nBlocks getWord32le) bs+    bsTail  = BS.drop (nBlocks*4) bs `BS.append` BS.replicate (4-nTail) 0+    -- Body+    h1   = foldl mix nHashSeed blocks+    -- Tail+    t1   = runGet' getWord32le bsTail+    t2   = t1 * c1+    t3   = t2 `rotateL` 15+    t4   = t3 * c2+    h2   = h1 `xor` t4+    -- Finalization+    h3   = h2 `xor` (fromIntegral $ BS.length bs)+    h4   = h3 `xor` (h3 `shiftR` 16) +    h5   = h4 * 0x85ebca6b+    h6   = h5 `xor` (h5 `shiftR` 13)+    h7   = h6 * 0xc2b2ae35+    h8   = h7 `xor` (h7 `shiftR` 16)+    -- Mix function+    mix r1 k1 = r4+      where+        k2 = k1 * c1+        k3 = k2 `rotateL` 15+        k4 = k3 * c2+        r2 = r1 `xor` k4+        r3 = r2 `rotateL` 13+        r4 = r3*5 + 0xe6546b64+    -- Constants+    c1 = 0xcc9e2d51 +    c2 = 0x1b873593 +
+ Network/Haskoin/Crypto/Keys.hs view
@@ -0,0 +1,258 @@+module Network.Haskoin.Crypto.Keys+( PubKey(..)+, isValidPubKey+, isPubKeyU+, derivePubKey+, pubKeyAddr+, addPubKeys+, PrvKey(..)+, isValidPrvKey+, makePrvKey+, makePrvKeyU+, fromPrvKey+, isPrvKeyU+, addPrvKeys+, putPrvKey+, getPrvKey+, getPrvKeyU+, fromWIF+, toWIF+, curveG+) where++import Data.Binary (Binary, get, put)+import Data.Binary.Get (Get, getWord8)+import Data.Binary.Put (Put, putWord8)++import Control.Monad (when, unless, guard)+import Control.Applicative ((<$>),(<*>))+import Data.Maybe (isJust, fromJust)++import qualified Data.ByteString as BS +    ( head, tail+    , last, init+    , cons, snoc+    , length+    )+import Network.Haskoin.Crypto.Curve +import Network.Haskoin.Crypto.BigWord +import Network.Haskoin.Crypto.Point +import Network.Haskoin.Crypto.Base58 +import Network.Haskoin.Crypto.Hash +import Network.Haskoin.Util ++-- | G parameter of the EC curve expressed as a Point+curveG :: Point+curveG = fromJust $ makePoint (fromInteger $ fst pairG) +                              (fromInteger $ snd pairG)++-- | Elliptic curve public key type. Two constructors are provided for creating+-- compressed and uncompressed public keys from a Point. The use of compressed+-- keys is preferred as it produces shorter keys without compromising security.+-- Uncompressed keys are supported for backwards compatibility.+data PubKey +    -- | Compressed public key+    = PubKey  { pubKeyPoint :: !Point } +    -- | Uncompressed public key+    | PubKeyU { pubKeyPoint :: !Point }+    deriving (Read, Show)++instance Eq PubKey where+    -- Compression does not matter for InfPoint+    (PubKey  InfPoint) == (PubKeyU InfPoint) = True+    (PubKeyU InfPoint) == (PubKey  InfPoint) = True+    (PubKey  a)        == (PubKey  b)        = a == b+    (PubKeyU a)        == (PubKeyU b)        = a == b+    _                  == _                  = False++-- | Returns True if the public key is valid. This will check if the public+-- key point lies on the curve.+isValidPubKey :: PubKey -> Bool+isValidPubKey = validatePoint . pubKeyPoint++-- | Add a public key to a private key defined by its Hash256 value. This will+-- transform the private key into a public key and add the respective public+-- key points together. This is provided as a helper for BIP32 wallet+-- implementations. This function fails for uncompressed keys and returns+-- Nothing if the private key value is >= than the order of the curve N.+addPubKeys :: PubKey -> Hash256 -> Maybe PubKey+addPubKeys pub i+    | isPubKeyU pub = error "Add: HDW only supports compressed formats"+    | toInteger i < curveN =+        let pt1 = mulPoint (toFieldN i) curveG+            pt2 = addPoint (pubKeyPoint pub) pt1+            in if isInfPoint pt2 then Nothing+                                 else Just $ PubKey pt2+    | otherwise = Nothing++-- | Returns True if the public key is uncompressed+isPubKeyU :: PubKey -> Bool+isPubKeyU (PubKey  _) = False+isPubKeyU (PubKeyU _) = True++-- | Derives a public key from a private key. This function will preserve+-- information on key compression (PrvKey becomes PubKey and PrvKeyU becomes+-- PubKeyU)+derivePubKey :: PrvKey -> PubKey+derivePubKey k = case k of+    (PrvKey  d) -> PubKey  $ mulPoint d curveG+    (PrvKeyU d) -> PubKeyU $ mulPoint d curveG++instance Binary PubKey where++    -- Section 2.3.4 http://www.secg.org/download/aid-780/sec1-v2.pdf+    get = go =<< getWord8+      where +        -- skip 2.3.4.1 and fail. InfPoint is an invalid public key+        go 0 = fail "InfPoint is not a valid public key"+        -- 2.3.4.3 Uncompressed format+        go 4 = getUncompressed+        -- 2.3.4.2 Compressed format+        -- 2 means pY is even, 3 means pY is odd+        go y | y == 2 || y == 3 = getCompressed (even y)+             | otherwise = fail "Get: Invalid public key encoding"++    -- Section 2.3.3 http://www.secg.org/download/aid-780/sec1-v2.pdf+    put pk = case getAffine (pubKeyPoint pk) of+        -- 2.3.3.1+        Nothing    -> putWord8 0x00+        Just (x,y) -> case pk of+            -- Compressed+            PubKey  _ -> putWord8 (if even y then 2 else 3) >> put x+            -- Uncompressed+            PubKeyU _ -> putWord8 4 >> put x >> put y++getUncompressed :: Get PubKey+getUncompressed = do+    p <- makePoint <$> get <*> get+    unless (isJust p) (fail "Get: Point not on the curve")+    return $ PubKeyU $ fromJust $ p++getCompressed :: Bool -> Get PubKey+getCompressed e = do+    -- 2.1 +    x <- get :: Get FieldP+    -- 2.4.1 (deriving yP)+    let a  = x ^ (3 :: Integer) + (curveA * x) + curveB+        ys = filter matchSign (quadraticResidue a)+    -- We found no square root (mod p)+    when (null ys) (fail $ "No ECC point for x = " ++ (show x))+    let p = makePoint x (head ys)+    -- Additionally, check that the point is on the curve+    unless (isJust p) (fail "Get: Point not on the curve")+    return $ PubKey $ fromJust $ p+  where +    matchSign a = (even a) == e++-- | Computes an Address value from a public key+pubKeyAddr :: PubKey -> Address+pubKeyAddr = PubKeyAddress . hash160 . hash256BS . encode'++{- Private Keys -}++-- | Elliptic curve private key type. Two constructors are provided for creating+-- compressed or uncompressed private keys. Compression information is stored+-- in private key WIF formats and needs to be preserved to generate the correct+-- addresses from the corresponding public key. +data PrvKey +    -- | Compressed private key+    = PrvKey  { prvKeyFieldN :: !FieldN } +    -- | Uncompressed private key+    | PrvKeyU { prvKeyFieldN :: !FieldN } +    deriving (Eq, Show, Read)++-- | Returns True if the private key is valid. This will check if the integer+-- value representing the private key is greater than 0 and smaller than the+-- curve order N.+isValidPrvKey :: Integer -> Bool+isValidPrvKey = isIntegerValidKey++-- | Builds a compressed private key from an Integer value. Returns Nothing if+-- the Integer would not produce a valid private key. For security, the Integer+-- needs to be generated from a random source with sufficient entropy.+makePrvKey :: Integer -> Maybe PrvKey+makePrvKey i+    | isValidPrvKey i = Just $ PrvKey $ fromInteger i+    | otherwise       = Nothing++-- | Builds an uncompressed private key from an Integer value. Returns Nothing+-- if the Integer would not produce a valid private key. For security, the+-- Integer needs to be generated from a random source with sufficient entropy.+makePrvKeyU :: Integer -> Maybe PrvKey+makePrvKeyU i+    | isValidPrvKey i = Just $ PrvKeyU $ fromInteger i+    | otherwise       = Nothing++-- | Returns the Integer value of a private key+fromPrvKey :: PrvKey -> Integer+fromPrvKey = fromIntegral . prvKeyFieldN++-- | Add two private keys together. One of the keys is defined by a Hash256.+-- The functions fails on uncompressed private keys and return Nothing if the+-- Hash256 is smaller than the order of the curve N. This is provided+-- as a helper for implementing BIP32 wallets.+addPrvKeys :: PrvKey -> Hash256 -> Maybe PrvKey+addPrvKeys key i+    | isPrvKeyU key = error "Add: HDW only supports compressed formats"+    | toInteger i < curveN =+        let r = (prvKeyFieldN key) + (toFieldN i) +            in makePrvKey $ toInteger r+    | otherwise = Nothing++-- | Returns True of the private key is uncompressed+isPrvKeyU :: PrvKey -> Bool+isPrvKeyU (PrvKey  _) = False+isPrvKeyU (PrvKeyU _) = True++-- | Serialize a private key into the Data.Binary.Put monad as a 32 byte+-- big endian ByteString. This is useful when a constant length serialization+-- format for private keys is required+putPrvKey :: PrvKey -> Put+putPrvKey k | prvKeyFieldN k == 0 = error "Put: 0 is an invalid private key"+            | otherwise        = put $ toMod256 $ prvKeyFieldN k++-- | Deserializes a compressed private key from the Data.Binary.Get monad as a+-- 32 byte big endian ByteString.+getPrvKey :: Get PrvKey+getPrvKey = do+        i <- get :: Get Hash256+        let res = makePrvKey $ fromIntegral i+        unless (isJust res) $ fail "Get: PrivateKey is invalid"+        return $ fromJust res++-- | Deserializes an uncompressed private key from the Data.Binary.Get monad as+-- a 32 byte big endian ByteString+getPrvKeyU :: Get PrvKey+getPrvKeyU = do+        i <- get :: Get Hash256+        let res = makePrvKeyU $ fromIntegral i+        unless (isJust res) $ fail "Get: PrivateKey is invalid"+        return $ fromJust res++-- | Decodes a private key from a WIF encoded String. This function can 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 :: String -> Maybe PrvKey+fromWIF str = do+    bs <- decodeBase58Check $ stringToBS str+    -- Check that this is a private key+    guard (BS.head bs == secretPrefix)  +    case BS.length bs of+        33 -> do               -- Uncompressed format+            let i = bsToInteger (BS.tail bs)+            makePrvKeyU i+        34 -> do               -- Compressed format+            guard (BS.last bs == 0x01) +            let i = bsToInteger $ BS.tail $ BS.init bs+            makePrvKey i+        _  -> Nothing          -- Bad length++-- | Encodes a private key into WIF format+toWIF :: PrvKey -> String+toWIF k = bsToString $ encodeBase58Check $ BS.cons secretPrefix enc+  where +    enc | isPrvKeyU k = bs+        | otherwise   = BS.snoc bs 0x01+    bs = runPut' $ putPrvKey k+
+ Network/Haskoin/Crypto/Merkle.hs view
@@ -0,0 +1,130 @@+module Network.Haskoin.Crypto.Merkle +( calcTreeHeight+, calcTreeWidth+, buildMerkleRoot+, calcHash+, buildPartialMerkle+, extractMatches+) where++import Data.Bits+import Data.Maybe+import qualified Data.ByteString as BS ++import Network.Haskoin.Crypto.Hash+import Network.Haskoin.Util++-- | Computes the height of a merkle tree.+calcTreeHeight :: Int -- ^ Number of transactions (leaf nodes).+               -> Int -- ^ Height of the merkle tree.+calcTreeHeight ntx = ceiling $ log (fromIntegral ntx :: Double) / log 2++-- | Computes the width of a merkle tree at a specific height. The transactions+-- are at height 0.+calcTreeWidth :: Int -- ^ Number of transactions (leaf nodes).+              -> Int -- ^ Height at which we want to compute the width.+              -> Int -- ^ Width of the merkle tree.+calcTreeWidth ntx h = (ntx + (1 `shiftL` h) - 1) `shiftR` h++-- | Computes the root of a merkle tree from a list of leaf node hashes.+buildMerkleRoot :: [Hash256] -- ^ List of transaction hashes (leaf nodes).+                -> Hash256   -- ^ Root of the merkle tree.+buildMerkleRoot txs = calcHash (calcTreeHeight $ length txs) 0 txs++hash2 :: Hash256 -> Hash256 -> Hash256+hash2 a b = doubleHash256 $ encode' a `BS.append` encode' b++-- | Computes the hash of a specific node in a merkle tree.+calcHash :: Int       -- ^ Height of the node in the merkle tree.+         -> Int       -- ^ Position of the node (0 for the leftmost node).+         -> [Hash256] -- ^ Transaction hashes of the merkle tree (leaf nodes).+         -> Hash256   -- ^ Hash of the node at the specified position.+calcHash height pos txs+    | height < 0 || pos < 0 = error "calcHash: Invalid parameters"+    | height == 0 = txs !! pos+    | otherwise = hash2 left right+  where+    left = calcHash (height-1) (pos*2) txs+    right | pos*2+1 < calcTreeWidth (length txs) (height-1) = +                calcHash (height-1) (pos*2+1) txs+          | otherwise = left++-- | Build a partial merkle tree.+buildPartialMerkle +    :: [(Hash256,Bool)] +    -- ^ List of transactions hashes forming the leaves of the merkle tree+    -- and a bool indicating if that transaction should be included in the +    -- partial merkle tree.+    -> ([Bool], [Hash256]) +    -- ^ Flag bits (used to parse the partial merkle tree) and the +    -- partial merkle tree.+buildPartialMerkle hs = traverseAndBuild (calcTreeHeight $ length hs) 0 hs++traverseAndBuild :: Int -> Int -> [(Hash256,Bool)] -> ([Bool], [Hash256])+traverseAndBuild height pos txs+    | height < 0 || pos < 0 = error "traverseAndBuild: Invalid parameters"+    | height == 0 || not match = ([match],[calcHash height pos t])+    | otherwise = (match : lb ++ rb, lh ++ rh)+  where+    t = map fst txs+    s = pos `shiftL` height+    e = min (length txs) $ (pos+1) `shiftL` height+    match = or $ map snd $ take (e-s) $ drop s txs+    (lb,lh) = traverseAndBuild (height-1) (pos*2) txs+    (rb,rh) | (pos*2+1) < calcTreeWidth (length txs) (height-1)+                = traverseAndBuild (height-1) (pos*2+1) txs+            | otherwise = ([],[])++traverseAndExtract :: Int -> Int -> Int -> [Bool] -> [Hash256] +                   -> Maybe (Hash256, [Hash256], Int, Int)+traverseAndExtract height pos ntx flags hashes+    | length flags == 0        = Nothing+    | height == 0 || not match = leafResult+    | isNothing leftM          = Nothing+    | (pos*2+1) >= calcTreeWidth ntx (height-1) = +        Just (hash2 lh lh, lm, lcf+1, lch)+    | isNothing rightM         = Nothing+    | otherwise = +        Just (hash2 lh rh, lm ++ rm, lcf+rcf+1, lch+rch)+  where+    leafResult+        | null hashes = Nothing+        | otherwise = Just (h,if height == 0 && match then [h] else [],1,1)+    (match:fs) = flags+    (h:_)     = hashes+    leftM  = traverseAndExtract (height-1) (pos*2) ntx fs hashes+    (lh,lm,lcf,lch) = fromJust leftM+    rightM = traverseAndExtract (height-1) (pos*2+1) ntx +                (drop lcf fs) (drop lch hashes)+    (rh,rm,rcf,rch) = fromJust rightM++-- | 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 :: [Bool]    -- ^ Flag bits (produced by buildPartialMerkle).+               -> [Hash256] -- ^ Partial merkle tree.+               -> Int       -- ^ Number of transaction at height 0 (leaf nodes).+               -> Either String (Hash256, [Hash256])+               -- ^ Merkle root and the list of matching transaction hashes.+extractMatches flags hashes ntx+    | ntx == 0 = Left $+        "extractMatches: number of transactions can not be 0"+    | ntx > maxBlockSize `div` 60 = Left $+        "extractMatches: number of transactions excessively high"+    | length hashes > ntx = Left $+        "extractMatches: More hashes provided than the number of transactions"+    | length flags < length hashes = Left $+        "extractMatches: At least one bit per node and one bit per hash"+    | isNothing resM = Left $+        "extractMatches: traverseAndExtract failed"+    | (nBitsUsed+7) `div` 8 /= (length flags+7) `div` 8 = Left $+        "extractMatches: All bits were not consumed"+    | nHashUsed /= length hashes = Left $+        "extractMatches: All hashes were not consumed: " ++ (show nHashUsed)+    | otherwise = return (merkleRoot, matches)+  where+    resM = traverseAndExtract (calcTreeHeight ntx) 0 ntx flags hashes+    (merkleRoot, matches, nBitsUsed, nHashUsed) = fromJust resM+++
+ Network/Haskoin/Crypto/Mnemonic.hs view
@@ -0,0 +1,500 @@+{-# LANGUAGE OverloadedStrings #-}+-- | Mnemonic keys (BIP-0039)+module Network.Haskoin.Crypto.Mnemonic+(+  -- * Data types+  WordList+, Entropy+, Mnemonic+, Passphrase+, Seed++  -- * Entropy encoding and decoding+, toMnemonic+, fromMnemonic++  -- * Generating 512-bit seeds+, anyToSeed+, mnemonicToSeed++  -- * Dictionaries+, english++  -- * Helper functions+, getBits+) where++import Control.Monad (when)+import qualified Crypto.Hash.SHA256 as SHA256+import Crypto.PBKDF.ByteString (sha512PBKDF2)+import Data.Bits ((.&.), shiftL, shiftR)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.List+import Data.Maybe+import Data.Text (Text)+import qualified Data.Text as T+import Data.Text.Encoding (encodeUtf8)+import Data.Text.ICU.Normalize (NormalizationMode(NFKD), normalize)+import Network.Haskoin.Util (bsToInteger, integerToBS)++type WordList = [Text]+type Entropy = ByteString+type Mnemonic = Text+type Passphrase = Text+type Seed = ByteString+type Checksum = ByteString++-- | Provide dictionary and intial entropy as a 'ByteString' with length+-- multiple of 32 bits (4 bytes). Output a mnemonic sentence as 'Text'.+toMnemonic :: WordList -> Entropy -> Either String Mnemonic+toMnemonic wl ent = do+    when (remainder /= 0)+        $ Left "toMnemonic: entropy must be multiples of 32 bits"+    when (cs_len > 16)+        $ Left "toMnemonic: maximum entropy is 512 bits"+    return ms+  where+    (cs_len, remainder) = BS.length ent `quotRem` 4+    cs = calcCS cs_len ent+    indices = bsToIndices $ ent `BS.append` cs+    ms = T.unwords $ map (wl !!) indices++-- | Revert 'toMnemonic'. Do not use this to generate seeds. Instead use+-- 'mnemonicToSeed'.+fromMnemonic :: WordList -> Mnemonic -> Either String Entropy+fromMnemonic wl ms = do+    when (word_count > 48)+        . Left $ "fromMnemonic: too many words: " ++ show word_count+    when (word_count `mod` 3 /= 0)+        . Left $ "fromMnemonic: wrong number of words: " ++ show word_count+    ms_bs <- indicesToBS =<< getIndices wl ms_words+    let (ms_ent, ms_cs) = BS.splitAt (ent_len * 4) ms_bs+        ms_cs_num = numCS cs_len ms_cs+        ent_cs_num = numCS cs_len $ calcCS cs_len ms_ent+    when (ent_cs_num /= ms_cs_num)+        . Left $ "fromMnemonic: checksum failed: " ++ sh ent_cs_num ms_cs_num+    return ms_ent+  where+    ms_words = T.words $ normalize NFKD ms+    word_count = length ms_words+    (ent_len, cs_len) = (word_count * 11) `quotRem` 32+    sh cs_a cs_b = show cs_a ++ " /= " ++ show cs_b++calcCS :: Int -> Entropy -> Checksum+calcCS len = getBits len . SHA256.hash++numCS :: Int -> Entropy -> Integer+numCS len = shiftCS . bsToInteger+  where+    shiftCS = case 8 - len `mod` 8 of+        0 -> id+        x -> flip shiftR x++-- | Turn any sequence of characters to a seed. Does not have to be a mnemonic+-- sentence generated from 'toMnemonic'. Use 'mnemonicToSeed' to get a seed+-- from a mnemonic sentence.+anyToSeed :: Passphrase -> Mnemonic -> Seed+anyToSeed pf ms = sha512PBKDF2 p s 2048 64+  where+    p = encodeUtf8 $ normalize NFKD ms+    s = encodeUtf8 $ normalize NFKD ("mnemonic" `T.append` pf)++-- | Get a seed from a mnemonic sentence. Will calculate checksum. Requires+-- same dictionary used to generate the mnemonic sentence as first argument.+-- Passphrase can be used to protect the mnemonic. Use an empty string as+-- passphrase if none is required.+mnemonicToSeed :: WordList -> Passphrase -> Mnemonic -> Either String Seed+mnemonicToSeed wl pf ms = do+    ent <- fromMnemonic wl ms+    mnm <- toMnemonic wl ent+    return $ anyToSeed pf mnm++-- | Obtain 'Int' bits from beginning of 'ByteString'. Resulting 'ByteString'+-- will be smallest required to hold that many bits, padded with zeroes to the+-- right.+getBits :: Int -> ByteString -> ByteString+getBits b bs+    | r == 0 = BS.take q bs+    | otherwise = i `BS.snoc` l+  where+    (q, r) = b `quotRem` 8+    s = (BS.take (q + 1) bs)+    i = BS.init s+    l = BS.last s .&. (0xff `shiftL` (8 - r))    -- zero unneeded bits++-- Expects already normalized list of words+getIndices :: WordList -> [Text] -> Either String [Int]+getIndices wl ws+    | null n = return . fromJust $ sequence i+    | otherwise = Left $ "getIndices: words not found: " ++ T.unpack w+  where+    i = map (flip elemIndex wl) ws+    n = elemIndices Nothing i+    w = T.unwords $ map (ws !!) n++indicesToBS :: [Int] -> Either String ByteString+indicesToBS is = do+    when lrg $ Left "indicesToBS: index larger or equal than 2048"+    return . pad . integerToBS $ (foldl' f 0 is) `shiftL` shift_width+  where+    lrg = not . isNothing $ find (>= 2048) is+    (q, r) = (length is * 11) `quotRem` 8+    shift_width = if r == 0 then 0 else 8 - r+    bl = if r == 0 then q else q + 1   -- length of resulting ByteString+    pad bs = BS.append (BS.replicate (bl - BS.length bs) 0x00) bs+    f acc x = (acc `shiftL` 11) + fromIntegral x++bsToIndices :: ByteString -> [Int]+bsToIndices bs = reverse . go q $ bsToInteger bs `shiftR` r+  where+    (q, r) = (BS.length bs * 8) `quotRem` 11+    go 0 _ = []+    go n i = (fromIntegral $ i `mod` 2048) : go (n - 1) (i `shiftR` 11)++-- | Standard English dictionary from BIP-0039 specification.+english :: [Text]+english =+    [ "abandon", "ability", "able", "about", "above", "absent"+    , "absorb", "abstract", "absurd", "abuse", "access", "accident"+    , "account", "accuse", "achieve", "acid", "acoustic", "acquire"+    , "across", "act", "action", "actor", "actress", "actual"+    , "adapt", "add", "addict", "address", "adjust", "admit"+    , "adult", "advance", "advice", "aerobic", "affair", "afford"+    , "afraid", "again", "age", "agent", "agree", "ahead"+    , "aim", "air", "airport", "aisle", "alarm", "album"+    , "alcohol", "alert", "alien", "all", "alley", "allow"+    , "almost", "alone", "alpha", "already", "also", "alter"+    , "always", "amateur", "amazing", "among", "amount", "amused"+    , "analyst", "anchor", "ancient", "anger", "angle", "angry"+    , "animal", "ankle", "announce", "annual", "another", "answer"+    , "antenna", "antique", "anxiety", "any", "apart", "apology"+    , "appear", "apple", "approve", "april", "arch", "arctic"+    , "area", "arena", "argue", "arm", "armed", "armor"+    , "army", "around", "arrange", "arrest", "arrive", "arrow"+    , "art", "artefact", "artist", "artwork", "ask", "aspect"+    , "assault", "asset", "assist", "assume", "asthma", "athlete"+    , "atom", "attack", "attend", "attitude", "attract", "auction"+    , "audit", "august", "aunt", "author", "auto", "autumn"+    , "average", "avocado", "avoid", "awake", "aware", "away"+    , "awesome", "awful", "awkward", "axis", "baby", "bachelor"+    , "bacon", "badge", "bag", "balance", "balcony", "ball"+    , "bamboo", "banana", "banner", "bar", "barely", "bargain"+    , "barrel", "base", "basic", "basket", "battle", "beach"+    , "bean", "beauty", "because", "become", "beef", "before"+    , "begin", "behave", "behind", "believe", "below", "belt"+    , "bench", "benefit", "best", "betray", "better", "between"+    , "beyond", "bicycle", "bid", "bike", "bind", "biology"+    , "bird", "birth", "bitter", "black", "blade", "blame"+    , "blanket", "blast", "bleak", "bless", "blind", "blood"+    , "blossom", "blouse", "blue", "blur", "blush", "board"+    , "boat", "body", "boil", "bomb", "bone", "bonus"+    , "book", "boost", "border", "boring", "borrow", "boss"+    , "bottom", "bounce", "box", "boy", "bracket", "brain"+    , "brand", "brass", "brave", "bread", "breeze", "brick"+    , "bridge", "brief", "bright", "bring", "brisk", "broccoli"+    , "broken", "bronze", "broom", "brother", "brown", "brush"+    , "bubble", "buddy", "budget", "buffalo", "build", "bulb"+    , "bulk", "bullet", "bundle", "bunker", "burden", "burger"+    , "burst", "bus", "business", "busy", "butter", "buyer"+    , "buzz", "cabbage", "cabin", "cable", "cactus", "cage"+    , "cake", "call", "calm", "camera", "camp", "can"+    , "canal", "cancel", "candy", "cannon", "canoe", "canvas"+    , "canyon", "capable", "capital", "captain", "car", "carbon"+    , "card", "cargo", "carpet", "carry", "cart", "case"+    , "cash", "casino", "castle", "casual", "cat", "catalog"+    , "catch", "category", "cattle", "caught", "cause", "caution"+    , "cave", "ceiling", "celery", "cement", "census", "century"+    , "cereal", "certain", "chair", "chalk", "champion", "change"+    , "chaos", "chapter", "charge", "chase", "chat", "cheap"+    , "check", "cheese", "chef", "cherry", "chest", "chicken"+    , "chief", "child", "chimney", "choice", "choose", "chronic"+    , "chuckle", "chunk", "churn", "cigar", "cinnamon", "circle"+    , "citizen", "city", "civil", "claim", "clap", "clarify"+    , "claw", "clay", "clean", "clerk", "clever", "click"+    , "client", "cliff", "climb", "clinic", "clip", "clock"+    , "clog", "close", "cloth", "cloud", "clown", "club"+    , "clump", "cluster", "clutch", "coach", "coast", "coconut"+    , "code", "coffee", "coil", "coin", "collect", "color"+    , "column", "combine", "come", "comfort", "comic", "common"+    , "company", "concert", "conduct", "confirm", "congress", "connect"+    , "consider", "control", "convince", "cook", "cool", "copper"+    , "copy", "coral", "core", "corn", "correct", "cost"+    , "cotton", "couch", "country", "couple", "course", "cousin"+    , "cover", "coyote", "crack", "cradle", "craft", "cram"+    , "crane", "crash", "crater", "crawl", "crazy", "cream"+    , "credit", "creek", "crew", "cricket", "crime", "crisp"+    , "critic", "crop", "cross", "crouch", "crowd", "crucial"+    , "cruel", "cruise", "crumble", "crunch", "crush", "cry"+    , "crystal", "cube", "culture", "cup", "cupboard", "curious"+    , "current", "curtain", "curve", "cushion", "custom", "cute"+    , "cycle", "dad", "damage", "damp", "dance", "danger"+    , "daring", "dash", "daughter", "dawn", "day", "deal"+    , "debate", "debris", "decade", "december", "decide", "decline"+    , "decorate", "decrease", "deer", "defense", "define", "defy"+    , "degree", "delay", "deliver", "demand", "demise", "denial"+    , "dentist", "deny", "depart", "depend", "deposit", "depth"+    , "deputy", "derive", "describe", "desert", "design", "desk"+    , "despair", "destroy", "detail", "detect", "develop", "device"+    , "devote", "diagram", "dial", "diamond", "diary", "dice"+    , "diesel", "diet", "differ", "digital", "dignity", "dilemma"+    , "dinner", "dinosaur", "direct", "dirt", "disagree", "discover"+    , "disease", "dish", "dismiss", "disorder", "display", "distance"+    , "divert", "divide", "divorce", "dizzy", "doctor", "document"+    , "dog", "doll", "dolphin", "domain", "donate", "donkey"+    , "donor", "door", "dose", "double", "dove", "draft"+    , "dragon", "drama", "drastic", "draw", "dream", "dress"+    , "drift", "drill", "drink", "drip", "drive", "drop"+    , "drum", "dry", "duck", "dumb", "dune", "during"+    , "dust", "dutch", "duty", "dwarf", "dynamic", "eager"+    , "eagle", "early", "earn", "earth", "easily", "east"+    , "easy", "echo", "ecology", "economy", "edge", "edit"+    , "educate", "effort", "egg", "eight", "either", "elbow"+    , "elder", "electric", "elegant", "element", "elephant", "elevator"+    , "elite", "else", "embark", "embody", "embrace", "emerge"+    , "emotion", "employ", "empower", "empty", "enable", "enact"+    , "end", "endless", "endorse", "enemy", "energy", "enforce"+    , "engage", "engine", "enhance", "enjoy", "enlist", "enough"+    , "enrich", "enroll", "ensure", "enter", "entire", "entry"+    , "envelope", "episode", "equal", "equip", "era", "erase"+    , "erode", "erosion", "error", "erupt", "escape", "essay"+    , "essence", "estate", "eternal", "ethics", "evidence", "evil"+    , "evoke", "evolve", "exact", "example", "excess", "exchange"+    , "excite", "exclude", "excuse", "execute", "exercise", "exhaust"+    , "exhibit", "exile", "exist", "exit", "exotic", "expand"+    , "expect", "expire", "explain", "expose", "express", "extend"+    , "extra", "eye", "eyebrow", "fabric", "face", "faculty"+    , "fade", "faint", "faith", "fall", "false", "fame"+    , "family", "famous", "fan", "fancy", "fantasy", "farm"+    , "fashion", "fat", "fatal", "father", "fatigue", "fault"+    , "favorite", "feature", "february", "federal", "fee", "feed"+    , "feel", "female", "fence", "festival", "fetch", "fever"+    , "few", "fiber", "fiction", "field", "figure", "file"+    , "film", "filter", "final", "find", "fine", "finger"+    , "finish", "fire", "firm", "first", "fiscal", "fish"+    , "fit", "fitness", "fix", "flag", "flame", "flash"+    , "flat", "flavor", "flee", "flight", "flip", "float"+    , "flock", "floor", "flower", "fluid", "flush", "fly"+    , "foam", "focus", "fog", "foil", "fold", "follow"+    , "food", "foot", "force", "forest", "forget", "fork"+    , "fortune", "forum", "forward", "fossil", "foster", "found"+    , "fox", "fragile", "frame", "frequent", "fresh", "friend"+    , "fringe", "frog", "front", "frost", "frown", "frozen"+    , "fruit", "fuel", "fun", "funny", "furnace", "fury"+    , "future", "gadget", "gain", "galaxy", "gallery", "game"+    , "gap", "garage", "garbage", "garden", "garlic", "garment"+    , "gas", "gasp", "gate", "gather", "gauge", "gaze"+    , "general", "genius", "genre", "gentle", "genuine", "gesture"+    , "ghost", "giant", "gift", "giggle", "ginger", "giraffe"+    , "girl", "give", "glad", "glance", "glare", "glass"+    , "glide", "glimpse", "globe", "gloom", "glory", "glove"+    , "glow", "glue", "goat", "goddess", "gold", "good"+    , "goose", "gorilla", "gospel", "gossip", "govern", "gown"+    , "grab", "grace", "grain", "grant", "grape", "grass"+    , "gravity", "great", "green", "grid", "grief", "grit"+    , "grocery", "group", "grow", "grunt", "guard", "guess"+    , "guide", "guilt", "guitar", "gun", "gym", "habit"+    , "hair", "half", "hammer", "hamster", "hand", "happy"+    , "harbor", "hard", "harsh", "harvest", "hat", "have"+    , "hawk", "hazard", "head", "health", "heart", "heavy"+    , "hedgehog", "height", "hello", "helmet", "help", "hen"+    , "hero", "hidden", "high", "hill", "hint", "hip"+    , "hire", "history", "hobby", "hockey", "hold", "hole"+    , "holiday", "hollow", "home", "honey", "hood", "hope"+    , "horn", "horror", "horse", "hospital", "host", "hotel"+    , "hour", "hover", "hub", "huge", "human", "humble"+    , "humor", "hundred", "hungry", "hunt", "hurdle", "hurry"+    , "hurt", "husband", "hybrid", "ice", "icon", "idea"+    , "identify", "idle", "ignore", "ill", "illegal", "illness"+    , "image", "imitate", "immense", "immune", "impact", "impose"+    , "improve", "impulse", "inch", "include", "income", "increase"+    , "index", "indicate", "indoor", "industry", "infant", "inflict"+    , "inform", "inhale", "inherit", "initial", "inject", "injury"+    , "inmate", "inner", "innocent", "input", "inquiry", "insane"+    , "insect", "inside", "inspire", "install", "intact", "interest"+    , "into", "invest", "invite", "involve", "iron", "island"+    , "isolate", "issue", "item", "ivory", "jacket", "jaguar"+    , "jar", "jazz", "jealous", "jeans", "jelly", "jewel"+    , "job", "join", "joke", "journey", "joy", "judge"+    , "juice", "jump", "jungle", "junior", "junk", "just"+    , "kangaroo", "keen", "keep", "ketchup", "key", "kick"+    , "kid", "kidney", "kind", "kingdom", "kiss", "kit"+    , "kitchen", "kite", "kitten", "kiwi", "knee", "knife"+    , "knock", "know", "lab", "label", "labor", "ladder"+    , "lady", "lake", "lamp", "language", "laptop", "large"+    , "later", "latin", "laugh", "laundry", "lava", "law"+    , "lawn", "lawsuit", "layer", "lazy", "leader", "leaf"+    , "learn", "leave", "lecture", "left", "leg", "legal"+    , "legend", "leisure", "lemon", "lend", "length", "lens"+    , "leopard", "lesson", "letter", "level", "liar", "liberty"+    , "library", "license", "life", "lift", "light", "like"+    , "limb", "limit", "link", "lion", "liquid", "list"+    , "little", "live", "lizard", "load", "loan", "lobster"+    , "local", "lock", "logic", "lonely", "long", "loop"+    , "lottery", "loud", "lounge", "love", "loyal", "lucky"+    , "luggage", "lumber", "lunar", "lunch", "luxury", "lyrics"+    , "machine", "mad", "magic", "magnet", "maid", "mail"+    , "main", "major", "make", "mammal", "man", "manage"+    , "mandate", "mango", "mansion", "manual", "maple", "marble"+    , "march", "margin", "marine", "market", "marriage", "mask"+    , "mass", "master", "match", "material", "math", "matrix"+    , "matter", "maximum", "maze", "meadow", "mean", "measure"+    , "meat", "mechanic", "medal", "media", "melody", "melt"+    , "member", "memory", "mention", "menu", "mercy", "merge"+    , "merit", "merry", "mesh", "message", "metal", "method"+    , "middle", "midnight", "milk", "million", "mimic", "mind"+    , "minimum", "minor", "minute", "miracle", "mirror", "misery"+    , "miss", "mistake", "mix", "mixed", "mixture", "mobile"+    , "model", "modify", "mom", "moment", "monitor", "monkey"+    , "monster", "month", "moon", "moral", "more", "morning"+    , "mosquito", "mother", "motion", "motor", "mountain", "mouse"+    , "move", "movie", "much", "muffin", "mule", "multiply"+    , "muscle", "museum", "mushroom", "music", "must", "mutual"+    , "myself", "mystery", "myth", "naive", "name", "napkin"+    , "narrow", "nasty", "nation", "nature", "near", "neck"+    , "need", "negative", "neglect", "neither", "nephew", "nerve"+    , "nest", "net", "network", "neutral", "never", "news"+    , "next", "nice", "night", "noble", "noise", "nominee"+    , "noodle", "normal", "north", "nose", "notable", "note"+    , "nothing", "notice", "novel", "now", "nuclear", "number"+    , "nurse", "nut", "oak", "obey", "object", "oblige"+    , "obscure", "observe", "obtain", "obvious", "occur", "ocean"+    , "october", "odor", "off", "offer", "office", "often"+    , "oil", "okay", "old", "olive", "olympic", "omit"+    , "once", "one", "onion", "online", "only", "open"+    , "opera", "opinion", "oppose", "option", "orange", "orbit"+    , "orchard", "order", "ordinary", "organ", "orient", "original"+    , "orphan", "ostrich", "other", "outdoor", "outer", "output"+    , "outside", "oval", "oven", "over", "own", "owner"+    , "oxygen", "oyster", "ozone", "pact", "paddle", "page"+    , "pair", "palace", "palm", "panda", "panel", "panic"+    , "panther", "paper", "parade", "parent", "park", "parrot"+    , "party", "pass", "patch", "path", "patient", "patrol"+    , "pattern", "pause", "pave", "payment", "peace", "peanut"+    , "pear", "peasant", "pelican", "pen", "penalty", "pencil"+    , "people", "pepper", "perfect", "permit", "person", "pet"+    , "phone", "photo", "phrase", "physical", "piano", "picnic"+    , "picture", "piece", "pig", "pigeon", "pill", "pilot"+    , "pink", "pioneer", "pipe", "pistol", "pitch", "pizza"+    , "place", "planet", "plastic", "plate", "play", "please"+    , "pledge", "pluck", "plug", "plunge", "poem", "poet"+    , "point", "polar", "pole", "police", "pond", "pony"+    , "pool", "popular", "portion", "position", "possible", "post"+    , "potato", "pottery", "poverty", "powder", "power", "practice"+    , "praise", "predict", "prefer", "prepare", "present", "pretty"+    , "prevent", "price", "pride", "primary", "print", "priority"+    , "prison", "private", "prize", "problem", "process", "produce"+    , "profit", "program", "project", "promote", "proof", "property"+    , "prosper", "protect", "proud", "provide", "public", "pudding"+    , "pull", "pulp", "pulse", "pumpkin", "punch", "pupil"+    , "puppy", "purchase", "purity", "purpose", "purse", "push"+    , "put", "puzzle", "pyramid", "quality", "quantum", "quarter"+    , "question", "quick", "quit", "quiz", "quote", "rabbit"+    , "raccoon", "race", "rack", "radar", "radio", "rail"+    , "rain", "raise", "rally", "ramp", "ranch", "random"+    , "range", "rapid", "rare", "rate", "rather", "raven"+    , "raw", "razor", "ready", "real", "reason", "rebel"+    , "rebuild", "recall", "receive", "recipe", "record", "recycle"+    , "reduce", "reflect", "reform", "refuse", "region", "regret"+    , "regular", "reject", "relax", "release", "relief", "rely"+    , "remain", "remember", "remind", "remove", "render", "renew"+    , "rent", "reopen", "repair", "repeat", "replace", "report"+    , "require", "rescue", "resemble", "resist", "resource", "response"+    , "result", "retire", "retreat", "return", "reunion", "reveal"+    , "review", "reward", "rhythm", "rib", "ribbon", "rice"+    , "rich", "ride", "ridge", "rifle", "right", "rigid"+    , "ring", "riot", "ripple", "risk", "ritual", "rival"+    , "river", "road", "roast", "robot", "robust", "rocket"+    , "romance", "roof", "rookie", "room", "rose", "rotate"+    , "rough", "round", "route", "royal", "rubber", "rude"+    , "rug", "rule", "run", "runway", "rural", "sad"+    , "saddle", "sadness", "safe", "sail", "salad", "salmon"+    , "salon", "salt", "salute", "same", "sample", "sand"+    , "satisfy", "satoshi", "sauce", "sausage", "save", "say"+    , "scale", "scan", "scare", "scatter", "scene", "scheme"+    , "school", "science", "scissors", "scorpion", "scout", "scrap"+    , "screen", "script", "scrub", "sea", "search", "season"+    , "seat", "second", "secret", "section", "security", "seed"+    , "seek", "segment", "select", "sell", "seminar", "senior"+    , "sense", "sentence", "series", "service", "session", "settle"+    , "setup", "seven", "shadow", "shaft", "shallow", "share"+    , "shed", "shell", "sheriff", "shield", "shift", "shine"+    , "ship", "shiver", "shock", "shoe", "shoot", "shop"+    , "short", "shoulder", "shove", "shrimp", "shrug", "shuffle"+    , "shy", "sibling", "sick", "side", "siege", "sight"+    , "sign", "silent", "silk", "silly", "silver", "similar"+    , "simple", "since", "sing", "siren", "sister", "situate"+    , "six", "size", "skate", "sketch", "ski", "skill"+    , "skin", "skirt", "skull", "slab", "slam", "sleep"+    , "slender", "slice", "slide", "slight", "slim", "slogan"+    , "slot", "slow", "slush", "small", "smart", "smile"+    , "smoke", "smooth", "snack", "snake", "snap", "sniff"+    , "snow", "soap", "soccer", "social", "sock", "soda"+    , "soft", "solar", "soldier", "solid", "solution", "solve"+    , "someone", "song", "soon", "sorry", "sort", "soul"+    , "sound", "soup", "source", "south", "space", "spare"+    , "spatial", "spawn", "speak", "special", "speed", "spell"+    , "spend", "sphere", "spice", "spider", "spike", "spin"+    , "spirit", "split", "spoil", "sponsor", "spoon", "sport"+    , "spot", "spray", "spread", "spring", "spy", "square"+    , "squeeze", "squirrel", "stable", "stadium", "staff", "stage"+    , "stairs", "stamp", "stand", "start", "state", "stay"+    , "steak", "steel", "stem", "step", "stereo", "stick"+    , "still", "sting", "stock", "stomach", "stone", "stool"+    , "story", "stove", "strategy", "street", "strike", "strong"+    , "struggle", "student", "stuff", "stumble", "style", "subject"+    , "submit", "subway", "success", "such", "sudden", "suffer"+    , "sugar", "suggest", "suit", "summer", "sun", "sunny"+    , "sunset", "super", "supply", "supreme", "sure", "surface"+    , "surge", "surprise", "surround", "survey", "suspect", "sustain"+    , "swallow", "swamp", "swap", "swarm", "swear", "sweet"+    , "swift", "swim", "swing", "switch", "sword", "symbol"+    , "symptom", "syrup", "system", "table", "tackle", "tag"+    , "tail", "talent", "talk", "tank", "tape", "target"+    , "task", "taste", "tattoo", "taxi", "teach", "team"+    , "tell", "ten", "tenant", "tennis", "tent", "term"+    , "test", "text", "thank", "that", "theme", "then"+    , "theory", "there", "they", "thing", "this", "thought"+    , "three", "thrive", "throw", "thumb", "thunder", "ticket"+    , "tide", "tiger", "tilt", "timber", "time", "tiny"+    , "tip", "tired", "tissue", "title", "toast", "tobacco"+    , "today", "toddler", "toe", "together", "toilet", "token"+    , "tomato", "tomorrow", "tone", "tongue", "tonight", "tool"+    , "tooth", "top", "topic", "topple", "torch", "tornado"+    , "tortoise", "toss", "total", "tourist", "toward", "tower"+    , "town", "toy", "track", "trade", "traffic", "tragic"+    , "train", "transfer", "trap", "trash", "travel", "tray"+    , "treat", "tree", "trend", "trial", "tribe", "trick"+    , "trigger", "trim", "trip", "trophy", "trouble", "truck"+    , "true", "truly", "trumpet", "trust", "truth", "try"+    , "tube", "tuition", "tumble", "tuna", "tunnel", "turkey"+    , "turn", "turtle", "twelve", "twenty", "twice", "twin"+    , "twist", "two", "type", "typical", "ugly", "umbrella"+    , "unable", "unaware", "uncle", "uncover", "under", "undo"+    , "unfair", "unfold", "unhappy", "uniform", "unique", "unit"+    , "universe", "unknown", "unlock", "until", "unusual", "unveil"+    , "update", "upgrade", "uphold", "upon", "upper", "upset"+    , "urban", "urge", "usage", "use", "used", "useful"+    , "useless", "usual", "utility", "vacant", "vacuum", "vague"+    , "valid", "valley", "valve", "van", "vanish", "vapor"+    , "various", "vast", "vault", "vehicle", "velvet", "vendor"+    , "venture", "venue", "verb", "verify", "version", "very"+    , "vessel", "veteran", "viable", "vibrant", "vicious", "victory"+    , "video", "view", "village", "vintage", "violin", "virtual"+    , "virus", "visa", "visit", "visual", "vital", "vivid"+    , "vocal", "voice", "void", "volcano", "volume", "vote"+    , "voyage", "wage", "wagon", "wait", "walk", "wall"+    , "walnut", "want", "warfare", "warm", "warrior", "wash"+    , "wasp", "waste", "water", "wave", "way", "wealth"+    , "weapon", "wear", "weasel", "weather", "web", "wedding"+    , "weekend", "weird", "welcome", "west", "wet", "whale"+    , "what", "wheat", "wheel", "when", "where", "whip"+    , "whisper", "wide", "width", "wife", "wild", "will"+    , "win", "window", "wine", "wing", "wink", "winner"+    , "winter", "wire", "wisdom", "wise", "wish", "witness"+    , "wolf", "woman", "wonder", "wood", "wool", "word"+    , "work", "world", "worry", "worth", "wrap", "wreck"+    , "wrestle", "wrist", "write", "wrong", "yard", "year"+    , "yellow", "you", "young", "youth", "zebra", "zero"+    , "zone", "zoo"+    ]
+ Network/Haskoin/Crypto/NormalizedKeys.hs view
@@ -0,0 +1,292 @@+module Network.Haskoin.Crypto.NormalizedKeys+( MasterKey(..)+, AccPrvKey(..)+, AccPubKey(..)+, AddrPrvKey(..)+, AddrPubKey(..)+, KeyIndex+, makeMasterKey+, loadMasterKey+, loadPrvAcc+, loadPubAcc+, addr+, accPrvKey+, accPubKey+, extPrvKey+, extPubKey+, intPrvKey+, intPubKey+, accPrvKeys+, accPubKeys+, extPrvKeys+, extPubKeys+, intPrvKeys+, intPubKeys+, extAddr+, intAddr+, extAddrs+, intAddrs+, extAddrs'+, intAddrs'+, extMulSigKey+, intMulSigKey+, extMulSigKeys+, intMulSigKeys+, extMulSigAddr+, intMulSigAddr+, extMulSigAddrs+, intMulSigAddrs+) where++import Control.Monad (liftM2, guard)+import Control.Applicative ((<$>))++import Data.Word (Word32)+import Data.Maybe (mapMaybe, fromJust, isJust)+import qualified Data.ByteString as BS (ByteString)++import Network.Haskoin.Crypto.ExtendedKeys+import Network.Haskoin.Crypto.Base58+import Network.Haskoin.Script.Parser++type KeyIndex = Word32++-- | Data type representing an extended private key at the root of the+-- derivation tree. Master keys have depth 0 and no parents. They are+-- represented as m\/ in BIP32 notation.+newtype MasterKey = MasterKey { masterKey :: XPrvKey }+    deriving (Eq, Show, Read)++-- | Data type representing a private account key. Account keys are generated+-- from a 'MasterKey' through prime derivation. This guarantees that the+-- 'MasterKey' will not be compromised if the account key is compromised. +-- 'AccPrvKey' is represented as m\/i'\/ in BIP32 notation.+newtype AccPrvKey = AccPrvKey { getAccPrvKey :: XPrvKey }+    deriving (Eq, Show, Read)++-- | Data type representing a public account key. It is computed through+-- derivation from an 'AccPrvKey'. It can not be derived from the 'MasterKey'+-- directly (property of prime derivation). It is represented as M\/i'\/ in+-- BIP32 notation. 'AccPubKey' is used for generating receiving payment+-- addresses without the knowledge of the 'AccPrvKey'.+newtype AccPubKey = AccPubKey { getAccPubKey :: XPubKey }+    deriving (Eq, Show, Read)++-- | Data type representing a private address key. Private address keys are+-- generated through a non-prime derivation from an 'AccPrvKey'. Non-prime+-- derivation is used so that the public account key can generate the receiving+-- payment addresses without knowledge of the private account key. 'AccPrvKey'+-- is represented as m\/i'\/0\/j\/ in BIP32 notation if it is a regular+-- receiving address. Internal (change) addresses are represented as+-- m\/i'\/1\/j\/. Non-prime subtree 0 is used for regular receiving addresses+-- and non-prime subtree 1 for internal (change) addresses.+newtype AddrPrvKey = AddrPrvKey { getAddrPrvKey :: XPrvKey }+    deriving (Eq, Show, Read)++-- | Data type representing a public address key. They are generated through+-- non-prime derivation from an 'AccPubKey'. This is a useful feature for+-- read-only wallets. They are represented as M\/i'\/0\/j in BIP32 notation+-- for regular receiving addresses and by M\/i'\/1\/j for internal (change)+-- addresses.+newtype AddrPubKey = AddrPubKey { getAddrPubKey :: XPubKey }+    deriving (Eq, Show, Read)++-- | Create a 'MasterKey' from a seed.+makeMasterKey :: BS.ByteString -> Maybe MasterKey+makeMasterKey bs = MasterKey <$> makeXPrvKey bs++-- | Load a 'MasterKey' from an 'XPrvKey'. This function will fail if the+-- extended private key does not have the properties of a 'MasterKey'.+loadMasterKey :: XPrvKey -> Maybe MasterKey+loadMasterKey k+    | xPrvDepth  k == 0 && +      xPrvParent k == 0 && +      xPrvIndex  k == 0 = Just $ MasterKey k+    | otherwise         = Nothing++-- | Load a private account key from an 'XPrvKey'. This function will fail if+-- the extended private key does not have the properties of a 'AccPrvKey'.+loadPrvAcc :: XPrvKey -> Maybe AccPrvKey+loadPrvAcc k+    | xPrvDepth k == 1 &&+      xPrvIsPrime k    = Just $ AccPrvKey k+    | otherwise        = Nothing++-- | Load a public account key from an 'XPubKey'. This function will fail if+-- the extended public key does not have the properties of a 'AccPubKey'.+loadPubAcc :: XPubKey -> Maybe AccPubKey+loadPubAcc k+    | xPubDepth k == 1 &&+      xPubIsPrime k    = Just $ AccPubKey k+    | otherwise        = Nothing++-- | Computes an 'AccPrvKey' from a 'MasterKey' and a derivation index.+accPrvKey :: MasterKey -> KeyIndex -> Maybe AccPrvKey+accPrvKey (MasterKey par) i = AccPrvKey <$> (f =<< primeSubKey par i)+    where f k = guard (isJust $ prvSubKey k 0) >>+                guard (isJust $ prvSubKey k 1) >>+                return k++-- | Computes an 'AccPubKey' from a 'MasterKey' and a derivation index.+accPubKey :: MasterKey -> KeyIndex -> Maybe AccPubKey+accPubKey (MasterKey par) i = f <$> primeSubKey par i+    where f = AccPubKey . deriveXPubKey++-- | Computes an external 'AddrPrvKey' from an 'AccPrvKey' and a derivation+-- index.+extPrvKey :: AccPrvKey -> KeyIndex -> Maybe AddrPrvKey+extPrvKey (AccPrvKey par) i = AddrPrvKey <$> prvSubKey extKey i+    where extKey = fromJust $ prvSubKey par 0++-- | Computes an external 'AddrPubKey' from an 'AccPubKey' and a derivation+-- index.+extPubKey :: AccPubKey -> KeyIndex -> Maybe AddrPubKey+extPubKey (AccPubKey par) i = AddrPubKey <$> pubSubKey extKey i+    where extKey = fromJust $ pubSubKey par 0++-- | Computes an internal 'AddrPrvKey' from an 'AccPrvKey' and a derivation+-- index.+intPrvKey :: AccPrvKey -> KeyIndex -> Maybe AddrPrvKey+intPrvKey (AccPrvKey par) i = AddrPrvKey <$> prvSubKey intKey i+    where intKey = fromJust $ prvSubKey par 1++-- | Computes an internal 'AddrPubKey' from an 'AccPubKey' and a derivation+-- index.+intPubKey :: AccPubKey -> KeyIndex -> Maybe AddrPubKey+intPubKey (AccPubKey par) i = AddrPubKey <$> pubSubKey intKey i+    where intKey = fromJust $ pubSubKey par 1++-- | Cyclic list of all valid 'AccPrvKey' derived from a 'MasterKey' and+-- starting from an offset index.+accPrvKeys :: MasterKey -> KeyIndex -> [(AccPrvKey,KeyIndex)]+accPrvKeys m i = mapMaybe f $ cycleIndex i+    where f j = liftM2 (,) (accPrvKey m j) (return j)++-- | Cyclic list of all valid 'AccPubKey' derived from a 'MasterKey' and+-- starting from an offset index.+accPubKeys :: MasterKey -> KeyIndex -> [(AccPubKey,KeyIndex)]+accPubKeys m i = mapMaybe f $ cycleIndex i+    where f j = liftM2 (,) (accPubKey m j) (return j)++-- | Cyclic list of all valid external 'AddrPrvKey' derived from a 'AccPrvKey'+-- and starting from an offset index.+extPrvKeys :: AccPrvKey -> KeyIndex -> [(AddrPrvKey,KeyIndex)]+extPrvKeys a i = mapMaybe f $ cycleIndex i+    where f j = liftM2 (,) (extPrvKey a j) (return j)++-- | Cyclic list of all valid external 'AddrPubKey' derived from a 'AccPubKey'+-- and starting from an offset index.+extPubKeys :: AccPubKey -> KeyIndex -> [(AddrPubKey,KeyIndex)]+extPubKeys a i = mapMaybe f $ cycleIndex i+    where f j = liftM2 (,) (extPubKey a j) (return j)++-- | Cyclic list of all internal 'AddrPrvKey' derived from a 'AccPrvKey' and+-- starting from an offset index.+intPrvKeys :: AccPrvKey -> KeyIndex -> [(AddrPrvKey,KeyIndex)]+intPrvKeys a i = mapMaybe f $ cycleIndex i+    where f j = liftM2 (,) (intPrvKey a j) (return j)++-- | Cyclic list of all internal 'AddrPubKey' derived from a 'AccPubKey' and+-- starting from an offset index.+intPubKeys :: AccPubKey -> KeyIndex -> [(AddrPubKey,KeyIndex)]+intPubKeys a i = mapMaybe f $ cycleIndex i+    where f j = liftM2 (,) (intPubKey a j) (return j)++{- Generate addresses -}++-- | Computes an 'Address' from an 'AddrPubKey'.+addr :: AddrPubKey -> Address+addr = xPubAddr . getAddrPubKey++-- | Computes an external base58 address from an 'AccPubKey' and a +-- derivation index.+extAddr :: AccPubKey -> KeyIndex -> Maybe String+extAddr a i = addrToBase58 . addr <$> extPubKey a i++-- | Computes an internal base58 addres from an 'AccPubKey' and a +-- derivation index.+intAddr :: AccPubKey -> KeyIndex -> Maybe String+intAddr a i = addrToBase58 . addr <$> intPubKey a i++-- | Cyclic list of all external base58 addresses derived from a 'AccPubKey'+-- and starting from an offset index.+extAddrs :: AccPubKey -> KeyIndex -> [(String,KeyIndex)]+extAddrs a i = mapMaybe f $ cycleIndex i+    where f j = liftM2 (,) (extAddr a j) (return j)++-- | Cyclic list of all internal base58 addresses derived from a 'AccPubKey'+-- and starting from an offset index.+intAddrs :: AccPubKey -> KeyIndex -> [(String,KeyIndex)]+intAddrs a i = mapMaybe f $ cycleIndex i+    where f j = liftM2 (,) (intAddr a j) (return j)++-- | Same as 'extAddrs' with the list reversed.+extAddrs' :: AccPubKey -> KeyIndex -> [(String,KeyIndex)]+extAddrs' a i = mapMaybe f $ cycleIndex' i+    where f j = liftM2 (,) (extAddr a j) (return j)++-- | Same as 'intAddrs' with the list reversed.+intAddrs' :: AccPubKey -> KeyIndex -> [(String,KeyIndex)]+intAddrs' a i = mapMaybe f $ cycleIndex' i+    where f j = liftM2 (,) (intAddr a j) (return j)++{- MultiSig -}++-- | Computes a list of external 'AddrPubKey' from an 'AccPubKey', a list+-- of thirdparty multisig keys and a derivation index. This is useful for +-- computing the public keys associated with a derivation index for+-- multisig accounts.+extMulSigKey :: AccPubKey -> [XPubKey] -> KeyIndex -> Maybe [AddrPubKey]+extMulSigKey a ps i = (map AddrPubKey) <$> mulSigSubKey keys i+    where keys = map (fromJust . (flip pubSubKey 0)) $ (getAccPubKey a) : ps++-- | Computes a list of internal 'AddrPubKey' from an 'AccPubKey', a list+-- of thirdparty multisig keys and a derivation index. This is useful for +-- computing the public keys associated with a derivation index for+-- multisig accounts.+intMulSigKey :: AccPubKey -> [XPubKey] -> KeyIndex -> Maybe [AddrPubKey]+intMulSigKey a ps i = (map AddrPubKey) <$> mulSigSubKey keys i+    where keys = map (fromJust . (flip pubSubKey 1)) $ (getAccPubKey a) : ps++-- | Cyclic list of all external multisignature 'AddrPubKey' derivations +-- starting from an offset index.+extMulSigKeys :: AccPubKey -> [XPubKey] -> KeyIndex -> [([AddrPubKey],KeyIndex)]+extMulSigKeys a ps i = mapMaybe f $ cycleIndex i+    where f j = liftM2 (,) (extMulSigKey a ps j) (return j)++-- | Cyclic list of all internal multisignature 'AddrPubKey' derivations+-- starting from an offset index.+intMulSigKeys :: AccPubKey -> [XPubKey] -> KeyIndex -> [([AddrPubKey],KeyIndex)]+intMulSigKeys a ps i = mapMaybe f $ cycleIndex i+    where f j = liftM2 (,) (intMulSigKey a ps j) (return j)++-- | Computes an external base58 multisig address from an 'AccPubKey', a+-- list of thirdparty multisig keys and a derivation index.+extMulSigAddr :: AccPubKey -> [XPubKey] -> Int -> KeyIndex -> Maybe String+extMulSigAddr a ps r i = do+    xs <- (map (xPubKey . getAddrPubKey)) <$> extMulSigKey a ps i+    return $ addrToBase58 $ scriptAddr $ sortMulSig $ PayMulSig xs r++-- | Computes an internal base58 multisig address from an 'AccPubKey', a+-- list of thirdparty multisig keys and a derivation index.+intMulSigAddr :: AccPubKey -> [XPubKey] -> Int -> KeyIndex -> Maybe String+intMulSigAddr a ps r i = do+    xs <- (map (xPubKey . getAddrPubKey)) <$> intMulSigKey a ps i+    return $ addrToBase58 $ scriptAddr $ sortMulSig $ PayMulSig xs r++-- | Cyclic list of all external base58 multisig addresses derived from+-- an 'AccPubKey' and a list of thirdparty multisig keys. The list starts+-- at an offset index.+extMulSigAddrs :: AccPubKey -> [XPubKey] -> Int -> KeyIndex +              -> [(String,KeyIndex)]+extMulSigAddrs a ps r i = mapMaybe f $ cycleIndex i+    where f j = liftM2 (,) (extMulSigAddr a ps r j) (return j)++-- | Cyclic list of all internal base58 multisig addresses derived from+-- an 'AccPubKey' and a list of thirdparty multisig keys. The list starts+-- at an offset index.+intMulSigAddrs :: AccPubKey -> [XPubKey] -> Int -> KeyIndex +              -> [(String,KeyIndex)]+intMulSigAddrs a ps r i = mapMaybe f $ cycleIndex i+    where f j = liftM2 (,) (intMulSigAddr a ps r j) (return j)+
+ Network/Haskoin/Crypto/NumberTheory.hs view
@@ -0,0 +1,23 @@+module Network.Haskoin.Crypto.NumberTheory+( extendedModGCD+, mulInverse+) where++-- Extended euclidean algorithm+-- Calculates the multiplicative inverse modulo p+extendedModGCD :: Integer -> Integer -> Integer -> (Integer, Integer)+extendedModGCD a b p+    | b == 0 = (1,0)+    | otherwise = (t, (s - q*t) `mod` p)+  where +    (q,r) = quotRem a b+    (s,t) = extendedModGCD b r p++-- Find multiplicative inverse of a : a*s = 1 (mod p)+mulInverse :: Integer -> Integer -> Integer+mulInverse a p +    | a*s `mod` p == 1 = s+    | otherwise = error "No multiplicative inverse (mod p) for a"+  where +    (s,_) = extendedModGCD a p p+
+ Network/Haskoin/Crypto/Point.hs view
@@ -0,0 +1,147 @@+module Network.Haskoin.Crypto.Point+( Point( InfPoint )+, makePoint+, makeInfPoint+, getAffine, getX, getY+, validatePoint+, isInfPoint+, addPoint+, doublePoint+, mulPoint+, shamirsTrick+, curveB+, curveA+) where++import Data.Bits (shiftR)+import Control.Applicative ((<$>))++import Network.Haskoin.Crypto.Curve+import Network.Haskoin.Crypto.BigWord ++curveA :: FieldP+curveA = fromInteger integerA++curveB :: FieldP+curveB = fromInteger integerB++{-| +  Elliptic curves of the form y^2 = x^3 + 7 (mod p)+  Point on the elliptic curve in transformed Jacobian coordinates +  (X,Y,Z) such that (x,y) = (X/Z^2, Y/Z^3)+  InfPoint is the point at infinity+-}+data Point = Point !FieldP !FieldP !FieldP | InfPoint+    deriving (Show, Read)++instance Eq Point where+    InfPoint         == InfPoint         = True+    (Point x1 y1 z1) == (Point x2 y2 z2) = a == b && c == d+      where +        a = x1*z2 ^ (2 :: Int)+        b = x2*z1 ^ (2 :: Int)+        c = y1*z2 ^ (3 :: Int)+        d = y2*z1 ^ (3 :: Int)+    _                == _                = False++-- Create a new point from (x,y) coordinates.+-- Returns Nothing if the point doesn't lie on the curve+makePoint :: FieldP -> FieldP -> Maybe Point+makePoint x y+    | validatePoint point = Just point+    | otherwise = Nothing+  where +    point = Point x y 1++makeInfPoint :: Point+makeInfPoint = InfPoint++-- Get the original (x,y) coordinates from the Jacobian triple (X,Y,Z)+getAffine :: Point -> Maybe (FieldP, FieldP)+getAffine point = case point of+    InfPoint      -> Nothing+    (Point _ _ 0) -> Nothing+    (Point x y z) -> Just (x/z ^ (2 :: Int), y/z ^ (3 :: Int))++getX :: Point -> Maybe FieldP+getX point = fst <$> (getAffine point)++getY :: Point -> Maybe FieldP+getY point = snd <$> (getAffine point)++-- Section 3.2.2.1 http://www.secg.org/download/aid-780/sec1-v2.pdf+-- point 3.2.2.1.4 is not necessary as h=1+validatePoint :: Point -> Bool+validatePoint point = case getAffine point of+    -- 3.2.2.1.1 (check that point not equal to InfPoint)+    Nothing    -> False +    -- 3.2.2.1.2 (check that the point lies on the curve)+    Just (x,y) -> y ^ (2 :: Int) == x ^ (3 :: Int) + (curveA * x) + curveB++isInfPoint :: Point -> Bool+isInfPoint InfPoint      = True+isInfPoint (Point _ _ 0) = True+isInfPoint _             = False++-- Elliptic curve point addition+-- http://en.wikibooks.org/wiki/Cryptography/Prime_Curve/Jacobian_Coordinates+addPoint :: Point -> Point -> Point+addPoint InfPoint point = point+addPoint point InfPoint = point+addPoint p1@(Point x1 y1 z1) (Point x2 y2 z2)+    | u1 == u2 = if s1 == s2 then doublePoint p1 else InfPoint+    | otherwise = Point x3 y3 z3+  where +    u1 = x1*z2 ^ (2 :: Int)+    u2 = x2*z1 ^ (2 :: Int)+    s1 = y1*z2 ^ (3 :: Int)+    s2 = y2*z1 ^ (3 :: Int)+    h  = u2 - u1+    r  = s2 - s1+    x3 = r ^ (2 :: Int) - h ^ (3 :: Int) - 2*u1*h ^ (2 :: Int) +    y3 = r*(u1 * h ^ (2 :: Int) - x3) - s1 * h ^ (3 :: Int)+    z3 = h * z1 * z2++-- Elliptic curve point doubling +-- http://en.wikibooks.org/wiki/Cryptography/Prime_Curve/Jacobian_Coordinates+doublePoint :: Point -> Point+doublePoint InfPoint = InfPoint+doublePoint (Point x y z)+    | y == 0 = InfPoint+    | otherwise = Point x' y' z'+  where +    s  = 4*x*y ^ (2 :: Int)+    m  = 3*x ^ (2 :: Int) + curveA * z ^ (4 :: Int)+    x' = m ^ (2 :: Int) - 2*s+    y' = m*(s - x') - 8*y ^ (4 :: Int)+    z' = 2*y*z++-- Elliptic curve point multiplication+-- Double and add method (weak to side channel attacks)+-- http://en.wikipedia.org/wiki/Elliptic_curve_point_multiplication+mulPoint :: FieldN -> Point -> Point+mulPoint 0 _        = InfPoint+mulPoint 1 p        = p+mulPoint _ InfPoint = InfPoint+mulPoint n p +    | n == 0    = InfPoint+    | odd n     = addPoint p (mulPoint (n-1) p)+    | otherwise = mulPoint (n `shiftR` 1) (doublePoint p)++-- Efficiently compute r1*p1 + r2*p2+shamirsTrick :: FieldN -> Point -> FieldN -> Point -> Point+shamirsTrick r1 p1 r2 p2 = go r1 r2+  where +    q      = addPoint p1 p2+    go 0 0 = InfPoint+    go a b +        | ea && eb  = b2+        | ea        = addPoint b2 p2+        | eb        = addPoint b2 p1+        | otherwise = addPoint b2 q+      where +        b2 = doublePoint $ go (a `shiftR` 1) (b `shiftR` 1)+        ea = even a+        eb = even b++
+ Network/Haskoin/Protocol.hs view
@@ -0,0 +1,99 @@+{-|+  This package provides all of the basic types used for the Bitcoin +  networking protocol together with Data.Binary instances for efficiently+  serializing and de-serializing them. More information on the bitcoin protocol+  is available here: <http://en.bitcoin.it/wiki/Protocol_specification>+-}+module Network.Haskoin.Protocol+( +  -- * Blocks+  Block(..)+, BlockLocator+, GetBlocks(..)++  -- * Block Headers+, BlockHeader(..)+, GetHeaders(..)+, Headers(..)+, BlockHeaderCount+, blockid++  -- * Requesting data+, GetData(..)+, Inv(..)+, InvVector(..)+, InvType(..)+, NotFound(..)++  -- *Scripts+  -- | More informations on scripts is available here:+  -- <http://en.bitcoin.it/wiki/Script>+, Script(..)+, ScriptOp(..)+, PushDataType(..)+, opPushData+, getScriptOps+, putScriptOps+, decodeScriptOps+, encodeScriptOps++  -- *Transactions+, Tx(..)+, txid+, cbid+, CoinbaseTx(..)+, TxIn(..)+, TxOut(..)+, OutPoint(..)+, encodeTxid+, decodeTxid++  -- * Merkle trees and bloom filters+, MerkleBlock(..)++ -- * Bloom Filter+, BloomFlags(..)+, BloomFilter(..)+, FilterLoad(..)+, FilterAdd(..)++  -- * Network types+, VarInt(..)+, VarString(..)+, NetworkAddress(..)+, Addr(..)+, NetworkAddressTime+, Version(..)+, Ping(..)+, Pong(..)+, Alert(..)++  -- *Messages+, Message(..)+, MessageHeader(..)+, MessageCommand(..)+) where++import Network.Haskoin.Protocol.Message+import Network.Haskoin.Protocol.Addr+import Network.Haskoin.Protocol.Alert+import Network.Haskoin.Protocol.BlockHeader+import Network.Haskoin.Protocol.Block+import Network.Haskoin.Protocol.MerkleBlock+import Network.Haskoin.Protocol.GetBlocks+import Network.Haskoin.Protocol.GetData+import Network.Haskoin.Protocol.GetHeaders+import Network.Haskoin.Protocol.Headers+import Network.Haskoin.Protocol.Inv+import Network.Haskoin.Protocol.InvVector+import Network.Haskoin.Protocol.MessageHeader+import Network.Haskoin.Protocol.NetworkAddress+import Network.Haskoin.Protocol.NotFound+import Network.Haskoin.Protocol.Ping+import Network.Haskoin.Protocol.Script+import Network.Haskoin.Protocol.Tx+import Network.Haskoin.Protocol.VarInt+import Network.Haskoin.Protocol.VarString+import Network.Haskoin.Protocol.Version+import Network.Haskoin.Protocol.BloomFilter+
+ Network/Haskoin/Protocol/Addr.hs view
@@ -0,0 +1,39 @@+module Network.Haskoin.Protocol.Addr +( Addr(..)+, NetworkAddressTime +) where++import Control.Monad (liftM2, replicateM, forM_)+import Control.Applicative ((<$>))++import Data.Word (Word32)+import Data.Binary (Binary, get, put)+import Data.Binary.Get (getWord32le)+import Data.Binary.Put (putWord32le)++import Network.Haskoin.Protocol.VarInt+import Network.Haskoin.Protocol.NetworkAddress++-- | Network address with a timestamp+type NetworkAddressTime = (Word32, NetworkAddress)++-- | Provides information on known nodes in the bitcoin network. An 'Addr'+-- type is sent inside a 'Message' as a response to a 'GetAddr' message.+data Addr = +    Addr { +           -- List of addresses of other nodes on the network with timestamps.+           addrList :: ![NetworkAddressTime] +         } +    deriving (Eq, Show, Read)++instance Binary Addr where++    get = Addr <$> (repList =<< get)+      where +        repList (VarInt c) = replicateM (fromIntegral c) action+        action             = liftM2 (,) getWord32le get ++    put (Addr xs) = do+        put $ VarInt $ fromIntegral $ length xs+        forM_ xs $ \(a,b) -> (putWord32le a) >> (put b)+
+ Network/Haskoin/Protocol/Alert.hs view
@@ -0,0 +1,21 @@+module Network.Haskoin.Protocol.Alert ( Alert(..) ) where++import Control.Applicative ((<$>),(<*>))+import Data.Binary (Binary, get, put)+import Network.Haskoin.Protocol.VarString++-- | Data type describing signed messages that can be sent between bitcoin+-- nodes to display important notifications to end users about the health of+-- the network.+data Alert = +    Alert {+          -- | Alert payload. +            alertPayload   :: !VarString+          -- | ECDSA signature of the payload+          , alertSignature :: !VarString+          } deriving (Eq, Show, Read)++instance Binary Alert where+    get = Alert <$> get <*> get+    put (Alert p s) = put p >> put s+
+ Network/Haskoin/Protocol/Block.hs view
@@ -0,0 +1,38 @@+module Network.Haskoin.Protocol.Block (Block(..)) where++import Control.Monad (replicateM, forM_)++import Data.Binary (Binary, get, put)++import Network.Haskoin.Protocol.Tx+import Network.Haskoin.Protocol.VarInt+import Network.Haskoin.Protocol.BlockHeader++-- | Data type describing a block in the bitcoin protocol. Blocks are sent in+-- response to 'GetData' messages that are requesting information from a+-- block hash.+data Block = +    Block {+            -- | Header information for this block.+            blockHeader     :: !BlockHeader+            -- | Coinbase transaction of this block.+          , blockCoinbaseTx :: !CoinbaseTx+            -- | List of transactions pertaining to this block.+          , blockTxns       :: ![Tx]+          } deriving (Eq, Show)++instance Binary Block where++    get = do+        header     <- get+        (VarInt c) <- get+        cb         <- get+        txs        <- replicateM (fromIntegral (c-1)) get+        return $ Block header cb txs++    put (Block h cb txs) = do+        put h+        put $ VarInt $ fromIntegral $ (length txs) + 1+        put cb+        forM_ txs put+
+ Network/Haskoin/Protocol/BlockHeader.hs view
@@ -0,0 +1,63 @@+module Network.Haskoin.Protocol.BlockHeader +( BlockHeader(..) +, blockid+) where++import Control.Applicative ((<$>),(<*>))++import Data.Word (Word32)+import Data.Binary (Binary, get, put)+import Data.Binary.Get (getWord32le)+import Data.Binary.Put (putWord32le)++import Network.Haskoin.Crypto.Hash +import Network.Haskoin.Util ++-- | Data type recording information on a 'Block'. The hash of a block is+-- defined as the hash of this data structure. The block mining process+-- involves finding a partial hash collision by varying the nonce in the+-- 'BlockHeader' and/or additional randomness in the 'CoinbaseTx' of this+-- 'Block'. Variations in the 'CoinbaseTx' will result in different merkle +-- roots in the 'BlockHeader'.+data BlockHeader = +    BlockHeader {+                  -- | Block version information, based on the version of the+                  -- software creating this block.+                  blockVersion   :: !Word32+                  -- | Hash of the previous block (parent) referenced by this+                  -- block.+                , prevBlock      :: !Hash256+                  -- | Root of the merkle tree of all transactions pertaining+                  -- to this block.+                , merkleRoot     :: !Hash256+                  -- | Unix timestamp recording when this block was created+                , blockTimestamp :: !Word32+                  -- | The difficulty target being used for this block+                , blockBits      :: !Word32+                  -- | A random nonce used to generate this block. Additional+                  -- randomness is included in the coinbase transaction of+                  -- this block.+                , bhNonce        :: !Word32+                } deriving (Eq, Show, Read)++instance Binary BlockHeader where++    get = BlockHeader <$> getWord32le+                      <*> get+                      <*> get+                      <*> getWord32le+                      <*> getWord32le+                      <*> getWord32le++    put (BlockHeader v p m bt bb n) = do+        putWord32le v+        put         p+        put         m+        putWord32le bt+        putWord32le bb+        putWord32le n ++-- | Compute the hash of a block header+blockid :: BlockHeader -> Hash256+blockid = doubleHash256 . encode'+
+ Network/Haskoin/Protocol/BloomFilter.hs view
@@ -0,0 +1,101 @@+module Network.Haskoin.Protocol.BloomFilter +( BloomFlags(..)+, BloomFilter(..)+, FilterLoad(..)+, FilterAdd(..)+) where++import Control.Monad (replicateM, forM_)+import Control.Applicative ((<$>),(<*>))++import Data.Word (Word8, Word32)+import Data.Binary (Binary, get, put)+import Data.Binary.Get (getWord8, getWord32le, getByteString)+import Data.Binary.Put (putWord8, putWord32le, putByteString)+import qualified Data.Foldable as F (toList)+import qualified Data.Sequence as S (Seq, fromList, length)+import qualified Data.ByteString as BS (ByteString, length)++import Network.Haskoin.Protocol.VarInt++-- | The bloom flags are used to tell the remote peer how to auto-update+-- the provided bloom filter. +data BloomFlags+    = BloomUpdateNone         -- ^ Never update+    | BloomUpdateAll          -- ^ Auto-update on all outputs+    | BloomUpdateP2PubKeyOnly +    -- ^ Only auto-update on outputs that are pay-to-pubkey or pay-to-multisig.+    -- This is the default setting.+    deriving (Eq, Show, Read)++instance Binary BloomFlags where+    get = go =<< getWord8+      where+        go 0 = return BloomUpdateNone+        go 1 = return BloomUpdateAll+        go 2 = return BloomUpdateP2PubKeyOnly+        go _ = fail "BloomFlags get: Invalid bloom flag"++    put f = putWord8 $ case f of+        BloomUpdateNone         -> 0+        BloomUpdateAll          -> 1+        BloomUpdateP2PubKeyOnly -> 2+            +-- | A bloom filter is a probabilistic data structure that SPV clients send to+-- other peers to filter the set of transactions received from them. Bloom+-- filters are probabilistic and have a false positive rate. Some transactions+-- that pass the filter may not be relevant to the receiving peer. By+-- controlling the false positive rate, SPV nodes can trade off bandwidth+-- versus privacy.+data BloomFilter = BloomFilter+    { bloomData      :: S.Seq Word8 -- ^ Bloom filter data+    , bloomFull      :: Bool        +    -- ^ Flag indicating if the filter is full ('bloomData' is all 0x00)+    , bloomEmpty     :: Bool+    -- ^ Flag indicating if the filter is empty ('bloomData' is all 0xff)+    , bloomHashFuncs :: Word32     -- ^ Number of hash functions for this filter+    , bloomTweak     :: Word32     -- ^ Hash function random nonce+    , bloomFlags     :: BloomFlags -- ^ Bloom filter auto-update flags+    }+    deriving (Eq, Show, Read)++instance Binary BloomFilter where++    get = BloomFilter <$> (S.fromList <$> (readDat =<< get))+                      <*> (return False) <*> (return False)+                      <*> getWord32le <*> getWord32le+                      <*> get+      where+        readDat (VarInt len) = replicateM (fromIntegral len) getWord8   ++    put (BloomFilter dat _ _ hashFuncs tweak flags) = do+        put $ VarInt $ fromIntegral $ S.length dat+        forM_ (F.toList dat) putWord8+        putWord32le hashFuncs+        putWord32le tweak+        put flags++-- | Set a new bloom filter on the peer connection.+newtype FilterLoad = FilterLoad { getBloomFilter :: BloomFilter }+    deriving (Eq, Show, Read)++instance Binary FilterLoad where+    get = FilterLoad <$> get+    put (FilterLoad f) = put f++-- | Add the given data element to the connections current filter without+-- requiring a completely new one to be set.+newtype FilterAdd = FilterAdd { getFilterData :: BS.ByteString }+    deriving (Eq, Show, Read)++instance Binary FilterAdd where+    get = do+        (VarInt len) <- get+        dat <- getByteString $ fromIntegral len+        return $ FilterAdd dat++    put (FilterAdd bs) = do+        put $ VarInt $ fromIntegral $ BS.length bs+        putByteString bs++
+ Network/Haskoin/Protocol/GetBlocks.hs view
@@ -0,0 +1,53 @@+module Network.Haskoin.Protocol.GetBlocks +( GetBlocks(..) +, BlockLocator+) where++import Control.Monad (replicateM, forM_)+import Control.Applicative ((<$>),(<*>))++import Data.Word (Word32)+import Data.Binary (Binary, get, put)+import Data.Binary.Get (getWord32le)+import Data.Binary.Put (putWord32le)++import Network.Haskoin.Protocol.VarInt+import Network.Haskoin.Crypto.Hash ++type BlockLocator = [Hash256]++-- | Data type representing a GetBlocks message request. It is used in the+-- bitcoin protocol to retrieve blocks from a peer by providing it a+-- 'BlockLocator' object. The 'BlockLocator' is a sparse list of block hashes+-- from the caller node with the purpose of informing the receiving node+-- about the state of the caller's blockchain. The receiver node will detect+-- a wrong branch in the caller's main chain and send the caller appropriate +-- 'Blocks'. The response to a 'GetBlocks' message is an 'Inv' message+-- containing the list of block hashes pertaining to the request. +data GetBlocks = +    GetBlocks {+                -- | The protocol version+                getBlocksVersion  :: !Word32+                -- | Block locator object. It is a list of block hashes from the+                -- most recent block back to the genesis block. The list is+                -- dense at first and sparse towards the end.+              , getBlocksLocator  :: !BlockLocator+                -- | Hash of the last desired block. If set to zero, the+                -- maximum number of block hashes is returned (500).+              , getBlocksHashStop :: !Hash256+              } deriving (Eq, Show, Read)++instance Binary GetBlocks where++    get = GetBlocks <$> getWord32le+                    <*> (repList =<< get)+                    <*> get+      where +        repList (VarInt c) = replicateM (fromIntegral c) get++    put (GetBlocks v xs h) = do+        putWord32le v+        put $ VarInt $ fromIntegral $ length xs+        forM_ xs put+        put h+
+ Network/Haskoin/Protocol/GetData.hs view
@@ -0,0 +1,34 @@+module Network.Haskoin.Protocol.GetData ( GetData(..) ) where++import Control.Monad (replicateM, forM_)+import Control.Applicative ((<$>))++import Data.Binary (Binary, get, put)++import Network.Haskoin.Protocol.InvVector+import Network.Haskoin.Protocol.VarInt++-- | The 'GetData' type is used to retrieve information on a specific object+-- ('Block' or 'Tx') identified by the objects hash. The payload of a 'GetData'+-- request is a list of 'InvVector' which represent all the hashes for which a+-- node wants to request information. The response to a 'GetBlock' message+-- wille be either a 'Block' or a 'Tx' message depending on the type of the+-- object referenced by the hash. Usually, 'GetData' messages are sent after a+-- node receives an 'Inv' message to obtain information on unknown object+-- hashes. +data GetData = +    GetData {+              -- | List of object hashes +              getDataList :: ![InvVector] +            } deriving (Eq, Show, Read)++instance Binary GetData where++    get = GetData <$> (repList =<< get)+      where +        repList (VarInt c) = replicateM (fromIntegral c) get++    put (GetData xs) = do+        put $ VarInt $ fromIntegral $ length xs+        forM_ xs put+
+ Network/Haskoin/Protocol/GetHeaders.hs view
@@ -0,0 +1,46 @@+module Network.Haskoin.Protocol.GetHeaders ( GetHeaders(..) ) where++import Control.Monad (replicateM, forM_)+import Control.Applicative ((<$>),(<*>))++import Data.Word (Word32)+import Data.Binary (Binary, get, put)+import Data.Binary.Get (getWord32le)+import Data.Binary.Put (putWord32le)++import Network.Haskoin.Protocol.VarInt+import Network.Haskoin.Protocol.GetBlocks +import Network.Haskoin.Crypto.Hash ++-- | Similar to the 'GetBlocks' message type but for retrieving block headers+-- only. The response to a 'GetHeaders' request is a 'Headers' message+-- containing a list of block headers pertaining to the request. A maximum of+-- 2000 block headers can be returned. 'GetHeaders' is used by thin (SPV)+-- clients to exclude block contents when synchronizing the blockchain.+data GetHeaders = +    GetHeaders {+                 -- | The protocol version+                 getHeadersVersion  :: !Word32+                 -- | Block locator object. It is a list of block hashes from+                 -- the most recent block back to the Genesis block. The list+                 -- is dense at first and sparse towards the end.+               , getHeadersBL       :: !BlockLocator+                 -- | Hash of the last desired block header. When set to zero,+                 -- the maximum number of block headers is returned (2000)+               , getHeadersHashStop :: !Hash256+               } deriving (Eq, Show, Read)++instance Binary GetHeaders where++    get = GetHeaders <$> getWord32le+                     <*> (repList =<< get)+                     <*> get+      where +        repList (VarInt c) = replicateM (fromIntegral c) get++    put (GetHeaders v xs h) = do+        putWord32le v+        put $ VarInt $ fromIntegral $ length xs+        forM_ xs put+        put h+
+ Network/Haskoin/Protocol/Headers.hs view
@@ -0,0 +1,36 @@+module Network.Haskoin.Protocol.Headers +( Headers(..)+, BlockHeaderCount+) where++import Control.Monad (liftM2, replicateM, forM_)+import Control.Applicative ((<$>))++import Data.Binary (Binary, get, put)++import Network.Haskoin.Protocol.VarInt+import Network.Haskoin.Protocol.BlockHeader++-- | 'BlockHeader' type with a transaction count as 'VarInt'+type BlockHeaderCount = (BlockHeader, VarInt)++-- | The 'Headers' type is used to return a list of block headers in+-- response to a 'GetHeaders' message.+data Headers = +    Headers { +              -- | List of block headers with respective transaction counts+              headersList :: ![BlockHeaderCount] +            } +    deriving (Eq, Show, Read)++instance Binary Headers where++    get = Headers <$> (repList =<< get)+      where +        repList (VarInt c) = replicateM (fromIntegral c) action+        action = liftM2 (,) get get++    put (Headers xs) = do+        put $ VarInt $ fromIntegral $ length xs+        forM_ xs $ \(a,b) -> put a >> put b+
+ Network/Haskoin/Protocol/Inv.hs view
@@ -0,0 +1,29 @@+module Network.Haskoin.Protocol.Inv ( Inv(..) ) where++import Control.Monad (replicateM, forM_)+import Control.Applicative ((<$>))++import Data.Binary (Binary, get, put)++import Network.Haskoin.Protocol.InvVector+import Network.Haskoin.Protocol.VarInt++-- | 'Inv' messages are used by nodes to advertise their knowledge of new+-- objects by publishing a list of hashes. 'Inv' messages can be sent+-- unsolicited or in response to a 'GetBlocks' message.+data Inv = +    Inv { +        -- | Inventory vectors+          invList :: ![InvVector] +        } deriving (Eq, Show, Read)++instance Binary Inv where++    get = Inv <$> (repList =<< get)+      where +        repList (VarInt c) = replicateM (fromIntegral c) get++    put (Inv xs) = do+        put $ VarInt $ fromIntegral $ length xs+        forM_ xs put+
+ Network/Haskoin/Protocol/InvVector.hs view
@@ -0,0 +1,54 @@+module Network.Haskoin.Protocol.InvVector +( InvVector(..) +, InvType(..)+) where++import Control.Applicative ((<$>),(<*>))++import Data.Binary (Binary, get, put)+import Data.Binary.Get (getWord32le)+import Data.Binary.Put (putWord32le)++import Network.Haskoin.Crypto.Hash ++-- | Data type identifying the type of an inventory vector. +data InvType +    = InvError -- ^ Error. Data containing this type can be ignored.+    | InvTx    -- ^ InvVector hash is related to a transaction +    | InvBlock -- ^ InvVector hash is related to a block+    | InvMerkleBlock -- ^ InvVector has is related to a merkle block+    deriving (Eq, Show, Read)++instance Binary InvType where++    get = go =<< getWord32le+      where +        go x = case x of+            0 -> return InvError+            1 -> return InvTx+            2 -> return InvBlock+            3 -> return InvMerkleBlock+            _ -> fail "bitcoinGet InvType: Invalid Type"++    put x = putWord32le $ case x of+                InvError       -> 0+                InvTx          -> 1+                InvBlock       -> 2+                InvMerkleBlock -> 3++-- | Invectory vectors represent hashes identifying objects such as a 'Block'+-- or a 'Tx'. They are sent inside messages to notify other peers about +-- new data or data they have requested.+data InvVector = +    InvVector {+                -- | Type of the object referenced by this inventory vector+                invType :: !InvType+                -- | Hash of the object referenced by this inventory vector+              , invHash :: !Hash256+              } deriving (Eq, Show, Read)++instance Binary InvVector where+    get = InvVector <$> get <*> get+    put (InvVector t h) = put t >> put h++
+ Network/Haskoin/Protocol/MerkleBlock.hs view
@@ -0,0 +1,67 @@+module Network.Haskoin.Protocol.MerkleBlock (MerkleBlock(..)) where++import Control.Monad (replicateM, forM_)++import Data.Word (Word8, Word32)+import Data.Bits (testBit, setBit)+import Data.Binary (Binary, get, put)+import Data.Binary.Get (getWord8, getWord32le)+import Data.Binary.Put (putWord8, putWord32le)++import Network.Haskoin.Protocol.VarInt+import Network.Haskoin.Protocol.BlockHeader+import Network.Haskoin.Crypto.Hash ++data MerkleBlock = +    MerkleBlock {+                -- | Header information for this merkle block.+                  merkleHeader :: !BlockHeader+                -- | Number of transactions in the block (including+                -- unmatched transactions).+                , merkleTotalTxns :: !Word32+                  -- | Hashes in depth-first order. They are used to rebuild a+                  -- partial merkle tree.+                , mHashes     :: [Hash256]+                  -- | Flag bits, packed per 8 in a byte. Least significant bit+                  -- first. Flag bits are used to rebuild a partial merkle+                  -- tree.+                , mFlags      :: [Bool]+                } deriving (Eq, Show, Read)++instance Binary MerkleBlock where++    get = do+        header <- get+        ntx    <- getWord32le+        (VarInt matchLen) <- get+        hashes <- replicateM (fromIntegral matchLen) get+        (VarInt flagLen)  <- get+        ws <- replicateM (fromIntegral flagLen) getWord8+        return $ MerkleBlock header ntx hashes (decodeMerkleFlags ws)++    put (MerkleBlock h ntx hashes flags) = do+        put h+        putWord32le ntx+        put $ VarInt $ fromIntegral $ length hashes+        forM_ hashes put+        let ws = encodeMerkleFlags flags+        put $ VarInt $ fromIntegral $ length ws+        forM_ ws putWord8++decodeMerkleFlags :: [Word8] -> [Bool]+decodeMerkleFlags ws = +    [ b | p <- [0..(length ws)*8-1]+    , b <- [testBit (ws !! (p `div` 8)) (p `mod` 8)]+    ]++encodeMerkleFlags :: [Bool] -> [Word8]+encodeMerkleFlags bs = map boolsToWord8 $ splitIn 8 bs+    +splitIn :: Int -> [a] -> [[a]]+splitIn _ [] = []+splitIn c xs = take c xs : (splitIn c $ drop c xs)+ +boolsToWord8 :: [Bool] -> Word8+boolsToWord8 [] = 0+boolsToWord8 xs = foldl setBit 0 (map snd $ filter fst $ zip xs [0..7])+
+ Network/Haskoin/Protocol/Message.hs view
@@ -0,0 +1,120 @@+module Network.Haskoin.Protocol.Message ( Message(..) ) where++import Control.Monad (unless)+import Control.Applicative ((<$>))++import Data.Binary (Binary, get, put)+import Data.Binary.Get +    ( lookAhead+    , getByteString+    )+import Data.Binary.Put (putByteString)+import qualified Data.ByteString as BS +    ( length +    , append+    , empty+    )++import Network.Haskoin.Protocol.MessageHeader+import Network.Haskoin.Protocol.Version+import Network.Haskoin.Protocol.Addr+import Network.Haskoin.Protocol.Inv+import Network.Haskoin.Protocol.GetData+import Network.Haskoin.Protocol.NotFound+import Network.Haskoin.Protocol.GetBlocks+import Network.Haskoin.Protocol.GetHeaders+import Network.Haskoin.Protocol.Tx+import Network.Haskoin.Protocol.Block+import Network.Haskoin.Protocol.Headers+import Network.Haskoin.Protocol.BloomFilter+import Network.Haskoin.Protocol.Ping+import Network.Haskoin.Protocol.Alert++import Network.Haskoin.Util +import Network.Haskoin.Crypto.Hash ++-- | The 'Message' type is used to identify all the valid messages that can be+-- sent between bitcoin peers. Only values of type 'Message' will be accepted+-- by other bitcoin peers as bitcoin protocol messages need to be correctly+-- serialized with message headers. Serializing a 'Message' value will+-- include the 'MessageHeader' with the correct checksum value automatically.+-- No need to add the 'MessageHeader' separately.+data Message +    = MVersion Version +    | MVerAck +    | MAddr Addr +    | MInv Inv +    | MGetData GetData +    | MNotFound NotFound +    | MGetBlocks GetBlocks +    | MGetHeaders GetHeaders +    | MTx Tx +    | MBlock Block +    | MHeaders Headers +    | MGetAddr +    | MFilterLoad FilterLoad+    | MFilterAdd FilterAdd+    | MFilterClear+    | MPing Ping +    | MPong Pong +    | MAlert Alert+    deriving (Eq, Show)++instance Binary 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 (chksum32 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+                MCHeaders     -> MHeaders <$> get+                MCFilterLoad  -> MFilterLoad <$> get+                MCFilterAdd   -> MFilterAdd <$> get+                MCPing        -> MPing <$> get+                MCPong        -> MPong <$> get+                MCAlert       -> MAlert <$> get+                _             -> fail $ "get: Invalid command " ++ (show cmd)+            else case cmd of+                MCGetAddr     -> return MGetAddr +                MCVerAck      -> return MVerAck+                MCFilterClear -> return MFilterClear+                _             -> 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)+                (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)+            chk = chksum32 payload+            len = fromIntegral $ BS.length payload+            header = MessageHeader networkMagic cmd len chk+        putByteString $ (encode' header) `BS.append` payload+
+ Network/Haskoin/Protocol/MessageHeader.hs view
@@ -0,0 +1,134 @@+module Network.Haskoin.Protocol.MessageHeader +    ( MessageHeader(..) +    , MessageCommand(..)+    ) where++import Control.Applicative ((<$>),(<*>))++import Data.Word (Word32)+import qualified Data.ByteString as BS +    ( ByteString+    , takeWhile+    )+import Data.Binary (Binary, get, put)+import Data.Binary.Get +    ( getWord32le+    , getWord32be+    , getByteString+    )+import Data.Binary.Put +    ( putWord32le+    , putWord32be+    , putByteString+    )++import Network.Haskoin.Util (stringToBS, bsToString)+import Network.Haskoin.Crypto.Hash (CheckSum32)++-- | A 'MessageCommand' is included in a 'MessageHeader' in order to identify+-- the type of message present in the payload. This allows the message +-- de-serialization code to know how to decode a particular message payload.+-- Every valid 'Message' constructor has a corresponding 'MessageCommand'+-- constructor.+data MessageCommand +    = MCVersion +    | MCVerAck +    | MCAddr +    | MCInv +    | MCGetData +    | MCNotFound +    | MCGetBlocks +    | MCGetHeaders +    | MCTx +    | MCBlock +    | MCHeaders +    | MCGetAddr +    | MCFilterLoad+    | MCFilterAdd+    | MCFilterClear+    | MCPing +    | MCPong +    | MCAlert+    deriving (Eq, Show, Read)++instance Binary MessageCommand where+    +    get = go =<< getByteString 12+      where +        go bs = case unpackCommand bs of+            "version"     -> return MCVersion+            "verack"      -> return MCVerAck+            "addr"        -> return MCAddr+            "inv"         -> return MCInv+            "getdata"     -> return MCGetData+            "notfound"    -> return MCNotFound+            "getblocks"   -> return MCGetBlocks+            "getheaders"  -> return MCGetHeaders+            "tx"          -> return MCTx+            "block"       -> return MCBlock+            "headers"     -> return MCHeaders+            "getaddr"     -> return MCGetAddr+            "filterload"  -> return MCFilterLoad+            "filteradd"   -> return MCFilterAdd+            "filterclear" -> return MCFilterClear+            "ping"        -> return MCPing+            "pong"        -> return MCPong+            "alert"       -> return MCAlert+            _             -> fail "get MessageCommand : Invalid command"++    put mc = putByteString $ packCommand $ case mc of+        MCVersion     -> "version"+        MCVerAck      -> "verack"+        MCAddr        -> "addr"+        MCInv         -> "inv"+        MCGetData     -> "getdata"+        MCNotFound    -> "notfound"+        MCGetBlocks   -> "getblocks"+        MCGetHeaders  -> "getheaders"+        MCTx          -> "tx"+        MCBlock       -> "block"+        MCHeaders     -> "headers"+        MCGetAddr     -> "getaddr"+        MCFilterLoad  -> "filterload"+        MCFilterAdd   -> "filteradd"+        MCFilterClear -> "filterclear"+        MCPing        -> "ping"+        MCPong        -> "pong"+        MCAlert       -> "alert"++packCommand :: String -> BS.ByteString+packCommand s = stringToBS $ take 12 $ s ++ repeat '\NUL'++unpackCommand :: BS.ByteString -> String+unpackCommand bs = bsToString $ BS.takeWhile (/= 0) bs++-- | Data type representing the header of a 'Message'. All messages sent between+-- nodes contain a message header.+data MessageHeader = +    MessageHeader {+                  -- | Network magic bytes. It is used to differentiate +                  -- messages meant for different bitcoin networks, such as+                  -- prodnet and testnet.+                    headMagic       :: !Word32+                  -- | Message command identifying the type of message.+                  -- included in the payload.+                  , headCmd         :: !MessageCommand+                  -- | Byte length of the payload.+                  , headPayloadSize :: !Word32+                  -- | Checksum of the payload. +                  , headChecksum    :: !CheckSum32+                  } deriving (Eq, Show, Read)++instance Binary MessageHeader where++    get = MessageHeader <$> getWord32be+                        <*> get+                        <*> getWord32le+                        <*> get++    put (MessageHeader m c l chk) = do+        putWord32be m+        put         c+        putWord32le l+        put         chk+
+ Network/Haskoin/Protocol/NetworkAddress.hs view
@@ -0,0 +1,45 @@+module Network.Haskoin.Protocol.NetworkAddress ( NetworkAddress(..) ) where++import Control.Monad (liftM2)+import Control.Applicative ((<$>),(<*>))++import Data.Word (Word16, Word64)+import Data.Binary (Binary, get, put)+import Data.Binary.Get +    ( getWord16be+    , getWord64le+    , getWord64be+    )+import Data.Binary.Put+    ( putWord16be+    , putWord64le+    , putWord64be+    )++-- | Data type describing a bitcoin network address. Addresses are stored in+-- IPv6. IPv4 addresses are mapped to IPv6 using IPv4 mapped IPv6 addresses:+-- <http://en.wikipedia.org/wiki/IPv6#IPv4-mapped_IPv6_addresses>. Sometimes,+-- timestamps are sent together with the 'NetworkAddress' such as in the 'Addr'+-- data type.+data NetworkAddress = +    NetworkAddress {+                   -- | Bitmask of services available for this address+                     naServices :: !Word64+                   -- | IPv6 address serialized as big endian+                   , naAddress  :: !(Word64, Word64)+                   -- | Port number serialized as big endian+                   , naPort     :: !Word16+                   } deriving (Eq, Show, Read)++instance Binary NetworkAddress where++    get = NetworkAddress <$> getWord64le+                         <*> (liftM2 (,) getWord64be getWord64be)+                         <*> getWord16be++    put (NetworkAddress s (al,ar) p) = do+        putWord64le s+        putWord64be al+        putWord64be ar+        putWord16be p+
+ Network/Haskoin/Protocol/NotFound.hs view
@@ -0,0 +1,30 @@+module Network.Haskoin.Protocol.NotFound ( NotFound(..) ) where++import Control.Monad (replicateM, forM_)+import Control.Applicative ((<$>))++import Data.Binary (Binary, get, put)++import Network.Haskoin.Protocol.VarInt+import Network.Haskoin.Protocol.InvVector++-- | A 'NotFound' message is returned as a response to a 'GetData' message+-- whe one of the requested objects could not be retrieved. This could happen,+-- for example, if a tranasaction was requested and was not available in the+-- memory pool of the receiving node.+data NotFound = +    NotFound {+             -- | Inventory vectors related to this request+               notFoundList :: ![InvVector] +             } deriving (Eq, Show, Read)++instance Binary NotFound where++    get = NotFound <$> (repList =<< get)+      where +        repList (VarInt c) = replicateM (fromIntegral c) get++    put (NotFound xs) = do+        put $ VarInt $ fromIntegral $ length xs+        forM_ xs put+
+ Network/Haskoin/Protocol/Ping.hs view
@@ -0,0 +1,37 @@+module Network.Haskoin.Protocol.Ping+( Ping(..)+, Pong(..)+) where++import Control.Applicative ((<$>))++import Data.Word (Word64)+import Data.Binary (Binary, get, put)+import Data.Binary.Get (getWord64le)+import Data.Binary.Put (putWord64le)++-- | A Ping message is sent to bitcoin peers to check if a TCP\/IP connection+-- is still valid.+newtype Ping = +    Ping { +           -- | A random nonce used to identify the recipient of the ping+           -- request once a Pong response is received.  +           pingNonce :: Word64 +         } deriving (Eq, Show, Read)++-- | A Pong message is sent as a response to a ping message.+newtype Pong = +    Pong { +           -- | When responding to a Ping request, the nonce from the Ping+           -- is copied in the Pong response.+           pongNonce :: Word64 +         } deriving (Eq, Show, Read)++instance Binary Ping where+    get = Ping <$> getWord64le+    put (Ping n) = putWord64le n++instance Binary Pong where+    get = Pong <$> getWord64le+    put (Pong n) = putWord64le n+
+ Network/Haskoin/Protocol/Script.hs view
@@ -0,0 +1,252 @@+module Network.Haskoin.Protocol.Script +( ScriptOp(..)+, Script(..)+, PushDataType(..)+, opPushData+, getScriptOps+, putScriptOps+, decodeScriptOps+, encodeScriptOps+) where++import Control.Monad (liftM2, unless, when)+import Control.Applicative ((<$>))++import Data.Word (Word8)+import Data.Binary (Binary, get, put)+import Data.Binary.Get +    ( Get+    , isEmpty+    , getWord8+    , getWord16le+    , getWord32le+    , getByteString+    )+import Data.Binary.Put +    ( Put +    , putWord8+    , putWord16le+    , putWord32le+    , putByteString+    )+import qualified Data.ByteString as BS+    ( ByteString+    , length+    )++import Network.Haskoin.Protocol.VarInt+import Network.Haskoin.Crypto.Keys +import Network.Haskoin.Util ++-- | Data type representing a transaction script. Scripts are defined as lists+-- of script operators 'ScriptOp'. Scripts are used to:+--+-- * Define the spending conditions in the output of a transaction+--+-- * Provide the spending signatures in the input of a transaction+data Script = +    Script { +             -- | List of script operators defining this script+             scriptOps :: [ScriptOp] +           }+    deriving (Eq, Show, Read)++instance Binary Script where+    get = do+        (VarInt len) <- get+        isolate (fromIntegral len) $ Script <$> getScriptOps++    put (Script ops) = do+        let bs = runPut' $ putScriptOps ops+        put $ VarInt $ fromIntegral $ BS.length bs+        putByteString bs++-- | Deserialize a list of 'ScriptOp' inside the 'Data.Binary.Get' monad.+-- This deserialization does not take into account the length of the script.+getScriptOps :: Get [ScriptOp]+getScriptOps = do+    empty <- isEmpty+    if empty +        then return [] +        else liftM2 (:) get getScriptOps++-- | Serialize a list of 'ScriptOp' inside the 'Data.Binary.Put' monad.+-- This serialization does not take into account the length of the script.+putScriptOps :: [ScriptOp] -> Put+putScriptOps (x:xs) = put x >> putScriptOps xs+putScriptOps _       = return ()++-- | Decode a 'Script' from a ByteString by omiting the length of the script.+-- This is used to produce scripthash addresses.+decodeScriptOps :: BS.ByteString -> Either String Script+decodeScriptOps bs = fromRunGet getScriptOps bs msg (return . Script)+  where +    msg = Left "decodeScriptOps: Could not decode scriptops"++-- | Encode a 'Script' into a ByteString by omiting the length of the script.+-- This is used to produce scripthash addresses.+encodeScriptOps :: Script -> BS.ByteString+encodeScriptOps = runPut' . putScriptOps . scriptOps++-- | Data type representing the type of an OP_PUSHDATA opcode.+data PushDataType+    = +      -- | The next opcode bytes is data to be pushed onto the stack+      OPCODE +      -- | The next byte contains the number of bytes to be pushed onto+      -- the stack+    | OPDATA1 +      -- | The next two bytes contains the number of bytes to be pushed onto+      -- the stack+    | OPDATA2+      -- | The next four bytes contains the number of bytes to be pushed onto+      -- the stack+    | OPDATA4+    deriving (Show, Read, Eq)++-- | Data type representing all of the operators allowed inside a 'Script'.+data ScriptOp +      -- Pushing Data+    = OP_PUSHDATA BS.ByteString PushDataType +    | OP_0 +    | OP_1NEGATE +    | OP_1  | OP_2  | OP_3  | OP_4  +    | OP_5  | OP_6  | OP_7  | OP_8  +    | OP_9  | OP_10 | OP_11 | OP_12 +    | OP_13 | OP_14 | OP_15 | OP_16 ++      -- Flow control+    | OP_VERIFY ++      -- Stack operations+    | OP_DUP ++      -- Bitwise logic+    | OP_EQUAL +    | OP_EQUALVERIFY ++      -- Crypto+    | OP_HASH160 +    | OP_CHECKSIG +    | OP_CHECKMULTISIG ++      -- Other+    | OP_PUBKEY PubKey +    | OP_INVALIDOPCODE Word8+        deriving (Show, Read, Eq)++instance Binary ScriptOp where++    get = go =<< (fromIntegral <$> getWord8) +      where +        go op +            | op == 0x00 = return $ OP_0+            | op <= 0x4b = do+                payload <- getByteString (fromIntegral op)+                return $ OP_PUSHDATA payload OPCODE+            | op == 0x4c = do+                len  <- getWord8+                payload <- getByteString (fromIntegral len)+                return $ OP_PUSHDATA payload OPDATA1+            | op == 0x4d = do+                len  <- getWord16le+                payload <- getByteString (fromIntegral len)+                return $ OP_PUSHDATA payload OPDATA2+            | op == 0x4e = do+                len  <- getWord32le+                payload <- getByteString (fromIntegral len)+                return $ OP_PUSHDATA payload OPDATA4+            | op == 0x4f = return $ OP_1NEGATE+            | op == 0x51 = return $ OP_1+            | op == 0x52 = return $ OP_2+            | op == 0x53 = return $ OP_3+            | op == 0x54 = return $ OP_4+            | op == 0x55 = return $ OP_5+            | op == 0x56 = return $ OP_6+            | op == 0x57 = return $ OP_7+            | op == 0x58 = return $ OP_8+            | op == 0x59 = return $ OP_9+            | op == 0x5a = return $ OP_10+            | op == 0x5b = return $ OP_11+            | op == 0x5c = return $ OP_12+            | op == 0x5d = return $ OP_13+            | op == 0x5e = return $ OP_14+            | op == 0x5f = return $ OP_15+            | op == 0x60 = return $ OP_16+            | op == 0x69 = return $ OP_VERIFY+            | op == 0x76 = return $ OP_DUP+            | op == 0x87 = return $ OP_EQUAL+            | op == 0x88 = return $ OP_EQUALVERIFY+            | op == 0xa9 = return $ OP_HASH160+            | op == 0xac = return $ OP_CHECKSIG+            | op == 0xae = return $ OP_CHECKMULTISIG+            | op == 0xfe = OP_PUBKEY <$> get+            | otherwise = return $ OP_INVALIDOPCODE op++    put op = case op of++        (OP_PUSHDATA payload optype)-> do+            let len = BS.length payload+            when (len == 0) $ fail "OP_PUSHDATA: Payload size must be > 0"+            case optype of+                OPCODE -> do+                    unless (len <= 0x4b) $ fail +                        "OP_PUSHDATA OPCODE: Payload size too big"+                    putWord8 $ fromIntegral len+                OPDATA1 -> do+                    unless (len <= 0xff) $ fail +                        "OP_PUSHDATA OPDATA1: Payload size too big"+                    putWord8 0x4c+                    putWord8 $ fromIntegral len+                OPDATA2 -> do+                    unless (len <= 0xffff) $ fail +                        "OP_PUSHDATA OPDATA2: Payload size too big"+                    putWord8 0x4d+                    putWord16le $ fromIntegral len+                OPDATA4 -> do+                    unless (len <= 0xffffffff) $ fail +                        "OP_PUSHDATA OPDATA4: Payload size too big"+                    putWord8 0x4e+                    putWord32le $ fromIntegral len+            putByteString payload++        OP_0                 -> putWord8 0x00+        OP_1NEGATE           -> putWord8 0x4f+        OP_1                 -> putWord8 0x51+        OP_2                 -> putWord8 0x52+        OP_3                 -> putWord8 0x53+        OP_4                 -> putWord8 0x54+        OP_5                 -> putWord8 0x55+        OP_6                 -> putWord8 0x56+        OP_7                 -> putWord8 0x57+        OP_8                 -> putWord8 0x58+        OP_9                 -> putWord8 0x59+        OP_10                -> putWord8 0x5a+        OP_11                -> putWord8 0x5b+        OP_12                -> putWord8 0x5c+        OP_13                -> putWord8 0x5d+        OP_14                -> putWord8 0x5e+        OP_15                -> putWord8 0x5f+        OP_16                -> putWord8 0x60+        OP_VERIFY            -> putWord8 0x69+        OP_DUP               -> putWord8 0x76+        OP_EQUAL             -> putWord8 0x87+        OP_EQUALVERIFY       -> putWord8 0x88+        OP_HASH160           -> putWord8 0xa9+        OP_CHECKSIG          -> putWord8 0xac+        OP_CHECKMULTISIG     -> putWord8 0xae+        (OP_PUBKEY pk)       -> putWord8 0xfe >> put pk+        (OP_INVALIDOPCODE _) -> putWord8 0xff++-- | Optimally encode data using one of the 4 types of data pushing opcodes+opPushData :: BS.ByteString -> ScriptOp+opPushData bs+    | len <= 0          = error "opPushData: data length must be > 0"+    | len <= 0x4b       = OP_PUSHDATA bs OPCODE+    | len <= 0xff       = OP_PUSHDATA bs OPDATA1+    | len <= 0xffff     = OP_PUSHDATA bs OPDATA2+    | len <= 0xffffffff = OP_PUSHDATA bs OPDATA4+    | otherwise         = error "opPushData: payload size too big"+  where+    len = BS.length bs+
+ Network/Haskoin/Protocol/Tx.hs view
@@ -0,0 +1,194 @@+module Network.Haskoin.Protocol.Tx +( Tx(..) +, TxIn(..)+, TxOut(..)+, OutPoint(..)+, CoinbaseTx(..)+, txid+, cbid+, encodeTxid+, decodeTxid+) where++import Control.Monad (replicateM, forM_, liftM2, unless)+import Control.Applicative ((<$>),(<*>))++import Data.Word (Word32, Word64)+import Data.Binary (Binary, get, put)+import Data.Binary.Get +    ( getWord32le+    , getWord64le+    , getByteString+    )+import Data.Binary.Put +    ( putWord32le+    , putWord64le+    , putByteString+    )+import qualified Data.ByteString as BS +    ( ByteString+    , length+    , reverse+    )++import Network.Haskoin.Protocol.VarInt+import Network.Haskoin.Protocol.Script+import Network.Haskoin.Crypto.Hash +import Network.Haskoin.Util ++-- | Data type representing a bitcoin transaction+data Tx = +    Tx { +         -- | Transaction data format version+         txVersion  :: !Word32+         -- | List of transaction inputs+       , txIn       :: ![TxIn]+         -- | List of transaction outputs+       , txOut      :: ![TxOut]+         -- | The block number of timestamp at which this transaction is locked+       , txLockTime :: !Word32+       } deriving (Eq, Show, Read)++instance Binary Tx where++    get = Tx <$> getWord32le+             <*> (replicateList =<< get)+             <*> (replicateList =<< get)+             <*> getWord32le+      where +        replicateList (VarInt c) = replicateM (fromIntegral c) get++    put (Tx v is os l) = do+        putWord32le v+        put $ VarInt $ fromIntegral $ length is+        forM_ is put+        put $ VarInt $ fromIntegral $ length os+        forM_ os put+        putWord32le l++-- | Data type representing the coinbase transaction of a 'Block'. Coinbase+-- transactions are special types of transactions which are created by miners+-- when they find a new block. Coinbase transactions have no inputs. They have+-- outputs sending the newly generated bitcoins together with all the block's+-- fees to a bitcoin address (usually the miners address). Data can be embedded+-- in a Coinbase transaction which can be chosen by the miner of a block. This+-- data also typically contains some randomness which is used, together with+-- the nonce, to find a partial hash collision on the block's hash.+data CoinbaseTx = +    CoinbaseTx { +                 -- | Transaction data format version.+                 cbVersion    :: !Word32+                 -- | Previous outpoint. This is ignored for+                 -- coinbase transactions but preserved for computing+                 -- the correct txid.+               , cbPrevOutput :: !OutPoint+                 -- | Data embedded inside the coinbase transaction.+               , cbData       :: !BS.ByteString+                 -- | Transaction sequence number. This is ignored for+                 -- coinbase transactions but preserved for computing+                 -- the correct txid.+               , cbInSequence :: !Word32+                 -- | List of transaction outputs.+               , cbOut        :: ![TxOut]+                 -- | The block number of timestamp at which this +                 -- transaction is locked.+               , cbLockTime   :: !Word32+               } deriving (Eq, Show, Read)++instance Binary CoinbaseTx where++    get = do+        v <- getWord32le+        (VarInt len) <- get+        unless (len == 1) $ fail "CoinbaseTx get: Input size is not 1"+        op <- get+        (VarInt cbLen) <- get+        cb <- getByteString (fromIntegral cbLen)+        sq <- getWord32le+        (VarInt oLen) <- get+        os <- replicateM (fromIntegral oLen) get+        lt <- getWord32le+        return $ CoinbaseTx v op cb sq os lt++    put (CoinbaseTx v op cb sq os lt) = do+        putWord32le v+        put $ VarInt 1+        put op+        put $ VarInt $ fromIntegral $ BS.length cb+        putByteString cb +        putWord32le sq+        put $ VarInt $ fromIntegral $ length os+        forM_ os put+        putWord32le lt++-- | Data type representing a transaction input.+data TxIn = +    TxIn { +           -- | Reference the previous transaction output (hash + position)+           prevOutput   :: !OutPoint+           -- | Script providing the requirements of the previous transaction+           -- output to spend those coins.+         , scriptInput  :: !Script+           -- | Transaction version as defined by the sender of the+           -- transaction. The intended use is for replacing transactions with+           -- new information before the transaction is included in a block.+         , txInSequence :: !Word32+         } deriving (Eq, Show, Read)++instance Binary TxIn where+    get = TxIn <$> get <*> get <*> getWord32le+    put (TxIn o s q) = put o >> put s >> putWord32le q++-- | Data type representing a transaction output.+data TxOut = +    TxOut { +            -- | Transaction output value.+            outValue     :: !Word64+            -- | Script specifying the conditions to spend this output.+          , scriptOutput :: !Script+          } deriving (Eq, Show, Read)++instance Binary TxOut where+    get = do+        val <- getWord64le+        unless (val <= 2100000000000000) $ fail $+            "Invalid TxOut value: " ++ (show val)+        TxOut val <$> get+    put (TxOut o s) = putWord64le o >> put s++-- | The OutPoint is used inside a transaction input to reference the previous+-- transaction output that it is spending.+data OutPoint = +    OutPoint { +               -- | The hash of the referenced transaction.+               outPointHash  :: !Hash256+               -- | The position of the specific output in the transaction.+               -- The first output position is 0.+             , outPointIndex :: !Word32+             } deriving (Read, Show, Eq)++instance Binary OutPoint where+    get = do+        (h,i) <- liftM2 (,) get getWord32le+        return $ OutPoint h i+    put (OutPoint h i) = put h >> putWord32le i++-- | Computes the hash of a transaction.+txid :: Tx -> Hash256+txid = doubleHash256 . encode' ++-- | Computes the hash of a coinbase transaction.+cbid :: CoinbaseTx -> Hash256+cbid = doubleHash256 . encode' ++-- | Encodes a transaction hash as little endian in HEX format.+-- This is mostly used for displaying transaction ids. Internally, these ids+-- are handled as big endian but are transformed to little endian when+-- displaying them.+encodeTxid :: Hash256 -> String+encodeTxid = bsToHex . BS.reverse .  encode' ++-- | Decodes a little endian transaction hash in HEX format. +decodeTxid :: String -> Maybe Hash256+decodeTxid = (decodeToMaybe . BS.reverse =<<) . hexToBS+
+ Network/Haskoin/Protocol/VarInt.hs view
@@ -0,0 +1,46 @@+module Network.Haskoin.Protocol.VarInt ( VarInt(..) ) where+ +import Data.Word (Word64)+import Control.Applicative ((<$>))++import Data.Binary (Binary, get, put)+import Data.Binary.Get +    ( getWord8+    , getWord16le+    , getWord32le+    , getWord64le+    )+import Data.Binary.Put +    ( putWord8+    , putWord16le+    , putWord32le+    , putWord64le+    )++-- | Data type representing a variable length integer. The 'VarInt' type+-- usually precedes an array or a string that can vary in length. +newtype VarInt = VarInt { getVarInt :: Word64 }+    deriving (Eq, Show, Read)+    +instance Binary VarInt where++    get = VarInt <$> ( getWord8 >>= go )+      where +        go 0xff = getWord64le+        go 0xfe = fromIntegral <$> getWord32le+        go 0xfd = fromIntegral <$> getWord16le+        go x    = fromIntegral <$> return x++    put (VarInt x)+        | x < 0xfd = +            putWord8 $ fromIntegral x+        | x <= 0xffff = do+            putWord8 0xfd+            putWord16le $ fromIntegral x+        | x <= 0xffffffff = do+            putWord8 0xfe+            putWord32le $ fromIntegral x+        | otherwise = do+            putWord8 0xff+            putWord64le x+
+ Network/Haskoin/Protocol/VarString.hs view
@@ -0,0 +1,29 @@+module Network.Haskoin.Protocol.VarString ( VarString(..) ) where++import Control.Applicative ((<$>))++import qualified Data.ByteString as BS +    ( ByteString+    , length+    )+import Data.Binary (Binary, get, put)+import Data.Binary.Get (getByteString)+import Data.Binary.Put (putByteString)++import Network.Haskoin.Protocol.VarInt++-- | Data type for variable length strings. Variable length strings are+-- serialized as a 'VarInt' followed by a bytestring.+newtype VarString = VarString { getVarString :: BS.ByteString }+    deriving (Eq, Show, Read)++instance Binary VarString where++    get = VarString <$> (readBS =<< get)+      where +        readBS (VarInt len) = getByteString (fromIntegral len)++    put (VarString bs) = do+        put $ VarInt $ fromIntegral $ BS.length bs+        putByteString bs+
+ Network/Haskoin/Protocol/Version.hs view
@@ -0,0 +1,85 @@+module Network.Haskoin.Protocol.Version ( Version(..) ) where++import Control.Applicative ((<$>),(<*>))++import Data.Word (Word32, Word64)+import Data.Binary (Binary, get, put, Get, Put)+import Data.Binary.Get +    ( getWord8+    , getWord32le+    , getWord64le+    , isEmpty+    )+import Data.Binary.Put +    ( putWord8+    , putWord32le+    , putWord64le+    )++import Network.Haskoin.Protocol.VarString+import Network.Haskoin.Protocol.NetworkAddress++-- | When a bitcoin node creates an outgoing connection to another node,+-- the first message it will send is a 'Version' message. The other node+-- will similarly respond with it's own 'Version' message.+data Version = +    Version {+              -- | Protocol version being used by the node.+              version     :: !Word32+              -- | Bitmask of features to enable for this connection.+            , services    :: !Word64+              -- | UNIX timestamp+            , timestamp   :: !Word64+              -- | Network address of the node receiving this message.+            , addrRecv    :: !NetworkAddress+              -- | Network address of the node sending this message.+            , addrSend    :: !NetworkAddress+              -- | Randomly generated identifying sent with every version+              -- message. This nonce is used to detect connection to self.+            , verNonce    :: !Word64+              -- | User agent+            , userAgent   :: !VarString+              -- | The height of the last block received by the sending node.+            , startHeight :: !Word32+              -- | Wether the remote peer should announce relaying transactions+              -- or not. This feature is enabled since version >= 70001. See+              -- BIP37 for more details.+            , relay       :: !Bool+            } deriving (Eq, Show, Read)++instance Binary Version where++    get = Version <$> getWord32le+                  <*> getWord64le+                  <*> getWord64le+                  <*> get+                  <*> get+                  <*> getWord64le+                  <*> get+                  <*> getWord32le+                  <*> (go =<< isEmpty)+      where +        go True  = return True+        go False = getBool++    put (Version v s t ar as n ua sh r) = do+        putWord32le v+        putWord64le s+        putWord64le t+        put         ar+        put         as+        putWord64le n+        put         ua+        putWord32le sh+        putBool     r++getBool :: Get Bool+getBool = go =<< getWord8+  where +    go 0 = return False+    go _ = return True++putBool :: Bool -> Put +putBool True  = putWord8 1+putBool False = putWord8 0+
+ Network/Haskoin/Script.hs view
@@ -0,0 +1,56 @@+{-|+  This package provides functions for parsing and evaluating bitcoin+  transaction scripts. Data types are provided for building and+  deconstructing all of the standard input and output script types. +-}+module Network.Haskoin.Script+(+  -- *Script Parsing+  -- **Script Outputs+  ScriptOutput(..)+, encodeOutput+, decodeOutput+, isPayPK+, isPayPKHash+, isPayMulSig+, isPayScriptHash+, scriptAddr+, sortMulSig+  -- **Script Inputs+, ScriptInput(..)+, encodeInput+, decodeInput+, isSpendPK+, isSpendPKHash+, isSpendMulSig+  -- **ScriptHash Inputs+, ScriptHashInput(..)+, RedeemScript+, encodeScriptHash+, decodeScriptHash+  -- * Helpers+, scriptRecipient+, scriptSender+, intToScriptOp+, scriptOpToInt++-- *SigHash+-- | For additional information on sighashes, see:+-- <http://en.bitcoin.it/wiki/OP_CHECKSIG>+, SigHash(..)+, txSigHash+, encodeSigHash32+, isSigAll+, isSigNone+, isSigSingle+, isSigUnknown+, TxSignature(..)+, encodeSig+, decodeSig+, decodeCanonicalSig++) where++import Network.Haskoin.Script.Parser+import Network.Haskoin.Script.SigHash+
+ Network/Haskoin/Script/Parser.hs view
@@ -0,0 +1,287 @@+module Network.Haskoin.Script.Parser+( ScriptOutput(..)+, ScriptInput(..)+, RedeemScript+, ScriptHashInput(..)+, scriptAddr+, scriptRecipient+, scriptSender+, encodeInput+, decodeInput+, encodeOutput+, decodeOutput+, encodeScriptHash+, decodeScriptHash+, sortMulSig+, intToScriptOp+, scriptOpToInt+, isPayPK+, isPayPKHash+, isPayMulSig+, isPayScriptHash+, isSpendPK+, isSpendPKHash+, isSpendMulSig+) where++import Control.Monad (liftM2)+import Control.Applicative ((<$>),(<*>))++import Data.List (sortBy)+import qualified Data.ByteString as BS (head, singleton)++import Network.Haskoin.Util+import Network.Haskoin.Crypto.Keys+import Network.Haskoin.Crypto.Base58+import Network.Haskoin.Crypto.Hash+import Network.Haskoin.Protocol.Script+import Network.Haskoin.Script.SigHash++-- | Data type describing standard transaction output scripts. Output scripts+-- provide the conditions that must be fulfilled for someone to spend the+-- output coins. +data ScriptOutput = +      -- | Pay to a public key.+      PayPK         { getOutputPubKey   :: !PubKey }+      -- | Pay to a public key hash.+    | PayPKHash     { getOutputAddress  :: !Address }+      -- | Pay to multiple public keys.+    | PayMulSig     { getOutputMulSigKeys     :: ![PubKey]+                    , getOutputMulSigRequired :: !Int+                    }+      -- | Pay to a script hash.+    | PayScriptHash { getOutputAddress  :: !Address }+    deriving (Eq, Show)++-- | Returns True if the script is a pay to public key output.+isPayPK :: ScriptOutput -> Bool+isPayPK (PayPK _) = True+isPayPK _ = False++-- | Returns True if the script is a pay to public key hash output.+isPayPKHash :: ScriptOutput -> Bool+isPayPKHash (PayPKHash _) = True+isPayPKHash _ = False++-- | Returns True if the script is a pay to multiple public keys output.+isPayMulSig :: ScriptOutput -> Bool+isPayMulSig (PayMulSig _ _) = True+isPayMulSig _ = False++-- | Returns true if the script is a pay to script hash output.+isPayScriptHash :: ScriptOutput -> Bool+isPayScriptHash (PayScriptHash _) = True+isPayScriptHash _ = False++-- | Computes a script address from a script output. This address can be used+-- in a pay to script hash output.+scriptAddr :: ScriptOutput -> Address+scriptAddr = ScriptAddress . hash160 . hash256BS . toBS+  where +    toBS = encodeScriptOps . encodeOutput ++-- | Sorts the public keys of a multisignature output in ascending order by+-- comparing their serialized representations. This feature allows for easier+-- multisignature account management as participants in a multisignature wallet+-- will blindly agree on an ordering of the public keys without having to+-- communicate. +sortMulSig :: ScriptOutput -> ScriptOutput+sortMulSig out = case out of+    PayMulSig keys r -> PayMulSig (sortBy f keys) r+    _ -> error "Can only call orderMulSig on PayMulSig scripts"+  where +    f a b = encode' a `compare` encode' b++-- | Computes a 'Script' from a 'ScriptOutput'. The 'Script' is a list of +-- 'ScriptOp' can can be used to build a 'Tx'.+encodeOutput :: ScriptOutput -> Script+encodeOutput s = Script $ case s of+    -- Pay to PubKey+    (PayPK k) -> [opPushData $ encode' k, OP_CHECKSIG]+    -- Pay to PubKey Hash Address+    (PayPKHash a) -> case a of+        (PubKeyAddress h) -> [ OP_DUP, OP_HASH160, opPushData $ encode' h+                             , OP_EQUALVERIFY, OP_CHECKSIG +                             ] +        (ScriptAddress _) -> +            error "encodeOutput: ScriptAddress is invalid in PayPKHash"+    -- Pay to MultiSig Keys+    (PayMulSig ps r)+      | r <= length ps ->+        let opM = intToScriptOp r+            opN = intToScriptOp $ length ps+            keys = map (opPushData . encode') ps+            in opM : keys ++ [opN, OP_CHECKMULTISIG]+      | otherwise -> error "encodeOutput: PayMulSig r must be <= than pkeys"+    -- Pay to Script Hash Address+    (PayScriptHash a) -> case a of+        (ScriptAddress h) -> [ OP_HASH160+                             , opPushData $ encode' h, OP_EQUAL+                             ]+        (PubKeyAddress _) -> +            error "encodeOutput: PubKeyAddress is invalid in PayScriptHash"++-- | Tries to decode a 'ScriptOutput' from a 'Script'. This can fail if the+-- script is not recognized as any of the standard output types.+decodeOutput :: Script -> Either String ScriptOutput+decodeOutput s = case scriptOps s of+    -- Pay to PubKey+    [OP_PUSHDATA bs _, OP_CHECKSIG] -> PayPK <$> decodeToEither bs+    -- Pay to PubKey Hash+    [OP_DUP, OP_HASH160, OP_PUSHDATA bs _, OP_EQUALVERIFY, OP_CHECKSIG] -> +        (PayPKHash . PubKeyAddress) <$> decodeToEither bs+    -- Pay to Script Hash+    [OP_HASH160, OP_PUSHDATA bs _, OP_EQUAL] -> +        (PayScriptHash . ScriptAddress) <$> decodeToEither bs+    -- Pay to MultiSig Keys+    _ -> matchPayMulSig s++-- Match [ OP_N, PubKey1, ..., PubKeyM, OP_M, OP_CHECKMULTISIG ]+matchPayMulSig :: Script -> Either String ScriptOutput+matchPayMulSig (Script ops) = case splitAt (length ops - 2) ops of+    (m:xs,[n,OP_CHECKMULTISIG]) -> do+        (intM,intN) <- liftM2 (,) (scriptOpToInt m) (scriptOpToInt n)+        if intM <= intN && length xs == intN +            then liftM2 PayMulSig (go xs) (return intM)+            else Left "matchPayMulSig: Invalid M or N parameters"+    _ -> Left "matchPayMulSig: script did not match output template"+  where +    go (OP_PUSHDATA bs _:xs) = liftM2 (:) (decodeToEither bs) (go xs)+    go [] = return []+    go  _ = Left "matchPayMulSig: invalid multisig opcode"++-- | Transforms integers [1 .. 16] to 'ScriptOp' [OP_1 .. OP_16]+intToScriptOp :: Int -> ScriptOp+intToScriptOp i+    | i `elem` [1..16] = op+    |        otherwise = error $ "intToScriptOp: Invalid integer " ++ (show i)+  where +    op = decode' $ BS.singleton $ fromIntegral $ i + 0x50++-- | Decode 'ScriptOp' [OP_1 .. OP_16] to integers [1 .. 16]. This functions+-- fails for other values of 'ScriptOp'+scriptOpToInt :: ScriptOp -> Either String Int+scriptOpToInt s +    | res `elem` [1..16] = return res+    | otherwise          = Left $ "scriptOpToInt: invalid opcode " ++ (show s)+  where +    res = (fromIntegral $ BS.head $ encode' s) - 0x50++-- | Computes the recipient address of a script. This function fails if the+-- script could not be decoded as a pay to public key hash or pay to script+-- hash. +scriptRecipient :: Script -> Either String Address+scriptRecipient s = case decodeOutput s of+    Right (PayPKHash a)     -> return a+    Right (PayScriptHash a) -> return a+    Right _                 -> Left "scriptRecipient: bad output script type"+    _                       -> Left "scriptRecipient: non-standard script type"++-- | Computes the sender address of a script. This function fails if the+-- script could not be decoded as a spend public key hash or script hash+-- input. +scriptSender :: Script -> Either String Address+scriptSender s = case decodeInput s of+    Right (SpendPKHash _ key) -> return $ pubKeyAddr key+    Right _ -> Left "scriptSender: bad input script type"+    _ -> case decodeScriptHash s of+        Right (ScriptHashInput _ rdm) -> return $ scriptAddr rdm+        _ -> Left "scriptSender: non-standard script type"++-- | Data type describing standard transaction input scripts. Input scripts+-- provide the signing data required to unlock the coins of the output they are+-- trying to spend. +data ScriptInput = +      -- | Spend the coins of a PayPK output.+      SpendPK     { getInputSig       :: !TxSignature }+      -- | Spend the coins of a PayPKHash output.+    | SpendPKHash { getInputSig :: !TxSignature +                  , getInputKey :: !PubKey+                  }+      -- | Spend the coins of a PayMulSig output.+    | SpendMulSig { getInputMulSigKeys     :: ![TxSignature] +                  , getInputMulSigRequired :: !Int+                  }+    deriving (Eq, Show)++-- | Returns True if the input script is spending a public key.+isSpendPK :: ScriptInput -> Bool+isSpendPK (SpendPK _) = True+isSpendPK _ = False++-- | Returns True if the input script is spending a public key hash.+isSpendPKHash :: ScriptInput -> Bool+isSpendPKHash (SpendPKHash _ _) = True+isSpendPKHash _ = False++-- | Returns True if the input script is spending a multisignature output.+isSpendMulSig :: ScriptInput -> Bool+isSpendMulSig (SpendMulSig _ _) = True+isSpendMulSig _ = False++-- | Computes a 'Script' from a 'ScriptInput'. The 'Script' is a list of +-- 'ScriptOp' can can be used to build a 'Tx'.+encodeInput :: ScriptInput -> Script+encodeInput s = Script $ case s of+    SpendPK ts        -> [ opPushData $ encodeSig ts ]+    SpendPKHash ts p  -> [ opPushData $ encodeSig ts+                         , opPushData $ encode' p+                         ]+    SpendMulSig ts r +        | length ts <= 16 && r >= 1 && r <= 16 ->+            let sigs = map (opPushData . encodeSig) ts+                in OP_0 : sigs ++ replicate (r - length ts) OP_0+        | otherwise -> error "SpendMulSig: Bad multisig parameters"++-- | 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 s = case scriptOps s of+    [OP_PUSHDATA bs _] -> SpendPK <$> decodeSig bs +    [OP_PUSHDATA sig _, OP_PUSHDATA p _] -> +        liftM2 SpendPKHash (decodeSig sig) (decodeToEither p)+    (OP_0 : xs) -> matchSpendMulSig $ Script xs+    _ -> Left "decodeInput: Script did not match input templates"++matchSpendMulSig :: Script -> Either String ScriptInput+matchSpendMulSig (Script ops) = +    liftM2 SpendMulSig (go ops) (return $ length ops)+  where +    go (OP_PUSHDATA bs _:xs) = liftM2 (:) (decodeSig bs) (go xs)+    go (OP_0:xs)+        | all (== OP_0) xs = return []+        | otherwise = Left "matchSpendMulSig: invalid opcode after OP_0"+    go [] = return []+    go _  = Left "matchSpendMulSig: invalid multisig opcode"++type RedeemScript = ScriptOutput++-- | Data type describing an input script spending a pay to script hash+-- output. To spend a script hash output, an input script must provide+-- both a redeem script and a regular input script spending the redeem +-- script.+data ScriptHashInput = ScriptHashInput +    { -- | Input script spending the redeem script+      spendSHInput  :: ScriptInput   +      -- | Redeem script+    , spendSHOutput :: RedeemScript+    } deriving (Eq, Show)++-- | Compute a 'Script' from a 'ScriptHashInput'. The 'Script' is a list of +-- 'ScriptOp' can can be used to build a 'Tx'.+encodeScriptHash :: ScriptHashInput -> Script+encodeScriptHash (ScriptHashInput i o) =+    Script $ (scriptOps si) ++ [opPushData $ encodeScriptOps so]+  where +    si = encodeInput i+    so = encodeOutput o++-- | Tries to decode a 'ScriptHashInput' from a 'Script'. This function fails+-- if the script can not be parsed as a script hash input.+decodeScriptHash :: Script -> Either String ScriptHashInput+decodeScriptHash (Script ops) = case splitAt (length ops - 1) ops of+    (is,[OP_PUSHDATA bs _]) -> +        ScriptHashInput <$> (decodeInput $ Script is) +                        <*> (decodeOutput =<< decodeScriptOps bs)+    _ -> Left "decodeScriptHash: Script did not match input template"+
+ Network/Haskoin/Script/SigHash.hs view
@@ -0,0 +1,199 @@+module Network.Haskoin.Script.SigHash+( SigHash(..)+, encodeSigHash32+, isSigAll+, isSigNone+, isSigSingle+, isSigUnknown+, txSigHash+, TxSignature(..)+, encodeSig+, decodeSig+, decodeCanonicalSig+) where++import Control.Monad (liftM2)++import Data.Word (Word8)+import Data.Bits (testBit, clearBit, setBit)+import Data.Maybe (fromMaybe)+import Data.Binary (Binary, get, put, getWord8, putWord8)+import qualified Data.ByteString as BS +    ( ByteString+    , index+    , length+    , last+    , append+    , pack+    , splitAt+    )++import Network.Haskoin.Crypto.Hash+import Network.Haskoin.Crypto.ECDSA+import Network.Haskoin.Protocol.Script+import Network.Haskoin.Protocol.Tx+import Network.Haskoin.Util++-- | Data type representing the different ways a transaction can be signed.+-- When producing a signature, a hash of the transaction is used as the message+-- to be signed. The 'SigHash' parameter controls which parts of the+-- transaction are used or ignored to produce the transaction hash. The idea is+-- that if some part of a transaction is not used to produce the transaction+-- hash, then you can change that part of the transaction after producing a+-- signature without invalidating that signature.+--+-- If the anyoneCanPay flag is True, then only the current input is signed.+-- Otherwise, all of the inputs of a transaction are signed. The default value+-- for anyoneCanPay is False.+data SigHash +    -- | Sign all of the outputs of a transaction (This is the default value).+    -- Changing any of the outputs of the transaction will invalidate the+    -- signature.+    = SigAll     { anyoneCanPay :: Bool }   +    -- | Sign none of the outputs of a transaction. This allows anyone to+    -- change any of the outputs of the transaction.+    | SigNone    { anyoneCanPay :: Bool }     +    -- | Sign only the output corresponding the the current transaction input.+    -- You care about your own output in the transaction but you don't+    -- care about any of the other outputs.+    | SigSingle  { anyoneCanPay :: Bool }   +    -- | Unrecognized sighash types will decode to SigUnknown.+    | SigUnknown { anyoneCanPay :: Bool+                 , getSigCode   :: Word8 +                 }+    deriving (Eq, Show)++-- | Returns True if the 'SigHash' has the value SigAll.+isSigAll :: SigHash -> Bool+isSigAll sh = case sh of+    SigAll _ -> True+    _ -> False++-- | Returns True if the 'SigHash' has the value SigNone.+isSigNone :: SigHash -> Bool+isSigNone sh = case sh of+    SigNone _ -> True+    _ -> False++-- | Returns True if the 'SigHash' has the value SigSingle.+isSigSingle :: SigHash -> Bool+isSigSingle sh = case sh of+    SigSingle _ -> True+    _ -> False++-- | Returns True if the 'SigHash' has the value SigUnknown.+isSigUnknown :: SigHash -> Bool+isSigUnknown sh = case sh of+    SigUnknown _ _ -> True+    _ -> False++instance Binary SigHash where++    get = getWord8 >>= \w ->+        let acp = testBit w 7+            in return $ case clearBit w 7 of+                1 -> SigAll acp+                2 -> SigNone acp+                3 -> SigSingle acp+                _ -> SigUnknown acp w++    put sh = putWord8 $ case sh of+        SigAll acp -> if acp then 0x81 else 0x01+        SigNone acp -> if acp then 0x82 else 0x02+        SigSingle acp -> if acp then 0x83 else 0x03+        SigUnknown _ w -> w++-- | Encodes a 'SigHash' to a 32 bit-long bytestring.+encodeSigHash32 :: SigHash -> BS.ByteString+encodeSigHash32 sh = encode' sh `BS.append` BS.pack [0,0,0]++-- | Computes the hash that will be used for signing a transaction.+txSigHash :: Tx      -- ^ Transaction to sign.+          -> Script  -- ^ Output script that is 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 i sh = do+    let newIn = buildInputs (txIn tx) out i sh+    -- When SigSingle and input index > outputs, then sign integer 1+    fromMaybe (setBit 0 248) $ do+        newOut <- buildOutputs (txOut tx) i sh+        let newTx = tx{ txIn = newIn, txOut = newOut }+        return $ doubleHash256 $ encode' newTx `BS.append` encodeSigHash32 sh++-- Builds transaction inputs for computing SigHashes+buildInputs :: [TxIn] -> Script -> Int -> SigHash -> [TxIn]+buildInputs txins out i sh+    | anyoneCanPay sh   = (txins !! i) { scriptInput = out } : []+    | isSigAll sh || isSigUnknown sh = single+    | otherwise         = map noSeq $ zip single [0..]+  where +    empty  = map (\ti -> ti{ scriptInput = Script [] }) txins+    single = updateIndex i empty $ \ti -> ti{ scriptInput = out }+    noSeq (ti,j) = if i == j then ti else ti{ txInSequence = 0 }++-- Build transaction outputs for computing SigHashes+buildOutputs :: [TxOut] -> Int -> SigHash -> Maybe [TxOut]+buildOutputs txos i sh+    | isSigAll sh || isSigUnknown sh = return txos+    | isSigNone sh = return []+    | i >= length txos = Nothing+    | otherwise = return $ buffer ++ [txos !! i]+  where +    buffer = replicate i $ TxOut (-1) $ Script []++-- | Data type representing a 'Signature' together with a 'SigHash'. The+-- 'SigHash' is serialized as one byte at the end of a regular ECDSA+-- 'Signature'. All signatures in transaction inputs are of type 'TxSignature'.+data TxSignature = TxSignature +    { txSignature :: Signature +    , sigHashType :: SigHash+    } deriving (Eq, Show)++-- | Serialize a 'TxSignature' to a ByteString.+encodeSig :: TxSignature -> BS.ByteString+encodeSig (TxSignature sig sh) = runPut' $ put sig >> put sh++-- | Decode a 'TxSignature' from a ByteString.+decodeSig :: BS.ByteString -> Either String TxSignature+decodeSig bs = do+    let (h,l) = BS.splitAt (BS.length bs - 1) bs+    liftM2 TxSignature (decodeToEither h) (decodeToEither l)++-- github.com/bitcoin/bitcoin/blob/master/src/script.cpp+-- | Decode a 'TxSignature' from a ByteString. This function will check if+-- the signature is canonical and fail if it is not.+decodeCanonicalSig :: BS.ByteString -> Either String TxSignature+decodeCanonicalSig bs+    | len < 9 = Left "Non-canonical signature: too short"+    | len > 73 = Left "Non-canonical signature: too long"+    | hashtype < 1 || hashtype > 3 = +        Left" Non-canonical signature: unknown hashtype byte"+    | BS.index bs 0 /= 0x30 = Left "Non-canonical signature: wrong type"+    | BS.index bs 1 /= len - 3 = +        Left "Non-canonical signature: wrong length marker"+    | 5 + rlen >= len = Left "Non-canonical signature: S length misplaced"+    | rlen + slen + 7 /= len = +        Left "Non-canonical signature: R+S length mismatch"+    | BS.index bs 2 /= 0x02 = +        Left "Non-canonical signature: R value type mismatch"+    | rlen == 0 = Left "Non-canonical signature: R length is zero"+    | testBit (BS.index bs 4) 7 = +        Left "Non-canonical signature: R value negative"+    | rlen > 1 && BS.index bs 4 == 0 && not (testBit (BS.index bs 5) 7) =+        Left "Non-canonical signature: R value excessively padded"+    | BS.index bs (fromIntegral rlen+4) /= 0x02 =+        Left "Non-canonical signature: S value type mismatch"+    | slen == 0 = Left "Non-canonical signature: S length is zero"+    | testBit (BS.index bs (fromIntegral rlen+6)) 7 =+        Left "Non-canonical signature: S value negative"+    | slen > 1 && BS.index bs (fromIntegral rlen+6) == 0 +        && not (testBit (BS.index bs (fromIntegral rlen+7)) 7) =+        Left "Non-canonical signature: S value excessively padded"+    | otherwise = decodeSig bs+  where +    len = fromIntegral $ BS.length bs+    rlen = BS.index bs 3+    slen = BS.index bs (fromIntegral rlen + 5)+    hashtype = clearBit (BS.last bs) 7+
+ Network/Haskoin/Stratum.hs view
@@ -0,0 +1,274 @@+{-# LANGUAGE OverloadedStrings, FlexibleInstances #-}+module Network.Haskoin.Stratum+( -- * Types+  -- ** Bitcoin+  Balance(..)+, Coin(..)+, TxHeight(..)+  -- ** Stratum data+, StratumNotif(..)+, StratumQuery(..)+, StratumResponse(..)+  -- ** JSON-RPC data for Stratum+, MessageStratum+, NotifStratum+, RequestStratum+, ResponseStratum+, ResultStratum+  -- ** Stratum Session for JSON-RPC Conduit+, StratumSession+  -- * Functions+, toRequest+, parseResult+, parseNotif+, newStratumReq+  -- * Generic JSON-RPC Conduit+  -- ** Types+, Session+  -- ** Functions+, initSession+, newReq+, newNotif+, reqSource+, resConduit+  -- * Generic JSON-RPC Messages+  -- ** Types+, Method+, ErrorValue+, RequestValue+, ResponseValue+, MessageValue+, ResultValue+, Id(..)+, Result+, Error(..)+  -- ** Messages+, Request(..)+, Response(..)+, Message(..)+  -- ** Errors+, errParse+, errReq+, errMeth+, errParams+, errInternal+, errStr+  -- ** Helpers+, leftStr+, numericId+) where++import Control.Monad (mzero)+import Control.Monad.Trans (MonadIO)+import Data.Aeson+    ( FromJSON+    , ToJSON+    , Value (Array, Object, String)+    , (.:), (.=)+    , object+    , parseJSON+    , toJSON+    , withText+    )+import Data.Aeson.Types (Parser)+import Data.Maybe (fromJust)+import Data.Text (Text, pack, unpack)+import qualified Data.Vector as V+import Data.Word (Word, Word64)+import Network.Haskoin.Crypto+import Network.Haskoin.Protocol hiding (Message)+import Network.Haskoin.Stratum.Message+import Network.Haskoin.Stratum.Conduit+import Network.Haskoin.Util++-- | JSON-RPC request with Stratum payload.+type RequestStratum = Request StratumQuery+-- | JSON-RPC notification with Stratum payload.+type NotifStratum = Request StratumNotif+-- | JSON-RPC response with Stratum payload.+type ResponseStratum = Response StratumResponse Value String+-- | Stratum result in JSON-RPC response.+type ResultStratum = Result StratumResponse Value String+-- | Message from Stratum JSON-RPC server.+type MessageStratum = Message StratumNotif StratumResponse Value String+-- | Session type for JSON-RPC conduit.+type StratumSession+    = Session RequestStratum StratumResponse Value String StratumNotif++-- | Transaction height and ID pair. Used in history responses.+data TxHeight = TxHeight+    { txHeightBlock :: Word  -- ^ Block height.+    , txHeightId :: Hash256 -- ^ Transaction id.+    } deriving (Show, Eq)++-- | Bitcoin outpoint information.+data Coin = Coin+    { coinOutPoint :: OutPoint   -- ^ Coin data.+    , coinTxHeight :: TxHeight   -- ^ Transaction information.+    , coinValue :: Word64        -- ^ Output vale.+    } deriving (Show, Eq)++-- | Balance information.+data Balance = Balance+    { balConfirmed :: Word64   -- ^ Confirmed balance.+    , balUnconfirmed :: Word64 -- ^ Unconfirmed balance.+    } deriving (Show, Eq)++-- | Stratum Request data. To be placed inside JSON request.+data StratumQuery+    = QueryVersion { queryClientVer :: Text, queryProtoVer :: Text }+    | QueryHistory { queryAddr :: Address }+    | QueryBalance { queryAddr :: Address }+    | QueryUnspent { queryAddr :: Address }+    | QueryTx { queryTxid :: Hash256 }+    | QueryBroadcast { queryTx :: Tx }+    | SubAddress { queryAddr :: Address }+    deriving (Eq, Show)++-- | Stratum Response Result data.+data StratumResponse+    = ServerVersion { stratumServerVer :: String }+    | AddressHistory { stratumAddrHist :: [TxHeight] }+    | AddressBalance { stratumBalance :: Balance }+    | AddressUnspent { stratumCoins :: [Coin] }+    | Transaction { stratumTx :: Tx }+    | BroadcastId { stratumTxid :: Hash256 }+    | AddrStatus { stratumAddrStatus :: Hash256 }+    deriving (Eq, Show)++data StratumNotif+    = NotifAddress { notifAddr :: Address, notifAddrStatus :: Hash256 }+    deriving (Eq, Show)++instance ToJSON StratumNotif where+    toJSON (NotifAddress a t) = toJSON (a, hashToJSON t)++instance ToJSON StratumQuery where+    toJSON (QueryVersion c p) = toJSON (c, p)+    toJSON (QueryHistory a) = toJSON [a]+    toJSON (QueryUnspent a) = toJSON [a]+    toJSON (QueryBalance a) = toJSON [a]+    toJSON (QueryTx i) = toJSON [txidToJSON i]+    toJSON (QueryBroadcast t) = txToJSON t+    toJSON (SubAddress a) = toJSON [a]++instance FromJSON Balance where+    parseJSON (Object o) = do+        c <- o .: "confirmed"+        u <- o .: "unconfirmed"+        return $ Balance c u+    parseJSON _ = mzero++instance FromJSON TxHeight where+    parseJSON (Object v) = do+        h <- v .: "height"+        t <- v .: "tx_hash"+        i <- txidParse t+        return $ TxHeight h i+    parseJSON _ = mzero++instance ToJSON TxHeight where+    toJSON x = object+        [ "height" .= txHeightBlock x+        , "tx_hash" .= txidToJSON (txHeightId x)+        ]++instance FromJSON Coin where+    parseJSON (Object o) = do+        h <- o .: "height"+        v <- o .: "value"+        t <- o .: "tx_hash"+        p <- o .: "tx_pos"+        i <- txidParse t+        let op = OutPoint i p+            th = TxHeight h i+        return $ Coin op th v+    parseJSON _ = mzero++instance ToJSON Coin where+    toJSON x = object+        [ "height" .= txHeightBlock (coinTxHeight x)+        , "value" .= coinValue x+        , "tx_hash" .= txidToJSON (txHeightId $ coinTxHeight x)+        , "tx_pos" .= outPointIndex (coinOutPoint x)+        ]++method :: StratumQuery -> Text+method (QueryVersion _ _) = "server.version"+method (QueryHistory _) = "blockchain.address.get_history"+method (QueryBalance _) = "blockchain.address.get_balance"+method (QueryUnspent _) = "blockchain.address.get_unspent"+method (QueryTx _) = "blockchain.transaction.get"+method (QueryBroadcast _) = "blockchain.transaction.broadcast"+method (SubAddress _) = "blockchain.address.subscribe"++-- | Create a JSON-RPC request from a Stratum request.+toRequest :: StratumQuery          -- ^ Stratum request data.+          -> Int                   -- ^ JSON-RPC request id.+          -> RequestStratum   -- ^ Returns JSON-RPC request object.+toRequest s i = Request (method s) (Just s) (Just (IntId i))++-- | Parse result from JSON-RPC response into a Stratum response.+parseResult :: StratumQuery -- ^ StratumQuery used in corresponding request.+            -> ResultValue -- ^ Result from JSON-RPC response+            -> Parser ResultStratum -- ^ Returns Aeson parser.+parseResult q (Right v) = parseHelper q v >>= return . Right+parseResult _ (Left e) = return $ Left e++parseHelper :: StratumQuery -> Value -> Parser StratumResponse+parseHelper (QueryVersion _ _) v = parseJSON v >>= return . ServerVersion+parseHelper (QueryHistory _) v = parseJSON v >>= return . AddressHistory+parseHelper (QueryBalance _) v = parseJSON v >>= return . AddressBalance+parseHelper (QueryUnspent _) v = parseJSON v >>= return . AddressUnspent+parseHelper (QueryTx _) v = txParse v >>= return . Transaction+parseHelper (QueryBroadcast _) v = txidParse v >>= return . BroadcastId+parseHelper (SubAddress _) v = hashParse v >>= return . AddrStatus++parseNotifHelper :: Method+                 -> Value+                 -> Parser StratumNotif+parseNotifHelper "blockchain.address.subscribe" (Array v) = do+    a <- parseJSON (V.head v)+    s <- hashParse (V.head $ V.tail v)+    return $ NotifAddress a s+parseNotifHelper _ _ = mzero++-- | Parse notification from JSON-RPC request into Stratum format.+parseNotif :: RequestValue+             -- ^ Request to parse.+             -> Parser NotifStratum+             -- ^ Parser to Stratum request format+parseNotif (Request m (Just p) i) =+    parseNotifHelper m p >>= \s -> return $ Request m (Just s) i+parseNotif _ = mzero++-- | Helper function for Network.Haskoin.JSONRPC.Conduit+newStratumReq :: MonadIO m+              => StratumSession+              -> StratumQuery+              -> m Int+newStratumReq s q = newReq s (toRequest q) p+  where+    p (Response r i) = do+        x <- parseResult q r+        return $ Response x i++txidToJSON :: Hash256 -> Value+txidToJSON = String . pack . encodeTxid++txToJSON :: Tx -> Value+txToJSON = String . pack . bsToHex . encode'++txParse :: Value -> Parser Tx+txParse = withText "bitcoin transaction" $+    return . decode' . fromJust . hexToBS . unpack++txidParse :: Value -> Parser Hash256+txidParse = withText "transaction id" $+    return . fromJust . decodeTxid . unpack++hashToJSON :: Hash256 -> Value+hashToJSON = String . pack . bsToHex . encode'++hashParse :: Value -> Parser Hash256+hashParse = withText "hash" $ return . decode' . fromJust . hexToBS . unpack
+ Network/Haskoin/Stratum/Conduit.hs view
@@ -0,0 +1,153 @@+{-# LANGUAGE OverloadedStrings, RankNTypes, FlexibleContexts #-}+module Network.Haskoin.Stratum.Conduit+( -- * Types+  Session+  -- * Functions+, initSession+, newReq+, newNotif+, reqSource+, resConduit+) where++import Prelude hiding (lines, lookup, map, map, null)+import Control.Applicative ((<$>), (<*>))+import Control.Concurrent.MVar (MVar, newMVar, putMVar, readMVar, takeMVar)+import Control.Concurrent.Chan (Chan, getChanContents, newChan, writeChan)+import Control.Monad (unless)+import Control.Monad.Trans (MonadIO, liftIO)+import Data.Aeson (ToJSON, eitherDecode, encode)+import Data.Aeson.Types (Parser, parseEither)+import Data.ByteString (ByteString)+import Data.ByteString.Lazy.Char8 (append, fromStrict, toStrict)+import Data.Conduit (Conduit, Source, ($=), (=$=), await, yield)+import Data.Conduit.List (sourceList, map)+import Data.IntMap.Strict (IntMap, delete, empty, insert, lookup, null)+import Network.Haskoin.Stratum.Message+import Network.Haskoin.Util (maybeToEither)++-- | Parse JSON-RPC ResponseValue to expected Response data type.+type ResponseParser r e v = ResponseValue -> Parser (Response r e v)++-- | Parse JSON-RPC RequestValue to expectedo Request data type.+type RequestParser j = RequestValue -> Parser (Request j)++-- | Map of ids to result parsers.+type ParserMap r e v = IntMap (ResponseParser r e v)++-- | Session state.+data Session q r e v j = Session+    (Chan q)                  -- Requests to be sent.+    (MVar Int)                -- Last id of sent request.+    (MVar (ParserMap r e v))  -- Map of parsers for response result data.+    (Maybe (RequestParser j)) -- Parser for requests or notifications.++-- | Create initial session.+initSession :: MonadIO m+            => Maybe (RequestParser j)+            -- ^ Parse incoming requests and notifications.+            -- Keep connection open.+            -> m (Session q r e v j)+initSession d = liftIO $ Session+    <$> newChan+    <*> newMVar 0+    <*> newMVar empty+    <*> return d++-- | Send a new request. Goes to a channel that is read from reqSource.+newReq :: MonadIO m+       => Session q r e v j     -- ^ Session state.+       -> (Int -> q)            -- ^ Request builder.+       -> ResponseParser r e v  -- ^ Parser for response.+       -> m Int                 -- ^ Output ID of sent request.+newReq (Session rc iv pv _) f g = liftIO $ do+    i <- (+1) <$> takeMVar iv+    p <- takeMVar pv+    putMVar pv (insert i g p)+    putMVar iv i+    writeChan rc (f i)+    return i++-- | New notification, or request with no id tracking.+newNotif :: MonadIO m+         => Session q r e v j  -- ^ Session state.+         -> q                  -- ^ Request to send to the network.+         -> m ()               -- ^ No meaningful output.+newNotif (Session rc _ _ _) v = liftIO $ writeChan rc v++-- | Source of requests to send to the network.+reqSource :: (MonadIO m, ToJSON q)+          => Session q r e v j     -- ^ Session state.+          -> Source m ByteString   -- ^ Source with serialized requests.+reqSource (Session rc _ _ _) = do+    rs <- liftIO $ getChanContents rc+    sourceList rs $= map (toStrict . flip append "\n" . encode)++-- | Conduit that parses messages from network.+resConduit :: (MonadIO m)+           => Session q r e v j -- ^ Session state.+           -> Conduit ByteString m (Either String (Message j r e v))+           -- ^ Returns Conduit with parsed data or parsing errors.+resConduit (Session _ _ pv d) =+    stopOnNull pv (maybe True (const False) d) =$= decodeConduit pv d++decodeConduit :: (MonadIO m)+              => MVar (ParserMap r e v)+              -> Maybe (RequestParser j)+              -> Conduit ByteString m (Either String (Message j r e v))+decodeConduit pv d = do+    mx <- await+    case mx of+        Nothing -> return ()+        Just x -> do+            p <- liftIO $ takeMVar pv+            let m = decodeMsg p d x+            case m of+                Left e -> yield $ Left e+                Right (i, t) -> case i of+                    Nothing -> do+                        liftIO $ putMVar pv p+                        yield $ Right t+                    Just n -> do+                        liftIO $ putMVar pv $ n `delete` p+                        yield $ Right t+            decodeConduit pv d++stopOnNull :: MonadIO m+           => MVar (IntMap a)+           -> Bool+           -> Conduit i m i+stopOnNull pv d = do+    b <- null <$> liftIO (readMVar pv)+    unless (d && b) $ await >>= maybe e (\x -> yield x >> stopOnNull pv d)+  where+    e = error "Connection closed unexpectedly."++decodeMsg :: ParserMap r e v+          -> Maybe (RequestParser j)+          -> ByteString+          -> Either String (Maybe Int, Message j r e v)+decodeMsg p d x = do+    y <- eitherDecode (fromStrict x)+    case y of+        MsgRequest r -> do+            m <- case d of+                Nothing -> Left "No parser for requests"+                Just l -> parseEither l r+            return $ (Nothing, MsgRequest m)+        MsgResponse r -> do+            (i, z) <- decodeRes p r+            return $ (Just i, MsgResponse z)++decodeRes :: ParserMap r e v+          -> ResponseValue+          -> Either String (Int, (Response r e v))+decodeRes p r = do+    i <- case resId r of+        Just n -> numericId n+        Nothing -> Left "Id is not set."+    a <- maybeToEither (e i) (lookup i p)+    t <- parseEither a r+    return (i, t)+  where+    e i = "Parser not found for response id " ++ show i ++ "."
+ Network/Haskoin/Stratum/Message.hs view
@@ -0,0 +1,218 @@+{-# LANGUAGE OverloadedStrings #-}+-- | Implementation of basic JSON-RPC data types.+module Network.Haskoin.Stratum.Message+( -- * Types+  Method+, ErrorValue+, RequestValue+, ResponseValue+, MessageValue+, ResultValue+, Id(..)+, Result+, Error(..)+  -- * Messages+, Request(..)+, Response(..)+, Message(..)+  -- * Errors+, errParse+, errReq+, errMeth+, errParams+, errInternal+, errStr+  -- * Helpers+, leftStr+, numericId+) where++import Control.Applicative ((<|>))+import Control.Monad (mzero)+import Data.Aeson.Types hiding (Result)+import Data.Text (Text, unpack)+import Text.Read (readEither)+ +-- | JSON-RPC method name.+type Method = Text+-- | JSON-RPC result.+type Result r e v = Either (Error e v) r+-- | JSON-RPC error object with default JSON values.+type ErrorValue = Error Value String+-- | JSON-RPC request with default JSON values.+type RequestValue = Request Value+-- | JSON-RPC response with default JSON values.+type ResponseValue = Response Value Value String+-- | JSON-RPC request or response with default JSON values.+type MessageValue = Message Value Value Value String+-- | JSON-RPC result with default JSON values.+type ResultValue = Result Value Value String++-- | JSON-RPC id in text or integer form.+data Id = IntId { intId :: Int }  -- ^ Id in integer form.+        | TxtId { txtId :: Text } -- ^ Id in string form (discouraged).+        deriving (Eq, Show)++-- | JSON-RPC error object in v1 or v2 format.+-- Sent inside a JSONRes in case of error.+data Error e v -- | Error object in JSON-RPC version 2 format.+               = ErrObj+                   { errCode :: Int      -- ^ Integer error code.+                   , errMsg :: String    -- ^ Error message.+                   , errData :: Maybe e  -- ^ Optional error object.+                   }+               -- | Error object in JSON-RPC version 1 format.+               | ErrVal+                   { errVal :: v  -- ^ Usually String.+                   }+               deriving (Eq, Show)++-- | JSON-RPC request on notification.+data Request j = Request+    { reqMethod :: Method   -- ^ Request method.+    , reqParams :: Maybe j  -- ^ Request parameters. Should be Object or Array.+    , reqId :: Maybe Id     -- ^ Request id. Nothing for notifications.+    } deriving (Eq, Show)++-- | JSON-RPC response or error.+data Response r e v = Response+    { resResult :: Result r e v -- ^ Result or error.+    , resId :: Maybe Id         -- ^ Result id.+    } deriving (Eq, Show)++-- | JSON-RPC message, can contain request or response.+data Message j r e v+    -- | Request message container.+    = MsgRequest (Request j)+    -- | response message container.+    | MsgResponse (Response r e v)+    deriving (Eq, Show)++instance FromJSON Id where+    parseJSON (String s) = return (TxtId s)+    parseJSON (Number n) = do+        let (i, d) = properFraction n+        if d == 0.0 then return (IntId i) else mzero+    parseJSON _ = mzero++instance ToJSON Id where+    toJSON (TxtId s) = toJSON s+    toJSON (IntId i) = toJSON i++instance (FromJSON e, FromJSON v) => FromJSON (Error e v) where+    parseJSON v@(Object o) = do+        mc <- o .:? "code"+        mm <- o .:? "message"+        md <- o .:? "data"+        case (mc, mm) of+            (Just c, Just m) -> return (ErrObj c m md)+            _ -> parseJSON v >>= return . ErrVal+    parseJSON v = parseJSON v >>= return . ErrVal++instance (ToJSON e, ToJSON v) => ToJSON (Error e v) where+    toJSON (ErrObj c m d) = object+        [ "code"    .= c+        , "message" .= m+        , "data"    .= d ]+    toJSON (ErrVal v) = toJSON v++instance FromJSON j => FromJSON (Request j) where+    parseJSON (Object o) = do+        m <- o .: "method"+        p <- o .:? "params"+        i <- o .:? "id"+        return (Request m p i)+    parseJSON _ = mzero++instance ToJSON j => ToJSON (Request j) where+    toJSON (Request m p i) = object $ filter f+        [ "jsonrpc" .= ("2.0" :: String)+        , "method"  .= m+        , "params"  .= p+        , "id"      .= i ]+      where+        f (_, Null) = False+        f _ = True++instance (FromJSON r, FromJSON e, FromJSON v)+    => FromJSON (Response r e v)+  where+    parseJSON (Object o) = do+        mi <- o .: "id"+        me <- o .:? "error" .!= Nothing+        mr <- o .:? "result" .!= Nothing+        case (me, mr) of+            (Just e, _) -> return (Response (Left e) mi)+            (_, Just r) -> return (Response (Right r) mi)+            _ -> mzero+    parseJSON _ = mzero++instance (ToJSON r, ToJSON e, ToJSON v)+    => ToJSON (Response r e v)+  where+    toJSON (Response (Right r) i) = object+        [ "jsonrpc" .= ("2.0" :: String)+        , "id" .= i+        , "result" .= r+        ]+    toJSON (Response (Left e) i) = object+        [ "jsonrpc" .= ("2.0" :: String)+        , "id" .= i+        , "error" .= e+        ]++instance (FromJSON j, FromJSON r, FromJSON e, FromJSON v)+    => FromJSON (Message j r e v)+  where+    parseJSON o@(Object _) = q <|> s+      where+        q = parseJSON o >>= return . MsgRequest+        s = parseJSON o >>= return . MsgResponse+    parseJSON _ = mzero++instance (ToJSON j, ToJSON r, ToJSON e, ToJSON v)+    => ToJSON (Message j r e v)+  where+    toJSON (MsgRequest r) = toJSON r+    toJSON (MsgResponse r) = toJSON r++-- | Parse error in JSON-RPC v2 format.+-- Provide optional error object.+errParse :: ToJSON e => Maybe e -> Error e v+errParse = ErrObj (-32700) "Parse error"++-- | Request error in JSON-RPC v2 format.+-- Provide optional error object.+errReq :: ToJSON e => Maybe e -> Error e v+errReq = ErrObj (-32600) "Invalid request"++-- | Unknown method error in JSON-RPC v2 format.+-- Provide optional error object.+errMeth :: ToJSON e => Maybe e -> Error e v+errMeth = ErrObj (-32601) "Method not found"++-- | Invalid parameters error in JSON-RPC v2 format.+-- Provide optional error object.+errParams :: ToJSON e => Maybe e -> Error e v+errParams = ErrObj (-32602) "Invalid params"++-- | Internal error in JSON-RPC v2 format.+-- Provide optional error object.+errInternal :: ToJSON e => Maybe e -> Error e v+errInternal = ErrObj (-32606) "Internal error"++-- | Get string from error object.+errStr :: Error e Value -> String+errStr (ErrObj _ m _) = m+errStr (ErrVal v) = either id id . flip parseEither v $+    withText "error string" (return . unpack)++-- | Map Left error objects to strings.+leftStr :: Either (Error e Value) r -> Either String r+leftStr (Left e) = Left (errStr e)+leftStr (Right r) = Right r++-- | Force an id into a number or fail if not possible.+numericId :: Id -> Either String Int+numericId (IntId i) = Right i+numericId (TxtId t) = readEither $ unpack t
+ Network/Haskoin/Transaction.hs view
@@ -0,0 +1,26 @@+{-|+  This package provides functions for building and signing both simple+  transactions and multisignature transactions.+-}+module Network.Haskoin.Transaction+(+  -- *Build Transactions+  buildTx+, buildAddrTx++  -- *Transaction signing+, SigInput(..)+, signTx+, detSignTx+, isTxComplete++  -- *Coin selection+, Coin(..)+, chooseCoins+, chooseMSCoins+, guessTxSize++) where++import Network.Haskoin.Transaction.Builder+
+ Network/Haskoin/Transaction/Builder.hs view
@@ -0,0 +1,362 @@+module Network.Haskoin.Transaction.Builder +( Coin(..)+, buildTx+, buildAddrTx+, SigInput(..)+, signTx+, detSignTx+, verifyTx+, guessTxSize+, chooseCoins+, chooseMSCoins+, getFee+, getMSFee+, isTxComplete+) where++import Control.Monad (when, guard, liftM2)+import Control.Applicative ((<$>))+import Control.Monad.Trans  (lift)++import Data.Maybe (catMaybes, maybeToList, fromMaybe)+import Data.List (sortBy, find)+import Data.Word (Word64)+import qualified Data.ByteString as BS (length, replicate)++import Network.Haskoin.Util+import Network.Haskoin.Crypto+import Network.Haskoin.Protocol+import Network.Haskoin.Script++-- | A Coin is something that can be spent by a transaction and is+-- represented by a transaction output, an outpoint and optionally a+-- redeem script.+data Coin = +    Coin { coinTxOut    :: TxOut        -- ^ Transaction output+         , coinOutPoint :: OutPoint     -- ^ Previous outpoint+         , coinRedeem   :: Maybe Script -- ^ Redeem script+         } deriving (Eq, Show)++-- | Coin selection algorithm for normal (non-multisig) transactions. This+-- function returns the selected coins together with the amount of change to+-- send back to yourself, taking the fee into account.+chooseCoins :: Word64 -- ^ Target price to pay.+            -> Word64 -- ^ Fee price per 1000 bytes.+            -> [Coin] -- ^ List of coins to choose from.+            -> Either String ([Coin],Word64) +               -- ^ Coin selection result and change amount.+chooseCoins target kbfee xs +    | target > 0 = maybeToEither err $ greedyAdd target (getFee kbfee) xs+    | otherwise  = Left "chooseCoins: Target must be > 0"+    where err = "chooseCoins: No solution found"++-- | Coin selection algorithm for multisignature transactions. This function+-- returns the selected coins together with the amount of change to send back+-- to yourself, taking the fee into account. This function assumes all the +-- coins are script hash outputs that send funds to a multisignature address.+chooseMSCoins :: Word64    -- ^ Target price to pay.+              -> Word64    -- ^ Fee price per 1000 bytes.+              -> (Int,Int) -- ^ Multisig parameters m of n (m,n).+              -> [Coin]    -- ^ List of coins to choose from.+              -> Either String ([Coin],Word64) +                 -- ^ Coin selection result and change amount.+chooseMSCoins target kbfee ms xs +    | target > 0 = maybeToEither err $ greedyAdd target (getMSFee kbfee ms) xs+    | otherwise  = Left "chooseMSCoins: Target must be > 0"+    where err = "chooseMSCoins: No solution found"++-- Select coins greedily by starting from an empty solution+greedyAdd :: Word64 -> (Int -> Word64) -> [Coin] -> Maybe ([Coin],Word64)+greedyAdd target fee xs = go [] 0 [] 0 $ sortBy desc xs+    where desc a b = compare (outValue $ coinTxOut b) (outValue $ coinTxOut a)+          goal c = target + fee c+          go _ _ [] _ []    = Nothing+          go _ _ ps pTot [] = return (ps,pTot - (goal $ length ps))+          go acc aTot ps pTot (y:ys)+            | val + aTot >= (goal $ length acc + 1) =+                if aTot + val - target < pTot - target+                    then go [] 0 (y:acc) (aTot + val) ys+                    else return (ps,pTot - (goal $ length ps))+            | otherwise = go (y:acc) (aTot + val) ps pTot ys+            where val = outValue $ coinTxOut y++{-+-- Start from a solution containing all coins and greedily remove them+greedyRem :: Word64 -> (Int -> Word64) -> [Coin] -> Maybe ([Coin],Word64)+greedyRem target fee xs +    | s < goal (length xs) = Nothing+    | otherwise = return $ go [] s $ sortBy desc xs+    where desc a b = compare (outValue $ coinTxOut b) (outValue $ coinTxOut a)+          s        = sum $ map (outValue . coinTxOut) xs+          goal   c = target + fee c+          go acc tot [] = (acc,tot - (goal $ length acc))+          go acc tot (y:ys) +            | tot - val >= (goal $ length ys + length acc) = +                go acc (tot - val) ys+            | otherwise = go (y:acc) tot ys+            where val = outValue $ coinTxOut y+-}++getFee :: Word64 -> Int -> Word64+getFee kbfee count = kbfee*((len + 999) `div` 1000)+    where len = fromIntegral $ guessTxSize count [] 2 0++getMSFee :: Word64 -> (Int,Int) -> Int -> Word64+getMSFee kbfee ms count = kbfee*((len + 999) `div` 1000)+    where len = fromIntegral $ guessTxSize 0 (replicate count ms) 2 0++-- | Computes an upper bound on the size of a transaction based on some known+-- properties of the transaction.+guessTxSize :: Int         -- ^ Number of regular transaction inputs.+            -> [(Int,Int)] +               -- ^ For every multisig input in the transaction, provide+               -- the multisig parameters m of n (m,n) for that input.+            -> Int         -- ^ Number of pay to public key hash outputs.+            -> Int         -- ^ Number of pay to script hash outputs.+            -> Int         -- ^ Upper bound on the transaction size.+guessTxSize pki msi pkout msout = 8 + inpLen + inp + outLen + out+    where inpLen = BS.length $ encode' $ +            VarInt $ fromIntegral $ (length msi) + pki+          outLen = BS.length $ encode' $ +            VarInt $ fromIntegral $ pkout + msout+          inp    = pki*148 + (sum $ map guessMSSize msi)+                   -- (20: hash160) + (5: opcodes) + +                   -- (1: script len) + (8: Word64)+          out    = pkout*34 + +                   -- (20: hash160) + (3: opcodes) + +                   -- (1: script len) + (8: Word64)+                   msout*32++-- Size of a multisig pay2sh input+guessMSSize :: (Int,Int) -> Int+          -- OutPoint (36) + Sequence (4) + Script+guessMSSize (m,n) = 40 + (BS.length $ encode' $ VarInt $ fromIntegral scp) + scp+          -- OP_M + n*PubKey + OP_N + OP_CHECKMULTISIG+    where rdm = BS.length $ encode' $ opPushData $ BS.replicate (n*34 + 3) 0+          -- Redeem + m*sig + OP_0+          scp = rdm + m*73 + 1 ++{- Build a new Tx -}++-- | Build a transaction by providing a list of outpoints as inputs+-- and a list of recipients addresses and amounts as outputs. +buildAddrTx :: [OutPoint] -> [(String,Word64)] -> Either String Tx+buildAddrTx xs ys = buildTx xs =<< mapM f ys+    where f (s,v) = case base58ToAddr s of+            Just a@(PubKeyAddress _) -> return (PayPKHash a,v)+            Just a@(ScriptAddress _) -> return (PayScriptHash a,v)+            _ -> Left $ "buildAddrTx: Invalid address " ++ s++-- | Build a transaction by providing a list of outpoints as inputs+-- and a list of 'ScriptOutput' and amounts as outputs.+buildTx :: [OutPoint] -> [(ScriptOutput,Word64)] -> Either String Tx+buildTx xs ys = mapM fo ys >>= \os -> return $ Tx 1 (map fi xs) os 0+    where fi outPoint = TxIn outPoint (Script []) maxBound+          fo (o,v) | v <= 2100000000000000 = return $ TxOut v $ encodeOutput o+                   | otherwise = Left $ "buildTx: Invalid amount " ++ (show v)++-- | Data type used to specify the signing parameters of a transaction input.+-- To sign an input, the previous output script, outpoint and sighash are+-- required. When signing a pay to script hash output, an additional redeem+-- script is required.+data SigInput +    -- | Parameters for signing a pay to public key hash output.+    = SigInput   { sigDataOut :: Script   -- ^ Output script to spend.+                 , sigDataOP  :: OutPoint +                   -- ^ Reference to the transaction output to spend.+                 , sigDataSH  :: SigHash  -- ^ Signature type.+                 } +    -- | Parameters for signing a pay to script hash output.+    | SigInputSH { sigDataOut :: Script   +                 , sigDataOP  :: OutPoint +                 , sigRedeem  :: Script   -- ^ Redeem script.+                 , sigDataSH  :: SigHash  +                 } deriving (Eq, Show)++liftSecret :: Monad m => Build a -> SecretT (BuildT m) a+liftSecret = lift . liftBuild++-- | Returns True if all the inputs of a transactions are non-empty and if+-- all multisignature inputs are fully signed.+isTxComplete :: Tx -> Bool+isTxComplete = isComplete . (mapM toBuildTxIn) . txIn++-- | Sign a transaction by providing the 'SigInput' signing parameters and a+-- list of private keys. The signature is computed within the 'SecretT' monad+-- to generate the random signing nonce and within the 'BuildT' monad to add+-- information on wether the result was fully or partially signed.+signTx :: Monad m +       => Tx                    -- ^ Transaction to sign+       -> [SigInput]            -- ^ SigInput signing parameters+       -> [PrvKey]              -- ^ List of private keys to use for signing+       -> SecretT (BuildT m) Tx -- ^ Signed transaction+signTx tx@(Tx _ ti _ _) sigis keys = do+    liftSecret $ when (null ti) $ Broken "signTx: Transaction has no inputs"+    newIn <- mapM sign $ orderSigInput ti sigis+    return tx{ txIn = newIn }+    where sign (maybeSI,txin,i) = case maybeSI of+              Just sigi -> signTxIn txin sigi tx i keys+              _         -> liftSecret $ toBuildTxIn txin++signTxIn :: Monad m => TxIn -> SigInput -> Tx -> Int -> [PrvKey] +         -> SecretT (BuildT m) TxIn+signTxIn txin sigi tx i keys = do+    (out,vKeys,pubs,buildf) <- liftSecret $ decodeSigInput sigi keys+    let msg = txSigHash tx (encodeOutput out) i sh+    sigs <- mapM (signMsg msg) vKeys+    liftSecret $ buildf txin tx out i pubs $ map (flip TxSignature sh) sigs+    where sh = sigDataSH sigi++-- | 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. The signature is computed within the 'Build' monad+-- to add information on wether the result was fully or partially signed.+detSignTx :: Tx         -- ^ Transaction to sign+          -> [SigInput] -- ^ SigInput signing parameters+          -> [PrvKey]   -- ^ List of private keys to use for signing+          -> Build Tx   -- ^ Signed transaction+detSignTx tx@(Tx _ ti _ _) sigis keys = do+    when (null ti) $ Broken "detSignTx: Transaction has no inputs"+    newIn <- mapM sign $ orderSigInput ti sigis+    return tx{ txIn = newIn }+  where +    sign (maybeSI,txin,i) +        | isComplete txinB = txinB+        | otherwise        = case maybeSI of+            Just sigi -> detSignTxIn txin sigi tx i keys+            _         -> txinB+      where+        txinB = toBuildTxIn txin+      +detSignTxIn :: TxIn -> SigInput -> Tx -> Int -> [PrvKey] -> Build TxIn+detSignTxIn txin sigi tx i keys = do+    (out,vKeys,pubs,buildf) <- decodeSigInput sigi keys+    let msg  = txSigHash tx (encodeOutput out) i sh+        sigs = map (detSignMsg msg) vKeys+    buildf txin tx out i pubs $ map (flip TxSignature sh) sigs+    where sh = sigDataSH sigi++{- Helpers for signing transactions -}++-- |Decides if a TxIn is complete. If the TxIn could not be decoded and it+-- is not empty, we consider it complete.+toBuildTxIn :: TxIn -> Build TxIn+toBuildTxIn txin@(TxIn _ s _)+    | null $ scriptOps s = Partial txin+    | otherwise = case decodeScriptHash s of+        Right (ScriptHashInput (SpendMulSig xs r) _) -> +            guardPartial (length xs == r) >> return txin+        Right _ -> return txin+        Left _ -> case decodeInput s of+            Right (SpendMulSig xs r) ->+                guardPartial (length xs == r) >> return txin+            _ -> return txin++orderSigInput :: [TxIn] -> [SigInput] -> [(Maybe SigInput, TxIn, Int)]+orderSigInput ti si = zip3 (matchTemplate si ti f) ti [0..]+    where f s txin = sigDataOP s == prevOutput txin++type BuildFunction =  TxIn -> Tx -> ScriptOutput -> Int +                   -> [PubKey] -> [TxSignature] -> Build TxIn++decodeSigInput :: SigInput -> [PrvKey] -> +    Build (ScriptOutput, [PrvKey], [PubKey], BuildFunction)+decodeSigInput sigi keys = case sigi of+    SigInput s _ _ -> do+        out          <- eitherToBuild $ decodeOutput s+        (vKeys,pubs) <- sigKeys out keys+        return (out,vKeys,pubs,buildTxIn)+    SigInputSH s _ sr _ -> do+        out          <- eitherToBuild $ decodeOutput s+        rdm          <- eitherToBuild $ decodeOutput sr+        (vKeys,pubs) <- sigKeysSH out rdm keys+        return (rdm,vKeys,pubs,buildTxInSH)++buildTxInSH :: BuildFunction+buildTxInSH txin tx rdm i pubs sigs = do+    s   <- scriptInput <$> buildTxIn txin tx rdm i pubs sigs+    res <- either emptyIn return $ +        encodeScriptHash . (flip ScriptHashInput rdm) <$> decodeInput s+    return txin{ scriptInput = res }+    where emptyIn = const $ Partial $ Script []++buildTxIn :: BuildFunction+buildTxIn txin tx out i pubs sigs +    | null sigs = Partial txin{ scriptInput = Script [] }+    | otherwise = buildRes <$> case out of+        PayPK _     -> return $ SpendPK $ head sigs+        PayPKHash _ -> return $ SpendPKHash (head sigs) (head pubs)+        PayMulSig msPubs r -> do+            let mSigs = take r $ catMaybes $ matchTemplate aSigs msPubs f+            guardPartial $ length mSigs == r+            return $ SpendMulSig mSigs r+        _ -> Broken "buildTxIn: Can't sign a P2SH script here"+    where buildRes res = txin{ scriptInput = encodeInput res }+          aSigs = concat+            [ sigs +            , case decodeScriptHash $ scriptInput txin of+                Right (ScriptHashInput (SpendMulSig xs _) _) -> xs+                _ -> case decodeInput $ scriptInput txin of+                        Right (SpendMulSig xs _) -> xs+                        _ -> []+            ]+          f (TxSignature sig sh) pub = +              verifySig (txSigHash tx (encodeOutput out) i sh) sig pub++sigKeysSH :: ScriptOutput -> RedeemScript -> [PrvKey]+          -> Build ([PrvKey],[PubKey])+sigKeysSH out rdm keys = case out of+    PayScriptHash a -> if scriptAddr rdm == a+        then sigKeys rdm keys+        else Broken "sigKeys: Redeem script does not match P2SH script"+    _ -> Broken "sigKeys: Can only decode P2SH script here"++sigKeys :: ScriptOutput -> [PrvKey] -> Build ([PrvKey],[PubKey])+sigKeys out keys = unzip <$> case out of+    PayPK p        -> return $ maybeToList $ +        find ((== p) . snd) zipKeys+    PayPKHash a    -> return $ maybeToList $ +        find ((== a) . pubKeyAddr . snd) zipKeys+    PayMulSig ps r -> return $ take r $ +        filter ((`elem` ps) . snd) zipKeys+    _ -> Broken "sigKeys: Can't decode P2SH here" +    where zipKeys = zip keys $ map derivePubKey keys++{- Tx verification -}++-- This is not the final transaction verification function. It is here mainly+-- as a helper for tests. It can only validates standard inputs.+verifyTx :: Tx -> [(Script,OutPoint)] -> Bool+verifyTx tx xs = flip all z3 $ \(maybeS,txin,i) -> fromMaybe False $ do+    (out,inp) <- maybeS >>= flip decodeVerifySigInput txin+    let so = encodeOutput out+    case (out,inp) of+        (PayPK pub,SpendPK (TxSignature sig sh)) -> +            return $ verifySig (txSigHash tx so i sh) sig pub+        (PayPKHash a,SpendPKHash (TxSignature sig sh) pub) -> do+            guard $ pubKeyAddr pub == a+            return $ verifySig (txSigHash tx so i sh) sig pub+        (PayMulSig pubs r,SpendMulSig sigs _) ->+            (== r) <$> countMulSig tx so i pubs sigs +        _ -> Nothing+    where m = map (fst <$>) $ matchTemplate xs (txIn tx) f+          f (_,o) txin = o == prevOutput txin+          z3 = zip3 m (txIn tx) [0..]+                      +-- Count the number of valid signatures+countMulSig :: Tx -> Script -> Int -> [PubKey] -> [TxSignature] -> Maybe Int+countMulSig _ _ _ [] _  = return 0+countMulSig _ _ _ _  [] = return 0+countMulSig tx so i (pub:pubs) sigs@(TxSignature sig sh:rest)+    | verifySig (txSigHash tx so i sh) sig pub = +         (+1) <$> countMulSig tx so i pubs rest+    | otherwise = countMulSig tx so i pubs sigs+                  +decodeVerifySigInput :: Script -> TxIn -> Maybe (ScriptOutput, ScriptInput)+decodeVerifySigInput so (TxIn _ si _ ) = case decodeOutput so of+    Right (PayScriptHash a) -> do+        (ScriptHashInput inp rdm) <- eitherToMaybe $ decodeScriptHash si+        guard $ scriptAddr rdm == a+        return (rdm,inp)+    out -> eitherToMaybe $ liftM2 (,) out (decodeInput si)+
+ Network/Haskoin/Util.hs view
@@ -0,0 +1,332 @@+{-|+  This module defines various utility functions used across the +  Network.Haskoin modules.+-}+module Network.Haskoin.Util+( +  -- * ByteString helpers+  toStrictBS+, toLazyBS+, stringToBS+, bsToString+, bsToInteger+, integerToBS+, bsToHex+, hexToBS++  -- * Data.Binary helpers+, encode'+, decode'+, runPut'+, runGet'+, decodeOrFail'+, runGetOrFail'+, fromDecode+, fromRunGet+, decodeToEither+, decodeToMaybe+, isolate++  -- * Maybe and Either monad helpers+, isLeft+, isRight+, fromRight+, fromLeft+, eitherToMaybe+, maybeToEither+, liftEither+, liftMaybe++  -- * Various helpers+, updateIndex+, matchTemplate++  -- Triples+, fst3+, snd3+, lst3++ -- *Build monad+, Build(..)+, isComplete+, isPartial+, isBroken+, eitherToBuild+, buildToEither+, guardPartial++  -- *BuildT transformer monad+, BuildT(..)+, liftBuild++  -- *Constants+, addrPrefix+, scriptPrefix+, secretPrefix+, extPubKeyPrefix+, extSecretPrefix+, networkMagic+, genesisHeader+, maxBlockSize+, walletFile+, haskoinUserAgent++) where++import Numeric (readHex)+import Control.Applicative ((<$>))+import Control.Monad (guard)+import Control.Monad.Trans.Either (EitherT, hoistEither)+import Text.Printf (printf)++import Data.Monoid (mappend)+import Data.Word (Word8)+import Data.Bits ((.|.), shiftL, shiftR)+import Data.List (unfoldr)+import Data.List.Split (chunksOf)+import Data.Binary.Put (Put, runPut)+import Data.Binary +    ( Binary+    , encode+    , decode+    , decodeOrFail+    )+import Data.Binary.Get+    ( Get+    , runGetOrFail+    , getByteString+    , ByteOffset+    , runGet+    )++import qualified Data.ByteString.Lazy as BL +    ( ByteString+    , toChunks+    , fromChunks+    )+import qualified Data.ByteString as BS +    ( ByteString+    , concat+    , pack, unpack+    , foldl'+    , null+    )+import qualified Data.ByteString.Char8 as C+    ( pack+    , unpack+    )++import Network.Haskoin.Util.BuildMonad+import Network.Haskoin.Util.Constants++-- ByteString helpers++-- | Transforms a lazy bytestring into a strict bytestring+toStrictBS :: BL.ByteString -> BS.ByteString+toStrictBS = BS.concat . BL.toChunks++-- | Transforms a strict bytestring into a lazy bytestring+toLazyBS :: BS.ByteString -> BL.ByteString+toLazyBS bs = BL.fromChunks [bs]++-- | Transforms a string into a strict bytestring+stringToBS :: String -> BS.ByteString+stringToBS = C.pack++-- | Transform a strict bytestring to a string+bsToString :: BS.ByteString -> String+bsToString = C.unpack++-- | Decode a big endian Integer from a bytestring+bsToInteger :: BS.ByteString -> Integer+bsToInteger = (foldr f 0) . reverse . BS.unpack+  where +    f w n = (toInteger w) .|. shiftL n 8++-- | Encode an Integer to a bytestring as big endian+integerToBS :: Integer -> BS.ByteString+integerToBS 0 = BS.pack [0]+integerToBS i +    | i > 0     = BS.pack $ reverse $ unfoldr f i+    | otherwise = error "integerToBS not defined for negative values"+  where +    f 0 = Nothing+    f x = Just $ (fromInteger x :: Word8, x `shiftR` 8)++-- | Encode a bytestring to a base16 (HEX) representation+bsToHex :: BS.ByteString -> String+bsToHex = BS.foldl' (\a x -> mappend a (printf "%02x" x)) ""++-- | Decode a base16 (HEX) string from a bytestring. This function can fail+-- if the string contains invalid HEX characters+hexToBS :: String -> Maybe BS.ByteString+hexToBS xs = BS.pack <$> mapM hexWord (chunksOf 2 xs)+  where+    hexWord x = do+        guard $ length x == 2+        let (w, s) = head $ readHex x+        guard $ s == ""+        return w++-- Data.Binary helpers++-- | Strict version of @Data.Binary.encode@+encode' :: Binary a => a -> BS.ByteString+encode' = toStrictBS . encode++-- | Strict version of @Data.Binary.decode@+decode' :: Binary a => BS.ByteString -> a+decode' = decode . toLazyBS++-- | Strict version of @Data.Binary.runGet@+runGet' :: Binary a => Get a -> BS.ByteString -> a+runGet' m = (runGet m) . toLazyBS++-- | Strict version of @Data.Binary.runPut@+runPut' :: Put -> BS.ByteString+runPut' = toStrictBS . runPut++-- | Strict version of @Data.Binary.decodeOrFail@+decodeOrFail' :: +    Binary a => +    BS.ByteString -> +    Either (BS.ByteString, ByteOffset, String) (BS.ByteString, ByteOffset, a)+decodeOrFail' bs = case decodeOrFail $ toLazyBS bs of+    Left  (lbs,o,err) -> Left  (toStrictBS lbs,o,err)+    Right (lbs,o,res) -> Right (toStrictBS lbs,o,res)++-- | Strict version of @Data.Binary.runGetOrFail@+runGetOrFail' ::+    Binary a => Get a -> BS.ByteString ->+    Either (BS.ByteString, ByteOffset, String) (BS.ByteString, ByteOffset, a)+runGetOrFail' m bs = case runGetOrFail m $ toLazyBS bs of+    Left  (lbs,o,err) -> Left  (toStrictBS lbs,o,err)+    Right (lbs,o,res) -> Right (toStrictBS lbs,o,res)++-- | Try to decode a Data.Binary value. If decoding succeeds, apply the function+-- to the result. Otherwise, return the default value.+fromDecode :: Binary a +           => BS.ByteString -- ^ The bytestring to decode+           -> b             -- ^ Default value to return when decoding fails +           -> (a -> b)      -- ^ Function to apply when decoding succeeds +           -> b             -- ^ Final result+fromDecode bs def f = either (const def) (f . lst) $ decodeOrFail' bs+  where +    lst (_,_,c) = c++-- | Try to run a Data.Binary.Get monad. If decoding succeeds, apply a function+-- to the result. Otherwise, return the default value.+fromRunGet :: Binary a +           => Get a         -- ^ The Get monad to run+           -> BS.ByteString -- ^ The bytestring to decode+           -> b             -- ^ Default value to return when decoding fails +           -> (a -> b)      -- ^ Function to apply when decoding succeeds +           -> b             -- ^ Final result+fromRunGet m bs def f = either (const def) (f . lst) $ runGetOrFail' m bs+  where +    lst (_,_,c) = c++-- | Decode a Data.Binary value into the Either monad. A Right value is returned+-- with the result upon success. Otherwise a Left value with the error message+-- is returned.+decodeToEither :: Binary a => BS.ByteString -> Either String a+decodeToEither bs = case decodeOrFail' bs of+    Left  (_,_,err) -> Left err+    Right (_,_,res) -> Right res++-- | Decode a Data.Binary value into the Maybe monad. A Just value is returned+-- with the result upon success. Otherwise, Nothing is returned.+decodeToMaybe :: Binary a => BS.ByteString -> Maybe a+decodeToMaybe bs = fromDecode bs Nothing Just++-- | Isolate a Data.Binary.Get monad for the next @Int@ bytes. Only the next+-- @Int@ bytes of the input bytestring will be available for the Get monad to+-- consume. This function will fail if the Get monad fails or some of the input+-- is not consumed.+isolate :: Binary a => Int -> Get a -> Get a+isolate i g = do+    bs <- getByteString i+    case runGetOrFail' g bs of+        Left (_, _, err) -> fail err+        Right (unconsumed, _, res)+            | BS.null unconsumed -> return res+            | otherwise          -> fail "Isolate: unconsumed input"++-- Maybe and Eithre monad helpers++-- | Returns True if the Either value is Right+isRight :: Either a b -> Bool+isRight (Right _) = True+isRight _         = False++-- | Returns True if the Either value is Left+isLeft :: Either a b -> Bool+isLeft = not . isRight++-- | Extract the Right value from an Either value. Fails if the value is Left+fromRight :: Either a b -> b+fromRight (Right b) = b+fromRight _ = error "Either.fromRight: Left"++-- | Extract the Left value from an Either value. Fails if the value is Right+fromLeft :: Either a b -> a+fromLeft (Left a) = a+fromLeft _ = error "Either.fromLeft: Right"++-- | Transforms an Either value into a Maybe value. Right is mapped to Just+-- and Left is mapped to Nothing. The value inside Left is lost.+eitherToMaybe :: Either a b -> Maybe b+eitherToMaybe (Right b) = Just b+eitherToMaybe _ = Nothing++-- | Transforms a Maybe value into an Either value. Just is mapped to Right and+-- Nothing is mapped to Left. You also pass in an error value in case Left is+-- returned.+maybeToEither :: b -> Maybe a -> Either b a+maybeToEither err m = maybe (Left err) Right m++-- | Lift a Either computation into the EitherT monad+liftEither :: Monad m => Either b a -> EitherT b m a+liftEither = hoistEither++-- | Lift a Maybe computation into the EitherT monad+liftMaybe :: Monad m => b -> Maybe a -> EitherT b m a+liftMaybe err = liftEither . (maybeToEither err)++-- Various helpers++-- | Applies a function to only one element of a list defined by it's index.+-- If the index is out of the bounds of the list, the original list is returned+updateIndex :: Int      -- ^ The index of the element to change+            -> [a]      -- ^ The list of elements+            -> (a -> a) -- ^ The function to apply+            -> [a]      -- ^ The result with one element changed+updateIndex i xs f +    | i < 0 || i >= length xs = xs+    | otherwise = l ++ (f h : r)+  where +    (l,h:r) = splitAt i xs++-- | Use the list [b] as a template and try to match the elements of [a]+-- against it. For each element of [b] return the (first) matching element of+-- [a], or Nothing. Output list has same size as [b] and contains results in+-- same order. Elements of [a] can only appear once.+matchTemplate :: [a]              -- ^ The input list+              -> [b]              -- ^ The list to serve as a template +              -> (a -> b -> Bool) -- ^ The comparison function+              -> [Maybe a]        -- ^ Results of the template matching+matchTemplate [] bs _ = replicate (length bs) Nothing+matchTemplate _  [] _ = []+matchTemplate as (b:bs) f = case break (flip f b) as of+    (l,(r:rs)) -> (Just r) : matchTemplate (l ++ rs) bs f+    _          -> Nothing  : matchTemplate as bs f++fst3 :: (a,b,c) -> a+fst3 (a,_,_) = a++snd3 :: (a,b,c) -> b+snd3 (_,b,_) = b++lst3 :: (a,b,c) -> c+lst3 (_,_,c) = c+
+ Network/Haskoin/Util/BuildMonad.hs view
@@ -0,0 +1,136 @@+{-|+  The Build type, and associated operations.+-}+module Network.Haskoin.Util.BuildMonad +( Build(..)+, BuildT(..)+, isComplete+, isPartial+, isBroken+, eitherToBuild+, buildToEither+, guardPartial+, liftBuild+) where++import Control.Monad (liftM)+import Control.Monad.Trans +    ( MonadTrans+    , MonadIO+    , lift+    , liftIO+    )++{-|+  The Build monad represents computations that can be in one of three states:+  +      * Complete++      * Partial++      * Broken++  It extends the Either monad with an additional Partial value to describe a+  valid computation flagged with a Partial context. The Build monad is useful+  when you describe computations where parts of the computation are either+  complete, partially complete or broken. Combining only Complete computations+  will produce a Complete result. However, if one of the computations is+  Partial, the whole computation will be Partial as well. And if some+  computation is Broken, the whole computation will be broken as well.++  The Build monad is used by Haskoin to describe the state of the transaction+  signing computation. To sign a transaction, all input scripts need to be +  signed. The whole transaction will be completely signed only if all the+  input scripts are completely signed. If any of the inputs is partially signed,+  then the whole transaction will be partially signed as well. And the whole+  transaction is broken if one of the inputs failed to parse or is broken.+-}+data Build a +    -- | Describes a successful complete computation+    = Complete { runBuild :: a } +    -- | Describes a successful but partial computation+    | Partial  { runBuild :: a }+    -- | Describes a broken computation+    | Broken   { runBroken  :: String }+    deriving Eq++instance Show a => Show (Build a) where+    show (Complete a) = "Complete " ++ (show a)+    show (Partial a)  = "Partial " ++ (show a)+    show (Broken str) = "Broken " ++ str++instance Functor Build where+    fmap f (Complete x) = Complete (f x)+    fmap f (Partial x)  = Partial (f x)+    fmap _ (Broken s)   = Broken s++instance Monad Build where+    return = Complete+    Complete x >>= f = f x+    Partial x >>= f = case f x of+        e@(Broken _) -> e+        a            -> Partial $ runBuild a+    Broken s >>= _ = Broken s++-- | Returns True if the Build value is Complete+isComplete :: Build a -> Bool+isComplete (Complete _) = True+isComplete _            = False++-- | Returns True if the Build value is Partial+isPartial :: Build a -> Bool+isPartial (Partial _) = True+isPartial _           = False++-- | Return True if the Build value is Broken+isBroken :: Build a -> Bool+isBroken (Broken _) = True+isBroken _          = False++-- | Transforms an Either String value into a Build value. Right is mapped to+-- Complete and Left is mapped to Broken+eitherToBuild :: Either String a -> Build a+eitherToBuild m = case m of+    Left  err -> Broken err +    Right res -> Complete res++-- | Transforms a Build value into an Either String value. Complete and Partial+-- are mapped to Right and Broken is mapped to Left.+buildToEither :: Build a -> Either String a+buildToEither m = case m of+    Complete a   -> Right a+    Partial  a   -> Right a+    Broken   err -> Left err++-- | Binds a Partial value to the computation when the predicate is False.+guardPartial :: Bool -> Build ()+guardPartial True  = Complete ()+guardPartial False = Partial ()++-- | BuildT transformer monad+newtype BuildT m a = BuildT { runBuildT :: m (Build a) }++mapBuildT :: (m (Build a) -> n (Build b)) -> BuildT m a -> BuildT n b+mapBuildT f = BuildT . f . runBuildT++instance Functor m => Functor (BuildT m) where+    fmap f = mapBuildT (fmap (fmap f))++instance Monad m => Monad (BuildT m) where+    return = lift . return+    x >>= f = BuildT $ do+        v <- runBuildT x+        case v of Complete a -> runBuildT (f a)+                  Partial a  -> runBuildT (f a)+                  Broken str -> return $ Broken str++instance MonadTrans BuildT where+    lift = BuildT . liftM Complete++instance MonadIO m => MonadIO (BuildT m) where+    liftIO = lift . liftIO++-- | Lift a Build computation into the BuildT monad+liftBuild :: Monad m => Build a -> BuildT m a+liftBuild = BuildT . return+
+ Network/Haskoin/Util/Constants.hs view
@@ -0,0 +1,55 @@+{-|+  Declaration of constants used across the bitcoin protocol.+-}+module Network.Haskoin.Util.Constants where++import Data.Word (Word8,Word32)++-- | Prefix for base58 PubKey hash address+addrPrefix :: Word8+addrPrefix = 0++-- | Prefix for base58 script hash address+scriptPrefix :: Word8+scriptPrefix = 5++-- | Prefix for private key WIF format+secretPrefix :: Word8+secretPrefix = 128++-- | Prefix for extended public keys (BIP32)+extPubKeyPrefix :: Word32+extPubKeyPrefix = 0x0488b21e++-- | Prefix for extended private keys (BIP32)+extSecretPrefix :: Word32+extSecretPrefix = 0x0488ade4++-- | Network magic bytes+networkMagic :: Word32+networkMagic = 0xf9beb4d9 ++-- | Genesis block header information+genesisHeader :: [Integer]+genesisHeader =+    -- Hash = 000000000019d6689c085ae165831e934ff763ae46a2a6c172b3f1b60a8ce26f+    [ 0x01+    , 0x00+    , 0x3ba3edfd7a7b12b27ac72c3e67768f617fc81bc3888a51323a9fb8aa4b1e5e4a+    , 1231006505+    , 486604799+    , 2083236893+    ]++-- | Maximum size of a block in bytes+maxBlockSize :: Int+maxBlockSize = 1000000++-- | Wallet database file name+walletFile :: String+walletFile = "walletdb"++-- | User agent of this haskoin package+haskoinUserAgent :: String+haskoinUserAgent = "/haskoin:0.0.2/"+
+ Network/Haskoin/Util/Constants/Testnet.hs view
@@ -0,0 +1,55 @@+{-|+  Declaration of constants used across the testnet bitcoin protocol+-}+module Network.Haskoin.Util.Constants.Testnet where++import Data.Word (Word8,Word32)++-- | Prefix for base58 PubKey hash address+addrPrefix :: Word8+addrPrefix = 111++-- | Prefix for base58 script hash address+scriptPrefix :: Word8+scriptPrefix = 196++-- | Prefix for private key WIF format+secretPrefix :: Word8+secretPrefix = 239++-- | Prefix for extended public keys (BIP32)+extPubKeyPrefix :: Word32+extPubKeyPrefix = 0x043587cf++-- | Prefix for extended private keys (BIP32)+extSecretPrefix :: Word32+extSecretPrefix = 0x04358394++-- | Network magic bytes+networkMagic :: Word32+networkMagic = 0x0b110907 ++-- | Genesis block header information+genesisHeader :: [Integer]+genesisHeader =+    -- Hash = 000000000933ea01ad0ee984209779baaec3ced90fa3f408719526f8d77f4943+    [ 0x01+    , 0x00+    , 0x3ba3edfd7a7b12b27ac72c3e67768f617fc81bc3888a51323a9fb8aa4b1e5e4a+    , 1296688602+    , 486604799+    , 414098458+    ]++-- | Maximum size of a block in bytes+maxBlockSize :: Int+maxBlockSize = 1000000++-- | Wallet database file name+walletFile :: String+walletFile = "testwalletdb"++-- | User agent of this haskoin package+haskoinUserAgent :: String+haskoinUserAgent = "/haskoin:0.0.2/"+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ UNLICENSE view
@@ -0,0 +1,24 @@+This is free and unencumbered software released into the public domain.++Anyone is free to copy, modify, publish, use, compile, sell, or+distribute this software, either in source code form or as a compiled+binary, for any purpose, commercial or non-commercial, and by any+means.++In jurisdictions that recognize copyright laws, the author or authors+of this software dedicate any and all copyright interest in the+software to the public domain. We make this dedication for the benefit+of the public at large and to the detriment of our heirs and+successors. We intend this dedication to be an overt act of+relinquishment in perpetuity of all present and future rights to this+software under copyright law.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR+OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,+ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.++For more information, please refer to <http://unlicense.org/>
+ haskoin.cabal view
@@ -0,0 +1,149 @@+name:                  haskoin+version:               0.0.2+synopsis:              Implementation of the Bitcoin protocol.+description:+    Haskoin is a package providing an implementation of the Bitcoin protocol+    specifications. It provides the cryptographic ECDSA and hashing primitives,+    functions for handling BIP32 extended keys, functions for building and+    signing various types of regular and multisig transactions and a definition+    of the network protocol messages.+homepage:              http://github.com/plaprade/haskoin+bug-reports:           http://github.com/plaprade/haskoin/issues+stability:             experimental+license:               PublicDomain+license-file:          UNLICENSE+author:                Philippe Laprade, Jean-Pierre Rupp+maintainer:            plaprade+hackage@gmail.com+category:              Bitcoin, Finance, Network+build-type:            Simple+cabal-version:         >= 1.9.2+extra-source-files:    tests/data/*.json++source-repository head+    type:     git+    location: git://github.com/plaprade/haskoin.git+++library+    exposed-modules:   Network.Haskoin.Util,+                       Network.Haskoin.Stratum,+                       Network.Haskoin.Crypto,+                       Network.Haskoin.Protocol,+                       Network.Haskoin.Script,+                       Network.Haskoin.Transaction+    other-modules:     Network.Haskoin.Util.BuildMonad,+                       Network.Haskoin.Util.Constants,+                       Network.Haskoin.Util.Constants.Testnet,+                       Network.Haskoin.Crypto.NumberTheory, +                       Network.Haskoin.Crypto.Curve, +                       Network.Haskoin.Crypto.Hash, +                       Network.Haskoin.Crypto.BigWord,+                       Network.Haskoin.Crypto.Point,+                       Network.Haskoin.Crypto.Base58,+                       Network.Haskoin.Crypto.Keys,+                       Network.Haskoin.Crypto.ExtendedKeys,+                       Network.Haskoin.Crypto.NormalizedKeys,+                       Network.Haskoin.Crypto.ECDSA,+                       Network.Haskoin.Crypto.Mnemonic,+                       Network.Haskoin.Crypto.Merkle,+                       Network.Haskoin.Crypto.Bloom,+                       Network.Haskoin.Protocol.Message,+                       Network.Haskoin.Protocol.VarInt,+                       Network.Haskoin.Protocol.BlockHeader,+                       Network.Haskoin.Protocol.Addr, +                       Network.Haskoin.Protocol.Tx, +                       Network.Haskoin.Protocol.NotFound, +                       Network.Haskoin.Protocol.NetworkAddress, +                       Network.Haskoin.Protocol.Inv, +                       Network.Haskoin.Protocol.VarString, +                       Network.Haskoin.Protocol.GetBlocks, +                       Network.Haskoin.Protocol.Ping, +                       Network.Haskoin.Protocol.Script, +                       Network.Haskoin.Protocol.InvVector, +                       Network.Haskoin.Protocol.Alert, +                       Network.Haskoin.Protocol.MessageHeader, +                       Network.Haskoin.Protocol.Block, +                       Network.Haskoin.Protocol.MerkleBlock, +                       Network.Haskoin.Protocol.BloomFilter, +                       Network.Haskoin.Protocol.Version, +                       Network.Haskoin.Protocol.GetData, +                       Network.Haskoin.Protocol.Headers, +                       Network.Haskoin.Protocol.GetHeaders,+                       Network.Haskoin.Script.Parser, +                       Network.Haskoin.Script.SigHash,+                       Network.Haskoin.Stratum.Message,+                       Network.Haskoin.Stratum.Conduit,+                       Network.Haskoin.Transaction.Builder+    build-depends:     aeson                >= 0.7  && < 0.8,+                       base                 >= 4.6  && < 4.7, +                       binary               >= 0.7  && < 0.8, +                       byteable             >= 0.1  && < 0.2,+                       bytestring           >= 0.10 && < 0.11, +                       conduit              >= 1.1  && < 1.2,+                       conduit-extra        >= 1.1  && < 1.2,+                       containers           >= 0.5  && < 0.6,+                       cryptohash           >= 0.11 && < 0.12,+                       either               >= 4.0  && < 4.1,+                       mtl                  >= 2.1  && < 2.2, +                       pbkdf                >= 1.1  && < 1.2,+                       split                >= 0.2  && < 0.3,+                       text                 >= 0.11 && < 0.12,+                       text-icu             >= 0.6  && < 0.7,+                       vector               >= 0.10 && < 0.11+    ghc-options:       -Wall -fno-warn-orphans++test-suite test-haskoin+    type:              exitcode-stdio-1.0+    main-is:           Main.hs+    other-modules:     Network.Haskoin.Util.Tests,+                       Network.Haskoin.Util.Arbitrary,+                       Network.Haskoin.Crypto.BigWord.Tests,+                       Network.Haskoin.Crypto.Point.Tests,+                       Network.Haskoin.Crypto.ECDSA.Tests,+                       Network.Haskoin.Crypto.Base58.Tests,+                       Network.Haskoin.Crypto.Keys.Tests,+                       Network.Haskoin.Crypto.ExtendedKeys.Tests,+                       Network.Haskoin.Crypto.ExtendedKeys.Units,+                       Network.Haskoin.Crypto.Hash.Tests,+                       Network.Haskoin.Crypto.Hash.Units,+                       Network.Haskoin.Crypto.Mnemonic.Tests,+                       Network.Haskoin.Crypto.Mnemonic.Units,+                       Network.Haskoin.Crypto.Bloom.Tests,+                       Network.Haskoin.Crypto.Bloom.Units,+                       Network.Haskoin.Crypto.Merkle.Tests,+                       Network.Haskoin.Crypto.Merkle.Units,+                       Network.Haskoin.Crypto.Arbitrary,+                       Network.Haskoin.Crypto.Units,+                       Network.Haskoin.Protocol.Arbitrary,+                       Network.Haskoin.Protocol.Tests,+                       Network.Haskoin.Protocol.Units,+                       Network.Haskoin.Script.Arbitrary,+                       Network.Haskoin.Script.Tests,+                       Network.Haskoin.Script.Units,+                       Network.Haskoin.Transaction.Tests,+                       Network.Haskoin.Transaction.Units,+                       Network.Haskoin.Transaction.Arbitrary,+                       Network.Haskoin.Stratum.Units+    build-depends:     aeson                      >= 0.7  && < 0.8,+                       base                       >= 4.6  && < 4.7, +                       binary                     >= 0.7  && < 0.8, +                       byteable                   >= 0.1  && < 0.2,+                       bytestring                 >= 0.10 && < 0.11, +                       conduit                    >= 1.1  && < 1.2,+                       conduit-extra              >= 1.1  && < 1.2,+                       containers                 >= 0.5  && < 0.6,+                       cryptohash                 >= 0.11 && < 0.12,+                       either                     >= 4.0  && < 4.1,+                       mtl                        >= 2.1  && < 2.2, +                       pbkdf                      >= 1.1  && < 1.2,+                       split                      >= 0.2  && < 0.3,+                       text                       >= 0.11 && < 0.12,+                       text-icu                   >= 0.6  && < 0.7,+                       HUnit                      >= 1.2  && < 1.3,+                       QuickCheck                 >= 2.6  && < 2.7,+                       test-framework             >= 0.8  && < 0.9, +                       test-framework-quickcheck2 >= 0.3  && < 0.4, +                       test-framework-hunit       >= 0.3  && < 0.4 +    hs-source-dirs:    . tests+    ghc-options:       -Wall -fno-warn-orphans+
+ tests/Main.hs view
@@ -0,0 +1,68 @@+module Main where++import Test.Framework (defaultMain)++-- Util tests+import qualified Network.Haskoin.Util.Tests (tests)++-- Crypto tests+import qualified Network.Haskoin.Crypto.BigWord.Tests (tests)+import qualified Network.Haskoin.Crypto.Point.Tests (tests)+import qualified Network.Haskoin.Crypto.ECDSA.Tests (tests)+import qualified Network.Haskoin.Crypto.Base58.Tests (tests)+import qualified Network.Haskoin.Crypto.Keys.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.Mnemonic.Tests (tests)+import qualified Network.Haskoin.Crypto.Mnemonic.Units (tests)+import qualified Network.Haskoin.Crypto.Bloom.Tests (tests)+import qualified Network.Haskoin.Crypto.Bloom.Units (tests)+import qualified Network.Haskoin.Crypto.Merkle.Tests (tests)+import qualified Network.Haskoin.Crypto.Merkle.Units (tests)+import qualified Network.Haskoin.Crypto.Units (tests)++-- Protocol tests+import qualified Network.Haskoin.Protocol.Tests (tests)+import qualified Network.Haskoin.Protocol.Units (tests)++-- Script tests+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 (tests)++-- Stratum tests+import qualified Network.Haskoin.Stratum.Units (tests)++main :: IO ()+main = defaultMain+    (  Network.Haskoin.Util.Tests.tests+    ++ Network.Haskoin.Crypto.BigWord.Tests.tests +    ++ Network.Haskoin.Crypto.Point.Tests.tests +    ++ Network.Haskoin.Crypto.ECDSA.Tests.tests +    ++ Network.Haskoin.Crypto.Base58.Tests.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.Bloom.Tests.tests +    ++ Network.Haskoin.Crypto.Bloom.Units.tests +    ++ Network.Haskoin.Crypto.Merkle.Tests.tests +    ++ Network.Haskoin.Crypto.Merkle.Units.tests +    ++ Network.Haskoin.Crypto.Units.tests+    ++ Network.Haskoin.Protocol.Tests.tests+    ++ Network.Haskoin.Protocol.Units.tests+    ++ Network.Haskoin.Script.Tests.tests+    ++ Network.Haskoin.Script.Units.tests+    ++ Network.Haskoin.Transaction.Tests.tests+    ++ Network.Haskoin.Transaction.Units.tests+    ++ Network.Haskoin.Stratum.Units.tests+    )+
+ tests/Network/Haskoin/Crypto/Arbitrary.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE EmptyDataDecls #-}+{-| +  QuickCheck Arbitrary instances for Haskoin.Crypto types.+-}+module Network.Haskoin.Crypto.Arbitrary +( Test32+, TestPrvKeyC(..)+, TestPrvKeyU(..)+, genPrvKeyC+, genPrvKeyU+)  where++import Test.QuickCheck+import Network.Haskoin.Util.Arbitrary()++import Control.Applicative ((<$>), (<*>))++import Data.Maybe++import Network.Haskoin.Crypto.Point+import Network.Haskoin.Crypto.Hash+import Network.Haskoin.Crypto.BigWord+import Network.Haskoin.Crypto.ECDSA+import Network.Haskoin.Crypto.Keys+import Network.Haskoin.Crypto.Base58+import Network.Haskoin.Crypto.Curve+import Network.Haskoin.Crypto.ExtendedKeys+import Network.Haskoin.Crypto.NormalizedKeys++data Mod32+type Test32 = BigWord Mod32++instance BigWordMod Mod32 where+    rFromInteger i = BigWord $ i `mod` 2 ^ (32 :: Integer)+    rBitSize     _ = 32++instance BigWordMod n => Arbitrary (BigWord n) where+    arbitrary = arbitrarySizedBoundedIntegral++instance Arbitrary CheckSum32 where+    arbitrary = chksum32 <$> arbitrary++instance Arbitrary Point where+    arbitrary = frequency+        [ (1, return makeInfPoint)+        , (9, (flip mulPoint $ curveG) <$> (arbitrary :: Gen FieldN))+        ]++-- | Generate an arbitrary compressed private key+genPrvKeyC :: Gen PrvKey+genPrvKeyC = do+    i <- fromInteger <$> choose (1, curveN-1)+    return $ fromJust $ makePrvKey i++-- | Generate an arbitrary uncompressed private key+genPrvKeyU :: Gen PrvKey+genPrvKeyU = do+    i <- fromInteger <$> choose (1, curveN-1)+    return $ fromJust $ makePrvKeyU i++newtype TestPrvKeyC = TestPrvKeyC { getTestPrvKeyC :: PrvKey }+    deriving (Eq, Show)++newtype TestPrvKeyU = TestPrvKeyU { getTestPrvKeyU :: PrvKey }+    deriving (Eq, Show)++instance Arbitrary TestPrvKeyC where+    arbitrary = TestPrvKeyC <$> genPrvKeyC++instance Arbitrary TestPrvKeyU where+    arbitrary = TestPrvKeyU <$> genPrvKeyU++instance Arbitrary PrvKey where+    arbitrary = oneof [genPrvKeyC, genPrvKeyU]++instance Arbitrary PubKey where+    arbitrary = derivePubKey <$> arbitrary++instance Arbitrary Address where+    arbitrary = do+        i <- fromInteger <$> choose (1,2^(160-1 :: Int))+        elements [ PubKeyAddress i+                 , ScriptAddress i+                 ]++instance Arbitrary Signature where+    arbitrary = do+        msg <- arbitrary+        prv <- prvKeyFieldN <$> arbitrary+        non <- prvKeyFieldN <$> arbitrary+        let pub  = mulPoint non curveG+        case unsafeSignMsg msg prv (non,pub) of+            (Just sig) -> return sig+            Nothing    -> arbitrary ++instance Arbitrary XPrvKey where+    arbitrary = XPrvKey <$> arbitrary+                        <*> arbitrary+                        <*> arbitrary+                        <*> arbitrary+                        <*> genPrvKeyC++instance Arbitrary XPubKey where+    arbitrary = deriveXPubKey <$> arbitrary++instance Arbitrary MasterKey where+    arbitrary = fromJust . makeMasterKey <$> arbitrary++instance Arbitrary AccPrvKey where+    arbitrary = do+        master <- arbitrary+        index  <- choose (0,0x7fffffff)+        return $ fromJust $ accPrvKey master index++instance Arbitrary AccPubKey where+    arbitrary = do+        master <- arbitrary+        index  <- choose (0,0x7fffffff)+        return $ fromJust $ accPubKey master index++instance Arbitrary AddrPrvKey where+    arbitrary = do+        accKey <- arbitrary+        index  <- arbitrary+        elements [ fromJust $ extPrvKey accKey index+                 , fromJust $ intPrvKey accKey index+                 ]++instance Arbitrary AddrPubKey where+    arbitrary = do+        accKey <- arbitrary+        index  <- arbitrary+        elements [ fromJust $ extPubKey accKey index+                 , fromJust $ intPubKey accKey index+                 ]+
+ tests/Network/Haskoin/Crypto/Base58/Tests.hs view
@@ -0,0 +1,32 @@+module Network.Haskoin.Crypto.Base58.Tests (tests) where++import Test.Framework (Test, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import Data.Maybe (fromJust)+import qualified Data.ByteString as BS (ByteString)++import Network.Haskoin.Crypto.Arbitrary()+import Network.Haskoin.Util.Arbitrary()++import Network.Haskoin.Crypto.Base58++tests :: [Test]+tests = +    [ testGroup "Address and Base58"+        [ testProperty "decode58( encode58(i) ) = i" decodeEncode58+        , testProperty "decode58Chk( encode58Chk(i) ) = i" decodeEncode58Check+        , testProperty "decode58( encode58(address) ) = address" decEncAddr+        ]+    ]++decodeEncode58 :: BS.ByteString -> Bool+decodeEncode58 bs = (fromJust $ decodeBase58 $ encodeBase58 bs) == bs++decodeEncode58Check :: BS.ByteString -> Bool+decodeEncode58Check bs = +    (fromJust $ decodeBase58Check $ encodeBase58Check bs) == bs++decEncAddr :: Address -> Bool+decEncAddr a = (fromJust $ base58ToAddr $ addrToBase58 a) == a+
+ tests/Network/Haskoin/Crypto/BigWord/Tests.hs view
@@ -0,0 +1,349 @@+module Network.Haskoin.Crypto.BigWord.Tests (tests) where++import Test.QuickCheck.Property (Property, (==>))+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import Data.Bits +    ( isSigned+    , bit+    , testBit+    , shift+    , bitSize+    , popCount+    , (.&.), (.|.)+    , xor, complement+    )+import Data.Word (Word8, Word32)+import qualified Data.ByteString as BS (length, index)++import Network.Haskoin.Crypto.Arbitrary +import Network.Haskoin.Crypto.BigWord+import Network.Haskoin.Crypto.NumberTheory+import Network.Haskoin.Crypto.Curve+import Network.Haskoin.Util++tests :: [Test]+tests = +    [ testGroup "Number Theory" +        [ testProperty "a * inv(a) = 1 (mod p)" inverseMod+        , testProperty "a * inv(a) = 1 (mod p) in FieldP" inverseModP+        , testProperty "a * inv(a) = 1 (mod n) in FieldN" inverseModN+        , testProperty "sqrt( a^2 ) = a (mod p)" sqrtP+        ],+      testGroup "BigWord Numeric"+        [ testProperty "BigWord fromInteger" ringFromInteger+        , testProperty "BigWord addition" ringAddition+        , testProperty "BigWord multiplication" ringMult+        , testProperty "BigWord negation" ringNegate+        , testProperty "BigWord abs" ringAbs+        , testProperty "BigWord signum" ringSignum+        ],+      testGroup "BigWord Bits"+        [ testProperty "BigWord AND" ringAnd+        , testProperty "BigWord OR" ringOr+        , testProperty "BigWord XOR" ringXor+        , testProperty "BigWord Complement" ringComplement+        , testProperty "BigWord Shift" ringShift+        , testProperty "BigWord Bitsize" ringBitsize+        , testProperty "BigWord Testbit" ringTestbit+        , testProperty "BigWord Bit" ringBit+        , testProperty "BigWord PopCount" ringPopCount+        , testProperty "BigWord IsSigned" ringIsSigned+        ],+      testGroup "BigWord Bounded"+        [ testProperty "BigWord minBound" ringMinBound+        , testProperty "BigWord maxBound" ringMaxBound+        ],+      testGroup "BigWord Enum"+        [ testProperty "BigWord succ" ringSucc+        , testProperty "BigWord pred" ringPred+        , testProperty "BigWord toEnum" ringToEnum+        , testProperty "BigWord fromEnum" ringFromEnum+        ],+      testGroup "BigWord Integral"+        [ testProperty "BigWord Quot" ringQuot+        , testProperty "BigWord Rem" ringRem+        , testProperty "BigWord Div" ringDiv+        , testProperty "BigWord Mod" ringMod+        , testProperty "BigWord QuotRem" ringQuotRem+        , testProperty "BigWord DivMod" ringDivMod+        , testProperty "BigWord toInteger" ringToInteger+        ],+      testGroup "BigWord Binary"+        [ testProperty "get( put(Word512) ) = Word512" getPutWord512+        , testProperty "get( put(Word256) ) = Word256" getPutWord256+        , testProperty "get( put(Word160) ) = Word160" getPutWord160+        , testProperty "get( put(Word128) ) = Word128" getPutWord128+        , testProperty "get( put(FieldP) ) = FieldP" getPutModP+        , testProperty "size( put(FieldP) ) = 32" putModPSize+        , testProperty "get( put(FieldN) ) = FieldN" getPutModN+        , testProperty "Verify DER of put(FieldN)" putModNSize+        ],+      testGroup "BigWord Read Show"+        [ testProperty "read( show(Word512) ) = Word512" readShowWord512+        , testProperty "read( show(Word256) ) = Word256" readShowWord256+        , testProperty "read( show(Word160) ) = Word160" readShowWord160+        , testProperty "read( show(Word128) ) = Word128" readShowWord128+        , testProperty "read( show(FieldP) ) = FieldP" readShowModP+        , testProperty "read( show(FieldN) ) = FieldN" readShowModN+        ]+    ]++{- Number Theory -}++inverseMod :: Integer -> Property+inverseMod i = p > 0 ==> (p * (mulInverse p curveP)) `mod` curveP == 1+  where +    p = abs i++inverseModP :: FieldP -> Property+inverseModP r = r > 0 ==> r/r == 1++inverseModN :: FieldN -> Property+inverseModN r = r > 0 ==> r/r == 1++sqrtP :: FieldP -> Bool+sqrtP x = (a == x && b == (-x)) || (a == (-x) && b == x)+  where +    (a:b:_) = quadraticResidue (x^(2 :: Int))++{- BigWord Numeric -}++ringFromInteger :: Integer -> Bool+ringFromInteger i = getBigWordInteger ring == fromIntegral model+  where +    model = fromInteger i :: Word32+    ring  = fromInteger i :: Test32++ringAddition :: Integer -> Integer -> Bool+ringAddition i1 i2 = getBigWordInteger ring == fromIntegral model+  where +    model = (fromInteger i1) + (fromInteger i2) :: Word32+    ring  = (fromInteger i1) + (fromInteger i2) :: Test32++ringMult :: Integer -> Integer -> Bool+ringMult i1 i2 = getBigWordInteger ring == fromIntegral model+  where +    model = (fromInteger i1) * (fromInteger i2) :: Word32+    ring  = (fromInteger i1) * (fromInteger i2) :: Test32++ringNegate :: Integer -> Bool+ringNegate i = getBigWordInteger ring == fromIntegral model+  where +    model = negate (fromInteger i) :: Word32+    ring  = negate (fromInteger i) :: Test32++ringAbs :: Integer -> Bool+ringAbs i = getBigWordInteger ring == fromIntegral model+  where +    model = abs (fromInteger i) :: Word32+    ring  = abs (fromInteger i) :: Test32++ringSignum :: Integer -> Bool+ringSignum i = getBigWordInteger ring == fromIntegral model+  where +    model = signum (fromInteger i) :: Word32+    ring  = signum (fromInteger i) :: Test32++{- BigWord Bits -}++ringAnd :: Integer -> Integer -> Bool+ringAnd i1 i2 = getBigWordInteger ring == fromIntegral model+  where +    model = (fromInteger i1) .&. (fromInteger i2) :: Word32+    ring  = (fromInteger i1) .&. (fromInteger i2) :: Test32++ringOr :: Integer -> Integer -> Bool+ringOr i1 i2 = getBigWordInteger ring == fromIntegral model+  where +    model = (fromInteger i1) .|. (fromInteger i2) :: Word32+    ring  = (fromInteger i1) .|. (fromInteger i2) :: Test32+          +ringXor :: Integer -> Integer -> Bool+ringXor i1 i2 = getBigWordInteger ring == fromIntegral model+  where +    model = (fromInteger i1) `xor` (fromInteger i2) :: Word32+    ring  = (fromInteger i1) `xor` (fromInteger i2) :: Test32++ringComplement :: Integer -> Bool+ringComplement i = getBigWordInteger ring == fromIntegral model+  where +    model = complement (fromInteger i) :: Word32+    ring  = complement (fromInteger i) :: Test32++ringShift :: Integer -> Word8 -> Bool+ringShift i j = getBigWordInteger ring == fromIntegral model+  where +    model = shift (fromInteger i) (fromIntegral j) :: Word32+    ring  = shift (fromInteger i) (fromIntegral j) :: Test32++ringBitsize :: Integer -> Bool+ringBitsize i = ring == model+  where +    model = bitSize ((fromInteger i) :: Word32) +    ring  = bitSize ((fromInteger i) :: Test32) ++ringTestbit :: Integer -> Word8 -> Bool+ringTestbit i j = ring == model+  where +    model = testBit ((fromInteger i) :: Word32) (fromIntegral j)+    ring  = testBit ((fromInteger i) :: Test32) (fromIntegral j)++ringBit :: Word8 -> Bool+ringBit i = getBigWordInteger ring == fromIntegral model+  where +    model = bit (fromIntegral i) :: Word32+    ring  = bit (fromIntegral i) :: Test32++ringPopCount :: Integer -> Bool+ringPopCount i = ring == model+  where +    model = popCount ((fromInteger i) :: Word32)+    ring  = popCount ((fromInteger i) :: Test32)++ringIsSigned :: Integer -> Bool+ringIsSigned i = ring == model+  where +    model = isSigned ((fromInteger i) :: Word32)+    ring  = isSigned ((fromInteger i) :: Test32)++{- BigWord Bounded -}++ringMinBound :: Test32 -> Bool+ringMinBound _ = (minBound :: Test32) - 1 == (maxBound :: Test32)++ringMaxBound :: Test32 -> Bool+ringMaxBound _ = (maxBound :: Test32) + 1 == (minBound :: Test32)++{- BigWord Enum -}++ringSucc :: Integer -> Property+ringSucc i = (fromIntegral i) /= maxB ==> +    getBigWordInteger ring == fromIntegral model+  where +    model = succ (fromInteger i) :: Word32+    ring  = succ (fromInteger i) :: Test32+    maxB   = maxBound :: Word32++ringPred :: Integer -> Property+ringPred i = (fromIntegral i) /= minB ==> +    getBigWordInteger ring == fromIntegral model+  where +    model = pred (fromInteger i) :: Word32+    ring  = pred (fromInteger i) :: Test32+    minB   = minBound :: Word32++ringToEnum :: Word32 -> Bool+ringToEnum w = getBigWordInteger ring == fromIntegral model+  where +    model = toEnum (fromIntegral w) :: Word32+    ring  = toEnum (fromIntegral w) :: Test32++ringFromEnum :: Integer -> Bool+ringFromEnum i = model == ring+  where +    model = fromEnum ((fromInteger i) :: Word32)+    ring  = fromEnum ((fromInteger i) :: Test32)++{- BigWord Integral -}++ringQuot :: Integer -> Integer -> Property+ringQuot i1 i2 = i2 /= 0 ==> getBigWordInteger ring == fromIntegral model+  where +    model = (fromInteger i1) `quot` (fromInteger i2) :: Word32+    ring  = (fromInteger i1) `quot` (fromInteger i2) :: Test32++ringRem :: Integer -> Integer -> Property+ringRem i1 i2 = i2 /= 0 ==> getBigWordInteger ring == fromIntegral model+  where +    model = (fromInteger i1) `rem` (fromInteger i2) :: Word32+    ring  = (fromInteger i1) `rem` (fromInteger i2) :: Test32++ringDiv :: Integer -> Integer -> Property+ringDiv i1 i2 = i2 /= 0 ==> getBigWordInteger ring == fromIntegral model+  where +    model = (fromInteger i1) `div` (fromInteger i2) :: Word32+    ring  = (fromInteger i1) `div` (fromInteger i2) :: Test32++ringMod :: Integer -> Integer -> Property+ringMod i1 i2 = i2 /= 0 ==> getBigWordInteger ring == fromIntegral model+  where +    model = (fromInteger i1) `mod` (fromInteger i2) :: Word32+    ring  = (fromInteger i1) `mod` (fromInteger i2) :: Test32++ringQuotRem :: Integer -> Integer -> Property+ringQuotRem i1 i2 = i2 /= 0 ==> +    (getBigWordInteger r1 == fromIntegral m1) && +    (getBigWordInteger r2 == fromIntegral m2)+  where +    (m1,m2) = (fromInteger i1) `quotRem` (fromInteger i2) :: (Word32, Word32)+    (r1,r2) = (fromInteger i1) `quotRem` (fromInteger i2) :: (Test32, Test32)++ringDivMod :: Integer -> Integer -> Property+ringDivMod i1 i2 = i2 /= 0 ==> +    (getBigWordInteger r1 == fromIntegral m1) && +    (getBigWordInteger r2 == fromIntegral m2)+  where +    (m1,m2) = (fromInteger i1) `divMod` (fromInteger i2) :: (Word32, Word32)+    (r1,r2) = (fromInteger i1) `divMod` (fromInteger i2) :: (Test32, Test32)++ringToInteger :: Test32 -> Bool+ringToInteger r@(BigWord i) = toInteger r == i++{- BigWord Binary -}++getPutWord512 :: Word512 -> Bool+getPutWord512 r = r == (decode' $ encode' r)++getPutWord256 :: Word256 -> Bool+getPutWord256 r = r == (decode' $ encode' r)++getPutWord160 :: Word160 -> Bool+getPutWord160 r = r == (decode' $ encode' r)++getPutWord128 :: Word128 -> Bool+getPutWord128 r = r == (decode' $ encode' r)++getPutModP :: FieldP -> Bool+getPutModP r = r == (decode' $ encode' r)++putModPSize :: FieldP -> Bool+putModPSize r = BS.length (encode' r) == 32++getPutModN :: FieldN -> Property+getPutModN r = r > 0 ==> r == (decode' $ encode' r)++putModNSize :: FieldN -> Property+putModNSize r = r > 0 ==>+    (  a == 0x02    -- DER type is Integer+    && b <= 33      -- Can't be bigger than 32 + 0x00 padding+    && l == fromIntegral (b + 2) -- Advertised length matches+    && c < 0x80     -- High byte is never 1+    )+  where +    bs = encode' r+    a  = BS.index bs 0+    b  = BS.index bs 1+    c  = BS.index bs 2+    l  = BS.length bs++{- BigWord Read Show -}++readShowWord512 :: Word512 -> Bool+readShowWord512 r = r == (read $ show r)++readShowWord256 :: Word256 -> Bool+readShowWord256 r = r == (read $ show r)++readShowWord160 :: Word160 -> Bool+readShowWord160 r = r == (read $ show r)++readShowWord128 :: Word128 -> Bool+readShowWord128 r = r == (read $ show r)++readShowModP :: FieldP -> Bool+readShowModP r = r == (read $ show r)++readShowModN :: FieldN -> Property+readShowModN r = r > 0 ==> r == (read $ show r)
+ tests/Network/Haskoin/Crypto/Bloom/Tests.hs view
@@ -0,0 +1,22 @@+module Network.Haskoin.Crypto.Bloom.Tests (tests) where++import Test.Framework (Test, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import Network.Haskoin.Protocol.Arbitrary ()+import Network.Haskoin.Crypto+import Network.Haskoin.Util++tests :: [Test]+tests = +    [ testGroup "Bloom Filters"+        [ testProperty "decode . encode BloomFilter" decodeEncodeBloom+        ]+    ]++{- Bloom Filters -}++decodeEncodeBloom :: BloomFilter -> Bool+decodeEncodeBloom bfilter = (decode' $ encode' bfilter) == bfilter++
+ tests/Network/Haskoin/Crypto/Bloom/Units.hs view
@@ -0,0 +1,71 @@+module Network.Haskoin.Crypto.Bloom.Units (tests) where++import Test.HUnit (Assertion, assertBool)+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.HUnit (testCase)++import Data.Maybe (fromJust)++import Network.Haskoin.Crypto+import Network.Haskoin.Util++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+      ]+    ]++bloomFilter1 :: Assertion+bloomFilter1 = do+    assertBool "Bloom filter doesn't contain vector 1" $ bloomContains f1 v1+    assertBool "Bloom filter contains something it should not" $+        not $ bloomContains f1 v2+    assertBool "Bloom filter doesn't contain vector 3" $ bloomContains f3 v3+    assertBool "Bloom filter doesn't contain vector 4" $ bloomContains f4 v4+    assertBool "Bloom filter serialization is incorrect" $ (encode' f4) == bs+  where+    f0 = bloomCreate 3 0.01 0 BloomUpdateAll+    f1 = bloomInsert f0 v1+    f3 = bloomInsert f1 v3+    f4 = bloomInsert f3 v4+    v1 = fromJust $ hexToBS "99108ad8ed9bb6274d3980bab5a85c048f0950c8"+    v2 = fromJust $ hexToBS "19108ad8ed9bb6274d3980bab5a85c048f0950c8"+    v3 = fromJust $ hexToBS "b5a2c786d9ef4658287ced5914b37a1b4aa32eee"+    v4 = fromJust $ hexToBS "b9300670b4c5366e95b2699e8b18bc75e5f729c5"+    bs = fromJust $ hexToBS "03614e9b050000000000000001"++bloomFilter2 :: Assertion+bloomFilter2 = do+    assertBool "Bloom filter doesn't contain vector 1" $ bloomContains f1 v1+    assertBool "Bloom filter contains something it should not" $+        not $ bloomContains f1 v2+    assertBool "Bloom filter doesn't contain vector 3" $ bloomContains f3 v3+    assertBool "Bloom filter doesn't contain vector 4" $ bloomContains f4 v4+    assertBool "Bloom filter serialization is incorrect" $ (encode' f4) == bs+  where+    f0 = bloomCreate 3 0.01 2147483649 BloomUpdateAll+    f1 = bloomInsert f0 v1+    f3 = bloomInsert f1 v3+    f4 = bloomInsert f3 v4+    v1 = fromJust $ hexToBS "99108ad8ed9bb6274d3980bab5a85c048f0950c8"+    v2 = fromJust $ hexToBS "19108ad8ed9bb6274d3980bab5a85c048f0950c8"+    v3 = fromJust $ hexToBS "b5a2c786d9ef4658287ced5914b37a1b4aa32eee"+    v4 = fromJust $ hexToBS "b9300670b4c5366e95b2699e8b18bc75e5f729c5"+    bs = fromJust $ hexToBS "03ce4299050000000100008001"++bloomFilter3 :: Assertion+bloomFilter3 = do+    assertBool "Bloom filter serialization is incorrect" $ (encode' f2) == bs+  where+    f0 = bloomCreate 2 0.001 0 BloomUpdateAll+    f1 = bloomInsert f0 $ encode' p+    f2 = bloomInsert f1 $ encode' $ getAddrHash $ pubKeyAddr p+    k = fromJust $ fromWIF "5Kg1gnAjaLfKiwhhPpGS3QfRg2m6awQvaj98JCZBZQ5SuS2F15C"+    p = derivePubKey k+    bs = fromJust $ hexToBS "038fc16b080000000000000001"+
+ tests/Network/Haskoin/Crypto/ECDSA/Tests.hs view
@@ -0,0 +1,97 @@+module Network.Haskoin.Crypto.ECDSA.Tests (tests) where++import Test.Framework (Test, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.QuickCheck.Property ((==>), Property)++import Data.Bits (testBit)+import qualified Data.ByteString as BS++import Network.Haskoin.Crypto.Arbitrary++import Network.Haskoin.Crypto.ECDSA+import Network.Haskoin.Crypto.Point+import Network.Haskoin.Crypto.BigWord+import Network.Haskoin.Crypto.Keys+import Network.Haskoin.Crypto.Curve+import Network.Haskoin.Util++tests :: [Test]+tests = +    [ testGroup "ECDSA signatures"+        [ testProperty "verify( sign(msg) ) = True" signAndVerify+        , testProperty "verify( detSign(msg) ) = True" signAndVerifyD+        , testProperty "S component <= order/2" halfOrderSig+        ],+      testGroup "ECDSA Binary"+        [ testProperty "get( put(Sig) ) = Sig" getPutSig+        , testProperty "Encoded signature is canonical" testIsCanonical+        ]+    ]++{- ECDSA Signatures -}++signAndVerify :: Hash256 -> FieldN -> FieldN -> Property+signAndVerify msg k n = k > 0 && n > 0 ==> case sM of+    (Just s) -> verifySig msg s (PubKey kP)+    Nothing  -> True -- very bad luck+    where kP = mulPoint k curveG+          nP = mulPoint n curveG+          sM = unsafeSignMsg msg k (n,nP)++signAndVerifyD :: Hash256 -> TestPrvKeyC -> Bool+signAndVerifyD msg (TestPrvKeyC k) = verifySig msg (detSignMsg msg k) p+    where p = derivePubKey k+           +halfOrderSig :: Signature -> Bool+halfOrderSig sig@(Signature _ (BigWord s)) = +    s <= (curveN `div` 2) && isCanonicalHalfOrder sig++{- ECDSA Binary -}++getPutSig :: Signature -> Bool+getPutSig sig = (decode' $ encode' sig) == sig++-- github.com/bitcoin/bitcoin/blob/master/src/script.cpp+-- from function IsCanonicalSignature+testIsCanonical :: Signature -> Bool+testIsCanonical sig = not $+    -- Non-canonical signature: too short+    (len < 8) ||+    -- Non-canonical signature: too long+    (len > 72) ||+    -- Non-canonical signature: wrong type+    (BS.index s 0 /= 0x30) ||+    -- Non-canonical signature: wrong length marker+    (BS.index s 1 /= len - 2) ||+    -- Non-canonical signature: S length misplaced+    (5 + rlen >= len) || +    -- Non-canonical signature: R+S length mismatch+    (rlen + slen + 6 /= len) ||+    -- Non-canonical signature: R value type mismatch+    (BS.index s 2 /= 0x02) ||+    -- Non-canonical signature: R length is zero+    (rlen == 0) ||+    -- Non-canonical signature: R value negative+    (testBit (BS.index s 4) 7) ||+    -- Non-canonical signature: R value excessively padded+    (  rlen > 1 +    && BS.index s 4 == 0 +    && not (testBit (BS.index s 5) 7)+    ) ||+    -- Non-canonical signature: S value type mismatch+    (BS.index s (fromIntegral rlen+4) /= 0x02) ||+    -- Non-canonical signature: S length is zero+    (slen == 0) ||+    -- Non-canonical signature: S value negative+    (testBit (BS.index s (fromIntegral rlen+6)) 7) ||+    -- Non-canonical signature: S value excessively padded+    (  slen > 1+    && BS.index s (fromIntegral rlen+6) == 0 +    && not (testBit (BS.index s (fromIntegral rlen+7)) 7)+    ) +    where s = encode' sig+          len = fromIntegral $ BS.length s+          rlen = BS.index s 3+          slen = BS.index s (fromIntegral rlen + 5)+
+ tests/Network/Haskoin/Crypto/ExtendedKeys/Tests.hs view
@@ -0,0 +1,66 @@+module Network.Haskoin.Crypto.ExtendedKeys.Tests (tests) where++import Test.Framework (Test, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import Control.Monad (liftM2)+import Control.Applicative ((<$>))++import Data.Word (Word32)+import Data.Bits ((.&.))+import Data.Maybe (fromJust)++import Network.Haskoin.Crypto+import Network.Haskoin.Crypto.Arbitrary()+import Network.Haskoin.Util++tests :: [Test]+tests = +    [ testGroup "HDW Extended Keys"+        [ testProperty "prvSubKey(k,c)*G = pubSubKey(k*G,c)" subkeyTest+        , testProperty "decode . encode prvKey" binXPrvKey+        , testProperty "decode . encode pubKey" binXPubKey+        , testProperty "fromB58 . toB58 prvKey" b58PrvKey+        , testProperty "fromB58 . toB58 pubKey" b58PubKey+        ]+    , testGroup "HDW Normalized Keys"+        [ testProperty "decode . encode masterKey" decEncMaster+        , testProperty "decode . encode prvAccKey" decEncPrvAcc+        , testProperty "decode . encode pubAccKey" decEncPubAcc+        ]+    ]++{- HDW Extended Keys -}++subkeyTest :: XPrvKey -> Word32 -> Bool+subkeyTest k i = fromJust $ liftM2 (==) +    (deriveXPubKey <$> prvSubKey k i') (pubSubKey (deriveXPubKey k) i')+    where i' = fromIntegral $ i .&. 0x7fffffff -- make it a public derivation++binXPrvKey :: XPrvKey -> Bool+binXPrvKey k = (decode' $ encode' k) == k++binXPubKey :: XPubKey -> Bool+binXPubKey k = (decode' $ encode' k) == k++b58PrvKey :: XPrvKey -> Bool+b58PrvKey k = (fromJust $ xPrvImport $ xPrvExport k) == k++b58PubKey :: XPubKey -> Bool+b58PubKey k = (fromJust $ xPubImport $ xPubExport k) == k++{- HDW Normalized Keys -}++decEncMaster :: MasterKey -> Bool+decEncMaster k = (fromJust $ loadMasterKey $ decode' bs) == k+    where bs = encode' $ masterKey k++decEncPrvAcc :: AccPrvKey -> Bool+decEncPrvAcc k = (fromJust $ loadPrvAcc $ decode' bs) == k+    where bs = encode' $ getAccPrvKey k++decEncPubAcc :: AccPubKey -> Bool+decEncPubAcc k = (fromJust $ loadPubAcc $ decode' bs) == k+    where bs = encode' $ getAccPubKey k++
+ tests/Network/Haskoin/Crypto/ExtendedKeys/Units.hs view
@@ -0,0 +1,250 @@+module Network.Haskoin.Crypto.ExtendedKeys.Units (tests) where++import Test.HUnit (Assertion, assertBool)+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.HUnit (testCase)++import Data.Maybe (fromJust, catMaybes)++import Network.Haskoin.Crypto+import Network.Haskoin.Util++tests :: [Test]+tests =+    [ testGroup "BIP32 derivation vector 1" +        [ testCase "Chain m" $ runXKeyVec (xKeyVec !! 0)+        , 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 (xKeyVec2 !! 0)+        , 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)+        ] +    ]+++runXKeyVec :: ([String],XPrvKey) -> Assertion+runXKeyVec (v,m) = do+    assertBool "xPrvID" $ (bsToHex $ encode' $ xPrvID m) == v !! 0+    assertBool "xPrvFP" $ (bsToHex $ encode' $ xPrvFP m) == v !! 1+    assertBool "xPrvAddr" $ +        (addrToBase58 $ xPubAddr $ deriveXPubKey m) == v !! 2+    assertBool "prvKey" $ (bsToHex $ runPut' $ putPrvKey $ xPrvKey m) == v !! 3+    assertBool "xPrvWIF" $ xPrvWIF m == v !! 4+    assertBool "pubKey" $ +        (bsToHex $ encode' $ xPubKey $ deriveXPubKey m) == v !! 5+    assertBool "chain code" $ (bsToHex $ encode' $ xPrvChain m) == v !! 6+    assertBool "Hex PubKey" $ (bsToHex $ encode' $ deriveXPubKey m) == v !! 7+    assertBool "Hex PrvKey" $ (bsToHex $ encode' m) == v !! 8+    assertBool "Base58 PubKey" $ (xPubExport $ deriveXPubKey m) == v !! 9+    assertBool "Base58 PrvKey" $ xPrvExport m == v !! 10++-- BIP 0032 Test Vectors+-- https://en.bitcoin.it/wiki/BIP_0032_TestVectors++xKeyVec :: [([String],XPrvKey)]+xKeyVec = zip xKeyResVec $ catMaybes $ foldl f [m] der+    where f acc d = acc ++ [d =<< last acc]+          m   = makeXPrvKey $ fromJust $ hexToBS m0+          der = [ flip primeSubKey 0+                , flip prvSubKey 1+                , flip primeSubKey 2+                , flip prvSubKey 2+                , flip prvSubKey 1000000000+                ]++xKeyVec2 :: [([String],XPrvKey)]+xKeyVec2 = zip xKeyResVec2 $ catMaybes $ foldl f [m] der+    where f acc d = acc ++ [d =<< last acc]+          m   = makeXPrvKey $ fromJust $ hexToBS m1+          der = [ flip prvSubKey 0+                , flip primeSubKey 2147483647+                , flip prvSubKey 1+                , flip primeSubKey 2147483646+                , flip prvSubKey 2+                ]++m0 :: String+m0 = "000102030405060708090a0b0c0d0e0f"++xKeyResVec :: [[String]]+xKeyResVec =+    [+      -- m+      [ "3442193e1bb70916e914552172cd4e2dbc9df811"+      , "3442193e"+      , "15mKKb2eos1hWa6tisdPwwDC1a5J1y9nma"+      , "e8f32e723decf4051aefac8e2c93c9c5b214313817cdb01a1494b917c8436b35"+      , "L52XzL2cMkHxqxBXRyEpnPQZGUs3uKiL3R11XbAdHigRzDozKZeW"+      , "0339a36013301597daef41fbe593a02cc513d0b55527ec2df1050e2e8ff49c85c2"+      , "873dff81c02f525623fd1fe5167eac3a55a049de3d314bb42ee227ffed37d508"+      , "0488b21e000000000000000000873dff81c02f525623fd1fe5167eac3a55a049de3d314bb42ee227ffed37d5080339a36013301597daef41fbe593a02cc513d0b55527ec2df1050e2e8ff49c85c2"+      , "0488ade4000000000000000000873dff81c02f525623fd1fe5167eac3a55a049de3d314bb42ee227ffed37d50800e8f32e723decf4051aefac8e2c93c9c5b214313817cdb01a1494b917c8436b35"+      , "xpub661MyMwAqRbcFtXgS5sYJABqqG9YLmC4Q1Rdap9gSE8NqtwybGhePY2gZ29ESFjqJoCu1Rupje8YtGqsefD265TMg7usUDFdp6W1EGMcet8"+      , "xprv9s21ZrQH143K3QTDL4LXw2F7HEK3wJUD2nW2nRk4stbPy6cq3jPPqjiChkVvvNKmPGJxWUtg6LnF5kejMRNNU3TGtRBeJgk33yuGBxrMPHi"+      ]+      -- m/0'+    , [ "5c1bd648ed23aa5fd50ba52b2457c11e9e80a6a7"+      , "5c1bd648"+      , "19Q2WoS5hSS6T8GjhK8KZLMgmWaq4neXrh"+      , "edb2e14f9ee77d26dd93b4ecede8d16ed408ce149b6cd80b0715a2d911a0afea"+      , "L5BmPijJjrKbiUfG4zbiFKNqkvuJ8usooJmzuD7Z8dkRoTThYnAT"+      , "035a784662a4a20a65bf6aab9ae98a6c068a81c52e4b032c0fb5400c706cfccc56"+      , "47fdacbd0f1097043b78c63c20c34ef4ed9a111d980047ad16282c7ae6236141"+      , "0488b21e013442193e8000000047fdacbd0f1097043b78c63c20c34ef4ed9a111d980047ad16282c7ae6236141035a784662a4a20a65bf6aab9ae98a6c068a81c52e4b032c0fb5400c706cfccc56"+      , "0488ade4013442193e8000000047fdacbd0f1097043b78c63c20c34ef4ed9a111d980047ad16282c7ae623614100edb2e14f9ee77d26dd93b4ecede8d16ed408ce149b6cd80b0715a2d911a0afea"+      , "xpub68Gmy5EdvgibQVfPdqkBBCHxA5htiqg55crXYuXoQRKfDBFA1WEjWgP6LHhwBZeNK1VTsfTFUHCdrfp1bgwQ9xv5ski8PX9rL2dZXvgGDnw"+      , "xprv9uHRZZhk6KAJC1avXpDAp4MDc3sQKNxDiPvvkX8Br5ngLNv1TxvUxt4cV1rGL5hj6KCesnDYUhd7oWgT11eZG7XnxHrnYeSvkzY7d2bhkJ7"+      ]+      -- m/0'/1+    , [ "bef5a2f9a56a94aab12459f72ad9cf8cf19c7bbe"+      , "bef5a2f9"+      , "1JQheacLPdM5ySCkrZkV66G2ApAXe1mqLj"+      , "3c6cb8d0f6a264c91ea8b5030fadaa8e538b020f0a387421a12de9319dc93368"+      , "KyFAjQ5rgrKvhXvNMtFB5PCSKUYD1yyPEe3xr3T34TZSUHycXtMM"+      , "03501e454bf00751f24b1b489aa925215d66af2234e3891c3b21a52bedb3cd711c"+      , "2a7857631386ba23dacac34180dd1983734e444fdbf774041578e9b6adb37c19"+      , "0488b21e025c1bd648000000012a7857631386ba23dacac34180dd1983734e444fdbf774041578e9b6adb37c1903501e454bf00751f24b1b489aa925215d66af2234e3891c3b21a52bedb3cd711c"+      , "0488ade4025c1bd648000000012a7857631386ba23dacac34180dd1983734e444fdbf774041578e9b6adb37c19003c6cb8d0f6a264c91ea8b5030fadaa8e538b020f0a387421a12de9319dc93368"+      , "xpub6ASuArnXKPbfEwhqN6e3mwBcDTgzisQN1wXN9BJcM47sSikHjJf3UFHKkNAWbWMiGj7Wf5uMash7SyYq527Hqck2AxYysAA7xmALppuCkwQ"+      , "xprv9wTYmMFdV23N2TdNG573QoEsfRrWKQgWeibmLntzniatZvR9BmLnvSxqu53Kw1UmYPxLgboyZQaXwTCg8MSY3H2EU4pWcQDnRnrVA1xe8fs"+      ]+      -- m/0'/1/2'+    , [ "ee7ab90cde56a8c0e2bb086ac49748b8db9dce72"+      , "ee7ab90c"+      , "1NjxqbA9aZWnh17q1UW3rB4EPu79wDXj7x"+      , "cbce0d719ecf7431d88e6a89fa1483e02e35092af60c042b1df2ff59fa424dca"+      , "L43t3od1Gh7Lj55Bzjj1xDAgJDcL7YFo2nEcNaMGiyRZS1CidBVU"+      , "0357bfe1e341d01c69fe5654309956cbea516822fba8a601743a012a7896ee8dc2"+      , "04466b9cc8e161e966409ca52986c584f07e9dc81f735db683c3ff6ec7b1503f"+      , "0488b21e03bef5a2f98000000204466b9cc8e161e966409ca52986c584f07e9dc81f735db683c3ff6ec7b1503f0357bfe1e341d01c69fe5654309956cbea516822fba8a601743a012a7896ee8dc2"+      , "0488ade403bef5a2f98000000204466b9cc8e161e966409ca52986c584f07e9dc81f735db683c3ff6ec7b1503f00cbce0d719ecf7431d88e6a89fa1483e02e35092af60c042b1df2ff59fa424dca"+      , "xpub6D4BDPcP2GT577Vvch3R8wDkScZWzQzMMUm3PWbmWvVJrZwQY4VUNgqFJPMM3No2dFDFGTsxxpG5uJh7n7epu4trkrX7x7DogT5Uv6fcLW5"+      , "xprv9z4pot5VBttmtdRTWfWQmoH1taj2axGVzFqSb8C9xaxKymcFzXBDptWmT7FwuEzG3ryjH4ktypQSAewRiNMjANTtpgP4mLTj34bhnZX7UiM"+      ]+      -- m/0'/1/2'/2+    , [ "d880d7d893848509a62d8fb74e32148dac68412f"+      , "d880d7d8"+      , "1LjmJcdPnDHhNTUgrWyhLGnRDKxQjoxAgt"+      , "0f479245fb19a38a1954c5c7c0ebab2f9bdfd96a17563ef28a6a4b1a2a764ef4"+      , "KwjQsVuMjbCP2Zmr3VaFaStav7NvevwjvvkqrWd5Qmh1XVnCteBR"+      , "02e8445082a72f29b75ca48748a914df60622a609cacfce8ed0e35804560741d29"+      , "cfb71883f01676f587d023cc53a35bc7f88f724b1f8c2892ac1275ac822a3edd"+      , "0488b21e04ee7ab90c00000002cfb71883f01676f587d023cc53a35bc7f88f724b1f8c2892ac1275ac822a3edd02e8445082a72f29b75ca48748a914df60622a609cacfce8ed0e35804560741d29"+      , "0488ade404ee7ab90c00000002cfb71883f01676f587d023cc53a35bc7f88f724b1f8c2892ac1275ac822a3edd000f479245fb19a38a1954c5c7c0ebab2f9bdfd96a17563ef28a6a4b1a2a764ef4"+      , "xpub6FHa3pjLCk84BayeJxFW2SP4XRrFd1JYnxeLeU8EqN3vDfZmbqBqaGJAyiLjTAwm6ZLRQUMv1ZACTj37sR62cfN7fe5JnJ7dh8zL4fiyLHV"+      , "xprvA2JDeKCSNNZky6uBCviVfJSKyQ1mDYahRjijr5idH2WwLsEd4Hsb2Tyh8RfQMuPh7f7RtyzTtdrbdqqsunu5Mm3wDvUAKRHSC34sJ7in334"+      ]+      -- m/0'/1/2'/2/1000000000+    , [ "d69aa102255fed74378278c7812701ea641fdf32"+      , "d69aa102"+      , "1LZiqrop2HGR4qrH1ULZPyBpU6AUP49Uam"+      , "471b76e389e528d6de6d816857e012c5455051cad6660850e58372a6c3e6e7c8"+      , "Kybw8izYevo5xMh1TK7aUr7jHFCxXS1zv8p3oqFz3o2zFbhRXHYs"+      , "022a471424da5e657499d1ff51cb43c47481a03b1e77f951fe64cec9f5a48f7011"+      , "c783e67b921d2beb8f6b389cc646d7263b4145701dadd2161548a8b078e65e9e"+      , "0488b21e05d880d7d83b9aca00c783e67b921d2beb8f6b389cc646d7263b4145701dadd2161548a8b078e65e9e022a471424da5e657499d1ff51cb43c47481a03b1e77f951fe64cec9f5a48f7011"+      , "0488ade405d880d7d83b9aca00c783e67b921d2beb8f6b389cc646d7263b4145701dadd2161548a8b078e65e9e00471b76e389e528d6de6d816857e012c5455051cad6660850e58372a6c3e6e7c8"+      , "xpub6H1LXWLaKsWFhvm6RVpEL9P4KfRZSW7abD2ttkWP3SSQvnyA8FSVqNTEcYFgJS2UaFcxupHiYkro49S8yGasTvXEYBVPamhGW6cFJodrTHy"+      , "xprvA41z7zogVVwxVSgdKUHDy1SKmdb533PjDz7J6N6mV6uS3ze1ai8FHa8kmHScGpWmj4WggLyQjgPie1rFSruoUihUZREPSL39UNdE3BBDu76"+      ]+    ]++m1 :: String+m1 = "fffcf9f6f3f0edeae7e4e1dedbd8d5d2cfccc9c6c3c0bdbab7b4b1aeaba8a5a29f9c999693908d8a8784817e7b7875726f6c696663605d5a5754514e4b484542"++xKeyResVec2 :: [[String]]+xKeyResVec2 =+    [+      -- m+      [ "bd16bee53961a47d6ad888e29545434a89bdfe95"+      , "bd16bee5"+      , "1JEoxevbLLG8cVqeoGKQiAwoWbNYSUyYjg"+      , "4b03d6fc340455b363f51020ad3ecca4f0850280cf436c70c727923f6db46c3e"+      , "KyjXhyHF9wTphBkfpxjL8hkDXDUSbE3tKANT94kXSyh6vn6nKaoy"+      , "03cbcaa9c98c877a26977d00825c956a238e8dddfbd322cce4f74b0b5bd6ace4a7"+      , "60499f801b896d83179a4374aeb7822aaeaceaa0db1f85ee3e904c4defbd9689"+      , "0488b21e00000000000000000060499f801b896d83179a4374aeb7822aaeaceaa0db1f85ee3e904c4defbd968903cbcaa9c98c877a26977d00825c956a238e8dddfbd322cce4f74b0b5bd6ace4a7"+      , "0488ade400000000000000000060499f801b896d83179a4374aeb7822aaeaceaa0db1f85ee3e904c4defbd9689004b03d6fc340455b363f51020ad3ecca4f0850280cf436c70c727923f6db46c3e"+      , "xpub661MyMwAqRbcFW31YEwpkMuc5THy2PSt5bDMsktWQcFF8syAmRUapSCGu8ED9W6oDMSgv6Zz8idoc4a6mr8BDzTJY47LJhkJ8UB7WEGuduB"+      , "xprv9s21ZrQH143K31xYSDQpPDxsXRTUcvj2iNHm5NUtrGiGG5e2DtALGdso3pGz6ssrdK4PFmM8NSpSBHNqPqm55Qn3LqFtT2emdEXVYsCzC2U"+      ]+      -- m/0+    , [ "5a61ff8eb7aaca3010db97ebda76121610b78096"+      , "5a61ff8e"+      , "19EuDJdgfRkwCmRzbzVBHZWQG9QNWhftbZ"+      , "abe74a98f6c7eabee0428f53798f0ab8aa1bd37873999041703c742f15ac7e1e"+      , "L2ysLrR6KMSAtx7uPqmYpoTeiRzydXBattRXjXz5GDFPrdfPzKbj"+      , "02fc9e5af0ac8d9b3cecfe2a888e2117ba3d089d8585886c9c826b6b22a98d12ea"+      , "f0909affaa7ee7abe5dd4e100598d4dc53cd709d5a5c2cac40e7412f232f7c9c"+      , "0488b21e01bd16bee500000000f0909affaa7ee7abe5dd4e100598d4dc53cd709d5a5c2cac40e7412f232f7c9c02fc9e5af0ac8d9b3cecfe2a888e2117ba3d089d8585886c9c826b6b22a98d12ea"+      , "0488ade401bd16bee500000000f0909affaa7ee7abe5dd4e100598d4dc53cd709d5a5c2cac40e7412f232f7c9c00abe74a98f6c7eabee0428f53798f0ab8aa1bd37873999041703c742f15ac7e1e"+      , "xpub69H7F5d8KSRgmmdJg2KhpAK8SR3DjMwAdkxj3ZuxV27CprR9LgpeyGmXUbC6wb7ERfvrnKZjXoUmmDznezpbZb7ap6r1D3tgFxHmwMkQTPH"+      , "xprv9vHkqa6EV4sPZHYqZznhT2NPtPCjKuDKGY38FBWLvgaDx45zo9WQRUT3dKYnjwih2yJD9mkrocEZXo1ex8G81dwSM1fwqWpWkeS3v86pgKt"+      ]+      -- m/0/2147483647'+    , [ "d8ab493736da02f11ed682f88339e720fb0379d1"+      , "d8ab4937"+      , "1Lke9bXGhn5VPrBuXgN12uGUphrttUErmk"+      , "877c779ad9687164e9c2f4f0f4ff0340814392330693ce95a58fe18fd52e6e93"+      , "L1m5VpbXmMp57P3knskwhoMTLdhAAaXiHvnGLMribbfwzVRpz2Sr"+      , "03c01e7425647bdefa82b12d9bad5e3e6865bee0502694b94ca58b666abc0a5c3b"+      , "be17a268474a6bb9c61e1d720cf6215e2a88c5406c4aee7b38547f585c9a37d9"+      , "0488b21e025a61ff8effffffffbe17a268474a6bb9c61e1d720cf6215e2a88c5406c4aee7b38547f585c9a37d903c01e7425647bdefa82b12d9bad5e3e6865bee0502694b94ca58b666abc0a5c3b"+      , "0488ade4025a61ff8effffffffbe17a268474a6bb9c61e1d720cf6215e2a88c5406c4aee7b38547f585c9a37d900877c779ad9687164e9c2f4f0f4ff0340814392330693ce95a58fe18fd52e6e93"+      , "xpub6ASAVgeehLbnwdqV6UKMHVzgqAG8Gr6riv3Fxxpj8ksbH9ebxaEyBLZ85ySDhKiLDBrQSARLq1uNRts8RuJiHjaDMBU4Zn9h8LZNnBC5y4a"+      , "xprv9wSp6B7kry3Vj9m1zSnLvN3xH8RdsPP1Mh7fAaR7aRLcQMKTR2vidYEeEg2mUCTAwCd6vnxVrcjfy2kRgVsFawNzmjuHc2YmYRmagcEPdU9"+      ]+      -- m/0/2147483647'/1+    , [ "78412e3a2296a40de124307b6485bd19833e2e34"+      , "78412e3a"+      , "1BxrAr2pHpeBheusmd6fHDP2tSLAUa3qsW"+      , "704addf544a06e5ee4bea37098463c23613da32020d604506da8c0518e1da4b7"+      , "KzyzXnznxSv249b4KuNkBwowaN3akiNeEHy5FWoPCJpStZbEKXN2"+      , "03a7d1d856deb74c508e05031f9895dab54626251b3806e16b4bd12e781a7df5b9"+      , "f366f48f1ea9f2d1d3fe958c95ca84ea18e4c4ddb9366c336c927eb246fb38cb"+      , "0488b21e03d8ab493700000001f366f48f1ea9f2d1d3fe958c95ca84ea18e4c4ddb9366c336c927eb246fb38cb03a7d1d856deb74c508e05031f9895dab54626251b3806e16b4bd12e781a7df5b9"+      , "0488ade403d8ab493700000001f366f48f1ea9f2d1d3fe958c95ca84ea18e4c4ddb9366c336c927eb246fb38cb00704addf544a06e5ee4bea37098463c23613da32020d604506da8c0518e1da4b7"+      , "xpub6DF8uhdarytz3FWdA8TvFSvvAh8dP3283MY7p2V4SeE2wyWmG5mg5EwVvmdMVCQcoNJxGoWaU9DCWh89LojfZ537wTfunKau47EL2dhHKon"+      , "xprv9zFnWC6h2cLgpmSA46vutJzBcfJ8yaJGg8cX1e5StJh45BBciYTRXSd25UEPVuesF9yog62tGAQtHjXajPPdbRCHuWS6T8XA2ECKADdw4Ef"+      ]+      -- m/0/2147483647'/1/2147483646'+    , [ "31a507b815593dfc51ffc7245ae7e5aee304246e"+      , "31a507b8"+      , "15XVotxCAV7sRx1PSCkQNsGw3W9jT9A94R"+      , "f1c7c871a54a804afe328b4c83a1c33b8e5ff48f5087273f04efa83b247d6a2d"+      , "L5KhaMvPYRW1ZoFmRjUtxxPypQ94m6BcDrPhqArhggdaTbbAFJEF"+      , "02d2b36900396c9282fa14628566582f206a5dd0bcc8d5e892611806cafb0301f0"+      , "637807030d55d01f9a0cb3a7839515d796bd07706386a6eddf06cc29a65a0e29"+      , "0488b21e0478412e3afffffffe637807030d55d01f9a0cb3a7839515d796bd07706386a6eddf06cc29a65a0e2902d2b36900396c9282fa14628566582f206a5dd0bcc8d5e892611806cafb0301f0"+      , "0488ade40478412e3afffffffe637807030d55d01f9a0cb3a7839515d796bd07706386a6eddf06cc29a65a0e2900f1c7c871a54a804afe328b4c83a1c33b8e5ff48f5087273f04efa83b247d6a2d"+      , "xpub6ERApfZwUNrhLCkDtcHTcxd75RbzS1ed54G1LkBUHQVHQKqhMkhgbmJbZRkrgZw4koxb5JaHWkY4ALHY2grBGRjaDMzQLcgJvLJuZZvRcEL"+      , "xprvA1RpRA33e1JQ7ifknakTFpgNXPmW2YvmhqLQYMmrj4xJXXWYpDPS3xz7iAxn8L39njGVyuoseXzU6rcxFLJ8HFsTjSyQbLYnMpCqE2VbFWc"+      ]+      -- m/0/2147483647'/1/2147483646'/2+    , [ "26132fdbe7bf89cbc64cf8dafa3f9f88b8666220"+      , "26132fdb"+      , "14UKfRV9ZPUp6ZC9PLhqbRtxdihW9em3xt"+      , "bb7d39bdb83ecf58f2fd82b6d918341cbef428661ef01ab97c28a4842125ac23"+      , "L3WAYNAZPxx1fr7KCz7GN9nD5qMBnNiqEJNJMU1z9MMaannAt4aK"+      , "024d902e1a2fc7a8755ab5b694c575fce742c48d9ff192e63df5193e4c7afe1f9c"+      , "9452b549be8cea3ecb7a84bec10dcfd94afe4d129ebfd3b3cb58eedf394ed271"+      , "0488b21e0531a507b8000000029452b549be8cea3ecb7a84bec10dcfd94afe4d129ebfd3b3cb58eedf394ed271024d902e1a2fc7a8755ab5b694c575fce742c48d9ff192e63df5193e4c7afe1f9c"+      , "0488ade40531a507b8000000029452b549be8cea3ecb7a84bec10dcfd94afe4d129ebfd3b3cb58eedf394ed27100bb7d39bdb83ecf58f2fd82b6d918341cbef428661ef01ab97c28a4842125ac23"+      , "xpub6FnCn6nSzZAw5Tw7cgR9bi15UV96gLZhjDstkXXxvCLsUXBGXPdSnLFbdpq8p9HmGsApME5hQTZ3emM2rnY5agb9rXpVGyy3bdW6EEgAtqt"+      , "xprvA2nrNbFZABcdryreWet9Ea4LvTJcGsqrMzxHx98MMrotbir7yrKCEXw7nadnHM8Dq38EGfSh6dqA9QWTyefMLEcBYJUuekgW4BYPJcr9E7j"+      ]+    ]+
+ tests/Network/Haskoin/Crypto/Hash/Tests.hs view
@@ -0,0 +1,30 @@+module Network.Haskoin.Crypto.Hash.Tests (tests) where++import Test.Framework (Test, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import Network.Haskoin.Crypto.Hash+import Network.Haskoin.Crypto.Arbitrary()++tests :: [Test]+tests = +    [ testGroup "Hash tests" +        [ testProperty "join512( split512(h) ) == h" joinSplit512+        , testProperty "decodeCompact . encodeCompact i == i" decEncCompact+        ]+    ]++joinSplit512 :: Hash512 -> Bool+joinSplit512 h = (join512 $ split512 h) == h++-- 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+    -- Otherwise precision will be lost and the decoded result will+    -- be smaller than the original number+    | i >= 0                = (decodeCompact $ encodeCompact i) < i+    | otherwise             = (decodeCompact $ encodeCompact i) > i+
+ tests/Network/Haskoin/Crypto/Hash/Units.hs view
@@ -0,0 +1,1300 @@+module Network.Haskoin.Crypto.Hash.Units (tests) where++import Test.HUnit (assertBool, Assertion)+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.HUnit (testCase)++import Data.Maybe (fromJust)+import Data.Word (Word32)++import Network.Haskoin.Crypto.Hash+import Network.Haskoin.Util++-- 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] +    , testGroup "Murmur Hash 3" +        (map mapMurmurVector $ zip murmurVectors [0..])+    , testGroup "Compact number representation"+        [ testCase "Compact number representations" testCompact ]+    ]++type TestVector = [String]++mapDRBG :: [TestVector] -> Test.Framework.Test+mapDRBG vs = testCase "HMAC DRBG Vectors" $ mapM_ testDRBG $ zip vs [0..]++mapDRBGRsd :: [TestVector] -> Test.Framework.Test+mapDRBGRsd vs = testCase "HMAC DRBG Vectors" $ mapM_ testDRBGRsd $ zip vs [0..]++testDRBG :: (TestVector,Int) -> Assertion+testDRBG (s,i) = do+    let w1     = hmacDRBGNew (v !! 0) (v !! 1) (v !! 2)+        (w2,_) = hmacDRBGGen w1 128 (v !! 3)+        (_,r)  = hmacDRBGGen w2 128 (v !! 4)+    assertBool name $ fromJust r == (v !! 5)+    where v = map (fromJust . hexToBS) s+          name = "    > HMAC DRBG Vector " ++ (show i)++testDRBGRsd :: (TestVector,Int) -> Assertion+testDRBGRsd (s,i) = do+    let w1 = hmacDRBGNew (v !! 0) (v !! 1) (v !! 2)+        w2 = hmacDRBGRsd w1 (v !! 3) (v !! 4)+        (w3,_) = hmacDRBGGen w2 128 (v !! 5)+        (_,r)  = hmacDRBGGen w3 128 (v !! 6)+    assertBool name $ fromJust r == (v !! 7)+    where v = map (fromJust . hexToBS) s+          name = "    > HMAC DRBG Vector " ++ (show i)++mapMurmurVector :: ((Word32,Word32,String),Int) -> Test.Framework.Test+mapMurmurVector (_,i) =+    testCase ("MurmurHash3 Vector " ++ (show i)) func+  where+    func = testMurmurVector $ murmurVectors !! i++testMurmurVector :: (Word32,Word32,String) -> Assertion+testMurmurVector (expected,seed,str) =+    assertBool "    > MurmurHash3 " $ hash == expected+  where+    hash = murmurHash3 seed (fromJust $ hexToBS str)++murmurVectors :: [(Word32,Word32,String)]+murmurVectors =+    [ (0x00000000, 0x00000000, "")+    , (0x6a396f08, 0xFBA4C795, "")+    , (0x81f16f39, 0xffffffff, "")+    , (0x514e28b7, 0x00000000, "00")+    , (0xea3f0b17, 0xFBA4C795, "00")+    , (0xfd6cf10d, 0x00000000, "ff")+    , (0x16c6b7ab, 0x00000000, "0011")+    , (0x8eb51c3d, 0x00000000, "001122")+    , (0xb4471bf8, 0x00000000, "00112233")+    , (0xe2301fa8, 0x00000000, "0011223344")+    , (0xfc2e4a15, 0x00000000, "001122334455")+    , (0xb074502c, 0x00000000, "00112233445566")+    , (0x8034d2a0, 0x00000000, "0011223344556677")+    , (0xb4698def, 0x00000000, "001122334455667788")+    ]++testCompact :: Assertion+testCompact = do+    assertBool "Vector 1" $ (encodeCompact 0x1234560000)    == 0x05123456+    assertBool "Vector 2" $ (decodeCompact 0x05123456)      == 0x1234560000+    assertBool "Vector 3" $ (encodeCompact 0xc0de000000)    == 0x0600c0de+    assertBool "Vector 4" $ (decodeCompact 0x0600c0de)      == 0xc0de000000+    assertBool "Vector 5" $ (encodeCompact (-0x40de000000)) == 0x05c0de00+    assertBool "Vector 6" $ (decodeCompact 0x05c0de00)      == (-0x40de000000)++{- +    [SHA-256]+    [PredictionResistance = False]+    [EntropyInputLen = 256]+    [NonceLen = 128]+    [PersonalizationStringLen = 0]+    [AdditionalInputLen = 0]+    [ReturnedBitsLen = 1024]+-}++t1 :: [TestVector]+t1 = +    [+    -- COUNT = 0+    [ "ca851911349384bffe89de1cbdc46e6831e44d34a4fb935ee285dd14b71a7488"+    , "659ba96c601dc69fc902940805ec0ca8"+    , ""+    , ""+    , ""+    , "e528e9abf2dece54d47c7e75e5fe302149f817ea9fb4bee6f4199697d04d5b89d54fbb978a15b5c443c9ec21036d2460b6f73ebad0dc2aba6e624abf07745bc107694bb7547bb0995f70de25d6b29e2d3011bb19d27676c07162c8b5ccde0668961df86803482cb37ed6d5c0bb8d50cf1f50d476aa0458bdaba806f48be9dcb8"+    ],+    -- COUNT = 1+    [ "79737479ba4e7642a221fcfd1b820b134e9e3540a35bb48ffae29c20f5418ea3"+    , "3593259c092bef4129bc2c6c9e19f343"+    , ""+    , ""+    , ""+    , "cf5ad5984f9e43917aa9087380dac46e410ddc8a7731859c84e9d0f31bd43655b924159413e2293b17610f211e09f770f172b8fb693a35b85d3b9e5e63b1dc252ac0e115002e9bedfb4b5b6fd43f33b8e0eafb2d072e1a6fee1f159df9b51e6c8da737e60d5032dd30544ec51558c6f080bdbdab1de8a939e961e06b5f1aca37"+    ],+    -- COUNT = 2+    [ "b340907445b97a8b589264de4a17c0bea11bb53ad72f9f33297f05d2879d898d"+    , "65cb27735d83c0708f72684ea58f7ee5"+    , ""+    , ""+    , ""+    , "75183aaaf3574bc68003352ad655d0e9ce9dd17552723b47fab0e84ef903694a32987eeddbdc48efd24195dbdac8a46ba2d972f5808f23a869e71343140361f58b243e62722088fe10a98e43372d252b144e00c89c215a76a121734bdc485486f65c0b16b8963524a3a70e6f38f169c12f6cbdd169dd48fe4421a235847a23ff"+    ],+    -- COUNT = 3+    [ "8e159f60060a7d6a7e6fe7c9f769c30b98acb1240b25e7ee33f1da834c0858e7"+    , "c39d35052201bdcce4e127a04f04d644"+    , ""+    , ""+    , ""+    , "62910a77213967ea93d6457e255af51fc79d49629af2fccd81840cdfbb4910991f50a477cbd29edd8a47c4fec9d141f50dfde7c4d8fcab473eff3cc2ee9e7cc90871f180777a97841597b0dd7e779eff9784b9cc33689fd7d48c0dcd341515ac8fecf5c55a6327aea8d58f97220b7462373e84e3b7417a57e80ce946d6120db5"+    ],+    -- COUNT = 4+    [ "74755f196305f7fb6689b2fe6835dc1d81484fc481a6b8087f649a1952f4df6a"+    , "c36387a544a5f2b78007651a7b74b749"+    , ""+    , ""+    , ""+    , "b2896f3af4375dab67e8062d82c1a005ef4ed119d13a9f18371b1b873774418684805fd659bfd69964f83a5cfe08667ddad672cafd16befffa9faed49865214f703951b443e6dca22edb636f3308380144b9333de4bcb0735710e4d9266786342fc53babe7bdbe3c01a3addb7f23c63ce2834729fabbd419b47beceb4a460236"+    ],+    -- COUNT = 5+    [ "4b222718f56a3260b3c2625a4cf80950b7d6c1250f170bd5c28b118abdf23b2f"+    , "7aed52d0016fcaef0b6492bc40bbe0e9"+    , ""+    , ""+    , ""+    , "a6da029b3665cd39fd50a54c553f99fed3626f4902ffe322dc51f0670dfe8742ed48415cf04bbad5ed3b23b18b7892d170a7dcf3ef8052d5717cb0c1a8b3010d9a9ea5de70ae5356249c0e098946030c46d9d3d209864539444374d8fbcae068e1d6548fa59e6562e6b2d1acbda8da0318c23752ebc9be0c1c1c5b3cf66dd967"+    ],+    -- COUNT = 6+    [ "b512633f27fb182a076917e39888ba3ff35d23c3742eb8f3c635a044163768e0"+    , "e2c39b84629a3de5c301db5643af1c21"+    , ""+    , ""+    , ""+    , "fb931d0d0194a97b48d5d4c231fdad5c61aedf1c3a55ac24983ecbf38487b1c93396c6b86ff3920cfa8c77e0146de835ea5809676e702dee6a78100da9aa43d8ec0bf5720befa71f82193205ac2ea403e8d7e0e6270b366dc4200be26afd9f63b7e79286a35c688c57cbff55ac747d4c28bb80a2b2097b3b62ea439950d75dff"+    ],+    -- COUNT = 7+    [ "aae3ffc8605a975befefcea0a7a286642bc3b95fb37bd0eb0585a4cabf8b3d1e"+    , "9504c3c0c4310c1c0746a036c91d9034"+    , ""+    , ""+    , ""+    , "2819bd3b0d216dad59ddd6c354c4518153a2b04374b07c49e64a8e4d055575dfbc9a8fcde68bd257ff1ba5c6000564b46d6dd7ecd9c5d684fd757df62d85211575d3562d7814008ab5c8bc00e7b5a649eae2318665b55d762de36eba00c2906c0e0ec8706edb493e51ca5eb4b9f015dc932f262f52a86b11c41e9a6d5b3bd431"+    ],+    -- COUNT = 8+    [ "b9475210b79b87180e746df704b3cbc7bf8424750e416a7fbb5ce3ef25a82cc6"+    , "24baf03599c10df6ef44065d715a93f7"+    , ""+    , ""+    , ""+    , "ae12d784f796183c50db5a1a283aa35ed9a2b685dacea97c596ff8c294906d1b1305ba1f80254eb062b874a8dfffa3378c809ab2869aa51a4e6a489692284a25038908a347342175c38401193b8afc498077e10522bec5c70882b7f760ea5946870bd9fc72961eedbe8bff4fd58c7cc1589bb4f369ed0d3bf26c5bbc62e0b2b2"+    ],+    -- COUNT = 9+    [ "27838eb44ceccb4e36210703ebf38f659bc39dd3277cd76b7a9bcd6bc964b628"+    , "39cfe0210db2e7b0eb52a387476e7ea1"+    , ""+    , ""+    , ""+    , "e5e72a53605d2aaa67832f97536445ab774dd9bff7f13a0d11fd27bf6593bfb52309f2d4f09d147192199ea584503181de87002f4ee085c7dc18bf32ce5315647a3708e6f404d6588c92b2dda599c131aa350d18c747b33dc8eda15cf40e95263d1231e1b4b68f8d829f86054d49cfdb1b8d96ab0465110569c8583a424a099a"+    ],+    -- COUNT = 10+    [ "d7129e4f47008ad60c9b5d081ff4ca8eb821a6e4deb91608bf4e2647835373a5"+    , "a72882773f78c2fc4878295840a53012"+    , ""+    , ""+    , ""+    , "0cbf48585c5de9183b7ff76557f8fc9ebcfdfde07e588a8641156f61b7952725bbee954f87e9b937513b16bba0f2e523d095114658e00f0f3772175acfcb3240a01de631c19c5a834c94cc58d04a6837f0d2782fa53d2f9f65178ee9c837222494c799e64c60406069bd319549b889fa00a0032dd7ba5b1cc9edbf58de82bfcd"+    ],+    -- COUNT = 11+    [ "67fe5e300c513371976c80de4b20d4473889c9f1214bce718bc32d1da3ab7532"+    , "e256d88497738a33923aa003a8d7845c"+    , ""+    , ""+    , ""+    , "b44660d64ef7bcebc7a1ab71f8407a02285c7592d755ae6766059e894f694373ed9c776c0cfc8594413eefb400ed427e158d687e28da3ecc205e0f7370fb089676bbb0fa591ec8d916c3d5f18a3eb4a417120705f3e2198154cd60648dbfcfc901242e15711cacd501b2c2826abe870ba32da785ed6f1fdc68f203d1ab43a64f"+    ],+    -- COUNT = 12+    [ "de8142541255c46d66efc6173b0fe3ffaf5936c897a3ce2e9d5835616aafa2cb"+    , "d01f9002c407127bc3297a561d89b81d"+    , ""+    , ""+    , ""+    , "64d1020929d74716446d8a4e17205d0756b5264867811aa24d0d0da8644db25d5cde474143c57d12482f6bf0f31d10af9d1da4eb6d701bdd605a8db74fb4e77f79aaa9e450afda50b18d19fae68f03db1d7b5f1738d2fdce9ad3ee9461b58ee242daf7a1d72c45c9213eca34e14810a9fca5208d5c56d8066bab1586f1513de7"+    ],+    -- COUNT = 13+    [ "4a8e0bd90bdb12f7748ad5f147b115d7385bb1b06aee7d8b76136a25d779bcb7"+    , "7f3cce4af8c8ce3c45bdf23c6b181a00"+    , ""+    , ""+    , ""+    , "320c7ca4bbeb7af977bc054f604b5086a3f237aa5501658112f3e7a33d2231f5536d2c85c1dad9d9b0bf7f619c81be4854661626839c8c10ae7fdc0c0b571be34b58d66da553676167b00e7d8e49f416aacb2926c6eb2c66ec98bffae20864cf92496db15e3b09e530b7b9648be8d3916b3c20a3a779bec7d66da63396849aaf"+    ],+    -- COUNT = 14+    [ "451ed024bc4b95f1025b14ec3616f5e42e80824541dc795a2f07500f92adc665"+    , "2f28e6ee8de5879db1eccd58c994e5f0"+    , ""+    , ""+    , ""+    , "3fb637085ab75f4e95655faae95885166a5fbb423bb03dbf0543be063bcd48799c4f05d4e522634d9275fe02e1edd920e26d9accd43709cb0d8f6e50aa54a5f3bdd618be23cf73ef736ed0ef7524b0d14d5bef8c8aec1cf1ed3e1c38a808b35e61a44078127c7cb3a8fd7addfa50fcf3ff3bc6d6bc355d5436fe9b71eb44f7fd"+    ]+    ]++{-+    [SHA-256]+    [PredictionResistance = False]+    [EntropyInputLen = 256]+    [NonceLen = 128]+    [PersonalizationStringLen = 0]+    [AdditionalInputLen = 256]+    [ReturnedBitsLen = 1024]+-}++t2 :: [TestVector]+t2 = +    [+    -- COUNT = 0+    [ "d3cc4d1acf3dde0c4bd2290d262337042dc632948223d3a2eaab87da44295fbd"+    , "0109b0e729f457328aa18569a9224921"+    , ""+    , "3c311848183c9a212a26f27f8c6647e40375e466a0857cc39c4e47575d53f1f6"+    , "fcb9abd19ccfbccef88c9c39bfb3dd7b1c12266c9808992e305bc3cff566e4e4"+    , "9c7b758b212cd0fcecd5daa489821712e3cdea4467b560ef5ddc24ab47749a1f1ffdbbb118f4e62fcfca3371b8fbfc5b0646b83e06bfbbab5fac30ea09ea2bc76f1ea568c9be0444b2cc90517b20ca825f2d0eccd88e7175538b85d90ab390183ca6395535d34473af6b5a5b88f5a59ee7561573337ea819da0dcc3573a22974"+    ],+    -- COUNT = 1+    [ "f97a3cfd91faa046b9e61b9493d436c4931f604b22f1081521b3419151e8ff06"+    , "11f3a7d43595357d58120bd1e2dd8aed"+    , ""+    , "517289afe444a0fe5ed1a41dbbb5eb17150079bdd31e29cf2ff30034d8268e3b"+    , "88028d29ef80b4e6f0fe12f91d7449fe75062682e89c571440c0c9b52c42a6e0"+    , "c6871cff0824fe55ea7689a52229886730450e5d362da5bf590dcf9acd67fed4cb32107df5d03969a66b1f6494fdf5d63d5b4d0d34ea7399a07d0116126d0d518c7c55ba46e12f62efc8fe28a51c9d428e6d371d7397ab319fc73ded4722e5b4f30004032a6128df5e7497ecf82ca7b0a50e867ef6728a4f509a8c859087039c"+    ],+    -- COUNT = 2+    [ "0f2f23d64f481cabec7abb01db3aabf125c3173a044b9bf26844300b69dcac8b"+    , "9a5ae13232b43aa19cfe8d7958b4b590"+    , ""+    , "ec4c7a62acab73385f567da10e892ff395a0929f959231a5628188ce0c26e818"+    , "6b97b8c6b6bb8935e676c410c17caa8042aa3145f856d0a32b641e4ae5298648"+    , "7480a361058bd9afa3db82c9d7586e42269102013f6ec5c269b6d05f17987847748684766b44918fd4b65e1648622fc0e0954178b0279dfc9fa99b66c6f53e51c4860131e9e0644287a4afe4ca8e480417e070db68008a97c3397e4b320b5d1a1d7e1d18a95cfedd7d1e74997052bf649d132deb9ec53aae7dafdab55e6dae93"+    ],+    -- COUNT = 3+    [ "53c56660c78481be9c63284e005fcc14fbc7fb27732c9bf1366d01a426765a31"+    , "dc7a14d0eb5b0b3534e717a0b3c64614"+    , ""+    , "3aa848706ecb877f5bedf4ffc332d57c22e08747a47e75cff6f0fd1316861c95"+    , "9a401afa739b8f752fddacd291e0b854f5eff4a55b515e20cb319852189d3722"+    , "5c0eb420e0bf41ce9323e815310e4e8303cd677a8a8b023f31f0d79f0ca15aeb636099a369fd074d69889865eac1b72ab3cbfebdb8cf460b00072802e2ec648b1349a5303be4ccaadd729f1a9ea17482fd026aaeb93f1602bc1404b9853adde40d6c34b844cf148bc088941ecfc1642c8c0b9778e45f3b07e06e21ee2c9e0300"+    ],+    -- COUNT = 4+    [ "f63c804404902db334c54bb298fc271a21d7acd9f770278e089775710bf4fdd7"+    , "3e45009ea9cb2a36ba1aa4bf39178200"+    , ""+    , "d165a13dc8cc43f3f0952c3f5d3de4136954d983683d4a3e6d2dc4c89bf23423"+    , "75106bc86d0336df85097f6af8e80e2da59046a03fa65b06706b8bbc7ffc6785"+    , "6363139bba32c22a0f5cd23ca6d437b5669b7d432f786b8af445471bee0b2d24c9d5f2f93717cbe00d1f010cc3b9c515fc9f7336d53d4d26ba5c0d76a90186663c8582eb739c7b6578a3328bf68dc2cec2cd89b3a90201f6993adcc854df0f5c6974d0f5570765a15fe03dbce28942dd2fd16ba2027e68abac83926969349af8"+    ],+    -- COUNT = 5+    [ "2aaca9147da66c176615726b69e3e851cc3537f5f279fe7344233d8e44cfc99d"+    , "4e171f080af9a6081bee9f183ac9e340"+    , ""+    , "d75a2a6eb66c3833e50f5ec3d2e434cf791448d618026d0c360806d120ded669"+    , "b643b74c15b37612e6577ed7ca2a4c67a78d560af9eb50a4108fca742e87b8d6"+    , "501dcdc977f4ba856f24eaa4968b374bebb3166b280334cb510232c31ebffde10fa47b7840ef3fe3b77725c2272d3a1d4219baf23e0290c622271edcced58838cf428f0517425d2e19e0d8c89377eecfc378245f283236fafa466c914b99672ceafab369e8889a0c866d8bd639db9fb797254262c6fd44cfa9045ad6340a60ef"+    ],+    -- COUNT = 6+    [ "a2e4cd48a5cf918d6f55942d95fcb4e8465cdc4f77b7c52b6fae5b16a25ca306"+    , "bef036716440db6e6d333d9d760b7ca8"+    , ""+    , "bfa591c7287f3f931168f95e38869441d1f9a11035ad8ea625bb61b9ea17591c"+    , "c00c735463bca215adc372cb892b05e939bf669583341c06d4e31d0e5b363a37"+    , "e7d136af69926a5421d4266ee0420fd729f2a4f7c295d3c966bdfa05268180b508b8a2852d1b3a06fd2ab3e13c54005123ef319f42d0c6d3a575e6e7e1496cb28aacadbcf83740fba8f35fcee04bb2ed8a51db3d3362b01094a62fb57e33c99a432f29fce6676cffbbcc05107e794e75e44a02d5e6d9d748c5fbff00a0178d65"+    ],+    -- COUNT = 7+    [ "95a67771cba69011a79776e713145d309edae56fad5fd6d41d83eaff89df6e5e"+    , "be5b5164e31ecc51ba6f7c3c5199eb33"+    , ""+    , "065f693b229a7c4fd373cd15b3807552dd9bf98c5485cef361949d4e7d774b53"+    , "9afb62406f0e812c4f156d58b19a656c904813c1b4a45a0029ae7f50731f8014"+    , "f61b61a6e79a41183e8ed6647899d2dc85cdaf5c3abf5c7f3bf37685946dc28f4923dc842f2d4326bd6ce0d50a84cb3ba869d72a36e246910eba6512ba36cd7ed3a5437c9245b00a344308c792b668b458d3c3e16dee2fbec41867da31084d46d8ec168de2148ef64fc5b72069abf5a6ada1ead2b7146bb793ff1c9c3690fa56"+    ],+    -- COUNT = 8+    [ "a459e1815cbca4514ec8094d5ab2414a557ba6fe10e613c345338d0521e4bf90"+    , "62221392e2552e76cd0d36df6e6068eb"+    , ""+    , "0a3642b02b23b3ef62c701a63401124022f5b896de86dab6e6c7451497aa1dcc"+    , "c80514865901371c45ba92d9f95d50bb7c9dd1768cb3dfbc45b968da94965c6e"+    , "464e6977b8adaef307c9623e41c357013249c9ffd77f405f3925cebb69f151ce8fbb6a277164002aee7858fc224f6499042aa1e6322deee9a5d133c31d640e12a7487c731ba03ad866a24675badb1d79220c40be689f79c2a0be93cb4dada3e0eac4ab140cb91998b6f11953e68f2319b050c40f71c34de9905ae41b2de1c2f6"+    ],+    -- COUNT = 9+    [ "252c2cad613e002478162861880979ee4e323025eebb6fb2e0aa9f200e28e0a1"+    , "d001bc9a8f2c8c242e4369df0c191989"+    , ""+    , "9bcfc61cb2bc000034bb3db980eb47c76fb5ecdd40553eff113368d639b947fd"+    , "8b0565c767c2610ee0014582e9fbecb96e173005b60e9581503a6dca5637a26e"+    , "e96c15fe8a60692b0a7d67171e0195ff6e1c87aab844221e71700d1bbee75feea695f6a740c9760bbe0e812ecf4061d8f0955bc0195e18c4fd1516ebca50ba6a6db86881737dbab8321707675479b87611db6af2c97ea361a5484555ead454defb1a64335de964fc803d40f3a6f057893d2afc25725754f4f00abc51920743dc"+    ],+    -- COUNT = 10+    [ "8be0ca6adc8b3870c9d69d6021bc1f1d8eb9e649073d35ee6c5aa0b7e56ad8a5"+    , "9d1265f7d51fdb65377f1e6edd6ae0e4"+    , ""+    , "da86167ac997c406bb7979f423986a84ec6614d6caa7afc10aff0699a9b2cf7f"+    , "e4baa3c555950b53e2bfdba480cb4c94b59381bac1e33947e0c22e838a9534cf"+    , "64384ecc4ea6b458efc227ca697eac5510092265520c0a0d8a0ccf9ed3ca9d58074671188c6a7ad16d0b050cdc072c125d7298d3a31d9f044a9ee40da0089a84fea28cc7f05f1716db952fad29a0e779635cb7a912a959be67be2f0a4170aace2981802e2ff6467e5b46f0ffbff3b42ba5935fd553c82482ac266acf1cd247d7"+    ],+    -- COUNT = 11+    [ "d43a75b6adf26d60322284cb12ac38327792442aa8f040f60a2f331b33ac4a8f"+    , "0682f8b091f811afacaacaec9b04d279"+    , ""+    , "7fd3b8f512940da7de5d80199d9a7b42670c04a945775a3dba869546cbb9bc65"+    , "2575db20bc7aafc2a90a5dabab760db851d754777bc9f05616af1858b24ff3da"+    , "0da7a8dc73c163014bf0841913d3067806456bbca6d5de92b85534c6545467313648d71ef17c923d090dc92cff8d4d1a9a2bb63e001dc2e8ab1a597999be3d6cf70ff63fee9985801395fbd4f4990430c4259fcae4fa1fcd73dc3187ccc102d04af7c07532885e5a226fc42809c48f22eecf4f6ab996ae4fcb144786957d9f41"+    ],+    -- COUNT = 12+    [ "64352f236af5d32067a529a8fd05ba00a338c9de306371a0b00c36e610a48d18"+    , "df99ed2c7608c870624b962a5dc68acd"+    , ""+    , "da416335e7aaf60cf3d06fb438735ce796aad09034f8969c8f8c3f81e32fef24"+    , "a28c07c21a2297311adf172c19e83ca0a87731bdffb80548978d2d1cd82cf8a3"+    , "132b9f25868729e3853d3c51f99a3b5fae6d4204bea70890daf62e042b776a526c8fb831b80a6d5d3f153237df1fd39b6fd9137963f5516d9cdd4e3f9195c46e9972c15d3edc6606e3368bde1594977fb88d0ca6e6f5f3d057ccadc7d7dab77dfc42658a1e972aa446b20d418286386a52dfc1c714d2ac548713268b0b709729"+    ],+    -- COUNT = 13+    [ "282f4d2e05a2cd30e9087f5633089389449f04bac11df718c90bb351cd3653a5"+    , "90a7daf3c0de9ea286081efc4a684dfb"+    , ""+    , "2630b4ccc7271cc379cb580b0aaede3d3aa8c1c7ba002cf791f0752c3d739007"+    , "c31d69de499f1017be44e3d4fa77ecebc6a9b9934749fcf136f267b29115d2cc"+    , "c899094520e0197c37b91dd50778e20a5b950decfb308d39f1db709447ae48f6101d9abe63a783fbb830eec1d359a5f61a2013728966d349213ee96382614aa4135058a967627183810c6622a2158cababe3b8ab99169c89e362108bf5955b4ffc47440f87e4bad0d36bc738e737e072e64d8842e7619f1be0af1141f05afe2d"+    ],+    -- COUNT = 14+    [ "13c752b9e745ce77bbc7c0dbda982313d3fe66f903e83ebd8dbe4ff0c11380e9"+    , "f1a533095d6174164bd7c82532464ae7"+    , ""+    , "4f53db89b9ba7fc00767bc751fb8f3c103fe0f76acd6d5c7891ab15b2b7cf67c"+    , "582c2a7d34679088cca6bd28723c99aac07db46c332dc0153d1673256903b446"+    , "6311f4c0c4cd1f86bd48349abb9eb930d4f63df5e5f7217d1d1b91a71d8a6938b0ad2b3e897bd7e3d8703db125fab30e03464fad41e5ddf5bf9aeeb5161b244468cfb26a9d956931a5412c97d64188b0da1bd907819c686f39af82e91cfeef0cbffb5d1e229e383bed26d06412988640706815a6e820796876f416653e464961"+    ]+    ]++{-+    [SHA-256]+    [PredictionResistance = False]+    [EntropyInputLen = 256]+    [NonceLen = 128]+    [PersonalizationStringLen = 256]+    [AdditionalInputLen = 0]+    [ReturnedBitsLen = 1024]+-}++t3 :: [TestVector]+t3 = +    [+    -- COUNT = 0+    [ "5cacc68165a2e2ee20812f35ec73a79dbf30fd475476ac0c44fc6174cdac2b55"+    , "6f885496c1e63af620becd9e71ecb824"+    , "e72dd8590d4ed5295515c35ed6199e9d211b8f069b3058caa6670b96ef1208d0"+    , ""+    , ""+    , "f1012cf543f94533df27fedfbf58e5b79a3dc517a9c402bdbfc9a0c0f721f9d53faf4aafdc4b8f7a1b580fcaa52338d4bd95f58966a243cdcd3f446ed4bc546d9f607b190dd69954450d16cd0e2d6437067d8b44d19a6af7a7cfa8794e5fbd728e8fb2f2e8db5dd4ff1aa275f35886098e80ff844886060da8b1e7137846b23b"+    ],+    -- COUNT = 1+    [ "8df013b4d103523073917ddf6a869793059e9943fc8654549e7ab22f7c29f122"+    , "da2625af2ddd4abcce3cf4fa4659d84e"+    , "b571e66d7c338bc07b76ad3757bb2f9452bf7e07437ae8581ce7bc7c3ac651a9"+    , ""+    , ""+    , "b91cba4cc84fa25df8610b81b641402768a2097234932e37d590b1154cbd23f97452e310e291c45146147f0da2d81761fe90fba64f94419c0f662b28c1ed94da487bb7e73eec798fbcf981b791d1be4f177a8907aa3c401643a5b62b87b89d66b3a60e40d4a8e4e9d82af6d2700e6f535cdb51f75c321729103741030ccc3a56"+    ],+    -- COUNT = 2+    [ "565b2b77937ba46536b0f693b3d5e4a8a24563f9ef1f676e8b5b2ef17823832f"+    , "4ef3064ec29f5b7f9686d75a23d170e3"+    , "3b722433226c9dba745087270ab3af2c909425ba6d39f5ce46f07256068319d9"+    , ""+    , ""+    , "d144ee7f8363d128872f82c15663fe658413cd42651098e0a7c51a970de75287ec943f9061e902280a5a9e183a7817a44222d198fbfab184881431b4adf35d3d1019da5a90b3696b2349c8fba15a56d0f9d010a88e3f9eeedb67a69bcaa71281b41afa11af576b765e66858f0eb2e4ec4081609ec81da81df0a0eb06787340ea"+    ],+    -- COUNT = 3+    [ "fc3832a91b1dcdcaa944f2d93cbceb85c267c491b7b59d017cde4add79a836b6"+    , "d5e76ce9eabafed06e33a913e395c5e0"+    , "ffc5f6eefd51da64a0f67b5f0cf60d7ab43fc7836bca650022a0cee57a43c148"+    , ""+    , ""+    , "0e713c6cc9a4dbd4249201d12b7bf5c69c3e18eb504bf3252db2f43675e17d99b6a908400cea304011c2e54166dae1f20260008efe4e06a87e0ce525ca482bca223a902a14adcf2374a739a5dfeaf14cadd72efa4d55d15154c974d9521535bcb70658c5b6c944020afb04a87b223b4b8e5d89821704a9985bb010405ba8f3d4"+    ],+    -- COUNT = 4+    [ "8009eb2cb49fdf16403bcdfd4a9f952191062acb9cc111eca019f957fb9f4451"+    , "355598866952394b1eddd85d59f81c9d"+    , "09ff1d4b97d83b223d002e05f754be480d13ba968e5aac306d71cc9fc49cc2dd"+    , ""+    , ""+    , "9550903c2f02cf77c8f9c9a37041d0040ee1e3ef65ba1a1fbbcf44fb7a2172bd6b3aaabe850281c3a1778277bacd09614dfefececac64338ae24a1bf150cbf9d9541173a82ecba08aa19b75abb779eb10efa4257d5252e8afcac414bc3bb5d3006b6f36fb9daea4c8c359ef6cdbeff27c1068571dd3c89dc87eda9190086888d"+    ],+    -- COUNT = 5+    [ "a6e4c9a8bd6da23b9c2b10a7748fd08c4f782fadbac7ea501c17efdc6f6087bd"+    , "acdc47edf1d3b21d0aec7631abb6d7d5"+    , "c16ee0908a5886dccf332fbc61de9ec7b7972d2c4c83c477409ce8a15c623294"+    , ""+    , ""+    , "a52f93ccb363e2bdf0903622c3caedb7cffd04b726052b8d455744c71b76dee1b71db9880dc3c21850489cb29e412d7d80849cfa9151a151dcbf32a32b4a54cac01d3200200ed66a3a5e5c131a49655ffbf1a8824ff7f265690dffb4054df46a707b9213924c631c5bce379944c856c4f7846e281ac89c64fad3a49909dfb92b"+    ],+    -- COUNT = 6+    [ "59d6307460a9bdd392dfc0904973991d585696010a71e52d590a5039b4849fa4"+    , "34a0aafb95917cbf8c38fc5548373c05"+    , "0407b7c57bc11361747c3d67526c36e228028a5d0b145d66ab9a2fe4b07507a0"+    , ""+    , ""+    , "299aba0661315211b09d2861855d0b4b125ab24649461341af6abd903ed6f025223b3299f2126fcad44c675166d800619cf49540946b12138989417904324b0ddad121327211a297f11259c9c34ce4c70c322a653675f78d385e4e2443f8058d141195e17e0bd1b9d44bf3e48c376e6eb44ef020b11cf03eb141c46ecb43cf3d"+    ],+    -- COUNT = 7+    [ "9ae3506aadbc8358696ba1ba17e876e1157b7048235921503d36d9211b430342"+    , "9abf7d66afee5d2b811cba358bbc527d"+    , "0d645f6238e9ceb038e4af9772426ca110c5be052f8673b8b5a65c4e53d2f519"+    , ""+    , ""+    , "5f032c7fec6320fe423b6f38085cbad59d826085afe915247b3d546c4c6b174554dd4877c0d671de9554b505393a44e71f209b70f991ac8aa6e08f983fff2a4c817b0cd26c12b2c929378506489a75b2025b358cb5d0400821e7e252ac6376cd94a40c911a7ed8b6087e3de5fa39fa6b314c3ba1c593b864ce4ff281a97c325b"+    ],+    -- COUNT = 8+    [ "96ae3b8775b36da2a29b889ad878941f43c7d51295d47440cd0e3c4999193109"+    , "1fe022a6fc0237b055d4d6a7036b18d5"+    , "1e40e97362d0a823d3964c26b81ab53825c56446c5261689011886f19b08e5c2"+    , ""+    , ""+    , "e707cd14b06ce1e6dbcceaedbf08d88891b03f44ad6a797bd12fdeb557d0151df9346a028dec004844ca46adec3051dafb345895fa9f4604d8a13c8ff66ae093fa63c4d9c0816d55a0066d31e8404c841e87b6b2c7b5ae9d7afb6840c2f7b441bf2d3d8bd3f40349c1c014347c1979213c76103e0bece26ad7720601eff42275"+    ],+    -- COUNT = 9+    [ "33f5120396336e51ee3b0b619b5f873db05ca57cda86aeae2964f51480d14992"+    , "6f1f6e9807ba5393edcf3cb4e4bb6113"+    , "3709605af44d90196867c927512aa8ba31837063337b4879408d91a05c8efa9f"+    , ""+    , ""+    , "8b8291126ded9acef12516025c99ccce225d844308b584b872c903c7bc6467599a1cead003dc4c70f6d519f5b51ce0da57f53da90dbe8f666a1a1dde297727fee2d44cebd1301fc1ca75956a3fcae0d374e0df6009b668fd21638d2b733e6902d22d5bfb4af1b455975e08eef0ebe4dc87705801e7776583c8de11672729f723"+    ],+    -- COUNT = 10+    [ "ad300b799005f290fee7f930eebce158b98fb6cb449987fe433f955456b35300"+    , "06aa2514e4bd114edf7ac105cfef2772"+    , "87ada711465e4169da2a74c931afb9b5a5b190d07b7af342aa99570401c3ee8a"+    , ""+    , ""+    , "80d7c606ff49415a3a92ba1f2943235c01339c8f9cd0b0511fbfdf3ef23c42ffff008524193faaa4b7f2f2eb0cfa221d9df89bd373fe4e158ec06fad3ecf1eb48b8239b0bb826ee69d773883a3e8edac66254610ff70b6609836860e39ea1f3bfa04596fee1f2baca6cebb244774c6c3eb4af1f02899eba8f4188f91776de16f"+    ],+    -- COUNT = 11+    [ "130b044e2c15ab89375e54b72e7baae6d4cad734b013a090f4df057e634f6ff0"+    , "65fd6ac602cd44107d705dbc066e52b6"+    , "f374aba16f34d54aae5e494505b67d3818ef1c08ea24967a76876d4361379aec"+    , ""+    , ""+    , "5d179534fb0dba3526993ed8e27ec9f915183d967336bb24352c67f4ab5d7935d3168e57008da851515efbaecb69904b6d899d3bfa6e9805659aef2942c4903875b8fcbc0d1d24d1c075f0ff667c1fc240d8b410dff582fa71fa30878955ce2ed786ef32ef852706e62439b69921f26e84e0f54f62b938f04905f05fcd7c2204"+    ],+    -- COUNT = 12+    [ "716430e999964b35459c17921fe5f60e09bd9ab234cb8f4ba4932bec4a60a1d5"+    , "9533b711e061b07d505da707cafbca03"+    , "372ae616d1a1fc45c5aecad0939c49b9e01c93bfb40c835eebd837af747f079d"+    , ""+    , ""+    , "a80d6a1b2d0ce01fe0d26e70fb73da20d45841cf01bfbd50b90d2751a46114c0e758cb787d281a0a9cf62f5c8ce2ee7ca74fefff330efe74926acca6d6f0646e4e3c1a1e52fce1d57b88beda4a5815896f25f38a652cc240deb582921c8b1d03a1da966dd04c2e7eee274df2cd1837096b9f7a0d89a82434076bc30173229a60"+    ],+    -- COUNT = 13+    [ "7679f154296e6d580854826539003a82d1c54e2e062c619d00da6c6ac820789b"+    , "55d12941b0896462e7d888e5322a99a3"+    , "ba4d1ed696f58ef64596c76cee87cc1ca83069a79e7982b9a06f9d62f4209faf"+    , ""+    , ""+    , "10dc7cd2bb68c2c28f76d1b04ae2aa287071e04c3b688e1986b05cc1209f691daa55868ebb05b633c75a40a32b49663185fe5bb8f906008347ef51590530948b87613920014802e5864e0758f012e1eae31f0c4c031ef823aecfb2f8a73aaa946fc507037f9050b277bdeaa023123f9d22da1606e82cb7e56de34bf009eccb46"+    ],+    -- COUNT = 14+    [ "8ca4a964e1ff68753db86753d09222e09b888b500be46f2a3830afa9172a1d6d"+    , "a59394e0af764e2f21cf751f623ffa6c"+    , "eb8164b3bf6c1750a8de8528af16cffdf400856d82260acd5958894a98afeed5"+    , ""+    , ""+    , "fc5701b508f0264f4fdb88414768e1afb0a5b445400dcfdeddd0eba67b4fea8c056d79a69fd050759fb3d626b29adb8438326fd583f1ba0475ce7707bd294ab01743d077605866425b1cbd0f6c7bba972b30fbe9fce0a719b044fcc1394354895a9f8304a2b5101909808ddfdf66df6237142b6566588e4e1e8949b90c27fc1f"+    ]+    ]++{-+    [SHA-256]+    [PredictionResistance = False]+    [EntropyInputLen = 256]+    [NonceLen = 128]+    [PersonalizationStringLen = 256]+    [AdditionalInputLen = 256]+    [ReturnedBitsLen = 1024]+-}++t4 :: [TestVector]+t4 = +    [+    -- COUNT = 0+    [ "5d3286bc53a258a53ba781e2c4dcd79a790e43bbe0e89fb3eed39086be34174b"+    , "c5422294b7318952ace7055ab7570abf"+    , "2dba094d008e150d51c4135bb2f03dcde9cbf3468a12908a1b025c120c985b9d"+    , "793a7ef8f6f0482beac542bb785c10f8b7b406a4de92667ab168ecc2cf7573c6"+    , "2238cdb4e23d629fe0c2a83dd8d5144ce1a6229ef41dabe2a99ff722e510b530"+    , "d04678198ae7e1aeb435b45291458ffde0891560748b43330eaf866b5a6385e74c6fa5a5a44bdb284d436e98d244018d6acedcdfa2e9f499d8089e4db86ae89a6ab2d19cb705e2f048f97fb597f04106a1fa6a1416ad3d859118e079a0c319eb95686f4cbcce3b5101c7a0b010ef029c4ef6d06cdfac97efb9773891688c37cf"+    ],+    -- COUNT = 1+    [ "c2a566a9a1817b15c5c3b778177ac87c24e797be0a845f11c2fe399dd37732f2"+    , "cb1894eb2b97b3c56e628329516f86ec"+    , "13ce4d8dd2db9796f94156c8e8f0769b0aa1c82c1323b61536603bca37c9ee29"+    , "413dd83fe56835abd478cb9693d67635901c40239a266462d3133b83e49c820b"+    , "d5c4a71f9d6d95a1bedf0bd2247c277d1f84a4e57a4a8825b82a2d097de63ef1"+    , "b3a3698d777699a0dd9fa3f0a9fa57832d3cefac5df24437c6d73a0fe41040f1729038aef1e926352ea59de120bfb7b073183a34106efed6278ff8ad844ba0448115dfddf3319a82de6bb11d80bd871a9acd35c73645e1270fb9fe4fa88ec0e465409ea0cba809fe2f45e04943a2e396bbb7dd2f4e0795303524cc9cc5ea54a1"+    ],+    -- COUNT = 2+    [ "a33288a96f41dd54b945e060c8bd0c094f1e28267cc1dcbba52063c1a9d54c4d"+    , "36918c977e1a7276a2bb475591c367b7"+    , "6aa528c940962638dc2201738850fd1fe6f5d0eb9f687ff1af39d9c7b36830d9"+    , "37ee633a635e43af59abdb1762c7ea45bfe060ec1d9077ecd2a43a658673f3c7"+    , "2eb96f2e28fa9f674bb03ade703b8f791ee5356e2ee85c7ed5bda96325256c61"+    , "db2f91932767eb846961ce5321c7003431870508e8c6f8d432ca1f9cee5cdc1aed6e0f133d317eb6990c4b3b0a360cdfb5b43a6e712bd46bca04c414868fab22c6a49c4b89c812697c3a7fbfc8ddf10c8aa5ebf13a09fd114eb2a02a07f69786f3ce7fd30231f22779bc8db103b13fa546dbc45a89a86275281172761683d384"+    ],+    -- COUNT = 3+    [ "5f37b6e47e1776e735adc03d4b999879477ff4a206231924033d94c0114f911b"+    , "7d12d62c79c9f6234ae0314156947459"+    , "92d4d9fab5f8bf5119f2663a9df7334f50dcde74fb9d7732f7eba56501e60d54"+    , "c9aef0d7a9ba7345d08b6d5b5ce5645c7495b8685e6b93846ffcf470f5abd40d"+    , "50d9d1f5074f7d9f1a24a9c63aa47b94da5ba78db1b0f18e4d4fe45c6875813c"+    , "20d942bbd7d98700faa37e94d53bf74f2d6bd1d8c95c0b88d842c4857797d59e7c8788aeeac29740122f208f703bf35dc32b0035db0648384feb6aa17a3274bc09b2d2b746c5a06fd82f4469fb86131a49482cb7be7d9b4b95042394cfb18b13f333ec0fe5c227bf1d8f33ecb2e42e358b6c3e034cb585331bd1d27f638029b9"+    ],+    -- COUNT = 4+    [ "2311c5afd64c584484b2729e84db80c0b4063fe9ca7edc83350488d7e67264a0"+    , "6a6dfd975a0dc7b72df1f107c4b3b3a6"+    , "2abd870ec5fe26ed14dfa57a3309f920131b70580c3639af2645cd1af93db1b1"+    , "c6e532a3b25653b6002aed5269cc2118749306e736bde039d4d569d4f967773f"+    , "5e7d26c4da769c373092b2b4f72b109fe34bdb7d169ea38f78ebae5df4a15759"+    , "cacaeb1b4ac2305d8714eb50cbe1c67c5a2c0bbc7938fdfdcafef7c85fc40becbf777a4cfb6f14c6eee320943a493d2b0a744a6eb3c256ee9a3763037437df9adce3e2260f0c35e958af0edb5a81debd8bdaf2b8bb2b98b9186e5a222a21609ff58df4cbe1d4898d10d6e7c46f31f5cb1041bfd83a5fb27d5c56c961e91403fc"+    ],+    -- COUNT = 5+    [ "362ece9d330e1172a8f9e50258476d0c79c3ee50346524ba12d970ee3a6ef8c5"+    , "cf11bcb4d9d51311ceacfca8705e833f"+    , "abb5a8edde02e526449284ecc31bc713383df3ed085f752e3b6a32f305861eed"+    , "746302ab1f4a86b17546bea762e929360f2e95c7788a63545a264ef997c8c65e"+    , "b907c5b2a8833a48e56e819228ce9a050b41b3309f5ca37bed720311d92b33af"+    , "73c7131a558350590053580873ef956ff952f2aa6ff1bea452e013d1bc2afddea2311756dbe756e63ba6258480c48f3f6c1319b5f572f67ca530af09e39413d1d432bea8f89206619618cb0e7c88e9f2033639d0eb0efc20616b64f940da99b88231984c3fb23f19e890576f555fde394dbd4351f17a7ffd5c369379001bda03"+    ],+    -- COUNT = 6+    [ "cf614bc29946bc0095f415e8bdeda10aab05392f9cc9187a86ea6ec95ee422e1"+    , "77fb5ec22dc0432cc13f4693e2e3bd9a"+    , "e4ce77914ffbc5fddf1fb51edfafdc196109139b84c741354135ec8d314c7c43"+    , "e1e83ee1205acaf6164dc287aec08e5b32789e5be818078db39e53cad589db51"+    , "4e20c0226d5e1e7e805679f03f72452b5bea2d0ba41e0c12329bf60eb3016dd1"+    , "838fdf1418a746aa52ae4005d90c3fd301f648c5770ffef2a9f3912e37a93850cc4b8bfcce910aead0cb75958823b1a62e283901c5e4a3980e4ea36257458e2e4953555819b8852a26489b1d74821f80c9908469b43f124ff7ea62497c36159a47353098a1b9ec32e54800d6704371cc37f357ad74aacc203e9b6db97f94d0c4"+    ],+    -- COUNT = 7+    [ "a8da1d3e233f393fd44d204c200202f7d01896e72c5ac652940cfd15b5d4b0bd"+    , "0a112b4cb0890af0a495e0f49fcf6874"+    , "d2e32799bc822b8d033299bdf63dc35774f7649e935d25be5b10512c430d1bda"+    , "920a82d76fcd2cd106ada64bba232b7b2344f3afe6b1d1d20ee8795144571009"+    , "eeaac5878275372025f8231febed64db6a11273c3c00d625fc80a95f18ad7d3f"+    , "5f6dae489b53d89027b2cc333c700f090152d77b3eaf01d47f56ce6eca9893ef877b4cb560fab0fbdb34e3d1c6cd8480b33c053d2661a10aa531df4961b97d659c7492584236582b3fe701055efa59c328194cd1e07fcffd910d9ee01b7b9e8c8fda7f7ac01a8e203b8b26eb8078a9b9a5021562c44af24089e3ef84c1d5a6bd"+    ],+    -- COUNT = 8+    [ "a77b1ed4ecaa650374e1052c405f1d88881c25c87d13dbe1334d8c1a847fa76b"+    , "05c143e2f145db216fe7be9ed23635d0"+    , "b5c750968ff09ed251d4a1c05342ac843db5246b19045728a634fa4f6e752e54"+    , "ff5937bcd01a363696bf8e40adc8e4ab3e56dbf7e7d09451c99e538785fe6697"+    , "4acb34eea8266badcf8f6557a0eecf3eb4d7a295c876d6175598cb66a388efb8"+    , "ec13eadfcc84e77d2a2efa1a2cd8b1355587cb27feb3d19d75b37f0446333ddb8236e751c63b7a6e595ec24a25051a696dbe8c062dd8896d1446db228a2f10e8094ee07e7ee648ed6bebb2f5ec5aae24c9c640665c28355cc11c116795ecc070790f7fdfc4398900311b6695d5da0175091ed1828d2731085bfb4a20bd86cce0"+    ],+    -- COUNT = 9+    [ "491686c781e83eb4e21d9989e8d718100b0d21a2c56295888baef1a65f219651"+    , "499085296d21065feabf3106101c8d6f"+    , "d208a72f9ae34f0817669fb04f49239dd31700f3dc9a93db8d75fb79f9b686c1"+    , "9ffc61893a293a864008fdd56d3292600d9e2ec8a1ea8f34ac5931e968905a23"+    , "4ff3a397dfdae0912032a302a5e7a07dceca8d9013a21545689319b7c024cd07"+    , "3c258ebf2203fca3b322ad1b016e21c7f5c148425f81e4fb0a0e462dce9dfa569c37a006527768297a5b68461b08912642a341b88c85597e30e7561206886098c4e2d861f11513f0ffdbbc78d3a2dd60c105abbb33c5e05ae27081b690fb8b3610917aa9bf1a4ad74481b5ff8334f14e5ad6a6a1eb2259476078076fb7e3a992"+    ],+    -- COUNT = 10+    [ "36a5267eeeb5a1a7d46de0f8f9281f73cd9611f01198fdaa78c5315205e5a177"+    , "b66b5337970df36219321badacc624eb"+    , "c2a7b164949da102bece44a423197682ff97627d1fe9654266b8527f64e5b386"+    , "a977e2d8637b019c74063d163bb25387dc56f4eb40e502cefc5ae6ad26a6abdc"+    , "c5c9819557b1e7d8a86fa8c60be42993edc3ef539c13d9a51fb64b0de06e145e"+    , "b471711a4fc7ab7247e65d2c2fe49a50169187187b7978cd2fdb0f8318be3ec55fc68ed4577ad9b42cbb57100b5d35ac86c244c4c93a5b28c1a11c2dfe905d608ec7804dec5bb15cf8d79695534d5e13a6a7e18a887ec9cf184da0cbbc6267f3a952a769403bafcdbb559401be0d8b3300ea7258b4026fc892175efd55ba1a67"+    ],+    -- COUNT = 11+    [ "a76b0366df89e4073a6b6b9c04da1d6817ce26f1c4825cad4097bdf4d7b9445e"+    , "773d3cc3290176773847869be528d1a4"+    , "1bfd3bcfb9287a5ad055d1b2b8615fa81c94ac24bc1c219a0f8de58789e0404a"+    , "edd879fa56f21d93029da875b683ce50f6fdc4c0da41da051d000eed2afefefa"+    , "f528ffd29160039260133ed9654589ce60e39e7f667c34f82cda65ddcf5fff14"+    , "39d1ff8848e74dd2cdc6b818ad69823878062116fdf1679942f892c7e191be1c4b6ea268ecdff001b22af0d510f30c2c25b90fc34927f46e3f45d36b0e1848b3a5d54c36c7c65ee7287d325dfbb51b56a438feb6650ce13df88bf06b87ac4a35d2a199ea888629fb0d83f82f0ea160dc79ed220d8ef195b9e80c542f60c2d320"+    ],+    -- COUNT = 12+    [ "46571e1df43e5e141235e2a9ec85bb0faf1dc0566031e14d41a2fbd0315653ec"+    , "b60ef6a3347967519aabeaf748e4e991"+    , "759fd8593e3688b23c4a003b655311770d670789878570eb3b155a8e6c2d8c45"+    , "033128460b449e1accb0e9c54508759ddc2538bc64b51e6277553f0c60a02723"+    , "a5e4a717240bdeac18a0c0e231a11dc04a47d7550f342fa9a7a5ff334eb9327d"+    , "9d222df1d530ea7f8f2297a0c79d637da570b48042ecddded75956bba0f0e70b271ffa3c9a53bada6ee1b8a4203c22bfde82a5e2eb1b150f54c6483458569422c1a34a8997d42cc09750167a78bf52a0bd158397af9f83caabe689185c099bf0a9a4853dd3cf8b8e89efebb6a27dba873e65e9927741b22968f2875789b44e01"+    ],+    -- COUNT = 13+    [ "d63980e63bbe4ac08d2ac5646bf085b82c75995e3fdfc23bb9cc734cd85ca7d2"+    , "d33ed1dcae13fb634ba08272d6697590"+    , "acd0da070072a5340c4f5f4395568e1a36374e074196ae87f3692ee40487e1df"+    , "f567677b5e12e26f3544be3da9314c88fc475bf84804a89a51f12b191392c02b"+    , "c01cc7873e93c86e2bfb8fc984cfc2eab5cc58eeef018fedb5cba5aedd386156"+    , "b133446f633bcb40724bbf9fa187c39a44b9c094a0a0d40e98977e5466dc2c9adf62a5f4551eeb6406a14658de8a0ed7487c3bf6277e811101284a941745ce16176acc875f1435e14161772fa84609e8123c53dd03cbb868030835c0d11d8d6aa04a1b6f908248b028997737f54735ec4ed7a81fc868199ffb61a779d9340334"+    ],+    -- COUNT = 14+    [ "3d99f9b7ac3a2fbe9cf15d960bf41f5588fc4db1e0d2a5c9c0fe9059f03593fb"+    , "411f504bb63a9b3afa7ffa1357bb48be"+    , "0bb5ebd55981a25ba69164da49fa92f2871fd3fc65eb30d0f0d0b8d798a4f8f2"+    , "288e948a551284eb3cb23e26299955c2fb8f063c132a92683c1615ecaed80f30"+    , "d975b22f79e34acf5db25a2a167ef60a10682dd9964e15533d75f7fa9efc5dcb"+    , "ee8d707eea9bc7080d58768c8c64a991606bb808600cafab834db8bc884f866941b4a7eb8d0334d876c0f1151bccc7ce8970593dad0c1809075ce6dbca54c4d4667227331eeac97f83ccb76901762f153c5e8562a8ccf12c8a1f2f480ec6f1975ac097a49770219107d4edea54fb5ee23a8403874929d073d7ef0526a647011a"+    ]+    ]++{- Reseed test vectors -}++{-+    [SHA-256]+    [PredictionResistance = False]+    [EntropyInputLen = 256]+    [NonceLen = 128]+    [PersonalizationStringLen = 0]+    [AdditionalInputLen = 0]+    [ReturnedBitsLen = 1024]+-}++r1 :: [TestVector]+r1 = +    [+    -- COUNT = 0+    [ "06032cd5eed33f39265f49ecb142c511da9aff2af71203bffaf34a9ca5bd9c0d"+    , "0e66f71edc43e42a45ad3c6fc6cdc4df"+    , ""+    , "01920a4e669ed3a85ae8a33b35a74ad7fb2a6bb4cf395ce00334a9c9a5a5d552"+    , ""+    , ""+    , ""+    , "76fc79fe9b50beccc991a11b5635783a83536add03c157fb30645e611c2898bb2b1bc215000209208cd506cb28da2a51bdb03826aaf2bd2335d576d519160842e7158ad0949d1a9ec3e66ea1b1a064b005de914eac2e9d4f2d72a8616a80225422918250ff66a41bd2f864a6a38cc5b6499dc43f7f2bd09e1e0f8f5885935124"+    ],+    -- COUNT = 1+    [ "aadcf337788bb8ac01976640726bc51635d417777fe6939eded9ccc8a378c76a"+    , "9ccc9d80c89ac55a8cfe0f99942f5a4d"+    , ""+    , "03a57792547e0c98ea1776e4ba80c007346296a56a270a35fd9ea2845c7e81e2"+    , ""+    , ""+    , ""+    , "17d09f40a43771f4a2f0db327df637dea972bfff30c98ebc8842dc7a9e3d681c61902f71bffaf5093607fbfba9674a70d048e562ee88f027f630a78522ec6f706bb44ae130e05c8d7eac668bf6980d99b4c0242946452399cb032cc6f9fd96284709bd2fa565b9eb9f2004be6c9ea9ff9128c3f93b60dc30c5fc8587a10de68c"+    ],+    -- COUNT = 2+    [ "62cda441dd802c7652c00b99cac3652a64fc75388dc9adcf763530ac31df9214"+    , "5fdc897a0c1c482204ef07e0805c014b"+    , ""+    , "bd9bbf717467bf4b5db2aa344dd0d90997c8201b2265f4451270128f5ac05a1a"+    , ""+    , ""+    , ""+    , "7e41f9647a5e6750eb8acf13a02f23f3be77611e51992cedb6602c314531aff2a6e4c557da0777d4e85faefcb143f1a92e0dbac8de8b885ced62a124f0b10620f1409ae87e228994b830eca638ccdceedd3fcd07d024b646704f44d5d9c4c3a7b705f37104b45b9cfc2d933ae43c12f53e3e6f798c51be5f640115d45cf919a4"+    ],+    -- COUNT = 3+    [ "6bdc6ca8eef0e3533abd02580ebbc8a92f382c5b1c8e3eaa12566ecfb90389a3"+    , "8f8481cc7735827477e0e4acb7f4a0fa"+    , ""+    , "72eca6f1560720e6bd1ff0152c12eeff1f959462fd62c72b7dde96abcb7f79fb"+    , ""+    , ""+    , ""+    , "d5a2e2f254b5ae65590d4fd1ff5c758e425be4bacdeede7989669f0a22d34274fdfc2bf87135e30abdae2691629c2f6f425bd4e119904d4785ecd9328f15259563e5a71f915ec0c02b66655471067b01016fdf934a47b017e07c21332641400bbe5719050dba22c020b9b2d2cdb933dbc70f76fec4b1d83980fd1a13c4565836"+    ],+    -- COUNT = 4+    [ "096ef37294d369face1add3eb8b425895e921626495705c5a03ee566b34158ec"+    , "6e2e0825534d2989715cc85956e0148d"+    , ""+    , "1b4f7125f472c253837fa787d5acf0382a3b89c3f41c211d263052402dcc62c5"+    , ""+    , ""+    , ""+    , "4541f24f759b5f2ac2b57b51125077cc740b3859a719a9bab1196e6c0ca2bd057af9d3892386a1813fc8875d8d364f15e7fd69d1cc6659470415278164df656295ba9cfcee79f6cbe26ee136e6b45ec224ad379c6079b10a2e0cb5f7f785ef0ab7a7c3fcd9cb6506054d20e2f3ec610cbba9b045a248af56e4f6d3f0c8d96a23"+    ],+    -- COUNT = 5+    [ "a7dccdd431ae5726b83585b54eae4108f7b7a25c70187c0acbb94c96cc277aa8"+    , "94c8f4b8e195a47356a89a50d1389ab5"+    , ""+    , "51733eee2e922f4055e53939e222e71fae730eb037443db2c7679708abb86a65"+    , ""+    , ""+    , ""+    , "99ba2691a622afecc9472418e6a8f9f1cdc1e3583c3bc7a2a650a1ab79dcbccbd656636c573179276e782569420c97438c06be898867f628b1c01eb570263d2c0f09c7aab536f6fba7df6aad19e05c236b645674667c03d1b6a04d7fc11177fe78933b309679f5bf26a4632b9a13e314c4bf4532428d3d95c689002b6dc1fbb1"+    ],+    -- COUNT = 6+    [ "c286425ecf543a49bcc9196b0db1a80bc54e4948adba6f41712a350a02891fa6"+    , "957a659a4ec2e0b7ad185483c220fd61"+    , ""+    , "08c2129813eea0776fba72788fdf2718759cc3c4207fa20a5fe23ac6e32cc28e"+    , ""+    , ""+    , ""+    , "8e1020a4fd84c99e0fc7e3f7ce48de5ed9ec9a5c2ccd624dbe6f30e2f688a31dc55957630357a5d48ca2a456241a28bfb16d8bb000877697a7ce24d9ad4d22b0c15117996f1f270b94f46d7a9bdfa7608fa1dd849177a9b8049e51b6b7a2742623854a1fddb5efc447eed1ea1aed6f02b4b2754ecf71ea0509da2e54f524a7e7"+    ],+    -- COUNT = 7+    [ "02818bd7c1ec456ace55beeba99f646a6d3aa0ea78356ea726b763ff0dd2d656"+    , "c482687d508c9b5c2a75f7ce390014e8"+    , ""+    , "cf319bfa63980e3cb997fd28771bb5614e3acb1149ba45c133ffbbab17433193"+    , ""+    , ""+    , ""+    , "19a231ff26c1865ce75d7a7185c30dd0b333126433d0c8cbf1be0d2b384d4eb3a8aff03540fbfa5f5496521a4e4a64071b44c78bd0b7e68fac9e5695c5c13fd3b9dbe7f7739781a4c8f0b980f1b17d99bce17ceb52b56866ae02456ffef83399c8cf7826f3c45c8a19315890919d20f40fc4e18d07e9c8ccd16c3327b5988f71"+    ],+    -- COUNT = 8+    [ "77a5c86d99be7bc2502870f4025f9f7563e9174ec67c5f481f21fcf2b41cae4b"+    , "ed044ad72ee822506a6d0b1211502967"+    , ""+    , "778100749f01a4d35c3b4a958aafe296877e0acafd089f50bc7797a42a33ab71"+    , ""+    , ""+    , ""+    , "831a4da566f46289904893ef1cc1cd4ad19ee48f3857e2b69e936d10afbdc29822e85d02663d346ef3e09a848b1d9cc04f4c4c6e3b3b0e56a034e2334d34ca08f8097be307ba41d020bc94f8c1937fe85644eeb5592c2b5a2138f7ded9a5b44b200c8b5beb27597c790f94d660eb61e8248391edc3ae2d77656cbe8354275b13"+    ],+    -- COUNT = 9+    [ "0ea458cff8bfd1dd8b1addcba9c01317d53039e533104e32f96e7d342e6c7b9b"+    , "935a4b66fc74c2a48757a99c399e64e3"+    , ""+    , "6c5f3708e7b714c4ed139b4fa9e8c763af01773484005109a85e33653bb0ce98"+    , ""+    , ""+    , ""+    , "373a37af84fddec13645a9768d6a785ae5a2589d64cd9b37980dde2541499210c4f408335de1d585349064f3f53a2b4c5ec6dc2a09591f99ad9fad528ac83474164b45497bf167f81e66fa08463ffea917f6891e48f149fafc20622bb1172f34886feb45c26fd446a4a4e2891b4bc594186896141aaaeeb301b49e7c1a26fec7"+    ],+    -- COUNT = 10+    [ "bfb68be4ce1756d25bdfad5e0c2f8bec29360901cc4da51d423d1591cc57e1ba"+    , "98afe4bd194c143e099680c504cceaab"+    , ""+    , "b97caf210e82498c3408790d41c320dd4a72007778389b44b7bc3c1c4b8c53f8"+    , ""+    , ""+    , ""+    , "409e0aa949fb3b38231bf8732e7959e943a338ea399026b744df15cbfeff8d71b3da023dcce059a88cf0d4b7475f628e4764c8bef13c70cfbbbb6da2a18aabcad919db09d04fc59765edb165147c88dd473a0f3c5ee19237ca955697e001ba654c5ee0bd26761b49333154426bc63286298a8be634fe0d72cfdeef0f3fc48eca"+    ],+    -- COUNT = 11+    [ "4f6880a64610004463031d67d7924fa446c39138d4d41007e8df3d65691a9367"+    , "6b33b2c13600f4b1df6ca3d1960e8dd4"+    , ""+    , "57b87b8c8f48312b5333d43b367730c0a5ad4725a16778fcb53fe136d136cbfd"+    , ""+    , ""+    , ""+    , "73d0f324ed186e2ad06bd1800e262bdbda79ba54e626761bd60f74f43e3bb62958ec1e2f1d940af163e1cadc124e7ebaba2f72e67efd746c7f6d0cad53ef03d859d93cff778a32ee5be172fe7fdbdc232ded360d704a6fa0f70bebe942e56478345492f49dc5c6fc346b88a58947ad250e688e8c626fe1efe7624620e571976e"+    ],+    -- COUNT = 12+    [ "aae352e111843219cae8f70e7b8f6eb9bb53d246cbec1e4f07d42757143295b4"+    , "b84485dccd1bf93210e322eafcbebcd9"+    , ""+    , "f9237f00d744d8fbff21b9d0043c258e8731817e6a5fb7b4bf5011680e5bc642"+    , ""+    , ""+    , ""+    , "cfb28b93522c7d61d8d3ce3f080e435e4c83c7e13a9dab788db8fef0407267a14fbc9324e090e24df5491fedfa81116869983938d4d4d7324a310c3af33a6f7938f602c5e4e63f1771cdaabdab0782b5affb54eb53047c109a9606739dd0065bd21eca33132986554878354f5f9f852e674dd690163b0ff74c7a25e6bae8ce39"+    ],+    -- COUNT = 13+    [ "589e79e339b7d2a1b879f0b0e1a7d1ad2474eaa8025b070f1ffa877b7124d4ff"+    , "0961ed64dbd62065d96e75de6d2ff9d6"+    , ""+    , "e928388d3af48c2968527a4d2f9c2626fbc3f3f5a5d84e0583ab6f78e7f8b081"+    , ""+    , ""+    , ""+    , "fce6ced1ecf474d181ab331f79c3d2cc8a768ec2818de5b3fc7cf418322716d6a6853733561a497c0c25cb288d2c9fcfbca891bafd5a834c85f3603f402acf1a7b1ea92db847ed5c252a862ad4ab5e259715f1fc81da67f5230bf8be50ee8069758095f7d0e559e03f2c6072290e61794458437609e473eb66580cddaad19b71"+    ],+    -- COUNT = 14+    [ "714277d408ad87fde317f0a94732fce62f1352bdc90936673b4f1daa0925aa26"+    , "d16582a99f23010b4248b88d86485419"+    , ""+    , "bd9fc7cb2fd5063b2c3c0c4f346ad2e3879371a9c805e59b9f2cd2cc2a40894f"+    , ""+    , ""+    , ""+    , "62ef7a431288252e0d736c1d4e36cc9ac37107dcd0d0e971a22444a4adae73a41eff0b11c8625e118dbc9226142fd0a6aa10ac9b190919bda44e7248d6c88874612abd77fb3716ea515a2d563237c446e2a282e7c3b0a3aef27d3427cc7d0a7d38714659c3401dbc91d3595159318ebca01ae7d7fd1c89f6ad6b604173b0c744"+    ]+    ]++{-+    [SHA-256]+    [PredictionResistance = False]+    [EntropyInputLen = 256]+    [NonceLen = 128]+    [PersonalizationStringLen = 0]+    [AdditionalInputLen = 256]+    [ReturnedBitsLen = 1024]+-}++r2 :: [TestVector]+r2 = +    [+    -- COUNT = 0+    [ "05ac9fc4c62a02e3f90840da5616218c6de5743d66b8e0fbf833759c5928b53d"+    , "2b89a17904922ed8f017a63044848545"+    , ""+    , "2791126b8b52ee1fd9392a0a13e0083bed4186dc649b739607ac70ec8dcecf9b"+    , "43bac13bae715092cf7eb280a2e10a962faf7233c41412f69bc74a35a584e54c"+    , "3f2fed4b68d506ecefa21f3f5bb907beb0f17dbc30f6ffbba5e5861408c53a1e"+    , "529030df50f410985fde068df82b935ec23d839cb4b269414c0ede6cffea5b68"+    , "02ddff5173da2fcffa10215b030d660d61179e61ecc22609b1151a75f1cbcbb4363c3a89299b4b63aca5e581e73c860491010aa35de3337cc6c09ebec8c91a6287586f3a74d9694b462d2720ea2e11bbd02af33adefb4a16e6b370fa0effd57d607547bdcfbb7831f54de7073ad2a7da987a0016a82fa958779a168674b56524"+    ],+    -- COUNT = 1+    [ "1bea3296f24e9242b96ed00648ac6255007c91f7c1a5088b2482c28c834942bf"+    , "71073136a5cc1eb5b5fa09e1790a0bed"+    , ""+    , "d714329f3fbea1df9d0b0b0d88dfe3774beb63d011935923d048e521b710dc6f"+    , "4ef872fd211a426ea1085ab39eb220cc698fdfeabe49b8835d620ab7885de7a4"+    , "d74d1669e89875852d9ccbf11c20fe3c13a621ebcb3f7edeea39a2b3379fdcf5"+    , "0c8aa67ca310bd8e58c16aba35880f747266dbf624e88ec8f9ee9be5d08fdeb1"+    , "ce95b98f13adcdf7a32aa34709d6e02f658ae498d2ab01ce920f69e7e42c4be1d005acf0ca6b17891dfafc620dd4cd3894f8492a5c846089b9b452483eb0b91f3649ec0b6f98d1aaabc2e42cd39c2b25081b85ab50cb723007a0fd83550f32c210b7c4150b5a6bb3b0c9e3c971a09d43acb48e410a77f824b957092aa8ef98bc"+    ],+    -- COUNT = 2+    [ "a7ea449b49db48601fc3a3d5d77081fab092b8d420ed1b266f704f94352dd726"+    , "d11a159b60af8d20a0e37d27e6c74aa3"+    , ""+    , "50916ab47e8cb5dc843f9fba80639103711f86be8e3aa94f8a64a3fe0e6e5b35"+    , "e2bb6768120555e7b9e0d573537a82f8f32f54560e1050b6abb1588fb3441e66"+    , "a50cec9d1ecddb2c163d24019e81c31a2b350ccd3ad8181fd31bb8d1f64fa50e"+    , "591dbbd48b51abced67f9c6269cf0133cd3dcbb5cfafcb6ef758569c555a5773"+    , "0a464abcc8685158372d544635b953fcb1d3821c30aaa93982f9b788935f00f88115aad61d5cee003b3d1cb50f3e961a501e2dd0fc7e1724778b184a4bdf9f64e110dda7446e5544a30bd49a400ea1a5411800e1edfeea349323618afc5dc5782dc4b71d2da4d6a4785f8dd346feb9c8740ffd26bf644e3e4323ff24c30b9f10"+    ],+    -- COUNT = 3+    [ "14683ec508a29d7812e0f04a3e9d87897000dc07b4fbcfda58eb7cdabc492e58"+    , "b2243e744eb980b3ece25ce76383fd46"+    , ""+    , "18590e0ef4ee2bdae462f76d9324b3002559f74c370cfccf96a571d6955703a7"+    , "9ea3ccca1e8d791d22fcda621fc4d51b882df32d94ea8f20ee449313e6909b78"+    , "16366a578b5ea4d0cb547790ef5b4fd45d7cd845bc8a7c45e99419c8737debb4"+    , "a68caa29a53f1ba857e484d095805dc319fe6963e4c4daaf355f722eba746b92"+    , "c4e7532ee816789c2d3da9ff9f4b37139a8515dbf8f9e1d0bf00c12addd79ebbd76236f75f2aa705a09f7955038ebff0d566911c5ea13214e2c2eeb46d23ad86a33b60f7b9448d63eec3e1d59f48b39552857447dc5d7944667a230e3dbfa30ca322f6eacaf7536a286706a627c5083c32de0658b9073857c30fb1d86eb8ad1b"+    ],+    -- COUNT = 4+    [ "fa261fb230e2822458532ca2d5c39758750e6819a6fcebef10579ba995096959"+    , "564e1c9fbcb12878df2bd49202cbf821"+    , ""+    , "bf7de29e99e7f0e1b9f96f3b1902fb4049c8c6234d20de8316ebe66d97725457"+    , "8b7326621f6afbd44a726de48d03bcc5331f7306026c229ea9523497fbeaa88d"+    , "33b00b31623d6160c4c6740363a96481be14b19bc47be95641227284c366922a"+    , "2d812c8203575790ad6b6f2ed91a49d57460de779a3e881bef3be12e8766dc91"+    , "5574e0b4efc17e8ce136e592beabfe32551072bddd740929e698467b40b3991f028a22c760f7034853cc53007e3793e3c4a600d9e9d94528f8dc09aeba86146cdde2b7f71255ae0efc529b49be2205979dba6525bfe155e8819e8e2aeeaa285704242da90b4c4535101cc47d94b0e388a1b2e63ad0cbe158b9e1bbae9cc0007c"+    ],+    -- COUNT = 5+    [ "61f1471ced56aa04c57e1b512307d4cb92497d9592d7e9e35356e99d585cab1b"+    , "84714e960c403a4fac06b2828cc564d9"+    , ""+    , "7bf97db3c102edc81596d4757045fe6bdc008f35792fc6290b77d889c09c33a8"+    , "5b8bdc41f76d98cfa71ed976ea3994706375c8841adb8b6b3b6418e3132e8832"+    , "94c8a8fdf38a6ccb8571c89420d899adab169214bb0dfcd43a04622e289935b2"+    , "8a4b46e0a7a55907365f82d4ab9376509bd44728cab8cbafb0da901012ad8dcd"+    , "933eb159a6af7455b60e40586c064f05f1970f564281b1ebc4662701ac1f299e4eb908c4afcb2e065191281ab576f684aefedd6904bad04d96bd93c0516c62a496c3073a0cda0676a11cc08866b0cc74f62cb9d3db48673b2c3fbeada69f922b4b795ccba22df12ef7125909381f7d681f6b9caba02fb913c5437b98c040c576"+    ],+    -- COUNT = 6+    [ "a1d5bb7d70621dee6b668b28c56d5610c2f8ced30284cc3e0e48de331af05062"+    , "88a49e3e54c5ea54c98b95de81bcc807"+    , ""+    , "b4e2426e98f6eed97a6cdf690a89ee109e84c3dca16c883c26fa4ac671638d8d"+    , "5bd1e086ed228cfd8b55c1731fea40c3a63d022599ca2da4bb23118f4821ba62"+    , "b754b53ac226e8ebe47a3d31496ec822de06fca2e7ef5bf1dec6c83d05368ec3"+    , "fa7e76b2805d90b3d89fff545010d84f67aa3a2c9eb2ba232e75f4d53267dac3"+    , "df6b2460688fa537df3ddfe5575fca5eb8abad56cbc4e5a618a2b4a7daf6e215c3a497974c502f9d0ec35de3fc2ea5d4f10de9b2aee66dcc7e7ae6357983095959b817f0383e3030771bd2ed97406acf78a1a4a5f30fa0992289c9202e69e3eb1eabe227c11409ff430f6dfca1a923a8b17bc4b87e908007f5e9759c41482b01"+    ],+    -- COUNT = 7+    [ "68f21d14525d56233c7e263482d344c388a840103a77fb20ac60ce463cabdc79"+    , "59fa80ae570f3e0c60ac7e2578cec3cb"+    , ""+    , "7584b4166530442f06e241dd904f562167e2fdae3247ab853a4a9d4884a5fa46"+    , "f6a5482f139045c5389c9246d772c782c4ebf79c3a84b5cf779f458a69a52914"+    , "9d37b1ce99f8079993ddf0bd54bab218016685b22655a678ce4300105f3a45b7"+    , "4c97c67026ff43c2ee730e7b2ce8cce4794fd0588deb16185fa6792ddd0d46de"+    , "e5f8874be0a8345aabf2f829a7c06bb40e60869508c2bdef071d73692c0265f6a5bf9ca6cf47d75cbd9df88b9cb236cdfce37d2fd4913f177dbd41887dae116edfbdad4fd6e4c1a51aad9f9d6afe7fcafced45a4913d742a7ec00fd6170d63a68f986d8c2357765e4d38835d3fea301afab43a50bd9edd2dec6a979732b25292"+    ],+    -- COUNT = 8+    [ "7988146cbf9598d74cf88dc314af6b25c3f7de96ae9892fb0756318cea01987e"+    , "280bc1ae9bfdf8a73c2df07b82a32c9c"+    , ""+    , "2bbc607085232e5e12ccf7c0c19a5dc80e45eb4b3d4a147fe941fa6c13333474"+    , "f3f5c1bb5da59252861753c4980c23f72be1732f899fdea7183b5c024c858a12"+    , "44d0cfc4f56ab38fa465a659151b3461b65b2462d1ad6b3463b5cf96ad9dc577"+    , "34fb9a3cdacc834ff6241474c4f6e73ed6f5d9ea0337ab2b7468f01ad8a26e93"+    , "4caec9e760c4d468e47613fe50de4a366ae20ba76793744a4e14433ea4de79dc188601eb86c803b094641ab2337b99d459d37decc7d27473057be45ba848868ee0fb5f1cf303d2fcd0b3e0c36f65a65f81b3fee8778a1f22302e25dfe34e6d587fa8864e621121880f7cd55f350531c4ce0530099eec2d0059706dcd657708d9"+    ],+    -- COUNT = 9+    [ "1c974c953fa2a057c9fc9409a6843f6f839aa544bca4fa11e48afd77931d4656"+    , "ed7c08285464af7a5dbdc10b944a1270"+    , ""+    , "78146ad135acb836360d36afc50653dcc36c21662da2a6f6ae05222e75f34000"+    , "263c4984c238ded333c86472866353817379502157172cfa51371d82b1efd7b5"+    , "79b591529f9a26a0d7c8f8fd64e354b0c134ef1f757e43f9463b3dbb7a3da1ab"+    , "7d8f7204b0b5401ddce9e88dcf5facb9a44660a9f5f1c862748e7269c29f7964"+    , "72e2ca257b9edaf59b50e05a144f56fb517832fb9ad3489b1e664e3d5412cbf6b2883e891703b2e73aff9ab56da1009fcdef010ab4cdab996795c8f7c47fb1192bb160353997ad39d7d5fd0e2efc9103a7c3f158246afd53fe53ca6782f809698ef5f1f0d85536780a3fd6a8bafa475891c09213088bd1a3dc169257c34a517a"+    ],+    -- COUNT = 10+    [ "56216d71984a77154569122c777ce57e1d101a6025b28163a25971d39c1c5d0f"+    , "5cd148ba7e54f4975ac8e3e0f9b5d06a"+    , ""+    , "3580f8ca974626c77259c6e37383cb8150b4d0ab0b30e377bed0dc9d1ff1a1bf"+    , "15633e3a62b21594d49d3d26c4c3509f96011d4dbb9d48bbbea1b61c453f6abe"+    , "6068eaca85c14165b101bb3e8c387c41d3f298918c7f3da2a28786ab0738a6fc"+    , "e34f92d2b6aeeeea4ff49bfe7e4b1f462eabb853f0e86fbae0e8b3d51409ce49"+    , "587fdb856abc19ede9078797ecb44099e07aadcd83acdcb2b090601d653f4a14c68ab2ebdda63578c5633a825bae4c0c818f89aac58d30fd7b0b5d459a0f3d86fcad78f4bb14dfff08ad81e4ea9f487cb426e91d6e80dfed436ba38fce8d6f21ca2151c92dd5c323b077d6139c66395558f0537026c4a028affa271ef4e7ea23"+    ],+    -- COUNT = 11+    [ "83eb48bedc1e9294866ab8e5322ef83f6f271f8188e8fdabe5817788bd31570d"+    , "d6ed90bc692237f132441ede857a6629"+    , ""+    , "a4e5e127f992bd5ca79ee56bb8a9bccf74c21814bfaf97ffd052211e802e12e4"+    , "84136e403d9ed7f4515c188213abcfaca35715fa55de6d734aec63c4606a68f1"+    , "fe9d8ef26e2d2e94b99943148392b2b33a581b4b97a8d7a0ecd41660a61dd10b"+    , "594dad642183ce2cdc9494d6bcb358e0e7b767c5a0fa33e456971b8754a9abd5"+    , "86715d43ba95fbbca9b7193ea977a820f4b61ba1b7e3b8d161b6c51b09dfd5040d94c04338b14d97ed25af577186b36ae7251a486c8a2d24a35e84a95c89d669d49e307b4a368b72164135ac54d020a970a180dfbed135d2c86f01270846d5301bd73db2c431a8aa10a0a3d03d146e5fafb9a2aa0b4efc80edab06ff3b532236"+    ],+    -- COUNT = 12+    [ "ba2c94203dab2e6499d8c50dca7b5c34a6b4764834f9816631aa21b9f9c37361"+    , "67db133bdefb25e395085bceee5a0afc"+    , ""+    , "fa8984d16d35302cda35a3a355ab9242ec96fec0652d39282d4a0abf0a80df87"+    , "b6fed10255a3fea6772ae1ae6d9f6cbb9bfaa34804e58a5b786f9bc60b348ccd"+    , "445e072244edc716d3528f0e0a20ff0cd8f819c0d031736c8da122748f24d6c6"+    , "1f856e403c4fa035bac9aa81a20e347c7d8b213aab699d69d9d6186a06ac45c1"+    , "79f33fc36b3b47d9ac805bdbbe699909a8d0beb689a8b2723c291bd5bf7f3ce61343d4722a14e4add36312dbb0594910c8828aff1abc159915d498106f9ffb31147478d8c9ef75d1536ba5036506b313f6e85033f8f6fea2a4de817c867a59378c53c70a2f108275daedd415c05b61c4fd5d48c54be9adb9dea6c40a2ec99ee0"+    ],+    -- COUNT = 13+    [ "0db4c51492db4fe973b4bb1c52a1e873b58fc6bb37a3a4bfc252b03b994495d1"+    , "a2a3900f169bba3f78a42526c700de62"+    , ""+    , "29d5aab356876447e3a20d81c7e3fc6975e2b984180a91493044442999e1ca3a"+    , "40b34183b4e72cdff5952b317b3d45943d0fdcfa0527f3563055f7c73ae8f892"+    , "dc94220c99ffb595c7c4d6de8de5a6bb4b38847169e24a557ef6d879ad84149d"+    , "b2376626fd2f5218b3ed4a5609b43aa24d371cd2176ea017c2b99cf868060021"+    , "f0bd6bc4c506d9427a09352d9c1970b146360732841a6323f4cb602c87dedfb5ff7e6964b9144933af3c5c83017ccd6a94bdca467a504564aaa7b452591a16ff6a1e7e94ddc98f9a58016cdcb8caaed6c80671ba48cc81a832d341093dda1d4e5001ec6bf66348b21e3692a13df92538ad572bb2023822072fc95f9590293ffc"+    ],+    --  COUNT = 14+    [ "593845f0adfeffa7c169f8a610147ae8a08c0072fc0c14c3977d3de0d00b55af"+    , "9e0eb2507342ee01c02beadee7d077bd"+    , ""+    , "aefe591697eab678c52e20013aa424b95cfd217b259757fbe17335563f5b5706"+    , "cbb5be0ef9bf0555ee58955c4d971fb9baa6d6070c3f7244a4eb88b48f0793bf"+    , "6dd878394abdc0402146ba07005327c55f4d821bfebca08d04e66824e3760ab4"+    , "ba86a691d6cbf452b1e2fd1dfb5d31ef9ea5b8be92c4988dc5f560733b371f69"+    , "00735cbfafac5df82e5cb28fc619b01e2ba9571dc0023d26f09c37fb37d0e809066165a97e532bf86fa7d148078e865fe1a09e27a6889be1533b459cd9cd229494b5cf4d2abf28c38180278d47281f13820276ec85effb8d45284eb9eef5d179ab4880023ab2bd08ee3f766f990286bf32430c042f5521bbfd0c7ee09e2254d7"+    ]+    ]++{-+    [SHA-256]+    [PredictionResistance = False]+    [EntropyInputLen = 256]+    [NonceLen = 128]+    [PersonalizationStringLen = 256]+    [AdditionalInputLen = 0]+    [ReturnedBitsLen = 1024]+-}++r3 :: [TestVector]+r3 =+    [+    -- COUNT = 0+    [ "fa0ee1fe39c7c390aa94159d0de97564342b591777f3e5f6a4ba2aea342ec840"+    , "dd0820655cb2ffdb0da9e9310a67c9e5"+    , "f2e58fe60a3afc59dad37595415ffd318ccf69d67780f6fa0797dc9aa43e144c"+    , "e0629b6d7975ddfa96a399648740e60f1f9557dc58b3d7415f9ba9d4dbb501f6"+    , ""+    , ""+    , ""+    , "f92d4cf99a535b20222a52a68db04c5af6f5ffc7b66a473a37a256bd8d298f9b4aa4af7e8d181e02367903f93bdb744c6c2f3f3472626b40ce9bd6a70e7b8f93992a16a76fab6b5f162568e08ee6c3e804aefd952ddd3acb791c50f2ad69e9a04028a06a9c01d3a62aca2aaf6efe69ed97a016213a2dd642b4886764072d9cbe"+    ],+    -- COUNT = 1+    [ "cff72f345115376a57f4db8a5c9f64053e7379171a5a1e81e82aad3448d17d44"+    , "d1e971ec795d098b3dae14ffcbeecfd9"+    , "6ec0c798c240f22740cad7e27b41f5e42dccaf66def3b7f341c4d827294f83c9"+    , "45ec80f0c00cad0ff0b7616d2a930af3f5cf23cd61be7fbf7c65be0031e93e38"+    , ""+    , ""+    , ""+    , "17a7901e2550de088f472518d377cc4cc6979f4a64f4975c74344215e4807a1234eefef99f64cb8abc3fb86209f6fc7ddd03e94f83746c5abe5360cdde4f2525ccf7167e6f0befae05b38fd6089a2ab83719874ce8f670480d5f3ed9bf40538a15aaad112db1618a58b10687b68875f00f139a72bdf043f736e4a320c06efd2c"+    ],+    -- COUNT = 2+    [ "b7099b06fc7a8a74c58219729db6b0f780d7b4fa307bc3d3f9f22bfb763596a3"+    , "b8772059a135a6b61da72f375411de26"+    , "2ac1bfb24e0b8c6ac2803e89261822b7f72a0320df2b199171b79bcbdb40b719"+    , "9aec4f56ec5e96fbd96048b9a63ac8d047aedbbeea7712e241133b1a357ecfc4"+    , ""+    , ""+    , ""+    , "0e1f2bfef778f5e5be671ecb4971624ec784ed2732abc4fbb98a8b482fb68737df91fd15acfad2951403ac77c5ca3edffc1e03398ae6cf6ac24a91678db5c7290abc3fa001aa02d50399326f85d2b8942199a1575f6746364740a5910552c639804d7530c0d41339345a58ff0080eccf1711895192a3817a8dc3f00f28cc10cc"+    ],+    -- COUNT = 3+    [ "7ba02a734c8744b15ef8b4074fe639b32e4431762ab5b7cd4d5df675ea90672b"+    , "8a424f32108607c8f1f45d97f500ee12"+    , "3ad627433f465187c48141e30c2678106091e7a680229a534b851b8d46feb957"+    , "d8f02b59b6a3dd276bc69cba68efcf11ab83ead1397afd9841786bd1bb5da97a"+    , ""+    , ""+    , ""+    , "1fb91186ba4b4459d994b4b9f4ca252c7be6294d6cdb5fe56f8ff784d4b190a1c6456e0a41223bbbdf83ed8e7cfbfa765d9d8bc7ea5f4d79ea7eccb4928081a21de4cca36620d6267f55d9a352b76fc0a57375884112c31f65ff28e76d315698c29e6c4c05cb58b0a07ae66143b4abc78b9d25c78b4121e1e45bef1a6c1793e2"+    ],+    -- COUNT = 4+    [ "9a8865dfe053ae77cb6a9365b88f34eec17ea5cbfb0b1f04d1459e7fa9c4f3cb"+    , "180c0a74da3ec464df11fac172d1c632"+    , "336372ec82d0d68befad83691966ef6ffc65105388eb2d6eed826c2285037c77"+    , "75b95108eff1fabe83613e1c4de575e72a5cdc4bb9311dd006f971a052386692"+    , ""+    , ""+    , ""+    , "3c683f6d4f8f5a4018d01633dfee74266aaa68ed6fc649e81b64dfdf5f75e75d5c058d66cf5fd01a4f143a6ff695517a4a43bd3adfd1fb2c28ba9a41063140bedbffdb4d21b1ace1550d59209ec61f1e2dbacb2a9116a79cb1410bf2deca5218080aacd9c68e1d6557721a8913e23f617e30f2e594f61267d5ed81464ee730b2"+    ],+    -- COUNT = 5+    [ "22c1af2f2a4c885f06988567da9fc90f34f80f6dd5101c281beef497a6a1b2f8"+    , "3fafdecf79a4174801f133131629037b"+    , "80327dac486111b8a8b2c8e8381fb2d713a67695c2e660b2b0d4af696cc3e1de"+    , "f95a0e4bd24f0e2e9e444f511b7632868ead0d5bb3846771264e03f8ab8ed074"+    , ""+    , ""+    , ""+    , "77a7fea2f35a188f6d1bfdd49b569d8c45e2dd431d35a18c6f432c724f1e33ae92cb89a9cf91519e50705a53199f5b572dc85c1aef8f28fb52dc7986228f66954d54eda84a86962cf25cf765bd9949876349291b1aae5f88fcf4b376912d205add4f53b2770c657946c0d824281f441509153f48356d9d43f8a927e0693db8fc"+    ],+    -- COUNT = 6+    [ "d0840e3a8d629d5b883d33e053a341b21c674e67e1999f068c497ecfaabfd6f6"+    , "071de7244ecb2fdf7ab27f2d84aa7b7a"+    , "90d609527fad96ffe64ab153860346f3d237c8940555ae17b47842d82d3b0943"+    , "1dd1a8b59856c49a388f594c5f42cc2e4a56b3ccb8a65e7066e44c12f4344d50"+    , ""+    , ""+    , ""+    , "7ab28a9b2d3ae999195553e6550cced4c2daccbe7ec9dcbb0d467fabba185b727fbfd9830242cd098f4db3cf4a85e8bf8e8d5974b62b28550922b32ed5bfc1a522b6605cf93bf8d90bdec1c5b9e59c6fc37a817d437068a87254be1f7c4618ada46fbc3a2efb02e44524e21d91be7534cf05fbfd858304b706d6a91ea1cc6ad5"+    ],+    -- COUNT = 7+    [ "2e2dd56869104492767a59778652831919e1c8b970f84e824ae4116597a0ab7f"+    , "01c42a7e983641de46c82fd09b4f2f76"+    , "bcd9e1508fcc22820a8be07180fea5045367333b569e111b011cd57dc1858765"+    , "7306507cd3ca7eec667e640d270cfbb033063d97520b6b7e38ff3cea0e79d12b"+    , ""+    , ""+    , ""+    , "b915726c7b8c5dc3975f1a334684b973abf6a9495d930088cf5d071548e4fd29a67b55cc561ed6949ad28150a9fb4307c1fa5f783a7ea872e8d7c7e67ff0c2906081ee915737d813c25be5c30b952a36f393e6baa56ab01adc2b4776ad7b5d036a53659877c7a4e5220a897d6c0799af37beeed91173fbe9c613c3b6b9bb28e5"+    ],+    -- COUNT = 8+    [ "d1aab0f16bd47a5ccd67c22e094daa3735eae21aa57f0bcd9e053d9d0d545cb8"+    , "199310dfe1b01265b8c0d2b46d6c7c9f"+    , "625b4b8f4de72ea9cb6f70556322dc2a19d6b2b32de623f557e419a084ba60fd"+    , "f50cabae4e060f3971096b78e550cda2837a26a693d905db2d992d589b268f44"+    , ""+    , ""+    , ""+    , "987e1fdfe004c619cf1e9034576707eccd849400e19c87a1fef5b0179ec51c42a2f8c45d7942d0023a023c89f188b2634362703985695369863322f58619c50a7385a2dc91fc78f94b59f0131dc2b56a0d7c699d427285da1c104b0ad1739da10d8071c23993787045dc21f0070e1e9aa1658fc8e3add73dac7262e80e0aa2ee"+    ],+    -- COUNT = 9+    [ "449480eaa100aff6f48dc6286a5a81b9728b084864f78a9da98f606a00a6a41f"+    , "e53c6c5ac3da9f4726389a03f97bb640"+    , "6b8fedc084d8e28d333aef6db3702b6351f0d24e30908cccb63794282655886b"+    , "73a6d64e1966ae324388dc12c14544e9dc5ae4fcb331e99d350c456ff16f9aa0"+    , ""+    , ""+    , ""+    , "a06912d362da7eb25598857f6d65344c3e23ec3deb80c6e43158845b95eaeca241c0bbbd67ac385e24693444455cc1c2c08c1134d956b8bc93b28be9c2d3322b3e09252979dfb8d39d04c94f81bebda5c73110605a237b561216bda9ee9bdee1cc0c7728bcc8304682334ca944e467a27a85313fa5395a9c790e35defd2edb12"+    ],+    -- COUNT = 10+    [ "9a6174166e97aa4981ddf580bc01c96754b9f0ba042750aabfda1cffe56e8581"+    , "d7512ff6b7db7ce141b2bb01dcd0425e"+    , "ed75288f23275f9422444da5d3b53ccb3c4ac8acfb659a1e9b7655c2db52f879"+    , "6888b9277e57dc57663d402eba8d03cf56a070dc868e6a128b18040002baf690"+    , ""+    , ""+    , ""+    , "03519dfb2ff88cc2b53eecc48ae2a18ddcf91a5d69d5aefcdda8444e6df790a5240e67b2a4de75b4bb8a31f0f8aeb5e785ffb7a1341bb52fe00a05ee66fa2d44ea9956e055f9ffa6647c3bfe851ab364ade71a0d356de710ddafb7622b1da1bc53fd4d3210407289c68d8aeb346bf15806dbe787e781b94f63da3e1f61b5ac60"+    ],+    -- COUNT = 11+    [ "9c6ae1002ee1b0add0be563ce50f899da936e13efa620d08c2688c192514763a"+    , "fde7db5160c73044be73e9d4c1b22d86"+    , "8fdaaeffd64e53f7b4374d902d441209964e12b65d29afec258e65db6de167ca"+    , "bcc28fd58e397f53f494ad8132df82c5d8c4c22ea0b7139bd81eeba65667bb69"+    , ""+    , ""+    , ""+    , "021d938c9b4db780c7d8134aeff1053e5b8843370b8ae9a6749fca7199d809810f1bc8dfa49426470c30c3616f903e35fbacb23420a32f1bee567cc32300f704246ddc0217f236ef52c3ec9e2433ca66f05c25721f7661c43f22c1a125ed5db531bd0836eb435c27eefc7424ce9d845e1d4cc4c503097b4ffca788e674a5cb53"+    ],+    -- COUNT = 12+    [ "fe96a85b69d46b540918927bb609dc57642eeaefd46bb5da2163a0bc60294b58"+    , "22195a410d24db45589448dfe979d3fd"+    , "20f698833a4472fd7b78fb9b0c4eb68604f166a2694c4af48dac2b2376790e1e"+    , "09cb870879d3f734214f6a4bd2e08c62a2a954bebe559416d8c3551aafe71d6a"+    , ""+    , ""+    , ""+    , "d3e96dbe29e1fcb8ed83b19dbfb240e6f41679fbe83853aa71446617e63e5af78cf98b331d15bccb8c673c4e5d5dcec467a1fe26a6cd1696d0c9bc49f78139d051287df7f3ae0dbb4bbf581cb8211931063c3f4612ced53f59d1b4ebb875729139f5d2a7d60642e8f2835eed888b7e3e49c0dffd012cd746abfa3e1c5c2308c6"+    ],+    -- COUNT = 13+    [ "a4fd693ff0a8af24bcec352d3196549fd0da5ee5d99ca58416ca03ce4c50f38e"+    , "8cd67f2bf71d4366ce61396642531ff5"+    , "368969c15a4849d7593be8b162113b9298a535c148ff668a9e8b147fb3af4eba"+    , "83d2be9a0d74e6a42159ae630acebf4e15271ef7f14f3de14752be0e0e822b11"+    , ""+    , ""+    , ""+    , "e9188fc0eaec74b2608e21e3a40be94aaf4ae08eb684de8f8bba2d5fd3b073aa5531c938c0fc628da65725c54b5c68bb91d7d326565e96685e0a4e7b220c50e0caf1628edba5bd755b31894f8cb90afa76e88c5eb9e61b4932444c1397dee3e32241a3fb70a3929e49f6da02eea54812abb3d6b5cee18f03af1e0b4958430ab3"+    ],+    -- COUNT = 14+    [ "254ff5687a6dad3f1d237dc762f58d24ef2e2c084d0a48d26a3dc81e5490cda3"+    , "f2ec392acca491e03ce47b95963a49fc"+    , "f806b9b4a56682c61b55cb6a334caf87ffe135adfea6d0c3fc22b39898fbd078"+    , "b8494b1c1f1752fb6f80d732a89b08115857f7cc96e7dff05ebb822706889917"+    , ""+    , ""+    , ""+    , "0e527e00494d55564f9d9b28e7110f9a61ce36c883b5be2dcb055444164cdddd1a9f2731716f22d6ff476ce413c77abfc0e946871d5481345c2e97b4bfdd12ac03df606fc56bdb99ac7b71a69b5b9160373bbec3e9dde477180af454e7acc6bc58dc0afb4281c0de4354c1bf599054e3800c6d60d892858865b5361f50bfca9b"+    ]+    ]++{-+    [SHA-256]+    [PredictionResistance = False]+    [EntropyInputLen = 256]+    [NonceLen = 128]+    [PersonalizationStringLen = 256]+    [AdditionalInputLen = 256]+    [ReturnedBitsLen = 1024]+-}++r4 :: [TestVector]+r4 =+    [+    -- COUNT = 0+    [ "cdb0d9117cc6dbc9ef9dcb06a97579841d72dc18b2d46a1cb61e314012bdf416"+    , "d0c0d01d156016d0eb6b7e9c7c3c8da8"+    , "6f0fb9eab3f9ea7ab0a719bfa879bf0aaed683307fda0c6d73ce018b6e34faaa"+    , "8ec6f7d5a8e2e88f43986f70b86e050d07c84b931bcf18e601c5a3eee3064c82"+    , "1ab4ca9014fa98a55938316de8ba5a68c629b0741bdd058c4d70c91cda5099b3"+    , "16e2d0721b58d839a122852abd3bf2c942a31c84d82fca74211871880d7162ff"+    , "53686f042a7b087d5d2eca0d2a96de131f275ed7151189f7ca52deaa78b79fb2"+    , "dda04a2ca7b8147af1548f5d086591ca4fd951a345ce52b3cd49d47e84aa31a183e31fbc42a1ff1d95afec7143c8008c97bc2a9c091df0a763848391f68cb4a366ad89857ac725a53b303ddea767be8dc5f605b1b95f6d24c9f06be65a973a089320b3cc42569dcfd4b92b62a993785b0301b3fc452445656fce22664827b88f"+    ],+    -- COUNT = 1+    [ "3e42348bf76c0559cce9a44704308c85d9c205b676af0ac6ba377a5da12d3244"+    , "9af783973c632a490f03dbb4b4852b1e"+    , "2e51c7a8ac70adc37fc7e40d59a8e5bf8dfd8f7b027c77e6ec648bd0c41a78de"+    , "45718ac567fd2660b91c8f5f1f8f186c58c6284b6968eadc9810b7beeca148a1"+    , "63a107246a2070739aa4bed6746439d8c2ce678a54fc887c5aba29c502da7ba9"+    , "e4576291b1cde51c5044fdc5375624cebf63333c58c7457ca7490da037a9556e"+    , "b5a3fbd57784b15fd875e0b0c5e59ec5f089829fac51620aa998fff003534d6f"+    , "c624d26087ffb8f39836c067ba37217f1977c47172d5dcb7d40193a1cfe20158b774558cbee8eb6f9c62d629e1bcf70a1439e46c5709ba4c94a006ba94994796e10660d6cb1e150a243f7ba5d35c8572fd96f43c08490131797e86d3ed8467b692f92f668631b1d32862c3dc43bfba686fe72fdd947db2792463e920522eb4bc"+    ],+    -- COUNT = 2+    [ "b63fdd83c674699ba473faab9c358434771c5fa0348ca0faf7ebd7cf5891826b"+    , "5fd204e2598d9626edab4158a8cfd95f"+    , "2a5dfad8494306d9d4648a805c4602216a746ae3493492693a50a86d1ba05c64"+    , "adea5ba92f8010bb1a6a4b6fae2caa0b384165adf721253afd635d6021f764af"+    , "07c69d8d2b8aa1454c5c48083dd41477fda6bfcf0385638379933a60ed2e0a77"+    , "a14e902247a3d6493d3fbc8519518b71a660e5502cf7ecfc796cfaa5b4ee4baa"+    , "60e690e4a1eba14aec5187112a383e9991347fab7bac7cb2a40a52579a0d2718"+    , "792b47b6ed221623bb187d63e3f039c6983d94efd5771dc9b4c40bee65924513485a6332baeda6a96f9bb431f592d73462b61d9d914a72b56fa9d87597426fb246424ebcd7abd51b2eefec8f5b839c0b3c34015342ace296b5f2218fa194b50aea1c89663460292c92c45f112ddbf6b9406f6e7ccee9c47ed2d90a27be5dd73e"+    ],+    -- COUNT = 3+    [ "dab85f98eaf0cfba013b97de4d9c264ca6fe120366cb83e8b3113c68b34e39d5"+    , "d05108e1028ae67b4ea63bdc6d75eb88"+    , "09fed3822f6f5e5b9e575d31dc215de1607b0dfc927412618c2d8f79166dbaba"+    , "1794885a64470744198b7d0bc24472ffe8daf3c7eb219df6ddf180e484fe0aa5"+    , "8d74d01b582f70b92f53b43468084e1586d9b36465d333d5faaf6911e62fe40e"+    , "ef7f6b6eb479ab05b3f9ab6dd72eac8b1e86d887f1bcae363cae386d0275a06f"+    , "7442b2a792a6a29559bb8a515d56916ee18200580aa02e1237dd358619382d8f"+    , "49d2cbfa0897b7d961c293c1e572fb26f28e7b956e746f6eda90454c1370a29e25303ceadc7837514dc638553b487ef9487c977c10625409178ad6506d103c487a66655d08659d92a4d5994d1c8ddb28fe60f2e49577d6e80cae1478068c98268f45e6293c9326c7f726ec89601351c0a26fd3a6549f8a41c6f58692c86594c0"+    ],+    -- COUNT = 4+    [ "0f0aa84ef12e10ae2b279e799c683441862457b9bc25581c2cd3d5b58a5b3246"+    , "f74f4230c2427a52f01f39e825d250ac"+    , "d02b2f53da48b923c2921e0f75bd7e6139d7030aead5aeebe46c20b9ca47a38a"+    , "5222b26e79f7c3b7066d581185b1a1f6376796f3d67f59d025dd2a7b1886d258"+    , "d11512457bf3b92d1b1c0923989911f58f74e136b1436f00bad440dd1d6f1209"+    , "54d9ea7d40b7255ef3d0ab16ea9fdf29b9a281920962b5c72d97b0e371b9d816"+    , "601cef261da8864f1e30196c827143e4c363d3fa865b808e9450b13e251d47fa"+    , "e9847cefea3b88062ea63f92dc9e96767ce9202a6e049c98dc1dcbc6d707687bd0e98ed2cc215780c454936292e44a7c6856d664581220b8c8ca1d413a2b81120380bfd0da5ff2bf737b602727709523745c2ced8daef6f47d1e93ef9bc141a135674cba23045e1f99aa78f8cead12eeffff20de2008878b1f806a2652db565a"+    ],+    -- COUNT = 5+    [ "6a868ce39a3adcd189bd704348ba732936628f083de8208640dbd42731447d4e"+    , "efdde4e22b376e5e7385e79024350699"+    , "f7285cd5647ff0e2c71a9b54b57f04392641a4bde4a4024fa11c859fecaad713"+    , "0174f7f456ac06c1d789facc071701f8b60e9accebced73a634a6ad0e1a697d4"+    , "5463bb2241d10c970b68c3abc356c0fe5ef87439fc6457c5ee94be0a3fb89834"+    , "3ab62cdbc638c1b2b50533d28f31b1758c3b8435fe24bb6d4740005a73e54ce6"+    , "2dbf4c9123e97177969139f5d06466c272f60d067fefadf326ccc47971115469"+    , "8afce49dccc4ff64c65a83d8c0638bd8e3b7c13c52c3c59d110a8198753e96da512c7e03aeed30918706f3ad3b819e6571cfa87369c179fb9c9bbc88110baa490032a9d41f9931434e80c40ae0051400b7498810d769fb42dddbc7aa19bdf79603172efe9c0f5d1a65372b463a31178cbae581fa287f39c4fbf8434051b7419f"+    ],+    -- COUNT = 6+    [ "bb6b339eae26072487084ec9e4b53f2f1d4267d205042e74c77fb9ca0591ba50"+    , "c0e7bf6eb07feccbc494af4098e59d30"+    , "34aeec7ed0cae83701b6477709c8654a1114212401dc91cbe7de39d71f0c06e1"+    , "f47fc60afbeb807236f7974d837335bc0b22288ef09ddfcb684e16b4c36a050b"+    , "e8071ccd84ac4527e5c6e85b0709ed867776f25ae0e04180dcb7105ecd3e3490"+    , "fbac45b5952200ad7c4232500f2417a1c14723bdd1cc078821bc2fe138b86597"+    , "c4292d7dbef3ba7c18bf46bcf26776add22ab8ee206d6c722665dec6576b1bc0"+    , "228aa2a314fcbfe63089ce953ac457093deaa39dd9ce2a4ece56a6028a476a98129be516d6979eff5587c032cdf4739d7ac712970f600fa781a8e542e399661183e34e4b90c59ec5dc5cad86f91083529d41c77b8f36c5a8e28ba1a548223a02eaed8426f6fe9f349ebec11bc743e767482e3472ec2799c1f530ebdc6c03bc4b"+    ],+    -- COUNT = 7+    [ "be658e56f80436039e2a9c0a62952dd7d70842244b5ab10f3b8a87d36104e629"+    , "33c9627455dfde91865aee93e5071147"+    , "d3a6eb29b180b791984deb056d72c0608a2c9044237aecf100ccb03700064c5e"+    , "bef24dc9a5aa23003d3825f9b2b00e7dab571ea6ad86415dbd30c0bbdce7b972"+    , "047c29e4d1584fa70cb66e2aa148a2aa29837c5eee64dcac60fdba356cdf90bb"+    , "41c4792161b1b00d410cb79cd56bd311a714fb78dc3471c25bdd7479f2e9a952"+    , "cd4936d7bc3ea0e7201bcbefbc908215a97680ca6ce8672360aea600b6564308"+    , "2c25557f6db07db057f56ad5b6dc0427d1a0e825c48c19a526f9a65087c6d1ead7c78363a61616c84f1022653af65173a3f9ec3275f2b0a0d0bc750194673c0eaa6c623cd88abb0c8979baee4cd85bfce2e4a20bfebf2c3be61676563767dfe229e0b7be67ad6fcd116dd0b460708b1b0e5c3d60f3dd8138030404d197375d75"+    ],+    -- COUNT = 8+    [ "ae537f31a28ca14500e759716bc207983bfeab60b25079fa30b77b8d41244cb9"+    , "fca9e27d8ab84cf9b9ce491ec5d8cb67"+    , "8c9cb2b19aa3abe83c8fe7da96e9c11648252653a29dcd5bf0ac334ac587f032"+    , "1eb52777be480f05115ae6370f30159a94d50ffcc64454678ab1d1ac6f166fa7"+    , "9cdf6f1a2bc07acd4b0f43b5f2b892a1153e2669f237d257923636094fb40b54"+    , "692d512722de6ba720fd23c8994ac63179b5f7e611addf9cfacd60e06e144a6a"+    , "bbeea7b2bea821f339f494947c0b4bae8056119db69a3cbef21914953729cdef"+    , "c0c4fb7080c0fbe425c1b756fb3a090cb0d08c7027d1bb82ed3b07613e2a757f83a78d42f9d8653954b489f800a5e058ebc4f5a1747526541d8448cb72e2232db20569dc96342c36672c4be625b363b4587f44557e58cedb4597cb57d006fda27e027818ae89e15b4c6382b9e7a4453290ea43163b4f9cae38b1023de6a47f7b"+    ],+    -- COUNT = 9+    [ "2f8994c949e08862db0204008f55d3561f3e0362df13b9d9a70fda39938f2d33"+    , "1bf3e94ea858160b832fe85d301256f5"+    , "b46671cf7fa142e7012ed261e1fe86714711c246c7d1c0330fa692141e86d5d1"+    , "5ecdb1e8fe12260b9bfe12d6e6f161474fa2311e12e39b0beb0fcd92a6737b73"+    , "3ce9a29f0207d079e6dc81fb830356e555f96a23ea71424972ea9308965786d3"+    , "db950000c0776cc0e049929ce021020adc42d29cd9b5d8f7117fbe6bde3e594f"+    , "fc18ee6dd3dac2306774f0ac36cd789e33462d72a8c75df9057123db33e5f7bc"+    , "8546362cc8af9b78dd6e8eb2c37db96e70708852bfd9380abedc7f324575a167bea18f632f3e19d099cfbf310773f9719eec036d2e09f393a023add8ebdc4fb87af43b2fe6c7eaa4d39f8022ce247aa45fdc84d1b92cacce6eae8252a03ec2ec5330c01f56d113fd2ec3d0240af0afcf13ddde205bb5e7c2d912dcb4aee5dcf3"+    ],+    -- COUNT = 10+    [ "0c85e31487de1d7ba4a7b998ac56dc42c6dc0eae7bf5c8aaf1e4e78875f5fb47"+    , "de878f728f73f83dc2a2f550b96c8b97"+    , "9aac37bce1a6a81dc7934e23747991e3cf48c55ffe5a57781c41768a35220a01"+    , "2d5ca8af1a70cfdccd015ee3bf0665dd1941fc6a7317b9d0d06658f5744cfbd9"+    , "db881e6d0dc3b62793d7da5fe5a18e33be9b93f4a63a00a878dfbecf0d383bd2"+    , "f743ce1b72f3de4c901369eed581c626ed3081ca707e6634fdaff46721ce0878"+    , "cd52da3ec8a839c537dacdea8506a3eeee879de388ff5e513322d6d1bb3ff694"+    , "a5bdd57cb8fde6298e7c5e563afcca60dd472eca484bd8c3cc17f3307be09b601744dd3ab9e8a44107c5868824575f850c0f399b280cf198006f83ede8c0b537e9be227fa140b65995ad9dfa1f2303d560c3b7f59bedd93c1282ea263924469411c2653f87fd814c74cb91c148430481d64bad0fec3cbb3dd1f39aa55c36f81b"+    ],+    -- COUNT = 11+    [ "93161b2dc08cb0fd50171141c865a841ca935cfdd2b5907d6ff8ab0348c4ceb0"+    , "5cb9f6e5912b90c3349a50ab881b35a1"+    , "0dceb4a36326c4df1685df43fddeecb5d0c76f00eb44826694f27e610290f6e1"+    , "d8e9be44b5f293482548d4787762ebfb03c73c40e45385e8b98907cd66f493dd"+    , "105a8f85d6959f3e043ef508cfea21d52123f03b7aea8034c4eec761eaba1fee"+    , "bf781f7e489d9b4b5aa5ee6d1796468af672a8d25f311edf3c4b4dbf433d703f"+    , "c81d6bcf1e5bf37e39dda1735c6f193df115b1a854a12e7cafe060afe4589335"+    , "4306628124d0100fade7eaaf5edf227d50771f9e5f2e1e983800eef9a39fde0b0c280e63c8728d836b5b93ea794a32c1c04cfc54bd5300e3febb5fe2e1023eded8d7cd180279a598f76823e8d5a7dffcc93a09deec5d1f80838e938fba4de9f47e94b99382ae55f116df9c3b3ddf7e50516e203645852a415796f03a86418107"+    ],+    -- COUNT = 12+    [ "1ae12a5e4e9a4a5bfa79da30a9e6c62ffc639572ef1254194d129a16eb53c716"+    , "5399b3481fdf24d373222267790a0fec"+    , "8280cfdcd7a575816e0199e115da0ea77cae9d30b49c891a6c225e9037ba67e2"+    , "681554ff702658122e91ba017450cfdfc8e3f4911153f7bcc428403e9c7b9d68"+    , "226732b7a457cf0ac0ef09fd4f81296573b49a68de5e7ac3070e148c95e8e323"+    , "45942b5e9a1a128e85e12c34596374ddc85fd7502e5633c7390fc6e6f1e5ef56"+    , "6fc59929b41e77072886aff45f737b449b105ed7eacbd74c7cbfedf533dbeaa1"+    , "b7547332e1509663fcfea2128f7f3a3df484cd8df034b00199157d35d61e35f1a9d481c7d2e81305616d70fc371ee459b0b2267d627e928590edcac3231898b24ef378aa9c3d381619f665379be76c7c1bd535505c563db3725f034786e35bdd90429305fd71d7bf680e8cdd6d4c348d97078f5cf5e89dee2dc410fad4f2a30f"+    ],+    -- COUNT = 13+    [ "29e20d724dfa459960df21c6ec76b1e6cabd23a9e9456d6c591d7e4529da0ef8"+    , "95df1f837eba47a1687aa5c4ddcf8aaf"+    , "3713b601e164b1a51dda1ca9242ff477514648e90d311a06e10ce5aa15da5d7f"+    , "2a2a312626ca3e20034fc4f28033c7d573f66ef61ab2ea0c7bf0411a9d247264"+    , "ec68be33ac8ff3dd127e051604898c0f9a501271859376653a0516336180993d"+    , "9935499661d699a00c622a875441b4df5204958fe95892c8ce67f7dfb2be3e4a"+    , "256a4ba9e8f439d5487fa5eb45efcf1bc1120491724db3abe328d951f2739fc9"+    , "73114cb3624d687d4cd49a6e769dfc7a3f8901dc41f6ad1df4ce480536fa82e52ae958d0528640d92b8bb981b755058e32c4733682e5c4c0df41f3505a1643a0dd49cfdeaf7a18adffca88256c6d2cceb838af6c92a64bc21cb7a760a0391291bfe3575e014fc156323f8eb5e86518c669dad8d29ad5fd4ef6e296f4a0764c26"+    ],+    -- COUNT = 14+    [ "1353f3543eb1134980e061fc4382394975dbc74f1f1ea5ecc02780a813ac5ee6"+    , "cf584db2447afbe2c8fa0c15575ee391"+    , "345b0cc016f2765a8c33fc24f1dcfa182cbe29d7eacbcdc9bcda988521458fc2"+    , "ba60219332a67b95d90ec9de6b8453d4c8af991ae9277461ff3af1b92fc985d3"+    , "6964b9b9842aec9c7ec2aad926d701f30eec76fe699265ae2a7765d716958069"+    , "6a03c28a9365c558c33d3fdc7e5ebf0b4d32caac70df71403fd70ced09757528"+    , "a58546c72a0b4d47c9bd6c19e7cf4ab73b2d7ba36c6c6dc08606f608795ebd29"+    , "5b029ef68b6799868b04dc28dbea26bc2fa9fcc8c2b2795aafeed0127b7297fa19a4ef2ba60c42ff8259d5a759f92bd90fdfb27145e82d798bb3ab7fd60bfaefb7aefb116ca2a4fa8b01d96a03c47c8d987fdd33c460e560b138891278313bb619d0c3c6f9d7c5a37e88fce83e94943705c6ff68e00484e74ad4097b0c9e5f10"+    ]+    ]+
+ tests/Network/Haskoin/Crypto/Keys/Tests.hs view
@@ -0,0 +1,133 @@+module Network.Haskoin.Crypto.Keys.Tests (tests) where++import Test.QuickCheck.Property (Property, (==>))+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import Data.Maybe (fromJust, isNothing)+import Data.Binary.Get (runGet)+import Data.Binary.Put (runPut)+import qualified Data.ByteString as BS (ByteString, length, index)++import Network.Haskoin.Crypto.Arbitrary++import Network.Haskoin.Crypto.Keys+import Network.Haskoin.Crypto.Point+import Network.Haskoin.Crypto.BigWord+import Network.Haskoin.Crypto.Curve+import Network.Haskoin.Util++tests :: [Test]+tests = +    [ testGroup "PubKey Binary"+        [ testProperty "get( put(PubKey) ) = PubKey" getPutPubKey+        , testProperty "is public key canonical" isCanonicalPubKey+        , testProperty "makeKey( toKey(k) ) = k" makeToKey+        , testProperty "makeKeyU( toKey(k) ) = k" makeToKeyU+        , testProperty "decoded PubKey is always valid" decodePubKey+        ],+      testGroup "Key formats"+        [ testProperty "fromWIF( toWIF(i) ) = i" fromToWIF+        , testProperty "get( put(PrvKey) )" getPutPrv+        ],+      testGroup "Key compression"+        [ testProperty "Compressed public key" testCompressed+        , testProperty "Uncompressed public key" testUnCompressed+        , testProperty "Compressed private key" testPrivateCompressed+        , testProperty "Uncompressed private key" testPrivateUnCompressed+        ],+      testGroup "Public Key"+        [ testProperty "Derived public key valid" testDerivedPubKey+        , testProperty "Derived public key from Integer valid" deriveFromInt+        ],+      testGroup "Key properties"+        [ testProperty "PubKey addition" testAddPubKey+        , testProperty "PrvKey addition" testAddPrvKey+        ]+    ]++{- Public Key Binary -}++getPutPubKey :: PubKey -> Bool+getPutPubKey p = p == (decode' $ encode' p)++-- 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+    (not $ BS.index bs 0 `elem` [2,3,4])+    where bs = encode' p++makeToKey :: FieldN -> Property+makeToKey i = i /= 0 ==> +    (fromPrvKey $ makeKey (fromIntegral i)) == (fromIntegral i)+    where makeKey = fromJust . makePrvKey++makeToKeyU :: FieldN -> Property+makeToKeyU i = i /= 0 ==> +    (fromPrvKey $ makeKey (fromIntegral i)) == (fromIntegral i)+    where makeKey = fromJust . makePrvKeyU++decodePubKey :: BS.ByteString -> Bool+decodePubKey bs = fromDecode bs True isValidPubKey++{- Key formats -}++fromToWIF :: PrvKey -> Bool+fromToWIF pk = pk == (fromJust $ fromWIF $ toWIF pk)++getPutPrv :: PrvKey -> Bool+getPutPrv k@(PrvKey  _) = k == runGet getPrvKey  (runPut $ putPrvKey k)+getPutPrv k@(PrvKeyU _) = k == runGet getPrvKeyU (runPut $ putPrvKey k)++{- Key Compression -}++testCompressed :: FieldN -> Property+testCompressed n = n > 0 ==> +    not $ isPubKeyU $ derivePubKey $ fromJust $ makePrvKey $ fromIntegral n++testUnCompressed :: FieldN -> Property+testUnCompressed n = n > 0 ==> +    isPubKeyU $ derivePubKey $ fromJust $ makePrvKeyU $ fromIntegral n++testPrivateCompressed :: FieldN -> Property+testPrivateCompressed n = n > 0 ==> +    not $ isPrvKeyU $ fromJust $ makePrvKey $ fromIntegral n++testPrivateUnCompressed :: FieldN -> Property+testPrivateUnCompressed n = n > 0 ==> +    isPrvKeyU $ fromJust $ makePrvKeyU $ fromIntegral n++testDerivedPubKey :: PrvKey -> Bool+testDerivedPubKey k = isValidPubKey $ derivePubKey k++deriveFromInt :: Integer -> Bool+deriveFromInt i = maybe True (isValidPubKey . derivePubKey) $ makePrvKey i++{- Key properties -}++testAddPubKey :: TestPrvKeyC -> Hash256 -> Bool+testAddPubKey (TestPrvKeyC key) i +    | toInteger i >= curveN = isNothing res+    | model == InfPoint     = isNothing res+    | otherwise             = PubKey model == fromJust res+    where pub   = derivePubKey key+          pt    = mulPoint (toFieldN i) curveG+          model = addPoint (pubKeyPoint pub) pt+          res   = addPubKeys pub i++testAddPrvKey :: TestPrvKeyC -> Hash256 -> Bool+testAddPrvKey (TestPrvKeyC key) i+    | toInteger i >= curveN = isNothing res+    | model == 0  = isNothing res+    | otherwise   = PrvKey model == fromJust res+    where model = (prvKeyFieldN key) + (toFieldN i)+          res   = addPrvKeys key i+
+ tests/Network/Haskoin/Crypto/Merkle/Tests.hs view
@@ -0,0 +1,36 @@+module Network.Haskoin.Crypto.Merkle.Tests (tests) where++import Test.QuickCheck.Property (Property, (==>))+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import Network.Haskoin.Crypto.Arbitrary ()+import Network.Haskoin.Crypto+import Network.Haskoin.Util++tests :: [Test]+tests = +    [ 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" buildExtractTree+        ]+    ]++{- Merkle Trees -}++testTreeWidth :: Int -> Property+testTreeWidth i = i > 0 ==> calcTreeWidth i (calcTreeHeight i) == 1++testBaseWidth :: Int -> Property+testBaseWidth i = i > 0 ==> calcTreeWidth i 0 == i++buildExtractTree :: [(Hash256,Bool)] -> Property+buildExtractTree txs = not (null txs) ==>+    r == (buildMerkleRoot hashes) && m == (map fst $ filter snd txs)+  where+    (f,h)  = buildPartialMerkle txs+    (r,m)  = fromRight $ extractMatches f h (length txs)+    hashes = map fst txs++
+ tests/Network/Haskoin/Crypto/Merkle/Units.hs view
@@ -0,0 +1,113 @@+module Network.Haskoin.Crypto.Merkle.Units (tests) where++import Test.HUnit (Assertion, assertBool)+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.HUnit (testCase)++import Data.Maybe (fromJust)+import qualified Data.ByteString as BS (reverse)++import Network.Haskoin.Crypto+import Network.Haskoin.Util++tests :: [Test]+tests =+    [ testGroup "Merkle Roots" +        (map mapMerkleVectors $ zip merkleVectors [0..])+    ]++mapMerkleVectors :: ((String,[String]),Int) -> Test.Framework.Test+mapMerkleVectors (v,i) = +    testCase name $ runMerkleVector v+  where+    name = "MerkleRoot vector " ++ (show i)++runMerkleVector :: (String,[String]) -> Assertion+runMerkleVector (r,hs) = do+    assertBool "    >  Merkle Vector" $ buildMerkleRoot (map f hs) == (f r)+  where+    f = decode' . BS.reverse . fromJust . hexToBS++merkleVectors :: [(String,[String])]+merkleVectors =+      -- Block 000000000000cd7e8cf6510303dde76121a1a791c15dba0be4be7022b07cf9e1+    [ ( "fb6698ac95b754256c5e71b4fbe07638cb6ca83ee67f44e181b91727f09f4b1f"+      , [ "dd96fdcfaec994bf583af650ff6022980ee0ba1686d84d0a3a2d24eabf34bc52"+        , "1bc216f786a564378710ae589916fc8e092ddfb9f24fe6c47b733550d476d5d9"+        , "a1db0b0194426064b067899ff2d975fb277fd52dbb1a38370800c76dd6503d41"+        , "d69f7fb0e668fbd437d1bf5211cc34d7eb8746f50cfddf705fe10bc2f8f7035f"+        , "5b4057cd80be7df5ed2ac42b776897ed3c26e3a01e4072075b8129c587094ef6"+        , "ed6dabcfba0ef43c50d89a8a0e4b236b1bc6585d4c3bbf49728b55f44312d6bc"+        , "056aaa9a3c635909c794e9b0acc7dccb0456c59a84c6b08417335bee4515e3d3"+        , "05bae5f1d1c874171692e1fc06f664e63eb143d3f096601ef938e4a9012eee66"+        , "b5e48e94e3f2fba197b3f591e01f47e185d7834d669529d44078e41c671aab0f"+        , "3b56aeadfc0c5484fd507bc89f13f2e5f61c42e0a4ae9062eda9a9aeef7db6a4"+        , "2affa187e1ebb94a2a86578b9f64951e854ff3d346fef259acfb6d0f5212e0d3"+        ]+      )+      -- Block 00000000000007cc4b6f07bfed72bccc1ed8dd031a93969a4c22211f784457d4+    , ( "886fea311d2dc64c315519f2d647e43998d780d2170f77e53dc0d85bf2ee680c"+      , [ "c9c9e5211512629fd111cc071d745b8c79bf486b4ea95489eb5de08b5d786b8e"+        , "20beb0ee30dfd323ade790ce9a46ae7a174f9ea44ce22a17c4d4eb23b7016f51"+        , "d4cb7dd741e78a8f57e12f6c8ddb0361ff2a5bf9365bd7d7df761060847daf9a"+        , "ddbfa6fdd29d4b47aeaadf82a4bf0a93d58cd7d8401fabf860a1ae8eeb51f42e"+        , "9d82bafe44abee248b968c86f165051c8413482c232659795335c52922dab471"+        , "86035372d31b53efd848cea7231aa9738c209aff64d3c59b1619341afb5b6ba3"+        , "11e7a7393d9658813dfaebc04fa6d4b73bac8d641bffa7067da879523d43d030"+        , "2f676b9aa5bc0ebf3395032c84c466e40cac29f80434cd1138e31c2d0fcc5c13"+        , "37567d559fbfae07fda9a90de0ce30b202128bc8ebdfef5ad2b53e865a3478c2"+        , "0b8e6c1200c454361e94e261738429e9c9b8dcffd85ec8511bbf5dc7e2e0ada8"+        ]+      )+      -- Block 00000000839a8e6886ab5951d76f411475428afc90947ee320161bbf18eb6048+    , ( "0e3e2357e806b6cdb1f70b54c3a3a17b6714ee1f0e68bebb44a74b1efd512098"+      , [ "0e3e2357e806b6cdb1f70b54c3a3a17b6714ee1f0e68bebb44a74b1efd512098" ]+      )+      -- Block 000000000004d160ac1f7b775d7c1823345aeadd5fcb29ca2ad2403bb7babd4c+    , ( "aae018650f513fc42d55b2210ec3ceeeb194fb1261d37989de07451fc0cbac5c"+      , [ "a4454f22831acd7904a9902c5070a3ee4bf4c2b13bc6b2dc66735dd3c4414028"+        , "45297f334278885108dd38a0b689ed95a4373dd3f7e4413e6aebdc2654fb771b"+        ]+      )+      -- Block 000000000001d1b13a7e86ddb20da178f20d6da5cd037a29c2a15b8b84cc774e+    , ( "ca3580505feb87544760ac14a5859659e23be05f765bbed9f86a3c9aad1a5d0c"+      , [ "60702384c6e9d34ff03c2b3e726bdc649befe603216815bd0a2974921d0d9549"+        , "11f40f58941d2a81a1616a3b84b7dd8b9d07e68750827de488c11a18f54220bb"+        , "d78e82527aa8cf16e375010bc666362c0258d3c0da1885a1871121706da8b633"+        ]+      )+      -- Block 0000000000000630a4e2266a31776e952a19b7c99a6387917d9de9032f608021+    , ( "dcce8be0a9a41e7bb726c5b49d957d90b5308e3dc5dce070ccbc8996e265a6c2"+      , [ "c0f58ff12cd1023b05f8f7035cc62bf50958ddb216a4e0eb5471deb7ef25fe81"+        , "24e5bbf9008641b8fcf3d076fef66c28c695362ba9f6a6042f8275a98414ee92"+        , "e8e1f72abad5e34dabc0f6de46a484b17a9af857d1c41de19482fadf6f7f4b27"+        , "540e4d34d9fd9e5ec02853054be7ad9260379bc23388489049cca1b0f7cf518a"+        , "324444835c5fe0545f98c4240011b75e6ea1bb76f41829e4cfbe7f75b6cee924"+        , "e7d31437ac21bceb0c222a82b2723e2b8a7654147e33397679f041537022a4b2"+        , "a8b5768d8b33525ee89d546a6a6897f8e42ba9d56a2c5e871a5d2ab40258dc95"+        , "7ba712b31bae8d45810a5cda3838c7e7fb9abd6e88bb4b3ee79be9ea2f714bb4"+        , "2ae1c4d927b06edaa626b230976ad8062bbae24da9378d1de2409da5ab08a26d"+        , "3c417dc8087d6878003624b74431e17fec9ca761389034b1b1e0f32cbfb11f4f"+        , "de6de7beae8d8c98c7d46b4409d5460e58e3204d8b4caed256c7471998595909"+        , "c7c3c211402b7c4379f7b01fadc67260ee58d11e8d0bcce3d68cb45f3467e99d"+        , "77aa2717e727a096d81074bd46ae59462692d20a1acc1a01b2535518ae5aeb53"+        , "4859a710bb673aca46208bbd59d1000ae990dafff5f70b56f0853aeeaea3948b"+        , "38deca6991988e461b83aa0d49ffef0f304c4b760371682d152eeb8c56a48174"+        , "648f4f50dada3574e2dfe2dc68956b01dd97d543859a3540bbe1ef5418d0e494"+        , "9cd7be42c2f0cd8bf38738c162cd05108e213ec7958bf2571cb627872963f5c4"+        , "6740e0dd8b97e23864af41839fc197238d2f0dbefce9a82c657556be65c465fa"+        , "f75c2e4b70db4b0aabc44b77af1ae75d305340fcf6e7b5f806ddcba4aa42b55d"+        , "e125c488636749da68e6696b97525a77146c0777c7946927e37afd513d74a4e6"+        , "c20526f119aea10880af631eba7f0b60385a22e0b0c402fe8508d41952e58be9"+        , "6456c023c7e245f5c57a168633a23f57f4fadb651115f807694a6bed14ae3b55"+        , "98b26e364e2888c9f264e4b5e13103c89608609774eb07ce933d8a2a45d19776"+        , "2efaa4f167bb65ba5684f8076cd9279fd67fd9c67388c8862809bab5542e637d"+        , "ec44eeb84d8d976d77079a822710b4dfdb11a2d9a03d8cc00bab0ae424e84666"+        , "410730d9f807d81ac48b8eafac6f1d36642c1c370241b367a35f0bac6ac7c05f"+        , "e95a7d0d477fd3db22756a3fd390a50c7bc48dc9e946fea9d24bd0866b3bb0e9"+        , "a72fec99d14939216628aaf7a0afc4c017113bcae964e777e6b508864eeaacc4"+        , "8548433310fcf75dbbc042121e8318c678e0a017534786dd322a91cebe8d213f"+        ]+      )+    ]+
+ tests/Network/Haskoin/Crypto/Mnemonic/Tests.hs view
@@ -0,0 +1,179 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.Haskoin.Crypto.Mnemonic.Tests (tests) where++import Data.Bits ((.&.), shiftR)+import Data.Binary (Binary)+import qualified Data.Text as T+import Data.Word (Word32)+import qualified Data.ByteString as BS+import Network.Haskoin.Crypto.Arbitrary()+import Network.Haskoin.Crypto.Mnemonic+import Network.Haskoin.Crypto.BigWord+import Network.Haskoin.Util (encode', fromRight)+import Test.QuickCheck (Arbitrary, Property, arbitrary, choose, (==>))+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)+++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+        ]+    ]++binWordsToBS :: Binary a => [a] -> BS.ByteString+binWordsToBS = foldr f BS.empty+  where+    f b a = a `BS.append` encode' b++{- Encode mnemonic -}++toMnemonic128 :: Word128 -> Bool+toMnemonic128 x = l == 12+  where+    bs = encode' x+    l = length . T.words . fromRight $ toMnemonic english bs++toMnemonic160 :: Word160 -> Bool+toMnemonic160 x = l == 15+  where+    bs = encode' x+    l = length . T.words . fromRight $ toMnemonic english bs++toMnemonic256 :: Word256 -> Bool+toMnemonic256 x = l == 24+  where+    bs = encode' x+    l = length . T.words . fromRight $ toMnemonic english bs++toMnemonic512 :: Word512 -> Bool+toMnemonic512 x = l == 48+  where+    bs = encode' x+    l = length . T.words . fromRight $ toMnemonic english bs++toMnemonicVar :: [Word32] -> Property+toMnemonicVar ls = not (length ls > 8) ==> l == wc+  where+    bs = binWordsToBS ls+    bl = BS.length bs+    cb = bl `div` 4+    wc = (cb + bl * 8) `div` 11+    l = length . T.words . fromRight $ toMnemonic english bs++{- Encode/Decode -}++fromToMnemonic128 :: Word128 -> Bool+fromToMnemonic128 x = bs == bs'+  where+    bs = encode' x+    bs' = fromRight (fromMnemonic english =<< toMnemonic english bs)++fromToMnemonic160 :: Word160 -> Bool+fromToMnemonic160 x = bs == bs'+  where+    bs = encode' x+    bs' = fromRight (fromMnemonic english =<< toMnemonic english bs)++fromToMnemonic256 :: Word256 -> Bool+fromToMnemonic256 x = bs == bs'+  where+    bs = encode' x+    bs' = fromRight (fromMnemonic english =<< toMnemonic english bs)++fromToMnemonic512 :: Word512 -> Bool+fromToMnemonic512 x = bs == bs'+  where+    bs = encode' x+    bs' = fromRight (fromMnemonic english =<< toMnemonic english bs)++fromToMnemonicVar :: [Word32] -> Property+fromToMnemonicVar ls = not (length ls > 8) ==> bs == bs'+  where+    bs = binWordsToBS ls+    bs' = fromRight (fromMnemonic english =<< toMnemonic english bs)++{- Mnemonic to seed -}++mnemonicToSeed128 :: Word128 -> Bool+mnemonicToSeed128 x = l == 64+  where+    bs = encode' x+    seed = fromRight (mnemonicToSeed english "" =<< toMnemonic english bs)+    l = BS.length seed++mnemonicToSeed160 :: Word160 -> Bool+mnemonicToSeed160 x = l == 64+  where+    bs = encode' x+    seed = fromRight (mnemonicToSeed english "" =<< toMnemonic english bs)+    l = BS.length seed++mnemonicToSeed256 :: Word256 -> Bool+mnemonicToSeed256 x = l == 64+  where+    bs = encode' x+    seed = fromRight (mnemonicToSeed english "" =<< toMnemonic english bs)+    l = BS.length seed++mnemonicToSeed512 :: Word512 -> Bool+mnemonicToSeed512 x = l == 64+  where+    bs = encode' x+    seed = fromRight (mnemonicToSeed english "" =<< toMnemonic english bs)+    l = BS.length seed++mnemonicToSeedVar :: [Word32] -> Property+mnemonicToSeedVar ls = not (length ls > 16) ==> l == 64+  where+    bs = binWordsToBS ls+    seed = fromRight (mnemonicToSeed english "" =<< toMnemonic english bs)+    l = BS.length seed++{- Get bits from ByteString -}++data ByteCountGen = ByteCountGen BS.ByteString Int deriving Show++instance Arbitrary ByteCountGen where+    arbitrary = do+        bs <- arbitrary+        i <- choose (0, BS.length bs * 8)+        return $ ByteCountGen bs i++getBitsByteCount :: ByteCountGen -> Bool+getBitsByteCount (ByteCountGen bs i) = BS.length bits == l+  where+    (q, r) = i `quotRem` 8+    bits = getBits i bs+    l = if r == 0 then q else q + 1++getBitsEndBits :: ByteCountGen -> Bool+getBitsEndBits (ByteCountGen bs i) = mask+  where+    r = i `mod` 8+    bits = getBits i bs+    mask = if r == 0 then True else BS.last bits .&. (0xff `shiftR` r) == 0x00+
+ tests/Network/Haskoin/Crypto/Mnemonic/Units.hs view
@@ -0,0 +1,177 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.Haskoin.Crypto.Mnemonic.Units (tests) where++import Test.HUnit (assertEqual)+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.HUnit (testCase)++import Data.Maybe (fromJust)+import qualified Data.Text as T+import Network.Haskoin.Crypto.Mnemonic+import Network.Haskoin.Util (hexToBS, bsToHex, fromRight)++tests :: [Test]+tests =+    [ testGroup "Entropy to mnemonic sentence" toMnemonicTest+    , testGroup "Mnemonic sentence to entropy" fromMnemonicTest+    , testGroup "Mnemonic sentence to seed" mnemonicToSeedTest+    ]++toMnemonicTest :: [Test]+toMnemonicTest = map f $ zip ents mss+  where+    f (e, m) = g e . assertEqual "" m . h $ e+    g = testCase+    h = fromRight . toMnemonic english . fromJust . hexToBS++fromMnemonicTest :: [Test]+fromMnemonicTest = map f $ zip ents mss+  where+    f (e, m) = g e . assertEqual "" e . h $ m+    g = testCase+    h = bsToHex . fromRight . fromMnemonic english++mnemonicToSeedTest :: [Test]+mnemonicToSeedTest = map f $ zip mss seeds+  where+    f (m, s) = g s . assertEqual "" s . h $ m+    g = testCase . (++ "...") . take 50+    h = bsToHex . fromRight . mnemonicToSeed english "TREZOR"+    ++ents :: [String]+ents =+    [ "00000000000000000000000000000000"+    , "7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f"+    , "80808080808080808080808080808080"+    , "ffffffffffffffffffffffffffffffff"+    , "000000000000000000000000000000000000000000000000"+    , "7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f"+    , "808080808080808080808080808080808080808080808080"+    , "ffffffffffffffffffffffffffffffffffffffffffffffff"+    , "0000000000000000000000000000000000000000000000000000000000000000"+    , "7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f"+    , "8080808080808080808080808080808080808080808080808080808080808080"+    , "ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff"+    , "77c2b00716cec7213839159e404db50d"+    , "b63a9c59a6e641f288ebc103017f1da9f8290b3da6bdef7b"+    , "3e141609b97933b66a060dcddc71fad1d91677db872031e85f4c015c5e7e8982"+    , "0460ef47585604c5660618db2e6a7e7f"+    , "72f60ebac5dd8add8d2a25a797102c3ce21bc029c200076f"+    , "2c85efc7f24ee4573d2b81a6ec66cee209b2dcbd09d8eddc51e0215b0b68e416"+    , "eaebabb2383351fd31d703840b32e9e2"+    , "7ac45cfe7722ee6c7ba84fbc2d5bd61b45cb2fe5eb65aa78"+    , "4fa1a8bc3e6d80ee1316050e862c1812031493212b7ec3f3bb1b08f168cabeef"+    , "18ab19a9f54a9274f03e5209a2ac8a91"+    , "18a2e1d81b8ecfb2a333adcb0c17a5b9eb76cc5d05db91a4"+    , "15da872c95a13dd738fbf50e427583ad61f18fd99f628c417a61cf8343c90419"+    ]++mss :: [T.Text]+mss =+    [ "abandon abandon abandon abandon abandon abandon abandon abandon abandon\+      \ abandon abandon about"+    , "legal winner thank year wave sausage worth useful legal winner thank\+      \ yellow"+    , "letter advice cage absurd amount doctor acoustic avoid letter advice\+      \ cage above"+    , "zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo wrong"+    , "abandon abandon abandon abandon abandon abandon abandon abandon abandon\+      \ abandon abandon abandon abandon abandon abandon abandon abandon agent"+    , "legal winner thank year wave sausage worth useful legal winner thank\+      \ year wave sausage worth useful legal will"+    , "letter advice cage absurd amount doctor acoustic avoid letter advice\+      \ cage absurd amount doctor acoustic avoid letter always"+    , "zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo\+      \ when"+    , "abandon abandon abandon abandon abandon abandon abandon abandon abandon\+      \ abandon abandon abandon abandon abandon abandon abandon abandon abandon\+      \ abandon abandon abandon abandon abandon art"+    , "legal winner thank year wave sausage worth useful legal winner thank\+      \ year wave sausage worth useful legal winner thank year wave sausage\+      \ worth title"+    , "letter advice cage absurd amount doctor acoustic avoid letter advice\+      \ cage absurd amount doctor acoustic avoid letter advice cage absurd\+      \ amount doctor acoustic bless"+    , "zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo\+      \ zoo zoo zoo zoo zoo vote"+    , "jelly better achieve collect unaware mountain thought cargo oxygen act\+      \ hood bridge"+    , "renew stay biology evidence goat welcome casual join adapt armor shuffle\+      \ fault little machine walk stumble urge swap"+    , "dignity pass list indicate nasty swamp pool script soccer toe leaf photo\+      \ multiply desk host tomato cradle drill spread actor shine dismiss\+      \ champion exotic"+    , "afford alter spike radar gate glance object seek swamp infant panel\+      \ yellow"+    , "indicate race push merry suffer human cruise dwarf pole review arch keep\+      \ canvas theme poem divorce alter left"+    , "clutch control vehicle tonight unusual clog visa ice plunge glimpse\+      \ recipe series open hour vintage deposit universe tip job dress radar\+      \ refuse motion taste"+    , "turtle front uncle idea crush write shrug there lottery flower risk\+      \ shell"+    , "kiss carry display unusual confirm curtain upgrade antique rotate hello\+      \ void custom frequent obey nut hole price segment"+    , "exile ask congress lamp submit jacket era scheme attend cousin alcohol\+      \ catch course end lucky hurt sentence oven short ball bird grab wing top"+    , "board flee heavy tunnel powder denial science ski answer betray cargo\+      \ cat"+    , "board blade invite damage undo sun mimic interest slam gaze truly\+      \ inherit resist great inject rocket museum chief"+    , "beyond stage sleep clip because twist token leaf atom beauty genius food\+      \ business side grid unable middle armed observe pair crouch tonight away\+      \ coconut"+    ]++seeds :: [String]+seeds =+    [ "c55257c360c07c72029aebc1b53c05ed0362ada38ead3e3e9efa3708e53495531f09a69\+      \87599d18264c1e1c92f2cf141630c7a3c4ab7c81b2f001698e7463b04"+    , "2e8905819b8723fe2c1d161860e5ee1830318dbf49a83bd451cfb8440c28bd6fa457fe1\+      \296106559a3c80937a1c1069be3a3a5bd381ee6260e8d9739fce1f607"+    , "d71de856f81a8acc65e6fc851a38d4d7ec216fd0796d0a6827a3ad6ed5511a30fa280f1\+      \2eb2e47ed2ac03b5c462a0358d18d69fe4f985ec81778c1b370b652a8"+    , "ac27495480225222079d7be181583751e86f571027b0497b5b5d11218e0a8a133325729\+      \17f0f8e5a589620c6f15b11c61dee327651a14c34e18231052e48c069"+    , "035895f2f481b1b0f01fcf8c289c794660b289981a78f8106447707fdd9666ca06da5a9\+      \a565181599b79f53b844d8a71dd9f439c52a3d7b3e8a79c906ac845fa"+    , "f2b94508732bcbacbcc020faefecfc89feafa6649a5491b8c952cede496c214a0c7b3c3\+      \92d168748f2d4a612bada0753b52a1c7ac53c1e93abd5c6320b9e95dd"+    , "107d7c02a5aa6f38c58083ff74f04c607c2d2c0ecc55501dadd72d025b751bc27fe913f\+      \fb796f841c49b1d33b610cf0e91d3aa239027f5e99fe4ce9e5088cd65"+    , "0cd6e5d827bb62eb8fc1e262254223817fd068a74b5b449cc2f667c3f1f985a76379b43\+      \348d952e2265b4cd129090758b3e3c2c49103b5051aac2eaeb890a528"+    , "bda85446c68413707090a52022edd26a1c9462295029f2e60cd7c4f2bbd3097170af7a4\+      \d73245cafa9c3cca8d561a7c3de6f5d4a10be8ed2a5e608d68f92fcc8"+    , "bc09fca1804f7e69da93c2f2028eb238c227f2e9dda30cd63699232578480a4021b146a\+      \d717fbb7e451ce9eb835f43620bf5c514db0f8add49f5d121449d3e87"+    , "c0c519bd0e91a2ed54357d9d1ebef6f5af218a153624cf4f2da911a0ed8f7a09e2ef61a\+      \f0aca007096df430022f7a2b6fb91661a9589097069720d015e4e982f"+    , "dd48c104698c30cfe2b6142103248622fb7bb0ff692eebb00089b32d22484e1613912f0\+      \a5b694407be899ffd31ed3992c456cdf60f5d4564b8ba3f05a69890ad"+    , "b5b6d0127db1a9d2226af0c3346031d77af31e918dba64287a1b44b8ebf63cdd52676f6\+      \72a290aae502472cf2d602c051f3e6f18055e84e4c43897fc4e51a6ff"+    , "9248d83e06f4cd98debf5b6f010542760df925ce46cf38a1bdb4e4de7d21f5c39366941\+      \c69e1bdbf2966e0f6e6dbece898a0e2f0a4c2b3e640953dfe8b7bbdc5"+    , "ff7f3184df8696d8bef94b6c03114dbee0ef89ff938712301d27ed8336ca89ef9635da2\+      \0af07d4175f2bf5f3de130f39c9d9e8dd0472489c19b1a020a940da67"+    , "65f93a9f36b6c85cbe634ffc1f99f2b82cbb10b31edc7f087b4f6cb9e976e9faf76ff41\+      \f8f27c99afdf38f7a303ba1136ee48a4c1e7fcd3dba7aa876113a36e4"+    , "3bbf9daa0dfad8229786ace5ddb4e00fa98a044ae4c4975ffd5e094dba9e0bb289349db\+      \e2091761f30f382d4e35c4a670ee8ab50758d2c55881be69e327117ba"+    , "fe908f96f46668b2d5b37d82f558c77ed0d69dd0e7e043a5b0511c48c2f1064694a956f\+      \86360c93dd04052a8899497ce9e985ebe0c8c52b955e6ae86d4ff4449"+    , "bdfb76a0759f301b0b899a1e3985227e53b3f51e67e3f2a65363caedf3e32fde42a66c4\+      \04f18d7b05818c95ef3ca1e5146646856c461c073169467511680876c"+    , "ed56ff6c833c07982eb7119a8f48fd363c4a9b1601cd2de736b01045c5eb8ab4f57b079\+      \403485d1c4924f0790dc10a971763337cb9f9c62226f64fff26397c79"+    , "095ee6f817b4c2cb30a5a797360a81a40ab0f9a4e25ecd672a3f58a0b5ba0687c096a6b\+      \14d2c0deb3bdefce4f61d01ae07417d502429352e27695163f7447a8c"+    , "6eff1bb21562918509c73cb990260db07c0ce34ff0e3cc4a8cb3276129fbcb300bddfe0\+      \05831350efd633909f476c45c88253276d9fd0df6ef48609e8bb7dca8"+    , "f84521c777a13b61564234bf8f8b62b3afce27fc4062b51bb5e62bdfecb23864ee6ecf0\+      \7c1d5a97c0834307c5c852d8ceb88e7c97923c0a3b496bedd4e5f88a9"+    , "b15509eaa2d09d3efd3e006ef42151b30367dc6e3aa5e44caba3fe4d3e352e65101fbdb\+      \86a96776b91946ff06f8eac594dc6ee1d3e82a42dfe1b40fef6bcc3fd"+    ]
+ tests/Network/Haskoin/Crypto/Point/Tests.hs view
@@ -0,0 +1,103 @@+module Network.Haskoin.Crypto.Point.Tests (tests) where++import Test.QuickCheck.Property (Property, (==>))+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import Data.Maybe (fromJust)++import Network.Haskoin.Crypto.Arbitrary()+import Network.Haskoin.Crypto.Point+import Network.Haskoin.Crypto.BigWord++tests :: [Test]+tests = +    [ testGroup "Elliptic curve point arithmetic"+        [ testProperty "P is on the curve" checkOnCurve+        , testProperty "P1 + P2 is on the curve" addOnCurve+        , testProperty "n*P is on the curve" mulOnCurve+        , testProperty "makePoint (getAffine P) = P" fromToAffine+        , testProperty "P + InfPoint = P" addInfPoint+        , testProperty "InfPoint + P = P" addInfPoint'+        , testProperty "P1 + P2 = P2 + P1" addCommutative+        , testProperty "(P1 + P2) + P3 = P1 + (P2 + P3)" addAssoc+        , testProperty "(x,y) + (x,-y) = InfPoint" addInverseY+        , testProperty "double P = P + P" doubleAddPoint+        , testProperty "double P = 2*P" doubleMulPoint+        , testProperty "n*P = P + (n-1)*P" mulPointInduction+        , testProperty "a*P + b*P = (a + b)*P" mulDistributivity+        , testProperty "shamirsTrick = n1*P1 + n2*P2" testShamirsTrick+        , testProperty "point equality" testPointEqual+        ]+    ]++{- Elliptic curve point arithmetic -}++checkOnCurve :: Point -> Bool+checkOnCurve InfPoint = True+checkOnCurve p = validatePoint p++addOnCurve :: Point -> Point -> Bool+addOnCurve p1 p2 = case addPoint p1 p2 of+    InfPoint -> True+    p        -> validatePoint p++mulOnCurve :: Point -> FieldN -> Bool+mulOnCurve p1 n = case mulPoint n p1 of+    InfPoint -> True+    p        -> validatePoint p++fromToAffine :: Point -> Property+fromToAffine p = not (isInfPoint p) ==> (fromJust $ makePoint x y) == p+  where +    (x,y) = fromJust $ getAffine p++addInfPoint :: Point -> Bool+addInfPoint p = addPoint p makeInfPoint == p++addInfPoint' :: Point -> Bool+addInfPoint' p = addPoint makeInfPoint p == p++addCommutative :: Point -> Point -> Bool+addCommutative p1 p2 = addPoint p1 p2 == addPoint p2 p1++addAssoc :: Point -> Point -> Point -> Bool+addAssoc p1 p2 p3 = +    addPoint (addPoint p1 p2) p3 == addPoint p1 (addPoint p2 p3)++addInverseY :: Point -> Bool+addInverseY p1 = case (getAffine p1) of+    (Just (x,y)) -> addPoint p1 (fromJust $ makePoint x (-y)) == makeInfPoint+    Nothing      -> True++doubleAddPoint :: Point -> Bool+doubleAddPoint p = doublePoint p == addPoint p p++doubleMulPoint :: Point -> Bool+doubleMulPoint p = doublePoint p == mulPoint 2 p++mulPointInduction :: FieldN -> Point -> Property+mulPointInduction i p = i > 2 ==> +    mulPoint i p == addPoint p (mulPoint (i-1) p)++mulDistributivity :: FieldN -> FieldN -> Point -> Bool+mulDistributivity a b p = +    (addPoint (mulPoint a p) (mulPoint b p)) == mulPoint (a + b) p++testShamirsTrick :: FieldN -> Point -> FieldN -> Point -> Bool+testShamirsTrick n1 p1 n2 p2 = shamirRes == normalRes+  where +    shamirRes = shamirsTrick n1 p1 n2 p2+    normalRes = addPoint (mulPoint n1 p1) (mulPoint n2 p2)  ++testPointEqual :: Point -> Point -> Bool+testPointEqual p1@InfPoint p2@InfPoint = p1 == p2 +testPointEqual p1 p2@InfPoint          = p1 /= p2+testPointEqual p1@InfPoint p2          = p1 /= p2+testPointEqual p1 p2+    | x1 == x2 && y1 == y2 = p1 == p2+    | otherwise            = p1 /= p2+  where +    (x1,y1) = fromJust $ getAffine p1+    (x2,y2) = fromJust $ getAffine p2+
+ tests/Network/Haskoin/Crypto/Units.hs view
@@ -0,0 +1,264 @@+module Network.Haskoin.Crypto.Units (tests) where++import Test.HUnit (Assertion, assertBool)+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.HUnit (testCase)++import Control.Monad (replicateM_)+import Control.Monad.Trans (liftIO)++import Data.Maybe+import Data.Binary+import qualified Data.ByteString as BS++import Network.Haskoin.Crypto.Keys+import Network.Haskoin.Crypto.BigWord+import Network.Haskoin.Crypto.ECDSA+import Network.Haskoin.Crypto.Hash+import Network.Haskoin.Crypto.Base58+import Network.Haskoin.Util++-- Unit tests copied from bitcoind implementation+-- https://github.com/bitcoin/bitcoin/blob/master/src/test/key_tests.cpp++strSecret1 :: String+strSecret1  = "5HxWvvfubhXpYYpS3tJkw6fq9jE9j18THftkZjHHfmFiWtmAbrj"++strSecret2 :: String+strSecret2  = "5KC4ejrDjv152FGwP386VD1i2NYc5KkfSMyv1nGy1VGDxGHqVY3"++strSecret1C :: String+strSecret1C = "Kwr371tjA9u2rFSMZjTNun2PXXP3WPZu2afRHTcta6KxEUdm1vEw"++strSecret2C :: String+strSecret2C = "L3Hq7a8FEQwJkW1M2GNKDW28546Vp5miewcCzSqUD9kCAXrJdS3g"++addr1 :: String +addr1  = "1QFqqMUD55ZV3PJEJZtaKCsQmjLT6JkjvJ"++addr2 :: String +addr2  = "1F5y5E5FMc5YzdJtB9hLaUe43GDxEKXENJ"++addr1C :: String+addr1C = "1NoJrossxPBKfCHuJXT4HadJrXRE9Fxiqs"++addr2C :: String+addr2C = "1CRj2HyM1CXWzHAXLQtiGLyggNT9WQqsDs"++strAddressBad :: String+strAddressBad = "1HV9Lc3sNHZxwj4Zk6fB38tEmBryq2cBiF"++sigMsg :: [String]+sigMsg = [ ("Very secret message " ++ (show (i :: Int)) ++ ": 11") +         | i <- [0..15]+         ]++sec1 :: PrvKey+sec1  = fromJust $ fromWIF strSecret1++sec2 :: PrvKey+sec2  = fromJust $ fromWIF strSecret2++sec1C :: PrvKey+sec1C = fromJust $ fromWIF strSecret1C++sec2C :: PrvKey+sec2C = fromJust $ fromWIF strSecret2C++pub1 :: PubKey+pub1  = derivePubKey sec1++pub2 :: PubKey+pub2  = derivePubKey sec2++pub1C :: PubKey+pub1C = derivePubKey sec1C++pub2C :: PubKey+pub2C = derivePubKey sec2C++tests :: [Test]+tests =+    [ testGroup "ECDSA PRNG unit tests"+        [ testCase "signMsg produces unique sigantures" uniqueSigs+        , testCase "genPrvKey produces unique keys" uniqueKeys+        ] +    , testGroup "bitcoind /src/test/key_tests.cpp" $+        [ testCase "Decode Valid WIF" checkPrivkey+        , testCase "Decode Invalid WIF" checkInvalidKey+        , 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 $ doubleHash256 $ stringToBS x))) sigMsg )+    , testGroup "Trezor RFC 6979 Test Vectors"+        [ testCase "RFC 6979 Test Vector 1" (testDetSigning $ detVec !! 0)+        , testCase "RFC 6979 Test Vector 2" (testDetSigning $ detVec !! 1)+        , testCase "RFC 6979 Test Vector 3" (testDetSigning $ detVec !! 2)+        , testCase "RFC 6979 Test Vector 4" (testDetSigning $ detVec !! 3)+        , testCase "RFC 6979 Test Vector 5" (testDetSigning $ detVec !! 4)+        , testCase "RFC 6979 Test Vector 6" (testDetSigning $ detVec !! 5)+        , testCase "RFC 6979 Test Vector 7" (testDetSigning $ detVec !! 6)+        , testCase "RFC 6979 Test Vector 8" (testDetSigning $ detVec !! 7)+        , testCase "RFC 6979 Test Vector 9" (testDetSigning $ detVec !! 8)+        , testCase "RFC 6979 Test Vector 10" (testDetSigning $ detVec !! 9)+        , testCase "RFC 6979 Test Vector 11" (testDetSigning $ detVec !! 10)+        , testCase "RFC 6979 Test Vector 12" (testDetSigning $ detVec !! 11)+        ] +    ]++{- ECDSA PRNG unit tests -}++uniqueSigs :: Assertion+uniqueSigs = do+    let msg = hash256 $ BS.pack [0..19]+        prv = fromJust $ makePrvKey 0x987654321+    ((r1,s1),(r2,s2),(r3,s3)) <- liftIO $ withSource devURandom $ do+        (Signature a b) <- signMsg msg prv+        (Signature c d) <- signMsg msg prv+        replicateM_ 20 $ signMsg msg prv+        (Signature e f) <- signMsg msg prv+        return $ ((a,b),(c,d),(e,f))+    assertBool "DiffSig" $ +        r1 /= r2 && r1 /= r3 && r2 /= r3 &&+        s1 /= s2 && s1 /= s3 && s2 /= s3++uniqueKeys :: Assertion+uniqueKeys = do+    (k1,k2,k3) <- liftIO $ withSource devURandom $ do+        a <- genPrvKey+        b <- genPrvKey+        replicateM_ 20 genPrvKey+        c <- genPrvKey+        return (a,b,c)+    assertBool "DiffKey" $ k1 /= k2 && k1 /= k3 && k2 /= k3++{- bitcoind /src/test/key_tests.cpp -}++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++checkInvalidKey :: Assertion+checkInvalidKey = +    assertBool "Bad key" $ isNothing $ fromWIF strAddressBad+++checkPrvKeyCompressed :: Assertion+checkPrvKeyCompressed = do+    assertBool "Key 1"  $ isPrvKeyU sec1+    assertBool "Key 2"  $ isPrvKeyU sec2+    assertBool "Key 1C" $ not $ isPrvKeyU sec1C+    assertBool "Key 2C" $ not $ isPrvKeyU sec2C++checkKeyCompressed :: Assertion+checkKeyCompressed = do+    assertBool "Key 1"  $ isPubKeyU pub1+    assertBool "Key 2"  $ isPubKeyU pub2+    assertBool "Key 1C" $ not $ isPubKeyU pub1C+    assertBool "Key 2C" $ not $ isPubKeyU pub2C++checkMatchingAddress :: Assertion+checkMatchingAddress = do+    assertBool "Key 1"  $ addr1  == (addrToBase58 $ pubKeyAddr pub1)+    assertBool "Key 2"  $ addr2  == (addrToBase58 $ pubKeyAddr pub2)+    assertBool "Key 1C" $ addr1C == (addrToBase58 $ pubKeyAddr pub1C)+    assertBool "Key 2C" $ addr2C == (addrToBase58 $ pubKeyAddr pub2C)+    +checkSignatures :: Hash256 -> Assertion+checkSignatures h = do+    (sign1, sign2, sign1C, sign2C) <- liftIO $ withSource devURandom $ do+        a <- signMsg h sec1+        b <- signMsg h sec2+        c <- signMsg h sec1C+        d <- signMsg h sec2C+        return (a,b,c,d)+    assertBool "Key 1, Sign1"   $ verifySig h sign1 pub1+    assertBool "Key 1, Sign2"   $ not $ verifySig h sign2 pub1+    assertBool "Key 1, Sign1C"  $ verifySig h sign1C pub1+    assertBool "Key 1, Sign2C"  $ not $ verifySig h sign2C pub1+    assertBool "Key 2, Sign1"   $ not $ verifySig h sign1 pub2+    assertBool "Key 2, Sign2"   $ verifySig h sign2 pub2+    assertBool "Key 2, Sign1C"  $ not $ verifySig h sign1C pub2+    assertBool "Key 2, Sign2C"  $ verifySig h sign2C pub2+    assertBool "Key 1C, Sign1"  $ verifySig h sign1 pub1C+    assertBool "Key 1C, Sign2"  $ not $ verifySig h sign2 pub1C+    assertBool "Key 1C, Sign1C" $ verifySig h sign1C pub1C+    assertBool "Key 1C, Sign2C" $ not $ verifySig h sign2C pub1C+    assertBool "Key 2C, Sign1"  $ not $ verifySig h sign1 pub2C+    assertBool "Key 2C, Sign2"  $ verifySig h sign2 pub2C+    assertBool "Key 2C, Sign1C" $ not $ verifySig h sign1C pub2C+    assertBool "Key 2C, Sign2C" $ verifySig h sign2C pub2C+++{- Trezor RFC 6979 Test Vectors -}+-- github.com/trezor/python-ecdsa/blob/master/ecdsa/test_pyecdsa.py++detVec :: [(Integer,String,String)]+detVec = +    [ +      ( 0x1+      , "Satoshi Nakamoto"+      , "934b1ea10a4b3c1757e2b0c017d0b6143ce3c9a7e6a4a49860d7a6ab210ee3d82442ce9d2b916064108014783e923ec36b49743e2ffa1c4496f01a512aafd9e5"+      )+    , ( 0x1+      , "All those moments will be lost in time, like tears in rain. Time to die..."+      , "8600dbd41e348fe5c9465ab92d23e3db8b98b873beecd930736488696438cb6b547fe64427496db33bf66019dacbf0039c04199abb0122918601db38a72cfc21"+      )+    , ( 0Xfffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364140+      , "Satoshi Nakamoto"+      , "fd567d121db66e382991534ada77a6bd3106f0a1098c231e47993447cd6af2d06b39cd0eb1bc8603e159ef5c20a5c8ad685a45b06ce9bebed3f153d10d93bed5"+      )+    , ( 0xf8b8af8ce3c7cca5e300d33939540c10d45ce001b8f252bfbc57ba0342904181+      , "Alan Turing"+      , "7063ae83e7f62bbb171798131b4a0564b956930092b33b07b395615d9ec7e15c58dfcc1e00a35e1572f366ffe34ba0fc47db1e7189759b9fb233c5b05ab388ea"+      )+    , ( 0xe91671c46231f833a6406ccbea0e3e392c76c167bac1cb013f6f1013980455c2+      , "There is a computer disease that anybody who works with computers knows about. It's a very serious disease and it interferes completely with the work. The trouble with computers is that you 'play' with them!"+      , "b552edd27580141f3b2a5463048cb7cd3e047b97c9f98076c32dbdf85a68718b279fa72dd19bfae05577e06c7c0c1900c371fcd5893f7e1d56a37d30174671f6"+      )+    , ( 0x0000000000000000000000000000000000000000000000000000000000000001+      , "Everything should be made as simple as possible, but not simpler."+      , "33a69cd2065432a30f3d1ce4eb0d59b8ab58c74f27c41a7fdb5696ad4e6108c96f807982866f785d3f6418d24163ddae117b7db4d5fdf0071de069fa54342262"+      )+    , ( 0xfffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364140+      , "Equations are more important to me, because politics is for the present, but an equation is something for eternity."+      , "54c4a33c6423d689378f160a7ff8b61330444abb58fb470f96ea16d99d4a2fed07082304410efa6b2943111b6a4e0aaa7b7db55a07e9861d1fb3cb1f421044a5"+      )+    , ( 0xfffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364140+      , "Not only is the Universe stranger than we think, it is stranger than we can think."+      , "ff466a9f1b7b273e2f4c3ffe032eb2e814121ed18ef84665d0f515360dab3dd06fc95f5132e5ecfdc8e5e6e616cc77151455d46ed48f5589b7db7771a332b283"+      )+    , ( 0x0000000000000000000000000000000000000000000000000000000000000001+      , "How wonderful that we have met with a paradox. Now we have some hope of making progress."+      , "c0dafec8251f1d5010289d210232220b03202cba34ec11fec58b3e93a85b91d375afdc06b7d6322a590955bf264e7aaa155847f614d80078a90292fe205064d3"+      )+    , ( 0x69ec59eaa1f4f2e36b639716b7c30ca86d9a5375c7b38d8918bd9c0ebc80ba64+      , "Computer science is no more about computers than astronomy is about telescopes."+      , "7186363571d65e084e7f02b0b77c3ec44fb1b257dee26274c38c928986fea45d0de0b38e06807e46bda1f1e293f4f6323e854c86d58abdd00c46c16441085df6"+      )+    , ( 0x00000000000000000000000000007246174ab1e92e9149c6e446fe194d072637+      , "...if you aren't, at any given time, scandalized by code you wrote five or even three years ago, you're not learning anywhere near enough"+      , "fbfe5076a15860ba8ed00e75e9bd22e05d230f02a936b653eb55b61c99dda4870e68880ebb0050fe4312b1b1eb0899e1b82da89baa5b895f612619edf34cbd37"+      )+    , ( 0x000000000000000000000000000000000000000000056916d0f9b31dc9b637f3+      , "The question of whether computers can think is like the question of whether submarines can swim."+      , "cde1302d83f8dd835d89aef803c74a119f561fbaef3eb9129e45f30de86abbf906ce643f5049ee1f27890467b77a6a8e11ec4661cc38cd8badf90115fbd03cef"+      )+    ]++testDetSigning :: (Integer, String, String) -> Assertion+testDetSigning (prv,msg,str) = do+    assertBool "RFC 6979 Vector" $ res == (fromJust $ hexToBS str)+    assertBool "Valid sig" $ verifySig msg' sig (derivePubKey prv')+    where sig@(Signature r s) = detSignMsg msg' prv'+          msg' = hash256 $ stringToBS msg+          prv' = fromJust $ makePrvKey prv+          res = runPut' $ put (fromIntegral r :: Hash256) >> +                          put (fromIntegral s :: Hash256)++
+ tests/Network/Haskoin/Protocol/Arbitrary.hs view
@@ -0,0 +1,237 @@+{-|+  This package provides QuickCheck Arbitrary instances for all the protocol+  data types defined in 'Network.Haskoin.Protocol'.+-}+module Network.Haskoin.Protocol.Arbitrary () where++import Test.QuickCheck+import Network.Haskoin.Util.Arbitrary (nonEmptyBS)+import Network.Haskoin.Crypto.Arbitrary()++import Control.Monad+import Control.Applicative ++import qualified Data.Sequence as S (fromList)++import Network.Haskoin.Protocol+import Network.Haskoin.Crypto++instance Arbitrary VarInt where+    arbitrary = VarInt <$> arbitrary++instance Arbitrary VarString where+    arbitrary = VarString <$> arbitrary++instance Arbitrary NetworkAddress where+    arbitrary = do+        s <- arbitrary+        a <- liftM2 (,) arbitrary arbitrary+        p <- arbitrary+        return $ NetworkAddress s a p++instance Arbitrary InvType where+    arbitrary = elements [InvError, InvTx, InvBlock, InvMerkleBlock]++instance Arbitrary InvVector where+    arbitrary = InvVector <$> arbitrary <*> (hash256 <$> arbitrary)++instance Arbitrary Inv where+    arbitrary = Inv <$> listOf arbitrary++instance Arbitrary Version where+    arbitrary = Version <$> arbitrary+                        <*> arbitrary+                        <*> arbitrary+                        <*> arbitrary+                        <*> arbitrary+                        <*> arbitrary+                        <*> arbitrary+                        <*> arbitrary+                        <*> arbitrary++instance Arbitrary Addr where+    arbitrary = Addr <$> listOf arbitrary++instance Arbitrary Alert where+    arbitrary = Alert <$> arbitrary <*> arbitrary++instance Arbitrary BlockHeader where+    arbitrary = BlockHeader <$> arbitrary+                            <*> (hash256 <$> arbitrary)+                            <*> (hash256 <$> arbitrary)+                            <*> arbitrary+                            <*> arbitrary+                            <*> arbitrary+                            +instance Arbitrary Script where+    arbitrary = do+        i <- choose (1,10)+        Script <$> (vectorOf i arbitrary)++instance Arbitrary Tx where+    arbitrary = do+        v   <- arbitrary+        tin <- do +            l <- choose (0,10)+            vectorOf l arbitrary+        tout <- do+            l <- choose (0,10)+            vectorOf l arbitrary+        t    <- arbitrary+        return $ Tx v tin tout t++instance Arbitrary CoinbaseTx where+    arbitrary = CoinbaseTx <$> arbitrary+                           <*> (return $ OutPoint 0 0xffffffff)+                           <*> arbitrary+                           <*> (return $ 0xffffffff)+                           <*> (listOf arbitrary)+                           <*> arbitrary++instance Arbitrary TxIn where+    arbitrary = TxIn <$> arbitrary+                     <*> arbitrary+                     <*> arbitrary++instance Arbitrary TxOut where+    arbitrary = TxOut <$> (choose (0,2100000000000000))+                      <*> arbitrary++instance Arbitrary OutPoint where+    arbitrary = OutPoint <$> arbitrary+                         <*> arbitrary++instance Arbitrary Block where+    arbitrary = do+        h <- arbitrary+        c <- arbitrary+        t <- do +            l <- choose (0,10)+            vectorOf l arbitrary+        return $ Block h c t++instance Arbitrary MerkleBlock where+    arbitrary = do+        h <- arbitrary+        ntx <- arbitrary+        hashes <- arbitrary+        c <- choose (1,10)+        flags <- vectorOf (c*8) arbitrary+        return $ MerkleBlock h ntx hashes flags++instance Arbitrary PushDataType where+    arbitrary = elements [ OPCODE, OPDATA1, OPDATA2, OPDATA4 ]++instance Arbitrary ScriptOp where+    arbitrary = oneof [ opPushData <$> nonEmptyBS+                      , return OP_0+                      , return OP_1NEGATE+                      , return OP_1+                      , return OP_2, return OP_3, return OP_4, return OP_5+                      , return OP_6, return OP_7, return OP_8, return OP_9+                      , return OP_10, return OP_11, return OP_12, return OP_13+                      , return OP_14, return OP_15, return OP_16+                      , return OP_VERIFY+                      , return OP_DUP+                      , return OP_EQUAL+                      , return OP_EQUALVERIFY+                      , return OP_HASH160+                      , return OP_CHECKSIG+                      , return OP_CHECKMULTISIG+                      , OP_PUBKEY <$> arbitrary+                      , return $ OP_INVALIDOPCODE 0xff+                      ]++instance Arbitrary GetBlocks where+    arbitrary = GetBlocks <$> arbitrary+                          <*> (listOf arbitrary)+                          <*> arbitrary++instance Arbitrary GetData where+    arbitrary = GetData <$> (listOf arbitrary)++instance Arbitrary GetHeaders where+    arbitrary = GetHeaders <$> arbitrary+                           <*> (listOf arbitrary)+                           <*> arbitrary++instance Arbitrary Headers where+    arbitrary = Headers <$> (listOf (liftM2 (,) arbitrary arbitrary))++instance Arbitrary NotFound where+    arbitrary = NotFound <$> (listOf arbitrary)++instance Arbitrary Ping where+    arbitrary = Ping <$> arbitrary++instance Arbitrary Pong where+    arbitrary = Pong <$> arbitrary++instance Arbitrary MessageCommand where+    arbitrary = elements [ MCVersion+                         , MCVerAck+                         , MCAddr+                         , MCInv+                         , MCGetData+                         , MCNotFound+                         , MCGetBlocks+                         , MCGetHeaders+                         , MCTx+                         , MCBlock+                         , MCHeaders+                         , MCGetAddr+                         , MCFilterLoad+                         , MCFilterAdd+                         , MCFilterClear+                         , MCPing+                         , MCPong+                         , MCAlert+                         ]++instance Arbitrary MessageHeader where+    arbitrary = MessageHeader <$> arbitrary+                              <*> arbitrary+                              <*> arbitrary+                              <*> arbitrary++instance Arbitrary Message where+    arbitrary = oneof [ MVersion    <$> arbitrary+                      , return MVerAck+                      , MAddr        <$> arbitrary+                      , MInv         <$> arbitrary+                      , MGetData     <$> arbitrary+                      , MNotFound    <$> arbitrary+                      , MGetBlocks   <$> arbitrary+                      , MGetHeaders  <$> arbitrary+                      , MTx          <$> arbitrary+                      , MBlock       <$> arbitrary+                      , MHeaders     <$> arbitrary+                      , return MGetAddr+                      , MFilterLoad  <$> arbitrary+                      , MFilterAdd   <$> arbitrary+                      , return MFilterClear+                      , MPing        <$> arbitrary+                      , MPong        <$> arbitrary+                      , MAlert       <$> arbitrary+                      ]++instance Arbitrary BloomFlags where+    arbitrary = elements [ BloomUpdateNone+                         , BloomUpdateAll+                         , BloomUpdateP2PubKeyOnly+                         ]++instance Arbitrary BloomFilter where+    arbitrary = BloomFilter <$> (S.fromList <$> arbitrary)+                            <*> (return False)+                            <*> (return False)+                            <*> arbitrary+                            <*> arbitrary+                            <*> arbitrary+                        +instance Arbitrary FilterLoad where+    arbitrary = FilterLoad <$> arbitrary++instance Arbitrary FilterAdd where+    arbitrary = FilterAdd <$> arbitrary+
+ tests/Network/Haskoin/Protocol/Tests.hs view
@@ -0,0 +1,59 @@+module Network.Haskoin.Protocol.Tests (tests) where++import Test.Framework (Test, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import Data.Maybe+import Data.Binary+import Data.Binary.Get+import Data.Binary.Put++import Network.Haskoin.Protocol.Arbitrary()+import Network.Haskoin.Protocol+import Network.Haskoin.Crypto++tests :: [Test]+tests = +    [ testGroup "Serialize & de-serialize protocol messages"+        [ testProperty "VarInt" (metaGetPut :: VarInt -> Bool)+        , testProperty "VarString" (metaGetPut :: VarString -> Bool)+        , testProperty "NetworkAddress" (metaGetPut :: NetworkAddress -> Bool)+        , testProperty "InvType" (metaGetPut :: InvType -> Bool)+        , testProperty "InvVector" (metaGetPut :: InvVector -> Bool)+        , testProperty "Inv" (metaGetPut :: Inv -> Bool)+        , testProperty "Version" (metaGetPut :: Version -> Bool)+        , testProperty "Addr" (metaGetPut :: Addr -> Bool)+        , testProperty "Alert" (metaGetPut :: Alert -> Bool)+        , testProperty "TxIn" (metaGetPut :: TxIn -> Bool)+        , testProperty "TxOut" (metaGetPut :: TxOut -> Bool)+        , testProperty "OutPoint" (metaGetPut :: OutPoint -> Bool)+        , testProperty "ScriptOp" (metaGetPut :: ScriptOp -> Bool)+        , testProperty "Script" (metaGetPut :: Script -> Bool)+        , testProperty "Tx" (metaGetPut :: Tx -> Bool)+        , testProperty "CoinbaseTx" (metaGetPut :: CoinbaseTx -> Bool)+        , testProperty "BlockHeader" (metaGetPut :: BlockHeader -> Bool)+        , testProperty "Block" (metaGetPut :: Block -> Bool)+        , testProperty "MerkleBlock" (metaGetPut :: MerkleBlock -> Bool)+        , testProperty "GetBlocks" (metaGetPut :: GetBlocks -> Bool)+        , testProperty "GetData" (metaGetPut :: GetData -> Bool)+        , testProperty "GetHeaders" (metaGetPut :: GetHeaders -> Bool)+        , testProperty "Headers" (metaGetPut :: Headers -> Bool)+        , testProperty "FilterLoad" (metaGetPut :: FilterLoad -> Bool)+        , testProperty "FilterAdd" (metaGetPut :: FilterAdd -> Bool)+        , testProperty "NotFound" (metaGetPut :: NotFound -> Bool)+        , testProperty "Ping" (metaGetPut :: Ping -> Bool)+        , testProperty "Pong" (metaGetPut :: Pong -> Bool)+        , testProperty "MessageCommand" (metaGetPut :: MessageCommand -> Bool)+        , testProperty "MessageHeader" (metaGetPut :: MessageHeader -> Bool)+        , testProperty "Message" (metaGetPut :: Message -> Bool)+        ]+    , testGroup "Transactions"+        [ testProperty "decode . encode Txid" decEncTxid ]+    ]++metaGetPut :: (Binary a, Eq a) => a -> Bool+metaGetPut x = (runGet get (runPut $ put x)) == x++decEncTxid :: Hash256 -> Bool+decEncTxid h = (fromJust $ decodeTxid $ encodeTxid h) == h+
+ tests/Network/Haskoin/Protocol/Units.hs view
@@ -0,0 +1,44 @@+module Network.Haskoin.Protocol.Units (tests) where++import Test.HUnit (Assertion, assertBool)+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.HUnit (testCase)++import Data.Maybe++import Network.Haskoin.Protocol+import Network.Haskoin.Util++tests :: [Test]+tests =+    [ testGroup "Computing TxID from Tx" +        ( map mapTxIDVec $ zip txIDVec [0..] )+    ]++mapTxIDVec :: ((String,String),Int) -> Test.Framework.Test+mapTxIDVec (v,i) = testCase name $ runTxIDVec v+  where +    name = "Compute TxID " ++ (show i)++runTxIDVec :: (String,String) -> Assertion+runTxIDVec (tid,tx) = assertBool "TxID" $ +    (encodeTxid $ txid txBS) == tid+  where +    txBS = decode' $ fromJust $ hexToBS tx++txIDVec :: [(String,String)]+txIDVec =+    [ ( "23b397edccd3740a74adb603c9756370fafcde9bcc4483eb271ecad09a94dd63"+      , "0100000001b14bdcbc3e01bdaad36cc08e81e69c82e1060bc14e518db2b49aa43ad90ba26000000000490047304402203f16c6f40162ab686621ef3000b04e75418a0c0cb2d8aebeac894ae360ac1e780220ddc15ecdfc3507ac48e1681a33eb60996631bf6bf5bc0a0682c4db743ce7ca2b01ffffffff0140420f00000000001976a914660d4ef3a743e3e696ad990364e555c271ad504b88ac00000000"+      )+    , ( "c99c49da4c38af669dea436d3e73780dfdb6c1ecf9958baa52960e8baee30e73"+      , "01000000010276b76b07f4935c70acf54fbf1f438a4c397a9fb7e633873c4dd3bc062b6b40000000008c493046022100d23459d03ed7e9511a47d13292d3430a04627de6235b6e51a40f9cd386f2abe3022100e7d25b080f0bb8d8d5f878bba7d54ad2fda650ea8d158a33ee3cbd11768191fd004104b0e2c879e4daf7b9ab68350228c159766676a14f5815084ba166432aab46198d4cca98fa3e9981d0a90b2effc514b76279476550ba3663fdcaff94c38420e9d5000000000100093d00000000001976a9149a7b0f3b80c6baaeedce0a0842553800f832ba1f88ac00000000"+      )+    , ( "f7fdd091fa6d8f5e7a8c2458f5c38faffff2d3f1406b6e4fe2c99dcc0d2d1cbb"+      , "01000000023d6cf972d4dff9c519eff407ea800361dd0a121de1da8b6f4138a2f25de864b4000000008a4730440220ffda47bfc776bcd269da4832626ac332adfca6dd835e8ecd83cd1ebe7d709b0e022049cffa1cdc102a0b56e0e04913606c70af702a1149dc3b305ab9439288fee090014104266abb36d66eb4218a6dd31f09bb92cf3cfa803c7ea72c1fc80a50f919273e613f895b855fb7465ccbc8919ad1bd4a306c783f22cd3227327694c4fa4c1c439affffffff21ebc9ba20594737864352e95b727f1a565756f9d365083eb1a8596ec98c97b7010000008a4730440220503ff10e9f1e0de731407a4a245531c9ff17676eda461f8ceeb8c06049fa2c810220c008ac34694510298fa60b3f000df01caa244f165b727d4896eb84f81e46bcc4014104266abb36d66eb4218a6dd31f09bb92cf3cfa803c7ea72c1fc80a50f919273e613f895b855fb7465ccbc8919ad1bd4a306c783f22cd3227327694c4fa4c1c439affffffff01f0da5200000000001976a914857ccd42dded6df32949d4646dfa10a92458cfaa88ac00000000"+      )+    , ( "afd9c17f8913577ec3509520bd6e5d63e9c0fd2a5f70c787993b097ba6ca9fae"+      , "010000000370ac0a1ae588aaf284c308d67ca92c69a39e2db81337e563bf40c59da0a5cf63000000006a4730440220360d20baff382059040ba9be98947fd678fb08aab2bb0c172efa996fd8ece9b702201b4fb0de67f015c90e7ac8a193aeab486a1f587e0f54d0fb9552ef7f5ce6caec032103579ca2e6d107522f012cd00b52b9a65fb46f0c57b9b8b6e377c48f526a44741affffffff7d815b6447e35fbea097e00e028fb7dfbad4f3f0987b4734676c84f3fcd0e804010000006b483045022100c714310be1e3a9ff1c5f7cacc65c2d8e781fc3a88ceb063c6153bf950650802102200b2d0979c76e12bb480da635f192cc8dc6f905380dd4ac1ff35a4f68f462fffd032103579ca2e6d107522f012cd00b52b9a65fb46f0c57b9b8b6e377c48f526a44741affffffff3f1f097333e4d46d51f5e77b53264db8f7f5d2e18217e1099957d0f5af7713ee010000006c493046022100b663499ef73273a3788dea342717c2640ac43c5a1cf862c9e09b206fcb3f6bb8022100b09972e75972d9148f2bdd462e5cb69b57c1214b88fc55ca638676c07cfc10d8032103579ca2e6d107522f012cd00b52b9a65fb46f0c57b9b8b6e377c48f526a44741affffffff0380841e00000000001976a914bfb282c70c4191f45b5a6665cad1682f2c9cfdfb88ac80841e00000000001976a9149857cc07bed33a5cf12b9c5e0500b675d500c81188ace0fd1c00000000001976a91443c52850606c872403c0601e69fa34b26f62db4a88ac00000000"+      )+    ]+
+ tests/Network/Haskoin/Script/Arbitrary.hs view
@@ -0,0 +1,85 @@+{-|+  This module provides arbitrary instances for data types in+  'Network.Haskoin.Script'.+-}+module Network.Haskoin.Script.Arbitrary where++import Test.QuickCheck +    ( Gen+    , Arbitrary+    , arbitrary+    , oneof+    , choose+    , vectorOf+    , elements+    )+import Network.Haskoin.Crypto.Arbitrary()++import Control.Monad (liftM2)+import Control.Applicative ((<$>),(<*>))++import Data.Bits (testBit, clearBit)+import Data.Word (Word8)++import Network.Haskoin.Script+import Network.Haskoin.Protocol+import Network.Haskoin.Crypto++instance Arbitrary TxSignature where+    arbitrary = liftM2 TxSignature arbitrary arbitrary++instance Arbitrary SigHash where+    arbitrary = do+        w <- arbitrary :: Gen Word8+        let acp = testBit w 7+        return $ case clearBit w 7 of+            1 -> SigAll acp+            2 -> SigNone acp+            3 -> SigSingle acp+            _ -> SigUnknown acp w++instance Arbitrary ScriptOutput where+    arbitrary = oneof +        [ PayPK <$> arbitrary+        , (PayPKHash . pubKeyAddr) <$> arbitrary +        , genPayMulSig+        , (PayScriptHash . scriptAddr) <$> arbitrary+        ]++-- | Generate an arbitrary 'ScriptOutput' of value PayMulSig.+genPayMulSig :: Gen ScriptOutput+genPayMulSig = do+    n <- choose (1,16)+    m <- choose (1,n)+    PayMulSig <$> (vectorOf n arbitrary) <*> (return m)++instance Arbitrary ScriptInput where+    arbitrary = oneof+        [ SpendPK <$> arbitrary+        , SpendPKHash <$> arbitrary <*> arbitrary+        , genSpendMulSig+        ]++-- | Generate an arbitrary 'ScriptInput' of value SpendMulSig.+genSpendMulSig :: Gen ScriptInput+genSpendMulSig = do+    m <- choose (1,16)+    s <- choose (1,m)+    SpendMulSig <$> (vectorOf s arbitrary) <*> (return m)++instance Arbitrary ScriptHashInput where+    arbitrary = ScriptHashInput <$> arbitrary <*> arbitrary++-- | Data type for generating an arbitrary 'ScriptOp' with a value in+-- [OP_1 .. OP_16]+data ScriptOpInt = ScriptOpInt ScriptOp+    deriving (Eq, Show)++instance Arbitrary ScriptOpInt where+    arbitrary = ScriptOpInt <$> elements +                    [ OP_1,  OP_2,  OP_3,  OP_4+                    , OP_5,  OP_6,  OP_7,  OP_8+                    , OP_9,  OP_10, OP_11, OP_12+                    , OP_13, OP_14, OP_15, OP_16+                    ]+
+ tests/Network/Haskoin/Script/Tests.hs view
@@ -0,0 +1,116 @@+module Network.Haskoin.Script.Tests (tests) where++import Test.QuickCheck.Property (Property, (==>))+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import Control.Applicative ((<$>))++import Data.Bits (setBit, testBit)+import Data.Binary (Word8)+import qualified Data.ByteString as BS +    ( singleton+    , length+    , tail+    , head+    , pack+    )++import Network.Haskoin.Protocol.Arbitrary ()+import Network.Haskoin.Script.Arbitrary (ScriptOpInt(..))++import Network.Haskoin.Script+import Network.Haskoin.Crypto+import Network.Haskoin.Protocol+import Network.Haskoin.Util++tests :: [Test]+tests = +    [ testGroup "Script Parser"+        [ testProperty "decode . encode OP_1 .. OP_16" testScriptOpInt+        , testProperty "decode . encode ScriptOutput" testScriptOutput+        , testProperty "decode . encode ScriptInput" testScriptInput+        , testProperty "decode . encode ScriptHashInput" testScriptHashInput+        , testProperty "sorting MultiSig scripts" testSortMulSig+        ]+    , testGroup "Script SigHash"+        [ testProperty "canonical signatures" testCanonicalSig+        , testProperty "decode . encode SigHash" binSigHash+        , testProperty "decode SigHash from Word8" binSigHashByte+        , testProperty "encodeSigHash32 is 4 bytes long" testEncodeSH32+        , testProperty "decode . encode TxSignature" binTxSig+        , testProperty "decodeCanonical . encode TxSignature" binTxSigCanonical+        , testProperty "Testing txSigHash with SigSingle" testSigHashOne+        ]+    ]++{- Script Parser -}++testScriptOpInt :: ScriptOpInt -> Bool+testScriptOpInt (ScriptOpInt i) = (intToScriptOp <$> scriptOpToInt i) == Right i++testScriptOutput :: ScriptOutput -> Bool+testScriptOutput so = (decodeOutput $ encodeOutput so) == Right so++testScriptInput :: ScriptInput -> Bool+testScriptInput si = (decodeInput $ encodeInput si) == Right si++testScriptHashInput :: ScriptHashInput -> Bool+testScriptHashInput sh = (decodeScriptHash $ encodeScriptHash sh) == Right sh++testSortMulSig :: ScriptOutput -> Bool+testSortMulSig out = case out of+    (PayMulSig _ _) -> check $ sortMulSig out+    _ -> True+    where check (PayMulSig ps _) +              | length ps <= 1 = True+              | otherwise = snd $ foldl f (head ps,True) $ tail ps+          check _ = False+          f (a,t) b | t && encode' a <= encode' b = (b,True)+                    | otherwise   = (b,False)+        +{- Script SigHash -}++testCanonicalSig :: TxSignature -> Bool+testCanonicalSig ts@(TxSignature _ sh) +    | isSigUnknown sh = isLeft $ decodeCanonicalSig bs+    | otherwise       = isRight (decodeCanonicalSig bs) && +                        isCanonicalHalfOrder (txSignature ts)+    where bs = encodeSig ts++binSigHash :: SigHash -> Bool+binSigHash sh = (decode' $ encode' sh) == sh++binSigHashByte :: Word8 -> Bool+binSigHashByte w+    | w == 0x01 = res == SigAll False+    | w == 0x02 = res == SigNone False+    | w == 0x03 = res == SigSingle False+    | w == 0x81 = res == SigAll True+    | w == 0x82 = res == SigNone True+    | w == 0x83 = res == SigSingle True+    | testBit w 7 = res == SigUnknown True w+    | otherwise = res == SigUnknown False w+    where res = decode' $ BS.singleton w++testEncodeSH32 :: SigHash -> Bool+testEncodeSH32 sh = BS.length bs == 4 && BS.head bs == w && BS.tail bs == zs+    where bs = encodeSigHash32 sh+          w  = BS.head $ encode' sh+          zs = BS.pack [0,0,0]++binTxSig :: TxSignature -> Bool+binTxSig ts = (fromRight $ decodeSig $ encodeSig ts) == ts++binTxSigCanonical :: TxSignature -> Bool+binTxSigCanonical ts@(TxSignature _ sh) +    | isSigUnknown sh = isLeft $ decodeCanonicalSig $ encodeSig ts+    | otherwise = (fromRight $ decodeCanonicalSig $ encodeSig ts) == ts++testSigHashOne :: Tx -> Script -> Bool -> Property+testSigHashOne tx s acp = not (null $ txIn tx) ==> +    if length (txIn tx) > length (txOut tx) +        then res == (setBit 0 248)+        else res /= (setBit 0 248)+    where res = txSigHash tx s (length (txIn tx) - 1) (SigSingle acp)+
+ tests/Network/Haskoin/Script/Units.hs view
@@ -0,0 +1,100 @@+module Network.Haskoin.Script.Units (tests) where++import Test.HUnit (Assertion, assertBool)+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.HUnit (testCase)++import Data.Maybe (fromJust)++import Network.Haskoin.Script+import Network.Haskoin.Protocol+import Network.Haskoin.Crypto+import Network.Haskoin.Util++tests :: [Test]+tests =+    [ testGroup "Canonical signatures" +        (map canonicalVectorsMap $ zip canonicalVectors [0..])+    , testGroup "Non canonical sigatures" +        (map notCanonicalVectorsMap $ zip notCanonicalVectors [0..])+    , testGroup "Multi Signatures" +        (map mapMulSigVector $ zip mulSigVectors [0..])+    ]++canonicalVectorsMap :: (String,Int) -> Test.Framework.Test+canonicalVectorsMap (_,i) = +    testCase ("Canonical Sig " ++ (show i)) func+  where +    func = testCanonicalSig $ canonicalVectors !! i++notCanonicalVectorsMap :: (String,Int) -> Test.Framework.Test+notCanonicalVectorsMap (_,i) = +    testCase ("Not canonical Sig " ++ (show i)) func+  where +    func = testNotCanonicalSig $ notCanonicalVectors !! i++testCanonicalSig :: String -> Assertion+testCanonicalSig str = +    assertBool "    > Canonical Sig" $ isRight $ decodeCanonicalSig bs+  where +    bs = fromJust $ hexToBS str++testNotCanonicalSig :: String -> Assertion+testNotCanonicalSig str = +    assertBool "    > Not canonical sig" $ isLeft $ decodeCanonicalSig bs+  where +    bs = fromJust $ hexToBS str++mapMulSigVector :: ((String,String),Int) -> Test.Framework.Test+mapMulSigVector (v,i) = +    testCase name $ runMulSigVector v+  where +    name = "MultiSignature vector " ++ (show i)++runMulSigVector :: (String,String) -> Assertion+runMulSigVector (a,ops) = +    assertBool "    >  MultiSig Vector" $ a == b+  where +    s = Script $ runGet' getScriptOps $ fromJust $ hexToBS ops+    b = addrToBase58 $ scriptAddr $ fromRight $ decodeOutput s++{- Canonical Signatures -}++-- Test vectors from bitcoind+-- http://github.com/bitcoin/bitcoin/blob/master/src/test/data/sig_canonical.json++canonicalVectors :: [String]+canonicalVectors =+    [ "300602010102010101" -- Changed 0x00 to 0x01 as 0x00 is invalid+    , "3008020200ff020200ff01"+    , "304402203932c892e2e550f3af8ee4ce9c215a87f9bb831dcac87b2838e2c2eaa891df0c022030b61dd36543125d56b9f9f3a1f9353189e5af33cdda8d77a5209aec03978fa001"+    , "30450220076045be6f9eca28ff1ec606b833d0b87e70b2a630f5e3a496b110967a40f90a0221008fffd599910eefe00bc803c688c2eca1d2ba7f6b180620eaa03488e6585db6ba01"+    , "3046022100876045be6f9eca28ff1ec606b833d0b87e70b2a630f5e3a496b110967a40f90a0221008fffd599910eefe00bc803c688c2eca1d2ba7f6b180620eaa03488e6585db6ba01"+    ]++notCanonicalVectors :: [String]+notCanonicalVectors =+    [ "30050201ff020001"+    , "30470221005990e0584b2b238e1dfaad8d6ed69ecc1a4a13ac85fc0b31d0df395eb1ba6105022200002d5876262c288beb511d061691bf26777344b702b00f8fe28621fe4e566695ed01"+    , "304402205990e0584b2b238e1dfaad8d6ed69ecc1a4a13ac85fc0b31d0df395eb1ba610502202d5876262c288beb511d061691bf26777344b702b00f8fe28621fe4e566695ed11"+    , "314402205990e0584b2b238e1dfaad8d6ed69ecc1a4a13ac85fc0b31d0df395eb1ba610502202d5876262c288beb511d061691bf26777344b702b00f8fe28621fe4e566695ed01"+    , "304502205990e0584b2b238e1dfaad8d6ed69ecc1a4a13ac85fc0b31d0df395eb1ba610502202d5876262c288beb511d061691bf26777344b702b00f8fe28621fe4e566695ed01"+    , "301f01205990e0584b2b238e1dfaad8d6ed69ecc1a4a13ac85fc0b31d0df395eb101"+    , "304502205990e0584b2b238e1dfaad8d6ed69ecc1a4a13ac85fc0b31d0df395eb1ba610502202d5876262c288beb511d061691bf26777344b702b00f8fe28621fe4e566695ed0001"+    , "304401205990e0584b2b238e1dfaad8d6ed69ecc1a4a13ac85fc0b31d0df395eb1ba610502202d5876262c288beb511d061691bf26777344b702b00f8fe28621fe4e566695ed01"+    , "3024020002202d5876262c288beb511d061691bf26777344b702b00f8fe28621fe4e566695ed01"+    , "304402208990e0584b2b238e1dfaad8d6ed69ecc1a4a13ac85fc0b31d0df395eb1ba610502202d5876262c288beb511d061691bf26777344b702b00f8fe28621fe4e566695ed01"+    , "30450221005990e0584b2b238e1dfaad8d6ed69ecc1a4a13ac85fc0b31d0df395eb1ba610502202d5876262c288beb511d061691bf26777344b702b00f8fe28621fe4e566695ed01"+    , "304402205990e0584b2b238e1dfaad8d6ed69ecc1a4a13ac85fc0b31d0df395eb1ba610501202d5876262c288beb511d061691bf26777344b702b00f8fe28621fe4e566695ed01"+    , "302402205990e0584b2b238e1dfaad8d6ed69ecc1a4a13ac85fc0b31d0df395eb1ba6105020001"+    , "304402205990e0584b2b238e1dfaad8d6ed69ecc1a4a13ac85fc0b31d0df395eb1ba61050220fd5876262c288beb511d061691bf26777344b702b00f8fe28621fe4e566695ed01"+    , "304502205990e0584b2b238e1dfaad8d6ed69ecc1a4a13ac85fc0b31d0df395eb1ba61050221002d5876262c288beb511d061691bf26777344b702b00f8fe28621fe4e566695ed01"+    ]++mulSigVectors :: [(String,String)]+mulSigVectors =+    [ ( "3QJmV3qfvL9SuYo34YihAf3sRCW3qSinyC"+      , "52410491bba2510912a5bd37da1fb5b1673010e43d2c6d812c514e91bfa9f2eb129e1c183329db55bd868e209aac2fbc02cb33d98fe74bf23f0c235d6126b1d8334f864104865c40293a680cb9c020e7b1e106d8c1916d3cef99aa431a56d253e69256dac09ef122b1a986818a7cb624532f062c1d1f8722084861c5c3291ccffef4ec687441048d2455d2403e08708fc1f556002f1b6cd83f992d085097f9974ab08a28838f07896fbab08f39495e15fa6fad6edbfb1e754e35fa1c7844c41f322a1863d4621353ae"+      ) +    ]+
+ tests/Network/Haskoin/Stratum/Units.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.Haskoin.Stratum.Units (tests) where++import Control.Monad (liftM)+import Data.Aeson (decode)+import Data.ByteString.Lazy.Char8 (pack)+import Network.Haskoin.Stratum.Message+import Test.Framework (Test, testGroup, buildTest)+import Test.Framework.Providers.HUnit (testCase)+import qualified Test.HUnit as HUnit++tests :: [Test]+tests =+    [ testFile "Decode JSON-RPC request"+      isRequest "tests/data/requests.json"+    , testFile "Decode JSON-RPC notification"+      isNotif "tests/data/notifications.json"+    , testFile "Decode JSON-RPC response"+      isResponse "tests/data/responses.json"+    , testFile "Decode JSON-RPC error"+      isError "tests/data/errors.json"+    , testFile "Decode invalid JSON-RPC"+      isInvalid "tests/data/invalid.json"+    ]++testFile :: String -> (Maybe MessageValue -> Bool) -> String -> Test+testFile label f file = buildTest $ do+    vectors <- liftM lines $ readFile file+    let test = g vectors+    return test+  where+    g vectors = testGroup label $ do+        (vector, count) <- zip vectors [0..]+        let msg = decode $ pack vector+            lbl = label ++ " " ++ show (count :: Int)+        return . testCase lbl . HUnit.assertBool (failure vector) $ f msg+    failure vector = "Failed to decode: " ++ vector++isRequest :: Maybe MessageValue -> Bool+isRequest (Just (MsgRequest (Request _ _ (Just _)))) = True+isRequest _ = False++isNotif :: Maybe MessageValue -> Bool+isNotif (Just (MsgRequest (Request _ _ Nothing))) = True+isNotif _ = False++isResponse :: Maybe MessageValue -> Bool+isResponse (Just (MsgResponse (Response (Right _) _))) = True+isResponse _ = False++isError :: Maybe MessageValue -> Bool+isError (Just (MsgResponse (Response (Left _) _))) = True+isError _ = False++isInvalid :: Maybe MessageValue -> Bool+isInvalid Nothing = True+isInvalid _ = False
+ tests/Network/Haskoin/Transaction/Arbitrary.hs view
@@ -0,0 +1,162 @@+{-|+  Arbitrary instances for transaction package+-}+module Network.Haskoin.Transaction.Arbitrary +( genPubKeyC+, genMulSigInput+, genRegularInput +, genAddrOutput+, RegularTx(..)+, MSParam(..)+, PKHashSigTemplate(..)+, MulSigTemplate(..)+) where++import Test.QuickCheck +    ( Gen+    , Arbitrary+    , arbitrary+    , vectorOf+    , oneof+    , choose+    )++import Control.Monad (liftM)+import Control.Applicative ((<$>),(<*>))++import Data.Word (Word64)+import Data.List (permutations, nubBy)++import Network.Haskoin.Crypto.Arbitrary +import Network.Haskoin.Protocol.Arbitrary ()+import Network.Haskoin.Script.Arbitrary ()++import Network.Haskoin.Transaction+import Network.Haskoin.Script+import Network.Haskoin.Protocol+import Network.Haskoin.Crypto+import Network.Haskoin.Util++-- | Data type for generating arbitrary valid multisignature parameters (m of n)+data MSParam = MSParam Int Int deriving (Eq, Show)++instance Arbitrary MSParam where+    arbitrary = do+        n <- choose (1,16)+        m <- choose (1,n)+        return $ MSParam m n++-- | Data type for generating arbitrary transaction with inputs and outputs+-- consisting only of script hash or pub key hash scripts.+data RegularTx = RegularTx Tx deriving (Eq, Show)++-- | Generate an arbitrary compressed public key.+genPubKeyC :: Gen PubKey+genPubKeyC = derivePubKey <$> genPrvKeyC++-- | Generate an arbitrary script hash input spending a multisignature+-- pay to script hash.+genMulSigInput :: Gen ScriptHashInput+genMulSigInput = do+    (MSParam m n) <- arbitrary+    rdm <- PayMulSig <$> (vectorOf n genPubKeyC) <*> (return m)+    inp <- SpendMulSig <$> (vectorOf m arbitrary) <*> (return m)+    return $ ScriptHashInput inp rdm++-- | Generate an arbitrary transaction input spending a public key hash or+-- script hash output.+genRegularInput :: Gen TxIn+genRegularInput = do+    op <- arbitrary+    sq <- arbitrary+    sc <- oneof [ encodeScriptHash <$> genMulSigInput+                , encodeInput <$> (SpendPKHash <$> arbitrary <*> genPubKeyC)+                ]+    return $ TxIn op sc sq++-- | Generate an arbitrary output paying to a public key hash or script hash+-- address.+genAddrOutput :: Gen TxOut+genAddrOutput = do+    v  <- choose (1,2100000000000000)+    sc <- oneof [ (PayPKHash . pubKeyAddr) <$> arbitrary+                , (PayScriptHash . scriptAddr) <$> arbitrary+                ]+    return $ TxOut v $ encodeOutput sc++instance Arbitrary RegularTx where+    arbitrary = do+        x <- choose (1,10)+        y <- choose (1,10)+        liftM RegularTx $ Tx <$> arbitrary +                             <*> (vectorOf x genRegularInput) +                             <*> (vectorOf y genAddrOutput) +                             <*> arbitrary++instance Arbitrary Coin where+    arbitrary = Coin <$> arbitrary <*> arbitrary <*> arbitrary+        +data PKHashSigTemplate = PKHashSigTemplate Tx [SigInput] [PrvKey]+    deriving (Eq, Show)++data MulSigTemplate = MulSigTemplate Tx [SigInput] [PrvKey]+    deriving (Eq, Show)++-- Generates a private key that can sign a input using the OutPoint and SigInput+genPKHashData :: Gen (OutPoint, SigInput, PrvKey)+genPKHashData = do+    op  <- arbitrary+    prv <- arbitrary+    sh  <- arbitrary+    let pub    = derivePubKey prv+        script = encodeOutput $ PayPKHash $ pubKeyAddr pub+        sigi   = SigInput script op sh+    return (op, sigi, prv)++-- Generates private keys that can sign an input using the OutPoint and SigInput+genMSData :: Gen (OutPoint, SigInput, [PrvKey])+genMSData = do+    (MSParam m n) <- arbitrary+    prv     <- vectorOf n arbitrary+    perm    <- choose (0,n-1)+    op      <- arbitrary+    sh      <- arbitrary+    let pub    = map derivePubKey prv+        rdm    = PayMulSig pub m+        script = encodeOutput $ PayScriptHash $ scriptAddr rdm+        sigi   = SigInputSH script op (encodeOutput rdm) sh+        perPrv = permutations prv !! perm+    return (op, sigi, take m perPrv)++genPayTo :: Gen (String,Word64)+genPayTo = do+    v  <- choose (1,2100000000000000)+    sc <- oneof [ PubKeyAddress <$> arbitrary+                , ScriptAddress <$> arbitrary+                ]+    return (addrToBase58 sc, v)++-- Generates data for signing a PKHash transaction+instance Arbitrary PKHashSigTemplate where+    arbitrary = do+        inC   <- choose (0,5)+        outC  <- choose (0,10)+        dat   <- nubBy (\a b -> fst3 a == fst3 b) <$> vectorOf inC genPKHashData+        perm  <- choose (0,max 0 $ length dat - 1)+        payTo <- vectorOf outC genPayTo+        let tx   = fromRight $ buildAddrTx (map fst3 dat) payTo+            perI = permutations (map snd3 dat) !! perm+        return $ PKHashSigTemplate tx perI (map lst3 dat)++-- Generates data for signing a P2SH transactions+instance Arbitrary MulSigTemplate where+    arbitrary = do+        inC   <- choose (0,5)+        outC  <- choose (0,10)+        dat   <- nubBy (\a b -> fst3 a == fst3 b) <$> vectorOf inC genMSData+        perm  <- choose (0,max 0 $ length dat - 1)+        payTo <- vectorOf outC genPayTo+        let tx   = fromRight $ buildAddrTx (map fst3 dat) payTo+            perI = permutations (map snd3 dat) !! perm+        return $ MulSigTemplate tx perI (concat $ map lst3 dat)+
+ tests/Network/Haskoin/Transaction/Tests.hs view
@@ -0,0 +1,114 @@+module Network.Haskoin.Transaction.Tests (tests) where++import Test.Framework (Test, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import Data.Word (Word64)+import qualified Data.ByteString as BS (length)++import Network.Haskoin.Transaction.Arbitrary+import Network.Haskoin.Transaction.Builder+import Network.Haskoin.Protocol+import Network.Haskoin.Script+import Network.Haskoin.Crypto+import Network.Haskoin.Util++tests :: [Test]+tests = +    [ testGroup "Building Transactions"+        [ testProperty "building address tx" testBuildAddrTx+        , testProperty "testing guessTxSize function" testGuessSize+        , testProperty "testing chooseCoins function" testChooseCoins+        , testProperty "testing chooseMSCoins function" testChooseMSCoins+        ]+    , testGroup "Signing Transactions"+        [ testProperty "Sign and validate PKHash transactions" testSignTx+        , testProperty "Sign and validate Multisig transactions" testSignMS+        ]+    ]++{- Building Transactions -}++testBuildAddrTx :: [OutPoint] -> Address -> Word64 -> Bool+testBuildAddrTx os a v +    | v <= 2100000000000000 = isRight tx && case a of+        x@(PubKeyAddress _) -> Right (PayPKHash x) == out+        x@(ScriptAddress _) -> Right (PayScriptHash x) == out+    | otherwise = isLeft tx+    where tx  = buildAddrTx os [(addrToBase58 a,v)]+          out = decodeOutput $ scriptOutput $ txOut (fromRight tx) !! 0++testGuessSize :: RegularTx -> Bool+testGuessSize (RegularTx tx) =+    -- We compute an upper bound but it should be close enough to the real size+    -- We give 3 bytes of slack on every signature (1 on r and 2 on s)+    guess >= len && guess - 3*delta <= len+    where delta = pki + (sum $ map fst msi)+          guess = guessTxSize pki msi pkout msout+          len = BS.length $ encode' tx+          rIns = map (decodeInput . scriptInput) $ txIn tx+          mIns = map (decodeScriptHash . scriptInput) $ txIn tx+          pki = length $ filter (isSpendPKHash . fromRight) $ +                    filter isRight rIns+          msi = concat $ map (shData . fromRight) $ filter isRight mIns+          shData (ScriptHashInput _ (PayMulSig keys r)) = [(r,length keys)]+          shData _ = []+          out  = map (fromRight . decodeOutput . scriptOutput) $ txOut tx+          pkout = length $ filter isPayPKHash out+          msout = length $ filter isPayScriptHash out++testChooseCoins :: Word64 -> Word64 -> [Coin] -> Bool+testChooseCoins target kbfee xs = case chooseCoins target kbfee xs of+    Right (chosen,change) ->+        let outSum = sum $ map (outValue . coinTxOut) chosen+            fee    = getFee kbfee (length chosen) +        in outSum == target + change + fee+    Left _ -> +        let fee = getFee kbfee (length xs) +        in target == 0 || s < target || s < target + fee+    where s = sum $ map (outValue . coinTxOut) xs++testChooseMSCoins :: Word64 -> Word64 -> MSParam -> [Coin] -> Bool+testChooseMSCoins target kbfee (MSParam m n) xs = +    case chooseMSCoins target kbfee (m,n) xs of+        Right (chosen,change) ->+            let outSum = sum $ map (outValue . coinTxOut) chosen+                fee    = getMSFee kbfee (m,n) (length chosen) +            in outSum == target + change + fee+        Left _ -> +            let fee = getMSFee kbfee (m,n) (length xs) +            in target == 0 || s < target + fee+    where s = sum $ map (outValue . coinTxOut) xs++{- Signing Transactions -}++testSignTx :: PKHashSigTemplate -> Bool+testSignTx (PKHashSigTemplate tx sigi prv)+    | null $ txIn tx = isBroken txSig && isBroken txSigP+    | otherwise =  (not $ verifyTx tx verData)+                && isComplete txSig +                && verifyTx (runBuild txSig) verData+                && isPartial txSigP+                && (not $ verifyTx (runBuild txSigP) verData)+                && isComplete txSigC+                && verifyTx (runBuild txSigC) verData+    where txSig   = detSignTx tx sigi prv+          txSigP  = detSignTx tx sigi (tail prv)+          txSigC  = detSignTx (runBuild txSigP) sigi [head prv]+          verData = map (\(SigInput s o _) -> (s,o)) sigi+         +testSignMS :: MulSigTemplate -> Bool+testSignMS (MulSigTemplate tx sigi prv)+    | null $ txIn tx = isBroken txSig && isBroken txSigP+    | otherwise =  (not $ verifyTx tx verData)+                && isComplete txSig +                && verifyTx (runBuild txSig) verData+                && isPartial txSigP+                && (not $ verifyTx (runBuild txSigP) verData)+                && isComplete txSigC+                && verifyTx (runBuild txSigC) verData+    where txSig   = detSignTx tx sigi prv+          txSigP  = detSignTx tx sigi (tail prv)+          txSigC  = detSignTx (runBuild txSigP) sigi [head prv]+          verData = map (\(SigInputSH s o _ _) -> (s,o)) sigi+
+ tests/Network/Haskoin/Transaction/Units.hs view
@@ -0,0 +1,214 @@+module Network.Haskoin.Transaction.Units (tests) where++import Test.HUnit (Assertion, assertBool)+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.HUnit (testCase)++import Data.Word (Word32, Word64)+import Data.Maybe (fromJust)+import Data.Binary.Get (getWord32le)+import qualified Data.ByteString as BS (reverse)++import Network.Haskoin.Transaction.Builder+import Network.Haskoin.Protocol+import Network.Haskoin.Util++tests :: [Test]+tests =+    [ testGroup "Build PKHash Transaction (generated from bitcoind)" +        ( map mapPKHashVec $ zip pkHashVec [0..] )+    , testGroup "Verify transaction (bitcoind /test/data/tx_valid.json)" +        ( map mapVerifyVec $ zip verifyVec [0..] )+    ]++mapPKHashVec :: (([(String,Word32)],[(String,Word64)],String),Int)+            -> Test.Framework.Test+mapPKHashVec (v,i) = testCase name $ runPKHashVec v+    where name = "Build PKHash Tx " ++ (show i)++runPKHashVec :: ([(String,Word32)],[(String,Word64)],String) -> Assertion+runPKHashVec (xs,ys,res) = +    assertBool "Build PKHash Tx" $ (bsToHex $ encode' tx) == res+    where tx = fromRight $ buildAddrTx (map f xs) ys+          f (tid,ix) = OutPoint (fromJust $ decodeTxid tid) ix+++mapVerifyVec :: (([(String,String,String)],String),Int) +             -> Test.Framework.Test+mapVerifyVec (v,i) = testCase name $ runVerifyVec v i+    where name = "Verify Tx " ++ (show i)++runVerifyVec :: ([(String,String,String)],String) -> Int -> Assertion+runVerifyVec (is,bsTx) i = +    assertBool name $ verifyTx tx $ map f is+    where name = "    > Verify transaction " ++ (show i)+          tx  = decode' (fromJust $ hexToBS bsTx)+          f (o1,o2,bsScript) = +              let ops = runGet' getScriptOps (fromJust $ hexToBS bsScript)+                  op  = OutPoint (decode' $ BS.reverse $ fromJust $ hexToBS o1) +                                 (runGet' getWord32le $ fromJust $ hexToBS o2)+                  in (Script ops,op)++-- These test vectors have been generated from bitcoind raw transaction api++pkHashVec :: [([(String,Word32)],[(String,Word64)],String)]+pkHashVec =+    [+      ( [("eb29eba154166f6541ebcc9cbdf5088756e026af051f123bcfb526df594549db",14)]+      , [("14LsRquZfURNFrzpcLVGdaHTfAPjjwiSPb",90000000)]+      , "0100000001db494559df26b5cf3b121f05af26e0568708f5bd9ccceb41656f1654a1eb29eb0e00000000ffffffff01804a5d05000000001976a91424aa604689cc582292b97668bedd91dd5bf9374c88ac00000000"+      )+    , ( [ ("eb29eba154166f6541ebcc9cbdf5088756e026af051f123bcfb526df594549db",0)+        , ("0001000000000000000000000000000000000000000000000000000000000000",2147483647)+        ]+      , [ ("14LsRquZfURNFrzpcLVGdaHTfAPjjwiSPb",1)+        , ("19VCgS642vzEA1sdByoSn6GsWBwraV8D4n",2100000000000000)+        ]+      , "0100000002db494559df26b5cf3b121f05af26e0568708f5bd9ccceb41656f1654a1eb29eb0000000000ffffffff0000000000000000000000000000000000000000000000000000000000000100ffffff7f00ffffffff0201000000000000001976a91424aa604689cc582292b97668bedd91dd5bf9374c88ac0040075af07507001976a9145d16672f53981ff21c5f42b40d1954993cbca54f88ac00000000"+      )+    , ( [ ("eb29eba154166f6541ebcc9cbdf5088756e026af051f123bcfb526df594549db",0)+        , ("0001000000000000000000000000000000000000000000000000000000000000",2147483647)+        ]+      , []+      , "0100000002db494559df26b5cf3b121f05af26e0568708f5bd9ccceb41656f1654a1eb29eb0000000000ffffffff0000000000000000000000000000000000000000000000000000000000000100ffffff7f00ffffffff0000000000"+      )+    , ( []+      , [ ("14LsRquZfURNFrzpcLVGdaHTfAPjjwiSPb",1)+        , ("19VCgS642vzEA1sdByoSn6GsWBwraV8D4n",2100000000000000)+        ]+      , "01000000000201000000000000001976a91424aa604689cc582292b97668bedd91dd5bf9374c88ac0040075af07507001976a9145d16672f53981ff21c5f42b40d1954993cbca54f88ac00000000"+      )+    ]++{- Test vectors from bitcoind -}+-- github.com/bitcoin/bitcoin/blob/master/src/test/data/tx_valid.json++verifyVec :: [([(String,String,String)],String)]+verifyVec = +    [+      -- It is of particular interest because it contains an invalidly-encoded signature which OpenSSL accepts+      ( [ +          ( "60a20bd93aa49ab4b28d514ec10b06e1829ce6818ec06cd3aabd013ebcdc4bb1"+          , "00000000"+          , "514104cc71eb30d653c0c3163990c47b976f3fb3f37cccdcbedb169a1dfef58bbfbfaff7d8a473e7e2e6d317b87bafe8bde97e3cf8f065dec022b51d11fcdd0d348ac4410461cbdcc5409fb4b4d42b51d33381354d80e550078cb532a34bfa2fcfdeb7d76519aecc62770f5b0e4ef8551946d8a540911abe3e7854a26f39f58b25c15342af52ae"+          )+        ]+      , "0100000001b14bdcbc3e01bdaad36cc08e81e69c82e1060bc14e518db2b49aa43ad90ba26000000000490047304402203f16c6f40162ab686621ef3000b04e75418a0c0cb2d8aebeac894ae360ac1e780220ddc15ecdfc3507ac48e1681a33eb60996631bf6bf5bc0a0682c4db743ce7ca2b01ffffffff0140420f00000000001976a914660d4ef3a743e3e696ad990364e555c271ad504b88ac00000000"+      )+      -- It has an arbitrary extra byte stuffed into the signature at pos length - 2+    , ( [+          ( "60a20bd93aa49ab4b28d514ec10b06e1829ce6818ec06cd3aabd013ebcdc4bb1"+          , "00000000"+          , "514104cc71eb30d653c0c3163990c47b976f3fb3f37cccdcbedb169a1dfef58bbfbfaff7d8a473e7e2e6d317b87bafe8bde97e3cf8f065dec022b51d11fcdd0d348ac4410461cbdcc5409fb4b4d42b51d33381354d80e550078cb532a34bfa2fcfdeb7d76519aecc62770f5b0e4ef8551946d8a540911abe3e7854a26f39f58b25c15342af52ae"+          )+        ]+      , "0100000001b14bdcbc3e01bdaad36cc08e81e69c82e1060bc14e518db2b49aa43ad90ba260000000004A0048304402203f16c6f40162ab686621ef3000b04e75418a0c0cb2d8aebeac894ae360ac1e780220ddc15ecdfc3507ac48e1681a33eb60996631bf6bf5bc0a0682c4db743ce7ca2bab01ffffffff0140420f00000000001976a914660d4ef3a743e3e696ad990364e555c271ad504b88ac00000000"+      )+      -- it is of interest because it contains a 0-sequence as well as a signature of SIGHASH type 0 (which is not a real type)+    , ( [+          ( "406b2b06bcd34d3c8733e6b79f7a394c8a431fbf4ff5ac705c93f4076bb77602"+          , "00000000"+          , "76a914dc44b1164188067c3a32d4780f5996fa14a4f2d988ac"+          )+        ]+      , "01000000010276b76b07f4935c70acf54fbf1f438a4c397a9fb7e633873c4dd3bc062b6b40000000008c493046022100d23459d03ed7e9511a47d13292d3430a04627de6235b6e51a40f9cd386f2abe3022100e7d25b080f0bb8d8d5f878bba7d54ad2fda650ea8d158a33ee3cbd11768191fd004104b0e2c879e4daf7b9ab68350228c159766676a14f5815084ba166432aab46198d4cca98fa3e9981d0a90b2effc514b76279476550ba3663fdcaff94c38420e9d5000000000100093d00000000001976a9149a7b0f3b80c6baaeedce0a0842553800f832ba1f88ac00000000"+      )+      -- It caught a bug in the workaround for 23b397edccd3740a74adb603c9756370fafcde9bcc4483eb271ecad09a94dd63 in an overly simple implementation+    , ( [+          ( "b464e85df2a238416f8bdae11d120add610380ea07f4ef19c5f9dfd472f96c3d"+          , "00000000"+          , "76a914bef80ecf3a44500fda1bc92176e442891662aed288ac"+          )+        , ( "b7978cc96e59a8b13e0865d3f95657561a7f725be952438637475920bac9eb21"+          , "01000000"+          , "76a914bef80ecf3a44500fda1bc92176e442891662aed288ac"+          )+        ]+      , "01000000023d6cf972d4dff9c519eff407ea800361dd0a121de1da8b6f4138a2f25de864b4000000008a4730440220ffda47bfc776bcd269da4832626ac332adfca6dd835e8ecd83cd1ebe7d709b0e022049cffa1cdc102a0b56e0e04913606c70af702a1149dc3b305ab9439288fee090014104266abb36d66eb4218a6dd31f09bb92cf3cfa803c7ea72c1fc80a50f919273e613f895b855fb7465ccbc8919ad1bd4a306c783f22cd3227327694c4fa4c1c439affffffff21ebc9ba20594737864352e95b727f1a565756f9d365083eb1a8596ec98c97b7010000008a4730440220503ff10e9f1e0de731407a4a245531c9ff17676eda461f8ceeb8c06049fa2c810220c008ac34694510298fa60b3f000df01caa244f165b727d4896eb84f81e46bcc4014104266abb36d66eb4218a6dd31f09bb92cf3cfa803c7ea72c1fc80a50f919273e613f895b855fb7465ccbc8919ad1bd4a306c783f22cd3227327694c4fa4c1c439affffffff01f0da5200000000001976a914857ccd42dded6df32949d4646dfa10a92458cfaa88ac00000000"+      )+      -- It results in signing the constant 1, instead of something generated based on the transaction,+      -- when the input doing the signing has an index greater than the maximum output index+    , ( [ +          ( "0000000000000000000000000000000000000000000000000000000000000100"+          , "00000000"+          , "76a914e52b482f2faa8ecbf0db344f93c84ac908557f3388ac"+          )+        , ( "0000000000000000000000000000000000000000000000000000000000000200"+          , "00000000"+          , "76a914751e76e8199196d454941c45d1b3a323f1433bd688ac"+          )+        ]+        , "01000000020002000000000000000000000000000000000000000000000000000000000000000000006a47304402200469f169b8091cd18a2770136be7411f079b3ac2b5c199885eb66a80aa3ed75002201fa89f3e6f80974e1b3474e70a0fbe907c766137ff231e4dd05a555d8544536701210279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798ffffffff0001000000000000000000000000000000000000000000000000000000000000000000006b483045022100c9cdd08798a28af9d1baf44a6c77bcc7e279f47dc487c8c899911bc48feaffcc0220503c5c50ae3998a733263c5c0f7061b483e2b56c4c41b456e7d2f5a78a74c077032102d5c25adb51b61339d2b05315791e21bbe80ea470a49db0135720983c905aace0ffffffff010000000000000000015100000000"+      )+      -- A valid P2SH Transaction using the standard transaction type put forth in BIP 16+    , ( [+          ( "0000000000000000000000000000000000000000000000000000000000000100"+          , "00000000"+          , "a9148febbed40483661de6958d957412f82deed8e2f787"+          )+        ]+      , "01000000010001000000000000000000000000000000000000000000000000000000000000000000006e493046022100c66c9cdf4c43609586d15424c54707156e316d88b0a1534c9e6b0d4f311406310221009c0fe51dbc9c4ab7cc25d3fdbeccf6679fe6827f08edf2b4a9f16ee3eb0e438a0123210338e8034509af564c62644c07691942e0c056752008a173c89f60ab2a88ac2ebfacffffffff010000000000000000015100000000"+      )+      -- MAX_MONEY output+    , ( [+          ( "0000000000000000000000000000000000000000000000000000000000000100"+          , "00000000"+          , "a91432afac281462b822adbec5094b8d4d337dd5bd6a87"+          )+        ]+      , "01000000010001000000000000000000000000000000000000000000000000000000000000000000006e493046022100e1eadba00d9296c743cb6ecc703fd9ddc9b3cd12906176a226ae4c18d6b00796022100a71aef7d2874deff681ba6080f1b278bac7bb99c61b08a85f4311970ffe7f63f012321030c0588dc44d92bdcbf8e72093466766fdc265ead8db64517b0c542275b70fffbacffffffff010040075af0750700015100000000"+      )+      -- MAX_MONEY output + 0 output+    , ( [+          ( "0000000000000000000000000000000000000000000000000000000000000100"+          , "00000000"+          , "a914b558cbf4930954aa6a344363a15668d7477ae71687"+          )+        ]+      , "01000000010001000000000000000000000000000000000000000000000000000000000000000000006d483045022027deccc14aa6668e78a8c9da3484fbcd4f9dcc9bb7d1b85146314b21b9ae4d86022100d0b43dece8cfb07348de0ca8bc5b86276fa88f7f2138381128b7c36ab2e42264012321029bb13463ddd5d2cc05da6e84e37536cb9525703cfd8f43afdb414988987a92f6acffffffff020040075af075070001510000000000000000015100000000"+      )+      -- Simple transaction with first input is signed with SIGHASH_ALL, second with SIGHASH_ANYONECANPAY+    , ( [+          ( "0000000000000000000000000000000000000000000000000000000000000100"+          , "00000000"+          , "21035e7f0d4d0841bcd56c39337ed086b1a633ee770c1ffdd94ac552a95ac2ce0efcac"+          )+        , ( "0000000000000000000000000000000000000000000000000000000000000200"+          , "00000000"+          , "21035e7f0d4d0841bcd56c39337ed086b1a633ee770c1ffdd94ac552a95ac2ce0efcac"+          )+        ]+      , "010000000200010000000000000000000000000000000000000000000000000000000000000000000049483045022100d180fd2eb9140aeb4210c9204d3f358766eb53842b2a9473db687fa24b12a3cc022079781799cd4f038b85135bbe49ec2b57f306b2bb17101b17f71f000fcab2b6fb01ffffffff0002000000000000000000000000000000000000000000000000000000000000000000004847304402205f7530653eea9b38699e476320ab135b74771e1c48b81a5d041e2ca84b9be7a802200ac8d1f40fb026674fe5a5edd3dea715c27baa9baca51ed45ea750ac9dc0a55e81ffffffff010100000000000000015100000000"+      )+      -- Same as above, but we change the sequence number of the first input to check that SIGHASH_ANYONECANPAY is being followed+    , ( [+          ( "0000000000000000000000000000000000000000000000000000000000000100"+          , "00000000"+          , "21035e7f0d4d0841bcd56c39337ed086b1a633ee770c1ffdd94ac552a95ac2ce0efcac"+          )+        , ( "0000000000000000000000000000000000000000000000000000000000000200"+          , "00000000"+          , "21035e7f0d4d0841bcd56c39337ed086b1a633ee770c1ffdd94ac552a95ac2ce0efcac"+          )+        ]+      , "01000000020001000000000000000000000000000000000000000000000000000000000000000000004948304502203a0f5f0e1f2bdbcd04db3061d18f3af70e07f4f467cbc1b8116f267025f5360b022100c792b6e215afc5afc721a351ec413e714305cb749aae3d7fee76621313418df101010000000002000000000000000000000000000000000000000000000000000000000000000000004847304402205f7530653eea9b38699e476320ab135b74771e1c48b81a5d041e2ca84b9be7a802200ac8d1f40fb026674fe5a5edd3dea715c27baa9baca51ed45ea750ac9dc0a55e81ffffffff010100000000000000015100000000"+      )+      -- several SIGHASH_SINGLE signatures+    , ( [+          ( "63cfa5a09dc540bf63e53713b82d9ea3692ca97cd608c384f2aa88e51a0aac70"+          , "00000000"+          , "76a914dcf72c4fd02f5a987cf9b02f2fabfcac3341a87d88ac"+          )+        , ( "04e8d0fcf3846c6734477b98f0f3d4badfb78f020ee097a0be5fe347645b817d"+          , "01000000"+          , "76a914dcf72c4fd02f5a987cf9b02f2fabfcac3341a87d88ac"+          )+        , ( "ee1377aff5d0579909e11782e1d2f5f7b84d26537be7f5516dd4e43373091f3f"+          , "01000000"+          , "76a914dcf72c4fd02f5a987cf9b02f2fabfcac3341a87d88ac"+          )+        ]+      , "010000000370ac0a1ae588aaf284c308d67ca92c69a39e2db81337e563bf40c59da0a5cf63000000006a4730440220360d20baff382059040ba9be98947fd678fb08aab2bb0c172efa996fd8ece9b702201b4fb0de67f015c90e7ac8a193aeab486a1f587e0f54d0fb9552ef7f5ce6caec032103579ca2e6d107522f012cd00b52b9a65fb46f0c57b9b8b6e377c48f526a44741affffffff7d815b6447e35fbea097e00e028fb7dfbad4f3f0987b4734676c84f3fcd0e804010000006b483045022100c714310be1e3a9ff1c5f7cacc65c2d8e781fc3a88ceb063c6153bf950650802102200b2d0979c76e12bb480da635f192cc8dc6f905380dd4ac1ff35a4f68f462fffd032103579ca2e6d107522f012cd00b52b9a65fb46f0c57b9b8b6e377c48f526a44741affffffff3f1f097333e4d46d51f5e77b53264db8f7f5d2e18217e1099957d0f5af7713ee010000006c493046022100b663499ef73273a3788dea342717c2640ac43c5a1cf862c9e09b206fcb3f6bb8022100b09972e75972d9148f2bdd462e5cb69b57c1214b88fc55ca638676c07cfc10d8032103579ca2e6d107522f012cd00b52b9a65fb46f0c57b9b8b6e377c48f526a44741affffffff0380841e00000000001976a914bfb282c70c4191f45b5a6665cad1682f2c9cfdfb88ac80841e00000000001976a9149857cc07bed33a5cf12b9c5e0500b675d500c81188ace0fd1c00000000001976a91443c52850606c872403c0601e69fa34b26f62db4a88ac00000000"+      )+    ]+
+ tests/Network/Haskoin/Util/Arbitrary.hs view
@@ -0,0 +1,43 @@+{-|+  QuickCheck Arbitrary instances for various utility data types+-}+module Network.Haskoin.Util.Arbitrary (nonEmptyBS) where++import Test.QuickCheck +    ( Arbitrary+    , Gen+    , arbitrary+    , choose+    , oneof+    )+import qualified Data.ByteString as BS +    ( ByteString+    , pack+    , drop+    , null+    )++import Control.Applicative++import Network.Haskoin.Util.BuildMonad (Build(..))++-- Arbitrary instance for strict ByteStrings+instance Arbitrary BS.ByteString where+    arbitrary = do+        bs <- BS.pack `fmap` arbitrary+        n <- choose (0, 2)+        return $ BS.drop n bs -- to give us some with non-0 offset++-- | Generate non-empty strict ByteStrings+nonEmptyBS :: Gen BS.ByteString+nonEmptyBS = do+    bs <- arbitrary+    return $ if BS.null bs then BS.pack [0] else bs++-- Arbitrary instance for the Build monad+instance Arbitrary a => Arbitrary (Build a) where+    arbitrary = oneof [ Complete <$> arbitrary+                      , Partial <$> arbitrary+                      , return $ Broken "Arbitrary: Broken"+                      ]+
+ tests/Network/Haskoin/Util/Tests.hs view
@@ -0,0 +1,115 @@+module Network.Haskoin.Util.Tests (tests) where++import Test.Framework (Test, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import Data.List (permutations)+import Data.Maybe (fromJust, catMaybes)+import Data.Foldable (toList)+import qualified Data.Sequence as Seq (update, fromList)+import qualified Data.ByteString as BS (ByteString)++import Network.Haskoin.Util +import Network.Haskoin.Util.Arbitrary()++tests :: [Test]+tests = +    [ testGroup "Utility functions"+        [ testProperty "toStrict( toLazy(bs) ) = bs" fromToLazy+        , testProperty "get( put(Integer) ) = Integer" getPutInteger+        , testProperty "stringToBS( bsToString(s) ) = s" fromToString+        , testProperty "decode'( encode'(s) ) = s" decEncBS+        , testProperty "decodeOrFail'( encode'(s) ) = s" decEncFailBS+        , testProperty "fromHex( toHex(bs) ) = bs" fromToHex+        , testProperty "testing decodeEither" testFromDecode+        , testProperty "compare updateIndex with Data.Sequence" testUpdateIndex+        , testProperty "testing matchTemplate" testMatchTemplate+        , testProperty +            "testing matchTemplate with two lists" testMatchTemplateLen+        , testProperty "Testing either helper functions" testEither+        ]+    , testGroup "Build Monad"+        [ testProperty "Build monadic composition" testBuildCompose+        , testProperty "Testing guardPartial" testGuardPartial+        ]+    ]++{- Various utilities -}++fromToLazy :: BS.ByteString -> Bool+fromToLazy bs = (toStrictBS $ toLazyBS bs) == bs++fromToString :: BS.ByteString -> Bool+fromToString bs = (stringToBS $ bsToString bs) == bs++decEncBS :: BS.ByteString -> Bool+decEncBS bs = (decode' $ encode' bs) == bs++decEncFailBS :: BS.ByteString -> Bool+decEncFailBS bs = case (decodeOrFail' $ encode' bs) of+    (Left _)            -> False+    (Right (_, _, res)) -> res == bs++getPutInteger :: Integer -> Bool+getPutInteger i = (bsToInteger $ integerToBS p) == p+  where +    p = abs i++fromToHex :: BS.ByteString -> Bool+fromToHex bs = (fromJust $ hexToBS $ bsToHex bs) == bs++testFromDecode :: BS.ByteString -> Integer -> Integer -> Bool+testFromDecode bs def v = case decodeOrFail' bs of+    (Left _)          -> fromDecode bs def (*v) == def +    (Right (_,_,res)) -> fromDecode bs def (*v) == res*v ++testUpdateIndex :: [Int] -> Int -> Int -> Bool +testUpdateIndex xs v i = +    (updateIndex i xs $ const v) == (toList $ Seq.update i v s)+  where +    s = Seq.fromList xs++testMatchTemplate :: [Int] -> Int -> Bool+testMatchTemplate as i = catMaybes res == bs+  where +    res = matchTemplate as bs (==)+    idx = if length as == 0 then 0 else i `mod` length as +    bs  = (permutations as) !! idx++testMatchTemplateLen :: [Int] -> [Int] -> Bool+testMatchTemplateLen as bs = length bs == length res+  where +    res = matchTemplate as bs (==)++testEither :: Either String Int -> Bool+testEither e = case e of+    (Right v) -> (isRight e)+              && (not $ isLeft e) +              && (fromRight e == v)+              && (eitherToMaybe e == Just v)+    (Left v)  -> (isLeft e)+              && (not $ isRight e)+              && (fromLeft e == v)+              && (eitherToMaybe e == Nothing)++{- Build Monad -}++testBuildCompose :: Build Int -> Build Int -> Bool+testBuildCompose ma mb+    | isBroken ma || isBroken mb   = isBroken res+    | isPartial ma || isPartial mb = isPartial res+    | otherwise                    = isComplete res+  where +    res = ma >>= (\a -> mb >>= (\b -> return $ a + b ))++testGuardPartial :: Build Int -> Build Int -> Bool+testGuardPartial ma mb+    | isBroken ma || isBroken mb   = isBroken res+    | otherwise                    = isPartial res+  where +    res = do+        a <- ma+        guardPartial False+        b <- mb+        return $ a + b+
+ tests/data/errors.json view
@@ -0,0 +1,7 @@+{"id": 3, "error": "unknown method:blockchain.foo"}+{"jsonrpc": "2.0", "error": {"code": -32601, "message": "Method not found"}, "id": "1"}+{"jsonrpc": "2.0", "error": {"code": -32700, "message": "Parse error"}, "id": null}+{"jsonrpc": "2.0", "error": {"code": -32600, "message": "Invalid Request"}, "id": null}+{"jsonrpc": "2.0", "error": {"code": -32700, "message": "Parse error"}, "id": null}+{"jsonrpc": "2.0", "error": {"code": -32600, "message": "Invalid Request"}, "id": null}+{"jsonrpc": "2.0", "error": {"code": -32601, "message": "Method not found"}, "id": "5"}
+ tests/data/invalid.json view
@@ -0,0 +1,6 @@+{"jsonrpc": "2.0", "method": "foobar, "params": "bar", "baz]+{"jsonrpc": "2.0", "method": 1, "params": "bar"}+{"jsonrpc": "2.0", "method"+[]+[1,2,3]+{"foo": "boo"}
+ tests/data/notifications.json view
@@ -0,0 +1,7 @@+{"method": "handleMessage", "params": ["user1", "we were just talking"], "id": null}+{"method": "handleMessage", "params": ["user3", "sorry, gotta go now, ttyl"], "id": null}+{"method": "userLeft", "params": ["user3"], "id": null}+{"jsonrpc": "2.0", "method": "update", "params": [1,2,3,4,5]}+{"jsonrpc": "2.0", "method": "foobar"}+{"jsonrpc": "2.0", "method": "notify_hello", "params": [7]}+{"jsonrpc": "2.0", "method": "notify_sum", "params": [1,2,4]}
+ tests/data/requests.json view
@@ -0,0 +1,12 @@+{ "method": "echo", "params": ["Hello JSON-RPC"], "id": 1}+{"method": "postMessage", "params": ["Hello all!"], "id": 99}+{"method": "postMessage", "params": ["I have a question:"], "id": 101}+{"jsonrpc": "2.0", "method": "subtract", "params": [42, 23], "id": 1}+{"jsonrpc": "2.0", "method": "subtract", "params": [23, 42], "id": 2}+{"jsonrpc": "2.0", "method": "subtract", "params": {"subtrahend": 23, "minuend": 42}, "id": 3}+{"jsonrpc": "2.0", "method": "subtract", "params": {"minuend": 42, "subtrahend": 23}, "id": 4}+{"jsonrpc": "2.0", "method": "foobar", "id": "1"}+{"jsonrpc": "2.0", "method": "sum", "params": [1,2,4], "id": "1"}+{"jsonrpc": "2.0", "method": "subtract", "params": [42,23], "id": "2"}+{"jsonrpc": "2.0", "method": "foo.get", "params": {"name": "myself"}, "id": "5"}+{"jsonrpc": "2.0", "method": "get_data", "id": "9"}
+ tests/data/responses.json view
@@ -0,0 +1,10 @@+{ "result": "Hello JSON-RPC", "error": null, "id": 1}+{"result": 1, "error": null, "id": 99}+{"result": 1, "error": null, "id": 101}+{"jsonrpc": "2.0", "result": 19, "id": 1}+{"jsonrpc": "2.0", "result": -19, "id": 2}+{"jsonrpc": "2.0", "result": 19, "id": 3}+{"jsonrpc": "2.0", "result": 19, "id": 4}+{"jsonrpc": "2.0", "result": 7, "id": "1"}+{"jsonrpc": "2.0", "result": 19, "id": "2"}+{"jsonrpc": "2.0", "result": ["hello", 5], "id": "9"}