module Feature.Sharing.SQLite where

import           Core.SQLite
import           Core.Types
import           Feature.Generation.Passwords (Password)

import           Control.Monad.Reader          (ask, lift, liftIO)
import           Data.List.Split               (splitOn)
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.Class              as CL 
import qualified Data.ByteString.Base64            as B64
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

findByLink :: String -> PurrAction (Maybe T.Text)
findByLink link = do
  db    <- dbPath
  key   <- liftIO encKey
  conn  <- liftIO $ open db
  res   <- liftIO $ query conn "SELECT * from pws WHERE link = ?" (Only (last $ splitOn "/" link))
  liftIO $ close conn
  readEncryptedSecret key res

insertNewSecret :: T.Text -> Integer -> T.Text -> Integer -> PurrAction ()
insertNewSecret sec life link maxViews = do
  db     <- dbPath
  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, nonce, date, life, views, maxViews) VALUES (?, ?, ?, ?, ?, ?, ?)"
      (SecretEntry link (encodeSecret encSec) (CL.encode nonce) time life 0 maxViews)
  liftIO  $ close conn

readEncryptedSecret :: B.ByteString -> [SecretEntry] -> PurrAction (Maybe T.Text)
readEncryptedSecret key sec = do
  db     <- dbPath
  let secNonce = nonce $ safeHead failedSecret sec
  liftIO $ incViews sec db
  delete <- liftIO $ deleteExpiredSecret sec db
  let decSec = decryptSecret key secNonce $ decodeSecret $ safeHead failedSecret sec
  if (delete)
    then return Nothing
    else return (ET.decodeLatin1 <$> decSec)
    where
      incViews :: [SecretEntry] -> String -> IO ()
      incViews []         _ = return ()
      incViews (sec : _) db = do
        conn <- liftIO $ open db
        liftIO $ execute conn
          "UPDATE pws SET views = views + 1 WHERE link = ?" (Only (link sec))
        liftIO $ close conn

-- Returns True if deletion occurs, informing the caller to not provide
-- the successfully retrieved secret to the requestor.
deleteExpiredSecret :: [SecretEntry] -> String -> IO Bool
deleteExpiredSecret []         _ = return False
deleteExpiredSecret (sec : _) db = do
  time <- liftIO $ epochTime
  if ((date sec) + ((life sec) * 86400) < time) || (views sec >= maxViews sec)
    then deleteSec sec db
    else return False
    where
      deleteSec :: SecretEntry -> String -> IO Bool
      deleteSec sec db = do
        conn  <- liftIO $ open db
        liftIO $ execute conn
          "DELETE FROM pws WHERE link = ?" (Only (link sec))
        liftIO $ close conn
        return True

encodeSecret :: B.ByteString -> T.Text
encodeSecret b = ET.decodeUtf8 $ B64.encode b

decodeSecret :: SecretEntry -> B.ByteString
decodeSecret s = B64.decodeLenient $ ET.encodeUtf8 (secret s)

encryptSecret :: B.ByteString -> T.Text -> Box.Nonce ->  B.ByteString
encryptSecret k s n = do 
  case (CL.decode k) of
    (Just key) -> Box.secretbox key n (ET.encodeUtf8 s)
    Nothing -> error "fail"

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" (BSC8.pack "fail") 0 0 0 0

safeHead :: a -> [a] -> a
safeHead x [] = x
safeHead x l  = head l