{-# LANGUAGE DataKinds, TypeOperators, OverloadedStrings, ScopedTypeVariables, TypeApplications #-}

module Server
( insecureOAuthMock'
, runMockServer
, runMockServer'
) where

import User

import Control.Concurrent
import Control.Exception (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class

import Data.Aeson
import Data.List (find)
import Data.Text hiding (elem, find, head, map)
import Data.Text.Encoding (decodeUtf8)

import qualified Data.Map.Strict as Map

import Network.HTTP.Client (newManager, defaultManagerSettings)
import Network.Wai.Handler.Warp

import Servant
import Servant.Client
import Servant.API

import Text.ParserCombinators.ReadPrec (look)
import Text.Read (readPrec)


testUsers :: [User] -- TODO move to db
testUsers =
  [ User {name = "Fallback User", email = "foo@bar.com", password = "0000", uID = "0"}
  , User {name = "Tina Tester", email = "t@t.tt", password = "1111", uID = "1"}
  , User {name = "Max Muster", email = "m@m.mm", password = "2222", uID = "2"}]

trustedClients :: [Text] -- TODO move to db
trustedClients = ["42"]

data ResponseType = Code -- ^ authorisation code grant
                  | Token -- ^ implicit grant via access token
                  | IDToken -- ^ implicit grant via access token & ID token
                  deriving (Eq, Show)
instance Read ResponseType where
  readPrec = look >>= \str -> return $ case str of
    "code" -> Code
    "token" -> Token
    "id_token" -> IDToken

type QScope    = String
type QClient   = String
type QResType  = String
type QRedirect = String

type QParam = QueryParam' [Required, Strict]

type Auth user userData = BasicAuth "login" user
                       :> "auth"
                       :> QParam "scope" QScope
                       :> QParam "client_id" QClient
                       :> QParam "response_type" QResType
                       :> QParam "redirect_uri" QRedirect
                       :> Get '[JSON] userData

type Token = "token" :> Post '[JSON] Text -- TODO post jwt token
-- type Insert = "insert" :> Post '[JSON] User

authServer :: forall user userData . UserData user userData => Server (Auth user userData)
authServer = handleAuth
  where
    handleAuth :: user
               -> QScope
               -> QClient
               -> QResType
               -> QRedirect
               -> Handler userData
    handleAuth u scopes client responseType url = do
      unless (pack client `elem` trustedClients) . -- TODO fetch trusted clients from db
        throwError $ err404 { errBody = "Not a trusted client."}
      let
        scopes' = readScopes @user @userData scopes
        uData = mconcat $ map (userScope @user @userData u) scopes'
        responseType' = read @ResponseType responseType

      liftIO (putStrLn $ "user: " ++ show u ++ " | scopes: " ++ showScopes @user @userData scopes')
      return uData

exampleAuthServer :: Server (Auth User (Map.Map Text Text))
exampleAuthServer = authServer

authAPI :: Proxy (Auth User (Map.Map Text Text))
authAPI = Proxy

-- insecureOAuthMock :: Application
-- insecureOAuthMock = authAPI `serve` exampleAuthServer

insecureOAuthMock' :: [User] -> Application
insecureOAuthMock' testUsers = serveWithContext authAPI c exampleAuthServer
  where c = authenticate testUsers :. EmptyContext

authenticate :: [User] -> BasicAuthCheck User
authenticate users = BasicAuthCheck $ \authData -> do
  let
    (uEmail, uPass) = (,) <$> (decodeUtf8 . basicAuthUsername) <*> (decodeUtf8 . basicAuthPassword) $ authData
  case (find (\u -> email u == uEmail) users) of
    Nothing -> return NoSuchUser
    Just u  -> return $ if uPass == password u then Authorized u else BadPassword

frontend :: BasicAuthData -> ClientM (Map.Map Text Text)
frontend ba = client authAPI ba "[ID]" "42" "code" ""

runMockServer :: Int -> IO ()
runMockServer port = run port $ insecureOAuthMock' testUsers

runMockServer' :: Int -> IO ()
runMockServer' port = do
  mgr <- newManager defaultManagerSettings
  bracket (forkIO . run port $ insecureOAuthMock' testUsers) killThread $ \_ ->
    runClientM (frontend $ BasicAuthData "foo@bar.com" "0000") (mkClientEnv mgr (BaseUrl Http "localhost" port ""))
      >>= print
  

tokenEndpoint :: Server Token
tokenEndpoint = undefined