Address undefineds and review comments

Author: Jimbo4350

cardano-api/src/Cardano/Api/Certificate/Internal.hs

@@ -63,7 +63,6 @@ module Cardano.Api.Certificate.Internal
   , fromShelleyCertificate
   , toShelleyPoolParams
   , fromShelleyPoolParams
-  , fromShelleyStakePoolState
 
     -- * Data family instances
   , AsType (AsCertificate, AsTxId)
@@ -93,7 +92,6 @@ import Cardano.Api.Serialise.TextEnvelope.Internal
 
 import Cardano.Ledger.BaseTypes (strictMaybe)
 import Cardano.Ledger.Coin qualified as L
-import Cardano.Ledger.State qualified as Ledger
 
 import Control.Monad
 import Control.Monad.Except (MonadError (..))
@@ -792,76 +790,6 @@ fromShelleyPoolParams
       Text.encodeUtf8
         . Ledger.dnsToText
 
-fromShelleyStakePoolState
-  :: Ledger.KeyHash Ledger.StakePool
-  -> Ledger.StakePoolState
-  -> StakePoolParameters
-fromShelleyStakePoolState
-  poolId
-  Ledger.StakePoolState
-    { Ledger.spsVrf
-    , Ledger.spsPledge
-    , Ledger.spsCost
-    , Ledger.spsMargin
-    , Ledger.spsAccountAddress
-    , Ledger.spsOwners
-    , Ledger.spsRelays
-    , Ledger.spsMetadata
-    } =
-    StakePoolParameters
-      { stakePoolId = StakePoolKeyHash poolId
-      , stakePoolVRF = VrfKeyHash (Ledger.fromVRFVerKeyHash spsVrf)
-      , stakePoolCost = spsCost
-      , stakePoolMargin = Ledger.unboundRational spsMargin
-      , stakePoolRewardAccount = StakeAddress undefined spsAccountAddress -- TODO the Network argument was removed in Ledger
-      , stakePoolPledge = spsPledge
-      , stakePoolOwners = map StakeKeyHash (toList spsOwners)
-      , stakePoolRelays =
-          map
-            fromShelleyStakePoolRelay
-            (toList spsRelays)
-      , stakePoolMetadata =
-          fromShelleyPoolMetadata
-            <$> Ledger.strictMaybeToMaybe spsMetadata
-      }
-   where
-    fromShelleyStakePoolRelay :: Ledger.StakePoolRelay -> StakePoolRelay
-    fromShelleyStakePoolRelay (Ledger.SingleHostAddr mport mipv4 mipv6) =
-      StakePoolRelayIp
-        (Ledger.strictMaybeToMaybe mipv4)
-        (Ledger.strictMaybeToMaybe mipv6)
-        (fromIntegral . Ledger.portToWord16 <$> Ledger.strictMaybeToMaybe mport)
-    fromShelleyStakePoolRelay (Ledger.SingleHostName mport dnsname) =
-      StakePoolRelayDnsARecord
-        (fromShelleyDnsName dnsname)
-        (fromIntegral . Ledger.portToWord16 <$> Ledger.strictMaybeToMaybe mport)
-    fromShelleyStakePoolRelay (Ledger.MultiHostName dnsname) =
-      StakePoolRelayDnsSrvRecord
-        (fromShelleyDnsName dnsname)
-
-    fromShelleyPoolMetadata :: Ledger.PoolMetadata -> StakePoolMetadataReference
-    fromShelleyPoolMetadata
-      Ledger.PoolMetadata
-        { Ledger.pmUrl
-        , Ledger.pmHash
-        } =
-        StakePoolMetadataReference
-          { stakePoolMetadataURL = Ledger.urlToText pmUrl
-          , stakePoolMetadataHash =
-              StakePoolMetadataHash
-                . fromMaybe (error "fromShelleyPoolMetadata: invalid hash. TODO: proper validation")
-                . Ledger.hashFromBytes
-                . SBS.fromShort
-                . byteArrayToShortByteString
-                $ pmHash
-          }
-
-    -- TODO: change the ledger rep of the DNS name to use ShortByteString
-    fromShelleyDnsName :: Ledger.DnsName -> ByteString
-    fromShelleyDnsName =
-      Text.encodeUtf8
-        . Ledger.dnsToText
-
 data AnchorDataFromCertificateError
   = InvalidPoolMetadataHashError Ledger.Url ByteArray
   deriving (Eq, Show)

cardano-api/src/Cardano/Api/Consensus/Internal/InMode.hs

@@ -262,7 +262,22 @@ appTxErrToJson
   => ShelleyBasedEra era
   -> Consensus.ApplyTxErr (Consensus.ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era))
   -> Aeson.Value
-appTxErrToJson w e = shelleyBasedEraConstraints w $ toJSON e
+appTxErrToJson w e =
+  case w of
+    ShelleyBasedEraShelley -> toJSON e
+    ShelleyBasedEraAllegra -> toJSON e
+    ShelleyBasedEraMary -> toJSON e
+    ShelleyBasedEraAlonzo -> toJSON e
+    ShelleyBasedEraBabbage -> toJSON e
+    ShelleyBasedEraConway -> toJSON e
+    -- TODO: Ledger needs to expose DijkstraLedgerPredFailure in order
+    -- to define the necessary JSON instances for Dijkstra era.
+    ShelleyBasedEraDijkstra ->
+      Aeson.String . Text.pack $
+        unlines
+          [ "This is not JSON serializable yet. Ledger must expose DijkstraLedgerPredFailure to implement the necessary instances."
+          , show e
+          ]
 
 -- | A 'TxValidationError' in one of the eras supported by a given protocol
 -- mode.

cardano-api/src/Cardano/Api/Era/Internal/Case.hs

@@ -121,7 +121,7 @@ caseShelleyToMaryOrAlonzoEraOnwards l r = \case
   ShelleyBasedEraAlonzo -> r AlonzoEraOnwardsAlonzo
   ShelleyBasedEraBabbage -> r AlonzoEraOnwardsBabbage
   ShelleyBasedEraConway -> r AlonzoEraOnwardsConway
-  ShelleyBasedEraDijkstra -> error "caseShelleyToMaryOrAlonzoEraOnwards: DijkstraEra is not supported"
+  ShelleyBasedEraDijkstra -> r AlonzoEraOnwardsDijkstra
 
 -- | @caseShelleyToAlonzoOrBabbageEraOnwards f g era@ applies @f@ to shelley, allegra, mary, and alonzo;
 -- and applies @g@ to babbage and later eras.

cardano-api/src/Cardano/Api/Internal/Orphans/Serialisation.hs

@@ -45,6 +45,7 @@ import Cardano.Chain.Update.Validation.Registration qualified as L.Registration
 import Cardano.Chain.Update.Validation.Voting qualified as L.Voting
 import Cardano.Crypto.Hash qualified as Crypto
 import Cardano.Ledger.Allegra.Rules qualified as L
+import Cardano.Ledger.Alonzo qualified as L
 import Cardano.Ledger.Alonzo.PParams qualified as Ledger
 import Cardano.Ledger.Alonzo.Rules qualified as Alonzo
 import Cardano.Ledger.Alonzo.Rules qualified as L
@@ -63,6 +64,8 @@ import Cardano.Ledger.Conway.PParams qualified as Ledger
 import Cardano.Ledger.Conway.Rules qualified as L
 import Cardano.Ledger.Conway.TxCert qualified as L
 import Cardano.Ledger.Core qualified as L hiding (KeyHash)
+import Cardano.Ledger.Dijkstra qualified as L
+import Cardano.Ledger.Dijkstra.Rules qualified as L
 import Cardano.Ledger.HKD (NoUpdate (..))
 import Cardano.Ledger.Hashes qualified as L hiding (KeyHash)
 import Cardano.Ledger.Keys qualified as L.Keys
@@ -108,6 +111,7 @@ import Data.Aeson
   )
 import Data.Aeson qualified as A
 import Data.Aeson qualified as Aeson
+import Data.Aeson.Types (toJSONKeyText)
 import Data.Bifunctor
 import Data.ByteString qualified as BS
 import Data.ByteString.Base16 qualified as B16
@@ -119,7 +123,7 @@ import Data.Data (Data)
 import Data.Kind (Constraint, Type)
 import Data.ListMap (ListMap)
 import Data.ListMap qualified as ListMap
-import Data.Map.NonEmpty (NonEmptyMap)
+import Data.Map.NonEmpty (NonEmptyMap, toMap)
 import Data.Map.NonEmpty qualified as NonEmptyMap
 import Data.Maybe.Strict (StrictMaybe (..))
 import Data.Monoid
@@ -204,11 +208,11 @@ deriving anyclass instance ToJSON L.VotingPeriod
 
 deriving anyclass instance ToJSON L.Withdrawals
 
-instance ToJSON (NonEmptyMap k v) where
-  toJSON = undefined
+instance (ToJSONKey k, ToJSON v) => ToJSON (NonEmptyMap k v) where
+  toJSON = toJSON . toMap
 
-instance ToJSON (NonEmptySet v) where
-  toJSON = undefined
+instance ToJSON v => ToJSON (NonEmptySet v) where
+  toJSON = toJSON . NonEmptySet.toSet
 
 deriving anyclass instance
   ( ToJSON (L.PredicateFailure (L.EraRule "UTXOW" ledgerera))
@@ -247,8 +251,31 @@ instance
   where
   toJSON = genericToJSON defaultOptions
 
-instance ToJSON (L.ApplyTxError ledgerera) where
-  toJSON = undefined
+instance ToJSON (L.ApplyTxError L.ShelleyEra) where
+  toJSON = Aeson.genericToJSON Aeson.defaultOptions
+
+instance ToJSON (L.ApplyTxError L.AllegraEra) where
+  toJSON = Aeson.genericToJSON Aeson.defaultOptions
+
+instance ToJSON (L.ApplyTxError L.MaryEra) where
+  toJSON = Aeson.genericToJSON Aeson.defaultOptions
+
+instance ToJSON (L.ApplyTxError L.AlonzoEra) where
+  toJSON = Aeson.genericToJSON Aeson.defaultOptions
+
+instance ToJSON (L.ApplyTxError L.BabbageEra) where
+  toJSON = Aeson.genericToJSON Aeson.defaultOptions
+
+instance ToJSON (L.ApplyTxError L.ConwayEra) where
+  toJSON = Aeson.genericToJSON Aeson.defaultOptions
+
+-- TODO: Ledger must expose DijkstraLedgerPredFailure in order to write the
+-- instances below.
+-- instance ToJSON (L.ApplyTxError L.DijkstraEra) where
+--   toJSON = Aeson.genericToJSON Aeson.defaultOptions
+
+-- instance ToJSON (L.DijkstraMempoolPredFailure L.DijkstraEra) where
+--   toJSON = Aeson.genericToJSON Aeson.defaultOptions
 
 deriving via
   ShowOf (L.Keys.VKey L.Keys.Witness)

cardano-api/src/Cardano/Api/Tx/Internal/Output.hs

@@ -793,8 +793,8 @@ toShelleyTxOut
   => ShelleyBasedEra era
   -> TxOut CtxUTxO era
   -> Ledger.TxOut ledgerera
-toShelleyTxOut sbe = shelleyBasedEraConstraints sbe $ \case
-  TxOut addr (TxOutValueShelleyBased _ value) txoutdata refScript ->
+toShelleyTxOut sbe' = shelleyBasedEraConstraints sbe' $ \case
+  TxOut addr (TxOutValueShelleyBased sbe value) txoutdata refScript ->
     caseShelleyToMaryOrAlonzoEraOnwards
       (const $ L.mkBasicTxOut (toShelleyAddr addr) value)
       ( \case
@@ -814,13 +814,6 @@ toShelleyTxOut sbe = shelleyBasedEraConstraints sbe $ \case
                 .~ toBabbageTxOutDatumUTxO txoutdata
               & L.referenceScriptTxOutL
                 .~ refScriptToShelleyScript sbe refScript
-          -- TODO: this pattern shows up as redundant
-          -- AlonzoEraOnwardsDijkstra ->
-          --   L.mkBasicTxOut (toShelleyAddr addr) value
-          --     & L.datumTxOutL
-          --       .~ toBabbageTxOutDatumUTxO txoutdata
-          --     & L.referenceScriptTxOutL
-          --       .~ refScriptToShelleyScript sbe refScript
       )
       sbe
 
@@ -855,13 +848,6 @@ toShelleyTxOutAny sbe = shelleyBasedEraConstraints sbe $ \case
                 .~ toBabbageTxOutDatum txoutdata
               & L.referenceScriptTxOutL
                 .~ refScriptToShelleyScript sbe refScript
-          -- TODO: this pattern shows up as redundant
-          -- AlonzoEraOnwardsDijkstra ->
-          --   L.mkBasicTxOut (toShelleyAddr addr) value
-          --     & L.datumTxOutL
-          --       .~ toBabbageTxOutDatum txoutdata
-          --     & L.referenceScriptTxOutL
-          --       .~ refScriptToShelleyScript sbe refScript
       )
       sbe
 
@@ -924,24 +910,6 @@ fromShelleyTxOut sbe ledgerTxOut = shelleyBasedEraConstraints sbe $ do
      where
       datum = ledgerTxOut ^. L.datumTxOutL
       mRefScript = ledgerTxOut ^. L.referenceScriptTxOutL
-    -- TODO: this pattern shows up as redundant
-    -- ShelleyBasedEraDijkstra ->
-    --   TxOut
-    --     addressInEra
-    --     txOutValue
-    --     ( fromBabbageTxOutDatum
-    --         AlonzoEraOnwardsDijkstra
-    --         BabbageEraOnwardsDijkstra
-    --         datum
-    --     )
-    --     ( case mRefScript of
-    --         SNothing -> ReferenceScriptNone
-    --         SJust refScript ->
-    --           fromShelleyScriptToReferenceScript ShelleyBasedEraDijkstra refScript
-    --     )
-    --  where
-    --   datum = ledgerTxOut ^. L.datumTxOutL
-    --   mRefScript = ledgerTxOut ^. L.referenceScriptTxOutL
 
 -- ----------------------------------------------------------------------------
 -- Transaction output values (era-dependent)