{-# LANGUAGE OverloadedLabels #-}

module Mensam.Server.Database.Check where

import Mensam.Server.Application.SeldaPool.Class
import Mensam.Server.Database.Schema

import Control.Monad
import Control.Monad.Logger.CallStack
import Control.Monad.Trans.Class
import Data.Text qualified as T
import Database.Selda qualified as Selda

checkDatabase ::
  ( MonadLogger m
  , MonadSeldaPool m
  ) =>
  m ()
checkDatabase :: forall (m :: * -> *). (MonadLogger m, MonadSeldaPool m) => m ()
checkDatabase = m (SeldaResult ()) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (SeldaResult ()) -> m ()) -> m (SeldaResult ()) -> m ()
forall a b. (a -> b) -> a -> b
$ SeldaTransactionT m () -> m (SeldaResult ())
forall a. SeldaTransactionT m a -> m (SeldaResult a)
forall (m :: * -> *) a.
MonadSeldaPool m =>
SeldaTransactionT m a -> m (SeldaResult a)
runSeldaTransactionT (SeldaTransactionT m () -> m (SeldaResult ()))
-> SeldaTransactionT m () -> m (SeldaResult ())
forall a b. (a -> b) -> a -> b
$ do
  --  -- TODO: The validator internally makes a mistake, thinking that INTEGER means Int32.
  --  -- https://github.com/valderman/selda/blob/ab9619db13b93867d1a244441bb4de03d3e1dadb/selda-sqlite/src/Database/Selda/SQLite.hs#L129
  --
  --  lift $ logDebug "Validating table 'migration'."
  --  Selda.validateTable tableMigration
  --
  --  lift $ logDebug "Validating table 'jwk'."
  --  Selda.validateTable tableJwk
  --
  --  lift $ logDebug "Validating table 'user'."
  --  Selda.validateTable tableUser
  --
  --  lift $ logDebug "Validating table 'confirmation'."
  --  Selda.validateTable tableConfirmation
  --
  --  lift $ logDebug "Validating table 'session'."
  --  Selda.validateTable tableSession
  --
  --  lift $ logDebug "Validating table 'space'."
  --  Selda.validateTable tableSpace
  --
  --  lift $ logDebug "Validating table 'role'."
  --  Selda.validateTable tableRole
  --
  --  lift $ logDebug "Validating table 'role_permission'."
  --  Selda.validateTable tableRolePermission
  --
  --  lift $ logDebug "Validating table 'space_user'."
  --  Selda.validateTable tableSpaceUser
  --
  --  lift $ logDebug "Validating table 'desk'."
  --  Selda.validateTable tableDesk
  --
  --  lift $ logDebug "Validating table 'reservation'."
  --  Selda.validateTable tableReservation

  do
    m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Checking for overlapping reservations."
    [DbReservation]
reservationsOverlapping <- Query (Backend (SeldaTransactionT m)) (Row SQLite DbReservation)
-> SeldaTransactionT m [Res (Row SQLite DbReservation)]
forall (m :: * -> *) a.
(MonadSelda m, Result a) =>
Query (Backend m) a -> m [Res a]
Selda.query (Query (Backend (SeldaTransactionT m)) (Row SQLite DbReservation)
 -> SeldaTransactionT m [Res (Row SQLite DbReservation)])
-> Query (Backend (SeldaTransactionT m)) (Row SQLite DbReservation)
-> SeldaTransactionT m [Res (Row SQLite DbReservation)]
forall a b. (a -> b) -> a -> b
$ do
      Row SQLite DbReservation
dbReservationX <- Table DbReservation -> Query SQLite (Row SQLite DbReservation)
forall a s. Relational a => Table a -> Query s (Row s a)
Selda.select Table DbReservation
tableReservation
      Col SQLite Bool -> Query SQLite ()
forall s t. Same s t => Col s Bool -> Query t ()
Selda.restrict (Col SQLite Bool -> Query SQLite ())
-> Col SQLite Bool -> Query SQLite ()
forall a b. (a -> b) -> a -> b
$ Row SQLite DbReservation
dbReservationX Row SQLite DbReservation
-> Selector DbReservation DbReservationStatus
-> Col SQLite DbReservationStatus
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbReservation DbReservationStatus
#dbReservation_status Col SQLite DbReservationStatus
-> Col SQLite DbReservationStatus -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda../= DbReservationStatus -> Col SQLite DbReservationStatus
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal DbReservationStatus
MkDbReservationStatus_cancelled
      Row SQLite DbReservation
dbReservationY <- Table DbReservation -> Query SQLite (Row SQLite DbReservation)
forall a s. Relational a => Table a -> Query s (Row s a)
Selda.select Table DbReservation
tableReservation
      Col SQLite Bool -> Query SQLite ()
forall s t. Same s t => Col s Bool -> Query t ()
Selda.restrict (Col SQLite Bool -> Query SQLite ())
-> Col SQLite Bool -> Query SQLite ()
forall a b. (a -> b) -> a -> b
$ Row SQLite DbReservation
dbReservationY Row SQLite DbReservation
-> Selector DbReservation DbReservationStatus
-> Col SQLite DbReservationStatus
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbReservation DbReservationStatus
#dbReservation_status Col SQLite DbReservationStatus
-> Col SQLite DbReservationStatus -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda../= DbReservationStatus -> Col SQLite DbReservationStatus
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal DbReservationStatus
MkDbReservationStatus_cancelled
      Col SQLite Bool -> Query SQLite ()
forall s t. Same s t => Col s Bool -> Query t ()
Selda.restrict (Col SQLite Bool -> Query SQLite ())
-> Col SQLite Bool -> Query SQLite ()
forall a b. (a -> b) -> a -> b
$ Row SQLite DbReservation
dbReservationX Row SQLite DbReservation
-> Selector DbReservation (ID DbReservation)
-> Col SQLite (ID DbReservation)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbReservation (ID DbReservation)
#dbReservation_id Col SQLite (ID DbReservation)
-> Col SQLite (ID DbReservation) -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda../= Row SQLite DbReservation
dbReservationY Row SQLite DbReservation
-> Selector DbReservation (ID DbReservation)
-> Col SQLite (ID DbReservation)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbReservation (ID DbReservation)
#dbReservation_id
      Col SQLite Bool -> Query SQLite ()
forall s t. Same s t => Col s Bool -> Query t ()
Selda.restrict (Col SQLite Bool -> Query SQLite ())
-> Col SQLite Bool -> Query SQLite ()
forall a b. (a -> b) -> a -> b
$ Row SQLite DbReservation
dbReservationX Row SQLite DbReservation
-> Selector DbReservation (ID DbDesk) -> Col SQLite (ID DbDesk)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbReservation (ID DbDesk)
#dbReservation_desk Col SQLite (ID DbDesk) -> Col SQLite (ID DbDesk) -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda..== Row SQLite DbReservation
dbReservationY Row SQLite DbReservation
-> Selector DbReservation (ID DbDesk) -> Col SQLite (ID DbDesk)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbReservation (ID DbDesk)
#dbReservation_desk
      Col SQLite Bool -> Query SQLite ()
forall s t. Same s t => Col s Bool -> Query t ()
Selda.restrict (Col SQLite Bool -> Query SQLite ())
-> Col SQLite Bool -> Query SQLite ()
forall a b. (a -> b) -> a -> b
$ Row SQLite DbReservation
dbReservationX Row SQLite DbReservation
-> Selector DbReservation UTCTime -> Col SQLite UTCTime
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbReservation UTCTime
#dbReservation_time_begin Col SQLite UTCTime -> Col SQLite UTCTime -> Col SQLite Bool
forall s t a.
(Same s t, SqlOrd a) =>
Col s a -> Col t a -> Col s Bool
Selda..< Row SQLite DbReservation
dbReservationY Row SQLite DbReservation
-> Selector DbReservation UTCTime -> Col SQLite UTCTime
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbReservation UTCTime
#dbReservation_time_end
      Col SQLite Bool -> Query SQLite ()
forall s t. Same s t => Col s Bool -> Query t ()
Selda.restrict (Col SQLite Bool -> Query SQLite ())
-> Col SQLite Bool -> Query SQLite ()
forall a b. (a -> b) -> a -> b
$ Row SQLite DbReservation
dbReservationX Row SQLite DbReservation
-> Selector DbReservation UTCTime -> Col SQLite UTCTime
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbReservation UTCTime
#dbReservation_time_end Col SQLite UTCTime -> Col SQLite UTCTime -> Col SQLite Bool
forall s t a.
(Same s t, SqlOrd a) =>
Col s a -> Col t a -> Col s Bool
Selda..> Row SQLite DbReservation
dbReservationY Row SQLite DbReservation
-> Selector DbReservation UTCTime -> Col SQLite UTCTime
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbReservation UTCTime
#dbReservation_time_begin
      Row SQLite DbReservation -> Query SQLite (Row SQLite DbReservation)
forall a. a -> Query SQLite a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Row SQLite DbReservation
dbReservationX
    case [DbReservation]
reservationsOverlapping of
      [] -> m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"No overlapping reservations found."
      DbReservation
_ : [DbReservation]
_ -> m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"There are overlapping reservations: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack ([DbReservation] -> String
forall a. Show a => a -> String
show [DbReservation]
reservationsOverlapping)

  do
    m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Checking that setting a password coincides with the `joinable_with_password` accessibility."
    do
      [DbRole]
dbRolesJoinableWithPasswordButPasswordNull <- Query (Backend (SeldaTransactionT m)) (Row SQLite DbRole)
-> SeldaTransactionT m [Res (Row SQLite DbRole)]
forall (m :: * -> *) a.
(MonadSelda m, Result a) =>
Query (Backend m) a -> m [Res a]
Selda.query (Query (Backend (SeldaTransactionT m)) (Row SQLite DbRole)
 -> SeldaTransactionT m [Res (Row SQLite DbRole)])
-> Query (Backend (SeldaTransactionT m)) (Row SQLite DbRole)
-> SeldaTransactionT m [Res (Row SQLite DbRole)]
forall a b. (a -> b) -> a -> b
$ do
        Row SQLite DbRole
dbRole <- Table DbRole -> Query SQLite (Row SQLite DbRole)
forall a s. Relational a => Table a -> Query s (Row s a)
Selda.select Table DbRole
tableRole
        Col SQLite Bool -> Query SQLite ()
forall s t. Same s t => Col s Bool -> Query t ()
Selda.restrict (Col SQLite Bool -> Query SQLite ())
-> Col SQLite Bool -> Query SQLite ()
forall a b. (a -> b) -> a -> b
$ Row SQLite DbRole
dbRole Row SQLite DbRole
-> Selector DbRole DbRoleAccessibility
-> Col SQLite DbRoleAccessibility
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbRole DbRoleAccessibility
#dbRole_accessibility Col SQLite DbRoleAccessibility
-> Col SQLite DbRoleAccessibility -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda..== DbRoleAccessibility -> Col SQLite DbRoleAccessibility
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal DbRoleAccessibility
MkDbRoleAccessibility_joinable_with_password
        Col SQLite Bool -> Query SQLite ()
forall s t. Same s t => Col s Bool -> Query t ()
Selda.restrict (Col SQLite Bool -> Query SQLite ())
-> Col SQLite Bool -> Query SQLite ()
forall a b. (a -> b) -> a -> b
$ Col SQLite (Maybe Text) -> Col SQLite Bool
forall a s. SqlType a => Col s (Maybe a) -> Col s Bool
Selda.isNull (Col SQLite (Maybe Text) -> Col SQLite Bool)
-> Col SQLite (Maybe Text) -> Col SQLite Bool
forall a b. (a -> b) -> a -> b
$ Row SQLite DbRole
dbRole Row SQLite DbRole
-> Selector DbRole (Maybe Text) -> Col SQLite (Maybe Text)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbRole (Maybe Text)
#dbRole_password_hash
        Row SQLite DbRole -> Query SQLite (Row SQLite DbRole)
forall a. a -> Query SQLite a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Row SQLite DbRole
dbRole
      case [DbRole]
dbRolesJoinableWithPasswordButPasswordNull of
        [] -> m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"No roles with missing passwords found."
        DbRole
_ : [DbRole]
_ -> m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"There are missing passwords in roles: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack ([DbRole] -> String
forall a. Show a => a -> String
show [DbRole]
dbRolesJoinableWithPasswordButPasswordNull)
    do
      [DbRole]
dbRolesNotJoinableWithPasswordButPasswordNotNull <- Query (Backend (SeldaTransactionT m)) (Row SQLite DbRole)
-> SeldaTransactionT m [Res (Row SQLite DbRole)]
forall (m :: * -> *) a.
(MonadSelda m, Result a) =>
Query (Backend m) a -> m [Res a]
Selda.query (Query (Backend (SeldaTransactionT m)) (Row SQLite DbRole)
 -> SeldaTransactionT m [Res (Row SQLite DbRole)])
-> Query (Backend (SeldaTransactionT m)) (Row SQLite DbRole)
-> SeldaTransactionT m [Res (Row SQLite DbRole)]
forall a b. (a -> b) -> a -> b
$ do
        Row SQLite DbRole
dbRole <- Table DbRole -> Query SQLite (Row SQLite DbRole)
forall a s. Relational a => Table a -> Query s (Row s a)
Selda.select Table DbRole
tableRole
        Col SQLite Bool -> Query SQLite ()
forall s t. Same s t => Col s Bool -> Query t ()
Selda.restrict (Col SQLite Bool -> Query SQLite ())
-> Col SQLite Bool -> Query SQLite ()
forall a b. (a -> b) -> a -> b
$ Row SQLite DbRole
dbRole Row SQLite DbRole
-> Selector DbRole DbRoleAccessibility
-> Col SQLite DbRoleAccessibility
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbRole DbRoleAccessibility
#dbRole_accessibility Col SQLite DbRoleAccessibility
-> Col SQLite DbRoleAccessibility -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda../= DbRoleAccessibility -> Col SQLite DbRoleAccessibility
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal DbRoleAccessibility
MkDbRoleAccessibility_joinable_with_password
        Col SQLite Bool -> Query SQLite ()
forall s t. Same s t => Col s Bool -> Query t ()
Selda.restrict (Col SQLite Bool -> Query SQLite ())
-> Col SQLite Bool -> Query SQLite ()
forall a b. (a -> b) -> a -> b
$ Col SQLite Bool -> Col SQLite Bool
forall s. Col s Bool -> Col s Bool
Selda.not_ (Col SQLite Bool -> Col SQLite Bool)
-> Col SQLite Bool -> Col SQLite Bool
forall a b. (a -> b) -> a -> b
$ Col SQLite (Maybe Text) -> Col SQLite Bool
forall a s. SqlType a => Col s (Maybe a) -> Col s Bool
Selda.isNull (Col SQLite (Maybe Text) -> Col SQLite Bool)
-> Col SQLite (Maybe Text) -> Col SQLite Bool
forall a b. (a -> b) -> a -> b
$ Row SQLite DbRole
dbRole Row SQLite DbRole
-> Selector DbRole (Maybe Text) -> Col SQLite (Maybe Text)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbRole (Maybe Text)
#dbRole_password_hash
        Row SQLite DbRole -> Query SQLite (Row SQLite DbRole)
forall a. a -> Query SQLite a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Row SQLite DbRole
dbRole
      case [DbRole]
dbRolesNotJoinableWithPasswordButPasswordNotNull of
        [] -> m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"No roles with passwords and unexpected accessibility found."
        DbRole
_ : [DbRole]
_ -> m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"There are unexpected accessibilities in roles: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack ([DbRole] -> String
forall a. Show a => a -> String
show [DbRole]
dbRolesNotJoinableWithPasswordButPasswordNotNull)

  do
    m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Checking that the roles used for `space_user`s actually belong to the right space."
    [DbSpaceUser :*: Res (Row SQLite DbRole)]
dbSpaceUsersWithWrongRoles <- Query
  (Backend (SeldaTransactionT m))
  (Row SQLite DbSpaceUser :*: Row SQLite DbRole)
-> SeldaTransactionT
     m [Res (Row SQLite DbSpaceUser :*: Row SQLite DbRole)]
forall (m :: * -> *) a.
(MonadSelda m, Result a) =>
Query (Backend m) a -> m [Res a]
Selda.query (Query
   (Backend (SeldaTransactionT m))
   (Row SQLite DbSpaceUser :*: Row SQLite DbRole)
 -> SeldaTransactionT
      m [Res (Row SQLite DbSpaceUser :*: Row SQLite DbRole)])
-> Query
     (Backend (SeldaTransactionT m))
     (Row SQLite DbSpaceUser :*: Row SQLite DbRole)
-> SeldaTransactionT
     m [Res (Row SQLite DbSpaceUser :*: Row SQLite DbRole)]
forall a b. (a -> b) -> a -> b
$ do
      Row SQLite DbSpaceUser
dbSpaceUser <- Table DbSpaceUser -> Query SQLite (Row SQLite DbSpaceUser)
forall a s. Relational a => Table a -> Query s (Row s a)
Selda.select Table DbSpaceUser
tableSpaceUser
      Row SQLite DbRole
dbRole <-
        (OuterCols (Row (Inner SQLite) DbRole) -> Col SQLite Bool)
-> Query (Inner SQLite) (Row (Inner SQLite) DbRole)
-> Query SQLite (OuterCols (Row (Inner SQLite) DbRole))
forall a s.
(Columns a, Columns (OuterCols a)) =>
(OuterCols a -> Col s Bool)
-> Query (Inner s) a -> Query s (OuterCols a)
Selda.innerJoin
          ( \OuterCols (Row (Inner SQLite) DbRole)
dbRole ->
              Row SQLite DbRole
OuterCols (Row (Inner SQLite) DbRole)
dbRole Row SQLite DbRole
-> Selector DbRole (ID DbRole) -> Col SQLite (ID DbRole)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbRole (ID DbRole)
#dbRole_id Col SQLite (ID DbRole) -> Col SQLite (ID DbRole) -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda..== Row SQLite DbSpaceUser
dbSpaceUser Row SQLite DbSpaceUser
-> Selector DbSpaceUser (ID DbRole) -> Col SQLite (ID DbRole)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbSpaceUser (ID DbRole)
#dbSpaceUser_role
                Col SQLite Bool -> Col SQLite Bool -> Col SQLite Bool
forall s t. Same s t => Col s Bool -> Col t Bool -> Col s Bool
Selda..&& Row SQLite DbRole
OuterCols (Row (Inner SQLite) DbRole)
dbRole Row SQLite DbRole
-> Selector DbRole (ID DbSpace) -> Col SQLite (ID DbSpace)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbRole (ID DbSpace)
#dbRole_space Col SQLite (ID DbSpace)
-> Col SQLite (ID DbSpace) -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda../= Row SQLite DbSpaceUser
dbSpaceUser Row SQLite DbSpaceUser
-> Selector DbSpaceUser (ID DbSpace) -> Col SQLite (ID DbSpace)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbSpaceUser (ID DbSpace)
#dbSpaceUser_space
          )
          (Table DbRole -> Query (Inner SQLite) (Row (Inner SQLite) DbRole)
forall a s. Relational a => Table a -> Query s (Row s a)
Selda.select Table DbRole
tableRole)
      (Row SQLite DbSpaceUser :*: Row SQLite DbRole)
-> Query SQLite (Row SQLite DbSpaceUser :*: Row SQLite DbRole)
forall a. a -> Query SQLite a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Row SQLite DbSpaceUser
dbSpaceUser Row SQLite DbSpaceUser
-> Row SQLite DbRole
-> Row SQLite DbSpaceUser :*: Row SQLite DbRole
forall a b. a -> b -> a :*: b
Selda.:*: Row SQLite DbRole
dbRole)
    case [DbSpaceUser :*: Res (Row SQLite DbRole)]
dbSpaceUsersWithWrongRoles of
      [] -> m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"No users have roles from other spaces."
      DbSpaceUser :*: Res (Row SQLite DbRole)
_ : [DbSpaceUser :*: Res (Row SQLite DbRole)]
_ -> m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"There are unexpected role/space combinations in space users: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack ([DbSpaceUser :*: Res (Row SQLite DbRole)] -> String
forall a. Show a => a -> String
show [DbSpaceUser :*: Res (Row SQLite DbRole)]
dbSpaceUsersWithWrongRoles)

  do
    m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Checking that desk locations cover all parameters (position, direction and size)"
    [DbDesk]
dbDesksWithBrokenLocations <- Query (Backend (SeldaTransactionT m)) (Row SQLite DbDesk)
-> SeldaTransactionT m [Res (Row SQLite DbDesk)]
forall (m :: * -> *) a.
(MonadSelda m, Result a) =>
Query (Backend m) a -> m [Res a]
Selda.query (Query (Backend (SeldaTransactionT m)) (Row SQLite DbDesk)
 -> SeldaTransactionT m [Res (Row SQLite DbDesk)])
-> Query (Backend (SeldaTransactionT m)) (Row SQLite DbDesk)
-> SeldaTransactionT m [Res (Row SQLite DbDesk)]
forall a b. (a -> b) -> a -> b
$ do
      Row SQLite DbDesk
dbDesk <- Table DbDesk -> Query SQLite (Row SQLite DbDesk)
forall a s. Relational a => Table a -> Query s (Row s a)
Selda.select Table DbDesk
tableDesk
      Col SQLite (Maybe (ID DbDesk))
dbDeskIdJoined <-
        (OuterCols (Col (Inner SQLite) (ID DbDesk)) -> Col SQLite Bool)
-> Query (Inner SQLite) (Col (Inner SQLite) (ID DbDesk))
-> Query SQLite (LeftCols (Col (Inner SQLite) (ID DbDesk)))
forall a s.
(Columns a, Columns (OuterCols a), Columns (LeftCols a)) =>
(OuterCols a -> Col s Bool)
-> Query (Inner s) a -> Query s (LeftCols a)
Selda.leftJoin
          ( \OuterCols (Col (Inner SQLite) (ID DbDesk))
dbDeskWithOrWithoutLocationId ->
              Row SQLite DbDesk
dbDesk Row SQLite DbDesk
-> Selector DbDesk (ID DbDesk) -> Col SQLite (ID DbDesk)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbDesk (ID DbDesk)
#dbDesk_id Col SQLite (ID DbDesk) -> Col SQLite (ID DbDesk) -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda..== Col SQLite (ID DbDesk)
OuterCols (Col (Inner SQLite) (ID DbDesk))
dbDeskWithOrWithoutLocationId
          )
          ( do
              Row (Inner SQLite) DbDesk
dbDeskWithOrWithoutLocation <- Table DbDesk -> Query (Inner SQLite) (Row (Inner SQLite) DbDesk)
forall a s. Relational a => Table a -> Query s (Row s a)
Selda.select Table DbDesk
tableDesk
              Col (Inner SQLite) Bool -> Query (Inner SQLite) ()
forall s t. Same s t => Col s Bool -> Query t ()
Selda.restrict (Col (Inner SQLite) Bool -> Query (Inner SQLite) ())
-> Col (Inner SQLite) Bool -> Query (Inner SQLite) ()
forall a b. (a -> b) -> a -> b
$
                ( Col (Inner SQLite) (Maybe Double) -> Col (Inner SQLite) Bool
forall a s. SqlType a => Col s (Maybe a) -> Col s Bool
Selda.isNull (Row (Inner SQLite) DbDesk
dbDeskWithOrWithoutLocation Row (Inner SQLite) DbDesk
-> Selector DbDesk (Maybe Double)
-> Col (Inner SQLite) (Maybe Double)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbDesk (Maybe Double)
#dbDesk_position_x)
                    Col (Inner SQLite) Bool
-> Col (Inner SQLite) Bool -> Col (Inner SQLite) Bool
forall s t. Same s t => Col s Bool -> Col t Bool -> Col s Bool
Selda..&& Col (Inner SQLite) (Maybe Double) -> Col (Inner SQLite) Bool
forall a s. SqlType a => Col s (Maybe a) -> Col s Bool
Selda.isNull (Row (Inner SQLite) DbDesk
dbDeskWithOrWithoutLocation Row (Inner SQLite) DbDesk
-> Selector DbDesk (Maybe Double)
-> Col (Inner SQLite) (Maybe Double)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbDesk (Maybe Double)
#dbDesk_position_y)
                    Col (Inner SQLite) Bool
-> Col (Inner SQLite) Bool -> Col (Inner SQLite) Bool
forall s t. Same s t => Col s Bool -> Col t Bool -> Col s Bool
Selda..&& Col (Inner SQLite) (Maybe Double) -> Col (Inner SQLite) Bool
forall a s. SqlType a => Col s (Maybe a) -> Col s Bool
Selda.isNull (Row (Inner SQLite) DbDesk
dbDeskWithOrWithoutLocation Row (Inner SQLite) DbDesk
-> Selector DbDesk (Maybe Double)
-> Col (Inner SQLite) (Maybe Double)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbDesk (Maybe Double)
#dbDesk_direction)
                    Col (Inner SQLite) Bool
-> Col (Inner SQLite) Bool -> Col (Inner SQLite) Bool
forall s t. Same s t => Col s Bool -> Col t Bool -> Col s Bool
Selda..&& Col (Inner SQLite) (Maybe Double) -> Col (Inner SQLite) Bool
forall a s. SqlType a => Col s (Maybe a) -> Col s Bool
Selda.isNull (Row (Inner SQLite) DbDesk
dbDeskWithOrWithoutLocation Row (Inner SQLite) DbDesk
-> Selector DbDesk (Maybe Double)
-> Col (Inner SQLite) (Maybe Double)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbDesk (Maybe Double)
#dbDesk_size_width)
                    Col (Inner SQLite) Bool
-> Col (Inner SQLite) Bool -> Col (Inner SQLite) Bool
forall s t. Same s t => Col s Bool -> Col t Bool -> Col s Bool
Selda..&& Col (Inner SQLite) (Maybe Double) -> Col (Inner SQLite) Bool
forall a s. SqlType a => Col s (Maybe a) -> Col s Bool
Selda.isNull (Row (Inner SQLite) DbDesk
dbDeskWithOrWithoutLocation Row (Inner SQLite) DbDesk
-> Selector DbDesk (Maybe Double)
-> Col (Inner SQLite) (Maybe Double)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbDesk (Maybe Double)
#dbDesk_size_depth)
                )
                  Col (Inner SQLite) Bool
-> Col (Inner SQLite) Bool -> Col (Inner SQLite) Bool
forall s t. Same s t => Col s Bool -> Col t Bool -> Col s Bool
Selda..|| ( Col (Inner SQLite) Bool -> Col (Inner SQLite) Bool
forall s. Col s Bool -> Col s Bool
Selda.not_ (Col (Inner SQLite) (Maybe Double) -> Col (Inner SQLite) Bool
forall a s. SqlType a => Col s (Maybe a) -> Col s Bool
Selda.isNull (Row (Inner SQLite) DbDesk
dbDeskWithOrWithoutLocation Row (Inner SQLite) DbDesk
-> Selector DbDesk (Maybe Double)
-> Col (Inner SQLite) (Maybe Double)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbDesk (Maybe Double)
#dbDesk_position_x))
                                Col (Inner SQLite) Bool
-> Col (Inner SQLite) Bool -> Col (Inner SQLite) Bool
forall s t. Same s t => Col s Bool -> Col t Bool -> Col s Bool
Selda..&& Col (Inner SQLite) Bool -> Col (Inner SQLite) Bool
forall s. Col s Bool -> Col s Bool
Selda.not_ (Col (Inner SQLite) (Maybe Double) -> Col (Inner SQLite) Bool
forall a s. SqlType a => Col s (Maybe a) -> Col s Bool
Selda.isNull (Row (Inner SQLite) DbDesk
dbDeskWithOrWithoutLocation Row (Inner SQLite) DbDesk
-> Selector DbDesk (Maybe Double)
-> Col (Inner SQLite) (Maybe Double)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbDesk (Maybe Double)
#dbDesk_position_y))
                                Col (Inner SQLite) Bool
-> Col (Inner SQLite) Bool -> Col (Inner SQLite) Bool
forall s t. Same s t => Col s Bool -> Col t Bool -> Col s Bool
Selda..&& Col (Inner SQLite) Bool -> Col (Inner SQLite) Bool
forall s. Col s Bool -> Col s Bool
Selda.not_ (Col (Inner SQLite) (Maybe Double) -> Col (Inner SQLite) Bool
forall a s. SqlType a => Col s (Maybe a) -> Col s Bool
Selda.isNull (Row (Inner SQLite) DbDesk
dbDeskWithOrWithoutLocation Row (Inner SQLite) DbDesk
-> Selector DbDesk (Maybe Double)
-> Col (Inner SQLite) (Maybe Double)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbDesk (Maybe Double)
#dbDesk_direction))
                                Col (Inner SQLite) Bool
-> Col (Inner SQLite) Bool -> Col (Inner SQLite) Bool
forall s t. Same s t => Col s Bool -> Col t Bool -> Col s Bool
Selda..&& Col (Inner SQLite) Bool -> Col (Inner SQLite) Bool
forall s. Col s Bool -> Col s Bool
Selda.not_ (Col (Inner SQLite) (Maybe Double) -> Col (Inner SQLite) Bool
forall a s. SqlType a => Col s (Maybe a) -> Col s Bool
Selda.isNull (Row (Inner SQLite) DbDesk
dbDeskWithOrWithoutLocation Row (Inner SQLite) DbDesk
-> Selector DbDesk (Maybe Double)
-> Col (Inner SQLite) (Maybe Double)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbDesk (Maybe Double)
#dbDesk_size_width))
                                Col (Inner SQLite) Bool
-> Col (Inner SQLite) Bool -> Col (Inner SQLite) Bool
forall s t. Same s t => Col s Bool -> Col t Bool -> Col s Bool
Selda..&& Col (Inner SQLite) Bool -> Col (Inner SQLite) Bool
forall s. Col s Bool -> Col s Bool
Selda.not_ (Col (Inner SQLite) (Maybe Double) -> Col (Inner SQLite) Bool
forall a s. SqlType a => Col s (Maybe a) -> Col s Bool
Selda.isNull (Row (Inner SQLite) DbDesk
dbDeskWithOrWithoutLocation Row (Inner SQLite) DbDesk
-> Selector DbDesk (Maybe Double)
-> Col (Inner SQLite) (Maybe Double)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbDesk (Maybe Double)
#dbDesk_size_depth))
                            )
              Col (Inner SQLite) (ID DbDesk)
-> Query (Inner SQLite) (Col (Inner SQLite) (ID DbDesk))
forall a. a -> Query (Inner SQLite) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Col (Inner SQLite) (ID DbDesk)
 -> Query (Inner SQLite) (Col (Inner SQLite) (ID DbDesk)))
-> Col (Inner SQLite) (ID DbDesk)
-> Query (Inner SQLite) (Col (Inner SQLite) (ID DbDesk))
forall a b. (a -> b) -> a -> b
$ Row (Inner SQLite) DbDesk
dbDeskWithOrWithoutLocation Row (Inner SQLite) DbDesk
-> Selector DbDesk (ID DbDesk) -> Col (Inner SQLite) (ID DbDesk)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbDesk (ID DbDesk)
#dbDesk_id
          )
      Col SQLite Bool -> Query SQLite ()
forall s t. Same s t => Col s Bool -> Query t ()
Selda.restrict (Col SQLite Bool -> Query SQLite ())
-> Col SQLite Bool -> Query SQLite ()
forall a b. (a -> b) -> a -> b
$ Col SQLite (Maybe (ID DbDesk)) -> Col SQLite Bool
forall a s. SqlType a => Col s (Maybe a) -> Col s Bool
Selda.isNull Col SQLite (Maybe (ID DbDesk))
dbDeskIdJoined
      Row SQLite DbDesk -> Query SQLite (Row SQLite DbDesk)
forall a. a -> Query SQLite a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Row SQLite DbDesk
dbDesk
    case [DbDesk]
dbDesksWithBrokenLocations of
      [] -> m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"No desks have broken locations."
      DbDesk
_ : [DbDesk]
_ -> m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"There are desks with broken locations: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack ([DbDesk] -> String
forall a. Show a => a -> String
show [DbDesk]
dbDesksWithBrokenLocations)

  () -> SeldaTransactionT m ()
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()