cryptocompare (empty) → 0.0.1
raw patch · 7 files changed
+470/−0 lines, 7 filesdep +MissingHdep +aesondep +basesetup-changed
Dependencies added: MissingH, aeson, base, bytestring, containers, cryptocompare, directory, exceptions, http-conduit, text, time, transformers, unordered-containers
Files
- LICENSE +21/−0
- README.md +15/−0
- Setup.hs +2/−0
- app/Main.hs +15/−0
- cryptocompare.cabal +81/−0
- src/CryptoCompare.hs +334/−0
- test/Spec.hs +2/−0
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2017 Avi Press++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,15 @@+# CryptoCompare++[](https://travis-ci.org/aviaviavi/cryptocompare)++A Haskell wrapper to the public [CryptoCompare API](https://www.cryptocompare.com/api/), a +source of information and pricing of different crypto currencies++## State++This library is usable but not complete. It currently covers a subset of the API.+Breaking changes will occur if necessary but will be avoided if possible.++## Contributing++Contributions in any form are always welcome.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,15 @@+module Main (main) where++import CryptoCompare++main :: IO ()+main = do+ coinList <- fetchCoinList+ either print (print . length) coinList+ either print (print . head) coinList+ priceResp <- fetchCurrentPrice "BTC" ["USD", "EUR", "BTC"]+ print priceResp+ priceHistResp <- fetchDailyPriceHistory "BTC" "USD" 300+ print priceHistResp+ snapshotResp <- fetchCoinSnapshot "BTC" "USD"+ print snapshotResp
+ cryptocompare.cabal view
@@ -0,0 +1,81 @@+name: cryptocompare+version: 0.0.1+synopsis: Haskell wrapper for the cryptocompare API+description:+ # CryptoCompare++ [](https://travis-ci.org/aviaviavi/cryptocompare)++ A Haskell wrapper to the public [CryptoCompare API](https://www.cryptocompare.com/api/), a + source of information and pricing of different crypto currencies++ ## State++ This library is usable but not complete. It currently covers a subset of the API.+ Breaking changes will occur if necessary but will be avoided if possible.++ ## Contributing++ Contributions in any form are always welcome.+homepage: https://github.com/aviaviavi/cryptocompare+license: MIT+license-file: LICENSE+author: Avi Press+maintainer: avipress@gmail.com+copyright: 2017 Avi Press+category: Web+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: CryptoCompare+ build-depends: base >= 4.7 && < 5+ default-language: Haskell2010+ build-depends: base >= 4.8 && < 5+ , directory+ , text+ , MissingH+ , time+ , aeson+ , unordered-containers+ , http-conduit+ , bytestring+ , containers+ , transformers+ , exceptions+++executable cryptocompare-exe+ hs-source-dirs: app+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends: base+ , cryptocompare+ default-language: Haskell2010+ build-depends: base >= 4.8 && < 5+ , directory+ , text+ , MissingH+ , time+ , aeson+ , unordered-containers+ , http-conduit+ , bytestring+ , containers+ , transformers+ , exceptions++test-suite cryptocompare-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base+ , cryptocompare+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/githubuser/cryptocompare
+ src/CryptoCompare.hs view
@@ -0,0 +1,334 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}++-- | A haskell wrapper for the cryptocompare API, a source of information and pricing of different crypto currencies+--+-- > module Main (main) where+-- >+-- > import CryptoCompare+-- >+-- > main :: IO ()+-- > main = do+-- > coinList <- fetchCoinList+-- > either print (print . length) coinList+-- > either print (print . head) coinList+-- > priceResp <- fetchCurrentPrice "BTC" ["USD", "EUR", "BTC"]+-- > print priceResp+-- > priceHistResp <- fetchDailyPriceHistory "BTC" "USD" 300+-- > print priceHistResp+-- > snapshotResp <- fetchCoinSnapshot "BTC" "USD"+-- > print snapshotResp+--+module CryptoCompare+ ( fetchCoinList+ , fetchCurrentPrice+ , fetchDailyPriceHistory+ , fetchCoinSnapshot+ , CoinDetails(..)+ , PriceHistoryResponse(..)+ , PriceHistoryResponseData(..)+ , CoinSnapshot(..)+ , AggregatedSnapshot(..)+ , PriceResponse(..)+ ) where++import Control.Monad.Catch+import Control.Monad.IO.Class+import Data.Aeson+import Data.Aeson.Types+import Data.HashMap.Strict+import Data.List+import Data.Map (Map)+import Data.Maybe+import Data.Time.Clock+import GHC.Generics+import Network.HTTP.Simple+import Text.Printf++-- | Typeclass for datatypes from which url query parameters can be generated+class ToQueryString a where+ toQueryString :: a -> String++-- | List of all known coins, and some basic info for them+data CoinListResponse = CoinListResponse {+ response :: String,+ message :: String,+ responseType :: Integer,+ coins :: [CoinDetails]+} deriving (Show, Generic)++-- | High level information about each coin.+data CoinDetails = CoinDetails {+ _key :: String,+ id :: String,+ url :: String,+ imageUrl :: Maybe String,+ name :: String,+ coinName :: String,+ fullName :: String,+ algorithm :: String,+ proofType :: String,+ sortOrder :: String+} deriving (Show, Generic)++-- | Request the current price of a particular cryptocurrency+data PriceRequest = PriceRequest {+ fromSym :: String,+ toSyms :: [String]+}++instance ToQueryString PriceRequest where+ toQueryString req =+ printf+ "?fsym=%s&tsyms=%s"+ (fromSym (req :: PriceRequest))+ (intercalate "," $ toSyms (req :: PriceRequest))++-- TODO - get rid of repeated code++-- | Request a more detailed view of a coin's information+data CoinSnapshotRequest = CoinSnapshotRequest {+ snapshotFromSym :: String,+ snapshotToSym :: String+}++instance ToQueryString CoinSnapshotRequest where+ toQueryString req =+ printf+ "?fsym=%s&tsym=%s"+ (snapshotFromSym req)+ (snapshotToSym req)++-- | Response containing more detailed meta information about a coin, as well as+-- aggregated pricing information+data CoinSnapshotResponse = CoinSnapshotResponse+ { snapshotResponseMessage :: String+ , snapshotResponseType :: Integer+ , snapshot :: CoinSnapshot+ } deriving (Show)++instance FromJSON CoinSnapshotResponse where+ parseJSON (Object x) =+ CoinSnapshotResponse <$> x .: "Message" <*> x .: "Type" <*>+ x .: "Data"+ parseJSON _ = error "expected an object"++-- | High level data about a particular coin+data CoinSnapshot = CoinSnapshot+ { snapshotAlgorithm :: String+ , snapshotProofType :: String+ , blockNumber :: Integer+ , netHashesPerSecond :: Float+ , totalCoinsMined :: Float+ , blockReward :: Float+ , aggregatedSnapshotData :: AggregatedSnapshot+ } deriving (Show)++instance FromJSON CoinSnapshot where+ parseJSON (Object x) =+ CoinSnapshot <$> x .: "Algorithm" <*> x .: "ProofType" <*>+ x .: "BlockNumber" <*>+ x .: "NetHashesPerSecond" <*>+ x .: "TotalCoinsMined" <*>+ x .: "BlockReward" <*>+ x .: "AggregatedData"+ parseJSON _ = error "expected an object"++-- | Aggregated data about a particular coin+data AggregatedSnapshot = AggregatedSnapshot+ { market :: String+ , fromSymbol :: String+ , toSymbol :: String+ , flags :: String+ , price :: Float+ , lastUpdate :: Integer+ , lastVolume :: Float+ , lastVolumeto :: Float+ , lastTradeId :: String+ , volume24Hour :: Float+ , volume24HourTo :: Float+ , open24Hour :: Float+ , high24Hour :: Float+ , low24Hour :: Float+ , lastMarket :: String+ } deriving (Show)+instance FromJSON AggregatedSnapshot where+ parseJSON (Object x) =+ AggregatedSnapshot <$> x .: "MARKET" <*> x .: "FROMSYMBOL" <*>+ x .: "TOSYMBOL" <*>+ x .: "FLAGS" <*>+ (read <$> x .: "PRICE") <*>+ (read <$> x .: "LASTUPDATE") <*>+ (read <$> x .: "LASTVOLUME") <*>+ (read <$> x .: "LASTVOLUMETO") <*>+ x .: "LASTTRADEID" <*>+ (read <$> x .: "VOLUME24HOUR") <*>+ (read <$> x .: "VOLUME24HOURTO") <*>+ (read <$> x .: "OPEN24HOUR") <*>+ (read <$> x .: "HIGH24HOUR") <*>+ (read <$> x .: "LOW24HOUR") <*>+ x .: "LASTMARKET"+ parseJSON _ = error "expected an object"++-- | contains pairs of prices: crypto symbol -> (regular currency symbol, price)+newtype PriceResponse =+ PriceResponse (Map String Float)+ deriving (Show, Generic)+instance FromJSON PriceResponse++-- | Get the price history of a coin (daily)+data PriceHistoryRequest = PriceHistoryRequest {+ -- | coin symbol+ historyFromSym :: String,+ -- | display in currency+ historyToSym :: String,+ -- | most recent timestamp in returned result+ toTimestamp :: Maybe UTCTime,+ -- | days to go back+ limit :: Maybe Integer+}+priceHistReqDefault :: PriceHistoryRequest+priceHistReqDefault = PriceHistoryRequest "" [] Nothing Nothing++-- | API response container for daily price history+data PriceHistoryResponse = PriceHistoryResponse {+ responseData :: [PriceHistoryResponseData], -- ^ the actual response, list of price entries+ timeTo :: Maybe Integer, -- ^ latest price returned+ timeFrom :: Maybe Integer -- ^ earliest price returned+} deriving (Show, Generic)++instance FromJSON PriceHistoryResponse where+ parseJSON (Object x) =+ PriceHistoryResponse <$> x .: "Data" <*> x .:? "TimeTo" <*> x .:? "TimeFrom"+ parseJSON _ = error "expected an object"++-- | Data for a particular snapshot of a coin's daily price+data PriceHistoryResponseData = PriceHistoryResponseData {+ time :: Float,+ open :: Float,+ high :: Float,+ low :: Float,+ close :: Float,+ volumefrom :: Float,+ volumeto :: Float+} deriving (Show, Generic)++instance FromJSON PriceHistoryResponseData++instance ToQueryString PriceHistoryRequest where+ toQueryString req =+ printf+ "?fsym=%s&tsym=%s&limit=%s"+ (historyFromSym req)+ (historyToSym req)+ (fromMaybe "" (show <$> limit req))++instance FromJSON CoinListResponse where+ parseJSON (Object x) =+ CoinListResponse <$> x .: "Response" <*> x .: "Message" <*> x .: "Type" <*>+ x .: "Data"+ parseJSON _ = error "expected an object"++-- Aeson claims this definition overlaps with the internal+-- instance of FromJSON [a], so the overlap pragma seems to fix that+-- TODO - this seems wrong, there's probably a cleaner way to write+-- that doesn't involve extension pragmas+instance {-# OVERLAPS #-} FromJSON [CoinDetails] where+ parseJSON x =+ parseJSON x >>= mapM parseCointListResponseData . toList++-- Since this entry uses keys that we don't know ahead of time, we+-- need to do some special parsing that doesn't require it.+parseCointListResponseData :: (String, Value) -> Parser CoinDetails+parseCointListResponseData (i, v) =+ withObject+ "entry body"+ (\o ->+ CoinDetails i <$> o .: "Id" <*> o .: "Url" <*> o .:? "ImageUrl" <*>+ o .: "Name" <*>+ o .: "CoinName" <*>+ o .: "FullName" <*>+ o .: "Algorithm" <*>+ o .: "ProofType" <*>+ o .: "SortOrder")+ v++-- | Get a list of all of the coins the API is aware of, and high level details+-- about those coins+--+-- @+-- do+-- coinList <- fetchCoinList+-- either print (print . length) coinList+-- either print (print . head) coinList+-- @+--+fetchCoinList :: (MonadIO m, MonadCatch m) => m (Either String [CoinDetails])+fetchCoinList = catchIOError (do+ r <- httpJSON "https://www.cryptocompare.com/api/data/coinlist/"+ return . Right . coins $ getResponseBody r)+ (return . Left . show)++-- | For a given coin, get a daily history of the coin's price+--+-- > do+-- > priceHistResp <- fetchDailyPriceHistory "BTC" "USD" 300+-- > print priceHistResp+--+fetchDailyPriceHistory ::+ (MonadIO m, MonadThrow m, MonadCatch m)+ => String -- ^ Coin symbol (`BTC`, `ETH`, etc)+ -> String -- ^ Currency symbol to display prices in (`USD`, `EUR`, etc)+ -> Integer -- ^ Days of history to return (Max 2000)+ -> m (Either String PriceHistoryResponse) -- ^ Either an error or response data+fetchDailyPriceHistory coinSymbol priceCurrency days = catchIOError (do+ priceHistReq <-+ return . parseRequest $+ "https://min-api.cryptocompare.com/data/histoday" +++ toQueryString+ (priceHistReqDefault+ {historyFromSym = coinSymbol, historyToSym = priceCurrency, limit = Just days} :: PriceHistoryRequest)+ r <- httpJSON <$> priceHistReq+ Right . getResponseBody <$> r)+ (return . Left . show)++-- | For a given coin, get the current price+--+--+-- > do+-- > priceResp <- fetchCurrentPrice "BTC" ["USD", "EUR", "BTC"]+-- > print priceResp+--+fetchCurrentPrice ::+ (MonadIO m, MonadThrow m, MonadCatch m)+ => String -- ^ Coin symbol (`BTC`, `ETH`, etc)+ -> [String] -- ^ Currency symbol(s) to display prices in. Eg [`USD`, `EUR`, ...]+ -> m (Either String PriceResponse) -- ^ Either an error or response data+fetchCurrentPrice coinSymbol priceSymbols = catchIOError (do+ priceReq <-+ return . parseRequest $+ "https://min-api.cryptocompare.com/data/price" +++ toQueryString (PriceRequest coinSymbol priceSymbols)+ r <- httpJSON <$> priceReq+ Right . getResponseBody <$> r)+ (return . Left . show)++-- | Fetch details about a particular coin+--+-- > do+-- > snapshotResp <- fetchCoinSnapshot "BTC" "USD"+-- > print snapshotResp+--+fetchCoinSnapshot :: (MonadIO m, MonadThrow m, MonadCatch m)+ => String -- ^ Coin symbol (`BTC`, `ETH`, etc)+ -> String -- ^ Currency symbol(s) to display prices in (`USD`, `EUR`, etc)+ -> m (Either String CoinSnapshot) -- ^ Either an error or response data+fetchCoinSnapshot fSym tSym = catchIOError (do+ snapshotReq <-+ return . parseRequest $+ "https://www.cryptocompare.com/api/data/coinsnapshot" +++ toQueryString (CoinSnapshotRequest fSym tSym)+ r <- httpJSON <$> snapshotReq+ Right . snapshot . getResponseBody <$> r)+ (return . Left . show)
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"