Merge pull request #2074 from input-output-hk/jc/asset-name-32-bytes

restrict asset names to 32 bytes

shelley-ma/impl/cardano-ledger-shelley-ma.cabal

@@ -49,6 +49,7 @@ library
     nothunks,
     shelley-spec-ledger,
     small-steps,
+    text,
     transformers
   hs-source-dirs: src
   ghc-options:

shelley-ma/impl/src/Cardano/Ledger/Mary/Value.hs

@@ -25,6 +25,7 @@ where
 
 import Cardano.Binary
   ( Decoder,
+    DecoderError (..),
     Encoding,
     FromCBOR,
     ToCBOR,
@@ -45,11 +46,12 @@ import Cardano.Ledger.Val
     EncodeMint (..),
     Val (..),
   )
+import Cardano.Prelude (cborError)
 import Control.DeepSeq (NFData (..))
 import Control.Monad (guard)
 import Data.Array (Array)
 import Data.Array.IArray (array)
-import Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
 import Data.CanonicalMaps
   ( canonicalMap,
     canonicalMapUnion,
@@ -75,6 +77,7 @@ import qualified Data.Map.Strict as Map
 import Data.Maybe (fromMaybe)
 import Data.Set (Set)
 import qualified Data.Set as Set
+import Data.Text.Encoding (decodeUtf8)
 import Data.Typeable (Typeable)
 import Data.Word (Word64)
 import GHC.Generics (Generic)
@@ -85,17 +88,23 @@ import Shelley.Spec.Ledger.Serialization (decodeMap, encodeMap)
 import Prelude hiding (lookup)
 
 -- | Asset Name
-newtype AssetName = AssetName {assetName :: ByteString}
+newtype AssetName = AssetName {assetName :: BS.ByteString}
   deriving newtype
     ( Show,
       Eq,
       ToCBOR,
-      FromCBOR,
       Ord,
       NoThunks,
       NFData
     )
 
+instance FromCBOR AssetName where
+  fromCBOR = do
+    an <- fromCBOR
+    if BS.length an > 32
+      then cborError $ DecoderErrorCustom "asset name exceeds 32 bytes:" (decodeUtf8 an)
+      else pure . AssetName $ an
+
 -- | Policy ID
 newtype PolicyID crypto = PolicyID {policyID :: ScriptHash crypto}
   deriving (Show, Eq, ToCBOR, FromCBOR, Ord, NoThunks, NFData)

shelley-ma/shelley-ma-test/src/Test/Cardano/Ledger/ShelleyMA/Serialisation/Generators.hs

@@ -44,6 +44,7 @@ import qualified Cardano.Ledger.ShelleyMA.Rules.Utxo as MA.STS
 import Cardano.Ledger.ShelleyMA.Timelocks (Timelock (..), ValidityInterval (..))
 import qualified Cardano.Ledger.ShelleyMA.Timelocks as MA (Timelock (..))
 import qualified Cardano.Ledger.ShelleyMA.TxBody as MA (TxBody (..))
+import qualified Data.ByteString as BS
 import Data.Coerce (coerce)
 import Data.Int (Int64)
 import qualified Data.Map.Strict as Map
@@ -204,7 +205,7 @@ valueFromListBounded (fromIntegral -> ada) =
         (min (fromIntegral $ maxBound @i) (a + b))
 
 instance Arbitrary Mary.AssetName where
-  arbitrary = Mary.AssetName <$> arbitrary
+  arbitrary = Mary.AssetName . BS.pack . take 32 . BS.unpack <$> arbitrary
 
 instance Mock c => Arbitrary (MA.STS.UtxoPredicateFailure (MaryEra c)) where
   arbitrary = genericArbitraryU

shelley-ma/shelley-ma-test/src/Test/Cardano/Ledger/TranslationTools.hs

@@ -9,6 +9,7 @@ module Test.Cardano.Ledger.TranslationTools
   , translationCompatToCBOR
   , decodeTest
   , decodeTestAnn
+  , expectDecodeFailure
   ) where
 
 
@@ -77,3 +78,9 @@ decodeTestAnn :: forall a b proxy. (ToCBOR a, FromCBOR (Annotator b))
 decodeTestAnn _ x = case decodeAnnotator mempty fromCBOR (serialize x) :: Either DecoderError b of
   Left e -> assertFailure $ show e
   Right _ -> return ()
+
+-- Tests that a decoder error happens
+expectDecodeFailure :: forall a. (ToCBOR a, FromCBOR a) => a -> Assertion
+expectDecodeFailure x = case decodeFull (serialize x) :: Either DecoderError a of
+  Left _ -> pure ()
+  Right _ -> assertFailure "should not deserialize"

shelley-ma/shelley-ma-test/test/Test/Cardano/Ledger/ShelleyMA/Serialisation/Golden/Encoding.hs

@@ -51,6 +51,7 @@ import Shelley.Spec.Ledger.TxBody
     Wdrl (..),
   )
 import Test.Cardano.Ledger.EraBuffet (AllegraEra, MaryEra, TestCrypto)
+import Test.Cardano.Ledger.TranslationTools (expectDecodeFailure)
 import Test.Shelley.Spec.Ledger.Generator.EraGen (genesisId)
 import Test.Shelley.Spec.Ledger.Serialisation.GoldenUtils
   ( ToTokens (..),
@@ -59,6 +60,7 @@ import Test.Shelley.Spec.Ledger.Serialisation.GoldenUtils
   )
 import Test.Shelley.Spec.Ledger.Utils (mkGenKey, mkKeyPair)
 import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit (Assertion, testCase)
 
 type A = AllegraEra TestCrypto
 
@@ -432,11 +434,15 @@ goldenEncodingTestsMary =
             )
     ]
 
+assetName32Bytes :: Assertion
+assetName32Bytes = expectDecodeFailure . AssetName . BS.pack $ "123456789-123456789-123456789-123"
+
 -- | Golden Tests for Allegra and Mary
 goldenEncodingTests :: TestTree
 goldenEncodingTests =
   testGroup
     "Golden Encoding Tests"
     [ goldenEncodingTestsAllegra,
-      goldenEncodingTestsMary
+      goldenEncodingTestsMary,
+      testCase "33 bytes asset name too big" assetName32Bytes
     ]