diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,1 @@ +Public Domain. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/mybitcoin-sci-pgp-key.asc b/mybitcoin-sci-pgp-key.asc new file mode 100644 --- /dev/null +++ b/mybitcoin-sci-pgp-key.asc @@ -0,0 +1,31 @@ +-----BEGIN PGP PUBLIC KEY BLOCK----- +Version: GnuPG + +mQENBEvfPosBCACwT0PMxOgh3iI5loNxhMUrB2fQpFwMy6m0OQO9U+mVpG8fcWdc +TQyLE0LLgU3q1a3A7qpvvWZ+IPeDfFokPwhXsS5fBwGF9LpWIfPCObIif59/r9A0 +6aJ03AfKS6pvIxkCje4ndjIvNXcDQuzaKZI38WkHHMHcwkOsmFy5EDtguCvu2i3u +c3HTZ2KJOEHqvw7cO8/hfmvSvNX1WTYUN7/3tMFVGiHkxsxK11HBGdVsKsFlBslS +21Y/zzwqWW1HWC7XNI5IVnqjPWbYz0VnPZeYItoPJ/07xIjA1UmsrN2V2z+qdO4F +bEEtYnMevl6Z9aNOVzJkoEkmtJ7rZhv+MZF9ABEBAAG0O015Qml0Y29pbiBMTEMg +KFNDSSBWZXJpZmljYXRpb24gS2V5KSA8bm9ib2R5QG15Yml0Y29pbi5jb20+iQE4 +BBMBAgAiBQJL3z6LAhsDBgsJCAcDAgYVCAIJCgsEFgIDAQIeAQIXgAAKCRCfuYNO +pQJ6hdg1B/9x/WRyTbTIq3oUvJc2QZVWYpLr3SHIhv6yDiLpOgtfIls+wZIrOP/q +7wowkHGO4V5Gz5BcbgPl65/v4/wtV+ZFknZOrTkQxqquY2G+Om4kB19kYhIk9Hyq +cQ0EF5GmiwmDel7tru5UodZfzCfWdo9RnJA2Gr7Hbcc4P9r9vxMwwcyk/oHFT2Ms +sfe7sQq/ZCDtLs1qkpPtOGAEhjmXPiiHRx2LgVoPsRVRWb2Io20zNxjhDRLIO56Q +meLcZ4izq7Ir0EC3AvPljhtpvxjPj7fE8Q8onU3w3l56oxz0hYfY77jFHmuiLkmx +jbrc8jcODegEx9d/xZtTrKsmM3AcRXdwuQENBEvfPosBCADA0x8iYN8UDruVzwfD +uKErS36oINCz+gX60I2mwQ56lKL9TMNjyJpXLgAiu3Ly+rs/v25jb1W8/dzWHJQ3 +R0ajmIUs0WHR3P5du7HnvLcu60zrug/n2dAR1t0LspbiuMI0AEB8pzZF1hEz2Dx2 +F6NWvJkEiTAJplsLAY9dg8E2bM3RQtK5jFn8UanY/ryNqjFqFDb5x+5uytXHV99+ +KjZM04Imr94UP4r+43opljfhifwylDz5peKXjB2YYunggznXBEnWSDeNGUXcS1k/ +aVQyb9ysOo87QZtS+IsUSQ8YQdPlfl2jA0DLMJBjZKXLqcjT1olW3rk6j65QEc1t +Em1/ABEBAAGJAR8EGAECAAkFAkvfPosCGwwACgkQn7mDTqUCeoVZTwf/afFkF1pY +pl30K90ht6QKkmBUDSZX+eu2vmhuEKQaB9z2hE1Z5sDgieLR4rxsyPldDwpA10vx +4+ECIvtxAGJ6CE3VklxrmY6hR9zLrUO73DxQN+jGRPt6P91XtR3pcU9WcxQkN5XT +4jID+ZqWrbEoxJxAQ9TD9niFNN4NWrVirU+eh+xZ7XaAT7iHo465fvGAqhVP94p+ +laHabEXf42cEODN++gM2cd7mrfra3wnkyPughpc2W9oqxf5aUUb7+8N4Hd1loryg +/l2b9eJ3fRpD7IK4QFp1YHNAEyvBLSCUUk6GMYeWuSarwic2ygxY/HPuai3PYKtb +23+Ssqo7Xh7b/Q== +=uUsD +-----END PGP PUBLIC KEY BLOCK----- diff --git a/mybitcoin-sci.cabal b/mybitcoin-sci.cabal new file mode 100644 --- /dev/null +++ b/mybitcoin-sci.cabal @@ -0,0 +1,64 @@ +-- mybitcoin-sci.cabal auto-generated by cabal init. For additional +-- options, see +-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr. +-- The name of the package. +Name: mybitcoin-sci + +-- The package version. See the Haskell package versioning policy +-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for +-- standards guiding when and how versions should be incremented. +Version: 0.1 + +-- A short (one-line) description of the package. +Synopsis: Binding to mybitcoin.com's Shopping Cart Interface. + +-- A longer description of the package. +Description: See and for more information. + +-- The license under which the package is released. +License: PublicDomain + +-- The file containing the license text. +License-file: LICENSE + +-- The package author(s). +Author: Lemmih + +-- An email address to which users can send suggestions, bug reports, +-- and patches. +Maintainer: lemmih@gmail.com + +-- A copyright notice. +-- Copyright: + +Category: Network + +Build-type: Simple + +-- Extra files to be distributed with the package, such as examples or +-- a README. +Extra-source-files: mybitcoin-sci-pgp-key.asc + +-- Constraint on the version of Cabal needed to build this package. +Cabal-version: >=1.6 + + +Library + -- Modules exported by the library. + Exposed-modules: Network.MyBitcoin + + -- Packages needed in order to build this package. + Build-depends: base >= 4 && < 5, curl, cgi, process, mtl, split, directory + + Hs-Source-dirs: src/ + + -- Modules not exported by this package. + Other-modules: Paths_mybitcoin_sci + + -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. + -- Build-tools: + + +source-repository head + type: darcs + location: http://mirror.seize.it/mybitcoin-sci/ diff --git a/src/Network/MyBitcoin.hs b/src/Network/MyBitcoin.hs new file mode 100644 --- /dev/null +++ b/src/Network/MyBitcoin.hs @@ -0,0 +1,144 @@ +-- | Interface to mybitcoin.com's shopping cart interface. +-- +-- After entering your credentials into the config structure, you should be +-- able to use the library like this: +-- +-- Behold my glorious fortune: +-- +-- @ +-- *Network.MyBitcoin> mbcGetBalance myConfig +-- [(\"SCI Version\",\"1.0\"),(\"SCI Code\",\"1\"),(\"SCI Reason\",\"OK\"),(\"SCI Balance\",\"0.49000000000\")] +-- @ +-- +-- Well, how much are 0.49 bitcoins worth? +-- +-- @ +-- *Network.MyBitcoin> fmap (lookup \"SCI Currency USD Rate\") $ mbcGetRates myConfig +-- Just \"17.113100\" +-- @ +-- +-- Can we be sure the responses are authentic? +-- +-- @ +-- *Network.MyBitcoin> mbcPostProcess myConfig \"response\" +-- *** Exception: GPG Signature failure! +-- @ +-- +-- This library is shaped after the PHP interface to mybitcoin.com. It uses libcurl +-- and verifies responses with GPG. To enable verification, you need to add the mybitcoin +-- public key to your GPG keychain. +module Network.MyBitcoin + ( Config(..) + , mbcSpend + , mbcGetBalance + , mbcGetRates + , mbcEncryptFormData + , mbcPostProcess + ) where + +import Network.Curl +import System.Directory +import System.Process +import Text.Printf +import Data.List +import Data.List.Split +import Data.Char +import Data.Version +import Control.Monad ( when, unless ) +import Numeric +import Network.CGI + +import Paths_mybitcoin_sci + +data Config + = Config + { cfgUserName :: String + , cfgAutoKey :: String + , cfgGPGBinary :: FilePath + , cfgEnableGPG :: Bool + } + +myConfig = Config { cfgUserName = "Nuwen" + , cfgAutoKey = "15f67e08ebaf912907f14913f8b91e80" + , cfgGPGBinary = "gpg" + , cfgEnableGPG = True } + +gpgVerify :: Config -> String -> IO () +gpgVerify cfg text + = do mbExec <- findExecutable (cfgGPGBinary cfg) + gpg <- case mbExec of Nothing -> error "Can't verify mybitcoin.com response without GPG." + Just gpg -> return gpg + (code, stdout, stderr) <- readProcessWithExitCode gpg ["--verify"] text + let checkString = "Good signature from \"MyBitcoin LLC (SCI Verification Key) \"" + unless (checkString `isInfixOf` stderr) $ + error "GPG Signature failure!" + +mbcCurl :: Config -> String -> [String] -> IO String +mbcCurl cfg action rawPostData + = withCurlDo $ + do (code, resp) <- curlGetString url [ CurlPost True + , CurlPostFields postData + , CurlSSLVerifyPeer False + , CurlUserAgent userAgent ] + return resp + where hostname = "https://www.mybitcoin.com" + url = printf "%s/sci/%s.php" hostname action + userAgent = printf "MBC SCI Client for Haskell/%s" (showVersion version) + postData = ["username=" ++ cfgUserName cfg + ,"sci_auto_key=" ++ cfgAutoKey cfg] ++ rawPostData + + +-- | Parse and verify (if enabled) a message from mybitcoin.com. This method is used +-- when processing receipts. See 'mbcSpend'. +mbcPostProcess :: Config -> String -> IO [(String,String)] +mbcPostProcess cfg text + = do when (null text) $ error "Curl failure." + when (cfgEnableGPG cfg) $ gpgVerify cfg text + return (mbcParseResponse text) + +mbcParseResponse :: String -> [(String,String)] +mbcParseResponse text + = [ (key, trim (drop 1 val)) | line <- takeWhile (not.null) $ drop 3 (lines text) + , let (key, val) = break (==':') line ] + where trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace + +mbcRequest :: Config -> String -> [String] -> IO [(String,String)] +mbcRequest cfg action postData + = mbcPostProcess cfg =<< mbcCurl cfg action postData + +-- | Returns the key \"SCI Balance\" with your account balance. +mbcGetBalance :: Config -> IO [(String, String)] +mbcGetBalance cfg + = mbcRequest cfg "auto-getbalance" [] + +-- | Lists bitcoin exchange rates for various currencies. Presumably taken from +-- Mt. Gox. +mbcGetRates :: Config -> IO [(String, String)] +mbcGetRates cfg + = mbcRequest cfg "auto-getrates" [] + +-- | This function is used for receiving payments. You receive payments by redirecting +-- customers to the mybitcoin pay page with your bitcoin address in the query arguments. +-- This method lets you do that without revealing your bitcoin address. See the Merchant +-- Tools at mybitcoin.com for more information. +mbcEncryptFormData :: Config -> String -> IO [(String, String)] +mbcEncryptFormData cfg formData + = mbcRequest cfg "auto-encryptformdata" [ "form_data=" ++ urlEncode formData ] + +-- | This method is used for sending bitcoins to other bitcoin addresses. Mybitcoin.com +-- uses a two-step commit procedure where you have to confirm a receipt before the transaction +-- is final. +mbcSpend :: Config + -> String -- ^ Bitcoin address of the receiver. + -> Rational -- ^ Amount of bitcoins to send. + -> String -- ^ Text associated with the payment so you can remember + -- what it was for. The receiver will not see this note. + -> String -- ^ Baggage. MyBitcoin will send this string back to you + -- as part of their two-step commit procedure. + -> IO [(String, String)] +mbcSpend cfg receiver amount note baggage + = mbcRequest cfg "auto-spend" [ "amount=" ++ showFFloat (Just 8) (fromRational amount) "" + , "bitcoin_addr=" ++ receiver + , "note=" ++ urlEncode note + , "baggage=" ++ urlEncode baggage ] +