Skip to content

Commit 7a2ac3c

Browse files
committed
Extract maryValueToEraValue helper and document cast usage
Extract the cast-based value conversion from txOutBaseParseJson into a standalone documented helper. The ledger's Value type family resolves to Coin for Shelley/Allegra and MaryValue for Mary onwards, requiring a runtime type check via Data.Typeable.cast to bridge the gap.
1 parent fb8d48f commit 7a2ac3c

1 file changed

Lines changed: 19 additions & 7 deletions

File tree

  • cardano-api/src/Cardano/Api/Experimental/Tx/Internal/BodyContent

cardano-api/src/Cardano/Api/Experimental/Tx/Internal/BodyContent/New.hs

Lines changed: 19 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -166,6 +166,7 @@ import Data.Map.Strict qualified as Map
166166
import Data.Maybe
167167
import Data.OSet.Strict (OSet)
168168
import Data.OSet.Strict qualified as OSet
169+
import Data.Proxy (Proxy (..))
169170
import Data.Sequence.Strict qualified as Seq
170171
import Data.Set (Set)
171172
import Data.Set qualified as Set
@@ -507,18 +508,29 @@ instance FromJSON (TxOut L.ConwayEra) where
507508
parseJSON = Aeson.withObject "TxOut" babbageOnwardsTxOutParseJson
508509

509510
-- | Parse the base fields (address and value) shared by all eras.
510-
txOutBaseParseJson :: L.EraTxOut era => Aeson.Object -> Parser (L.TxOut era)
511+
txOutBaseParseJson :: forall era. L.EraTxOut era => Aeson.Object -> Parser (L.TxOut era)
511512
txOutBaseParseJson o = do
512513
addr <- addrFromJson =<< o .: "address"
513514
apiVal <- parseJSON =<< o .: "value"
514-
let mv = toMaryValue apiVal
515-
val <- case cast mv of
516-
Just v -> pure v
517-
Nothing -> case cast (L.coin mv) of
518-
Just v -> pure v
519-
Nothing -> fail "Unsupported value type for era"
515+
val <- maryValueToEraValue (Proxy @era) $ toMaryValue apiVal
520516
pure $ L.mkBasicTxOut addr val
521517

518+
-- | Convert a 'MaryValue' to the era-specific @'L.Value' era@ using runtime type
519+
-- checks via 'Data.Typeable.cast'.
520+
--
521+
-- The ledger's @Value@ type family resolves to different concrete types per era:
522+
-- 'Coin' for Shelley\/Allegra and 'MaryValue' for Mary onwards. Since 'MaryValue'
523+
-- subsumes 'Coin' (it separates lovelace from multi-asset), we can always produce
524+
-- the correct era type: first try casting the 'MaryValue' directly (succeeds in
525+
-- Mary+), then fall back to extracting the 'Coin' component (succeeds in
526+
-- Shelley\/Allegra).
527+
maryValueToEraValue :: L.EraTxOut era => Proxy era -> L.MaryValue -> Parser (L.Value era)
528+
maryValueToEraValue _proxy mv = case cast mv of
529+
Just v -> pure v
530+
Nothing -> case cast (L.coin mv) of
531+
Just v -> pure v
532+
Nothing -> fail "Unsupported value type for era"
533+
522534
-- | Parse a ledger 'L.Addr' from JSON. Reverse of 'addrToJson'.
523535
addrFromJson :: Aeson.Value -> Parser L.Addr
524536
addrFromJson = Aeson.withText "Address" $ \txt ->

0 commit comments

Comments
 (0)