diff options
Diffstat (limited to 'src/server/Model')
-rw-r--r-- | src/server/Model/Database.hs | 7 | ||||
-rw-r--r-- | src/server/Model/Message.hs | 15 | ||||
-rw-r--r-- | src/server/Model/Payment.hs | 6 | ||||
-rw-r--r-- | src/server/Model/SignIn.hs | 34 | ||||
-rw-r--r-- | src/server/Model/UUID.hs | 10 | ||||
-rw-r--r-- | src/server/Model/User.hs | 6 |
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 |