{-# LANGUAGE OverloadedLabels #-}

module Mensam.Server.User where

import Mensam.API.Aeson
import Mensam.API.Data.User
import Mensam.API.Data.User.Username
import Mensam.Server.Application.SeldaPool.Class
import Mensam.Server.Database.Extra qualified as Selda
import Mensam.Server.Database.Schema
import Mensam.Server.Jpeg

import Control.Monad.Catch
import Control.Monad.IO.Class
import Control.Monad.Logger.CallStack
import Control.Monad.Trans.Class
import Data.Aeson qualified as A
import Data.Aeson.Text qualified as A
import Data.ByteString.Lazy qualified as BL
import Data.Kind
import Data.Password.Bcrypt
import Data.Text qualified as T
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Encoding qualified as TL
import Data.Time qualified as T
import Database.Selda qualified as Selda
import Deriving.Aeson qualified as A
import GHC.Generics
import System.Random
import Text.Email.Parser
import Text.Email.Text

type AuthenticationError :: Type
data AuthenticationError
  = AuthenticationErrorUserDoesNotExist
  | AuthenticationErrorWrongPassword
  deriving stock (AuthenticationError -> AuthenticationError -> Bool
(AuthenticationError -> AuthenticationError -> Bool)
-> (AuthenticationError -> AuthenticationError -> Bool)
-> Eq AuthenticationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthenticationError -> AuthenticationError -> Bool
== :: AuthenticationError -> AuthenticationError -> Bool
$c/= :: AuthenticationError -> AuthenticationError -> Bool
/= :: AuthenticationError -> AuthenticationError -> Bool
Eq, (forall x. AuthenticationError -> Rep AuthenticationError x)
-> (forall x. Rep AuthenticationError x -> AuthenticationError)
-> Generic AuthenticationError
forall x. Rep AuthenticationError x -> AuthenticationError
forall x. AuthenticationError -> Rep AuthenticationError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AuthenticationError -> Rep AuthenticationError x
from :: forall x. AuthenticationError -> Rep AuthenticationError x
$cto :: forall x. Rep AuthenticationError x -> AuthenticationError
to :: forall x. Rep AuthenticationError x -> AuthenticationError
Generic, Eq AuthenticationError
Eq AuthenticationError =>
(AuthenticationError -> AuthenticationError -> Ordering)
-> (AuthenticationError -> AuthenticationError -> Bool)
-> (AuthenticationError -> AuthenticationError -> Bool)
-> (AuthenticationError -> AuthenticationError -> Bool)
-> (AuthenticationError -> AuthenticationError -> Bool)
-> (AuthenticationError
    -> AuthenticationError -> AuthenticationError)
-> (AuthenticationError
    -> AuthenticationError -> AuthenticationError)
-> Ord AuthenticationError
AuthenticationError -> AuthenticationError -> Bool
AuthenticationError -> AuthenticationError -> Ordering
AuthenticationError -> AuthenticationError -> AuthenticationError
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AuthenticationError -> AuthenticationError -> Ordering
compare :: AuthenticationError -> AuthenticationError -> Ordering
$c< :: AuthenticationError -> AuthenticationError -> Bool
< :: AuthenticationError -> AuthenticationError -> Bool
$c<= :: AuthenticationError -> AuthenticationError -> Bool
<= :: AuthenticationError -> AuthenticationError -> Bool
$c> :: AuthenticationError -> AuthenticationError -> Bool
> :: AuthenticationError -> AuthenticationError -> Bool
$c>= :: AuthenticationError -> AuthenticationError -> Bool
>= :: AuthenticationError -> AuthenticationError -> Bool
$cmax :: AuthenticationError -> AuthenticationError -> AuthenticationError
max :: AuthenticationError -> AuthenticationError -> AuthenticationError
$cmin :: AuthenticationError -> AuthenticationError -> AuthenticationError
min :: AuthenticationError -> AuthenticationError -> AuthenticationError
Ord, ReadPrec [AuthenticationError]
ReadPrec AuthenticationError
Int -> ReadS AuthenticationError
ReadS [AuthenticationError]
(Int -> ReadS AuthenticationError)
-> ReadS [AuthenticationError]
-> ReadPrec AuthenticationError
-> ReadPrec [AuthenticationError]
-> Read AuthenticationError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AuthenticationError
readsPrec :: Int -> ReadS AuthenticationError
$creadList :: ReadS [AuthenticationError]
readList :: ReadS [AuthenticationError]
$creadPrec :: ReadPrec AuthenticationError
readPrec :: ReadPrec AuthenticationError
$creadListPrec :: ReadPrec [AuthenticationError]
readListPrec :: ReadPrec [AuthenticationError]
Read, Int -> AuthenticationError -> ShowS
[AuthenticationError] -> ShowS
AuthenticationError -> String
(Int -> AuthenticationError -> ShowS)
-> (AuthenticationError -> String)
-> ([AuthenticationError] -> ShowS)
-> Show AuthenticationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthenticationError -> ShowS
showsPrec :: Int -> AuthenticationError -> ShowS
$cshow :: AuthenticationError -> String
show :: AuthenticationError -> String
$cshowList :: [AuthenticationError] -> ShowS
showList :: [AuthenticationError] -> ShowS
Show)

userAuthenticate ::
  (MonadLogger m, MonadSeldaPool m) =>
  Username ->
  Password ->
  SeldaTransactionT m (Either AuthenticationError UserAuthenticated)
userAuthenticate :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
Username
-> Password
-> SeldaTransactionT
     m (Either AuthenticationError UserAuthenticated)
userAuthenticate Username
username Password
password = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Querying user " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Username -> String
forall a. Show a => a -> String
show Username
username) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" from database for password authentication."
  Maybe DbUser
maybeUser :: Maybe DbUser <- Query (Backend (SeldaTransactionT m)) (Row SQLite DbUser)
-> SeldaTransactionT m (Maybe (Res (Row SQLite DbUser)))
forall (m :: * -> *) a.
(MonadSelda m, MonadThrow m, Result a) =>
Query (Backend m) a -> m (Maybe (Res a))
Selda.queryUnique (Query (Backend (SeldaTransactionT m)) (Row SQLite DbUser)
 -> SeldaTransactionT m (Maybe (Res (Row SQLite DbUser))))
-> Query (Backend (SeldaTransactionT m)) (Row SQLite DbUser)
-> SeldaTransactionT m (Maybe (Res (Row SQLite DbUser)))
forall a b. (a -> b) -> a -> b
$ do
    Row SQLite DbUser
user <- Table DbUser -> Query SQLite (Row SQLite DbUser)
forall a s. Relational a => Table a -> Query s (Row s a)
Selda.select Table DbUser
tableUser
    Col SQLite Bool -> Query SQLite ()
forall s t. Same s t => Col s Bool -> Query t ()
Selda.restrict (Col SQLite Bool -> Query SQLite ())
-> Col SQLite Bool -> Query SQLite ()
forall a b. (a -> b) -> a -> b
$ Row SQLite DbUser
user Row SQLite DbUser -> Selector DbUser Text -> Col SQLite Text
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbUser Text
#dbUser_name Col SQLite Text -> Col SQLite Text -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda..== Text -> Col SQLite Text
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (Username -> Text
unUsername Username
username)
    Row SQLite DbUser -> Query SQLite (Row SQLite DbUser)
forall a. a -> Query SQLite a
forall (m :: * -> *) a. Monad m => a -> m a
return Row SQLite DbUser
user
  case Maybe DbUser
maybeUser of
    Maybe DbUser
Nothing -> do
      m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Password authentication failed because username does not exist."
      Either AuthenticationError UserAuthenticated
-> SeldaTransactionT
     m (Either AuthenticationError UserAuthenticated)
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either AuthenticationError UserAuthenticated
 -> SeldaTransactionT
      m (Either AuthenticationError UserAuthenticated))
-> Either AuthenticationError UserAuthenticated
-> SeldaTransactionT
     m (Either AuthenticationError UserAuthenticated)
forall a b. (a -> b) -> a -> b
$ AuthenticationError -> Either AuthenticationError UserAuthenticated
forall a b. a -> Either a b
Left AuthenticationError
AuthenticationErrorUserDoesNotExist
    Just DbUser
dbUser -> do
      let passwordHash :: PasswordHash Bcrypt
passwordHash = Text -> PasswordHash Bcrypt
forall a. Text -> PasswordHash a
PasswordHash (Text -> PasswordHash Bcrypt) -> Text -> PasswordHash Bcrypt
forall a b. (a -> b) -> a -> b
$ DbUser -> Text
dbUser_password_hash DbUser
dbUser
      m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Queried user from database for password authentication. Checking password now."
      case Password -> PasswordHash Bcrypt -> PasswordCheck
checkPassword Password
password PasswordHash Bcrypt
passwordHash of
        PasswordCheck
PasswordCheckFail -> do
          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Password authentication failed because of wrong password."
          Either AuthenticationError UserAuthenticated
-> SeldaTransactionT
     m (Either AuthenticationError UserAuthenticated)
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either AuthenticationError UserAuthenticated
 -> SeldaTransactionT
      m (Either AuthenticationError UserAuthenticated))
-> Either AuthenticationError UserAuthenticated
-> SeldaTransactionT
     m (Either AuthenticationError UserAuthenticated)
forall a b. (a -> b) -> a -> b
$ AuthenticationError -> Either AuthenticationError UserAuthenticated
forall a b. a -> Either a b
Left AuthenticationError
AuthenticationErrorWrongPassword
        PasswordCheck
PasswordCheckSuccess -> do
          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Password authentication succeeded."
          Either AuthenticationError UserAuthenticated
-> SeldaTransactionT
     m (Either AuthenticationError UserAuthenticated)
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either AuthenticationError UserAuthenticated
 -> SeldaTransactionT
      m (Either AuthenticationError UserAuthenticated))
-> Either AuthenticationError UserAuthenticated
-> SeldaTransactionT
     m (Either AuthenticationError UserAuthenticated)
forall a b. (a -> b) -> a -> b
$
            UserAuthenticated -> Either AuthenticationError UserAuthenticated
forall a b. b -> Either a b
Right
              MkUserAuthenticated
                { userAuthenticatedId :: IdentifierUser
userAuthenticatedId = Int64 -> IdentifierUser
MkIdentifierUser (Int64 -> IdentifierUser) -> Int64 -> IdentifierUser
forall a b. (a -> b) -> a -> b
$ forall a. ID a -> Int64
Selda.fromId @DbUser (ID DbUser -> Int64) -> ID DbUser -> Int64
forall a b. (a -> b) -> a -> b
$ DbUser -> ID DbUser
dbUser_id DbUser
dbUser
                , userAuthenticatedSession :: Maybe IdentifierSession
userAuthenticatedSession = Maybe IdentifierSession
forall a. Maybe a
Nothing
                }

userLookupId ::
  (MonadIO m, MonadLogger m, MonadSeldaPool m) =>
  Username ->
  SeldaTransactionT m (Maybe IdentifierUser)
userLookupId :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
Username -> SeldaTransactionT m (Maybe IdentifierUser)
userLookupId Username
username = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Looking up user identifier with name: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Username -> String
forall a. Show a => a -> String
show Username
username)
  Maybe (ID DbUser)
maybeDbId <- Query (Backend (SeldaTransactionT m)) (Col SQLite (ID DbUser))
-> SeldaTransactionT m (Maybe (Res (Col SQLite (ID DbUser))))
forall (m :: * -> *) a.
(MonadSelda m, MonadThrow m, Result a) =>
Query (Backend m) a -> m (Maybe (Res a))
Selda.queryUnique (Query (Backend (SeldaTransactionT m)) (Col SQLite (ID DbUser))
 -> SeldaTransactionT m (Maybe (Res (Col SQLite (ID DbUser)))))
-> Query (Backend (SeldaTransactionT m)) (Col SQLite (ID DbUser))
-> SeldaTransactionT m (Maybe (Res (Col SQLite (ID DbUser))))
forall a b. (a -> b) -> a -> b
$ do
    Row SQLite DbUser
dbUser <- Table DbUser -> Query SQLite (Row SQLite DbUser)
forall a s. Relational a => Table a -> Query s (Row s a)
Selda.select Table DbUser
tableUser
    Col SQLite Bool -> Query SQLite ()
forall s t. Same s t => Col s Bool -> Query t ()
Selda.restrict (Col SQLite Bool -> Query SQLite ())
-> Col SQLite Bool -> Query SQLite ()
forall a b. (a -> b) -> a -> b
$ Row SQLite DbUser
dbUser Row SQLite DbUser -> Selector DbUser Text -> Col SQLite Text
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbUser Text
#dbUser_name Col SQLite Text -> Col SQLite Text -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda..== Text -> Col SQLite Text
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (Username -> Text
unUsername Username
username)
    Col SQLite (ID DbUser) -> Query SQLite (Col SQLite (ID DbUser))
forall a. a -> Query SQLite a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Col SQLite (ID DbUser) -> Query SQLite (Col SQLite (ID DbUser)))
-> Col SQLite (ID DbUser) -> Query SQLite (Col SQLite (ID DbUser))
forall a b. (a -> b) -> a -> b
$ Row SQLite DbUser
dbUser Row SQLite DbUser
-> Selector DbUser (ID DbUser) -> Col SQLite (ID DbUser)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbUser (ID DbUser)
#dbUser_id
  case Maybe (ID DbUser)
maybeDbId of
    Maybe (ID DbUser)
Nothing -> do
      m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Failed to look up user. Name doesn't exist: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Username -> String
forall a. Show a => a -> String
show Username
username)
      Maybe IdentifierUser -> SeldaTransactionT m (Maybe IdentifierUser)
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe IdentifierUser
forall a. Maybe a
Nothing
    Just ID DbUser
dbId -> do
      m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Looked up user successfully."
      Maybe IdentifierUser -> SeldaTransactionT m (Maybe IdentifierUser)
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe IdentifierUser
 -> SeldaTransactionT m (Maybe IdentifierUser))
-> Maybe IdentifierUser
-> SeldaTransactionT m (Maybe IdentifierUser)
forall a b. (a -> b) -> a -> b
$ IdentifierUser -> Maybe IdentifierUser
forall a. a -> Maybe a
Just (IdentifierUser -> Maybe IdentifierUser)
-> IdentifierUser -> Maybe IdentifierUser
forall a b. (a -> b) -> a -> b
$ Int64 -> IdentifierUser
MkIdentifierUser (Int64 -> IdentifierUser) -> Int64 -> IdentifierUser
forall a b. (a -> b) -> a -> b
$ ID DbUser -> Int64
forall a. ID a -> Int64
Selda.fromId ID DbUser
dbId

userGet ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierUser ->
  SeldaTransactionT m User
userGet :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierUser -> SeldaTransactionT m User
userGet IdentifierUser
identifier = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Get user info with identifier: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierUser -> String
forall a. Show a => a -> String
show IdentifierUser
identifier)
  DbUser
dbUser <- Query (Backend (SeldaTransactionT m)) (Row SQLite DbUser)
-> SeldaTransactionT m (Res (Row SQLite DbUser))
forall (m :: * -> *) a.
(MonadSelda m, MonadCatch m, Result a) =>
Query (Backend m) a -> m (Res a)
Selda.queryOne (Query (Backend (SeldaTransactionT m)) (Row SQLite DbUser)
 -> SeldaTransactionT m (Res (Row SQLite DbUser)))
-> Query (Backend (SeldaTransactionT m)) (Row SQLite DbUser)
-> SeldaTransactionT m (Res (Row SQLite DbUser))
forall a b. (a -> b) -> a -> b
$ do
    Row SQLite DbUser
dbUser <- Table DbUser -> Query SQLite (Row SQLite DbUser)
forall a s. Relational a => Table a -> Query s (Row s a)
Selda.select Table DbUser
tableUser
    Col SQLite Bool -> Query SQLite ()
forall s t. Same s t => Col s Bool -> Query t ()
Selda.restrict (Col SQLite Bool -> Query SQLite ())
-> Col SQLite Bool -> Query SQLite ()
forall a b. (a -> b) -> a -> b
$ Row SQLite DbUser
dbUser Row SQLite DbUser
-> Selector DbUser (ID DbUser) -> Col SQLite (ID DbUser)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbUser (ID DbUser)
#dbUser_id Col SQLite (ID DbUser) -> Col SQLite (ID DbUser) -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda..== ID DbUser -> Col SQLite (ID DbUser)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbUser (Int64 -> ID DbUser) -> Int64 -> ID DbUser
forall a b. (a -> b) -> a -> b
$ IdentifierUser -> Int64
unIdentifierUser IdentifierUser
identifier)
    Row SQLite DbUser -> Query SQLite (Row SQLite DbUser)
forall a. a -> Query SQLite a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Row SQLite DbUser
dbUser
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Got user info successfully."
  User -> SeldaTransactionT m User
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    MkUser
      { userId :: IdentifierUser
userId = Int64 -> IdentifierUser
MkIdentifierUser (Int64 -> IdentifierUser) -> Int64 -> IdentifierUser
forall a b. (a -> b) -> a -> b
$ ID DbUser -> Int64
forall a. ID a -> Int64
Selda.fromId (ID DbUser -> Int64) -> ID DbUser -> Int64
forall a b. (a -> b) -> a -> b
$ DbUser -> ID DbUser
dbUser_id DbUser
dbUser
      , userName :: Username
userName = Text -> Username
MkUsernameUnsafe (Text -> Username) -> Text -> Username
forall a b. (a -> b) -> a -> b
$ DbUser -> Text
dbUser_name DbUser
dbUser
      , userPasswordHash :: PasswordHash Bcrypt
userPasswordHash = Text -> PasswordHash Bcrypt
forall a. Text -> PasswordHash a
PasswordHash (Text -> PasswordHash Bcrypt) -> Text -> PasswordHash Bcrypt
forall a b. (a -> b) -> a -> b
$ DbUser -> Text
dbUser_password_hash DbUser
dbUser
      , userEmail :: EmailAddress
userEmail = Text -> EmailAddress
fromTextUnsafe (Text -> EmailAddress) -> Text -> EmailAddress
forall a b. (a -> b) -> a -> b
$ DbUser -> Text
dbUser_email DbUser
dbUser
      , userEmailVisible :: Bool
userEmailVisible =
          case DbUser -> DbEmailVisibility
dbUser_email_visibility DbUser
dbUser of
            DbEmailVisibility
MkDbEmailVisibility_hidden -> Bool
False
            DbEmailVisibility
MkDbEmailVisibility_visible -> Bool
True
      , userEmailValidated :: Bool
userEmailValidated = DbUser -> Bool
dbUser_email_validated DbUser
dbUser
      , userEmailNotifications :: Bool
userEmailNotifications = DbUser -> Bool
dbUser_email_notifications DbUser
dbUser
      }

type User :: Type
data User = MkUser
  { User -> IdentifierUser
userId :: IdentifierUser
  , User -> Username
userName :: Username
  , User -> PasswordHash Bcrypt
userPasswordHash :: PasswordHash Bcrypt
  , User -> EmailAddress
userEmail :: EmailAddress
  , User -> Bool
userEmailVisible :: Bool
  , User -> Bool
userEmailValidated :: Bool
  , User -> Bool
userEmailNotifications :: Bool
  }
  deriving stock (User -> User -> Bool
(User -> User -> Bool) -> (User -> User -> Bool) -> Eq User
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: User -> User -> Bool
== :: User -> User -> Bool
$c/= :: User -> User -> Bool
/= :: User -> User -> Bool
Eq, (forall x. User -> Rep User x)
-> (forall x. Rep User x -> User) -> Generic User
forall x. Rep User x -> User
forall x. User -> Rep User x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. User -> Rep User x
from :: forall x. User -> Rep User x
$cto :: forall x. Rep User x -> User
to :: forall x. Rep User x -> User
Generic, Eq User
Eq User =>
(User -> User -> Ordering)
-> (User -> User -> Bool)
-> (User -> User -> Bool)
-> (User -> User -> Bool)
-> (User -> User -> Bool)
-> (User -> User -> User)
-> (User -> User -> User)
-> Ord User
User -> User -> Bool
User -> User -> Ordering
User -> User -> User
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: User -> User -> Ordering
compare :: User -> User -> Ordering
$c< :: User -> User -> Bool
< :: User -> User -> Bool
$c<= :: User -> User -> Bool
<= :: User -> User -> Bool
$c> :: User -> User -> Bool
> :: User -> User -> Bool
$c>= :: User -> User -> Bool
>= :: User -> User -> Bool
$cmax :: User -> User -> User
max :: User -> User -> User
$cmin :: User -> User -> User
min :: User -> User -> User
Ord, ReadPrec [User]
ReadPrec User
Int -> ReadS User
ReadS [User]
(Int -> ReadS User)
-> ReadS [User] -> ReadPrec User -> ReadPrec [User] -> Read User
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS User
readsPrec :: Int -> ReadS User
$creadList :: ReadS [User]
readList :: ReadS [User]
$creadPrec :: ReadPrec User
readPrec :: ReadPrec User
$creadListPrec :: ReadPrec [User]
readListPrec :: ReadPrec [User]
Read, Int -> User -> ShowS
[User] -> ShowS
User -> String
(Int -> User -> ShowS)
-> (User -> String) -> ([User] -> ShowS) -> Show User
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> User -> ShowS
showsPrec :: Int -> User -> ShowS
$cshow :: User -> String
show :: User -> String
$cshowList :: [User] -> ShowS
showList :: [User] -> ShowS
Show)

userCreate ::
  (MonadIO m, MonadLogger m, MonadSeldaPool m) =>
  Username ->
  Password ->
  EmailAddress ->
  -- | email address visible
  Bool ->
  -- | receive email notifications
  Bool ->
  SeldaTransactionT m IdentifierUser
userCreate :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
Username
-> Password
-> EmailAddress
-> Bool
-> Bool
-> SeldaTransactionT m IdentifierUser
userCreate Username
username Password
password EmailAddress
emailAddress Bool
emailAddressVisible Bool
emailNotifications = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Creating user."
  Maybe IdentifierUser
maybeExistingUser <- Username -> SeldaTransactionT m (Maybe IdentifierUser)
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
Username -> SeldaTransactionT m (Maybe IdentifierUser)
userLookupId Username
username
  case Maybe IdentifierUser
maybeExistingUser of
    Maybe IdentifierUser
Nothing -> m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Username doesn't exist yet."
    Just IdentifierUser
_ -> do
      m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Username is already taken. Cannot create new user."
      SqlErrorMensamUsernameIsTaken -> SeldaTransactionT m ()
forall e a.
(HasCallStack, Exception e) =>
e -> SeldaTransactionT m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM SqlErrorMensamUsernameIsTaken
MkSqlErrorMensamUsernameIsTaken
  PasswordHash Bcrypt
passwordHash :: PasswordHash Bcrypt <- Password -> SeldaTransactionT m (PasswordHash Bcrypt)
forall (m :: * -> *).
MonadIO m =>
Password -> m (PasswordHash Bcrypt)
hashPassword Password
password
  let dbUser :: DbUser
dbUser =
        MkDbUser
          { dbUser_id :: ID DbUser
dbUser_id = ID DbUser
forall a. SqlType a => a
Selda.def
          , dbUser_name :: Text
dbUser_name = Username -> Text
unUsername Username
username
          , dbUser_password_hash :: Text
dbUser_password_hash = PasswordHash Bcrypt -> Text
forall a. PasswordHash a -> Text
unPasswordHash PasswordHash Bcrypt
passwordHash
          , dbUser_email :: Text
dbUser_email = EmailAddress -> Text
toText EmailAddress
emailAddress
          , dbUser_email_visibility :: DbEmailVisibility
dbUser_email_visibility =
              if Bool
emailAddressVisible
                then DbEmailVisibility
MkDbEmailVisibility_visible
                else DbEmailVisibility
MkDbEmailVisibility_hidden
          , dbUser_email_validated :: Bool
dbUser_email_validated = Bool
False
          , dbUser_email_notifications :: Bool
dbUser_email_notifications = Bool
emailNotifications
          , dbUser_picture_jpeg :: Maybe ByteString
dbUser_picture_jpeg = Maybe ByteString
forall a. Maybe a
Nothing
          }
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Inserting user into database."
  ID DbUser
dbUserId <- Table DbUser -> [DbUser] -> SeldaTransactionT m (ID DbUser)
forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a -> [a] -> m (ID a)
Selda.insertWithPK Table DbUser
tableUser [DbUser
dbUser]
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Created user successfully."
  IdentifierUser -> SeldaTransactionT m IdentifierUser
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IdentifierUser -> SeldaTransactionT m IdentifierUser)
-> IdentifierUser -> SeldaTransactionT m IdentifierUser
forall a b. (a -> b) -> a -> b
$ Int64 -> IdentifierUser
MkIdentifierUser (Int64 -> IdentifierUser) -> Int64 -> IdentifierUser
forall a b. (a -> b) -> a -> b
$ forall a. ID a -> Int64
Selda.fromId @DbUser ID DbUser
dbUserId

type SqlErrorMensamUsernameIsTaken :: Type
data SqlErrorMensamUsernameIsTaken = MkSqlErrorMensamUsernameIsTaken
  deriving stock (SqlErrorMensamUsernameIsTaken
-> SqlErrorMensamUsernameIsTaken -> Bool
(SqlErrorMensamUsernameIsTaken
 -> SqlErrorMensamUsernameIsTaken -> Bool)
-> (SqlErrorMensamUsernameIsTaken
    -> SqlErrorMensamUsernameIsTaken -> Bool)
-> Eq SqlErrorMensamUsernameIsTaken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SqlErrorMensamUsernameIsTaken
-> SqlErrorMensamUsernameIsTaken -> Bool
== :: SqlErrorMensamUsernameIsTaken
-> SqlErrorMensamUsernameIsTaken -> Bool
$c/= :: SqlErrorMensamUsernameIsTaken
-> SqlErrorMensamUsernameIsTaken -> Bool
/= :: SqlErrorMensamUsernameIsTaken
-> SqlErrorMensamUsernameIsTaken -> Bool
Eq, (forall x.
 SqlErrorMensamUsernameIsTaken
 -> Rep SqlErrorMensamUsernameIsTaken x)
-> (forall x.
    Rep SqlErrorMensamUsernameIsTaken x
    -> SqlErrorMensamUsernameIsTaken)
-> Generic SqlErrorMensamUsernameIsTaken
forall x.
Rep SqlErrorMensamUsernameIsTaken x
-> SqlErrorMensamUsernameIsTaken
forall x.
SqlErrorMensamUsernameIsTaken
-> Rep SqlErrorMensamUsernameIsTaken x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
SqlErrorMensamUsernameIsTaken
-> Rep SqlErrorMensamUsernameIsTaken x
from :: forall x.
SqlErrorMensamUsernameIsTaken
-> Rep SqlErrorMensamUsernameIsTaken x
$cto :: forall x.
Rep SqlErrorMensamUsernameIsTaken x
-> SqlErrorMensamUsernameIsTaken
to :: forall x.
Rep SqlErrorMensamUsernameIsTaken x
-> SqlErrorMensamUsernameIsTaken
Generic, Eq SqlErrorMensamUsernameIsTaken
Eq SqlErrorMensamUsernameIsTaken =>
(SqlErrorMensamUsernameIsTaken
 -> SqlErrorMensamUsernameIsTaken -> Ordering)
-> (SqlErrorMensamUsernameIsTaken
    -> SqlErrorMensamUsernameIsTaken -> Bool)
-> (SqlErrorMensamUsernameIsTaken
    -> SqlErrorMensamUsernameIsTaken -> Bool)
-> (SqlErrorMensamUsernameIsTaken
    -> SqlErrorMensamUsernameIsTaken -> Bool)
-> (SqlErrorMensamUsernameIsTaken
    -> SqlErrorMensamUsernameIsTaken -> Bool)
-> (SqlErrorMensamUsernameIsTaken
    -> SqlErrorMensamUsernameIsTaken -> SqlErrorMensamUsernameIsTaken)
-> (SqlErrorMensamUsernameIsTaken
    -> SqlErrorMensamUsernameIsTaken -> SqlErrorMensamUsernameIsTaken)
-> Ord SqlErrorMensamUsernameIsTaken
SqlErrorMensamUsernameIsTaken
-> SqlErrorMensamUsernameIsTaken -> Bool
SqlErrorMensamUsernameIsTaken
-> SqlErrorMensamUsernameIsTaken -> Ordering
SqlErrorMensamUsernameIsTaken
-> SqlErrorMensamUsernameIsTaken -> SqlErrorMensamUsernameIsTaken
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SqlErrorMensamUsernameIsTaken
-> SqlErrorMensamUsernameIsTaken -> Ordering
compare :: SqlErrorMensamUsernameIsTaken
-> SqlErrorMensamUsernameIsTaken -> Ordering
$c< :: SqlErrorMensamUsernameIsTaken
-> SqlErrorMensamUsernameIsTaken -> Bool
< :: SqlErrorMensamUsernameIsTaken
-> SqlErrorMensamUsernameIsTaken -> Bool
$c<= :: SqlErrorMensamUsernameIsTaken
-> SqlErrorMensamUsernameIsTaken -> Bool
<= :: SqlErrorMensamUsernameIsTaken
-> SqlErrorMensamUsernameIsTaken -> Bool
$c> :: SqlErrorMensamUsernameIsTaken
-> SqlErrorMensamUsernameIsTaken -> Bool
> :: SqlErrorMensamUsernameIsTaken
-> SqlErrorMensamUsernameIsTaken -> Bool
$c>= :: SqlErrorMensamUsernameIsTaken
-> SqlErrorMensamUsernameIsTaken -> Bool
>= :: SqlErrorMensamUsernameIsTaken
-> SqlErrorMensamUsernameIsTaken -> Bool
$cmax :: SqlErrorMensamUsernameIsTaken
-> SqlErrorMensamUsernameIsTaken -> SqlErrorMensamUsernameIsTaken
max :: SqlErrorMensamUsernameIsTaken
-> SqlErrorMensamUsernameIsTaken -> SqlErrorMensamUsernameIsTaken
$cmin :: SqlErrorMensamUsernameIsTaken
-> SqlErrorMensamUsernameIsTaken -> SqlErrorMensamUsernameIsTaken
min :: SqlErrorMensamUsernameIsTaken
-> SqlErrorMensamUsernameIsTaken -> SqlErrorMensamUsernameIsTaken
Ord, ReadPrec [SqlErrorMensamUsernameIsTaken]
ReadPrec SqlErrorMensamUsernameIsTaken
Int -> ReadS SqlErrorMensamUsernameIsTaken
ReadS [SqlErrorMensamUsernameIsTaken]
(Int -> ReadS SqlErrorMensamUsernameIsTaken)
-> ReadS [SqlErrorMensamUsernameIsTaken]
-> ReadPrec SqlErrorMensamUsernameIsTaken
-> ReadPrec [SqlErrorMensamUsernameIsTaken]
-> Read SqlErrorMensamUsernameIsTaken
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SqlErrorMensamUsernameIsTaken
readsPrec :: Int -> ReadS SqlErrorMensamUsernameIsTaken
$creadList :: ReadS [SqlErrorMensamUsernameIsTaken]
readList :: ReadS [SqlErrorMensamUsernameIsTaken]
$creadPrec :: ReadPrec SqlErrorMensamUsernameIsTaken
readPrec :: ReadPrec SqlErrorMensamUsernameIsTaken
$creadListPrec :: ReadPrec [SqlErrorMensamUsernameIsTaken]
readListPrec :: ReadPrec [SqlErrorMensamUsernameIsTaken]
Read, Int -> SqlErrorMensamUsernameIsTaken -> ShowS
[SqlErrorMensamUsernameIsTaken] -> ShowS
SqlErrorMensamUsernameIsTaken -> String
(Int -> SqlErrorMensamUsernameIsTaken -> ShowS)
-> (SqlErrorMensamUsernameIsTaken -> String)
-> ([SqlErrorMensamUsernameIsTaken] -> ShowS)
-> Show SqlErrorMensamUsernameIsTaken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SqlErrorMensamUsernameIsTaken -> ShowS
showsPrec :: Int -> SqlErrorMensamUsernameIsTaken -> ShowS
$cshow :: SqlErrorMensamUsernameIsTaken -> String
show :: SqlErrorMensamUsernameIsTaken -> String
$cshowList :: [SqlErrorMensamUsernameIsTaken] -> ShowS
showList :: [SqlErrorMensamUsernameIsTaken] -> ShowS
Show)
  deriving anyclass (Show SqlErrorMensamUsernameIsTaken
Typeable SqlErrorMensamUsernameIsTaken
(Typeable SqlErrorMensamUsernameIsTaken,
 Show SqlErrorMensamUsernameIsTaken) =>
(SqlErrorMensamUsernameIsTaken -> SomeException)
-> (SomeException -> Maybe SqlErrorMensamUsernameIsTaken)
-> (SqlErrorMensamUsernameIsTaken -> String)
-> Exception SqlErrorMensamUsernameIsTaken
SomeException -> Maybe SqlErrorMensamUsernameIsTaken
SqlErrorMensamUsernameIsTaken -> String
SqlErrorMensamUsernameIsTaken -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: SqlErrorMensamUsernameIsTaken -> SomeException
toException :: SqlErrorMensamUsernameIsTaken -> SomeException
$cfromException :: SomeException -> Maybe SqlErrorMensamUsernameIsTaken
fromException :: SomeException -> Maybe SqlErrorMensamUsernameIsTaken
$cdisplayException :: SqlErrorMensamUsernameIsTaken -> String
displayException :: SqlErrorMensamUsernameIsTaken -> String
Exception)

userSetPassword ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierUser ->
  Password ->
  SeldaTransactionT m ()
userSetPassword :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierUser -> Password -> SeldaTransactionT m ()
userSetPassword IdentifierUser
identifier Password
password = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Set new user password."
  PasswordHash Bcrypt
passwordHash :: PasswordHash Bcrypt <- Password -> SeldaTransactionT m (PasswordHash Bcrypt)
forall (m :: * -> *).
MonadIO m =>
Password -> m (PasswordHash Bcrypt)
hashPassword Password
password
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Hashed password."
  Table DbUser
-> (Row (Backend (SeldaTransactionT m)) DbUser
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> (Row (Backend (SeldaTransactionT m)) DbUser
    -> Row (Backend (SeldaTransactionT m)) DbUser)
-> SeldaTransactionT m ()
forall (m :: * -> *) a.
(MonadSelda m, MonadThrow m, Relational a) =>
Table a
-> (Row (Backend m) a -> Col (Backend m) Bool)
-> (Row (Backend m) a -> Row (Backend m) a)
-> m ()
Selda.updateOne
    Table DbUser
tableUser
    (Selector DbUser (ID DbUser)
#dbUser_id Selector DbUser (ID DbUser)
-> ID DbUser -> Row SQLite DbUser -> Col SQLite Bool
forall r s c.
SqlType c =>
Selector r c -> c -> Row s r -> Col s Bool
`Selda.is` forall a. Int64 -> ID a
Selda.toId @DbUser (IdentifierUser -> Int64
unIdentifierUser IdentifierUser
identifier))
    (Row (Backend (SeldaTransactionT m)) DbUser
-> [Assignment (Backend (SeldaTransactionT m)) DbUser]
-> Row (Backend (SeldaTransactionT m)) DbUser
forall s a. Row s a -> [Assignment s a] -> Row s a
`Selda.with` [Selector DbUser Text
#dbUser_password_hash Selector DbUser Text -> Col SQLite Text -> Assignment SQLite DbUser
forall a a1 s. Selector a a1 -> Col s a1 -> Assignment s a
Selda.:= Text -> Col SQLite Text
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (PasswordHash Bcrypt -> Text
forall a. PasswordHash a -> Text
unPasswordHash PasswordHash Bcrypt
passwordHash)])
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Set new password successfully."

userSetPicture ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierUser ->
  Maybe ByteStringJpeg ->
  SeldaTransactionT m ()
userSetPicture :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierUser -> Maybe ByteStringJpeg -> SeldaTransactionT m ()
userSetPicture IdentifierUser
identifier Maybe ByteStringJpeg
picture = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Set new profile picture."
  Table DbUser
-> (Row (Backend (SeldaTransactionT m)) DbUser
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> (Row (Backend (SeldaTransactionT m)) DbUser
    -> Row (Backend (SeldaTransactionT m)) DbUser)
-> SeldaTransactionT m ()
forall (m :: * -> *) a.
(MonadSelda m, MonadThrow m, Relational a) =>
Table a
-> (Row (Backend m) a -> Col (Backend m) Bool)
-> (Row (Backend m) a -> Row (Backend m) a)
-> m ()
Selda.updateOne
    Table DbUser
tableUser
    (Selector DbUser (ID DbUser)
#dbUser_id Selector DbUser (ID DbUser)
-> ID DbUser -> Row SQLite DbUser -> Col SQLite Bool
forall r s c.
SqlType c =>
Selector r c -> c -> Row s r -> Col s Bool
`Selda.is` forall a. Int64 -> ID a
Selda.toId @DbUser (IdentifierUser -> Int64
unIdentifierUser IdentifierUser
identifier))
    (Row (Backend (SeldaTransactionT m)) DbUser
-> [Assignment (Backend (SeldaTransactionT m)) DbUser]
-> Row (Backend (SeldaTransactionT m)) DbUser
forall s a. Row s a -> [Assignment s a] -> Row s a
`Selda.with` [Selector DbUser (Maybe ByteString)
#dbUser_picture_jpeg Selector DbUser (Maybe ByteString)
-> Col SQLite (Maybe ByteString) -> Assignment SQLite DbUser
forall a a1 s. Selector a a1 -> Col s a1 -> Assignment s a
Selda.:= Maybe ByteString -> Col SQLite (Maybe ByteString)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (ByteStringJpeg -> ByteString) -> ByteStringJpeg -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteStringJpeg -> ByteString
unByteStringJpeg (ByteStringJpeg -> ByteString)
-> Maybe ByteStringJpeg -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteStringJpeg
picture)])
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Set new profile picture successfully."

userGetPicture ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierUser ->
  SeldaTransactionT m (Maybe ByteStringJpeg)
userGetPicture :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierUser -> SeldaTransactionT m (Maybe ByteStringJpeg)
userGetPicture IdentifierUser
identifier = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Get profile picture."
  Maybe ByteString
picture <- Query
  (Backend (SeldaTransactionT m)) (Col SQLite (Maybe ByteString))
-> SeldaTransactionT m (Res (Col SQLite (Maybe ByteString)))
forall (m :: * -> *) a.
(MonadSelda m, MonadCatch m, Result a) =>
Query (Backend m) a -> m (Res a)
Selda.queryOne (Query
   (Backend (SeldaTransactionT m)) (Col SQLite (Maybe ByteString))
 -> SeldaTransactionT m (Res (Col SQLite (Maybe ByteString))))
-> Query
     (Backend (SeldaTransactionT m)) (Col SQLite (Maybe ByteString))
-> SeldaTransactionT m (Res (Col SQLite (Maybe ByteString)))
forall a b. (a -> b) -> a -> b
$ do
    Row SQLite DbUser
user <- Table DbUser -> Query SQLite (Row SQLite DbUser)
forall a s. Relational a => Table a -> Query s (Row s a)
Selda.select Table DbUser
tableUser
    Col SQLite Bool -> Query SQLite ()
forall s t. Same s t => Col s Bool -> Query t ()
Selda.restrict (Col SQLite Bool -> Query SQLite ())
-> Col SQLite Bool -> Query SQLite ()
forall a b. (a -> b) -> a -> b
$ Row SQLite DbUser
user Row SQLite DbUser
-> Selector DbUser (ID DbUser) -> Col SQLite (ID DbUser)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbUser (ID DbUser)
#dbUser_id Col SQLite (ID DbUser) -> Col SQLite (ID DbUser) -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda..== ID DbUser -> Col SQLite (ID DbUser)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbUser (Int64 -> ID DbUser) -> Int64 -> ID DbUser
forall a b. (a -> b) -> a -> b
$ IdentifierUser -> Int64
unIdentifierUser IdentifierUser
identifier)
    Col SQLite (Maybe ByteString)
-> Query SQLite (Col SQLite (Maybe ByteString))
forall a. a -> Query SQLite a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Col SQLite (Maybe ByteString)
 -> Query SQLite (Col SQLite (Maybe ByteString)))
-> Col SQLite (Maybe ByteString)
-> Query SQLite (Col SQLite (Maybe ByteString))
forall a b. (a -> b) -> a -> b
$ Row SQLite DbUser
user Row SQLite DbUser
-> Selector DbUser (Maybe ByteString)
-> Col SQLite (Maybe ByteString)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbUser (Maybe ByteString)
#dbUser_picture_jpeg
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Got profile picture successfully."
  Maybe ByteStringJpeg -> SeldaTransactionT m (Maybe ByteStringJpeg)
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteStringJpeg
 -> SeldaTransactionT m (Maybe ByteStringJpeg))
-> Maybe ByteStringJpeg
-> SeldaTransactionT m (Maybe ByteStringJpeg)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteStringJpeg
MkByteStringJpegUnsafe (ByteString -> ByteStringJpeg)
-> (ByteString -> ByteString) -> ByteString -> ByteStringJpeg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict (ByteString -> ByteStringJpeg)
-> Maybe ByteString -> Maybe ByteStringJpeg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
picture

type SessionValidity :: Type
data SessionValidity
  = SessionValid
  | SessionInvalid
  deriving stock (SessionValidity -> SessionValidity -> Bool
(SessionValidity -> SessionValidity -> Bool)
-> (SessionValidity -> SessionValidity -> Bool)
-> Eq SessionValidity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SessionValidity -> SessionValidity -> Bool
== :: SessionValidity -> SessionValidity -> Bool
$c/= :: SessionValidity -> SessionValidity -> Bool
/= :: SessionValidity -> SessionValidity -> Bool
Eq, (forall x. SessionValidity -> Rep SessionValidity x)
-> (forall x. Rep SessionValidity x -> SessionValidity)
-> Generic SessionValidity
forall x. Rep SessionValidity x -> SessionValidity
forall x. SessionValidity -> Rep SessionValidity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SessionValidity -> Rep SessionValidity x
from :: forall x. SessionValidity -> Rep SessionValidity x
$cto :: forall x. Rep SessionValidity x -> SessionValidity
to :: forall x. Rep SessionValidity x -> SessionValidity
Generic, Eq SessionValidity
Eq SessionValidity =>
(SessionValidity -> SessionValidity -> Ordering)
-> (SessionValidity -> SessionValidity -> Bool)
-> (SessionValidity -> SessionValidity -> Bool)
-> (SessionValidity -> SessionValidity -> Bool)
-> (SessionValidity -> SessionValidity -> Bool)
-> (SessionValidity -> SessionValidity -> SessionValidity)
-> (SessionValidity -> SessionValidity -> SessionValidity)
-> Ord SessionValidity
SessionValidity -> SessionValidity -> Bool
SessionValidity -> SessionValidity -> Ordering
SessionValidity -> SessionValidity -> SessionValidity
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SessionValidity -> SessionValidity -> Ordering
compare :: SessionValidity -> SessionValidity -> Ordering
$c< :: SessionValidity -> SessionValidity -> Bool
< :: SessionValidity -> SessionValidity -> Bool
$c<= :: SessionValidity -> SessionValidity -> Bool
<= :: SessionValidity -> SessionValidity -> Bool
$c> :: SessionValidity -> SessionValidity -> Bool
> :: SessionValidity -> SessionValidity -> Bool
$c>= :: SessionValidity -> SessionValidity -> Bool
>= :: SessionValidity -> SessionValidity -> Bool
$cmax :: SessionValidity -> SessionValidity -> SessionValidity
max :: SessionValidity -> SessionValidity -> SessionValidity
$cmin :: SessionValidity -> SessionValidity -> SessionValidity
min :: SessionValidity -> SessionValidity -> SessionValidity
Ord, ReadPrec [SessionValidity]
ReadPrec SessionValidity
Int -> ReadS SessionValidity
ReadS [SessionValidity]
(Int -> ReadS SessionValidity)
-> ReadS [SessionValidity]
-> ReadPrec SessionValidity
-> ReadPrec [SessionValidity]
-> Read SessionValidity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SessionValidity
readsPrec :: Int -> ReadS SessionValidity
$creadList :: ReadS [SessionValidity]
readList :: ReadS [SessionValidity]
$creadPrec :: ReadPrec SessionValidity
readPrec :: ReadPrec SessionValidity
$creadListPrec :: ReadPrec [SessionValidity]
readListPrec :: ReadPrec [SessionValidity]
Read, Int -> SessionValidity -> ShowS
[SessionValidity] -> ShowS
SessionValidity -> String
(Int -> SessionValidity -> ShowS)
-> (SessionValidity -> String)
-> ([SessionValidity] -> ShowS)
-> Show SessionValidity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SessionValidity -> ShowS
showsPrec :: Int -> SessionValidity -> ShowS
$cshow :: SessionValidity -> String
show :: SessionValidity -> String
$cshowList :: [SessionValidity] -> ShowS
showList :: [SessionValidity] -> ShowS
Show)

userSessionValidate ::
  (MonadIO m, MonadLogger m, MonadSeldaPool m) =>
  IdentifierSession ->
  SeldaTransactionT m SessionValidity
userSessionValidate :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
IdentifierSession -> SeldaTransactionT m SessionValidity
userSessionValidate IdentifierSession
identifier = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Querying session " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierSession -> String
forall a. Show a => a -> String
show IdentifierSession
identifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" from database to validate."
  Maybe DbSession
maybeSession :: Maybe DbSession <- Query (Backend (SeldaTransactionT m)) (Row SQLite DbSession)
-> SeldaTransactionT m (Maybe (Res (Row SQLite DbSession)))
forall (m :: * -> *) a.
(MonadSelda m, MonadThrow m, Result a) =>
Query (Backend m) a -> m (Maybe (Res a))
Selda.queryUnique (Query (Backend (SeldaTransactionT m)) (Row SQLite DbSession)
 -> SeldaTransactionT m (Maybe (Res (Row SQLite DbSession))))
-> Query (Backend (SeldaTransactionT m)) (Row SQLite DbSession)
-> SeldaTransactionT m (Maybe (Res (Row SQLite DbSession)))
forall a b. (a -> b) -> a -> b
$ do
    Row SQLite DbSession
session <- Table DbSession -> Query SQLite (Row SQLite DbSession)
forall a s. Relational a => Table a -> Query s (Row s a)
Selda.select Table DbSession
tableSession
    Col SQLite Bool -> Query SQLite ()
forall s t. Same s t => Col s Bool -> Query t ()
Selda.restrict (Col SQLite Bool -> Query SQLite ())
-> Col SQLite Bool -> Query SQLite ()
forall a b. (a -> b) -> a -> b
$ Row SQLite DbSession
session Row SQLite DbSession
-> Selector DbSession (ID DbSession) -> Col SQLite (ID DbSession)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbSession (ID DbSession)
#dbSession_id Col SQLite (ID DbSession)
-> Col SQLite (ID DbSession) -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda..== ID DbSession -> Col SQLite (ID DbSession)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbSession (Int64 -> ID DbSession) -> Int64 -> ID DbSession
forall a b. (a -> b) -> a -> b
$ IdentifierSession -> Int64
unIdentifierSession IdentifierSession
identifier)
    Row SQLite DbSession -> Query SQLite (Row SQLite DbSession)
forall a. a -> Query SQLite a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Row SQLite DbSession
session
  case Maybe DbSession
maybeSession of
    Maybe DbSession
Nothing -> do
      m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Session validation failed. Session does not exist."
      SessionValidity -> SeldaTransactionT m SessionValidity
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SessionValidity
SessionInvalid
    Just DbSession
dbSession -> do
      -- TODO: Currently the session expiration is checked twice.
      --       Once by servant-auth and once in this following piece of code.
      --       For optimization the following code could be removed.
      m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Queried session from database for validation. Checking whether session is still valid."
      case DbSession -> Maybe UTCTime
dbSession_time_expired DbSession
dbSession of
        Maybe UTCTime
Nothing -> do
          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Session validation succeeded. Session does not expire."
          SessionValidity -> SeldaTransactionT m SessionValidity
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SessionValidity
SessionValid
        Just UTCTime
expirationTime -> do
          UTCTime
currentTime <- IO UTCTime -> SeldaTransactionT m UTCTime
forall a. IO a -> SeldaTransactionT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
T.getCurrentTime
          if UTCTime
currentTime UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
>= UTCTime
expirationTime
            then do
              m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Session validation failed. Session has expired."
              SessionValidity -> SeldaTransactionT m SessionValidity
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SessionValidity
SessionInvalid
            else do
              m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Session validation succeeded. Session has not yet expired."
              SessionValidity -> SeldaTransactionT m SessionValidity
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SessionValidity
SessionValid

userSessionGet ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierSession ->
  SeldaTransactionT m Session
userSessionGet :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSession -> SeldaTransactionT m Session
userSessionGet IdentifierSession
identifier = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Get session info with identifier: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierSession -> String
forall a. Show a => a -> String
show IdentifierSession
identifier)
  DbSession
dbSession <- Query (Backend (SeldaTransactionT m)) (Row SQLite DbSession)
-> SeldaTransactionT m (Res (Row SQLite DbSession))
forall (m :: * -> *) a.
(MonadSelda m, MonadCatch m, Result a) =>
Query (Backend m) a -> m (Res a)
Selda.queryOne (Query (Backend (SeldaTransactionT m)) (Row SQLite DbSession)
 -> SeldaTransactionT m (Res (Row SQLite DbSession)))
-> Query (Backend (SeldaTransactionT m)) (Row SQLite DbSession)
-> SeldaTransactionT m (Res (Row SQLite DbSession))
forall a b. (a -> b) -> a -> b
$ do
    Row SQLite DbSession
dbSession <- Table DbSession -> Query SQLite (Row SQLite DbSession)
forall a s. Relational a => Table a -> Query s (Row s a)
Selda.select Table DbSession
tableSession
    Col SQLite Bool -> Query SQLite ()
forall s t. Same s t => Col s Bool -> Query t ()
Selda.restrict (Col SQLite Bool -> Query SQLite ())
-> Col SQLite Bool -> Query SQLite ()
forall a b. (a -> b) -> a -> b
$ Row SQLite DbSession
dbSession Row SQLite DbSession
-> Selector DbSession (ID DbSession) -> Col SQLite (ID DbSession)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbSession (ID DbSession)
#dbSession_id Col SQLite (ID DbSession)
-> Col SQLite (ID DbSession) -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda..== ID DbSession -> Col SQLite (ID DbSession)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbSession (Int64 -> ID DbSession) -> Int64 -> ID DbSession
forall a b. (a -> b) -> a -> b
$ IdentifierSession -> Int64
unIdentifierSession IdentifierSession
identifier)
    Row SQLite DbSession -> Query SQLite (Row SQLite DbSession)
forall a. a -> Query SQLite a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Row SQLite DbSession
dbSession
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Got session info successfully."
  Session -> SeldaTransactionT m Session
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    MkSession
      { sessionId :: IdentifierSession
sessionId = Int64 -> IdentifierSession
MkIdentifierSession (Int64 -> IdentifierSession) -> Int64 -> IdentifierSession
forall a b. (a -> b) -> a -> b
$ forall a. ID a -> Int64
Selda.fromId @DbSession (ID DbSession -> Int64) -> ID DbSession -> Int64
forall a b. (a -> b) -> a -> b
$ DbSession -> ID DbSession
dbSession_id DbSession
dbSession
      , sessionTimeCreated :: UTCTime
sessionTimeCreated = DbSession -> UTCTime
dbSession_time_created DbSession
dbSession
      , sessionTimeExpired :: Maybe UTCTime
sessionTimeExpired = DbSession -> Maybe UTCTime
dbSession_time_expired DbSession
dbSession
      }

userSessionCreate ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierUser ->
  -- | session created
  T.UTCTime ->
  -- | session expires
  Maybe T.UTCTime ->
  SeldaTransactionT m IdentifierSession
userSessionCreate :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierUser
-> UTCTime
-> Maybe UTCTime
-> SeldaTransactionT m IdentifierSession
userSessionCreate IdentifierUser
userIdentifier UTCTime
timeCreated Maybe UTCTime
maybeTimeExpired = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Creating session for user: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierUser -> String
forall a. Show a => a -> String
show IdentifierUser
userIdentifier)
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Inserting session into database."
  ID DbSession
dbSessionId <-
    Table DbSession
-> [DbSession] -> SeldaTransactionT m (ID DbSession)
forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a -> [a] -> m (ID a)
Selda.insertWithPK
      Table DbSession
tableSession
      [ MkDbSession
          { dbSession_id :: ID DbSession
dbSession_id = ID DbSession
forall a. SqlType a => a
Selda.def
          , dbSession_user :: ID DbUser
dbSession_user = forall a. Int64 -> ID a
Selda.toId @DbUser (Int64 -> ID DbUser) -> Int64 -> ID DbUser
forall a b. (a -> b) -> a -> b
$ IdentifierUser -> Int64
unIdentifierUser IdentifierUser
userIdentifier
          , dbSession_time_created :: UTCTime
dbSession_time_created = UTCTime
timeCreated
          , dbSession_time_expired :: Maybe UTCTime
dbSession_time_expired = Maybe UTCTime
maybeTimeExpired
          }
      ]
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Created session successfully."
  IdentifierSession -> SeldaTransactionT m IdentifierSession
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IdentifierSession -> SeldaTransactionT m IdentifierSession)
-> IdentifierSession -> SeldaTransactionT m IdentifierSession
forall a b. (a -> b) -> a -> b
$ Int64 -> IdentifierSession
MkIdentifierSession (Int64 -> IdentifierSession) -> Int64 -> IdentifierSession
forall a b. (a -> b) -> a -> b
$ forall a. ID a -> Int64
Selda.fromId @DbSession ID DbSession
dbSessionId

userSessionDelete ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierSession ->
  SeldaTransactionT m ()
userSessionDelete :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSession -> SeldaTransactionT m ()
userSessionDelete IdentifierSession
identifier = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Deleting session from database: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierSession -> String
forall a. Show a => a -> String
show IdentifierSession
identifier)
  Int
count <-
    Table DbSession
-> (Row (Backend (SeldaTransactionT m)) DbSession
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> SeldaTransactionT m Int
forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a -> (Row (Backend m) a -> Col (Backend m) Bool) -> m Int
Selda.deleteFrom Table DbSession
tableSession ((Row (Backend (SeldaTransactionT m)) DbSession
  -> Col (Backend (SeldaTransactionT m)) Bool)
 -> SeldaTransactionT m Int)
-> (Row (Backend (SeldaTransactionT m)) DbSession
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> SeldaTransactionT m Int
forall a b. (a -> b) -> a -> b
$ \Row (Backend (SeldaTransactionT m)) DbSession
dbSession ->
      Row (Backend (SeldaTransactionT m)) DbSession
Row SQLite DbSession
dbSession Row SQLite DbSession
-> Selector DbSession (ID DbSession) -> Col SQLite (ID DbSession)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbSession (ID DbSession)
#dbSession_id Col SQLite (ID DbSession)
-> Col SQLite (ID DbSession) -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda..== ID DbSession -> Col SQLite (ID DbSession)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbSession (IdentifierSession -> Int64
unIdentifierSession IdentifierSession
identifier))
  case Int
count of
    Int
1 -> do
      m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Deleted session successfully."
      () -> SeldaTransactionT m ()
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Int
0 -> do
      m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Failed to delete session. There is no matching session: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierSession -> String
forall a. Show a => a -> String
show IdentifierSession
identifier)
      () -> SeldaTransactionT m ()
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Int
n -> do
      let message :: Text
message = Text
"Critical failure when trying to delete a single session. Multiple sessions have been deleted: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
n)
      m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logError Text
message
      String -> SeldaTransactionT m ()
forall a. HasCallStack => String -> a
error (String -> SeldaTransactionT m ())
-> String -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
message

userConfirmationConfirm ::
  (MonadIO m, MonadLogger m, MonadSeldaPool m) =>
  IdentifierUser ->
  ConfirmationSecret ->
  SeldaTransactionT m (Either ConfirmationError ())
userConfirmationConfirm :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
IdentifierUser
-> ConfirmationSecret
-> SeldaTransactionT m (Either ConfirmationError ())
userConfirmationConfirm IdentifierUser
identifier ConfirmationSecret
secret = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Attempting confirmation: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack ((IdentifierUser, ConfirmationSecret) -> String
forall a. Show a => a -> String
show (IdentifierUser
identifier, ConfirmationSecret
secret))
  DbConfirmation
dbConfirmation <- Query (Backend (SeldaTransactionT m)) (Row SQLite DbConfirmation)
-> SeldaTransactionT m (Res (Row SQLite DbConfirmation))
forall (m :: * -> *) a.
(MonadSelda m, MonadCatch m, Result a) =>
Query (Backend m) a -> m (Res a)
Selda.queryOne (Query (Backend (SeldaTransactionT m)) (Row SQLite DbConfirmation)
 -> SeldaTransactionT m (Res (Row SQLite DbConfirmation)))
-> Query
     (Backend (SeldaTransactionT m)) (Row SQLite DbConfirmation)
-> SeldaTransactionT m (Res (Row SQLite DbConfirmation))
forall a b. (a -> b) -> a -> b
$ do
    Row SQLite DbConfirmation
dbConfirmation <- Table DbConfirmation -> Query SQLite (Row SQLite DbConfirmation)
forall a s. Relational a => Table a -> Query s (Row s a)
Selda.select Table DbConfirmation
tableConfirmation
    Col SQLite Bool -> Query SQLite ()
forall s t. Same s t => Col s Bool -> Query t ()
Selda.restrict (Col SQLite Bool -> Query SQLite ())
-> Col SQLite Bool -> Query SQLite ()
forall a b. (a -> b) -> a -> b
$
      (Row SQLite DbConfirmation
dbConfirmation Row SQLite DbConfirmation
-> Selector DbConfirmation (ID DbUser) -> Col SQLite (ID DbUser)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbConfirmation (ID DbUser)
#dbConfirmation_user Col SQLite (ID DbUser) -> Col SQLite (ID DbUser) -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda..== ID DbUser -> Col SQLite (ID DbUser)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbUser (Int64 -> ID DbUser) -> Int64 -> ID DbUser
forall a b. (a -> b) -> a -> b
$ IdentifierUser -> Int64
unIdentifierUser IdentifierUser
identifier))
        Col SQLite Bool -> Col SQLite Bool -> Col SQLite Bool
forall s t. Same s t => Col s Bool -> Col t Bool -> Col s Bool
Selda..&& (Row SQLite DbConfirmation
dbConfirmation Row SQLite DbConfirmation
-> Selector DbConfirmation Text -> Col SQLite Text
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbConfirmation Text
#dbConfirmation_secret Col SQLite Text -> Col SQLite Text -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda..== Text -> Col SQLite Text
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (ConfirmationSecret -> Text
unConfirmationSecret ConfirmationSecret
secret))
    Row SQLite DbConfirmation
-> Query SQLite (Row SQLite DbConfirmation)
forall a. a -> Query SQLite a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Row SQLite DbConfirmation
dbConfirmation
  UTCTime
currentTime <- m UTCTime -> SeldaTransactionT m UTCTime
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m UTCTime -> SeldaTransactionT m UTCTime)
-> m UTCTime -> SeldaTransactionT m UTCTime
forall a b. (a -> b) -> a -> b
$ IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
T.getCurrentTime
  if UTCTime
currentTime UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
>= DbConfirmation -> UTCTime
dbConfirmation_expired DbConfirmation
dbConfirmation
    then do
      m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Confirmation has already expired: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (UTCTime -> String
forall a. Show a => a -> String
show (UTCTime -> String) -> UTCTime -> String
forall a b. (a -> b) -> a -> b
$ DbConfirmation -> UTCTime
dbConfirmation_expired DbConfirmation
dbConfirmation)
      Either ConfirmationError ()
-> SeldaTransactionT m (Either ConfirmationError ())
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ConfirmationError ()
 -> SeldaTransactionT m (Either ConfirmationError ()))
-> Either ConfirmationError ()
-> SeldaTransactionT m (Either ConfirmationError ())
forall a b. (a -> b) -> a -> b
$ ConfirmationError -> Either ConfirmationError ()
forall a b. a -> Either a b
Left ConfirmationError
MkConfirmationErrorExpired
    else do
      m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Parsing confirmation effect: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Text -> String
forall a. Show a => a -> String
show (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ DbConfirmation -> Text
dbConfirmation_effect DbConfirmation
dbConfirmation)
      case ByteString -> Either String ConfirmationEffect
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode (ByteString -> Either String ConfirmationEffect)
-> ByteString -> Either String ConfirmationEffect
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TL.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ DbConfirmation -> Text
dbConfirmation_effect DbConfirmation
dbConfirmation of
        Left String
err -> do
          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Failed to parse confirmation effect: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (ShowS
forall a. Show a => a -> String
show String
err)
          Either ConfirmationError ()
-> SeldaTransactionT m (Either ConfirmationError ())
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ConfirmationError ()
 -> SeldaTransactionT m (Either ConfirmationError ()))
-> Either ConfirmationError ()
-> SeldaTransactionT m (Either ConfirmationError ())
forall a b. (a -> b) -> a -> b
$ ConfirmationError -> Either ConfirmationError ()
forall a b. a -> Either a b
Left ConfirmationError
MkConfirmationErrorEffectInvalid
        Right ConfirmationEffect
effect -> do
          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Looked up confirmation. Running effect."
          case ConfirmationEffect
effect of
            MkConfirmationEffectEmailValidation EmailAddress
emailAddress -> do
              m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Confirming email address."
              DbUser
dbUser <- Query (Backend (SeldaTransactionT m)) (Row SQLite DbUser)
-> SeldaTransactionT m (Res (Row SQLite DbUser))
forall (m :: * -> *) a.
(MonadSelda m, MonadCatch m, Result a) =>
Query (Backend m) a -> m (Res a)
Selda.queryOne (Query (Backend (SeldaTransactionT m)) (Row SQLite DbUser)
 -> SeldaTransactionT m (Res (Row SQLite DbUser)))
-> Query (Backend (SeldaTransactionT m)) (Row SQLite DbUser)
-> SeldaTransactionT m (Res (Row SQLite DbUser))
forall a b. (a -> b) -> a -> b
$ do
                Row SQLite DbUser
dbUser <- Table DbUser -> Query SQLite (Row SQLite DbUser)
forall a s. Relational a => Table a -> Query s (Row s a)
Selda.select Table DbUser
tableUser
                Col SQLite Bool -> Query SQLite ()
forall s t. Same s t => Col s Bool -> Query t ()
Selda.restrict (Col SQLite Bool -> Query SQLite ())
-> Col SQLite Bool -> Query SQLite ()
forall a b. (a -> b) -> a -> b
$ Row SQLite DbUser
dbUser Row SQLite DbUser
-> Selector DbUser (ID DbUser) -> Col SQLite (ID DbUser)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbUser (ID DbUser)
#dbUser_id Col SQLite (ID DbUser) -> Col SQLite (ID DbUser) -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda..== ID DbUser -> Col SQLite (ID DbUser)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbUser (IdentifierUser -> Int64
unIdentifierUser IdentifierUser
identifier))
                Row SQLite DbUser -> Query SQLite (Row SQLite DbUser)
forall a. a -> Query SQLite a
forall (m :: * -> *) a. Monad m => a -> m a
return Row SQLite DbUser
dbUser
              if Text -> Either String EmailAddress
fromText (DbUser -> Text
dbUser_email DbUser
dbUser) Either String EmailAddress -> Either String EmailAddress -> Bool
forall a. Eq a => a -> a -> Bool
== EmailAddress -> Either String EmailAddress
forall a b. b -> Either a b
Right EmailAddress
emailAddress
                then do
                  Int
count <-
                    Table DbUser
-> (Row (Backend (SeldaTransactionT m)) DbUser
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> (Row (Backend (SeldaTransactionT m)) DbUser
    -> Row (Backend (SeldaTransactionT m)) DbUser)
-> SeldaTransactionT m Int
forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a
-> (Row (Backend m) a -> Col (Backend m) Bool)
-> (Row (Backend m) a -> Row (Backend m) a)
-> m Int
Selda.update
                      Table DbUser
tableUser
                      ( \Row (Backend (SeldaTransactionT m)) DbUser
dbUserRow ->
                          Row (Backend (SeldaTransactionT m)) DbUser
Row SQLite DbUser
dbUserRow Row SQLite DbUser
-> Selector DbUser (ID DbUser) -> Col SQLite (ID DbUser)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbUser (ID DbUser)
#dbUser_id Col SQLite (ID DbUser) -> Col SQLite (ID DbUser) -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda..== ID DbUser -> Col SQLite (ID DbUser)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbUser (IdentifierUser -> Int64
unIdentifierUser IdentifierUser
identifier))
                      )
                      ( \Row (Backend (SeldaTransactionT m)) DbUser
dbUserRow ->
                          Row (Backend (SeldaTransactionT m)) DbUser
Row SQLite DbUser
dbUserRow
                            Row SQLite DbUser
-> [Assignment SQLite DbUser] -> Row SQLite DbUser
forall s a. Row s a -> [Assignment s a] -> Row s a
`Selda.with` [ Selector DbUser Bool
#dbUser_email_validated
                                            Selector DbUser Bool -> Col SQLite Bool -> Assignment SQLite DbUser
forall a a1 s. Selector a a1 -> Col s a1 -> Assignment s a
Selda.:= Bool -> Col SQLite Bool
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal Bool
True
                                         ]
                      )
                  case Int
count of
                    Int
1 -> do
                      m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Validated email address."
                      () -> SeldaTransactionT m ()
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                    Int
0 -> do
                      let Text
message :: T.Text = Text
"Failed to validate email address. User not found."
                      m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logError Text
message
                      String -> SeldaTransactionT m ()
forall a. HasCallStack => String -> a
error (String -> SeldaTransactionT m ())
-> String -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
message
                    Int
n -> do
                      let Text
message :: T.Text = Text
"Critical failure when trying to validate a single email address. Multiple users have been affected: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
n)
                      m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logError Text
message
                      String -> SeldaTransactionT m ()
forall a. HasCallStack => String -> a
error (String -> SeldaTransactionT m ())
-> String -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
message
                  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Confirmed email address."
                else do
                  let Text
message :: T.Text = Text
"Email address has changed. Can't confirm it now."
                  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logWarn Text
message
                  String -> SeldaTransactionT m ()
forall a. HasCallStack => String -> a
error (String -> SeldaTransactionT m ())
-> String -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
message
          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Deleting confirmation."
          Int
count <- Table DbConfirmation
-> (Row (Backend (SeldaTransactionT m)) DbConfirmation
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> SeldaTransactionT m Int
forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a -> (Row (Backend m) a -> Col (Backend m) Bool) -> m Int
Selda.deleteFrom Table DbConfirmation
tableConfirmation ((Row (Backend (SeldaTransactionT m)) DbConfirmation
  -> Col (Backend (SeldaTransactionT m)) Bool)
 -> SeldaTransactionT m Int)
-> (Row (Backend (SeldaTransactionT m)) DbConfirmation
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> SeldaTransactionT m Int
forall a b. (a -> b) -> a -> b
$ \Row (Backend (SeldaTransactionT m)) DbConfirmation
dbConfirmation' ->
            Row (Backend (SeldaTransactionT m)) DbConfirmation
Row SQLite DbConfirmation
dbConfirmation' Row SQLite DbConfirmation
-> Selector DbConfirmation (ID DbConfirmation)
-> Col SQLite (ID DbConfirmation)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbConfirmation (ID DbConfirmation)
#dbConfirmation_id Col SQLite (ID DbConfirmation)
-> Col SQLite (ID DbConfirmation) -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda..== ID DbConfirmation -> Col SQLite (ID DbConfirmation)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (DbConfirmation -> ID DbConfirmation
dbConfirmation_id DbConfirmation
dbConfirmation)
          case Int
count of
            Int
1 -> do
              m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Deleted confirmation successfully."
              Either ConfirmationError ()
-> SeldaTransactionT m (Either ConfirmationError ())
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ConfirmationError ()
 -> SeldaTransactionT m (Either ConfirmationError ()))
-> Either ConfirmationError ()
-> SeldaTransactionT m (Either ConfirmationError ())
forall a b. (a -> b) -> a -> b
$ () -> Either ConfirmationError ()
forall a b. b -> Either a b
Right ()
            Int
0 -> do
              let Text
message :: T.Text = Text
"Failed to delete confirmation. No confirmation deleted."
              m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logWarn Text
message
              String -> SeldaTransactionT m (Either ConfirmationError ())
forall a. HasCallStack => String -> a
error (String -> SeldaTransactionT m (Either ConfirmationError ()))
-> String -> SeldaTransactionT m (Either ConfirmationError ())
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
message
            Int
n -> do
              let Text
message :: T.Text = Text
"Critical failure when trying to delete a single confirmation. Multiple confirmations have been deleted: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
n)
              m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logError Text
message
              String -> SeldaTransactionT m (Either ConfirmationError ())
forall a. HasCallStack => String -> a
error (String -> SeldaTransactionT m (Either ConfirmationError ()))
-> String -> SeldaTransactionT m (Either ConfirmationError ())
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
message

userConfirmationCreate ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierUser ->
  ConfirmationEffect ->
  T.UTCTime ->
  SeldaTransactionT m ConfirmationSecret
userConfirmationCreate :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierUser
-> ConfirmationEffect
-> UTCTime
-> SeldaTransactionT m ConfirmationSecret
userConfirmationCreate IdentifierUser
userIdentifier ConfirmationEffect
effect UTCTime
expires = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Creating confirmation for user: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierUser -> String
forall a. Show a => a -> String
show IdentifierUser
userIdentifier)
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Generating secret for confirmation."
  ConfirmationSecret
secret <- Text -> ConfirmationSecret
MkConfirmationSecret (Text -> ConfirmationSecret)
-> (Word -> Text) -> Word -> ConfirmationSecret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Word -> String) -> Word -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show @Word (Word -> ConfirmationSecret)
-> SeldaTransactionT m Word
-> SeldaTransactionT m ConfirmationSecret
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SeldaTransactionT m Word
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Generating secret for confirmation."
  ID DbConfirmation
dbConfirmationId <-
    Table DbConfirmation
-> [DbConfirmation] -> SeldaTransactionT m (ID DbConfirmation)
forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a -> [a] -> m (ID a)
Selda.insertWithPK
      Table DbConfirmation
tableConfirmation
      [ MkDbConfirmation
          { dbConfirmation_id :: ID DbConfirmation
dbConfirmation_id = ID DbConfirmation
forall a. SqlType a => a
Selda.def
          , dbConfirmation_user :: ID DbUser
dbConfirmation_user = forall a. Int64 -> ID a
Selda.toId @DbUser (Int64 -> ID DbUser) -> Int64 -> ID DbUser
forall a b. (a -> b) -> a -> b
$ IdentifierUser -> Int64
unIdentifierUser IdentifierUser
userIdentifier
          , dbConfirmation_secret :: Text
dbConfirmation_secret = ConfirmationSecret -> Text
unConfirmationSecret ConfirmationSecret
secret
          , dbConfirmation_expired :: UTCTime
dbConfirmation_expired = UTCTime
expires
          , dbConfirmation_effect :: Text
dbConfirmation_effect = Text -> Text
TL.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ConfirmationEffect -> Text
forall a. ToJSON a => a -> Text
A.encodeToLazyText ConfirmationEffect
effect
          }
      ]
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Created confirmation successfully: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (ID DbConfirmation -> String
forall a. Show a => a -> String
show ID DbConfirmation
dbConfirmationId)
  ConfirmationSecret -> SeldaTransactionT m ConfirmationSecret
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfirmationSecret
secret

type ConfirmationError :: Type
data ConfirmationError
  = MkConfirmationErrorExpired
  | MkConfirmationErrorEffectInvalid
  deriving stock (ConfirmationError -> ConfirmationError -> Bool
(ConfirmationError -> ConfirmationError -> Bool)
-> (ConfirmationError -> ConfirmationError -> Bool)
-> Eq ConfirmationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConfirmationError -> ConfirmationError -> Bool
== :: ConfirmationError -> ConfirmationError -> Bool
$c/= :: ConfirmationError -> ConfirmationError -> Bool
/= :: ConfirmationError -> ConfirmationError -> Bool
Eq, (forall x. ConfirmationError -> Rep ConfirmationError x)
-> (forall x. Rep ConfirmationError x -> ConfirmationError)
-> Generic ConfirmationError
forall x. Rep ConfirmationError x -> ConfirmationError
forall x. ConfirmationError -> Rep ConfirmationError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConfirmationError -> Rep ConfirmationError x
from :: forall x. ConfirmationError -> Rep ConfirmationError x
$cto :: forall x. Rep ConfirmationError x -> ConfirmationError
to :: forall x. Rep ConfirmationError x -> ConfirmationError
Generic, Eq ConfirmationError
Eq ConfirmationError =>
(ConfirmationError -> ConfirmationError -> Ordering)
-> (ConfirmationError -> ConfirmationError -> Bool)
-> (ConfirmationError -> ConfirmationError -> Bool)
-> (ConfirmationError -> ConfirmationError -> Bool)
-> (ConfirmationError -> ConfirmationError -> Bool)
-> (ConfirmationError -> ConfirmationError -> ConfirmationError)
-> (ConfirmationError -> ConfirmationError -> ConfirmationError)
-> Ord ConfirmationError
ConfirmationError -> ConfirmationError -> Bool
ConfirmationError -> ConfirmationError -> Ordering
ConfirmationError -> ConfirmationError -> ConfirmationError
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ConfirmationError -> ConfirmationError -> Ordering
compare :: ConfirmationError -> ConfirmationError -> Ordering
$c< :: ConfirmationError -> ConfirmationError -> Bool
< :: ConfirmationError -> ConfirmationError -> Bool
$c<= :: ConfirmationError -> ConfirmationError -> Bool
<= :: ConfirmationError -> ConfirmationError -> Bool
$c> :: ConfirmationError -> ConfirmationError -> Bool
> :: ConfirmationError -> ConfirmationError -> Bool
$c>= :: ConfirmationError -> ConfirmationError -> Bool
>= :: ConfirmationError -> ConfirmationError -> Bool
$cmax :: ConfirmationError -> ConfirmationError -> ConfirmationError
max :: ConfirmationError -> ConfirmationError -> ConfirmationError
$cmin :: ConfirmationError -> ConfirmationError -> ConfirmationError
min :: ConfirmationError -> ConfirmationError -> ConfirmationError
Ord, ReadPrec [ConfirmationError]
ReadPrec ConfirmationError
Int -> ReadS ConfirmationError
ReadS [ConfirmationError]
(Int -> ReadS ConfirmationError)
-> ReadS [ConfirmationError]
-> ReadPrec ConfirmationError
-> ReadPrec [ConfirmationError]
-> Read ConfirmationError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ConfirmationError
readsPrec :: Int -> ReadS ConfirmationError
$creadList :: ReadS [ConfirmationError]
readList :: ReadS [ConfirmationError]
$creadPrec :: ReadPrec ConfirmationError
readPrec :: ReadPrec ConfirmationError
$creadListPrec :: ReadPrec [ConfirmationError]
readListPrec :: ReadPrec [ConfirmationError]
Read, Int -> ConfirmationError -> ShowS
[ConfirmationError] -> ShowS
ConfirmationError -> String
(Int -> ConfirmationError -> ShowS)
-> (ConfirmationError -> String)
-> ([ConfirmationError] -> ShowS)
-> Show ConfirmationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfirmationError -> ShowS
showsPrec :: Int -> ConfirmationError -> ShowS
$cshow :: ConfirmationError -> String
show :: ConfirmationError -> String
$cshowList :: [ConfirmationError] -> ShowS
showList :: [ConfirmationError] -> ShowS
Show)

type ConfirmationEffect :: Type
newtype ConfirmationEffect
  = MkConfirmationEffectEmailValidation EmailAddress
  deriving stock (ConfirmationEffect -> ConfirmationEffect -> Bool
(ConfirmationEffect -> ConfirmationEffect -> Bool)
-> (ConfirmationEffect -> ConfirmationEffect -> Bool)
-> Eq ConfirmationEffect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConfirmationEffect -> ConfirmationEffect -> Bool
== :: ConfirmationEffect -> ConfirmationEffect -> Bool
$c/= :: ConfirmationEffect -> ConfirmationEffect -> Bool
/= :: ConfirmationEffect -> ConfirmationEffect -> Bool
Eq, (forall x. ConfirmationEffect -> Rep ConfirmationEffect x)
-> (forall x. Rep ConfirmationEffect x -> ConfirmationEffect)
-> Generic ConfirmationEffect
forall x. Rep ConfirmationEffect x -> ConfirmationEffect
forall x. ConfirmationEffect -> Rep ConfirmationEffect x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConfirmationEffect -> Rep ConfirmationEffect x
from :: forall x. ConfirmationEffect -> Rep ConfirmationEffect x
$cto :: forall x. Rep ConfirmationEffect x -> ConfirmationEffect
to :: forall x. Rep ConfirmationEffect x -> ConfirmationEffect
Generic, Eq ConfirmationEffect
Eq ConfirmationEffect =>
(ConfirmationEffect -> ConfirmationEffect -> Ordering)
-> (ConfirmationEffect -> ConfirmationEffect -> Bool)
-> (ConfirmationEffect -> ConfirmationEffect -> Bool)
-> (ConfirmationEffect -> ConfirmationEffect -> Bool)
-> (ConfirmationEffect -> ConfirmationEffect -> Bool)
-> (ConfirmationEffect -> ConfirmationEffect -> ConfirmationEffect)
-> (ConfirmationEffect -> ConfirmationEffect -> ConfirmationEffect)
-> Ord ConfirmationEffect
ConfirmationEffect -> ConfirmationEffect -> Bool
ConfirmationEffect -> ConfirmationEffect -> Ordering
ConfirmationEffect -> ConfirmationEffect -> ConfirmationEffect
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ConfirmationEffect -> ConfirmationEffect -> Ordering
compare :: ConfirmationEffect -> ConfirmationEffect -> Ordering
$c< :: ConfirmationEffect -> ConfirmationEffect -> Bool
< :: ConfirmationEffect -> ConfirmationEffect -> Bool
$c<= :: ConfirmationEffect -> ConfirmationEffect -> Bool
<= :: ConfirmationEffect -> ConfirmationEffect -> Bool
$c> :: ConfirmationEffect -> ConfirmationEffect -> Bool
> :: ConfirmationEffect -> ConfirmationEffect -> Bool
$c>= :: ConfirmationEffect -> ConfirmationEffect -> Bool
>= :: ConfirmationEffect -> ConfirmationEffect -> Bool
$cmax :: ConfirmationEffect -> ConfirmationEffect -> ConfirmationEffect
max :: ConfirmationEffect -> ConfirmationEffect -> ConfirmationEffect
$cmin :: ConfirmationEffect -> ConfirmationEffect -> ConfirmationEffect
min :: ConfirmationEffect -> ConfirmationEffect -> ConfirmationEffect
Ord, ReadPrec [ConfirmationEffect]
ReadPrec ConfirmationEffect
Int -> ReadS ConfirmationEffect
ReadS [ConfirmationEffect]
(Int -> ReadS ConfirmationEffect)
-> ReadS [ConfirmationEffect]
-> ReadPrec ConfirmationEffect
-> ReadPrec [ConfirmationEffect]
-> Read ConfirmationEffect
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ConfirmationEffect
readsPrec :: Int -> ReadS ConfirmationEffect
$creadList :: ReadS [ConfirmationEffect]
readList :: ReadS [ConfirmationEffect]
$creadPrec :: ReadPrec ConfirmationEffect
readPrec :: ReadPrec ConfirmationEffect
$creadListPrec :: ReadPrec [ConfirmationEffect]
readListPrec :: ReadPrec [ConfirmationEffect]
Read, Int -> ConfirmationEffect -> ShowS
[ConfirmationEffect] -> ShowS
ConfirmationEffect -> String
(Int -> ConfirmationEffect -> ShowS)
-> (ConfirmationEffect -> String)
-> ([ConfirmationEffect] -> ShowS)
-> Show ConfirmationEffect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfirmationEffect -> ShowS
showsPrec :: Int -> ConfirmationEffect -> ShowS
$cshow :: ConfirmationEffect -> String
show :: ConfirmationEffect -> String
$cshowList :: [ConfirmationEffect] -> ShowS
showList :: [ConfirmationEffect] -> ShowS
Show)
  deriving
    (Value -> Parser [ConfirmationEffect]
Value -> Parser ConfirmationEffect
(Value -> Parser ConfirmationEffect)
-> (Value -> Parser [ConfirmationEffect])
-> FromJSON ConfirmationEffect
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ConfirmationEffect
parseJSON :: Value -> Parser ConfirmationEffect
$cparseJSONList :: Value -> Parser [ConfirmationEffect]
parseJSONList :: Value -> Parser [ConfirmationEffect]
A.FromJSON, [ConfirmationEffect] -> Value
[ConfirmationEffect] -> Encoding
ConfirmationEffect -> Value
ConfirmationEffect -> Encoding
(ConfirmationEffect -> Value)
-> (ConfirmationEffect -> Encoding)
-> ([ConfirmationEffect] -> Value)
-> ([ConfirmationEffect] -> Encoding)
-> ToJSON ConfirmationEffect
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ConfirmationEffect -> Value
toJSON :: ConfirmationEffect -> Value
$ctoEncoding :: ConfirmationEffect -> Encoding
toEncoding :: ConfirmationEffect -> Encoding
$ctoJSONList :: [ConfirmationEffect] -> Value
toJSONList :: [ConfirmationEffect] -> Value
$ctoEncodingList :: [ConfirmationEffect] -> Encoding
toEncodingList :: [ConfirmationEffect] -> Encoding
A.ToJSON)
    via A.CustomJSON (JSONSettings "MkConfirmationEffect" "") ConfirmationEffect

userNotificationsPreferencesEmailGet ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierUser ->
  SeldaTransactionT m EmailPreferences
userNotificationsPreferencesEmailGet :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierUser -> SeldaTransactionT m EmailPreferences
userNotificationsPreferencesEmailGet IdentifierUser
userIdentifier = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Get Email preferences for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierUser -> String
forall a. Show a => a -> String
show IdentifierUser
userIdentifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
  User
user <- IdentifierUser -> SeldaTransactionT m User
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierUser -> SeldaTransactionT m User
userGet IdentifierUser
userIdentifier
  if User -> Bool
userEmailNotifications User
user
    then do
      m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"User will receive notification."
      EmailPreferences -> SeldaTransactionT m EmailPreferences
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EmailPreferences -> SeldaTransactionT m EmailPreferences)
-> EmailPreferences -> SeldaTransactionT m EmailPreferences
forall a b. (a -> b) -> a -> b
$ EmailAddress -> EmailPreferences
MkEmailPreferencesSend (EmailAddress -> EmailPreferences)
-> EmailAddress -> EmailPreferences
forall a b. (a -> b) -> a -> b
$ User -> EmailAddress
userEmail User
user
    else do
      m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"User doesn't prefer email notifications."
      EmailPreferences -> SeldaTransactionT m EmailPreferences
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EmailPreferences
MkEmailPreferencesDontSend

-- | Make sure the email address is verified and only then set new email preferences.
userNotificationsPreferencesEmailSet ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierUser ->
  -- | receive email notifications
  Bool ->
  SeldaTransactionT m ()
userNotificationsPreferencesEmailSet :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierUser -> Bool -> SeldaTransactionT m ()
userNotificationsPreferencesEmailSet IdentifierUser
userIdentifier Bool
receiveNotifications = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Set Email preferences " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Bool -> String
forall a. Show a => a -> String
show Bool
receiveNotifications) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierUser -> String
forall a. Show a => a -> String
show IdentifierUser
userIdentifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
  User
user <- IdentifierUser -> SeldaTransactionT m User
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierUser -> SeldaTransactionT m User
userGet IdentifierUser
userIdentifier
  if User -> Bool
userEmailValidated User
user
    then do
      m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Email address is verified. Setting notification preferences."
      Table DbUser
-> (Row (Backend (SeldaTransactionT m)) DbUser
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> (Row (Backend (SeldaTransactionT m)) DbUser
    -> Row (Backend (SeldaTransactionT m)) DbUser)
-> SeldaTransactionT m ()
forall (m :: * -> *) a.
(MonadSelda m, MonadThrow m, Relational a) =>
Table a
-> (Row (Backend m) a -> Col (Backend m) Bool)
-> (Row (Backend m) a -> Row (Backend m) a)
-> m ()
Selda.updateOne
        Table DbUser
tableUser
        (Selector DbUser (ID DbUser)
#dbUser_id Selector DbUser (ID DbUser)
-> ID DbUser -> Row SQLite DbUser -> Col SQLite Bool
forall r s c.
SqlType c =>
Selector r c -> c -> Row s r -> Col s Bool
`Selda.is` forall a. Int64 -> ID a
Selda.toId @DbUser (IdentifierUser -> Int64
unIdentifierUser IdentifierUser
userIdentifier))
        (Row (Backend (SeldaTransactionT m)) DbUser
-> [Assignment (Backend (SeldaTransactionT m)) DbUser]
-> Row (Backend (SeldaTransactionT m)) DbUser
forall s a. Row s a -> [Assignment s a] -> Row s a
`Selda.with` [Selector DbUser Bool
#dbUser_email_notifications Selector DbUser Bool -> Col SQLite Bool -> Assignment SQLite DbUser
forall a a1 s. Selector a a1 -> Col s a1 -> Assignment s a
Selda.:= Bool -> Col SQLite Bool
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal Bool
receiveNotifications])
    else do
      m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Cannot set notification preferences, because the email address is not verified."
      SqlErrorMensamEmailNotVerified -> SeldaTransactionT m ()
forall e a.
(HasCallStack, Exception e) =>
e -> SeldaTransactionT m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM SqlErrorMensamEmailNotVerified
MkSqlErrorMensamEmailNotVerified

type EmailPreferences :: Type
data EmailPreferences
  = MkEmailPreferencesSend EmailAddress
  | MkEmailPreferencesDontSend
  deriving stock (EmailPreferences -> EmailPreferences -> Bool
(EmailPreferences -> EmailPreferences -> Bool)
-> (EmailPreferences -> EmailPreferences -> Bool)
-> Eq EmailPreferences
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EmailPreferences -> EmailPreferences -> Bool
== :: EmailPreferences -> EmailPreferences -> Bool
$c/= :: EmailPreferences -> EmailPreferences -> Bool
/= :: EmailPreferences -> EmailPreferences -> Bool
Eq, (forall x. EmailPreferences -> Rep EmailPreferences x)
-> (forall x. Rep EmailPreferences x -> EmailPreferences)
-> Generic EmailPreferences
forall x. Rep EmailPreferences x -> EmailPreferences
forall x. EmailPreferences -> Rep EmailPreferences x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EmailPreferences -> Rep EmailPreferences x
from :: forall x. EmailPreferences -> Rep EmailPreferences x
$cto :: forall x. Rep EmailPreferences x -> EmailPreferences
to :: forall x. Rep EmailPreferences x -> EmailPreferences
Generic, Eq EmailPreferences
Eq EmailPreferences =>
(EmailPreferences -> EmailPreferences -> Ordering)
-> (EmailPreferences -> EmailPreferences -> Bool)
-> (EmailPreferences -> EmailPreferences -> Bool)
-> (EmailPreferences -> EmailPreferences -> Bool)
-> (EmailPreferences -> EmailPreferences -> Bool)
-> (EmailPreferences -> EmailPreferences -> EmailPreferences)
-> (EmailPreferences -> EmailPreferences -> EmailPreferences)
-> Ord EmailPreferences
EmailPreferences -> EmailPreferences -> Bool
EmailPreferences -> EmailPreferences -> Ordering
EmailPreferences -> EmailPreferences -> EmailPreferences
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EmailPreferences -> EmailPreferences -> Ordering
compare :: EmailPreferences -> EmailPreferences -> Ordering
$c< :: EmailPreferences -> EmailPreferences -> Bool
< :: EmailPreferences -> EmailPreferences -> Bool
$c<= :: EmailPreferences -> EmailPreferences -> Bool
<= :: EmailPreferences -> EmailPreferences -> Bool
$c> :: EmailPreferences -> EmailPreferences -> Bool
> :: EmailPreferences -> EmailPreferences -> Bool
$c>= :: EmailPreferences -> EmailPreferences -> Bool
>= :: EmailPreferences -> EmailPreferences -> Bool
$cmax :: EmailPreferences -> EmailPreferences -> EmailPreferences
max :: EmailPreferences -> EmailPreferences -> EmailPreferences
$cmin :: EmailPreferences -> EmailPreferences -> EmailPreferences
min :: EmailPreferences -> EmailPreferences -> EmailPreferences
Ord, ReadPrec [EmailPreferences]
ReadPrec EmailPreferences
Int -> ReadS EmailPreferences
ReadS [EmailPreferences]
(Int -> ReadS EmailPreferences)
-> ReadS [EmailPreferences]
-> ReadPrec EmailPreferences
-> ReadPrec [EmailPreferences]
-> Read EmailPreferences
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS EmailPreferences
readsPrec :: Int -> ReadS EmailPreferences
$creadList :: ReadS [EmailPreferences]
readList :: ReadS [EmailPreferences]
$creadPrec :: ReadPrec EmailPreferences
readPrec :: ReadPrec EmailPreferences
$creadListPrec :: ReadPrec [EmailPreferences]
readListPrec :: ReadPrec [EmailPreferences]
Read, Int -> EmailPreferences -> ShowS
[EmailPreferences] -> ShowS
EmailPreferences -> String
(Int -> EmailPreferences -> ShowS)
-> (EmailPreferences -> String)
-> ([EmailPreferences] -> ShowS)
-> Show EmailPreferences
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EmailPreferences -> ShowS
showsPrec :: Int -> EmailPreferences -> ShowS
$cshow :: EmailPreferences -> String
show :: EmailPreferences -> String
$cshowList :: [EmailPreferences] -> ShowS
showList :: [EmailPreferences] -> ShowS
Show)
  deriving
    (Value -> Parser [EmailPreferences]
Value -> Parser EmailPreferences
(Value -> Parser EmailPreferences)
-> (Value -> Parser [EmailPreferences])
-> FromJSON EmailPreferences
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser EmailPreferences
parseJSON :: Value -> Parser EmailPreferences
$cparseJSONList :: Value -> Parser [EmailPreferences]
parseJSONList :: Value -> Parser [EmailPreferences]
A.FromJSON, [EmailPreferences] -> Value
[EmailPreferences] -> Encoding
EmailPreferences -> Value
EmailPreferences -> Encoding
(EmailPreferences -> Value)
-> (EmailPreferences -> Encoding)
-> ([EmailPreferences] -> Value)
-> ([EmailPreferences] -> Encoding)
-> ToJSON EmailPreferences
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: EmailPreferences -> Value
toJSON :: EmailPreferences -> Value
$ctoEncoding :: EmailPreferences -> Encoding
toEncoding :: EmailPreferences -> Encoding
$ctoJSONList :: [EmailPreferences] -> Value
toJSONList :: [EmailPreferences] -> Value
$ctoEncodingList :: [EmailPreferences] -> Encoding
toEncodingList :: [EmailPreferences] -> Encoding
A.ToJSON)
    via A.CustomJSON (JSONSettings "MkConfirmationEffect" "") EmailPreferences

type SqlErrorMensamEmailNotVerified :: Type
data SqlErrorMensamEmailNotVerified = MkSqlErrorMensamEmailNotVerified
  deriving stock (SqlErrorMensamEmailNotVerified
-> SqlErrorMensamEmailNotVerified -> Bool
(SqlErrorMensamEmailNotVerified
 -> SqlErrorMensamEmailNotVerified -> Bool)
-> (SqlErrorMensamEmailNotVerified
    -> SqlErrorMensamEmailNotVerified -> Bool)
-> Eq SqlErrorMensamEmailNotVerified
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SqlErrorMensamEmailNotVerified
-> SqlErrorMensamEmailNotVerified -> Bool
== :: SqlErrorMensamEmailNotVerified
-> SqlErrorMensamEmailNotVerified -> Bool
$c/= :: SqlErrorMensamEmailNotVerified
-> SqlErrorMensamEmailNotVerified -> Bool
/= :: SqlErrorMensamEmailNotVerified
-> SqlErrorMensamEmailNotVerified -> Bool
Eq, (forall x.
 SqlErrorMensamEmailNotVerified
 -> Rep SqlErrorMensamEmailNotVerified x)
-> (forall x.
    Rep SqlErrorMensamEmailNotVerified x
    -> SqlErrorMensamEmailNotVerified)
-> Generic SqlErrorMensamEmailNotVerified
forall x.
Rep SqlErrorMensamEmailNotVerified x
-> SqlErrorMensamEmailNotVerified
forall x.
SqlErrorMensamEmailNotVerified
-> Rep SqlErrorMensamEmailNotVerified x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
SqlErrorMensamEmailNotVerified
-> Rep SqlErrorMensamEmailNotVerified x
from :: forall x.
SqlErrorMensamEmailNotVerified
-> Rep SqlErrorMensamEmailNotVerified x
$cto :: forall x.
Rep SqlErrorMensamEmailNotVerified x
-> SqlErrorMensamEmailNotVerified
to :: forall x.
Rep SqlErrorMensamEmailNotVerified x
-> SqlErrorMensamEmailNotVerified
Generic, Eq SqlErrorMensamEmailNotVerified
Eq SqlErrorMensamEmailNotVerified =>
(SqlErrorMensamEmailNotVerified
 -> SqlErrorMensamEmailNotVerified -> Ordering)
-> (SqlErrorMensamEmailNotVerified
    -> SqlErrorMensamEmailNotVerified -> Bool)
-> (SqlErrorMensamEmailNotVerified
    -> SqlErrorMensamEmailNotVerified -> Bool)
-> (SqlErrorMensamEmailNotVerified
    -> SqlErrorMensamEmailNotVerified -> Bool)
-> (SqlErrorMensamEmailNotVerified
    -> SqlErrorMensamEmailNotVerified -> Bool)
-> (SqlErrorMensamEmailNotVerified
    -> SqlErrorMensamEmailNotVerified
    -> SqlErrorMensamEmailNotVerified)
-> (SqlErrorMensamEmailNotVerified
    -> SqlErrorMensamEmailNotVerified
    -> SqlErrorMensamEmailNotVerified)
-> Ord SqlErrorMensamEmailNotVerified
SqlErrorMensamEmailNotVerified
-> SqlErrorMensamEmailNotVerified -> Bool
SqlErrorMensamEmailNotVerified
-> SqlErrorMensamEmailNotVerified -> Ordering
SqlErrorMensamEmailNotVerified
-> SqlErrorMensamEmailNotVerified -> SqlErrorMensamEmailNotVerified
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SqlErrorMensamEmailNotVerified
-> SqlErrorMensamEmailNotVerified -> Ordering
compare :: SqlErrorMensamEmailNotVerified
-> SqlErrorMensamEmailNotVerified -> Ordering
$c< :: SqlErrorMensamEmailNotVerified
-> SqlErrorMensamEmailNotVerified -> Bool
< :: SqlErrorMensamEmailNotVerified
-> SqlErrorMensamEmailNotVerified -> Bool
$c<= :: SqlErrorMensamEmailNotVerified
-> SqlErrorMensamEmailNotVerified -> Bool
<= :: SqlErrorMensamEmailNotVerified
-> SqlErrorMensamEmailNotVerified -> Bool
$c> :: SqlErrorMensamEmailNotVerified
-> SqlErrorMensamEmailNotVerified -> Bool
> :: SqlErrorMensamEmailNotVerified
-> SqlErrorMensamEmailNotVerified -> Bool
$c>= :: SqlErrorMensamEmailNotVerified
-> SqlErrorMensamEmailNotVerified -> Bool
>= :: SqlErrorMensamEmailNotVerified
-> SqlErrorMensamEmailNotVerified -> Bool
$cmax :: SqlErrorMensamEmailNotVerified
-> SqlErrorMensamEmailNotVerified -> SqlErrorMensamEmailNotVerified
max :: SqlErrorMensamEmailNotVerified
-> SqlErrorMensamEmailNotVerified -> SqlErrorMensamEmailNotVerified
$cmin :: SqlErrorMensamEmailNotVerified
-> SqlErrorMensamEmailNotVerified -> SqlErrorMensamEmailNotVerified
min :: SqlErrorMensamEmailNotVerified
-> SqlErrorMensamEmailNotVerified -> SqlErrorMensamEmailNotVerified
Ord, ReadPrec [SqlErrorMensamEmailNotVerified]
ReadPrec SqlErrorMensamEmailNotVerified
Int -> ReadS SqlErrorMensamEmailNotVerified
ReadS [SqlErrorMensamEmailNotVerified]
(Int -> ReadS SqlErrorMensamEmailNotVerified)
-> ReadS [SqlErrorMensamEmailNotVerified]
-> ReadPrec SqlErrorMensamEmailNotVerified
-> ReadPrec [SqlErrorMensamEmailNotVerified]
-> Read SqlErrorMensamEmailNotVerified
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SqlErrorMensamEmailNotVerified
readsPrec :: Int -> ReadS SqlErrorMensamEmailNotVerified
$creadList :: ReadS [SqlErrorMensamEmailNotVerified]
readList :: ReadS [SqlErrorMensamEmailNotVerified]
$creadPrec :: ReadPrec SqlErrorMensamEmailNotVerified
readPrec :: ReadPrec SqlErrorMensamEmailNotVerified
$creadListPrec :: ReadPrec [SqlErrorMensamEmailNotVerified]
readListPrec :: ReadPrec [SqlErrorMensamEmailNotVerified]
Read, Int -> SqlErrorMensamEmailNotVerified -> ShowS
[SqlErrorMensamEmailNotVerified] -> ShowS
SqlErrorMensamEmailNotVerified -> String
(Int -> SqlErrorMensamEmailNotVerified -> ShowS)
-> (SqlErrorMensamEmailNotVerified -> String)
-> ([SqlErrorMensamEmailNotVerified] -> ShowS)
-> Show SqlErrorMensamEmailNotVerified
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SqlErrorMensamEmailNotVerified -> ShowS
showsPrec :: Int -> SqlErrorMensamEmailNotVerified -> ShowS
$cshow :: SqlErrorMensamEmailNotVerified -> String
show :: SqlErrorMensamEmailNotVerified -> String
$cshowList :: [SqlErrorMensamEmailNotVerified] -> ShowS
showList :: [SqlErrorMensamEmailNotVerified] -> ShowS
Show)
  deriving anyclass (Show SqlErrorMensamEmailNotVerified
Typeable SqlErrorMensamEmailNotVerified
(Typeable SqlErrorMensamEmailNotVerified,
 Show SqlErrorMensamEmailNotVerified) =>
(SqlErrorMensamEmailNotVerified -> SomeException)
-> (SomeException -> Maybe SqlErrorMensamEmailNotVerified)
-> (SqlErrorMensamEmailNotVerified -> String)
-> Exception SqlErrorMensamEmailNotVerified
SomeException -> Maybe SqlErrorMensamEmailNotVerified
SqlErrorMensamEmailNotVerified -> String
SqlErrorMensamEmailNotVerified -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: SqlErrorMensamEmailNotVerified -> SomeException
toException :: SqlErrorMensamEmailNotVerified -> SomeException
$cfromException :: SomeException -> Maybe SqlErrorMensamEmailNotVerified
fromException :: SomeException -> Maybe SqlErrorMensamEmailNotVerified
$cdisplayException :: SqlErrorMensamEmailNotVerified -> String
displayException :: SqlErrorMensamEmailNotVerified -> String
Exception)