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

{-# Language GADTs,
             GeneralizedNewtypeDeriving,
             OverloadedStrings,
             QuasiQuotes,
             TemplateHaskell,
             TypeFamilies,
             TypeApplications,
             DerivingStrategies,
             StandaloneDeriving,
             UndecidableInstances,
             DataKinds,
             FlexibleInstances,
             MultiParamTypeClasses,
             RecordWildCards #-}

module UniWorX (User(..), initDB, testUsers) where

import User

import Control.Applicative ((<|>))
import Control.Monad (void, forM_)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runStderrLoggingT, NoLoggingT)
import Control.Monad.Reader (ReaderT)

import Conduit (ResourceT)

import Data.Map (Map(..))
import Data.String (IsString(..))
import Data.Text (Text(..))
import qualified Data.Map as M
import qualified Data.Text as T

import Database.Persist
import Database.Persist.TH
import Database.Persist.Postgresql

import System.Environment (lookupEnv)


share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
  User
    name Text
    email Text
    deriving Eq Show
|]

testUsers :: [User] -- TODO move to db
testUsers =
  [ User "Fallback User" "foo@bar.com"
  , User "Tina Tester" "tester@campus.lmu.de"
  , User "Max Muster" "m@m.mm" ]

runDB :: ReaderT SqlBackend (NoLoggingT (ResourceT IO)) a -> IO a
runDB action = do
  Just port <- lookupEnv "OAUTH2_DB_PORT" -- >>= \p -> return $ p <|> Just "9444"
  Just host <- lookupEnv "OAUTH2_PGHOST"
  let connStr = fromString @ConnectionString $ "host=" ++ host ++ " dbname=test_users user=oauth2mock password=0000 port=" ++ port
  runStderrLoggingT $ withPostgresqlPool connStr 10 $ \pool -> liftIO $ flip runSqlPersistMPool pool action

initDB :: IO ()
initDB = runDB $ do
  runMigration migrateAll
  forM_ testUsers $ void . insert

instance UserData (Entity User) (Map Text Text) where
  data Scope (Entity User) = ID | Profile deriving (Show, Read, Eq)
  readScope = read
  showScope = show
  userScope (Entity _ User{..}) ID = M.singleton "id" userEmail
  userScope (Entity _ User{..}) Profile = M.fromList [("name", userName), ("email", userEmail)]
  lookupUser email _ = runDB $ do
    user <- selectList [UserEmail ==. email] []
    case user of
      [entity] -> return $ Just entity
      [] -> return Nothing
      _ -> error "Ambiguous User."