ErrorsSpec.hs

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module HStratus.Http.ErrorsSpec
  ( spec
  )
where

import Control.Exception (throwIO, try)
import Data.Aeson (Value (..), decode, encode, object)
import Data.Aeson.Key (fromText)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Maybe (catMaybes)
import Data.Text (Text)
import qualified HStratus.Examples as Examples
import Network.HStratus.Internal.HttpErrors
  ( ApiError (..)
  , ApiResponse (..)
  , AuthError (..)
  , extractOr
  )
import Test.Hspec (Spec, context, describe, it, shouldBe, shouldReturn)
import Test.Hspec.Benri (endsLeft, endsRight)
import Test.QuickCheck
  ( Gen
  , Property
  , elements
  , forAll
  , frequency
  )


spec :: Spec
spec = describe "module Network.HStratus.Http.Error" $ do
  apiErrorSpec
  authErrorSpec


apiErrorSpec :: Spec
apiErrorSpec = describe "ApiError" $ do
  context "parsing it from JSON" $ do
    it "should succeed" prop_parseJSONApiError


prop_parseJSONApiError :: Property
prop_parseJSONApiError = forAll genApiErrorWithJsonEncoding $ \(encoded, ae) ->
  decode (BS.fromStrict encoded) == Just ae


genApiErrorWithJsonEncoding :: Gen (ByteString, ApiError)
genApiErrorWithJsonEncoding = do
  reasonKV <- genKeyValue $ elements Examples.errorKeys
  mbCodeKV <- genKeyValueMb $ elements Examples.codeKeys
  let ae =
        ApiError
          { aeReason = snd reasonKV
          , aeCode = snd <$> mbCodeKV
          }
      asKV (x, y) = (fromText x, String y)
      objectParts = catMaybes [Just reasonKV, mbCodeKV]
      encoded = BS.toStrict $ encode $ object $ map asKV objectParts
  pure (encoded, ae)


{- |
generate a value or Nothing as the value of field
when there is a value, generate the value of the key
-}
genKeyValueMb :: Gen Text -> Gen (Maybe (Text, Text))
genKeyValueMb keyGen = do
  valueMb <-
    frequency
      [ (1, Just <$> elements Examples.wordz)
      , (2, pure Nothing)
      ]
  case valueMb of
    Nothing -> pure Nothing
    Just x -> do
      key <- keyGen
      pure (Just (key, x))


genKeyValue :: Gen Text -> Gen (Text, Text)
genKeyValue keyGen = do
  value <- elements Examples.wordz
  key <- keyGen
  pure (key, value)


authErrorSpec :: Spec
authErrorSpec = describe "AuthError" $ do
  context "is catchable with try @AuthError" $ do
    it "catches InvalidCredentials" $
      catchAuthError InvalidCredentials `endsLeft` InvalidCredentials
    it "catches AccountLocked" $
      catchAuthError AccountLocked `endsLeft` AccountLocked
    it "catches PrivacyAgreementRequired" $
      catchAuthError PrivacyAgreementRequired `endsLeft` PrivacyAgreementRequired
    it "catches ServiceError" $
      catchAuthError (ServiceError "reason" (Just "code")) `endsLeft` ServiceError "reason" (Just "code")
    it "catches UnexpectedResponse" $
      catchAuthError (UnexpectedResponse "oops") `endsLeft` UnexpectedResponse "oops"

  context "extractOr on a Failed ApiResponse" $ do
    it "throws ServiceError with the ApiError reason and code" $
      catchAuthError' (extractOr (Failed (ApiError "bad" (Just "E1"))))
        `endsRight` ServiceError "bad" (Just "E1")

  context "extractOr on a Succeeded ApiResponse" $ do
    it "returns the wrapped value" $
      extractOr (Succeeded (42 :: Int)) `shouldReturn` 42

  context "ApiResponse FromJSON" $ do
    it "parses a success body as Succeeded" $
      (decode "{\"length\":6}" :: Maybe (ApiResponse Value))
        `shouldBe` Just (Succeeded (object [("length", Number 6)]))
    it "parses an error body as Failed" $
      (decode "{\"errorMessage\":\"oops\"}" :: Maybe (ApiResponse Value))
        `shouldBe` Just (Failed (ApiError "oops" Nothing))


catchAuthError :: AuthError -> IO (Either AuthError AuthError)
catchAuthError e = try (throwIO e)


catchAuthError' :: IO a -> IO (Either AuthError AuthError)
catchAuthError' action =
  try action >>= \case
    Left e -> pure (Right e)
    Right _ -> pure (Left (UnexpectedResponse "expected AuthError but got success"))