module Network.Haskoin.Stratum
(
Balance(..)
, Coin(..)
, TxHeight(..)
, StratumNotif(..)
, StratumQuery(..)
, StratumResponse(..)
, MessageStratum
, NotifStratum
, RequestStratum
, ResponseStratum
, ResultStratum
, StratumSession
, toRequest
, parseResult
, parseNotif
, newStratumReq
, Session
, initSession
, newReq
, newNotif
, reqSource
, resConduit
, Method
, ErrorValue
, RequestValue
, ResponseValue
, MessageValue
, ResultValue
, Id(..)
, Result
, Error(..)
, Request(..)
, Response(..)
, Message(..)
, errParse
, errReq
, errMeth
, errParams
, errInternal
, errStr
, leftStr
, numericId
) where
import Control.Monad (mzero)
import Control.Monad.Trans (MonadIO)
import Data.Aeson
( FromJSON
, ToJSON
, Value (Array, Object, String)
, (.:), (.=)
, object
, parseJSON
, toJSON
, withText
)
import Data.Aeson.Types (Parser)
import Data.Maybe (fromJust)
import Data.Text (Text, pack, unpack)
import qualified Data.Vector as V
import Data.Word (Word, Word64)
import Network.Haskoin.Crypto
import Network.Haskoin.Protocol hiding (Message)
import Network.Haskoin.Stratum.Message
import Network.Haskoin.Stratum.Conduit
import Network.Haskoin.Util
type RequestStratum = Request StratumQuery
type NotifStratum = Request StratumNotif
type ResponseStratum = Response StratumResponse Value String
type ResultStratum = Result StratumResponse Value String
type MessageStratum = Message StratumNotif StratumResponse Value String
type StratumSession
= Session RequestStratum StratumResponse Value String StratumNotif
data TxHeight = TxHeight
{ txHeightBlock :: Word
, txHeightId :: Hash256
} deriving (Show, Eq)
data Coin = Coin
{ coinOutPoint :: OutPoint
, coinTxHeight :: TxHeight
, coinValue :: Word64
} deriving (Show, Eq)
data Balance = Balance
{ balConfirmed :: Word64
, balUnconfirmed :: Word64
} deriving (Show, Eq)
data StratumQuery
= QueryVersion { queryClientVer :: Text, queryProtoVer :: Text }
| QueryHistory { queryAddr :: Address }
| QueryBalance { queryAddr :: Address }
| QueryUnspent { queryAddr :: Address }
| QueryTx { queryTxid :: Hash256 }
| QueryBroadcast { queryTx :: Tx }
| SubAddress { queryAddr :: Address }
deriving (Eq, Show)
data StratumResponse
= ServerVersion { stratumServerVer :: String }
| AddressHistory { stratumAddrHist :: [TxHeight] }
| AddressBalance { stratumBalance :: Balance }
| AddressUnspent { stratumCoins :: [Coin] }
| Transaction { stratumTx :: Tx }
| BroadcastId { stratumTxid :: Hash256 }
| AddrStatus { stratumAddrStatus :: Hash256 }
deriving (Eq, Show)
data StratumNotif
= NotifAddress { notifAddr :: Address, notifAddrStatus :: Hash256 }
deriving (Eq, Show)
instance ToJSON StratumNotif where
toJSON (NotifAddress a t) = toJSON (a, hashToJSON t)
instance ToJSON StratumQuery where
toJSON (QueryVersion c p) = toJSON (c, p)
toJSON (QueryHistory a) = toJSON [a]
toJSON (QueryUnspent a) = toJSON [a]
toJSON (QueryBalance a) = toJSON [a]
toJSON (QueryTx i) = toJSON [txidToJSON i]
toJSON (QueryBroadcast t) = txToJSON t
toJSON (SubAddress a) = toJSON [a]
instance FromJSON Balance where
parseJSON (Object o) = do
c <- o .: "confirmed"
u <- o .: "unconfirmed"
return $ Balance c u
parseJSON _ = mzero
instance FromJSON TxHeight where
parseJSON (Object v) = do
h <- v .: "height"
t <- v .: "tx_hash"
i <- txidParse t
return $ TxHeight h i
parseJSON _ = mzero
instance ToJSON TxHeight where
toJSON x = object
[ "height" .= txHeightBlock x
, "tx_hash" .= txidToJSON (txHeightId x)
]
instance FromJSON Coin where
parseJSON (Object o) = do
h <- o .: "height"
v <- o .: "value"
t <- o .: "tx_hash"
p <- o .: "tx_pos"
i <- txidParse t
let op = OutPoint i p
th = TxHeight h i
return $ Coin op th v
parseJSON _ = mzero
instance ToJSON Coin where
toJSON x = object
[ "height" .= txHeightBlock (coinTxHeight x)
, "value" .= coinValue x
, "tx_hash" .= txidToJSON (txHeightId $ coinTxHeight x)
, "tx_pos" .= outPointIndex (coinOutPoint x)
]
method :: StratumQuery -> Text
method (QueryVersion _ _) = "server.version"
method (QueryHistory _) = "blockchain.address.get_history"
method (QueryBalance _) = "blockchain.address.get_balance"
method (QueryUnspent _) = "blockchain.address.get_unspent"
method (QueryTx _) = "blockchain.transaction.get"
method (QueryBroadcast _) = "blockchain.transaction.broadcast"
method (SubAddress _) = "blockchain.address.subscribe"
toRequest :: StratumQuery
-> Int
-> RequestStratum
toRequest s i = Request (method s) (Just s) (Just (IntId i))
parseResult :: StratumQuery
-> ResultValue
-> Parser ResultStratum
parseResult q (Right v) = parseHelper q v >>= return . Right
parseResult _ (Left e) = return $ Left e
parseHelper :: StratumQuery -> Value -> Parser StratumResponse
parseHelper (QueryVersion _ _) v = parseJSON v >>= return . ServerVersion
parseHelper (QueryHistory _) v = parseJSON v >>= return . AddressHistory
parseHelper (QueryBalance _) v = parseJSON v >>= return . AddressBalance
parseHelper (QueryUnspent _) v = parseJSON v >>= return . AddressUnspent
parseHelper (QueryTx _) v = txParse v >>= return . Transaction
parseHelper (QueryBroadcast _) v = txidParse v >>= return . BroadcastId
parseHelper (SubAddress _) v = hashParse v >>= return . AddrStatus
parseNotifHelper :: Method
-> Value
-> Parser StratumNotif
parseNotifHelper "blockchain.address.subscribe" (Array v) = do
a <- parseJSON (V.head v)
s <- hashParse (V.head $ V.tail v)
return $ NotifAddress a s
parseNotifHelper _ _ = mzero
parseNotif :: RequestValue
-> Parser NotifStratum
parseNotif (Request m (Just p) i) =
parseNotifHelper m p >>= \s -> return $ Request m (Just s) i
parseNotif _ = mzero
newStratumReq :: MonadIO m
=> StratumSession
-> StratumQuery
-> m Int
newStratumReq s q = newReq s (toRequest q) p
where
p (Response r i) = do
x <- parseResult q r
return $ Response x i
txidToJSON :: Hash256 -> Value
txidToJSON = String . pack . encodeTxid
txToJSON :: Tx -> Value
txToJSON = String . pack . bsToHex . encode'
txParse :: Value -> Parser Tx
txParse = withText "bitcoin transaction" $
return . decode' . fromJust . hexToBS . unpack
txidParse :: Value -> Parser Hash256
txidParse = withText "transaction id" $
return . fromJust . decodeTxid . unpack
hashToJSON :: Hash256 -> Value
hashToJSON = String . pack . bsToHex . encode'
hashParse :: Value -> Parser Hash256
hashParse = withText "hash" $ return . decode' . fromJust . hexToBS . unpack