Initial commit

Add new files

Diceware.hs

@@ -0,0 +1,35 @@
+module Diceware where
+
+import qualified Data.Map as Map
+import List
+
+-- Diceware dictionary type
+type Diceware = Map.Map Int String
+
+-- Parse a line into a tuple
+parseLine :: String -> (Int, String)
+parseLine x =
+	(read a :: Int, b)
+	where
+		x' = split x ' '
+		(a, b) = (head x', last x')
+
+-- Parse file content to a Diceware
+parseDiceware :: String -> Diceware
+parseDiceware x = (Map.fromList . map parseLine . lines) x
+
+-- Lookup word with dice index
+readDiceware :: Diceware -> Int -> String
+readDiceware d n =
+	show n ++ " -> " ++
+	case Map.lookup n d of
+		Just x ->  x
+		Nothing -> "Does not exist"
+
+-- Lookup word with linear index
+readDiceware' :: Diceware -> Int -> String
+readDiceware' d n = (snd . (!!n) . Map.toList) d
+
+-- Size of Diceware (should be 2^5)
+size :: Diceware -> Int
+size = Map.size

List.hs

@@ -0,0 +1,16 @@
+module List where
+
+-- Remove the nth element of a list. (0-indexed)
+-- RemoveAt 2 "abc" == ('c', "ab")
+removeAt :: Int -> [a] -> (a, [a])
+removeAt n xs = (xs !! n, take n xs ++ drop (n+1) xs)
+
+-- Split a string into a list of strings
+-- ex. split "ab,cd,ef" ',' == ["ab","cd","ef"]
+split :: String -> Char -> [String]
+split [] _ = [""]
+split (c:cs) delim
+	| c == delim = "" : rest
+	| otherwise = (c : head rest) : tail rest
+	where
+		rest = split cs delim

Random.hs

@@ -0,0 +1,18 @@
+module Random where
+
+import System.Random
+import List
+
+-- Get n random numbers from the list ys
+randPick :: (Eq a, RandomGen g) => [a] -> Int -> g -> ([a], g)
+randPick [] _ gen = ([], gen)
+randPick _ 0  gen = ([], gen)
+randPick ys n gen = (x : xs', gen'')
+	where
+		(randIndex, gen') = randomR (0, length ys - 1) gen
+		(x, xs) = removeAt randIndex ys
+		(xs', gen'') = randPick xs (n-1) gen'
+
+-- Generate k random number in the range [0, n)
+randWords :: Int -> Int -> IO [Int]
+randWords n k = getStdRandom (randPick [0..n] k)

main.hs

@@ -0,0 +1,63 @@
+{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}
+
+import System.IO
+import System.Console.CmdArgs
+import System.Environment (getArgs, withArgs)
+import Control.Monad      (when)
+
+import Diceware
+import Random
+
+_NAME = "Alea"
+_VERSION = "0.1.0"
+_INFO = _NAME ++ " version " ++ _VERSION
+_ABOUT = "a diceware passphrase generator"
+_COPYRIGHT = "(C) Rnhmjoj 2014"
+
+data Args = Args
+	{ interactive  :: Bool
+	, dictionary   :: FilePath
+	, phraseLength :: Int
+	, phrases      :: Int
+	} deriving (Data, Typeable, Show, Eq)
+
+progArgs :: Args
+progArgs = Args
+	{ interactive  = def &= help "Manually insert numbers"
+	, dictionary   = def &= help "Specify dictionary file path"
+	, phraseLength = def &= help "Number of words in a passphrase"
+	, phrases      = def &= help "Number of passphrases to generate"
+	}
+
+getProgArgs :: IO Args
+getProgArgs = cmdArgs $ progArgs
+    &= versionArg [explicit, name "version", name "v", summary _INFO]
+    &= summary (_INFO ++ ", " ++ _COPYRIGHT)
+    &= help _ABOUT
+    &= helpArg [explicit, name "help", name "h"]
+    &= program _NAME
+
+
+main :: IO ()
+main = do
+	args <- getArgs
+	opts <- getProgArgs
+	exec opts
+
+exec :: Args -> IO ()
+exec opts@Args{..} = do
+	file <- readFile dictionary'
+	opts <- getProgArgs
+	if interactive
+		then interact (unlines . map (dice file) . lines)
+		else do
+			phrase <- randWords (size $ parseDiceware file) phraseLength'
+			putStrLn . unwords . map (dice' file) $ phrase
+			when (phrases > 1) $ exec opts {phrases = phrases - 1}
+	where
+		-- helpers
+		dice x n = readDiceware  (parseDiceware x) (read n :: Int)
+		dice' x n = readDiceware' (parseDiceware x) n
+		-- default arguments
+		phraseLength' = if phraseLength == 0 then 6 else phraseLength
+		dictionary' = if null dictionary then "diceware.txt" else dictionary