From b397c2af39a7c0434129328c2ba8b0529ac3099c Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Thu, 17 Oct 2024 18:10:43 +0530 Subject: [PATCH 1/5] feat(#85): add taptools `/prices` route --- .github/workflows/haskell.yml | 2 +- .../geniusyield-server-lib.cabal | 3 +- .../Dex/HistoricalPrices/TapTools/Client.hs | 67 +++++++++++++++---- 3 files changed, 56 insertions(+), 16 deletions(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 167ed7e..fc288a6 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -57,7 +57,7 @@ jobs: uses: haskell-actions/setup@v2 with: ghc-version: '9.6.5' - cabal-version: '3.10.1.0' + cabal-version: '3.12.1.0' enable-stack: true stack-version: '2.9' - name: Setup cache diff --git a/geniusyield-server-lib/geniusyield-server-lib.cabal b/geniusyield-server-lib/geniusyield-server-lib.cabal index ed77614..8404f88 100644 --- a/geniusyield-server-lib/geniusyield-server-lib.cabal +++ b/geniusyield-server-lib/geniusyield-server-lib.cabal @@ -1,4 +1,4 @@ -cabal-version: 3.6 +cabal-version: 3.12 name: geniusyield-server-lib version: 0.11.0 synopsis: GeniusYield server library @@ -85,6 +85,7 @@ library , binary , bytestring , cardano-api + , containers , deriving-aeson , envy , fast-logger diff --git a/geniusyield-server-lib/src/GeniusYield/Server/Dex/HistoricalPrices/TapTools/Client.hs b/geniusyield-server-lib/src/GeniusYield/Server/Dex/HistoricalPrices/TapTools/Client.hs index b69e55f..977b68b 100644 --- a/geniusyield-server-lib/src/GeniusYield/Server/Dex/HistoricalPrices/TapTools/Client.hs +++ b/geniusyield-server-lib/src/GeniusYield/Server/Dex/HistoricalPrices/TapTools/Client.hs @@ -6,12 +6,17 @@ module GeniusYield.Server.Dex.HistoricalPrices.TapTools.Client ( TapToolsOHLCVAPI, tapToolsClientEnv, tapToolsOHLCV, + tapToolsPrices, + PricesResponse, TapToolsException, handleTapToolsError, ) where import Control.Lens ((?~)) import Data.Aeson (ToJSON (..)) +import Data.Aeson qualified as Aeson +import Data.Aeson.Types qualified as Aeson +import Data.Map.Strict qualified as Map import Data.Swagger qualified as Swagger import Data.Time.Clock.POSIX import Deriving.Aeson @@ -19,7 +24,7 @@ import GHC.TypeLits (Symbol, symbolVal) import GeniusYield.Server.Ctx (TapToolsApiKey, TapToolsEnv (tteApiKey, tteClientEnv)) import GeniusYield.Server.Utils (commonEnumParamSchemaRecipe, hideServantClientErrorHeader) import GeniusYield.Swagger.Utils -import GeniusYield.Types (GYAssetClass) +import GeniusYield.Types (GYAssetClass, makeAssetClass) import Maestro.Types.Common (LowerFirst) import Network.HTTP.Client (newManager) import Network.HTTP.Client.TLS (tlsManagerSettings) @@ -47,6 +52,25 @@ instance ToHttpApiData TapToolsUnit where where removeDot = Text.filter (/= '.') +instance Aeson.ToJSON TapToolsUnit where + toJSON = Aeson.toJSON . toUrlPiece + +instance Aeson.ToJSONKey TapToolsUnit where + toJSONKey = Aeson.toJSONKeyText toUrlPiece + +instance FromHttpApiData TapToolsUnit where + parseUrlPiece t = + let (pid, tn) = Text.splitAt 56 t + in bimap Text.pack TapToolsUnit $ makeAssetClass pid tn + +instance Aeson.FromJSON TapToolsUnit where + parseJSON = Aeson.withText "TapToolsUnit" $ \t → case parseUrlPiece t of + Left e → fail $ show e + Right ttu → pure ttu + +instance Aeson.FromJSONKey TapToolsUnit where + fromJSONKey = Aeson.FromJSONKeyTextParser (either (fail . show) pure . parseUrlPiece) + data TapToolsInterval = TTI3m | TTI5m | TTI15m | TTI30m | TTI1h | TTI2h | TTI4h | TTI12h | TTI1d | TTI3d | TTI1w | TTI1M deriving stock (Eq, Ord, Enum, Bounded, Data, Typeable, Generic) deriving (FromJSON, ToJSON) via CustomJSON '[ConstructorTagModifier '[StripPrefix "TTI"]] TapToolsInterval @@ -80,13 +104,13 @@ instance Swagger.ToParamSchema TapToolsInterval where instance Swagger.ToSchema TapToolsInterval where declareNamedSchema p = - pure - $ Swagger.NamedSchema (Just "TapToolsInterval") - $ Swagger.paramSchemaToSchema p - & Swagger.example - ?~ toJSON TTI1M - & Swagger.description - ?~ "The time interval" + pure $ + Swagger.NamedSchema (Just "TapToolsInterval") $ + Swagger.paramSchemaToSchema p + & Swagger.example + ?~ toJSON TTI1M + & Swagger.description + ?~ "The time interval" type TapToolsOHLCVPrefix ∷ Symbol type TapToolsOHLCVPrefix = "tapToolsOHLCV" @@ -111,22 +135,34 @@ instance Swagger.ToSchema TapToolsOHLCV where & addSwaggerDescription "Get a specific token's trended (open, high, low, close, volume) price data." & addSwaggerExample (toJSON $ TapToolsOHLCV {tapToolsOHLCVTime = 1_715_007_300, tapToolsOHLCVOpen = open, tapToolsOHLCVHigh = open, tapToolsOHLCVLow = open, tapToolsOHLCVClose = open, tapToolsOHLCVVolume = 120}) +type PricesResponse = Map.Map TapToolsUnit Double + type TapToolsApiKeyHeaderName ∷ Symbol type TapToolsApiKeyHeaderName = "x-api-key" type TapToolsAPI = - Header' '[Required] TapToolsApiKeyHeaderName TapToolsApiKey :> TapToolsOHLCVAPI + Header' '[Required] TapToolsApiKeyHeaderName TapToolsApiKey + :> "token" + :> (TapToolsOHLCVAPI :<|> TapToolsPricesAPI) type TapToolsOHLCVAPI = - "token" - :> "ohlcv" + "ohlcv" :> QueryParam "unit" TapToolsUnit :> QueryParam' '[Required, Strict] "interval" TapToolsInterval :> QueryParam "numIntervals" Natural :> Get '[JSON] [TapToolsOHLCV] -_tapToolsOHLCV ∷ TapToolsApiKey → Maybe TapToolsUnit → TapToolsInterval → Maybe Natural → ClientM [TapToolsOHLCV] -_tapToolsOHLCV = client (Proxy @TapToolsAPI) +type TapToolsPricesAPI = "prices" :> ReqBody '[JSON] [TapToolsUnit] :> Post '[JSON] PricesResponse + +data TapToolsClient = TapToolsClient + { tapToolsOHLCVClient ∷ Maybe TapToolsUnit → TapToolsInterval → Maybe Natural → ClientM [TapToolsOHLCV], + tapToolsPricesClient ∷ [TapToolsUnit] → ClientM PricesResponse + } + +mkTapToolsClient ∷ TapToolsApiKey → TapToolsClient +mkTapToolsClient apiKey = + let tapToolsOHLCVClient :<|> tapToolsPricesClient = client (Proxy @TapToolsAPI) apiKey + in TapToolsClient {..} tapToolsBaseUrl ∷ String tapToolsBaseUrl = "https://openapi.taptools.io/api/v1" @@ -151,4 +187,7 @@ handleTapToolsError ∷ Text → Either ClientError a → IO a handleTapToolsError locationInfo = either (throwIO . TapToolsApiError locationInfo . hideServantClientErrorHeader (fromString $ symbolVal (Proxy @TapToolsApiKeyHeaderName))) pure tapToolsOHLCV ∷ TapToolsEnv → Maybe TapToolsUnit → TapToolsInterval → Maybe Natural → IO [TapToolsOHLCV] -tapToolsOHLCV env@(tteApiKey → apiKey) ttu tti mttni = _tapToolsOHLCV apiKey ttu tti mttni & runTapToolsClient env >>= handleTapToolsError "tapToolsOHLCV" +tapToolsOHLCV env@(tteApiKey → apiKey) ttu tti mttni = mkTapToolsClient apiKey & tapToolsOHLCVClient & (\f → f ttu tti mttni) & runTapToolsClient env >>= handleTapToolsError "tapToolsOHLCV" + +tapToolsPrices ∷ TapToolsEnv → [TapToolsUnit] → IO PricesResponse +tapToolsPrices env@(tteApiKey → apiKey) ttus = mkTapToolsClient apiKey & tapToolsPricesClient & (\f → f ttus) & runTapToolsClient env >>= handleTapToolsError "tapToolsPrices" From 90cd415a0120d15164a802df74c30c4b8db6b643 Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Thu, 17 Oct 2024 18:12:54 +0530 Subject: [PATCH 2/5] style(#85): handle fourmolu formatter --- .../Server/Dex/HistoricalPrices/TapTools/Client.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/geniusyield-server-lib/src/GeniusYield/Server/Dex/HistoricalPrices/TapTools/Client.hs b/geniusyield-server-lib/src/GeniusYield/Server/Dex/HistoricalPrices/TapTools/Client.hs index 977b68b..e1f5d5a 100644 --- a/geniusyield-server-lib/src/GeniusYield/Server/Dex/HistoricalPrices/TapTools/Client.hs +++ b/geniusyield-server-lib/src/GeniusYield/Server/Dex/HistoricalPrices/TapTools/Client.hs @@ -104,13 +104,13 @@ instance Swagger.ToParamSchema TapToolsInterval where instance Swagger.ToSchema TapToolsInterval where declareNamedSchema p = - pure $ - Swagger.NamedSchema (Just "TapToolsInterval") $ - Swagger.paramSchemaToSchema p - & Swagger.example - ?~ toJSON TTI1M - & Swagger.description - ?~ "The time interval" + pure + $ Swagger.NamedSchema (Just "TapToolsInterval") + $ Swagger.paramSchemaToSchema p + & Swagger.example + ?~ toJSON TTI1M + & Swagger.description + ?~ "The time interval" type TapToolsOHLCVPrefix ∷ Symbol type TapToolsOHLCVPrefix = "tapToolsOHLCV" From 6f96ee83e0cedf7f87b429d41c1f0f29a1209753 Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Fri, 18 Oct 2024 16:45:45 +0530 Subject: [PATCH 3/5] ci(#85): update cabal version in dockerfile --- Dockerfile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Dockerfile b/Dockerfile index 8ce34bf..585287c 100644 --- a/Dockerfile +++ b/Dockerfile @@ -81,7 +81,7 @@ RUN gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 7D1E8AFD1D4A16D71FA # ghcup: ENV BOOTSTRAP_HASKELL_NONINTERACTIVE=1 ENV BOOTSTRAP_HASKELL_GHC_VERSION=9.6.5 -ENV BOOTSTRAP_HASKELL_CABAL_VERSION=3.10.2.0 +ENV BOOTSTRAP_HASKELL_CABAL_VERSION=3.12.1.0 RUN bash -c "curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh" ENV PATH=${PATH}:/root/.local/bin ENV PATH=${PATH}:/root/.ghcup/bin From 8e9ca05cb7041b4421fb049a3dc6b5acec9147d2 Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Mon, 28 Oct 2024 15:28:49 +0530 Subject: [PATCH 4/5] chore(#85): changelog & versioning --- geniusyield-server-lib/CHANGELOG.md | 4 ++++ geniusyield-server-lib/geniusyield-server-lib.cabal | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/geniusyield-server-lib/CHANGELOG.md b/geniusyield-server-lib/CHANGELOG.md index 4009aa9..ad0bd1f 100644 --- a/geniusyield-server-lib/CHANGELOG.md +++ b/geniusyield-server-lib/CHANGELOG.md @@ -1,5 +1,9 @@ # Revision history for geniusyield-server-lib +## 0.11.1 -- 2024-10-28 + +* Adds support of [`prices`](https://openapi.taptools.io/#tag/Market-Tokens/paths/~1token~1prices/post) TapTools endpoint. + ## 0.11.0 -- 2024-08-30 * Update to Atlas v0.6.0. diff --git a/geniusyield-server-lib/geniusyield-server-lib.cabal b/geniusyield-server-lib/geniusyield-server-lib.cabal index 8404f88..23488e0 100644 --- a/geniusyield-server-lib/geniusyield-server-lib.cabal +++ b/geniusyield-server-lib/geniusyield-server-lib.cabal @@ -1,6 +1,6 @@ cabal-version: 3.12 name: geniusyield-server-lib -version: 0.11.0 +version: 0.11.1 synopsis: GeniusYield server library description: Library for GeniusYield server. license: Apache-2.0 From b6ab4d8d722d22c3fc9eae9c8689de00ba8d37c2 Mon Sep 17 00:00:00 2001 From: sourabhxyz Date: Wed, 30 Oct 2024 17:25:06 +0530 Subject: [PATCH 5/5] feat(#85): use `UNKNOWN_REVISION` when are unable to determine git revision when building bot --- geniusyield-server-lib/CHANGELOG.md | 3 ++- geniusyield-server-lib/src/GeniusYield/Server/Constants.hs | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/geniusyield-server-lib/CHANGELOG.md b/geniusyield-server-lib/CHANGELOG.md index ad0bd1f..38e3002 100644 --- a/geniusyield-server-lib/CHANGELOG.md +++ b/geniusyield-server-lib/CHANGELOG.md @@ -1,8 +1,9 @@ # Revision history for geniusyield-server-lib -## 0.11.1 -- 2024-10-28 +## 0.11.1 -- 2024-10-30 * Adds support of [`prices`](https://openapi.taptools.io/#tag/Market-Tokens/paths/~1token~1prices/post) TapTools endpoint. +* In case project is being built from an environment which lacks access to corresponding `.git` directory, "UNKNOWN_REVISION" is used for `revision` field when querying for settings of the server. ## 0.11.0 -- 2024-08-30 diff --git a/geniusyield-server-lib/src/GeniusYield/Server/Constants.hs b/geniusyield-server-lib/src/GeniusYield/Server/Constants.hs index 0f57a0b..8b7d104 100644 --- a/geniusyield-server-lib/src/GeniusYield/Server/Constants.hs +++ b/geniusyield-server-lib/src/GeniusYield/Server/Constants.hs @@ -9,4 +9,4 @@ import RIO -- | The git hash of the current commit. gitHash ∷ String -gitHash = $$tGitInfoCwd & giHash +gitHash = either (const "UNKNOWN_REVISION") giHash $$tGitInfoCwdTry