diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,22 @@ +The MIT License (MIT) + +Copyright (c) 2015 Leon Mergen + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +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 OR COPYRIGHT HOLDERS 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. + diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,10 @@ +haskell-bitcoin-script +================== + +[![Build Status](https://travis-ci.org/solatis/haskell-bitcoin-script.png?branch=master)](https://travis-ci.org/solatis/haskell-bitcoin-script) +[![Coverage Status](https://coveralls.io/repos/solatis/haskell-bitcoin-script/badge.svg?branch=master)](https://coveralls.io/r/solatis/haskell-bitcoin-script?branch=master) +[![MIT](http://b.repl.ca/v1/license-MIT-blue.png)](http://en.wikipedia.org/wiki/MIT_License) +[![Haskell](http://b.repl.ca/v1/language-haskell-lightgrey.png)](http://haskell.org) + +This library provides utilities for compiling, manipulation and decompiling of +Bitcoin scripts. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple + +main = defaultMain diff --git a/bitcoin-api-extra.cabal b/bitcoin-api-extra.cabal new file mode 100644 --- /dev/null +++ b/bitcoin-api-extra.cabal @@ -0,0 +1,77 @@ +name: bitcoin-api-extra +category: Network, Finance +version: 0.9.0 +license: MIT +license-file: LICENSE +copyright: (c) 2015 Leon Mergen +author: Leon Mergen +maintainer: leon@solatis.com +homepage: http://www.leonmergen.com/opensource.html +bug-reports: http://github.com/solatis/haskell-bitcoin-api-extra/issues +stability: experimental +synopsis: Higher level constructs on top of the bitcoin-api package +description: + Where `bitcoin-api` focusses solely on interacting with the Bitcoin Core client, + this library attempts to provide higher level constructs on top of that API. + + It provides a collection of algorithms and useful interfaces for communicating + with Bitcoin. + +build-type: Simple +data-files: LICENSE, README.md +cabal-version: >= 1.10 +tested-with: GHC == 7.6, GHC == 7.8, GHC == 7.10 + +library + hs-source-dirs: src + ghc-options: -Wall -ferror-spans + default-language: Haskell2010 + + exposed-modules: Control.Bitcoin.Api.Transaction + + build-depends: base >= 4.3 && < 5 + , text + , bytestring + , binary + + , conduit + , transformers + , stm + , stm-chans + , stm-conduit + + , bitcoin-block + , bitcoin-tx + , bitcoin-api + +test-suite test-suite + type: exitcode-stdio-1.0 + ghc-options: -Wall -ferror-spans -threaded -auto-all -caf-all -fno-warn-type-defaults + default-language: Haskell2010 + hs-source-dirs: test + main-is: Main.hs + + other-modules: Control.Bitcoin.Api.TestUtil + Control.Bitcoin.Api.TransactionSpec + Spec + Main + + build-depends: base >= 4.3 && < 5 + , bytestring + , text + + , http-client + , wreq + , lens + , conduit + + , hspec + + , bitcoin-api + , bitcoin-tx + , bitcoin-api-extra + +source-repository head + type: git + location: git://github.com/solatis/haskell-bitcoin-api-extra.git + branch: master diff --git a/src/Control/Bitcoin/Api/Transaction.hs b/src/Control/Bitcoin/Api/Transaction.hs new file mode 100644 --- /dev/null +++ b/src/Control/Bitcoin/Api/Transaction.hs @@ -0,0 +1,86 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | This module provides functionality to manipulate raw transaction. It +-- automatically interprets transactions using the `bitcoin-tx` package, so +-- you can work with actual 'Btc.Transaction' objects rather than their +-- serialized format. + +module Control.Bitcoin.Api.Transaction where + +import Data.Maybe (fromMaybe) + +import qualified Data.Conduit as C (Source) + +import Control.Concurrent (forkIO, + killThread, + myThreadId, + threadDelay) +import Control.Concurrent.STM.TBMQueue (isClosedTBMQueue, + newTBMQueue, + writeTBMQueue) +import Control.Monad (unless) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.STM (atomically) +import Data.Conduit.TQueue (sourceTBMQueue) + +import qualified Data.Bitcoin.Transaction as Btc +import qualified Data.Bitcoin.Block as Btc + +import qualified Network.Bitcoin.Api.Blockchain as Blockchain +import qualified Network.Bitcoin.Api.Types as T + +import Network.Bitcoin.Api.Types.UnspentTransaction hiding (confirmations) + +-- | Watches incoming transactions and yields new transactions as soon as they +-- are are inside a block. This is modelled as a Conduit 'C.Source', which means +-- that you can easily apply your own mutators, filters, etcetera. +-- +-- Keep in mind that calling this function launches a background thread which +-- pools the Bitcoin daemon, and stops as soon as the Conduit Sink is closed. +watch :: T.Client -- ^ Our client session context + -> Maybe Integer -- ^ Minimum amount of confirmations. Should be 1 or higher. A default value of 6 is used. + -> C.Source IO Btc.Transaction -- ^ Conduit that generates transactions +watch client Nothing = watch client (Just 6) +watch client (Just confirmations) = do + chan <- liftIO $ atomically $ newTBMQueue 16 + curHeight <- liftIO blockHeight + _ <- liftIO $ forkIO $ watchNext chan curHeight + + sourceTBMQueue chan + + where + + -- | Calculates the height of the block we currently are looking for + blockHeight = do + limit <- Blockchain.getBlockCount client + return (limit - confirmations) + + -- | Watches the current height of the block chain, and continues only + -- when the height changes. + watchNext chan height = do + cur <- blockHeight + + if cur > height + then go chan (height + 1) + else threadDelay 1000000 >> watchNext chan height + + -- | Fills the chan with all transactions from the block at `height`, + -- and then continues waiting until a next block is available. + go chan height = do + block <- Blockchain.getBlock client =<< Blockchain.getBlockHash client height + tid <- myThreadId + + + result <- mapM (insert chan) (Btc.blockTxns block) + let isClosed = False `elem` result + + if isClosed + then killThread tid + else watchNext chan height + + -- | Inserts a transaction into the queue. Blocks if the queue is full. + -- Returns True if write succeeded, False is the queue was closed. + insert chan tx = atomically $ do + isClosed <- isClosedTBMQueue chan + unless isClosed (writeTBMQueue chan tx) + return isClosed diff --git a/test/Control/Bitcoin/Api/TestUtil.hs b/test/Control/Bitcoin/Api/TestUtil.hs new file mode 100644 --- /dev/null +++ b/test/Control/Bitcoin/Api/TestUtil.hs @@ -0,0 +1,8 @@ +module Control.Bitcoin.Api.TestUtil (testClient) where + +import qualified Data.Text as T (pack) + +import Network.Bitcoin.Api.Client + +testClient :: (Client -> IO a) -> IO a +testClient = withClient "127.0.0.1" 18332 (T.pack "user") (T.pack "pass") diff --git a/test/Control/Bitcoin/Api/TransactionSpec.hs b/test/Control/Bitcoin/Api/TransactionSpec.hs new file mode 100644 --- /dev/null +++ b/test/Control/Bitcoin/Api/TransactionSpec.hs @@ -0,0 +1,53 @@ +module Control.Bitcoin.Api.TransactionSpec where + +import Control.Concurrent (forkIO) +import Control.Concurrent.MVar (newEmptyMVar, + putMVar, + takeMVar) +import Control.Lens ((^.)) +import Data.Conduit +import qualified Data.Conduit.List as CL + +import qualified Network.Bitcoin.Api.Mining as Mining +import qualified Network.Bitcoin.Api.Transaction as Transaction +import Network.Bitcoin.Api.Types.UnspentTransaction (amount) +import qualified Network.Bitcoin.Api.Wallet as Wallet + +import Control.Bitcoin.Api.TestUtil (testClient) +import Test.Hspec + +spec :: Spec +spec = do + describe "when testing transaction functions" $ do + it "can watch for new transactions" $ do + testClient $ \client -> do + + result <- newEmptyMVar + + -- This forks a thread, consumes a single transaction from the conduit, + -- and puts it in the MVar. + _ <- forkIO $ do + list <- runConduit $ Transaction.watch client (Just 1) $= CL.take 1 + putMVar result list + + -- Now, let's generate a transaction and some blocks to put the + -- the transaction in. + utxs <- Wallet.listUnspent client + + (length utxs) `shouldSatisfy` (>= 1) + + -- Calculate the total BTC of all unspent transactions + let btc = foldr (+) 0 $ map (^. amount) utxs + + addr <- Wallet.newAddress client + tx <- Transaction.create client utxs [(addr, (btc - 0.0001))] + (tx', completed) <- Transaction.sign client tx (Just utxs) Nothing + + completed `shouldBe` True + + _ <- Transaction.send client tx' + _ <- Mining.generate client 10 + + val <- takeMVar result + + length (val) `shouldBe` 1 diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,8 @@ +module Main where + +import Test.Hspec.Runner +import qualified Spec + +main :: IO () +main = + hspecWith defaultConfig Spec.spec diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}