http-exchange-0.1.1.0: test/Main.hs

{-# language DuplicateRecordFields #-}
{-# language OverloadedStrings #-}

import Test.Tasty (TestTree,testGroup,defaultMain)
import Test.Tasty.HUnit (testCase,(@=?))
import Data.Bytes (Bytes)
import Http.Request (Request(Request),RequestLine(RequestLine))
import Http.Types (Response, Bodied(Bodied), Header(Header))
import OkChannel (M(M))
import Data.Bytes.Chunks (Chunks(ChunksCons,ChunksNil))

import qualified Data.Bytes as Bytes
import qualified Data.Bytes.Chunks as Chunks
import qualified GHC.Exts as Exts
import qualified OkExchange as E
import qualified Http.Header
import qualified Http.Headers as Headers
import qualified Http.Bodied
import qualified Http.Request as Request
import qualified Data.Bytes.Text.Ascii as Ascii

main :: IO ()
main = defaultMain tests

tests :: TestTree
tests = testGroup "tests"
  [ testCase "get-a" $ do
      (input,output,Bodied{body}) <- evaluateM (E.exchange () getReqA) (Chunks.fromBytes getRespA)
      body @=? ChunksNil
      input @=? mempty
      output @=? Chunks.concat (Request.bodiedToChunks getReqA)
  , testCase "get-chunked-a" $ do
      (input,output,Bodied{body}) <- evaluateM (E.exchange () getReqA) (Chunks.fromBytes getRespChunkedA)
      body @=? ChunksNil
      input @=? mempty
      output @=? Chunks.concat (Request.bodiedToChunks getReqA)
  , testCase "get-chunked-byte-by-byte-a" $ do
      (input,output,Bodied{body}) <- evaluateM (E.exchange () getReqA) (bytesToSingleByteChunks getRespChunkedA)
      body @=? ChunksNil
      input @=? mempty
      output @=? Chunks.concat (Request.bodiedToChunks getReqA)
  , testCase "get-body-a" $ do
      (input,output,Bodied{body}) <- evaluateM (E.exchange () getReqA) (Chunks.fromBytes getRespBodyA)
      input @=? mempty
      body @=? ChunksCons (Ascii.fromString "helloworld") ChunksNil
      output @=? Chunks.concat (Request.bodiedToChunks getReqA)
  , testCase "get-chunked-b" $ do
      (input,output,Bodied{body}) <- evaluateM (E.exchange () getReqA) (Chunks.fromBytes getRespChunkedB)
      Ascii.fromString "hello to my friends." @=? Chunks.concat body
      mempty @=? input
      Chunks.concat (Request.bodiedToChunks getReqA) @=? output
  , testCase "get-chunked-byte-by-byte-b" $ do
      (input,output,Bodied{body}) <- evaluateM (E.exchange () getReqA) (bytesToSingleByteChunks getRespChunkedB)
      Ascii.fromString "hello to my friends." @=? Chunks.concat body
      mempty @=? input
      Chunks.concat (Request.bodiedToChunks getReqA) @=? output
  , testCase "get-chunked-two-by-two-b" $ do
      (input,output,Bodied{body}) <- evaluateM (E.exchange () getReqA) (bytesToDoubletonByteChunks getRespChunkedB)
      Ascii.fromString "hello to my friends." @=? Chunks.concat body
      mempty @=? input
      Chunks.concat (Request.bodiedToChunks getReqA) @=? output
  ]

bytesToSingleByteChunks :: Bytes -> Chunks
bytesToSingleByteChunks = Bytes.foldr'
  (\w acc -> ChunksCons (Bytes.singleton w) acc
  ) ChunksNil

bytesToDoubletonByteChunks :: Bytes -> Chunks
bytesToDoubletonByteChunks b0 = go (Exts.toList b0)
  where
  go (x : y : zs) = ChunksCons (Exts.fromList [x,y]) (go zs)
  go [x] = ChunksCons (Bytes.singleton x) ChunksNil
  go [] = ChunksNil

evaluateM ::
     M (Either E.Exception (Bodied Response))
  -> Chunks -- prebuilt response
  -> IO (Chunks,Bytes,Bodied Response)
evaluateM (M f) resp = case f resp mempty of
  (input,output,r) -> case r of
    Left e -> case e of
      E.Http err -> fail ("exchange http protocol failure: " ++ show err)
      E.Receive err -> fail ("exchange http transport receive failure: " ++ show err)
    Right b -> pure (input,output,b)

getReqA :: Bodied Request
getReqA = Bodied
  { metadata = Request
    { requestLine=RequestLine
      { method = "GET"
      , path = "/health"
      }
    , headers = Headers.fromArray $ Exts.fromList
      [ Header{name="Host",value="example.com"}
      ]
    }
  , body = mempty
  }

getRespA :: Bytes
getRespA = Ascii.fromString
  "HTTP/1.1 200 OK\r\n\
  \Server: testsuite/1.2.3\r\n\
  \Content-Type: text/plain\r\n\r\n"

getRespBodyA :: Bytes
getRespBodyA = Ascii.fromString
  "HTTP/1.1 200 OK\r\n\
  \Server: testsuite/1.2.3\r\n\
  \Content-Type: text/plain\r\n\
  \Content-Length: 10\r\n\r\n\
  \helloworld"

getRespChunkedA :: Bytes
getRespChunkedA = Ascii.fromString
  "HTTP/1.1 200 OK\r\n\
  \Server: testsuite/1.2.3\r\n\
  \Transfer-Encoding: chunked\r\n\
  \Content-Type: text/plain\r\n\r\n\
  \0\r\n\r\n"

getRespChunkedB :: Bytes
getRespChunkedB = Ascii.fromString
  "HTTP/1.1 200 OK\r\n\
  \Server: testsuite/1.2.3\r\n\
  \Transfer-Encoding: chunked\r\n\
  \Content-Type: text/plain\r\n\r\n\
  \5\r\nhello\r\n\
  \f\r\n to my friends.\r\n\
  \0\r\n\r\n"