module Network.MtGoxAPI.StreamAuthCommands
( StreamAuthCommandData(..)
, prepareAuthCommand
, getNonce
, parseIDKeyCallResult
, parseFullDepthCallResult
) where
import Data.Aeson
import Data.Digest.Pure.SHA
import Data.Time.Clock.POSIX
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import Network.MtGoxAPI.Credentials
import Network.MtGoxAPI.Types
data StreamAuthCommandData = StreamAuthCommandData
{ sacdCall :: T.Text
, sacdParameters :: [(T.Text, T.Text)]
, sacdSetBTCUSD :: Bool
, sacdNonce :: T.Text
}
deriving (Show)
getNonce :: IO T.Text
getNonce = do
now <- getPOSIXTime
let nonce = round $ now * 1000000 :: Integer
return $ (T.pack . show) nonce
prepareCallPayload :: StreamAuthCommandData -> BL.ByteString
prepareCallPayload (StreamAuthCommandData { sacdCall = call
, sacdParameters = parameters
, sacdSetBTCUSD = setBTCUSD
, sacdNonce = nonce
}) =
let alwaysPresent = [ "id" .= nonce
, "call" .= call
, "nonce" .= nonce
, "params" .= toMap parameters
]
optionalAddon = if setBTCUSD
then [ "item" .= ("BTC" :: T.Text)
, "currency" .= ("EUR" :: T.Text)
]
else []
in encode $ object (alwaysPresent ++ optionalAddon)
where
toMap :: ToJSON b => [(T.Text, b)] -> Value
toMap = object . map (uncurry (.=))
createSignedCall :: MtGoxCredentials -> StreamAuthCommandData -> B.ByteString
createSignedCall creds authCmd =
let authKeyDecoded = BL.fromChunks [mgcAuthKeyDecoded creds]
authSecretDecoded = BL.fromChunks [mgcAuthSecretDecoded creds]
call = prepareCallPayload authCmd
hmac = bytestringDigest $ hmacSha512 authSecretDecoded call
payload = authKeyDecoded `BL.append` hmac `BL.append` call
in B64.encode . foldl1 B.append $ BL.toChunks payload
prepareAuthCommand :: MtGoxCredentials -> StreamAuthCommandData -> Value
prepareAuthCommand creds authCmd =
let signedCall = createSignedCall creds authCmd
in object [ "op" .= ("call" :: T.Text)
, "id" .= sacdNonce authCmd
, "call" .= signedCall
, "context" .= ("mtgox.com" :: T.Text)
]
parseIDKeyCallResult :: StreamMessage -> Maybe IDKey
parseIDKeyCallResult CallResult { crResult = v } =
case fromJSON v of
Success p -> Just p
Error _ -> Nothing
parseIDKeyCallResult _ = Nothing
parseFullDepthCallResult :: StreamMessage -> Maybe FullDepth
parseFullDepthCallResult CallResult { crResult = v } =
case fromJSON v of
Success p -> Just p
Error _ -> Nothing
parseFullDepthCallResult _ = Nothing