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/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 diff --git a/geniusyield-server-lib/CHANGELOG.md b/geniusyield-server-lib/CHANGELOG.md index 4009aa9..38e3002 100644 --- a/geniusyield-server-lib/CHANGELOG.md +++ b/geniusyield-server-lib/CHANGELOG.md @@ -1,5 +1,10 @@ # Revision history for geniusyield-server-lib +## 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 * 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 ed77614..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.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 @@ -85,6 +85,7 @@ library , binary , bytestring , cardano-api + , containers , deriving-aeson , envy , fast-logger 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 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..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 @@ -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 @@ -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"