Squashed commit of the following:

commit 86ee3c4d262916bec531ad5616273b391cdffeb3
Author: James Eversole <james@eversole.co>
Date:   Tue Jul 5 20:09:22 2022 -0500

    Refactored findByLink for modularity, started prototyping document creation

commit 65b68df295069edb57adcdc16a3300c9d762dc2f
Author: James Eversole <james@eversole.co>
Date:   Tue Jul 5 18:45:25 2022 -0500

    Feature parity with MongoDB implementation in main; need to refactor Feature.Sharing.Couch.findByLink into multiple functions so that more information regarding retrieved documents can be used compositionally to DRY before merging into main

commit e10cc4de8acd45488679f0587732f02fee950c77
Author: James Eversole <james@eversole.co>
Date:   Mon Jul 4 20:53:55 2022 -0500

    Better configuration file keys

commit d683a51cac4ad891856f7782aa6221402988fea4
Author: James Eversole <james@eversole.co>
Date:   Mon Jul 4 20:38:40 2022 -0500

    Added beginnings of CouchDB logic while removing all Mongo references and dependencies. Updated configuration file and related data types. Added a MonadHttp instance for PurrAction to enable requests in their monadic context. Will merge into main once feature parity on the Sharing Feature is reached

src/Core/Couch.hs

@@ -0,0 +1,79 @@
+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/Mongo.hs

@@ -1,21 +0,0 @@
-module Core.Mongo ( mongoSetup ) where
-
-import Core.Types
-
-import Control.Monad.Reader (MonadIO, lift, ask)
-import Data.Maybe
-import Data.Text            (Text)
-import Database.MongoDB
-import Prelude
-
--- Authenticates to Mongo and returns the MongoContext for the dataDB
-mongoSetup :: DhallConfig -> IO MongoContext
-mongoSetup conf = do
-  mongoCon     <- connect $ host (hostname conf)
-  let adminCon  = MongoContext mongoCon master (adminDB conf)
-  access 
-    (mongoPipe       adminCon) 
-    (mongoAccessMode adminCon) 
-    (mongoDatabase   adminCon) 
-    (auth (mongoUsername conf) (mongoPassword conf))
-  return $ MongoContext mongoCon master (dataDB conf)

src/Core/Templates.hs

@@ -4,7 +4,6 @@
 module Core.Templates ( renderIndex, renderStyle ) where
 
 import Data.Text.Lazy                (Text)
-import Database.MongoDB              (Document)
 import Text.Blaze.Html.Renderer.Text (renderHtml)
 import Text.Blaze.Html
 import Text.Cassius                  (cassiusFile, renderCss)

src/Core/Types.hs

@@ -4,8 +4,8 @@ import qualified Data.Text.Lazy as LT
 
 import Control.Monad.Reader (MonadIO, MonadReader, ReaderT)
 import Data.Text
-import Database.MongoDB     (MongoContext)
 import GHC.Generics         (Generic)
+import Network.HTTP.Req     (HttpException, MonadHttp, handleHttpException)
 import Numeric.Natural      (Natural)
 import Web.Scotty.Trans     (ScottyT, ActionT)
 
@@ -13,21 +13,20 @@ type PurrApp    a = ScottyT LT.Text ConfigM a
 type PurrAction a = ActionT LT.Text ConfigM a
 
 newtype ConfigM a = ConfigM
-  { runConfigM :: ReaderT AppConfig IO a
-  } deriving (Applicative, Functor, Monad, MonadIO, MonadReader AppConfig)
+  { runConfigM :: ReaderT DhallConfig IO a
+  } deriving (Applicative, Functor, Monad, MonadIO, MonadReader DhallConfig)
 
-data AppConfig = AppConfig
-  { res    :: DhallConfig
-  , dbconn :: MongoContext
-  }
+instance MonadHttp (ActionT LT.Text ConfigM) where
+  handleHttpException = error . show
 
 data DhallConfig = DhallConfig
-  { hostname      :: String
-  , port          :: Int
-  , environment   :: Text
-  , adminDB       :: Text
-  , dataDB        :: Text
-  , collection    :: Text
-  , mongoUsername :: Text
-  , mongoPassword :: Text
+  { environment     :: String
+  , applicationHost :: String
+  , applicationPort :: Int
+  , couchHost       :: String
+  , couchPort       :: Int
+  , couchUsername   :: String
+  , couchPassword   :: String
+  , adminDB         :: String
+  , dataDB          :: String
   } deriving (Generic, Show)