src/Gargantext/Prelude/Crypto/Pass/User.hs

   1 {-|
   2 Module      : Gargantext.Prelude.Crypto.Pass.User
   3 Description :
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : Public Domain
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 1) quick password generator for first invitations
  11 2) Easy password manager for User (easy to memorize) (needs list of words)
  12
  13 -}
  14
  15
  16 module Gargantext.Prelude.Crypto.Pass.User
  17       where
  18
  19
  20 -- | 1) Quick password generator imports
  21 import Data.Text (Text)
  22 import Data.String (String)
  23 import Control.Monad
  24 import Control.Monad.Random
  25 import Data.List hiding (sum)
  26
  27 -- | 2) Easy password manager imports
  28 import Gargantext.Prelude
  29 import Gargantext.Prelude.Utils (shuffle)
  30
  31
  32 -- | 1) Quick password generator
  33 -- | Inspired by Rosetta code
  34 -- https://www.rosettacode.org/wiki/Password_generator#Haskell
  35 gargPass :: MonadRandom m => m Text
  36 gargPass = cs <$> gargPass' chars 33
  37   where
  38     chars = zipWith (\\) charSets visualySimilar
  39
  40     charSets = [ ['a'..'z']
  41                , ['A'..'Z']
  42                , ['0'..'9']
  43                , "!\"#$%&'()*+,-./:;<=>?@[]^_{|}~"
  44                ]
  45
  46     visualySimilar = ["l","IOSZ","012","!|.,'\""]
  47
  48 gargPass' :: MonadRandom m => [String] -> Int -> m String
  49 gargPass' charSets n = do
  50   parts <- getPartition n
  51   chars <- zipWithM replicateM parts (uniform <$> charSets)
  52   shuffle' (concat chars)
  53   where
  54     getPartition n' = adjust <$> replicateM (k-1) (getRandomR (1, n' `div` k))
  55     k = length charSets
  56     adjust p = (n - sum p) : p
  57
  58 shuffle' :: (Eq a, MonadRandom m) => [a] -> m [a]
  59 shuffle' [] = pure []
  60 shuffle' lst = do
  61   x <- uniform lst
  62   xs <- shuffle (delete x lst)
  63   return (x : xs)
  64
  65
  66
  67 -- | 2) Easy password manager
  68 -- TODO add this as parameter to gargantext.ini
  69 gargPassUserEasy :: (Num a, Enum a, Integral a) => a -> [b] -> IO [b]
  70 gargPassUserEasy n = gargPassUserEasy' (100 * fromIntegral n) n
  71
  72 gargPassUserEasy' :: (Num a, Enum a) => Int -> a -> [b] -> IO [b]
  73 gargPassUserEasy' threshold size wlist
  74   | length wlist > threshold  = generatePassword size wlist
  75   | otherwise                 = panic "List to short"
  76
  77 generatePassword :: (Num a, Enum a) => a -> [b] -> IO [b]
  78 generatePassword size wlist = shuffle wlist
  79   >>= \wlist' -> mapM (\_ -> getRandomElement wlist') [1..size]
  80
  81 getRandomIndex :: Foldable t => t a -> IO Int
  82 getRandomIndex list = randomRIO (0, (length list - 1))
  83
  84 getRandomElement :: [b] -> IO b
  85 getRandomElement list = do
  86   index <- (getRandomIndex list)
  87   pure (list !! index)
  88