WIP: Implement validator for CBOR

bin/Main.hs

@@ -3,6 +3,7 @@
 module Main (main) where
 
 import Codec.CBOR.Cuddle.CBOR.Gen (generateCBORTerm)
+import Codec.CBOR.Cuddle.CBOR.Validator
 import Codec.CBOR.Cuddle.CDDL (Name (..), sortCDDL)
 import Codec.CBOR.Cuddle.CDDL.Prelude (prependPrelude)
 import Codec.CBOR.Cuddle.CDDL.Resolve (
@@ -28,12 +29,21 @@ import Text.Megaparsec (ParseErrorBundle, Parsec, errorBundlePretty, runParser)
 
 data Opts = Opts Command String
 
-newtype ValidateOpts = ValidateOpts {vNoPrelude :: Bool}
-
 data Command
   = Format FormatOpts
   | Validate ValidateOpts
   | GenerateCBOR GenOpts
+  | ValidateCBOR ValidateCBOROpts
+
+newtype ValidateOpts = ValidateOpts {vNoPrelude :: Bool}
+
+pValidateOpts :: Parser ValidateOpts
+pValidateOpts =
+  ValidateOpts
+    <$> switch
+      ( long "no-prelude"
+          <> help "Do not include the CDDL prelude."
+      )
 
 -- | Various formats for outputtting CBOR
 data CBOROutputFormat
@@ -53,6 +63,7 @@ pCBOROutputFormat = eitherReader $ \case
 data GenOpts = GenOpts
   { itemName :: T.Text
   , outputFormat :: CBOROutputFormat
+  , outputTo :: Maybe String
   , gNoPrelude :: Bool
   }
 
@@ -72,6 +83,13 @@ pGenOpts =
           <> help "Output format"
           <> value AsCBOR
       )
+    <*> optional
+      ( strOption
+          ( long "out-file"
+              <> short 'o'
+              <> help "Write to"
+          )
+      )
     <*> switch
       ( long "no-prelude"
           <> help "Do not include the CDDL prelude."
@@ -88,10 +106,27 @@ pFormatOpts =
           <> help "Sort the CDDL rule definitions before printing."
       )
 
-pValidateOpts :: Parser ValidateOpts
-pValidateOpts =
-  ValidateOpts
-    <$> switch
+data ValidateCBOROpts = ValidateCBOROpts
+  { vcItemName :: T.Text
+  , vcInput :: FilePath
+  , vcNoPrelude :: Bool
+  }
+
+pValidateCBOROpts :: Parser ValidateCBOROpts
+pValidateCBOROpts =
+  ValidateCBOROpts
+    <$> strOption
+      ( long "rule"
+          <> short 'r'
+          <> metavar "RULE"
+          <> help "Name of the CDDL rule to validate this file with"
+      )
+    <*> strOption
+      ( long "cbor"
+          <> short 'c'
+          <> help "CBOR file"
+      )
+    <*> switch
       ( long "no-prelude"
           <> help "Do not include the CDDL prelude."
       )
@@ -118,6 +153,12 @@ opts =
                 (GenerateCBOR <$> pGenOpts <**> helper)
                 (progDesc "Generate a CBOR term matching the schema")
             )
+          <> command
+            "validate-cbor"
+            ( info
+                (ValidateCBOR <$> pValidateCBOROpts <**> helper)
+                (progDesc "Validate a CBOR file against a schema")
+            )
       )
     <*> argument str (metavar "CDDL_FILE")
 
@@ -171,8 +212,21 @@ run (Opts cmd cddlFile) = do
                  in case outputFormat gOpts of
                       AsTerm -> print term
                       AsFlatTerm -> print $ toFlatTerm (encodeTerm term)
-                      AsCBOR -> BSC.putStrLn . Base16.encode . toStrictByteString $ encodeTerm term
+                      AsCBOR -> case outputTo gOpts of
+                        Nothing -> BSC.putStrLn . Base16.encode . toStrictByteString $ encodeTerm term
+                        Just out -> BSC.writeFile out $ toStrictByteString $ encodeTerm term
                       AsPrettyCBOR -> putStrLn . prettyHexEnc $ encodeTerm term
+        ValidateCBOR vcOpts ->
+          let
+            res'
+              | vcNoPrelude vcOpts = res
+              | otherwise = prependPrelude res
+           in
+            case fullResolveCDDL res' of
+              Left err -> putStrLnErr (show err) >> exitFailure
+              Right mt -> do
+                cbor <- BSC.readFile (vcInput vcOpts)
+                validateCBOR cbor (Name $ vcItemName vcOpts) mt
 
 putStrLnErr :: String -> IO ()
 putStrLnErr = hPutStrLn stderr

cuddle.cabal

@@ -44,6 +44,7 @@ library
   import:           warnings, ghc2021
   exposed-modules:
     Codec.CBOR.Cuddle.CBOR.Gen
+    Codec.CBOR.Cuddle.CBOR.Validator
     Codec.CBOR.Cuddle.CDDL
     Codec.CBOR.Cuddle.CDDL.CtlOp
     Codec.CBOR.Cuddle.CDDL.CTree
@@ -70,6 +71,9 @@ library
     , data-default-class
     , foldable1-classes-compat
     , generic-optics
+    , regex-tdfa
+    , lens
+    , semigroupoids
     , hashable
     , megaparsec
     , mtl
@@ -81,6 +85,7 @@ library
     , random              <1.3
     , scientific
     , text
+    , validation
     , tree-diff
 
   hs-source-dirs:   src
@@ -119,6 +124,7 @@ executable cuddle
     , optparse-applicative
     , prettyprinter
     , random
+    , mtl
     , text
 
 test-suite cuddle-test
@@ -128,6 +134,7 @@ test-suite cuddle-test
     Test.Codec.CBOR.Cuddle.CDDL.Examples
     Test.Codec.CBOR.Cuddle.CDDL.Gen
     Test.Codec.CBOR.Cuddle.CDDL.Parser
+    Test.Codec.CBOR.Cuddle.CDDL.Validator
     Test.Codec.CBOR.Cuddle.Huddle
 
   -- other-extensions:
@@ -143,4 +150,9 @@ test-suite cuddle-test
     , prettyprinter
     , QuickCheck
     , text
+    , temporary
     , tree-diff
+    , bytestring
+    , process
+    , filepath
+    , directory

load-test.sh

@@ -0,0 +1,4 @@
+gen () { cabal run cuddle -- gen -r $1 -o example.cbor $2 }
+pprint () { cbor2pretty.rb example.cbor }
+validate () { cabal run cuddle -- validate-cbor -r $1 -c example.cbor $2 }
+cuddle-test () { gen $1 $2; pprint; validate $1 $2 }