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

module Test.Cardano.Ledger.Binary.Cddl (
  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.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 = forall a. HasCallStack => IO a -> SpecWith a -> Spec
beforeAll 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 forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.fromStrict forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.toStrict forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [ByteString]
cddls
  forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
cddlNumExamples :: Int
cddlData :: Cddl
cddlNumExamples :: CddlData -> Int
cddlData :: CddlData -> Cddl
..} CddlVarFile -> IO b
roundTripTest = do
  let suffix :: ByteString
suffix = Text -> ByteString
T.encodeUtf8 forall a b. (a -> b) -> a -> b
$ Text
"output = " forall a. Semigroup a => a -> a -> a
<> Text
varName forall a. Semigroup a => a -> a -> a
<> Text
"\n"
      varData :: Cddl
varData = ByteString -> Cddl
Cddl (ByteString -> ByteString
BSL.fromStrict ByteString
suffix forall a. Semigroup a => a -> a -> a
<> Cddl -> ByteString
unCddl Cddl
cddlData)
  [DiagCbor]
diagCbor <- HasCallStack => Int -> Cddl -> IO [DiagCbor]
genCddlDiagCbor Int
cddlNumExamples Cddl
varData
  forall a. ByteString -> (FilePath -> IO a) -> IO a
usingTempFile (Cddl -> ByteString
unCddl Cddl
varData) forall a b. (a -> b) -> a -> b
$ \FilePath
filePath ->
    CddlVarFile -> IO b
roundTripTest 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 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 = forall a. DecCBOR a => Proxy a -> Text
label forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @a
   in forall a.
(HasCallStack, Example a) =>
FilePath -> a -> SpecWith (Arg a)
it (Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ Text
varName forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> Text
lbl) forall a b. (a -> b) -> a -> b
$ \CddlData
cddlData ->
        forall b.
HasCallStack =>
Text -> CddlData -> (CddlVarFile -> IO b) -> IO b
withCddlVarFile Text
varName CddlData
cddlData forall a b. (a -> b) -> a -> b
$
          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 a b. Trip a b -> forall s. Decoder s b
tripDecoder :: forall s. Decoder s a
tripDecoder} CddlVarFile {FilePath
[DiagCbor]
Text
Cddl
cddlVarDiagCbor :: [DiagCbor]
cddlVarData :: Cddl
cddlVarName :: Text
cddlVarFilePath :: FilePath
cddlVarDiagCbor :: CddlVarFile -> [DiagCbor]
cddlVarData :: CddlVarFile -> Cddl
cddlVarName :: CddlVarFile -> Text
cddlVarFilePath :: CddlVarFile -> FilePath
..} = do
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [DiagCbor]
cddlVarDiagCbor forall a b. (a -> b) -> a -> b
$ \DiagCbor
diagCbor -> do
    Cbor ByteString
cbor <- HasCallStack => 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 forall a.
Version
-> Text
-> (forall s. Decoder s a)
-> ByteString
-> Either DecoderError a
decodeFullDecoder Version
decVersion Text
lbl forall s. Decoder s a
tripDecoder ByteString
cbor of
      Left DecoderError
decErr ->
        HasCallStack => DiagCbor -> RoundTripFailure -> IO ()
cddlFailure DiagCbor
diagCbor forall a b. (a -> b) -> a -> b
$ Encoding
-> Maybe ByteString
-> Maybe FilePath
-> Maybe DecoderError
-> Maybe DecoderError
-> RoundTripFailure
mkFailure forall a. Monoid a => a
mempty forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just DecoderError
decErr)
      Right a
val ->
        case 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Left FilePath
confErr ->
                HasCallStack => DiagCbor -> RoundTripFailure -> IO ()
cddlFailure DiagCbor
diagCbor forall a b. (a -> b) -> a -> b
$
                  Encoding
-> Maybe ByteString
-> Maybe FilePath
-> Maybe DecoderError
-> Maybe DecoderError
-> RoundTripFailure
mkFailure Encoding
encoding (forall a. a -> Maybe a
Just ByteString
encodedBytes) (forall a. a -> Maybe a
Just FilePath
confErr) forall a. Maybe a
Nothing forall a. Maybe a
Nothing
              Right ByteString
_bsl -> a
val' forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` a
val
          Left RoundTripFailure
embedErr -> HasCallStack => 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 ()
expectationFailure forall a b. (a -> b) -> a -> b
$
    [FilePath] -> FilePath
unlines
      [ FilePath
"Failed to Cddl RoundTrip verification:"
      , forall a. Show a => a -> FilePath
show RoundTripFailure
err
      , FilePath
"Generated diag: " 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)) =>
  -- | Serialization version
  Version ->
  -- | Cddl variable name
  T.Text ->
  SpecWith CddlData
cddlRoundTripAnnCborSpec :: forall a.
(HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR (Annotator a)) =>
Version -> Text -> SpecWith CddlData
cddlRoundTripAnnCborSpec Version
version Text
varName =
  let lbl :: Text
lbl = forall a. DecCBOR a => Proxy a -> Text
label (forall {k} (t :: k). Proxy t
Proxy @(Annotator a))
   in forall a.
(HasCallStack, Example a) =>
FilePath -> a -> SpecWith (Arg a)
it (Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ Text
varName forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> Text
lbl) forall a b. (a -> b) -> a -> b
$ \CddlData
cddlData ->
        forall b.
HasCallStack =>
Text -> CddlData -> (CddlVarFile -> IO b) -> IO b
withCddlVarFile Text
varName CddlData
cddlData forall a b. (a -> b) -> a -> b
$
          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)
tripDropper :: forall a b. Trip a b -> forall s. Decoder s ()
tripEncoder :: forall a b. Trip a b -> a -> Encoding
tripDropper :: forall s. Decoder s ()
tripDecoder :: forall s. Decoder s (Annotator a)
tripEncoder :: a -> Encoding
tripDecoder :: forall a b. Trip a b -> forall s. Decoder s b
..} CddlVarFile {FilePath
[DiagCbor]
Text
Cddl
cddlVarDiagCbor :: [DiagCbor]
cddlVarData :: Cddl
cddlVarName :: Text
cddlVarFilePath :: FilePath
cddlVarDiagCbor :: CddlVarFile -> [DiagCbor]
cddlVarData :: CddlVarFile -> Cddl
cddlVarName :: CddlVarFile -> Text
cddlVarFilePath :: CddlVarFile -> FilePath
..} = do
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [DiagCbor]
cddlVarDiagCbor forall a b. (a -> b) -> a -> b
$ \DiagCbor
diagCbor -> do
    Cbor ByteString
cbor <- HasCallStack => 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 forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
decodeFullAnnotator Version
decVersion Text
lbl forall s. Decoder s (Annotator a)
tripDecoder ByteString
cbor of
      Left DecoderError
decErr ->
        HasCallStack => DiagCbor -> RoundTripFailure -> IO ()
cddlFailure DiagCbor
diagCbor forall a b. (a -> b) -> a -> b
$ Encoding
-> Maybe ByteString
-> Maybe FilePath
-> Maybe DecoderError
-> Maybe DecoderError
-> RoundTripFailure
mkFailure forall a. Monoid a => a
mempty forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just DecoderError
decErr)
      Right a
val ->
        let encoding :: Encoding
encoding = Version -> Encoding -> Encoding
toPlainEncoding Version
encVersion forall a b. (a -> b) -> a -> b
$ a -> Encoding
tripEncoder a
val
         in case forall t.
Text
-> Version
-> Version
-> (forall s. Decoder s (Annotator t))
-> Encoding
-> Either RoundTripFailure (t, ByteString)
decodeAnnExtra Text
lbl Version
encVersion Version
decVersion 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                  Left FilePath
confErr ->
                    HasCallStack => DiagCbor -> RoundTripFailure -> IO ()
cddlFailure DiagCbor
diagCbor forall a b. (a -> b) -> a -> b
$
                      Encoding
-> Maybe ByteString
-> Maybe FilePath
-> Maybe DecoderError
-> Maybe DecoderError
-> RoundTripFailure
mkFailure Encoding
encoding (forall a. a -> Maybe a
Just ByteString
encodedBytes) (forall a. a -> Maybe a
Just FilePath
confErr) forall a. Maybe a
Nothing forall a. Maybe a
Nothing
                  Right ByteString
_bsl -> a
val' forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` a
val
              Left RoundTripFailure
embedErr -> HasCallStack => DiagCbor -> RoundTripFailure -> IO ()
cddlFailure DiagCbor
diagCbor RoundTripFailure
embedErr

genCddlDiagCbor :: HasCallStack => Int -> Cddl -> IO [DiagCbor]
genCddlDiagCbor :: HasCallStack => Int -> Cddl -> IO [DiagCbor]
genCddlDiagCbor Int
numCases =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => FilePath -> a
error (forall a b. (a -> b) -> [a] -> [b]
map ByteString -> DiagCbor
DiagCbor forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BSL8.lines))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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", forall a. Show a => a -> FilePath
show Int
numCases])
    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 =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => FilePath -> a
error ByteString -> Cbor
Cbor)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
"-"])
    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 =
  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 =
  forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ExitCode, ByteString, ByteString)
readProcess (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) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    (ExitCode
ExitSuccess, ByteString
stdOut, ByteString
"") -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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
      --     ]
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ByteString
stdOut
    (ExitFailure Int
exitCode, ByteString
_, ByteString
stdErr) ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$
          [FilePath] -> FilePath
unlines
            [ FilePath
"Process for " forall a. Semigroup a => a -> a -> a
<> FilePath
procDescr
            , forall a. Show a => a -> FilePath
show ProcessConfig stdin stdout stderr
procConfig
            , FilePath
"failed with an error code: " forall a. Semigroup a => a -> a -> a
<> 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8 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 =
  forall (m :: * -> *) a.
MonadUnliftIO m =>
FilePath -> FilePath -> (FilePath -> Handle -> m a) -> m a
withTempFile FilePath
"." FilePath
"tmp" 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