Skip to content

Commit 8efbdbc

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

File tree

2 files changed

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

2 files changed

+75
-87
lines changed

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

Lines changed: 58 additions & 67 deletions
Original file line numberDiff line numberDiff line change
@@ -12,11 +12,11 @@
1212
{-# LANGUAGE StandaloneDeriving #-}
1313
{-# LANGUAGE TypeApplications #-}
1414
{-# LANGUAGE TypeFamilies #-}
15-
{-# LANGUAGE TypeOperators #-}
1615
{-# LANGUAGE UndecidableInstances #-}
1716
{-# LANGUAGE UndecidableSuperClasses #-}
1817
{-# LANGUAGE ViewPatterns #-}
1918
{-# OPTIONS_GHC -Wno-orphans #-}
19+
{-# LANGUAGE BangPatterns #-}
2020

2121
module Cardano.Ledger.Alonzo.TxOut (
2222
AlonzoEraTxOut (..),
@@ -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,19 @@ 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 Addr network paymentCred (StakeRefBase stakeRef)
130129
{-# INLINE decodeAddress28 #-}
131130

132131
data AlonzoTxOut era
@@ -155,16 +154,11 @@ deriving instance Generic (AlonzoTxOut era)
155154
instance NFData (AlonzoTxOut era) where
156155
rnf = rwhnf
157156

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

169163
viewCompactTxOut ::
170164
Val (Value era) =>
@@ -173,15 +167,15 @@ viewCompactTxOut ::
173167
viewCompactTxOut txOut = case txOut of
174168
TxOutCompact' addr val -> (addr, val, SNothing)
175169
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
170+
TxOut_AddrHash28_AdaOnly stakeRef addr28Extra adaVal ->
171+
let
172+
!addr = decodeAddress28 stakeRef addr28Extra
173+
in (compactAddr addr, injectCompact adaVal, SNothing)
174+
TxOut_AddrHash28_AdaOnly_DataHash32 stakeRef addr28Extra adaVal dataHash32 ->
175+
let
176+
!addr = decodeAddress28 stakeRef addr28Extra
177+
!dh = decodeDataHash32 dataHash32
178+
in (compactAddr addr, injectCompact adaVal, SJust dh)
185179

186180
viewTxOut ::
187181
Val (Value era) =>
@@ -195,15 +189,14 @@ viewTxOut (TxOutCompactDH' bs c dh) = (addr, val, SJust dh)
195189
where
196190
addr = decompactAddr bs
197191
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
192+
viewTxOut (TxOut_AddrHash28_AdaOnly stakeRef addr28Extra adaVal) =
193+
let !addr = decodeAddress28 stakeRef addr28Extra
194+
in (addr, inject (fromCompact adaVal), SNothing)
195+
viewTxOut (TxOut_AddrHash28_AdaOnly_DataHash32 stakeRef addr28Extra adaVal dataHash32) =
196+
let
197+
!addr = decodeAddress28 stakeRef addr28Extra
198+
!dh = decodeDataHash32 dataHash32
199+
in (addr, inject (fromCompact adaVal), SJust dh)
207200

208201
instance (Era era, Val (Value era)) => Show (AlonzoTxOut era) where
209202
show = show . viewTxOut -- FIXME: showing tuple is ugly
@@ -213,7 +206,7 @@ deriving via InspectHeapNamed "AlonzoTxOut" (AlonzoTxOut era) instance NoThunks
213206
encodeAddress28 ::
214207
Network ->
215208
PaymentCredential ->
216-
Maybe (SizeHash ADDRHASH :~: 28, Addr28Extra)
209+
Addr28Extra
217210
encodeAddress28 network paymentCred = do
218211
let networkBit, payCredTypeBit :: Word64
219212
networkBit =
@@ -226,26 +219,28 @@ encodeAddress28 network paymentCred = do
226219
ScriptHashObj {} -> 0
227220
encodeAddr ::
228221
Hash ADDRHASH a ->
229-
Maybe (SizeHash ADDRHASH :~: 28, Addr28Extra)
222+
Addr28Extra
230223
encodeAddr h = do
231-
refl@Refl <- sameNat (Proxy @(SizeHash ADDRHASH)) (Proxy @28)
232224
case hashToPackedBytes h of
233225
PackedBytes28 a b c d ->
234226
let d' = (fromIntegral d `shiftL` 32) .|. networkBit .|. payCredTypeBit
235-
in Just (refl, Addr28Extra a b c d')
236-
_ -> Nothing
227+
in Addr28Extra a b c d'
228+
_ ->
229+
-- This case should never match, but if it does, we output garbage
230+
Addr28Extra 0xaa 0xaa 0xaa 0xaa
237231
case paymentCred of
238232
KeyHashObj (KeyHash addrHash) -> encodeAddr addrHash
239233
ScriptHashObj (ScriptHash addrHash) -> encodeAddr addrHash
240234

241235
encodeDataHash32 ::
242236
DataHash ->
243-
Maybe (SizeHash HASH :~: 32, DataHash32)
237+
DataHash32
244238
encodeDataHash32 dataHash = do
245-
refl@Refl <- sameNat (Proxy @(SizeHash HASH)) (Proxy @32)
246239
case hashToPackedBytes (extractHash dataHash) of
247-
PackedBytes32 a b c d -> Just (refl, DataHash32 a b c d)
248-
_ -> Nothing
240+
PackedBytes32 a b c d -> DataHash32 a b c d
241+
_ ->
242+
-- This case should never match, but if it does, we output garbage
243+
DataHash32 0xbb 0xbb 0xbb 0xbb
249244

250245
getAdaOnly ::
251246
forall era.
@@ -269,15 +264,16 @@ pattern AlonzoTxOut addr vl dh <-
269264
where
270265
AlonzoTxOut (Addr network paymentCred stakeRef) vl SNothing
271266
| StakeRefBase stakeCred <- stakeRef
272-
, Just adaCompact <- getAdaOnly (Proxy @era) vl
273-
, Just (Refl, addr28Extra) <- encodeAddress28 network paymentCred =
274-
TxOut_AddrHash28_AdaOnly stakeCred addr28Extra adaCompact
267+
, Just adaCompact <- getAdaOnly (Proxy @era) vl =
268+
let addr28Extra = encodeAddress28 network paymentCred
269+
in TxOut_AddrHash28_AdaOnly stakeCred addr28Extra adaCompact
275270
AlonzoTxOut (Addr network paymentCred stakeRef) vl (SJust dh)
276271
| 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
272+
, Just adaCompact <- getAdaOnly (Proxy @era) vl =
273+
let
274+
addr28Extra = encodeAddress28 network paymentCred
275+
dataHash32 = encodeDataHash32 dh
276+
in TxOut_AddrHash28_AdaOnly_DataHash32 stakeCred addr28Extra adaCompact dataHash32
281277
AlonzoTxOut addr vl mdh =
282278
let v = fromMaybe (error $ "Illegal value in TxOut: " ++ show vl) $ toCompact vl
283279
a = compactAddr addr
@@ -440,15 +436,12 @@ mkTxOutCompact addr cAddr cVal mdh
440436

441437
getAlonzoTxOutDataHash ::
442438
forall era.
443-
HasCallStack =>
444439
AlonzoTxOut era ->
445440
StrictMaybe DataHash
446441
getAlonzoTxOutDataHash = \case
447442
TxOutCompactDH' _ _ dh -> SJust dh
448443
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
444+
SJust $! decodeDataHash32 dh
452445
_ -> SNothing
453446

454447
getAlonzoTxOutEitherAddr ::
@@ -457,12 +450,10 @@ getAlonzoTxOutEitherAddr ::
457450
getAlonzoTxOutEitherAddr = \case
458451
TxOutCompact' cAddr _ -> Right cAddr
459452
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
453+
TxOut_AddrHash28_AdaOnly stakeRef addr28Extra _ ->
454+
Left $! decodeAddress28 stakeRef addr28Extra
455+
TxOut_AddrHash28_AdaOnly_DataHash32 stakeRef addr28Extra _ _ ->
456+
Left $! decodeAddress28 stakeRef addr28Extra
466457

467458
-- | Compute an estimate of the size of storing one UTxO entry.
468459
-- 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: 17 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,18 @@ 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 TxOut_AddrHash28_AdaOnly stakeCred addr28Extra adaCompact
385386
mkTxOut addr _cAddr vl (DatumHash dh) SNothing
386387
| Just adaCompact <- getAdaOnly (Proxy @era) vl
387388
, 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
389+
, StakeRefBase stakeCred <- stakeRef =
390+
let
391+
addr28Extra = encodeAddress28 network paymentCred
392+
dataHash32 = encodeDataHash32 dh
393+
in TxOut_AddrHash28_AdaOnly_DataHash32 stakeCred addr28Extra adaCompact dataHash32
392394
mkTxOut _addr cAddr vl d rs =
393395
let cVal = fromMaybe (error ("Illegal Value in TxOut: " ++ show vl)) $ toCompact vl
394396
in case rs of
@@ -611,20 +613,17 @@ babbageMinUTxOValue pp sizedTxOut =
611613
{-# INLINE babbageMinUTxOValue #-}
612614

613615
getEitherAddrBabbageTxOut ::
614-
HasCallStack =>
615616
BabbageTxOut era ->
616617
Either Addr CompactAddr
617618
getEitherAddrBabbageTxOut = \case
618619
TxOutCompact' cAddr _ -> Right cAddr
619620
TxOutCompactDH' cAddr _ _ -> Right cAddr
620621
TxOutCompactRefScript cAddr _ _ _ -> Right cAddr
621622
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"
623+
TxOut_AddrHash28_AdaOnly stakeRef addr28Extra _ ->
624+
Left $! decodeAddress28 stakeRef addr28Extra
625+
TxOut_AddrHash28_AdaOnly_DataHash32 stakeRef addr28Extra _ _ ->
626+
Left $! decodeAddress28 stakeRef addr28Extra
628627
{-# INLINE getEitherAddrBabbageTxOut #-}
629628

630629
-- TODO: Switch to using `getDatumBabbageTxOut`
@@ -646,7 +645,6 @@ getDataBabbageTxOut = \case
646645
-- Note that this function does *not* return the hash of an inline datum
647646
-- if one is present.
648647
getDataHashBabbageTxOut ::
649-
HasCallStack =>
650648
BabbageTxOut era ->
651649
StrictMaybe DataHash
652650
getDataHashBabbageTxOut txOut =
@@ -666,16 +664,15 @@ getScriptBabbageTxOut = \case
666664
TxOut_AddrHash28_AdaOnly_DataHash32 {} -> SNothing
667665
{-# INLINE getScriptBabbageTxOut #-}
668666

669-
getDatumBabbageTxOut :: HasCallStack => BabbageTxOut era -> Datum era
667+
getDatumBabbageTxOut :: BabbageTxOut era -> Datum era
670668
getDatumBabbageTxOut = \case
671669
TxOutCompact' {} -> NoDatum
672670
TxOutCompactDH' _ _ dh -> DatumHash dh
673671
TxOutCompactDatum _ _ binaryData -> Datum binaryData
674672
TxOutCompactRefScript _ _ datum _ -> datum
675673
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
674+
TxOut_AddrHash28_AdaOnly_DataHash32 _ _ _ dataHash32 ->
675+
DatumHash $! decodeDataHash32 dataHash32
679676
{-# INLINEABLE getDatumBabbageTxOut #-}
680677

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

0 commit comments

Comments
 (0)