{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE TypeApplications #-}
module Hspec.Client where

import Control.Arrow (left)
import Control.Concurrent (ThreadId, forkIO, killThread)
import Control.Monad (Monad(..), when)
import Data.Bool
import Data.Either (Either(..))
import Data.Eq (Eq(..))
import Data.Function (($), (.))
import Data.Functor ((<$>))
import Data.Int (Int)
import Data.Map.Strict (Map)
import Data.Maybe (Maybe(..), fromJust)
import Data.Semigroup (Semigroup(..))
import Data.String (String)
import Data.Text (Text)
import Prelude (fromIntegral, (+))
import System.IO (IO)
import Test.Hspec
import Test.Hspec.Wai (liftIO)
import Test.Tasty
import Test.Tasty.Hspec
import Text.Read (readMaybe)
import Text.Show (Show(..))
import qualified Data.ByteString.Base64 as BS64
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Map.Strict as Map
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.Client as Client
import qualified Network.HTTP.Types as HTTP
import qualified Network.Socket as Net
import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp
import qualified Test.Hspec.Wai as Wai

import Symantic.HTTP

api = "auth"  </> basicAuth @User "realm"
              <.> get @() @PlainText

srv = server api $ route_auth
	where
	route_auth User{} (ServerRespond respond) =
		ServerResponse $ \_req res -> do
			res $ respond status200 [] ()

alice, carol :: User
alice = User "Alice" "pass" 19
carol = User "Carol" "pass" 31

-- * Type "User"
data User
 =   User
 {   user_name :: Text
 ,   user_pass :: Text
 ,   user_age  :: Int
 } deriving (Eq, Show)
instance ServerBasicAuth User where
	serverBasicAuth user pass =
		return $
			case Map.lookup user users of
			 Nothing -> BasicAuth_NoSuchUser
			 Just u@User{..}
			  | user_pass == pass -> BasicAuth_Authorized u
			  | otherwise -> BasicAuth_BadPassword

users :: Map Text User
users =
	Map.fromList $
	(\u -> (user_name u, u)) <$>
	[ alice
	, carol
	]

{-
instance ToJSON   User
instance ToForm   User
instance FromJSON User
instance FromForm User

instance Arbitrary User where
  arbitrary = User <$> arbitrary <*> arbitrary
-}

hspec :: IO [TestTree]
hspec = testSpecs $ describe "Client" $
	beforeAll (runTestServer srv) $
	afterAll killTestServer $ do
		describe "BasicAuth" $ do
			it "can authenticate" $ \TestServer{..} -> do
				runClient (clientConnection $ client api (user_name alice) (user_pass alice))
				 `shouldReturn` Right ()

-- * Type 'TestServer'
data TestServer = TestServer
 { thread    :: ThreadId
 , socket    :: Net.Socket
 , runClient :: forall a. ClientConnection a -> IO (Either ClientError a)
 }

runTestServer :: Wai.Application -> IO TestServer
runTestServer waiApp = do
	let baseURI = fromJust $ parseURI "http://localhost:8080"
	(port, socket) <- openTestSocket
	thread <- forkIO $
		Warp.runSettingsSocket
		 (Warp.setPort port $ Warp.defaultSettings)
		 socket waiApp
	manager <- Client.newManager Client.defaultManagerSettings
	let runClient = runClientConnection $ clientEnv manager baseURI
	return $ TestServer{..}

killTestServer :: TestServer -> IO ()
killTestServer TestServer{..} = do
	Net.close socket
	killThread thread

openTestSocket :: IO (Warp.Port, Net.Socket)
openTestSocket = do
	let host = Net.tupleToHostAddress (127, 0, 0, 1)
	let port = 8080
	sock <- Net.socket Net.AF_INET Net.Stream Net.defaultProtocol
	Net.setSocketOption sock Net.ReuseAddr 1
	Net.bind sock (Net.SockAddrInet port host)
	Net.listen sock 1000
	return (port, sock)