Upgrade to cuddle 1.1.0

scls-cardano/cddl-src/Cardano/SCLS/Namespace/Snapshots.hs

@@ -115,7 +115,7 @@ relay =
     / sarr [1, a single_host_name]
     / sarr [2, a multi_host_name]
 
-single_host_addr :: Named Group
+single_host_addr :: GroupDef
 single_host_addr =
   comment [str| A single host address relay |] $
     "single_host_addr"
@@ -125,12 +125,12 @@ single_host_addr =
         , a (ipv6 / VNil)
         ]
 
-single_host_name :: Named Group
+single_host_name :: GroupDef
 single_host_name =
   "single_host_name"
     =:~ grp [a (port / VNil), a dns_name]
 
-multi_host_name :: Named Group
+multi_host_name :: GroupDef
 multi_host_name =
   "multi_host_name" =:~ grp [a dns_name]
 

scls-cardano/cddl-src/Cardano/SCLS/Namespace/UTxO.hs

@@ -120,22 +120,22 @@ native_script =
     -- This field specifies the left (included) endpoint a.
     / arr [a invalid_hereafter]
 
-script_pubkey :: Named Group
+script_pubkey :: GroupDef
 script_pubkey = "script_pubkey" =:~ grp [0, a hash28]
 
-script_all :: Named Group
+script_all :: GroupDef
 script_all = "script_all" =:~ grp [1, a (arr [0 <+ a native_script])]
 
-script_any :: Named Group
+script_any :: GroupDef
 script_any = "script_any" =:~ grp [2, a (arr [0 <+ a native_script])]
 
-script_n_of_k :: Named Group
+script_n_of_k :: GroupDef
 script_n_of_k =
   "script_n_of_k"
     =:~ grp [3, "n" ==> int64, a (arr [0 <+ a native_script])]
 
-invalid_before :: Named Group
+invalid_before :: GroupDef
 invalid_before = "invalid_before" =:~ grp [4, a slot_no]
 
-invalid_hereafter :: Named Group
+invalid_hereafter :: GroupDef
 invalid_hereafter = "invalid_hereafter" =:~ grp [5, a slot_no]

scls-cardano/cddl-validate/Cardano/SCLS/CDDL/Validate.hs

@@ -3,56 +3,41 @@
 
 -- | Various helper functions for CBOR validation against supported CDDL specifications.
 module Cardano.SCLS.CDDL.Validate (
-  validateTermAgainst,
   validateBytesAgainst,
   invalidSpecs,
 ) where
 
 import Cardano.SCLS.CDDL
-import Codec.CBOR.Cuddle.CBOR.Validator (CBORTermResult (..), validateTerm)
+import Codec.CBOR.Cuddle.CBOR.Validator (CBORTermResult (..), validateCBOR)
 import Codec.CBOR.Cuddle.CDDL (Name (..))
-import Codec.CBOR.Cuddle.CDDL.CTree (CTreeRoot' (..))
+import Codec.CBOR.Cuddle.CDDL.CTree (CTreeRoot (..))
 import Codec.CBOR.Cuddle.CDDL.Resolve (
-  MonoRef,
+  MonoReferenced,
   NameResolutionFailure,
   asMap,
   buildMonoCTree,
   buildRefCTree,
   buildResolvedCTree,
  )
 import Codec.CBOR.Cuddle.Huddle (toCDDL)
-import Codec.CBOR.Read qualified as CBOR
-import Codec.CBOR.Term (Term, decodeTerm)
-import Control.Monad.Trans.Reader (runReader)
+import Codec.CBOR.Cuddle.IndexMappable (IndexMappable (mapIndex), mapCDDLDropExt)
 import Data.ByteString (ByteString)
-import Data.ByteString.Lazy qualified as BSL
-import Data.Functor ((<&>))
-import Data.Functor.Identity (Identity (..))
 import Data.Map.Strict qualified as Map
 import Data.Text (Text)
 
 -- | Pre-compiled CDDL specifications for all supported namespaces.
 invalidSpecs :: Map.Map Text NameResolutionFailure
-validSpecs :: Map.Map Text (CTreeRoot' Identity Codec.CBOR.Cuddle.CDDL.Resolve.MonoRef)
+validSpecs :: Map.Map Text (CTreeRoot Codec.CBOR.Cuddle.CDDL.Resolve.MonoReferenced)
 (invalidSpecs, validSpecs) = Map.mapEither
   do
     \NamespaceInfo{..} -> do
-      case buildMonoCTree =<< buildResolvedCTree (buildRefCTree $ asMap $ toCDDL namespaceSpec) of
+      case buildMonoCTree =<< buildResolvedCTree (buildRefCTree $ asMap $ mapCDDLDropExt $ toCDDL namespaceSpec) of
         Left e -> Left e
         Right tree -> Right tree
   do namespaces
 
--- | Validate a parsed CBOR term against a rule in the namespace.
-validateTermAgainst :: Term -> Text -> Text -> Maybe CBORTermResult
-validateTermAgainst term namespace name =
-  let cddlName = Name name mempty
-   in Map.lookup namespace validSpecs >>= \cddl@(CTreeRoot cddlTree) ->
-        Map.lookup cddlName cddlTree <&> \rule ->
-          runReader (validateTerm term (runIdentity rule)) cddl
-
 -- | Validate raw bytes against a rule in the namespace.
 validateBytesAgainst :: ByteString -> Text -> Text -> Maybe CBORTermResult
-validateBytesAgainst bytes namespace name =
-  case CBOR.deserialiseFromBytes decodeTerm (BSL.fromStrict bytes) of
-    Left _ -> Nothing
-    Right (_, term) -> validateTermAgainst term namespace name
+validateBytesAgainst bytes namespace name = do
+  cddl <- Map.lookup namespace validSpecs
+  pure $ validateCBOR bytes (Name name) (mapIndex cddl)

scls-cardano/gen-cddl/Main.hs

@@ -5,8 +5,10 @@ module Main where
 
 import Cardano.SCLS.CDDL (NamespaceInfo (..), namespaces)
 
+import Codec.CBOR.Cuddle.CDDL (CDDL)
 import Codec.CBOR.Cuddle.Huddle qualified as Cuddle
-import Codec.CBOR.Cuddle.Pretty ()
+import Codec.CBOR.Cuddle.IndexMappable (IndexMappable (mapIndex))
+import Codec.CBOR.Cuddle.Pretty (PrettyStage)
 import Control.Monad (forM_)
 import Data.Map.Strict qualified as Map
 import Data.Text qualified as T
@@ -28,7 +30,7 @@ main =
 
 writeSpec :: Cuddle.Huddle -> FilePath -> IO ()
 writeSpec hddl path =
-  let cddl = Cuddle.toCDDLNoRoot hddl
+  let cddl :: CDDL PrettyStage = mapIndex $ Cuddle.toCDDLNoRoot hddl
       preface = "; This file was auto-generated from huddle. Please do not modify it directly!\n"
    in withFile path WriteMode $ \h -> do
         hPutStrLn h preface

scls-cardano/scls-cardano.cabal

@@ -41,7 +41,7 @@ library
   build-depends:
     base >=4.18 && <5,
     containers >=0.6,
-    cuddle >=0.3 && <1.1.0,
+    cuddle >=1.1,
     heredoc >=0.2,
     scls-core,
     text
@@ -60,12 +60,10 @@ library validate
   build-depends:
     base >=4.18 && <5,
     bytestring,
-    cborg,
     containers,
-    cuddle >=0.3 && <1.1.0,
+    cuddle >=1.1,
     scls-cardano,
-    text,
-    transformers
+    text
 
   hs-source-dirs:
     cddl-validate
@@ -103,7 +101,7 @@ executable gen-cddl
   build-depends:
     base >=4.18 && <5,
     containers >=0.6,
-    cuddle >=0.3 && <1.1.0,
+    cuddle >=1.1,
     directory >=1,
     filepath >=1.4,
     prettyprinter,

scls-format/scls-format.cabal

@@ -111,7 +111,7 @@ test-suite scls-format-test
     bytestring,
     cborg >=0.2,
     containers,
-    cuddle >=0.3 && <1.1.0,
+    cuddle >=1.1,
     filepath,
     hspec,
     hspec-expectations,

scls-format/test/Roundtrip.hs

@@ -30,6 +30,7 @@ import Codec.CBOR.Cuddle.CDDL.Resolve (
   buildResolvedCTree,
  )
 import Codec.CBOR.Cuddle.Huddle (toCDDL)
+import Codec.CBOR.Cuddle.IndexMappable (mapCDDLDropExt)
 import Codec.CBOR.Read
 import Codec.CBOR.Term
 import Codec.CBOR.Write
@@ -60,7 +61,7 @@ mkRoundtripTestsFor :: String -> SerializeF -> Spec
 mkRoundtripTestsFor groupName serialize =
   describe groupName $ do
     sequence_
-      [ context (Namespace.asString n) $ it "should succeed with stream roundtrip" $ roundtrip n (namespaceKeySize ns, toCDDL (namespaceSpec ns))
+      [ context (Namespace.asString n) $ it "should succeed with stream roundtrip" $ roundtrip n (namespaceKeySize ns, mapCDDLDropExt $ toCDDL (namespaceSpec ns))
       | (Namespace.fromText -> n, ns) <- Map.toList namespaces
       ]
     it "should write/read manifest comment" $ do
@@ -109,7 +110,7 @@ mkRoundtripTestsFor groupName serialize =
             withKnownNat snat do
               fmap nubByKey $ replicateM 1024 $ do
                 key <- uniformByteStringM (fromIntegral kSize) globalStdGen
-                term <- applyAtomicGen (generateCBORTerm' mt (Name (T.pack "record_entry") mempty)) globalStdGen
+                term <- applyAtomicGen (generateCBORTerm' mt (Name (T.pack "record_entry"))) globalStdGen
                 Right (_, canonicalTerm) <- pure $ deserialiseFromBytes decodeTerm $ toLazyByteString (encodeTerm term)
                 pure $! SomeCBOREntry (GenericCBOREntry $ ChunkEntry (ByteStringSized @n key) (CBORTerm canonicalTerm))
         mEntries <-