{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module WikiMusic.Sqlite.UserCommand () where

import Data.ByteString.Base64 qualified
import Data.Password.Bcrypt
import Data.Text (pack)
import Data.Text qualified as T
import Data.UUID qualified as UUID
import Data.UUID.V4
import Database.Beam
import Database.Beam.Sqlite
import Relude
import WikiMusic.Beam.Database
import WikiMusic.Beam.User
import WikiMusic.Beam.Util
import WikiMusic.Free.UserCommand
import WikiMusic.Model.Auth
import WikiMusic.Model.Env
import WikiMusic.Protolude

instance Exec UserCommand where
  execAlgebra :: forall a. UserCommand (IO a) -> IO a
execAlgebra (MakeResetPasswordLink Env
env UserEmail
email Either UserCommandError Text -> IO a
next) = Env
-> UserEmail
-> (UUID -> IO (Either UserCommandError Text))
-> IO (Either UserCommandError Text)
forall (m :: * -> *) a.
MonadIO m =>
Env
-> UserEmail
-> (UUID -> m (Either UserCommandError a))
-> m (Either UserCommandError a)
doIfUserFoundByEmail Env
env UserEmail
email (Env -> UUID -> IO (Either UserCommandError Text)
forall (m :: * -> *).
MonadIO m =>
Env -> UUID -> m (Either UserCommandError Text)
makeToken Env
env) IO (Either UserCommandError Text)
-> (Either UserCommandError Text -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either UserCommandError Text -> IO a
next
  execAlgebra (ChangePasswordByEmail Env
env UserEmail
email UserPassword
password Either UserCommandError () -> IO a
next) = do
    Either UserCommandError () -> IO a
next (Either UserCommandError () -> IO a)
-> IO (Either UserCommandError ()) -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Env
-> UserEmail
-> (UUID -> IO (Either UserCommandError ()))
-> IO (Either UserCommandError ())
forall (m :: * -> *) a.
MonadIO m =>
Env
-> UserEmail
-> (UUID -> m (Either UserCommandError a))
-> m (Either UserCommandError a)
doIfUserFoundByEmail Env
env UserEmail
email (Env -> UserPassword -> UUID -> IO (Either UserCommandError ())
forall (m :: * -> *).
MonadIO m =>
Env -> UserPassword -> UUID -> m (Either UserCommandError ())
changePassword Env
env UserPassword
password)
  execAlgebra (InvalidateResetTokenByEmail Env
env UserEmail
email Either UserCommandError () -> IO a
next) = Either UserCommandError () -> IO a
next (Either UserCommandError () -> IO a)
-> IO (Either UserCommandError ()) -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Env
-> UserEmail
-> (UUID -> IO (Either UserCommandError ()))
-> IO (Either UserCommandError ())
forall (m :: * -> *) a.
MonadIO m =>
Env
-> UserEmail
-> (UUID -> m (Either UserCommandError a))
-> m (Either UserCommandError a)
doIfUserFoundByEmail Env
env UserEmail
email (Env -> UUID -> IO (Either UserCommandError ())
forall (m :: * -> *).
MonadIO m =>
Env -> UUID -> m (Either UserCommandError ())
invalidateToken Env
env)
  execAlgebra (InviteUser Env
env WikiMusicUser
_ UserEmail
email UserName
name' UserRole
role Maybe Text
desc Either UserCommandError Text -> IO a
next) = Either UserCommandError Text -> IO a
next (Either UserCommandError Text -> IO a)
-> IO (Either UserCommandError Text) -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Env
-> UserEmail
-> UserName
-> UserRole
-> Maybe Text
-> IO (Either UserCommandError Text)
forall (m :: * -> *).
MonadIO m =>
Env
-> UserEmail
-> UserName
-> UserRole
-> Maybe Text
-> m (Either UserCommandError Text)
addUser Env
env UserEmail
email UserName
name' UserRole
role Maybe Text
desc
  execAlgebra (DeleteUser Env
env WikiMusicUser
_ UserEmail
email Either UserCommandError () -> IO a
next) = Either UserCommandError () -> IO a
next (Either UserCommandError () -> IO a)
-> IO (Either UserCommandError ()) -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Env
-> UserEmail
-> (UUID -> IO (Either UserCommandError ()))
-> IO (Either UserCommandError ())
forall (m :: * -> *) a.
MonadIO m =>
Env
-> UserEmail
-> (UUID -> m (Either UserCommandError a))
-> m (Either UserCommandError a)
doIfUserFoundByEmail Env
env UserEmail
email (Env -> UUID -> IO (Either UserCommandError ())
forall (m :: * -> *).
MonadIO m =>
Env -> UUID -> m (Either UserCommandError ())
deleteU Env
env)

makeToken :: (MonadIO m) => Env -> UUID -> m (Either UserCommandError Text)
makeToken :: forall (m :: * -> *).
MonadIO m =>
Env -> UUID -> m (Either UserCommandError Text)
makeToken Env
env UUID
identifier = do
  Maybe (UserT Identity)
maybeUser <- IO (Maybe (UserT Identity)) -> m (Maybe (UserT Identity))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (UserT Identity)) -> m (Maybe (UserT Identity)))
-> IO (Maybe (UserT Identity)) -> m (Maybe (UserT Identity))
forall a b. (a -> b) -> a -> b
$ (String -> IO ())
-> Connection
-> SqliteM (Maybe (UserT Identity))
-> IO (Maybe (UserT Identity))
forall a. (String -> IO ()) -> Connection -> SqliteM a -> IO a
runBeamSqliteDebug String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn (Env
env Env -> Optic' A_Lens NoIx Env Connection -> Connection
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Env Connection
#conn) (SqliteM (Maybe (UserT Identity)) -> IO (Maybe (UserT Identity)))
-> SqliteM (Maybe (UserT Identity)) -> IO (Maybe (UserT Identity))
forall a b. (a -> b) -> a -> b
$ do
    SqlSelect Sqlite (UserT Identity)
-> SqliteM (Maybe (UserT Identity))
forall be (m :: * -> *) a.
(MonadBeam be m, BeamSqlBackend be, FromBackendRow be a) =>
SqlSelect be a -> m (Maybe a)
runSelectReturningFirst (SqlSelect Sqlite (UserT Identity)
 -> SqliteM (Maybe (UserT Identity)))
-> SqlSelect Sqlite (UserT Identity)
-> SqliteM (Maybe (UserT Identity))
forall a b. (a -> b) -> a -> b
$ Q Sqlite
  WikiMusicDatabase
  QBaseScope
  (UserT (QExpr Sqlite QBaseScope))
-> SqlSelect
     Sqlite (QExprToIdentity (UserT (QExpr Sqlite QBaseScope)))
forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select (Q Sqlite
   WikiMusicDatabase
   QBaseScope
   (UserT (QExpr Sqlite QBaseScope))
 -> SqlSelect
      Sqlite (QExprToIdentity (UserT (QExpr Sqlite QBaseScope))))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> SqlSelect
     Sqlite (QExprToIdentity (UserT (QExpr Sqlite QBaseScope)))
forall a b. (a -> b) -> a -> b
$ do
      (UserT (QExpr Sqlite QBaseScope) -> QExpr Sqlite QBaseScope Bool)
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
forall r be (db :: (* -> *) -> *) s.
BeamSqlBackend be =>
(r -> QExpr be s Bool) -> Q be db s r -> Q be db s r
filter_
        ( \UserT (QExpr Sqlite QBaseScope)
s ->
            (UserT (QExpr Sqlite QBaseScope)
s UserT (QExpr Sqlite QBaseScope)
-> Optic'
     A_Lens
     NoIx
     (UserT (QExpr Sqlite QBaseScope))
     (QGenExpr QValueContext Sqlite QBaseScope Text)
-> QGenExpr QValueContext Sqlite QBaseScope Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (UserT (QExpr Sqlite QBaseScope))
  (QGenExpr QValueContext Sqlite QBaseScope Text)
#identifier)
              QGenExpr QValueContext Sqlite QBaseScope Text
-> QGenExpr QValueContext Sqlite QBaseScope Text
-> QExpr Sqlite QBaseScope Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. HaskellLiteralForQExpr
  (QGenExpr QValueContext Sqlite QBaseScope Text)
-> QGenExpr QValueContext Sqlite QBaseScope Text
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ (UUID -> Text
UUID.toText UUID
identifier)
        )
        (Q Sqlite
   WikiMusicDatabase
   QBaseScope
   (UserT (QExpr Sqlite QBaseScope))
 -> Q Sqlite
      WikiMusicDatabase
      QBaseScope
      (UserT (QExpr Sqlite QBaseScope)))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT)
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ ((DatabaseSettings Sqlite WikiMusicDatabase
-> Optic'
     A_Lens
     NoIx
     (DatabaseSettings Sqlite WikiMusicDatabase)
     (DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT))
-> DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (DatabaseSettings Sqlite WikiMusicDatabase)
  (DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT))
#users) DatabaseSettings Sqlite WikiMusicDatabase
forall be. DatabaseSettings be WikiMusicDatabase
wikiMusicDatabase)
  UTCTime
now <- IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  Either UnicodeException Text
maybeToken <- m (Either UnicodeException Text)
forall (m :: * -> *). MonadIO m => m (Either UnicodeException Text)
maybeGenToken
  case Maybe (UserT Identity)
maybeUser of
    Maybe (UserT Identity)
Nothing -> Either UserCommandError Text -> m (Either UserCommandError Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UserCommandError Text -> m (Either UserCommandError Text))
-> (UserCommandError -> Either UserCommandError Text)
-> UserCommandError
-> m (Either UserCommandError Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserCommandError -> Either UserCommandError Text
forall a b. a -> Either a b
Left (UserCommandError -> m (Either UserCommandError Text))
-> UserCommandError -> m (Either UserCommandError Text)
forall a b. (a -> b) -> a -> b
$ Text -> UserCommandError
PersistenceError Text
""
    Just UserT Identity
x -> do
      case Either UnicodeException Text
maybeToken of
        Left UnicodeException
l -> Either UserCommandError Text -> m (Either UserCommandError Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UserCommandError Text -> m (Either UserCommandError Text))
-> (UnicodeException -> Either UserCommandError Text)
-> UnicodeException
-> m (Either UserCommandError Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserCommandError -> Either UserCommandError Text
forall a b. a -> Either a b
Left (UserCommandError -> Either UserCommandError Text)
-> (UnicodeException -> UserCommandError)
-> UnicodeException
-> Either UserCommandError Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> UserCommandError
PersistenceError (Text -> UserCommandError)
-> (UnicodeException -> Text)
-> UnicodeException
-> UserCommandError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnicodeException -> Text
forall b a. (Show a, IsString b) => a -> b
Relude.show (UnicodeException -> m (Either UserCommandError Text))
-> UnicodeException -> m (Either UserCommandError Text)
forall a b. (a -> b) -> a -> b
$ UnicodeException
l
        Right Text
t -> do
          ()
_ <-
            IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
              (IO () -> m ())
-> (SqlUpdate Sqlite UserT -> IO ())
-> SqlUpdate Sqlite UserT
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> IO ()) -> Connection -> SqliteM () -> IO ()
forall a. (String -> IO ()) -> Connection -> SqliteM a -> IO a
runBeamSqliteDebug String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn (Env
env Env -> Optic' A_Lens NoIx Env Connection -> Connection
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Env Connection
#conn)
              (SqliteM () -> IO ())
-> (SqlUpdate Sqlite UserT -> SqliteM ())
-> SqlUpdate Sqlite UserT
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlUpdate Sqlite UserT -> SqliteM ()
forall be (m :: * -> *) (tbl :: (* -> *) -> *).
(BeamSqlBackend be, MonadBeam be m) =>
SqlUpdate be tbl -> m ()
runUpdate
              (SqlUpdate Sqlite UserT -> m ()) -> SqlUpdate Sqlite UserT -> m ()
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT)
-> UserT Identity -> SqlUpdate Sqlite UserT
forall (table :: (* -> *) -> *) be (db :: (* -> *) -> *).
(Table table, BeamSqlBackend be,
 SqlValableTable be (PrimaryKey table), SqlValableTable be table,
 HasTableEquality be (PrimaryKey table)) =>
DatabaseEntity be db (TableEntity table)
-> table Identity -> SqlUpdate be table
save
                ((DatabaseSettings Sqlite WikiMusicDatabase
-> Optic'
     A_Lens
     NoIx
     (DatabaseSettings Sqlite WikiMusicDatabase)
     (DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT))
-> DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (DatabaseSettings Sqlite WikiMusicDatabase)
  (DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT))
#users) DatabaseSettings Sqlite WikiMusicDatabase
forall be. DatabaseSettings be WikiMusicDatabase
wikiMusicDatabase)
                (UserT Identity
x {passwordResetToken = Just t, lastEditedAt = Just now} :: User')
          Either UserCommandError Text -> m (Either UserCommandError Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UserCommandError Text -> m (Either UserCommandError Text))
-> (Text -> Either UserCommandError Text)
-> Text
-> m (Either UserCommandError Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either UserCommandError Text
forall a b. b -> Either a b
Right (Text -> m (Either UserCommandError Text))
-> Text -> m (Either UserCommandError Text)
forall a b. (a -> b) -> a -> b
$ Text
t

maybeGenToken :: (MonadIO m) => m (Either UnicodeException Text)
maybeGenToken :: forall (m :: * -> *). MonadIO m => m (Either UnicodeException Text)
maybeGenToken = do
  Text
l <- String -> Text
pack (String -> Text) -> (UUID -> String) -> UUID -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> String
forall b a. (Show a, IsString b) => a -> b
Relude.show (UUID -> Text) -> m UUID -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UUID -> m UUID
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UUID
nextRandom
  Text
r <- String -> Text
pack (String -> Text) -> (UUID -> String) -> UUID -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> String
forall b a. (Show a, IsString b) => a -> b
Relude.show (UUID -> Text) -> m UUID -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UUID -> m UUID
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UUID
nextRandom
  Either UnicodeException Text -> m (Either UnicodeException Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UnicodeException Text -> m (Either UnicodeException Text))
-> Either UnicodeException Text -> m (Either UnicodeException Text)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either UnicodeException Text
decodeUtf8' (ByteString -> Either UnicodeException Text)
-> (Text -> ByteString) -> Text -> Either UnicodeException Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Data.ByteString.Base64.encode (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> Either UnicodeException Text)
-> Text -> Either UnicodeException Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a -> a
tokenConcat Text
l Text
r
  where
    tokenConcat :: a -> a -> a
tokenConcat a
l a
r = a
l a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"$" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
r

invalidateToken :: (MonadIO m) => Env -> UUID -> m (Either UserCommandError ())
invalidateToken :: forall (m :: * -> *).
MonadIO m =>
Env -> UUID -> m (Either UserCommandError ())
invalidateToken Env
env UUID
identifier = do
  UTCTime
now <- IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  Maybe (UserT Identity)
art <- IO (Maybe (UserT Identity)) -> m (Maybe (UserT Identity))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (UserT Identity)) -> m (Maybe (UserT Identity)))
-> IO (Maybe (UserT Identity)) -> m (Maybe (UserT Identity))
forall a b. (a -> b) -> a -> b
$ (String -> IO ())
-> Connection
-> SqliteM (Maybe (UserT Identity))
-> IO (Maybe (UserT Identity))
forall a. (String -> IO ()) -> Connection -> SqliteM a -> IO a
runBeamSqliteDebug String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn (Env
env Env -> Optic' A_Lens NoIx Env Connection -> Connection
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Env Connection
#conn) (SqliteM (Maybe (UserT Identity)) -> IO (Maybe (UserT Identity)))
-> SqliteM (Maybe (UserT Identity)) -> IO (Maybe (UserT Identity))
forall a b. (a -> b) -> a -> b
$ do
    SqlSelect Sqlite (UserT Identity)
-> SqliteM (Maybe (UserT Identity))
forall be (m :: * -> *) a.
(MonadBeam be m, BeamSqlBackend be, FromBackendRow be a) =>
SqlSelect be a -> m (Maybe a)
runSelectReturningOne (SqlSelect Sqlite (UserT Identity)
 -> SqliteM (Maybe (UserT Identity)))
-> SqlSelect Sqlite (UserT Identity)
-> SqliteM (Maybe (UserT Identity))
forall a b. (a -> b) -> a -> b
$ Q Sqlite
  WikiMusicDatabase
  QBaseScope
  (UserT (QExpr Sqlite QBaseScope))
-> SqlSelect
     Sqlite (QExprToIdentity (UserT (QExpr Sqlite QBaseScope)))
forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select (Q Sqlite
   WikiMusicDatabase
   QBaseScope
   (UserT (QExpr Sqlite QBaseScope))
 -> SqlSelect
      Sqlite (QExprToIdentity (UserT (QExpr Sqlite QBaseScope))))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> SqlSelect
     Sqlite (QExprToIdentity (UserT (QExpr Sqlite QBaseScope)))
forall a b. (a -> b) -> a -> b
$ do
      (UserT (QExpr Sqlite QBaseScope) -> QExpr Sqlite QBaseScope Bool)
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
forall r be (db :: (* -> *) -> *) s.
BeamSqlBackend be =>
(r -> QExpr be s Bool) -> Q be db s r -> Q be db s r
filter_
        (\UserT (QExpr Sqlite QBaseScope)
s -> (UserT (QExpr Sqlite QBaseScope)
s UserT (QExpr Sqlite QBaseScope)
-> Optic'
     A_Lens
     NoIx
     (UserT (QExpr Sqlite QBaseScope))
     (QGenExpr QValueContext Sqlite QBaseScope Text)
-> QGenExpr QValueContext Sqlite QBaseScope Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (UserT (QExpr Sqlite QBaseScope))
  (QGenExpr QValueContext Sqlite QBaseScope Text)
#identifier) QGenExpr QValueContext Sqlite QBaseScope Text
-> QGenExpr QValueContext Sqlite QBaseScope Text
-> QExpr Sqlite QBaseScope Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. HaskellLiteralForQExpr
  (QGenExpr QValueContext Sqlite QBaseScope Text)
-> QGenExpr QValueContext Sqlite QBaseScope Text
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ (UUID -> Text
UUID.toText UUID
identifier))
        (Q Sqlite
   WikiMusicDatabase
   QBaseScope
   (UserT (QExpr Sqlite QBaseScope))
 -> Q Sqlite
      WikiMusicDatabase
      QBaseScope
      (UserT (QExpr Sqlite QBaseScope)))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT)
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ ((DatabaseSettings Sqlite WikiMusicDatabase
-> Optic'
     A_Lens
     NoIx
     (DatabaseSettings Sqlite WikiMusicDatabase)
     (DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT))
-> DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (DatabaseSettings Sqlite WikiMusicDatabase)
  (DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT))
#users) DatabaseSettings Sqlite WikiMusicDatabase
forall be. DatabaseSettings be WikiMusicDatabase
wikiMusicDatabase)
  case Maybe (UserT Identity)
art of
    Maybe (UserT Identity)
Nothing -> Either UserCommandError () -> m (Either UserCommandError ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UserCommandError () -> m (Either UserCommandError ()))
-> (() -> Either UserCommandError ())
-> ()
-> m (Either UserCommandError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Either UserCommandError ()
forall a b. b -> Either a b
Right (() -> m (Either UserCommandError ()))
-> () -> m (Either UserCommandError ())
forall a b. (a -> b) -> a -> b
$ ()
    Just UserT Identity
foundArt -> do
      let a :: UserT Identity
a = UserT Identity
foundArt {passwordResetToken = Nothing, lastEditedAt = Just now} :: User'
      IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (UserT Identity -> IO ()) -> UserT Identity -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> IO ()) -> Connection -> SqliteM () -> IO ()
forall a. (String -> IO ()) -> Connection -> SqliteM a -> IO a
runBeamSqliteDebug String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn (Env
env Env -> Optic' A_Lens NoIx Env Connection -> Connection
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Env Connection
#conn) (SqliteM () -> IO ())
-> (UserT Identity -> SqliteM ()) -> UserT Identity -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlUpdate Sqlite UserT -> SqliteM ()
forall be (m :: * -> *) (tbl :: (* -> *) -> *).
(BeamSqlBackend be, MonadBeam be m) =>
SqlUpdate be tbl -> m ()
runUpdate (SqlUpdate Sqlite UserT -> SqliteM ())
-> (UserT Identity -> SqlUpdate Sqlite UserT)
-> UserT Identity
-> SqliteM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT)
-> UserT Identity -> SqlUpdate Sqlite UserT
forall (table :: (* -> *) -> *) be (db :: (* -> *) -> *).
(Table table, BeamSqlBackend be,
 SqlValableTable be (PrimaryKey table), SqlValableTable be table,
 HasTableEquality be (PrimaryKey table)) =>
DatabaseEntity be db (TableEntity table)
-> table Identity -> SqlUpdate be table
save ((DatabaseSettings Sqlite WikiMusicDatabase
-> Optic'
     A_Lens
     NoIx
     (DatabaseSettings Sqlite WikiMusicDatabase)
     (DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT))
-> DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (DatabaseSettings Sqlite WikiMusicDatabase)
  (DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT))
#users) DatabaseSettings Sqlite WikiMusicDatabase
forall be. DatabaseSettings be WikiMusicDatabase
wikiMusicDatabase) (UserT Identity -> m ()) -> UserT Identity -> m ()
forall a b. (a -> b) -> a -> b
$ UserT Identity
a
      Either UserCommandError () -> m (Either UserCommandError ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UserCommandError () -> m (Either UserCommandError ()))
-> (() -> Either UserCommandError ())
-> ()
-> m (Either UserCommandError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Either UserCommandError ()
forall a b. b -> Either a b
Right (() -> m (Either UserCommandError ()))
-> () -> m (Either UserCommandError ())
forall a b. (a -> b) -> a -> b
$ ()

changePassword :: (MonadIO m) => Env -> UserPassword -> UUID -> m (Either UserCommandError ())
changePassword :: forall (m :: * -> *).
MonadIO m =>
Env -> UserPassword -> UUID -> m (Either UserCommandError ())
changePassword Env
env UserPassword
password UUID
identifier = do
  PasswordHash Bcrypt
hashed <- Password -> m (PasswordHash Bcrypt)
forall (m :: * -> *).
MonadIO m =>
Password -> m (PasswordHash Bcrypt)
hashPassword (Text -> Password
mkPassword (UserPassword
password UserPassword -> Optic' An_Iso NoIx UserPassword Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' An_Iso NoIx UserPassword Text
#value))
  UTCTime
now <- IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  UUID
new <- IO UUID -> m UUID
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UUID
nextRandom
  Maybe (UserT Identity)
art <- IO (Maybe (UserT Identity)) -> m (Maybe (UserT Identity))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (UserT Identity)) -> m (Maybe (UserT Identity)))
-> IO (Maybe (UserT Identity)) -> m (Maybe (UserT Identity))
forall a b. (a -> b) -> a -> b
$ (String -> IO ())
-> Connection
-> SqliteM (Maybe (UserT Identity))
-> IO (Maybe (UserT Identity))
forall a. (String -> IO ()) -> Connection -> SqliteM a -> IO a
runBeamSqliteDebug String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn (Env
env Env -> Optic' A_Lens NoIx Env Connection -> Connection
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Env Connection
#conn) (SqliteM (Maybe (UserT Identity)) -> IO (Maybe (UserT Identity)))
-> SqliteM (Maybe (UserT Identity)) -> IO (Maybe (UserT Identity))
forall a b. (a -> b) -> a -> b
$ do
    SqlSelect Sqlite (UserT Identity)
-> SqliteM (Maybe (UserT Identity))
forall be (m :: * -> *) a.
(MonadBeam be m, BeamSqlBackend be, FromBackendRow be a) =>
SqlSelect be a -> m (Maybe a)
runSelectReturningOne (SqlSelect Sqlite (UserT Identity)
 -> SqliteM (Maybe (UserT Identity)))
-> SqlSelect Sqlite (UserT Identity)
-> SqliteM (Maybe (UserT Identity))
forall a b. (a -> b) -> a -> b
$ Q Sqlite
  WikiMusicDatabase
  QBaseScope
  (UserT (QExpr Sqlite QBaseScope))
-> SqlSelect
     Sqlite (QExprToIdentity (UserT (QExpr Sqlite QBaseScope)))
forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select (Q Sqlite
   WikiMusicDatabase
   QBaseScope
   (UserT (QExpr Sqlite QBaseScope))
 -> SqlSelect
      Sqlite (QExprToIdentity (UserT (QExpr Sqlite QBaseScope))))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> SqlSelect
     Sqlite (QExprToIdentity (UserT (QExpr Sqlite QBaseScope)))
forall a b. (a -> b) -> a -> b
$ do
      (UserT (QExpr Sqlite QBaseScope) -> QExpr Sqlite QBaseScope Bool)
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
forall r be (db :: (* -> *) -> *) s.
BeamSqlBackend be =>
(r -> QExpr be s Bool) -> Q be db s r -> Q be db s r
filter_
        (\UserT (QExpr Sqlite QBaseScope)
s -> (UserT (QExpr Sqlite QBaseScope)
s UserT (QExpr Sqlite QBaseScope)
-> Optic'
     A_Lens
     NoIx
     (UserT (QExpr Sqlite QBaseScope))
     (QGenExpr QValueContext Sqlite QBaseScope Text)
-> QGenExpr QValueContext Sqlite QBaseScope Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (UserT (QExpr Sqlite QBaseScope))
  (QGenExpr QValueContext Sqlite QBaseScope Text)
#identifier) QGenExpr QValueContext Sqlite QBaseScope Text
-> QGenExpr QValueContext Sqlite QBaseScope Text
-> QExpr Sqlite QBaseScope Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. HaskellLiteralForQExpr
  (QGenExpr QValueContext Sqlite QBaseScope Text)
-> QGenExpr QValueContext Sqlite QBaseScope Text
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ (UUID -> Text
UUID.toText UUID
identifier))
        (Q Sqlite
   WikiMusicDatabase
   QBaseScope
   (UserT (QExpr Sqlite QBaseScope))
 -> Q Sqlite
      WikiMusicDatabase
      QBaseScope
      (UserT (QExpr Sqlite QBaseScope)))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT)
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ ((DatabaseSettings Sqlite WikiMusicDatabase
-> Optic'
     A_Lens
     NoIx
     (DatabaseSettings Sqlite WikiMusicDatabase)
     (DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT))
-> DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (DatabaseSettings Sqlite WikiMusicDatabase)
  (DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT))
#users) DatabaseSettings Sqlite WikiMusicDatabase
forall be. DatabaseSettings be WikiMusicDatabase
wikiMusicDatabase)
  case Maybe (UserT Identity)
art of
    Maybe (UserT Identity)
Nothing -> Either UserCommandError () -> m (Either UserCommandError ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UserCommandError () -> m (Either UserCommandError ()))
-> (() -> Either UserCommandError ())
-> ()
-> m (Either UserCommandError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Either UserCommandError ()
forall a b. b -> Either a b
Right (() -> m (Either UserCommandError ()))
-> () -> m (Either UserCommandError ())
forall a b. (a -> b) -> a -> b
$ ()
    Just UserT Identity
foundArt -> do
      let a :: UserT Identity
a =
            UserT Identity
foundArt
              { passwordHash = Just $ unPasswordHash hashed,
                authToken = Just $ newToken now new,
                lastEditedAt = Just now
              } ::
              User'
      IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (UserT Identity -> IO ()) -> UserT Identity -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> IO ()) -> Connection -> SqliteM () -> IO ()
forall a. (String -> IO ()) -> Connection -> SqliteM a -> IO a
runBeamSqliteDebug String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn (Env
env Env -> Optic' A_Lens NoIx Env Connection -> Connection
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Env Connection
#conn) (SqliteM () -> IO ())
-> (UserT Identity -> SqliteM ()) -> UserT Identity -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlUpdate Sqlite UserT -> SqliteM ()
forall be (m :: * -> *) (tbl :: (* -> *) -> *).
(BeamSqlBackend be, MonadBeam be m) =>
SqlUpdate be tbl -> m ()
runUpdate (SqlUpdate Sqlite UserT -> SqliteM ())
-> (UserT Identity -> SqlUpdate Sqlite UserT)
-> UserT Identity
-> SqliteM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT)
-> UserT Identity -> SqlUpdate Sqlite UserT
forall (table :: (* -> *) -> *) be (db :: (* -> *) -> *).
(Table table, BeamSqlBackend be,
 SqlValableTable be (PrimaryKey table), SqlValableTable be table,
 HasTableEquality be (PrimaryKey table)) =>
DatabaseEntity be db (TableEntity table)
-> table Identity -> SqlUpdate be table
save ((DatabaseSettings Sqlite WikiMusicDatabase
-> Optic'
     A_Lens
     NoIx
     (DatabaseSettings Sqlite WikiMusicDatabase)
     (DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT))
-> DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (DatabaseSettings Sqlite WikiMusicDatabase)
  (DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT))
#users) DatabaseSettings Sqlite WikiMusicDatabase
forall be. DatabaseSettings be WikiMusicDatabase
wikiMusicDatabase) (UserT Identity -> m ()) -> UserT Identity -> m ()
forall a b. (a -> b) -> a -> b
$ UserT Identity
a
      Either UserCommandError () -> m (Either UserCommandError ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UserCommandError () -> m (Either UserCommandError ()))
-> (() -> Either UserCommandError ())
-> ()
-> m (Either UserCommandError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Either UserCommandError ()
forall a b. b -> Either a b
Right (() -> m (Either UserCommandError ()))
-> () -> m (Either UserCommandError ())
forall a b. (a -> b) -> a -> b
$ ()

newToken :: UTCTime -> UUID -> Text
newToken :: UTCTime -> UUID -> Text
newToken UTCTime
now UUID
new =
  ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8
    (ByteString -> Text) -> (Text -> ByteString) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Data.ByteString.Base64.encode
    (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8
    (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (String -> Text
pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> String
forall b a. (Show a, IsString b) => a -> b
WikiMusic.Protolude.show (UTCTime -> Text) -> UTCTime -> Text
forall a b. (a -> b) -> a -> b
$ UTCTime
now)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"--"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
pack (String -> Text) -> (UUID -> String) -> UUID -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> String
forall b a. (Show a, IsString b) => a -> b
WikiMusic.Protolude.show (UUID -> Text) -> UUID -> Text
forall a b. (a -> b) -> a -> b
$ UUID
new)

addUser :: (MonadIO m) => Env -> UserEmail -> UserName -> UserRole -> Maybe Text -> m (Either UserCommandError Text)
addUser :: forall (m :: * -> *).
MonadIO m =>
Env
-> UserEmail
-> UserName
-> UserRole
-> Maybe Text
-> m (Either UserCommandError Text)
addUser Env
env UserEmail
email UserName
name' UserRole
role Maybe Text
desc = do
  UTCTime
now <- IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  UUID
passResetToken <- IO UUID -> m UUID
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UUID
nextRandom
  UUID
new <- IO UUID -> m UUID
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UUID
nextRandom
  UUID
newNew <- IO UUID -> m UUID
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UUID
nextRandom
  let u :: UserT Identity
u =
        User'
          { $sel:identifier:User' :: C Identity Text
identifier = UUID -> Text
UUID.toText UUID
new,
            $sel:displayName:User' :: C Identity Text
displayName = UserName
name' UserName -> Optic' An_Iso NoIx UserName Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' An_Iso NoIx UserName Text
#value,
            $sel:emailAddress:User' :: C Identity Text
emailAddress = UserEmail
email UserEmail -> Optic' An_Iso NoIx UserEmail Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' An_Iso NoIx UserEmail Text
#value,
            $sel:passwordHash:User' :: Columnar Identity (Maybe Text)
passwordHash = Maybe Text
Columnar Identity (Maybe Text)
forall a. Maybe a
Nothing,
            $sel:passwordResetToken:User' :: Columnar Identity (Maybe Text)
passwordResetToken = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ UUID -> Text
UUID.toText UUID
passResetToken,
            $sel:createdAt:User' :: C Identity UTCTime
createdAt = UTCTime
C Identity UTCTime
now,
            $sel:authToken:User' :: Columnar Identity (Maybe Text)
authToken = Maybe Text
Columnar Identity (Maybe Text)
forall a. Maybe a
Nothing,
            $sel:latestLoginAt:User' :: Columnar Identity (Maybe UTCTime)
latestLoginAt = Maybe UTCTime
Columnar Identity (Maybe UTCTime)
forall a. Maybe a
Nothing,
            $sel:latestLoginDevice:User' :: Columnar Identity (Maybe Text)
latestLoginDevice = Maybe Text
Columnar Identity (Maybe Text)
forall a. Maybe a
Nothing,
            $sel:avatarUrl:User' :: Columnar Identity (Maybe Text)
avatarUrl = Maybe Text
Columnar Identity (Maybe Text)
forall a. Maybe a
Nothing,
            $sel:lastEditedAt:User' :: Columnar Identity (Maybe UTCTime)
lastEditedAt = Maybe UTCTime
Columnar Identity (Maybe UTCTime)
forall a. Maybe a
Nothing,
            $sel:description:User' :: Columnar Identity (Maybe Text)
description = Maybe Text
Columnar Identity (Maybe Text)
desc
          } ::
          User'
  let r :: UserRoleT Identity
r =
        UserRole'
          { $sel:identifier:UserRole' :: C Identity Text
identifier = UUID -> Text
UUID.toText UUID
newNew,
            $sel:userIdentifier:UserRole' :: PrimaryKey UserT Identity
userIdentifier = Text -> PrimaryKey UserT Identity
C Identity Text -> PrimaryKey UserT Identity
forall (f :: * -> *). Columnar f Text -> PrimaryKey UserT f
UserId (Text -> PrimaryKey UserT Identity)
-> (UUID -> Text) -> UUID -> PrimaryKey UserT Identity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Text
UUID.toText (UUID -> PrimaryKey UserT Identity)
-> UUID -> PrimaryKey UserT Identity
forall a b. (a -> b) -> a -> b
$ UUID
new,
            $sel:roleId:UserRole' :: C Identity Text
roleId = String -> Text
String -> C Identity Text
T.pack (String -> C Identity Text)
-> (UserRole -> String) -> UserRole -> C Identity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserRole -> String
forall b a. (Show a, IsString b) => a -> b
Relude.show (UserRole -> C Identity Text) -> UserRole -> C Identity Text
forall a b. (a -> b) -> a -> b
$ UserRole
role,
            $sel:createdAt:UserRole' :: C Identity UTCTime
createdAt = UTCTime
C Identity UTCTime
now
          } ::
          UserRole'
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    (IO () -> m ())
-> (SqlInsertValues Sqlite (UserT (QExpr Sqlite Any)) -> IO ())
-> SqlInsertValues Sqlite (UserT (QExpr Sqlite Any))
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> IO ()) -> Connection -> SqliteM () -> IO ()
forall a. (String -> IO ()) -> Connection -> SqliteM a -> IO a
runBeamSqliteDebug String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn (Env
env Env -> Optic' A_Lens NoIx Env Connection -> Connection
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Env Connection
#conn)
    (SqliteM () -> IO ())
-> (SqlInsertValues Sqlite (UserT (QExpr Sqlite Any))
    -> SqliteM ())
-> SqlInsertValues Sqlite (UserT (QExpr Sqlite Any))
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlInsert Sqlite UserT -> SqliteM ()
forall be (m :: * -> *) (table :: (* -> *) -> *).
(BeamSqlBackend be, MonadBeam be m) =>
SqlInsert be table -> m ()
runInsert
    (SqlInsert Sqlite UserT -> SqliteM ())
-> (SqlInsertValues Sqlite (UserT (QExpr Sqlite Any))
    -> SqlInsert Sqlite UserT)
-> SqlInsertValues Sqlite (UserT (QExpr Sqlite Any))
-> SqliteM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT)
-> SqlInsertValues Sqlite (UserT (QExpr Sqlite Any))
-> SqlInsert Sqlite UserT
forall be (table :: (* -> *) -> *) s (db :: (* -> *) -> *).
(BeamSqlBackend be,
 ProjectibleWithPredicate AnyType () Text (table (QField s))) =>
DatabaseEntity be db (TableEntity table)
-> SqlInsertValues be (table (QExpr be s)) -> SqlInsert be table
insert ((DatabaseSettings Sqlite WikiMusicDatabase
-> Optic'
     A_Lens
     NoIx
     (DatabaseSettings Sqlite WikiMusicDatabase)
     (DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT))
-> DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (DatabaseSettings Sqlite WikiMusicDatabase)
  (DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT))
#users) DatabaseSettings Sqlite WikiMusicDatabase
forall be. DatabaseSettings be WikiMusicDatabase
wikiMusicDatabase)
    (SqlInsertValues Sqlite (UserT (QExpr Sqlite Any)) -> m ())
-> SqlInsertValues Sqlite (UserT (QExpr Sqlite Any)) -> m ()
forall a b. (a -> b) -> a -> b
$ [UserT Identity]
-> SqlInsertValues Sqlite (UserT (QExpr Sqlite Any))
forall be (table :: (* -> *) -> *) s.
(BeamSqlBackend be, Beamable table,
 FieldsFulfillConstraint (BeamSqlBackendCanSerialize be) table) =>
[table Identity] -> SqlInsertValues be (table (QExpr be s))
insertValues [UserT Identity
u]
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    (IO () -> m ())
-> (SqlInsertValues Sqlite (UserRoleT (QExpr Sqlite Any)) -> IO ())
-> SqlInsertValues Sqlite (UserRoleT (QExpr Sqlite Any))
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> IO ()) -> Connection -> SqliteM () -> IO ()
forall a. (String -> IO ()) -> Connection -> SqliteM a -> IO a
runBeamSqliteDebug String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn (Env
env Env -> Optic' A_Lens NoIx Env Connection -> Connection
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Env Connection
#conn)
    (SqliteM () -> IO ())
-> (SqlInsertValues Sqlite (UserRoleT (QExpr Sqlite Any))
    -> SqliteM ())
-> SqlInsertValues Sqlite (UserRoleT (QExpr Sqlite Any))
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlInsert Sqlite UserRoleT -> SqliteM ()
forall be (m :: * -> *) (table :: (* -> *) -> *).
(BeamSqlBackend be, MonadBeam be m) =>
SqlInsert be table -> m ()
runInsert
    (SqlInsert Sqlite UserRoleT -> SqliteM ())
-> (SqlInsertValues Sqlite (UserRoleT (QExpr Sqlite Any))
    -> SqlInsert Sqlite UserRoleT)
-> SqlInsertValues Sqlite (UserRoleT (QExpr Sqlite Any))
-> SqliteM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserRoleT)
-> SqlInsertValues Sqlite (UserRoleT (QExpr Sqlite Any))
-> SqlInsert Sqlite UserRoleT
forall be (table :: (* -> *) -> *) s (db :: (* -> *) -> *).
(BeamSqlBackend be,
 ProjectibleWithPredicate AnyType () Text (table (QField s))) =>
DatabaseEntity be db (TableEntity table)
-> SqlInsertValues be (table (QExpr be s)) -> SqlInsert be table
insert ((DatabaseSettings Sqlite WikiMusicDatabase
-> Optic'
     A_Lens
     NoIx
     (DatabaseSettings Sqlite WikiMusicDatabase)
     (DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserRoleT))
-> DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserRoleT)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (DatabaseSettings Sqlite WikiMusicDatabase)
  (DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserRoleT))
#userRoles) DatabaseSettings Sqlite WikiMusicDatabase
forall be. DatabaseSettings be WikiMusicDatabase
wikiMusicDatabase)
    (SqlInsertValues Sqlite (UserRoleT (QExpr Sqlite Any)) -> m ())
-> SqlInsertValues Sqlite (UserRoleT (QExpr Sqlite Any)) -> m ()
forall a b. (a -> b) -> a -> b
$ [UserRoleT Identity]
-> SqlInsertValues Sqlite (UserRoleT (QExpr Sqlite Any))
forall be (table :: (* -> *) -> *) s.
(BeamSqlBackend be, Beamable table,
 FieldsFulfillConstraint (BeamSqlBackendCanSerialize be) table) =>
[table Identity] -> SqlInsertValues be (table (QExpr be s))
insertValues [UserRoleT Identity
r]
  Either UserCommandError Text -> m (Either UserCommandError Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UserCommandError Text -> m (Either UserCommandError Text))
-> (UUID -> Either UserCommandError Text)
-> UUID
-> m (Either UserCommandError Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either UserCommandError Text
forall a b. b -> Either a b
Right (Text -> Either UserCommandError Text)
-> (UUID -> Text) -> UUID -> Either UserCommandError Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Text
UUID.toText (UUID -> m (Either UserCommandError Text))
-> UUID -> m (Either UserCommandError Text)
forall a b. (a -> b) -> a -> b
$ UUID
passResetToken

doIfUserFoundByEmail :: (MonadIO m) => Env -> UserEmail -> (UUID -> m (Either UserCommandError a)) -> m (Either UserCommandError a)
doIfUserFoundByEmail :: forall (m :: * -> *) a.
MonadIO m =>
Env
-> UserEmail
-> (UUID -> m (Either UserCommandError a))
-> m (Either UserCommandError a)
doIfUserFoundByEmail Env
env UserEmail
email UUID -> m (Either UserCommandError a)
eff = do
  Maybe (UserT Identity)
maybeUser <- IO (Maybe (UserT Identity)) -> m (Maybe (UserT Identity))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (UserT Identity)) -> m (Maybe (UserT Identity)))
-> IO (Maybe (UserT Identity)) -> m (Maybe (UserT Identity))
forall a b. (a -> b) -> a -> b
$ (String -> IO ())
-> Connection
-> SqliteM (Maybe (UserT Identity))
-> IO (Maybe (UserT Identity))
forall a. (String -> IO ()) -> Connection -> SqliteM a -> IO a
runBeamSqliteDebug String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn (Env
env Env -> Optic' A_Lens NoIx Env Connection -> Connection
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Env Connection
#conn) (SqliteM (Maybe (UserT Identity)) -> IO (Maybe (UserT Identity)))
-> SqliteM (Maybe (UserT Identity)) -> IO (Maybe (UserT Identity))
forall a b. (a -> b) -> a -> b
$ do
    SqlSelect Sqlite (UserT Identity)
-> SqliteM (Maybe (UserT Identity))
forall be (m :: * -> *) a.
(MonadBeam be m, BeamSqlBackend be, FromBackendRow be a) =>
SqlSelect be a -> m (Maybe a)
runSelectReturningFirst (SqlSelect Sqlite (UserT Identity)
 -> SqliteM (Maybe (UserT Identity)))
-> SqlSelect Sqlite (UserT Identity)
-> SqliteM (Maybe (UserT Identity))
forall a b. (a -> b) -> a -> b
$ Q Sqlite
  WikiMusicDatabase
  QBaseScope
  (UserT (QExpr Sqlite QBaseScope))
-> SqlSelect
     Sqlite (QExprToIdentity (UserT (QExpr Sqlite QBaseScope)))
forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select (Q Sqlite
   WikiMusicDatabase
   QBaseScope
   (UserT (QExpr Sqlite QBaseScope))
 -> SqlSelect
      Sqlite (QExprToIdentity (UserT (QExpr Sqlite QBaseScope))))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> SqlSelect
     Sqlite (QExprToIdentity (UserT (QExpr Sqlite QBaseScope)))
forall a b. (a -> b) -> a -> b
$ do
      (UserT (QExpr Sqlite QBaseScope) -> QExpr Sqlite QBaseScope Bool)
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
forall r be (db :: (* -> *) -> *) s.
BeamSqlBackend be =>
(r -> QExpr be s Bool) -> Q be db s r -> Q be db s r
filter_
        ( \UserT (QExpr Sqlite QBaseScope)
s ->
            (UserT (QExpr Sqlite QBaseScope)
s UserT (QExpr Sqlite QBaseScope)
-> Optic'
     A_Lens
     NoIx
     (UserT (QExpr Sqlite QBaseScope))
     (QGenExpr QValueContext Sqlite QBaseScope Text)
-> QGenExpr QValueContext Sqlite QBaseScope Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (UserT (QExpr Sqlite QBaseScope))
  (QGenExpr QValueContext Sqlite QBaseScope Text)
#emailAddress)
              QGenExpr QValueContext Sqlite QBaseScope Text
-> QGenExpr QValueContext Sqlite QBaseScope Text
-> QExpr Sqlite QBaseScope Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. HaskellLiteralForQExpr
  (QGenExpr QValueContext Sqlite QBaseScope Text)
-> QGenExpr QValueContext Sqlite QBaseScope Text
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ (UserEmail
email UserEmail
-> Optic'
     An_Iso
     NoIx
     UserEmail
     (HaskellLiteralForQExpr
        (QGenExpr QValueContext Sqlite QBaseScope Text))
-> HaskellLiteralForQExpr
     (QGenExpr QValueContext Sqlite QBaseScope Text)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  An_Iso
  NoIx
  UserEmail
  (HaskellLiteralForQExpr
     (QGenExpr QValueContext Sqlite QBaseScope Text))
#value)
        )
        (Q Sqlite
   WikiMusicDatabase
   QBaseScope
   (UserT (QExpr Sqlite QBaseScope))
 -> Q Sqlite
      WikiMusicDatabase
      QBaseScope
      (UserT (QExpr Sqlite QBaseScope)))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT)
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ ((DatabaseSettings Sqlite WikiMusicDatabase
-> Optic'
     A_Lens
     NoIx
     (DatabaseSettings Sqlite WikiMusicDatabase)
     (DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT))
-> DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (DatabaseSettings Sqlite WikiMusicDatabase)
  (DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT))
#users) DatabaseSettings Sqlite WikiMusicDatabase
forall be. DatabaseSettings be WikiMusicDatabase
wikiMusicDatabase)

  case Maybe (UserT Identity)
maybeUser of
    Maybe (UserT Identity)
Nothing -> Either UserCommandError a -> m (Either UserCommandError a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UserCommandError a -> m (Either UserCommandError a))
-> (Text -> Either UserCommandError a)
-> Text
-> m (Either UserCommandError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserCommandError -> Either UserCommandError a
forall a b. a -> Either a b
Left (UserCommandError -> Either UserCommandError a)
-> (Text -> UserCommandError) -> Text -> Either UserCommandError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> UserCommandError
LogicError (Text -> m (Either UserCommandError a))
-> Text -> m (Either UserCommandError a)
forall a b. (a -> b) -> a -> b
$ Text
"User could not be found!"
    Just UserT Identity
u -> UUID -> m (Either UserCommandError a)
eff (Text -> UUID
textToUUID (Text -> UUID) -> Text -> UUID
forall a b. (a -> b) -> a -> b
$ UserT Identity
u UserT Identity -> Optic' A_Lens NoIx (UserT Identity) Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (UserT Identity) Text
#identifier)

deleteU :: (MonadIO m) => Env -> UUID -> m (Either UserCommandError ())
deleteU :: forall (m :: * -> *).
MonadIO m =>
Env -> UUID -> m (Either UserCommandError ())
deleteU Env
env UUID
identifier = do
  Maybe (UserT Identity)
maybeUser <- IO (Maybe (UserT Identity)) -> m (Maybe (UserT Identity))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (UserT Identity)) -> m (Maybe (UserT Identity)))
-> IO (Maybe (UserT Identity)) -> m (Maybe (UserT Identity))
forall a b. (a -> b) -> a -> b
$ (String -> IO ())
-> Connection
-> SqliteM (Maybe (UserT Identity))
-> IO (Maybe (UserT Identity))
forall a. (String -> IO ()) -> Connection -> SqliteM a -> IO a
runBeamSqliteDebug String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn (Env
env Env -> Optic' A_Lens NoIx Env Connection -> Connection
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Env Connection
#conn) (SqliteM (Maybe (UserT Identity)) -> IO (Maybe (UserT Identity)))
-> SqliteM (Maybe (UserT Identity)) -> IO (Maybe (UserT Identity))
forall a b. (a -> b) -> a -> b
$ do
    SqlSelect Sqlite (UserT Identity)
-> SqliteM (Maybe (UserT Identity))
forall be (m :: * -> *) a.
(MonadBeam be m, BeamSqlBackend be, FromBackendRow be a) =>
SqlSelect be a -> m (Maybe a)
runSelectReturningFirst (SqlSelect Sqlite (UserT Identity)
 -> SqliteM (Maybe (UserT Identity)))
-> SqlSelect Sqlite (UserT Identity)
-> SqliteM (Maybe (UserT Identity))
forall a b. (a -> b) -> a -> b
$ Q Sqlite
  WikiMusicDatabase
  QBaseScope
  (UserT (QExpr Sqlite QBaseScope))
-> SqlSelect
     Sqlite (QExprToIdentity (UserT (QExpr Sqlite QBaseScope)))
forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select (Q Sqlite
   WikiMusicDatabase
   QBaseScope
   (UserT (QExpr Sqlite QBaseScope))
 -> SqlSelect
      Sqlite (QExprToIdentity (UserT (QExpr Sqlite QBaseScope))))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> SqlSelect
     Sqlite (QExprToIdentity (UserT (QExpr Sqlite QBaseScope)))
forall a b. (a -> b) -> a -> b
$ do
      (UserT (QExpr Sqlite QBaseScope) -> QExpr Sqlite QBaseScope Bool)
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
forall r be (db :: (* -> *) -> *) s.
BeamSqlBackend be =>
(r -> QExpr be s Bool) -> Q be db s r -> Q be db s r
filter_
        ( \UserT (QExpr Sqlite QBaseScope)
s ->
            (UserT (QExpr Sqlite QBaseScope)
s UserT (QExpr Sqlite QBaseScope)
-> Optic'
     A_Lens
     NoIx
     (UserT (QExpr Sqlite QBaseScope))
     (QGenExpr QValueContext Sqlite QBaseScope Text)
-> QGenExpr QValueContext Sqlite QBaseScope Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (UserT (QExpr Sqlite QBaseScope))
  (QGenExpr QValueContext Sqlite QBaseScope Text)
#identifier)
              QGenExpr QValueContext Sqlite QBaseScope Text
-> QGenExpr QValueContext Sqlite QBaseScope Text
-> QExpr Sqlite QBaseScope Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. HaskellLiteralForQExpr
  (QGenExpr QValueContext Sqlite QBaseScope Text)
-> QGenExpr QValueContext Sqlite QBaseScope Text
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ (UUID -> Text
UUID.toText UUID
identifier)
        )
        (Q Sqlite
   WikiMusicDatabase
   QBaseScope
   (UserT (QExpr Sqlite QBaseScope))
 -> Q Sqlite
      WikiMusicDatabase
      QBaseScope
      (UserT (QExpr Sqlite QBaseScope)))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT)
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ ((DatabaseSettings Sqlite WikiMusicDatabase
-> Optic'
     A_Lens
     NoIx
     (DatabaseSettings Sqlite WikiMusicDatabase)
     (DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT))
-> DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (DatabaseSettings Sqlite WikiMusicDatabase)
  (DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT))
#users) DatabaseSettings Sqlite WikiMusicDatabase
forall be. DatabaseSettings be WikiMusicDatabase
wikiMusicDatabase)
  case Maybe (UserT Identity)
maybeUser of
    Maybe (UserT Identity)
Nothing -> Either UserCommandError () -> m (Either UserCommandError ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UserCommandError () -> m (Either UserCommandError ()))
-> (UserCommandError -> Either UserCommandError ())
-> UserCommandError
-> m (Either UserCommandError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserCommandError -> Either UserCommandError ()
forall a b. a -> Either a b
Left (UserCommandError -> m (Either UserCommandError ()))
-> UserCommandError -> m (Either UserCommandError ())
forall a b. (a -> b) -> a -> b
$ Text -> UserCommandError
PersistenceError Text
""
    Just UserT Identity
x -> do
      ()
_ <-
        IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
          (IO () -> m ())
-> (SqlUpdate Sqlite UserT -> IO ())
-> SqlUpdate Sqlite UserT
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> IO ()) -> Connection -> SqliteM () -> IO ()
forall a. (String -> IO ()) -> Connection -> SqliteM a -> IO a
runBeamSqliteDebug String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn (Env
env Env -> Optic' A_Lens NoIx Env Connection -> Connection
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Env Connection
#conn)
          (SqliteM () -> IO ())
-> (SqlUpdate Sqlite UserT -> SqliteM ())
-> SqlUpdate Sqlite UserT
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlUpdate Sqlite UserT -> SqliteM ()
forall be (m :: * -> *) (tbl :: (* -> *) -> *).
(BeamSqlBackend be, MonadBeam be m) =>
SqlUpdate be tbl -> m ()
runUpdate
          (SqlUpdate Sqlite UserT -> m ()) -> SqlUpdate Sqlite UserT -> m ()
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT)
-> UserT Identity -> SqlUpdate Sqlite UserT
forall (table :: (* -> *) -> *) be (db :: (* -> *) -> *).
(Table table, BeamSqlBackend be,
 SqlValableTable be (PrimaryKey table), SqlValableTable be table,
 HasTableEquality be (PrimaryKey table)) =>
DatabaseEntity be db (TableEntity table)
-> table Identity -> SqlUpdate be table
save ((DatabaseSettings Sqlite WikiMusicDatabase
-> Optic'
     A_Lens
     NoIx
     (DatabaseSettings Sqlite WikiMusicDatabase)
     (DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT))
-> DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (DatabaseSettings Sqlite WikiMusicDatabase)
  (DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT))
#users) DatabaseSettings Sqlite WikiMusicDatabase
forall be. DatabaseSettings be WikiMusicDatabase
wikiMusicDatabase) (UserT Identity
x {passwordHash = Just "", authToken = Just ""} :: User')
      Either UserCommandError () -> m (Either UserCommandError ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UserCommandError () -> m (Either UserCommandError ()))
-> (() -> Either UserCommandError ())
-> ()
-> m (Either UserCommandError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Either UserCommandError ()
forall a b. b -> Either a b
Right (() -> m (Either UserCommandError ()))
-> () -> m (Either UserCommandError ())
forall a b. (a -> b) -> a -> b
$ ()