Compare commits
	
		
			3 Commits
		
	
	
		
			cbcf23e316
			...
			d2f1b07922
		
	
	| Author | SHA1 | Date | 
|---|---|---|
| 
							
							
								
									
								
								 | 
						d2f1b07922 | |
| 
							
							
								
									
								
								 | 
						3666f29756 | |
| 
							
							
								
									
								
								 | 
						04d0efb545 | 
| 
						 | 
					@ -137,6 +137,13 @@ deleteExpiredEmails time = runQuery $ delete $ do
 | 
				
			||||||
    verification <- from $ table @DBEmailVerification
 | 
					    verification <- from $ table @DBEmailVerification
 | 
				
			||||||
    where_ $ verification ^. DBEmailVerificationExpires <=. val time
 | 
					    where_ $ verification ^. DBEmailVerificationExpires <=. val time
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					deleteOrphanedVerifications :: MonadDB m => m ()
 | 
				
			||||||
 | 
					deleteOrphanedVerifications = runQuery $ delete $ do
 | 
				
			||||||
 | 
					    verification <- from $ table @DBEmailVerification
 | 
				
			||||||
 | 
					    where_ $ (==. val (0 :: Int)) $ subSelectCount $ do
 | 
				
			||||||
 | 
					        email <- from $ table @DBEmail
 | 
				
			||||||
 | 
					        where_ $ email ^. DBEmailVid ==. just (verification ^. DBEmailVerificationId)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
deleteUsersWithoutEmail :: MonadDB m => m ()
 | 
					deleteUsersWithoutEmail :: MonadDB m => m ()
 | 
				
			||||||
deleteUsersWithoutEmail = runQuery $ delete $ do
 | 
					deleteUsersWithoutEmail = runQuery $ delete $ do
 | 
				
			||||||
    user <- from $ table @DBUser
 | 
					    user <- from $ table @DBUser
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -19,20 +19,11 @@ import Datarekisteri.Core.Types
 | 
				
			||||||
import Data.Aeson (ToJSON(..), FromJSON(..))
 | 
					import Data.Aeson (ToJSON(..), FromJSON(..))
 | 
				
			||||||
import Data.ByteArray (ByteArray, ByteArrayAccess)
 | 
					import Data.ByteArray (ByteArray, ByteArrayAccess)
 | 
				
			||||||
import Data.Morpheus.App.Internal.Resolving (Resolver, LiftOperation)
 | 
					import Data.Morpheus.App.Internal.Resolving (Resolver, LiftOperation)
 | 
				
			||||||
import Data.Morpheus.Server.Types (SCALAR)
 | 
					import Data.Morpheus.Types (MonadError, GQLError)
 | 
				
			||||||
import Data.Morpheus.Types (GQLType, DecodeScalar(..), KIND, EncodeScalar(..),
 | 
					import Data.Time (getCurrentTime)
 | 
				
			||||||
    ScalarValue(..), MonadError, GQLError)
 | 
					 | 
				
			||||||
import Data.Morpheus.Types.GQLScalar (scalarToJSON, scalarFromJSON)
 | 
					 | 
				
			||||||
import Data.Time (UTCTime, getCurrentTime, NominalDiffTime, addUTCTime, Day)
 | 
					 | 
				
			||||||
import Data.Time.Format.ISO8601 (iso8601Show, iso8601ParseM)
 | 
					 | 
				
			||||||
import qualified Data.Text as T
 | 
					 | 
				
			||||||
import Data.Char (isSpace)
 | 
					 | 
				
			||||||
import Database.Persist.Class (PersistField(..))
 | 
					import Database.Persist.Class (PersistField(..))
 | 
				
			||||||
import Database.Persist.PersistValue (PersistValue(..))
 | 
					 | 
				
			||||||
import Database.Persist.Sql (PersistFieldSql(..), SqlBackend)
 | 
					import Database.Persist.Sql (PersistFieldSql(..), SqlBackend)
 | 
				
			||||||
import Network.Mail.Mime (Mail, Address(..))
 | 
					import Network.Mail.Mime (Mail, Address(..))
 | 
				
			||||||
import Text.Email.Validate (EmailAddress, toByteString, validate, emailAddress)
 | 
					 | 
				
			||||||
import qualified "base64" Data.ByteString.Base64 as B64 (encodeBase64, decodeBase64)
 | 
					 | 
				
			||||||
import "cryptonite" Crypto.Random (MonadRandom(..))
 | 
					import "cryptonite" Crypto.Random (MonadRandom(..))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
forward :: Monad m => [a] -> m [Maybe a]
 | 
					forward :: Monad m => [a] -> m [Maybe a]
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -58,6 +58,7 @@ gcEmailsMain :: CLIM ()
 | 
				
			||||||
gcEmailsMain = do
 | 
					gcEmailsMain = do
 | 
				
			||||||
    time <- currentTime
 | 
					    time <- currentTime
 | 
				
			||||||
    deleteExpiredEmails time
 | 
					    deleteExpiredEmails time
 | 
				
			||||||
 | 
					    deleteOrphanedVerifications
 | 
				
			||||||
 | 
					
 | 
				
			||||||
gcApplicationsMain :: CLIM ()
 | 
					gcApplicationsMain :: CLIM ()
 | 
				
			||||||
gcApplicationsMain = do
 | 
					gcApplicationsMain = do
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -204,6 +204,9 @@ instance Yesod DataIdClient where
 | 
				
			||||||
                  --bg-colour: #ffffff;
 | 
					                  --bg-colour: #ffffff;
 | 
				
			||||||
                  --fg-colour: #181c22;
 | 
					                  --fg-colour: #181c22;
 | 
				
			||||||
                }
 | 
					                }
 | 
				
			||||||
 | 
					                * {
 | 
				
			||||||
 | 
					                  box-sizing: border-box;
 | 
				
			||||||
 | 
					                }
 | 
				
			||||||
                html {
 | 
					                html {
 | 
				
			||||||
                  font-family: "Fira Sans", sans-serif;
 | 
					                  font-family: "Fira Sans", sans-serif;
 | 
				
			||||||
                  height: 100%;
 | 
					                  height: 100%;
 | 
				
			||||||
| 
						 | 
					@ -239,7 +242,7 @@ instance Yesod DataIdClient where
 | 
				
			||||||
                  margin-bottom: 0.3em;
 | 
					                  margin-bottom: 0.3em;
 | 
				
			||||||
                }
 | 
					                }
 | 
				
			||||||
                form {
 | 
					                form {
 | 
				
			||||||
                  max-width: 20em;
 | 
					                  max-width: min(30em,100%);
 | 
				
			||||||
                }
 | 
					                }
 | 
				
			||||||
                summary > h2 {
 | 
					                summary > h2 {
 | 
				
			||||||
                  display: inline-block;
 | 
					                  display: inline-block;
 | 
				
			||||||
| 
						 | 
					@ -330,6 +333,7 @@ instance Yesod DataIdClient where
 | 
				
			||||||
            $doctype 5
 | 
					            $doctype 5
 | 
				
			||||||
            <html>
 | 
					            <html>
 | 
				
			||||||
              <head>
 | 
					              <head>
 | 
				
			||||||
 | 
					                <meta name="viewport" content="width=device-width,initial-scale=1"/>
 | 
				
			||||||
                <title>#{pageTitle p}
 | 
					                <title>#{pageTitle p}
 | 
				
			||||||
                ^{pageHead p}
 | 
					                ^{pageHead p}
 | 
				
			||||||
              <body>
 | 
					              <body>
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue