diff --git a/lib/cli/src/Cardano/CLI.hs b/lib/cli/src/Cardano/CLI.hs index b334aac261e..d1dd77146ef 100644 --- a/lib/cli/src/Cardano/CLI.hs +++ b/lib/cli/src/Cardano/CLI.hs @@ -45,6 +45,7 @@ module Cardano.CLI -- * Option & Argument Parsers , optionT , argumentT + , cacheListPoolsOption , databaseOption , hostPreferenceOption , listenOption @@ -197,6 +198,8 @@ import Control.Applicative ( optional, some, (<|>) ) import Control.Arrow ( first, left ) +import Control.Cache + ( CacheConfig (..) ) import Control.Monad ( forM_, forever, join, unless, void, when ) import Control.Monad.IO.Class @@ -1142,7 +1145,7 @@ cmdNetworkClock mkClient = runClient wPort Aeson.encodePretty $ networkClock mkClient forceNtpCheck {------------------------------------------------------------------------------- - Commands - 'launch' + Commands - 'serve' -------------------------------------------------------------------------------} -- | Initialize a directory to store data such as blocks or the wallet databases @@ -1405,6 +1408,23 @@ walletIdArgument :: Parser WalletId walletIdArgument = argumentT $ mempty <> metavar "WALLET_ID" +-- | [--no-cache-listpools|--cache-listpools-ttl DURATION] +cacheListPoolsOption :: Parser CacheConfig +cacheListPoolsOption = no <|> fmap (CacheTTL . getQuantity) ttl + where + ttl :: Parser (Quantity "second" NominalDiffTime) + ttl = fmap Quantity $ optionT $ mempty + <> long "cache-listpools-ttl" + <> metavar "TTL" + <> help ( "Cache time to live (TTL) for stake-pools listing. " + <> "Expressed in seconds with a trailing 's'. " + ) + <> value 3600 + <> showDefaultWith showT + no = flag' NoCache $ mempty + <> long "no-cache-listpools" + <> help "Do not cache the stake-pools listing." + -- | [--stake=STAKE] stakeOption :: Parser (Maybe Coin) stakeOption = optional $ optionT $ mempty diff --git a/lib/cli/test/unit/Cardano/CLISpec.hs b/lib/cli/test/unit/Cardano/CLISpec.hs index 3d963962f8e..e4e4b7ac3ad 100644 --- a/lib/cli/test/unit/Cardano/CLISpec.hs +++ b/lib/cli/test/unit/Cardano/CLISpec.hs @@ -18,6 +18,7 @@ import Prelude import Cardano.CLI ( Port (..) , TxId + , cacheListPoolsOption , cli , cmdAddress , cmdKey @@ -46,6 +47,10 @@ import Cardano.Wallet.Primitive.Types ( PoolMetadataSource ) import Cardano.Wallet.Primitive.Types.Tx ( TxMetadata (..), TxMetadataValue (..) ) +import Control.Cache + ( CacheConfig (..) ) +import Control.Monad + ( forM_ ) import Data.Proxy ( Proxy (..) ) import Data.Quantity @@ -271,15 +276,7 @@ spec = do , ("null 3", "{ }", ok (Just (ApiT mempty))) ] - describe "Tx TTL option" $ do - let parse arg = execParserPure defaultPrefs - (info timeToLiveOption mempty) ["--ttl", arg] - let ok ex (Success res) = Just (Quantity ex) == res - ok _ _ = False - let err (Failure _) = True - err _ = False - mapM_ - (\(desc, arg, tst) -> it desc (parse arg `shouldSatisfy` tst)) + let parseTimeTests = [ ("valid integer", "1s", ok 1) , ("valid zero", "0s", ok 0) , ("invalid negative", "-1s", err) @@ -290,6 +287,25 @@ spec = do , ("malformed emptyish", "s", err) , ("malformed leading", "a1s", err) ] + where + ok ex (Success res) = Just (Quantity ex) == res + ok _ _ = False + err (Failure _) = True + err _ = False + + describe "Tx TTL option" $ do + let parse arg = execParserPure defaultPrefs + (info timeToLiveOption mempty) ["--ttl", arg] + forM_ parseTimeTests $ \(desc, arg, tst) -> + it desc $ parse arg `shouldSatisfy` tst + + describe "Cache listpools TTL option" $ do + let parse arg = execParserPure defaultPrefs + (info cacheListPoolsOption mempty) ["--cache-listpools-ttl", arg] + let toMaybe (CacheTTL x) = Just (Quantity x) + toMaybe (NoCache) = Nothing + forM_ parseTimeTests $ \(desc, arg, tst) -> + it desc $ parse arg `shouldSatisfy` (tst . fmap toMaybe) where backspace :: Text diff --git a/lib/core/cardano-wallet-core.cabal b/lib/core/cardano-wallet-core.cabal index 2fb63629b55..323fec87761 100644 --- a/lib/core/cardano-wallet-core.cabal +++ b/lib/core/cardano-wallet-core.cabal @@ -213,6 +213,7 @@ library Cardano.Wallet.Util Cardano.Wallet.Version Cardano.Wallet.Version.TH + Control.Cache Control.Concurrent.Concierge Crypto.Hash.Utils Data.Function.Utils diff --git a/lib/shelley/src/Control/Cache.hs b/lib/core/src/Control/Cache.hs similarity index 100% rename from lib/shelley/src/Control/Cache.hs rename to lib/core/src/Control/Cache.hs diff --git a/lib/shelley/cardano-wallet.cabal b/lib/shelley/cardano-wallet.cabal index 2e6ee888aa8..649c72a021e 100644 --- a/lib/shelley/cardano-wallet.cabal +++ b/lib/shelley/cardano-wallet.cabal @@ -105,7 +105,6 @@ library Cardano.Wallet.Shelley.Launch Cardano.Wallet.Shelley.Launch.Cluster Cardano.Wallet.Shelley.Pools - Control.Cache executable cardano-wallet default-language: diff --git a/lib/shelley/exe/cardano-wallet.hs b/lib/shelley/exe/cardano-wallet.hs index 56260d84b46..2551104bca6 100644 --- a/lib/shelley/exe/cardano-wallet.hs +++ b/lib/shelley/exe/cardano-wallet.hs @@ -34,6 +34,7 @@ import Cardano.BM.Trace import Cardano.CLI ( LogOutput (..) , LoggingOptions + , cacheListPoolsOption , cli , cmdAddress , cmdKey @@ -204,17 +205,6 @@ cmdServe = command "serve" $ info (helper <*> helper' <*> cmd) $ mempty where helper' = helperTracing tracerDescriptions - cacheListPoolsOption = (CacheTTL <$> option auto - ( long "cache-listpools-ttl" - <> metavar "TTL" - <> help "Cache time to live (TTL) for stake-pools listing (number in seconds)." - <> value (let one_hour = 60*60 in one_hour) - <> showDefaultWith showT - )) <|> flag' NoCache - ( long "no-cache-listpools" - <> help "Do not cache the stake-pools listing." - ) - cmd = fmap exec $ ServeArgs <$> hostPreferenceOption <*> listenOption