ripple 0.2 → 0.3
raw patch · 4 files changed
+65/−13 lines, 4 filesdep +time
Dependencies added: time
Files
- Ripple/Amount.hs +5/−5
- Ripple/Transaction.hs +2/−1
- Ripple/WebSockets.hs +56/−6
- ripple.cabal +2/−1
Ripple/Amount.hs view
@@ -18,7 +18,6 @@ import Data.Aeson ((.=), (.:)) import qualified Data.Aeson as Aeson import qualified Data.Aeson.Types as Aeson-import qualified Data.Attoparsec.Number as Aeson data Currency = XRP | Currency (Char,Char,Char) RippleAddress deriving (Eq)@@ -97,12 +96,13 @@ let [a,b,c] = currency return $ Amount amount (Currency (a,b,c) issuer)- parseJSON (Aeson.Number (Aeson.I n)) = pure $ Amount (fromIntegral n) XRP- parseJSON (Aeson.Number (Aeson.D n)) = pure $ Amount (one_drop * realToFrac n) XRP+ parseJSON (Aeson.Number n)+ | floor n == ceiling n = pure $ Amount (realToFrac n / one_drop) XRP+ | otherwise = pure $ Amount (realToFrac n) XRP parseJSON (Aeson.String s) = case T.find (=='.') s of- Nothing -> (Amount . realToFrac) <$>+ Nothing -> (Amount . (/one_drop) . realToFrac) <$> (readZ (T.unpack s) :: Aeson.Parser Integer) <*> pure XRP- Just _ -> (\x -> Amount (realToFrac x * one_drop)) <$>+ Just _ -> (\x -> Amount (realToFrac x)) <$> (readZ (T.unpack s) :: Aeson.Parser Double) <*> pure XRP parseJSON _ = fail "Invalid amount"
Ripple/Transaction.hs view
@@ -399,9 +399,10 @@ result <- fmap (>>= fmap TransactionResult . tRes) (k "TransactionResult") dt <- (fmap.fmap) DestinationTag (k "DestinationTag") invoiceid <- fmap (>>= fmap InvoiceID . hexMay) (k "InvoiceID")+ date <- fmap (>>= fmap SigningTime) (k "date") return $ catMaybes [ txhash, account, amount, destination, fee, flags, sendMax, sequence,- typ, delivered, result, dt, invoiceid+ typ, delivered, result, dt, invoiceid, date ] where k s = o .:? T.pack s
Ripple/WebSockets.hs view
@@ -6,6 +6,7 @@ RippleError(..), RippleResult(..), getRippleResult,+ getRippleResult', -- * ripple_path_find CommandRipplePathFind(..), ResultRipplePathFind(..),@@ -13,6 +14,9 @@ -- * account_tx CommandAccountTX(..), ResultAccountTX(..),+ -- * ledger+ CommandLedger(..),+ ResultLedger(..), -- * ledger_closed CommandLedgerClosed(..), ResultLedgerClosed(..)@@ -25,6 +29,8 @@ import Control.Monad (forM) import Control.Error (note, fmapL, readZ, justZ) import Data.Base58Address (RippleAddress)+import Data.Time.Clock (UTCTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Data.Binary (decodeOrFail) import Control.Monad.IO.Class (MonadIO, liftIO) @@ -55,15 +61,19 @@ deriving (Show, Eq) -- | The result of a WebSocket command -- either error or a response-newtype RippleResult a = RippleResult (Either RippleError a)+data RippleResult id a = RippleResult (Maybe id) (Either RippleError a) deriving (Show, Eq) -getRippleResult :: Either String (RippleResult a) -> Either RippleError a-getRippleResult (Left e) = Left $ ResponseParseError e-getRippleResult (Right (RippleResult x)) = x+getRippleResult' :: Either String (RippleResult id a) -> Either RippleError a+getRippleResult' (Left e) = Left $ ResponseParseError e+getRippleResult' (Right (RippleResult _ x)) = x -instance (Aeson.FromJSON a) => Aeson.FromJSON (RippleResult a) where- parseJSON (Aeson.Object o) = RippleResult <$> do+getRippleResult :: Either String (RippleResult () a) -> Either RippleError a+getRippleResult = getRippleResult'++instance (Aeson.FromJSON a, Aeson.FromJSON id) =>+ Aeson.FromJSON (RippleResult id a) where+ parseJSON (Aeson.Object o) = RippleResult <$> o .:? T.pack "id" <*> do status <- o .: T.pack "status" typ <- o .: T.pack "type" case (status, typ) of@@ -177,6 +187,46 @@ _ -> fail "tx or tx_blob required" parseJSON _ = fail "account_tx result is always a JSON object"++-- ledger++data CommandLedger = CommandLedger {+ ledger_index :: Maybe Integer,+ transactions :: Bool,+ expand :: Bool+ } deriving (Show, Eq)++instance Aeson.ToJSON CommandLedger where+ toJSON (CommandLedger ledger_index transactions expand) = Aeson.object [+ T.pack "command" .= "ledger",+ T.pack "ledger_index" .= fromMaybe (-1) ledger_index,+ T.pack "transactions" .= transactions,+ T.pack "expand" .= expand+ ]++data ResultLedger = ResultLedger {+ result_ledger_closed :: Bool,+ result_ledger_accepted :: Bool,+ result_ledger_index :: Integer,+ result_parent_hash :: LZ.ByteString,+ result_ledger_hash :: LZ.ByteString,+ result_total_coins :: Integer,+ result_close_time :: UTCTime+ } deriving (Show, Eq)++instance Aeson.FromJSON ResultLedger where+ parseJSON (Aeson.Object root) = do+ o <- root .: T.pack "ledger"+ ResultLedger <$>+ (o .: T.pack "closed") <*>+ fmap (fromMaybe False) (o .:? T.pack "accepted") <*>+ (readZ =<< o .: T.pack "ledger_index") <*>+ (fmap LZ.pack . justZ . hex2bytes =<< o .: T.pack "parent_hash") <*>+ (fmap LZ.pack . justZ . hex2bytes =<< o .: T.pack "ledger_hash") <*>+ (readZ =<< o .: T.pack "total_coins") <*>+ fmap (posixSecondsToUTCTime.fromInteger.(+946684800))+ (o .: T.pack "close_time")+ parseJSON _ = fail "ledger result is always a JSON object" -- ledger_closed
ripple.cabal view
@@ -1,5 +1,5 @@ name: ripple-version: 0.2+version: 0.3 cabal-version: >= 1.8 license: OtherLicense license-file: COPYING@@ -34,6 +34,7 @@ bytestring, text, transformers,+ time, largeword >= 1.1.0, binary >= 0.7.0.0, cereal,