{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Binary.Cddl (
  cddlDecoderEquivalenceSpec,
  cddlRoundTripCborSpec,
  cddlRoundTripExpectation,
  cddlRoundTripAnnCborSpec,
  cddlRoundTripAnnExpectation,

  -- * Helper functions and types
  Cddl (..),
  Cbor (..),
  DiagCbor (..),
  CddlData (..),
  CddlVarFile (..),
  beforeAllCddlFile,
  withCddlVarFile,
  genCddlDiagCbor,
  diagCborToCbor,
  validateCddlConformance,
  readProcessNoFailure,
  usingTempFile,
) where

import Cardano.Ledger.Binary
import Control.Monad (forM_)
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Lazy.Char8 as BSL8
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Typeable
import System.IO (hClose)
import System.Process.Typed (
  ExitCode (..),
  ProcessConfig,
  byteStringInput,
  proc,
  readProcess,
  setStdin,
 )
import Test.Cardano.Ledger.Binary (decoderEquivalenceExpectation)
import Test.Cardano.Ledger.Binary.RoundTrip
import Test.Hspec
import UnliftIO.Temporary (withTempFile)

-- | Contents of CDDL Spec
newtype Cddl = Cddl {Cddl -> ByteString
unCddl :: BSL.ByteString}

-- | Binary form of CBOR data.
newtype Cbor = Cbor {Cbor -> ByteString
unCbor :: BSL.ByteString}

-- | Human readable CBOR, which was randomly generated.
newtype DiagCbor = DiagCbor {DiagCbor -> ByteString
unDiagCbor :: BSL.ByteString}

data CddlVarFile = CddlVarFile
  { CddlVarFile -> FilePath
cddlVarFilePath :: !FilePath
  -- ^ File that contains the Cddl data included in this type
  , CddlVarFile -> Text
cddlVarName :: !T.Text
  -- ^ Name of the variable being tested
  , CddlVarFile -> Cddl
cddlVarData :: !Cddl
  -- ^ Full CDDL spec with @output=`cddlVarName`@ prefix
  , CddlVarFile -> [DiagCbor]
cddlVarDiagCbor :: ![DiagCbor]
  -- ^ Generated CBOR data from the above CDDL spec
  }

data CddlData = CddlData
  { CddlData -> Cddl
cddlData :: !Cddl
  , CddlData -> Int
cddlNumExamples :: !Int
  -- ^ Number of random cases to generate
  }

-- | Given an action that produces CDDL content, we combine it all into `CddlData` and
-- make it available to every subsequent Spec. Important point about this is that the
-- supplied action will only be executed once.
beforeAllCddlFile ::
  HasCallStack =>
  -- | Number of random cases to generate
  Int ->
  -- | Action that produces a list of valid CDDL specs
  IO [BSL.ByteString] ->
  SpecWith CddlData ->
  Spec
beforeAllCddlFile :: HasCallStack => Int -> IO [ByteString] -> SpecWith CddlData -> Spec
beforeAllCddlFile Int
numExamples IO [ByteString]
getCddlFiles = IO CddlData -> SpecWith CddlData -> Spec
forall a. HasCallStack => IO a -> SpecWith a -> Spec
beforeAll (IO CddlData -> SpecWith CddlData -> Spec)
-> IO CddlData -> SpecWith CddlData -> Spec
forall a b. (a -> b) -> a -> b
$ do
  [ByteString]
cddls <- IO [ByteString]
getCddlFiles
  -- combine all files into one large strict bytestring, while converting it back to the
  -- lazy one for later usage. This is done to reduce overhead of a lazy bytestring
  let cddl :: Cddl
cddl = ByteString -> Cddl
Cddl (ByteString -> Cddl) -> ByteString -> Cddl
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat [ByteString]
cddls
  CddlData -> IO CddlData
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CddlData -> IO CddlData) -> CddlData -> IO CddlData
forall a b. (a -> b) -> a -> b
$
    CddlData
      { cddlData :: Cddl
cddlData = Cddl
cddl
      , cddlNumExamples :: Int
cddlNumExamples = Int
numExamples
      }

-- | Given a `CddlData` and a CDDL variable name present in the supplied data, generate a
-- `CddlVarFile`, that contains random data for that variable.
withCddlVarFile ::
  HasCallStack =>
  -- | Name of the variable that will be tested
  T.Text ->
  -- | CddlData that will be used for random data generation
  CddlData ->
  -- | Action that can use the random data for roundtrip and conformance testing
  (CddlVarFile -> IO b) ->
  IO b
withCddlVarFile :: forall b.
HasCallStack =>
Text -> CddlData -> (CddlVarFile -> IO b) -> IO b
withCddlVarFile Text
varName CddlData {Int
Cddl
cddlData :: CddlData -> Cddl
cddlNumExamples :: CddlData -> Int
cddlData :: Cddl
cddlNumExamples :: Int
..} CddlVarFile -> IO b
roundTripTest = do
  let suffix :: ByteString
suffix = Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
"output = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
varName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
      varData :: Cddl
varData = ByteString -> Cddl
Cddl (ByteString -> ByteString
BSL.fromStrict ByteString
suffix ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Cddl -> ByteString
unCddl Cddl
cddlData)
  [DiagCbor]
diagCbor <- HasCallStack => Int -> Cddl -> IO [DiagCbor]
Int -> Cddl -> IO [DiagCbor]
genCddlDiagCbor Int
cddlNumExamples Cddl
varData
  ByteString -> (FilePath -> IO b) -> IO b
forall a. ByteString -> (FilePath -> IO a) -> IO a
usingTempFile (Cddl -> ByteString
unCddl Cddl
varData) ((FilePath -> IO b) -> IO b) -> (FilePath -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \FilePath
filePath ->
    CddlVarFile -> IO b
roundTripTest (CddlVarFile -> IO b) -> CddlVarFile -> IO b
forall a b. (a -> b) -> a -> b
$
      CddlVarFile
        { cddlVarFilePath :: FilePath
cddlVarFilePath = FilePath
filePath
        , cddlVarName :: Text
cddlVarName = Text
varName
        , cddlVarData :: Cddl
cddlVarData = Cddl
varData
        , cddlVarDiagCbor :: [DiagCbor]
cddlVarDiagCbor = [DiagCbor]
diagCbor
        }

-- | Using the supplied `CddlData` inside the `SpecWith`, generate random data
-- and verify that decoding with `DecCBOR (Annotator)` produces the same result
-- as decoding with `DecCBOR`.
cddlDecoderEquivalenceSpec ::
  forall a.
  ( HasCallStack
  , Eq a
  , Show a
  , DecCBOR a
  , DecCBOR (Annotator a)
  ) =>
  -- | Serialization version
  Version ->
  -- | Name of the CDDL variable to test
  T.Text ->
  SpecWith CddlData
cddlDecoderEquivalenceSpec :: forall a.
(HasCallStack, Eq a, Show a, DecCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith CddlData
cddlDecoderEquivalenceSpec Version
version Text
varName =
  let lbl :: Text
lbl = Proxy a -> Text
forall a. DecCBOR a => Proxy a -> Text
label (Proxy a -> Text) -> Proxy a -> Text
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a
   in FilePath
-> (CddlData -> IO ()) -> SpecWith (Arg (CddlData -> IO ()))
forall a.
(HasCallStack, Example a) =>
FilePath -> a -> SpecWith (Arg a)
it (Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Text
varName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
lbl) ((CddlData -> IO ()) -> SpecWith (Arg (CddlData -> IO ())))
-> (CddlData -> IO ()) -> SpecWith (Arg (CddlData -> IO ()))
forall a b. (a -> b) -> a -> b
$ \CddlData
cddlData ->
        Text -> CddlData -> (CddlVarFile -> IO ()) -> IO ()
forall b.
HasCallStack =>
Text -> CddlData -> (CddlVarFile -> IO b) -> IO b
withCddlVarFile Text
varName CddlData
cddlData ((CddlVarFile -> IO ()) -> IO ())
-> (CddlVarFile -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CddlVarFile {FilePath
[DiagCbor]
Text
Cddl
cddlVarFilePath :: CddlVarFile -> FilePath
cddlVarName :: CddlVarFile -> Text
cddlVarData :: CddlVarFile -> Cddl
cddlVarDiagCbor :: CddlVarFile -> [DiagCbor]
cddlVarFilePath :: FilePath
cddlVarName :: Text
cddlVarData :: Cddl
cddlVarDiagCbor :: [DiagCbor]
..} -> do
          [DiagCbor] -> (DiagCbor -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [DiagCbor]
cddlVarDiagCbor ((DiagCbor -> IO ()) -> IO ()) -> (DiagCbor -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \DiagCbor
diagCbor -> do
            Cbor ByteString
cbor <- HasCallStack => DiagCbor -> IO Cbor
DiagCbor -> IO Cbor
diagCborToCbor DiagCbor
diagCbor
            forall t.
(Eq t, DecCBOR t, DecCBOR (Annotator t), Show t) =>
Version -> ByteString -> IO ()
decoderEquivalenceExpectation @a Version
version ByteString
cbor

-- | Using the supplied `CddlData` inside the `SpecWith` generate random data and run the
-- `cddlRoundTripExpectation` for the supplied CDDL variable
cddlRoundTripCborSpec ::
  forall a.
  (HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
  -- | Serialization version
  Version ->
  -- | Name of the CDDL variable to test
  T.Text ->
  SpecWith CddlData
cddlRoundTripCborSpec :: forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR a) =>
Version -> Text -> SpecWith CddlData
cddlRoundTripCborSpec Version
version Text
varName =
  let lbl :: Text
lbl = Proxy a -> Text
forall a. DecCBOR a => Proxy a -> Text
label (Proxy a -> Text) -> Proxy a -> Text
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a
   in FilePath
-> (CddlData -> IO ()) -> SpecWith (Arg (CddlData -> IO ()))
forall a.
(HasCallStack, Example a) =>
FilePath -> a -> SpecWith (Arg a)
it (Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Text
varName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
lbl) ((CddlData -> IO ()) -> SpecWith (Arg (CddlData -> IO ())))
-> (CddlData -> IO ()) -> SpecWith (Arg (CddlData -> IO ()))
forall a b. (a -> b) -> a -> b
$ \CddlData
cddlData ->
        Text -> CddlData -> (CddlVarFile -> IO ()) -> IO ()
forall b.
HasCallStack =>
Text -> CddlData -> (CddlVarFile -> IO b) -> IO b
withCddlVarFile Text
varName CddlData
cddlData ((CddlVarFile -> IO ()) -> IO ())
-> (CddlVarFile -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
          Text -> Version -> Version -> Trip a a -> CddlVarFile -> IO ()
forall a.
(HasCallStack, Show a, Eq a) =>
Text -> Version -> Version -> Trip a a -> CddlVarFile -> IO ()
cddlRoundTripExpectation Text
lbl Version
version Version
version (forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @a)

-- | Verify that random data generated is:
--
-- * Decoded successfully into a Haskell type using the decoder in `Trip` and the version
--   supplied
--
-- * When reencoded conforms to the CDDL spec and produces valid `FlatTerm`
--
-- * When decoded again from the bytes produced by the encoder matches the type exactly
--   when it was decoded from random bytes
cddlRoundTripExpectation ::
  (HasCallStack, Show a, Eq a) =>
  T.Text ->
  -- | Version to use for decoding
  Version ->
  -- | Version to use for encoding
  Version ->
  -- | Decode/encoder that needs tsting
  Trip a a ->
  -- | Randomly generated data and the CDDL spec
  CddlVarFile ->
  Expectation
cddlRoundTripExpectation :: forall a.
(HasCallStack, Show a, Eq a) =>
Text -> Version -> Version -> Trip a a -> CddlVarFile -> IO ()
cddlRoundTripExpectation Text
lbl Version
encVersion Version
decVersion trip :: Trip a a
trip@Trip {forall s. Decoder s a
tripDecoder :: forall s. Decoder s a
tripDecoder :: forall a b. Trip a b -> forall s. Decoder s b
tripDecoder} CddlVarFile {FilePath
[DiagCbor]
Text
Cddl
cddlVarFilePath :: CddlVarFile -> FilePath
cddlVarName :: CddlVarFile -> Text
cddlVarData :: CddlVarFile -> Cddl
cddlVarDiagCbor :: CddlVarFile -> [DiagCbor]
cddlVarFilePath :: FilePath
cddlVarName :: Text
cddlVarData :: Cddl
cddlVarDiagCbor :: [DiagCbor]
..} = do
  [DiagCbor] -> (DiagCbor -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [DiagCbor]
cddlVarDiagCbor ((DiagCbor -> IO ()) -> IO ()) -> (DiagCbor -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \DiagCbor
diagCbor -> do
    Cbor ByteString
cbor <- HasCallStack => DiagCbor -> IO Cbor
DiagCbor -> IO Cbor
diagCborToCbor DiagCbor
diagCbor
    let mkFailure :: Encoding
-> Maybe ByteString
-> Maybe FilePath
-> Maybe DecoderError
-> Maybe DecoderError
-> RoundTripFailure
mkFailure Encoding
encoding =
          Version
-> Version
-> Encoding
-> ByteString
-> Maybe ByteString
-> Maybe FilePath
-> Maybe DecoderError
-> Maybe DecoderError
-> RoundTripFailure
RoundTripFailure Version
encVersion Version
decVersion Encoding
encoding ByteString
cbor
    case Version
-> Text
-> (forall s. Decoder s a)
-> ByteString
-> Either DecoderError a
forall a.
Version
-> Text
-> (forall s. Decoder s a)
-> ByteString
-> Either DecoderError a
decodeFullDecoder Version
decVersion Text
lbl Decoder s a
forall s. Decoder s a
tripDecoder ByteString
cbor of
      Left DecoderError
decErr ->
        HasCallStack => DiagCbor -> RoundTripFailure -> IO ()
DiagCbor -> RoundTripFailure -> IO ()
cddlFailure DiagCbor
diagCbor (RoundTripFailure -> IO ()) -> RoundTripFailure -> IO ()
forall a b. (a -> b) -> a -> b
$ Encoding
-> Maybe ByteString
-> Maybe FilePath
-> Maybe DecoderError
-> Maybe DecoderError
-> RoundTripFailure
mkFailure Encoding
forall a. Monoid a => a
mempty Maybe ByteString
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing Maybe DecoderError
forall a. Maybe a
Nothing (DecoderError -> Maybe DecoderError
forall a. a -> Maybe a
Just DecoderError
decErr)
      Right a
val ->
        case Text
-> Version
-> Version
-> Trip a a
-> a
-> Either RoundTripFailure (a, Encoding, ByteString)
forall a b.
Eq b =>
Text
-> Version
-> Version
-> Trip a b
-> a
-> Either RoundTripFailure (b, Encoding, ByteString)
embedTripLabelExtra Text
lbl Version
encVersion Version
decVersion Trip a a
trip a
val of
          Right (a
val', Encoding
encoding, ByteString
encodedBytes) ->
            FilePath -> ByteString -> IO (Either FilePath ByteString)
validateCddlConformance FilePath
cddlVarFilePath ByteString
encodedBytes IO (Either FilePath ByteString)
-> (Either FilePath ByteString -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Left FilePath
confErr ->
                HasCallStack => DiagCbor -> RoundTripFailure -> IO ()
DiagCbor -> RoundTripFailure -> IO ()
cddlFailure DiagCbor
diagCbor (RoundTripFailure -> IO ()) -> RoundTripFailure -> IO ()
forall a b. (a -> b) -> a -> b
$
                  Encoding
-> Maybe ByteString
-> Maybe FilePath
-> Maybe DecoderError
-> Maybe DecoderError
-> RoundTripFailure
mkFailure Encoding
encoding (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
encodedBytes) (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
confErr) Maybe DecoderError
forall a. Maybe a
Nothing Maybe DecoderError
forall a. Maybe a
Nothing
              Right ByteString
_bsl -> a
val' a -> a -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` a
val
          Left RoundTripFailure
embedErr -> HasCallStack => DiagCbor -> RoundTripFailure -> IO ()
DiagCbor -> RoundTripFailure -> IO ()
cddlFailure DiagCbor
diagCbor RoundTripFailure
embedErr

cddlFailure :: HasCallStack => DiagCbor -> RoundTripFailure -> Expectation
cddlFailure :: HasCallStack => DiagCbor -> RoundTripFailure -> IO ()
cddlFailure DiagCbor
diagCbor RoundTripFailure
err =
  HasCallStack => FilePath -> IO ()
FilePath -> IO ()
expectationFailure (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
    [FilePath] -> FilePath
unlines
      [ FilePath
"Failed to Cddl RoundTrip verification:"
      , RoundTripFailure -> FilePath
forall a. Show a => a -> FilePath
show RoundTripFailure
err
      , FilePath
"Generated diag: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ByteString -> FilePath
BSL8.unpack (DiagCbor -> ByteString
unDiagCbor DiagCbor
diagCbor)
      ]

-- | Similar to `cddlRoundTripCborSpec`, but for Annotator.
cddlRoundTripAnnCborSpec ::
  forall a.
  (HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR (Annotator a), Typeable a) =>
  -- | Serialization version
  Version ->
  -- | Cddl variable name
  T.Text ->
  SpecWith CddlData
cddlRoundTripAnnCborSpec :: forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR (Annotator a),
 Typeable a) =>
Version -> Text -> SpecWith CddlData
cddlRoundTripAnnCborSpec Version
version Text
varName =
  let lbl :: Text
lbl = Proxy (Annotator a) -> Text
forall a. DecCBOR a => Proxy a -> Text
label (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Annotator a))
   in FilePath
-> (CddlData -> IO ()) -> SpecWith (Arg (CddlData -> IO ()))
forall a.
(HasCallStack, Example a) =>
FilePath -> a -> SpecWith (Arg a)
it (Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Text
varName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
lbl) ((CddlData -> IO ()) -> SpecWith (Arg (CddlData -> IO ())))
-> (CddlData -> IO ()) -> SpecWith (Arg (CddlData -> IO ()))
forall a b. (a -> b) -> a -> b
$ \CddlData
cddlData ->
        Text -> CddlData -> (CddlVarFile -> IO ()) -> IO ()
forall b.
HasCallStack =>
Text -> CddlData -> (CddlVarFile -> IO b) -> IO b
withCddlVarFile Text
varName CddlData
cddlData ((CddlVarFile -> IO ()) -> IO ())
-> (CddlVarFile -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
          Text
-> Version
-> Version
-> Trip a (Annotator a)
-> CddlVarFile
-> IO ()
forall a.
(HasCallStack, Show a, Eq a) =>
Text
-> Version
-> Version
-> Trip a (Annotator a)
-> CddlVarFile
-> IO ()
cddlRoundTripAnnExpectation Text
lbl Version
version Version
version (forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip @a)

-- | Same as `cddlRoundTripExpectation`, but works for decoders that are wrapped into
-- `Annotator`
cddlRoundTripAnnExpectation ::
  forall a.
  (HasCallStack, Show a, Eq a) =>
  T.Text ->
  Version ->
  Version ->
  Trip a (Annotator a) ->
  CddlVarFile ->
  Expectation
cddlRoundTripAnnExpectation :: forall a.
(HasCallStack, Show a, Eq a) =>
Text
-> Version
-> Version
-> Trip a (Annotator a)
-> CddlVarFile
-> IO ()
cddlRoundTripAnnExpectation Text
lbl Version
encVersion Version
decVersion Trip {a -> Encoding
forall s. Decoder s ()
forall s. Decoder s (Annotator a)
tripDecoder :: forall a b. Trip a b -> forall s. Decoder s b
tripEncoder :: a -> Encoding
tripDecoder :: forall s. Decoder s (Annotator a)
tripDropper :: forall s. Decoder s ()
tripEncoder :: forall a b. Trip a b -> a -> Encoding
tripDropper :: forall a b. Trip a b -> forall s. Decoder s ()
..} CddlVarFile {FilePath
[DiagCbor]
Text
Cddl
cddlVarFilePath :: CddlVarFile -> FilePath
cddlVarName :: CddlVarFile -> Text
cddlVarData :: CddlVarFile -> Cddl
cddlVarDiagCbor :: CddlVarFile -> [DiagCbor]
cddlVarFilePath :: FilePath
cddlVarName :: Text
cddlVarData :: Cddl
cddlVarDiagCbor :: [DiagCbor]
..} = do
  [DiagCbor] -> (DiagCbor -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [DiagCbor]
cddlVarDiagCbor ((DiagCbor -> IO ()) -> IO ()) -> (DiagCbor -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \DiagCbor
diagCbor -> do
    Cbor ByteString
cbor <- HasCallStack => DiagCbor -> IO Cbor
DiagCbor -> IO Cbor
diagCborToCbor DiagCbor
diagCbor
    let mkFailure :: Encoding
-> Maybe ByteString
-> Maybe FilePath
-> Maybe DecoderError
-> Maybe DecoderError
-> RoundTripFailure
mkFailure Encoding
encoding =
          Version
-> Version
-> Encoding
-> ByteString
-> Maybe ByteString
-> Maybe FilePath
-> Maybe DecoderError
-> Maybe DecoderError
-> RoundTripFailure
RoundTripFailure Version
encVersion Version
decVersion Encoding
encoding ByteString
cbor
    case Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
decodeFullAnnotator Version
decVersion Text
lbl Decoder s (Annotator a)
forall s. Decoder s (Annotator a)
tripDecoder ByteString
cbor of
      Left DecoderError
decErr ->
        HasCallStack => DiagCbor -> RoundTripFailure -> IO ()
DiagCbor -> RoundTripFailure -> IO ()
cddlFailure DiagCbor
diagCbor (RoundTripFailure -> IO ()) -> RoundTripFailure -> IO ()
forall a b. (a -> b) -> a -> b
$ Encoding
-> Maybe ByteString
-> Maybe FilePath
-> Maybe DecoderError
-> Maybe DecoderError
-> RoundTripFailure
mkFailure Encoding
forall a. Monoid a => a
mempty Maybe ByteString
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing Maybe DecoderError
forall a. Maybe a
Nothing (DecoderError -> Maybe DecoderError
forall a. a -> Maybe a
Just DecoderError
decErr)
      Right a
val ->
        let encoding :: Encoding
encoding = Version -> Encoding -> Encoding
toPlainEncoding Version
encVersion (Encoding -> Encoding) -> Encoding -> Encoding
forall a b. (a -> b) -> a -> b
$ a -> Encoding
tripEncoder a
val
         in case Text
-> Version
-> Version
-> (forall s. Decoder s (Annotator a))
-> Encoding
-> Either RoundTripFailure (a, ByteString)
forall t.
Text
-> Version
-> Version
-> (forall s. Decoder s (Annotator t))
-> Encoding
-> Either RoundTripFailure (t, ByteString)
decodeAnnExtra Text
lbl Version
encVersion Version
decVersion Decoder s (Annotator a)
forall s. Decoder s (Annotator a)
tripDecoder Encoding
encoding of
              Right (a
val', ByteString
encodedBytes) ->
                FilePath -> ByteString -> IO (Either FilePath ByteString)
validateCddlConformance FilePath
cddlVarFilePath ByteString
encodedBytes IO (Either FilePath ByteString)
-> (Either FilePath ByteString -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                  Left FilePath
confErr ->
                    HasCallStack => DiagCbor -> RoundTripFailure -> IO ()
DiagCbor -> RoundTripFailure -> IO ()
cddlFailure DiagCbor
diagCbor (RoundTripFailure -> IO ()) -> RoundTripFailure -> IO ()
forall a b. (a -> b) -> a -> b
$
                      Encoding
-> Maybe ByteString
-> Maybe FilePath
-> Maybe DecoderError
-> Maybe DecoderError
-> RoundTripFailure
mkFailure Encoding
encoding (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
encodedBytes) (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
confErr) Maybe DecoderError
forall a. Maybe a
Nothing Maybe DecoderError
forall a. Maybe a
Nothing
                  Right ByteString
_bsl -> a
val' a -> a -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` a
val
              Left RoundTripFailure
embedErr -> HasCallStack => DiagCbor -> RoundTripFailure -> IO ()
DiagCbor -> RoundTripFailure -> IO ()
cddlFailure DiagCbor
diagCbor RoundTripFailure
embedErr

genCddlDiagCbor :: HasCallStack => Int -> Cddl -> IO [DiagCbor]
genCddlDiagCbor :: HasCallStack => Int -> Cddl -> IO [DiagCbor]
genCddlDiagCbor Int
numCases =
  (Either FilePath ByteString -> [DiagCbor])
-> IO (Either FilePath ByteString) -> IO [DiagCbor]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath -> [DiagCbor])
-> (ByteString -> [DiagCbor])
-> Either FilePath ByteString
-> [DiagCbor]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> [DiagCbor]
forall a. HasCallStack => FilePath -> a
error ((ByteString -> DiagCbor) -> [ByteString] -> [DiagCbor]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> DiagCbor
DiagCbor ([ByteString] -> [DiagCbor])
-> (ByteString -> [ByteString]) -> ByteString -> [DiagCbor]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BSL8.lines))
    (IO (Either FilePath ByteString) -> IO [DiagCbor])
-> (Cddl -> IO (Either FilePath ByteString))
-> Cddl
-> IO [DiagCbor]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath
-> ProcessConfig () () ()
-> ByteString
-> IO (Either FilePath ByteString)
forall stdin stdout stderr.
FilePath
-> ProcessConfig stdin stdout stderr
-> ByteString
-> IO (Either FilePath ByteString)
readProcessNoFailure FilePath
"generating examples" (FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
"cddl" [FilePath
"-", FilePath
"generate", Int -> FilePath
forall a. Show a => a -> FilePath
show Int
numCases])
    (ByteString -> IO (Either FilePath ByteString))
-> (Cddl -> ByteString) -> Cddl -> IO (Either FilePath ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cddl -> ByteString
unCddl

-- | Convert randomly generated Cbor in special Diag (human readable) format to binary CBOR
-- format
diagCborToCbor :: HasCallStack => DiagCbor -> IO Cbor
diagCborToCbor :: HasCallStack => DiagCbor -> IO Cbor
diagCborToCbor =
  (Either FilePath ByteString -> Cbor)
-> IO (Either FilePath ByteString) -> IO Cbor
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath -> Cbor)
-> (ByteString -> Cbor) -> Either FilePath ByteString -> Cbor
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> Cbor
forall a. HasCallStack => FilePath -> a
error ByteString -> Cbor
Cbor)
    (IO (Either FilePath ByteString) -> IO Cbor)
-> (DiagCbor -> IO (Either FilePath ByteString))
-> DiagCbor
-> IO Cbor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath
-> ProcessConfig () () ()
-> ByteString
-> IO (Either FilePath ByteString)
forall stdin stdout stderr.
FilePath
-> ProcessConfig stdin stdout stderr
-> ByteString
-> IO (Either FilePath ByteString)
readProcessNoFailure FilePath
"converting cbor diagnostic notation to bytes" (FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
"diag2cbor.rb" [FilePath
"-"])
    (ByteString -> IO (Either FilePath ByteString))
-> (DiagCbor -> ByteString)
-> DiagCbor
-> IO (Either FilePath ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiagCbor -> ByteString
unDiagCbor

-- | Run a @cddl@ process and validate that encoded data is in confomrance with the
-- supplied CDDL spec
validateCddlConformance ::
  -- | File path to the file with CDDL spec
  FilePath ->
  -- | CBOR encoded data that should conform with CDDL spec
  BSL8.ByteString ->
  IO (Either String BSL.ByteString)
validateCddlConformance :: FilePath -> ByteString -> IO (Either FilePath ByteString)
validateCddlConformance FilePath
filePath =
  FilePath
-> ProcessConfig () () ()
-> ByteString
-> IO (Either FilePath ByteString)
forall stdin stdout stderr.
FilePath
-> ProcessConfig stdin stdout stderr
-> ByteString
-> IO (Either FilePath ByteString)
readProcessNoFailure FilePath
"validating cddl conformace" (FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
"cddl" [FilePath
filePath, FilePath
"validate", FilePath
"-"])

-- | Run a process with `readProcess` and return `Left` on failure, which will contain the
-- output produced on @stderr@. Accepts lazy bytestring as input for the spawned
-- process. In case when a process exits successfuly, the output is returned on the
-- `Right`. Upon a successful exit, @stderr@ output is ignored to avoid polluting test
-- suite output with copious amounts of warnings.
readProcessNoFailure ::
  String ->
  ProcessConfig stdin stdout stderr ->
  BSL.ByteString ->
  IO (Either String BSL.ByteString)
readProcessNoFailure :: forall stdin stdout stderr.
FilePath
-> ProcessConfig stdin stdout stderr
-> ByteString
-> IO (Either FilePath ByteString)
readProcessNoFailure FilePath
procDescr ProcessConfig stdin stdout stderr
procConfig ByteString
input =
  ProcessConfig () stdout stderr
-> IO (ExitCode, ByteString, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ExitCode, ByteString, ByteString)
readProcess (StreamSpec 'STInput ()
-> ProcessConfig stdin stdout stderr
-> ProcessConfig () stdout stderr
forall stdin stdin0 stdout stderr.
StreamSpec 'STInput stdin
-> ProcessConfig stdin0 stdout stderr
-> ProcessConfig stdin stdout stderr
setStdin (ByteString -> StreamSpec 'STInput ()
byteStringInput ByteString
input) ProcessConfig stdin stdout stderr
procConfig) IO (ExitCode, ByteString, ByteString)
-> ((ExitCode, ByteString, ByteString)
    -> IO (Either FilePath ByteString))
-> IO (Either FilePath ByteString)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    (ExitCode
ExitSuccess, ByteString
stdOut, ByteString
"") -> Either FilePath ByteString -> IO (Either FilePath ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath ByteString -> IO (Either FilePath ByteString))
-> Either FilePath ByteString -> IO (Either FilePath ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either FilePath ByteString
forall a b. b -> Either a b
Right ByteString
stdOut
    (ExitCode
ExitSuccess, ByteString
stdOut, ByteString
_stdErr) -> do
      -- Ideally we would only want to use relevant CDDL for particular test, which would
      -- result in stdErr to be empty, but currently there are many warnings about unused
      -- CDDL rules:
      --
      -- putStrLn $
      --   unlines
      --     [ "Process for " <> procDescr
      --     , "received some output on stderr"
      --     , show procConfig
      --     , "StdErr output:"
      --     , bslToString stdErr
      --     ]
      Either FilePath ByteString -> IO (Either FilePath ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath ByteString -> IO (Either FilePath ByteString))
-> Either FilePath ByteString -> IO (Either FilePath ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either FilePath ByteString
forall a b. b -> Either a b
Right ByteString
stdOut
    (ExitFailure Int
exitCode, ByteString
_, ByteString
stdErr) ->
      Either FilePath ByteString -> IO (Either FilePath ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath ByteString -> IO (Either FilePath ByteString))
-> Either FilePath ByteString -> IO (Either FilePath ByteString)
forall a b. (a -> b) -> a -> b
$
        FilePath -> Either FilePath ByteString
forall a b. a -> Either a b
Left (FilePath -> Either FilePath ByteString)
-> FilePath -> Either FilePath ByteString
forall a b. (a -> b) -> a -> b
$
          [FilePath] -> FilePath
unlines
            [ FilePath
"Process for " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
procDescr
            , ProcessConfig stdin stdout stderr -> FilePath
forall a. Show a => a -> FilePath
show ProcessConfig stdin stdout stderr
procConfig
            , FilePath
"failed with an error code: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
exitCode
            , FilePath
"StdErr output:"
            , ByteString -> FilePath
bslToString ByteString
stdErr
            ]
  where
    bslToString :: ByteString -> FilePath
bslToString = Text -> FilePath
T.unpack (Text -> FilePath)
-> (ByteString -> Text) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict

-- | Write binary data to a temporary file and apply an action to a temporary file name
-- path that contains that data. File is guaranteed to be alive only until the supplied
-- action is active, therefore make sure not to return the name for the temporary file
-- name.
usingTempFile :: BSL.ByteString -> (FilePath -> IO a) -> IO a
usingTempFile :: forall a. ByteString -> (FilePath -> IO a) -> IO a
usingTempFile ByteString
bytes FilePath -> IO a
action =
  FilePath -> FilePath -> (FilePath -> Handle -> IO a) -> IO a
forall (m :: * -> *) a.
MonadUnliftIO m =>
FilePath -> FilePath -> (FilePath -> Handle -> m a) -> m a
withTempFile FilePath
"." FilePath
"tmp" ((FilePath -> Handle -> IO a) -> IO a)
-> (FilePath -> Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \FilePath
fileName Handle
h -> do
    Handle -> ByteString -> IO ()
BSL.hPut Handle
h ByteString
bytes
    Handle -> IO ()
hClose Handle
h
    FilePath -> IO a
action FilePath
fileName