Skip to content

Commit 5ef11bb

Browse files
carbolymercarbolymer
committed
wip
1 parent a10f917 commit 5ef11bb

20 files changed

+142
-138
lines changed

‎cardano-api/src/Cardano/Api/Internal/Address.hs

Lines changed: 21 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,7 @@
88
{-# LANGUAGE StandaloneDeriving #-}
99
{-# LANGUAGE TypeApplications #-}
1010
{-# LANGUAGE TypeFamilies #-}
11+
{-# LANGUAGE TypeOperators #-}
1112

1213
{- HLINT ignore "Avoid lambda using `infix`" -}
1314

@@ -120,6 +121,7 @@ import Data.Either.Combinators (rightToMaybe)
120121
import Data.Text (Text)
121122
import Data.Text qualified as Text
122123
import Data.Text.Encoding qualified as Text
124+
import Data.Type.Equality
123125
import Text.Parsec qualified as Parsec
124126
import Text.Parsec.String qualified as Parsec
125127

@@ -384,10 +386,10 @@ instance IsShelleyBasedEra era => FromJSON (AddressInEra era) where
384386
addressAny <- runParsecParser parseAddressAny txt
385387
pure $ anyAddressInShelleyBasedEra sbe addressAny
386388

387-
parseAddressAny :: Parsec.Parser AddressAny
389+
parseAddressAny :: SerialiseAddress addr => Parsec.Parser addr
388390
parseAddressAny = do
389391
str <- lexPlausibleAddressString
390-
case deserialiseAddress AsAddressAny str of
392+
case deserialiseAddress (proxyToAsType Proxy) str of
391393
Nothing -> fail $ "invalid address: " <> Text.unpack str
392394
Just addr -> pure addr
393395

@@ -435,7 +437,8 @@ deriving instance Show (AddressInEra era)
435437
data AddressTypeInEra addrtype era where
436438
ByronAddressInAnyEra :: AddressTypeInEra ByronAddr era
437439
ShelleyAddressInEra
438-
:: ShelleyBasedEra era
440+
:: (era == ByronEra) ~ False
441+
=> ShelleyBasedEra era
439442
-> AddressTypeInEra ShelleyAddr era
440443

441444
deriving instance Show (AddressTypeInEra addrtype era)
@@ -478,7 +481,8 @@ shelleyAddressInEra
478481
-> Address ShelleyAddr
479482
-> AddressInEra era
480483
shelleyAddressInEra sbe =
481-
AddressInEra (ShelleyAddressInEra sbe)
484+
shelleyBasedEraConstraints sbe $
485+
AddressInEra (ShelleyAddressInEra sbe)
482486

483487
anyAddressInShelleyBasedEra
484488
:: ()
@@ -495,12 +499,12 @@ anyAddressInEra
495499
-> Either String (AddressInEra era)
496500
anyAddressInEra era = \case
497501
AddressByron addr ->
498-
Right (AddressInEra ByronAddressInAnyEra addr)
499-
AddressShelley addr ->
500-
forEraInEon
501-
era
502-
(Left "Expected Byron based era address")
503-
(\sbe -> Right (AddressInEra (ShelleyAddressInEra sbe) addr))
502+
pure $ AddressInEra ByronAddressInAnyEra addr
503+
AddressShelley addr -> do
504+
sbe <- forEraMaybeEon era ?! "Expected Byron based era address"
505+
shelleyBasedEraConstraints sbe $
506+
pure $
507+
AddressInEra (ShelleyAddressInEra sbe) addr
504508

505509
toAddressAny :: Address addr -> AddressAny
506510
toAddressAny a@ShelleyAddress{} = AddressShelley a
@@ -685,18 +689,20 @@ fromShelleyAddrIsSbe sbe = \case
685689
Shelley.AddrBootstrap (Shelley.BootstrapAddress addr) ->
686690
AddressInEra ByronAddressInAnyEra (ByronAddress addr)
687691
Shelley.Addr nw pc scr ->
688-
AddressInEra (ShelleyAddressInEra sbe) (ShelleyAddress nw pc scr)
692+
shelleyBasedEraConstraints sbe $
693+
AddressInEra (ShelleyAddressInEra sbe) (ShelleyAddress nw pc scr)
689694

690695
fromShelleyAddr
691696
:: ShelleyBasedEra era
692697
-> Shelley.Addr
693698
-> AddressInEra era
694699
fromShelleyAddr _ (Shelley.AddrBootstrap (Shelley.BootstrapAddress addr)) =
695700
AddressInEra ByronAddressInAnyEra (ByronAddress addr)
696-
fromShelleyAddr sBasedEra (Shelley.Addr nw pc scr) =
697-
AddressInEra
698-
(ShelleyAddressInEra sBasedEra)
699-
(ShelleyAddress nw pc scr)
701+
fromShelleyAddr sbe (Shelley.Addr nw pc scr) =
702+
shelleyBasedEraConstraints sbe $
703+
AddressInEra
704+
(ShelleyAddressInEra sbe)
705+
(ShelleyAddress nw pc scr)
700706

701707
fromShelleyStakeAddr :: Shelley.RewardAccount -> StakeAddress
702708
fromShelleyStakeAddr (Shelley.RewardAccount nw sc) = StakeAddress nw sc

‎cardano-api/src/Cardano/Api/Internal/Eon/AllegraEraOnwards.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -37,6 +37,7 @@ import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus
3737
import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus
3838

3939
import Data.Aeson
40+
import Data.Type.Equality
4041
import Data.Typeable (Typeable)
4142

4243
data AllegraEraOnwards era where
@@ -101,6 +102,7 @@ type AllegraEraOnwardsConstraints era =
101102
, ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
102103
, ToJSON (DebugLedgerState era)
103104
, Typeable era
105+
, (era == ByronEra) ~ False
104106
)
105107

106108
allegraEraOnwardsConstraints

‎cardano-api/src/Cardano/Api/Internal/Eon/AlonzoEraOnwards.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -46,6 +46,7 @@ import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus
4646
import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus
4747

4848
import Data.Aeson
49+
import Data.Type.Equality
4950
import Data.Typeable (Typeable)
5051

5152
data AlonzoEraOnwards era where
@@ -115,6 +116,7 @@ type AlonzoEraOnwardsConstraints era =
115116
, ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
116117
, ToJSON (DebugLedgerState era)
117118
, Typeable era
119+
, (era == ByronEra) ~ False
118120
)
119121

120122
alonzoEraOnwardsConstraints

‎cardano-api/src/Cardano/Api/Internal/Eon/BabbageEraOnwards.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -45,6 +45,7 @@ import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus
4545
import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus
4646

4747
import Data.Aeson
48+
import Data.Type.Equality
4849
import Data.Typeable (Typeable)
4950

5051
data BabbageEraOnwards era where
@@ -119,6 +120,7 @@ type BabbageEraOnwardsConstraints era =
119120
, ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
120121
, ToJSON (DebugLedgerState era)
121122
, Typeable era
123+
, (era == ByronEra) ~ False
122124
)
123125

124126
babbageEraOnwardsConstraints

‎cardano-api/src/Cardano/Api/Internal/Eon/Convert.hs

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE FlexibleInstances #-}
12
{-# LANGUAGE MultiParamTypeClasses #-}
23
{-# LANGUAGE PolyKinds #-}
34
{-# LANGUAGE RankNTypes #-}
@@ -14,3 +15,6 @@ import Data.Kind (Type)
1415
-- relationship between types.
1516
class Convert (f :: a -> Type) (g :: a -> Type) where
1617
convert :: forall era. f era -> g era
18+
19+
instance Convert a a where
20+
convert = id

‎cardano-api/src/Cardano/Api/Internal/Eon/ConwayEraOnwards.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -46,6 +46,7 @@ import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus
4646
import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus
4747

4848
import Data.Aeson
49+
import Data.Type.Equality
4950
import Data.Typeable (Typeable)
5051

5152
data ConwayEraOnwards era where
@@ -122,6 +123,7 @@ type ConwayEraOnwardsConstraints era =
122123
, ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
123124
, ToJSON (DebugLedgerState era)
124125
, Typeable era
126+
, (era == ByronEra) ~ False
125127
)
126128

127129
conwayEraOnwardsConstraints

‎cardano-api/src/Cardano/Api/Internal/Eon/MaryEraOnwards.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -40,6 +40,7 @@ import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus
4040
import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus
4141

4242
import Data.Aeson
43+
import Data.Type.Equality
4344
import Data.Typeable (Typeable)
4445

4546
data MaryEraOnwards era where
@@ -103,6 +104,7 @@ type MaryEraOnwardsConstraints era =
103104
, ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
104105
, ToJSON (DebugLedgerState era)
105106
, Typeable era
107+
, (era == ByronEra) ~ False
106108
)
107109

108110
maryEraOnwardsConstraints

‎cardano-api/src/Cardano/Api/Internal/Eon/ShelleyBasedEra.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -59,7 +59,7 @@ import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus
5959
import Control.DeepSeq
6060
import Data.Aeson (FromJSON (..), ToJSON, toJSON, withText)
6161
import Data.Text qualified as Text
62-
import Data.Type.Equality (TestEquality (..), (:~:) (Refl))
62+
import Data.Type.Equality (TestEquality (..), (:~:) (Refl), type (==))
6363
import Data.Typeable (Typeable)
6464
import Text.Pretty (Pretty (..))
6565

@@ -230,6 +230,7 @@ type ShelleyBasedEraConstraints era =
230230
, ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
231231
, ToJSON (L.PredicateFailure (L.EraRule "LEDGER" (ShelleyLedgerEra era)))
232232
, Typeable era
233+
, (era == ByronEra) ~ False
233234
)
234235

235236
shelleyBasedEraConstraints

‎cardano-api/src/Cardano/Api/Internal/Eon/ShelleyEraOnly.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,7 @@ import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus
3838
import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus
3939

4040
import Data.Aeson
41+
import Data.Type.Equality
4142
import Data.Typeable (Typeable)
4243

4344
data ShelleyEraOnly era where
@@ -97,6 +98,7 @@ type ShelleyEraOnlyConstraints era =
9798
, ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
9899
, ToJSON (DebugLedgerState era)
99100
, Typeable era
101+
, (era == ByronEra) ~ False
100102
)
101103

102104
shelleyEraOnlyConstraints

‎cardano-api/src/Cardano/Api/Internal/Eon/ShelleyToAllegraEra.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -39,6 +39,7 @@ import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus
3939
import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus
4040

4141
import Data.Aeson
42+
import Data.Type.Equality
4243
import Data.Typeable (Typeable)
4344

4445
data ShelleyToAllegraEra era where
@@ -100,6 +101,7 @@ type ShelleyToAllegraEraConstraints era =
100101
, ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
101102
, ToJSON (DebugLedgerState era)
102103
, Typeable era
104+
, (era == ByronEra) ~ False
103105
)
104106

105107
shelleyToAllegraEraConstraints

‎cardano-api/src/Cardano/Api/Internal/Eon/ShelleyToAlonzoEra.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -37,6 +37,7 @@ import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus
3737
import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus
3838

3939
import Data.Aeson
40+
import Data.Type.Equality
4041
import Data.Typeable (Typeable)
4142

4243
data ShelleyToAlonzoEra era where
@@ -101,6 +102,7 @@ type ShelleyToAlonzoEraConstraints era =
101102
, ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
102103
, ToJSON (DebugLedgerState era)
103104
, Typeable era
105+
, (era == ByronEra) ~ False
104106
)
105107

106108
shelleyToAlonzoEraConstraints

‎cardano-api/src/Cardano/Api/Internal/Eon/ShelleyToBabbageEra.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -37,6 +37,7 @@ import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus
3737
import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus
3838

3939
import Data.Aeson
40+
import Data.Type.Equality
4041
import Data.Typeable (Typeable)
4142

4243
data ShelleyToBabbageEra era where
@@ -105,6 +106,7 @@ type ShelleyToBabbageEraConstraints era =
105106
, ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
106107
, ToJSON (DebugLedgerState era)
107108
, Typeable era
109+
, (era == ByronEra) ~ False
108110
)
109111

110112
shelleyToBabbageEraConstraints

‎cardano-api/src/Cardano/Api/Internal/Eon/ShelleyToMaryEra.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,7 @@ import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus
3838
import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus
3939

4040
import Data.Aeson
41+
import Data.Type.Equality
4142
import Data.Typeable (Typeable)
4243

4344
data ShelleyToMaryEra era where
@@ -100,6 +101,7 @@ type ShelleyToMaryEraConstraints era =
100101
, ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
101102
, ToJSON (DebugLedgerState era)
102103
, Typeable era
104+
, (era == ByronEra) ~ False
103105
)
104106

105107
shelleyToMaryEraConstraints

‎cardano-api/src/Cardano/Api/Internal/Eras/Case.hs

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -150,6 +150,7 @@ caseShelleyToBabbageOrConwayEraOnwards l r = \case
150150
ShelleyBasedEraBabbage -> l ShelleyToBabbageEraBabbage
151151
ShelleyBasedEraConway -> r ConwayEraOnwardsConway
152152

153+
{-# DEPRECATED shelleyToAlonzoEraToShelleyToBabbageEra "Use convert instead" #-}
153154
shelleyToAlonzoEraToShelleyToBabbageEra
154155
:: ()
155156
=> ShelleyToAlonzoEra era
@@ -160,6 +161,7 @@ shelleyToAlonzoEraToShelleyToBabbageEra = \case
160161
ShelleyToAlonzoEraMary -> ShelleyToBabbageEraMary
161162
ShelleyToAlonzoEraAlonzo -> ShelleyToBabbageEraAlonzo
162163

164+
{-# DEPRECATED alonzoEraOnwardsToMaryEraOnwards "Use convert instead" #-}
163165
alonzoEraOnwardsToMaryEraOnwards
164166
:: ()
165167
=> AlonzoEraOnwards era
@@ -169,6 +171,7 @@ alonzoEraOnwardsToMaryEraOnwards = \case
169171
AlonzoEraOnwardsBabbage -> MaryEraOnwardsBabbage
170172
AlonzoEraOnwardsConway -> MaryEraOnwardsConway
171173

174+
{-# DEPRECATED babbageEraOnwardsToMaryEraOnwards "Use convert instead" #-}
172175
babbageEraOnwardsToMaryEraOnwards
173176
:: ()
174177
=> BabbageEraOnwards era
@@ -177,6 +180,7 @@ babbageEraOnwardsToMaryEraOnwards = \case
177180
BabbageEraOnwardsBabbage -> MaryEraOnwardsBabbage
178181
BabbageEraOnwardsConway -> MaryEraOnwardsConway
179182

183+
{-# DEPRECATED babbageEraOnwardsToAlonzoEraOnwards "Use convert instead" #-}
180184
babbageEraOnwardsToAlonzoEraOnwards
181185
:: ()
182186
=> BabbageEraOnwards era

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

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -72,6 +72,7 @@ import Ouroboros.Consensus.Shelley.Eras qualified as Consensus
7272
import Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyHash (..))
7373
import Ouroboros.Consensus.Shelley.Ledger.Query qualified as Consensus
7474
import Ouroboros.Network.Block (HeaderHash, Tip (..))
75+
import Ouroboros.Network.Protocol.LocalTxSubmission.Type qualified as Net.Tx
7576
import PlutusLedgerApi.Common qualified as P
7677
import PlutusLedgerApi.V2 qualified as V2
7778

@@ -371,6 +372,8 @@ instance ToJSON PraosState where
371372
, "lastEpochBlockNonce" .= Consensus.praosStateLastEpochBlockNonce s
372373
]
373374

375+
deriving instance Show a => Show (Net.Tx.SubmitResult a)
376+
374377
-- We wrap the individual records with Last and use Last's Semigroup instance.
375378
-- In this instance we take the last 'Just' value or the only 'Just' value
376379
instance Semigroup (Ledger.ShelleyPParams StrictMaybe era) where

0 commit comments

Comments
 (0)