[FEAT] Pass gen (WIP)

package.yaml

@@ -213,6 +213,11 @@ library:
   - smtp-mail
   - mime-mail
 
+    # for password generation
+  - cprng-aes
+  - binary
+  - crypto-random
+
   - split
   - stemmer
   - string-conversions

src/Gargantext/Core/Pass.hs

+{-|
+Module      : Gargantext.Core.Pass
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : Public Domain
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+To avoid weak password, just offer an easy way to make "good" one and
+let user add his own entropy.
+
+Thanks to 
+https://zuttobenkyou.wordpress.com/2011/12/23/simple-password-generation-with-haskell/
+
+-}
+
+
+module Gargantext.Core.Pass
+      where
+
+-- import System.Environment (getArgs)
+-- import System.IO (hSetEcho)
+import Control.Monad.State
+import Crypto.Random (cprgGenerate)
+import Crypto.Random.AESCtr
+import Data.Binary (decode)
+import Data.List (nub)
+import Prelude
+import qualified Data.ByteString.Lazy as B
+
+
+keysChar, keysNum, keysPunc, keysCharNum, keysAll, keysHex :: String
+keysChar = ['a'..'z'] ++ ['A'..'Z']
+keysHex = ['a'..'f']
+keysNum = ['0'..'9']
+keysPunc = "`~!@#$%^&*()-_=+[{]}\\|;:'\",<.>/? "
+keysCharNum = keysChar ++ keysNum
+keysAll = keysChar ++ keysNum ++ keysPunc
+ 
+giveKey ::  String -> Char -> Int -> Char
+giveKey keysCustom c n = extractChar $ case c of
+    'i'  -> (keysNum ++ keysHex)
+    'j'  -> keysNum
+    'k'  -> keysChar
+    'l'  -> keysCharNum
+    ';'  -> keysPunc
+    'h'  -> (keysCharNum ++ keysCustom)
+    '\n' -> ['\n']
+    _    -> keysAll
+    where
+    extractChar xs = xs!!mod n (length xs)
+ 
+showRandomKey :: Int -> String -> StateT AESRNG IO ()
+showRandomKey len keysCustom = handleKey =<< liftIO getChar
+    where
+    handleKey key = case key of
+        '\n' -> liftIO (putChar '\n') >> showRandomKey len keysCustom
+        'q' -> (liftIO $ putStrLn "\nBye!") >> return ()
+        _ -> mapM_ f [0..len] >> (liftIO $ putStrLn []) >> showRandomKey len keysCustom
+        where
+        f _ = liftIO
+            . putChar
+            . giveKey keysCustom key
+            . (\n -> mod n (length (keysAll ++ keysCustom) - 1))
+            =<< aesRandomInt
+ 
+aesRandomInt :: StateT AESRNG IO Int
+aesRandomInt = do
+    aesState <- get
+    -- aesState <- liftIO makeSystem
+    -- let aesState = 128
+    let (bs, aesState') = cprgGenerate 64 aesState
+    put aesState'
+    return (decode $ B.fromChunks [bs])
+
+-- gargPass :: Int -> IO String
+gargPass len = do
+  let as = ["alphanumeric","punctuation"]
+  let as' = filter (\c -> elem c keysAll) . nub $ unwords as
+  aesState <- makeSystem -- gather entropy from the system to use as the initial seed
+  --_ <- runStateT (showRandomKey len as') aesState -- enter loop
+  -- return ()
+  (p,pass) <- runStateT aesRandomInt aesState -- enter loop
+  pure pass
+
+{- 
+main :: IO ()
+main = do
+    hSetBuffering stdin NoBuffering  -- disable buffering from STDIN
+    hSetBuffering stdout NoBuffering -- disable buffering from STDOUT
+    hSetEcho stdin False             -- disable terminal echo
+    as <- getArgs
+    let as' = filter (\c -> elem c keysAll) . nub $ unwords as
+    mapM_ putStrLn
+        [ []
+        , "poke: 'q'     quit"
+        , "      'j'     number"
+        , "      'k'     letter"
+        , "      'l'     alphanumeric"
+        , "      ';'     punctuation"
+        , "      'h'     alphanumeric" ++ (if null as' then [] else " + " ++ as')
+        , "      'i'     hexadecimal"
+        , "      'ENTER' newline"
+        , "      else    any"
+        , []
+        ]
+    aesState <- makeSystem -- gather entropy from the system to use as the initial seed
+    _ <- runStateT (showRandomKey as') aesState -- enter loop
+    return ()
+-}