content: -- Intentionally /NOT/ enabling OverloadedStrings.
  -- This forces us to be precise about encoding issues.
  
  {-# LANGUAGE OverloadedLabels #-}
  
  module Test.Sanity.BrokenDeployments (tests) where
  
  import Control.Concurrent
  import Control.Exception
  import Data.ByteString.Char8 qualified as BS.Strict.Char8
  import Data.ByteString.UTF8 qualified as BS.Strict.UTF8
  import Data.IORef
  import Data.Text qualified as Text
  import Network.HTTP.Types qualified as HTTP
  import Test.Tasty
  import Test.Tasty.HUnit
  
  import Network.GRPC.Client qualified as Client
  import Network.GRPC.Client.StreamType.IO qualified as Client
  import Network.GRPC.Common
  import Network.GRPC.Common.Protobuf
  import Network.GRPC.Server.StreamType qualified as Server
  
  import Test.Driver.ClientServer
  import Test.Util.RawTestServer
  
  import Proto.API.Ping
  
  {-------------------------------------------------------------------------------
    Top-level
  -------------------------------------------------------------------------------}
  
  tests :: TestTree
  tests = testGroup "Test.Sanity.BrokenDeployments" [
        testGroup "status" [
            testCase "non200"     test_statusNon200
          , testCase "non200Body" test_statusNon200Body
          ]
      , testGroup "ContentType" [
            testCase "nonGrpcRegular"      test_nonGrpcContentTypeRegular
          , testCase "missingRegular"      test_missingContentTypeRegular
          , testCase "nonGrpcTrailersOnly" test_nonGrpcContentTypeTrailersOnly
          , testCase "missingTrailersOnly" test_missingContentTypeTrailersOnly
        ]
      , testGroup "Omit" [
           testCase "status"        test_omitStatus
         , testCase "statusMessage" test_omitStatusMessage
         , testCase "allTrailers"   test_omitAllTrailers
         ]
      , testGroup "Invalid" [
            testCase "statusMessage"   test_invalidStatusMessage
          , testCase "requestMetadata" test_invalidRequestMetadata
          , testCase "trailerMetadata" test_invalidTrailerMetadata
          ]
      , testGroup "Undefined" [
            testCase "output" test_undefinedOutput
          ]
      , testGroup "Timeout" [
            testCase "serverIgnoresTimeout" test_serverIgnoresTimeout
          ]
      ]
  
  connParams :: Client.ConnParams
  connParams = def {
        Client.connVerifyHeaders = True
      }
  
  {-------------------------------------------------------------------------------
    HTTP Status
  -------------------------------------------------------------------------------}
  
  -- | Test HTTP to gRPC status code mapping
  --
  -- We don't test all codes here; we'd just end up duplicating the logic in
  -- 'classifyServerResponse'. We just check one representative value.
  test_statusNon200 :: Assertion
  test_statusNon200 = respondWith response $ \addr -> do
      mResp :: Either GrpcException (Proto PongMessage) <- try $
        Client.withConnection connParams (Client.ServerInsecure addr) $ \conn ->
          Client.withRPC conn def (Proxy @Ping) $ \call -> do
            Client.sendFinalInput call defMessage
            fst <$> Client.recvFinalOutput call
      case mResp of
        Left err | grpcError err == GrpcInternal ->
          return ()
        _otherwise ->
          assertFailure $ "Unexpected response: " ++ show mResp
    where
      response :: Response
      response = def {
            responseStatus = HTTP.badRequest400
          }
  
  -- | Ensure that we include the response body for errors, if any
  test_statusNon200Body :: Assertion
  test_statusNon200Body = respondWith response $ \addr -> do
      mResp :: Either GrpcException (Proto PongMessage) <- try $
        Client.withConnection connParams (Client.ServerInsecure addr) $ \conn ->
          Client.withRPC conn def (Proxy @Ping) $ \call -> do
            Client.sendFinalInput call defMessage
            fst <$> Client.recvFinalOutput call
      case mResp of
        Left err
          | grpcError err == GrpcInternal
          , Just msg <- grpcErrorMessage err
          , Text.pack "Server supplied custom error" `Text.isInfixOf` msg ->
          return ()
        _otherwise ->
          assertFailure $ "Unexpected response: " ++ show mResp
    where
      response :: Response
      response = def {
            responseStatus = HTTP.badRequest400
          , responseBody   = BS.Strict.Char8.pack customError
          }
  
      customError :: String
      customError = "Server supplied custom error"
  
  {-------------------------------------------------------------------------------
    Content-type
  -------------------------------------------------------------------------------}
  
  test_invalidContentType :: Response -> Assertion
  test_invalidContentType response = respondWith response $ \addr -> do
      mResp <- try $
        Client.withConnection connParams (Client.ServerInsecure addr) $ \conn ->
          Client.withRPC conn def (Proxy @Ping) $ \call -> do
            Client.sendFinalInput call defMessage
            fst <$> Client.recvFinalOutput call
      case mResp of
        Left GrpcException{grpcError = GrpcUnknown} ->
          return ()
        _otherwise ->
          assertFailure $ "Unexpected response: " ++ show mResp
  
  test_nonGrpcContentTypeRegular :: Assertion
  test_nonGrpcContentTypeRegular = test_invalidContentType def {
        responseHeaders = [
            asciiHeader "content-type" "someInvalidContentType"
          ]
      }
  
  test_missingContentTypeRegular :: Assertion
  test_missingContentTypeRegular = test_invalidContentType def {
        responseHeaders = [ ]
      }
  
  test_nonGrpcContentTypeTrailersOnly :: Assertion
  test_nonGrpcContentTypeTrailersOnly = test_invalidContentType def {
        responseHeaders = [
            asciiHeader "grpc-status" "0"
          , asciiHeader "content-type" "someInvalidContentType"
          ]
      }
  
  test_missingContentTypeTrailersOnly :: Assertion
  test_missingContentTypeTrailersOnly = test_invalidContentType def {
        responseHeaders = [
            asciiHeader "grpc-status" "0"
          ]
      }
  
  {-------------------------------------------------------------------------------
    Omit trailers
  -------------------------------------------------------------------------------}
  
  test_omitStatus :: Assertion
  test_omitStatus = respondWith response $ \addr -> do
      mResp :: Either GrpcException
                      (StreamElem NoMetadata (Proto PongMessage)) <- try $
        Client.withConnection connParams (Client.ServerInsecure addr) $ \conn ->
          Client.withRPC conn def (Proxy @Ping) $ \call -> do
            Client.sendFinalInput call defMessage
            Client.recvOutput call
      case mResp of
        Left err
          | grpcError err == GrpcUnknown
          , grpcMessageContains err "grpc-status" ->
          return ()
        _otherwise ->
          assertFailure $ "Unexpected response: " ++ show mResp
    where
      response :: Response
      response = def {
            responseTrailers = [
                asciiHeader "grpc-message" "Message but no status"
              ]
          }
  
  test_omitStatusMessage :: Assertion
  test_omitStatusMessage = respondWith response $ \addr -> do
      mResp :: Either GrpcException
                      (StreamElem NoMetadata (Proto PongMessage)) <- try $
        Client.withConnection connParams (Client.ServerInsecure addr) $ \conn ->
          Client.withRPC conn def (Proxy @Ping) $ \call -> do
            Client.sendFinalInput call defMessage
            Client.recvOutput call
      case mResp of
        Right (NoMoreElems _) ->
          return ()
        _otherwise ->
          assertFailure $ "Unexpected response: " ++ show mResp
    where
      response :: Response
      response = def {
            responseTrailers = [
                asciiHeader "grpc-status" "0"
              ]
          }
  
  test_omitAllTrailers :: Assertion
  test_omitAllTrailers = respondWith response $ \addr -> do
      mResp :: Either GrpcException
                      (StreamElem NoMetadata (Proto PongMessage)) <- try $
        Client.withConnection connParams (Client.ServerInsecure addr) $ \conn ->
          Client.withRPC conn def (Proxy @Ping) $ \call -> do
            Client.sendFinalInput call defMessage
            Client.recvOutput call
      case mResp of
        Left err
          | grpcError err == GrpcUnknown
          , grpcMessageContains err "closed without trailers" ->
          return ()
        _otherwise ->
          assertFailure $ "Unexpected response: " ++ show mResp
    where
      response :: Response
      response = def {
            responseTrailers = []
          }
  
  {-------------------------------------------------------------------------------
    Invalid headers
  
    The gRPC spec mandates that we /MUST NOT/ throw away invalid headers. This
    is done as a matter of default for all headers in grapesy, except the ones
    that it really needs to operate. To access these invalid values, users do
    however need to use the low-level API.
  -------------------------------------------------------------------------------}
  
  test_invalidStatusMessage :: Assertion
  test_invalidStatusMessage = respondWith response $ \addr -> do
      mResp :: StreamElem
                 Client.ProperTrailers'
                 (InboundMeta, Proto PongMessage) <-
        Client.withConnection connParams (Client.ServerInsecure addr) $ \conn ->
          Client.withRPC conn def (Proxy @Ping) $ \call -> do
            Client.sendFinalInput call defMessage
            Client.recvOutputWithMeta call
      case mResp of
        NoMoreElems trailers
          | Left invalid <- Client.properTrailersGrpcMessage trailers
          , [ (_, headerValue) ] <- invalidHeaders invalid
          , headerValue == BS.Strict.Char8.pack someInvalidMessage
          ->
          return ()
        _otherwise ->
          assertFailure $ "Unexpected response: " ++ show mResp
    where
      response :: Response
      response = def {
            responseTrailers = [
                asciiHeader "grpc-status" "13" -- 'GrpcInternal'
              , asciiHeader "grpc-message" someInvalidMessage
              ]
          }
  
      someInvalidMessage :: String
      someInvalidMessage = "This is invalid: %X"
  
  test_invalidRequestMetadata :: Assertion
  test_invalidRequestMetadata = respondWith response $ \addr -> do
      mResp :: Either
                 (Client.TrailersOnly'    HandledSynthesized)
                 (Client.ResponseHeaders' HandledSynthesized) <-
        Client.withConnection connParams' (Client.ServerInsecure addr) $ \conn ->
          Client.withRPC conn def (Proxy @Ping) $ \call -> do
            Client.sendEndOfInput call
            Client.recvInitialResponse call
      case mResp of
        Right headers
          | Left invalid <- Client.responseUnrecognized headers
          , [ (_, headerValue) ] <- invalidHeaders invalid
          , headerValue == BS.Strict.UTF8.fromString someInvalidMetadata
          ->
          return ()
        _otherwise ->
          assertFailure $ "Unexpected response: " ++ show mResp
    where
      -- In this case we do /NOT/ want to verify all headers
      -- (the whole point is that we can access the invalid header value)
      connParams' :: Client.ConnParams
      connParams' = def { Client.connVerifyHeaders = False }
  
      response :: Response
      response = def {
            responseHeaders = [
                asciiHeader "content-type" "application/grpc"
              , utf8Header "some-custom-header" someInvalidMetadata
              ]
          }
  
      someInvalidMetadata :: String
      someInvalidMetadata = "This is invalid: 你好"
  
  test_invalidTrailerMetadata :: Assertion
  test_invalidTrailerMetadata = respondWith response $ \addr -> do
      mResp :: StreamElem
                 Client.ProperTrailers'
                 (InboundMeta, Proto PongMessage) <-
        Client.withConnection connParams (Client.ServerInsecure addr) $ \conn ->
          Client.withRPC conn def (Proxy @Ping) $ \call -> do
            Client.sendFinalInput call defMessage
            Client.recvOutputWithMeta call
      case mResp of
        NoMoreElems trailers
          | Left invalid <- Client.properTrailersUnrecognized trailers
          , [ (_, headerValue) ] <- invalidHeaders invalid
          , headerValue == BS.Strict.UTF8.fromString someInvalidMetadata
          ->
          return ()
        _otherwise ->
          assertFailure $ "Unexpected response: " ++ show mResp
    where
      response :: Response
      response = def {
            responseTrailers = [
                asciiHeader "grpc-status" "0"
              , utf8Header "some-custom-trailer" someInvalidMetadata
              ]
          }
  
      someInvalidMetadata :: String
      someInvalidMetadata = "This is invalid: 你好"
  
  grpcMessageContains :: GrpcException -> String -> Bool
  grpcMessageContains GrpcException{grpcErrorMessage} str =
      case grpcErrorMessage of
        Just msg -> Text.pack str `Text.isInfixOf` msg
        Nothing  -> False
  
  {-------------------------------------------------------------------------------
    Undefined values
  -------------------------------------------------------------------------------}
  
  test_undefinedOutput :: Assertion
  test_undefinedOutput = do
      st <- newIORef 0
      testClientServer $ ClientServerTest {
          config = def {
              isExpectedServerException = isDeliberateException
            }
        , server = [Server.fromMethod @Ping $ Server.mkNonStreaming (handler st)]
        , client = simpleTestClient $ \conn -> do
  
            -- The first time the handler is invoked, it attempts to enqueue a
            -- an undefined message (one containing a pure exception). Prior to
            -- #235 this would result in undefined behaviour, probably the server
            -- disconnecting. What should happen instead is that this exception
            -- is thrown in the handler, caught, sent to the client as a
            -- 'GrpcException', and re-raised in the client.
            mResp1 :: Either GrpcException (Proto PongMessage) <- try $
              Client.nonStreaming conn (Client.rpc @Ping) (defMessage & #id .~ 1)
            case mResp1 of
              Left err | Just msg <- grpcErrorMessage err ->
                assertBool "" $ Text.pack "uhoh" `Text.isInfixOf` msg
              _otherwise ->
                assertFailure "Unexpected response"
  
            -- Meanwhile, the server should just continue running; the /second/
            -- invocation of the handler should succeed normally.
            mResp2 :: Either GrpcException (Proto PongMessage) <- try $
              Client.nonStreaming conn (Client.rpc @Ping) (defMessage & #id .~ 2)
            case mResp2 of
              Right resp ->
                assertEqual "" 2 $ resp ^. #id
              _otherwise ->
                assertFailure "Unexpected response"
        }
    where
      -- Server handler attempts to enqueue an undefined message
      handler :: IORef Int -> Proto PingMessage -> IO (Proto PongMessage)
      handler st req = do
          isFirst <- atomicModifyIORef st $ \i -> (succ i, i == 0)
          if isFirst
            then return $ throw $ DeliberateException (userError "uhoh")
            else return $ defMessage & #id .~ req ^. #id
  
  {-------------------------------------------------------------------------------
    Timeouts
  -------------------------------------------------------------------------------}
  
  -- | Check that timeouts don't depend on the server
  --
  -- When a timeout is set for an RPC, the server should respect it, but the
  -- client should not /depend/ on the server respecting it.
  --
  -- See also <https://github.com/well-typed/grapesy/issues/221>.
  test_serverIgnoresTimeout :: Assertion
  test_serverIgnoresTimeout = respondWithIO response $ \addr -> do
      mResp :: Either GrpcException
                      (StreamElem NoMetadata (Proto PongMessage)) <- try $
        Client.withConnection connParams (Client.ServerInsecure addr) $ \conn ->
          Client.withRPC conn callParams (Proxy @Ping) $ \call -> do
            Client.sendFinalInput call defMessage
            Client.recvOutput call
      case mResp of
        Left e | grpcError e == GrpcDeadlineExceeded ->
          return ()
        Left e ->
          assertFailure $ "unexpected error: " ++ show e
        Right _ ->
          assertFailure "Timeout did not trigger"
    where
      response :: IO Response
      response = do
          threadDelay 10_000_000
          return def
  
      callParams :: Client.CallParams Ping
      callParams = def {
            Client.callTimeout = Just $
              Client.Timeout Client.Millisecond (Client.TimeoutValue 100)
          }
  
  