From 86beac78a10dbc4ad0ab787af1daf39af2e8c522 Mon Sep 17 00:00:00 2001
From: Jordan Millar <jordan.millar@iohk.io>
Date: Fri, 6 Mar 2026 09:28:17 -0400
Subject: [PATCH] Fix pUrl to use parser error instead of runtime crash

Replace `error` call in `pUrl` with `Opt.readerError`, giving users a
clean parse error when the URL exceeds 128 bytes. Correct the limit
from 64 to 128 to match the ledger's Conway+ `textDecCBOR 128`.

Add property tests for `parseLovelace` and `pUrl`.
---
 cardano-cli/cardano-cli.cabal                 |  1 +
 .../src/Cardano/CLI/EraBased/Common/Option.hs | 21 +++++----
 .../test/cardano-cli-test/Test/Cli/Parser.hs  | 46 +++++++++++++++++++
 3 files changed, 59 insertions(+), 9 deletions(-)

diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal
index 53ac7fa587..32c57bf40f 100644
--- a/cardano-cli/cardano-cli.cabal
+++ b/cardano-cli/cardano-cli.cabal
@@ -376,6 +376,7 @@ test-suite cardano-cli-test
     microlens-aeson,
     mmorph,
     monad-control,
+    optparse-applicative-fork,
     regex-tdfa,
     resourcet,
     tasty,
diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Common/Option.hs b/cardano-cli/src/Cardano/CLI/EraBased/Common/Option.hs
index 8941a0be70..237845fabf 100644
--- a/cardano-cli/src/Cardano/CLI/EraBased/Common/Option.hs
+++ b/cardano-cli/src/Cardano/CLI/EraBased/Common/Option.hs
@@ -855,15 +855,18 @@ pConstitutionHash =
 
 pUrl :: String -> String -> Parser L.Url
 pUrl l h =
-  let toUrl urlText =
-        fromMaybe (error "Url longer than 64 bytes") $
-          L.textToUrl (Text.length urlText) urlText
-   in fmap toUrl . Opt.strOption $
-        mconcat
-          [ Opt.long l
-          , Opt.metavar "TEXT"
-          , Opt.help h
-          ]
+  Opt.option urlReader $
+    mconcat
+      [ Opt.long l
+      , Opt.metavar "TEXT"
+      , Opt.help h
+      ]
+ where
+  urlReader = do
+    urlStr <- readerAsk
+    let urlText = Text.pack urlStr
+    maybe (Opt.readerError $ "URL exceeds the maximum of 128 bytes: " <> urlStr) pure $
+      L.textToUrl 128 urlText
 
 pGovActionDeposit :: Parser Lovelace
 pGovActionDeposit =
diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Parser.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Parser.hs
index 41605a2a75..b3f582d714 100644
--- a/cardano-cli/test/cardano-cli-test/Test/Cli/Parser.hs
+++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Parser.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -6,22 +7,29 @@ module Test.Cli.Parser
   ( hprop_integral_reader
   , hprop_integral_pair_reader_positive
   , hprop_integral_pair_reader_negative
+  , hprop_lovelace_reader
+  , hprop_url_reader
   )
 where
 
+import Cardano.Api.Ledger qualified as L
 import Cardano.Api.Parser.Text qualified as P
 import Cardano.Api.Pretty (textShow)
 
 import Cardano.CLI.EraBased.Common.Option
   ( integralParsecParser
+  , pUrl
   , pairIntegralParsecParser
+  , parseLovelace
   )
 
 import Data.Bits (Bits)
 import Data.Data (Proxy (..), Typeable)
 import Data.Either (isLeft, isRight)
+import Data.Maybe (isJust, isNothing)
 import Data.Text (Text)
 import Data.Word (Word16)
+import Options.Applicative qualified as Opt
 
 import Test.Cardano.CLI.Util (watchdogProp)
 
@@ -97,3 +105,41 @@ hprop_integral_pair_reader_negative =
  where
   parse :: (Typeable a, Integral a, Bits a) => Text -> Either String (a, a)
   parse = P.runParser pairIntegralParsecParser
+
+-- | Execute me with:
+-- @cabal test cardano-cli-test --test-options '-p "/lovelace reader/"'@
+hprop_lovelace_reader :: Property
+hprop_lovelace_reader =
+  watchdogProp . propertyOnce $ do
+    parse "0" === Right 0
+    parse "42" === Right 42
+    parse "1000000" === Right 1000000
+    parse "18446744073709551615" === Right (L.Coin 18446744073709551615)
+    assertWith (parse "18446744073709551616") isLeft
+    assertWith (parse "-1") isLeft
+    assertWith (parse "abc") isLeft
+    assertWith (parse "") isLeft
+ where
+  parse :: Text -> Either String L.Coin
+  parse = P.runParser parseLovelace
+
+-- | Execute me with:
+-- @cabal test cardano-cli-test --test-options '-p "/url reader/"'@
+hprop_url_reader :: Property
+hprop_url_reader =
+  watchdogProp . propertyOnce $ do
+    -- Valid short URL
+    assertWith (parseUrl "http://example.com") isJust
+    -- Exactly 128 bytes should succeed
+    assertWith (parseUrl (replicate 128 'x')) isJust
+    -- 129 bytes should fail
+    assertWith (parseUrl (replicate 129 'x')) isNothing
+    -- Empty URL should succeed (the ledger allows it)
+    assertWith (parseUrl "") isJust
+ where
+  parseUrl :: String -> Maybe L.Url
+  parseUrl url =
+    Opt.getParseResult $
+      Opt.execParserPure Opt.defaultPrefs urlParserInfo ["--test-url", url]
+  urlParserInfo :: Opt.ParserInfo L.Url
+  urlParserInfo = Opt.info (pUrl "test-url" "Test URL") mempty