[#462] Enforce canonical encodings for types that are addressHashed

crypto/src/Cardano/Crypto/HD.hs

@@ -42,7 +42,8 @@ import Data.ByteArray as BA (convert)
 import Data.ByteString.Base64.Type (getByteString64, makeByteString64)
 import Data.ByteString.Char8 as B
 
-import Cardano.Binary (FromCBOR(..), ToCBOR(..), decodeFull', serialize')
+import Cardano.Binary
+  (FromCBOR(..), ToCBOR(..), decodeBytesCanonical, decodeFull', serialize')
 import Cardano.Crypto.Signing (PublicKey(..))
 import Cardano.Crypto.Signing.Safe
   (EncryptedSecretKey(..), PassPhrase, checkPassMatches)
@@ -64,9 +65,12 @@ data HDPassphrase =
 newtype HDAddressPayload = HDAddressPayload
   { getHDAddressPayload :: ByteString
   } deriving (Eq, Ord, Show, Generic)
-    deriving newtype (FromCBOR, ToCBOR, HeapWords)
+    deriving newtype (ToCBOR, HeapWords)
     deriving anyclass NFData
 
+instance FromCBOR HDAddressPayload where
+  fromCBOR = HDAddressPayload <$> decodeBytesCanonical
+
 instance FromJSON HDAddressPayload where
   parseJSON v = HDAddressPayload . getByteString64 <$> parseJSON v
 

crypto/src/Cardano/Crypto/Signing/PublicKey.hs

@@ -31,7 +31,8 @@ import Formatting.Buildable (Buildable(..))
 import Text.JSON.Canonical (JSValue(..))
 import qualified Text.JSON.Canonical as TJC (FromJSON(..), ToJSON(..))
 
-import Cardano.Binary (Decoder, Encoding, FromCBOR(..), ToCBOR(..))
+import Cardano.Binary
+  (Decoder, Encoding, FromCBOR(..), ToCBOR(..), decodeBytesCanonical)
 
 
 -- | Wrapper around 'CC.XPub'.
@@ -61,8 +62,10 @@ instance FromCBOR PublicKey where
 toCBORXPub :: CC.XPub -> Encoding
 toCBORXPub a = toCBOR $ CC.unXPub a
 
+-- | We enforce canonical CBOR encodings for `PublicKey`s, because we serialize
+--   them before hashing to get `HashKey`s.
 fromCBORXPub :: Decoder s CC.XPub
-fromCBORXPub = toCborError . CC.xpub =<< fromCBOR
+fromCBORXPub = toCborError . CC.xpub =<< decodeBytesCanonical
 
 instance Buildable PublicKey where
   build = bprint ("pub:" . shortPublicKeyHexF)

src/Cardano/Chain/Common/AddrAttributes.hs

@@ -19,6 +19,8 @@ import Cardano.Binary
   , FromCBOR(..)
   , ToCBOR(..)
   , decodeFull
+  , decodeFullDecoder
+  , decodeWord32Canonical
   , serialize
   )
 import Cardano.Chain.Common.Attributes
@@ -93,8 +95,11 @@ instance ToCBOR (Attributes AddrAttributes) where
 instance FromCBOR (Attributes AddrAttributes) where
   fromCBOR = fromCBORAttributes initValue go
    where
-    initValue = AddrAttributes { aaPkDerivationPath = Nothing
-                               , aaNetworkMagic = NetworkMainOrStage }
+    initValue = AddrAttributes
+      { aaPkDerivationPath = Nothing
+      , aaNetworkMagic     = NetworkMainOrStage
+      }
+
     go
       :: Word8
       -> LByteString
@@ -103,6 +108,8 @@ instance FromCBOR (Attributes AddrAttributes) where
     go n v acc = case n of
       1 -> (\deriv -> Just $ acc { aaPkDerivationPath = Just deriv })
         <$> toCborError (decodeFull v)
-      2 -> (\deriv -> Just $ acc {aaNetworkMagic = NetworkTestnet deriv })
-        <$> toCborError (decodeFull v)
+      2 ->
+        (\deriv -> Just $ acc { aaNetworkMagic = NetworkTestnet deriv })
+          <$> toCborError
+                (decodeFullDecoder "NetworkMagic" decodeWord32Canonical v)
       _ -> pure Nothing

src/Cardano/Chain/Common/AddrSpendingData.hs

@@ -22,8 +22,10 @@ import Cardano.Binary
   , DecoderError(..)
   , FromCBOR(..)
   , ToCBOR(..)
+  , decodeListLenCanonical
+  , decodeWord8Canonical
   , encodeListLen
-  , enforceSize
+  , matchSize
   , szCases
   )
 import Cardano.Crypto.Signing (PublicKey, RedeemPublicKey)
@@ -60,8 +62,9 @@ instance ToCBOR AddrSpendingData where
 
 instance FromCBOR AddrSpendingData where
   fromCBOR = do
-    enforceSize "AddrSpendingData" 2
-    fromCBOR @Word8 >>= \case
+    len <- decodeListLenCanonical
+    matchSize "AddrSpendingData" 2 len
+    decodeWord8Canonical >>= \case
       0   -> PubKeyASD <$> fromCBOR
       2   -> RedeemASD <$> fromCBOR
       tag -> cborError $ DecoderErrorUnknownTag "AddrSpendingData" tag
@@ -84,7 +87,7 @@ instance ToCBOR AddrType where
   encodedSizeExpr size _ = encodedSizeExpr size (Proxy @Word8)
 
 instance FromCBOR AddrType where
-  fromCBOR = fromCBOR @Word8 >>= \case
+  fromCBOR = decodeWord8Canonical >>= \case
     0   -> pure ATPubKey
     2   -> pure ATRedeem
     tag -> cborError $ DecoderErrorUnknownTag "AddrType" tag

src/Cardano/Chain/Common/Address.hs

@@ -84,8 +84,10 @@ import Cardano.Binary
   , biSize
   , decodeCrcProtected
   , decodeFull'
+  , decodeListLenCanonical
   , encodeCrcProtected
   , encodedCrcProtectedSizeExpr
+  , matchSize
   , serialize'
   )
 import Cardano.Chain.Common.AddrAttributes (AddrAttributes(..))
@@ -123,7 +125,16 @@ import Cardano.Crypto.Signing
 newtype Address' = Address'
   { unAddress' :: (AddrType, AddrSpendingData, Attributes AddrAttributes)
   } deriving (Eq, Show, Generic)
-    deriving newtype (FromCBOR, ToCBOR)
+    deriving newtype ToCBOR
+
+-- We need to use canonical encodings for @Address'@ so that all implementations
+-- agree on the `AddressHash`. The components of the @Address'@ also have
+-- canonical encodings enforced.
+instance FromCBOR Address' where
+  fromCBOR = do
+    len <- decodeListLenCanonical
+    matchSize "Address'" 3 len
+    fmap Address' $ (,,) <$> fromCBOR <*> fromCBOR <*> fromCBOR
 
 -- | 'Address' is where you can send Lovelace
 data Address = Address