aboutsummaryrefslogtreecommitdiff
path: root/server/src/Model/User.hs
blob: e14fcefb8c83c13bab161c127de4bf9094b9e2a7 (plain)
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
{-# LANGUAGE OverloadedStrings    #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Model.User
  ( list
  , get
  , create
  , delete
  ) where

import Data.Maybe (listToMaybe)
import Data.Text (Text)
import Data.Time.Clock (getCurrentTime)
import Database.SQLite.Simple (Only(Only), FromRow(fromRow))
import Prelude hiding (id)
import qualified Database.SQLite.Simple as SQLite

import Common.Model (UserId, User(..))

import Model.Query (Query(Query))

instance FromRow User where
  fromRow = User <$> SQLite.field <*> SQLite.field <*> SQLite.field <*> SQLite.field

list :: Query [User]
list = Query (\conn -> SQLite.query_ conn "SELECT * from user ORDER BY creation DESC")

get :: Text -> Query (Maybe User)
get userEmail =
  Query (\conn -> listToMaybe <$>
    SQLite.query conn "SELECT * FROM user WHERE email = ? LIMIT 1" (Only userEmail)
  )

create :: Text -> Text -> Query UserId
create userEmail userName =
  Query (\conn -> do
    now <- getCurrentTime
    SQLite.execute
      conn
      "INSERT INTO user (creation, email, name) VALUES (?, ?, ?)"
      (now, userEmail, userName)
    SQLite.lastInsertRowId conn
  )

delete :: Text -> Query ()
delete userEmail =
  Query (\conn ->
    SQLite.execute conn "DELETE FROM user WHERE email = ?" (Only userEmail)
  )