Don't allow configuration of dbFile path or name; use the DATADIR and a hardcoded path
This commit is contained in:
parent
f065300113
commit
0e8144b82c
@ -2,6 +2,5 @@ ENVIRONMENT="production"
|
||||
APPLICATIONHOST="localhost"
|
||||
APPLICATIONPORT="3000"
|
||||
DATADIR="./"
|
||||
DBFILE="data/Purr.sqlite"
|
||||
LINKLENGTH="24"
|
||||
ADMINEMAIL="admin@purr.example.com"
|
||||
|
@ -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"
|
||||
|
@ -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)
|
||||
|
@ -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,\
|
||||
|
@ -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
|
||||
|
||||
|
@ -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 (?, ?, ?, ?, ?, ?, ?)"
|
||||
|
Loading…
x
Reference in New Issue
Block a user