Don't allow configuration of dbFile path or name; use the DATADIR and a hardcoded path

This commit is contained in:
James Eversole 2024-02-17 08:41:39 -06:00
parent f065300113
commit 0e8144b82c
6 changed files with 15 additions and 20 deletions

View File

@ -2,6 +2,5 @@ ENVIRONMENT="production"
APPLICATIONHOST="localhost"
APPLICATIONPORT="3000"
DATADIR="./"
DBFILE="data/Purr.sqlite"
LINKLENGTH="24"
ADMINEMAIL="admin@purr.example.com"

View File

@ -33,8 +33,8 @@ appPort = getEnv "APPLICATIONPORT"
dataPath :: IO String
dataPath = getEnv "DATADIR"
dbPath :: IO String
dbPath = getEnv "DBFILE"
dbPath :: String
dbPath = "data/Purr.sqlite"
confLinkLength :: IO String
confLinkLength = getEnv "LINKLENGTH"

View File

@ -1,6 +1,6 @@
module Core.HTTP ( app ) where
import Core.Configuration (dbPath, adminEmail, confLinkLength)
import Core.Configuration (adminEmail, confLinkLength)
import Core.Types
import Core.Templates (renderIndex, renderStyle)

View File

@ -11,8 +11,7 @@ import qualified Data.Text as T
main :: IO ()
main = do
db <- dbPath
conn <- open db
conn <- open dbPath
execute_ conn
"CREATE TABLE IF NOT EXISTS pws\
\ (link TEXT PRIMARY KEY,\

View File

@ -1,6 +1,6 @@
module Feature.Sharing.HTTP ( routes ) where
import Core.Configuration (dbPath, adminEmail, confLinkLength)
import Core.Configuration (adminEmail, confLinkLength)
import Core.Templates (renderIndex)
import Core.Types

View File

@ -22,19 +22,17 @@ import qualified Data.Text.Lazy as LT
findByLink :: String -> PurrAction (Maybe T.Text)
findByLink link = do
db <- liftIO dbPath
key <- liftIO encKey
conn <- liftIO $ open db
conn <- liftIO $ open dbPath
res <- liftIO $ query conn "SELECT * from pws WHERE link = ?" (Only (last $ splitOn "/" link))
liftIO $ close conn
readEncryptedSecret key res
readEncryptedSecret :: B.ByteString -> [SecretEntry] -> PurrAction (Maybe T.Text)
readEncryptedSecret key secret = do
db <- liftIO dbPath
let secNonce = nonce $ safeHead failedSecret secret
liftIO $ incViews secret db
delete <- liftIO $ deleteExpiredSecret secret db
liftIO $ incViews secret dbPath
delete <- liftIO $ deleteExpiredSecret secret dbPath
case secret of
[] -> return Nothing
(x:_) -> if (delete)
@ -43,8 +41,8 @@ readEncryptedSecret key secret = do
where
incViews :: [SecretEntry] -> String -> IO ()
incViews [] _ = return ()
incViews (secret : _) db = do
conn <- open db
incViews (secret : _) dbPath = do
conn <- open dbPath
execute conn
"UPDATE pws SET views = views + 1 WHERE link = ?" (Only (link secret))
close conn
@ -53,15 +51,15 @@ readEncryptedSecret key secret = do
-- provide the successfully retrieved secret to the requestor.
deleteExpiredSecret :: [SecretEntry] -> String -> IO Bool
deleteExpiredSecret [] _ = return False
deleteExpiredSecret (sec : _) db = do
deleteExpiredSecret (sec : _) dbPath = do
time <- epochTime
if ((date sec) + ((life sec) * 86400) < time) || (views sec >= maxViews sec)
then deleteSec sec db
then deleteSec sec dbPath
else return False
where
deleteSec :: SecretEntry -> String -> IO Bool
deleteSec sec db = do
conn <- open db
deleteSec sec dbPath = do
conn <- open dbPath
execute conn
"DELETE FROM pws WHERE link = ?" (Only (link sec))
close conn
@ -69,11 +67,10 @@ deleteExpiredSecret (sec : _) db = do
insertNewSecret :: T.Text -> Integer -> T.Text -> Integer -> PurrAction ()
insertNewSecret sec life link maxViews = do
db <- liftIO dbPath
key <- liftIO encKey
nonce <- liftIO Box.newNonce
let encSec = encryptSecret key sec nonce
conn <- liftIO $ open db
conn <- liftIO $ open dbPath
time <- liftIO epochTime
liftIO $ execute conn
"INSERT INTO pws (link, secret, nonce, date, life, views, maxViews) VALUES (?, ?, ?, ?, ?, ?, ?)"