gemini-exports (empty) → 0.1.0.0
raw patch · 10 files changed
+1185/−0 lines, 10 filesdep +aesondep +basedep +base64setup-changed
Dependencies added: aeson, base, base64, bytestring, cassava, cmdargs, containers, cryptonite, directory, gemini-exports, hedgehog, http-client, http-types, mtl, raw-strings-qq, req, safe-exceptions, scientific, tasty, tasty-hedgehog, tasty-hunit, text, time, xdg-basedir, yaml
Files
- CHANGELOG.md +5/−0
- LICENSE +30/−0
- README.md +56/−0
- Setup.hs +2/−0
- app/Main.hs +10/−0
- gemini-exports.cabal +130/−0
- src/Console/Gemini/Exports/Csv.hs +153/−0
- src/Console/Gemini/Exports/Main.hs +309/−0
- src/Web/Gemini.hs +456/−0
- tests/Spec.hs +34/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# CHANGELOG++## v0.1.0.0++* Initial release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Pavan Rikhi (c) 2022++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Pavan Rikhi nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,56 @@+# gemini-exports++[](https://github.com/prikhi/gemini-exports/actions/workflows/main.yml)+++Generate CSV Exports of your Gemini Trades.++Requires [`stack`][get-stack]:++```sh+$ stack run -- -k <API_KEY> -s <API_SECRET>+time,base-asset,quote-asset,type,description,price,quantity,total,fee,fee-currency,trade-id+2022-04-20 04:20:00,GUSD,USD,Buy,,1.0,9001.0,9001.0,0.0,USD,900142424242+$ stack run -- --help+```++[get-stack]: https://docs.haskellstack.org/en/stable/README/+++## Install++You can install the CLI exe by running `stack install`. This lets you call the+executable directly instead of through stack:++```sh+stack install+export PATH="${HOME}/.local/bin/:${PATH}"+gemini-exports+```+++## Build++You can build the project with stack:++```sh+stack build+```++For development, you can enable fast builds with file-watching,+documentation-building, & test-running:++```sh+stack test --haddock --fast --file-watch --pedantic+```++To build & open the documentation, run:++```sh+stack haddock --open gemini-exports+```+++## LICENSE++BSD-3
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,10 @@+module Main where++import Console.Gemini.Exports.Main+++main :: IO ()+main = do+ args <- getArgs+ cfg <- loadConfigFile+ run cfg args
+ gemini-exports.cabal view
@@ -0,0 +1,130 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name: gemini-exports+version: 0.1.0.0+synopsis: Generate CSV Exports of Your Gemini Trades, Transfers, & Earn Transactions+description: @gemini-exports@ is a CLI program that queries the Gemini Exchange's API+ for your Trade History, Transfer History, & Earn History and exports all+ fetched data to a CSV file.+ .+ You can install @gemini-exports@ with Stack: @stack install --resolver+ nightly gemii-exports@. Then run the following to print out your complete+ history:+ .+ @+ $ gemini-exports -k \<API_KEY\> -s \<API_SECRET\>+ time,base-asset,quote-asset,type,description,price,quantity,total,fee,fee-currency,trade-id+ 2022-04-20 04:20:00,GUSD,USD,Buy,,1.0,9001.0,9001.0,0.0,USD,900142424242+ @+ .+ See @gemini-exports --help@ for additional options, configuration file+ details, etc.+category: Web, Finance, Console+homepage: https://github.com/prikhi/gemini-exports#readme+bug-reports: https://github.com/prikhi/gemini-exports/issues+author: Pavan Rikhi+maintainer: pavan.rikhi@gmail.com+copyright: 2022 Pavan Rikhi+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/prikhi/gemini-exports++library+ exposed-modules:+ Console.Gemini.Exports.Csv+ Console.Gemini.Exports.Main+ Web.Gemini+ other-modules:+ Paths_gemini_exports+ hs-source-dirs:+ src+ default-extensions:+ DeriveGeneric+ LambdaCase+ NamedFieldPuns+ OverloadedStrings+ TupleSections+ TypeApplications+ TypeOperators+ ViewPatterns+ ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -O2 -Wunused-packages+ build-depends:+ aeson <3+ , base >=4.7 && <5+ , base64 <1+ , bytestring <1+ , cassava <1+ , cmdargs >=0.10 && <1+ , containers <1+ , cryptonite <1+ , directory <2+ , http-client <1+ , http-types <1+ , mtl <3+ , raw-strings-qq <2+ , req <4+ , safe-exceptions <1+ , scientific <1+ , text <3+ , time <2+ , xdg-basedir <1+ , yaml <1+ default-language: Haskell2010++executable gemini-exports+ main-is: Main.hs+ other-modules:+ Paths_gemini_exports+ hs-source-dirs:+ app+ default-extensions:+ DeriveGeneric+ LambdaCase+ NamedFieldPuns+ OverloadedStrings+ TupleSections+ TypeApplications+ TypeOperators+ ViewPatterns+ ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -O2 -threaded -rtsopts -with-rtsopts "-N -T"+ build-depends:+ base >=4.7 && <5+ , gemini-exports+ default-language: Haskell2010++test-suite gemini-exports-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Paths_gemini_exports+ hs-source-dirs:+ tests+ default-extensions:+ DeriveGeneric+ LambdaCase+ NamedFieldPuns+ OverloadedStrings+ TupleSections+ TypeApplications+ TypeOperators+ ViewPatterns+ ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -O2 -threaded -rtsopts -with-rtsopts "-N -T"+ build-depends:+ base >=4.7 && <5+ , gemini-exports+ , hedgehog+ , tasty+ , tasty-hedgehog >=1.2+ , tasty-hunit+ default-language: Haskell2010
+ src/Console/Gemini/Exports/Csv.hs view
@@ -0,0 +1,153 @@+{-# LANGUAGE RecordWildCards #-}+{-| Types & functions for converting Gemini API responses into CSV exports.+-}+module Console.Gemini.Exports.Csv+ ( ExportData(..)+ , makeExportData+ , makeExportCsv+ , ExportLine(..)+ , getExportLineTimestamp+ ) where+import Control.Applicative ( (<|>) )+import Control.Monad.IO.Class ( MonadIO(..) )+import Data.Csv ( (.=)+ , DefaultOrdered(..)+ , ToNamedRecord(..)+ , defaultEncodeOptions+ , encUseCrLf+ , encodeDefaultOrderedByNameWith+ , header+ , namedRecord+ )+import Data.Maybe ( fromMaybe )+import Data.Scientific ( FPFormat(Fixed)+ , Scientific+ , formatScientific+ )+import Data.Text ( Text+ , empty+ , pack+ )+import Data.Time ( TimeZone+ , defaultTimeLocale+ , formatTime+ , getTimeZone+ , utcToZonedTime+ )+import Data.Time.Clock.POSIX ( POSIXTime+ , posixSecondsToUTCTime+ )++import Web.Gemini++import qualified Data.ByteString.Lazy.Char8 as LBS+++-- | The data required for rendering a single CSV row.+data ExportData = ExportData+ { edTZ :: TimeZone+ , edLine :: ExportLine+ }+ deriving (Show, Read, Eq, Ord)++instance DefaultOrdered ExportData where+ headerOrder _ = header+ [ "time"+ , "base-asset"+ , "quote-asset"+ , "type"+ , "description"+ , "price"+ , "quantity"+ , "total"+ , "fee"+ , "fee-currency"+ , "trade-id"+ ]++instance ToNamedRecord ExportData where+ toNamedRecord (ExportData tz lineData) = namedRecord $ case lineData of+ TradeExport Trade {..} SymbolDetails {..} ->+ [ "time" .= formatTimestamp tTimestamp+ , "base-asset" .= sdBaseCurrency+ , "quote-asset" .= sdQuoteCurrency+ , "type" .= if tIsBuy then "Buy" else ("Sell" :: Text)+ , "description" .= empty+ , "price" .= formatDecimal tPrice+ , "quantity" .= formatDecimal tAmount+ , "total" .= formatDecimal (tPrice * tAmount)+ , "fee" .= formatDecimal tFeeAmount+ , "fee-currency" .= tFeeCurrency+ , "trade-id" .= tId+ ]+ TransferExport Transfer {..} ->+ [ "time" .= formatTimestamp trTimestamp+ , "base-asset" .= trCurrency+ , "quote-asset" .= empty+ , "type" .= trType+ , "description" .= toDescr (trMethod, trPurpose)+ , "price" .= empty+ , "quantity" .= formatDecimal trAmount+ , "total" .= formatDecimal trAmount+ , "fee" .= empty+ , "fee-currency" .= empty+ , "trade-id" .= trId+ ]+ EarnExport EarnTransaction {..} ->+ [ "time" .= formatTimestamp etTimestamp+ , "base-asset" .= etAmountCurrency+ , "quote-asset" .= fromMaybe empty etPriceCurrency+ , "type" .= ("Earn " <> etType)+ , "description" .= empty+ , "price" .= maybe empty formatDecimal etPrice+ , "quantity" .= formatDecimal etAmount+ , "total" .= maybe empty (formatDecimal . (* etAmount)) etPrice+ , "fee" .= empty+ , "fee-currency" .= empty+ , "trade-id" .= etId+ ]+ where+ -- Render a transfer description by combining the optional method+ -- & purpose fields.+ toDescr :: (Maybe Text, Maybe Text) -> Text+ toDescr = \case+ (Just m, Just p) -> m <> " " <> p+ (m , p ) -> fromMaybe "" $ m <|> p+ -- Convert a timestamp into a localtime with the line's timezone+ -- & render it in `YYYY-MM-DD HH:MM:SS.nnnnnnnnn` format.`+ formatTimestamp :: POSIXTime -> String+ formatTimestamp =+ formatTime defaultTimeLocale "%F %T%Q"+ . utcToZonedTime tz+ . posixSecondsToUTCTime+ -- Render a decimal number with the minimum precision neccesary..+ formatDecimal :: Scientific -> Text+ formatDecimal = pack . formatScientific Fixed Nothing++-- | Determine the 'TimeZone' for the 'ExportLine' & return both as an+-- 'ExportData'.+makeExportData :: MonadIO m => ExportLine -> m ExportData+makeExportData lineData = do+ tz <- liftIO . getTimeZone . posixSecondsToUTCTime $ getExportLineTimestamp+ lineData+ return $ ExportData tz lineData++-- | Render the export data as a CSV with a header row.+makeExportCsv :: [ExportData] -> LBS.ByteString+makeExportCsv =+ encodeDefaultOrderedByNameWith (defaultEncodeOptions { encUseCrLf = False })+++-- | Split out the data required for different export line types.+data ExportLine+ = TradeExport Trade SymbolDetails+ | TransferExport Transfer+ | EarnExport EarnTransaction+ deriving (Show, Read, Eq, Ord)++-- | Get the timestamp field of an 'ExportLine'.+getExportLineTimestamp :: ExportLine -> POSIXTime+getExportLineTimestamp = \case+ TradeExport t _ -> tTimestamp t+ TransferExport t -> trTimestamp t+ EarnExport t -> etTimestamp t
+ src/Console/Gemini/Exports/Main.hs view
@@ -0,0 +1,309 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-}+{- | CLI application harness.++-}+module Console.Gemini.Exports.Main+ ( run+ , getArgs+ , Args(..)+ , loadConfigFile+ , ConfigFile(..)+ ) where++import Control.Applicative ( (<|>) )+import Control.Exception.Safe ( try )+import Control.Monad ( forM )+import Data.Aeson ( (.:?)+ , FromJSON(..)+ , withObject+ )+import Data.Maybe ( catMaybes+ , fromMaybe+ )+import Data.Text ( Text )+import Data.Time ( LocalTime(..)+ , UTCTime(..)+ , ZonedTime(..)+ , fromGregorian+ , getTimeZone+ , timeToTimeOfDay+ , zonedTimeToUTC+ )+import Data.Version ( showVersion )+import Data.Yaml ( prettyPrintParseException )+import Data.Yaml.Config ( ignoreEnv+ , loadYamlSettings+ )+import System.Console.CmdArgs ( (&=)+ , Data+ , Typeable+ , cmdArgs+ , def+ , details+ , explicit+ , help+ , helpArg+ , name+ , program+ , summary+ , typ+ )+import System.Directory ( doesFileExist )+import System.Environment ( lookupEnv )+import System.Environment.XDG.BaseDir ( getUserConfigFile )+import System.Exit ( exitFailure )+import System.IO ( hPutStrLn+ , stderr+ )+import Text.RawString.QQ ( r )++import Console.Gemini.Exports.Csv+import Paths_gemini_exports ( version )+import Web.Gemini++import qualified Data.ByteString.Lazy.Char8 as LBS+import qualified Data.List as L+import qualified Data.Map.Strict as M+import qualified Data.Text as T+++-- | Run the executable.+run :: ConfigFile -> Args -> IO ()+run cfg cfgArgs = do+ AppConfig {..} <- makeConfig cfg cfgArgs+ exportData <- runApi geminiCfg $ do+ trades <- getMyTrades dateRange+ let symbols = L.nub $ map tSymbol trades+ symbolDetails <- fmap M.fromList . forM symbols $ \symbol -> do+ (symbol, ) <$> getSymbolDetails symbol+ tradeExport <- fmap catMaybes . forM trades $ \t -> do+ let mbTrade = TradeExport t <$> M.lookup (tSymbol t) symbolDetails+ mapM makeExportData mbTrade+ transfers <- getMyTransfers dateRange+ transferExport <- mapM (makeExportData . TransferExport) transfers+ earnTransactions <- getMyEarnTransactions dateRange+ earnExport <- mapM (makeExportData . EarnExport) earnTransactions+ return $ tradeExport <> transferExport <> earnExport+ let+ csvData = makeExportCsv+ $ L.sortOn (getExportLineTimestamp . edLine) exportData+ if outputFile == "-"+ then LBS.putStrLn csvData+ else LBS.writeFile outputFile csvData++-- | Print some text to stderr and then exit with an error.+exitWithError :: String -> IO a+exitWithError msg = hPutStrLn stderr ("[ERROR] " <> msg) >> exitFailure+++-- CONFIGURATION++data AppConfig = AppConfig+ { geminiCfg :: GeminiConfig+ , outputFile :: FilePath+ , dateRange :: Maybe (UTCTime, UTCTime)+ }+ deriving (Show, Read, Eq, Ord)++-- | Pull Environmental variables, then merge the config file, env vars,+-- and cli args into an AppConfig.+--+-- Exit with an error if we cannot construct a 'GeminiConfig'.+makeConfig :: ConfigFile -> Args -> IO AppConfig+makeConfig ConfigFile {..} Args {..} = do+ envApiKey <- fmap T.pack <$> lookupEnv "GEMINI_API_KEY"+ gcApiKey <-+ errorIfNothing "Pass a Gemini API Key with `-k` or $GEMINI_API_KEY."+ $ argApiKey+ <|> envApiKey+ <|> cfgApiKey+ envApiSecret <- fmap T.pack <$> lookupEnv "GEMINI_API_SECRET"+ gcApiSecret <-+ errorIfNothing+ "Pass a Gemini API Secret with `-s` or $GEMINI_API_SECRET."+ $ argApiSecret+ <|> envApiSecret+ <|> cfgApiSecret+ let geminiCfg = GeminiConfig { .. }+ dateRange <- mapM buildDateRange argYear+ return AppConfig { outputFile = fromMaybe "-" argOutputFile, .. }+ where+ -- | Exit with error message if value is 'Nothing'+ errorIfNothing :: String -> Maybe a -> IO a+ errorIfNothing msg = maybe (exitWithError msg) return+ -- | Given a year, build a tuple representing the span of a year in the+ -- user's timezone.+ buildDateRange :: Integer -> IO (UTCTime, UTCTime)+ buildDateRange y = do+ let yearStart = UTCTime (fromGregorian y 1 1) 0+ yearEnd = UTCTime (fromGregorian y 12 31)+ ((23 * 60 * 60) + (59 * 60) + 59 + 0.9999)+ (,) <$> mkZonedTime yearStart <*> mkZonedTime yearEnd+ -- | Shift a time by the user's timezone - coercing it into a ZonedTime+ -- and converting that back into UTC.+ mkZonedTime :: UTCTime -> IO UTCTime+ mkZonedTime t = do+ tz <- getTimeZone t+ let localTime = LocalTime (utctDay t) (timeToTimeOfDay $ utctDayTime t)+ zonedTime = ZonedTime localTime tz+ return $ zonedTimeToUTC zonedTime+++-- CONFIG FILE++-- | Optional configuration data parsed from a yaml file.+data ConfigFile = ConfigFile+ { cfgApiKey :: Maybe Text+ , cfgApiSecret :: Maybe Text+ }+ deriving (Show, Read, Eq, Ord)++instance FromJSON ConfigFile where+ parseJSON = withObject "ConfigFile" $ \o -> do+ cfgApiKey <- o .:? "api-key"+ cfgApiSecret <- o .:? "api-secret"+ return ConfigFile { .. }++-- | Attempt to read a 'ConfigFile' from+-- @$XDG_CONFIG_HOME\/gemini-exports\/config.yaml@. Print any parsing+-- errors to 'stderr'.+loadConfigFile :: IO ConfigFile+loadConfigFile = do+ configPath <- getUserConfigFile "gemini-exports" "config.yaml"+ configExists <- doesFileExist configPath+ if configExists+ then try (loadYamlSettings [configPath] [] ignoreEnv) >>= \case+ Left (lines . prettyPrintParseException -> errorMsgs) ->+ hPutStrLn stderr "[WARN] Invalid Configuration Format:"+ >> mapM_ (hPutStrLn stderr . ("\t" <>)) errorMsgs+ >> return defaultConfig+ Right cfg -> return cfg+ else return defaultConfig+ where+ defaultConfig :: ConfigFile+ defaultConfig = ConfigFile Nothing Nothing+++-- CLI ARGS++-- | CLI arguments supported by the executable.+data Args = Args+ { argApiKey :: Maybe Text+ , argApiSecret :: Maybe Text+ , argOutputFile :: Maybe FilePath+ , argYear :: Maybe Integer+ }+ deriving (Show, Read, Eq, Data, Typeable)+++-- | Parse the CLI arguments with 'System.Console.CmdArgs'.+getArgs :: IO Args+getArgs = cmdArgs argSpec+++-- | Defines & documents the CLI arguments.+argSpec :: Args+argSpec =+ Args+ { argApiKey = def+ &= name "api-key"+ &= name "k"+ &= explicit+ &= help "Gemini API Key"+ &= typ "KEY"+ , argApiSecret = def+ &= name "api-secret"+ &= name "s"+ &= explicit+ &= help "Gemini API Secret"+ &= typ "SECRET"+ , argOutputFile = Nothing+ &= help "File to write export to. Default: stdout"+ &= name "o"+ &= name "output-file"+ &= explicit+ &= typ "FILE"+ , argYear = Nothing+ &= help "Limit transactions to given year."+ &= name "y"+ &= name "year"+ &= explicit+ &= typ "YYYY"+ }+ &= summary+ ( "gemini-exports v"+ <> showVersion version+ <> ", Pavan Rikhi 2022"+ )+ &= program "gemini-exports"+ &= helpArg [name "h"]+ &= help "Generate CSV Exports of your Gemini Trades."+ &= details programDetails+++programDetails :: [String]+programDetails = lines [r|+gemini-exports generates a CSV export of your Gemini Trades, Earn+Transactions, & Transfers.+++DESCRIPTION++By default, we will pull every single trade, transfer, and income you have+made on Gemini & print them out in chronological order with the following+fields:++ time,base-asset,quote-asset,type,description,price,quantity,total,fee,fee-currency,trade-id++Trades have blank descriptions.++Transfers have blank quote-assets, prices, & fees and potential blank+descriptions.++Earn transactions have blank descriptions & fees and potentially blank+quote-assets, price, & totals.+++OUTPUT FILE++You can use the `-o` flag to set the file we will write the CSV data into.+By default, the export is simply printed to stdout.++Warning: the export file will always be overwritten. We do not support+appending to an existing file.+++ENVIRONMENTAL VARIABLES++Instead of passing in your API credentials via the `-k` & `-s` CLI flags,+you can set the `$GEMINI_API_KEY` & `$GEMINI_API_SECRET` environmental+variables.+++CONFIGURATION FILE++You can also set some program options in a YAML file. We attempt to parse+a configuration file at `$XDG_CONFIG_HOME/gemini-exports/config.yaml`. It+supports the following top-level keys:++ - `api-key`: (string) Your Gemini API key+ - `api-secret`: (string) Your Gemini API secret++Environmental variables will override any configuration options, and CLI+flags will override both environmental variables & configuration file+options.+++USAGE EXAMPLES++Fetch all my trades, deposits, withdrawals, & earn transactions:+ gemini-exports -k <API_KEY> -s <API_SECRET>++Fetch my Gemini history from 2020:+ gemini-exports -y 2020++Fetch my history from 2022, write them to a file:+ gemini-exports -y 2022 -o 2022-gemini-history.csv+|]
+ src/Web/Gemini.hs view
@@ -0,0 +1,456 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE RecordWildCards #-}+{-| Request functions & response types for the Gemini Exchange API.+-}+module Web.Gemini+ ( GeminiApiM+ , runApi+ , GeminiConfig(..)+ , GeminiError(..)+ -- * Requests+ -- ** Symbol Details+ , getSymbolDetails+ , SymbolDetails(..)+ -- ** Trade History+ , getMyTrades+ , Trade(..)+ -- ** Transfer History+ , getMyTransfers+ , Transfer(..)+ -- ** Earn History+ , getMyEarnTransactions+ , EarnHistory(..)+ , EarnTransaction(..)+ -- * Helpers+ , protectedGeminiRequest+ , retryWithRateLimit+ , createSignature+ , makeNonce+ ) where++import Control.Concurrent ( threadDelay )+import Control.Exception.Safe ( MonadCatch+ , MonadThrow+ , try+ )+import Control.Monad.Reader ( MonadIO(liftIO)+ , MonadReader(ask)+ , ReaderT(..)+ , lift+ )+import Crypto.Hash ( SHA384 )+import Crypto.MAC.HMAC ( hmac+ , hmacGetDigest+ )+import Data.Aeson ( (.:)+ , (.:?)+ , FromJSON(..)+ , ToJSON(..)+ , Value(..)+ , eitherDecode+ , encode+ , withObject+ )+import Data.ByteString.Base64 ( encodeBase64 )+import Data.Maybe ( fromMaybe+ , listToMaybe+ , mapMaybe+ )+import Data.Ratio ( (%) )+import Data.Scientific ( Scientific )+import Data.Text ( Text )+import Data.Text.Encoding ( encodeUtf8 )+import Data.Time ( UTCTime )+import Data.Time.Clock.POSIX ( POSIXTime+ , getPOSIXTime+ , utcTimeToPOSIXSeconds+ )+import Data.Version ( showVersion )+import GHC.Generics ( Generic )+import Network.HTTP.Client ( HttpException(..)+ , HttpExceptionContent(..)+ , responseStatus+ )+import Network.HTTP.Req ( (/:)+ , GET(..)+ , HttpBodyAllowed+ , HttpException(..)+ , HttpMethod(..)+ , JsonResponse+ , MonadHttp(..)+ , NoReqBody(..)+ , Option+ , POST(..)+ , ProvidesBody+ , Req+ , Url+ , defaultHttpConfig+ , header+ , https+ , jsonResponse+ , req+ , responseBody+ , runReq+ )+import Network.HTTP.Types ( Status(..) )+import Text.Read ( readMaybe )++import Paths_gemini_exports ( version )++import qualified Data.Aeson.KeyMap as KM+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Text as T+++-- | Required configuration data for making requests to the Gemini API.+data GeminiConfig = GeminiConfig+ { gcApiKey :: Text+ , gcApiSecret :: Text+ }+ deriving (Show, Read, Eq, Ord)++-- | Monad in which Gemini API requests are run.+newtype GeminiApiM a = GeminiApiM+ { runGeminiApiM :: ReaderT GeminiConfig Req a+ } deriving (Functor, Applicative, Monad, MonadIO, MonadReader GeminiConfig, MonadThrow, MonadCatch)++-- | Run a series of API requests with the given Config.+runApi :: GeminiConfig -> GeminiApiM a -> IO a+runApi cfg = runReq defaultHttpConfig . flip runReaderT cfg . runGeminiApiM++-- | Use 'MonadHttp' from the 'Req' monad.+instance MonadHttp GeminiApiM where+ handleHttpException = GeminiApiM . lift . handleHttpException++-- | Potential error response body from the API.+data GeminiError = GeminiError+ { geReason :: Text+ , geMessage :: Text+ }+ deriving (Show, Read, Eq, Ord)++instance FromJSON GeminiError where+ parseJSON = withObject "GeminiError"+ $ \o -> GeminiError <$> o .: "reason" <*> o .: "message"+++-- SYMBOL DETAILS++-- | Fetch the details on a supported symbol.+getSymbolDetails :: MonadHttp m => Text -> m SymbolDetails+getSymbolDetails symbol =+ responseBody+ <$> req+ GET+ ( https "api.gemini.com"+ /: "v1"+ /: "symbols"+ /: "details"+ /: symbol+ )+ NoReqBody+ jsonResponse+ userAgentHeader++-- | Currency & Precision details for a 'Trade' Symbol.+data SymbolDetails = SymbolDetails+ { sdSymbol :: Text+ , sdBaseCurrency :: Text+ , sdBasePrecision :: Scientific+ , sdQuoteCurrency :: Text+ , sdQuotePrecision :: Scientific+ }+ deriving (Show, Read, Eq, Ord, Generic)++instance FromJSON SymbolDetails where+ parseJSON = withObject "SymbolDetails" $ \o -> do+ sdSymbol <- o .: "symbol"+ sdBaseCurrency <- o .: "base_currency"+ sdBasePrecision <- o .: "tick_size"+ sdQuoteCurrency <- o .: "quote_currency"+ sdQuotePrecision <- o .: "quote_increment"+ return SymbolDetails { .. }+++-- TRADE HISTORY++-- | Fetch all my Gemini Trades+getMyTrades+ :: Maybe (UTCTime, UTCTime)+ -- ^ Optional @(start, end)@ ranges for fetching.+ -> GeminiApiM [Trade]+getMyTrades = fetchAllPages getTradeBatch tTimestamp+ where+ getTradeBatch :: Integer -> GeminiApiM [Trade]+ getTradeBatch timestamp = do+ nonce <- makeNonce+ let parameters = KM.fromList+ [ ("request" , String "/v1/mytrades")+ , ("nonce" , toJSON nonce)+ , ("timestamp" , toJSON $ timestampToSeconds timestamp)+ , ("limit_trades", Number 500)+ ]+ responseBody+ <$> protectedGeminiRequest+ POST+ (https "api.gemini.com" /: "v1" /: "mytrades")+ parameters++-- | A single, completed Trade.+data Trade = Trade+ { tId :: Integer+ , tSymbol :: Text+ , tPrice :: Scientific+ , tAmount :: Scientific+ , tFeeCurrency :: Text+ , tFeeAmount :: Scientific+ , tIsBuy :: Bool+ , tIsAggressor :: Bool+ , tTimestamp :: POSIXTime+ , tOrderId :: Text+ }+ deriving (Show, Read, Eq, Ord, Generic)++instance FromJSON Trade where+ parseJSON = withObject "Trade" $ \o -> do+ tId <- o .: "tid"+ tSymbol <- o .: "symbol"+ tPrice <- read <$> o .: "price"+ tAmount <- read <$> o .: "amount"+ tFeeCurrency <- o .: "fee_currency"+ tFeeAmount <- read <$> o .: "fee_amount"+ tIsBuy <- (== ("Buy" :: String)) <$> o .: "type"+ tIsAggressor <- o .: "aggressor"+ tTimestamp <- (/ 1000.0) <$> o .: "timestampms"+ tOrderId <- o .: "order_id"+ return Trade { .. }+++-- TRANSFER HISTORY++-- | Fetch all my Gemini Transfers+getMyTransfers+ :: Maybe (UTCTime, UTCTime)+ -- ^ Optional @(start, end)@ ranges for fetching.+ -> GeminiApiM [Transfer]+getMyTransfers = fetchAllPages getTransferBatch trTimestamp+ where+ getTransferBatch :: Integer -> GeminiApiM [Transfer]+ getTransferBatch timestamp = do+ nonce <- makeNonce+ let parameters = KM.fromList+ [ ("request" , String "/v1/transfers")+ , ("nonce" , toJSON nonce)+ , ("timestamp" , toJSON $ timestampToSeconds timestamp)+ , ("limit_transfers", Number 50)+ ]+ responseBody+ <$> protectedGeminiRequest+ POST+ (https "api.gemini.com" /: "v1" /: "transfers")+ parameters++-- | A single fiat or cryptocurrency transfer, credit, deposit, or withdrawal.+data Transfer = Transfer+ { trId :: Integer+ , trType :: Text+ , trStatus :: Text+ , trCurrency :: Text+ , trAmount :: Scientific+ , trMethod :: Maybe Text+ , trPurpose :: Maybe Text+ , trTimestamp :: POSIXTime+ }+ deriving (Show, Read, Eq, Ord, Generic)++instance FromJSON Transfer where+ parseJSON = withObject "Transfer" $ \o -> do+ trId <- o .: "eid"+ trType <- o .: "type"+ trStatus <- o .: "status"+ trCurrency <- o .: "currency"+ trAmount <- read <$> o .: "amount"+ trMethod <- o .:? "method"+ trPurpose <- o .:? "purpose"+ trTimestamp <- (/ 1000) <$> o .: "timestampms"+ return Transfer { .. }+++-- EARN HISTORY++-- | Fetch all my Gemini Earn Transactions+getMyEarnTransactions+ :: Maybe (UTCTime, UTCTime) -> GeminiApiM [EarnTransaction]+getMyEarnTransactions = fetchAllPages getEarnBatch etTimestamp+ where+ getEarnBatch :: Integer -> GeminiApiM [EarnTransaction]+ getEarnBatch timestamp = do+ nonce <- makeNonce+ let parameters = KM.fromList+ [ ("request", String "/v1/earn/history")+ , ("nonce" , toJSON nonce)+ , ("since" , toJSON timestamp)+ , ("sortAsc", toJSON True)+ , ("limit" , Number 500)+ ]+ concatMap @[] ehTransactions+ . responseBody+ <$> protectedGeminiRequest+ POST+ (https "api.gemini.com" /: "v1" /: "earn" /: "history")+ parameters++-- | Earn Transactions grouped by a Provider/Borrower.+data EarnHistory = EarnHistory+ { ehProviderId :: Text+ , ehTransactions :: [EarnTransaction]+ }++instance FromJSON EarnHistory where+ parseJSON = withObject "EarnHistory"+ $ \o -> EarnHistory <$> o .: "providerId" <*> o .: "transactions"++-- | A single Earn transaction.+data EarnTransaction = EarnTransaction+ { etId :: Text+ , etType :: Text+ , etAmountCurrency :: Text+ , etAmount :: Scientific+ , etPriceCurrency :: Maybe Text+ , etPrice :: Maybe Scientific+ , etTimestamp :: POSIXTime+ }+ deriving (Show, Read, Eq, Ord, Generic)++instance FromJSON EarnTransaction where+ parseJSON = withObject "EarnTransaction" $ \o -> do+ etId <- o .: "earnTransactionId"+ etType <- o .: "transactionType"+ etAmountCurrency <- o .: "amountCurrency"+ etAmount <- o .: "amount"+ etPriceCurrency <- o .:? "priceCurrency"+ etPrice <- o .:? "priceAmount"+ etTimestamp <- (/ 1000.0) <$> o .: "dateTime"+ return EarnTransaction { .. }+++-- UTILS++-- | Run a request that requires authorization against the Gemini API.+protectedGeminiRequest+ :: ( MonadHttp m+ , HttpMethod method+ , HttpBodyAllowed (AllowsBody method) (ProvidesBody NoReqBody)+ , ToJSON body+ , FromJSON response+ , MonadReader GeminiConfig m+ )+ => method+ -> Url scheme+ -> body+ -> m (JsonResponse response)+protectedGeminiRequest method url body = do+ cfg <- ask+ let payload = encodeUtf8 . encodeBase64 . LBS.toStrict $ encode body+ signature = createSignature cfg payload+ let authorizedOptions = mconcat+ [ header "Content-Type" "text/plain"+ , header "X-GEMINI-APIKEY" (encodeUtf8 $ gcApiKey cfg)+ , header "X-GEMINI-PAYLOAD" payload+ , header "X-GEMINI-SIGNATURE" signature+ , header "Cache-Control" "no-cache"+ , userAgentHeader+ ]+ req method url NoReqBody jsonResponse authorizedOptions++-- | Attempt a request & retry if a @429@ @RateLimited@ error is returned.+-- We attempt to parse the retry wait time from the @message@ field but+-- fallback to one second.+retryWithRateLimit :: (MonadHttp m, MonadCatch m) => m a -> m a+retryWithRateLimit request = try request >>= \case+ Left e@(VanillaHttpException (HttpExceptionRequest _ (StatusCodeException (statusCode . responseStatus -> 429) body)))+ -> case eitherDecode $ LBS.fromStrict body of+ Left _ -> handleHttpException e+ Right r -> if geReason r == "RateLimited"+ then+ let msToWait =+ fromMaybe 1000+ . listToMaybe+ . mapMaybe (readMaybe . T.unpack)+ . T.words+ $ geMessage r+ in do+ liftIO . threadDelay $ msToWait * 1000+ retryWithRateLimit request+ else handleHttpException e+ Left e -> handleHttpException e+ Right r -> return r++-- | Fetch all pages of a response by calling the API with increasing+-- timestamp fields until it returns an empty response. Takes an optional+-- start & end date to offset the initial fetch & stop fetching early.+fetchAllPages+ :: (Integer -> GeminiApiM [a])+ -- ^ Make a request for items above the given milliseconds @timestamp@+ -> (a -> POSIXTime)+ -- ^ Pull a timestamp from an item+ -> Maybe (UTCTime, UTCTime)+ -- ^ Optional @(start, end)@ range+ -> GeminiApiM [a]+fetchAllPages mkRequest getTimestamp mbRange = do+ let startTimestamp =+ maybe 0 (truncate . (1000 *) . utcTimeToPOSIXSeconds . fst) mbRange+ fetchAll [] startTimestamp+ where+ fetchAll prevResults timestamp = do+ newResults <- retryWithRateLimit $ mkRequest timestamp+ if null newResults+ then return prevResults+ else+ let+ maxTimestamp = maximum $ map getTimestamp newResults+ nextTimestamp = truncate $ 1000 * maxTimestamp + 1+ continueFetching =+ fetchAll (newResults <> prevResults) nextTimestamp+ filteredResults end =+ filter ((<= end) . getTimestamp) newResults+ in+ case mbRange of+ Nothing -> continueFetching+ Just (_, utcTimeToPOSIXSeconds -> end) ->+ if maxTimestamp >= end+ then return $ filteredResults end <> prevResults+ else continueFetching++-- | Given a timestamp in ms, convert it to a timestamp param in seconds by+-- dividing & rounding up.+timestampToSeconds :: Integer -> Integer+timestampToSeconds = ceiling . (% 1000)++-- | Generate a 'Crypto.MAC.HMAC.HMAC' 'SHA384' signature for an authorized+-- API request.+createSignature+ :: GeminiConfig+ -- ^ API Credentials+ -> BS.ByteString+ -- ^ Base64-encoded request body.+ -> BS.ByteString+createSignature cfg body =+ let digest =+ hmacGetDigest @SHA384 $ hmac (encodeUtf8 $ gcApiSecret cfg) body+ in BC.pack $ show digest+++-- | Generate a nonce for authorized requests from the current timestamp in+-- milliseconds.+makeNonce :: MonadIO m => m Integer+makeNonce = truncate . (1000 *) <$> liftIO getPOSIXTime+++-- | Generate a @User-Agent@ header with the library's current version.+userAgentHeader :: Option scheme+userAgentHeader =+ header "User-Agent" . BC.pack $ "gemini-exports/v" <> showVersion version
+ tests/Spec.hs view
@@ -0,0 +1,34 @@+import Hedgehog+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.Hedgehog++import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+++main :: IO ()+main = defaultMain tests+++tests :: TestTree+tests = testGroup "Tests" [unitTests, properties]+++unitTests :: TestTree+unitTests = testGroup "Unit Tests" [testCase "2+2 = 4" testAddition]+ where+ testAddition :: Assertion+ testAddition = (2 + 2) @?= (4 :: Integer)+++properties :: TestTree+properties = testGroup+ "Properties"+ [testPropertyNamed "Addition is Communative" "testAdditionCommunative" testAdditionCommunative]+ where+ testAdditionCommunative :: Property+ testAdditionCommunative = property $ do+ let genInt = Gen.int $ Range.linear 0 9001+ (a, b) <- forAll $ (,) <$> genInt <*> genInt+ (a + b) === (b + a)