Extensive commenting of functions; refactor some duplicate pattern matching logic

src/Core/Configuration.hs

@@ -9,6 +9,7 @@ import           Configuration.Dotenv
 import           System.Directory              (doesFileExist)
 import           System.Environment            (getEnv, lookupEnv)
 
+-- Make the dotenv file configuration available if PURRNOFILE is not present
 main :: IO ()
 main = do
   envFile <- lookupEnv "PURRNOFILE"
@@ -16,6 +17,7 @@ main = do
     Nothing  -> loadFile defaultConfig
     _        -> putStrLn "Not using dotenv file"
 
+-- Check if an encryption key exists on the filesystem and create one if not
 keyFileInit :: IO ()
 keyFileInit = do
   dataPathStr <- dataPath
@@ -27,6 +29,13 @@ keyFileInit = do
       B.writeFile (dataPathStr ++ "data/encryptionKey") (encode key)
       putStrLn "Creating new encryption key; any pre-existing DB entries will not decrypt"
 
+-- Read and return the encryption key on the filesystem as a ByteString
+encKey :: IO B.ByteString
+encKey = do
+  dataPathStr <- dataPath 
+  B.readFile (dataPathStr ++ "data/encryptionKey")
+
+-- Helper functions for getting the value of environment variables
 adminEmail :: IO String
 adminEmail = getEnv "ADMINEMAIL"
 
@@ -41,8 +50,3 @@ dbPath = "data/Purr.sqlite"
 
 confLinkLength :: IO String
 confLinkLength = getEnv "LINKLENGTH"
-
-encKey :: IO B.ByteString
-encKey = do
-  dataPathStr <- dataPath 
-  B.readFile (dataPathStr ++ "data/encryptionKey")

src/Core/HTTP.hs

@@ -15,7 +15,7 @@ import           Web.Scotty
 
 app :: PurrApp ()
 app = do
-  -- Middleware definition
+  -- Middleware that are processed on every request
   middleware logStdoutDev
   middleware $ staticPolicy (noDots >-> addBase "data/assets/public")
 

src/Core/SQLite.hs

@@ -9,6 +9,7 @@ import           Database.SQLite.Simple.FromRow
 
 import qualified Data.Text                      as T
 
+-- Set up SQLite database table when Purr starts if it doesn't already exist
 main :: IO ()
 main = do
   conn <- open dbPath

src/Core/Types.hs

@@ -11,6 +11,7 @@ import           Numeric.Natural                (Natural)
 import           Text.Blaze.Html
 import           Web.Scotty                     (ActionM, ScottyM)
 
+-- Vestigial types from when Purr used a ReaderT in the monad stack
 type PurrApp    a = ScottyM a
 type PurrAction a = ActionM a
 type Random     a = IO a
@@ -24,6 +25,7 @@ newtype UserSecret = UserSecret' String
 newtype GenLink = GenLink' String
   deriving (Eq, Ord)
 
+-- This record type matches Purr's SQL table columns
 data SecretEntry = SecretEntry
   { link     :: T.Text
   , secret   :: T.Text

src/Feature/Generation/HTTP.hs

@@ -14,6 +14,9 @@ import           Data.Maybe                   (listToMaybe)
 import           Prelude
 import           Web.Scotty
 
+{- "Generator" route that provides radio button options to share a randomly
+   generated password. This usecase targets IT professionals that are setting
+   up temporary account credentials for someone else. -}
 routes :: PurrApp ()
 routes = do
   get "/gen" $ do

src/Feature/Generation/Links.hs

@@ -4,8 +4,8 @@ import           Core.Types
 import           Data.List                 (singleton)
 import           Feature.Generation.Shared (rChar, rIndex, validChars)
 
--- Generates a string containing romly generated and capitalized
+{- Generates a string containing randomly generated and capitalized characters.
--- characters. The number of characters used is defined in the global config.dhall.
+   The length is determined by the LINKLENGTH environment variable. -}
 genLink :: Int -> IO GenLink
 genLink linkLength = genLink' linkLength (return "")
   where

src/Feature/Generation/Passwords.hs

@@ -10,31 +10,35 @@ module Feature.Generation.Passwords
   ) where
 
 import           Core.Types
-import           Feature.Generation.Shared (camelCase, rCharSym, rIndex,
+import           Feature.Generation.Shared (titleCase, rCharSym, rIndex,
                                             validChars, validNumbers,
                                             validSymbols)
 
 import           Data.FileEmbed
 import           Data.List                 (singleton)
 
+{- Suggests one of Purr's generation schemes based on the
+   desired number of characters in the password. -}
 suggestedScheme :: Int -> Random Password
 suggestedScheme i
   | i > 17    = xkcd
   | i > 12    = oldschool
   | otherwise = gibberish i
 
+-- XKCD-style random password generator consisting of four titlecase words.
 xkcd :: Random Password
 xkcd = do
-  wOne   <- rCamel
+  wOne   <- rTitle
-  wTwo   <- rCamel
+  wTwo   <- rTitle
-  wThree <- rCamel
+  wThree <- rTitle
-  wFour  <- rCamel
+  wFour  <- rTitle
   return  $ Password' (wOne <> wTwo <> wThree <> wFour)
 
+-- Two random title case words, four random numbers, one random symbol.
 oldschool :: Random Password
 oldschool = do
-  wOne <- rCamel
+  wOne <- rTitle
-  wTwo <- rCamel
+  wTwo <- rTitle
   nOne <- rNum
   nTwo <- rNum
   nThr <- rNum
@@ -45,6 +49,7 @@ oldschool = do
    <> show nOne <> show nTwo <> show nThr <> show nFou
    <> pure sOne)
 
+-- A completely random selection of characters supported by Purr generation
 gibberish :: Int -> Random Password
 gibberish i = go i (return "")
   where
@@ -61,8 +66,8 @@ rWord = rIndex wordList
 rSym :: Random Char
 rSym = rIndex validSymbols
 
-rCamel :: Random String
+rTitle :: Random String
-rCamel = camelCase <$> rWord
+rTitle = titleCase <$> rWord
 
 wordList :: [String]
 wordList = lines $(embedStringFile "data/assets/wordlist.txt")

src/Feature/Generation/Shared.hs

@@ -3,10 +3,12 @@ module Feature.Generation.Shared where
 import           Data.Char     (intToDigit, toLower, toUpper)
 import           System.Random (randomRIO)
 
+-- Take a list of anything and return a random element from it
 rIndex :: [a] -> IO a
 rIndex arr = randomRIO (0, length arr - 1)
   >>= (\i -> return $ arr !! i)
 
+-- Return the input Char randomly uppercased or lowercased
 rCap :: Char -> IO Char
 rCap c = rIndex [True,False] >>= (\r -> return $ rCap' r c)
   where
@@ -14,16 +16,20 @@ rCap c = rIndex [True,False] >>= (\r -> return $ rCap' r c)
     rCap' True  c = toUpper c
     rCap' False c = toLower c
 
+-- Return a random character from validChars with random capitalization applied
 rChar :: IO Char
 rChar = rIndex validChars >>= rCap
 
+-- Return a random character or symbol with random capitalization applied
 rCharSym :: IO Char
 rCharSym = rIndex (validChars <> validSymbols)>>= rCap
 
-camelCase :: [Char] -> [Char]
+-- Takes any string and returns it in Titlecase
-camelCase [] = []
+titleCase :: [Char] -> [Char]
-camelCase x  = toUpper (head x) : map toLower (tail x)
+titleCase [] = []
+titleCase x  = toUpper (head x) : map toLower (tail x)
 
+-- List of valid characters consisting of latin alphabet and numbers
 validChars :: [Char]
 validChars = validLetters <> fmap intToDigit validNumbers
 

src/Feature/Sharing/HTTP.hs

@@ -17,10 +17,9 @@ import           Web.Scotty
 import qualified Data.Text                 as T
 import qualified Data.Text.Lazy            as LT
 
-
+-- Routes related to secret sharing functionality
 routes :: PurrApp ()
 routes = do
-
   get "/pw/:id" $ do
     reqId  <- param "id"
     email  <- liftIO adminEmail

src/Feature/Sharing/SQLite.hs

@@ -20,58 +20,74 @@ import qualified Data.Text                         as T
 import qualified Data.Text.Encoding                as ET
 import qualified Data.Text.Lazy                    as LT
 
+-- Look up a secret based on the "link" attribute
 findByLink :: String -> PurrAction (Maybe T.Text)
 findByLink link = do
+  -- Get the encryption key from the filesystem as a ByteString
   key   <- liftIO encKey
+  -- Start up a connection to the SQLite database
   conn  <- liftIO $ open dbPath
-  res   <- liftIO $ query conn "SELECT * from pws WHERE link = ?" (Only (last $ splitOn "/" link))
+  -- Constant containing the results of a query looking for the "link" attribute
+  res   <- liftIO $ 
+    query conn "SELECT * from pws WHERE link = ?" 
+    (Only (last $ splitOn "/" link))
+  -- Close the SQLite database connection
   liftIO $ close conn
+  -- Pass the encryption key and [SecretEntry] to be unencrypted
   readEncryptedSecret key res
 
 readEncryptedSecret :: B.ByteString -> [SecretEntry] -> PurrAction (Maybe T.Text)
-readEncryptedSecret key secret = do
+readEncryptedSecret key [] = return Nothing
-  let secNonce = nonce $ safeHead failedSecret secret
+readEncryptedSecret key (secret:_) = do
+  -- Increment the number of views on the secret in the database by one
   liftIO $ incViews secret dbPath
+  -- Delete the secret if it's expired
   delete <- liftIO $ deleteExpiredSecret secret dbPath
-  case secret of
+  if (delete) 
-    []     -> return Nothing
+    -- Don't return the secret if it's expired
-    (x:_) -> if (delete) 
+    then return Nothing
-      then return Nothing
+    -- Otherwise, try to decrypt and return it
-      else return (ET.decodeLatin1 <$> (decryptSecret key secNonce $ decodeSecret x))
+    else return (ET.decodeLatin1 <$> 
-    where
+      (decryptSecret key (nonce secret) $ decodeSecret secret))
-      incViews :: [SecretEntry] -> String -> IO ()
+  where
-      incViews []         _ = return ()
+    incViews :: SecretEntry -> String -> IO ()
-      incViews (secret : _) dbPath = do
+    incViews secret dbPath = do
-        conn <- open dbPath
+      conn <- open dbPath
-        execute conn
+      execute conn
-          "UPDATE pws SET views = views + 1 WHERE link = ?" (Only (link secret))
+        "UPDATE pws SET views = views + 1 WHERE link = ?" (Only (link secret))
-        close conn
+      close conn
 
--- Returns True if deletion occurs, informing the calling function to not 
+deleteExpiredSecret :: SecretEntry -> String -> IO Bool
--- provide the successfully retrieved secret to the requestor.
+deleteExpiredSecret sec dbPath = do
-deleteExpiredSecret :: [SecretEntry] -> String -> IO Bool
+  -- Get the current Unix Epoch time in seconds
-deleteExpiredSecret []         _ = return False
-deleteExpiredSecret (sec : _) dbPath = do
   time <- epochTime
+  -- Compare the current time against the secret's initial insertion and lifetime
   if ((date sec) + ((life sec) * 86400) < time) || (views sec >= maxViews sec)
+    -- Delete the secret if it's expired and return True for the caller
     then deleteSec sec dbPath
+    -- Only return False if the secret is not expired
     else return False
-    where
+  where
-      deleteSec :: SecretEntry -> String -> IO Bool
+    deleteSec :: SecretEntry -> String -> IO Bool
-      deleteSec sec dbPath = do
+    deleteSec sec dbPath = do
-        conn  <- open dbPath
+      conn  <- open dbPath
-        execute conn
+      execute conn
-          "DELETE FROM pws WHERE link = ?" (Only (link sec))
+        "DELETE FROM pws WHERE link = ?" (Only (link sec))
-        close conn
+      close conn
-        return True
+      return True
 
 insertNewSecret :: T.Text -> Integer -> T.Text -> Integer -> PurrAction ()
 insertNewSecret sec life link maxViews = do
   key    <- liftIO encKey
+  -- Create a new nonce to associate with the secret's encryption
   nonce  <- liftIO Box.newNonce
+  {- Encrypt the secret; this is a pure function because we seeded RNG at program
+     initialization with "sodiumInit" -}
   let encSec = encryptSecret key sec nonce
   conn   <- liftIO $ open dbPath
+  -- Get the current time to timestamp the secret's initial insertion
   time   <- liftIO epochTime
+  -- Save the secret to the database
   liftIO $ execute conn
     "INSERT INTO pws (link, secret, nonce, date, life, views, maxViews) VALUES (?, ?, ?, ?, ?, ?, ?)"
       (SecretEntry link (encodeSecret encSec) (CL.encode nonce) time life 0 maxViews)
@@ -94,15 +110,12 @@ decryptSecret k n b = do
   case (CL.decode k) of 
     (Just key) -> case (CL.decode n) of
       (Just nonce) -> Box.secretboxOpen key nonce b
+      {- There's no sensible way to fail gracefully if our nonce or secret
+         key can't be decoded. Throw an error so the instance admin can 
+         investigate -}
       Nothing -> error "Failed to decode nonce"
     Nothing -> error "Failed to decode secret key"
 
+-- Helper function to provide the current Epoch Time in seconds
 epochTime :: IO Integer
 epochTime = fmap round getPOSIXTime
-
-failedSecret :: SecretEntry
-failedSecret = SecretEntry "fail" "fail" (BSC8.pack "fail") 0 0 0 0
-
-safeHead :: a -> [a] -> a
-safeHead x [] = x
-safeHead x l  = head l

src/Lib.hs

@@ -10,12 +10,22 @@ import           GHC.Natural                   (popCountNatural)
 import           Prelude                       hiding (id)
 import           Web.Scotty
 
+-- Purr's entrypoint
 main :: IO () 
 main = do
+  -- Initialize the RNG used for sodium encryption (Saltine library)
   sodiumInit 
+  {- Initialize our dotenv configuration which reads from a .env configuration
+     file unless the PURRNOFILE env var exists already. -}
   Configuration.main 
+  {- Initialize the encryption key file if it doesn't
+     exist yet or use the existing key -}
   Configuration.keyFileInit 
+  {- Initialize our database by ensuring the SQLite file exists
+     and has tables setup as the application expects -}
   DB.main
+  {- Get the configured port to run on and start the Scotty webserver app
+     defined in HTTP.app -}
   appPortStr <- Configuration.appPort
   let appPort = read appPortStr :: Int
   scotty appPort HTTP.app