Skip to content

Commit f2a8447

Browse files
SoupstrawSoupstraw
committed
Removed hash size proofs
1 parent 5aed6e5 commit f2a8447

File tree

2 files changed

+82
-87
lines changed
  • eras
    • alonzo/impl/src/Cardano/Ledger/Alonzo
    • babbage/impl/src/Cardano/Ledger/Babbage

2 files changed

+82
-87
lines changed

‎eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxOut.hs‎

Lines changed: 63 additions & 67 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE BangPatterns #-}
12
{-# LANGUAGE DataKinds #-}
23
{-# LANGUAGE DeriveAnyClass #-}
34
{-# LANGUAGE DeriveGeneric #-}
@@ -12,7 +13,6 @@
1213
{-# LANGUAGE StandaloneDeriving #-}
1314
{-# LANGUAGE TypeApplications #-}
1415
{-# LANGUAGE TypeFamilies #-}
15-
{-# LANGUAGE TypeOperators #-}
1616
{-# LANGUAGE UndecidableInstances #-}
1717
{-# LANGUAGE UndecidableSuperClasses #-}
1818
{-# LANGUAGE ViewPatterns #-}
@@ -82,11 +82,10 @@ import Data.Aeson (ToJSON (..), object, (.=))
8282
import qualified Data.Aeson as Aeson (Value (Null, String))
8383
import Data.Bits
8484
import Data.Maybe (fromMaybe)
85-
import Data.Typeable (Proxy (..), (:~:) (Refl))
85+
import Data.Typeable (Proxy (..))
8686
import Data.Word
8787
import GHC.Generics (Generic)
8888
import GHC.Stack (HasCallStack)
89-
import GHC.TypeLits
9089
import Lens.Micro
9190
import NoThunks.Class (InspectHeapNamed (..), NoThunks)
9291

@@ -114,19 +113,20 @@ data DataHash32
114113
decodeAddress28 ::
115114
Credential 'Staking ->
116115
Addr28Extra ->
117-
Maybe Addr
118-
decodeAddress28 stakeRef (Addr28Extra a b c d) = do
119-
Refl <- sameNat (Proxy @(SizeHash ADDRHASH)) (Proxy @28)
120-
let network = if d `testBit` 1 then Mainnet else Testnet
121-
paymentCred =
122-
if d `testBit` 0
123-
then KeyHashObj (KeyHash addrHash)
124-
else ScriptHashObj (ScriptHash addrHash)
125-
addrHash :: Hash ADDRHASH a
126-
addrHash =
127-
hashFromPackedBytes $
128-
PackedBytes28 a b c (fromIntegral (d `shiftR` 32))
129-
pure $! Addr network paymentCred (StakeRefBase stakeRef)
116+
Addr
117+
decodeAddress28 stakeRef (Addr28Extra a b c d) =
118+
let
119+
network = if d `testBit` 1 then Mainnet else Testnet
120+
paymentCred =
121+
if d `testBit` 0
122+
then KeyHashObj (KeyHash addrHash)
123+
else ScriptHashObj (ScriptHash addrHash)
124+
addrHash :: Hash ADDRHASH a
125+
addrHash =
126+
hashFromPackedBytes $
127+
PackedBytes28 a b c (fromIntegral (d `shiftR` 32))
128+
in
129+
Addr network paymentCred (StakeRefBase stakeRef)
130130
{-# INLINE decodeAddress28 #-}
131131

132132
data AlonzoTxOut era
@@ -155,16 +155,11 @@ deriving instance Generic (AlonzoTxOut era)
155155
instance NFData (AlonzoTxOut era) where
156156
rnf = rwhnf
157157

158-
addressErrorMsg :: String
159-
addressErrorMsg = "Impossible: Compacted an address of non-standard size"
160-
{-# NOINLINE addressErrorMsg #-}
161-
162158
decodeDataHash32 ::
163159
DataHash32 ->
164-
Maybe DataHash
160+
DataHash
165161
decodeDataHash32 (DataHash32 a b c d) = do
166-
Refl <- sameNat (Proxy @(SizeHash HASH)) (Proxy @32)
167-
Just $! unsafeMakeSafeHash $ hashFromPackedBytes $ PackedBytes32 a b c d
162+
unsafeMakeSafeHash $ hashFromPackedBytes $ PackedBytes32 a b c d
168163

169164
viewCompactTxOut ::
170165
Val (Value era) =>
@@ -173,15 +168,17 @@ viewCompactTxOut ::
173168
viewCompactTxOut txOut = case txOut of
174169
TxOutCompact' addr val -> (addr, val, SNothing)
175170
TxOutCompactDH' addr val dh -> (addr, val, SJust dh)
176-
TxOut_AddrHash28_AdaOnly stakeRef addr28Extra adaVal
177-
| Just addr <- decodeAddress28 stakeRef addr28Extra ->
178-
(compactAddr addr, injectCompact adaVal, SNothing)
179-
| otherwise -> error addressErrorMsg
180-
TxOut_AddrHash28_AdaOnly_DataHash32 stakeRef addr28Extra adaVal dataHash32
181-
| Just addr <- decodeAddress28 stakeRef addr28Extra
182-
, Just dh <- decodeDataHash32 dataHash32 ->
183-
(compactAddr addr, injectCompact adaVal, SJust dh)
184-
| otherwise -> error addressErrorMsg
171+
TxOut_AddrHash28_AdaOnly stakeRef addr28Extra adaVal ->
172+
let
173+
!addr = decodeAddress28 stakeRef addr28Extra
174+
in
175+
(compactAddr addr, injectCompact adaVal, SNothing)
176+
TxOut_AddrHash28_AdaOnly_DataHash32 stakeRef addr28Extra adaVal dataHash32 ->
177+
let
178+
!addr = decodeAddress28 stakeRef addr28Extra
179+
!dh = decodeDataHash32 dataHash32
180+
in
181+
(compactAddr addr, injectCompact adaVal, SJust dh)
185182

186183
viewTxOut ::
187184
Val (Value era) =>
@@ -195,15 +192,15 @@ viewTxOut (TxOutCompactDH' bs c dh) = (addr, val, SJust dh)
195192
where
196193
addr = decompactAddr bs
197194
val = fromCompact c
198-
viewTxOut (TxOut_AddrHash28_AdaOnly stakeRef addr28Extra adaVal)
199-
| Just addr <- decodeAddress28 stakeRef addr28Extra =
200-
(addr, inject (fromCompact adaVal), SNothing)
201-
viewTxOut (TxOut_AddrHash28_AdaOnly_DataHash32 stakeRef addr28Extra adaVal dataHash32)
202-
| Just addr <- decodeAddress28 stakeRef addr28Extra
203-
, Just dh <- decodeDataHash32 dataHash32 =
204-
(addr, inject (fromCompact adaVal), SJust dh)
205-
viewTxOut TxOut_AddrHash28_AdaOnly {} = error addressErrorMsg
206-
viewTxOut TxOut_AddrHash28_AdaOnly_DataHash32 {} = error addressErrorMsg
195+
viewTxOut (TxOut_AddrHash28_AdaOnly stakeRef addr28Extra adaVal) =
196+
let !addr = decodeAddress28 stakeRef addr28Extra
197+
in (addr, inject (fromCompact adaVal), SNothing)
198+
viewTxOut (TxOut_AddrHash28_AdaOnly_DataHash32 stakeRef addr28Extra adaVal dataHash32) =
199+
let
200+
!addr = decodeAddress28 stakeRef addr28Extra
201+
!dh = decodeDataHash32 dataHash32
202+
in
203+
(addr, inject (fromCompact adaVal), SJust dh)
207204

208205
instance (Era era, Val (Value era)) => Show (AlonzoTxOut era) where
209206
show = show . viewTxOut -- FIXME: showing tuple is ugly
@@ -213,7 +210,7 @@ deriving via InspectHeapNamed "AlonzoTxOut" (AlonzoTxOut era) instance NoThunks
213210
encodeAddress28 ::
214211
Network ->
215212
PaymentCredential ->
216-
Maybe (SizeHash ADDRHASH :~: 28, Addr28Extra)
213+
Addr28Extra
217214
encodeAddress28 network paymentCred = do
218215
let networkBit, payCredTypeBit :: Word64
219216
networkBit =
@@ -226,26 +223,28 @@ encodeAddress28 network paymentCred = do
226223
ScriptHashObj {} -> 0
227224
encodeAddr ::
228225
Hash ADDRHASH a ->
229-
Maybe (SizeHash ADDRHASH :~: 28, Addr28Extra)
226+
Addr28Extra
230227
encodeAddr h = do
231-
refl@Refl <- sameNat (Proxy @(SizeHash ADDRHASH)) (Proxy @28)
232228
case hashToPackedBytes h of
233229
PackedBytes28 a b c d ->
234230
let d' = (fromIntegral d `shiftL` 32) .|. networkBit .|. payCredTypeBit
235-
in Just (refl, Addr28Extra a b c d')
236-
_ -> Nothing
231+
in Addr28Extra a b c d'
232+
_ ->
233+
-- This case should never match, but if it does, we output garbage
234+
Addr28Extra 0xaa 0xaa 0xaa 0xaa
237235
case paymentCred of
238236
KeyHashObj (KeyHash addrHash) -> encodeAddr addrHash
239237
ScriptHashObj (ScriptHash addrHash) -> encodeAddr addrHash
240238

241239
encodeDataHash32 ::
242240
DataHash ->
243-
Maybe (SizeHash HASH :~: 32, DataHash32)
241+
DataHash32
244242
encodeDataHash32 dataHash = do
245-
refl@Refl <- sameNat (Proxy @(SizeHash HASH)) (Proxy @32)
246243
case hashToPackedBytes (extractHash dataHash) of
247-
PackedBytes32 a b c d -> Just (refl, DataHash32 a b c d)
248-
_ -> Nothing
244+
PackedBytes32 a b c d -> DataHash32 a b c d
245+
_ ->
246+
-- This case should never match, but if it does, we output garbage
247+
DataHash32 0xaa 0xaa 0xaa 0xaa
249248

250249
getAdaOnly ::
251250
forall era.
@@ -269,15 +268,17 @@ pattern AlonzoTxOut addr vl dh <-
269268
where
270269
AlonzoTxOut (Addr network paymentCred stakeRef) vl SNothing
271270
| StakeRefBase stakeCred <- stakeRef
272-
, Just adaCompact <- getAdaOnly (Proxy @era) vl
273-
, Just (Refl, addr28Extra) <- encodeAddress28 network paymentCred =
274-
TxOut_AddrHash28_AdaOnly stakeCred addr28Extra adaCompact
271+
, Just adaCompact <- getAdaOnly (Proxy @era) vl =
272+
let addr28Extra = encodeAddress28 network paymentCred
273+
in TxOut_AddrHash28_AdaOnly stakeCred addr28Extra adaCompact
275274
AlonzoTxOut (Addr network paymentCred stakeRef) vl (SJust dh)
276275
| StakeRefBase stakeCred <- stakeRef
277-
, Just adaCompact <- getAdaOnly (Proxy @era) vl
278-
, Just (Refl, addr28Extra) <- encodeAddress28 network paymentCred
279-
, Just (Refl, dataHash32) <- encodeDataHash32 dh =
280-
TxOut_AddrHash28_AdaOnly_DataHash32 stakeCred addr28Extra adaCompact dataHash32
276+
, Just adaCompact <- getAdaOnly (Proxy @era) vl =
277+
let
278+
addr28Extra = encodeAddress28 network paymentCred
279+
dataHash32 = encodeDataHash32 dh
280+
in
281+
TxOut_AddrHash28_AdaOnly_DataHash32 stakeCred addr28Extra adaCompact dataHash32
281282
AlonzoTxOut addr vl mdh =
282283
let v = fromMaybe (error $ "Illegal value in TxOut: " ++ show vl) $ toCompact vl
283284
a = compactAddr addr
@@ -440,15 +441,12 @@ mkTxOutCompact addr cAddr cVal mdh
440441

441442
getAlonzoTxOutDataHash ::
442443
forall era.
443-
HasCallStack =>
444444
AlonzoTxOut era ->
445445
StrictMaybe DataHash
446446
getAlonzoTxOutDataHash = \case
447447
TxOutCompactDH' _ _ dh -> SJust dh
448448
TxOut_AddrHash28_AdaOnly_DataHash32 _ _ _ dh ->
449-
case decodeDataHash32 dh of
450-
Nothing -> error $ "Impossible: Compacted a DataHash of non-standard size: " ++ show dh
451-
Just dataHash -> SJust dataHash
449+
SJust $! decodeDataHash32 dh
452450
_ -> SNothing
453451

454452
getAlonzoTxOutEitherAddr ::
@@ -457,12 +455,10 @@ getAlonzoTxOutEitherAddr ::
457455
getAlonzoTxOutEitherAddr = \case
458456
TxOutCompact' cAddr _ -> Right cAddr
459457
TxOutCompactDH' cAddr _ _ -> Right cAddr
460-
TxOut_AddrHash28_AdaOnly stakeRef addr28Extra _
461-
| Just addr <- decodeAddress28 stakeRef addr28Extra -> Left addr
462-
| otherwise -> error addressErrorMsg
463-
TxOut_AddrHash28_AdaOnly_DataHash32 stakeRef addr28Extra _ _
464-
| Just addr <- decodeAddress28 stakeRef addr28Extra -> Left addr
465-
| otherwise -> error addressErrorMsg
458+
TxOut_AddrHash28_AdaOnly stakeRef addr28Extra _ ->
459+
Left $! decodeAddress28 stakeRef addr28Extra
460+
TxOut_AddrHash28_AdaOnly_DataHash32 stakeRef addr28Extra _ _ ->
461+
Left $! decodeAddress28 stakeRef addr28Extra
466462

467463
-- | Compute an estimate of the size of storing one UTxO entry.
468464
-- This function implements the UTxO entry size estimate done by scaledMinDeposit in the ShelleyMA era

‎eras/babbage/impl/src/Cardano/Ledger/Babbage/TxOut.hs‎

Lines changed: 19 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -114,7 +114,7 @@ import Data.Aeson (KeyValue, ToJSON (..), object, pairs, (.=))
114114
import qualified Data.ByteString.Lazy as LBS
115115
import Data.Maybe (fromMaybe)
116116
import qualified Data.Text as T
117-
import Data.Typeable (Proxy (..), (:~:) (Refl))
117+
import Data.Typeable (Proxy (..))
118118
import GHC.Generics (Generic)
119119
import GHC.Stack (HasCallStack)
120120
import Lens.Micro (Lens', lens, to, (^.))
@@ -379,16 +379,20 @@ mkTxOut ::
379379
mkTxOut addr _cAddr vl NoDatum SNothing
380380
| Just adaCompact <- getAdaOnly (Proxy @era) vl
381381
, Addr network paymentCred stakeRef <- addr
382-
, StakeRefBase stakeCred <- stakeRef
383-
, Just (Refl, addr28Extra) <- encodeAddress28 network paymentCred =
384-
TxOut_AddrHash28_AdaOnly stakeCred addr28Extra adaCompact
382+
, StakeRefBase stakeCred <- stakeRef =
383+
let
384+
addr28Extra = encodeAddress28 network paymentCred
385+
in
386+
TxOut_AddrHash28_AdaOnly stakeCred addr28Extra adaCompact
385387
mkTxOut addr _cAddr vl (DatumHash dh) SNothing
386388
| Just adaCompact <- getAdaOnly (Proxy @era) vl
387389
, Addr network paymentCred stakeRef <- addr
388-
, StakeRefBase stakeCred <- stakeRef
389-
, Just (Refl, addr28Extra) <- encodeAddress28 network paymentCred
390-
, Just (Refl, dataHash32) <- encodeDataHash32 dh =
391-
TxOut_AddrHash28_AdaOnly_DataHash32 stakeCred addr28Extra adaCompact dataHash32
390+
, StakeRefBase stakeCred <- stakeRef =
391+
let
392+
addr28Extra = encodeAddress28 network paymentCred
393+
dataHash32 = encodeDataHash32 dh
394+
in
395+
TxOut_AddrHash28_AdaOnly_DataHash32 stakeCred addr28Extra adaCompact dataHash32
392396
mkTxOut _addr cAddr vl d rs =
393397
let cVal = fromMaybe (error ("Illegal Value in TxOut: " ++ show vl)) $ toCompact vl
394398
in case rs of
@@ -611,20 +615,17 @@ babbageMinUTxOValue pp sizedTxOut =
611615
{-# INLINE babbageMinUTxOValue #-}
612616

613617
getEitherAddrBabbageTxOut ::
614-
HasCallStack =>
615618
BabbageTxOut era ->
616619
Either Addr CompactAddr
617620
getEitherAddrBabbageTxOut = \case
618621
TxOutCompact' cAddr _ -> Right cAddr
619622
TxOutCompactDH' cAddr _ _ -> Right cAddr
620623
TxOutCompactRefScript cAddr _ _ _ -> Right cAddr
621624
TxOutCompactDatum cAddr _ _ -> Right cAddr
622-
TxOut_AddrHash28_AdaOnly stakeRef addr28Extra _
623-
| Just addr <- decodeAddress28 stakeRef addr28Extra -> Left addr
624-
| otherwise -> error "Impossible: Compacted an address of non-standard size"
625-
TxOut_AddrHash28_AdaOnly_DataHash32 stakeRef addr28Extra _ _
626-
| Just addr <- decodeAddress28 stakeRef addr28Extra -> Left addr
627-
| otherwise -> error "Impossible: Compacted an address or a hash of non-standard size"
625+
TxOut_AddrHash28_AdaOnly stakeRef addr28Extra _ ->
626+
Left $! decodeAddress28 stakeRef addr28Extra
627+
TxOut_AddrHash28_AdaOnly_DataHash32 stakeRef addr28Extra _ _ ->
628+
Left $! decodeAddress28 stakeRef addr28Extra
628629
{-# INLINE getEitherAddrBabbageTxOut #-}
629630

630631
-- TODO: Switch to using `getDatumBabbageTxOut`
@@ -646,7 +647,6 @@ getDataBabbageTxOut = \case
646647
-- Note that this function does *not* return the hash of an inline datum
647648
-- if one is present.
648649
getDataHashBabbageTxOut ::
649-
HasCallStack =>
650650
BabbageTxOut era ->
651651
StrictMaybe DataHash
652652
getDataHashBabbageTxOut txOut =
@@ -666,16 +666,15 @@ getScriptBabbageTxOut = \case
666666
TxOut_AddrHash28_AdaOnly_DataHash32 {} -> SNothing
667667
{-# INLINE getScriptBabbageTxOut #-}
668668

669-
getDatumBabbageTxOut :: HasCallStack => BabbageTxOut era -> Datum era
669+
getDatumBabbageTxOut :: BabbageTxOut era -> Datum era
670670
getDatumBabbageTxOut = \case
671671
TxOutCompact' {} -> NoDatum
672672
TxOutCompactDH' _ _ dh -> DatumHash dh
673673
TxOutCompactDatum _ _ binaryData -> Datum binaryData
674674
TxOutCompactRefScript _ _ datum _ -> datum
675675
TxOut_AddrHash28_AdaOnly {} -> NoDatum
676-
TxOut_AddrHash28_AdaOnly_DataHash32 _ _ _ dataHash32
677-
| Just dh <- decodeDataHash32 dataHash32 -> DatumHash dh
678-
| otherwise -> error $ "Impossible: Compacted a hash of non-standard size: " ++ show dataHash32
676+
TxOut_AddrHash28_AdaOnly_DataHash32 _ _ _ dataHash32 ->
677+
DatumHash $! decodeDataHash32 dataHash32
679678
{-# INLINEABLE getDatumBabbageTxOut #-}
680679

681680
getCompactValueBabbageTxOut :: EraTxOut era => BabbageTxOut era -> CompactForm (Value era)

0 commit comments

Comments
 (0)