James Eversole
6a0b5b0144
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
79 lines
1.9 KiB
Haskell
79 lines
1.9 KiB
Haskell
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
|