content: -- This file is part of the Wire Server implementation.
  --
  -- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
  --
  -- This program is free software: you can redistribute it and/or modify it under
  -- the terms of the GNU Affero General Public License as published by the Free
  -- Software Foundation, either version 3 of the License, or (at your option) any
  -- later version.
  --
  -- This program is distributed in the hope that it will be useful, but WITHOUT
  -- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  -- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
  -- details.
  --
  -- You should have received a copy of the GNU Affero General Public License along
  -- with this program. If not, see <https://www.gnu.org/licenses/>.
  
  module Test.Wire.API.Golden.Runner
    ( assertJSONIsGolden,
      testObjects,
      testToJSON,
      protoTestObjects,
      testFromJSONFailure,
      testFromJSONFailureWithMsg,
      testFromJSONObject,
      testFromJSONObjects,
    )
  where
  
  import Data.Aeson
  import Data.Aeson.Diff qualified as AD
  import Data.Aeson.Encode.Pretty (Config (..), defConfig, encodePretty')
  import Data.ByteString qualified as ByteString
  import Data.ByteString.Lazy qualified as LBS
  import Data.ProtoLens.Encoding (decodeMessage, encodeMessage)
  import Data.ProtoLens.Message (Message)
  import Data.ProtoLens.TextFormat (readMessage, showMessage)
  import Data.String.Conversions
  import Data.Text.Lazy.IO qualified as LText
  import Imports
  import Test.Tasty (TestTree)
  import Test.Tasty.HUnit
  import Type.Reflection (typeRep)
  import Wire.API.ServantProto
  
  testObjects :: forall a. (Typeable a, ToJSON a, FromJSON a, Eq a, Show a) => [(a, FilePath)] -> [TestTree]
  testObjects = fmap (\(obj, path) -> testCase path $ testObject obj path)
  
  testObject :: forall a. (Typeable a, ToJSON a, FromJSON a, Eq a, Show a) => a -> FilePath -> Assertion
  testObject obj path = do
    assertJSONIsGolden obj path
    assertEqual
      (show (typeRep @a) <> ": FromJSON of " <> path <> " should match object")
      (Success obj)
      (fromJSON $ toJSON obj)
  
  testToJSON :: forall a. (Typeable a, ToJSON a) => a -> FilePath -> TestTree
  testToJSON obj path = testCase path $ assertJSONIsGolden obj path
  
  assertJSONIsGolden :: forall a. (Typeable a, ToJSON a) => a -> FilePath -> Assertion
  assertJSONIsGolden obj path = do
    let actualValue = toJSON obj :: Value
        actualJson = encodePretty' encodeConfig actualValue
        dir = "test/golden"
        fullPath = dir <> "/" <> path
    createDirectoryIfMissing True dir
    exists <- doesFileExist fullPath
    unless exists $ ByteString.writeFile fullPath (LBS.toStrict actualJson)
  
    expectedValue :: Value <- assertRight =<< eitherDecodeFileStrict fullPath
    assertBool
      ( show (typeRep @a)
          <> ": ToJSON should match golden file: "
          <> path
          <> "\n\nexpected:\n"
          <> cs (encodePretty' encodeConfig expectedValue)
          <> "\n\nactual:\n"
          <> cs (encodePretty' encodeConfig actualValue)
          <> "\n\ndiff:\n"
          <> cs (encodePretty' encodeConfig (AD.diff expectedValue actualValue))
      )
      (expectedValue == actualValue)
    assertBool ("JSON golden file " <> path <> " does not exist") exists
  
  encodeConfig :: Config
  encodeConfig = defConfig {confCompare = compare, confTrailingNewline = True}
  
  protoTestObjects ::
    forall m a.
    (Typeable a, ToProto a, FromProto a, Eq a, Show a, Show m, Eq m, Message m) =>
    [(a, FilePath)] ->
    IO ()
  protoTestObjects objs = do
    allFilesExist <- and <$> traverse (uncurry (protoTestObject @m)) objs
    assertBool "Some golden protobuf files do not exist" allFilesExist
  
  protoTestObject ::
    forall m a.
    (Typeable a, ToProto a, FromProto a, Eq a, Show a, Show m, Eq m, Message m) =>
    a ->
    FilePath ->
    IO Bool
  protoTestObject obj path = do
    let actual = toProto obj
    msg <- assertRight (decodeMessage @m actual)
    let pretty = showMessage msg
        dir = "test/golden"
        fullPath = dir <> "/" <> path
    createDirectoryIfMissing True dir
    exists <- doesFileExist fullPath
    unless exists $ writeFile fullPath pretty
  
    msgText <- LText.readFile fullPath
    expected <- assertRight (readMessage @m msgText)
    assertEqual
      (show (typeRep @a) <> ": ToProto should match golden file: " <> path)
      expected
      msg
    assertEqual
      (show (typeRep @a) <> ": FromProto of " <> path <> " should match object")
      (Right obj)
      (fromProto (encodeMessage expected))
  
    pure exists
  
  testFromJSONObjects :: forall a. (Typeable a, FromJSON a, Eq a, Show a) => [(a, FilePath)] -> IO ()
  testFromJSONObjects = traverse_ (uncurry testFromJSONObject)
  
  testFromJSONObject :: forall a. (Typeable a, FromJSON a, Eq a, Show a) => a -> FilePath -> IO ()
  testFromJSONObject expected path = do
    let dir = "test/golden/fromJSON"
        fullPath = dir <> "/" <> path
    parsed <- eitherDecodeFileStrict fullPath
    assertEqual (show (typeRep @a) <> ": FromJSON of " <> path <> " should match object") (Right expected) parsed
  
  testFromJSONFailure :: forall a. (Typeable a, FromJSON a, Show a) => FilePath -> IO ()
  testFromJSONFailure = testFromJSONFailureWithMsg @a Nothing
  
  testFromJSONFailureWithMsg :: forall a. (Typeable a, FromJSON a, Show a) => Maybe String -> FilePath -> IO ()
  testFromJSONFailureWithMsg msg path = do
    let dir = "test/golden/fromJSON"
        fullPath = dir <> "/" <> path
    parsed <- eitherDecodeFileStrict @a fullPath
    case parsed of
      Right x -> assertFailure $ failurePrefix <> ": expected failure, got " <> show x
      Left err -> case msg of
        Nothing -> pure ()
        Just m ->
          assertBool
            ( failurePrefix
                <> " had a wrong failure: "
                <> show m
                <> " is not contained in "
                <> show err
            )
            (m `isSuffixOf` err)
    where
      failurePrefix = show (typeRep @a) <> ": FromJSON of " <> path
  
  assertRight :: (Show a) => Either a b -> IO b
  assertRight =
    \case
      Left a -> assertFailure $ "Expected Right, got Left: " <> show a
      Right b -> pure b
  