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

src/Core/Configuration.hs

@@ -1,6 +1,6 @@
 module Core.Configuration ( main ) where
 
-import Core.Types 
+import Core.Types
 
 import Dhall
 

src/Core/HTTP.hs

@@ -2,11 +2,12 @@ module Core.HTTP ( app ) where
 
 import Core.Types
 
-import Core.Templates       (renderIndex)
+import Core.Templates       (renderIndex, renderStyle)
 import Feature.Sharing.HTTP as Sharing
 
+import Data.Maybe                           (Maybe (Nothing))
 import Network.Wai.Middleware.RequestLogger (logStdoutDev)
-import Web.Scotty.Trans 
+import Web.Scotty.Trans
 
 app :: PurrApp ()
 app = do
@@ -15,7 +16,11 @@ app = do
 
   -- Core Routes
   get "/" $ do
-    html $ renderIndex
+    html $ renderIndex "/" Nothing
+
+  get "/style.css" $ do
+    setHeader "Content-Type" "text/css"
+    text renderStyle
 
   -- Feature Routes
   Sharing.routes

src/Core/Templates.hs

@@ -1,16 +1,19 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TemplateHaskell #-}
 
-module Core.Templates ( renderIndex ) where
-
-import qualified Data.Text.Lazy                as LT
+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)
 import Text.Hamlet                   (shamletFile)
 
 import Prelude 
 
-renderIndex :: LT.Text
-renderIndex = renderHtml ( $(shamletFile "./views/index.hamlet") )
+renderIndex :: String -> Maybe String -> Text
+renderIndex link password = renderHtml ( $(shamletFile "./views/index.hamlet") )
+
+renderStyle :: Text
+renderStyle = renderCss ( $(cassiusFile "./views/cassius/style.cassius") "/style.css" )

src/Feature/Sharing/HTTP.hs

@@ -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

src/Lib.hs

@@ -1,23 +1,23 @@
 module Lib ( main ) where
 
-import           Core.Types
 import qualified Core.Configuration as Configuration
 import qualified Core.HTTP          as HTTP
 import qualified Core.Mongo         as DB
+import           Core.Types
 
 import Control.Monad.Reader (liftIO, runReaderT)
 import Database.MongoDB     (MongoContext)
 import GHC.Natural          (popCountNatural)
-import Web.Scotty.Trans     (scottyT)
 import Prelude              hiding (id)
+import Web.Scotty.Trans     (scottyT)
 
 main :: IO ()
 main = do
   dhallConf <- liftIO Configuration.main
   dataDB    <- liftIO $ DB.mongoSetup dhallConf
   let config = AppConfig { res    = dhallConf
-                         , dbconn = dataDB 
+                         , dbconn = dataDB
                          }
   scottyT (port dhallConf) (flip runApp config) HTTP.app where
     runApp :: ConfigM a -> AppConfig -> IO a
-    runApp m c = runReaderT (runConfigM m) c 
+    runApp m = runReaderT (runConfigM m)