refactor(lms): better lms indentifiers and passwords

This commit is contained in:
Steffen Jost 2022-04-12 11:30:53 +02:00
parent 2c66cb5e5d
commit 06201bc22e

View File

@ -23,9 +23,8 @@ import Import
import Handler.Utils import Handler.Utils
import qualified Database.Esqueleto.Legacy as E import qualified Database.Esqueleto.Legacy as E
import qualified Data.Text as T import Control.Monad.Random.Class (uniform)
import qualified Data.UUID as UUID (toText) import Control.Monad.Trans.Random (evalRandTIO)
import qualified Data.UUID.V4 as UUID (nextRandom)
-- generic Column names -- generic Column names
csvLmsIdent :: IsString a => a csvLmsIdent :: IsString a => a
@ -101,11 +100,12 @@ lengthPassword = 8
maxLmsUserIdentRetries :: Int maxLmsUserIdentRetries :: Int
maxLmsUserIdentRetries = 27 maxLmsUserIdentRetries = 27
randomText :: MonadIO m => Int -> m Text -- | Generate Random Text of specified length using numbers and lower case letters plus supplied extra characters
randomText n randomText :: MonadIO m => String -> Int -> m Text
| n <= 8 = T.take n . UUID.toText <$> liftIO UUID.nextRandom randomText extra n = fmap pack . evalRandTIO . replicateM n $ uniform range
| n <= 32 = T.take n . T.filter ('-' ==) . UUID.toText <$> liftIO UUID.nextRandom where
| otherwise = (<>) <$> randomText 32 <*> randomText (n - 32) 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 --TODO: consider using package elocrypt for user-friendly passwords here, licence requires mentioning of author, etc. though
-- import qualified Data.Elocrypt as Elo -- import qualified Data.Elocrypt as Elo
@ -115,8 +115,10 @@ randomText n
-- eopt = Elo.genOptions -- { genCapitals = False, genSpecials = False, genDigitis = True } -- eopt = Elo.genOptions -- { genCapitals = False, genSpecials = False, genDigitis = True }
randomLMSIdent :: MonadIO m => m LmsIdent randomLMSIdent :: MonadIO m => m LmsIdent
randomLMSIdent = LmsIdent <$> randomText lengthIdent randomLMSIdent = LmsIdent <$> randomText [] lengthIdent
randomLMSpw :: MonadIO m => m Text randomLMSpw :: MonadIO m => m Text
randomLMSpw = randomText lengthPassword randomLMSpw = randomText extra lengthPassword
where
extra = "_-+*.:;=!?#"