Read encrypted secret entries from the database and decode/unencrypt appropriately, add max duration/view count entries for the database and frontend interface, update README to remove graceful JS degradation goal, remove a few wordlist entries

src/Feature/Generation/wordlist.txt

@@ -175,7 +175,6 @@ bread
 break
 breast
 breath
-breed
 brick
 bridge
 brief
@@ -820,9 +819,7 @@ media
 medium
 meet
 melt
-member
 memory
-mental
 menu
 mere
 merely
@@ -1035,7 +1032,6 @@ profit
 prompt
 proof
 proper
-proud
 prove
 public
 pull

src/Feature/Sharing/HTTP.hs

@@ -26,10 +26,12 @@ routes = do
   post "/pw" $ do
     reqId <- param "userLink"
     res   <- findByLink reqId
-    html   $ renderPw reqId (secret <$> res)
+    html   $ renderPw reqId res
 
   post "/new" $ do 
     reqSecret <- param "newSec"
+    reqDur    <- param "newSecDuration"
+    reqViews  <- param "newSecViews"
     link      <- genLink
-    insertNewSecret reqSecret (T.pack link)
+    insertNewSecret reqSecret reqDur (T.pack link) reqViews
     html       $ renderPw link (Just reqSecret)

src/Feature/Sharing/SQLite.hs

@@ -9,7 +9,6 @@ import Crypto.Simple.CBC              (encrypt, decrypt)
 import Data.Maybe                     (listToMaybe)
 import Data.Time.Clock.POSIX          (getPOSIXTime)
 import Database.SQLite.Simple
-import Database.SQLite.Simple.FromRow
 
 import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.Char8  as B
@@ -17,28 +16,44 @@ import qualified Data.Text              as T
 import qualified Data.Text.Encoding     as ET
 import qualified Data.Text.Lazy         as LT
 
-findByLink :: String -> PurrAction (Maybe SecretEntry)
+findByLink :: String -> PurrAction (Maybe T.Text)
 findByLink link = do
-  db   <- dbPath
-  conn <- liftIO $ open db
-  res  <- liftIO $ query conn "SELECT * from pws WHERE link = ?" (Only link)
+  db    <- dbPath
+  key   <- encKey
+  conn  <- liftIO $ open db
+  res   <- liftIO $ query conn "SELECT * from pws WHERE link = ?" (Only link)
   liftIO $ close conn
-  return $ listToMaybe res
+  readEncryptedSecret key res
 
-insertNewSecret :: T.Text -> T.Text -> PurrAction ()
-insertNewSecret sec link = do
+insertNewSecret :: T.Text -> Integer -> T.Text -> Integer -> PurrAction ()
+insertNewSecret sec life link maxViews = do
   db     <- dbPath
   key    <- encKey
-  encSec <- liftIO $ encrypt (B.pack key) (ET.encodeUtf8 sec)
+  encSec <- liftIO $ encryptSecret key sec
   conn   <- liftIO $ open db
   time   <- liftIO $ epochTime
-  liftIO $ execute conn 
-    "INSERT INTO pws (link, secret, date) VALUES (?, ?, ?)"
-      (SecretEntry link (encodeSecret encSec) time)
-  liftIO $ close conn
+  liftIO  $ execute conn 
+    "INSERT INTO pws (link, secret, date, life, views, maxViews) VALUES (?, ?, ?, ?, ?, ?)"
+      (SecretEntry link (encodeSecret encSec) time life 0 maxViews)
+  liftIO  $ close conn
 
-epochTime :: IO Integer
-epochTime = fmap round getPOSIXTime
+readEncryptedSecret :: String -> [SecretEntry] -> PurrAction (Maybe T.Text)
+readEncryptedSecret key sec = do
+  decKey <- liftIO
+    (sequence $ decryptSecret key <$> decodeSecret <$> listToMaybe sec)
+  return (ET.decodeLatin1 <$> decKey)
 
 encodeSecret :: B.ByteString -> T.Text
 encodeSecret b = ET.decodeUtf8 $ B64.encode b
+
+decodeSecret :: SecretEntry -> B.ByteString
+decodeSecret s = B64.decodeLenient $ ET.encodeUtf8 (secret s)
+
+encryptSecret :: String -> T.Text -> IO B.ByteString
+encryptSecret k s = encrypt (B.pack k) (ET.encodeUtf8 s)
+
+decryptSecret :: String -> B.ByteString -> IO B.ByteString
+decryptSecret k b = decrypt (B.pack k) b 
+
+epochTime :: IO Integer
+epochTime = fmap round getPOSIXTime

src/Feature/Sharing/Types.hs

@@ -10,9 +10,12 @@ import Database.SQLite.Simple.FromRow
 import qualified Data.Text as T
 
 data SecretEntry = SecretEntry 
- { link   :: T.Text 
- , secret :: T.Text 
- , date   :: Integer
+ { link     :: T.Text 
+ , secret   :: T.Text 
+ , date     :: Integer
+ , life     :: Integer
+ , views    :: Integer
+ , maxViews :: Integer
  } deriving (Show, Generic)
 
 instance FromRow SecretEntry where