Check CLI argument bounds

IntersectMBO · Feb 27, 2023 · 9d91b4c · 9d91b4c
1 parent ec57638
commit 9d91b4c
Show file tree

Hide file tree

Showing 10 changed files with 120 additions and 59 deletions.
diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal
@@ -65,6 +65,7 @@ library
                         Cardano.CLI.Byron.Vote
 
                         Cardano.CLI.IO.Lazy
+                        Cardano.CLI.OptParse
 
                         Cardano.CLI.Shelley.Commands
                         Cardano.CLI.Shelley.Key

diff --git a/cardano-cli/src/Cardano/CLI/Byron/Parsers.hs b/cardano-cli/src/Cardano/CLI/Byron/Parsers.hs
@@ -66,6 +66,7 @@ import           Cardano.CLI.Byron.Commands
 import           Cardano.CLI.Byron.Genesis
 import           Cardano.CLI.Byron.Key
 import           Cardano.CLI.Byron.Tx
+import qualified Cardano.CLI.OptParse as Opt
 import           Cardano.CLI.Run (ClientCommand (ByronCommand))
 import           Cardano.CLI.Shelley.Commands (ByronKeyFormat (..))
 import           Cardano.CLI.Types
@@ -664,12 +665,11 @@ pNetworkId =
 
 pTestnetMagic :: Parser NetworkMagic
 pTestnetMagic =
-  NetworkMagic <$>
-    Opt.option Opt.auto
-      (  Opt.long "testnet-magic"
-      <> Opt.metavar "NATURAL"
-      <> Opt.help "Specify a testnet magic id."
-      )
+  fmap NetworkMagic $ Opt.option (Opt.bounded "TESTNET_MAGIC") $ mconcat
+    [ Opt.long "testnet-magic"
+    , Opt.metavar "TESTNET_MAGIC"
+    , Opt.help "Specify a testnet magic id."
+    ]
 
 parseNewSigningKeyFile :: String -> Parser NewSigningKeyFile
 parseNewSigningKeyFile opt =

diff --git a/cardano-cli/src/Cardano/CLI/Optparse.hs b/cardano-cli/src/Cardano/CLI/Optparse.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Cardano.CLI.OptParse
+  ( bounded,
+  ) where
+
+import           Control.Monad (when)
+import           Options.Applicative (ReadM, eitherReader)
+import qualified Text.Read as Read
+
+bounded :: forall a. (Bounded a, Integral a, Show a) => String -> ReadM a
+bounded t = eitherReader $ \s -> do
+  i <- Read.readEither @Integer s
+  when (i < fromIntegral (minBound @a)) $ Left $ t <> " must not be less than " <> show (minBound @a)
+  when (i > fromIntegral (maxBound @a)) $ Left $ t <> " must not greater than " <> show (maxBound @a)
+  pure (fromIntegral i)
diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs
@@ -58,6 +58,7 @@ import           Cardano.Api
 import           Cardano.Api.Shelley
 
 import           Cardano.Chain.Common (BlockCount (BlockCount))
+import qualified Cardano.CLI.OptParse as Opt
 import           Cardano.CLI.Shelley.Commands
 import           Cardano.CLI.Shelley.Key (PaymentVerifier (..), StakeVerifier (..),
                    VerificationKeyOrFile (..), VerificationKeyOrHashOrFile (..),
@@ -1727,29 +1728,28 @@ pSigningKeyFile fdir =
 
 pKesPeriod :: Parser KESPeriod
 pKesPeriod =
-  KESPeriod <$>
-    Opt.option Opt.auto
-      (  Opt.long "kes-period"
-      <> Opt.metavar "NATURAL"
-      <> Opt.help "The start of the KES key validity period."
-      )
+  fmap KESPeriod $ Opt.option (Opt.bounded "KES_PERIOD") $ mconcat
+    [ Opt.long "kes-period"
+    , Opt.metavar "KES_PERIOD"
+    , Opt.help "The start of the KES key validity period."
+    ]
 
 pEpochNo :: Parser EpochNo
 pEpochNo =
   EpochNo <$>
-    Opt.option Opt.auto
+    Opt.option (Opt.bounded "EPOCH")
       (  Opt.long "epoch"
-      <> Opt.metavar "NATURAL"
+      <> Opt.metavar "EPOCH"
       <> Opt.help "The epoch number."
       )
 
 
 pEpochNoUpdateProp :: Parser EpochNo
 pEpochNoUpdateProp =
   EpochNo <$>
-    Opt.option Opt.auto
+    Opt.option (Opt.bounded "EPOCH")
       (  Opt.long "epoch"
-      <> Opt.metavar "NATURAL"
+      <> Opt.metavar "EPOCH"
       <> Opt.help "The epoch number in which the update proposal is valid."
       )
 
@@ -2051,12 +2051,11 @@ pNetworkId =
 
 pTestnetMagic :: Parser NetworkMagic
 pTestnetMagic =
-  NetworkMagic <$>
-    Opt.option Opt.auto
-      (  Opt.long "testnet-magic"
-      <> Opt.metavar "NATURAL"
-      <> Opt.help "Specify a testnet magic id."
-      )
+  fmap NetworkMagic $ Opt.option (Opt.bounded "TESTNET_MAGIC") $ mconcat
+    [ Opt.long "testnet-magic"
+    , Opt.metavar "TESTNET_MAGIC"
+    , Opt.help "Specify a testnet magic id."
+    ]
 
 pTxSubmitFile :: Parser FilePath
 pTxSubmitFile =
@@ -2364,12 +2363,12 @@ pPolicyId =
 
 pInvalidBefore :: Parser SlotNo
 pInvalidBefore = fmap SlotNo $ asum
-  [ Opt.option Opt.auto $ mconcat
+  [ Opt.option (Opt.bounded "SLOT") $ mconcat
     [ Opt.long "invalid-before"
     , Opt.metavar "SLOT"
     , Opt.help "Time that transaction is valid from (in slots)."
     ]
-  , Opt.option Opt.auto $ mconcat
+  , Opt.option (Opt.bounded "SLOT") $ mconcat
     [ Opt.long "lower-bound"
     , Opt.metavar "SLOT"
     , Opt.help $ mconcat
@@ -2383,12 +2382,12 @@ pInvalidBefore = fmap SlotNo $ asum
 pInvalidHereafter :: Parser SlotNo
 pInvalidHereafter =
   fmap SlotNo $ asum
-  [ Opt.option Opt.auto $ mconcat
+  [ Opt.option (Opt.bounded "SLOT") $ mconcat
     [ Opt.long "invalid-hereafter"
     , Opt.metavar "SLOT"
     , Opt.help "Time that transaction is valid until (in slots)."
     ]
-  , Opt.option Opt.auto $ mconcat
+  , Opt.option (Opt.bounded "SLOT") $ mconcat
     [ Opt.long "upper-bound"
     , Opt.metavar "SLOT"
     , Opt.help $ mconcat
@@ -2397,7 +2396,7 @@ pInvalidHereafter =
       ]
     , Opt.internal
     ]
-  , Opt.option Opt.auto $ mconcat
+  , Opt.option (Opt.bounded "SLOT") $ mconcat
     [ Opt.long "ttl"
     , Opt.metavar "SLOT"
     , Opt.help "Time to live (in slots) (deprecated; use --invalid-hereafter instead)."
@@ -3049,9 +3048,9 @@ pPoolDeposit =
 pEpochBoundRetirement :: Parser EpochNo
 pEpochBoundRetirement =
     EpochNo <$>
-    Opt.option Opt.auto
+    Opt.option (Opt.bounded "EPOCH_BOUNDARY")
       (  Opt.long "pool-retirement-epoch-boundary"
-      <> Opt.metavar "INT"
+      <> Opt.metavar "EPOCH_BOUNDARY"
       <> Opt.help "Epoch bound on pool retirement."
       )
 
@@ -3245,14 +3244,13 @@ defaultByronEpochSlots = 21600
 
 pEpochSlots :: Parser EpochSlots
 pEpochSlots =
-  EpochSlots <$>
-    Opt.option Opt.auto
-      (  Opt.long "epoch-slots"
-      <> Opt.metavar "NATURAL"
-      <> Opt.help "The number of slots per epoch for the Byron era."
-      <> Opt.value defaultByronEpochSlots -- Default to the mainnet value.
-      <> Opt.showDefault
-      )
+  fmap EpochSlots $ Opt.option (Opt.bounded "SLOTS") $ mconcat
+    [ Opt.long "epoch-slots"
+    , Opt.metavar "SLOTS"
+    , Opt.help "The number of slots per epoch for the Byron era."
+    , Opt.value defaultByronEpochSlots -- Default to the mainnet value.
+    , Opt.showDefault
+    ]
 
 pProtocolVersion :: Parser (Natural, Natural)
 pProtocolVersion =

diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal
@@ -69,6 +69,7 @@ library
                         Cardano.Node.Configuration.TopologyP2P
                         Cardano.Node.Handlers.Shutdown
                         Cardano.Node.Handlers.TopLevel
+                        Cardano.Node.OptParse
                         Cardano.Node.Orphans
                         Cardano.Node.Protocol
                         Cardano.Node.Protocol.Alonzo

diff --git a/cardano-node/src/Cardano/Node/Handlers/Shutdown.hs b/cardano-node/src/Cardano/Node/Handlers/Shutdown.hs
@@ -26,12 +26,12 @@ module Cardano.Node.Handlers.Shutdown
   )
 where
 
-import           Control.Applicative (Alternative (..))
 import           Control.Concurrent.Async (race_)
 import           Control.Exception (try)
 import           Control.Exception.Base (throwIO)
 import           Control.Monad (void, when)
 import           Data.Aeson (FromJSON, ToJSON)
+import           Data.Foldable (asum)
 import           Data.Text (Text, pack)
 import           Generic.Data.Orphans ()
 import           GHC.Generics (Generic)
@@ -50,6 +50,7 @@ import           Ouroboros.Consensus.Util.ResourceRegistry (ResourceRegistry)
 import           Ouroboros.Consensus.Util.STM (Watcher (..), forkLinkedWatcher)
 import           Ouroboros.Network.Block (BlockNo (..), HasHeader, SlotNo (..), pointSlot)
 
+import qualified Cardano.Node.OptParse as Opt
 
 data ShutdownOn
   = ASlot  !SlotNo
@@ -61,21 +62,21 @@ deriving instance FromJSON ShutdownOn
 deriving instance ToJSON ShutdownOn
 
 parseShutdownOn :: Opt.Parser ShutdownOn
-parseShutdownOn =
-    Opt.option (ASlot . SlotNo <$> Opt.auto) (
-         Opt.long "shutdown-on-slot-synced"
-      <> Opt.metavar "SLOT"
-      <> Opt.help "Shut down the process after ChainDB is synced up to the specified slot"
-      <> Opt.hidden
-    )
-    <|>
-    Opt.option (ABlock . BlockNo <$> Opt.auto) (
-         Opt.long "shutdown-on-block-synced"
-      <> Opt.metavar "BLOCK"
-      <> Opt.help "Shut down the process after ChainDB is synced up to the specified block"
-      <> Opt.hidden
-    )
-    <|> pure NoShutdown
+parseShutdownOn = asum
+  [ Opt.option (ASlot . SlotNo <$> Opt.bounded "SLOT") $ mconcat
+    [ Opt.long "shutdown-on-slot-synced"
+    , Opt.metavar "SLOT"
+    , Opt.help "Shut down the process after ChainDB is synced up to the specified slot"
+    , Opt.hidden
+    ]
+  , Opt.option (ABlock . BlockNo <$> Opt.bounded "BLOCK") $ mconcat
+    [ Opt.long "shutdown-on-block-synced"
+    , Opt.metavar "BLOCK"
+    , Opt.help "Shut down the process after ChainDB is synced up to the specified block"
+    , Opt.hidden
+    ]
+  , pure NoShutdown
+  ]
 
 data ShutdownTrace
   = ShutdownRequested

diff --git a/cardano-node/src/Cardano/Node/OptParse.hs b/cardano-node/src/Cardano/Node/OptParse.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Cardano.Node.OptParse
+  ( bounded,
+  ) where
+
+import           Control.Monad (when)
+import           Options.Applicative (ReadM, eitherReader)
+import qualified Text.Read as Read
+
+bounded :: forall a. (Bounded a, Integral a, Show a) => String -> ReadM a
+bounded t = eitherReader $ \s -> do
+  i <- Read.readEither @Integer s
+  when (i < fromIntegral (minBound @a)) $ Left $ t <> " must not be less than " <> show (minBound @a)
+  when (i > fromIntegral (maxBound @a)) $ Left $ t <> " must not greater than " <> show (maxBound @a)
+  pure (fromIntegral i)
diff --git a/cardano-submit-api/cardano-submit-api.cabal b/cardano-submit-api/cardano-submit-api.cabal
@@ -64,7 +64,8 @@ library
 
   exposed-modules:      Cardano.TxSubmit
 
-  other-modules:        Cardano.TxSubmit.CLI.Parsers
+  other-modules:        Cardano.TxSubmit.CLI.OptParse
+                      , Cardano.TxSubmit.CLI.Parsers
                       , Cardano.TxSubmit.CLI.Types
                       , Cardano.TxSubmit.Config
                       , Cardano.TxSubmit.ErrorRender

diff --git a/cardano-submit-api/src/Cardano/TxSubmit/CLI/OptParse.hs b/cardano-submit-api/src/Cardano/TxSubmit/CLI/OptParse.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Cardano.TxSubmit.CLI.OptParse
+  ( bounded,
+  ) where
+
+import           Control.Monad (when)
+import           Options.Applicative (ReadM, eitherReader)
+import qualified Text.Read as Read
+
+bounded :: forall a. (Bounded a, Integral a, Show a) => String -> ReadM a
+bounded t = eitherReader $ \s -> do
+  i <- Read.readEither @Integer s
+  when (i < fromIntegral (minBound @a)) $ Left $ t <> " must not be less than " <> show (minBound @a)
+  when (i > fromIntegral (maxBound @a)) $ Left $ t <> " must not greater than " <> show (maxBound @a)
+  pure (fromIntegral i)
diff --git a/cardano-submit-api/src/Cardano/TxSubmit/CLI/Parsers.hs b/cardano-submit-api/src/Cardano/TxSubmit/CLI/Parsers.hs
@@ -11,8 +11,12 @@ module Cardano.TxSubmit.CLI.Parsers
 
 import           Cardano.Api (AnyConsensusModeParams (..), ConsensusModeParams (..),
                    EpochSlots (..), NetworkId (..), NetworkMagic (..), SocketPath (..))
+
 import           Cardano.TxSubmit.CLI.Types (ConfigFile (..), TxSubmitNodeParams (..))
 import           Cardano.TxSubmit.Rest.Parsers (pWebserverConfig)
+
+import qualified Cardano.TxSubmit.CLI.OptParse as Opt
+
 import           Control.Applicative (Alternative (..), (<**>))
 import           Data.Word (Word64)
 import           Options.Applicative (Parser, ParserInfo)
@@ -56,11 +60,12 @@ pNetworkId = pMainnet <|> fmap Testnet pTestnetMagic
       )
 
     pTestnetMagic :: Parser NetworkMagic
-    pTestnetMagic = NetworkMagic <$> Opt.option Opt.auto
-      (   Opt.long "testnet-magic"
-      <>  Opt.metavar "NATURAL"
-      <>  Opt.help "Specify a testnet magic id."
-      )
+    pTestnetMagic =
+      fmap NetworkMagic $ Opt.option (Opt.bounded "TESTNET_MAGIC") $ mconcat
+        [ Opt.long "testnet-magic"
+        , Opt.metavar "TESTNET_MAGIC"
+        , Opt.help "Specify a testnet magic id."
+        ]
 
 
 -- TODO: This was ripped from `cardano-cli` because, unfortunately, it's not