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/Feature/Sharing/Couch.hs

@@ -0,0 +1,78 @@
+module Feature.Sharing.Couch where
+
+import Core.Types
+import Core.Couch (confDb, dbHost, dbPort, dbPassword, dbUser)
+import Feature.Sharing.Types
+
+import Control.Monad.Reader (MonadIO, lift, ask)
+import Data.Aeson
+import Data.Maybe (fromJust)
+import Data.Text.Encoding
+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
+
+findByLink :: String -> PurrAction FindResults
+findByLink link = do
+  host   <- dbHost
+  dbName <- confDb
+  dbPort <- dbPort
+  user   <- dbUser
+  pw     <- dbPassword
+  res    <- req
+    POST
+    (http host /: dbName /: "_find")
+    (ReqBodyJson postBody)
+    jsonResponse $ 
+    basicAuthUnsafe user pw
+      <>
+    Req.port dbPort 
+  return $ responseBody res
+    where
+      postBody :: Maybe Object
+      postBody = decodeStrict $ encodeUtf8 $
+        "{\"selector\": {\"link\": {\"$eq\": \"" <> sanitizeQ link <> "\"}}}"
+
+{- 
+createNewSecret :: String -> PurrAction ()
+createNewSecret sec = do
+  host   <- dbHost
+  dbName <- confDb
+  dbPort <- dbPort
+  user   <- dbUser
+  pw     <- dbPassword
+  res    <- req
+    POST 
+    (http host /: dbName)
+    (ReqBodyJson postBody)
+    jsonResponse $
+    basicAuthUnsafe user pw
+      <>
+    Req.port dbPort 
+  return $ responseBody res
+    where
+      postBody :: SecretEntry
+      postBody = SecretEntry
+        Nothing
+        Nothing
+        "notImplementedYet"
+        "zedNotImplementedYet"
+        sec
+-}
+      
+findToSecret :: FindResults -> Maybe String
+findToSecret doc = lookupSecret $ docs doc
+  where
+    lookupSecret :: [SecretEntry] -> Maybe String
+    lookupSecret []     = Nothing
+    lookupSecret (x:xs) = Just (secret x)
+
+sanitizeQ :: String -> T.Text
+sanitizeQ s = T.pack $ map sanitizeQ' s
+  where
+    sanitizeQ' :: Char -> Char
+    sanitizeQ' '"' = ' '
+    sanitizeQ' '\\' = ' '
+    sanitizeQ' c   = c

src/Feature/Sharing/HTTP.hs

@@ -3,31 +3,25 @@ module Feature.Sharing.HTTP ( routes ) where
 import Core.Types
 import Core.Templates (renderIndex)
 
-import           Feature.Sharing.Templates (renderPw)
-import qualified Feature.Sharing.Mongo     as DB
+import Feature.Sharing.Templates (renderPw)
+import Feature.Sharing.Couch     (findByLink, findToSecret)
 
 import qualified Data.Text      as T
 import qualified Data.Text.Lazy as LT
 
 import Control.Monad.Reader (ask, lift)
-import Data.AesonBson       (aesonify)
-import Data.Bson            (Document, Field (..), Value (..), lookup)
 import Web.Scotty.Trans 
-import Prelude              hiding (lookup)
+import Prelude 
 
 routes :: PurrApp ()
 routes = do 
 
   get "/pw/:id" $ do
-    reqId  <- param "id"
-    doc    <- DB.findByLink reqId
-    html    $ renderIndex reqId (pwLookup doc)
+    reqId     <- param "id"
+    secretRes <- findByLink reqId
+    html       $ renderIndex reqId (findToSecret secretRes)
 
   post "/pw" $ do
-    reqId  <- param "userLink"
-    doc    <- DB.findByLink reqId
-    html    $ renderPw reqId (pwLookup doc)
-
-pwLookup :: Maybe Document -> Maybe String
-pwLookup (Just x) = lookup "password" x
-pwLookup _        = Nothing
+    reqId     <- param "userLink"
+    secretRes <- findByLink reqId
+    html       $ renderPw reqId (findToSecret secretRes)

src/Feature/Sharing/Mongo.hs

@@ -1,35 +0,0 @@
-module Feature.Sharing.Mongo ( getAllDocs, findByLink ) where
-
-import Core.Types
-
-import Control.Monad.Reader (MonadIO, lift, ask)
-import Data.Maybe
-import Data.Text            (Text)
-import Database.MongoDB
-import Prelude
-
-findByLink :: String -> PurrAction (Maybe Document)
-findByLink link = do
-  col      <- confCollection
-  dataConn <- dataAccess
-  dataConn  $ findOne (select ["link" =: link] col)
-
-getAllDocs :: PurrAction [Document]
-getAllDocs = do
-  col      <- confCollection
-  dataConn <- dataAccess
-  dataConn  $ find (select [] col)
-    >>= rest
-
-dataAccess :: MonadIO m => PurrAction (Action m a -> m a)
-dataAccess = do
-  appConfig <- lift ask
-  return     $ access
-    (mongoPipe         $ dbconn appConfig)
-    (mongoAccessMode   $ dbconn appConfig)
-    (mongoDatabase     $ dbconn appConfig)
-
-confCollection :: PurrAction Text
-confCollection = do
-  appConfig <- lift ask
-  return     $ collection $ res appConfig

src/Feature/Sharing/Templates.hs

@@ -5,7 +5,6 @@ module Feature.Sharing.Templates ( renderPw ) where
 
 import qualified Data.Text.Lazy as LT
 
-import Database.MongoDB                (Document)
 import Text.Blaze.Html.Renderer.Text   (renderHtml)
 import Text.Blaze.Html
 import Text.Hamlet                     (shamletFile)

src/Feature/Sharing/Types.hs

@@ -0,0 +1,28 @@
+module Feature.Sharing.Types where
+
+import Data.Aeson
+import Data.Map.Strict (Map)
+import Data.Typeable   (Typeable)
+import GHC.Generics
+
+data SecretEntry = SecretEntry
+   { _id          :: Maybe String
+   , _rev         :: Maybe String
+   , creationTime :: String
+   , link         :: String
+   , secret       :: String
+   } deriving (Generic, Show, Typeable)
+
+data FindResults = FindResults
+  { bookmark :: String
+  , docs     :: [SecretEntry]
+  , warning  :: Maybe String
+  } deriving (Generic, Show, Typeable)
+
+instance ToJSON SecretEntry where
+  toEncoding = genericToEncoding defaultOptions
+instance ToJSON FindResults where
+  toEncoding = genericToEncoding defaultOptions
+
+instance FromJSON SecretEntry
+instance FromJSON FindResults