{-# LANGUAGE OverloadedLabels #-}

module Mensam.Server.Space where

import Mensam.API.Data.Desk
import Mensam.API.Data.Space
import Mensam.API.Data.Space.Permission
import Mensam.API.Data.User
import Mensam.API.Order
import Mensam.Server.Application.SeldaPool.Class
import Mensam.Server.Database.Extra qualified as Selda
import Mensam.Server.Database.Schema
import Mensam.Server.Database.Space

import Control.Monad
import Control.Monad.Catch
import Control.Monad.IO.Class
import Control.Monad.Logger.CallStack
import Control.Monad.Trans.Class
import Data.ByteString.Lazy qualified as BL
import Data.Foldable
import Data.Kind
import Data.List qualified as L
import Data.Maybe
import Data.Password.Bcrypt
import Data.Set qualified as S
import Data.Singletons
import Data.Text qualified as T
import Data.Time.Zones.All qualified as T
import Data.Typeable
import Database.Selda qualified as Selda
import GHC.Generics
import Mensam.Server.Jpeg
import Numeric.Natural

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

checkPermission ::
  (MonadLogger m, MonadSeldaPool m, Typeable p) =>
  SPermission p ->
  IdentifierUser ->
  IdentifierSpace ->
  SeldaTransactionT m ()
checkPermission :: forall (m :: * -> *) (p :: Permission).
(MonadLogger m, MonadSeldaPool m, Typeable p) =>
SPermission p
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
checkPermission SPermission p
sPermission IdentifierUser
userIdentifier IdentifierSpace
spaceIdentifier = do
  let permission :: Demote Permission
permission = Sing p -> Demote Permission
forall k (a :: k). SingKind k => Sing a -> Demote k
forall (a :: Permission). Sing a -> Demote Permission
fromSing Sing p
SPermission p
sPermission
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Checking permission " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Permission -> String
forall a. Show a => a -> String
show Demote Permission
Permission
permission) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" for user " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierUser -> String
forall a. Show a => a -> String
show IdentifierUser
userIdentifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in space " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierSpace -> String
forall a. Show a => a -> String
show IdentifierSpace
spaceIdentifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
  Bool
isOwner <- IdentifierSpace -> IdentifierUser -> SeldaTransactionT m Bool
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> IdentifierUser -> SeldaTransactionT m Bool
spaceUserIsOwner IdentifierSpace
spaceIdentifier IdentifierUser
userIdentifier
  if Bool
isOwner
    then 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
"User is owner. Permission granted."
    else do
      Set Permission
permissions <- IdentifierSpace
-> IdentifierUser -> SeldaTransactionT m (Set Permission)
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace
-> IdentifierUser -> SeldaTransactionT m (Set Permission)
spaceUserPermissions IdentifierSpace
spaceIdentifier IdentifierUser
userIdentifier
      if Demote Permission
Permission
permission Permission -> Set Permission -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Permission
permissions
        then 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
"Permission satisfied."
        else do
          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Permission was not satisfied."
          case SPermission p
sPermission of
            (SPermission p
_ :: SPermission permission) -> SqlErrorMensamPermissionNotSatisfied p -> SeldaTransactionT m ()
forall e a.
(HasCallStack, Exception e) =>
e -> SeldaTransactionT m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (SqlErrorMensamPermissionNotSatisfied p -> SeldaTransactionT m ())
-> SqlErrorMensamPermissionNotSatisfied p -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ forall (permission :: Permission).
SqlErrorMensamPermissionNotSatisfied permission
MkSqlErrorMensamPermissionNotSatisfied @permission

spaceLookupId ::
  (MonadLogger m, MonadSeldaPool m) =>
  NameSpace ->
  SeldaTransactionT m IdentifierSpace
spaceLookupId :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
NameSpace -> SeldaTransactionT m IdentifierSpace
spaceLookupId NameSpace
name = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Looking up space identifier with name: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (NameSpace -> String
forall a. Show a => a -> String
show NameSpace
name)
  DbSpace
dbSpace <- SeldaTransactionT m DbSpace
-> (SqlErrorMensamNotOneQuery -> SeldaTransactionT m DbSpace)
-> SeldaTransactionT m DbSpace
forall e a.
(HasCallStack, Exception e) =>
SeldaTransactionT m a
-> (e -> SeldaTransactionT m a) -> SeldaTransactionT m a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch (Query (Backend (SeldaTransactionT m)) (Row SQLite DbSpace)
-> SeldaTransactionT m (Res (Row SQLite DbSpace))
forall (m :: * -> *) a.
(MonadSelda m, MonadCatch m, Result a) =>
Query (Backend m) a -> m (Res a)
Selda.queryOne (Query (Backend (SeldaTransactionT m)) (Row SQLite DbSpace)
 -> SeldaTransactionT m (Res (Row SQLite DbSpace)))
-> Query (Backend (SeldaTransactionT m)) (Row SQLite DbSpace)
-> SeldaTransactionT m (Res (Row SQLite DbSpace))
forall a b. (a -> b) -> a -> b
$ Text
-> Query
     (Backend (SeldaTransactionT m))
     (Row (Backend (SeldaTransactionT m)) DbSpace)
forall backend. Text -> Query backend (Row backend DbSpace)
spaceLookup (Text
 -> Query
      (Backend (SeldaTransactionT m))
      (Row (Backend (SeldaTransactionT m)) DbSpace))
-> Text
-> Query
     (Backend (SeldaTransactionT m))
     (Row (Backend (SeldaTransactionT m)) DbSpace)
forall a b. (a -> b) -> a -> b
$ NameSpace -> Text
unNameSpace NameSpace
name) ((SqlErrorMensamNotOneQuery -> SeldaTransactionT m DbSpace)
 -> SeldaTransactionT m DbSpace)
-> (SqlErrorMensamNotOneQuery -> SeldaTransactionT m DbSpace)
-> SeldaTransactionT m DbSpace
forall a b. (a -> b) -> a -> b
$
    \case SqlErrorMensamNotOneQuery
exc -> SqlErrorMensamSpaceNotFound -> SeldaTransactionT m DbSpace
forall e a.
(HasCallStack, Exception e) =>
e -> SeldaTransactionT m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (SqlErrorMensamSpaceNotFound -> SeldaTransactionT m DbSpace)
-> SqlErrorMensamSpaceNotFound -> SeldaTransactionT m DbSpace
forall a b. (a -> b) -> a -> b
$ SqlErrorMensamNotOneQuery -> SqlErrorMensamSpaceNotFound
MkSqlErrorMensamSpaceNotFound SqlErrorMensamNotOneQuery
exc
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Looked up space successfully."
  IdentifierSpace -> SeldaTransactionT m IdentifierSpace
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IdentifierSpace -> SeldaTransactionT m IdentifierSpace)
-> IdentifierSpace -> SeldaTransactionT m IdentifierSpace
forall a b. (a -> b) -> a -> b
$ Int64 -> IdentifierSpace
MkIdentifierSpace (Int64 -> IdentifierSpace) -> Int64 -> IdentifierSpace
forall a b. (a -> b) -> a -> b
$ forall a. ID a -> Int64
Selda.fromId @DbSpace (ID DbSpace -> Int64) -> ID DbSpace -> Int64
forall a b. (a -> b) -> a -> b
$ DbSpace -> ID DbSpace
dbSpace_id DbSpace
dbSpace

spaceGetFromId ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierSpace ->
  SeldaTransactionT m Space
spaceGetFromId :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> SeldaTransactionT m Space
spaceGetFromId IdentifierSpace
identifier = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Get space info with identifier: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierSpace -> String
forall a. Show a => a -> String
show IdentifierSpace
identifier)
  DbSpace
dbSpace <- SeldaTransactionT m DbSpace
-> (SqlErrorMensamNotOneQuery -> SeldaTransactionT m DbSpace)
-> SeldaTransactionT m DbSpace
forall e a.
(HasCallStack, Exception e) =>
SeldaTransactionT m a
-> (e -> SeldaTransactionT m a) -> SeldaTransactionT m a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch (Query (Backend (SeldaTransactionT m)) (Row SQLite DbSpace)
-> SeldaTransactionT m (Res (Row SQLite DbSpace))
forall (m :: * -> *) a.
(MonadSelda m, MonadCatch m, Result a) =>
Query (Backend m) a -> m (Res a)
Selda.queryOne (Query (Backend (SeldaTransactionT m)) (Row SQLite DbSpace)
 -> SeldaTransactionT m (Res (Row SQLite DbSpace)))
-> Query (Backend (SeldaTransactionT m)) (Row SQLite DbSpace)
-> SeldaTransactionT m (Res (Row SQLite DbSpace))
forall a b. (a -> b) -> a -> b
$ ID DbSpace
-> Query
     (Backend (SeldaTransactionT m))
     (Row (Backend (SeldaTransactionT m)) DbSpace)
forall backend. ID DbSpace -> Query backend (Row backend DbSpace)
spaceGet (ID DbSpace
 -> Query
      (Backend (SeldaTransactionT m))
      (Row (Backend (SeldaTransactionT m)) DbSpace))
-> ID DbSpace
-> Query
     (Backend (SeldaTransactionT m))
     (Row (Backend (SeldaTransactionT m)) DbSpace)
forall a b. (a -> b) -> a -> b
$ forall a. Int64 -> ID a
Selda.toId @DbSpace (Int64 -> ID DbSpace) -> Int64 -> ID DbSpace
forall a b. (a -> b) -> a -> b
$ IdentifierSpace -> Int64
unIdentifierSpace IdentifierSpace
identifier) ((SqlErrorMensamNotOneQuery -> SeldaTransactionT m DbSpace)
 -> SeldaTransactionT m DbSpace)
-> (SqlErrorMensamNotOneQuery -> SeldaTransactionT m DbSpace)
-> SeldaTransactionT m DbSpace
forall a b. (a -> b) -> a -> b
$
    \case SqlErrorMensamNotOneQuery
exc -> SqlErrorMensamSpaceNotFound -> SeldaTransactionT m DbSpace
forall e a.
(HasCallStack, Exception e) =>
e -> SeldaTransactionT m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (SqlErrorMensamSpaceNotFound -> SeldaTransactionT m DbSpace)
-> SqlErrorMensamSpaceNotFound -> SeldaTransactionT m DbSpace
forall a b. (a -> b) -> a -> b
$ SqlErrorMensamNotOneQuery -> SqlErrorMensamSpaceNotFound
MkSqlErrorMensamSpaceNotFound SqlErrorMensamNotOneQuery
exc
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Got space info successfully."
  Space -> SeldaTransactionT m Space
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    MkSpace
      { spaceId :: IdentifierSpace
spaceId = Int64 -> IdentifierSpace
MkIdentifierSpace (Int64 -> IdentifierSpace) -> Int64 -> IdentifierSpace
forall a b. (a -> b) -> a -> b
$ forall a. ID a -> Int64
Selda.fromId @DbSpace (ID DbSpace -> Int64) -> ID DbSpace -> Int64
forall a b. (a -> b) -> a -> b
$ DbSpace -> ID DbSpace
dbSpace_id DbSpace
dbSpace
      , spaceName :: NameSpace
spaceName = Text -> NameSpace
MkNameSpace (Text -> NameSpace) -> Text -> NameSpace
forall a b. (a -> b) -> a -> b
$ DbSpace -> Text
dbSpace_name DbSpace
dbSpace
      , spaceTimezone :: TZLabel
spaceTimezone = DbSpace -> TZLabel
dbSpace_timezone DbSpace
dbSpace
      , spaceOwner :: IdentifierUser
spaceOwner = Int64 -> IdentifierUser
MkIdentifierUser (Int64 -> IdentifierUser) -> Int64 -> IdentifierUser
forall a b. (a -> b) -> a -> b
$ forall a. ID a -> Int64
Selda.fromId @DbUser (ID DbUser -> Int64) -> ID DbUser -> Int64
forall a b. (a -> b) -> a -> b
$ DbSpace -> ID DbUser
dbSpace_owner DbSpace
dbSpace
      }

spaceInternalGetFromId ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierSpace ->
  SeldaTransactionT m SpaceInternal
spaceInternalGetFromId :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> SeldaTransactionT m SpaceInternal
spaceInternalGetFromId IdentifierSpace
identifier = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Get space info with identifier: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierSpace -> String
forall a. Show a => a -> String
show IdentifierSpace
identifier)
  DbSpace
dbSpace <- SeldaTransactionT m DbSpace
-> (SqlErrorMensamNotOneQuery -> SeldaTransactionT m DbSpace)
-> SeldaTransactionT m DbSpace
forall e a.
(HasCallStack, Exception e) =>
SeldaTransactionT m a
-> (e -> SeldaTransactionT m a) -> SeldaTransactionT m a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch (Query (Backend (SeldaTransactionT m)) (Row SQLite DbSpace)
-> SeldaTransactionT m (Res (Row SQLite DbSpace))
forall (m :: * -> *) a.
(MonadSelda m, MonadCatch m, Result a) =>
Query (Backend m) a -> m (Res a)
Selda.queryOne (Query (Backend (SeldaTransactionT m)) (Row SQLite DbSpace)
 -> SeldaTransactionT m (Res (Row SQLite DbSpace)))
-> Query (Backend (SeldaTransactionT m)) (Row SQLite DbSpace)
-> SeldaTransactionT m (Res (Row SQLite DbSpace))
forall a b. (a -> b) -> a -> b
$ ID DbSpace
-> Query
     (Backend (SeldaTransactionT m))
     (Row (Backend (SeldaTransactionT m)) DbSpace)
forall backend. ID DbSpace -> Query backend (Row backend DbSpace)
spaceGet (ID DbSpace
 -> Query
      (Backend (SeldaTransactionT m))
      (Row (Backend (SeldaTransactionT m)) DbSpace))
-> ID DbSpace
-> Query
     (Backend (SeldaTransactionT m))
     (Row (Backend (SeldaTransactionT m)) DbSpace)
forall a b. (a -> b) -> a -> b
$ forall a. Int64 -> ID a
Selda.toId @DbSpace (Int64 -> ID DbSpace) -> Int64 -> ID DbSpace
forall a b. (a -> b) -> a -> b
$ IdentifierSpace -> Int64
unIdentifierSpace IdentifierSpace
identifier) ((SqlErrorMensamNotOneQuery -> SeldaTransactionT m DbSpace)
 -> SeldaTransactionT m DbSpace)
-> (SqlErrorMensamNotOneQuery -> SeldaTransactionT m DbSpace)
-> SeldaTransactionT m DbSpace
forall a b. (a -> b) -> a -> b
$
    \case SqlErrorMensamNotOneQuery
exc -> SqlErrorMensamSpaceNotFound -> SeldaTransactionT m DbSpace
forall e a.
(HasCallStack, Exception e) =>
e -> SeldaTransactionT m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (SqlErrorMensamSpaceNotFound -> SeldaTransactionT m DbSpace)
-> SqlErrorMensamSpaceNotFound -> SeldaTransactionT m DbSpace
forall a b. (a -> b) -> a -> b
$ SqlErrorMensamNotOneQuery -> SqlErrorMensamSpaceNotFound
MkSqlErrorMensamSpaceNotFound SqlErrorMensamNotOneQuery
exc
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Got space info successfully."
  SpaceInternal -> SeldaTransactionT m SpaceInternal
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    MkSpaceInternal
      { spaceInternalId :: IdentifierSpace
spaceInternalId = Int64 -> IdentifierSpace
MkIdentifierSpace (Int64 -> IdentifierSpace) -> Int64 -> IdentifierSpace
forall a b. (a -> b) -> a -> b
$ forall a. ID a -> Int64
Selda.fromId @DbSpace (ID DbSpace -> Int64) -> ID DbSpace -> Int64
forall a b. (a -> b) -> a -> b
$ DbSpace -> ID DbSpace
dbSpace_id DbSpace
dbSpace
      , spaceInternalName :: NameSpace
spaceInternalName = Text -> NameSpace
MkNameSpace (Text -> NameSpace) -> Text -> NameSpace
forall a b. (a -> b) -> a -> b
$ DbSpace -> Text
dbSpace_name DbSpace
dbSpace
      , spaceInternalTimezone :: TZLabel
spaceInternalTimezone = DbSpace -> TZLabel
dbSpace_timezone DbSpace
dbSpace
      , spaceInternalVisibility :: VisibilitySpace
spaceInternalVisibility = DbSpaceVisibility -> VisibilitySpace
spaceVisibilityDbToApi (DbSpaceVisibility -> VisibilitySpace)
-> DbSpaceVisibility -> VisibilitySpace
forall a b. (a -> b) -> a -> b
$ DbSpace -> DbSpaceVisibility
dbSpace_visibility DbSpace
dbSpace
      , spaceInternalOwner :: IdentifierUser
spaceInternalOwner = Int64 -> IdentifierUser
MkIdentifierUser (Int64 -> IdentifierUser) -> Int64 -> IdentifierUser
forall a b. (a -> b) -> a -> b
$ forall a. ID a -> Int64
Selda.fromId @DbUser (ID DbUser -> Int64) -> ID DbUser -> Int64
forall a b. (a -> b) -> a -> b
$ DbSpace -> ID DbUser
dbSpace_owner DbSpace
dbSpace
      }

type SpaceInternal :: Type
data SpaceInternal = MkSpaceInternal
  { SpaceInternal -> IdentifierSpace
spaceInternalId :: IdentifierSpace
  , SpaceInternal -> NameSpace
spaceInternalName :: NameSpace
  , SpaceInternal -> TZLabel
spaceInternalTimezone :: T.TZLabel
  , SpaceInternal -> VisibilitySpace
spaceInternalVisibility :: VisibilitySpace
  , SpaceInternal -> IdentifierUser
spaceInternalOwner :: IdentifierUser
  }
  deriving stock (SpaceInternal -> SpaceInternal -> Bool
(SpaceInternal -> SpaceInternal -> Bool)
-> (SpaceInternal -> SpaceInternal -> Bool) -> Eq SpaceInternal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpaceInternal -> SpaceInternal -> Bool
== :: SpaceInternal -> SpaceInternal -> Bool
$c/= :: SpaceInternal -> SpaceInternal -> Bool
/= :: SpaceInternal -> SpaceInternal -> Bool
Eq, (forall x. SpaceInternal -> Rep SpaceInternal x)
-> (forall x. Rep SpaceInternal x -> SpaceInternal)
-> Generic SpaceInternal
forall x. Rep SpaceInternal x -> SpaceInternal
forall x. SpaceInternal -> Rep SpaceInternal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SpaceInternal -> Rep SpaceInternal x
from :: forall x. SpaceInternal -> Rep SpaceInternal x
$cto :: forall x. Rep SpaceInternal x -> SpaceInternal
to :: forall x. Rep SpaceInternal x -> SpaceInternal
Generic, Eq SpaceInternal
Eq SpaceInternal =>
(SpaceInternal -> SpaceInternal -> Ordering)
-> (SpaceInternal -> SpaceInternal -> Bool)
-> (SpaceInternal -> SpaceInternal -> Bool)
-> (SpaceInternal -> SpaceInternal -> Bool)
-> (SpaceInternal -> SpaceInternal -> Bool)
-> (SpaceInternal -> SpaceInternal -> SpaceInternal)
-> (SpaceInternal -> SpaceInternal -> SpaceInternal)
-> Ord SpaceInternal
SpaceInternal -> SpaceInternal -> Bool
SpaceInternal -> SpaceInternal -> Ordering
SpaceInternal -> SpaceInternal -> SpaceInternal
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SpaceInternal -> SpaceInternal -> Ordering
compare :: SpaceInternal -> SpaceInternal -> Ordering
$c< :: SpaceInternal -> SpaceInternal -> Bool
< :: SpaceInternal -> SpaceInternal -> Bool
$c<= :: SpaceInternal -> SpaceInternal -> Bool
<= :: SpaceInternal -> SpaceInternal -> Bool
$c> :: SpaceInternal -> SpaceInternal -> Bool
> :: SpaceInternal -> SpaceInternal -> Bool
$c>= :: SpaceInternal -> SpaceInternal -> Bool
>= :: SpaceInternal -> SpaceInternal -> Bool
$cmax :: SpaceInternal -> SpaceInternal -> SpaceInternal
max :: SpaceInternal -> SpaceInternal -> SpaceInternal
$cmin :: SpaceInternal -> SpaceInternal -> SpaceInternal
min :: SpaceInternal -> SpaceInternal -> SpaceInternal
Ord, ReadPrec [SpaceInternal]
ReadPrec SpaceInternal
Int -> ReadS SpaceInternal
ReadS [SpaceInternal]
(Int -> ReadS SpaceInternal)
-> ReadS [SpaceInternal]
-> ReadPrec SpaceInternal
-> ReadPrec [SpaceInternal]
-> Read SpaceInternal
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SpaceInternal
readsPrec :: Int -> ReadS SpaceInternal
$creadList :: ReadS [SpaceInternal]
readList :: ReadS [SpaceInternal]
$creadPrec :: ReadPrec SpaceInternal
readPrec :: ReadPrec SpaceInternal
$creadListPrec :: ReadPrec [SpaceInternal]
readListPrec :: ReadPrec [SpaceInternal]
Read, Int -> SpaceInternal -> ShowS
[SpaceInternal] -> ShowS
SpaceInternal -> String
(Int -> SpaceInternal -> ShowS)
-> (SpaceInternal -> String)
-> ([SpaceInternal] -> ShowS)
-> Show SpaceInternal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpaceInternal -> ShowS
showsPrec :: Int -> SpaceInternal -> ShowS
$cshow :: SpaceInternal -> String
show :: SpaceInternal -> String
$cshowList :: [SpaceInternal] -> ShowS
showList :: [SpaceInternal] -> ShowS
Show)

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

spaceView ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierUser ->
  IdentifierSpace ->
  SeldaTransactionT m SpaceView
spaceView :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierUser -> IdentifierSpace -> SeldaTransactionT m SpaceView
spaceView IdentifierUser
userIdentifier IdentifierSpace
spaceIdentifier = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Getting space info with identifier: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack ((IdentifierSpace, IdentifierUser) -> String
forall a. Show a => a -> String
show (IdentifierSpace
spaceIdentifier, IdentifierUser
userIdentifier))
  DbSpace
dbSpace <- Query (Backend (SeldaTransactionT m)) (Row SQLite DbSpace)
-> SeldaTransactionT m (Res (Row SQLite DbSpace))
forall (m :: * -> *) a.
(MonadSelda m, MonadCatch m, Result a) =>
Query (Backend m) a -> m (Res a)
Selda.queryOne (Query (Backend (SeldaTransactionT m)) (Row SQLite DbSpace)
 -> SeldaTransactionT m (Res (Row SQLite DbSpace)))
-> Query (Backend (SeldaTransactionT m)) (Row SQLite DbSpace)
-> SeldaTransactionT m (Res (Row SQLite DbSpace))
forall a b. (a -> b) -> a -> b
$ ID DbSpace
-> Query
     (Backend (SeldaTransactionT m))
     (Row (Backend (SeldaTransactionT m)) DbSpace)
forall backend. ID DbSpace -> Query backend (Row backend DbSpace)
spaceGet (ID DbSpace
 -> Query
      (Backend (SeldaTransactionT m))
      (Row (Backend (SeldaTransactionT m)) DbSpace))
-> ID DbSpace
-> Query
     (Backend (SeldaTransactionT m))
     (Row (Backend (SeldaTransactionT m)) DbSpace)
forall a b. (a -> b) -> a -> b
$ forall a. Int64 -> ID a
Selda.toId @DbSpace (Int64 -> ID DbSpace) -> Int64 -> ID DbSpace
forall a b. (a -> b) -> a -> b
$ IdentifierSpace -> Int64
unIdentifierSpace IdentifierSpace
spaceIdentifier
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Got space successfully."
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Getting roles."
  [Role]
roles <- do
    [DbRole]
dbRoles <- 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
$ ID DbSpace
-> Query
     (Backend (SeldaTransactionT m))
     (Row (Backend (SeldaTransactionT m)) DbRole)
forall backend. ID DbSpace -> Query backend (Row backend DbRole)
spaceListRoles (ID DbSpace
 -> Query
      (Backend (SeldaTransactionT m))
      (Row (Backend (SeldaTransactionT m)) DbRole))
-> ID DbSpace
-> Query
     (Backend (SeldaTransactionT m))
     (Row (Backend (SeldaTransactionT m)) DbRole)
forall a b. (a -> b) -> a -> b
$ DbSpace -> ID DbSpace
dbSpace_id DbSpace
dbSpace
    [[DbRolePermission]]
dbRolesPermissions <- (DbRole -> SeldaTransactionT m [DbRolePermission])
-> [DbRole] -> SeldaTransactionT m [[DbRolePermission]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Query (Backend (SeldaTransactionT m)) (Row SQLite DbRolePermission)
-> SeldaTransactionT m [Res (Row SQLite DbRolePermission)]
Query SQLite (Row SQLite DbRolePermission)
-> SeldaTransactionT m [DbRolePermission]
forall (m :: * -> *) a.
(MonadSelda m, Result a) =>
Query (Backend m) a -> m [Res a]
Selda.query (Query SQLite (Row SQLite DbRolePermission)
 -> SeldaTransactionT m [DbRolePermission])
-> (DbRole -> Query SQLite (Row SQLite DbRolePermission))
-> DbRole
-> SeldaTransactionT m [DbRolePermission]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ID DbRole -> Query SQLite (Row SQLite DbRolePermission)
forall backend.
ID DbRole -> Query backend (Row backend DbRolePermission)
spaceRoleListPermissions (ID DbRole -> Query SQLite (Row SQLite DbRolePermission))
-> (DbRole -> ID DbRole)
-> DbRole
-> Query SQLite (Row SQLite DbRolePermission)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DbRole -> ID DbRole
dbRole_id) [DbRole]
dbRoles
    let roles :: [Role]
roles =
          (DbRole -> [DbRolePermission] -> Role)
-> [DbRole] -> [[DbRolePermission]] -> [Role]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
            ( \DbRole
dbRole [DbRolePermission]
dbRolePermissions ->
                MkRole
                  { roleId :: IdentifierRole
roleId = Int64 -> IdentifierRole
MkIdentifierRole (Int64 -> IdentifierRole) -> Int64 -> IdentifierRole
forall a b. (a -> b) -> a -> b
$ forall a. ID a -> Int64
Selda.fromId @DbRole (ID DbRole -> Int64) -> ID DbRole -> Int64
forall a b. (a -> b) -> a -> b
$ DbRole -> ID DbRole
dbRole_id DbRole
dbRole
                  , roleSpace :: IdentifierSpace
roleSpace = Int64 -> IdentifierSpace
MkIdentifierSpace (Int64 -> IdentifierSpace) -> Int64 -> IdentifierSpace
forall a b. (a -> b) -> a -> b
$ forall a. ID a -> Int64
Selda.fromId @DbSpace (ID DbSpace -> Int64) -> ID DbSpace -> Int64
forall a b. (a -> b) -> a -> b
$ DbRole -> ID DbSpace
dbRole_space DbRole
dbRole
                  , roleName :: NameRole
roleName = Text -> NameRole
MkNameRole (Text -> NameRole) -> Text -> NameRole
forall a b. (a -> b) -> a -> b
$ DbRole -> Text
dbRole_name DbRole
dbRole
                  , rolePermissions :: Set Permission
rolePermissions = [Permission] -> Set Permission
forall a. Ord a => [a] -> Set a
S.fromList ([Permission] -> Set Permission) -> [Permission] -> Set Permission
forall a b. (a -> b) -> a -> b
$ DbPermission -> Permission
spacePermissionDbToApi (DbPermission -> Permission)
-> (DbRolePermission -> DbPermission)
-> DbRolePermission
-> Permission
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DbRolePermission -> DbPermission
dbRolePermission_permission (DbRolePermission -> Permission)
-> [DbRolePermission] -> [Permission]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DbRolePermission]
dbRolePermissions
                  , roleAccessibility :: AccessibilityRole
roleAccessibility = DbRoleAccessibility -> AccessibilityRole
roleAccessibilityDbToApi (DbRoleAccessibility -> AccessibilityRole)
-> DbRoleAccessibility -> AccessibilityRole
forall a b. (a -> b) -> a -> b
$ DbRole -> DbRoleAccessibility
dbRole_accessibility DbRole
dbRole
                  }
            )
            [DbRole]
dbRoles
            [[DbRolePermission]]
dbRolesPermissions
    [Role] -> SeldaTransactionT m [Role]
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Role]
roles
  [DbSpaceUser]
dbSpaceUsers <- Query (Backend (SeldaTransactionT m)) (Row SQLite DbSpaceUser)
-> SeldaTransactionT m [Res (Row SQLite DbSpaceUser)]
forall (m :: * -> *) a.
(MonadSelda m, Result a) =>
Query (Backend m) a -> m [Res a]
Selda.query (Query (Backend (SeldaTransactionT m)) (Row SQLite DbSpaceUser)
 -> SeldaTransactionT m [Res (Row SQLite DbSpaceUser)])
-> Query (Backend (SeldaTransactionT m)) (Row SQLite DbSpaceUser)
-> SeldaTransactionT m [Res (Row SQLite DbSpaceUser)]
forall a b. (a -> b) -> a -> b
$ ID DbSpace
-> Query
     (Backend (SeldaTransactionT m))
     (Row (Backend (SeldaTransactionT m)) DbSpaceUser)
forall backend.
ID DbSpace -> Query backend (Row backend DbSpaceUser)
spaceListUsers (ID DbSpace
 -> Query
      (Backend (SeldaTransactionT m))
      (Row (Backend (SeldaTransactionT m)) DbSpaceUser))
-> ID DbSpace
-> Query
     (Backend (SeldaTransactionT m))
     (Row (Backend (SeldaTransactionT m)) DbSpaceUser)
forall a b. (a -> b) -> a -> b
$ DbSpace -> ID DbSpace
dbSpace_id DbSpace
dbSpace
  let spaceUsers :: [SpaceUser]
spaceUsers =
        ( \DbSpaceUser
dbSpaceUser ->
            MkSpaceUser
              { spaceUserUser :: IdentifierUser
spaceUserUser = Int64 -> IdentifierUser
MkIdentifierUser (Int64 -> IdentifierUser) -> Int64 -> IdentifierUser
forall a b. (a -> b) -> a -> b
$ forall a. ID a -> Int64
Selda.fromId @DbUser (ID DbUser -> Int64) -> ID DbUser -> Int64
forall a b. (a -> b) -> a -> b
$ DbSpaceUser -> ID DbUser
dbSpaceUser_user DbSpaceUser
dbSpaceUser
              , spaceUserRole :: IdentifierRole
spaceUserRole = Int64 -> IdentifierRole
MkIdentifierRole (Int64 -> IdentifierRole) -> Int64 -> IdentifierRole
forall a b. (a -> b) -> a -> b
$ forall a. ID a -> Int64
Selda.fromId @DbRole (ID DbRole -> Int64) -> ID DbRole -> Int64
forall a b. (a -> b) -> a -> b
$ DbSpaceUser -> ID DbRole
dbSpaceUser_role DbSpaceUser
dbSpaceUser
              }
        )
          (DbSpaceUser -> SpaceUser) -> [DbSpaceUser] -> [SpaceUser]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DbSpaceUser]
dbSpaceUsers
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Got roles successfully."
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Looking up role for requesting user."
  Maybe IdentifierRole
maybeRoleIdentifier <- do
    Maybe (ID DbRole)
dbMaybeRoleId <-
      Query (Backend (SeldaTransactionT m)) (Col SQLite (ID DbRole))
-> SeldaTransactionT m (Maybe (Res (Col SQLite (ID DbRole))))
forall (m :: * -> *) a.
(MonadSelda m, MonadThrow m, Result a) =>
Query (Backend m) a -> m (Maybe (Res a))
Selda.queryUnique (Query (Backend (SeldaTransactionT m)) (Col SQLite (ID DbRole))
 -> SeldaTransactionT m (Maybe (Res (Col SQLite (ID DbRole)))))
-> Query (Backend (SeldaTransactionT m)) (Col SQLite (ID DbRole))
-> SeldaTransactionT m (Maybe (Res (Col SQLite (ID DbRole))))
forall a b. (a -> b) -> a -> b
$
        ID DbSpace -> ID DbUser -> Query SQLite (Col SQLite (ID DbRole))
forall backend.
ID DbSpace -> ID DbUser -> Query backend (Col backend (ID DbRole))
spaceUserGetRole
          (forall a. Int64 -> ID a
Selda.toId @DbSpace (Int64 -> ID DbSpace) -> Int64 -> ID DbSpace
forall a b. (a -> b) -> a -> b
$ IdentifierSpace -> Int64
unIdentifierSpace IdentifierSpace
spaceIdentifier)
          (forall a. Int64 -> ID a
Selda.toId @DbUser (Int64 -> ID DbUser) -> Int64 -> ID DbUser
forall a b. (a -> b) -> a -> b
$ IdentifierUser -> Int64
unIdentifierUser IdentifierUser
userIdentifier)
    Maybe IdentifierRole -> SeldaTransactionT m (Maybe IdentifierRole)
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe IdentifierRole
 -> SeldaTransactionT m (Maybe IdentifierRole))
-> Maybe IdentifierRole
-> SeldaTransactionT m (Maybe IdentifierRole)
forall a b. (a -> b) -> a -> b
$ Int64 -> IdentifierRole
MkIdentifierRole (Int64 -> IdentifierRole)
-> (ID DbRole -> Int64) -> ID DbRole -> IdentifierRole
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ID a -> Int64
Selda.fromId @DbRole (ID DbRole -> IdentifierRole)
-> Maybe (ID DbRole) -> Maybe IdentifierRole
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ID DbRole)
dbMaybeRoleId
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Got requesting user's role successfully."
  SpaceView -> SeldaTransactionT m SpaceView
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SpaceView -> SeldaTransactionT m SpaceView)
-> SpaceView -> SeldaTransactionT m SpaceView
forall a b. (a -> b) -> a -> b
$
    MkSpaceView
      { spaceViewId :: IdentifierSpace
spaceViewId = Int64 -> IdentifierSpace
MkIdentifierSpace (Int64 -> IdentifierSpace) -> Int64 -> IdentifierSpace
forall a b. (a -> b) -> a -> b
$ forall a. ID a -> Int64
Selda.fromId @DbSpace (ID DbSpace -> Int64) -> ID DbSpace -> Int64
forall a b. (a -> b) -> a -> b
$ DbSpace -> ID DbSpace
dbSpace_id DbSpace
dbSpace
      , spaceViewName :: NameSpace
spaceViewName = Text -> NameSpace
MkNameSpace (Text -> NameSpace) -> Text -> NameSpace
forall a b. (a -> b) -> a -> b
$ DbSpace -> Text
dbSpace_name DbSpace
dbSpace
      , spaceViewTimezone :: TZLabel
spaceViewTimezone = DbSpace -> TZLabel
dbSpace_timezone DbSpace
dbSpace
      , spaceViewVisibility :: VisibilitySpace
spaceViewVisibility = DbSpaceVisibility -> VisibilitySpace
spaceVisibilityDbToApi (DbSpaceVisibility -> VisibilitySpace)
-> DbSpaceVisibility -> VisibilitySpace
forall a b. (a -> b) -> a -> b
$ DbSpace -> DbSpaceVisibility
dbSpace_visibility DbSpace
dbSpace
      , spaceViewOwner :: IdentifierUser
spaceViewOwner = Int64 -> IdentifierUser
MkIdentifierUser (Int64 -> IdentifierUser) -> Int64 -> IdentifierUser
forall a b. (a -> b) -> a -> b
$ forall a. ID a -> Int64
Selda.fromId @DbUser (ID DbUser -> Int64) -> ID DbUser -> Int64
forall a b. (a -> b) -> a -> b
$ DbSpace -> ID DbUser
dbSpace_owner DbSpace
dbSpace
      , spaceViewRoles :: Set Role
spaceViewRoles = [Role] -> Set Role
forall a. Ord a => [a] -> Set a
S.fromList [Role]
roles
      , spaceViewUsers :: Set SpaceUser
spaceViewUsers = [SpaceUser] -> Set SpaceUser
forall a. Ord a => [a] -> Set a
S.fromList [SpaceUser]
spaceUsers
      , spaceViewYourRole :: Maybe IdentifierRole
spaceViewYourRole = Maybe IdentifierRole
maybeRoleIdentifier
      }

type SpaceView :: Type
data SpaceView = MkSpaceView
  { SpaceView -> IdentifierSpace
spaceViewId :: IdentifierSpace
  , SpaceView -> NameSpace
spaceViewName :: NameSpace
  , SpaceView -> TZLabel
spaceViewTimezone :: T.TZLabel
  , SpaceView -> VisibilitySpace
spaceViewVisibility :: VisibilitySpace
  , SpaceView -> IdentifierUser
spaceViewOwner :: IdentifierUser
  , SpaceView -> Set Role
spaceViewRoles :: S.Set Role
  , SpaceView -> Set SpaceUser
spaceViewUsers :: S.Set SpaceUser
  , SpaceView -> Maybe IdentifierRole
spaceViewYourRole :: Maybe IdentifierRole
  }
  deriving stock (SpaceView -> SpaceView -> Bool
(SpaceView -> SpaceView -> Bool)
-> (SpaceView -> SpaceView -> Bool) -> Eq SpaceView
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpaceView -> SpaceView -> Bool
== :: SpaceView -> SpaceView -> Bool
$c/= :: SpaceView -> SpaceView -> Bool
/= :: SpaceView -> SpaceView -> Bool
Eq, (forall x. SpaceView -> Rep SpaceView x)
-> (forall x. Rep SpaceView x -> SpaceView) -> Generic SpaceView
forall x. Rep SpaceView x -> SpaceView
forall x. SpaceView -> Rep SpaceView x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SpaceView -> Rep SpaceView x
from :: forall x. SpaceView -> Rep SpaceView x
$cto :: forall x. Rep SpaceView x -> SpaceView
to :: forall x. Rep SpaceView x -> SpaceView
Generic, Eq SpaceView
Eq SpaceView =>
(SpaceView -> SpaceView -> Ordering)
-> (SpaceView -> SpaceView -> Bool)
-> (SpaceView -> SpaceView -> Bool)
-> (SpaceView -> SpaceView -> Bool)
-> (SpaceView -> SpaceView -> Bool)
-> (SpaceView -> SpaceView -> SpaceView)
-> (SpaceView -> SpaceView -> SpaceView)
-> Ord SpaceView
SpaceView -> SpaceView -> Bool
SpaceView -> SpaceView -> Ordering
SpaceView -> SpaceView -> SpaceView
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SpaceView -> SpaceView -> Ordering
compare :: SpaceView -> SpaceView -> Ordering
$c< :: SpaceView -> SpaceView -> Bool
< :: SpaceView -> SpaceView -> Bool
$c<= :: SpaceView -> SpaceView -> Bool
<= :: SpaceView -> SpaceView -> Bool
$c> :: SpaceView -> SpaceView -> Bool
> :: SpaceView -> SpaceView -> Bool
$c>= :: SpaceView -> SpaceView -> Bool
>= :: SpaceView -> SpaceView -> Bool
$cmax :: SpaceView -> SpaceView -> SpaceView
max :: SpaceView -> SpaceView -> SpaceView
$cmin :: SpaceView -> SpaceView -> SpaceView
min :: SpaceView -> SpaceView -> SpaceView
Ord, ReadPrec [SpaceView]
ReadPrec SpaceView
Int -> ReadS SpaceView
ReadS [SpaceView]
(Int -> ReadS SpaceView)
-> ReadS [SpaceView]
-> ReadPrec SpaceView
-> ReadPrec [SpaceView]
-> Read SpaceView
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SpaceView
readsPrec :: Int -> ReadS SpaceView
$creadList :: ReadS [SpaceView]
readList :: ReadS [SpaceView]
$creadPrec :: ReadPrec SpaceView
readPrec :: ReadPrec SpaceView
$creadListPrec :: ReadPrec [SpaceView]
readListPrec :: ReadPrec [SpaceView]
Read, Int -> SpaceView -> ShowS
[SpaceView] -> ShowS
SpaceView -> String
(Int -> SpaceView -> ShowS)
-> (SpaceView -> String)
-> ([SpaceView] -> ShowS)
-> Show SpaceView
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpaceView -> ShowS
showsPrec :: Int -> SpaceView -> ShowS
$cshow :: SpaceView -> String
show :: SpaceView -> String
$cshowList :: [SpaceView] -> ShowS
showList :: [SpaceView] -> ShowS
Show)

spaceListVisible ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierUser ->
  OrderByCategories SpaceOrderCategory ->
  -- | Predicate whether the user has to be a member of the space.
  Maybe Bool ->
  SeldaTransactionT m [Space]
spaceListVisible :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierUser
-> OrderByCategories SpaceOrderCategory
-> Maybe Bool
-> SeldaTransactionT m [Space]
spaceListVisible IdentifierUser
userIdentifier OrderByCategories SpaceOrderCategory
spaceOrder Maybe Bool
maybeIsMember = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Looking up spaces visible by user: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierUser -> String
forall a. Show a => a -> String
show IdentifierUser
userIdentifier)
  [DbSpace]
dbSpaces <- Query (Backend (SeldaTransactionT m)) (Row SQLite DbSpace)
-> SeldaTransactionT m [Res (Row SQLite DbSpace)]
forall (m :: * -> *) a.
(MonadSelda m, Result a) =>
Query (Backend m) a -> m [Res a]
Selda.query (Query (Backend (SeldaTransactionT m)) (Row SQLite DbSpace)
 -> SeldaTransactionT m [Res (Row SQLite DbSpace)])
-> Query (Backend (SeldaTransactionT m)) (Row SQLite DbSpace)
-> SeldaTransactionT m [Res (Row SQLite DbSpace)]
forall a b. (a -> b) -> a -> b
$ do
    Row SQLite DbSpace
dbSpace <- Table DbSpace -> Query SQLite (Row SQLite DbSpace)
forall a s. Relational a => Table a -> Query s (Row s a)
Selda.select Table DbSpace
tableSpace
    Row SQLite (Maybe DbSpaceUser)
dbSpaceUser <-
      (OuterCols (Row (Inner SQLite) DbSpaceUser) -> Col SQLite Bool)
-> Query (Inner SQLite) (Row (Inner SQLite) DbSpaceUser)
-> Query SQLite (LeftCols (Row (Inner SQLite) DbSpaceUser))
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 (Row (Inner SQLite) DbSpaceUser)
dbSpaceUser ->
            Row SQLite DbSpaceUser
OuterCols (Row (Inner 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 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 DbSpace
dbSpace Row SQLite DbSpace
-> Selector DbSpace (ID DbSpace) -> Col SQLite (ID DbSpace)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbSpace (ID DbSpace)
#dbSpace_id
              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 DbSpaceUser
OuterCols (Row (Inner SQLite) DbSpaceUser)
dbSpaceUser Row SQLite DbSpaceUser
-> Selector DbSpaceUser (ID DbUser) -> Col SQLite (ID DbUser)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbSpaceUser (ID DbUser)
#dbSpaceUser_user Col SQLite (ID DbUser) -> Col SQLite (ID DbUser) -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda..== ID DbUser -> Col SQLite (ID DbUser)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbUser (Int64 -> ID DbUser) -> Int64 -> ID DbUser
forall a b. (a -> b) -> a -> b
$ IdentifierUser -> Int64
unIdentifierUser IdentifierUser
userIdentifier)
        )
        (Table DbSpaceUser
-> Query (Inner SQLite) (Row (Inner SQLite) DbSpaceUser)
forall a s. Relational a => Table a -> Query s (Row s a)
Selda.select Table DbSpaceUser
tableSpaceUser)
    case Maybe Bool
maybeIsMember of
      Maybe Bool
Nothing -> () -> Query SQLite ()
forall a. a -> Query SQLite a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just Bool
True -> 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 (ID DbSpaceUser)) -> Col SQLite Bool
forall a s. SqlType a => Col s (Maybe a) -> Col s Bool
Selda.isNull (Col SQLite (Maybe (ID DbSpaceUser)) -> Col SQLite Bool)
-> Col SQLite (Maybe (ID DbSpaceUser)) -> Col SQLite Bool
forall a b. (a -> b) -> a -> b
$ Row SQLite (Maybe DbSpaceUser)
dbSpaceUser Row SQLite (Maybe DbSpaceUser)
-> Selector DbSpaceUser (ID DbSpaceUser)
-> Col SQLite (Coalesce (Maybe (ID DbSpaceUser)))
forall a s t.
SqlType a =>
Row s (Maybe t) -> Selector t a -> Col s (Coalesce (Maybe a))
Selda.? Selector DbSpaceUser (ID DbSpaceUser)
#dbSpaceUser_id
      Just Bool
False -> 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 DbSpaceUser)) -> Col SQLite Bool
forall a s. SqlType a => Col s (Maybe a) -> Col s Bool
Selda.isNull (Col SQLite (Maybe (ID DbSpaceUser)) -> Col SQLite Bool)
-> Col SQLite (Maybe (ID DbSpaceUser)) -> Col SQLite Bool
forall a b. (a -> b) -> a -> b
$ Row SQLite (Maybe DbSpaceUser)
dbSpaceUser Row SQLite (Maybe DbSpaceUser)
-> Selector DbSpaceUser (ID DbSpaceUser)
-> Col SQLite (Coalesce (Maybe (ID DbSpaceUser)))
forall a s t.
SqlType a =>
Row s (Maybe t) -> Selector t a -> Col s (Coalesce (Maybe a))
Selda.? Selector DbSpaceUser (ID DbSpaceUser)
#dbSpaceUser_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 DbSpace
dbSpace Row SQLite DbSpace
-> Selector DbSpace DbSpaceVisibility
-> Col SQLite DbSpaceVisibility
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbSpace DbSpaceVisibility
#dbSpace_visibility Col SQLite DbSpaceVisibility
-> Col SQLite DbSpaceVisibility -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda..== DbSpaceVisibility -> Col SQLite DbSpaceVisibility
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal DbSpaceVisibility
MkDbSpaceVisibility_visible
        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..|| Col SQLite Bool -> Col SQLite Bool
forall s. Col s Bool -> Col s Bool
Selda.not_ (Col SQLite (Maybe (ID DbSpaceUser)) -> Col SQLite Bool
forall a s. SqlType a => Col s (Maybe a) -> Col s Bool
Selda.isNull (Col SQLite (Maybe (ID DbSpaceUser)) -> Col SQLite Bool)
-> Col SQLite (Maybe (ID DbSpaceUser)) -> Col SQLite Bool
forall a b. (a -> b) -> a -> b
$ Row SQLite (Maybe DbSpaceUser)
dbSpaceUser Row SQLite (Maybe DbSpaceUser)
-> Selector DbSpaceUser (ID DbSpaceUser)
-> Col SQLite (Coalesce (Maybe (ID DbSpaceUser)))
forall a s t.
SqlType a =>
Row s (Maybe t) -> Selector t a -> Col s (Coalesce (Maybe a))
Selda.? Selector DbSpaceUser (ID DbSpaceUser)
#dbSpaceUser_id)
    let categorySelector :: SpaceOrderCategory -> SomeCol SQLite
categorySelector = \case
          SpaceOrderCategory
SpaceOrderCategoryId -> Col SQLite (ID DbSpace) -> SomeCol SQLite
forall t a. SqlType a => Col t a -> SomeCol t
Selda.MkSomeCol (Col SQLite (ID DbSpace) -> SomeCol SQLite)
-> Col SQLite (ID DbSpace) -> SomeCol SQLite
forall a b. (a -> b) -> a -> b
$ Row SQLite DbSpace
dbSpace Row SQLite DbSpace
-> Selector DbSpace (ID DbSpace) -> Col SQLite (ID DbSpace)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbSpace (ID DbSpace)
#dbSpace_id
          SpaceOrderCategory
SpaceOrderCategoryName -> Col SQLite Text -> SomeCol SQLite
forall t a. SqlType a => Col t a -> SomeCol t
Selda.MkSomeCol (Col SQLite Text -> SomeCol SQLite)
-> Col SQLite Text -> SomeCol SQLite
forall a b. (a -> b) -> a -> b
$ Row SQLite DbSpace
dbSpace Row SQLite DbSpace -> Selector DbSpace Text -> Col SQLite Text
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbSpace Text
#dbSpace_name
    (SpaceOrderCategory -> SomeCol SQLite)
-> OrderByCategories SpaceOrderCategory -> Query SQLite ()
forall s t c.
Same s t =>
(c -> SomeCol s) -> OrderByCategories c -> Query t ()
Selda.orderFlexible SpaceOrderCategory -> SomeCol SQLite
categorySelector OrderByCategories SpaceOrderCategory
spaceOrder
    Row SQLite DbSpace -> Query SQLite (Row SQLite DbSpace)
forall a. a -> Query SQLite a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Row SQLite DbSpace
dbSpace
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Looked up visible spaces successfully."
  let fromDbSpace :: DbSpace -> Space
fromDbSpace DbSpace
space =
        MkSpace
          { spaceId :: IdentifierSpace
spaceId = Int64 -> IdentifierSpace
MkIdentifierSpace (Int64 -> IdentifierSpace) -> Int64 -> IdentifierSpace
forall a b. (a -> b) -> a -> b
$ forall a. ID a -> Int64
Selda.fromId @DbSpace (ID DbSpace -> Int64) -> ID DbSpace -> Int64
forall a b. (a -> b) -> a -> b
$ DbSpace -> ID DbSpace
dbSpace_id DbSpace
space
          , spaceName :: NameSpace
spaceName = Text -> NameSpace
MkNameSpace (Text -> NameSpace) -> Text -> NameSpace
forall a b. (a -> b) -> a -> b
$ DbSpace -> Text
dbSpace_name DbSpace
space
          , spaceTimezone :: TZLabel
spaceTimezone = DbSpace -> TZLabel
dbSpace_timezone DbSpace
space
          , spaceOwner :: IdentifierUser
spaceOwner = Int64 -> IdentifierUser
MkIdentifierUser (Int64 -> IdentifierUser) -> Int64 -> IdentifierUser
forall a b. (a -> b) -> a -> b
$ forall a. ID a -> Int64
Selda.fromId @DbUser (ID DbUser -> Int64) -> ID DbUser -> Int64
forall a b. (a -> b) -> a -> b
$ DbSpace -> ID DbUser
dbSpace_owner DbSpace
space
          }
  [Space] -> SeldaTransactionT m [Space]
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Space] -> SeldaTransactionT m [Space])
-> [Space] -> SeldaTransactionT m [Space]
forall a b. (a -> b) -> a -> b
$ DbSpace -> Space
fromDbSpace (DbSpace -> Space) -> [DbSpace] -> [Space]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DbSpace]
dbSpaces

spaceCountUsers ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierSpace ->
  SeldaTransactionT m Natural
spaceCountUsers :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> SeldaTransactionT m Natural
spaceCountUsers IdentifierSpace
identifier = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Counting space users: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierSpace -> String
forall a. Show a => a -> String
show IdentifierSpace
identifier)
  Int
dbUserCount <- Query
  (Backend (SeldaTransactionT m))
  (AggrCols (Aggr (Inner SQLite) Int))
-> SeldaTransactionT m (Res (AggrCols (Aggr (Inner SQLite) Int)))
forall (m :: * -> *) a.
(MonadSelda m, MonadCatch m, Result a) =>
Query (Backend m) a -> m (Res a)
Selda.queryOne (Query
   (Backend (SeldaTransactionT m))
   (AggrCols (Aggr (Inner SQLite) Int))
 -> SeldaTransactionT m (Res (AggrCols (Aggr (Inner SQLite) Int))))
-> Query
     (Backend (SeldaTransactionT m))
     (AggrCols (Aggr (Inner SQLite) Int))
-> SeldaTransactionT m (Res (AggrCols (Aggr (Inner SQLite) Int)))
forall a b. (a -> b) -> a -> b
$ do
    Query
  (Inner (Backend (SeldaTransactionT m))) (Aggr (Inner SQLite) Int)
-> Query
     (Backend (SeldaTransactionT m))
     (AggrCols (Aggr (Inner SQLite) Int))
forall a s.
(Columns (AggrCols a), Aggregates a) =>
Query (Inner s) a -> Query s (AggrCols a)
Selda.aggregate (Query
   (Inner (Backend (SeldaTransactionT m))) (Aggr (Inner SQLite) Int)
 -> Query
      (Backend (SeldaTransactionT m))
      (AggrCols (Aggr (Inner SQLite) Int)))
-> Query
     (Inner (Backend (SeldaTransactionT m))) (Aggr (Inner SQLite) Int)
-> Query
     (Backend (SeldaTransactionT m))
     (AggrCols (Aggr (Inner SQLite) Int))
forall a b. (a -> b) -> a -> b
$ do
      Row (Inner SQLite) DbSpaceUser
dbSpaceUser <- Table DbSpaceUser
-> Query (Inner SQLite) (Row (Inner SQLite) DbSpaceUser)
forall a s. Relational a => Table a -> Query s (Row s a)
Selda.select Table DbSpaceUser
tableSpaceUser
      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
$ Row (Inner SQLite) DbSpaceUser
dbSpaceUser Row (Inner SQLite) DbSpaceUser
-> Selector DbSpaceUser (ID DbSpace)
-> Col (Inner 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 Col (Inner SQLite) (ID DbSpace)
-> Col (Inner SQLite) (ID DbSpace) -> Col (Inner SQLite) Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda..== ID DbSpace -> Col (Inner SQLite) (ID DbSpace)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbSpace (Int64 -> ID DbSpace) -> Int64 -> ID DbSpace
forall a b. (a -> b) -> a -> b
$ IdentifierSpace -> Int64
unIdentifierSpace IdentifierSpace
identifier)
      Aggr (Inner SQLite) Int
-> Query (Inner SQLite) (Aggr (Inner SQLite) Int)
forall a. a -> Query (Inner SQLite) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Aggr (Inner SQLite) Int
 -> Query (Inner SQLite) (Aggr (Inner SQLite) Int))
-> Aggr (Inner SQLite) Int
-> Query (Inner SQLite) (Aggr (Inner SQLite) Int)
forall a b. (a -> b) -> a -> b
$ Col (Inner SQLite) (ID DbSpaceUser) -> Aggr (Inner SQLite) Int
forall a s. SqlType a => Col s a -> Aggr s Int
Selda.count (Col (Inner SQLite) (ID DbSpaceUser) -> Aggr (Inner SQLite) Int)
-> Col (Inner SQLite) (ID DbSpaceUser) -> Aggr (Inner SQLite) Int
forall a b. (a -> b) -> a -> b
$ Row (Inner SQLite) DbSpaceUser
dbSpaceUser Row (Inner SQLite) DbSpaceUser
-> Selector DbSpaceUser (ID DbSpaceUser)
-> Col (Inner SQLite) (ID DbSpaceUser)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbSpaceUser (ID DbSpaceUser)
#dbSpaceUser_id
  let Int -> Natural
intToNatural :: Int -> Natural = Int -> Natural
forall a. Enum a => Int -> a
toEnum
  Natural -> SeldaTransactionT m Natural
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> SeldaTransactionT m Natural)
-> Natural -> SeldaTransactionT m Natural
forall a b. (a -> b) -> a -> b
$ Int -> Natural
intToNatural Int
dbUserCount

spaceCountDesks ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierSpace ->
  SeldaTransactionT m Natural
spaceCountDesks :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> SeldaTransactionT m Natural
spaceCountDesks IdentifierSpace
identifier = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Counting space desks: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierSpace -> String
forall a. Show a => a -> String
show IdentifierSpace
identifier)
  Int
dbDeskCount <- Query
  (Backend (SeldaTransactionT m))
  (AggrCols (Aggr (Inner SQLite) Int))
-> SeldaTransactionT m (Res (AggrCols (Aggr (Inner SQLite) Int)))
forall (m :: * -> *) a.
(MonadSelda m, MonadCatch m, Result a) =>
Query (Backend m) a -> m (Res a)
Selda.queryOne (Query
   (Backend (SeldaTransactionT m))
   (AggrCols (Aggr (Inner SQLite) Int))
 -> SeldaTransactionT m (Res (AggrCols (Aggr (Inner SQLite) Int))))
-> Query
     (Backend (SeldaTransactionT m))
     (AggrCols (Aggr (Inner SQLite) Int))
-> SeldaTransactionT m (Res (AggrCols (Aggr (Inner SQLite) Int)))
forall a b. (a -> b) -> a -> b
$ do
    Query
  (Inner (Backend (SeldaTransactionT m))) (Aggr (Inner SQLite) Int)
-> Query
     (Backend (SeldaTransactionT m))
     (AggrCols (Aggr (Inner SQLite) Int))
forall a s.
(Columns (AggrCols a), Aggregates a) =>
Query (Inner s) a -> Query s (AggrCols a)
Selda.aggregate (Query
   (Inner (Backend (SeldaTransactionT m))) (Aggr (Inner SQLite) Int)
 -> Query
      (Backend (SeldaTransactionT m))
      (AggrCols (Aggr (Inner SQLite) Int)))
-> Query
     (Inner (Backend (SeldaTransactionT m))) (Aggr (Inner SQLite) Int)
-> Query
     (Backend (SeldaTransactionT m))
     (AggrCols (Aggr (Inner SQLite) Int))
forall a b. (a -> b) -> a -> b
$ do
      Row (Inner SQLite) DbDesk
dbDesk <- 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
$ Row (Inner SQLite) DbDesk
dbDesk Row (Inner SQLite) DbDesk
-> Selector DbDesk (ID DbSpace) -> Col (Inner SQLite) (ID DbSpace)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbDesk (ID DbSpace)
#dbDesk_space Col (Inner SQLite) (ID DbSpace)
-> Col (Inner SQLite) (ID DbSpace) -> Col (Inner SQLite) Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda..== ID DbSpace -> Col (Inner SQLite) (ID DbSpace)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbSpace (Int64 -> ID DbSpace) -> Int64 -> ID DbSpace
forall a b. (a -> b) -> a -> b
$ IdentifierSpace -> Int64
unIdentifierSpace IdentifierSpace
identifier)
      Aggr (Inner SQLite) Int
-> Query (Inner SQLite) (Aggr (Inner SQLite) Int)
forall a. a -> Query (Inner SQLite) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Aggr (Inner SQLite) Int
 -> Query (Inner SQLite) (Aggr (Inner SQLite) Int))
-> Aggr (Inner SQLite) Int
-> Query (Inner SQLite) (Aggr (Inner SQLite) Int)
forall a b. (a -> b) -> a -> b
$ Col (Inner SQLite) (ID DbDesk) -> Aggr (Inner SQLite) Int
forall a s. SqlType a => Col s a -> Aggr s Int
Selda.count (Col (Inner SQLite) (ID DbDesk) -> Aggr (Inner SQLite) Int)
-> Col (Inner SQLite) (ID DbDesk) -> Aggr (Inner SQLite) Int
forall a b. (a -> b) -> a -> b
$ Row (Inner SQLite) DbDesk
dbDesk 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
  let Int -> Natural
intToNatural :: Int -> Natural = Int -> Natural
forall a. Enum a => Int -> a
toEnum
  Natural -> SeldaTransactionT m Natural
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> SeldaTransactionT m Natural)
-> Natural -> SeldaTransactionT m Natural
forall a b. (a -> b) -> a -> b
$ Int -> Natural
intToNatural Int
dbDeskCount

roleLookupId ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierSpace ->
  NameRole ->
  SeldaTransactionT m (Maybe IdentifierRole)
roleLookupId :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace
-> NameRole -> SeldaTransactionT m (Maybe IdentifierRole)
roleLookupId IdentifierSpace
spaceIdentifier NameRole
name = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Looking up space-role identifier with name: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (NameRole -> String
forall a. Show a => a -> String
show NameRole
name)
  Maybe DbRole
maybeDbRole <- Query (Backend (SeldaTransactionT m)) (Row SQLite DbRole)
-> SeldaTransactionT m (Maybe (Res (Row SQLite DbRole)))
forall (m :: * -> *) a.
(MonadSelda m, MonadThrow m, Result a) =>
Query (Backend m) a -> m (Maybe (Res a))
Selda.queryUnique (Query (Backend (SeldaTransactionT m)) (Row SQLite DbRole)
 -> SeldaTransactionT m (Maybe (Res (Row SQLite DbRole))))
-> Query (Backend (SeldaTransactionT m)) (Row SQLite DbRole)
-> SeldaTransactionT m (Maybe (Res (Row SQLite DbRole)))
forall a b. (a -> b) -> a -> b
$ ID DbSpace
-> Text
-> Query
     (Backend (SeldaTransactionT m))
     (Row (Backend (SeldaTransactionT m)) DbRole)
forall backend.
ID DbSpace -> Text -> Query backend (Row backend DbRole)
spaceRoleLookup (forall a. Int64 -> ID a
Selda.toId @DbSpace (Int64 -> ID DbSpace) -> Int64 -> ID DbSpace
forall a b. (a -> b) -> a -> b
$ IdentifierSpace -> Int64
unIdentifierSpace IdentifierSpace
spaceIdentifier) (Text
 -> Query
      (Backend (SeldaTransactionT m))
      (Row (Backend (SeldaTransactionT m)) DbRole))
-> Text
-> Query
     (Backend (SeldaTransactionT m))
     (Row (Backend (SeldaTransactionT m)) DbRole)
forall a b. (a -> b) -> a -> b
$ NameRole -> Text
unNameRole NameRole
name
  case Maybe DbRole
maybeDbRole of
    Maybe DbRole
Nothing -> do
      m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Failed to look up space-role. Name doesn't exist: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (NameRole -> String
forall a. Show a => a -> String
show NameRole
name)
      Maybe IdentifierRole -> SeldaTransactionT m (Maybe IdentifierRole)
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe IdentifierRole
forall a. Maybe a
Nothing
    Just DbRole
dbRole -> do
      m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Looked up space successfully."
      Maybe IdentifierRole -> SeldaTransactionT m (Maybe IdentifierRole)
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe IdentifierRole
 -> SeldaTransactionT m (Maybe IdentifierRole))
-> Maybe IdentifierRole
-> SeldaTransactionT m (Maybe IdentifierRole)
forall a b. (a -> b) -> a -> b
$ IdentifierRole -> Maybe IdentifierRole
forall a. a -> Maybe a
Just (IdentifierRole -> Maybe IdentifierRole)
-> IdentifierRole -> Maybe IdentifierRole
forall a b. (a -> b) -> a -> b
$ Int64 -> IdentifierRole
MkIdentifierRole (Int64 -> IdentifierRole) -> Int64 -> IdentifierRole
forall a b. (a -> b) -> a -> b
$ ID DbRole -> Int64
forall a. ID a -> Int64
Selda.fromId (ID DbRole -> Int64) -> ID DbRole -> Int64
forall a b. (a -> b) -> a -> b
$ DbRole -> ID DbRole
dbRole_id DbRole
dbRole

roleGet ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierRole ->
  SeldaTransactionT m Role
roleGet :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole -> SeldaTransactionT m Role
roleGet IdentifierRole
identifier = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Get role info with identifier: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierRole -> String
forall a. Show a => a -> String
show IdentifierRole
identifier)
  DbRole
dbRole <- Query (Backend (SeldaTransactionT m)) (Row SQLite DbRole)
-> SeldaTransactionT m (Res (Row SQLite DbRole))
forall (m :: * -> *) a.
(MonadSelda m, MonadCatch m, Result a) =>
Query (Backend m) a -> m (Res a)
Selda.queryOne (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
$ ID DbRole
-> Query
     (Backend (SeldaTransactionT m))
     (Row (Backend (SeldaTransactionT m)) DbRole)
forall backend. ID DbRole -> Query backend (Row backend DbRole)
spaceRoleGet (ID DbRole
 -> Query
      (Backend (SeldaTransactionT m))
      (Row (Backend (SeldaTransactionT m)) DbRole))
-> ID DbRole
-> Query
     (Backend (SeldaTransactionT m))
     (Row (Backend (SeldaTransactionT m)) DbRole)
forall a b. (a -> b) -> a -> b
$ forall a. Int64 -> ID a
Selda.toId @DbRole (Int64 -> ID DbRole) -> Int64 -> ID DbRole
forall a b. (a -> b) -> a -> b
$ IdentifierRole -> Int64
unIdentifierRole IdentifierRole
identifier
  [DbRolePermission]
dbRolePermissions <- Query (Backend (SeldaTransactionT m)) (Row SQLite DbRolePermission)
-> SeldaTransactionT m [Res (Row SQLite DbRolePermission)]
forall (m :: * -> *) a.
(MonadSelda m, Result a) =>
Query (Backend m) a -> m [Res a]
Selda.query (Query
   (Backend (SeldaTransactionT m)) (Row SQLite DbRolePermission)
 -> SeldaTransactionT m [Res (Row SQLite DbRolePermission)])
-> Query
     (Backend (SeldaTransactionT m)) (Row SQLite DbRolePermission)
-> SeldaTransactionT m [Res (Row SQLite DbRolePermission)]
forall a b. (a -> b) -> a -> b
$ ID DbRole
-> Query
     (Backend (SeldaTransactionT m))
     (Row (Backend (SeldaTransactionT m)) DbRolePermission)
forall backend.
ID DbRole -> Query backend (Row backend DbRolePermission)
spaceRoleListPermissions (ID DbRole
 -> Query
      (Backend (SeldaTransactionT m))
      (Row (Backend (SeldaTransactionT m)) DbRolePermission))
-> ID DbRole
-> Query
     (Backend (SeldaTransactionT m))
     (Row (Backend (SeldaTransactionT m)) DbRolePermission)
forall a b. (a -> b) -> a -> b
$ forall a. Int64 -> ID a
Selda.toId @DbRole (Int64 -> ID DbRole) -> Int64 -> ID DbRole
forall a b. (a -> b) -> a -> b
$ IdentifierRole -> Int64
unIdentifierRole IdentifierRole
identifier
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Got role info successfully."
  Role -> SeldaTransactionT m Role
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    MkRole
      { roleId :: IdentifierRole
roleId = Int64 -> IdentifierRole
MkIdentifierRole (Int64 -> IdentifierRole) -> Int64 -> IdentifierRole
forall a b. (a -> b) -> a -> b
$ forall a. ID a -> Int64
Selda.fromId @DbRole (ID DbRole -> Int64) -> ID DbRole -> Int64
forall a b. (a -> b) -> a -> b
$ DbRole -> ID DbRole
dbRole_id DbRole
dbRole
      , roleSpace :: IdentifierSpace
roleSpace = Int64 -> IdentifierSpace
MkIdentifierSpace (Int64 -> IdentifierSpace) -> Int64 -> IdentifierSpace
forall a b. (a -> b) -> a -> b
$ forall a. ID a -> Int64
Selda.fromId @DbSpace (ID DbSpace -> Int64) -> ID DbSpace -> Int64
forall a b. (a -> b) -> a -> b
$ DbRole -> ID DbSpace
dbRole_space DbRole
dbRole
      , roleName :: NameRole
roleName = Text -> NameRole
MkNameRole (Text -> NameRole) -> Text -> NameRole
forall a b. (a -> b) -> a -> b
$ DbRole -> Text
dbRole_name DbRole
dbRole
      , rolePermissions :: Set Permission
rolePermissions = [Permission] -> Set Permission
forall a. Ord a => [a] -> Set a
S.fromList ([Permission] -> Set Permission) -> [Permission] -> Set Permission
forall a b. (a -> b) -> a -> b
$ DbPermission -> Permission
spacePermissionDbToApi (DbPermission -> Permission)
-> (DbRolePermission -> DbPermission)
-> DbRolePermission
-> Permission
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DbRolePermission -> DbPermission
dbRolePermission_permission (DbRolePermission -> Permission)
-> [DbRolePermission] -> [Permission]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DbRolePermission]
dbRolePermissions
      , roleAccessibility :: AccessibilityRole
roleAccessibility = DbRoleAccessibility -> AccessibilityRole
roleAccessibilityDbToApi (DbRoleAccessibility -> AccessibilityRole)
-> DbRoleAccessibility -> AccessibilityRole
forall a b. (a -> b) -> a -> b
$ DbRole -> DbRoleAccessibility
dbRole_accessibility DbRole
dbRole
      }

spaceCreate ::
  (MonadLogger m, MonadSeldaPool m) =>
  NameSpace ->
  IdentifierUser ->
  T.TZLabel ->
  VisibilitySpace ->
  SeldaTransactionT m IdentifierSpace
spaceCreate :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
NameSpace
-> IdentifierUser
-> TZLabel
-> VisibilitySpace
-> SeldaTransactionT m IdentifierSpace
spaceCreate NameSpace
name IdentifierUser
owner TZLabel
timezoneLabel VisibilitySpace
visibility = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Creating space: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (NameSpace -> String
forall a. Show a => a -> String
show NameSpace
name)
  let dbSpace :: DbSpace
dbSpace =
        MkDbSpace
          { dbSpace_id :: ID DbSpace
dbSpace_id = ID DbSpace
forall a. SqlType a => a
Selda.def
          , dbSpace_name :: Text
dbSpace_name = NameSpace -> Text
unNameSpace NameSpace
name
          , dbSpace_timezone :: TZLabel
dbSpace_timezone = TZLabel
timezoneLabel
          , dbSpace_visibility :: DbSpaceVisibility
dbSpace_visibility = VisibilitySpace -> DbSpaceVisibility
spaceVisibilityApiToDb VisibilitySpace
visibility
          , dbSpace_owner :: ID DbUser
dbSpace_owner = forall a. Int64 -> ID a
Selda.toId @DbUser (Int64 -> ID DbUser) -> Int64 -> ID DbUser
forall a b. (a -> b) -> a -> b
$ IdentifierUser -> Int64
unIdentifierUser IdentifierUser
owner
          , dbSpace_picture_jpeg :: Maybe ByteString
dbSpace_picture_jpeg = Maybe ByteString
forall a. Maybe a
Nothing
          }
  ID DbSpace
dbSpaceId <- Table DbSpace -> [DbSpace] -> SeldaTransactionT m (ID DbSpace)
forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a -> [a] -> m (ID a)
Selda.insertWithPK Table DbSpace
tableSpace [DbSpace
dbSpace]
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Created space successfully."
  IdentifierSpace -> SeldaTransactionT m IdentifierSpace
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IdentifierSpace -> SeldaTransactionT m IdentifierSpace)
-> IdentifierSpace -> SeldaTransactionT m IdentifierSpace
forall a b. (a -> b) -> a -> b
$ Int64 -> IdentifierSpace
MkIdentifierSpace (Int64 -> IdentifierSpace) -> Int64 -> IdentifierSpace
forall a b. (a -> b) -> a -> b
$ forall a. ID a -> Int64
Selda.fromId @DbSpace ID DbSpace
dbSpaceId

spaceDelete ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierSpace ->
  SeldaTransactionT m ()
spaceDelete :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> SeldaTransactionT m ()
spaceDelete IdentifierSpace
identifier = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Deleting space: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierSpace -> String
forall a. Show a => a -> String
show IdentifierSpace
identifier)
  [ID DbDesk]
dbDeskIdentifiers <- Query (Backend (SeldaTransactionT m)) (Col SQLite (ID DbDesk))
-> SeldaTransactionT m [Res (Col SQLite (ID DbDesk))]
forall (m :: * -> *) a.
(MonadSelda m, Result a) =>
Query (Backend m) a -> m [Res a]
Selda.query (Query (Backend (SeldaTransactionT m)) (Col SQLite (ID DbDesk))
 -> SeldaTransactionT m [Res (Col SQLite (ID DbDesk))])
-> Query (Backend (SeldaTransactionT m)) (Col SQLite (ID DbDesk))
-> SeldaTransactionT m [Res (Col SQLite (ID 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 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 DbDesk
dbDesk Row SQLite DbDesk
-> Selector DbDesk (ID DbSpace) -> Col SQLite (ID DbSpace)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbDesk (ID DbSpace)
#dbDesk_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..== ID DbSpace -> Col SQLite (ID DbSpace)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbSpace (Int64 -> ID DbSpace) -> Int64 -> ID DbSpace
forall a b. (a -> b) -> a -> b
$ IdentifierSpace -> Int64
unIdentifierSpace IdentifierSpace
identifier)
    Col SQLite (ID DbDesk) -> Query SQLite (Col SQLite (ID DbDesk))
forall a. a -> Query SQLite a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Col SQLite (ID DbDesk) -> Query SQLite (Col SQLite (ID DbDesk)))
-> Col SQLite (ID DbDesk) -> Query SQLite (Col SQLite (ID DbDesk))
forall a b. (a -> b) -> a -> b
$ 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
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Deleting desks."
  (ID DbDesk -> SeldaTransactionT m ())
-> [ID DbDesk] -> SeldaTransactionT m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IdentifierDesk -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierDesk -> SeldaTransactionT m ()
deskDelete (IdentifierDesk -> SeldaTransactionT m ())
-> (ID DbDesk -> IdentifierDesk)
-> ID DbDesk
-> SeldaTransactionT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> IdentifierDesk
MkIdentifierDesk (Int64 -> IdentifierDesk)
-> (ID DbDesk -> Int64) -> ID DbDesk -> IdentifierDesk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ID a -> Int64
Selda.fromId @DbDesk) [ID DbDesk]
dbDeskIdentifiers
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Deleted " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show ([ID DbDesk] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ID DbDesk]
dbDeskIdentifiers)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" desks."
  Int
countMembers <- Table DbSpaceUser
-> (Row (Backend (SeldaTransactionT m)) DbSpaceUser
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> SeldaTransactionT m Int
forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a -> (Row (Backend m) a -> Col (Backend m) Bool) -> m Int
Selda.deleteFrom Table DbSpaceUser
tableSpaceUser ((Row (Backend (SeldaTransactionT m)) DbSpaceUser
  -> Col (Backend (SeldaTransactionT m)) Bool)
 -> SeldaTransactionT m Int)
-> (Row (Backend (SeldaTransactionT m)) DbSpaceUser
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> SeldaTransactionT m Int
forall a b. (a -> b) -> a -> b
$ \Row (Backend (SeldaTransactionT m)) DbSpaceUser
row ->
    Row (Backend (SeldaTransactionT m)) DbSpaceUser
Row SQLite DbSpaceUser
row 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 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..== ID DbSpace -> Col SQLite (ID DbSpace)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbSpace (Int64 -> ID DbSpace) -> Int64 -> ID DbSpace
forall a b. (a -> b) -> a -> b
$ IdentifierSpace -> Int64
unIdentifierSpace IdentifierSpace
identifier)
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Space had " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
countMembers) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" memberships."
  [ID DbRole]
dbRoleIdentifiers <- Query (Backend (SeldaTransactionT m)) (Col SQLite (ID DbRole))
-> SeldaTransactionT m [Res (Col SQLite (ID DbRole))]
forall (m :: * -> *) a.
(MonadSelda m, Result a) =>
Query (Backend m) a -> m [Res a]
Selda.query (Query (Backend (SeldaTransactionT m)) (Col SQLite (ID DbRole))
 -> SeldaTransactionT m [Res (Col SQLite (ID DbRole))])
-> Query (Backend (SeldaTransactionT m)) (Col SQLite (ID DbRole))
-> SeldaTransactionT m [Res (Col SQLite (ID DbRole))]
forall a b. (a -> b) -> a -> b
$ do
    Row SQLite DbRole
dbDesk <- 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
dbDesk 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..== ID DbSpace -> Col SQLite (ID DbSpace)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbSpace (Int64 -> ID DbSpace) -> Int64 -> ID DbSpace
forall a b. (a -> b) -> a -> b
$ IdentifierSpace -> Int64
unIdentifierSpace IdentifierSpace
identifier)
    Col SQLite (ID DbRole) -> Query SQLite (Col SQLite (ID DbRole))
forall a. a -> Query SQLite a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Col SQLite (ID DbRole) -> Query SQLite (Col SQLite (ID DbRole)))
-> Col SQLite (ID DbRole) -> Query SQLite (Col SQLite (ID DbRole))
forall a b. (a -> b) -> a -> b
$ Row SQLite DbRole
dbDesk 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
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Deleting roles."
  (ID DbRole -> SeldaTransactionT m ())
-> [ID DbRole] -> SeldaTransactionT m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IdentifierRole -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole -> SeldaTransactionT m ()
roleDeleteUnsafe (IdentifierRole -> SeldaTransactionT m ())
-> (ID DbRole -> IdentifierRole)
-> ID DbRole
-> SeldaTransactionT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> IdentifierRole
MkIdentifierRole (Int64 -> IdentifierRole)
-> (ID DbRole -> Int64) -> ID DbRole -> IdentifierRole
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ID a -> Int64
Selda.fromId @DbRole) [ID DbRole]
dbRoleIdentifiers
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Space had " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show ([ID DbRole] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ID DbRole]
dbRoleIdentifiers)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" roles."
  Table DbSpace
-> (Row (Backend (SeldaTransactionT m)) DbSpace
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> SeldaTransactionT m ()
forall (m :: * -> *) a.
(MonadSelda m, MonadThrow m, Relational a) =>
Table a -> (Row (Backend m) a -> Col (Backend m) Bool) -> m ()
Selda.deleteOneFrom Table DbSpace
tableSpace ((Row (Backend (SeldaTransactionT m)) DbSpace
  -> Col (Backend (SeldaTransactionT m)) Bool)
 -> SeldaTransactionT m ())
-> (Row (Backend (SeldaTransactionT m)) DbSpace
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ \Row (Backend (SeldaTransactionT m)) DbSpace
row ->
    Row (Backend (SeldaTransactionT m)) DbSpace
Row SQLite DbSpace
row Row SQLite DbSpace
-> Selector DbSpace (ID DbSpace) -> Col SQLite (ID DbSpace)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbSpace (ID DbSpace)
#dbSpace_id 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..== ID DbSpace -> Col SQLite (ID DbSpace)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbSpace (Int64 -> ID DbSpace) -> Int64 -> ID DbSpace
forall a b. (a -> b) -> a -> b
$ IdentifierSpace -> Int64
unIdentifierSpace IdentifierSpace
identifier)
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Deleted space successfully."
  () -> SeldaTransactionT m ()
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

spaceNameSet ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierSpace ->
  NameSpace ->
  SeldaTransactionT m ()
spaceNameSet :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> NameSpace -> SeldaTransactionT m ()
spaceNameSet IdentifierSpace
identifier NameSpace
name = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Setting name " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (NameSpace -> String
forall a. Show a => a -> String
show NameSpace
name) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" of space " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierSpace -> String
forall a. Show a => a -> String
show IdentifierSpace
identifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
  Table DbSpace
-> (Row (Backend (SeldaTransactionT m)) DbSpace
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> (Row (Backend (SeldaTransactionT m)) DbSpace
    -> Row (Backend (SeldaTransactionT m)) DbSpace)
-> SeldaTransactionT m ()
forall (m :: * -> *) a.
(MonadSelda m, MonadThrow m, Relational a) =>
Table a
-> (Row (Backend m) a -> Col (Backend m) Bool)
-> (Row (Backend m) a -> Row (Backend m) a)
-> m ()
Selda.updateOne
    Table DbSpace
tableSpace
    (Selector DbSpace (ID DbSpace)
#dbSpace_id Selector DbSpace (ID DbSpace)
-> ID DbSpace -> Row SQLite DbSpace -> Col SQLite Bool
forall r s c.
SqlType c =>
Selector r c -> c -> Row s r -> Col s Bool
`Selda.is` forall a. Int64 -> ID a
Selda.toId @DbSpace (IdentifierSpace -> Int64
unIdentifierSpace IdentifierSpace
identifier))
    (\Row (Backend (SeldaTransactionT m)) DbSpace
rowSpace -> Row (Backend (SeldaTransactionT m)) DbSpace
Row SQLite DbSpace
rowSpace Row SQLite DbSpace
-> [Assignment SQLite DbSpace] -> Row SQLite DbSpace
forall s a. Row s a -> [Assignment s a] -> Row s a
`Selda.with` [Selector DbSpace Text
#dbSpace_name Selector DbSpace Text
-> Col SQLite Text -> Assignment SQLite DbSpace
forall a a1 s. Selector a a1 -> Col s a1 -> Assignment s a
Selda.:= Text -> Col SQLite Text
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (NameSpace -> Text
unNameSpace NameSpace
name)])
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Set name successfully."

spaceTimezoneSet ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierSpace ->
  T.TZLabel ->
  SeldaTransactionT m ()
spaceTimezoneSet :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> TZLabel -> SeldaTransactionT m ()
spaceTimezoneSet IdentifierSpace
identifier TZLabel
timezone = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Setting timezone " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TZLabel -> String
forall a. Show a => a -> String
show TZLabel
timezone) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" of space " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierSpace -> String
forall a. Show a => a -> String
show IdentifierSpace
identifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
  Table DbSpace
-> (Row (Backend (SeldaTransactionT m)) DbSpace
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> (Row (Backend (SeldaTransactionT m)) DbSpace
    -> Row (Backend (SeldaTransactionT m)) DbSpace)
-> SeldaTransactionT m ()
forall (m :: * -> *) a.
(MonadSelda m, MonadThrow m, Relational a) =>
Table a
-> (Row (Backend m) a -> Col (Backend m) Bool)
-> (Row (Backend m) a -> Row (Backend m) a)
-> m ()
Selda.updateOne
    Table DbSpace
tableSpace
    (Selector DbSpace (ID DbSpace)
#dbSpace_id Selector DbSpace (ID DbSpace)
-> ID DbSpace -> Row SQLite DbSpace -> Col SQLite Bool
forall r s c.
SqlType c =>
Selector r c -> c -> Row s r -> Col s Bool
`Selda.is` forall a. Int64 -> ID a
Selda.toId @DbSpace (IdentifierSpace -> Int64
unIdentifierSpace IdentifierSpace
identifier))
    (\Row (Backend (SeldaTransactionT m)) DbSpace
rowSpace -> Row (Backend (SeldaTransactionT m)) DbSpace
Row SQLite DbSpace
rowSpace Row SQLite DbSpace
-> [Assignment SQLite DbSpace] -> Row SQLite DbSpace
forall s a. Row s a -> [Assignment s a] -> Row s a
`Selda.with` [Selector DbSpace TZLabel
#dbSpace_timezone Selector DbSpace TZLabel
-> Col SQLite TZLabel -> Assignment SQLite DbSpace
forall a a1 s. Selector a a1 -> Col s a1 -> Assignment s a
Selda.:= TZLabel -> Col SQLite TZLabel
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal TZLabel
timezone])
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Set timezone successfully."

spaceVisibilitySet ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierSpace ->
  VisibilitySpace ->
  SeldaTransactionT m ()
spaceVisibilitySet :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> VisibilitySpace -> SeldaTransactionT m ()
spaceVisibilitySet IdentifierSpace
identifier VisibilitySpace
visibility = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Setting visibility " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (VisibilitySpace -> String
forall a. Show a => a -> String
show VisibilitySpace
visibility) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" of space " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierSpace -> String
forall a. Show a => a -> String
show IdentifierSpace
identifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
  Table DbSpace
-> (Row (Backend (SeldaTransactionT m)) DbSpace
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> (Row (Backend (SeldaTransactionT m)) DbSpace
    -> Row (Backend (SeldaTransactionT m)) DbSpace)
-> SeldaTransactionT m ()
forall (m :: * -> *) a.
(MonadSelda m, MonadThrow m, Relational a) =>
Table a
-> (Row (Backend m) a -> Col (Backend m) Bool)
-> (Row (Backend m) a -> Row (Backend m) a)
-> m ()
Selda.updateOne
    Table DbSpace
tableSpace
    (Selector DbSpace (ID DbSpace)
#dbSpace_id Selector DbSpace (ID DbSpace)
-> ID DbSpace -> Row SQLite DbSpace -> Col SQLite Bool
forall r s c.
SqlType c =>
Selector r c -> c -> Row s r -> Col s Bool
`Selda.is` forall a. Int64 -> ID a
Selda.toId @DbSpace (IdentifierSpace -> Int64
unIdentifierSpace IdentifierSpace
identifier))
    (\Row (Backend (SeldaTransactionT m)) DbSpace
rowSpace -> Row (Backend (SeldaTransactionT m)) DbSpace
Row SQLite DbSpace
rowSpace Row SQLite DbSpace
-> [Assignment SQLite DbSpace] -> Row SQLite DbSpace
forall s a. Row s a -> [Assignment s a] -> Row s a
`Selda.with` [Selector DbSpace DbSpaceVisibility
#dbSpace_visibility Selector DbSpace DbSpaceVisibility
-> Col SQLite DbSpaceVisibility -> Assignment SQLite DbSpace
forall a a1 s. Selector a a1 -> Col s a1 -> Assignment s a
Selda.:= DbSpaceVisibility -> Col SQLite DbSpaceVisibility
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (VisibilitySpace -> DbSpaceVisibility
spaceVisibilityApiToDb VisibilitySpace
visibility)])
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Set visibility successfully."

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

spaceGetPicture ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierSpace ->
  SeldaTransactionT m (Maybe ByteStringJpeg)
spaceGetPicture :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> SeldaTransactionT m (Maybe ByteStringJpeg)
spaceGetPicture IdentifierSpace
identifier = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Get space picture."
  Maybe ByteString
picture <- Query
  (Backend (SeldaTransactionT m)) (Col SQLite (Maybe ByteString))
-> SeldaTransactionT m (Res (Col SQLite (Maybe ByteString)))
forall (m :: * -> *) a.
(MonadSelda m, MonadCatch m, Result a) =>
Query (Backend m) a -> m (Res a)
Selda.queryOne (Query
   (Backend (SeldaTransactionT m)) (Col SQLite (Maybe ByteString))
 -> SeldaTransactionT m (Res (Col SQLite (Maybe ByteString))))
-> Query
     (Backend (SeldaTransactionT m)) (Col SQLite (Maybe ByteString))
-> SeldaTransactionT m (Res (Col SQLite (Maybe ByteString)))
forall a b. (a -> b) -> a -> b
$ do
    Row SQLite DbSpace
space <- Table DbSpace -> Query SQLite (Row SQLite DbSpace)
forall a s. Relational a => Table a -> Query s (Row s a)
Selda.select Table DbSpace
tableSpace
    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 DbSpace
space Row SQLite DbSpace
-> Selector DbSpace (ID DbSpace) -> Col SQLite (ID DbSpace)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbSpace (ID DbSpace)
#dbSpace_id 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..== ID DbSpace -> Col SQLite (ID DbSpace)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbSpace (Int64 -> ID DbSpace) -> Int64 -> ID DbSpace
forall a b. (a -> b) -> a -> b
$ IdentifierSpace -> Int64
unIdentifierSpace IdentifierSpace
identifier)
    Col SQLite (Maybe ByteString)
-> Query SQLite (Col SQLite (Maybe ByteString))
forall a. a -> Query SQLite a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Col SQLite (Maybe ByteString)
 -> Query SQLite (Col SQLite (Maybe ByteString)))
-> Col SQLite (Maybe ByteString)
-> Query SQLite (Col SQLite (Maybe ByteString))
forall a b. (a -> b) -> a -> b
$ Row SQLite DbSpace
space Row SQLite DbSpace
-> Selector DbSpace (Maybe ByteString)
-> Col SQLite (Maybe ByteString)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbSpace (Maybe ByteString)
#dbSpace_picture_jpeg
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Got space picture successfully."
  Maybe ByteStringJpeg -> SeldaTransactionT m (Maybe ByteStringJpeg)
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteStringJpeg
 -> SeldaTransactionT m (Maybe ByteStringJpeg))
-> Maybe ByteStringJpeg
-> SeldaTransactionT m (Maybe ByteStringJpeg)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteStringJpeg
MkByteStringJpegUnsafe (ByteString -> ByteStringJpeg)
-> (ByteString -> ByteString) -> ByteString -> ByteStringJpeg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict (ByteString -> ByteStringJpeg)
-> Maybe ByteString -> Maybe ByteStringJpeg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
picture

spaceUserAdd ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierSpace ->
  IdentifierUser ->
  IdentifierRole ->
  SeldaTransactionT m ()
spaceUserAdd :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace
-> IdentifierUser -> IdentifierRole -> SeldaTransactionT m ()
spaceUserAdd IdentifierSpace
spaceIdentifier IdentifierUser
userIdentifier IdentifierRole
roleIdentifier = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Adding user " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierUser -> String
forall a. Show a => a -> String
show IdentifierUser
userIdentifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to space " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierSpace -> String
forall a. Show a => a -> String
show IdentifierSpace
spaceIdentifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" as " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierRole -> String
forall a. Show a => a -> String
show IdentifierRole
roleIdentifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Ensuring that the role is of the right space."
  Bool
roleBelongsToSpace <- do
    DbRole
dbRole <- Query (Backend (SeldaTransactionT m)) (Row SQLite DbRole)
-> SeldaTransactionT m (Res (Row SQLite DbRole))
forall (m :: * -> *) a.
(MonadSelda m, MonadCatch m, Result a) =>
Query (Backend m) a -> m (Res a)
Selda.queryOne (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
      ID DbRole
-> Query
     (Backend (SeldaTransactionT m))
     (Row (Backend (SeldaTransactionT m)) DbRole)
forall backend. ID DbRole -> Query backend (Row backend DbRole)
spaceRoleGet (ID DbRole
 -> Query
      (Backend (SeldaTransactionT m))
      (Row (Backend (SeldaTransactionT m)) DbRole))
-> ID DbRole
-> Query
     (Backend (SeldaTransactionT m))
     (Row (Backend (SeldaTransactionT m)) DbRole)
forall a b. (a -> b) -> a -> b
$ forall a. Int64 -> ID a
Selda.toId @DbRole (Int64 -> ID DbRole) -> Int64 -> ID DbRole
forall a b. (a -> b) -> a -> b
$ IdentifierRole -> Int64
unIdentifierRole IdentifierRole
roleIdentifier
    let roleSpaceId :: IdentifierSpace
roleSpaceId = Int64 -> IdentifierSpace
MkIdentifierSpace (Int64 -> IdentifierSpace) -> Int64 -> IdentifierSpace
forall a b. (a -> b) -> a -> b
$ forall a. ID a -> Int64
Selda.fromId @DbSpace (ID DbSpace -> Int64) -> ID DbSpace -> Int64
forall a b. (a -> b) -> a -> b
$ DbRole -> ID DbSpace
dbRole_space DbRole
dbRole
    Bool -> SeldaTransactionT m Bool
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> SeldaTransactionT m Bool)
-> Bool -> SeldaTransactionT m Bool
forall a b. (a -> b) -> a -> b
$ IdentifierSpace
roleSpaceId IdentifierSpace -> IdentifierSpace -> Bool
forall a. Eq a => a -> a -> Bool
== IdentifierSpace
spaceIdentifier
  Bool -> SeldaTransactionT m () -> SeldaTransactionT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
roleBelongsToSpace SeldaTransactionT m ()
forall a. HasCallStack => a
undefined -- TODO: Use an actual Exception type.
  let dbSpaceUser :: DbSpaceUser
dbSpaceUser =
        MkDbSpaceUser
          { dbSpaceUser_id :: ID DbSpaceUser
dbSpaceUser_id = ID DbSpaceUser
forall a. SqlType a => a
Selda.def
          , dbSpaceUser_space :: ID DbSpace
dbSpaceUser_space = forall a. Int64 -> ID a
Selda.toId @DbSpace (Int64 -> ID DbSpace) -> Int64 -> ID DbSpace
forall a b. (a -> b) -> a -> b
$ IdentifierSpace -> Int64
unIdentifierSpace IdentifierSpace
spaceIdentifier
          , dbSpaceUser_user :: ID DbUser
dbSpaceUser_user = forall a. Int64 -> ID a
Selda.toId @DbUser (Int64 -> ID DbUser) -> Int64 -> ID DbUser
forall a b. (a -> b) -> a -> b
$ IdentifierUser -> Int64
unIdentifierUser IdentifierUser
userIdentifier
          , dbSpaceUser_role :: ID DbRole
dbSpaceUser_role = forall a. Int64 -> ID a
Selda.toId @DbRole (Int64 -> ID DbRole) -> Int64 -> ID DbRole
forall a b. (a -> b) -> a -> b
$ IdentifierRole -> Int64
unIdentifierRole IdentifierRole
roleIdentifier
          }
  ID DbSpaceUser
_dbSpaceUserId <- Table DbSpaceUser
-> [DbSpaceUser] -> SeldaTransactionT m (ID DbSpaceUser)
forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a -> [a] -> m (ID a)
Selda.insertWithPK Table DbSpaceUser
tableSpaceUser [DbSpaceUser
dbSpaceUser]
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Created space-user successfully."
  () -> SeldaTransactionT m ()
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

spaceUserRemove ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierSpace ->
  IdentifierUser ->
  SeldaTransactionT m ()
spaceUserRemove :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> IdentifierUser -> SeldaTransactionT m ()
spaceUserRemove IdentifierSpace
spaceIdentifier IdentifierUser
userIdentifier = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Removing user " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierUser -> String
forall a. Show a => a -> String
show IdentifierUser
userIdentifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" from space " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierSpace -> String
forall a. Show a => a -> String
show IdentifierSpace
spaceIdentifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
  DbSpaceUser
dbSpaceUser <- Query (Backend (SeldaTransactionT m)) (Row SQLite DbSpaceUser)
-> SeldaTransactionT m (Res (Row SQLite DbSpaceUser))
forall (m :: * -> *) a.
(MonadSelda m, MonadCatch m, Result a) =>
Query (Backend m) a -> m (Res a)
Selda.queryOne (Query (Backend (SeldaTransactionT m)) (Row SQLite DbSpaceUser)
 -> SeldaTransactionT m (Res (Row SQLite DbSpaceUser)))
-> Query (Backend (SeldaTransactionT m)) (Row SQLite DbSpaceUser)
-> SeldaTransactionT m (Res (Row SQLite DbSpaceUser))
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
    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 DbSpaceUser
dbSpaceUser Row SQLite DbSpaceUser
-> Selector DbSpaceUser (ID DbUser) -> Col SQLite (ID DbUser)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbSpaceUser (ID DbUser)
#dbSpaceUser_user Col SQLite (ID DbUser) -> Col SQLite (ID DbUser) -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda..== ID DbUser -> Col SQLite (ID DbUser)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbUser (Int64 -> ID DbUser) -> Int64 -> ID DbUser
forall a b. (a -> b) -> a -> b
$ IdentifierUser -> Int64
unIdentifierUser IdentifierUser
userIdentifier)
    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 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 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..== ID DbSpace -> Col SQLite (ID DbSpace)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbSpace (Int64 -> ID DbSpace) -> Int64 -> ID DbSpace
forall a b. (a -> b) -> a -> b
$ IdentifierSpace -> Int64
unIdentifierSpace IdentifierSpace
spaceIdentifier)
    Row SQLite DbSpaceUser -> Query SQLite (Row SQLite DbSpaceUser)
forall a. a -> Query SQLite a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Row SQLite DbSpaceUser
dbSpaceUser
  Table DbSpaceUser
-> (Row (Backend (SeldaTransactionT m)) DbSpaceUser
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> SeldaTransactionT m ()
forall (m :: * -> *) a.
(MonadSelda m, MonadThrow m, Relational a) =>
Table a -> (Row (Backend m) a -> Col (Backend m) Bool) -> m ()
Selda.deleteOneFrom Table DbSpaceUser
tableSpaceUser ((Row (Backend (SeldaTransactionT m)) DbSpaceUser
  -> Col (Backend (SeldaTransactionT m)) Bool)
 -> SeldaTransactionT m ())
-> (Row (Backend (SeldaTransactionT m)) DbSpaceUser
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ \Row (Backend (SeldaTransactionT m)) DbSpaceUser
row -> Row (Backend (SeldaTransactionT m)) DbSpaceUser
Row SQLite DbSpaceUser
row Row SQLite DbSpaceUser
-> Selector DbSpaceUser (ID DbSpaceUser)
-> Col SQLite (ID DbSpaceUser)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbSpaceUser (ID DbSpaceUser)
#dbSpaceUser_id Col SQLite (ID DbSpaceUser)
-> Col SQLite (ID DbSpaceUser) -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda..== ID DbSpaceUser -> Col SQLite (ID DbSpaceUser)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (DbSpaceUser -> ID DbSpaceUser
dbSpaceUser_id DbSpaceUser
dbSpaceUser)
  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
"Removed space-user successfully."
  () -> SeldaTransactionT m ()
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

spaceUserRoleEdit ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierSpace ->
  IdentifierUser ->
  IdentifierRole ->
  SeldaTransactionT m ()
spaceUserRoleEdit :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace
-> IdentifierUser -> IdentifierRole -> SeldaTransactionT m ()
spaceUserRoleEdit IdentifierSpace
spaceIdentifier IdentifierUser
userIdentifier IdentifierRole
roleIdentifier = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Setting new role " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierRole -> String
forall a. Show a => a -> String
show IdentifierRole
roleIdentifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" for user " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierUser -> String
forall a. Show a => a -> String
show IdentifierUser
userIdentifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" from space " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierSpace -> String
forall a. Show a => a -> String
show IdentifierSpace
spaceIdentifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Ensuring that the role is of the right space."
  Bool
roleBelongsToSpace <- do
    DbRole
dbRole <- Query (Backend (SeldaTransactionT m)) (Row SQLite DbRole)
-> SeldaTransactionT m (Res (Row SQLite DbRole))
forall (m :: * -> *) a.
(MonadSelda m, MonadCatch m, Result a) =>
Query (Backend m) a -> m (Res a)
Selda.queryOne (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
      ID DbRole
-> Query
     (Backend (SeldaTransactionT m))
     (Row (Backend (SeldaTransactionT m)) DbRole)
forall backend. ID DbRole -> Query backend (Row backend DbRole)
spaceRoleGet (ID DbRole
 -> Query
      (Backend (SeldaTransactionT m))
      (Row (Backend (SeldaTransactionT m)) DbRole))
-> ID DbRole
-> Query
     (Backend (SeldaTransactionT m))
     (Row (Backend (SeldaTransactionT m)) DbRole)
forall a b. (a -> b) -> a -> b
$ forall a. Int64 -> ID a
Selda.toId @DbRole (Int64 -> ID DbRole) -> Int64 -> ID DbRole
forall a b. (a -> b) -> a -> b
$ IdentifierRole -> Int64
unIdentifierRole IdentifierRole
roleIdentifier
    let roleSpaceId :: IdentifierSpace
roleSpaceId = Int64 -> IdentifierSpace
MkIdentifierSpace (Int64 -> IdentifierSpace) -> Int64 -> IdentifierSpace
forall a b. (a -> b) -> a -> b
$ forall a. ID a -> Int64
Selda.fromId @DbSpace (ID DbSpace -> Int64) -> ID DbSpace -> Int64
forall a b. (a -> b) -> a -> b
$ DbRole -> ID DbSpace
dbRole_space DbRole
dbRole
    Bool -> SeldaTransactionT m Bool
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> SeldaTransactionT m Bool)
-> Bool -> SeldaTransactionT m Bool
forall a b. (a -> b) -> a -> b
$ IdentifierSpace
roleSpaceId IdentifierSpace -> IdentifierSpace -> Bool
forall a. Eq a => a -> a -> Bool
== IdentifierSpace
spaceIdentifier
  Bool -> SeldaTransactionT m () -> SeldaTransactionT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
roleBelongsToSpace SeldaTransactionT m ()
forall a. HasCallStack => a
undefined -- TODO: Use an actual Exception type.
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Updating the role."
  DbSpaceUser
dbSpaceUser <- Query (Backend (SeldaTransactionT m)) (Row SQLite DbSpaceUser)
-> SeldaTransactionT m (Res (Row SQLite DbSpaceUser))
forall (m :: * -> *) a.
(MonadSelda m, MonadCatch m, Result a) =>
Query (Backend m) a -> m (Res a)
Selda.queryOne (Query (Backend (SeldaTransactionT m)) (Row SQLite DbSpaceUser)
 -> SeldaTransactionT m (Res (Row SQLite DbSpaceUser)))
-> Query (Backend (SeldaTransactionT m)) (Row SQLite DbSpaceUser)
-> SeldaTransactionT m (Res (Row SQLite DbSpaceUser))
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
    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 DbSpaceUser
dbSpaceUser Row SQLite DbSpaceUser
-> Selector DbSpaceUser (ID DbUser) -> Col SQLite (ID DbUser)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbSpaceUser (ID DbUser)
#dbSpaceUser_user Col SQLite (ID DbUser) -> Col SQLite (ID DbUser) -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda..== ID DbUser -> Col SQLite (ID DbUser)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbUser (Int64 -> ID DbUser) -> Int64 -> ID DbUser
forall a b. (a -> b) -> a -> b
$ IdentifierUser -> Int64
unIdentifierUser IdentifierUser
userIdentifier)
    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 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 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..== ID DbSpace -> Col SQLite (ID DbSpace)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbSpace (Int64 -> ID DbSpace) -> Int64 -> ID DbSpace
forall a b. (a -> b) -> a -> b
$ IdentifierSpace -> Int64
unIdentifierSpace IdentifierSpace
spaceIdentifier)
    Row SQLite DbSpaceUser -> Query SQLite (Row SQLite DbSpaceUser)
forall a. a -> Query SQLite a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Row SQLite DbSpaceUser
dbSpaceUser
  Table DbSpaceUser
-> (Row (Backend (SeldaTransactionT m)) DbSpaceUser
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> (Row (Backend (SeldaTransactionT m)) DbSpaceUser
    -> Row (Backend (SeldaTransactionT m)) DbSpaceUser)
-> SeldaTransactionT m ()
forall (m :: * -> *) a.
(MonadSelda m, MonadThrow m, Relational a) =>
Table a
-> (Row (Backend m) a -> Col (Backend m) Bool)
-> (Row (Backend m) a -> Row (Backend m) a)
-> m ()
Selda.updateOne
    Table DbSpaceUser
tableSpaceUser
    (Selector DbSpaceUser (ID DbSpaceUser)
#dbSpaceUser_id Selector DbSpaceUser (ID DbSpaceUser)
-> ID DbSpaceUser -> Row SQLite DbSpaceUser -> Col SQLite Bool
forall r s c.
SqlType c =>
Selector r c -> c -> Row s r -> Col s Bool
`Selda.is` DbSpaceUser -> ID DbSpaceUser
dbSpaceUser_id DbSpaceUser
dbSpaceUser)
    (\Row (Backend (SeldaTransactionT m)) DbSpaceUser
rowSpaceUser -> Row (Backend (SeldaTransactionT m)) DbSpaceUser
Row SQLite DbSpaceUser
rowSpaceUser Row SQLite DbSpaceUser
-> [Assignment SQLite DbSpaceUser] -> Row SQLite DbSpaceUser
forall s a. Row s a -> [Assignment s a] -> Row s a
`Selda.with` [Selector DbSpaceUser (ID DbRole)
#dbSpaceUser_role Selector DbSpaceUser (ID DbRole)
-> Col SQLite (ID DbRole) -> Assignment SQLite DbSpaceUser
forall a a1 s. Selector a a1 -> Col s a1 -> Assignment s a
Selda.:= ID DbRole -> Col SQLite (ID DbRole)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbRole (Int64 -> ID DbRole) -> Int64 -> ID DbRole
forall a b. (a -> b) -> a -> b
$ IdentifierRole -> Int64
unIdentifierRole IdentifierRole
roleIdentifier)])
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Set new role for space-user successfully."
  () -> SeldaTransactionT m ()
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

spaceUserIsOwner ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierSpace ->
  IdentifierUser ->
  SeldaTransactionT m Bool
spaceUserIsOwner :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> IdentifierUser -> SeldaTransactionT m Bool
spaceUserIsOwner IdentifierSpace
spaceIdentifier IdentifierUser
userIdentifier = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Looking up if user " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierUser -> String
forall a. Show a => a -> String
show IdentifierUser
userIdentifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is owner of space " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierSpace -> String
forall a. Show a => a -> String
show IdentifierSpace
spaceIdentifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
  Space
space <- IdentifierSpace -> SeldaTransactionT m Space
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> SeldaTransactionT m Space
spaceGetFromId IdentifierSpace
spaceIdentifier
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Looked up space ownership successfully."
  Bool -> SeldaTransactionT m Bool
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> SeldaTransactionT m Bool)
-> Bool -> SeldaTransactionT m Bool
forall a b. (a -> b) -> a -> b
$ Space -> IdentifierUser
spaceOwner Space
space IdentifierUser -> IdentifierUser -> Bool
forall a. Eq a => a -> a -> Bool
== IdentifierUser
userIdentifier

spaceUserPermissions ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierSpace ->
  IdentifierUser ->
  SeldaTransactionT m (S.Set Permission)
spaceUserPermissions :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace
-> IdentifierUser -> SeldaTransactionT m (Set Permission)
spaceUserPermissions IdentifierSpace
spaceIdentifier IdentifierUser
userIdentifier = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Looking up user " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierUser -> String
forall a. Show a => a -> String
show IdentifierUser
userIdentifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" permissions for space " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierSpace -> String
forall a. Show a => a -> String
show IdentifierSpace
spaceIdentifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
  [DbRolePermission]
permissions <-
    Query (Backend (SeldaTransactionT m)) (Row SQLite DbRolePermission)
-> SeldaTransactionT m [Res (Row SQLite DbRolePermission)]
forall (m :: * -> *) a.
(MonadSelda m, Result a) =>
Query (Backend m) a -> m [Res a]
Selda.query (Query
   (Backend (SeldaTransactionT m)) (Row SQLite DbRolePermission)
 -> SeldaTransactionT m [Res (Row SQLite DbRolePermission)])
-> Query
     (Backend (SeldaTransactionT m)) (Row SQLite DbRolePermission)
-> SeldaTransactionT m [Res (Row SQLite DbRolePermission)]
forall a b. (a -> b) -> a -> b
$
      ID DbSpace
-> ID DbUser -> Query SQLite (Row SQLite DbRolePermission)
forall backend.
ID DbSpace
-> ID DbUser -> Query backend (Row backend DbRolePermission)
spaceUserListPermissions
        (forall a. Int64 -> ID a
Selda.toId @DbSpace (Int64 -> ID DbSpace) -> Int64 -> ID DbSpace
forall a b. (a -> b) -> a -> b
$ IdentifierSpace -> Int64
unIdentifierSpace IdentifierSpace
spaceIdentifier)
        (forall a. Int64 -> ID a
Selda.toId @DbUser (Int64 -> ID DbUser) -> Int64 -> ID DbUser
forall a b. (a -> b) -> a -> b
$ IdentifierUser -> Int64
unIdentifierUser IdentifierUser
userIdentifier)
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Looked up space permissions successfully."
  Set Permission -> SeldaTransactionT m (Set Permission)
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set Permission -> SeldaTransactionT m (Set Permission))
-> Set Permission -> SeldaTransactionT m (Set Permission)
forall a b. (a -> b) -> a -> b
$ [Permission] -> Set Permission
forall a. Ord a => [a] -> Set a
S.fromList ([Permission] -> Set Permission) -> [Permission] -> Set Permission
forall a b. (a -> b) -> a -> b
$ DbPermission -> Permission
spacePermissionDbToApi (DbPermission -> Permission)
-> (DbRolePermission -> DbPermission)
-> DbRolePermission
-> Permission
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DbRolePermission -> DbPermission
dbRolePermission_permission (DbRolePermission -> Permission)
-> [DbRolePermission] -> [Permission]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DbRolePermission]
permissions

roleCreate ::
  (MonadIO m, MonadLogger m, MonadSeldaPool m) =>
  IdentifierSpace ->
  NameRole ->
  AccessibilityRole ->
  Maybe Password ->
  SeldaTransactionT m IdentifierRole
roleCreate :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace
-> NameRole
-> AccessibilityRole
-> Maybe Password
-> SeldaTransactionT m IdentifierRole
roleCreate IdentifierSpace
spaceIdentifier NameRole
roleName AccessibilityRole
accessibility Maybe Password
password = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Creating role: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack ((IdentifierSpace, NameRole) -> String
forall a. Show a => a -> String
show (IdentifierSpace
spaceIdentifier, NameRole
roleName))
  Maybe (PasswordHash Bcrypt)
maybePasswordHash :: Maybe (PasswordHash Bcrypt) <- do
    m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Confirming that accessibility and password_hash match."
    let accessibilityMatchesPassword :: Bool
accessibilityMatchesPassword =
          case AccessibilityRole
accessibility of
            AccessibilityRole
MkAccessibilityRoleJoinable -> Maybe Password -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Password
password
            AccessibilityRole
MkAccessibilityRoleJoinableWithPassword -> Maybe Password -> Bool
forall a. Maybe a -> Bool
isJust Maybe Password
password
            AccessibilityRole
MkAccessibilityRoleInaccessible -> Maybe Password -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Password
password
    if Bool
accessibilityMatchesPassword
      then m (Maybe (PasswordHash Bcrypt))
-> SeldaTransactionT m (Maybe (PasswordHash Bcrypt))
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 (Maybe (PasswordHash Bcrypt))
 -> SeldaTransactionT m (Maybe (PasswordHash Bcrypt)))
-> m (Maybe (PasswordHash Bcrypt))
-> SeldaTransactionT m (Maybe (PasswordHash Bcrypt))
forall a b. (a -> b) -> a -> b
$ (Password -> m (PasswordHash Bcrypt))
-> Maybe Password -> m (Maybe (PasswordHash Bcrypt))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse Password -> m (PasswordHash Bcrypt)
forall (m :: * -> *).
MonadIO m =>
Password -> m (PasswordHash Bcrypt)
hashPassword Maybe Password
password
      else SqlErrorMensamRoleAccessibilityAndPasswordDontMatch
-> SeldaTransactionT m (Maybe (PasswordHash Bcrypt))
forall e a.
(HasCallStack, Exception e) =>
e -> SeldaTransactionT m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM SqlErrorMensamRoleAccessibilityAndPasswordDontMatch
MkSqlErrorMensamRoleAccessibilityAndPasswordDontMatch
  let dbRole :: DbRole
dbRole =
        MkDbRole
          { dbRole_id :: ID DbRole
dbRole_id = ID DbRole
forall a. SqlType a => a
Selda.def
          , dbRole_space :: ID DbSpace
dbRole_space = forall a. Int64 -> ID a
Selda.toId @DbSpace (Int64 -> ID DbSpace) -> Int64 -> ID DbSpace
forall a b. (a -> b) -> a -> b
$ IdentifierSpace -> Int64
unIdentifierSpace IdentifierSpace
spaceIdentifier
          , dbRole_name :: Text
dbRole_name = NameRole -> Text
unNameRole NameRole
roleName
          , dbRole_accessibility :: DbRoleAccessibility
dbRole_accessibility = AccessibilityRole -> DbRoleAccessibility
roleAccessibilityApiToDb AccessibilityRole
accessibility
          , dbRole_password_hash :: Maybe Text
dbRole_password_hash = PasswordHash Bcrypt -> Text
forall a. PasswordHash a -> Text
unPasswordHash (PasswordHash Bcrypt -> Text)
-> Maybe (PasswordHash Bcrypt) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (PasswordHash Bcrypt)
maybePasswordHash
          }
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Inserting space-role into database."
  ID DbRole
dbRoleId <- Table DbRole -> [DbRole] -> SeldaTransactionT m (ID DbRole)
forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a -> [a] -> m (ID a)
Selda.insertWithPK Table DbRole
tableRole [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 ()
logInfo Text
"Created role successfully."
  IdentifierRole -> SeldaTransactionT m IdentifierRole
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IdentifierRole -> SeldaTransactionT m IdentifierRole)
-> IdentifierRole -> SeldaTransactionT m IdentifierRole
forall a b. (a -> b) -> a -> b
$ Int64 -> IdentifierRole
MkIdentifierRole (Int64 -> IdentifierRole) -> Int64 -> IdentifierRole
forall a b. (a -> b) -> a -> b
$ forall a. ID a -> Int64
Selda.fromId @DbRole ID DbRole
dbRoleId

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

roleDeleteUnsafe ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierRole ->
  SeldaTransactionT m ()
roleDeleteUnsafe :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole -> SeldaTransactionT m ()
roleDeleteUnsafe IdentifierRole
identifier = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Deleting role: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierRole -> String
forall a. Show a => a -> String
show IdentifierRole
identifier)
  Int
countPermissions <- Table DbRolePermission
-> (Row (Backend (SeldaTransactionT m)) DbRolePermission
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> SeldaTransactionT m Int
forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a -> (Row (Backend m) a -> Col (Backend m) Bool) -> m Int
Selda.deleteFrom Table DbRolePermission
tableRolePermission ((Row (Backend (SeldaTransactionT m)) DbRolePermission
  -> Col (Backend (SeldaTransactionT m)) Bool)
 -> SeldaTransactionT m Int)
-> (Row (Backend (SeldaTransactionT m)) DbRolePermission
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> SeldaTransactionT m Int
forall a b. (a -> b) -> a -> b
$ \Row (Backend (SeldaTransactionT m)) DbRolePermission
row ->
    Row (Backend (SeldaTransactionT m)) DbRolePermission
Row SQLite DbRolePermission
row Row SQLite DbRolePermission
-> Selector DbRolePermission (ID DbRole) -> Col SQLite (ID DbRole)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbRolePermission (ID DbRole)
#dbRolePermission_role 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..== ID DbRole -> Col SQLite (ID DbRole)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbRole (Int64 -> ID DbRole) -> Int64 -> ID DbRole
forall a b. (a -> b) -> a -> b
$ IdentifierRole -> Int64
unIdentifierRole IdentifierRole
identifier)
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Role had " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
countPermissions) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" permissions."
  Table DbRole
-> (Row (Backend (SeldaTransactionT m)) DbRole
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> SeldaTransactionT m ()
forall (m :: * -> *) a.
(MonadSelda m, MonadThrow m, Relational a) =>
Table a -> (Row (Backend m) a -> Col (Backend m) Bool) -> m ()
Selda.deleteOneFrom Table DbRole
tableRole ((Row (Backend (SeldaTransactionT m)) DbRole
  -> Col (Backend (SeldaTransactionT m)) Bool)
 -> SeldaTransactionT m ())
-> (Row (Backend (SeldaTransactionT m)) DbRole
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ \Row (Backend (SeldaTransactionT m)) DbRole
row ->
    Row (Backend (SeldaTransactionT m)) DbRole
Row SQLite DbRole
row 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..== ID DbRole -> Col SQLite (ID DbRole)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbRole (Int64 -> ID DbRole) -> Int64 -> ID DbRole
forall a b. (a -> b) -> a -> b
$ IdentifierRole -> Int64
unIdentifierRole IdentifierRole
identifier)
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Deleted role successfully."
  () -> SeldaTransactionT m ()
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

roleDeleteWithFallback ::
  (MonadLogger m, MonadSeldaPool m) =>
  -- | to be deleted
  IdentifierRole ->
  -- | fallback
  IdentifierRole ->
  SeldaTransactionT m ()
roleDeleteWithFallback :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole -> IdentifierRole -> SeldaTransactionT m ()
roleDeleteWithFallback IdentifierRole
identifierToDelete IdentifierRole
identifierFallback = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Deleting role " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierRole -> String
forall a. Show a => a -> String
show IdentifierRole
identifierToDelete) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with fallback " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierRole -> String
forall a. Show a => a -> String
show IdentifierRole
identifierFallback) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
  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
"Making sure that the fallback role is of the same space."
  if IdentifierRole
identifierToDelete IdentifierRole -> IdentifierRole -> Bool
forall a. Eq a => a -> a -> Bool
/= IdentifierRole
identifierFallback
    then 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
"The fallback role is different from the role that will be deleted."
    else String -> SeldaTransactionT m ()
forall a. HasCallStack => String -> a
error String
"Fallback is the same."
  DbRole
dbRoleToDelete <- Query (Backend (SeldaTransactionT m)) (Row SQLite DbRole)
-> SeldaTransactionT m (Res (Row SQLite DbRole))
forall (m :: * -> *) a.
(MonadSelda m, MonadCatch m, Result a) =>
Query (Backend m) a -> m (Res a)
Selda.queryOne (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
$ ID DbRole
-> Query
     (Backend (SeldaTransactionT m))
     (Row (Backend (SeldaTransactionT m)) DbRole)
forall backend. ID DbRole -> Query backend (Row backend DbRole)
spaceRoleGet (ID DbRole
 -> Query
      (Backend (SeldaTransactionT m))
      (Row (Backend (SeldaTransactionT m)) DbRole))
-> ID DbRole
-> Query
     (Backend (SeldaTransactionT m))
     (Row (Backend (SeldaTransactionT m)) DbRole)
forall a b. (a -> b) -> a -> b
$ forall a. Int64 -> ID a
Selda.toId @DbRole (Int64 -> ID DbRole) -> Int64 -> ID DbRole
forall a b. (a -> b) -> a -> b
$ IdentifierRole -> Int64
unIdentifierRole IdentifierRole
identifierToDelete
  DbRole
dbRoleFallback <- Query (Backend (SeldaTransactionT m)) (Row SQLite DbRole)
-> SeldaTransactionT m (Res (Row SQLite DbRole))
forall (m :: * -> *) a.
(MonadSelda m, MonadCatch m, Result a) =>
Query (Backend m) a -> m (Res a)
Selda.queryOne (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
$ ID DbRole
-> Query
     (Backend (SeldaTransactionT m))
     (Row (Backend (SeldaTransactionT m)) DbRole)
forall backend. ID DbRole -> Query backend (Row backend DbRole)
spaceRoleGet (ID DbRole
 -> Query
      (Backend (SeldaTransactionT m))
      (Row (Backend (SeldaTransactionT m)) DbRole))
-> ID DbRole
-> Query
     (Backend (SeldaTransactionT m))
     (Row (Backend (SeldaTransactionT m)) DbRole)
forall a b. (a -> b) -> a -> b
$ forall a. Int64 -> ID a
Selda.toId @DbRole (Int64 -> ID DbRole) -> Int64 -> ID DbRole
forall a b. (a -> b) -> a -> b
$ IdentifierRole -> Int64
unIdentifierRole IdentifierRole
identifierFallback
  if DbRole -> ID DbSpace
dbRole_space DbRole
dbRoleToDelete ID DbSpace -> ID DbSpace -> Bool
forall a. Eq a => a -> a -> Bool
== DbRole -> ID DbSpace
dbRole_space DbRole
dbRoleFallback
    then 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
"The fallback role is of the same space."
    else String -> SeldaTransactionT m ()
forall a. HasCallStack => String -> a
error String
"Fallback role is not of the same space"
  Int
countFallbackSpaceUsers <-
    Table DbSpaceUser
-> (Row (Backend (SeldaTransactionT m)) DbSpaceUser
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> (Row (Backend (SeldaTransactionT m)) DbSpaceUser
    -> Row (Backend (SeldaTransactionT m)) DbSpaceUser)
-> SeldaTransactionT m Int
forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a
-> (Row (Backend m) a -> Col (Backend m) Bool)
-> (Row (Backend m) a -> Row (Backend m) a)
-> m Int
Selda.update
      Table DbSpaceUser
tableSpaceUser
      (\Row (Backend (SeldaTransactionT m)) DbSpaceUser
dbSpaceUser -> Row (Backend (SeldaTransactionT m)) DbSpaceUser
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 (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..== ID DbRole -> Col SQLite (ID DbRole)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbRole (Int64 -> ID DbRole) -> Int64 -> ID DbRole
forall a b. (a -> b) -> a -> b
$ IdentifierRole -> Int64
unIdentifierRole IdentifierRole
identifierToDelete))
      (\Row (Backend (SeldaTransactionT m)) DbSpaceUser
dbSpaceUser -> Row (Backend (SeldaTransactionT m)) DbSpaceUser
Row SQLite DbSpaceUser
dbSpaceUser Row SQLite DbSpaceUser
-> [Assignment SQLite DbSpaceUser] -> Row SQLite DbSpaceUser
forall s a. Row s a -> [Assignment s a] -> Row s a
`Selda.with` [Selector DbSpaceUser (ID DbRole)
#dbSpaceUser_role Selector DbSpaceUser (ID DbRole)
-> Col SQLite (ID DbRole) -> Assignment SQLite DbSpaceUser
forall a a1 s. Selector a a1 -> Col s a1 -> Assignment s a
Selda.:= ID DbRole -> Col SQLite (ID DbRole)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbRole (Int64 -> ID DbRole) -> Int64 -> ID DbRole
forall a b. (a -> b) -> a -> b
$ IdentifierRole -> Int64
unIdentifierRole IdentifierRole
identifierFallback)])
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"The amount of users that now use the fallback role: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
countFallbackSpaceUsers)
  IdentifierRole -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole -> SeldaTransactionT m ()
roleDeleteUnsafe IdentifierRole
identifierToDelete
  () -> SeldaTransactionT m ()
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

rolePermissionGive ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierRole ->
  Permission ->
  SeldaTransactionT m ()
rolePermissionGive :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole -> Permission -> SeldaTransactionT m ()
rolePermissionGive IdentifierRole
roleIdentifier Permission
permission = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Giving role " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierRole -> String
forall a. Show a => a -> String
show IdentifierRole
roleIdentifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" permission " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Permission -> String
forall a. Show a => a -> String
show Permission
permission) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
  let dbRolePermission :: DbRolePermission
dbRolePermission =
        MkDbRolePermission
          { dbRolePermission_id :: ID DbRolePermission
dbRolePermission_id = ID DbRolePermission
forall a. SqlType a => a
Selda.def
          , dbRolePermission_role :: ID DbRole
dbRolePermission_role = forall a. Int64 -> ID a
Selda.toId @DbRole (Int64 -> ID DbRole) -> Int64 -> ID DbRole
forall a b. (a -> b) -> a -> b
$ IdentifierRole -> Int64
unIdentifierRole IdentifierRole
roleIdentifier
          , dbRolePermission_permission :: DbPermission
dbRolePermission_permission = Permission -> DbPermission
spacePermissionApiToDb Permission
permission
          }
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Inserting space-role permission."
  Table DbRolePermission
-> [DbRolePermission] -> SeldaTransactionT m ()
forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a -> [a] -> m ()
Selda.insert_ Table DbRolePermission
tableRolePermission [DbRolePermission
dbRolePermission]
  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
"Gave space-role a permission successfully."

-- | Just checks that the password matches.
-- Does not check the accessibility of the role.
rolePasswordCheck ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierRole ->
  Maybe Password ->
  SeldaTransactionT m PasswordCheck
rolePasswordCheck :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole
-> Maybe Password -> SeldaTransactionT m PasswordCheck
rolePasswordCheck IdentifierRole
identifier Maybe Password
maybePassword = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Querying role " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierRole -> String
forall a. Show a => a -> String
show IdentifierRole
identifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" from database to check password."
  DbRole
dbRole <- Query (Backend (SeldaTransactionT m)) (Row SQLite DbRole)
-> SeldaTransactionT m (Res (Row SQLite DbRole))
forall (m :: * -> *) a.
(MonadSelda m, MonadCatch m, Result a) =>
Query (Backend m) a -> m (Res a)
Selda.queryOne (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
$ ID DbRole
-> Query
     (Backend (SeldaTransactionT m))
     (Row (Backend (SeldaTransactionT m)) DbRole)
forall backend. ID DbRole -> Query backend (Row backend DbRole)
spaceRoleGet (ID DbRole
 -> Query
      (Backend (SeldaTransactionT m))
      (Row (Backend (SeldaTransactionT m)) DbRole))
-> ID DbRole
-> Query
     (Backend (SeldaTransactionT m))
     (Row (Backend (SeldaTransactionT m)) DbRole)
forall a b. (a -> b) -> a -> b
$ forall a. Int64 -> ID a
Selda.toId @DbRole (Int64 -> ID DbRole) -> Int64 -> ID DbRole
forall a b. (a -> b) -> a -> b
$ IdentifierRole -> Int64
unIdentifierRole IdentifierRole
identifier
  case Text -> PasswordHash Bcrypt
forall a. Text -> PasswordHash a
PasswordHash (Text -> PasswordHash Bcrypt)
-> Maybe Text -> Maybe (PasswordHash Bcrypt)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DbRole -> Maybe Text
dbRole_password_hash DbRole
dbRole of
    Maybe (PasswordHash Bcrypt)
Nothing -> do
      case Maybe Password
maybePassword of
        Maybe Password
Nothing -> do
          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"No password has been set. Nothing to check."
          PasswordCheck -> SeldaTransactionT m PasswordCheck
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PasswordCheck
PasswordCheckSuccess
        Just Password
_ -> do
          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logWarn Text
"Tried to enter a password even though there is no password set up."
          SqlErrorMensamRoleNoPasswordSetCannotCheck
-> SeldaTransactionT m PasswordCheck
forall e a.
(HasCallStack, Exception e) =>
e -> SeldaTransactionT m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM SqlErrorMensamRoleNoPasswordSetCannotCheck
MkSqlErrorMensamRoleNoPasswordSetCannotCheck
    Just PasswordHash Bcrypt
passwordHash -> do
      case Maybe Password
maybePassword of
        Maybe Password
Nothing -> do
          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Didn't enter a password even though a password is required."
          PasswordCheck -> SeldaTransactionT m PasswordCheck
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PasswordCheck
PasswordCheckFail
        Just Password
password -> do
          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Comparing password hashes."
          let passwordCheck :: PasswordCheck
passwordCheck = Password -> PasswordHash Bcrypt -> PasswordCheck
checkPassword Password
password PasswordHash Bcrypt
passwordHash
          case PasswordCheck
passwordCheck of
            PasswordCheck
PasswordCheckSuccess ->
              m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Password matches. Check successful."
            PasswordCheck
PasswordCheckFail ->
              m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Password does not matches. Check failed."
          PasswordCheck -> SeldaTransactionT m PasswordCheck
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PasswordCheck
passwordCheck

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

-- | Fails the transaction when the password check fails.
rolePasswordCheck' ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierRole ->
  Maybe Password ->
  SeldaTransactionT m ()
rolePasswordCheck' :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole -> Maybe Password -> SeldaTransactionT m ()
rolePasswordCheck' IdentifierRole
identifier Maybe Password
maybePassword =
  IdentifierRole
-> Maybe Password -> SeldaTransactionT m PasswordCheck
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole
-> Maybe Password -> SeldaTransactionT m PasswordCheck
rolePasswordCheck IdentifierRole
identifier Maybe Password
maybePassword SeldaTransactionT m PasswordCheck
-> (PasswordCheck -> SeldaTransactionT m ())
-> SeldaTransactionT m ()
forall a b.
SeldaTransactionT m a
-> (a -> SeldaTransactionT m b) -> SeldaTransactionT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    PasswordCheck
PasswordCheckSuccess -> () -> SeldaTransactionT m ()
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    PasswordCheck
PasswordCheckFail -> do
      m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Abort transaction after failed role password check."
      SqlErrorMensamRolePasswordCheckFail -> SeldaTransactionT m ()
forall e a.
(HasCallStack, Exception e) =>
e -> SeldaTransactionT m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM SqlErrorMensamRolePasswordCheckFail
MkSqlErrorMensamRolePasswordCheckFail

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

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

roleNameSet ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierRole ->
  NameRole ->
  SeldaTransactionT m ()
roleNameSet :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole -> NameRole -> SeldaTransactionT m ()
roleNameSet IdentifierRole
identifier NameRole
name = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Setting name " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (NameRole -> String
forall a. Show a => a -> String
show NameRole
name) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" of role " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierRole -> String
forall a. Show a => a -> String
show IdentifierRole
identifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
  Table DbRole
-> (Row (Backend (SeldaTransactionT m)) DbRole
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> (Row (Backend (SeldaTransactionT m)) DbRole
    -> Row (Backend (SeldaTransactionT m)) DbRole)
-> SeldaTransactionT m ()
forall (m :: * -> *) a.
(MonadSelda m, MonadThrow m, Relational a) =>
Table a
-> (Row (Backend m) a -> Col (Backend m) Bool)
-> (Row (Backend m) a -> Row (Backend m) a)
-> m ()
Selda.updateOne
    Table DbRole
tableRole
    (Selector DbRole (ID DbRole)
#dbRole_id Selector DbRole (ID DbRole)
-> ID DbRole -> Row SQLite DbRole -> Col SQLite Bool
forall r s c.
SqlType c =>
Selector r c -> c -> Row s r -> Col s Bool
`Selda.is` forall a. Int64 -> ID a
Selda.toId @DbRole (IdentifierRole -> Int64
unIdentifierRole IdentifierRole
identifier))
    (\Row (Backend (SeldaTransactionT m)) DbRole
rowRole -> Row (Backend (SeldaTransactionT m)) DbRole
Row SQLite DbRole
rowRole Row SQLite DbRole
-> [Assignment SQLite DbRole] -> Row SQLite DbRole
forall s a. Row s a -> [Assignment s a] -> Row s a
`Selda.with` [Selector DbRole Text
#dbRole_name Selector DbRole Text -> Col SQLite Text -> Assignment SQLite DbRole
forall a a1 s. Selector a a1 -> Col s a1 -> Assignment s a
Selda.:= Text -> Col SQLite Text
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (NameRole -> Text
unNameRole NameRole
name)])
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Set new role name successfully."

roleAccessibilityAndPasswordSet ::
  (MonadIO m, MonadLogger m, MonadSeldaPool m) =>
  IdentifierRole ->
  AccessibilityRole ->
  Maybe Password ->
  SeldaTransactionT m ()
roleAccessibilityAndPasswordSet :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
IdentifierRole
-> AccessibilityRole -> Maybe Password -> SeldaTransactionT m ()
roleAccessibilityAndPasswordSet IdentifierRole
identifier AccessibilityRole
accessibility Maybe Password
password = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Setting accessibility " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (AccessibilityRole -> String
forall a. Show a => a -> String
show AccessibilityRole
accessibility) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" of role " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierRole -> String
forall a. Show a => a -> String
show IdentifierRole
identifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
  Maybe (PasswordHash Bcrypt)
maybePasswordHash :: Maybe (PasswordHash Bcrypt) <- do
    m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Confirming that accessibility and password_hash match."
    let accessibilityMatchesPassword :: Bool
accessibilityMatchesPassword =
          case AccessibilityRole
accessibility of
            AccessibilityRole
MkAccessibilityRoleJoinable -> Maybe Password -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Password
password
            AccessibilityRole
MkAccessibilityRoleJoinableWithPassword -> Maybe Password -> Bool
forall a. Maybe a -> Bool
isJust Maybe Password
password
            AccessibilityRole
MkAccessibilityRoleInaccessible -> Maybe Password -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Password
password
    if Bool
accessibilityMatchesPassword
      then m (Maybe (PasswordHash Bcrypt))
-> SeldaTransactionT m (Maybe (PasswordHash Bcrypt))
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 (Maybe (PasswordHash Bcrypt))
 -> SeldaTransactionT m (Maybe (PasswordHash Bcrypt)))
-> m (Maybe (PasswordHash Bcrypt))
-> SeldaTransactionT m (Maybe (PasswordHash Bcrypt))
forall a b. (a -> b) -> a -> b
$ (Password -> m (PasswordHash Bcrypt))
-> Maybe Password -> m (Maybe (PasswordHash Bcrypt))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse Password -> m (PasswordHash Bcrypt)
forall (m :: * -> *).
MonadIO m =>
Password -> m (PasswordHash Bcrypt)
hashPassword Maybe Password
password
      else SqlErrorMensamRoleAccessibilityAndPasswordDontMatch
-> SeldaTransactionT m (Maybe (PasswordHash Bcrypt))
forall e a.
(HasCallStack, Exception e) =>
e -> SeldaTransactionT m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM SqlErrorMensamRoleAccessibilityAndPasswordDontMatch
MkSqlErrorMensamRoleAccessibilityAndPasswordDontMatch
  Table DbRole
-> (Row (Backend (SeldaTransactionT m)) DbRole
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> (Row (Backend (SeldaTransactionT m)) DbRole
    -> Row (Backend (SeldaTransactionT m)) DbRole)
-> SeldaTransactionT m ()
forall (m :: * -> *) a.
(MonadSelda m, MonadThrow m, Relational a) =>
Table a
-> (Row (Backend m) a -> Col (Backend m) Bool)
-> (Row (Backend m) a -> Row (Backend m) a)
-> m ()
Selda.updateOne
    Table DbRole
tableRole
    (Selector DbRole (ID DbRole)
#dbRole_id Selector DbRole (ID DbRole)
-> ID DbRole -> Row SQLite DbRole -> Col SQLite Bool
forall r s c.
SqlType c =>
Selector r c -> c -> Row s r -> Col s Bool
`Selda.is` forall a. Int64 -> ID a
Selda.toId @DbRole (IdentifierRole -> Int64
unIdentifierRole IdentifierRole
identifier))
    (\Row (Backend (SeldaTransactionT m)) DbRole
rowRole -> Row (Backend (SeldaTransactionT m)) DbRole
Row SQLite DbRole
rowRole Row SQLite DbRole
-> [Assignment SQLite DbRole] -> Row SQLite DbRole
forall s a. Row s a -> [Assignment s a] -> Row s a
`Selda.with` [Selector DbRole DbRoleAccessibility
#dbRole_accessibility Selector DbRole DbRoleAccessibility
-> Col SQLite DbRoleAccessibility -> Assignment SQLite DbRole
forall a a1 s. Selector a a1 -> Col s a1 -> Assignment s a
Selda.:= DbRoleAccessibility -> Col SQLite DbRoleAccessibility
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (AccessibilityRole -> DbRoleAccessibility
roleAccessibilityApiToDb AccessibilityRole
accessibility)])
  Table DbRole
-> (Row (Backend (SeldaTransactionT m)) DbRole
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> (Row (Backend (SeldaTransactionT m)) DbRole
    -> Row (Backend (SeldaTransactionT m)) DbRole)
-> SeldaTransactionT m ()
forall (m :: * -> *) a.
(MonadSelda m, MonadThrow m, Relational a) =>
Table a
-> (Row (Backend m) a -> Col (Backend m) Bool)
-> (Row (Backend m) a -> Row (Backend m) a)
-> m ()
Selda.updateOne
    Table DbRole
tableRole
    (Selector DbRole (ID DbRole)
#dbRole_id Selector DbRole (ID DbRole)
-> ID DbRole -> Row SQLite DbRole -> Col SQLite Bool
forall r s c.
SqlType c =>
Selector r c -> c -> Row s r -> Col s Bool
`Selda.is` forall a. Int64 -> ID a
Selda.toId @DbRole (IdentifierRole -> Int64
unIdentifierRole IdentifierRole
identifier))
    (\Row (Backend (SeldaTransactionT m)) DbRole
rowRole -> Row (Backend (SeldaTransactionT m)) DbRole
Row SQLite DbRole
rowRole Row SQLite DbRole
-> [Assignment SQLite DbRole] -> Row SQLite DbRole
forall s a. Row s a -> [Assignment s a] -> Row s a
`Selda.with` [Selector DbRole (Maybe Text)
#dbRole_password_hash Selector DbRole (Maybe Text)
-> Col SQLite (Maybe Text) -> Assignment SQLite DbRole
forall a a1 s. Selector a a1 -> Col s a1 -> Assignment s a
Selda.:= Maybe Text -> Col SQLite (Maybe Text)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (PasswordHash Bcrypt -> Text
forall a. PasswordHash a -> Text
unPasswordHash (PasswordHash Bcrypt -> Text)
-> Maybe (PasswordHash Bcrypt) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (PasswordHash Bcrypt)
maybePasswordHash)])
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Set new role accessibility successfully."

rolePermissionsSet ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierRole ->
  S.Set Permission ->
  SeldaTransactionT m ()
rolePermissionsSet :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole -> Set Permission -> SeldaTransactionT m ()
rolePermissionsSet IdentifierRole
identifier Set Permission
permissions = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Setting permissions " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Set Permission -> String
forall a. Show a => a -> String
show Set Permission
permissions) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" of role " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierRole -> String
forall a. Show a => a -> String
show IdentifierRole
identifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
  Int
countPermissionsDeleted <- Table DbRolePermission
-> (Row (Backend (SeldaTransactionT m)) DbRolePermission
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> SeldaTransactionT m Int
forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a -> (Row (Backend m) a -> Col (Backend m) Bool) -> m Int
Selda.deleteFrom Table DbRolePermission
tableRolePermission ((Row (Backend (SeldaTransactionT m)) DbRolePermission
  -> Col (Backend (SeldaTransactionT m)) Bool)
 -> SeldaTransactionT m Int)
-> (Row (Backend (SeldaTransactionT m)) DbRolePermission
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> SeldaTransactionT m Int
forall a b. (a -> b) -> a -> b
$ \Row (Backend (SeldaTransactionT m)) DbRolePermission
row ->
    Row (Backend (SeldaTransactionT m)) DbRolePermission
Row SQLite DbRolePermission
row Row SQLite DbRolePermission
-> Selector DbRolePermission (ID DbRole) -> Col SQLite (ID DbRole)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbRolePermission (ID DbRole)
#dbRolePermission_role 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..== ID DbRole -> Col SQLite (ID DbRole)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbRole (Int64 -> ID DbRole) -> Int64 -> ID DbRole
forall a b. (a -> b) -> a -> b
$ IdentifierRole -> Int64
unIdentifierRole IdentifierRole
identifier)
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Deleted old permissions: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
countPermissionsDeleted)
  Int
countPermissionsGiven <- [()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length ([()] -> Int)
-> SeldaTransactionT m [()] -> SeldaTransactionT m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Permission -> SeldaTransactionT m ())
-> [Permission] -> SeldaTransactionT m [()]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (IdentifierRole -> Permission -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole -> Permission -> SeldaTransactionT m ()
rolePermissionGive IdentifierRole
identifier) (Set Permission -> [Permission]
forall a. Set a -> [a]
S.toList Set Permission
permissions)
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Gave new permissions: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
countPermissionsGiven)
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Set new role permissions successfully."

deskLookupId ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierSpace ->
  NameDesk ->
  SeldaTransactionT m (Maybe IdentifierDesk)
deskLookupId :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace
-> NameDesk -> SeldaTransactionT m (Maybe IdentifierDesk)
deskLookupId IdentifierSpace
spaceIdentifier NameDesk
deskName = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Looking up desk identifier with name: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack ((IdentifierSpace, NameDesk) -> String
forall a. Show a => a -> String
show (IdentifierSpace
spaceIdentifier, NameDesk
deskName))
  Maybe (ID DbDesk)
maybeDbId <- Query (Backend (SeldaTransactionT m)) (Col SQLite (ID DbDesk))
-> SeldaTransactionT m (Maybe (Res (Col SQLite (ID DbDesk))))
forall (m :: * -> *) a.
(MonadSelda m, MonadThrow m, Result a) =>
Query (Backend m) a -> m (Maybe (Res a))
Selda.queryUnique (Query (Backend (SeldaTransactionT m)) (Col SQLite (ID DbDesk))
 -> SeldaTransactionT m (Maybe (Res (Col SQLite (ID DbDesk)))))
-> Query (Backend (SeldaTransactionT m)) (Col SQLite (ID DbDesk))
-> SeldaTransactionT m (Maybe (Res (Col SQLite (ID 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 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 DbDesk
dbDesk Row SQLite DbDesk
-> Selector DbDesk (ID DbSpace) -> Col SQLite (ID DbSpace)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbDesk (ID DbSpace)
#dbDesk_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..== ID DbSpace -> Col SQLite (ID DbSpace)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbSpace (Int64 -> ID DbSpace) -> Int64 -> ID DbSpace
forall a b. (a -> b) -> a -> b
$ IdentifierSpace -> Int64
unIdentifierSpace IdentifierSpace
spaceIdentifier)
    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 DbDesk
dbDesk Row SQLite DbDesk -> Selector DbDesk Text -> Col SQLite Text
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbDesk Text
#dbDesk_name Col SQLite Text -> Col SQLite Text -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda..== Text -> Col SQLite Text
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (NameDesk -> Text
unNameDesk NameDesk
deskName)
    Col SQLite (ID DbDesk) -> Query SQLite (Col SQLite (ID DbDesk))
forall a. a -> Query SQLite a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Col SQLite (ID DbDesk) -> Query SQLite (Col SQLite (ID DbDesk)))
-> Col SQLite (ID DbDesk) -> Query SQLite (Col SQLite (ID DbDesk))
forall a b. (a -> b) -> a -> b
$ 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
  case Maybe (ID DbDesk)
maybeDbId of
    Maybe (ID DbDesk)
Nothing -> do
      m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Failed to look up desk. Name doesn't exist: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (NameDesk -> String
forall a. Show a => a -> String
show NameDesk
deskName)
      Maybe IdentifierDesk -> SeldaTransactionT m (Maybe IdentifierDesk)
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe IdentifierDesk
forall a. Maybe a
Nothing
    Just ID DbDesk
dbId -> do
      m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Looked up desk successfully."
      Maybe IdentifierDesk -> SeldaTransactionT m (Maybe IdentifierDesk)
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe IdentifierDesk
 -> SeldaTransactionT m (Maybe IdentifierDesk))
-> Maybe IdentifierDesk
-> SeldaTransactionT m (Maybe IdentifierDesk)
forall a b. (a -> b) -> a -> b
$ IdentifierDesk -> Maybe IdentifierDesk
forall a. a -> Maybe a
Just (IdentifierDesk -> Maybe IdentifierDesk)
-> IdentifierDesk -> Maybe IdentifierDesk
forall a b. (a -> b) -> a -> b
$ Int64 -> IdentifierDesk
MkIdentifierDesk (Int64 -> IdentifierDesk) -> Int64 -> IdentifierDesk
forall a b. (a -> b) -> a -> b
$ forall a. ID a -> Int64
Selda.fromId @DbDesk ID DbDesk
dbId

deskGetFromId ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierDesk ->
  SeldaTransactionT m Desk
deskGetFromId :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierDesk -> SeldaTransactionT m Desk
deskGetFromId IdentifierDesk
identifier = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Get desk info with identifier: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierDesk -> String
forall a. Show a => a -> String
show IdentifierDesk
identifier)
  DbDesk
dbDesk <- SeldaTransactionT m DbDesk
-> (SqlErrorMensamNotOneQuery -> SeldaTransactionT m DbDesk)
-> SeldaTransactionT m DbDesk
forall e a.
(HasCallStack, Exception e) =>
SeldaTransactionT m a
-> (e -> SeldaTransactionT m a) -> SeldaTransactionT m a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch
    ( Query (Backend (SeldaTransactionT m)) (Row SQLite DbDesk)
-> SeldaTransactionT m (Res (Row SQLite DbDesk))
forall (m :: * -> *) a.
(MonadSelda m, MonadCatch m, Result a) =>
Query (Backend m) a -> m (Res a)
Selda.queryOne (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 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 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..== ID DbDesk -> Col SQLite (ID DbDesk)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbDesk (Int64 -> ID DbDesk) -> Int64 -> ID DbDesk
forall a b. (a -> b) -> a -> b
$ IdentifierDesk -> Int64
unIdentifierDesk IdentifierDesk
identifier)
        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
    )
    ((SqlErrorMensamNotOneQuery -> SeldaTransactionT m DbDesk)
 -> SeldaTransactionT m DbDesk)
-> (SqlErrorMensamNotOneQuery -> SeldaTransactionT m DbDesk)
-> SeldaTransactionT m DbDesk
forall a b. (a -> b) -> a -> b
$ \case SqlErrorMensamNotOneQuery
exc -> SqlErrorMensamDeskNotFound -> SeldaTransactionT m DbDesk
forall e a.
(HasCallStack, Exception e) =>
e -> SeldaTransactionT m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (SqlErrorMensamDeskNotFound -> SeldaTransactionT m DbDesk)
-> SqlErrorMensamDeskNotFound -> SeldaTransactionT m DbDesk
forall a b. (a -> b) -> a -> b
$ SqlErrorMensamNotOneQuery -> SqlErrorMensamDeskNotFound
MkSqlErrorMensamDeskNotFound SqlErrorMensamNotOneQuery
exc
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Got desk info successfully."
  Desk -> SeldaTransactionT m Desk
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    MkDesk
      { deskId :: IdentifierDesk
deskId = Int64 -> IdentifierDesk
MkIdentifierDesk (Int64 -> IdentifierDesk) -> Int64 -> IdentifierDesk
forall a b. (a -> b) -> a -> b
$ ID DbDesk -> Int64
forall a. ID a -> Int64
Selda.fromId (ID DbDesk -> Int64) -> ID DbDesk -> Int64
forall a b. (a -> b) -> a -> b
$ DbDesk -> ID DbDesk
dbDesk_id DbDesk
dbDesk
      , deskSpace :: IdentifierSpace
deskSpace = Int64 -> IdentifierSpace
MkIdentifierSpace (Int64 -> IdentifierSpace) -> Int64 -> IdentifierSpace
forall a b. (a -> b) -> a -> b
$ forall a. ID a -> Int64
Selda.fromId @DbSpace (ID DbSpace -> Int64) -> ID DbSpace -> Int64
forall a b. (a -> b) -> a -> b
$ DbDesk -> ID DbSpace
dbDesk_space DbDesk
dbDesk
      , deskName :: NameDesk
deskName = Text -> NameDesk
MkNameDesk (Text -> NameDesk) -> Text -> NameDesk
forall a b. (a -> b) -> a -> b
$ DbDesk -> Text
dbDesk_name DbDesk
dbDesk
      , deskLocation :: Maybe LocationDesk
deskLocation = do
          Double
x <- DbDesk -> Maybe Double
dbDesk_position_x DbDesk
dbDesk
          Double
y <- DbDesk -> Maybe Double
dbDesk_position_y DbDesk
dbDesk
          Double
direction <- DbDesk -> Maybe Double
dbDesk_direction DbDesk
dbDesk
          Double
width <- DbDesk -> Maybe Double
dbDesk_size_width DbDesk
dbDesk
          Double
depth <- DbDesk -> Maybe Double
dbDesk_size_depth DbDesk
dbDesk
          LocationDesk -> Maybe LocationDesk
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            MkLocationDesk
              { locationDeskPosition :: PositionDesk
locationDeskPosition =
                  MkPositionDesk
                    { positionDeskX :: ConstrainedDouble '[]
positionDeskX = Double -> ConstrainedDouble '[]
forall (constraints :: [ConstraintDouble]).
Double -> ConstrainedDouble constraints
MkConstrainedDoubleUnsafe Double
x
                    , positionDeskY :: ConstrainedDouble '[]
positionDeskY = Double -> ConstrainedDouble '[]
forall (constraints :: [ConstraintDouble]).
Double -> ConstrainedDouble constraints
MkConstrainedDoubleUnsafe Double
y
                    }
              , locationDeskDirection :: DirectionDesk
locationDeskDirection =
                  MkDirectionDesk
                    { unDirectionDesk :: Direction
unDirectionDesk = ConstrainedDouble
  '[MkConstraintDoubleGreaterEqual 0, MkConstraintDoubleLessThan 360]
-> Direction
MkDirectionDegrees (ConstrainedDouble
   '[MkConstraintDoubleGreaterEqual 0, MkConstraintDoubleLessThan 360]
 -> Direction)
-> ConstrainedDouble
     '[MkConstraintDoubleGreaterEqual 0, MkConstraintDoubleLessThan 360]
-> Direction
forall a b. (a -> b) -> a -> b
$ Double
-> ConstrainedDouble
     '[MkConstraintDoubleGreaterEqual 0, MkConstraintDoubleLessThan 360]
forall (constraints :: [ConstraintDouble]).
Double -> ConstrainedDouble constraints
MkConstrainedDoubleUnsafe Double
direction
                    }
              , locationDeskSize :: SizeDesk
locationDeskSize =
                  MkSizeDesk
                    { sizeDeskWidth :: ConstrainedDouble
  '[MkConstraintDoubleGreaterEqual 30,
    MkConstraintDoubleLessEqual 600]
sizeDeskWidth = Double
-> ConstrainedDouble
     '[MkConstraintDoubleGreaterEqual 30,
       MkConstraintDoubleLessEqual 600]
forall (constraints :: [ConstraintDouble]).
Double -> ConstrainedDouble constraints
MkConstrainedDoubleUnsafe Double
width
                    , sizeDeskDepth :: ConstrainedDouble
  '[MkConstraintDoubleGreaterEqual 30,
    MkConstraintDoubleLessEqual 600]
sizeDeskDepth = Double
-> ConstrainedDouble
     '[MkConstraintDoubleGreaterEqual 30,
       MkConstraintDoubleLessEqual 600]
forall (constraints :: [ConstraintDouble]).
Double -> ConstrainedDouble constraints
MkConstrainedDoubleUnsafe Double
depth
                    }
              }
      }

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

deskList ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierSpace ->
  IdentifierUser ->
  SeldaTransactionT m [Desk]
deskList :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> IdentifierUser -> SeldaTransactionT m [Desk]
deskList IdentifierSpace
spaceIdentifier IdentifierUser
userIdentifier = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Looking up desks visible by user: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierUser -> String
forall a. Show a => a -> String
show IdentifierUser
userIdentifier)
  [DbDesk]
dbDesks <- 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 DbSpaceUser
dbSpaceUser <- Query (Inner SQLite) (Row (Inner SQLite) DbSpaceUser)
-> Query SQLite (OuterCols (Row (Inner SQLite) DbSpaceUser))
forall a s.
(Columns a, Columns (OuterCols a)) =>
Query (Inner s) a -> Query s (OuterCols a)
Selda.distinct (Query (Inner SQLite) (Row (Inner SQLite) DbSpaceUser)
 -> Query SQLite (OuterCols (Row (Inner SQLite) DbSpaceUser)))
-> Query (Inner SQLite) (Row (Inner SQLite) DbSpaceUser)
-> Query SQLite (OuterCols (Row (Inner SQLite) DbSpaceUser))
forall a b. (a -> b) -> a -> b
$ Table DbSpaceUser
-> Query (Inner SQLite) (Row (Inner SQLite) DbSpaceUser)
forall a s. Relational a => Table a -> Query s (Row s a)
Selda.select Table DbSpaceUser
tableSpaceUser
    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 DbSpaceUser
dbSpaceUser Row SQLite DbSpaceUser
-> Selector DbSpaceUser (ID DbUser) -> Col SQLite (ID DbUser)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbSpaceUser (ID DbUser)
#dbSpaceUser_user Col SQLite (ID DbUser) -> Col SQLite (ID DbUser) -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda..== ID DbUser -> Col SQLite (ID DbUser)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbUser (Int64 -> ID DbUser) -> Int64 -> ID DbUser
forall a b. (a -> b) -> a -> b
$ IdentifierUser -> Int64
unIdentifierUser IdentifierUser
userIdentifier)
    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 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 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..== ID DbSpace -> Col SQLite (ID DbSpace)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbSpace (Int64 -> ID DbSpace) -> Int64 -> ID DbSpace
forall a b. (a -> b) -> a -> b
$ IdentifierSpace -> Int64
unIdentifierSpace IdentifierSpace
spaceIdentifier)

    Row SQLite DbSpace
dbSpace <- Table DbSpace -> Query SQLite (Row SQLite DbSpace)
forall a s. Relational a => Table a -> Query s (Row s a)
Selda.select Table DbSpace
tableSpace
    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 DbSpace
dbSpace Row SQLite DbSpace
-> Selector DbSpace (ID DbSpace) -> Col SQLite (ID DbSpace)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbSpace (ID DbSpace)
#dbSpace_id 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..== ID DbSpace -> Col SQLite (ID DbSpace)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbSpace (Int64 -> ID DbSpace) -> Int64 -> ID DbSpace
forall a b. (a -> b) -> a -> b
$ IdentifierSpace -> Int64
unIdentifierSpace IdentifierSpace
spaceIdentifier)
    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 DbSpace
dbSpace Row SQLite DbSpace
-> Selector DbSpace DbSpaceVisibility
-> Col SQLite DbSpaceVisibility
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbSpace DbSpaceVisibility
#dbSpace_visibility Col SQLite DbSpaceVisibility
-> Col SQLite DbSpaceVisibility -> Col SQLite Bool
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Col t a -> Col s Bool
Selda..== DbSpaceVisibility -> Col SQLite DbSpaceVisibility
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal DbSpaceVisibility
MkDbSpaceVisibility_visible)
        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 DbSpace
dbSpace Row SQLite DbSpace
-> Selector DbSpace (ID DbSpace) -> Col SQLite (ID DbSpace)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbSpace (ID DbSpace)
#dbSpace_id 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)

    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 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 DbDesk
dbDesk Row SQLite DbDesk
-> Selector DbDesk (ID DbSpace) -> Col SQLite (ID DbSpace)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbDesk (ID DbSpace)
#dbDesk_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 DbSpace
dbSpace Row SQLite DbSpace
-> Selector DbSpace (ID DbSpace) -> Col SQLite (ID DbSpace)
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbSpace (ID DbSpace)
#dbSpace_id
    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
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Looked up visible desks successfully."
  let fromDbDesk :: DbDesk -> Desk
fromDbDesk DbDesk
dbDesk =
        MkDesk
          { deskId :: IdentifierDesk
deskId = Int64 -> IdentifierDesk
MkIdentifierDesk (Int64 -> IdentifierDesk) -> Int64 -> IdentifierDesk
forall a b. (a -> b) -> a -> b
$ forall a. ID a -> Int64
Selda.fromId @DbDesk (ID DbDesk -> Int64) -> ID DbDesk -> Int64
forall a b. (a -> b) -> a -> b
$ DbDesk -> ID DbDesk
dbDesk_id DbDesk
dbDesk
          , deskSpace :: IdentifierSpace
deskSpace = Int64 -> IdentifierSpace
MkIdentifierSpace (Int64 -> IdentifierSpace) -> Int64 -> IdentifierSpace
forall a b. (a -> b) -> a -> b
$ forall a. ID a -> Int64
Selda.fromId @DbSpace (ID DbSpace -> Int64) -> ID DbSpace -> Int64
forall a b. (a -> b) -> a -> b
$ DbDesk -> ID DbSpace
dbDesk_space DbDesk
dbDesk
          , deskName :: NameDesk
deskName = Text -> NameDesk
MkNameDesk (Text -> NameDesk) -> Text -> NameDesk
forall a b. (a -> b) -> a -> b
$ DbDesk -> Text
dbDesk_name DbDesk
dbDesk
          , deskLocation :: Maybe LocationDesk
deskLocation = do
              Double
x <- DbDesk -> Maybe Double
dbDesk_position_x DbDesk
dbDesk
              Double
y <- DbDesk -> Maybe Double
dbDesk_position_y DbDesk
dbDesk
              Double
direction <- DbDesk -> Maybe Double
dbDesk_direction DbDesk
dbDesk
              Double
width <- DbDesk -> Maybe Double
dbDesk_size_width DbDesk
dbDesk
              Double
depth <- DbDesk -> Maybe Double
dbDesk_size_depth DbDesk
dbDesk
              LocationDesk -> Maybe LocationDesk
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                MkLocationDesk
                  { locationDeskPosition :: PositionDesk
locationDeskPosition =
                      MkPositionDesk
                        { positionDeskX :: ConstrainedDouble '[]
positionDeskX = Double -> ConstrainedDouble '[]
forall (constraints :: [ConstraintDouble]).
Double -> ConstrainedDouble constraints
MkConstrainedDoubleUnsafe Double
x
                        , positionDeskY :: ConstrainedDouble '[]
positionDeskY = Double -> ConstrainedDouble '[]
forall (constraints :: [ConstraintDouble]).
Double -> ConstrainedDouble constraints
MkConstrainedDoubleUnsafe Double
y
                        }
                  , locationDeskDirection :: DirectionDesk
locationDeskDirection =
                      MkDirectionDesk
                        { unDirectionDesk :: Direction
unDirectionDesk = ConstrainedDouble
  '[MkConstraintDoubleGreaterEqual 0, MkConstraintDoubleLessThan 360]
-> Direction
MkDirectionDegrees (ConstrainedDouble
   '[MkConstraintDoubleGreaterEqual 0, MkConstraintDoubleLessThan 360]
 -> Direction)
-> ConstrainedDouble
     '[MkConstraintDoubleGreaterEqual 0, MkConstraintDoubleLessThan 360]
-> Direction
forall a b. (a -> b) -> a -> b
$ Double
-> ConstrainedDouble
     '[MkConstraintDoubleGreaterEqual 0, MkConstraintDoubleLessThan 360]
forall (constraints :: [ConstraintDouble]).
Double -> ConstrainedDouble constraints
MkConstrainedDoubleUnsafe Double
direction
                        }
                  , locationDeskSize :: SizeDesk
locationDeskSize =
                      MkSizeDesk
                        { sizeDeskWidth :: ConstrainedDouble
  '[MkConstraintDoubleGreaterEqual 30,
    MkConstraintDoubleLessEqual 600]
sizeDeskWidth = Double
-> ConstrainedDouble
     '[MkConstraintDoubleGreaterEqual 30,
       MkConstraintDoubleLessEqual 600]
forall (constraints :: [ConstraintDouble]).
Double -> ConstrainedDouble constraints
MkConstrainedDoubleUnsafe Double
width
                        , sizeDeskDepth :: ConstrainedDouble
  '[MkConstraintDoubleGreaterEqual 30,
    MkConstraintDoubleLessEqual 600]
sizeDeskDepth = Double
-> ConstrainedDouble
     '[MkConstraintDoubleGreaterEqual 30,
       MkConstraintDoubleLessEqual 600]
forall (constraints :: [ConstraintDouble]).
Double -> ConstrainedDouble constraints
MkConstrainedDoubleUnsafe Double
depth
                        }
                  }
          }
  [Desk] -> SeldaTransactionT m [Desk]
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Desk] -> SeldaTransactionT m [Desk])
-> [Desk] -> SeldaTransactionT m [Desk]
forall a b. (a -> b) -> a -> b
$ DbDesk -> Desk
fromDbDesk (DbDesk -> Desk) -> [DbDesk] -> [Desk]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DbDesk]
dbDesks

deskCreate ::
  (MonadLogger m, MonadSeldaPool m) =>
  NameDesk ->
  IdentifierSpace ->
  Maybe LocationDesk ->
  SeldaTransactionT m IdentifierDesk
deskCreate :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
NameDesk
-> IdentifierSpace
-> Maybe LocationDesk
-> SeldaTransactionT m IdentifierDesk
deskCreate NameDesk
deskName IdentifierSpace
spaceIdentifier Maybe LocationDesk
deskLocation = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Creating desk."
  let dbDesk :: DbDesk
dbDesk =
        MkDbDesk
          { dbDesk_id :: ID DbDesk
dbDesk_id = ID DbDesk
forall a. SqlType a => a
Selda.def
          , dbDesk_space :: ID DbSpace
dbDesk_space = forall a. Int64 -> ID a
Selda.toId @DbSpace (Int64 -> ID DbSpace) -> Int64 -> ID DbSpace
forall a b. (a -> b) -> a -> b
$ IdentifierSpace -> Int64
unIdentifierSpace IdentifierSpace
spaceIdentifier
          , dbDesk_name :: Text
dbDesk_name = NameDesk -> Text
unNameDesk NameDesk
deskName
          , dbDesk_position_x :: Maybe Double
dbDesk_position_x = ConstrainedDouble '[] -> Double
forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints -> Double
unConstrainedDouble (ConstrainedDouble '[] -> Double)
-> (LocationDesk -> ConstrainedDouble '[])
-> LocationDesk
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionDesk -> ConstrainedDouble '[]
positionDeskX (PositionDesk -> ConstrainedDouble '[])
-> (LocationDesk -> PositionDesk)
-> LocationDesk
-> ConstrainedDouble '[]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocationDesk -> PositionDesk
locationDeskPosition (LocationDesk -> Double) -> Maybe LocationDesk -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LocationDesk
deskLocation
          , dbDesk_position_y :: Maybe Double
dbDesk_position_y = ConstrainedDouble '[] -> Double
forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints -> Double
unConstrainedDouble (ConstrainedDouble '[] -> Double)
-> (LocationDesk -> ConstrainedDouble '[])
-> LocationDesk
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionDesk -> ConstrainedDouble '[]
positionDeskY (PositionDesk -> ConstrainedDouble '[])
-> (LocationDesk -> PositionDesk)
-> LocationDesk
-> ConstrainedDouble '[]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocationDesk -> PositionDesk
locationDeskPosition (LocationDesk -> Double) -> Maybe LocationDesk -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LocationDesk
deskLocation
          , dbDesk_direction :: Maybe Double
dbDesk_direction = ConstrainedDouble
  '[MkConstraintDoubleGreaterEqual 0, MkConstraintDoubleLessThan 360]
-> Double
forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints -> Double
unConstrainedDouble (ConstrainedDouble
   '[MkConstraintDoubleGreaterEqual 0, MkConstraintDoubleLessThan 360]
 -> Double)
-> (LocationDesk
    -> ConstrainedDouble
         '[MkConstraintDoubleGreaterEqual 0,
           MkConstraintDoubleLessThan 360])
-> LocationDesk
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction
-> ConstrainedDouble
     '[MkConstraintDoubleGreaterEqual 0, MkConstraintDoubleLessThan 360]
unDirectionDegrees (Direction
 -> ConstrainedDouble
      '[MkConstraintDoubleGreaterEqual 0,
        MkConstraintDoubleLessThan 360])
-> (LocationDesk -> Direction)
-> LocationDesk
-> ConstrainedDouble
     '[MkConstraintDoubleGreaterEqual 0, MkConstraintDoubleLessThan 360]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirectionDesk -> Direction
unDirectionDesk (DirectionDesk -> Direction)
-> (LocationDesk -> DirectionDesk) -> LocationDesk -> Direction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocationDesk -> DirectionDesk
locationDeskDirection (LocationDesk -> Double) -> Maybe LocationDesk -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LocationDesk
deskLocation
          , dbDesk_size_width :: Maybe Double
dbDesk_size_width = ConstrainedDouble
  '[MkConstraintDoubleGreaterEqual 30,
    MkConstraintDoubleLessEqual 600]
-> Double
forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints -> Double
unConstrainedDouble (ConstrainedDouble
   '[MkConstraintDoubleGreaterEqual 30,
     MkConstraintDoubleLessEqual 600]
 -> Double)
-> (LocationDesk
    -> ConstrainedDouble
         '[MkConstraintDoubleGreaterEqual 30,
           MkConstraintDoubleLessEqual 600])
-> LocationDesk
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizeDesk
-> ConstrainedDouble
     '[MkConstraintDoubleGreaterEqual 30,
       MkConstraintDoubleLessEqual 600]
sizeDeskWidth (SizeDesk
 -> ConstrainedDouble
      '[MkConstraintDoubleGreaterEqual 30,
        MkConstraintDoubleLessEqual 600])
-> (LocationDesk -> SizeDesk)
-> LocationDesk
-> ConstrainedDouble
     '[MkConstraintDoubleGreaterEqual 30,
       MkConstraintDoubleLessEqual 600]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocationDesk -> SizeDesk
locationDeskSize (LocationDesk -> Double) -> Maybe LocationDesk -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LocationDesk
deskLocation
          , dbDesk_size_depth :: Maybe Double
dbDesk_size_depth = ConstrainedDouble
  '[MkConstraintDoubleGreaterEqual 30,
    MkConstraintDoubleLessEqual 600]
-> Double
forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints -> Double
unConstrainedDouble (ConstrainedDouble
   '[MkConstraintDoubleGreaterEqual 30,
     MkConstraintDoubleLessEqual 600]
 -> Double)
-> (LocationDesk
    -> ConstrainedDouble
         '[MkConstraintDoubleGreaterEqual 30,
           MkConstraintDoubleLessEqual 600])
-> LocationDesk
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizeDesk
-> ConstrainedDouble
     '[MkConstraintDoubleGreaterEqual 30,
       MkConstraintDoubleLessEqual 600]
sizeDeskDepth (SizeDesk
 -> ConstrainedDouble
      '[MkConstraintDoubleGreaterEqual 30,
        MkConstraintDoubleLessEqual 600])
-> (LocationDesk -> SizeDesk)
-> LocationDesk
-> ConstrainedDouble
     '[MkConstraintDoubleGreaterEqual 30,
       MkConstraintDoubleLessEqual 600]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocationDesk -> SizeDesk
locationDeskSize (LocationDesk -> Double) -> Maybe LocationDesk -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LocationDesk
deskLocation
          }
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Inserting desk into database."
  ID DbDesk
dbDeskId <- Table DbDesk -> [DbDesk] -> SeldaTransactionT m (ID DbDesk)
forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a -> [a] -> m (ID a)
Selda.insertWithPK Table DbDesk
tableDesk [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 ()
logInfo Text
"Created desk successfully."
  IdentifierDesk -> SeldaTransactionT m IdentifierDesk
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IdentifierDesk -> SeldaTransactionT m IdentifierDesk)
-> IdentifierDesk -> SeldaTransactionT m IdentifierDesk
forall a b. (a -> b) -> a -> b
$ Int64 -> IdentifierDesk
MkIdentifierDesk (Int64 -> IdentifierDesk) -> Int64 -> IdentifierDesk
forall a b. (a -> b) -> a -> b
$ forall a. ID a -> Int64
Selda.fromId @DbDesk ID DbDesk
dbDeskId

deskDelete ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierDesk ->
  SeldaTransactionT m ()
deskDelete :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierDesk -> SeldaTransactionT m ()
deskDelete IdentifierDesk
identifier = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Deleting desk: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierDesk -> String
forall a. Show a => a -> String
show IdentifierDesk
identifier)
  Int
countReservations <- Table DbReservation
-> (Row (Backend (SeldaTransactionT m)) DbReservation
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> SeldaTransactionT m Int
forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a -> (Row (Backend m) a -> Col (Backend m) Bool) -> m Int
Selda.deleteFrom Table DbReservation
tableReservation ((Row (Backend (SeldaTransactionT m)) DbReservation
  -> Col (Backend (SeldaTransactionT m)) Bool)
 -> SeldaTransactionT m Int)
-> (Row (Backend (SeldaTransactionT m)) DbReservation
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> SeldaTransactionT m Int
forall a b. (a -> b) -> a -> b
$ \Row (Backend (SeldaTransactionT m)) DbReservation
row ->
    Row (Backend (SeldaTransactionT m)) DbReservation
Row SQLite DbReservation
row 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..== ID DbDesk -> Col SQLite (ID DbDesk)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbDesk (Int64 -> ID DbDesk) -> Int64 -> ID DbDesk
forall a b. (a -> b) -> a -> b
$ IdentifierDesk -> Int64
unIdentifierDesk IdentifierDesk
identifier)
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Desk had " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
countReservations) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" reservations."
  Table DbDesk
-> (Row (Backend (SeldaTransactionT m)) DbDesk
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> SeldaTransactionT m ()
forall (m :: * -> *) a.
(MonadSelda m, MonadThrow m, Relational a) =>
Table a -> (Row (Backend m) a -> Col (Backend m) Bool) -> m ()
Selda.deleteOneFrom Table DbDesk
tableDesk ((Row (Backend (SeldaTransactionT m)) DbDesk
  -> Col (Backend (SeldaTransactionT m)) Bool)
 -> SeldaTransactionT m ())
-> (Row (Backend (SeldaTransactionT m)) DbDesk
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ \Row (Backend (SeldaTransactionT m)) DbDesk
row ->
    Row (Backend (SeldaTransactionT m)) DbDesk
Row SQLite DbDesk
row 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..== ID DbDesk -> Col SQLite (ID DbDesk)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (forall a. Int64 -> ID a
Selda.toId @DbDesk (Int64 -> ID DbDesk) -> Int64 -> ID DbDesk
forall a b. (a -> b) -> a -> b
$ IdentifierDesk -> Int64
unIdentifierDesk IdentifierDesk
identifier)
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Deleted desk successfully."
  () -> SeldaTransactionT m ()
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

deskNameSet ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierDesk ->
  NameDesk ->
  SeldaTransactionT m ()
deskNameSet :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierDesk -> NameDesk -> SeldaTransactionT m ()
deskNameSet IdentifierDesk
identifier NameDesk
name = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Setting name " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (NameDesk -> String
forall a. Show a => a -> String
show NameDesk
name) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" of desk " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierDesk -> String
forall a. Show a => a -> String
show IdentifierDesk
identifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
  Table DbDesk
-> (Row (Backend (SeldaTransactionT m)) DbDesk
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> (Row (Backend (SeldaTransactionT m)) DbDesk
    -> Row (Backend (SeldaTransactionT m)) DbDesk)
-> SeldaTransactionT m ()
forall (m :: * -> *) a.
(MonadSelda m, MonadThrow m, Relational a) =>
Table a
-> (Row (Backend m) a -> Col (Backend m) Bool)
-> (Row (Backend m) a -> Row (Backend m) a)
-> m ()
Selda.updateOne
    Table DbDesk
tableDesk
    (Selector DbDesk (ID DbDesk)
#dbDesk_id Selector DbDesk (ID DbDesk)
-> ID DbDesk -> Row SQLite DbDesk -> Col SQLite Bool
forall r s c.
SqlType c =>
Selector r c -> c -> Row s r -> Col s Bool
`Selda.is` forall a. Int64 -> ID a
Selda.toId @DbDesk (IdentifierDesk -> Int64
unIdentifierDesk IdentifierDesk
identifier))
    (\Row (Backend (SeldaTransactionT m)) DbDesk
rowDesk -> Row (Backend (SeldaTransactionT m)) DbDesk
Row SQLite DbDesk
rowDesk Row SQLite DbDesk
-> [Assignment SQLite DbDesk] -> Row SQLite DbDesk
forall s a. Row s a -> [Assignment s a] -> Row s a
`Selda.with` [Selector DbDesk Text
#dbDesk_name Selector DbDesk Text -> Col SQLite Text -> Assignment SQLite DbDesk
forall a a1 s. Selector a a1 -> Col s a1 -> Assignment s a
Selda.:= Text -> Col SQLite Text
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (NameDesk -> Text
unNameDesk NameDesk
name)])
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Set desk name successfully."

deskLocationSet ::
  (MonadLogger m, MonadSeldaPool m) =>
  IdentifierDesk ->
  Maybe LocationDesk ->
  SeldaTransactionT m ()
deskLocationSet :: forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierDesk -> Maybe LocationDesk -> SeldaTransactionT m ()
deskLocationSet IdentifierDesk
identifier Maybe LocationDesk
location = do
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Setting location " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Maybe LocationDesk -> String
forall a. Show a => a -> String
show Maybe LocationDesk
location) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" of desk " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierDesk -> String
forall a. Show a => a -> String
show IdentifierDesk
identifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
  Table DbDesk
-> (Row (Backend (SeldaTransactionT m)) DbDesk
    -> Col (Backend (SeldaTransactionT m)) Bool)
-> (Row (Backend (SeldaTransactionT m)) DbDesk
    -> Row (Backend (SeldaTransactionT m)) DbDesk)
-> SeldaTransactionT m ()
forall (m :: * -> *) a.
(MonadSelda m, MonadThrow m, Relational a) =>
Table a
-> (Row (Backend m) a -> Col (Backend m) Bool)
-> (Row (Backend m) a -> Row (Backend m) a)
-> m ()
Selda.updateOne
    Table DbDesk
tableDesk
    (Selector DbDesk (ID DbDesk)
#dbDesk_id Selector DbDesk (ID DbDesk)
-> ID DbDesk -> Row SQLite DbDesk -> Col SQLite Bool
forall r s c.
SqlType c =>
Selector r c -> c -> Row s r -> Col s Bool
`Selda.is` forall a. Int64 -> ID a
Selda.toId @DbDesk (IdentifierDesk -> Int64
unIdentifierDesk IdentifierDesk
identifier))
    ( \Row (Backend (SeldaTransactionT m)) DbDesk
rowDesk ->
        Row (Backend (SeldaTransactionT m)) DbDesk
Row SQLite DbDesk
rowDesk
          Row SQLite DbDesk
-> [Assignment SQLite DbDesk] -> Row SQLite DbDesk
forall s a. Row s a -> [Assignment s a] -> Row s a
`Selda.with` [ Selector DbDesk (Maybe Double)
#dbDesk_position_x Selector DbDesk (Maybe Double)
-> Col SQLite (Maybe Double) -> Assignment SQLite DbDesk
forall a a1 s. Selector a a1 -> Col s a1 -> Assignment s a
Selda.:= Maybe Double -> Col SQLite (Maybe Double)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (ConstrainedDouble '[] -> Double
forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints -> Double
unConstrainedDouble (ConstrainedDouble '[] -> Double)
-> (LocationDesk -> ConstrainedDouble '[])
-> LocationDesk
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionDesk -> ConstrainedDouble '[]
positionDeskX (PositionDesk -> ConstrainedDouble '[])
-> (LocationDesk -> PositionDesk)
-> LocationDesk
-> ConstrainedDouble '[]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocationDesk -> PositionDesk
locationDeskPosition (LocationDesk -> Double) -> Maybe LocationDesk -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LocationDesk
location)
                       , Selector DbDesk (Maybe Double)
#dbDesk_position_y Selector DbDesk (Maybe Double)
-> Col SQLite (Maybe Double) -> Assignment SQLite DbDesk
forall a a1 s. Selector a a1 -> Col s a1 -> Assignment s a
Selda.:= Maybe Double -> Col SQLite (Maybe Double)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (ConstrainedDouble '[] -> Double
forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints -> Double
unConstrainedDouble (ConstrainedDouble '[] -> Double)
-> (LocationDesk -> ConstrainedDouble '[])
-> LocationDesk
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionDesk -> ConstrainedDouble '[]
positionDeskY (PositionDesk -> ConstrainedDouble '[])
-> (LocationDesk -> PositionDesk)
-> LocationDesk
-> ConstrainedDouble '[]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocationDesk -> PositionDesk
locationDeskPosition (LocationDesk -> Double) -> Maybe LocationDesk -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LocationDesk
location)
                       , Selector DbDesk (Maybe Double)
#dbDesk_direction Selector DbDesk (Maybe Double)
-> Col SQLite (Maybe Double) -> Assignment SQLite DbDesk
forall a a1 s. Selector a a1 -> Col s a1 -> Assignment s a
Selda.:= Maybe Double -> Col SQLite (Maybe Double)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (ConstrainedDouble
  '[MkConstraintDoubleGreaterEqual 0, MkConstraintDoubleLessThan 360]
-> Double
forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints -> Double
unConstrainedDouble (ConstrainedDouble
   '[MkConstraintDoubleGreaterEqual 0, MkConstraintDoubleLessThan 360]
 -> Double)
-> (LocationDesk
    -> ConstrainedDouble
         '[MkConstraintDoubleGreaterEqual 0,
           MkConstraintDoubleLessThan 360])
-> LocationDesk
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction
-> ConstrainedDouble
     '[MkConstraintDoubleGreaterEqual 0, MkConstraintDoubleLessThan 360]
unDirectionDegrees (Direction
 -> ConstrainedDouble
      '[MkConstraintDoubleGreaterEqual 0,
        MkConstraintDoubleLessThan 360])
-> (LocationDesk -> Direction)
-> LocationDesk
-> ConstrainedDouble
     '[MkConstraintDoubleGreaterEqual 0, MkConstraintDoubleLessThan 360]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirectionDesk -> Direction
unDirectionDesk (DirectionDesk -> Direction)
-> (LocationDesk -> DirectionDesk) -> LocationDesk -> Direction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocationDesk -> DirectionDesk
locationDeskDirection (LocationDesk -> Double) -> Maybe LocationDesk -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LocationDesk
location)
                       , Selector DbDesk (Maybe Double)
#dbDesk_size_width Selector DbDesk (Maybe Double)
-> Col SQLite (Maybe Double) -> Assignment SQLite DbDesk
forall a a1 s. Selector a a1 -> Col s a1 -> Assignment s a
Selda.:= Maybe Double -> Col SQLite (Maybe Double)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (ConstrainedDouble
  '[MkConstraintDoubleGreaterEqual 30,
    MkConstraintDoubleLessEqual 600]
-> Double
forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints -> Double
unConstrainedDouble (ConstrainedDouble
   '[MkConstraintDoubleGreaterEqual 30,
     MkConstraintDoubleLessEqual 600]
 -> Double)
-> (LocationDesk
    -> ConstrainedDouble
         '[MkConstraintDoubleGreaterEqual 30,
           MkConstraintDoubleLessEqual 600])
-> LocationDesk
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizeDesk
-> ConstrainedDouble
     '[MkConstraintDoubleGreaterEqual 30,
       MkConstraintDoubleLessEqual 600]
sizeDeskWidth (SizeDesk
 -> ConstrainedDouble
      '[MkConstraintDoubleGreaterEqual 30,
        MkConstraintDoubleLessEqual 600])
-> (LocationDesk -> SizeDesk)
-> LocationDesk
-> ConstrainedDouble
     '[MkConstraintDoubleGreaterEqual 30,
       MkConstraintDoubleLessEqual 600]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocationDesk -> SizeDesk
locationDeskSize (LocationDesk -> Double) -> Maybe LocationDesk -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LocationDesk
location)
                       , Selector DbDesk (Maybe Double)
#dbDesk_size_depth Selector DbDesk (Maybe Double)
-> Col SQLite (Maybe Double) -> Assignment SQLite DbDesk
forall a a1 s. Selector a a1 -> Col s a1 -> Assignment s a
Selda.:= Maybe Double -> Col SQLite (Maybe Double)
forall {k} a (s :: k). SqlType a => a -> Col s a
Selda.literal (ConstrainedDouble
  '[MkConstraintDoubleGreaterEqual 30,
    MkConstraintDoubleLessEqual 600]
-> Double
forall (constraints :: [ConstraintDouble]).
ConstrainedDouble constraints -> Double
unConstrainedDouble (ConstrainedDouble
   '[MkConstraintDoubleGreaterEqual 30,
     MkConstraintDoubleLessEqual 600]
 -> Double)
-> (LocationDesk
    -> ConstrainedDouble
         '[MkConstraintDoubleGreaterEqual 30,
           MkConstraintDoubleLessEqual 600])
-> LocationDesk
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizeDesk
-> ConstrainedDouble
     '[MkConstraintDoubleGreaterEqual 30,
       MkConstraintDoubleLessEqual 600]
sizeDeskDepth (SizeDesk
 -> ConstrainedDouble
      '[MkConstraintDoubleGreaterEqual 30,
        MkConstraintDoubleLessEqual 600])
-> (LocationDesk -> SizeDesk)
-> LocationDesk
-> ConstrainedDouble
     '[MkConstraintDoubleGreaterEqual 30,
       MkConstraintDoubleLessEqual 600]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocationDesk -> SizeDesk
locationDeskSize (LocationDesk -> Double) -> Maybe LocationDesk -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LocationDesk
location)
                       ]
    )
  m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Set desk location successfully."

spaceVisibilityApiToDb :: VisibilitySpace -> DbSpaceVisibility
spaceVisibilityApiToDb :: VisibilitySpace -> DbSpaceVisibility
spaceVisibilityApiToDb = \case
  VisibilitySpace
MkVisibilitySpaceVisible -> DbSpaceVisibility
MkDbSpaceVisibility_visible
  VisibilitySpace
MkVisibilitySpaceHidden -> DbSpaceVisibility
MkDbSpaceVisibility_hidden

spaceVisibilityDbToApi :: DbSpaceVisibility -> VisibilitySpace
spaceVisibilityDbToApi :: DbSpaceVisibility -> VisibilitySpace
spaceVisibilityDbToApi = \case
  DbSpaceVisibility
MkDbSpaceVisibility_visible -> VisibilitySpace
MkVisibilitySpaceVisible
  DbSpaceVisibility
MkDbSpaceVisibility_hidden -> VisibilitySpace
MkVisibilitySpaceHidden

roleAccessibilityApiToDb :: AccessibilityRole -> DbRoleAccessibility
roleAccessibilityApiToDb :: AccessibilityRole -> DbRoleAccessibility
roleAccessibilityApiToDb = \case
  AccessibilityRole
MkAccessibilityRoleJoinable -> DbRoleAccessibility
MkDbRoleAccessibility_joinable
  AccessibilityRole
MkAccessibilityRoleJoinableWithPassword -> DbRoleAccessibility
MkDbRoleAccessibility_joinable_with_password
  AccessibilityRole
MkAccessibilityRoleInaccessible -> DbRoleAccessibility
MkDbRoleAccessibility_inaccessible

roleAccessibilityDbToApi :: DbRoleAccessibility -> AccessibilityRole
roleAccessibilityDbToApi :: DbRoleAccessibility -> AccessibilityRole
roleAccessibilityDbToApi = \case
  DbRoleAccessibility
MkDbRoleAccessibility_joinable -> AccessibilityRole
MkAccessibilityRoleJoinable
  DbRoleAccessibility
MkDbRoleAccessibility_joinable_with_password -> AccessibilityRole
MkAccessibilityRoleJoinableWithPassword
  DbRoleAccessibility
MkDbRoleAccessibility_inaccessible -> AccessibilityRole
MkAccessibilityRoleInaccessible

spacePermissionApiToDb :: Permission -> DbPermission
spacePermissionApiToDb :: Permission -> DbPermission
spacePermissionApiToDb = \case
  Permission
MkPermissionViewSpace -> DbPermission
MkDbPermission_view_space
  Permission
MkPermissionEditDesk -> DbPermission
MkDbPermission_edit_desk
  Permission
MkPermissionEditUser -> DbPermission
MkDbPermission_edit_user
  Permission
MkPermissionEditRole -> DbPermission
MkDbPermission_edit_role
  Permission
MkPermissionEditSpace -> DbPermission
MkDbPermission_edit_space
  Permission
MkPermissionCreateReservation -> DbPermission
MkDbPermission_create_reservation
  Permission
MkPermissionCancelReservation -> DbPermission
MkDbPermission_cancel_reservation

spacePermissionDbToApi :: DbPermission -> Permission
spacePermissionDbToApi :: DbPermission -> Permission
spacePermissionDbToApi = \case
  DbPermission
MkDbPermission_view_space -> Permission
MkPermissionViewSpace
  DbPermission
MkDbPermission_edit_desk -> Permission
MkPermissionEditDesk
  DbPermission
MkDbPermission_edit_user -> Permission
MkPermissionEditUser
  DbPermission
MkDbPermission_edit_role -> Permission
MkPermissionEditRole
  DbPermission
MkDbPermission_edit_space -> Permission
MkPermissionEditSpace
  DbPermission
MkDbPermission_create_reservation -> Permission
MkPermissionCreateReservation
  DbPermission
MkDbPermission_cancel_reservation -> Permission
MkPermissionCancelReservation