{-# LANGUAGE LambdaCase #-}

module Test.Util.Serialisation.CDDL
  ( cddlTestCase
  , cddlTest
  , isCDDLCDisabled
  , CDDLsForNodeToNode (..)
  ) where

import Control.Monad (join)
import qualified Data.ByteString as BS
import Data.Maybe (isJust)
import qualified Data.Text as T
import qualified System.Directory as D
import qualified System.Environment as E
import System.Exit
import System.IO
import System.IO.Temp
import System.IO.Unsafe (unsafePerformIO)
import System.Process
import Test.Tasty
import Test.Tasty.HUnit

-- | Windows on Hydra cannot cross-compile CDDLC so we decided to skip the tests
-- there.
isCDDLCDisabled :: Bool
isCDDLCDisabled :: Bool
isCDDLCDisabled = Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (Maybe FilePath -> Bool) -> Maybe FilePath -> Bool
forall a b. (a -> b) -> a -> b
$ IO (Maybe FilePath) -> Maybe FilePath
forall a. IO a -> a
unsafePerformIO (FilePath -> IO (Maybe FilePath)
E.lookupEnv FilePath
"DISABLE_CDDLC")

-- | A Tasty test case running the @cuddle@
cddlTestCase :: IO BS.ByteString -> FilePath -> T.Text -> TestTree
cddlTestCase :: IO ByteString -> FilePath -> Text -> TestTree
cddlTestCase IO ByteString
cborM FilePath
cddl Text
rule =
  FilePath -> Assertion -> TestTree
testCase FilePath
"CDDL compliance" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
    if Bool
isCDDLCDisabled
      then HasCallStack => FilePath -> Bool -> Assertion
FilePath -> Bool -> Assertion
assertBool FilePath
"Skipped" Bool
True
      else
        IO ByteString -> FilePath -> Text -> IO (Either FilePath ())
cddlTest IO ByteString
cborM FilePath
cddl Text
rule IO (Either FilePath ())
-> (Either FilePath () -> Assertion) -> Assertion
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
err -> FilePath -> Assertion
forall a. HasCallStack => FilePath -> IO a
assertFailure FilePath
err
          Right ()
_ -> () -> Assertion
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Test the CDDL conformance of the given bytestring
cddlTest ::
  IO BS.ByteString ->
  String ->
  T.Text ->
  IO (Either String ())
cddlTest :: IO ByteString -> FilePath -> Text -> IO (Either FilePath ())
cddlTest IO ByteString
cborM FilePath
cddl Text
rule =
  FilePath
-> FilePath
-> (FilePath -> Handle -> IO (Either FilePath ()))
-> IO (Either FilePath ())
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> FilePath -> (FilePath -> Handle -> m a) -> m a
withTempFile FilePath
"." FilePath
"testcase.cbor" ((FilePath -> Handle -> IO (Either FilePath ()))
 -> IO (Either FilePath ()))
-> (FilePath -> Handle -> IO (Either FilePath ()))
-> IO (Either FilePath ())
forall a b. (a -> b) -> a -> b
$ \FilePath
fp Handle
h -> do
    bs <- IO ByteString
cborM
    BS.hPutStr h bs
    hClose h
    (code, _out, err) <-
      readProcessWithExitCode "cuddle" (cuddleArgs fp (T.unpack rule) cddl) mempty
    case code of
      ExitFailure Int
_ -> do
        -- Copy the CBOR term and the CDDL file into a directory and
        -- generate a script with a cuddle call that would lead to an error
        errorReproducerDir <-
          IO (IO FilePath) -> IO FilePath
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO FilePath) -> IO FilePath)
-> IO (IO FilePath) -> IO FilePath
forall a b. (a -> b) -> a -> b
$
            FilePath -> FilePath -> FilePath -> IO FilePath
dumpErrorReproducer (FilePath -> FilePath -> FilePath -> IO FilePath)
-> IO FilePath -> IO (FilePath -> FilePath -> IO FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
D.canonicalizePath FilePath
fp IO (FilePath -> FilePath -> IO FilePath)
-> IO FilePath -> IO (FilePath -> IO FilePath)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> IO FilePath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> FilePath
T.unpack Text
rule) IO (FilePath -> IO FilePath) -> IO FilePath -> IO (IO FilePath)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> IO FilePath
D.canonicalizePath FilePath
cddl
        pure (Left $ err <> " cuddle reproducer written to " <> errorReproducerDir)
      ExitCode
ExitSuccess -> Either FilePath () -> IO (Either FilePath ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either FilePath ()
forall a b. b -> Either a b
Right ())
 where
  cuddleArgs :: FilePath -> String -> FilePath -> [String]
  cuddleArgs :: FilePath -> FilePath -> FilePath -> [FilePath]
cuddleArgs FilePath
cborFile FilePath
ruleName FilePath
cddlFile = [FilePath
"validate-cbor", FilePath
"-c", FilePath
cborFile, FilePath
"-r", FilePath
ruleName, FilePath
cddlFile]

  dumpErrorReproducer :: FilePath -> String -> FilePath -> IO FilePath
  dumpErrorReproducer :: FilePath -> FilePath -> FilePath -> IO FilePath
dumpErrorReproducer FilePath
cborFile FilePath
ruleName FilePath
cddlFile = do
    errorReproducerDir <- FilePath -> IO FilePath
D.canonicalizePath (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"failing_cddl_tests"
    D.createDirectoryIfMissing False errorReproducerDir
    D.withCurrentDirectory errorReproducerDir $ do
      failingCborFile <- D.canonicalizePath $ ruleName <> "_failing.cbor"
      failingCddlFile <- D.canonicalizePath $ ruleName <> "_failing.cddl"
      let failingCuddleCallFile = FilePath
"call_cuddle_" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
ruleName FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"_failing.sh"
          failingCuddleCall = [FilePath] -> FilePath
unwords ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"cuddle" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (FilePath -> FilePath -> FilePath -> [FilePath]
cuddleArgs FilePath
failingCborFile FilePath
ruleName FilePath
failingCddlFile)
      D.copyFile cborFile failingCborFile
      D.copyFile cddlFile failingCddlFile
      writeFile failingCuddleCallFile failingCuddleCall
    pure errorReproducerDir

-- | A collection of CDDL spec and the relevant rule to use
data CDDLsForNodeToNode = CDDLsForNodeToNode
  { CDDLsForNodeToNode -> (FilePath, Text)
blockCDDL :: (FilePath, T.Text)
  , CDDLsForNodeToNode -> (FilePath, Text)
headerCDDL :: (FilePath, T.Text)
  , CDDLsForNodeToNode -> (FilePath, Text)
txCDDL :: (FilePath, T.Text)
  , CDDLsForNodeToNode -> (FilePath, Text)
txIdCDDL :: (FilePath, T.Text)
  }