Cleanup refactoring of config/settings/env
[gargantext.git] / src / Gargantext / Prelude / Crypto / Pass / User.hs
index cf83f67533a44b2ee9b1eecf872ceb9efec06c18..aac3994428a09cbc76ad46d10ef767ca404b0be0 100644 (file)
@@ -7,15 +7,76 @@ Maintainer  : team@gargantext.org
 Stability   : experimental
 Portability : POSIX
 
+1) quick password generator for first invitations
+2) Easy password manager for User (easy to memorize) (needs list of words)
+
 -}
 
 
 module Gargantext.Prelude.Crypto.Pass.User
       where
 
-import Data.List ((!!))
+
+-- | 1) Quick password generator imports
+import Data.Text (Text)
+import Data.String (String)
+import Control.Monad
+import Control.Monad.Random
+import Data.List hiding (sum)
+
+-- | 2) Easy password manager imports
 import Gargantext.Prelude
-import System.Random
+import Gargantext.Prelude.Utils (shuffle)
+
+
+-- | 1) Quick password generator
+-- | Inspired by Rosetta code
+-- https://www.rosettacode.org/wiki/Password_generator#Haskell
+gargPass :: MonadRandom m => m Text
+gargPass = cs <$> gargPass' chars 33
+  where
+    chars = zipWith (\\) charSets visualySimilar
+
+    charSets = [ ['a'..'z']
+               , ['A'..'Z']
+               , ['0'..'9']
+               , "!\"#$%&'()*+,-./:;<=>?@[]^_{|}~"
+               ]
+    visualySimilar = ["l","IOSZ","012","!|.,'\""]
+
+gargPass' :: MonadRandom m => [String] -> Int -> m String
+gargPass' charSets n = do
+  parts <- getPartition n
+  chars <- zipWithM replicateM parts (uniform <$> charSets)
+  shuffle' (concat chars)
+  where
+    getPartition n' = adjust <$> replicateM (k-1) (getRandomR (1, n' `div` k))
+    k = length charSets
+    adjust p = (n - sum p) : p
+shuffle' :: (Eq a, MonadRandom m) => [a] -> m [a]
+shuffle' [] = pure []
+shuffle' lst = do
+  x <- uniform lst
+  xs <- shuffle (delete x lst)
+  return (x : xs)
+
+
+
+-- | 2) Easy password manager
+-- TODO add this as parameter to gargantext.ini
+gargPassUserEasy :: (Num a, Enum a, Integral a) => a -> [b] -> IO [b]
+gargPassUserEasy n = gargPassUserEasy' (100 * fromIntegral n) n
+
+gargPassUserEasy' :: (Num a, Enum a) => Int -> a -> [b] -> IO [b]
+gargPassUserEasy' threshold size wlist
+  | length wlist > threshold  = generatePassword size wlist
+  | otherwise                 = panic "List to short"
+
+generatePassword :: (Num a, Enum a) => a -> [b] -> IO [b]
+generatePassword size wlist = shuffle wlist
+  >>= \wlist' -> mapM (\_ -> getRandomElement wlist') [1..size]
 
 getRandomIndex :: Foldable t => t a -> IO Int
 getRandomIndex list = randomRIO (0, (length list - 1))
@@ -25,6 +86,3 @@ getRandomElement list = do
   index <- (getRandomIndex list)
   pure (list !! index)
 
-generatePassword :: (Num a, Enum a) => a -> [b] -> IO [b]
-generatePassword size wlist = mapM (\_ -> getRandomElement wlist) [1..size]
-