From 9ad3d1ee7acce4f294267090ab5a017b3801bb65 Mon Sep 17 00:00:00 2001 From: James Eversole Date: Fri, 16 Feb 2024 18:30:06 -0600 Subject: [PATCH] Working saltine encryption and decryption --- src/Core/SQLite.hs | 6 +++-- src/Core/Types.hs | 4 ++-- src/Feature/Sharing/SQLite.hs | 42 +++++++++++++++++++++-------------- 3 files changed, 31 insertions(+), 21 deletions(-) diff --git a/src/Core/SQLite.hs b/src/Core/SQLite.hs index f4f3dc8..2b1cd9e 100644 --- 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 index 77252b2..f47d272 100644 --- 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 index 5702c76..3ea8eaa 100644 --- 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