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

module WikiMusic.Sqlite.AuthQuery () where

import Data.Text qualified as T
import Data.UUID qualified as UUID
import Database.Beam
import Database.Beam.Sqlite
import Relude
import WikiMusic.Beam.Database
import WikiMusic.Beam.User
import WikiMusic.Free.AuthQuery
import WikiMusic.Protolude

instance Exec AuthQuery where
  execAlgebra :: forall a. AuthQuery (IO a) -> IO a
execAlgebra (FetchUserForAuthCheck Env
env Text
email Either AuthQueryError (Maybe WikiMusicUser) -> IO a
next) = do
    Either AuthQueryError (Maybe WikiMusicUser) -> IO a
next (Either AuthQueryError (Maybe WikiMusicUser) -> IO a)
-> IO (Either AuthQueryError (Maybe WikiMusicUser)) -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Env -> Text -> IO (Either AuthQueryError (Maybe WikiMusicUser))
forall (m :: * -> *).
MonadIO m =>
Env -> Text -> m (Either AuthQueryError (Maybe WikiMusicUser))
fetchUserForAuthCheck' Env
env Text
email
  execAlgebra (FetchUserFromToken Env
env Text
t Either AuthQueryError (Maybe WikiMusicUser) -> IO a
next) = do
    Either AuthQueryError (Maybe WikiMusicUser) -> IO a
next (Either AuthQueryError (Maybe WikiMusicUser) -> IO a)
-> IO (Either AuthQueryError (Maybe WikiMusicUser)) -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Env -> Text -> IO (Either AuthQueryError (Maybe WikiMusicUser))
forall (m :: * -> *).
MonadIO m =>
Env -> Text -> m (Either AuthQueryError (Maybe WikiMusicUser))
fetchUserFromToken' Env
env Text
t
  execAlgebra (FetchMe Env
env UUID
identifier Either AuthQueryError (Maybe WikiMusicUser) -> IO a
next) = do
    Either AuthQueryError (Maybe WikiMusicUser) -> IO a
next (Either AuthQueryError (Maybe WikiMusicUser) -> IO a)
-> IO (Either AuthQueryError (Maybe WikiMusicUser)) -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Env -> UUID -> IO (Either AuthQueryError (Maybe WikiMusicUser))
forall (m :: * -> *).
MonadIO m =>
Env -> UUID -> m (Either AuthQueryError (Maybe WikiMusicUser))
fetchMe' Env
env UUID
identifier
  execAlgebra (FetchUserRoles Env
env UUID
identifier Either AuthQueryError [UserRole] -> IO a
next) = do
    Either AuthQueryError [UserRole] -> IO a
next (Either AuthQueryError [UserRole] -> IO a)
-> IO (Either AuthQueryError [UserRole]) -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Env -> UUID -> IO (Either AuthQueryError [UserRole])
forall (m :: * -> *).
MonadIO m =>
Env -> UUID -> m (Either AuthQueryError [UserRole])
fetchUserRoles' Env
env UUID
identifier

fetchMe' :: (MonadIO m) => Env -> UUID -> m (Either AuthQueryError (Maybe WikiMusicUser))
fetchMe' :: forall (m :: * -> *).
MonadIO m =>
Env -> UUID -> m (Either AuthQueryError (Maybe WikiMusicUser))
fetchMe' Env
env UUID
identifier = do
  Maybe User'
maybeUser <- IO (Maybe User') -> m (Maybe User')
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe User') -> m (Maybe User'))
-> (Q Sqlite
      WikiMusicDatabase
      QBaseScope
      (UserT (QExpr Sqlite QBaseScope))
    -> IO (Maybe User'))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> m (Maybe User')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> IO ())
-> Connection -> SqliteM (Maybe User') -> IO (Maybe User')
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 User') -> IO (Maybe User'))
-> (Q Sqlite
      WikiMusicDatabase
      QBaseScope
      (UserT (QExpr Sqlite QBaseScope))
    -> SqliteM (Maybe User'))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> IO (Maybe User')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlSelect Sqlite User' -> SqliteM (Maybe User')
forall be (m :: * -> *) a.
(MonadBeam be m, BeamSqlBackend be, FromBackendRow be a) =>
SqlSelect be a -> m (Maybe a)
runSelectReturningFirst (SqlSelect Sqlite User' -> SqliteM (Maybe User'))
-> (Q Sqlite
      WikiMusicDatabase
      QBaseScope
      (UserT (QExpr Sqlite QBaseScope))
    -> SqlSelect Sqlite User')
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> SqliteM (Maybe User')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 User'
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))
 -> m (Maybe User'))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> m (Maybe User')
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_ (String -> Text
String
-> HaskellLiteralForQExpr
     (QGenExpr QValueContext Sqlite QBaseScope Text)
T.pack (String
 -> HaskellLiteralForQExpr
      (QGenExpr QValueContext Sqlite QBaseScope Text))
-> (UUID -> String)
-> UUID
-> HaskellLiteralForQExpr
     (QGenExpr QValueContext Sqlite QBaseScope Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> String
forall b a. (Show a, IsString b) => a -> b
show (UUID
 -> HaskellLiteralForQExpr
      (QGenExpr QValueContext Sqlite QBaseScope Text))
-> UUID
-> HaskellLiteralForQExpr
     (QGenExpr QValueContext Sqlite QBaseScope Text)
forall a b. (a -> b) -> a -> b
$ 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 User'
maybeUser of
    Maybe User'
Nothing -> Either AuthQueryError (Maybe WikiMusicUser)
-> m (Either AuthQueryError (Maybe WikiMusicUser))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either AuthQueryError (Maybe WikiMusicUser)
 -> m (Either AuthQueryError (Maybe WikiMusicUser)))
-> (AuthQueryError -> Either AuthQueryError (Maybe WikiMusicUser))
-> AuthQueryError
-> m (Either AuthQueryError (Maybe WikiMusicUser))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthQueryError -> Either AuthQueryError (Maybe WikiMusicUser)
forall a b. a -> Either a b
Left (AuthQueryError -> m (Either AuthQueryError (Maybe WikiMusicUser)))
-> AuthQueryError
-> m (Either AuthQueryError (Maybe WikiMusicUser))
forall a b. (a -> b) -> a -> b
$ Text -> AuthQueryError
AuthError Text
"User did not exist"
    (Just User'
usr) -> do
      WikiMusicUser
u' <- Env -> WikiMusicUser -> m WikiMusicUser
forall (m :: * -> *).
MonadIO m =>
Env -> WikiMusicUser -> m WikiMusicUser
withRoles Env
env ([Text] -> User' -> WikiMusicUser
mkUserM [] User'
usr)
      Either AuthQueryError (Maybe WikiMusicUser)
-> m (Either AuthQueryError (Maybe WikiMusicUser))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either AuthQueryError (Maybe WikiMusicUser)
 -> m (Either AuthQueryError (Maybe WikiMusicUser)))
-> (WikiMusicUser -> Either AuthQueryError (Maybe WikiMusicUser))
-> WikiMusicUser
-> m (Either AuthQueryError (Maybe WikiMusicUser))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe WikiMusicUser -> Either AuthQueryError (Maybe WikiMusicUser)
forall a b. b -> Either a b
Right (Maybe WikiMusicUser
 -> Either AuthQueryError (Maybe WikiMusicUser))
-> (WikiMusicUser -> Maybe WikiMusicUser)
-> WikiMusicUser
-> Either AuthQueryError (Maybe WikiMusicUser)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WikiMusicUser -> Maybe WikiMusicUser
forall a. a -> Maybe a
Just (WikiMusicUser -> m (Either AuthQueryError (Maybe WikiMusicUser)))
-> WikiMusicUser -> m (Either AuthQueryError (Maybe WikiMusicUser))
forall a b. (a -> b) -> a -> b
$ WikiMusicUser
u'

fetchUserForAuthCheck' :: (MonadIO m) => Env -> Text -> m (Either AuthQueryError (Maybe WikiMusicUser))
fetchUserForAuthCheck' :: forall (m :: * -> *).
MonadIO m =>
Env -> Text -> m (Either AuthQueryError (Maybe WikiMusicUser))
fetchUserForAuthCheck' Env
env Text
email = do
  Maybe User'
maybeUser <- IO (Maybe User') -> m (Maybe User')
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe User') -> m (Maybe User'))
-> (Q Sqlite
      WikiMusicDatabase
      QBaseScope
      (UserT (QExpr Sqlite QBaseScope))
    -> IO (Maybe User'))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> m (Maybe User')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> IO ())
-> Connection -> SqliteM (Maybe User') -> IO (Maybe User')
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 User') -> IO (Maybe User'))
-> (Q Sqlite
      WikiMusicDatabase
      QBaseScope
      (UserT (QExpr Sqlite QBaseScope))
    -> SqliteM (Maybe User'))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> IO (Maybe User')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlSelect Sqlite User' -> SqliteM (Maybe User')
forall be (m :: * -> *) a.
(MonadBeam be m, BeamSqlBackend be, FromBackendRow be a) =>
SqlSelect be a -> m (Maybe a)
runSelectReturningFirst (SqlSelect Sqlite User' -> SqliteM (Maybe User'))
-> (Q Sqlite
      WikiMusicDatabase
      QBaseScope
      (UserT (QExpr Sqlite QBaseScope))
    -> SqlSelect Sqlite User')
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> SqliteM (Maybe User')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 User'
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))
 -> m (Maybe User'))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> m (Maybe User')
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_ Text
HaskellLiteralForQExpr
  (QGenExpr QValueContext Sqlite QBaseScope Text)
email)
      (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 User'
maybeUser of
    Maybe User'
Nothing -> Either AuthQueryError (Maybe WikiMusicUser)
-> m (Either AuthQueryError (Maybe WikiMusicUser))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either AuthQueryError (Maybe WikiMusicUser)
 -> m (Either AuthQueryError (Maybe WikiMusicUser)))
-> (AuthQueryError -> Either AuthQueryError (Maybe WikiMusicUser))
-> AuthQueryError
-> m (Either AuthQueryError (Maybe WikiMusicUser))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthQueryError -> Either AuthQueryError (Maybe WikiMusicUser)
forall a b. a -> Either a b
Left (AuthQueryError -> m (Either AuthQueryError (Maybe WikiMusicUser)))
-> AuthQueryError
-> m (Either AuthQueryError (Maybe WikiMusicUser))
forall a b. (a -> b) -> a -> b
$ Text -> AuthQueryError
AuthError Text
"User did not exist"
    (Just User'
usr) -> do
      WikiMusicUser
u <- Env -> WikiMusicUser -> m WikiMusicUser
forall (m :: * -> *).
MonadIO m =>
Env -> WikiMusicUser -> m WikiMusicUser
withRoles Env
env ([Text] -> User' -> WikiMusicUser
mkUserM [] User'
usr)
      Either AuthQueryError (Maybe WikiMusicUser)
-> m (Either AuthQueryError (Maybe WikiMusicUser))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either AuthQueryError (Maybe WikiMusicUser)
 -> m (Either AuthQueryError (Maybe WikiMusicUser)))
-> (WikiMusicUser -> Either AuthQueryError (Maybe WikiMusicUser))
-> WikiMusicUser
-> m (Either AuthQueryError (Maybe WikiMusicUser))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe WikiMusicUser -> Either AuthQueryError (Maybe WikiMusicUser)
forall a b. b -> Either a b
Right (Maybe WikiMusicUser
 -> Either AuthQueryError (Maybe WikiMusicUser))
-> (WikiMusicUser -> Maybe WikiMusicUser)
-> WikiMusicUser
-> Either AuthQueryError (Maybe WikiMusicUser)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WikiMusicUser -> Maybe WikiMusicUser
forall a. a -> Maybe a
Just (WikiMusicUser -> m (Either AuthQueryError (Maybe WikiMusicUser)))
-> WikiMusicUser -> m (Either AuthQueryError (Maybe WikiMusicUser))
forall a b. (a -> b) -> a -> b
$ WikiMusicUser
u

fetchUserFromToken' :: (MonadIO m) => Env -> Text -> m (Either AuthQueryError (Maybe WikiMusicUser))
fetchUserFromToken' :: forall (m :: * -> *).
MonadIO m =>
Env -> Text -> m (Either AuthQueryError (Maybe WikiMusicUser))
fetchUserFromToken' Env
env Text
t = do
  Maybe User'
maybeUser <- IO (Maybe User') -> m (Maybe User')
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe User') -> m (Maybe User'))
-> (Q Sqlite
      WikiMusicDatabase
      QBaseScope
      (UserT (QExpr Sqlite QBaseScope))
    -> IO (Maybe User'))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> m (Maybe User')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> IO ())
-> Connection -> SqliteM (Maybe User') -> IO (Maybe User')
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 User') -> IO (Maybe User'))
-> (Q Sqlite
      WikiMusicDatabase
      QBaseScope
      (UserT (QExpr Sqlite QBaseScope))
    -> SqliteM (Maybe User'))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> IO (Maybe User')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlSelect Sqlite User' -> SqliteM (Maybe User')
forall be (m :: * -> *) a.
(MonadBeam be m, BeamSqlBackend be, FromBackendRow be a) =>
SqlSelect be a -> m (Maybe a)
runSelectReturningFirst (SqlSelect Sqlite User' -> SqliteM (Maybe User'))
-> (Q Sqlite
      WikiMusicDatabase
      QBaseScope
      (UserT (QExpr Sqlite QBaseScope))
    -> SqlSelect Sqlite User')
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> SqliteM (Maybe User')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 User'
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))
 -> m (Maybe User'))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> m (Maybe User')
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 (Maybe Text))
-> QGenExpr QValueContext Sqlite QBaseScope (Maybe 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 (Maybe Text))
#authToken) QGenExpr QValueContext Sqlite QBaseScope (Maybe Text)
-> QGenExpr QValueContext Sqlite QBaseScope (Maybe Text)
-> QExpr Sqlite QBaseScope Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. HaskellLiteralForQExpr
  (QGenExpr QValueContext Sqlite QBaseScope (Maybe Text))
-> QGenExpr QValueContext Sqlite QBaseScope (Maybe Text)
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t))
      (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 User'
maybeUser of
    Maybe User'
Nothing -> Either AuthQueryError (Maybe WikiMusicUser)
-> m (Either AuthQueryError (Maybe WikiMusicUser))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either AuthQueryError (Maybe WikiMusicUser)
 -> m (Either AuthQueryError (Maybe WikiMusicUser)))
-> (AuthQueryError -> Either AuthQueryError (Maybe WikiMusicUser))
-> AuthQueryError
-> m (Either AuthQueryError (Maybe WikiMusicUser))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthQueryError -> Either AuthQueryError (Maybe WikiMusicUser)
forall a b. a -> Either a b
Left (AuthQueryError -> m (Either AuthQueryError (Maybe WikiMusicUser)))
-> AuthQueryError
-> m (Either AuthQueryError (Maybe WikiMusicUser))
forall a b. (a -> b) -> a -> b
$ Text -> AuthQueryError
AuthError Text
"User did not exist"
    (Just User'
usr) -> do
      WikiMusicUser
u <- Env -> WikiMusicUser -> m WikiMusicUser
forall (m :: * -> *).
MonadIO m =>
Env -> WikiMusicUser -> m WikiMusicUser
withRoles Env
env ([Text] -> User' -> WikiMusicUser
mkUserM [] User'
usr)
      Either AuthQueryError (Maybe WikiMusicUser)
-> m (Either AuthQueryError (Maybe WikiMusicUser))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either AuthQueryError (Maybe WikiMusicUser)
 -> m (Either AuthQueryError (Maybe WikiMusicUser)))
-> (WikiMusicUser -> Either AuthQueryError (Maybe WikiMusicUser))
-> WikiMusicUser
-> m (Either AuthQueryError (Maybe WikiMusicUser))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe WikiMusicUser -> Either AuthQueryError (Maybe WikiMusicUser)
forall a b. b -> Either a b
Right (Maybe WikiMusicUser
 -> Either AuthQueryError (Maybe WikiMusicUser))
-> (WikiMusicUser -> Maybe WikiMusicUser)
-> WikiMusicUser
-> Either AuthQueryError (Maybe WikiMusicUser)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WikiMusicUser -> Maybe WikiMusicUser
forall a. a -> Maybe a
Just (WikiMusicUser -> m (Either AuthQueryError (Maybe WikiMusicUser)))
-> WikiMusicUser -> m (Either AuthQueryError (Maybe WikiMusicUser))
forall a b. (a -> b) -> a -> b
$ WikiMusicUser
u

fetchUserRoles' :: (MonadIO m) => Env -> UUID -> m (Either AuthQueryError [UserRole])
fetchUserRoles' :: forall (m :: * -> *).
MonadIO m =>
Env -> UUID -> m (Either AuthQueryError [UserRole])
fetchUserRoles' Env
env UUID
identifier = do
  [UserRoleT Identity]
userRoles <- IO [UserRoleT Identity] -> m [UserRoleT Identity]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [UserRoleT Identity] -> m [UserRoleT Identity])
-> (Q Sqlite
      WikiMusicDatabase
      QBaseScope
      (UserRoleT (QExpr Sqlite QBaseScope))
    -> IO [UserRoleT Identity])
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserRoleT (QExpr Sqlite QBaseScope))
-> m [UserRoleT Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> IO ())
-> Connection
-> SqliteM [UserRoleT Identity]
-> IO [UserRoleT 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 [UserRoleT Identity] -> IO [UserRoleT Identity])
-> (Q Sqlite
      WikiMusicDatabase
      QBaseScope
      (UserRoleT (QExpr Sqlite QBaseScope))
    -> SqliteM [UserRoleT Identity])
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserRoleT (QExpr Sqlite QBaseScope))
-> IO [UserRoleT Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlSelect Sqlite (UserRoleT Identity)
-> SqliteM [UserRoleT Identity]
forall be (m :: * -> *) a.
(MonadBeam be m, BeamSqlBackend be, FromBackendRow be a) =>
SqlSelect be a -> m [a]
runSelectReturningList (SqlSelect Sqlite (UserRoleT Identity)
 -> SqliteM [UserRoleT Identity])
-> (Q Sqlite
      WikiMusicDatabase
      QBaseScope
      (UserRoleT (QExpr Sqlite QBaseScope))
    -> SqlSelect Sqlite (UserRoleT Identity))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserRoleT (QExpr Sqlite QBaseScope))
-> SqliteM [UserRoleT Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q Sqlite
  WikiMusicDatabase
  QBaseScope
  (UserRoleT (QExpr Sqlite QBaseScope))
-> SqlSelect
     Sqlite (QExprToIdentity (UserRoleT (QExpr Sqlite QBaseScope)))
Q Sqlite
  WikiMusicDatabase
  QBaseScope
  (UserRoleT (QExpr Sqlite QBaseScope))
-> SqlSelect Sqlite (UserRoleT Identity)
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
   (UserRoleT (QExpr Sqlite QBaseScope))
 -> m [UserRoleT Identity])
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserRoleT (QExpr Sqlite QBaseScope))
-> m [UserRoleT Identity]
forall a b. (a -> b) -> a -> b
$ do
    (UserRoleT (QExpr Sqlite QBaseScope)
 -> QExpr Sqlite QBaseScope Bool)
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserRoleT (QExpr Sqlite QBaseScope))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserRoleT (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_ (\UserRoleT (QExpr Sqlite QBaseScope)
s -> (UserRoleT (QExpr Sqlite QBaseScope)
s UserRoleT (QExpr Sqlite QBaseScope)
-> Optic'
     A_Lens
     NoIx
     (UserRoleT (QExpr Sqlite QBaseScope))
     (PrimaryKey UserT (QExpr Sqlite QBaseScope))
-> PrimaryKey UserT (QExpr Sqlite QBaseScope)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (UserRoleT (QExpr Sqlite QBaseScope))
  (PrimaryKey UserT (QExpr Sqlite QBaseScope))
#userIdentifier) PrimaryKey UserT (QExpr Sqlite QBaseScope)
-> PrimaryKey UserT (QExpr Sqlite QBaseScope)
-> QExpr Sqlite QBaseScope Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. (PrimaryKey UserT Identity
-> PrimaryKey UserT (QExpr Sqlite QBaseScope)
HaskellLiteralForQExpr (PrimaryKey UserT (QExpr Sqlite QBaseScope))
-> PrimaryKey UserT (QExpr Sqlite QBaseScope)
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ (PrimaryKey UserT Identity
 -> PrimaryKey UserT (QExpr Sqlite QBaseScope))
-> (Text -> PrimaryKey UserT Identity)
-> Text
-> PrimaryKey UserT (QExpr Sqlite QBaseScope)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PrimaryKey UserT Identity
C Identity Text -> PrimaryKey UserT Identity
forall (f :: * -> *). Columnar f Text -> PrimaryKey UserT f
UserId (Text -> PrimaryKey UserT (QExpr Sqlite QBaseScope))
-> Text -> PrimaryKey UserT (QExpr Sqlite QBaseScope)
forall a b. (a -> b) -> a -> b
$ UUID -> Text
UUID.toText UUID
identifier))
      (Q Sqlite
   WikiMusicDatabase
   QBaseScope
   (UserRoleT (QExpr Sqlite QBaseScope))
 -> Q Sqlite
      WikiMusicDatabase
      QBaseScope
      (UserRoleT (QExpr Sqlite QBaseScope)))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserRoleT (QExpr Sqlite QBaseScope))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserRoleT (QExpr Sqlite QBaseScope))
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserRoleT)
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserRoleT (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 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)

  let roles' :: [UserRole]
roles' = (UserRoleT Identity -> UserRole)
-> [UserRoleT Identity] -> [UserRole]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> UserRole
userRole (Text -> UserRole)
-> (UserRoleT Identity -> Text) -> UserRoleT Identity -> UserRole
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UserRoleT Identity
-> Optic' A_Lens NoIx (UserRoleT Identity) Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (UserRoleT Identity) Text
#roleId)) [UserRoleT Identity]
userRoles
  Either AuthQueryError [UserRole]
-> m (Either AuthQueryError [UserRole])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either AuthQueryError [UserRole]
 -> m (Either AuthQueryError [UserRole]))
-> ([UserRole] -> Either AuthQueryError [UserRole])
-> [UserRole]
-> m (Either AuthQueryError [UserRole])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UserRole] -> Either AuthQueryError [UserRole]
forall a b. b -> Either a b
Right ([UserRole] -> m (Either AuthQueryError [UserRole]))
-> [UserRole] -> m (Either AuthQueryError [UserRole])
forall a b. (a -> b) -> a -> b
$ [UserRole]
roles'

withRoles :: (MonadIO m) => Env -> WikiMusicUser -> m WikiMusicUser
withRoles :: forall (m :: * -> *).
MonadIO m =>
Env -> WikiMusicUser -> m WikiMusicUser
withRoles Env
env WikiMusicUser
usr = do
  Either AuthQueryError [UserRole]
roles' <- Env -> UUID -> m (Either AuthQueryError [UserRole])
forall (m :: * -> *).
MonadIO m =>
Env -> UUID -> m (Either AuthQueryError [UserRole])
fetchUserRoles' Env
env (WikiMusicUser
usr WikiMusicUser -> Optic' A_Lens NoIx WikiMusicUser UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx WikiMusicUser UUID
#identifier)
  WikiMusicUser -> m WikiMusicUser
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WikiMusicUser -> m WikiMusicUser)
-> WikiMusicUser -> m WikiMusicUser
forall a b. (a -> b) -> a -> b
$ WikiMusicUser
usr {roles = fromRight [] roles'}