purr

commit 910859bce6bdb37e9724c61211f5d510a43bed2b
parent ca73ed7982881f8df02d6c8ca0b5df37475c41a4
Author: James Eversole <james@eversole.co>
Date:   Fri,  5 Aug 2022 15:42:37 -0500

Track the number of views for secrets, delete secrets on next lookup attempt when the lifespan or max viewcount is exceeded.

Diffstat:
M
src/Feature/Sharing/SQLite.hs
 | 
40
+++++++++++++++++++++++++++++++++++++---
M
views/gen.hamlet
 | 
24
++++++++++++++++++++++++

2 files changed, 61 insertions(+), 3 deletions(-)
diff --git a/src/Feature/Sharing/SQLite.hs b/src/Feature/Sharing/SQLite.hs
@@ -39,10 +39,44 @@ insertNewSecret sec life link maxViews = do
 
 readEncryptedSecret :: String -> [SecretEntry] -> PurrAction (Maybe T.Text)
 readEncryptedSecret key sec = do
-  decKey <- liftIO
-    (sequence $ decryptSecret key <$> decodeSecret <$> listToMaybe sec)
-  return (ET.decodeLatin1 <$> decKey)
+  db     <- dbPath
+  liftIO  $ incViews sec db
+  delete <- liftIO $ deleteExpiredSecret sec db
+  decKey <- liftIO ( sequence 
+                   $ decryptSecret key 
+                 <$> decodeSecret 
+                 <$> listToMaybe sec )
+  if (delete)
+    then return Nothing
+    else return (ET.decodeLatin1 <$> decKey)
+      where
+        incViews :: [SecretEntry] -> String -> IO ()
+        incViews []        _  = return ()
+        incViews (sec : _) db = do
+          conn <- liftIO $ open db
+          liftIO $ execute conn
+            "UPDATE pws SET views = views + 1 WHERE link = ?" (Only (link sec))
+          liftIO $ close conn
 
+-- Returns True if deletion occurs, informing the caller to not provide
+-- the successfully retrieved secret to the requestor.
+deleteExpiredSecret :: [SecretEntry] -> String -> IO Bool
+deleteExpiredSecret [] _ = return False
+deleteExpiredSecret (sec : _) db = do
+  time <- liftIO $ epochTime
+  if  ((date sec) + ((life sec) * 86400) < time) || 
+       (views sec >= maxViews sec) 
+    then deleteSec sec db
+    else return False
+    where
+      deleteSec :: SecretEntry -> String -> IO Bool
+      deleteSec sec db = do
+        conn  <- liftIO $ open db
+        liftIO $ execute conn 
+          "DELETE FROM pws WHERE link = ?" (Only (link sec))
+        liftIO $ close conn
+        return True
+  
 encodeSecret :: B.ByteString -> T.Text
 encodeSecret b = ET.decodeUtf8 $ B64.encode b
 
diff --git a/views/gen.hamlet b/views/gen.hamlet
@@ -9,11 +9,35 @@
   />
     Generate New Password
   <br />
+
   <button .mainButton
     hx-post="/new"
     hx-target="#requestedPw"
     hx-swap="outerHTML"
+    hx-include="[id='generators']"
     *{hsGeneratedSharing}
   />
     Share Generated Password
     <img class="htmx-indicator" src="/loading.svg" />
+
+  <br />
+  Valid for:
+  <br />
+
+  <input .numberInput
+    name="newSecDuration"
+    type="number"
+    min="1"
+    max="90"
+    value="20"
+    onkeyup="if (value < 1 || value > 90) { value = 0 }"
+  /> days
+  <input .numberInput
+    name="newSecViews"
+    type="number"
+    min="1"
+    max="60"
+    value="20"
+    onkeyup="if (value < 1 || value > 60) { value = 0 }"
+  /> views
+