Fill in undefineds

Author: Jimbo4350

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

@@ -67,6 +67,7 @@ module Cardano.Api.Certificate.Internal
   , fromShelleyCertificate
   , toShelleyPoolParams
   , fromShelleyPoolParams
+  , fromShelleyStakePoolState
 
     -- * Data family instances
   , AsType (..)
@@ -100,6 +101,7 @@ import Cardano.Ledger.Api qualified as L
 import Cardano.Ledger.BaseTypes (strictMaybe)
 import Cardano.Ledger.Coin qualified as L
 import Cardano.Ledger.Keys qualified as Ledger
+import Cardano.Ledger.State qualified as Ledger
 
 import Control.Monad.Except (MonadError (..))
 import Data.ByteString (ByteString)
@@ -781,6 +783,74 @@ 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.spsRewardAccount
+    , Ledger.spsOwners
+    , Ledger.spsRelays
+    , Ledger.spsMetadata
+    } =
+    StakePoolParameters
+      { stakePoolId = StakePoolKeyHash poolId
+      , stakePoolVRF = VrfKeyHash (Ledger.fromVRFVerKeyHash spsVrf)
+      , stakePoolCost = spsCost
+      , stakePoolMargin = Ledger.unboundRational spsMargin
+      , stakePoolRewardAccount = fromShelleyStakeAddr spsRewardAccount
+      , 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
+                $ 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 ByteString
   deriving (Eq, Show)

cardano-api/src/Cardano/Api/Experimental/Tx.hs

@@ -214,11 +214,11 @@ newtype UnsignedTxError
   = UnsignedTxError TxBodyError
 
 makeUnsignedTx
-  :: Ledger.ProtVerAtMost (LedgerEra era) 11
-  => Era era
+  :: Era era
   -> TxBodyContent BuildTx era
   -> Either TxBodyError (UnsignedTx era)
-makeUnsignedTx era bc = obtainCommonConstraints era $ do
+makeUnsignedTx DijkstraEra _ = error "makeUnsignedTx: Dijkstra era not supported yet"
+makeUnsignedTx era@ConwayEra bc = obtainCommonConstraints era $ do
   let sbe = convert era
       aeon = convert era
   TxScriptWitnessRequirements languages scripts datums redeemers <-

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

@@ -45,10 +45,12 @@ 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.PParams qualified as Ledger
+import Cardano.Ledger.Alonzo.Rules qualified as Alonzo
 import Cardano.Ledger.Alonzo.Rules qualified as L
 import Cardano.Ledger.Alonzo.Tx qualified as L
 import Cardano.Ledger.Api qualified as L
 import Cardano.Ledger.Babbage.PParams qualified as Ledger
+import Cardano.Ledger.Babbage.Rules qualified as Babbage
 import Cardano.Ledger.Babbage.Rules qualified as L
 import Cardano.Ledger.BaseTypes (strictMaybeToMaybe)
 import Cardano.Ledger.BaseTypes qualified as L
@@ -91,11 +93,20 @@ import PlutusLedgerApi.V2 qualified as V2
 
 import Codec.Binary.Bech32 qualified as Bech32
 import Codec.CBOR.Read qualified as CBOR
-import Data.Aeson (KeyValue ((.=)), ToJSON (..), ToJSONKey (..), object, pairs)
+import Data.Aeson
+  ( KeyValue ((.=))
+  , ToJSON (..)
+  , ToJSONKey (..)
+  , defaultOptions
+  , genericToJSON
+  , object
+  , pairs
+  )
 import Data.Aeson qualified as A
 import Data.Aeson qualified as Aeson
 import Data.Bifunctor
 import Data.ByteString qualified as BS
+import Data.ByteString.Base16 qualified as B16
 import Data.ByteString.Base16 qualified as Base16
 import Data.ByteString.Char8 qualified as C8
 import Data.ByteString.Short qualified as SBS
@@ -106,6 +117,7 @@ import Data.ListMap qualified as ListMap
 import Data.Maybe.Strict (StrictMaybe (..))
 import Data.Monoid
 import Data.Text qualified as T
+import Data.Text qualified as Text
 import Data.Text.Encoding qualified as Text
 import Data.Typeable (Typeable)
 import GHC.Exts (IsList (..), IsString (..))
@@ -200,17 +212,22 @@ instance
   , ToJSON (L.PlutusPurpose L.AsItem ledgerera)
   , ToJSON (L.PlutusPurpose L.AsIx ledgerera)
   )
-  => ToJSON (L.AlonzoUtxowPredFailure ledgerera) where
-    toJSON = undefined
+  => ToJSON (L.AlonzoUtxowPredFailure ledgerera)
+  where
+  toJSON = genericToJSON defaultOptions
+
+instance ToJSON C8.ByteString where
+  toJSON = Aeson.String . Text.decodeLatin1 . B16.encode
 
 instance
   ( ToJSON (L.PredicateFailure (L.EraRule "UTXO" ledgerera))
   , ToJSON (L.TxCert ledgerera)
   , ToJSON (L.PlutusPurpose L.AsItem ledgerera)
   , ToJSON (L.PlutusPurpose L.AsIx ledgerera)
   )
-  => ToJSON (L.BabbageUtxowPredFailure ledgerera) where
-    toJSON = undefined
+  => ToJSON (L.BabbageUtxowPredFailure ledgerera)
+  where
+  toJSON = genericToJSON defaultOptions
 
 deriving anyclass instance
   ToJSON (L.PredicateFailure (L.EraRule "LEDGER" ledgerera))

cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs

@@ -643,11 +643,11 @@ toConsensusQueryShelleyBased sbe = \case
       )
       (const $ Some (consensusQueryInEraInMode era Consensus.GetFuturePParams))
       sbe
-  QueryDRepState _creds ->
+  QueryDRepState creds ->
     caseShelleyToBabbageOrConwayEraOnwards
       (const $ error "toConsensusQueryShelleyBased: QueryDRepState is only available in the Conway era")
       ( \w ->
-          Some (consensusQueryInEraInMode era (conwayEraOnwardsConstraints w $ Consensus.GetDRepState _creds))
+          Some (consensusQueryInEraInMode era (conwayEraOnwardsConstraints w $ Consensus.GetDRepState creds))
       )
       sbe
   QueryDRepStakeDistr dreps ->
@@ -664,16 +664,15 @@ toConsensusQueryShelleyBased sbe = \case
       )
       (const $ Some (consensusQueryInEraInMode era (Consensus.GetSPOStakeDistr spos)))
       sbe
-  QueryCommitteeMembersState _coldCreds _hotCreds _statuses ->
+  QueryCommitteeMembersState coldCreds hotCreds statuses ->
     caseShelleyToBabbageOrConwayEraOnwards
       ( const $
           error "toConsensusQueryShelleyBased: QueryCommitteeMembersState is only available in the Conway era"
       )
-      undefined
-      -- ( const $
-      --     Some
-      --       (consensusQueryInEraInMode era (Consensus.GetCommitteeMembersState coldCreds hotCreds statuses))
-      -- )
+      ( const $
+          Some
+            (consensusQueryInEraInMode era (Consensus.GetCommitteeMembersState coldCreds hotCreds statuses))
+      )
       sbe
   QueryStakeVoteDelegatees creds ->
     caseShelleyToBabbageOrConwayEraOnwards
@@ -933,10 +932,10 @@ fromConsensusQueryResultShelleyBased sbe sbeQuery q' r' =
         _ -> fromConsensusQueryResultMismatch
     QueryStakePoolParameters{} ->
       case q' of
-        Consensus.GetStakePoolParams{} ->
-          Map.map fromShelleyPoolParams
-            . Map.mapKeysMonotonic StakePoolKeyHash
-            $ undefined -- r'
+        Consensus.GetStakePoolParams{} -> do
+          Map.mapKeysMonotonic StakePoolKeyHash
+            . Map.mapWithKey fromShelleyStakePoolState
+            $ r'
         _ -> fromConsensusQueryResultMismatch
     QueryDebugLedgerState{} ->
       case q' of

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

@@ -272,6 +272,7 @@ import Cardano.Crypto.Hashing qualified as Byron
 import Cardano.Ledger.Allegra.Core qualified as L
 import Cardano.Ledger.Alonzo.Core qualified as L
 import Cardano.Ledger.Alonzo.Scripts qualified as Alonzo
+import Cardano.Ledger.Alonzo.Tx qualified as L
 -- import Cardano.Ledger.Alonzo.Tx qualified as Alonzo (hashScriptIntegrity)
 import Cardano.Ledger.Alonzo.TxWits qualified as Alonzo
 import Cardano.Ledger.Api qualified as L
@@ -1981,13 +1982,13 @@ convPParamsToScriptIntegrityHash
   -> Alonzo.TxDats (ShelleyLedgerEra era)
   -> Set Plutus.Language
   -> StrictMaybe L.ScriptIntegrityHash
-convPParamsToScriptIntegrityHash w (BuildTxWith mTxProtocolParams) _ _ _ = -- redeemers datums languages =
+convPParamsToScriptIntegrityHash w (BuildTxWith mTxProtocolParams) redeemers datums languages =
   alonzoEraOnwardsConstraints w $
     case mTxProtocolParams of
       Nothing -> SNothing
-      Just (LedgerProtocolParameters _) -> undefined
-      -- Just (LedgerProtocolParameters pp) -> 
-      --   Alonzo.hashScriptIntegrity (Set.map (L.getLanguageView pp) languages) redeemers datums
+      Just (LedgerProtocolParameters pp) ->
+        let scriptIntegrity = L.ScriptIntegrity redeemers datums (Set.map (L.getLanguageView pp) languages)
+         in SJust $ L.hashScriptIntegrity scriptIntegrity
 
 convLanguages :: [(ScriptWitnessIndex, AnyScriptWitness era)] -> Set Plutus.Language
 convLanguages witnesses =

cardano-api/src/Cardano/Api/Tx/Internal/Body/Lens.hs

@@ -1,8 +1,11 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE RankNTypes #-}
 
 {- HLINT ignore "Eta reduce" -}
 
+-- TODO: Deprecate all the lenses that use eons. Explore parameterizing them on `Era era` instead.
+
 module Cardano.Api.Tx.Internal.Body.Lens
   ( -- * Types
     LedgerTxBody (..)
@@ -163,7 +166,10 @@ collateralInputsTxBodyL w = alonzoEraOnwardsConstraints w $ txBodyL . L.collater
 
 reqSignerHashesTxBodyL
   :: AlonzoEraOnwards era -> Lens' (LedgerTxBody era) (Set (L.KeyHash L.Witness))
-reqSignerHashesTxBodyL w = alonzoEraOnwardsConstraints w $ txBodyL . undefined -- L.reqSignerHashesTxBodyL
+reqSignerHashesTxBodyL w@AlonzoEraOnwardsAlonzo = alonzoEraOnwardsConstraints w $ txBodyL . L.reqSignerHashesTxBodyL
+reqSignerHashesTxBodyL w@AlonzoEraOnwardsBabbage = alonzoEraOnwardsConstraints w $ txBodyL . L.reqSignerHashesTxBodyL
+reqSignerHashesTxBodyL w@AlonzoEraOnwardsConway = alonzoEraOnwardsConstraints w $ txBodyL . L.reqSignerHashesTxBodyL
+reqSignerHashesTxBodyL AlonzoEraOnwardsDijkstra = error "reqSignerHashesTxBodyL: DijkstraEra not supported yet"
 
 referenceInputsTxBodyL
   :: BabbageEraOnwards era -> Lens' (LedgerTxBody era) (Set L.TxIn)