diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,32 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.html) +## 0.52.5 +### Added +- Support for Blockchain.info export-history endpoint. + +### Fixed +- Use strict bytestring decoder for HTTP API client. + +## 0.52.4 +### Fixed +- Use Base58 addresses by default in Blockchain.info balance querios. + +## 0.52.3 +### Fixed +- Errors should also contain CORS headers. + +## 0.52.2 +### Fixed +- Blockchain.info raw address limit should use `limit` parametre and not `n`. + +## 0.52.1 +### Changed +- Stream multiple transactions when requested. + +### Fixed +- Fix missing unspent outputs. + ## 0.52.0 ### Changed - Remove unnecessary performance optimisations. diff --git a/haskoin-store-data.cabal b/haskoin-store-data.cabal --- a/haskoin-store-data.cabal +++ b/haskoin-store-data.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 710e372481353f316363a2d8c3a13be49c3531b328b4d4f6237ad9208a7a3535 +-- hash: 76582ece19c7f731811889eb943a5a281e48f5339b4ea24910f122b90326ba8c name: haskoin-store-data -version: 0.52.0 +version: 0.52.5 synopsis: Data for Haskoin Store description: Please see the README on GitHub at category: Bitcoin, Finance, Network @@ -55,6 +55,7 @@ , scotty >=0.11.5 , string-conversions >=0.4.0.1 , text >=1.2.3.0 + , time >=1.9.3 , unordered-containers >=0.2.10 , wreq >=0.5.3.2 default-language: Haskell2010 @@ -92,6 +93,7 @@ , scotty >=0.11.5 , string-conversions >=0.4.0.1 , text >=1.2.3.0 + , time >=1.9.3 , unordered-containers >=0.2.10 , wreq >=0.5.3.2 default-language: Haskell2010 diff --git a/src/Haskoin/Store/Data.hs b/src/Haskoin/Store/Data.hs --- a/src/Haskoin/Store/Data.hs +++ b/src/Haskoin/Store/Data.hs @@ -146,6 +146,10 @@ , BinfoBlockInfo(..) , BinfoSymbol(..) , BinfoTicker(..) + , BinfoRate(..) + , BinfoHistory(..) + , toBinfoHistory + , BinfoDate(..) ) where @@ -196,6 +200,10 @@ import qualified Data.Text.Encoding as TE import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TLE +import Data.Time.Clock.POSIX (posixSecondsToUTCTime, + utcTimeToPOSIXSeconds) +import Data.Time.Format (defaultTimeLocale, formatTime, + parseTimeM) import Data.Word (Word32, Word64, Word8) import GHC.Generics (Generic) import Haskoin @@ -288,9 +296,9 @@ data BlockRef = BlockRef { blockRefHeight :: !BlockHeight - -- ^ block height in the chain + -- ^ block height in the chain , blockRefPos :: !Word32 - -- ^ position of transaction within the block + -- ^ position of transaction within the block } | MemRef { memRefTime :: !UnixTime @@ -2176,10 +2184,9 @@ parseParam t = hex <> igr where - hex = - case hexToBlockHash (TL.toStrict t) of - Nothing -> Left "could not decode txid" - Just h -> Right $ BinfoBlockHash h + hex = case hexToBlockHash (TL.toStrict t) of + Nothing -> Left "could not decode txid" + Just h -> Right $ BinfoBlockHash h igr = BinfoBlockIndex <$> parseParam t data BinfoTxId @@ -3028,6 +3035,113 @@ getBinfoBlockInfoTime <- o .: "time" getBinfoBlockInfoIndex <- o .: "block_index" return BinfoBlockInfo {..} + +data BinfoRate + = BinfoRate + { binfoRateTime :: !Word64 + , binfoRatePrice :: !Double + , binfoRateVol24 :: !Double + } + deriving (Eq, Show, Generic, NFData) + +instance ToJSON BinfoRate where + toJSON BinfoRate{..} = + A.object + [ "timestamp" .= binfoRateTime + , "price" .= binfoRatePrice + , "volume24h" .= binfoRateVol24 + ] + +instance FromJSON BinfoRate where + parseJSON = A.withObject "price" $ \o -> do + binfoRateTime <- o .: "timestamp" + binfoRatePrice <- o .: "price" + binfoRateVol24 <- o .: "volume24h" + return BinfoRate{..} + +data BinfoHistory + = BinfoHistory + { binfoHistoryDate :: !Text + , binfoHistoryTime :: !Text + , binfoHistoryType :: !Text + , binfoHistoryAmount :: !Double + , binfoHistoryValueThen :: !Double + , binfoHistoryValueNow :: !Double + , binfoHistoryExchangeRateThen :: !Double + , binfoHistoryTx :: !TxHash + } + deriving (Eq, Show, Generic, NFData) + +instance ToJSON BinfoHistory where + toJSON BinfoHistory{..} = + A.object + [ "date" .= binfoHistoryDate + , "time" .= binfoHistoryTime + , "type" .= binfoHistoryType + , "amount" .= binfoHistoryAmount + , "value_then" .= binfoHistoryValueThen + , "value_now" .= binfoHistoryValueNow + , "exchange_rate_then" .= binfoHistoryExchangeRateThen + , "tx" .= binfoHistoryTx + ] + +instance FromJSON BinfoHistory where + parseJSON = A.withObject "history" $ \o -> do + binfoHistoryDate <- o .: "date" + binfoHistoryTime <- o .: "time" + binfoHistoryType <- o .: "type" + binfoHistoryAmount <- o .: "amount" + binfoHistoryValueThen <- o .: "value_then" + binfoHistoryValueNow <- o .: "value_now" + binfoHistoryExchangeRateThen <- o .: "exchange_rate_then" + binfoHistoryTx <- o .: "tx" + return BinfoHistory{..} + + +toBinfoHistory :: Int64 + -> Word64 + -> Double + -> Double + -> TxHash + -> BinfoHistory +toBinfoHistory satoshi timestamp rate_then rate_now txhash = + BinfoHistory + { binfoHistoryDate = + T.pack $ formatTime defaultTimeLocale "%Y-%m-%d" t + , binfoHistoryTime = + T.pack $ formatTime defaultTimeLocale "%H:%M:%S GMT %Ez" t + , binfoHistoryType = + if satoshi <= 0 then "sent" else "received" + , binfoHistoryAmount = + fromIntegral satoshi / (100 * 1000 * 1000) + , binfoHistoryValueThen = + v1 + , binfoHistoryValueNow = + v2 + , binfoHistoryExchangeRateThen = + rate_then + , binfoHistoryTx = + txhash + } + where + t = posixSecondsToUTCTime (realToFrac timestamp) + v = toInteger satoshi + r = round (rate_then * 100) + n = round (rate_now * 100) + v1 = fromIntegral (v * r) / (100 * 100 * 1000 * 1000) + v2 = fromIntegral (v * n) / (100 * 100 * 1000 * 1000) + +newtype BinfoDate = BinfoDate Word64 + deriving (Eq, Show, Read, Generic, NFData) + +instance Parsable BinfoDate where + parseParam t = + maybeToEither "Cannot parse date" + . fmap (BinfoDate . round . utcTimeToPOSIXSeconds) + $ p "%d-%m-%Y" <|> p "%d/%m/%Y" + where + s = TL.unpack t + p fmt = parseTimeM False defaultTimeLocale fmt s data BinfoTicker = BinfoTicker diff --git a/src/Haskoin/Store/WebClient.hs b/src/Haskoin/Store/WebClient.hs --- a/src/Haskoin/Store/WebClient.hs +++ b/src/Haskoin/Store/WebClient.hs @@ -67,6 +67,7 @@ import Control.Lens ((.~), (?~), (^.)) import Control.Monad.Except import qualified Data.Aeson as A +import qualified Data.ByteString.Lazy as BL import Data.Bytes.Get import Data.Bytes.Put import Data.Bytes.Serial @@ -212,7 +213,7 @@ resE <- try $ HTTP.getWith (binaryOpts opts) url return $ do res <- resE - toExcept $ runGetL deserialize $ res ^. HTTP.responseBody + toExcept $ runGetS deserialize $ BL.toStrict $ res ^. HTTP.responseBody postBinary :: (Serial a, Serial r) diff --git a/test/Haskoin/Store/DataSpec.hs b/test/Haskoin/Store/DataSpec.hs --- a/test/Haskoin/Store/DataSpec.hs +++ b/test/Haskoin/Store/DataSpec.hs @@ -68,9 +68,11 @@ , JsonBox (arbitrary :: Gen BinfoBlockInfo) , JsonBox (arbitrary :: Gen BinfoInfo) , JsonBox (arbitrary :: Gen BinfoSpender) + , JsonBox (arbitrary :: Gen BinfoRate) , JsonBox (arbitrary :: Gen BinfoTicker) , JsonBox (arbitrary :: Gen BinfoTxId) , JsonBox (arbitrary :: Gen BinfoShortBal) + , JsonBox (arbitrary :: Gen BinfoHistory) ] netVals :: [NetBox] @@ -551,6 +553,9 @@ getBinfoSymbolLocal <- arbitrary return BinfoSymbol {..} +instance Arbitrary BinfoRate where + arbitrary = BinfoRate <$> arbitrary <*> arbitrary <*> arbitrary + instance Arbitrary BinfoTicker where arbitrary = do binfoTicker15m <- arbitrary @@ -559,6 +564,18 @@ binfoTickerLast <- arbitrary binfoTickerSymbol <- cs <$> listOf1 arbitraryUnicodeChar return BinfoTicker{..} + +instance Arbitrary BinfoHistory where + arbitrary = do + binfoHistoryDate <- cs <$> listOf1 arbitraryUnicodeChar + binfoHistoryTime <- cs <$> listOf1 arbitraryUnicodeChar + binfoHistoryType <- cs <$> listOf1 arbitraryUnicodeChar + binfoHistoryAmount <- arbitrary + binfoHistoryValueThen <- arbitrary + binfoHistoryValueNow <- arbitrary + binfoHistoryExchangeRateThen <- arbitrary + binfoHistoryTx <- arbitraryTxHash + return BinfoHistory{..} instance Arbitrary BinfoUnspent where arbitrary = do