Working saltine encryption and decryption

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)

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

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