src/server/Controller/Index.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58

module Controller.Index
  ( getIndexAction
  , getUserName
  , signOutAction
  , getUsersAction
  , addUserAction
  , deleteUserAction
  ) where

import Web.Scotty

import Network.HTTP.Types.Status (ok200)

import Database.Persist

import Control.Monad.IO.Class (liftIO)

import Data.Text (Text)
import Data.String (fromString)

import qualified LoginSession

import qualified Secure

import Model.Database
import Model.User
import Model.Json.Message

import View.Page (page)

getIndexAction :: ActionM ()
getIndexAction = html page

getUserName :: ActionM ()
getUserName =
  Secure.loggedAction (\user -> do
    json . Message . userName . entityVal $ user
  )

signOutAction :: ActionM ()
signOutAction = do
  LoginSession.delete
  status ok200

getUsersAction :: ActionM ()
getUsersAction = do
  users <- liftIO $ runDb getUsers
  html . fromString . show $ users

addUserAction :: Text -> Text -> ActionM ()
addUserAction email name = do
  _ <- liftIO . runDb $ createUser email name
  status ok200

deleteUserAction :: Text -> ActionM ()
deleteUserAction email = do
  _ <- liftIO . runDb $ deleteUser email
  status ok200