haskoin-store-data 0.25.4 → 0.26.0
raw patch · 3 files changed
+222/−170 lines, 3 files
Files
- haskoin-store-data.cabal +2/−2
- src/Haskoin/Store/Data.hs +189/−157
- test/Haskoin/Store/DataSpec.hs +31/−11
haskoin-store-data.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 39a15f6c1fa31c97f8734f31c16c78e7b569a0b97cee9f2dabc4a1aee5353ccf+-- hash: 59fd8f96d157ca7e56be9c2b9a70387c1224e482a9895a02a30f183603f5a63c name: haskoin-store-data-version: 0.25.4+version: 0.26.0 synopsis: Data for Haskoin Store description: Data and its (de)serialisation functions for Haskoin Store category: Bitcoin, Finance, Network
src/Haskoin/Store/Data.hs view
@@ -25,16 +25,19 @@ , Transaction(..) , transactionToJSON , transactionToEncoding+ , transactionParseJSON , transactionData , fromTransaction , toTransaction , StoreInput(..) , storeInputToJSON , storeInputToEncoding+ , storeInputParseJSON , isCoinbase , StoreOutput(..) , storeOutputToJSON , storeOutputToEncoding+ , storeOutputParseJSON , Prev(..) , Spender(..) , BlockRef(..)@@ -47,6 +50,7 @@ , Unspent(..) , unspentToJSON , unspentToEncoding+ , unspentParseJSON -- * Extended Public Keys , XPubSpec(..)@@ -57,6 +61,7 @@ , XPubUnspent(..) , xPubUnspentToJSON , xPubUnspentToEncoding+ , xPubUnspentParseJSON , XPubSummary(..) , DeriveType(..) @@ -103,8 +108,9 @@ TxIn (..), TxOut (..), WitnessStack, XPubKey (..), addrFromJSON, addrToEncoding, addrToJSON,- blockHashToHex, decodeHex, encodeHex,- headerHash, scriptToAddressBS, txHash,+ blockHashToHex, decodeHex,+ eitherToMaybe, encodeHex, headerHash,+ scriptToAddressBS, txHash, txHashToHex, wrapPubKey) import Web.Scotty.Trans (ScottyError (..)) @@ -319,16 +325,17 @@ -- | Unspent output. data Unspent = Unspent- { unspentBlock :: !BlockRef- , unspentPoint :: !OutPoint- , unspentAmount :: !Word64- , unspentScript :: !ShortByteString+ { unspentBlock :: !BlockRef+ , unspentPoint :: !OutPoint+ , unspentAmount :: !Word64+ , unspentScript :: !ShortByteString+ , unspentAddress :: !(Maybe Address) } deriving (Show, Eq, Ord, Generic, Hashable, Serialize, NFData) unspentToJSON :: Network -> Unspent -> Value unspentToJSON net u = object- [ "address" .= scriptToAddrJSON net bsscript+ [ "address" .= (addrToJSON net <$> unspentAddress u) , "block" .= unspentBlock u , "txid" .= outPointHash (unspentPoint u) , "index" .= outPointIndex (unspentPoint u)@@ -342,7 +349,7 @@ unspentToEncoding :: Network -> Unspent -> Encoding unspentToEncoding net u = pairs- ( "address" `pair` scriptToAddrEncoding net bsscript+ ( "address" `pair` maybe null_ (addrToEncoding net) (unspentAddress u) <> "block" .= unspentBlock u <> "txid" .= outPointHash (unspentPoint u) <> "index" .= outPointIndex (unspentPoint u)@@ -353,21 +360,25 @@ bsscript = BSS.fromShort (unspentScript u) script = encodeHex bsscript -instance FromJSON Unspent where- parseJSON =- A.withObject "unspent" $ \o -> do- block <- o .: "block"- txid <- o .: "txid"- index <- o .: "index"- value <- o .: "value"- script <- BSS.toShort <$> (o .: "pkscript" >>= jsonHex)- return- Unspent- { unspentBlock = block- , unspentPoint = OutPoint txid index- , unspentAmount = value- , unspentScript = script- }+unspentParseJSON :: Network -> Value -> Parser Unspent+unspentParseJSON net =+ A.withObject "unspent" $ \o -> do+ block <- o .: "block"+ txid <- o .: "txid"+ index <- o .: "index"+ value <- o .: "value"+ script <- BSS.toShort <$> (o .: "pkscript" >>= jsonHex)+ addr <- o .: "address" >>= \case+ Nothing -> return Nothing+ Just a -> Just <$> addrFromJSON net a <|> return Nothing+ return+ Unspent+ { unspentBlock = block+ , unspentPoint = OutPoint txid index+ , unspentAmount = value+ , unspentScript = script+ , unspentAddress = addr+ } -- | Database value for a block entry. data BlockData = BlockData@@ -432,7 +443,7 @@ <> "fees" .= blockDataFees bv <> "outputs" .= blockDataOutputs bv <> "work" .= blockDataWork bv- <> if getSegWit net then "weight" .= blockDataWeight bv else mempty+ <> (if getSegWit net then "weight" .= blockDataWeight bv else mempty) ) instance FromJSON BlockData where@@ -476,18 +487,21 @@ } data StoreInput- = StoreCoinbase { inputPoint :: !OutPoint- , inputSequence :: !Word32- , inputSigScript :: !ByteString- , inputWitness :: !(Maybe WitnessStack)- }- | StoreInput { inputPoint :: !OutPoint- , inputSequence :: !Word32- , inputSigScript :: !ByteString- , inputPkScript :: !ByteString- , inputAmount :: !Word64- , inputWitness :: !(Maybe WitnessStack)- }+ = StoreCoinbase+ { inputPoint :: !OutPoint+ , inputSequence :: !Word32+ , inputSigScript :: !ByteString+ , inputWitness :: !(Maybe WitnessStack)+ }+ | StoreInput+ { inputPoint :: !OutPoint+ , inputSequence :: !Word32+ , inputSigScript :: !ByteString+ , inputPkScript :: !ByteString+ , inputAmount :: !Word64+ , inputWitness :: !(Maybe WitnessStack)+ , inputAddress :: !(Maybe Address)+ } deriving (Show, Read, Eq, Ord, Generic, Serialize, Hashable, NFData) isCoinbase :: StoreInput -> Bool@@ -501,6 +515,7 @@ , inputPkScript = ps , inputAmount = val , inputWitness = wit+ , inputAddress = a } = object $ [ "coinbase" .= False@@ -510,7 +525,7 @@ , "sequence" .= sq , "pkscript" .= String (encodeHex ps) , "value" .= val- , "address" .= scriptToAddrJSON net ps+ , "address" .= (addrToJSON net <$> a) ] <> ["witness" .= fmap (map encodeHex) wit | getSegWit net] storeInputToJSON net StoreCoinbase { inputPoint = OutPoint oph opi@@ -537,6 +552,7 @@ , inputPkScript = ps , inputAmount = val , inputWitness = wit+ , inputAddress = a } = pairs ( "coinbase" .= False@@ -546,10 +562,10 @@ <> "sequence" .= sq <> "pkscript" `pair` text (encodeHex ps) <> "value" .= val- <> "address" `pair` scriptToAddrEncoding net ps- <> if getSegWit net+ <> "address" `pair` (maybe null_ (addrToEncoding net) a)+ <> (if getSegWit net then "witness" .= fmap (map encodeHex) wit- else mempty+ else mempty) ) storeInputToEncoding net StoreCoinbase { inputPoint = OutPoint oph opi@@ -566,43 +582,47 @@ <> "pkscript" `pair` null_ <> "value" `pair` null_ <> "address" `pair` null_- <> if getSegWit net+ <> (if getSegWit net then "witness" .= fmap (map encodeHex) wit- else mempty+ else mempty) ) -instance FromJSON StoreInput where- parseJSON =- A.withObject "storeinput" $ \o -> do- coinbase <- o .: "coinbase"- outpoint <- OutPoint <$> o .: "txid" <*> o .: "output"- sequ <- o .: "sequence"- witness <-- o .:? "witness" >>= \mmxs ->- case join mmxs of- Nothing -> return Nothing- Just xs -> Just <$> mapM jsonHex xs- sigscript <- o .: "sigscript" >>= jsonHex- if coinbase- then return- StoreCoinbase- { inputPoint = outpoint- , inputSequence = sequ- , inputSigScript = sigscript- , inputWitness = witness- }- else do- pkscript <- o .: "pkscript" >>= jsonHex- value <- o .: "value"- return- StoreInput- { inputPoint = outpoint- , inputSequence = sequ- , inputSigScript = sigscript- , inputPkScript = pkscript- , inputAmount = value- , inputWitness = witness- }+storeInputParseJSON :: Network -> Value -> Parser StoreInput+storeInputParseJSON net =+ A.withObject "storeinput" $ \o -> do+ coinbase <- o .: "coinbase"+ outpoint <- OutPoint <$> o .: "txid" <*> o .: "output"+ sequ <- o .: "sequence"+ witness <-+ o .:? "witness" >>= \mmxs ->+ case join mmxs of+ Nothing -> return Nothing+ Just xs -> Just <$> mapM jsonHex xs+ sigscript <- o .: "sigscript" >>= jsonHex+ if coinbase+ then return+ StoreCoinbase+ { inputPoint = outpoint+ , inputSequence = sequ+ , inputSigScript = sigscript+ , inputWitness = witness+ }+ else do+ pkscript <- o .: "pkscript" >>= jsonHex+ value <- o .: "value"+ addr <- o .: "address" >>= \case+ Nothing -> return Nothing+ Just a -> Just <$> addrFromJSON net a <|> return Nothing+ return+ StoreInput+ { inputPoint = outpoint+ , inputSequence = sequ+ , inputSigScript = sigscript+ , inputPkScript = pkscript+ , inputAmount = value+ , inputWitness = witness+ , inputAddress = addr+ } jsonHex :: Text -> Parser ByteString jsonHex s =@@ -631,12 +651,13 @@ { outputAmount :: !Word64 , outputScript :: !ByteString , outputSpender :: !(Maybe Spender)+ , outputAddress :: !(Maybe Address) } deriving (Show, Read, Eq, Ord, Generic, Serialize, Hashable, NFData) storeOutputToJSON :: Network -> StoreOutput -> Value storeOutputToJSON net d = object- [ "address" .= scriptToAddrJSON net (outputScript d)+ [ "address" .= (addrToJSON net <$> outputAddress d) , "pkscript" .= encodeHex (outputScript d) , "value" .= outputAmount d , "spent" .= isJust (outputSpender d)@@ -646,25 +667,29 @@ storeOutputToEncoding :: Network -> StoreOutput -> Encoding storeOutputToEncoding net d = pairs- ( "address" `pair` scriptToAddrEncoding net (outputScript d)+ ( "address" `pair` maybe null_ (addrToEncoding net) (outputAddress d) <> "pkscript" `pair` text (encodeHex (outputScript d)) <> "value" .= outputAmount d <> "spent" .= isJust (outputSpender d) <> "spender" .= outputSpender d ) -instance FromJSON StoreOutput where- parseJSON =- A.withObject "storeoutput" $ \o -> do- value <- o .: "value"- pkscript <- o .: "pkscript" >>= jsonHex- spender <- o .: "spender"- return- StoreOutput- { outputAmount = value- , outputScript = pkscript- , outputSpender = spender- }+storeOutputParseJSON :: Network -> Value -> Parser StoreOutput+storeOutputParseJSON net =+ A.withObject "storeoutput" $ \o -> do+ value <- o .: "value"+ pkscript <- o .: "pkscript" >>= jsonHex+ spender <- o .: "spender"+ addr <- o .: "address" >>= \case+ Nothing -> return Nothing+ Just a -> Just <$> addrFromJSON net a <|> return Nothing+ return+ StoreOutput+ { outputAmount = value+ , outputScript = pkscript+ , outputSpender = spender+ , outputAddress = addr+ } data Prev = Prev { prevScript :: !ByteString@@ -687,6 +712,7 @@ , inputPkScript = prevScript p , inputAmount = prevAmount p , inputWitness = w+ , inputAddress = eitherToMaybe (scriptToAddressBS (prevScript p)) } toOutput :: TxOut -> Maybe Spender -> StoreOutput@@ -695,6 +721,7 @@ { outputAmount = outValue o , outputScript = scriptOutput o , outputSpender = s+ , outputAddress = eitherToMaybe (scriptToAddressBS (scriptOutput o)) } data TxData = TxData@@ -717,8 +744,24 @@ , transactionDeleted = txDataDeleted t , transactionRBF = txDataRBF t , transactionTime = txDataTime t+ , transactionId = txid+ , transactionSize = txsize+ , transactionWeight = txweight+ , transactionFees = fees } where+ txid = txHash (txData t)+ txsize = fromIntegral $ B.length (S.encode (txData t))+ txweight =+ let b = B.length $ S.encode (txData t) {txWitness = []}+ x = B.length $ S.encode (txData t)+ in fromIntegral $ b * 3 + x+ inv = sum (map inputAmount ins)+ outv = sum (map outputAmount outs)+ fees =+ if any isCoinbase ins+ then 0+ else inv - outv ws = take (length (txIn (txData t))) $ map Just (txWitness (txData t)) <> repeat Nothing@@ -765,6 +808,14 @@ -- ^ this transaction can be replaced in the mempool , transactionTime :: !Word64 -- ^ time the transaction was first seen or time of block+ , transactionId :: !TxHash+ -- ^ transaction id+ , transactionSize :: !Word32+ -- ^ serialized transaction size (includes witness data)+ , transactionWeight :: !Word32+ -- ^ transaction weight+ , transactionFees :: !Word64+ -- ^ fees that this transaction pays (0 for coinbase) } deriving (Show, Eq, Ord, Generic, Hashable, Serialize, NFData) transactionData :: Transaction -> Tx@@ -787,78 +838,71 @@ transactionToJSON :: Network -> Transaction -> Value transactionToJSON net dtx = object $- [ "txid" .= txHash (transactionData dtx)- , "size" .= B.length (S.encode (transactionData dtx))+ [ "txid" .= transactionId dtx+ , "size" .= transactionSize dtx , "version" .= transactionVersion dtx , "locktime" .= transactionLockTime dtx- , "fee" .=- if any isCoinbase (transactionInputs dtx)- then 0- else inv - outv+ , "fee" .= transactionFees dtx , "inputs" .= map (storeInputToJSON net) (transactionInputs dtx) , "outputs" .= map (storeOutputToJSON net) (transactionOutputs dtx) , "block" .= transactionBlock dtx , "deleted" .= transactionDeleted dtx , "time" .= transactionTime dtx- , "rbf" .= transactionRBF dtx ] <>- ["weight" .= w | getSegWit net]- where- inv = sum (map inputAmount (transactionInputs dtx))- outv = sum (map outputAmount (transactionOutputs dtx))- w =- let b = B.length $ S.encode (transactionData dtx) {txWitness = []}- x = B.length $ S.encode (transactionData dtx)- in b * 3 + x+ [ "rbf" .= transactionRBF dtx | getReplaceByFee net] <>+ [ "weight" .= transactionWeight dtx | getSegWit net] transactionToEncoding :: Network -> Transaction -> Encoding transactionToEncoding net dtx = pairs- ( "txid" `pair` text (txHashToHex (txHash (transactionData dtx)))- <> "size" .= B.length (S.encode (transactionData dtx))+ ( "txid" .= transactionId dtx+ <> "size" .= transactionSize dtx <> "version" .= transactionVersion dtx <> "locktime" .= transactionLockTime dtx- <> "fee" .= (if any isCoinbase (transactionInputs dtx) then 0 else inv - outv)+ <> "fee" .= transactionFees dtx <> "inputs" `pair` list (storeInputToEncoding net) (transactionInputs dtx) <> "outputs" `pair` list (storeOutputToEncoding net) (transactionOutputs dtx) <> "block" .= transactionBlock dtx <> "deleted" .= transactionDeleted dtx <> "time" .= transactionTime dtx- <> "rbf" .= transactionRBF dtx- <> if getSegWit net- then "weight" .= w- else mempty+ <> (if getReplaceByFee net+ then "rbf" .= transactionRBF dtx+ else mempty)+ <> (if getSegWit net+ then "weight" .= transactionWeight dtx+ else mempty) )- where- inv = sum (map inputAmount (transactionInputs dtx))- outv = sum (map outputAmount (transactionOutputs dtx))- w =- let b = B.length $ S.encode (transactionData dtx) {txWitness = []}- x = B.length $ S.encode (transactionData dtx)- in b * 3 + x -instance FromJSON Transaction where- parseJSON =- A.withObject "transaction" $ \o -> do- version <- o .: "version"- locktime <- o .: "locktime"- inputs <- o .: "inputs"- outputs <- o .: "outputs"- block <- o .: "block"- deleted <- o .: "deleted"- time <- o .: "time"- rbf <- o .:? "rbf" .!= False- return- Transaction- { transactionBlock = block- , transactionVersion = version- , transactionLockTime = locktime- , transactionInputs = inputs- , transactionOutputs = outputs- , transactionDeleted = deleted- , transactionTime = time- , transactionRBF = rbf- }+transactionParseJSON :: Network -> Value -> Parser Transaction+transactionParseJSON net =+ A.withObject "transaction" $ \o -> do+ version <- o .: "version"+ locktime <- o .: "locktime"+ inputs <- o .: "inputs" >>= mapM (storeInputParseJSON net)+ outputs <- o .: "outputs" >>= mapM (storeOutputParseJSON net)+ block <- o .: "block"+ deleted <- o .: "deleted"+ time <- o .: "time"+ rbf <- o .:? "rbf" .!= False+ weight <- o .:? "weight" .!= 0+ size <- o .: "size"+ txid <- o .: "txid"+ fees <- o .: "fee"+ return+ Transaction+ { transactionBlock = block+ , transactionVersion = version+ , transactionLockTime = locktime+ , transactionInputs = inputs+ , transactionOutputs = outputs+ , transactionDeleted = deleted+ , transactionTime = time+ , transactionRBF = rbf+ , transactionWeight = weight+ , transactionSize = size+ , transactionId = txid+ , transactionFees = fees+ } -- | Information about a connected peer. data PeerInformation@@ -947,12 +991,12 @@ xPubUnspentToEncoding net XPubUnspent {xPubUnspentPath = p, xPubUnspent = u} = pairs ("path" .= p <> "unspent" `pair` unspentToEncoding net u) -instance FromJSON XPubUnspent where- parseJSON =- A.withObject "xpubunspent" $ \o -> do- p <- o .: "path"- u <- o .: "unspent"- return XPubUnspent {xPubUnspentPath = p, xPubUnspent = u}+xPubUnspentParseJSON :: Network -> Value -> Parser XPubUnspent+xPubUnspentParseJSON net =+ A.withObject "xpubunspent" $ \o -> do+ p <- o .: "path"+ u <- o .: "unspent" >>= unspentParseJSON net+ return XPubUnspent {xPubUnspentPath = p, xPubUnspent = u} data XPubSummary = XPubSummary@@ -1160,18 +1204,6 @@ instance FromJSON TxId where parseJSON = A.withObject "txid" $ \o -> TxId <$> o .: "txid"--scriptToAddrJSON :: Network -> ByteString -> Value-scriptToAddrJSON net bs =- case scriptToAddressBS bs of- Left _ -> Null- Right a -> addrToJSON net a--scriptToAddrEncoding :: Network -> ByteString -> Encoding-scriptToAddrEncoding net bs =- case scriptToAddressBS bs of- Left _ -> null_- Right a -> addrToEncoding net a data Except = ThingNotFound
test/Haskoin/Store/DataSpec.hs view
@@ -35,10 +35,12 @@ XPubSummary (..), XPubUnspent (..), balanceParseJSON, balanceToEncoding, balanceToJSON, blockDataToEncoding,- blockDataToJSON,+ blockDataToJSON, transactionParseJSON, transactionToEncoding,- transactionToJSON, unspentToEncoding,- unspentToJSON, xPubUnspentToEncoding,+ transactionToJSON, unspentParseJSON,+ unspentToEncoding, unspentToJSON,+ xPubUnspentParseJSON,+ xPubUnspentToEncoding, xPubUnspentToJSON) import Test.Hspec (Expectation, Spec, describe, shouldBe) import Test.Hspec.QuickCheck (prop)@@ -80,7 +82,11 @@ prop "identity for block tx" $ \x -> testJSON (x :: BlockTx) prop "identity for block ref" $ \x -> testJSON (x :: BlockRef) prop "identity for unspent" . forAll arbitraryNetData $ \(net, x) ->- testNetJSON parseJSON (unspentToJSON net) (unspentToEncoding net) x+ testNetJSON+ (unspentParseJSON net)+ (unspentToJSON net)+ (unspentToEncoding net)+ x prop "identity for block data" . forAll arbitraryNetData $ \(net, x) -> let x' = if getSegWit net@@ -97,16 +103,24 @@ x' = if getSegWit net then x- else x {transactionInputs = map f (transactionInputs x)}+ else x+ { transactionInputs =+ map f (transactionInputs x)+ , transactionWeight = 0+ }+ x'' =+ if getReplaceByFee net+ then x'+ else x' {transactionRBF = False} in testNetJSON- parseJSON+ (transactionParseJSON net) (transactionToJSON net) (transactionToEncoding net)- x'+ x'' prop "identity for xpub summary" $ \x -> testJSON (x :: XPubSummary) prop "identity for xpub unspent" . forAll arbitraryNetData $ \(net, x) -> testNetJSON- parseJSON+ (xPubUnspentParseJSON net) (xPubUnspentToJSON net) (xPubUnspentToEncoding net) x@@ -212,7 +226,8 @@ (oneof [ Just <$> (listOf $ pack <$> listOf1 arbitrary) , return Nothing- ])+ ]) <*>+ arbitrary ] instance Arbitrary Spender where@@ -220,7 +235,8 @@ instance Arbitrary StoreOutput where arbitrary =- StoreOutput <$> arbitrary <*> (pack <$> listOf1 arbitrary) <*> arbitrary+ StoreOutput <$> arbitrary <*> (pack <$> listOf1 arbitrary) <*> arbitrary <*>+ arbitrary instance Arbitrary Transaction where arbitrary =@@ -233,6 +249,10 @@ <*> arbitrary <*> arbitrary <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary instance Arbitrary PeerInformation where arbitrary = do@@ -318,7 +338,7 @@ instance Arbitrary Unspent where arbitrary = Unspent <$> arbitrary <*> arbitrary <*> arbitrary <*>- (BSS.toShort . pack <$> listOf1 arbitrary)+ (BSS.toShort . pack <$> listOf1 arbitrary) <*> arbitrary instance Arbitrary BlockHeader where arbitrary =