commit 9ad3d1ee7acce4f294267090ab5a017b3801bb65
parent f9c3a40c991a3f489f44e3d96e2aaf793801540a
Author: James Eversole <james@eversole.co>
Date: Fri, 16 Feb 2024 18:30:06 -0600
Working saltine encryption and decryption
Diffstat:
3 files changed, 31 insertions(+), 21 deletions(-)
diff --git a/src/Core/SQLite.hs b/src/Core/SQLite.hs
@@ -3,6 +3,7 @@ module Core.SQLite where
import Core.Types
import Control.Monad.Reader (ask, lift, liftIO)
+import Data.ByteString as B
import Database.SQLite.Simple
import Database.SQLite.Simple.FromRow
@@ -15,6 +16,7 @@ main db = do
"CREATE TABLE IF NOT EXISTS pws\
\ (link TEXT PRIMARY KEY,\
\ secret TEXT,\
+ \ nonce TEXT,\
\ date DATETIME DEFAULT CURRENT_TIMESTAMP,\
\ life INT,\
\ views INT,\
@@ -24,8 +26,8 @@ main db = do
dbPath :: PurrAction String
dbPath = lift ask >>= (\a -> return $ dbFile a)
-encKey :: PurrAction String
-encKey = lift ask >>= (\a -> return $ dbKey a)
+encKey :: IO ByteString
+encKey = B.readFile "./data/key"
confLinkLength :: PurrAction Int
confLinkLength = lift ask >>= (\a -> return $ linkLength a)
diff --git a/src/Core/Types.hs b/src/Core/Types.hs
@@ -2,7 +2,7 @@ module Core.Types where
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
-
+import Data.ByteString as B
import Control.Monad.Reader (MonadIO, MonadReader, ReaderT)
import Data.Text
import Database.SQLite.Simple (ToRow)
@@ -34,7 +34,6 @@ data DhallConfig = DhallConfig
, applicationHost :: String
, applicationPort :: Int
, dbFile :: String
- , dbKey :: String
, linkLength :: Int
, adminEmail :: String
} deriving (Generic, Show)
@@ -42,6 +41,7 @@ data DhallConfig = DhallConfig
data SecretEntry = SecretEntry
{ link :: T.Text
, secret :: T.Text
+ , nonce :: B.ByteString
, date :: Integer
, life :: Integer
, views :: Integer
diff --git a/src/Feature/Sharing/SQLite.hs b/src/Feature/Sharing/SQLite.hs
@@ -6,14 +6,15 @@ import Feature.Generation.Passwords (Password)
import Control.Monad.Reader (ask, lift, liftIO)
import Data.List.Split (splitOn)
-import Data.Maybe (listToMaybe, fromMaybe)
+import Data.Maybe (listToMaybe, fromMaybe, Maybe(Just))
import Data.Time.Clock.POSIX (getPOSIXTime)
import Database.SQLite.Simple
import qualified Crypto.Saltine.Core.SecretBox as Box
-import qualified Crypto.Saltine.Internal.SecretBox as IBox
+import qualified Crypto.Saltine.Class as CL
import qualified Data.ByteString.Base64 as B64
-import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Char8 as BSC8
+import qualified Data.ByteString as B
import qualified Data.Text as T
import qualified Data.Text.Encoding as ET
import qualified Data.Text.Lazy as LT
@@ -21,7 +22,7 @@ import qualified Data.Text.Lazy as LT
findByLink :: String -> PurrAction (Maybe T.Text)
findByLink link = do
db <- dbPath
- key <- encKey
+ key <- liftIO encKey
conn <- liftIO $ open db
res <- liftIO $ query conn "SELECT * from pws WHERE link = ?" (Only (last $ splitOn "/" link))
liftIO $ close conn
@@ -30,26 +31,26 @@ findByLink link = do
insertNewSecret :: T.Text -> Integer -> T.Text -> Integer -> PurrAction ()
insertNewSecret sec life link maxViews = do
db <- dbPath
- key <- encKey
+ key <- liftIO encKey
nonce <- liftIO $ Box.newNonce
let encSec = encryptSecret key sec nonce
conn <- liftIO $ open db
time <- liftIO $ epochTime
liftIO $ execute conn
- "INSERT INTO pws (link, secret, date, life, views, maxViews) VALUES (?, ?, ?, ?, ?, ?)"
- (SecretEntry link (encodeSecret encSec) time life 0 maxViews)
+ "INSERT INTO pws (link, secret, nonce, date, life, views, maxViews) VALUES (?, ?, ?, ?, ?, ?, ?)"
+ (SecretEntry link (encodeSecret encSec) (CL.encode nonce) time life 0 maxViews)
liftIO $ close conn
-readEncryptedSecret :: String -> [SecretEntry] -> PurrAction (Maybe T.Text)
+readEncryptedSecret :: B.ByteString -> [SecretEntry] -> PurrAction (Maybe T.Text)
readEncryptedSecret key sec = do
db <- dbPath
- nonce <- liftIO $ Box.newNonce
- liftIO $ incViews sec db
+ let secNonce = nonce $ safeHead failedSecret sec
+ liftIO $ incViews sec db
delete <- liftIO $ deleteExpiredSecret sec db
- let decKey = decryptSecret key nonce $ decodeSecret $ safeHead failedSecret sec
+ let decSec = decryptSecret key secNonce $ decodeSecret $ safeHead failedSecret sec
if (delete)
then return Nothing
- else return (ET.decodeLatin1 <$> decKey)
+ else return (ET.decodeLatin1 <$> decSec)
where
incViews :: [SecretEntry] -> String -> IO ()
incViews [] _ = return ()
@@ -83,18 +84,25 @@ encodeSecret b = ET.decodeUtf8 $ B64.encode b
decodeSecret :: SecretEntry -> B.ByteString
decodeSecret s = B64.decodeLenient $ ET.encodeUtf8 (secret s)
-encryptSecret :: String -> T.Text -> Box.Nonce -> B.ByteString
+encryptSecret :: B.ByteString -> T.Text -> Box.Nonce -> B.ByteString
encryptSecret k s n = do
- Box.secretbox (IBox.Key $ B.pack k) n (ET.encodeUtf8 s)
+ case (CL.decode k) of
+ (Just key) -> Box.secretbox key n (ET.encodeUtf8 s)
+ Nothing -> error "fail"
-decryptSecret :: String -> Box.Nonce -> B.ByteString -> Maybe B.ByteString
-decryptSecret k n b = Box.secretboxOpen (IBox.Key $ B.pack k) n b
+decryptSecret :: B.ByteString -> B.ByteString -> B.ByteString -> Maybe B.ByteString
+decryptSecret k n b = do
+ case (CL.decode k) of
+ (Just key) -> case (CL.decode n) of
+ (Just nonce) -> Box.secretboxOpen key nonce b
+ Nothing -> error "Failed to decode nonce"
+ Nothing -> error "Failed to decode secret key"
epochTime :: IO Integer
epochTime = fmap round getPOSIXTime
failedSecret :: SecretEntry
-failedSecret = SecretEntry "fail" "fail" 0 0 0 0
+failedSecret = SecretEntry "fail" "fail" (BSC8.pack "fail") 0 0 0 0
safeHead :: a -> [a] -> a
safeHead x [] = x
