Skip to content

Commit

Permalink
Jitter backoff for V1
Browse files Browse the repository at this point in the history
  • Loading branch information
euonymos committed Sep 16, 2023
1 parent 541bc5a commit 9af6f7d
Show file tree
Hide file tree
Showing 7 changed files with 87 additions and 40 deletions.
1 change: 1 addition & 0 deletions .gitignore
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
.cabal
dist-newstyle
dist
dist-*
Expand Down
4 changes: 2 additions & 2 deletions maestro-exe/Maestro/Run/Address.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,8 +10,8 @@ import Maestro.Types.V1.Common (v1UtxoWithSlotToV0)

runAddressAPI :: String -> IO ()
runAddressAPI apiKey = do
mEnvV0 <- mkMaestroEnv @'V0 (T.pack apiKey) Preprod
mEnvV1 <- mkMaestroEnv @'V1 (T.pack apiKey) Preprod
mEnvV0 <- mkMaestroEnv @'V0 (T.pack apiKey) Preprod 50000
mEnvV1 <- mkMaestroEnv @'V1 (T.pack apiKey) Preprod 50000
let addrs = undefined -- Mention list of addresses.
utxos <- V0.allPages $ flip (V0.utxosAtMultiAddresses mEnvV0 Nothing Nothing) addrs
let utxosSorted = sort utxos
Expand Down
68 changes: 46 additions & 22 deletions maestro-exe/Main.hs
Original file line number Diff line number Diff line change
@@ -1,29 +1,53 @@
{-# LANGUAGE ImportQualifiedPost #-}
module Main (main) where

import qualified Data.Text as T
import Maestro.Client.Env
-- import Maestro.Run.Address
import Maestro.Run.Datum
import Maestro.Run.Epochs
import Maestro.Run.General
import Maestro.Run.Pools
import Maestro.Run.Scripts
import Maestro.Run.Tx
import System.Environment (getEnv)
import Control.Concurrent (MVar, ThreadId, newMVar, takeMVar, putMVar, newEmptyMVar, forkFinally)
import Control.Exception (try)
import Maestro.Client.V1
import Maestro.Types.V1
import System.Environment (getEnv)
import Data.Text qualified as T
import Control.Monad (void)
import System.IO.Unsafe (unsafePerformIO)


main :: IO ()

main = do
apiKey <- maestroKey
env <- mkMaestroEnv @'V0 (T.pack apiKey) Preprod
runPoolsAPI env
runTxApi env
runEpochsAPI env
runDatumAPI env
runScriptsAPI env
runGeneralAPI env
-- runAddressAPI apiKey
maestroKey <- T.pack <$> getEnv "MAESTRO_API_KEY"
env <- mkMaestroEnv @'V1 maestroKey Preprod 50000
void $ mapM forkChild $ replicate 30 $ task env
waitForChildren
where
task env = do
addressesUTxOs :: Either MaestroError [UtxoWithSlot] <-
try
$ allPages
$ flip
(
utxosAtMultiAddresses env
(Just True)
(Just False)
) ["addr_test1vqj247zdmh7n9g46ukk59k2yxeslevzhah0uj3t0t450x3ggycpxj"]
case addressesUTxOs of
Left err -> print err
Right utxos -> print $ length utxos

children :: MVar [MVar ()]
children = unsafePerformIO (newMVar [])

waitForChildren :: IO ()
waitForChildren = do
cs <- takeMVar children
case cs of
[] -> return ()
m:ms -> do
putMVar children ms
takeMVar m
waitForChildren

where
maestroKey = getEnv "MAESTRO_API_KEY"
forkChild :: IO () -> IO ThreadId
forkChild io = do
mvar <- newEmptyMVar
childs <- takeMVar children
putMVar children (mvar:childs)
forkFinally io (\_ -> putMVar mvar ())
19 changes: 10 additions & 9 deletions maestro-sdk.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,7 @@ source-repository head
type: git
location: https://github.com/maestro-org/haskell-sdk

common common
common common
ghc-options: -Wall
default-extensions:
GADTs
Expand All @@ -43,7 +43,7 @@ common common

library
import: common
exposed-modules:
exposed-modules:
Maestro.API.V0
Maestro.API.V0.Accounts
Maestro.API.V0.Address
Expand Down Expand Up @@ -114,22 +114,23 @@ library

-- other-modules:
-- other-extensions:
build-depends:
build-depends:
, aeson
, base >= 4.14.3.0 && < 4.19
, bytestring
, aeson
, containers
, data-default-class
, deriving-aeson
, http-api-data
, http-client
, http-client-tls
, http-types
, retry
, servant
, servant-client
, servant-client-core
, text
, time
, http-client
, http-client-tls
, http-types
, http-api-data
, data-default-class

hs-source-dirs: src
default-language: Haskell2010
Expand Down
5 changes: 5 additions & 0 deletions nix/hix.nix
Original file line number Diff line number Diff line change
Expand Up @@ -15,4 +15,9 @@
shell.tools.haskell-language-server = { version = "1.8.0.0"; index-state = "2022-12-17T00:00:00Z"; };

shell.buildInputs = with pkgs; [zlib zlib.dev zlib.out];

shell.shellHook = ''
export CABAL_DIR=$(pwd)/.cabal
'';

}
10 changes: 6 additions & 4 deletions src/Maestro/Client/Env.hs
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,6 @@ module Maestro.Client.Env
import Data.Text (Text)
import Network.HTTP.Client (newManager)
import Network.HTTP.Client.TLS (tlsManagerSettings)

import qualified Servant.Client as Servant

type MaestroToken = Text
Expand Down Expand Up @@ -37,6 +36,9 @@ instance SingMaestroApiVersionI 'V1 where singMaestroApiVersion = SingV1
data MaestroEnv (v :: MaestroApiVersion) = MaestroEnv
{ _maeClientEnv :: !Servant.ClientEnv
, _maeToken :: !MaestroToken
, _maeBaseDelay :: !Int
-- ^ Base delay in microseconds to use with jitter backoff
-- https://hackage.haskell.org/package/retry-0.9.3.1/docs/Control-Retry.html#v:fullJitterBackoff
}

data MaestroNetwork = Mainnet | Preprod | Preview
Expand All @@ -46,10 +48,10 @@ maestroBaseUrl Preview v = "https://preview.gomaestro-api.org/" <> show v
maestroBaseUrl Preprod v = "https://preprod.gomaestro-api.org/" <> show v
maestroBaseUrl Mainnet v = "https://mainnet.gomaestro-api.org/" <> show v

mkMaestroEnv :: forall (apiVersion :: MaestroApiVersion). SingMaestroApiVersionI apiVersion => MaestroToken -> MaestroNetwork -> IO (MaestroEnv apiVersion)
mkMaestroEnv token nid = do
mkMaestroEnv :: forall (apiVersion :: MaestroApiVersion). SingMaestroApiVersionI apiVersion => MaestroToken -> MaestroNetwork -> Int -> IO (MaestroEnv apiVersion)
mkMaestroEnv token nid delay = do
clientEnv <- servantClientEnv $ maestroBaseUrl nid (fromSingMaestroApiVersion $ singMaestroApiVersion @apiVersion)
pure $ MaestroEnv { _maeClientEnv = clientEnv, _maeToken = token }
pure $ MaestroEnv { _maeClientEnv = clientEnv, _maeToken = token, _maeBaseDelay = delay }

servantClientEnv :: String -> IO Servant.ClientEnv
servantClientEnv url = do
Expand Down
20 changes: 17 additions & 3 deletions src/Maestro/Client/V1/Core.hs
Original file line number Diff line number Diff line change
@@ -1,19 +1,33 @@
{-# LANGUAGE LambdaCase #-}
module Maestro.Client.V1.Core
( apiV1Client
, module Maestro.Client.V1.Core.Pagination
) where

import Control.Exception (throwIO)
import Control.Retry (retrying, fullJitterBackoff)
import Maestro.API.V1
import Maestro.Client.Env
import Maestro.Client.Error (fromServantClientError)
import Maestro.Client.Error (fromServantClientError, MaestroError (..))
import Maestro.Client.V1.Core.Pagination
import Servant.API.Generic (fromServant)
import Servant.Client
import Servant.Client.Generic


apiV1ClientAuth :: MaestroEnv 'V1 -> MaestroApiV1Auth (AsClientT IO)
apiV1ClientAuth MaestroEnv{..} = genericClientHoist $ \x -> runClientM x _maeClientEnv >>= either (throwIO . fromServantClientError) pure
apiV1ClientAuth MaestroEnv{..} =
genericClientHoist $
\x ->
retrying
(fullJitterBackoff _maeBaseDelay)
(\_retryStatus -> \case
Right _ -> pure False
Left clientErr -> case fromServantClientError clientErr of
MaestroUsageLimitReached -> pure True
_ -> pure False
)
(\_ -> runClientM x _maeClientEnv)
>>= either (throwIO . fromServantClientError) pure

apiV1Client :: MaestroEnv 'V1 -> MaestroApiV1 (AsClientT IO)
apiV1Client mEnv@MaestroEnv {..} = fromServant $ _apiV1 (apiV1ClientAuth mEnv) _maeToken

0 comments on commit 9af6f7d

Please sign in to comment.