{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Hspec.Router.Error where

import Control.Monad (Monad(..), when)
import Data.Either (Either(..))
import Data.Eq (Eq(..))
import Data.Function (($), (.))
import Data.Int (Int)
import Data.Maybe (Maybe(..))
import Data.Semigroup (Semigroup(..))
import System.IO (IO)
import Test.Hspec
import Test.Hspec.Wai
import Test.Tasty
import Test.Tasty
import Test.Tasty.Hspec
import Text.Read (readMaybe)
import Text.Show (Show(..))
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import qualified Network.HTTP.Types as HTTP
import qualified Network.Wai.Handler.Warp as Warp

import Symantic.HTTP

api = segment "good"
  <.> capture @Int "i"
  <.> queryParams @Int "param"
  <.> body @PlainText @Int
  <.> response @PlainText @Int HTTP.methodPost

rtr = routerAPI api $ route_good
	where
	route_good i params (RouterBodyArg b) (RouterResponseArg respond) =
		RouterResponse $ \_req res -> do
			res $ respond status200 [] i

srv :: IO ()
srv = Warp.run 8080 rtr

instance MimeSerialize PlainText Int where
	mimeSerialize _mt = BSL.fromStrict . Text.encodeUtf8 . Text.pack . show
instance MimeUnserialize PlainText Int where
	mimeUnserialize _mt s =
		case readMaybe $ TL.unpack $ TL.decodeUtf8 s of
		 Just n -> Right n
		 _ -> Left "cannot parse Int"

hspec =
	testSpec "Error order" $
		with (return rtr) $ do
			it "has 404 as its highest priority error (path)" $ do
				request badMethod badURI [badAuth, badAccept, badContentType] badBody
				`shouldRespondWith` 404
			it "has 405 as its second highest priority error (method)" $ do
				request badMethod badParam [badAuth, badAccept, badContentType] badBody
				`shouldRespondWith` 405
			it "has 401 as its third highest priority error (auth)" $ do
				request goodMethod badParam [badAuth, badAccept, badContentType] badBody
				`shouldRespondWith` 401
			it "has 406 as its fourth highest priority error (accept)" $ do
				request goodMethod badParam [goodAuth, badAccept, badContentType] badBody
				`shouldRespondWith` 406
			it "has 415 as its fifth highest priority error (content type)" $ do
				request goodMethod badParam [goodAuth, goodAccept, badContentType] badBody
				`shouldRespondWith` 415
			it "has 400 as its sixth highest priority error (query and body)" $ do
				let goodHeaders = [goodAuth, goodAccept, goodContentType]
				badParamsRes <- request goodMethod badParam goodHeaders goodBody
				badBodyRes   <- request goodMethod goodURI  goodHeaders badBody
				
				-- Both bad body and bad params result in 400
				return badParamsRes `shouldRespondWith` 400
				return badBodyRes   `shouldRespondWith` 400
				
				-- Param check should occur before body checks
				badBothRes <- request goodMethod badParam
				 [goodAuth, goodAccept, goodContentType] badBody
				when (badBothRes /= badParamsRes) $ liftIO $
					expectationFailure $ "badParam + badBody /= badParam: "
					 <> show badBothRes <> ", " <> show badParamsRes
				when (badBothRes == badBodyRes) $ liftIO $
					expectationFailure $ "badParam + badBody == badBody: "
					 <> show badBothRes


badContentType  = (HTTP.hContentType, "application/json")
badAccept       = (HTTP.hAccept, "application/json")
badMethod       = HTTP.methodGet
badURI          = "bad"
badBody         = "bad"
badAuth         = (HTTP.hAuthorization, "Basic foofoofoo")
goodContentType = (HTTP.hContentType, "text/plain;charset=utf-8")
goodAccept      = (HTTP.hAccept, "text/plain")
goodMethod      = HTTP.methodPost
goodPath        = "good/4"
goodURI         = goodPath<>"?param=2"
badParam        = goodPath<>"?param=foo"
goodBody        = "42" -- {-encode-} (42::Int)
-- username:password = user:pass
-- goodAuth        = (HTTP.hAuthorization, "Basic XXXXXXXXXXXXXXXXXXX=")