{-# LANGUAGE UndecidableInstances #-}

module Conduit.Features.Account.Common.EnsureUserCredsUnique where

import Conduit.DB.Core (mapDBResult)
import Conduit.DB.Core (MonadDB(..))
import Conduit.DB.Utils (suchThat)
import Conduit.Features.Account.DB (User)
import Conduit.Features.Account.Errors (AccountError(..))
import Database.Esqueleto.Experimental (Value(..), exists, from, selectOne, table, val, (==.))
import UnliftIO (MonadUnliftIO)

type Name = Maybe Text
type Mail = Maybe Text

ensureUserCredsUnique :: (ReadUsers m) => Name -> Mail -> m (Either AccountError ())
ensureUserCredsUnique :: forall (m :: * -> *).
ReadUsers m =>
Name -> Name -> m (Either AccountError ())
ensureUserCredsUnique Name
name Name
email = ExceptT AccountError m () -> m (Either AccountError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT do
  [Text]
errs <- m (Either AccountError [Text]) -> ExceptT AccountError m [Text]
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either AccountError [Text]) -> ExceptT AccountError m [Text])
-> m (Either AccountError [Text]) -> ExceptT AccountError m [Text]
forall a b. (a -> b) -> a -> b
$ Name -> Name -> m (Either AccountError [Text])
forall (m :: * -> *).
ReadUsers m =>
Name -> Name -> m (Either AccountError [Text])
findDuplicateCreds Name
name Name
email

  m (Either AccountError ()) -> ExceptT AccountError m ()
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either AccountError ()) -> ExceptT AccountError m ())
-> (Either AccountError () -> m (Either AccountError ()))
-> Either AccountError ()
-> ExceptT AccountError m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either AccountError () -> m (Either AccountError ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either AccountError () -> ExceptT AccountError m ())
-> Either AccountError () -> ExceptT AccountError m ()
forall a b. (a -> b) -> a -> b
$ case [Text]
errs of
    [] -> () -> Either AccountError ()
forall a. a -> Either AccountError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    [Text]
cs -> AccountError -> Either AccountError ()
forall a b. a -> Either a b
Left (AccountError -> Either AccountError ())
-> AccountError -> Either AccountError ()
forall a b. (a -> b) -> a -> b
$ [Text] -> AccountError
CredsTaken [Text]
cs

class (Monad m) => ReadUsers m where
  findDuplicateCreds :: Name -> Mail -> m (Either AccountError [Text])

instance (Monad m, MonadUnliftIO m, MonadDB m) => ReadUsers m where
  findDuplicateCreds :: Name -> Mail -> m (Either AccountError [Text])
  findDuplicateCreds :: Name -> Name -> m (Either AccountError [Text])
findDuplicateCreds Name
name Name
email = (Maybe (Value Bool, Value Bool) -> [Text])
-> Either DBError (Maybe (Value Bool, Value Bool))
-> Either AccountError [Text]
forall e a b.
FeatureError e =>
(a -> b) -> Either DBError a -> Either e b
mapDBResult Maybe (Value Bool, Value Bool) -> [Text]
processResult (Either DBError (Maybe (Value Bool, Value Bool))
 -> Either AccountError [Text])
-> m (Either DBError (Maybe (Value Bool, Value Bool)))
-> m (Either AccountError [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SqlPersistT m (Maybe (Value Bool, Value Bool))
-> m (Either DBError (Maybe (Value Bool, Value Bool)))
forall a. SqlPersistT m a -> m (Either DBError a)
forall (m :: * -> *) a.
MonadDB m =>
SqlPersistT m a -> m (Either DBError a)
runDB do
    SqlQuery (SqlExpr (Value Bool), SqlExpr (Value Bool))
-> SqlPersistT m (Maybe (Value Bool, Value Bool))
forall a r (m :: * -> *) backend.
(SqlSelect a r, MonadIO m, SqlBackendCanRead backend) =>
SqlQuery a -> ReaderT backend m (Maybe r)
selectOne (SqlQuery (SqlExpr (Value Bool), SqlExpr (Value Bool))
 -> SqlPersistT m (Maybe (Value Bool, Value Bool)))
-> SqlQuery (SqlExpr (Value Bool), SqlExpr (Value Bool))
-> SqlPersistT m (Maybe (Value Bool, Value Bool))
forall a b. (a -> b) -> a -> b
$ do
      let nameExists :: SqlExpr (Value Bool)
nameExists = Name -> (Text -> SqlExpr (Value Bool)) -> SqlExpr (Value Bool)
forall {a}.
Maybe a -> (a -> SqlExpr (Value Bool)) -> SqlExpr (Value Bool)
checkExists Name
name \Text
n -> 
            SqlQuery () -> SqlExpr (Value Bool)
exists (SqlQuery () -> SqlExpr (Value Bool))
-> SqlQuery () -> SqlExpr (Value Bool)
forall a b. (a -> b) -> a -> b
$ SqlQuery (SqlExpr (Entity User)) -> SqlQuery ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (SqlQuery (SqlExpr (Entity User)) -> SqlQuery ())
-> SqlQuery (SqlExpr (Entity User)) -> SqlQuery ()
forall a b. (a -> b) -> a -> b
$ From (SqlExpr (Entity User)) -> SqlQuery (SqlExpr (Entity User))
forall a a'. ToFrom a a' => a -> SqlQuery a'
from (forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table @User)
              SqlQuery (SqlExpr (Entity User))
-> (SqlExpr (Entity User) -> SqlExpr (Value Bool))
-> SqlQuery (SqlExpr (Entity User))
forall a. SqlQuery a -> (a -> SqlExpr (Value Bool)) -> SqlQuery a
`suchThat` \SqlExpr (Entity User)
u -> SqlExpr (Entity User)
u.username SqlExpr (Value Text)
-> SqlExpr (Value Text) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. Text -> SqlExpr (Value Text)
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Text
n

      let mailExists :: SqlExpr (Value Bool)
mailExists = Name -> (Text -> SqlExpr (Value Bool)) -> SqlExpr (Value Bool)
forall {a}.
Maybe a -> (a -> SqlExpr (Value Bool)) -> SqlExpr (Value Bool)
checkExists Name
email \Text
m -> 
            SqlQuery () -> SqlExpr (Value Bool)
exists (SqlQuery () -> SqlExpr (Value Bool))
-> SqlQuery () -> SqlExpr (Value Bool)
forall a b. (a -> b) -> a -> b
$ SqlQuery (SqlExpr (Entity User)) -> SqlQuery ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (SqlQuery (SqlExpr (Entity User)) -> SqlQuery ())
-> SqlQuery (SqlExpr (Entity User)) -> SqlQuery ()
forall a b. (a -> b) -> a -> b
$ From (SqlExpr (Entity User)) -> SqlQuery (SqlExpr (Entity User))
forall a a'. ToFrom a a' => a -> SqlQuery a'
from (forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table @User)
              SqlQuery (SqlExpr (Entity User))
-> (SqlExpr (Entity User) -> SqlExpr (Value Bool))
-> SqlQuery (SqlExpr (Entity User))
forall a. SqlQuery a -> (a -> SqlExpr (Value Bool)) -> SqlQuery a
`suchThat` \SqlExpr (Entity User)
u -> SqlExpr (Entity User)
u.email SqlExpr (Value Text)
-> SqlExpr (Value Text) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. Text -> SqlExpr (Value Text)
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Text
m

      (SqlExpr (Value Bool), SqlExpr (Value Bool))
-> SqlQuery (SqlExpr (Value Bool), SqlExpr (Value Bool))
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SqlExpr (Value Bool)
nameExists, SqlExpr (Value Bool)
mailExists)
    where
      checkExists :: Maybe a -> (a -> SqlExpr (Value Bool)) -> SqlExpr (Value Bool)
checkExists = ((a -> SqlExpr (Value Bool)) -> Maybe a -> SqlExpr (Value Bool))
-> Maybe a -> (a -> SqlExpr (Value Bool)) -> SqlExpr (Value Bool)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((a -> SqlExpr (Value Bool)) -> Maybe a -> SqlExpr (Value Bool))
 -> Maybe a -> (a -> SqlExpr (Value Bool)) -> SqlExpr (Value Bool))
-> ((a -> SqlExpr (Value Bool)) -> Maybe a -> SqlExpr (Value Bool))
-> Maybe a
-> (a -> SqlExpr (Value Bool))
-> SqlExpr (Value Bool)
forall a b. (a -> b) -> a -> b
$ SqlExpr (Value Bool)
-> (a -> SqlExpr (Value Bool)) -> Maybe a -> SqlExpr (Value Bool)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> SqlExpr (Value Bool)
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Bool
False)

processResult :: Maybe (Value Bool, Value Bool) -> [Text]
processResult :: Maybe (Value Bool, Value Bool) -> [Text]
processResult (Just (Value Bool
nameExists, Value Bool
mailExists)) = ((Bool, Text) -> Text) -> [(Bool, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, Text) -> Text
forall a b. (a, b) -> b
snd ([(Bool, Text)] -> [Text]) -> [(Bool, Text)] -> [Text]
forall a b. (a -> b) -> a -> b
$ ((Bool, Text) -> Bool) -> [(Bool, Text)] -> [(Bool, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool, Text) -> Bool
forall a b. (a, b) -> a
fst [(Bool
nameExists, Text
"username"), (Bool
mailExists, Text
"email")]
processResult Maybe (Value Bool, Value Bool)
Nothing = []