purr

password generation and secret sharing
Log | Files | Refs | README | LICENSE

HTTP.hs (1423B)

      1 module Feature.Sharing.HTTP ( routes ) where
      2 
      3 import           Core.Configuration        (adminEmail, confLinkLength)
      4 import           Core.Templates            (renderIndex)
      5 import           Core.Types
      6 
      7 import           Feature.Generation.Links  (genLink)
      8 import           Feature.Sharing.SQLite    (findByLink, insertNewSecret)
      9 import           Feature.Sharing.Templates (renderPw)
     10 
     11 import           Control.Monad.Trans       (liftIO)
     12 import           Data.List.Split           (splitOn)
     13 import           Data.Maybe                (listToMaybe)
     14 import           Prelude
     15 import           Web.Scotty
     16 
     17 import qualified Data.Text                 as T
     18 import qualified Data.Text.Lazy            as LT
     19 
     20 -- Routes related to secret sharing functionality
     21 routes :: PurrApp ()
     22 routes = do
     23   get "/pw/:id" $ do
     24     reqId  <- param "id"
     25     email  <- liftIO adminEmail
     26     html    $ renderIndex reqId email
     27 
     28   post "/pw" $ do
     29     reqId <- param "userLink"
     30     res   <- findByLink reqId
     31     html   $ renderPw (last $ splitOn "/" reqId) res
     32 
     33   post "/new" $ do
     34     reqSecret    <- param "newSec"
     35     reqDur       <- param "newSecDuration"
     36     reqViews     <- param "newSecViews"
     37     cLengthStr   <- liftIO confLinkLength
     38     let cLength   = read cLengthStr :: Int
     39     link         <- liftIO $ genLink cLength
     40     insertNewSecret reqSecret reqDur (T.pack $ show link) reqViews
     41     html          $ renderPw (show link) (Just reqSecret)