{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Hspec.Server.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 Prelude ((+))
import System.IO (IO)
import Test.Hspec
import Test.Tasty
import Test.Tasty
import Test.Tasty.Hspec
import Test.Hspec.Wai (liftIO)
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 qualified Test.Hspec.Wai as Wai

import Symantic.HTTP

api = "good" </> "path"
             </> capture @Int "i"
             <.> queryParams @Int "param"
             <.> body @Int @PlainText
             <.> post @Int @PlainText

srv = server api $ route_good
	where
	route_good i params (ServerBodyArg b) (ServerResponseArg respond) =
		ServerResponse $ \_req res -> do
			res $ respond status200 [] (i+b)

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

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

hspec = testSpecs $ describe "Error" $ Wai.with (return srv) $ do
	describe "Path" $ do
		it "checks shorter path" $ do
			Wai.get "/good"
			 `Wai.shouldRespondWith` 404
		it "checks longer path" $ do
			Wai.get "/good/path/bad"
			 `Wai.shouldRespondWith` 404
	describe "Priorities" $ do
		it "has 404 as its highest priority error (path)" $ do
			Wai.request badMethod badURI [badAuth, badAccept, badContentType] badBody
			`Wai.shouldRespondWith` 404
		it "has 405 as its second highest priority error (method)" $ do
			Wai.request badMethod badParam [badAuth, badAccept, badContentType] badBody
			`Wai.shouldRespondWith` 405
		it "has 401 as its third highest priority error (auth)" $ do
			Wai.request goodMethod badParam [badAuth, badAccept, badContentType] badBody
			`Wai.shouldRespondWith` 401
		it "has 406 as its fourth highest priority error (accept)" $ do
			Wai.request goodMethod badParam [goodAuth, badAccept, badContentType] badBody
			`Wai.shouldRespondWith` 406
		it "has 415 as its fifth highest priority error (content type)" $ do
			Wai.request goodMethod badParam [goodAuth, goodAccept, badContentType] badBody
			`Wai.shouldRespondWith` 415
		it "has 400 as its sixth highest priority error (query and body)" $ do
			let goodHeaders = [goodAuth, goodAccept, goodContentType]
			badParamsRes <- Wai.request goodMethod badParam goodHeaders goodBody
			badBodyRes   <- Wai.request goodMethod goodURI  goodHeaders badBody
			
			-- Both bad body and bad params result in 400
			return badParamsRes `Wai.shouldRespondWith` 400
			return badBodyRes   `Wai.shouldRespondWith` 400
			
			-- Param check should occur before body checks
			badBothRes <- Wai.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/path/4"
goodURI         = goodPath<>"?param=2"
badParam        = goodPath<>"?param=foo"
goodBody        = "42" -- {-encode-} (42::Int)
-- username:password = user:pass
goodAuth        = (HTTP.hAuthorization, "Basic XXXXXXXXXXXXXXXXXXX=")