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
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
mbcGetBalance :: Config -> IO [(String, String)]
mbcGetBalance cfg
= mbcRequest cfg "auto-getbalance" []
mbcGetRates :: Config -> IO [(String, String)]
mbcGetRates cfg
= mbcRequest cfg "auto-getrates" []
mbcEncryptFormData :: Config -> String -> IO [(String, String)]
mbcEncryptFormData cfg formData
= mbcRequest cfg "auto-encryptformdata" [ "form_data=" ++ urlEncode formData ]
mbcSpend :: Config
-> String
-> Rational
-> String
-> String
-> 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 ]