users management for scotty
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

80 lines
2.5KB

  1. {- | Example app.
  2. Demonstrates user registration, authentication and session functionality.
  3. The app needs to do the following things:
  4. 1. At the beginning of the program:
  5. - Create an sqlite database connection pool
  6. - Initialize the sqlite database tables with @dbMigrations@ using the connection pool
  7. - Initialize the session store with @initSessionStore@ and get back a SessionStore
  8. 2. Call @router@ from your routing so it will take care of the user registration, login and logout pages
  9. 3. Use @loginOrLogout@ to welcome the user and provide links for the registration, login or logout pages
  10. 4. Use @withLogin@ for @ActionM@s that require a logged-in user.
  11. -}
  12. {-# language OverloadedStrings #-}
  13. module Main where
  14. import qualified Control.Monad.Logger as Log
  15. import qualified Web.Scotty as S
  16. import qualified Data.Text.Lazy as TL
  17. import qualified Database.Persist.Sqlite as PSqlite3
  18. import Control.Monad.IO.Class (liftIO)
  19. import qualified Lucid as H
  20. import qualified Web.Scotty.Sqlite.Users as Users
  21. main :: IO ()
  22. main = do
  23. pool <- do -- (1.1)
  24. Log.runStderrLoggingT $ PSqlite3.createSqlitePool "file:/tmp/my-scotty-users.db" 1
  25. liftIO $ Users.dbMigrations pool -- (1.2)
  26. ses <- Users.initSessionStore -- (1.3)
  27. let sinfo = Users.StateInfo pool ses Users.Development -- Use Production for secure only cookies
  28. S.scotty 8080 (myApp sinfo)
  29. myApp :: Users.StateInfo -> S.ScottyM ()
  30. myApp sinfo = do
  31. Users.router sinfo template -- (2)
  32. S.get "/" $ do
  33. io <- Users.loginOrLogout sinfo -- (3)
  34. S.html $
  35. H.renderText $
  36. template
  37. ("Bulletin board")
  38. ( do
  39. io
  40. H.p_ $ H.a_ [ H.href_ "/users" ] "Users zone"
  41. )
  42. S.get "/users" $ -- (4)
  43. Users.withLogin sinfo $ \me -> do
  44. users <- liftIO $ Users.getAllUsers sinfo
  45. S.html $
  46. H.renderText $
  47. template "User zone" $ do
  48. H.p_ $ H.toHtml $ "You are: " <> Users.loginDisplayName (Users.getLoginDesc me)
  49. H.p_ $ "And these are everyone:"
  50. H.ul_ $
  51. mapM_ (H.li_ . H.toHtml . Users.loginDisplayName . Users.getLoginDesc) users
  52. type Html = H.Html ()
  53. template :: TL.Text -> Html -> Html
  54. template title content =
  55. H.doctypehtml_ $ do
  56. H.head_ $ do
  57. H.meta_ [ H.charset_ "utf-8" ]
  58. H.title_ (H.toHtml title)
  59. H.link_ [ H.rel_ "stylesheet", H.type_ "text/css", H.href_ "/style.css" ]
  60. H.body_ $ do
  61. content