Skip to content

Commit 80e61e0

Browse files
committed
Rebase changes
1 parent d7d53f1 commit 80e61e0

File tree

3 files changed

+85
-30
lines changed

3 files changed

+85
-30
lines changed

cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE EmptyCase #-}
23
{-# LANGUAGE FlexibleContexts #-}
34
{-# LANGUAGE GADTs #-}
45
{-# LANGUAGE NamedFieldPuns #-}

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

Lines changed: 32 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,10 @@
1-
{-# LANGUAGE EmptyCase #-}
21
{-# LANGUAGE FlexibleContexts #-}
32
{-# LANGUAGE FlexibleInstances #-}
43
{-# LANGUAGE GADTs #-}
54
{-# LANGUAGE InstanceSigs #-}
65
{-# LANGUAGE RankNTypes #-}
76
{-# LANGUAGE ScopedTypeVariables #-}
87
{-# LANGUAGE StandaloneDeriving #-}
9-
{-# LANGUAGE TupleSections #-}
108
{-# LANGUAGE TypeApplications #-}
119
{-# LANGUAGE TypeFamilies #-}
1210
{-# LANGUAGE TypeOperators #-}
@@ -19,10 +17,6 @@ module Cardano.Api.Experimental.Tx.Internal.Certificate
1917
)
2018
where
2119

22-
import Cardano.Api.Certificate.Internal qualified as Api
23-
import Cardano.Api.Era.Internal.Core (DijkstraEra)
24-
import Cardano.Api.Era.Internal.Eon.Convert
25-
import Cardano.Api.Era.Internal.Eon.ConwayEraOnwards
2620
import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra
2721
import Cardano.Api.Error
2822
import Cardano.Api.Experimental.Era
@@ -77,7 +71,7 @@ instance
7771

7872
getAnchorDataFromCertificate
7973
:: Era era
80-
-> Certificate (ShelleyLedgerEra era)
74+
-> Certificate (LedgerEra era)
8175
-> Either AnchorDataFromCertificateError (Maybe Ledger.Anchor)
8276
getAnchorDataFromCertificate ConwayEra (Certificate c) =
8377
case c of
@@ -94,22 +88,37 @@ getAnchorDataFromCertificate ConwayEra (Certificate c) =
9488
Ledger.UpdateDRepTxCert _ mAnchor -> return $ Ledger.strictMaybeToMaybe mAnchor
9589
Ledger.AuthCommitteeHotKeyTxCert _ _ -> return Nothing
9690
Ledger.ResignCommitteeColdTxCert _ mAnchor -> return $ Ledger.strictMaybeToMaybe mAnchor
97-
where
98-
anchorDataFromPoolMetadata
99-
:: MonadError AnchorDataFromCertificateError m
100-
=> Ledger.PoolMetadata
101-
-> m (Maybe Ledger.Anchor)
102-
anchorDataFromPoolMetadata (Ledger.PoolMetadata{Ledger.pmUrl = url, Ledger.pmHash = hashBytes}) = do
103-
hash <-
104-
maybe (throwError $ InvalidPoolMetadataHashError url hashBytes) return $
105-
Ledger.hashFromBytes hashBytes
106-
return $
107-
Just
108-
( Ledger.Anchor
109-
{ Ledger.anchorUrl = url
110-
, Ledger.anchorDataHash = Ledger.unsafeMakeSafeHash hash
111-
}
112-
)
91+
_ -> error "getAnchorDataFromCertificate: Unrecognized cert"
92+
getAnchorDataFromCertificate DijkstraEra (Certificate c) =
93+
case c of
94+
Ledger.RegDepositTxCert _ _ -> return Nothing
95+
Ledger.UnRegDepositTxCert _ _ -> return Nothing
96+
Ledger.RegDepositDelegTxCert{} -> return Nothing
97+
Ledger.DelegTxCert{} -> return Nothing
98+
Ledger.RegPoolTxCert poolParams -> strictMaybe (return Nothing) anchorDataFromPoolMetadata $ Ledger.ppMetadata poolParams
99+
Ledger.RetirePoolTxCert _ _ -> return Nothing
100+
Ledger.RegDRepTxCert _ _ mAnchor -> return $ Ledger.strictMaybeToMaybe mAnchor
101+
Ledger.UnRegDRepTxCert _ _ -> return Nothing
102+
Ledger.UpdateDRepTxCert _ mAnchor -> return $ Ledger.strictMaybeToMaybe mAnchor
103+
Ledger.AuthCommitteeHotKeyTxCert _ _ -> return Nothing
104+
Ledger.ResignCommitteeColdTxCert _ mAnchor -> return $ Ledger.strictMaybeToMaybe mAnchor
105+
_ -> error "getAnchorDataFromCertificate: Unrecognized cert"
106+
107+
anchorDataFromPoolMetadata
108+
:: MonadError AnchorDataFromCertificateError m
109+
=> Ledger.PoolMetadata
110+
-> m (Maybe Ledger.Anchor)
111+
anchorDataFromPoolMetadata (Ledger.PoolMetadata{Ledger.pmUrl = url, Ledger.pmHash = hashBytes}) = do
112+
hash <-
113+
maybe (throwError $ InvalidPoolMetadataHashError url hashBytes) return $
114+
Ledger.hashFromBytes hashBytes
115+
return $
116+
Just
117+
( Ledger.Anchor
118+
{ Ledger.anchorUrl = url
119+
, Ledger.anchorDataHash = Ledger.unsafeMakeSafeHash hash
120+
}
121+
)
113122

114123
data AnchorDataFromCertificateError
115124
= InvalidPoolMetadataHashError Ledger.Url ByteString

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

Lines changed: 52 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -62,6 +62,18 @@ mkTxCertificates certs =
6262
Api.ScriptWitness Api.ScriptWitnessForStakeAddr $
6363
newToOldPlutusCertificateScriptWitness ConwayEra psw
6464
(cert, pure $ (,wit) <$> mStakeCred)
65+
DijkstraEra -> do
66+
let Exp.Certificate c = cert
67+
mStakeCred = Api.getTxCertWitness (convert era) c
68+
wit =
69+
case witness of
70+
AnyKeyWitnessPlaceholder -> Api.KeyWitness Api.KeyWitnessForStakeAddr
71+
AnySimpleScriptWitness ss ->
72+
Api.ScriptWitness Api.ScriptWitnessForStakeAddr $ newToOldSimpleScriptWitness era ss
73+
AnyPlutusScriptWitness psw ->
74+
Api.ScriptWitness Api.ScriptWitnessForStakeAddr $
75+
newToOldPlutusCertificateScriptWitness DijkstraEra psw
76+
(cert, pure $ (,wit) <$> mStakeCred)
6577

6678
newToOldSimpleScriptWitness
6779
:: L.AllegraEraScript (LedgerEra era)
@@ -85,32 +97,65 @@ newToOldPlutusCertificateScriptWitness ConwayEra (Exp.PlutusScriptWitness Plutus
8597
Api.PlutusScriptWitness
8698
Api.PlutusScriptV1InConway
8799
Api.PlutusScriptV1
88-
(newToOldPlutusScriptOrReferenceInput ConwayEra scriptOrRef)
100+
(newToOldPlutusScriptOrReferenceInput scriptOrRef)
89101
Api.NoScriptDatumForStake
90102
redeemer
91103
execUnits
92104
newToOldPlutusCertificateScriptWitness ConwayEra (Exp.PlutusScriptWitness Plutus.SPlutusV2 scriptOrRef _ redeemer execUnits) =
93105
Api.PlutusScriptWitness
94106
Api.PlutusScriptV2InConway
95107
Api.PlutusScriptV2
96-
(newToOldPlutusScriptOrReferenceInput ConwayEra scriptOrRef)
108+
(newToOldPlutusScriptOrReferenceInput scriptOrRef)
97109
Api.NoScriptDatumForStake
98110
redeemer
99111
execUnits
100112
newToOldPlutusCertificateScriptWitness ConwayEra (Exp.PlutusScriptWitness Plutus.SPlutusV3 scriptOrRef _ redeemer execUnits) =
101113
Api.PlutusScriptWitness
102114
Api.PlutusScriptV3InConway
103115
Api.PlutusScriptV3
104-
(newToOldPlutusScriptOrReferenceInput ConwayEra scriptOrRef)
116+
(newToOldPlutusScriptOrReferenceInput scriptOrRef)
117+
Api.NoScriptDatumForStake
118+
redeemer
119+
execUnits
120+
newToOldPlutusCertificateScriptWitness ConwayEra (Exp.PlutusScriptWitness Plutus.SPlutusV4 _ _ _ _) =
121+
error "newToOldPlutusCertificateScriptWitness: PlutusV4 script not possible in Conway era"
122+
newToOldPlutusCertificateScriptWitness DijkstraEra (Exp.PlutusScriptWitness Plutus.SPlutusV1 scriptOrRef _ redeemer execUnits) =
123+
Api.PlutusScriptWitness
124+
Api.PlutusScriptV1InDijkstra
125+
Api.PlutusScriptV1
126+
(newToOldPlutusScriptOrReferenceInput scriptOrRef)
127+
Api.NoScriptDatumForStake
128+
redeemer
129+
execUnits
130+
newToOldPlutusCertificateScriptWitness DijkstraEra (Exp.PlutusScriptWitness Plutus.SPlutusV2 scriptOrRef _ redeemer execUnits) =
131+
Api.PlutusScriptWitness
132+
Api.PlutusScriptV2InDijkstra
133+
Api.PlutusScriptV2
134+
(newToOldPlutusScriptOrReferenceInput scriptOrRef)
135+
Api.NoScriptDatumForStake
136+
redeemer
137+
execUnits
138+
newToOldPlutusCertificateScriptWitness DijkstraEra (Exp.PlutusScriptWitness Plutus.SPlutusV3 scriptOrRef _ redeemer execUnits) =
139+
Api.PlutusScriptWitness
140+
Api.PlutusScriptV3InDijkstra
141+
Api.PlutusScriptV3
142+
(newToOldPlutusScriptOrReferenceInput scriptOrRef)
143+
Api.NoScriptDatumForStake
144+
redeemer
145+
execUnits
146+
newToOldPlutusCertificateScriptWitness DijkstraEra (Exp.PlutusScriptWitness Plutus.SPlutusV4 scriptOrRef _ redeemer execUnits) =
147+
Api.PlutusScriptWitness
148+
Api.PlutusScriptV4InDijkstra
149+
Api.PlutusScriptV4
150+
(newToOldPlutusScriptOrReferenceInput scriptOrRef)
105151
Api.NoScriptDatumForStake
106152
redeemer
107153
execUnits
108154

109155
newToOldPlutusScriptOrReferenceInput
110-
:: Era era
111-
-> Exp.PlutusScriptOrReferenceInput lang (LedgerEra era)
156+
:: Exp.PlutusScriptOrReferenceInput lang (LedgerEra era)
112157
-> Api.PlutusScriptOrReferenceInput oldlang
113-
newToOldPlutusScriptOrReferenceInput ConwayEra (Exp.PReferenceScript txin) = Api.PReferenceScript txin
114-
newToOldPlutusScriptOrReferenceInput ConwayEra (Exp.PScript (Exp.PlutusScriptInEra plutusRunnable)) =
158+
newToOldPlutusScriptOrReferenceInput (Exp.PReferenceScript txin) = Api.PReferenceScript txin
159+
newToOldPlutusScriptOrReferenceInput (Exp.PScript (Exp.PlutusScriptInEra plutusRunnable)) =
115160
let oldScript = L.unPlutusBinary . L.plutusBinary $ L.plutusFromRunnable plutusRunnable
116161
in Api.PScript $ Api.PlutusScriptSerialised oldScript

0 commit comments

Comments
 (0)