From 0b191f5c48edffc9da3e38c284e9640fd82e7cb1 Mon Sep 17 00:00:00 2001
From: Joris
Date: Mon, 5 Jun 2017 18:02:13 +0200
Subject: Replace persistent by sqlite-simple

---
 src/server/Model/SignIn.hs | 78 ++++++++++++++++++++++++++++++----------------
 1 file changed, 52 insertions(+), 26 deletions(-)

(limited to 'src/server/Model/SignIn.hs')

diff --git a/src/server/Model/SignIn.hs b/src/server/Model/SignIn.hs
index 06aba5a..c5182f0 100644
--- a/src/server/Model/SignIn.hs
+++ b/src/server/Model/SignIn.hs
@@ -1,40 +1,66 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Model.SignIn
-  ( createSignInToken
+  ( SignIn(..)
+  , createSignInToken
   , getSignIn
   , signInTokenToUsed
-  , isLastValidToken
+  , isLastTokenValid
   ) where
 
+import Data.Int (Int64)
+import Data.Maybe (listToMaybe)
 import Data.Text (Text)
 import Data.Time.Clock (getCurrentTime)
+import Data.Time.Clock (UTCTime)
+import Database.SQLite.Simple (Only(Only), FromRow(fromRow))
+import qualified Database.SQLite.Simple as SQLite
 
-import Control.Monad.IO.Class (liftIO)
+import Model.Query (Query(Query))
+import Model.UUID (generateUUID)
 
-import Database.Persist
+type SignInId = Int64
 
-import Model.Database
-import Model.UUID (generateUUID)
+data SignIn = SignIn
+  { id :: SignInId
+  , token :: Text
+  , creation :: UTCTime
+  , email :: Text
+  , isUsed :: Bool
+  } deriving Show
 
-createSignInToken :: Text -> Persist Text
-createSignInToken email = do
-  now <- liftIO getCurrentTime
-  token <- liftIO generateUUID
-  _ <- insert $ SignIn token now email False
-  return token
+instance FromRow SignIn where
+  fromRow = SignIn <$>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field <*>
+    SQLite.field
 
-getSignIn :: Text -> Persist (Maybe (Entity SignIn))
-getSignIn token =
-  selectFirst [SignInToken ==. token] []
+createSignInToken :: Text -> Query Text
+createSignInToken signInEmail =
+  Query (\conn -> do
+    now <- getCurrentTime
+    signInToken <- generateUUID
+    SQLite.execute conn "INSERT INTO sign_in (token, creation, email, is_used) VALUES (?, ?, ?, ?)" (signInToken, now, signInEmail, False)
+    return signInToken
+  )
 
-signInTokenToUsed :: SignInId -> Persist ()
+getSignIn :: Text -> Query (Maybe SignIn)
+getSignIn signInToken =
+  Query (\conn -> do
+    listToMaybe <$> (SQLite.query conn "SELECT * from sign_in WHERE token = ? LIMIT 1" (Only signInToken) :: IO [SignIn])
+  )
+
+signInTokenToUsed :: SignInId -> Query ()
 signInTokenToUsed tokenId =
-  update tokenId [SignInIsUsed =. True]
-
-isLastValidToken :: SignIn -> Persist Bool
-isLastValidToken signIn = do
-  maybe False ((== (signInToken signIn)) . signInToken . entityVal) <$>
-    selectFirst
-      [ SignInEmail ==. (signInEmail signIn)
-      , SignInIsUsed ==. True
-      ]
-      [ Desc SignInCreation ]
+  Query (\conn ->
+    SQLite.execute conn "UPDATE sign_in SET is_used = ? WHERE id = ?" (True, tokenId)
+  )
+
+isLastTokenValid :: SignIn -> Query Bool
+isLastTokenValid signIn =
+  Query (\conn -> do
+    [ Only lastToken ] <- SQLite.query conn "SELECT token from sign_in WHERE email = ? AND is_used = ? ORDER BY creation DESC LIMIT 1" (email signIn, True)
+    return . maybe False (== (token signIn)) $ lastToken
+  )
-- 
cgit v1.2.3