MyBitcoin.hs

-- | 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) <nobody@mybitcoin.com>\""
         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 ]