refactor(lms): better lms indentifiers and passwords
This commit is contained in:
parent
2c66cb5e5d
commit
06201bc22e
@ -23,9 +23,8 @@ import Import
|
||||
import Handler.Utils
|
||||
import qualified Database.Esqueleto.Legacy as E
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.UUID as UUID (toText)
|
||||
import qualified Data.UUID.V4 as UUID (nextRandom)
|
||||
import Control.Monad.Random.Class (uniform)
|
||||
import Control.Monad.Trans.Random (evalRandTIO)
|
||||
|
||||
-- generic Column names
|
||||
csvLmsIdent :: IsString a => a
|
||||
@ -101,11 +100,12 @@ lengthPassword = 8
|
||||
maxLmsUserIdentRetries :: Int
|
||||
maxLmsUserIdentRetries = 27
|
||||
|
||||
randomText :: MonadIO m => Int -> m Text
|
||||
randomText n
|
||||
| n <= 8 = T.take n . UUID.toText <$> liftIO UUID.nextRandom
|
||||
| n <= 32 = T.take n . T.filter ('-' ==) . UUID.toText <$> liftIO UUID.nextRandom
|
||||
| otherwise = (<>) <$> randomText 32 <*> randomText (n - 32)
|
||||
-- | 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
|
||||
@ -115,8 +115,10 @@ randomText n
|
||||
-- eopt = Elo.genOptions -- { genCapitals = False, genSpecials = False, genDigitis = True }
|
||||
|
||||
randomLMSIdent :: MonadIO m => m LmsIdent
|
||||
randomLMSIdent = LmsIdent <$> randomText lengthIdent
|
||||
randomLMSIdent = LmsIdent <$> randomText [] lengthIdent
|
||||
|
||||
randomLMSpw :: MonadIO m => m Text
|
||||
randomLMSpw = randomText lengthPassword
|
||||
randomLMSpw = randomText extra lengthPassword
|
||||
where
|
||||
extra = "_-+*.:;=!?#"
|
||||
|
||||
Loading…
Reference in New Issue
Block a user