Beginnings of HTMX frontend interaction, able to request particular PWs by link names and patch the DOM appropriately

src/Feature/Handlers.hs

@@ -1,23 +0,0 @@
-module Feature.Handlers ( pwLookup ) where
-
-import Core.Types
-import Core.Templates
-import qualified Core.Mongo as DB
-
-import Control.Monad.Reader (ask, lift)
-import Data.AesonBson (aesonify)
-import Data.Bson (Document, Field (..), Value (Array, Doc), lookup)
-import qualified Data.Text as T
-import qualified Data.Text.Lazy as LT
-import Web.Scotty.Trans (html, param)
-import Prelude hiding (id, lookup)
-
-pwLookup :: PurrAction ()
-pwLookup = do 
-  id  <- param "id"
-  doc <- DB.findByLink id
-  html $ LT.pack $ renderIndex id (pwLook doc)
-    where
-      pwLook :: Maybe Document -> Maybe String
-      pwLook (Just x) = (lookup "password" x) :: Maybe String
-      pwLook _ = Nothing

src/Feature/Sharing/HTTP.hs

@@ -0,0 +1,32 @@
+module Feature.Sharing.HTTP ( routes ) where
+
+import           Core.Types
+
+import           Feature.Sharing.Templates
+import qualified Feature.Sharing.Mongo as DB
+
+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 (id, lookup)
+
+routes :: PurrApp ()
+routes = do 
+
+  get "/pw/:id" $ do
+    id  <- param "id"
+    doc <- DB.findByLink id
+    html $ renderPw id (pwLookup doc)
+
+  post "/pw" $ do
+    id  <- param "userLink"
+    doc <- DB.findByLink id
+    html $ renderPw id (pwLookup doc)
+
+pwLookup :: Maybe Document -> Maybe String
+pwLookup (Just x) = (lookup "password" x)
+pwLookup _ = Nothing

src/Feature/Sharing/Mongo.hs

@@ -0,0 +1,35 @@
+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

@@ -0,0 +1,16 @@
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+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)
+
+import Prelude 
+
+renderPw :: String -> Maybe String -> LT.Text
+renderPw link password = renderHtml ( $(shamletFile "./views/pw.hamlet") )