Squashed commit of the following:

commit 9aaa5307e7671bc8bcc444733a6e38999f346772
Author: James Eversole <james@eversole.co>
Date:   Mon Jul 18 16:03:43 2022 -0500

    Completed migration to SQLite, full feature parity with original Mongo/Couch implementations. Added ability to submit new passwords with full frontend functionality. Generation of random links now functions as expected and Unix Epoch Timestamps are now included in DB entries.

src/Core/Couch.hs

@@ -1,79 +0,0 @@
-module Core.Couch where
-
-import Core.Types
-
-import Control.Monad.Reader (MonadIO, lift, ask)
-import Data.Aeson
-import Network.HTTP.Req     as Req
-
-import qualified Data.Text                  as T
-import qualified Data.ByteString.Char8      as B
-import qualified Data.ByteString.Lazy.Char8 as LB
-
-getAllDBs :: PurrAction LbsResponse
-getAllDBs = do
-  host <- dbHost
-  user <- dbUser
-  pw   <- dbPassword
-  req
-    GET
-    (http host /: "_all_dbs")
-    NoReqBody
-    lbsResponse $
-    basicAuthUnsafe user pw
-      <>
-    Req.port 5984
-
-createDB :: (FromJSON a) => T.Text -> PurrAction (JsonResponse a)
-createDB dbName  = do
-  host <- dbHost
-  user <- dbUser
-  pw   <- dbPassword
-  req
-    PUT
-    (http host /: dbName)
-    NoReqBody
-    jsonResponse $
-    basicAuthUnsafe user pw
-      <>
-    Req.port 5984
-
-getAllDocs :: PurrAction LbsResponse
-getAllDocs = do
-  host   <- dbHost
-  dbName <- confDb
-  user   <- dbUser
-  pw     <- dbPassword
-  req
-    GET
-    (http host /: dbName)
-    NoReqBody
-    lbsResponse $
-    basicAuthUnsafe user pw
-      <>
-    Req.port 5984
-
-confDb :: PurrAction T.Text
-confDb = do
-  conf <- lift ask
-  return $ T.pack $ dataDB conf
-
-dbHost :: PurrAction T.Text
-dbHost = do
-  conf <- lift ask
-  return $ T.pack $ couchHost conf
-
-dbPort :: PurrAction Int
-dbPort = do
-  conf <- lift ask
-  return $ couchPort conf
-
-dbPassword :: PurrAction B.ByteString
-dbPassword = do
-  conf <- lift ask
-  return $ B.pack $ couchPassword conf
-
-dbUser :: PurrAction B.ByteString
-dbUser = do
-  conf <- lift ask
-  return $ B.pack $ couchUsername conf

src/Core/SQLite.hs

@@ -0,0 +1,24 @@
+module Core.SQLite where
+
+import Core.Types
+
+import Control.Monad.Reader           (ask, lift, liftIO)
+import Database.SQLite.Simple
+import Database.SQLite.Simple.FromRow
+
+import qualified Data.Text                  as T
+
+main :: String -> IO ()
+main db = do 
+  conn <- open db
+  execute_ conn 
+    "CREATE TABLE IF NOT EXISTS pws\
+    \ (link TEXT PRIMARY KEY,\
+    \ secret TEXT,\
+    \ date DATETIME DEFAULT CURRENT_TIMESTAMP)"
+  close conn
+
+dbPath :: PurrAction String
+dbPath = do
+  conf <- lift ask
+  return $ dbFile conf

src/Core/Templates.hs

@@ -3,16 +3,18 @@
 
 module Core.Templates ( renderIndex, renderStyle ) where
 
-import Data.Text.Lazy                (Text)
 import Text.Blaze.Html.Renderer.Text (renderHtml)
 import Text.Blaze.Html
 import Text.Cassius                  (cassiusFile, renderCss)
 import Text.Hamlet                   (shamletFile)
 
+import qualified Data.Text      as T
+import qualified Data.Text.Lazy as LT
+
 import Prelude 
 
-renderIndex :: String -> Maybe String -> Text
+renderIndex :: String -> Maybe T.Text -> LT.Text
 renderIndex link password = renderHtml ( $(shamletFile "./views/index.hamlet") )
 
-renderStyle :: Text
+renderStyle :: LT.Text
 renderStyle = renderCss ( $(cassiusFile "./views/cassius/style.cassius") "/style.css" )

src/Core/Types.hs

@@ -5,7 +5,6 @@ import qualified Data.Text.Lazy as LT
 import Control.Monad.Reader (MonadIO, MonadReader, ReaderT)
 import Data.Text
 import GHC.Generics         (Generic)
-import Network.HTTP.Req     (HttpException, MonadHttp, handleHttpException)
 import Numeric.Natural      (Natural)
 import Web.Scotty.Trans     (ScottyT, ActionT)
 
@@ -16,17 +15,9 @@ newtype ConfigM a = ConfigM
   { runConfigM :: ReaderT DhallConfig IO a
   } deriving (Applicative, Functor, Monad, MonadIO, MonadReader DhallConfig)
 
-instance MonadHttp (ActionT LT.Text ConfigM) where
-  handleHttpException = error . show
-
 data DhallConfig = DhallConfig
   { environment     :: String
   , applicationHost :: String
   , applicationPort :: Int
-  , couchHost       :: String
-  , couchPort       :: Int
-  , couchUsername   :: String
-  , couchPassword   :: String
-  , adminDB         :: String
-  , dataDB          :: String
+  , dbFile          :: String
   } deriving (Generic, Show)