Skip to content

Commit 4ed8ec7

Browse files
carbolymercarbolymer
authored
Merge pull request #825 from IntersectMBO/mgalazyn/chore/small-fixes
Medium QoL changes
2 parents 73fd870 + 3414b12 commit 4ed8ec7

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

43 files changed

+219
-221
lines changed

‎cardano-api/gen/Test/Hedgehog/Roundtrip/Bech32.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -10,8 +10,8 @@ import Hedgehog qualified as H
1010

1111
roundtrip_Bech32
1212
:: (SerialiseAsBech32 a, Eq a, Show a)
13-
=> AsType a -> Gen a -> Property
14-
roundtrip_Bech32 typeProxy gen =
13+
=> Gen a -> Property
14+
roundtrip_Bech32 gen =
1515
H.property $ do
1616
val <- H.forAll gen
17-
H.tripping val serialiseToBech32 (deserialiseFromBech32 typeProxy)
17+
H.tripping val serialiseToBech32 deserialiseFromBech32

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -160,6 +160,7 @@ module Cardano.Api
160160
-- * Type tags
161161
, HasTypeProxy (..)
162162
, AsType (..)
163+
, asType
163164

164165
-- * Cryptographic key interface
165166
-- $keys

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

Lines changed: 19 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -270,7 +270,7 @@ instance SerialiseAddress (Address ShelleyAddr) where
270270

271271
deserialiseAddress (AsAddress AsShelleyAddr) t =
272272
either (const Nothing) Just $
273-
deserialiseFromBech32 (AsAddress AsShelleyAddr) t
273+
deserialiseFromBech32 t
274274

275275
instance ToJSON (Address ShelleyAddr) where
276276
toJSON = Aeson.String . serialiseAddress
@@ -384,10 +384,10 @@ instance IsShelleyBasedEra era => FromJSON (AddressInEra era) where
384384
addressAny <- runParsecParser parseAddressAny txt
385385
pure $ anyAddressInShelleyBasedEra sbe addressAny
386386

387-
parseAddressAny :: Parsec.Parser AddressAny
387+
parseAddressAny :: SerialiseAddress addr => Parsec.Parser addr
388388
parseAddressAny = do
389389
str <- lexPlausibleAddressString
390-
case deserialiseAddress AsAddressAny str of
390+
case deserialiseAddress asType str of
391391
Nothing -> fail $ "invalid address: " <> Text.unpack str
392392
Just addr -> pure addr
393393

@@ -478,7 +478,8 @@ shelleyAddressInEra
478478
-> Address ShelleyAddr
479479
-> AddressInEra era
480480
shelleyAddressInEra sbe =
481-
AddressInEra (ShelleyAddressInEra sbe)
481+
shelleyBasedEraConstraints sbe $
482+
AddressInEra (ShelleyAddressInEra sbe)
482483

483484
anyAddressInShelleyBasedEra
484485
:: ()
@@ -495,12 +496,12 @@ anyAddressInEra
495496
-> Either String (AddressInEra era)
496497
anyAddressInEra era = \case
497498
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))
499+
pure $ AddressInEra ByronAddressInAnyEra addr
500+
AddressShelley addr -> do
501+
sbe <- forEraMaybeEon era ?! "Expected Byron based era address"
502+
shelleyBasedEraConstraints sbe $
503+
pure $
504+
AddressInEra (ShelleyAddressInEra sbe) addr
504505

505506
toAddressAny :: Address addr -> AddressAny
506507
toAddressAny a@ShelleyAddress{} = AddressShelley a
@@ -589,7 +590,7 @@ instance SerialiseAddress StakeAddress where
589590

590591
deserialiseAddress AsStakeAddress t =
591592
either (const Nothing) Just $
592-
deserialiseFromBech32 AsStakeAddress t
593+
deserialiseFromBech32 t
593594

594595
instance ToJSON StakeAddress where
595596
toJSON s = Aeson.String $ serialiseAddress s
@@ -685,18 +686,20 @@ fromShelleyAddrIsSbe sbe = \case
685686
Shelley.AddrBootstrap (Shelley.BootstrapAddress addr) ->
686687
AddressInEra ByronAddressInAnyEra (ByronAddress addr)
687688
Shelley.Addr nw pc scr ->
688-
AddressInEra (ShelleyAddressInEra sbe) (ShelleyAddress nw pc scr)
689+
shelleyBasedEraConstraints sbe $
690+
AddressInEra (ShelleyAddressInEra sbe) (ShelleyAddress nw pc scr)
689691

690692
fromShelleyAddr
691693
:: ShelleyBasedEra era
692694
-> Shelley.Addr
693695
-> AddressInEra era
694696
fromShelleyAddr _ (Shelley.AddrBootstrap (Shelley.BootstrapAddress addr)) =
695697
AddressInEra ByronAddressInAnyEra (ByronAddress addr)
696-
fromShelleyAddr sBasedEra (Shelley.Addr nw pc scr) =
697-
AddressInEra
698-
(ShelleyAddressInEra sBasedEra)
699-
(ShelleyAddress nw pc scr)
698+
fromShelleyAddr sbe (Shelley.Addr nw pc scr) =
699+
shelleyBasedEraConstraints sbe $
700+
AddressInEra
701+
(ShelleyAddressInEra sbe)
702+
(ShelleyAddress nw pc scr)
700703

701704
fromShelleyStakeAddr :: Shelley.RewardAccount -> StakeAddress
702705
fromShelleyStakeAddr (Shelley.RewardAccount nw sc) = StakeAddress nw sc

‎cardano-api/src/Cardano/Api/Internal/CIP/Cip129.hs

Lines changed: 8 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -4,8 +4,8 @@
44
{-# LANGUAGE LambdaCase #-}
55
{-# LANGUAGE RankNTypes #-}
66
{-# LANGUAGE ScopedTypeVariables #-}
7+
{-# LANGUAGE TypeApplications #-}
78
{-# LANGUAGE TypeFamilies #-}
8-
{-# OPTIONS_GHC -Wno-orphans #-}
99

1010
module Cardano.Api.Internal.CIP.Cip129
1111
( Cip129 (..)
@@ -98,15 +98,17 @@ serialiseToBech32Cip129 a =
9898
humanReadablePart = cip129Bech32PrefixFor (proxyToAsType (Proxy :: Proxy a))
9999

100100
deserialiseFromBech32Cip129
101-
:: Cip129 a
102-
=> AsType a -> Text -> Either Bech32DecodeError a
103-
deserialiseFromBech32Cip129 asType bech32Str = do
101+
:: forall a
102+
. Cip129 a
103+
=> Text
104+
-> Either Bech32DecodeError a
105+
deserialiseFromBech32Cip129 bech32Str = do
104106
(prefix, dataPart) <-
105107
Bech32.decodeLenient bech32Str
106108
?!. Bech32DecodingError
107109

108110
let actualPrefix = Bech32.humanReadablePartToText prefix
109-
permittedPrefixes = cip129Bech32PrefixesPermitted asType
111+
permittedPrefixes = cip129Bech32PrefixesPermitted (asType @a)
110112
guard (actualPrefix `elem` permittedPrefixes)
111113
?! Bech32UnexpectedPrefix actualPrefix (fromList permittedPrefixes)
112114

@@ -128,7 +130,7 @@ deserialiseFromBech32Cip129 asType bech32Str = do
128130
guard (header == expectedHeader)
129131
?! Bech32UnexpectedHeader (toBase16Text expectedHeader) (toBase16Text header)
130132

131-
let expectedPrefix = Bech32.humanReadablePartToText $ cip129Bech32PrefixFor asType
133+
let expectedPrefix = Bech32.humanReadablePartToText $ cip129Bech32PrefixFor (asType @a)
132134
guard (actualPrefix == expectedPrefix)
133135
?! Bech32WrongPrefix actualPrefix expectedPrefix
134136

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

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,7 @@ where
2323

2424
import Cardano.Api.Internal.Address
2525
import Cardano.Api.Internal.Error
26+
import Cardano.Api.Internal.HasTypeProxy
2627
import Cardano.Api.Internal.Keys.Byron
2728
import Cardano.Api.Internal.Keys.Class
2829
import Cardano.Api.Internal.Keys.Praos
@@ -108,11 +109,10 @@ data DeserialiseInputResult a
108109
-- | Deserialise an input of some type that is formatted in some way.
109110
deserialiseInput
110111
:: forall a
111-
. AsType a
112-
-> NonEmpty (InputFormat a)
112+
. NonEmpty (InputFormat a)
113113
-> ByteString
114114
-> Either InputDecodeError a
115-
deserialiseInput asType acceptedFormats inputBs =
115+
deserialiseInput acceptedFormats inputBs =
116116
go (toList acceptedFormats)
117117
where
118118
inputText :: Text
@@ -135,7 +135,7 @@ deserialiseInput asType acceptedFormats inputBs =
135135
deserialiseTextEnvelope = do
136136
let textEnvRes :: Either TextEnvelopeError a
137137
textEnvRes =
138-
deserialiseFromTextEnvelope asType
138+
deserialiseFromTextEnvelope
139139
=<< first TextEnvelopeAesonDecodeError (Aeson.eitherDecodeStrict' inputBs)
140140
case textEnvRes of
141141
Right res -> DeserialiseInputSuccess res
@@ -148,7 +148,7 @@ deserialiseInput asType acceptedFormats inputBs =
148148

149149
deserialiseBech32 :: SerialiseAsBech32 a => DeserialiseInputResult a
150150
deserialiseBech32 =
151-
case deserialiseFromBech32 asType inputText of
151+
case deserialiseFromBech32 inputText of
152152
Right res -> DeserialiseInputSuccess res
153153
-- The input was not valid Bech32.
154154
Left (Bech32DecodingError _) -> DeserialiseInputErrorFormatMismatch
@@ -158,7 +158,7 @@ deserialiseInput asType acceptedFormats inputBs =
158158
deserialiseHex :: SerialiseAsRawBytes a => DeserialiseInputResult a
159159
deserialiseHex
160160
| isValidHex inputBs =
161-
case deserialiseFromRawBytesHex asType inputBs of
161+
case deserialiseFromRawBytesHex inputBs of
162162
Left _ -> DeserialiseInputError InputInvalidError
163163
Right x -> DeserialiseInputSuccess x
164164
| otherwise = DeserialiseInputErrorFormatMismatch

‎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

0 commit comments

Comments
 (0)