-- SPDX-FileCopyrightText: 2024 UniWorX Systems
-- SPDX-FileContributor: David Mosbach <david.mosbach@uniworx.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-# Language DataKinds, TypeOperators, OverloadedStrings, LambdaCase, TypeApplications, QuasiQuotes #-}

module SSO (CustomRoutes, customRoutes) where

import Prelude hiding (head)

import UniWorX
import Server
import User
import LoginForm

import Control.Monad.IO.Class (liftIO)

import Data.Map (Map, empty)
import Data.Maybe (fromMaybe)
import Data.String (IsString(..))
import Data.Text (Text, splitOn)
import Data.Text.Encoding (encodeUtf8)
import Data.Text.Encoding.Base64
import qualified Data.String.Interpolate as I

import Database.Persist (Entity(..))

import Servant
import Servant.API

import Text.Blaze.Html5
import qualified Text.Blaze.Html5.Attributes as A

import Web.Cookie (parseCookiesText)


type CustomRoutes = Login :<|> SSOTest

customRoutes = login :<|> routes

type Login = "login"
          :> QueryParam' [Strict, Required] "redirect" Text
          :> Header' [Strict, Required] "Authorization" Text
          :> Verb 'GET 303 '[HTML] (Headers '[ Header "Set-Cookie" Text
                                             , Header "Location" Text
                                             ] Html)

login :: AuthServer (Entity User) Login
login redirect creds = addHeader (authCookie <> "=\"" <> creds <> "\"") . addHeader redirect <$> do
  liftIO . putStrLn $ "\nREDIRECT: " ++ show redirect
  (liftIO . getUser $ Just creds) >>= \case
    Just user -> return mempty
    Nothing -> throwError err500 { errBody = "Unknown user" }

successMsg :: Html
successMsg = do
  head $ do
    meta ! A.charset "UTF-8"
    meta ! A.name "viewport" ! A.content "width=device-width, initial-scale=1.0"
    title "Success"
  body $ do
    h1 "OIDC SSO Test"
    p "Login successful."


getUser :: Maybe Text -> IO (Maybe (Entity User))
getUser (Just creds) = do
  putStrLn $ "\nCREDS: " ++ (show $ decodeBase64Lenient creds)
  let [username, password] = splitOn ":" $ decodeBase64Lenient creds
  lookupUser @(Entity User) @(Map Text Text) $ UserQuery (Just username) (Just password) Nothing
getUser Nothing = return Nothing
  

type SSOTest = "test-sso"
            :> QueryParam "redirect" String
            :> Header "Cookie" Text
            :> Get '[HTML] Html

routes :: AuthServer (Entity User) SSOTest
routes redirect mCookies = do
  (liftIO $ getUser mCreds) >>= \case
    Just user -> return $ ssoLink redirect
    Nothing -> return $ loginPage route empty
  where
    mCreds = mCookies >>= lookup authCookie . parseCookiesText . encodeUtf8 >>= \c -> if c == "\"\"" then Nothing else Just c
    route = "../login?redirect=-" -- TODO hacky "../login?redirect=..%2Ftest-sso%3Fredirect%3D" <> fromMaybe "" redirect

ssoLink :: Maybe String -> Html
ssoLink redirect = docTypeHtml $ head' >> body'
  where
    t = "OIDC SSO Test"
    head' = head $ do
      meta ! A.charset "UTF-8"
      meta ! A.name "viewport" ! A.content "width=device-width, initial-scale=1.0"
      title t
    body' = body $ do
      h1 t
      case redirect of
        Just r -> a ! A.href (fromString r) $ "Go to FraDrive"
        Nothing -> b "Redirect link is missing."