{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hspec.API where

import Control.Applicative (Applicative(..))
import Control.Monad (Monad(..))
import Data.Bool
import Data.Either (Either(..))
import Data.Function (($), (.))
import Data.Functor ((<$>))
import Data.Int (Int)
import Data.Maybe (Maybe(..))
import Data.Proxy (Proxy(..))
import Data.Semigroup (Semigroup(..))
import Data.String (IsString(..))
import Prelude (error, (+), (*))
import System.IO (IO)
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 Data.Time as Time
import qualified Network.HTTP.Client as Client
import qualified Network.HTTP.Media as Media
import qualified Network.HTTP.Types as HTTP
import qualified Network.URI as URI
import qualified Network.Wai.Handler.Warp as Warp
import qualified Test.Hspec.Wai as Wai
import qualified Web.HttpApiData as Web

import Test.Hspec
import Test.Tasty
import Test.Tasty.Hspec

import Symantic.HTTP

-- * Type 'API0'
data API0
 =   API0_Date Time.Day
 |   API0_Time Time.ZonedTime
 |   API0_Reset Bool
 deriving (Show)
instance IsString Time.TimeZone where
	fromString s = case s of
	 "CET"  -> Time.TimeZone (1*60) False "CET"
	 "CEST" -> Time.TimeZone (2*60) False "CEST"
	 _ -> error "unknown TimeZone"
instance Web.FromHttpApiData Time.TimeZone where
	parseUrlPiece = \case
	 "CET"  -> Right $ Time.TimeZone (1*60) True  "CET"
	 "CEST" -> Right $ Time.TimeZone (2*60) False "CEST"
	 _ -> Left "unknown TimeZone"
instance Web.ToHttpApiData Time.TimeZone where
	toUrlPiece (Time.TimeZone _s _b n) = Text.pack n

manager :: IO Client.Manager
manager = Client.newManager Client.defaultManagerSettings
Just baseURI = URI.parseURI "http://localhost:8080"
cliEnv = clientEnv <$> manager <*> pure baseURI

api1
 =   "time" </> capture @Time.TimeZone "timezone"
            <.> get @TL.Text @'[PlainText]

 <!> "date" </> get @TL.Text @'[PlainText]
 
 <!> "echo" </> captureAll
            <.> get @TL.Text @'[PlainText]
 
 <!> "succ" </> capture @Int "n"
            <.> get @Int @'[PlainText]
 
 <!> "info" </> (  head @TL.Text @'[PlainText]
               <!> get  @TL.Text @'[PlainText]
                )

instance MimeEncodable Int PlainText where
	mimeEncode _mt = BSL.fromStrict . Text.encodeUtf8 . Text.pack . show
instance MimeDecodable Int PlainText where
	mimeDecode _mt s =
		case readMaybe $ TL.unpack $ TL.decodeUtf8 s of
		 Just n -> Right n
		 _ -> Left "cannot parse Int"

-- lay1 = layout api1

(api1_time :!:
 api1_date :!:
 api1_echo :!:
 api1_succ :!:
 (api1_info_head :!:
  api1_info_get)
 ) = client api1

srv1 = server api1 $
	route_time :!:
	route_date :!:
	route_echo :!:
	route_succ :!:
	route_info
	where
	route_time tz (ServerRespond respond) =
		ServerResponse $ \_req res -> do
			time <- Time.utcToZonedTime tz <$> Time.getCurrentTime
			res $ respond status200 [] $
				TL.pack $ show time <> "\n"
	
	route_date (ServerRespond respond) =
		ServerResponse $ \_req res -> do
			date <- Time.utctDay <$> Time.getCurrentTime
			res $ respond status200 [] $
				TL.pack $ show date <> "\n"
	
	route_echo path (ServerRespond respond) =
		ServerResponse $ \_req res -> do
			res $ respond status200 [] $ TL.pack $ show path <> "\n"
	
	route_succ n (ServerRespond respond) =
		ServerResponse $ \_req res -> do
			res $ respond status200 [] $ n+1
	
	route_info = route_head :!: route_get
		where
		route_head (ServerRespond respond) =
			ServerResponse $ \req res -> do
				res $ respond (HTTP.mkStatus 201 "") [] $ TL.pack $ show req <> "\n"
		
		route_get (ServerRespond respond) =
			ServerResponse $ \req res -> do
				res $ respond status200 [] $ TL.pack $ show req <> "\n"

warp1 :: IO ()
warp1 = Warp.run 8080 srv1

api2 = "ti"</>"me" </> get @TL.Text @'[PlainText]
   <!> "auth"      </> basicAuth @User "realm"
                   <.> get @TL.Text @'[PlainText]
   <!> "da"</>"te" </> get @TL.Text @'[PlainText]

data User = User
 deriving (Show)
instance ServerBasicAuth User where
	serverBasicAuth user pass =
		return $ BasicAuth_Authorized User

srv2 = server api2 $
	    route_time
	:!: route_auth
	:!: route_date
	where
	route_time (ServerRespond respond) =
		ServerResponse $ \_req res -> do
			time <- Time.getCurrentTime
			res $ respond status200 [] $
				TL.pack $ show time <> "\n"
	
	route_date (ServerRespond respond) =
		ServerResponse $ \_req res -> do
			date <- Time.utctDay <$> Time.getCurrentTime
			res $ respond status200 [] $
				TL.pack $ show date <> "\n"
	
	route_auth User (ServerRespond respond) =
			ServerResponse $ \_req res -> do
				res $ respond status200 [] $
					TL.pack $ show User <> "\n"

warp2 :: IO ()
warp2 = Warp.run 8080 srv2

hspec =
	testSpecs $
	Wai.with (return srv2) $ do
		it "respond with success" $ do
			Wai.get "/da/te"
			 `Wai.shouldRespondWith` 200
		it "checks Accept header" $ do
			Wai.request HTTP.methodGet "/da/te"
			 [ (HTTP.hAccept, Media.renderHeader $ mediaType $ Proxy @OctetStream)
			 ] ""
			 `Wai.shouldRespondWith` 406