Skip to content

Commit c4fbe8a

Browse files
SoupstrawSoupstraw
committed
Add FixedSizeCodec
1 parent 193e6d1 commit c4fbe8a

8 files changed

Lines changed: 140 additions & 196 deletions

File tree

‎libs/cardano-ledger-binary/cardano-ledger-binary.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,7 @@ library
2121
Cardano.Ledger.Binary.Crypto
2222
Cardano.Ledger.Binary.Decoding
2323
Cardano.Ledger.Binary.Encoding
24+
Cardano.Ledger.Binary.FixedSizeCodec
2425
Cardano.Ledger.Binary.FlatTerm
2526
Cardano.Ledger.Binary.Group
2627
Cardano.Ledger.Binary.Plain

‎libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Crypto.hs‎

Lines changed: 32 additions & 110 deletions
Original file line numberDiff line numberDiff line change
@@ -1,66 +1,28 @@
11
{-# LANGUAGE ScopedTypeVariables #-}
2+
{-# LANGUAGE TypeApplications #-}
23

34
module Cardano.Ledger.Binary.Crypto (
4-
-- * DSIGN
5-
encodeVerKeyDSIGN,
6-
decodeVerKeyDSIGN,
7-
encodeSignKeyDSIGN,
8-
decodeSignKeyDSIGN,
9-
encodeSigDSIGN,
10-
decodeSigDSIGN,
11-
encodeSignedDSIGN,
5+
encFixed,
6+
decFixed,
127
decodeSignedDSIGN,
13-
14-
-- * KES
15-
encodeVerKeyKES,
16-
decodeVerKeyKES,
17-
encodeSigKES,
18-
decodeSigKES,
19-
encodeSignedKES,
20-
decodeSignedKES,
21-
22-
-- * VRF
23-
encodeVerKeyVRF,
24-
decodeVerKeyVRF,
25-
encodeSignKeyVRF,
26-
decodeSignKeyVRF,
27-
encodeCertVRF,
28-
decodeCertVRF,
8+
encodeSignedDSIGN,
299
) where
3010

3111
import qualified Cardano.Crypto.DSIGN.Class as C
32-
import qualified Cardano.Crypto.KES.Class as C
33-
import qualified Cardano.Crypto.VRF.Class as C
34-
import Cardano.Ledger.Binary.Decoding.Decoder (Decoder, fromPlainDecoder)
12+
import Cardano.Crypto.FixedSizeBytes (FixedSizeBytes (..))
13+
import Cardano.Ledger.Binary.Decoding.Decoder (
14+
Decoder,
15+
DecoderError (..),
16+
cborError,
17+
decodeBytes,
18+
fromPlainDecoder,
19+
)
3520
import Cardano.Ledger.Binary.Encoding.Encoder (Encoding, fromPlainEncoding)
36-
37-
--------------------------------------------------------------------------------
38-
-- DSIGN
39-
--------------------------------------------------------------------------------
40-
41-
encodeVerKeyDSIGN :: C.DSIGNAlgorithm v => C.VerKeyDSIGN v -> Encoding
42-
encodeVerKeyDSIGN = fromPlainEncoding . C.encodeVerKeyDSIGN
43-
{-# INLINE encodeVerKeyDSIGN #-}
44-
45-
decodeVerKeyDSIGN :: C.DSIGNAlgorithm v => Decoder s (C.VerKeyDSIGN v)
46-
decodeVerKeyDSIGN = fromPlainDecoder C.decodeVerKeyDSIGN
47-
{-# INLINE decodeVerKeyDSIGN #-}
48-
49-
encodeSignKeyDSIGN :: C.DSIGNAlgorithm v => C.SignKeyDSIGN v -> Encoding
50-
encodeSignKeyDSIGN = fromPlainEncoding . C.encodeSignKeyDSIGN
51-
{-# INLINE encodeSignKeyDSIGN #-}
52-
53-
decodeSignKeyDSIGN :: C.DSIGNAlgorithm v => Decoder s (C.SignKeyDSIGN v)
54-
decodeSignKeyDSIGN = fromPlainDecoder C.decodeSignKeyDSIGN
55-
{-# INLINE decodeSignKeyDSIGN #-}
56-
57-
encodeSigDSIGN :: C.DSIGNAlgorithm v => C.SigDSIGN v -> Encoding
58-
encodeSigDSIGN = fromPlainEncoding . C.encodeSigDSIGN
59-
{-# INLINE encodeSigDSIGN #-}
60-
61-
decodeSigDSIGN :: C.DSIGNAlgorithm v => Decoder s (C.SigDSIGN v)
62-
decodeSigDSIGN = fromPlainDecoder C.decodeSigDSIGN
63-
{-# INLINE decodeSigDSIGN #-}
21+
import qualified Data.ByteString as BS
22+
import Data.Proxy (Proxy (..))
23+
import qualified Data.Text as T
24+
import Data.Typeable (typeRep)
25+
import GHC.TypeLits (natVal)
6426

6527
encodeSignedDSIGN :: C.DSIGNAlgorithm v => C.SignedDSIGN v a -> Encoding
6628
encodeSignedDSIGN = fromPlainEncoding . C.encodeSignedDSIGN
@@ -70,58 +32,18 @@ decodeSignedDSIGN :: C.DSIGNAlgorithm v => Decoder s (C.SignedDSIGN v a)
7032
decodeSignedDSIGN = fromPlainDecoder C.decodeSignedDSIGN
7133
{-# INLINE decodeSignedDSIGN #-}
7234

73-
--------------------------------------------------------------------------------
74-
-- KES
75-
--------------------------------------------------------------------------------
76-
77-
encodeVerKeyKES :: C.KESAlgorithm v => C.VerKeyKES v -> Encoding
78-
encodeVerKeyKES = fromPlainEncoding . C.encodeVerKeyKES
79-
{-# INLINE encodeVerKeyKES #-}
80-
81-
decodeVerKeyKES :: C.KESAlgorithm v => Decoder s (C.VerKeyKES v)
82-
decodeVerKeyKES = fromPlainDecoder C.decodeVerKeyKES
83-
{-# INLINE decodeVerKeyKES #-}
84-
85-
encodeSigKES :: C.KESAlgorithm v => C.SigKES v -> Encoding
86-
encodeSigKES = fromPlainEncoding . C.encodeSigKES
87-
{-# INLINE encodeSigKES #-}
88-
89-
decodeSigKES :: C.KESAlgorithm v => Decoder s (C.SigKES v)
90-
decodeSigKES = fromPlainDecoder C.decodeSigKES
91-
{-# INLINE decodeSigKES #-}
92-
93-
encodeSignedKES :: C.KESAlgorithm v => C.SignedKES v a -> Encoding
94-
encodeSignedKES = fromPlainEncoding . C.encodeSignedKES
95-
{-# INLINE encodeSignedKES #-}
96-
97-
decodeSignedKES :: C.KESAlgorithm v => Decoder s (C.SignedKES v a)
98-
decodeSignedKES = fromPlainDecoder C.decodeSignedKES
99-
{-# INLINE decodeSignedKES #-}
100-
101-
--------------------------------------------------------------------------------
102-
-- VRF
103-
--------------------------------------------------------------------------------
104-
105-
encodeVerKeyVRF :: C.VRFAlgorithm v => C.VerKeyVRF v -> Encoding
106-
encodeVerKeyVRF = fromPlainEncoding . C.encodeVerKeyVRF
107-
{-# INLINE encodeVerKeyVRF #-}
108-
109-
decodeVerKeyVRF :: C.VRFAlgorithm v => Decoder s (C.VerKeyVRF v)
110-
decodeVerKeyVRF = fromPlainDecoder C.decodeVerKeyVRF
111-
{-# INLINE decodeVerKeyVRF #-}
112-
113-
encodeSignKeyVRF :: C.VRFAlgorithm v => C.SignKeyVRF v -> Encoding
114-
encodeSignKeyVRF = fromPlainEncoding . C.encodeSignKeyVRF
115-
{-# INLINE encodeSignKeyVRF #-}
116-
117-
decodeSignKeyVRF :: C.VRFAlgorithm v => Decoder s (C.SignKeyVRF v)
118-
decodeSignKeyVRF = fromPlainDecoder C.decodeSignKeyVRF
119-
{-# INLINE decodeSignKeyVRF #-}
120-
121-
encodeCertVRF :: C.VRFAlgorithm v => C.CertVRF v -> Encoding
122-
encodeCertVRF = fromPlainEncoding . C.encodeCertVRF
123-
{-# INLINE encodeCertVRF #-}
124-
125-
decodeCertVRF :: C.VRFAlgorithm v => Decoder s (C.CertVRF v)
126-
decodeCertVRF = fromPlainDecoder C.decodeCertVRF
127-
{-# INLINE decodeCertVRF #-}
35+
encFixed :: FixedSizeBytes a => a -> Encoding
36+
encFixed = fromPlainEncoding . encodeFixed
37+
38+
decFixed :: forall a s. FixedSizeBytes a => Decoder s a
39+
decFixed = do
40+
let p = Proxy @a
41+
bs <- decodeBytes
42+
case rawDecodeFixed bs of
43+
Just vk -> pure vk
44+
Nothing ->
45+
cborError $
46+
DecoderErrorSizeMismatch
47+
(T.pack . show $ typeRep p)
48+
(fromIntegral . natVal $ Proxy @(FixedSize a))
49+
(BS.length bs)

‎libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Decoding/DecCBOR.hs‎

Lines changed: 20 additions & 46 deletions
Original file line numberDiff line numberDiff line change
@@ -39,10 +39,7 @@ import Cardano.Crypto.VRF.Class (
3939
VRFAlgorithm,
4040
VerKeyVRF,
4141
)
42-
import Cardano.Crypto.VRF.Mock (MockVRF)
4342
import qualified Cardano.Crypto.VRF.Praos as Praos
44-
import Cardano.Crypto.VRF.Simple (SimpleVRF)
45-
import Cardano.Ledger.Binary.Crypto
4643
import Cardano.Ledger.Binary.Decoding.Decoder
4744
import Cardano.Ledger.Binary.Version (Version, byronProtVer)
4845
import Cardano.Slotting.Block (BlockNo (..))
@@ -66,6 +63,7 @@ import Data.ByteString.Short (ShortByteString(SBS))
6663
import Data.ByteString.Short.Internal (ShortByteString(SBS))
6764
#endif
6865
import Cardano.Base.IP (IPv4, IPv6)
66+
import Cardano.Ledger.Binary.Crypto (decFixed, decodeSignedDSIGN)
6967
import Control.Monad (when)
7068
import Data.Fixed (Fixed (..))
7169
import Data.Int (Int16, Int32, Int64, Int8)
@@ -470,15 +468,15 @@ instance DecCBOR UTCTime where
470468
--------------------------------------------------------------------------------
471469

472470
instance DSIGNAlgorithm v => DecCBOR (VerKeyDSIGN v) where
473-
decCBOR = decodeVerKeyDSIGN
471+
decCBOR = decFixed
474472
{-# INLINE decCBOR #-}
475473

476474
instance DSIGNAlgorithm v => DecCBOR (SignKeyDSIGN v) where
477-
decCBOR = decodeSignKeyDSIGN
475+
decCBOR = decFixed
478476
{-# INLINE decCBOR #-}
479477

480478
instance DSIGNAlgorithm v => DecCBOR (SigDSIGN v) where
481-
decCBOR = decodeSigDSIGN
479+
decCBOR = decFixed
482480
{-# INLINE decCBOR #-}
483481

484482
instance (DSIGNAlgorithm v, Typeable a) => DecCBOR (SignedDSIGN v a) where
@@ -502,39 +500,39 @@ instance (HashAlgorithm h, Typeable a) => DecCBOR (Hash h a) where
502500
--------------------------------------------------------------------------------
503501

504502
instance KESAlgorithm k => DecCBOR (VerKeyKES k) where
505-
decCBOR = decodeVerKeyKES
503+
decCBOR = decFixed
506504
{-# INLINE decCBOR #-}
507505

508506
instance KESAlgorithm k => DecCBOR (SigKES k) where
509-
decCBOR = decodeSigKES
507+
decCBOR = decFixed
510508
{-# INLINE decCBOR #-}
511509

512510
--------------------------------------------------------------------------------
513511
-- VRF
514512
--------------------------------------------------------------------------------
515513

516-
instance DecCBOR (VerKeyVRF SimpleVRF) where
517-
decCBOR = decodeVerKeyVRF
514+
instance VRFAlgorithm v => DecCBOR (SignKeyVRF v) where
515+
decCBOR = decFixed
518516
{-# INLINE decCBOR #-}
519517

520-
instance DecCBOR (SignKeyVRF SimpleVRF) where
521-
decCBOR = decodeSignKeyVRF
518+
instance VRFAlgorithm v => DecCBOR (VerKeyVRF v) where
519+
decCBOR = decFixed
522520
{-# INLINE decCBOR #-}
523521

524-
instance DecCBOR (CertVRF SimpleVRF) where
525-
decCBOR = decodeCertVRF
526-
{-# INLINE decCBOR #-}
527-
528-
instance DecCBOR (VerKeyVRF MockVRF) where
529-
decCBOR = decodeVerKeyVRF
522+
instance Typeable v => DecCBOR (OutputVRF v) where
523+
decCBOR = OutputVRF <$> decCBOR
530524
{-# INLINE decCBOR #-}
531525

532-
instance DecCBOR (SignKeyVRF MockVRF) where
533-
decCBOR = decodeSignKeyVRF
526+
instance VRFAlgorithm v => DecCBOR (CertVRF v) where
527+
decCBOR = decFixed
534528
{-# INLINE decCBOR #-}
535529

536-
instance DecCBOR (CertVRF MockVRF) where
537-
decCBOR = decodeCertVRF
530+
instance (VRFAlgorithm v, Typeable a) => DecCBOR (CertifiedVRF v a) where
531+
decCBOR =
532+
CertifiedVRF
533+
<$ enforceSize "CertifiedVRF" 2
534+
<*> decCBOR
535+
<*> decCBOR
538536
{-# INLINE decCBOR #-}
539537

540538
instance DecCBOR Praos.Proof where
@@ -549,30 +547,6 @@ instance DecCBOR Praos.VerKey where
549547
decCBOR = decCBOR >>= Praos.vkFromBytes
550548
{-# INLINE decCBOR #-}
551549

552-
instance DecCBOR (VerKeyVRF Praos.PraosVRF) where
553-
decCBOR = decodeVerKeyVRF
554-
{-# INLINE decCBOR #-}
555-
556-
instance DecCBOR (SignKeyVRF Praos.PraosVRF) where
557-
decCBOR = decodeSignKeyVRF
558-
{-# INLINE decCBOR #-}
559-
560-
instance DecCBOR (CertVRF Praos.PraosVRF) where
561-
decCBOR = decodeCertVRF
562-
{-# INLINE decCBOR #-}
563-
564-
instance Typeable v => DecCBOR (OutputVRF v) where
565-
decCBOR = OutputVRF <$> decCBOR
566-
{-# INLINE decCBOR #-}
567-
568-
instance (VRFAlgorithm v, Typeable a) => DecCBOR (CertifiedVRF v a) where
569-
decCBOR =
570-
CertifiedVRF
571-
<$ enforceSize "CertifiedVRF" 2
572-
<*> decCBOR
573-
<*> decodeCertVRF
574-
{-# INLINE decCBOR #-}
575-
576550
--------------------------------------------------------------------------------
577551
-- Slotting
578552
--------------------------------------------------------------------------------

‎libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Encoding/EncCBOR.hs‎

Lines changed: 13 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -49,10 +49,7 @@ import Cardano.Crypto.VRF.Class (
4949
VRFAlgorithm,
5050
VerKeyVRF,
5151
)
52-
import Cardano.Crypto.VRF.Mock (MockVRF)
5352
import qualified Cardano.Crypto.VRF.Praos as Praos
54-
import Cardano.Crypto.VRF.Simple (SimpleVRF)
55-
import Cardano.Ledger.Binary.Crypto
5653
import Cardano.Ledger.Binary.Encoding.Encoder
5754
import Cardano.Ledger.Binary.Version (Version, byronProtVer)
5855
import Cardano.Slotting.Block (BlockNo (..))
@@ -80,6 +77,7 @@ import Data.ByteString.Short.Internal (ShortByteString(SBS))
8077
#endif
8178
import Cardano.Base.IP (IPv4, IPv6)
8279
import qualified Cardano.Binary as Plain (Encoding, ToCBOR (..))
80+
import Cardano.Ledger.Binary.Crypto (encFixed, encodeSignedDSIGN)
8381
import Data.Fixed (Fixed (..))
8482
import Data.Foldable (toList)
8583
import Data.Int (Int16, Int32, Int64, Int8)
@@ -358,13 +356,13 @@ instance EncCBOR UTCTime where
358356
--------------------------------------------------------------------------------
359357

360358
instance DSIGNAlgorithm v => EncCBOR (VerKeyDSIGN v) where
361-
encCBOR = encodeVerKeyDSIGN
359+
encCBOR = encFixed
362360

363361
instance DSIGNAlgorithm v => EncCBOR (SignKeyDSIGN v) where
364-
encCBOR = encodeSignKeyDSIGN
362+
encCBOR = encFixed
365363

366364
instance DSIGNAlgorithm v => EncCBOR (SigDSIGN v) where
367-
encCBOR = encodeSigDSIGN
365+
encCBOR = encFixed
368366

369367
instance DSIGNAlgorithm v => EncCBOR (SignedDSIGN v a) where
370368
encCBOR = encodeSignedDSIGN
@@ -377,36 +375,27 @@ instance HashAlgorithm h => EncCBOR (Hash h a) where
377375
encCBOR (UnsafeHash h) = encCBOR h
378376

379377
instance KESAlgorithm k => EncCBOR (VerKeyKES k) where
380-
encCBOR = encodeVerKeyKES
378+
encCBOR = encFixed
381379

382380
instance KESAlgorithm k => EncCBOR (SigKES k) where
383-
encCBOR = encodeSigKES
381+
encCBOR = encFixed
384382

385-
instance EncCBOR (VerKeyVRF SimpleVRF) where
386-
encCBOR = encodeVerKeyVRF
383+
instance VRFAlgorithm v => EncCBOR (VerKeyVRF v) where
384+
encCBOR = encFixed
387385

388-
instance EncCBOR (SignKeyVRF SimpleVRF) where
389-
encCBOR = encodeSignKeyVRF
386+
instance VRFAlgorithm v => EncCBOR (SignKeyVRF v) where
387+
encCBOR = encFixed
390388

391-
instance EncCBOR (CertVRF SimpleVRF) where
392-
encCBOR = encodeCertVRF
393-
394-
instance EncCBOR (VerKeyVRF MockVRF) where
395-
encCBOR = encodeVerKeyVRF
396-
397-
instance EncCBOR (SignKeyVRF MockVRF) where
398-
encCBOR = encodeSignKeyVRF
399-
400-
instance EncCBOR (CertVRF MockVRF) where
401-
encCBOR = encodeCertVRF
389+
instance VRFAlgorithm v => EncCBOR (CertVRF v) where
390+
encCBOR = encFixed
402391

403392
deriving instance EncCBOR (OutputVRF v)
404393

405394
instance VRFAlgorithm v => EncCBOR (CertifiedVRF v a) where
406395
encCBOR cvrf =
407396
encodeListLen 2
408397
<> encCBOR (certifiedOutput cvrf)
409-
<> encodeCertVRF (certifiedProof cvrf)
398+
<> encCBOR (certifiedProof cvrf)
410399

411400
instance EncCBOR Praos.Proof where
412401
encCBOR = encCBOR . Praos.proofBytes
@@ -417,12 +406,6 @@ instance EncCBOR Praos.SignKey where
417406
instance EncCBOR Praos.VerKey where
418407
encCBOR = encCBOR . Praos.vkBytes
419408

420-
deriving instance EncCBOR (VerKeyVRF Praos.PraosVRF)
421-
422-
deriving instance EncCBOR (SignKeyVRF Praos.PraosVRF)
423-
424-
deriving instance EncCBOR (CertVRF Praos.PraosVRF)
425-
426409
--------------------------------------------------------------------------------
427410
-- Slotting
428411
--------------------------------------------------------------------------------

0 commit comments

Comments
 (0)