ClientSpec.hs

module HTTP.ClientSpec (tests) where

import Data.Char (isAsciiLower)
import Data.List (nub, sort)

import Test.Tasty
import Test.Tasty.HUnit

import qualified Network.HTTP.Client as HC

import HTTP.Client (UseDefaultHeaders(..), knownMethods, robustSettings)

tests :: TestTree
tests = testGroup "HTTP.Client"
  [ knownMethodsTests
  , useDefaultHeadersTests
  , robustSettingsTests
  ]

-- ---------------------------------------------------------------------------
-- knownMethods
-- ---------------------------------------------------------------------------

knownMethodsTests :: TestTree
knownMethodsTests = testGroup "knownMethods"
  [ testCase "contains GET" $
      elem "GET" knownMethods @?= True
  , testCase "contains HEAD" $
      elem "HEAD" knownMethods @?= True
  , testCase "contains POST" $
      elem "POST" knownMethods @?= True
  , testCase "contains PUT" $
      elem "PUT" knownMethods @?= True
  , testCase "contains DELETE" $
      elem "DELETE" knownMethods @?= True
  , testCase "contains TRACE" $
      elem "TRACE" knownMethods @?= True
  , testCase "contains OPTIONS" $
      elem "OPTIONS" knownMethods @?= True
  , testCase "contains CONNECT" $
      elem "CONNECT" knownMethods @?= True
  , testCase "contains PATCH" $
      elem "PATCH" knownMethods @?= True
  , testCase "has exactly 9 entries" $
      length knownMethods @?= 9
  , testCase "no duplicate methods" $
      nub knownMethods @?= knownMethods
  , testCase "all methods are non-empty strings" $
      (not . any null) knownMethods @?= True
  , testCase "all methods are uppercase" $
      not (any (\m -> map toUpper' m /= m) knownMethods) @?= True
  ]
  where
    toUpper' c
      | isAsciiLower c = toEnum (fromEnum c - 32)
      | otherwise             = c

-- ---------------------------------------------------------------------------
-- UseDefaultHeaders
-- ---------------------------------------------------------------------------

useDefaultHeadersTests :: TestTree
useDefaultHeadersTests = testGroup "UseDefaultHeaders"
  [ testCase "ReplaceDefaultHeaders == ReplaceDefaultHeaders" $
      ReplaceDefaultHeaders @?= ReplaceDefaultHeaders
  , testCase "AppendCustomToDefaultHeaders == AppendCustomToDefaultHeaders" $
      AppendCustomToDefaultHeaders @?= AppendCustomToDefaultHeaders
  , testCase "ReplaceDefaultHeaders /= AppendCustomToDefaultHeaders" $
      (ReplaceDefaultHeaders == AppendCustomToDefaultHeaders) @?= False
  , testCase "Ord: ReplaceDefaultHeaders < AppendCustomToDefaultHeaders" $
      (ReplaceDefaultHeaders < AppendCustomToDefaultHeaders) @?= True
  , testCase "Show ReplaceDefaultHeaders" $
      show ReplaceDefaultHeaders @?= "ReplaceDefaultHeaders"
  , testCase "Show AppendCustomToDefaultHeaders" $
      show AppendCustomToDefaultHeaders @?= "AppendCustomToDefaultHeaders"
  , testCase "Read . Show roundtrip for ReplaceDefaultHeaders" $
      (read (show ReplaceDefaultHeaders) :: UseDefaultHeaders) @?= ReplaceDefaultHeaders
  , testCase "Read . Show roundtrip for AppendCustomToDefaultHeaders" $
      (read (show AppendCustomToDefaultHeaders) :: UseDefaultHeaders) @?= AppendCustomToDefaultHeaders
  , testCase "Enum: minBound is ReplaceDefaultHeaders" $
      (minBound :: UseDefaultHeaders) @?= ReplaceDefaultHeaders
  , testCase "Enum: maxBound is AppendCustomToDefaultHeaders" $
      (maxBound :: UseDefaultHeaders) @?= AppendCustomToDefaultHeaders
  , testCase "Enum: [minBound..maxBound] has 2 elements" $
      length [minBound .. maxBound :: UseDefaultHeaders] @?= 2
  , testCase "Enum: sorted [minBound..maxBound] equals [minBound..maxBound]" $
      sort [minBound .. maxBound :: UseDefaultHeaders]
        @?= [minBound .. maxBound]
  , testCase "Enum: fromEnum ReplaceDefaultHeaders == 0" $
      fromEnum ReplaceDefaultHeaders @?= 0
  , testCase "Enum: fromEnum AppendCustomToDefaultHeaders == 1" $
      fromEnum AppendCustomToDefaultHeaders @?= 1
  , testCase "Enum: succ ReplaceDefaultHeaders == AppendCustomToDefaultHeaders" $
      succ ReplaceDefaultHeaders @?= AppendCustomToDefaultHeaders
  , testCase "Enum: pred AppendCustomToDefaultHeaders == ReplaceDefaultHeaders" $
      pred AppendCustomToDefaultHeaders @?= ReplaceDefaultHeaders
  ]

-- ---------------------------------------------------------------------------
-- robustSettings
-- ---------------------------------------------------------------------------

robustSettingsTests :: TestTree
robustSettingsTests = testGroup "robustSettings"
  [ testCase "can create a manager from robustSettings without error" $ do
      _mgr <- HC.newManager robustSettings
      pure ()
  ]