HaskellToScalaSpec.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}

module FlatBuffers.Integration.HaskellToScalaSpec where

import           Data.Aeson                ( (.=), Value(..), object )
import qualified Data.Aeson                as J
import qualified Data.ByteString.Lazy      as BSL
import qualified Data.ByteString.Lazy.UTF8 as BSLU
import           Data.Int

import           Examples

import           FlatBuffers
import qualified FlatBuffers.Vector        as Vec

import           Network.HTTP.Client
import           Network.HTTP.Types.Status ( statusCode )

import           TestImports


spec :: Spec
spec =
  describe "Haskell encoders should be consistent with Scala decoders" $
    it "VectorOfUnions" $ do
      testCase
        "VectorOfUnions"
        (encode $ vectorOfUnions
          (Just (Vec.singleton (weaponSword (sword (Just "hi")))))
          (Vec.singleton (weaponSword (sword (Just "hi2"))))
          )
        (object
          [ "xs" .= [object ["x" .= String "hi"]]
          , "xsReq" .= [object ["x" .= String "hi2"]]
          ]
        )
      testCase
        "VectorOfUnions"
        (encode $ vectorOfUnions
          (Just (Vec.singleton (weaponSword (sword Nothing))))
          (Vec.singleton (weaponAxe (axe Nothing)))
          )
        (object ["xs" .= [object ["x" .= Null]], "xsReq" .= [object ["y" .= Number 0]]])
      testCase
        "VectorOfUnions"
        (encode $ vectorOfUnions
          (Just $ Vec.fromList'
            [ weaponSword (sword (Just "hi"))
            , none
            , weaponAxe (axe (Just maxBound))
            , weaponSword (sword (Just "oi"))
            ]
          )
          (Vec.fromList'
            [ weaponSword (sword (Just "hi2"))
            , none
            , weaponAxe (axe (Just minBound))
            , weaponSword (sword (Just "oi2"))
            ]
          )
        )
        (object
          [ "xs" .=
            [ object ["x" .= String "hi"]
            , String "NONE"
            , object ["y" .= maxBound @Int32]
            , object ["x" .= String "oi"]
            ]
          , "xsReq" .=
            [ object ["x" .= String "hi2"]
            , String "NONE"
            , object ["y" .= minBound @Int32]
            , object ["x" .= String "oi2"]
            ]
          ])
      testCase
        "VectorOfUnions"
        (encode $ vectorOfUnions (Just Vec.empty) Vec.empty)
        (object ["xs" .= [] @Value, "xsReq" .= [] @Value])
      testCase
        "VectorOfUnions"
        (encode $ vectorOfUnions Nothing Vec.empty)
        (object ["xs" .= [] @Value, "xsReq" .= [] @Value])


testCase :: HasCallStack => String -> BSL.ByteString -> J.Value -> IO ()
testCase flatbufferName bs expectedJson = do
  man <- newManager defaultManagerSettings
  req <- parseRequest ("http://localhost:8080/" ++ flatbufferName)
  let req' = req {method = "POST", requestBody = RequestBodyLBS bs}
  rsp <- httpLbs req' man
  case statusCode $ responseStatus rsp of
    200 ->
      (PrettyJson <$> J.decode @J.Value (responseBody rsp)) `shouldBe`
      Just (PrettyJson expectedJson)
    _ -> expectationFailure ("Failed: " ++ BSLU.toString (responseBody rsp))