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

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

import AuthCode
import User

import Control.Concurrent
import Control.Concurrent.STM.TVar (newTVarIO)
import Control.Exception (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader

import Data.Aeson
import Data.List (find)
import Data.Text hiding (elem, find, head, map, words)
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


type AuthHandler = ReaderT AuthState Handler
type AuthServer a = ServerT a AuthHandler

toHandler :: AuthState -> AuthHandler a -> Handler a
toHandler s h = runReaderT h s

authServer :: forall user userData . UserData user userData => AuthServer (Auth user userData)
authServer = handleAuth
  where
    handleAuth :: user
               -> QScope
               -> QClient
               -> QResType
               -> QRedirect
               -> AuthHandler userData
    handleAuth u scopes client responseType url = do
      unless (pack client `elem` trustedClients) . -- TODO fetch trusted clients from db | TODO also check if the redirect url really belongs to the client
        throwError $ err404 { errBody = "Not a trusted client."}
      let
        scopes' = map (readScope @user @userData) $ words scopes
        uData = mconcat $ map (userScope @user @userData u) scopes'
        responseType' = read @ResponseType responseType
      mAuthCode <- asks (genUnencryptedCode client url 600) >>= liftIO
      liftIO $ print mAuthCode
      liftIO . putStrLn $ "user: " ++ show u ++ " | scopes: " ++ show (map (showScope @user @userData) scopes')
      return uData

exampleAuthServer :: AuthServer (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] -> AuthState -> Application
insecureOAuthMock' testUsers s = serveWithContext authAPI c $ hoistServerWithContext authAPI p (toHandler s) exampleAuthServer
  where
    c = authenticate testUsers :. EmptyContext
    p = Proxy :: Proxy '[BasicAuthCheck User]

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 = do
  state <- newTVarIO $ State { activeCodes = Map.empty }
  run port $ insecureOAuthMock' testUsers state

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

tokenEndpoint :: Server Token
tokenEndpoint = undefined