1 files changed, 49 insertions, 0 deletions
diff --git a/server/src/Model/User.hs b/server/src/Model/User.hs
new file mode 100644
index 0000000..e14fcef
--- /dev/null
+++ b/server/src/Model/User.hs
@@ -0,0 +1,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)
+  )