Started building generation functionality, added useful haddock-style comments for several functions

src/Feature/Generation/Links.hs

@@ -5,30 +5,45 @@ import Feature.Generation.Shared (rIndex)
 
 import Control.Monad.Reader (ask, lift, liftIO)
 import Data.Char (toLower, toUpper)
-import Data.List (foldl')
 import System.IO
 import System.Random
 
-genLink :: Int -> [Char] -> IO [Char]
-genLink 0 cs = return cs
-genLink d cs = do 
-  res <- rChar
-  fin <- rCap res
-  genLink (d - 1) (cs <> (fin:[]))
+-- Generates a string containing randomly generated and capitalized
+-- characters. The number of characters used is defined in the global config.dhall.
+genLink :: PurrAction String
+genLink = do 
+  linkLength <- confLinkLength
+  genLink' linkLength ""
+  where
+    genLink' 0 cs = return cs
+    genLink' d cs = do
+      res <- liftIO $ randChar
+      fin <- liftIO $ randCapitalization res
+      genLink' (d - 1) (cs <> (fin:[]))
 
+-- Defines the valid range of characters to be used when generating links.
+-- This consists of all lowercase Latin alphabet characters and the 
+-- numbers 1 through 9.
 validChars :: [Char]
 validChars = ['a'..'z'] <> ['1'..'9']
 
-rChar :: IO Char
-rChar = rIndex validChars
+randChar :: IO Char
+randChar = rIndex validChars
 
-rCap :: Char -> IO Char -- rCap takes a single character and returns it
-rCap c = do             -- capitalized or lowercased at random.
+randCapitalization :: Char -> IO Char
+randCapitalization c = do 
   capRand <- randomRIO (0,1)
-  return $ checkRand capRand c
+  return $ go capRand c
     where
-      checkRand :: Int -> Char -> Char
-      checkRand r c 
+      go :: Int -> Char -> Char
+      go r c 
         | r == 0 = toLower c
         | r == 1 = toUpper c
         | otherwise = c  
+
+-- Helper function in our PurrAction monad transformer stack to read
+-- the desired length for generated links.
+confLinkLength :: PurrAction Int
+confLinkLength = do
+  conf  <- lift ask
+  return $ linkLength conf

src/Feature/Generation/Passwords.hs

@@ -0,0 +1,25 @@
+module Feature.Generation.Passwords where
+
+import Core.Types
+import Feature.Generation.Shared (rIndex)
+
+import Control.Monad.Reader (ask, lift, liftIO)
+import Data.Char (toLower, toUpper)
+import System.IO
+import System.Random
+
+-- suggestedScheme and its helpers xkcd, oldschool, and gibberish are TODO.
+suggestedScheme :: Int -> String
+suggestedScheme i 
+  | i > 23    = xkcd i
+  | i > 12    = oldschool i
+  | otherwise = gibberish i
+
+xkcd :: Int -> String
+xkcd i = take i "correcthorsebatterystaple"
+
+oldschool :: Int -> String
+oldschool i = take i "PowerProlonger2974!"
+
+gibberish :: Int -> String
+gibberish i = take i "TCYx#@z5zlgw1o"

src/Feature/Sharing/HTTP.hs

@@ -21,8 +21,7 @@ routes = do
 
   get "/pw/:id" $ do
     reqId <- param "id"
-    res   <- findByLink reqId
-    html   $ renderIndex reqId (secret <$> res)
+    html   $ renderIndex reqId
 
   post "/pw" $ do
     reqId <- param "userLink"
@@ -31,6 +30,6 @@ routes = do
 
   post "/new" $ do 
     reqSecret <- param "newSec"
-    link      <- liftIO $ genLink 24 ""
+    link      <- genLink
     insertNewSecret reqSecret (T.pack link)
     html       $ renderPw link (Just reqSecret)