content: {-
    Copyright (c) Meta Platforms, Inc. and affiliates.
    All rights reserved.
  
    This source code is licensed under the BSD-style license found in the
    LICENSE file in the root directory of this source tree.
  -}
  
  module IntegrationTest where
  
  import Control.Exception
  import Control.Monad
  import Data.ByteString (ByteString, packCStringLen, useAsCStringLen)
  import qualified Data.ByteString.Char8 as ByteString
  import Foreign.C
  import Foreign.Marshal.Alloc
  import Foreign.Ptr
  import Foreign.Storable
  import System.Exit
  import Test.QuickCheck as QC
  
  import HsTest.Types
  import Thrift.Protocol.Binary
  import Thrift.Protocol.Compact
  import Thrift.Protocol.JSON
  
  -- Serialize a struct from Haskell, send it to C++ where it gets deserialized
  -- and then re-serialized and then read it back into Haskell.
  prop_roundtrip
    :: (TestStruct -> ByteString)
    -> (ByteString -> Either String TestStruct)
    -> (CString -> CSize -> Ptr CString -> IO CSize)
    -> TestStruct
    -> Property
  prop_roundtrip serialize deserialize echo struct = ioProperty $
    useAsCStringLen (serialize struct) $ \(str, len) ->
    alloca $ \ptr ->
      bracket
        (do size <- fromIntegral <$> echo str (fromIntegral len) ptr
            buf  <- peek ptr
            return (buf, size))
        (free . fst)
        (\cstr ->
         if fst cstr == nullPtr
         then return False
         else do
           cereal <- packCStringLen cstr
           let result = deserialize cereal == Right struct
           unless result $ do
             ByteString.putStrLn $ serialize struct
             ByteString.putStrLn cereal
             print result
           return result)
  --         return $ deserialize cereal == Right struct)
  
  main :: IO ()
  main = do
    result <- mapM quickCheckResult
              [ prop_roundtrip serializeJSON deserializeJSON c_echoJSON
              , prop_roundtrip serializePrettyJSON deserializeJSON c_echoJSON
              , prop_roundtrip serializeBinary deserializeBinary c_echoBinary
              , prop_roundtrip serializeCompact deserializeCompact c_echoCompact
              ]
    if all success result then exitSuccess else exitFailure
      where
        success QC.Success{} = True
        success _ = False
  
  --------------------------------------------------------------------------------
  
  foreign import ccall unsafe "echoJSON"
    c_echoJSON :: CString -> CSize -> Ptr CString -> IO CSize
  
  foreign import ccall unsafe "echoBinary"
    c_echoBinary :: CString -> CSize -> Ptr CString -> IO CSize
  
  foreign import ccall unsafe "echoCompact"
    c_echoCompact :: CString -> CSize -> Ptr CString -> IO CSize
  