-- SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-# OPTIONS -Wno-redundant-constraints #-} -- needed for Getter

module Handler.Utils.LMS
  ( getLmsCsvDecoder
  , csvLmsIdent
  , csvLmsTimestamp
  , csvLmsBlocked
  , csvLmsSuccess
  , csvLmsPin
  , csvLmsResetPin
  , csvLmsDelete
  , csvLmsStaff
  , csvFilenameLmsUser
  , csvFilenameLmsUserlist
  , csvFilenameLmsResult
  , lmsUserToDelete, _lmsUserToDelete
  , lmsUserToDeleteExpr
  , randomLMSIdent, randomLMSIdentBut
  , randomLMSpw, maxLmsUserIdentRetries
  ) where

-- general utils for LMS Interface Handlers

import Import
import Handler.Utils
import Handler.Utils.Csv
import Data.Csv (HasHeader(..), FromRecord)

import qualified Data.Set as Set  (notMember)
import qualified Database.Esqueleto.Legacy as E

import Control.Monad.Random.Class (uniform)
import Control.Monad.Trans.Random (evalRandTIO)


getLmsCsvDecoder :: (MonadHandler m, HandlerSite m ~ UniWorX, MonadThrow m, FromNamedRecord csv, FromRecord csv) => Handler (ConduitT ByteString csv m ())
getLmsCsvDecoder = do
  LmsConf{..} <- getsYesod $ view _appLmsConf
  if  | Just upDelim <- lmsUploadDelimiter -> do
        let fmtOpts = def { csvDelimiter     = upDelim
                          , csvIncludeHeader = lmsUploadHeader
                          }
            csvOpts = def { csvFormat = fmtOpts }
        return $ decodeCsvWith csvOpts
      | lmsUploadHeader -> return   decodeCsv
      | otherwise       -> return $ decodeCsvPositional NoHeader

-- generic Column names
csvLmsIdent   :: IsString a => a
csvLmsIdent = fromString "user" -- "Benutzerkennung"

csvLmsTimestamp   :: IsString a => a
csvLmsTimestamp = fromString "timestamp" -- "Zeitstempel"

-- for Users Table
csvLmsPin :: IsString a => a
csvLmsPin      = fromString "pin" -- "PIN"

csvLmsResetPin :: IsString a => a
csvLmsResetPin = fromString "reset_pin" -- "PIN zurücksetzen"

csvLmsDelete :: IsString a => a
csvLmsDelete   = fromString "delete" -- "Account löschen"

csvLmsStaff :: IsString a => a
csvLmsStaff    = fromString "staff" -- "Mitarbeiter"

-- for Userlist Table
csvLmsBlocked :: IsString a => a
csvLmsBlocked = fromString "blocked" -- "Sperrung"

-- for Result Table
csvLmsSuccess :: IsString a => a
csvLmsSuccess = fromString "success" -- "Datum"


-- | Filename for User transmission, contains current datestamp as agreed in LMS interface
csvFilenameLmsUser :: MonadHandler m => QualificationShorthand -> m Text
csvFilenameLmsUser = makeLmsFilename "user"

-- | Filename for Userlist transmission, contains current datestamp as agreed in LMS interface
csvFilenameLmsUserlist :: MonadHandler m => QualificationShorthand -> m Text
csvFilenameLmsUserlist = makeLmsFilename "userliste"

-- | Filename for Result transmission, contains current datestamp as agreed in LMS interface
csvFilenameLmsResult :: MonadHandler m => QualificationShorthand -> m Text
csvFilenameLmsResult = makeLmsFilename "ergebnisse"

-- | Create filenames as specified by the LMS interface agreed with Know How AG
makeLmsFilename :: MonadHandler m => Text -> QualificationShorthand ->  m Text
makeLmsFilename ftag (citext2lower -> qsh) = do
  ymth <- getYMTH
  return $ "fradrive_" <> qsh <> "_" <> ftag <> "_" <> ymth <> ".csv"

-- | Return current datetime in YYYYMMDDHH format
getYMTH :: MonadHandler m => m Text
getYMTH = formatTime' "%Y%m%d%H" =<< liftIO getCurrentTime

-- | Deceide whether LMS platform should delete an identifier
lmsUserToDeleteExpr :: E.SqlExpr (Entity LmsUser) -> E.SqlExpr (E.Value Bool)
lmsUserToDeleteExpr lmslist = E.isNothing (lmslist E.^. LmsUserEnded) E.&&. E.not_ (E.isNothing $ lmslist E.^. LmsUserStatus)

lmsUserToDelete :: LmsUser -> Bool
lmsUserToDelete LmsUser{lmsUserEnded, lmsUserStatus} = isNothing lmsUserEnded && isJust lmsUserStatus

_lmsUserToDelete :: Getter LmsUser Bool
_lmsUserToDelete = to lmsUserToDelete


-- random generation of LmsIdentifiers, maybe this should be in Model.Types.Lms since length specifications are type-y?

lengthIdent :: Int
lengthIdent = 8

lengthPassword :: Int
lengthPassword = 8

-- | Maximal number of times, randomLMSIdent should be called in a row to find an unused LmsIdent
maxLmsUserIdentRetries :: Int
maxLmsUserIdentRetries = 27

-- | Generate Random Text of specified length using numbers and lower case letters plus supplied extra characters
randomText :: MonadIO m => String -> Int -> m Text
randomText extra n = fmap pack . evalRandTIO . replicateM n $ uniform range
  where
    num_letters = ['0'..'9'] ++ ['a'..'z']
    range       = extra ++ num_letters

--TODO: consider using package elocrypt for user-friendly passwords here, licence requires mentioning of author, etc. though
-- import qualified Data.Elocrypt as Elo
-- randomLMSIdent :: MonadRandom m => m LmsIdent
-- randomLMSIdent = LmsIdent . T.pack <$> Elo.mkPassword lengthIdent eopt
--   where
--     eopt = Elo.genOptions -- { genCapitals = False, genSpecials = False, genDigitis = True }

randomLMSIdent :: MonadIO m => m LmsIdent
randomLMSIdent = LmsIdent <$> randomText [] lengthIdent

randomLMSIdentBut :: MonadIO m => Set LmsIdent -> m (Maybe LmsIdent)
randomLMSIdentBut banList = untilJustMaxM maxLmsUserIdentRetries getIdentOk
  where     
    getIdentOk = do 
      l <- randomLMSIdent
      return $ toMaybe (Set.notMember l banList) l

randomLMSpw :: MonadIO m => m Text
randomLMSpw = randomText extra lengthPassword
  where
    extra = "+*:=!?#&" -- you cannot distinguish ;: and ., in printed letters