Skip to content

Commit 4c298b8

Browse files
newhoggynewhoggy
committed
Check CLI argument bounds
1 parent ec57638 commit 4c298b8

File tree

10 files changed

+102
-38
lines changed

10 files changed

+102
-38
lines changed

‎cardano-cli/cardano-cli.cabal

+1
Original file line numberDiff line numberDiff line change
@@ -65,6 +65,7 @@ library
6565
Cardano.CLI.Byron.Vote
6666

6767
Cardano.CLI.IO.Lazy
68+
Cardano.CLI.OptParse
6869

6970
Cardano.CLI.Shelley.Commands
7071
Cardano.CLI.Shelley.Key

‎cardano-cli/src/Cardano/CLI/Byron/Parsers.hs

+3-2
Original file line numberDiff line numberDiff line change
@@ -66,6 +66,7 @@ import Cardano.CLI.Byron.Commands
6666
import Cardano.CLI.Byron.Genesis
6767
import Cardano.CLI.Byron.Key
6868
import Cardano.CLI.Byron.Tx
69+
import qualified Cardano.CLI.OptParse as Opt
6970
import Cardano.CLI.Run (ClientCommand (ByronCommand))
7071
import Cardano.CLI.Shelley.Commands (ByronKeyFormat (..))
7172
import Cardano.CLI.Types
@@ -665,9 +666,9 @@ pNetworkId =
665666
pTestnetMagic :: Parser NetworkMagic
666667
pTestnetMagic =
667668
NetworkMagic <$>
668-
Opt.option Opt.auto
669+
Opt.option (Opt.bounded "TESTNET_MAGIC")
669670
( Opt.long "testnet-magic"
670-
<> Opt.metavar "NATURAL"
671+
<> Opt.metavar "TESTNET_MAGIC"
671672
<> Opt.help "Specify a testnet magic id."
672673
)
673674

‎cardano-cli/src/Cardano/CLI/Optparse.hs

+18
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
1+
{-# LANGUAGE RankNTypes #-}
2+
{-# LANGUAGE ScopedTypeVariables #-}
3+
{-# LANGUAGE TypeApplications #-}
4+
5+
module Cardano.CLI.OptParse
6+
( bounded,
7+
) where
8+
9+
import Control.Monad (when)
10+
import Options.Applicative (ReadM, eitherReader)
11+
import qualified Text.Read as Read
12+
13+
bounded :: forall a. (Bounded a, Integral a, Show a) => String -> ReadM a
14+
bounded t = eitherReader $ \s -> do
15+
i <- Read.readEither @Integer s
16+
when (i < fromIntegral (minBound @a)) $ Left $ t <> " must not be less than " <> show (minBound @a)
17+
when (i > fromIntegral (maxBound @a)) $ Left $ t <> " must not greater than " <> show (maxBound @a)
18+
pure (fromIntegral i)

‎cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs

+18-17
Original file line numberDiff line numberDiff line change
@@ -58,6 +58,7 @@ import Cardano.Api
5858
import Cardano.Api.Shelley
5959

6060
import Cardano.Chain.Common (BlockCount (BlockCount))
61+
import qualified Cardano.CLI.OptParse as Opt
6162
import Cardano.CLI.Shelley.Commands
6263
import Cardano.CLI.Shelley.Key (PaymentVerifier (..), StakeVerifier (..),
6364
VerificationKeyOrFile (..), VerificationKeyOrHashOrFile (..),
@@ -1728,28 +1729,28 @@ pSigningKeyFile fdir =
17281729
pKesPeriod :: Parser KESPeriod
17291730
pKesPeriod =
17301731
KESPeriod <$>
1731-
Opt.option Opt.auto
1732+
Opt.option (Opt.bounded "KES_PERIOD")
17321733
( Opt.long "kes-period"
1733-
<> Opt.metavar "NATURAL"
1734+
<> Opt.metavar "KES_PERIOD"
17341735
<> Opt.help "The start of the KES key validity period."
17351736
)
17361737

17371738
pEpochNo :: Parser EpochNo
17381739
pEpochNo =
17391740
EpochNo <$>
1740-
Opt.option Opt.auto
1741+
Opt.option (Opt.bounded "EPOCH")
17411742
( Opt.long "epoch"
1742-
<> Opt.metavar "NATURAL"
1743+
<> Opt.metavar "EPOCH"
17431744
<> Opt.help "The epoch number."
17441745
)
17451746

17461747

17471748
pEpochNoUpdateProp :: Parser EpochNo
17481749
pEpochNoUpdateProp =
17491750
EpochNo <$>
1750-
Opt.option Opt.auto
1751+
Opt.option (Opt.bounded "EPOCH")
17511752
( Opt.long "epoch"
1752-
<> Opt.metavar "NATURAL"
1753+
<> Opt.metavar "EPOCH"
17531754
<> Opt.help "The epoch number in which the update proposal is valid."
17541755
)
17551756

@@ -2052,9 +2053,9 @@ pNetworkId =
20522053
pTestnetMagic :: Parser NetworkMagic
20532054
pTestnetMagic =
20542055
NetworkMagic <$>
2055-
Opt.option Opt.auto
2056+
Opt.option (Opt.bounded "TESTNET_MAGIC")
20562057
( Opt.long "testnet-magic"
2057-
<> Opt.metavar "NATURAL"
2058+
<> Opt.metavar "TESTNET_MAGIC"
20582059
<> Opt.help "Specify a testnet magic id."
20592060
)
20602061

@@ -2364,12 +2365,12 @@ pPolicyId =
23642365

23652366
pInvalidBefore :: Parser SlotNo
23662367
pInvalidBefore = fmap SlotNo $ asum
2367-
[ Opt.option Opt.auto $ mconcat
2368+
[ Opt.option (Opt.bounded "SLOT") $ mconcat
23682369
[ Opt.long "invalid-before"
23692370
, Opt.metavar "SLOT"
23702371
, Opt.help "Time that transaction is valid from (in slots)."
23712372
]
2372-
, Opt.option Opt.auto $ mconcat
2373+
, Opt.option (Opt.bounded "SLOT") $ mconcat
23732374
[ Opt.long "lower-bound"
23742375
, Opt.metavar "SLOT"
23752376
, Opt.help $ mconcat
@@ -2383,12 +2384,12 @@ pInvalidBefore = fmap SlotNo $ asum
23832384
pInvalidHereafter :: Parser SlotNo
23842385
pInvalidHereafter =
23852386
fmap SlotNo $ asum
2386-
[ Opt.option Opt.auto $ mconcat
2387+
[ Opt.option (Opt.bounded "SLOT") $ mconcat
23872388
[ Opt.long "invalid-hereafter"
23882389
, Opt.metavar "SLOT"
23892390
, Opt.help "Time that transaction is valid until (in slots)."
23902391
]
2391-
, Opt.option Opt.auto $ mconcat
2392+
, Opt.option (Opt.bounded "SLOT") $ mconcat
23922393
[ Opt.long "upper-bound"
23932394
, Opt.metavar "SLOT"
23942395
, Opt.help $ mconcat
@@ -2397,7 +2398,7 @@ pInvalidHereafter =
23972398
]
23982399
, Opt.internal
23992400
]
2400-
, Opt.option Opt.auto $ mconcat
2401+
, Opt.option (Opt.bounded "SLOT") $ mconcat
24012402
[ Opt.long "ttl"
24022403
, Opt.metavar "SLOT"
24032404
, Opt.help "Time to live (in slots) (deprecated; use --invalid-hereafter instead)."
@@ -3049,9 +3050,9 @@ pPoolDeposit =
30493050
pEpochBoundRetirement :: Parser EpochNo
30503051
pEpochBoundRetirement =
30513052
EpochNo <$>
3052-
Opt.option Opt.auto
3053+
Opt.option (Opt.bounded "EPOCH_BOUNDARY")
30533054
( Opt.long "pool-retirement-epoch-boundary"
3054-
<> Opt.metavar "INT"
3055+
<> Opt.metavar "EPOCH_BOUNDARY"
30553056
<> Opt.help "Epoch bound on pool retirement."
30563057
)
30573058

@@ -3246,9 +3247,9 @@ defaultByronEpochSlots = 21600
32463247
pEpochSlots :: Parser EpochSlots
32473248
pEpochSlots =
32483249
EpochSlots <$>
3249-
Opt.option Opt.auto
3250+
Opt.option (Opt.bounded "SLOTS")
32503251
( Opt.long "epoch-slots"
3251-
<> Opt.metavar "NATURAL"
3252+
<> Opt.metavar "SLOTS"
32523253
<> Opt.help "The number of slots per epoch for the Byron era."
32533254
<> Opt.value defaultByronEpochSlots -- Default to the mainnet value.
32543255
<> Opt.showDefault

‎cardano-node/cardano-node.cabal

+1
Original file line numberDiff line numberDiff line change
@@ -69,6 +69,7 @@ library
6969
Cardano.Node.Configuration.TopologyP2P
7070
Cardano.Node.Handlers.Shutdown
7171
Cardano.Node.Handlers.TopLevel
72+
Cardano.Node.OptParse
7273
Cardano.Node.Orphans
7374
Cardano.Node.Protocol
7475
Cardano.Node.Protocol.Alonzo

‎cardano-node/src/Cardano/Node/Handlers/Shutdown.hs

+17-16
Original file line numberDiff line numberDiff line change
@@ -26,12 +26,12 @@ module Cardano.Node.Handlers.Shutdown
2626
)
2727
where
2828

29-
import Control.Applicative (Alternative (..))
3029
import Control.Concurrent.Async (race_)
3130
import Control.Exception (try)
3231
import Control.Exception.Base (throwIO)
3332
import Control.Monad (void, when)
3433
import Data.Aeson (FromJSON, ToJSON)
34+
import Data.Foldable (asum)
3535
import Data.Text (Text, pack)
3636
import Generic.Data.Orphans ()
3737
import GHC.Generics (Generic)
@@ -50,6 +50,7 @@ import Ouroboros.Consensus.Util.ResourceRegistry (ResourceRegistry)
5050
import Ouroboros.Consensus.Util.STM (Watcher (..), forkLinkedWatcher)
5151
import Ouroboros.Network.Block (BlockNo (..), HasHeader, SlotNo (..), pointSlot)
5252

53+
import qualified Cardano.Node.OptParse as Opt
5354

5455
data ShutdownOn
5556
= ASlot !SlotNo
@@ -61,21 +62,21 @@ deriving instance FromJSON ShutdownOn
6162
deriving instance ToJSON ShutdownOn
6263

6364
parseShutdownOn :: Opt.Parser ShutdownOn
64-
parseShutdownOn =
65-
Opt.option (ASlot . SlotNo <$> Opt.auto) (
66-
Opt.long "shutdown-on-slot-synced"
67-
<> Opt.metavar "SLOT"
68-
<> Opt.help "Shut down the process after ChainDB is synced up to the specified slot"
69-
<> Opt.hidden
70-
)
71-
<|>
72-
Opt.option (ABlock . BlockNo <$> Opt.auto) (
73-
Opt.long "shutdown-on-block-synced"
74-
<> Opt.metavar "BLOCK"
75-
<> Opt.help "Shut down the process after ChainDB is synced up to the specified block"
76-
<> Opt.hidden
77-
)
78-
<|> pure NoShutdown
65+
parseShutdownOn = asum
66+
[ Opt.option (ASlot . SlotNo <$> Opt.bounded "SLOT") $ mconcat
67+
[ Opt.long "shutdown-on-slot-synced"
68+
, Opt.metavar "SLOT"
69+
, Opt.help "Shut down the process after ChainDB is synced up to the specified slot"
70+
, Opt.hidden
71+
]
72+
, Opt.option (ABlock . BlockNo <$> Opt.bounded "BLOCK") $ mconcat
73+
[ Opt.long "shutdown-on-block-synced"
74+
, Opt.metavar "BLOCK"
75+
, Opt.help "Shut down the process after ChainDB is synced up to the specified block"
76+
, Opt.hidden
77+
]
78+
, pure NoShutdown
79+
]
7980

8081
data ShutdownTrace
8182
= ShutdownRequested

‎cardano-node/src/Cardano/Node/OptParse.hs

+18
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
1+
{-# LANGUAGE RankNTypes #-}
2+
{-# LANGUAGE ScopedTypeVariables #-}
3+
{-# LANGUAGE TypeApplications #-}
4+
5+
module Cardano.Node.OptParse
6+
( bounded,
7+
) where
8+
9+
import Control.Monad (when)
10+
import Options.Applicative (ReadM, eitherReader)
11+
import qualified Text.Read as Read
12+
13+
bounded :: forall a. (Bounded a, Integral a, Show a) => String -> ReadM a
14+
bounded t = eitherReader $ \s -> do
15+
i <- Read.readEither @Integer s
16+
when (i < fromIntegral (minBound @a)) $ Left $ t <> " must not be less than " <> show (minBound @a)
17+
when (i > fromIntegral (maxBound @a)) $ Left $ t <> " must not greater than " <> show (maxBound @a)
18+
pure (fromIntegral i)

‎cardano-submit-api/cardano-submit-api.cabal

+2-1
Original file line numberDiff line numberDiff line change
@@ -64,7 +64,8 @@ library
6464

6565
exposed-modules: Cardano.TxSubmit
6666

67-
other-modules: Cardano.TxSubmit.CLI.Parsers
67+
other-modules: Cardano.TxSubmit.CLI.OptParse
68+
, Cardano.TxSubmit.CLI.Parsers
6869
, Cardano.TxSubmit.CLI.Types
6970
, Cardano.TxSubmit.Config
7071
, Cardano.TxSubmit.ErrorRender

‎cardano-submit-api/src/Cardano/TxSubmit/CLI/OptParse.hs

+18
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
1+
{-# LANGUAGE RankNTypes #-}
2+
{-# LANGUAGE ScopedTypeVariables #-}
3+
{-# LANGUAGE TypeApplications #-}
4+
5+
module Cardano.TxSubmit.CLI.OptParse
6+
( bounded,
7+
) where
8+
9+
import Control.Monad (when)
10+
import Options.Applicative (ReadM, eitherReader)
11+
import qualified Text.Read as Read
12+
13+
bounded :: forall a. (Bounded a, Integral a, Show a) => String -> ReadM a
14+
bounded t = eitherReader $ \s -> do
15+
i <- Read.readEither @Integer s
16+
when (i < fromIntegral (minBound @a)) $ Left $ t <> " must not be less than " <> show (minBound @a)
17+
when (i > fromIntegral (maxBound @a)) $ Left $ t <> " must not greater than " <> show (maxBound @a)
18+
pure (fromIntegral i)

‎cardano-submit-api/src/Cardano/TxSubmit/CLI/Parsers.hs

+6-2
Original file line numberDiff line numberDiff line change
@@ -11,8 +11,12 @@ module Cardano.TxSubmit.CLI.Parsers
1111

1212
import Cardano.Api (AnyConsensusModeParams (..), ConsensusModeParams (..),
1313
EpochSlots (..), NetworkId (..), NetworkMagic (..), SocketPath (..))
14+
1415
import Cardano.TxSubmit.CLI.Types (ConfigFile (..), TxSubmitNodeParams (..))
1516
import Cardano.TxSubmit.Rest.Parsers (pWebserverConfig)
17+
18+
import qualified Cardano.TxSubmit.CLI.OptParse as Opt
19+
1620
import Control.Applicative (Alternative (..), (<**>))
1721
import Data.Word (Word64)
1822
import Options.Applicative (Parser, ParserInfo)
@@ -56,9 +60,9 @@ pNetworkId = pMainnet <|> fmap Testnet pTestnetMagic
5660
)
5761

5862
pTestnetMagic :: Parser NetworkMagic
59-
pTestnetMagic = NetworkMagic <$> Opt.option Opt.auto
63+
pTestnetMagic = NetworkMagic <$> Opt.option (Opt.bounded "TESTNET_MAGIC")
6064
( Opt.long "testnet-magic"
61-
<> Opt.metavar "NATURAL"
65+
<> Opt.metavar "TESTNET_MAGIC"
6266
<> Opt.help "Specify a testnet magic id."
6367
)
6468

0 commit comments

Comments
 (0)