aboutsummaryrefslogtreecommitdiff
path: root/src/server/Model
diff options
context:
space:
mode:
Diffstat (limited to 'src/server/Model')
-rw-r--r--src/server/Model/Database.hs7
-rw-r--r--src/server/Model/Message.hs15
-rw-r--r--src/server/Model/Payment.hs6
-rw-r--r--src/server/Model/SignIn.hs34
-rw-r--r--src/server/Model/UUID.hs10
-rw-r--r--src/server/Model/User.hs6
6 files changed, 72 insertions, 6 deletions
diff --git a/src/server/Model/Database.hs b/src/server/Model/Database.hs
index abf235d..e5fd075 100644
--- a/src/server/Model/Database.hs
+++ b/src/server/Model/Database.hs
@@ -33,6 +33,13 @@ Payment
name Text
cost Int
deriving Show
+SignIn
+ token Text
+ creation UTCTime
+ email Text
+ isUsed Bool
+ UniqToken token
+ deriving Show
|]
type Persist a = SqlPersistT (ResourceT (NoLoggingT IO)) a
diff --git a/src/server/Model/Message.hs b/src/server/Model/Message.hs
new file mode 100644
index 0000000..acc785e
--- /dev/null
+++ b/src/server/Model/Message.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Model.Message.Json
+ ( Message(..)
+ ) where
+
+import Data.Aeson
+import GHC.Generics
+
+data Message = Message
+ { message :: String
+ } deriving (Show, Generic)
+
+instance FromJSON Message
+instance ToJSON Message
diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs
index b35e13c..ad1c261 100644
--- a/src/server/Model/Payment.hs
+++ b/src/server/Model/Payment.hs
@@ -1,6 +1,6 @@
module Model.Payment
( getPayments
- , insertPayment
+ , createPayment
) where
import Data.Text (Text)
@@ -30,7 +30,7 @@ getJsonPayment (paymentEntity, userEntity) =
in P.Payment (paymentCreation payment) (paymentName payment) (paymentCost payment) (userName user)
-insertPayment :: UserId -> Text -> Int -> Persist PaymentId
-insertPayment userId name cost = do
+createPayment :: UserId -> Text -> Int -> Persist PaymentId
+createPayment userId name cost = do
now <- liftIO getCurrentTime
insert $ Payment userId now name cost
diff --git a/src/server/Model/SignIn.hs b/src/server/Model/SignIn.hs
new file mode 100644
index 0000000..c447416
--- /dev/null
+++ b/src/server/Model/SignIn.hs
@@ -0,0 +1,34 @@
+module Model.SignIn
+ ( createSignInToken
+ , getSignInToken
+ , signInTokenIsUsed
+ ) where
+
+import Data.Text (Text)
+import Data.Time.Clock (getCurrentTime)
+
+import Control.Monad.IO.Class (liftIO)
+
+import Database.Persist
+
+import Model.Database
+import Model.UUID (generateUUID)
+
+createSignInToken :: Text -> Persist Text
+createSignInToken email = do
+ now <- liftIO getCurrentTime
+ token <- liftIO generateUUID
+ _ <- insert $ SignIn token now email False
+ return token
+
+getSignInToken :: Text -> Persist (Maybe (Entity SignIn))
+getSignInToken token =
+ selectFirst
+ [ SignInToken ==. token
+ , SignInIsUsed ==. False
+ ]
+ []
+
+signInTokenIsUsed :: SignInId -> Persist ()
+signInTokenIsUsed tokenId =
+ update tokenId [SignInIsUsed =. True]
diff --git a/src/server/Model/UUID.hs b/src/server/Model/UUID.hs
new file mode 100644
index 0000000..6cb7ce0
--- /dev/null
+++ b/src/server/Model/UUID.hs
@@ -0,0 +1,10 @@
+module Model.UUID
+ ( generateUUID
+ ) where
+
+import Data.UUID (toString)
+import Data.UUID.V4 (nextRandom)
+import Data.Text (Text, pack)
+
+generateUUID :: IO Text
+generateUUID = pack . toString <$> nextRandom
diff --git a/src/server/Model/User.hs b/src/server/Model/User.hs
index ddca0fb..339aff6 100644
--- a/src/server/Model/User.hs
+++ b/src/server/Model/User.hs
@@ -1,7 +1,7 @@
module Model.User
( getUsers
, getUser
- , insertUser
+ , createUser
, deleteUser
) where
@@ -20,8 +20,8 @@ getUsers = map entityVal <$> selectList [] [Desc UserCreation]
getUser :: Text -> Persist (Maybe (Entity User))
getUser email = selectFirst [UserEmail ==. email] []
-insertUser :: Text -> Text -> Persist UserId
-insertUser email name = do
+createUser :: Text -> Text -> Persist UserId
+createUser email name = do
now <- liftIO getCurrentTime
insert $ User now email name