James/purr
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Updated README with project goals, started prototyping frontend and added route for primary css dist, added reasonable functionality for requesting a password directly via link as well as patching index DOM when requesting HTML stub from /pw

Browse Source
This commit is contained in:
James Eversole
2022-07-03 21:48:40 -05:00
parent 7274560398
commit f1b18f3b47
10 changed files with 211 additions and 43 deletions
Download Patch File Download Diff File Expand all files Collapse all files

25
src/Feature/Sharing/HTTP.hs
View File

@ -1,9 +1,10 @@
module Feature.Sharing.HTTP ( routes ) where
import Core.Types
import Core.Types
import Core.Templates (renderIndex)
import Feature.Sharing.Templates
import qualified Feature.Sharing.Mongo as DB
import Feature.Sharing.Templates (renderPw)
import qualified Feature.Sharing.Mongo as DB
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
@ -12,21 +13,21 @@ 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)
import Prelude hiding (lookup)
routes :: PurrApp ()
routes = do
get "/pw/:id" $ do
id <- param "id"
doc <- DB.findByLink id
html $ renderPw id (pwLookup doc)
reqId <- param "id"
doc <- DB.findByLink reqId
html $ renderIndex reqId (pwLookup doc)
post "/pw" $ do
id <- param "userLink"
doc <- DB.findByLink id
html $ renderPw id (pwLookup doc)
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
pwLookup (Just x) = lookup "password" x
pwLookup _ = Nothing