module Mensam.Server.Server.Route.Api.Space where

import Mensam.API.Aeson
import Mensam.API.Aeson.StaticText
import Mensam.API.Data.Desk
import Mensam.API.Data.Space
import Mensam.API.Data.Space.Permission
import Mensam.API.Data.User
import Mensam.API.Route.Api.Space
import Mensam.API.Update
import Mensam.Server.Application.Configured.Class
import Mensam.Server.Application.SeldaPool.Class
import Mensam.Server.Application.SeldaPool.Servant
import Mensam.Server.Configuration
import Mensam.Server.Jpeg
import Mensam.Server.Reservation
import Mensam.Server.Server.Auth
import Mensam.Server.Space

import Control.Monad.Catch
import Control.Monad.IO.Class
import Control.Monad.Logger.CallStack
import Control.Monad.Trans.Class
import Data.ByteString qualified as B
import Data.Foldable
import Data.Password.Bcrypt
import Data.SOP qualified as SOP
import Data.Text qualified as T
import Data.Traversable
import Data.Typeable
import Database.Selda qualified as Selda
import Servant hiding (BasicAuthResult (..))
import Servant.API.ImageJpeg
import Servant.Auth.Server
import Servant.Server.Generic

handler ::
  (MonadConfigured m, MonadIO m, MonadLogger m, MonadSeldaPool m) =>
  Routes (AsServerT m)
handler :: forall (m :: * -> *).
(MonadConfigured m, MonadIO m, MonadLogger m, MonadSeldaPool m) =>
Routes (AsServerT m)
handler =
  Routes
    { routeSpaceCreate :: AsServerT m
:- (Summary "Create Space"
    :> (Description
          "Create a new space.\nYou will be an administrator of this newly created space.\n"
        :> ("space"
            :> ("create"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestSpaceCreate
                        :> UVerb
                             'PUT
                             '[JSON]
                             '[WithStatus 201 ResponseSpaceCreate,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus 500 ()]))))))
routeSpaceCreate = AsServerT m
:- (Summary "Create Space"
    :> (Description
          "Create a new space.\nYou will be an administrator of this newly created space.\n"
        :> ("space"
            :> ("create"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestSpaceCreate
                        :> UVerb
                             'PUT
                             '[JSON]
                             '[WithStatus 201 ResponseSpaceCreate,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus 500 ()]))))))
AuthResult UserAuthenticated
-> Either String RequestSpaceCreate
-> m (Union
        '[WithStatus 201 ResponseSpaceCreate,
          WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
          WithStatus 500 ()])
forall (m :: * -> *) (responses :: [*]).
(MonadIO m, MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 201 ResponseSpaceCreate) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestSpaceCreate -> m (Union responses)
createSpace
    , routeSpaceDelete :: AsServerT m
:- (Summary "Delete Space"
    :> (Description
          "Delete a space irreversibly.\nThis also purges data associated with this space including reservations, desks and member roles.\n"
        :> ("space"
            :> ("delete"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestSpaceDelete
                        :> UVerb
                             'DELETE
                             '[JSON]
                             '[WithStatus 200 ResponseSpaceDelete,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus
                                 403 (ErrorInsufficientPermission 'MkPermissionEditSpace),
                               WithStatus 404 (StaticText "Space not found."),
                               WithStatus 500 ()]))))))
routeSpaceDelete = AsServerT m
:- (Summary "Delete Space"
    :> (Description
          "Delete a space irreversibly.\nThis also purges data associated with this space including reservations, desks and member roles.\n"
        :> ("space"
            :> ("delete"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestSpaceDelete
                        :> UVerb
                             'DELETE
                             '[JSON]
                             '[WithStatus 200 ResponseSpaceDelete,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus
                                 403 (ErrorInsufficientPermission 'MkPermissionEditSpace),
                               WithStatus 404 (StaticText "Space not found."),
                               WithStatus 500 ()]))))))
AuthResult UserAuthenticated
-> Either String RequestSpaceDelete
-> m (Union
        '[WithStatus 200 ResponseSpaceDelete,
          WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
          WithStatus
            403 (ErrorInsufficientPermission 'MkPermissionEditSpace),
          WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseSpaceDelete) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionEditSpace))
   responses,
 IsMember
   (WithStatus 404 (StaticText "Space not found.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestSpaceDelete -> m (Union responses)
deleteSpace
    , routeSpaceEdit :: AsServerT m
:- (Summary "Edit Space"
    :> (Description "Update the configuration of a space.\n"
        :> ("space"
            :> ("edit"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestSpaceEdit
                        :> UVerb
                             'PATCH
                             '[JSON]
                             '[WithStatus 200 ResponseSpaceEdit,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus
                                 403 (ErrorInsufficientPermission 'MkPermissionEditSpace),
                               WithStatus 404 (StaticText "Space not found."),
                               WithStatus 500 ()]))))))
routeSpaceEdit = AsServerT m
:- (Summary "Edit Space"
    :> (Description "Update the configuration of a space.\n"
        :> ("space"
            :> ("edit"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestSpaceEdit
                        :> UVerb
                             'PATCH
                             '[JSON]
                             '[WithStatus 200 ResponseSpaceEdit,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus
                                 403 (ErrorInsufficientPermission 'MkPermissionEditSpace),
                               WithStatus 404 (StaticText "Space not found."),
                               WithStatus 500 ()]))))))
AuthResult UserAuthenticated
-> Either String RequestSpaceEdit
-> m (Union
        '[WithStatus 200 ResponseSpaceEdit,
          WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
          WithStatus
            403 (ErrorInsufficientPermission 'MkPermissionEditSpace),
          WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseSpaceEdit) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionEditSpace))
   responses,
 IsMember
   (WithStatus 404 (StaticText "Space not found.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestSpaceEdit -> m (Union responses)
editSpace
    , routePictureUpload :: AsServerT m
:- (Summary "Change Space Picture"
    :> (Description
          "Upload a new space logo.\nThis overwrites any old space logo.\n"
        :> ("space"
            :> ("picture"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (QueryParam' '[Lenient, Required] "space" IdentifierSpace
                        :> (ReqBody' '[Lenient, Required] '[ImageJpeg] ImageJpegBytes
                            :> UVerb
                                 'PUT
                                 '[JSON]
                                 '[WithStatus 200 (StaticText "Uploaded space picture."),
                                   WithStatus 400 ErrorParseBodyJpeg,
                                   WithStatus 401 ErrorBearerAuth,
                                   WithStatus
                                     403 (ErrorInsufficientPermission 'MkPermissionEditSpace),
                                   WithStatus 404 (StaticText "Space not found."),
                                   WithStatus 500 ()])))))))
routePictureUpload = AsServerT m
:- (Summary "Change Space Picture"
    :> (Description
          "Upload a new space logo.\nThis overwrites any old space logo.\n"
        :> ("space"
            :> ("picture"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (QueryParam' '[Lenient, Required] "space" IdentifierSpace
                        :> (ReqBody' '[Lenient, Required] '[ImageJpeg] ImageJpegBytes
                            :> UVerb
                                 'PUT
                                 '[JSON]
                                 '[WithStatus 200 (StaticText "Uploaded space picture."),
                                   WithStatus 400 ErrorParseBodyJpeg,
                                   WithStatus 401 ErrorBearerAuth,
                                   WithStatus
                                     403 (ErrorInsufficientPermission 'MkPermissionEditSpace),
                                   WithStatus 404 (StaticText "Space not found."),
                                   WithStatus 500 ()])))))))
AuthResult UserAuthenticated
-> Either Text IdentifierSpace
-> Either String ImageJpegBytes
-> m (Union
        '[WithStatus 200 (StaticText "Uploaded space picture."),
          WithStatus 400 ErrorParseBodyJpeg, WithStatus 401 ErrorBearerAuth,
          WithStatus
            403 (ErrorInsufficientPermission 'MkPermissionEditSpace),
          WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember
   (WithStatus 200 (StaticText "Uploaded space picture.")) responses,
 IsMember (WithStatus 400 ErrorParseBodyJpeg) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionEditSpace))
   responses,
 IsMember
   (WithStatus 404 (StaticText "Space not found.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either Text IdentifierSpace
-> Either String ImageJpegBytes
-> m (Union responses)
pictureUpload
    , routePictureDelete :: AsServerT m
:- (Summary "Delete Space Picture"
    :> (Description "Delete the current space logo.\n"
        :> ("space"
            :> ("picture"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (QueryParam' '[Lenient, Required] "space" IdentifierSpace
                        :> UVerb
                             'DELETE
                             '[JSON]
                             '[WithStatus 200 (StaticText "Deleted space picture."),
                               WithStatus 401 ErrorBearerAuth,
                               WithStatus
                                 403 (ErrorInsufficientPermission 'MkPermissionEditSpace),
                               WithStatus 404 (StaticText "Space not found."),
                               WithStatus 500 ()]))))))
routePictureDelete = AsServerT m
:- (Summary "Delete Space Picture"
    :> (Description "Delete the current space logo.\n"
        :> ("space"
            :> ("picture"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (QueryParam' '[Lenient, Required] "space" IdentifierSpace
                        :> UVerb
                             'DELETE
                             '[JSON]
                             '[WithStatus 200 (StaticText "Deleted space picture."),
                               WithStatus 401 ErrorBearerAuth,
                               WithStatus
                                 403 (ErrorInsufficientPermission 'MkPermissionEditSpace),
                               WithStatus 404 (StaticText "Space not found."),
                               WithStatus 500 ()]))))))
AuthResult UserAuthenticated
-> Either Text IdentifierSpace
-> m (Union
        '[WithStatus 200 (StaticText "Deleted space picture."),
          WithStatus 401 ErrorBearerAuth,
          WithStatus
            403 (ErrorInsufficientPermission 'MkPermissionEditSpace),
          WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember
   (WithStatus 200 (StaticText "Deleted space picture.")) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionEditSpace))
   responses,
 IsMember
   (WithStatus 404 (StaticText "Space not found.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either Text IdentifierSpace -> m (Union responses)
pictureDelete
    , routePictureDownload :: AsServerT m
:- (Summary "View Space Picture"
    :> (Description "View a space logo.\n"
        :> ("space"
            :> ("picture"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (QueryParam' '[Lenient, Required] "space" IdentifierSpace
                        :> Get '[ImageJpeg] ImageJpegBytes))))))
routePictureDownload = AsServerT m
:- (Summary "View Space Picture"
    :> (Description "View a space logo.\n"
        :> ("space"
            :> ("picture"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (QueryParam' '[Lenient, Required] "space" IdentifierSpace
                        :> Get '[ImageJpeg] ImageJpegBytes))))))
AuthResult UserAuthenticated
-> Either Text IdentifierSpace -> m ImageJpegBytes
forall (m :: * -> *).
(MonadConfigured m, MonadIO m, MonadLogger m, MonadSeldaPool m) =>
AuthResult UserAuthenticated
-> Either Text IdentifierSpace -> m ImageJpegBytes
pictureDownload
    , routeSpaceJoin :: AsServerT m
:- (Summary "Join Space"
    :> (Description "Become a member of a space.\n"
        :> ("space"
            :> ("join"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestSpaceJoin
                        :> UVerb
                             'POST
                             '[JSON]
                             '[WithStatus 200 ResponseSpaceJoin,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus
                                 403
                                 (StaticTexts '["Role is inaccessible.", "Wrong role password."]),
                               WithStatus 404 (StaticText "Space not found."),
                               WithStatus 500 ()]))))))
routeSpaceJoin = AsServerT m
:- (Summary "Join Space"
    :> (Description "Become a member of a space.\n"
        :> ("space"
            :> ("join"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestSpaceJoin
                        :> UVerb
                             'POST
                             '[JSON]
                             '[WithStatus 200 ResponseSpaceJoin,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus
                                 403
                                 (StaticTexts '["Role is inaccessible.", "Wrong role password."]),
                               WithStatus 404 (StaticText "Space not found."),
                               WithStatus 500 ()]))))))
AuthResult UserAuthenticated
-> Either String RequestSpaceJoin
-> m (Union
        '[WithStatus 200 ResponseSpaceJoin,
          WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
          WithStatus
            403
            (StaticTexts '["Role is inaccessible.", "Wrong role password."]),
          WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseSpaceJoin) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403
      (StaticTexts '["Role is inaccessible.", "Wrong role password."]))
   responses,
 IsMember
   (WithStatus 404 (StaticText "Space not found.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestSpaceJoin -> m (Union responses)
joinSpace
    , routeSpaceLeave :: AsServerT m
:- (Summary "Leave Space"
    :> (Description "Abandon membership of a space.\n"
        :> ("space"
            :> ("leave"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestSpaceLeave
                        :> UVerb
                             'POST
                             '[JSON]
                             '[WithStatus 200 ResponseSpaceLeave,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus 403 (StaticText "Owner cannot leave space."),
                               WithStatus 404 (StaticText "Space not found."),
                               WithStatus 500 ()]))))))
routeSpaceLeave = AsServerT m
:- (Summary "Leave Space"
    :> (Description "Abandon membership of a space.\n"
        :> ("space"
            :> ("leave"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestSpaceLeave
                        :> UVerb
                             'POST
                             '[JSON]
                             '[WithStatus 200 ResponseSpaceLeave,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus 403 (StaticText "Owner cannot leave space."),
                               WithStatus 404 (StaticText "Space not found."),
                               WithStatus 500 ()]))))))
AuthResult UserAuthenticated
-> Either String RequestSpaceLeave
-> m (Union
        '[WithStatus 200 ResponseSpaceLeave,
          WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
          WithStatus 403 (StaticText "Owner cannot leave space."),
          WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseSpaceLeave) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus 403 (StaticText "Owner cannot leave space."))
   responses,
 IsMember
   (WithStatus 404 (StaticText "Space not found.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestSpaceLeave -> m (Union responses)
leaveSpace
    , routeSpaceKick :: AsServerT m
:- (Summary "Kick User from Space"
    :> (Description
          "Kick a user out of a space.\nYou need the `edit-user` permission for that space to remove users.\n"
        :> ("space"
            :> ("kick"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestSpaceKick
                        :> UVerb
                             'POST
                             '[JSON]
                             '[WithStatus 200 ResponseSpaceKick,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditUser),
                               WithStatus 404 (StaticText "Space not found."),
                               WithStatus 500 ()]))))))
routeSpaceKick = AsServerT m
:- (Summary "Kick User from Space"
    :> (Description
          "Kick a user out of a space.\nYou need the `edit-user` permission for that space to remove users.\n"
        :> ("space"
            :> ("kick"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestSpaceKick
                        :> UVerb
                             'POST
                             '[JSON]
                             '[WithStatus 200 ResponseSpaceKick,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditUser),
                               WithStatus 404 (StaticText "Space not found."),
                               WithStatus 500 ()]))))))
AuthResult UserAuthenticated
-> Either String RequestSpaceKick
-> m (Union
        '[WithStatus 200 ResponseSpaceKick,
          WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
          WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditUser),
          WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseSpaceKick) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionEditUser))
   responses,
 IsMember
   (WithStatus 404 (StaticText "Space not found.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestSpaceKick -> m (Union responses)
kickUser
    , routeSpaceUserRole :: AsServerT m
:- (Summary "Set User Role for Space"
    :> (Description
          "Give a new role to a user of a space.\nYou need the `edit-user` permission for that space to redefine user roles.\n"
        :> ("space"
            :> ("user"
                :> ("role"
                    :> (Auth '[JWTWithSession] UserAuthenticated
                        :> (ReqBody' '[Lenient, Required] '[JSON] RequestSpaceUserRole
                            :> UVerb
                                 'POST
                                 '[JSON]
                                 '[WithStatus 200 ResponseSpaceUserRole,
                                   WithStatus 400 ErrorParseBodyJson,
                                   WithStatus 401 ErrorBearerAuth,
                                   WithStatus
                                     403 (ErrorInsufficientPermission 'MkPermissionEditUser),
                                   WithStatus 404 (StaticText "Space not found."),
                                   WithStatus 500 ()])))))))
routeSpaceUserRole = AsServerT m
:- (Summary "Set User Role for Space"
    :> (Description
          "Give a new role to a user of a space.\nYou need the `edit-user` permission for that space to redefine user roles.\n"
        :> ("space"
            :> ("user"
                :> ("role"
                    :> (Auth '[JWTWithSession] UserAuthenticated
                        :> (ReqBody' '[Lenient, Required] '[JSON] RequestSpaceUserRole
                            :> UVerb
                                 'POST
                                 '[JSON]
                                 '[WithStatus 200 ResponseSpaceUserRole,
                                   WithStatus 400 ErrorParseBodyJson,
                                   WithStatus 401 ErrorBearerAuth,
                                   WithStatus
                                     403 (ErrorInsufficientPermission 'MkPermissionEditUser),
                                   WithStatus 404 (StaticText "Space not found."),
                                   WithStatus 500 ()])))))))
AuthResult UserAuthenticated
-> Either String RequestSpaceUserRole
-> m (Union
        '[WithStatus 200 ResponseSpaceUserRole,
          WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
          WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditUser),
          WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseSpaceUserRole) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionEditUser))
   responses,
 IsMember
   (WithStatus 404 (StaticText "Space not found.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestSpaceUserRole -> m (Union responses)
setUserRole
    , routeSpaceList :: AsServerT m
:- (Summary "List Spaces"
    :> (Description "List visible spaces.\n"
        :> ("space"
            :> ("list"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestSpaceList
                        :> UVerb
                             'POST
                             '[JSON]
                             '[WithStatus 200 ResponseSpaceList,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus 500 ()]))))))
routeSpaceList = AsServerT m
:- (Summary "List Spaces"
    :> (Description "List visible spaces.\n"
        :> ("space"
            :> ("list"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestSpaceList
                        :> UVerb
                             'POST
                             '[JSON]
                             '[WithStatus 200 ResponseSpaceList,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus 500 ()]))))))
AuthResult UserAuthenticated
-> Either String RequestSpaceList
-> m (Union
        '[WithStatus 200 ResponseSpaceList,
          WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
          WithStatus 500 ()])
forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseSpaceList) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestSpaceList -> m (Union responses)
listSpaces
    , routeSpaceView :: AsServerT m
:- (Summary "View Space"
    :> (Description "View a single space in detail.\n"
        :> ("space"
            :> ("view"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestSpaceView
                        :> UVerb
                             'POST
                             '[JSON]
                             '[WithStatus 200 ResponseSpaceView,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus 403 ResponseSpaceView403,
                               WithStatus 404 (StaticText "Space not found."),
                               WithStatus 500 ()]))))))
routeSpaceView = AsServerT m
:- (Summary "View Space"
    :> (Description "View a single space in detail.\n"
        :> ("space"
            :> ("view"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestSpaceView
                        :> UVerb
                             'POST
                             '[JSON]
                             '[WithStatus 200 ResponseSpaceView,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus 403 ResponseSpaceView403,
                               WithStatus 404 (StaticText "Space not found."),
                               WithStatus 500 ()]))))))
AuthResult UserAuthenticated
-> Either String RequestSpaceView
-> m (Union
        '[WithStatus 200 ResponseSpaceView,
          WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
          WithStatus 403 ResponseSpaceView403,
          WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseSpaceView) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember (WithStatus 403 ResponseSpaceView403) responses,
 IsMember
   (WithStatus 404 (StaticText "Space not found.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestSpaceView -> m (Union responses)
viewSpace
    , routeRoleCreate :: AsServerT m
:- (Summary "Create Role"
    :> (Description
          "Create a new role.\nThis role will be a way to access the given space.\nYou need the `edit-role` permission for that space to create roles.\n"
        :> ("role"
            :> ("create"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestRoleCreate
                        :> UVerb
                             'PUT
                             '[JSON]
                             '[WithStatus 201 ResponseRoleCreate,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditRole),
                               WithStatus 404 (StaticText "Space not found."),
                               WithStatus 500 ()]))))))
routeRoleCreate = AsServerT m
:- (Summary "Create Role"
    :> (Description
          "Create a new role.\nThis role will be a way to access the given space.\nYou need the `edit-role` permission for that space to create roles.\n"
        :> ("role"
            :> ("create"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestRoleCreate
                        :> UVerb
                             'PUT
                             '[JSON]
                             '[WithStatus 201 ResponseRoleCreate,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditRole),
                               WithStatus 404 (StaticText "Space not found."),
                               WithStatus 500 ()]))))))
AuthResult UserAuthenticated
-> Either String RequestRoleCreate
-> m (Union
        '[WithStatus 201 ResponseRoleCreate,
          WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
          WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditRole),
          WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
forall (m :: * -> *) (responses :: [*]).
(MonadIO m, MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 201 ResponseRoleCreate) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionEditRole))
   responses,
 IsMember
   (WithStatus 404 (StaticText "Space not found.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestRoleCreate -> m (Union responses)
createRole
    , routeRoleEdit :: AsServerT m
:- (Summary "Edit Role"
    :> (Description
          "Update settings of a role.\nYou need the `edit-role` permission for the space to edit roles.\n"
        :> ("role"
            :> ("edit"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestRoleEdit
                        :> UVerb
                             'PATCH
                             '[JSON]
                             '[WithStatus 200 ResponseRoleEdit,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditRole),
                               WithStatus 500 ()]))))))
routeRoleEdit = AsServerT m
:- (Summary "Edit Role"
    :> (Description
          "Update settings of a role.\nYou need the `edit-role` permission for the space to edit roles.\n"
        :> ("role"
            :> ("edit"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestRoleEdit
                        :> UVerb
                             'PATCH
                             '[JSON]
                             '[WithStatus 200 ResponseRoleEdit,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditRole),
                               WithStatus 500 ()]))))))
AuthResult UserAuthenticated
-> Either String RequestRoleEdit
-> m (Union
        '[WithStatus 200 ResponseRoleEdit,
          WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
          WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditRole),
          WithStatus 500 ()])
forall (m :: * -> *) (responses :: [*]).
(MonadIO m, MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseRoleEdit) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionEditRole))
   responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestRoleEdit -> m (Union responses)
editRole
    , routeRoleDelete :: AsServerT m
:- (Summary "Delete Role"
    :> (Description
          "Delete a role.\nYou have to provide a fallback role to reassign members to that fallback role.\nYou need the `edit-role` permission for the space to delete roles.\n"
        :> ("role"
            :> ("delete"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestRoleDelete
                        :> UVerb
                             'DELETE
                             '[JSON]
                             '[WithStatus 200 ResponseRoleDelete,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditRole),
                               WithStatus 500 ()]))))))
routeRoleDelete = AsServerT m
:- (Summary "Delete Role"
    :> (Description
          "Delete a role.\nYou have to provide a fallback role to reassign members to that fallback role.\nYou need the `edit-role` permission for the space to delete roles.\n"
        :> ("role"
            :> ("delete"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestRoleDelete
                        :> UVerb
                             'DELETE
                             '[JSON]
                             '[WithStatus 200 ResponseRoleDelete,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditRole),
                               WithStatus 500 ()]))))))
AuthResult UserAuthenticated
-> Either String RequestRoleDelete
-> m (Union
        '[WithStatus 200 ResponseRoleDelete,
          WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
          WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditRole),
          WithStatus 500 ()])
forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseRoleDelete) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionEditRole))
   responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestRoleDelete -> m (Union responses)
deleteRole
    , routeDeskCreate :: AsServerT m
:- (Summary "Create Desk"
    :> (Description
          "Create a new desk.\nThis desk will belong to the given space.\nYou need the `edit-desk` permission for that space to create desks.\n"
        :> ("desk"
            :> ("create"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestDeskCreate
                        :> UVerb
                             'PUT
                             '[JSON]
                             '[WithStatus 201 ResponseDeskCreate,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditDesk),
                               WithStatus 404 (StaticText "Space not found."),
                               WithStatus 500 ()]))))))
routeDeskCreate = AsServerT m
:- (Summary "Create Desk"
    :> (Description
          "Create a new desk.\nThis desk will belong to the given space.\nYou need the `edit-desk` permission for that space to create desks.\n"
        :> ("desk"
            :> ("create"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestDeskCreate
                        :> UVerb
                             'PUT
                             '[JSON]
                             '[WithStatus 201 ResponseDeskCreate,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditDesk),
                               WithStatus 404 (StaticText "Space not found."),
                               WithStatus 500 ()]))))))
AuthResult UserAuthenticated
-> Either String RequestDeskCreate
-> m (Union
        '[WithStatus 201 ResponseDeskCreate,
          WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
          WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditDesk),
          WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 201 ResponseDeskCreate) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionEditDesk))
   responses,
 IsMember
   (WithStatus 404 (StaticText "Space not found.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestDeskCreate -> m (Union responses)
createDesk
    , routeDeskDelete :: AsServerT m
:- (Summary "Delete Desk"
    :> (Description
          "Delete a desk.\nYou need the `edit-desk` permission for that space to delete desks.\n"
        :> ("desk"
            :> ("delete"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestDeskDelete
                        :> UVerb
                             'DELETE
                             '[JSON]
                             '[WithStatus 200 ResponseDeskDelete,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditDesk),
                               WithStatus 404 (StaticText "Desk not found."),
                               WithStatus 500 ()]))))))
routeDeskDelete = AsServerT m
:- (Summary "Delete Desk"
    :> (Description
          "Delete a desk.\nYou need the `edit-desk` permission for that space to delete desks.\n"
        :> ("desk"
            :> ("delete"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestDeskDelete
                        :> UVerb
                             'DELETE
                             '[JSON]
                             '[WithStatus 200 ResponseDeskDelete,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditDesk),
                               WithStatus 404 (StaticText "Desk not found."),
                               WithStatus 500 ()]))))))
AuthResult UserAuthenticated
-> Either String RequestDeskDelete
-> m (Union
        '[WithStatus 200 ResponseDeskDelete,
          WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
          WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditDesk),
          WithStatus 404 (StaticText "Desk not found."), WithStatus 500 ()])
forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseDeskDelete) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionEditDesk))
   responses,
 IsMember (WithStatus 404 (StaticText "Desk not found.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestDeskDelete -> m (Union responses)
deleteDesk
    , routeDeskEdit :: AsServerT m
:- (Summary "Edit Desk"
    :> (Description
          "Update a desk.\nYou need the `edit-desk` permission for that space to edit desks.\n"
        :> ("desk"
            :> ("edit"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestDeskEdit
                        :> UVerb
                             'PATCH
                             '[JSON]
                             '[WithStatus 200 ResponseDeskEdit,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditDesk),
                               WithStatus 404 (StaticText "Desk not found."),
                               WithStatus 500 ()]))))))
routeDeskEdit = AsServerT m
:- (Summary "Edit Desk"
    :> (Description
          "Update a desk.\nYou need the `edit-desk` permission for that space to edit desks.\n"
        :> ("desk"
            :> ("edit"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestDeskEdit
                        :> UVerb
                             'PATCH
                             '[JSON]
                             '[WithStatus 200 ResponseDeskEdit,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditDesk),
                               WithStatus 404 (StaticText "Desk not found."),
                               WithStatus 500 ()]))))))
AuthResult UserAuthenticated
-> Either String RequestDeskEdit
-> m (Union
        '[WithStatus 200 ResponseDeskEdit,
          WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
          WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditDesk),
          WithStatus 404 (StaticText "Desk not found."), WithStatus 500 ()])
forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseDeskEdit) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionEditDesk))
   responses,
 IsMember (WithStatus 404 (StaticText "Desk not found.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestDeskEdit -> m (Union responses)
editDesk
    , routeDeskList :: AsServerT m
:- (Summary "List Desks"
    :> (Description
          "List desks.\nUse the time-window to restrict the reservations in the result to overlapping time frames.\n"
        :> ("desk"
            :> ("list"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestDeskList
                        :> UVerb
                             'POST
                             '[JSON]
                             '[WithStatus 200 ResponseDeskList,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus
                                 403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
                               WithStatus 404 (StaticText "Space not found."),
                               WithStatus 500 ()]))))))
routeDeskList = AsServerT m
:- (Summary "List Desks"
    :> (Description
          "List desks.\nUse the time-window to restrict the reservations in the result to overlapping time frames.\n"
        :> ("desk"
            :> ("list"
                :> (Auth '[JWTWithSession] UserAuthenticated
                    :> (ReqBody' '[Lenient, Required] '[JSON] RequestDeskList
                        :> UVerb
                             'POST
                             '[JSON]
                             '[WithStatus 200 ResponseDeskList,
                               WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                               WithStatus
                                 403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
                               WithStatus 404 (StaticText "Space not found."),
                               WithStatus 500 ()]))))))
AuthResult UserAuthenticated
-> Either String RequestDeskList
-> m (Union
        '[WithStatus 200 ResponseDeskList,
          WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
          WithStatus
            403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
          WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseDeskList) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionViewSpace))
   responses,
 IsMember
   (WithStatus 404 (StaticText "Space not found.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestDeskList -> m (Union responses)
listDesks
    }

createSpace ::
  ( MonadIO m
  , MonadLogger m
  , MonadSeldaPool m
  , IsMember (WithStatus 201 ResponseSpaceCreate) responses
  , IsMember (WithStatus 400 ErrorParseBodyJson) responses
  , IsMember (WithStatus 401 ErrorBearerAuth) responses
  , IsMember (WithStatus 500 ()) responses
  ) =>
  AuthResult UserAuthenticated ->
  Either String RequestSpaceCreate ->
  m (Union responses)
createSpace :: forall (m :: * -> *) (responses :: [*]).
(MonadIO m, MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 201 ResponseSpaceCreate) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestSpaceCreate -> m (Union responses)
createSpace AuthResult UserAuthenticated
auth Either String RequestSpaceCreate
eitherRequest =
  AuthResult UserAuthenticated
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 401 ErrorBearerAuth) responses) =>
AuthResult a -> (a -> m (Union responses)) -> m (Union responses)
handleAuthBearer AuthResult UserAuthenticated
auth ((UserAuthenticated -> m (Union responses)) -> m (Union responses))
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \UserAuthenticated
authenticated ->
    Either String RequestSpaceCreate
-> (RequestSpaceCreate -> m (Union responses))
-> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses) =>
Either String a
-> (a -> m (Union responses)) -> m (Union responses)
handleBadRequestBody Either String RequestSpaceCreate
eitherRequest ((RequestSpaceCreate -> m (Union responses))
 -> m (Union responses))
-> (RequestSpaceCreate -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \RequestSpaceCreate
request -> do
      Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Received request to create space: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (RequestSpaceCreate -> String
forall a. Show a => a -> String
show RequestSpaceCreate
request)
      SeldaResult IdentifierSpace
seldaResult <- SeldaTransactionT m IdentifierSpace
-> m (SeldaResult IdentifierSpace)
forall a. SeldaTransactionT m a -> m (SeldaResult a)
forall (m :: * -> *) a.
MonadSeldaPool m =>
SeldaTransactionT m a -> m (SeldaResult a)
runSeldaTransactionT (SeldaTransactionT m IdentifierSpace
 -> m (SeldaResult IdentifierSpace))
-> SeldaTransactionT m IdentifierSpace
-> m (SeldaResult IdentifierSpace)
forall a b. (a -> b) -> a -> b
$ 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
"Create space."
        IdentifierSpace
spaceIdentifier <- NameSpace
-> IdentifierUser
-> TZLabel
-> VisibilitySpace
-> SeldaTransactionT m IdentifierSpace
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
NameSpace
-> IdentifierUser
-> TZLabel
-> VisibilitySpace
-> SeldaTransactionT m IdentifierSpace
spaceCreate (RequestSpaceCreate -> NameSpace
requestSpaceCreateName RequestSpaceCreate
request) (UserAuthenticated -> IdentifierUser
userAuthenticatedId UserAuthenticated
authenticated) (RequestSpaceCreate -> TZLabel
requestSpaceCreateTimezone RequestSpaceCreate
request) (RequestSpaceCreate -> VisibilitySpace
requestSpaceCreateVisibility RequestSpaceCreate
request)

        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
"Create admin role and add user."
          IdentifierRole
roleIdentifier <- IdentifierSpace
-> NameRole
-> AccessibilityRole
-> Maybe Password
-> SeldaTransactionT m IdentifierRole
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace
-> NameRole
-> AccessibilityRole
-> Maybe Password
-> SeldaTransactionT m IdentifierRole
roleCreate IdentifierSpace
spaceIdentifier (Text -> NameRole
MkNameRole Text
"Admin") AccessibilityRole
MkAccessibilityRoleInaccessible Maybe Password
forall a. Maybe a
Nothing
          IdentifierRole -> Permission -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole -> Permission -> SeldaTransactionT m ()
rolePermissionGive IdentifierRole
roleIdentifier Permission
MkPermissionViewSpace
          IdentifierRole -> Permission -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole -> Permission -> SeldaTransactionT m ()
rolePermissionGive IdentifierRole
roleIdentifier Permission
MkPermissionEditDesk
          IdentifierRole -> Permission -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole -> Permission -> SeldaTransactionT m ()
rolePermissionGive IdentifierRole
roleIdentifier Permission
MkPermissionEditUser
          IdentifierRole -> Permission -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole -> Permission -> SeldaTransactionT m ()
rolePermissionGive IdentifierRole
roleIdentifier Permission
MkPermissionEditRole
          IdentifierRole -> Permission -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole -> Permission -> SeldaTransactionT m ()
rolePermissionGive IdentifierRole
roleIdentifier Permission
MkPermissionEditSpace
          IdentifierRole -> Permission -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole -> Permission -> SeldaTransactionT m ()
rolePermissionGive IdentifierRole
roleIdentifier Permission
MkPermissionCreateReservation
          IdentifierRole -> Permission -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole -> Permission -> SeldaTransactionT m ()
rolePermissionGive IdentifierRole
roleIdentifier Permission
MkPermissionCancelReservation
          IdentifierSpace
-> IdentifierUser -> IdentifierRole -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace
-> IdentifierUser -> IdentifierRole -> SeldaTransactionT m ()
spaceUserAdd IdentifierSpace
spaceIdentifier (UserAuthenticated -> IdentifierUser
userAuthenticatedId UserAuthenticated
authenticated) 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 ()
logInfo Text
"Create member role."
          IdentifierRole
roleIdentifier <- IdentifierSpace
-> NameRole
-> AccessibilityRole
-> Maybe Password
-> SeldaTransactionT m IdentifierRole
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace
-> NameRole
-> AccessibilityRole
-> Maybe Password
-> SeldaTransactionT m IdentifierRole
roleCreate IdentifierSpace
spaceIdentifier (Text -> NameRole
MkNameRole Text
"Member") AccessibilityRole
MkAccessibilityRoleJoinable Maybe Password
forall a. Maybe a
Nothing
          IdentifierRole -> Permission -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole -> Permission -> SeldaTransactionT m ()
rolePermissionGive IdentifierRole
roleIdentifier Permission
MkPermissionViewSpace
          IdentifierRole -> Permission -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole -> Permission -> SeldaTransactionT m ()
rolePermissionGive IdentifierRole
roleIdentifier Permission
MkPermissionCreateReservation
          IdentifierRole -> Permission -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole -> Permission -> SeldaTransactionT m ()
rolePermissionGive IdentifierRole
roleIdentifier Permission
MkPermissionCancelReservation

        IdentifierSpace -> SeldaTransactionT m IdentifierSpace
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IdentifierSpace
spaceIdentifier
      WithStatus 500 ()
-> SeldaResult IdentifierSpace
-> (IdentifierSpace -> m (Union responses))
-> m (Union responses)
forall r (m :: * -> *) (responses :: [*]) a.
(HasStatus r, MonadLogger m, IsMember r responses) =>
r
-> SeldaResult a
-> (a -> m (Union responses))
-> m (Union responses)
handleSeldaSomeException (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @500 ()) SeldaResult IdentifierSpace
seldaResult ((IdentifierSpace -> m (Union responses)) -> m (Union responses))
-> (IdentifierSpace -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \IdentifierSpace
spaceIdentifier ->
        WithStatus 201 ResponseSpaceCreate -> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 201 ResponseSpaceCreate -> m (Union responses))
-> WithStatus 201 ResponseSpaceCreate -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ forall (k :: Nat) a. a -> WithStatus k a
WithStatus @201 MkResponseSpaceCreate {responseSpaceCreateId :: IdentifierSpace
responseSpaceCreateId = IdentifierSpace
spaceIdentifier}

deleteSpace ::
  ( MonadLogger m
  , MonadSeldaPool m
  , IsMember (WithStatus 200 ResponseSpaceDelete) responses
  , IsMember (WithStatus 400 ErrorParseBodyJson) responses
  , IsMember (WithStatus 401 ErrorBearerAuth) responses
  , IsMember (WithStatus 403 (ErrorInsufficientPermission MkPermissionEditSpace)) responses
  , IsMember (WithStatus 404 (StaticText "Space not found.")) responses
  , IsMember (WithStatus 500 ()) responses
  ) =>
  AuthResult UserAuthenticated ->
  Either String RequestSpaceDelete ->
  m (Union responses)
deleteSpace :: forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseSpaceDelete) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionEditSpace))
   responses,
 IsMember
   (WithStatus 404 (StaticText "Space not found.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestSpaceDelete -> m (Union responses)
deleteSpace AuthResult UserAuthenticated
auth Either String RequestSpaceDelete
eitherRequest =
  AuthResult UserAuthenticated
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 401 ErrorBearerAuth) responses) =>
AuthResult a -> (a -> m (Union responses)) -> m (Union responses)
handleAuthBearer AuthResult UserAuthenticated
auth ((UserAuthenticated -> m (Union responses)) -> m (Union responses))
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \UserAuthenticated
authenticated ->
    Either String RequestSpaceDelete
-> (RequestSpaceDelete -> m (Union responses))
-> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses) =>
Either String a
-> (a -> m (Union responses)) -> m (Union responses)
handleBadRequestBody Either String RequestSpaceDelete
eitherRequest ((RequestSpaceDelete -> m (Union responses))
 -> m (Union responses))
-> (RequestSpaceDelete -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \RequestSpaceDelete
request -> do
      Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Received request to delete space: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (RequestSpaceDelete -> String
forall a. Show a => a -> String
show RequestSpaceDelete
request)
      SeldaResult ()
seldaResult <- SeldaTransactionT m () -> m (SeldaResult ())
forall a. SeldaTransactionT m a -> m (SeldaResult a)
forall (m :: * -> *) a.
MonadSeldaPool m =>
SeldaTransactionT m a -> m (SeldaResult a)
runSeldaTransactionT (SeldaTransactionT m () -> m (SeldaResult ()))
-> SeldaTransactionT m () -> m (SeldaResult ())
forall a b. (a -> b) -> a -> b
$ do
        SPermission 'MkPermissionEditSpace
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
forall (m :: * -> *) (p :: Permission).
(MonadLogger m, MonadSeldaPool m, Typeable p) =>
SPermission p
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
checkPermission
          SPermission 'MkPermissionEditSpace
SMkPermissionEditSpace
          (UserAuthenticated -> IdentifierUser
userAuthenticatedId UserAuthenticated
authenticated)
          (RequestSpaceDelete -> IdentifierSpace
requestSpaceDeleteId RequestSpaceDelete
request)
        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
"Delete space."
        IdentifierSpace -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> SeldaTransactionT m ()
spaceDelete (IdentifierSpace -> SeldaTransactionT m ())
-> IdentifierSpace -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ RequestSpaceDelete -> IdentifierSpace
requestSpaceDeleteId RequestSpaceDelete
request
      Proxy SqlErrorMensamSpaceNotFound
-> WithStatus 404 (StaticText "Space not found.")
-> SeldaResult ()
-> (SeldaResult () -> m (Union responses))
-> m (Union responses)
forall e r (m :: * -> *) (responses :: [*]) a.
(Exception e, HasStatus r, Applicative m, IsMember r responses) =>
Proxy e
-> r
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException
        (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SqlErrorMensamSpaceNotFound)
        (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @404 (StaticText "Space not found."
 -> WithStatus 404 (StaticText "Space not found."))
-> StaticText "Space not found."
-> WithStatus 404 (StaticText "Space not found.")
forall a b. (a -> b) -> a -> b
$ forall (text :: Symbol). StaticText text
MkStaticText @"Space not found.")
        SeldaResult ()
seldaResult
        ((SeldaResult () -> m (Union responses)) -> m (Union responses))
-> (SeldaResult () -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult ()
seldaResultAfter404 ->
          Proxy 'MkPermissionEditSpace
-> SeldaResult ()
-> (SeldaResult () -> m (Union responses))
-> m (Union responses)
forall (p :: Permission) (m :: * -> *) (responses :: [*]) a.
(Typeable p, Applicative m,
 IsMember
   (WithStatus 403 (ErrorInsufficientPermission p)) responses) =>
Proxy p
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException403InsufficientPermission
            (forall {k} (t :: k). Proxy t
forall (t :: Permission). Proxy t
Proxy @MkPermissionEditSpace)
            SeldaResult ()
seldaResultAfter404
            ((SeldaResult () -> m (Union responses)) -> m (Union responses))
-> (SeldaResult () -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult ()
seldaResultAfter403 ->
              WithStatus 500 ()
-> SeldaResult ()
-> (() -> m (Union responses))
-> m (Union responses)
forall r (m :: * -> *) (responses :: [*]) a.
(HasStatus r, MonadLogger m, IsMember r responses) =>
r
-> SeldaResult a
-> (a -> m (Union responses))
-> m (Union responses)
handleSeldaSomeException (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @500 ()) SeldaResult ()
seldaResultAfter403 ((() -> m (Union responses)) -> m (Union responses))
-> (() -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \() -> do
                Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Deleted space."
                WithStatus 200 ResponseSpaceDelete -> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 200 ResponseSpaceDelete -> m (Union responses))
-> WithStatus 200 ResponseSpaceDelete -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ forall (k :: Nat) a. a -> WithStatus k a
WithStatus @200 MkResponseSpaceDelete {responseSpaceDeleteUnit :: ()
responseSpaceDeleteUnit = ()}

editSpace ::
  ( MonadLogger m
  , MonadSeldaPool m
  , IsMember (WithStatus 200 ResponseSpaceEdit) responses
  , IsMember (WithStatus 400 ErrorParseBodyJson) responses
  , IsMember (WithStatus 401 ErrorBearerAuth) responses
  , IsMember (WithStatus 403 (ErrorInsufficientPermission MkPermissionEditSpace)) responses
  , IsMember (WithStatus 404 (StaticText "Space not found.")) responses
  , IsMember (WithStatus 500 ()) responses
  ) =>
  AuthResult UserAuthenticated ->
  Either String RequestSpaceEdit ->
  m (Union responses)
editSpace :: forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseSpaceEdit) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionEditSpace))
   responses,
 IsMember
   (WithStatus 404 (StaticText "Space not found.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestSpaceEdit -> m (Union responses)
editSpace AuthResult UserAuthenticated
auth Either String RequestSpaceEdit
eitherRequest =
  AuthResult UserAuthenticated
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 401 ErrorBearerAuth) responses) =>
AuthResult a -> (a -> m (Union responses)) -> m (Union responses)
handleAuthBearer AuthResult UserAuthenticated
auth ((UserAuthenticated -> m (Union responses)) -> m (Union responses))
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \UserAuthenticated
authenticated ->
    Either String RequestSpaceEdit
-> (RequestSpaceEdit -> m (Union responses)) -> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses) =>
Either String a
-> (a -> m (Union responses)) -> m (Union responses)
handleBadRequestBody Either String RequestSpaceEdit
eitherRequest ((RequestSpaceEdit -> m (Union responses)) -> m (Union responses))
-> (RequestSpaceEdit -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \RequestSpaceEdit
request -> do
      Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Received request to edit space: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (RequestSpaceEdit -> String
forall a. Show a => a -> String
show RequestSpaceEdit
request)
      SeldaResult SpaceInternal
seldaResult <- SeldaTransactionT m SpaceInternal -> m (SeldaResult SpaceInternal)
forall a. SeldaTransactionT m a -> m (SeldaResult a)
forall (m :: * -> *) a.
MonadSeldaPool m =>
SeldaTransactionT m a -> m (SeldaResult a)
runSeldaTransactionT (SeldaTransactionT m SpaceInternal
 -> m (SeldaResult SpaceInternal))
-> SeldaTransactionT m SpaceInternal
-> m (SeldaResult SpaceInternal)
forall a b. (a -> b) -> a -> b
$ do
        SPermission 'MkPermissionEditSpace
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
forall (m :: * -> *) (p :: Permission).
(MonadLogger m, MonadSeldaPool m, Typeable p) =>
SPermission p
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
checkPermission
          SPermission 'MkPermissionEditSpace
SMkPermissionEditSpace
          (UserAuthenticated -> IdentifierUser
userAuthenticatedId UserAuthenticated
authenticated)
          (RequestSpaceEdit -> IdentifierSpace
requestSpaceEditId RequestSpaceEdit
request)
        case RequestSpaceEdit -> Updatable NameSpace
requestSpaceEditName RequestSpaceEdit
request of
          Updatable NameSpace
Preserve -> () -> SeldaTransactionT m ()
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Overwrite NameSpace
name -> IdentifierSpace -> NameSpace -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> NameSpace -> SeldaTransactionT m ()
spaceNameSet (RequestSpaceEdit -> IdentifierSpace
requestSpaceEditId RequestSpaceEdit
request) NameSpace
name
        case RequestSpaceEdit -> Updatable TZLabel
requestSpaceEditTimezone RequestSpaceEdit
request of
          Updatable TZLabel
Preserve -> () -> SeldaTransactionT m ()
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Overwrite TZLabel
timezone -> IdentifierSpace -> TZLabel -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> TZLabel -> SeldaTransactionT m ()
spaceTimezoneSet (RequestSpaceEdit -> IdentifierSpace
requestSpaceEditId RequestSpaceEdit
request) TZLabel
timezone
        case RequestSpaceEdit -> Updatable VisibilitySpace
requestSpaceEditVisibility RequestSpaceEdit
request of
          Updatable VisibilitySpace
Preserve -> () -> SeldaTransactionT m ()
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Overwrite VisibilitySpace
visibility -> IdentifierSpace -> VisibilitySpace -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> VisibilitySpace -> SeldaTransactionT m ()
spaceVisibilitySet (RequestSpaceEdit -> IdentifierSpace
requestSpaceEditId RequestSpaceEdit
request) VisibilitySpace
visibility
        IdentifierSpace -> SeldaTransactionT m SpaceInternal
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> SeldaTransactionT m SpaceInternal
spaceInternalGetFromId (RequestSpaceEdit -> IdentifierSpace
requestSpaceEditId RequestSpaceEdit
request)
      Proxy SqlErrorMensamSpaceNotFound
-> WithStatus 404 (StaticText "Space not found.")
-> SeldaResult SpaceInternal
-> (SeldaResult SpaceInternal -> m (Union responses))
-> m (Union responses)
forall e r (m :: * -> *) (responses :: [*]) a.
(Exception e, HasStatus r, Applicative m, IsMember r responses) =>
Proxy e
-> r
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException
        (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SqlErrorMensamSpaceNotFound)
        (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @404 (StaticText "Space not found."
 -> WithStatus 404 (StaticText "Space not found."))
-> StaticText "Space not found."
-> WithStatus 404 (StaticText "Space not found.")
forall a b. (a -> b) -> a -> b
$ forall (text :: Symbol). StaticText text
MkStaticText @"Space not found.")
        SeldaResult SpaceInternal
seldaResult
        ((SeldaResult SpaceInternal -> m (Union responses))
 -> m (Union responses))
-> (SeldaResult SpaceInternal -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult SpaceInternal
seldaResultAfter404 ->
          Proxy 'MkPermissionEditSpace
-> SeldaResult SpaceInternal
-> (SeldaResult SpaceInternal -> m (Union responses))
-> m (Union responses)
forall (p :: Permission) (m :: * -> *) (responses :: [*]) a.
(Typeable p, Applicative m,
 IsMember
   (WithStatus 403 (ErrorInsufficientPermission p)) responses) =>
Proxy p
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException403InsufficientPermission
            (forall {k} (t :: k). Proxy t
forall (t :: Permission). Proxy t
Proxy @MkPermissionEditSpace)
            SeldaResult SpaceInternal
seldaResultAfter404
            ((SeldaResult SpaceInternal -> m (Union responses))
 -> m (Union responses))
-> (SeldaResult SpaceInternal -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult SpaceInternal
seldaResultAfter403 ->
              WithStatus 500 ()
-> SeldaResult SpaceInternal
-> (SpaceInternal -> m (Union responses))
-> m (Union responses)
forall r (m :: * -> *) (responses :: [*]) a.
(HasStatus r, MonadLogger m, IsMember r responses) =>
r
-> SeldaResult a
-> (a -> m (Union responses))
-> m (Union responses)
handleSeldaSomeException (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @500 ()) SeldaResult SpaceInternal
seldaResultAfter403 ((SpaceInternal -> m (Union responses)) -> m (Union responses))
-> (SpaceInternal -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SpaceInternal
spaceInternal -> do
                Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Edited space."
                WithStatus 200 ResponseSpaceEdit -> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 200 ResponseSpaceEdit -> m (Union responses))
-> WithStatus 200 ResponseSpaceEdit -> m (Union responses)
forall a b. (a -> b) -> a -> b
$
                  forall (k :: Nat) a. a -> WithStatus k a
WithStatus @200
                    MkResponseSpaceEdit
                      { responseSpaceEditId :: IdentifierSpace
responseSpaceEditId = SpaceInternal -> IdentifierSpace
spaceInternalId SpaceInternal
spaceInternal
                      , responseSpaceEditName :: NameSpace
responseSpaceEditName = SpaceInternal -> NameSpace
spaceInternalName SpaceInternal
spaceInternal
                      , responseSpaceEditTimezone :: TZLabel
responseSpaceEditTimezone = SpaceInternal -> TZLabel
spaceInternalTimezone SpaceInternal
spaceInternal
                      , responseSpaceEditVisibility :: VisibilitySpace
responseSpaceEditVisibility = SpaceInternal -> VisibilitySpace
spaceInternalVisibility SpaceInternal
spaceInternal
                      }

pictureUpload ::
  ( MonadLogger m
  , MonadSeldaPool m
  , IsMember (WithStatus 200 (StaticText "Uploaded space picture.")) responses
  , IsMember (WithStatus 400 ErrorParseBodyJpeg) responses
  , IsMember (WithStatus 401 ErrorBearerAuth) responses
  , IsMember (WithStatus 403 (ErrorInsufficientPermission MkPermissionEditSpace)) responses
  , IsMember (WithStatus 404 (StaticText "Space not found.")) responses
  , IsMember (WithStatus 500 ()) responses
  ) =>
  AuthResult UserAuthenticated ->
  Either T.Text IdentifierSpace ->
  Either String ImageJpegBytes ->
  m (Union responses)
pictureUpload :: forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember
   (WithStatus 200 (StaticText "Uploaded space picture.")) responses,
 IsMember (WithStatus 400 ErrorParseBodyJpeg) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionEditSpace))
   responses,
 IsMember
   (WithStatus 404 (StaticText "Space not found.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either Text IdentifierSpace
-> Either String ImageJpegBytes
-> m (Union responses)
pictureUpload AuthResult UserAuthenticated
auth Either Text IdentifierSpace
eitherQueryParamIdentifierSpace Either String ImageJpegBytes
eitherRequest =
  AuthResult UserAuthenticated
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 401 ErrorBearerAuth) responses) =>
AuthResult a -> (a -> m (Union responses)) -> m (Union responses)
handleAuthBearer AuthResult UserAuthenticated
auth ((UserAuthenticated -> m (Union responses)) -> m (Union responses))
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \UserAuthenticated
authenticated ->
    Either String ImageJpegBytes
-> (ImageJpegBytes -> m (Union responses)) -> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 400 ErrorParseBodyJpeg) responses) =>
Either String a
-> (a -> m (Union responses)) -> m (Union responses)
handleBadRequestBodyJpeg Either String ImageJpegBytes
eitherRequest ((ImageJpegBytes -> m (Union responses)) -> m (Union responses))
-> (ImageJpegBytes -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \ImageJpegBytes
request -> do
      case Either Text IdentifierSpace
eitherQueryParamIdentifierSpace of
        Left Text
_ -> do
          Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Unable to parse space identifier."
          WithStatus 404 (StaticText "Space not found.")
-> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 404 (StaticText "Space not found.")
 -> m (Union responses))
-> WithStatus 404 (StaticText "Space not found.")
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ forall (k :: Nat) a. a -> WithStatus k a
WithStatus @404 (StaticText "Space not found."
 -> WithStatus 404 (StaticText "Space not found."))
-> StaticText "Space not found."
-> WithStatus 404 (StaticText "Space not found.")
forall a b. (a -> b) -> a -> b
$ forall (text :: Symbol). StaticText text
MkStaticText @"Space not found."
        Right IdentifierSpace
identifierSpace -> do
          Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Changing space picture."
          case ImageJpegBytes -> Either String ByteStringJpeg
jpegConvertSpacePicture ImageJpegBytes
request of
            Left String
err -> do
              Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Failed to resize picture: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (String -> String
forall a. Show a => a -> String
show String
err)
              WithStatus 400 ErrorParseBodyJpeg -> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 400 ErrorParseBodyJpeg -> m (Union responses))
-> WithStatus 400 ErrorParseBodyJpeg -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ forall (k :: Nat) a. a -> WithStatus k a
WithStatus @400 (ErrorParseBodyJpeg -> WithStatus 400 ErrorParseBodyJpeg)
-> ErrorParseBodyJpeg -> WithStatus 400 ErrorParseBodyJpeg
forall a b. (a -> b) -> a -> b
$ String -> ErrorParseBodyJpeg
MkErrorParseBodyJpeg String
"Unable to read picture."
            Right ByteStringJpeg
picture -> do
              Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Successfully verified and potentially resized picture."
              SeldaResult ()
seldaResult <-
                SeldaTransactionT m () -> m (SeldaResult ())
forall a. SeldaTransactionT m a -> m (SeldaResult a)
forall (m :: * -> *) a.
MonadSeldaPool m =>
SeldaTransactionT m a -> m (SeldaResult a)
runSeldaTransactionT (SeldaTransactionT m () -> m (SeldaResult ()))
-> SeldaTransactionT m () -> m (SeldaResult ())
forall a b. (a -> b) -> a -> b
$ do
                  SPermission 'MkPermissionEditSpace
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
forall (m :: * -> *) (p :: Permission).
(MonadLogger m, MonadSeldaPool m, Typeable p) =>
SPermission p
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
checkPermission
                    SPermission 'MkPermissionEditSpace
SMkPermissionEditSpace
                    (UserAuthenticated -> IdentifierUser
userAuthenticatedId UserAuthenticated
authenticated)
                    IdentifierSpace
identifierSpace
                  IdentifierSpace -> Maybe ByteStringJpeg -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> Maybe ByteStringJpeg -> SeldaTransactionT m ()
spaceSetPicture IdentifierSpace
identifierSpace (ByteStringJpeg -> Maybe ByteStringJpeg
forall a. a -> Maybe a
Just ByteStringJpeg
picture)
              Proxy 'MkPermissionEditSpace
-> SeldaResult ()
-> (SeldaResult () -> m (Union responses))
-> m (Union responses)
forall (p :: Permission) (m :: * -> *) (responses :: [*]) a.
(Typeable p, Applicative m,
 IsMember
   (WithStatus 403 (ErrorInsufficientPermission p)) responses) =>
Proxy p
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException403InsufficientPermission
                (forall {k} (t :: k). Proxy t
forall (t :: Permission). Proxy t
Proxy @MkPermissionEditSpace)
                SeldaResult ()
seldaResult
                ((SeldaResult () -> m (Union responses)) -> m (Union responses))
-> (SeldaResult () -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult ()
seldaResultAfter403 ->
                  WithStatus 500 ()
-> SeldaResult ()
-> (() -> m (Union responses))
-> m (Union responses)
forall r (m :: * -> *) (responses :: [*]) a.
(HasStatus r, MonadLogger m, IsMember r responses) =>
r
-> SeldaResult a
-> (a -> m (Union responses))
-> m (Union responses)
handleSeldaSomeException (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @500 ()) SeldaResult ()
seldaResultAfter403 ((() -> m (Union responses)) -> m (Union responses))
-> (() -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \() -> do
                    Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Changed space picture successfully."
                    WithStatus 200 (StaticText "Uploaded space picture.")
-> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 200 (StaticText "Uploaded space picture.")
 -> m (Union responses))
-> WithStatus 200 (StaticText "Uploaded space picture.")
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ forall (k :: Nat) a. a -> WithStatus k a
WithStatus @200 (StaticText "Uploaded space picture."
 -> WithStatus 200 (StaticText "Uploaded space picture."))
-> StaticText "Uploaded space picture."
-> WithStatus 200 (StaticText "Uploaded space picture.")
forall a b. (a -> b) -> a -> b
$ forall (text :: Symbol). StaticText text
MkStaticText @"Uploaded space picture."

pictureDelete ::
  ( MonadLogger m
  , MonadSeldaPool m
  , IsMember (WithStatus 200 (StaticText "Deleted space picture.")) responses
  , IsMember (WithStatus 401 ErrorBearerAuth) responses
  , IsMember (WithStatus 403 (ErrorInsufficientPermission MkPermissionEditSpace)) responses
  , IsMember (WithStatus 404 (StaticText "Space not found.")) responses
  , IsMember (WithStatus 500 ()) responses
  ) =>
  AuthResult UserAuthenticated ->
  Either T.Text IdentifierSpace ->
  m (Union responses)
pictureDelete :: forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember
   (WithStatus 200 (StaticText "Deleted space picture.")) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionEditSpace))
   responses,
 IsMember
   (WithStatus 404 (StaticText "Space not found.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either Text IdentifierSpace -> m (Union responses)
pictureDelete AuthResult UserAuthenticated
auth Either Text IdentifierSpace
eitherQueryParamIdentifierSpace =
  AuthResult UserAuthenticated
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 401 ErrorBearerAuth) responses) =>
AuthResult a -> (a -> m (Union responses)) -> m (Union responses)
handleAuthBearer AuthResult UserAuthenticated
auth ((UserAuthenticated -> m (Union responses)) -> m (Union responses))
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \UserAuthenticated
authenticated -> do
    case Either Text IdentifierSpace
eitherQueryParamIdentifierSpace of
      Left Text
_ -> do
        Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Unable to parse space identifier."
        WithStatus 404 (StaticText "Space not found.")
-> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 404 (StaticText "Space not found.")
 -> m (Union responses))
-> WithStatus 404 (StaticText "Space not found.")
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ forall (k :: Nat) a. a -> WithStatus k a
WithStatus @404 (StaticText "Space not found."
 -> WithStatus 404 (StaticText "Space not found."))
-> StaticText "Space not found."
-> WithStatus 404 (StaticText "Space not found.")
forall a b. (a -> b) -> a -> b
$ forall (text :: Symbol). StaticText text
MkStaticText @"Space not found."
      Right IdentifierSpace
identifierSpace -> do
        Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Deleting space picture."
        SeldaResult ()
seldaResult <-
          SeldaTransactionT m () -> m (SeldaResult ())
forall a. SeldaTransactionT m a -> m (SeldaResult a)
forall (m :: * -> *) a.
MonadSeldaPool m =>
SeldaTransactionT m a -> m (SeldaResult a)
runSeldaTransactionT (SeldaTransactionT m () -> m (SeldaResult ()))
-> SeldaTransactionT m () -> m (SeldaResult ())
forall a b. (a -> b) -> a -> b
$ do
            SPermission 'MkPermissionEditSpace
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
forall (m :: * -> *) (p :: Permission).
(MonadLogger m, MonadSeldaPool m, Typeable p) =>
SPermission p
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
checkPermission
              SPermission 'MkPermissionEditSpace
SMkPermissionEditSpace
              (UserAuthenticated -> IdentifierUser
userAuthenticatedId UserAuthenticated
authenticated)
              IdentifierSpace
identifierSpace
            IdentifierSpace -> Maybe ByteStringJpeg -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> Maybe ByteStringJpeg -> SeldaTransactionT m ()
spaceSetPicture IdentifierSpace
identifierSpace Maybe ByteStringJpeg
forall a. Maybe a
Nothing
        Proxy 'MkPermissionEditSpace
-> SeldaResult ()
-> (SeldaResult () -> m (Union responses))
-> m (Union responses)
forall (p :: Permission) (m :: * -> *) (responses :: [*]) a.
(Typeable p, Applicative m,
 IsMember
   (WithStatus 403 (ErrorInsufficientPermission p)) responses) =>
Proxy p
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException403InsufficientPermission
          (forall {k} (t :: k). Proxy t
forall (t :: Permission). Proxy t
Proxy @MkPermissionEditSpace)
          SeldaResult ()
seldaResult
          ((SeldaResult () -> m (Union responses)) -> m (Union responses))
-> (SeldaResult () -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult ()
seldaResultAfter403 ->
            WithStatus 500 ()
-> SeldaResult ()
-> (() -> m (Union responses))
-> m (Union responses)
forall r (m :: * -> *) (responses :: [*]) a.
(HasStatus r, MonadLogger m, IsMember r responses) =>
r
-> SeldaResult a
-> (a -> m (Union responses))
-> m (Union responses)
handleSeldaSomeException (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @500 ()) SeldaResult ()
seldaResultAfter403 ((() -> m (Union responses)) -> m (Union responses))
-> (() -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \() -> do
              Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Deleted space picture successfully."
              WithStatus 200 (StaticText "Deleted space picture.")
-> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 200 (StaticText "Deleted space picture.")
 -> m (Union responses))
-> WithStatus 200 (StaticText "Deleted space picture.")
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ forall (k :: Nat) a. a -> WithStatus k a
WithStatus @200 (StaticText "Deleted space picture."
 -> WithStatus 200 (StaticText "Deleted space picture."))
-> StaticText "Deleted space picture."
-> WithStatus 200 (StaticText "Deleted space picture.")
forall a b. (a -> b) -> a -> b
$ forall (text :: Symbol). StaticText text
MkStaticText @"Deleted space picture."

pictureDownload ::
  ( MonadConfigured m
  , MonadIO m
  , MonadLogger m
  , MonadSeldaPool m
  ) =>
  AuthResult UserAuthenticated ->
  Either T.Text IdentifierSpace ->
  m ImageJpegBytes
pictureDownload :: forall (m :: * -> *).
(MonadConfigured m, MonadIO m, MonadLogger m, MonadSeldaPool m) =>
AuthResult UserAuthenticated
-> Either Text IdentifierSpace -> m ImageJpegBytes
pictureDownload AuthResult UserAuthenticated
auth Either Text IdentifierSpace
eitherQueryParamIdentifierSpace = do
  Union
  '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
    WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
    WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()]
handledResult <- do
    AuthResult UserAuthenticated
-> (UserAuthenticated
    -> m (Union
            '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
              WithStatus
                403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
              WithStatus 404 (StaticText "Space not found."),
              WithStatus 500 ()]))
-> m (Union
        '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
          WithStatus
            403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
          WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 401 ErrorBearerAuth) responses) =>
AuthResult a -> (a -> m (Union responses)) -> m (Union responses)
handleAuthBearer AuthResult UserAuthenticated
auth ((UserAuthenticated
  -> m (Union
          '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
            WithStatus
              403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
            WithStatus 404 (StaticText "Space not found."),
            WithStatus 500 ()]))
 -> m (Union
         '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
           WithStatus
             403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
           WithStatus 404 (StaticText "Space not found."),
           WithStatus 500 ()]))
-> (UserAuthenticated
    -> m (Union
            '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
              WithStatus
                403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
              WithStatus 404 (StaticText "Space not found."),
              WithStatus 500 ()]))
-> m (Union
        '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
          WithStatus
            403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
          WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
forall a b. (a -> b) -> a -> b
$ \UserAuthenticated
authenticated -> do
      case Either Text IdentifierSpace
eitherQueryParamIdentifierSpace of
        Left Text
_ -> do
          Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Unable to parse space identifier."
          WithStatus 404 (StaticText "Space not found.")
-> m (Union
        '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
          WithStatus
            403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
          WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 404 (StaticText "Space not found.")
 -> m (Union
         '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
           WithStatus
             403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
           WithStatus 404 (StaticText "Space not found."),
           WithStatus 500 ()]))
-> WithStatus 404 (StaticText "Space not found.")
-> m (Union
        '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
          WithStatus
            403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
          WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
forall a b. (a -> b) -> a -> b
$ forall (k :: Nat) a. a -> WithStatus k a
WithStatus @404 (StaticText "Space not found."
 -> WithStatus 404 (StaticText "Space not found."))
-> StaticText "Space not found."
-> WithStatus 404 (StaticText "Space not found.")
forall a b. (a -> b) -> a -> b
$ forall (text :: Symbol). StaticText text
MkStaticText @"Space not found."
        Right IdentifierSpace
identifierSpace -> do
          Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Requesting a space picture from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IdentifierSpace -> String
forall a. Show a => a -> String
show IdentifierSpace
identifierSpace)
          SeldaResult (Maybe ByteStringJpeg)
seldaResult <-
            SeldaTransactionT m (Maybe ByteStringJpeg)
-> m (SeldaResult (Maybe ByteStringJpeg))
forall a. SeldaTransactionT m a -> m (SeldaResult a)
forall (m :: * -> *) a.
MonadSeldaPool m =>
SeldaTransactionT m a -> m (SeldaResult a)
runSeldaTransactionT (SeldaTransactionT m (Maybe ByteStringJpeg)
 -> m (SeldaResult (Maybe ByteStringJpeg)))
-> SeldaTransactionT m (Maybe ByteStringJpeg)
-> m (SeldaResult (Maybe ByteStringJpeg))
forall a b. (a -> b) -> a -> b
$ do
              SPermission 'MkPermissionViewSpace
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
forall (m :: * -> *) (p :: Permission).
(MonadLogger m, MonadSeldaPool m, Typeable p) =>
SPermission p
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
checkPermission
                SPermission 'MkPermissionViewSpace
SMkPermissionViewSpace
                (UserAuthenticated -> IdentifierUser
userAuthenticatedId UserAuthenticated
authenticated)
                IdentifierSpace
identifierSpace
              IdentifierSpace -> SeldaTransactionT m (Maybe ByteStringJpeg)
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> SeldaTransactionT m (Maybe ByteStringJpeg)
spaceGetPicture IdentifierSpace
identifierSpace
          Proxy 'MkPermissionViewSpace
-> SeldaResult (Maybe ByteStringJpeg)
-> (SeldaResult (Maybe ByteStringJpeg)
    -> m (Union
            '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
              WithStatus
                403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
              WithStatus 404 (StaticText "Space not found."),
              WithStatus 500 ()]))
-> m (Union
        '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
          WithStatus
            403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
          WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
forall (p :: Permission) (m :: * -> *) (responses :: [*]) a.
(Typeable p, Applicative m,
 IsMember
   (WithStatus 403 (ErrorInsufficientPermission p)) responses) =>
Proxy p
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException403InsufficientPermission
            (forall {k} (t :: k). Proxy t
forall (t :: Permission). Proxy t
Proxy @MkPermissionViewSpace)
            SeldaResult (Maybe ByteStringJpeg)
seldaResult
            ((SeldaResult (Maybe ByteStringJpeg)
  -> m (Union
          '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
            WithStatus
              403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
            WithStatus 404 (StaticText "Space not found."),
            WithStatus 500 ()]))
 -> m (Union
         '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
           WithStatus
             403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
           WithStatus 404 (StaticText "Space not found."),
           WithStatus 500 ()]))
-> (SeldaResult (Maybe ByteStringJpeg)
    -> m (Union
            '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
              WithStatus
                403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
              WithStatus 404 (StaticText "Space not found."),
              WithStatus 500 ()]))
-> m (Union
        '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
          WithStatus
            403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
          WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
forall a b. (a -> b) -> a -> b
$ \SeldaResult (Maybe ByteStringJpeg)
seldaResultAfter403 ->
              WithStatus 500 ()
-> SeldaResult (Maybe ByteStringJpeg)
-> (Maybe ByteStringJpeg
    -> m (Union
            '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
              WithStatus
                403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
              WithStatus 404 (StaticText "Space not found."),
              WithStatus 500 ()]))
-> m (Union
        '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
          WithStatus
            403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
          WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
forall r (m :: * -> *) (responses :: [*]) a.
(HasStatus r, MonadLogger m, IsMember r responses) =>
r
-> SeldaResult a
-> (a -> m (Union responses))
-> m (Union responses)
handleSeldaSomeException (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @500 ()) SeldaResult (Maybe ByteStringJpeg)
seldaResultAfter403 ((Maybe ByteStringJpeg
  -> m (Union
          '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
            WithStatus
              403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
            WithStatus 404 (StaticText "Space not found."),
            WithStatus 500 ()]))
 -> m (Union
         '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
           WithStatus
             403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
           WithStatus 404 (StaticText "Space not found."),
           WithStatus 500 ()]))
-> (Maybe ByteStringJpeg
    -> m (Union
            '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
              WithStatus
                403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
              WithStatus 404 (StaticText "Space not found."),
              WithStatus 500 ()]))
-> m (Union
        '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
          WithStatus
            403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
          WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
forall a b. (a -> b) -> a -> b
$ \Maybe ByteStringJpeg
maybePicture -> do
                Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Checked out space picture successfully."
                case Maybe ByteStringJpeg
maybePicture of
                  Maybe ByteStringJpeg
Nothing -> do
                    Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"No picture set for this space. Returning default picture."
                    String
defaultProfilePictureFilePath <- (String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/default-space-picture.jpeg") (String -> String)
-> (Configuration -> String) -> Configuration -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Configuration -> String
configDirectoryStatic (Configuration -> String) -> m Configuration -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Configuration
forall (m :: * -> *). MonadConfigured m => m Configuration
configuration
                    ByteString
picture <- IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
B.readFile String
defaultProfilePictureFilePath
                    WithStatus 200 ImageJpegBytes
-> m (Union
        '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
          WithStatus
            403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
          WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 200 ImageJpegBytes
 -> m (Union
         '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
           WithStatus
             403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
           WithStatus 404 (StaticText "Space not found."),
           WithStatus 500 ()]))
-> WithStatus 200 ImageJpegBytes
-> m (Union
        '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
          WithStatus
            403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
          WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
forall a b. (a -> b) -> a -> b
$ forall (k :: Nat) a. a -> WithStatus k a
WithStatus @200 (ImageJpegBytes -> WithStatus 200 ImageJpegBytes)
-> ImageJpegBytes -> WithStatus 200 ImageJpegBytes
forall a b. (a -> b) -> a -> b
$ ByteString -> ImageJpegBytes
MkImageJpegBytes (ByteString -> ImageJpegBytes)
-> (ByteString -> ByteString) -> ByteString -> ImageJpegBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B.fromStrict (ByteString -> ImageJpegBytes) -> ByteString -> ImageJpegBytes
forall a b. (a -> b) -> a -> b
$ ByteString
picture
                  Just ByteStringJpeg
picture -> do
                    Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Answering with space picture."
                    WithStatus 200 ImageJpegBytes
-> m (Union
        '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
          WithStatus
            403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
          WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 200 ImageJpegBytes
 -> m (Union
         '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
           WithStatus
             403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
           WithStatus 404 (StaticText "Space not found."),
           WithStatus 500 ()]))
-> WithStatus 200 ImageJpegBytes
-> m (Union
        '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
          WithStatus
            403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
          WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
forall a b. (a -> b) -> a -> b
$ forall (k :: Nat) a. a -> WithStatus k a
WithStatus @200 (ImageJpegBytes -> WithStatus 200 ImageJpegBytes)
-> ImageJpegBytes -> WithStatus 200 ImageJpegBytes
forall a b. (a -> b) -> a -> b
$ ByteString -> ImageJpegBytes
MkImageJpegBytes (ByteString -> ImageJpegBytes)
-> (ByteStringJpeg -> ByteString)
-> ByteStringJpeg
-> ImageJpegBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteStringJpeg -> ByteString
unByteStringJpeg (ByteStringJpeg -> ImageJpegBytes)
-> ByteStringJpeg -> ImageJpegBytes
forall a b. (a -> b) -> a -> b
$ ByteStringJpeg
picture
  Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Handling multi-mimetype response manually: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Union
  '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
    WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
    WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()]
-> String
forall a. Show a => a -> String
show Union
  '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
    WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
    WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()]
handledResult) -- TODO: Logging pictures right now.
  -- TODO: Add all these HTTP statuses to the API definition. Requires different output types.
  case Union
  '[WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth,
    WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
    WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()]
handledResult :: Union [WithStatus 200 ImageJpegBytes, WithStatus 401 ErrorBearerAuth, WithStatus 403 (ErrorInsufficientPermission MkPermissionViewSpace), WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()] of
    SOP.Z (SOP.I (WithStatus ImageJpegBytes
result)) -> ImageJpegBytes -> m ImageJpegBytes
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImageJpegBytes
result
    SOP.S (SOP.Z (SOP.I (WithStatus ErrorBearerAuth
errorBearerAuth))) -> String -> m ImageJpegBytes
forall a. HasCallStack => String -> a
error (String -> m ImageJpegBytes) -> String -> m ImageJpegBytes
forall a b. (a -> b) -> a -> b
$ ErrorBearerAuth -> String
forall a. Show a => a -> String
show ErrorBearerAuth
errorBearerAuth
    SOP.S (SOP.S (SOP.Z (SOP.I (WithStatus ErrorInsufficientPermission 'MkPermissionViewSpace
MkErrorInsufficientPermission)))) -> m ImageJpegBytes
forall a. HasCallStack => a
undefined
    SOP.S (SOP.S (SOP.S (SOP.Z (SOP.I (WithStatus StaticText "Space not found."
MkStaticText))))) -> m ImageJpegBytes
forall a. HasCallStack => a
undefined
    SOP.S (SOP.S (SOP.S (SOP.S (SOP.Z (SOP.I (WithStatus ())))))) -> m ImageJpegBytes
forall a. HasCallStack => a
undefined
    SOP.S (SOP.S (SOP.S (SOP.S (SOP.S NS I xs
impossibleCase)))) -> case NS I xs
impossibleCase of {}

joinSpace ::
  ( MonadLogger m
  , MonadSeldaPool m
  , IsMember (WithStatus 200 ResponseSpaceJoin) responses
  , IsMember (WithStatus 400 ErrorParseBodyJson) responses
  , IsMember (WithStatus 401 ErrorBearerAuth) responses
  , IsMember (WithStatus 403 (StaticTexts ["Role is inaccessible.", "Wrong role password."])) responses
  , IsMember (WithStatus 404 (StaticText "Space not found.")) responses
  , IsMember (WithStatus 500 ()) responses
  ) =>
  AuthResult UserAuthenticated ->
  Either String RequestSpaceJoin ->
  m (Union responses)
joinSpace :: forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseSpaceJoin) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403
      (StaticTexts '["Role is inaccessible.", "Wrong role password."]))
   responses,
 IsMember
   (WithStatus 404 (StaticText "Space not found.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestSpaceJoin -> m (Union responses)
joinSpace AuthResult UserAuthenticated
auth Either String RequestSpaceJoin
eitherRequest =
  AuthResult UserAuthenticated
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 401 ErrorBearerAuth) responses) =>
AuthResult a -> (a -> m (Union responses)) -> m (Union responses)
handleAuthBearer AuthResult UserAuthenticated
auth ((UserAuthenticated -> m (Union responses)) -> m (Union responses))
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \UserAuthenticated
authenticated ->
    Either String RequestSpaceJoin
-> (RequestSpaceJoin -> m (Union responses)) -> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses) =>
Either String a
-> (a -> m (Union responses)) -> m (Union responses)
handleBadRequestBody Either String RequestSpaceJoin
eitherRequest ((RequestSpaceJoin -> m (Union responses)) -> m (Union responses))
-> (RequestSpaceJoin -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \RequestSpaceJoin
request -> do
      Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Received request to join space: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (RequestSpaceJoin -> String
forall a. Show a => a -> String
show RequestSpaceJoin
request)
      SeldaResult ()
seldaResult <- SeldaTransactionT m () -> m (SeldaResult ())
forall a. SeldaTransactionT m a -> m (SeldaResult a)
forall (m :: * -> *) a.
MonadSeldaPool m =>
SeldaTransactionT m a -> m (SeldaResult a)
runSeldaTransactionT (SeldaTransactionT m () -> m (SeldaResult ()))
-> SeldaTransactionT m () -> m (SeldaResult ())
forall a b. (a -> b) -> a -> b
$ do
        IdentifierSpace
spaceIdentifier <-
          case RequestSpaceJoin -> NameOrIdentifier NameSpace IdentifierSpace
requestSpaceJoinSpace RequestSpaceJoin
request of
            Identifier IdentifierSpace
spaceId -> IdentifierSpace -> SeldaTransactionT m Space
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> SeldaTransactionT m Space
spaceGetFromId IdentifierSpace
spaceId SeldaTransactionT m Space
-> SeldaTransactionT m IdentifierSpace
-> SeldaTransactionT m IdentifierSpace
forall a b.
SeldaTransactionT m a
-> SeldaTransactionT m b -> SeldaTransactionT m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IdentifierSpace -> SeldaTransactionT m IdentifierSpace
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IdentifierSpace
spaceId
            Name NameSpace
name -> NameSpace -> SeldaTransactionT m IdentifierSpace
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
NameSpace -> SeldaTransactionT m IdentifierSpace
spaceLookupId NameSpace
name
        IdentifierRole
roleIdentifier <-
          case RequestSpaceJoin -> NameOrIdentifier NameRole IdentifierRole
requestSpaceJoinRole RequestSpaceJoin
request of
            Identifier IdentifierRole
spaceId -> IdentifierRole -> SeldaTransactionT m IdentifierRole
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IdentifierRole
spaceId
            Name NameRole
name ->
              IdentifierSpace
-> NameRole -> SeldaTransactionT m (Maybe IdentifierRole)
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace
-> NameRole -> SeldaTransactionT m (Maybe IdentifierRole)
roleLookupId IdentifierSpace
spaceIdentifier NameRole
name SeldaTransactionT m (Maybe IdentifierRole)
-> (Maybe IdentifierRole -> SeldaTransactionT m IdentifierRole)
-> SeldaTransactionT m IdentifierRole
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
                Just IdentifierRole
identifier -> IdentifierRole -> SeldaTransactionT m IdentifierRole
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IdentifierRole
identifier
                Maybe IdentifierRole
Nothing -> do
                  let Text
msg :: T.Text = Text
"No matching space-role."
                  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
msg
                  SeldaError -> SeldaTransactionT m IdentifierRole
forall e a.
(HasCallStack, Exception e) =>
e -> SeldaTransactionT m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (SeldaError -> SeldaTransactionT m IdentifierRole)
-> SeldaError -> SeldaTransactionT m IdentifierRole
forall a b. (a -> b) -> a -> b
$ String -> SeldaError
Selda.SqlError (String -> SeldaError) -> String -> SeldaError
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. Show a => a -> String
show Text
msg
        Role
role <- IdentifierRole -> SeldaTransactionT m Role
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole -> SeldaTransactionT m Role
roleGet IdentifierRole
roleIdentifier
        case Role -> AccessibilityRole
roleAccessibility Role
role of
          AccessibilityRole
MkAccessibilityRoleInaccessible -> 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
"Space-role is inaccessible. Cannot join."
            SqlErrorMensamRoleInaccessible -> 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 SqlErrorMensamRoleInaccessible
MkSqlErrorMensamRoleInaccessible
          AccessibilityRole
MkAccessibilityRoleJoinableWithPassword -> 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
"Space-role is joinable with password. Checking password."
            IdentifierRole -> Maybe Password -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole -> Maybe Password -> SeldaTransactionT m ()
rolePasswordCheck' IdentifierRole
roleIdentifier (Text -> Password
mkPassword (Text -> Password) -> Maybe Text -> Maybe Password
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RequestSpaceJoin -> Maybe Text
requestSpaceJoinPassword RequestSpaceJoin
request)
          AccessibilityRole
MkAccessibilityRoleJoinable -> 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
"Space-role is joinable. Joining."
        IdentifierSpace
-> IdentifierUser -> IdentifierRole -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace
-> IdentifierUser -> IdentifierRole -> SeldaTransactionT m ()
spaceUserAdd IdentifierSpace
spaceIdentifier (UserAuthenticated -> IdentifierUser
userAuthenticatedId UserAuthenticated
authenticated) IdentifierRole
roleIdentifier
      Proxy SqlErrorMensamSpaceNotFound
-> WithStatus 404 (StaticText "Space not found.")
-> SeldaResult ()
-> (SeldaResult () -> m (Union responses))
-> m (Union responses)
forall e r (m :: * -> *) (responses :: [*]) a.
(Exception e, HasStatus r, Applicative m, IsMember r responses) =>
Proxy e
-> r
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException
        (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SqlErrorMensamSpaceNotFound)
        (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @404 (StaticText "Space not found."
 -> WithStatus 404 (StaticText "Space not found."))
-> StaticText "Space not found."
-> WithStatus 404 (StaticText "Space not found.")
forall a b. (a -> b) -> a -> b
$ forall (text :: Symbol). StaticText text
MkStaticText @"Space not found.")
        SeldaResult ()
seldaResult
        ((SeldaResult () -> m (Union responses)) -> m (Union responses))
-> (SeldaResult () -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult ()
seldaResultAfter404 ->
          Proxy SqlErrorMensamRoleInaccessible
-> WithStatus
     403
     (StaticTexts '["Role is inaccessible.", "Wrong role password."])
-> SeldaResult ()
-> (SeldaResult () -> m (Union responses))
-> m (Union responses)
forall e r (m :: * -> *) (responses :: [*]) a.
(Exception e, HasStatus r, Applicative m, IsMember r responses) =>
Proxy e
-> r
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException
            (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SqlErrorMensamRoleInaccessible)
            (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @403 (StaticTexts '["Role is inaccessible.", "Wrong role password."]
 -> WithStatus
      403
      (StaticTexts '["Role is inaccessible.", "Wrong role password."]))
-> StaticTexts '["Role is inaccessible.", "Wrong role password."]
-> WithStatus
     403
     (StaticTexts '["Role is inaccessible.", "Wrong role password."])
forall a b. (a -> b) -> a -> b
$ forall (texts :: [Symbol]) (text :: Symbol).
IsMember (StaticText text) (Map StaticText texts) =>
StaticText text -> StaticTexts texts
specificStaticText @["Role is inaccessible.", "Wrong role password."] (StaticText "Role is inaccessible."
 -> StaticTexts '["Role is inaccessible.", "Wrong role password."])
-> StaticText "Role is inaccessible."
-> StaticTexts '["Role is inaccessible.", "Wrong role password."]
forall a b. (a -> b) -> a -> b
$ forall (text :: Symbol). StaticText text
MkStaticText @"Role is inaccessible.")
            SeldaResult ()
seldaResultAfter404
            ((SeldaResult () -> m (Union responses)) -> m (Union responses))
-> (SeldaResult () -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult ()
seldaResultAfter403 ->
              Proxy SqlErrorMensamRolePasswordCheckFail
-> WithStatus
     403
     (StaticTexts '["Role is inaccessible.", "Wrong role password."])
-> SeldaResult ()
-> (SeldaResult () -> m (Union responses))
-> m (Union responses)
forall e r (m :: * -> *) (responses :: [*]) a.
(Exception e, HasStatus r, Applicative m, IsMember r responses) =>
Proxy e
-> r
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException
                (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SqlErrorMensamRolePasswordCheckFail)
                (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @403 (StaticTexts '["Role is inaccessible.", "Wrong role password."]
 -> WithStatus
      403
      (StaticTexts '["Role is inaccessible.", "Wrong role password."]))
-> StaticTexts '["Role is inaccessible.", "Wrong role password."]
-> WithStatus
     403
     (StaticTexts '["Role is inaccessible.", "Wrong role password."])
forall a b. (a -> b) -> a -> b
$ forall (texts :: [Symbol]) (text :: Symbol).
IsMember (StaticText text) (Map StaticText texts) =>
StaticText text -> StaticTexts texts
specificStaticText @["Role is inaccessible.", "Wrong role password."] (StaticText "Wrong role password."
 -> StaticTexts '["Role is inaccessible.", "Wrong role password."])
-> StaticText "Wrong role password."
-> StaticTexts '["Role is inaccessible.", "Wrong role password."]
forall a b. (a -> b) -> a -> b
$ forall (text :: Symbol). StaticText text
MkStaticText @"Wrong role password.")
                SeldaResult ()
seldaResultAfter403
                ((SeldaResult () -> m (Union responses)) -> m (Union responses))
-> (SeldaResult () -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult ()
seldaResultAfter403' ->
                  WithStatus 500 ()
-> SeldaResult ()
-> (() -> m (Union responses))
-> m (Union responses)
forall r (m :: * -> *) (responses :: [*]) a.
(HasStatus r, MonadLogger m, IsMember r responses) =>
r
-> SeldaResult a
-> (a -> m (Union responses))
-> m (Union responses)
handleSeldaSomeException (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @500 ()) SeldaResult ()
seldaResultAfter403' ((() -> m (Union responses)) -> m (Union responses))
-> (() -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \() -> do
                    Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Joined space."
                    WithStatus 200 ResponseSpaceJoin -> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 200 ResponseSpaceJoin -> m (Union responses))
-> WithStatus 200 ResponseSpaceJoin -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ forall (k :: Nat) a. a -> WithStatus k a
WithStatus @200 MkResponseSpaceJoin {responseSpaceJoinUnit :: ()
responseSpaceJoinUnit = ()}

leaveSpace ::
  ( MonadLogger m
  , MonadSeldaPool m
  , IsMember (WithStatus 200 ResponseSpaceLeave) responses
  , IsMember (WithStatus 400 ErrorParseBodyJson) responses
  , IsMember (WithStatus 401 ErrorBearerAuth) responses
  , IsMember (WithStatus 403 (StaticText "Owner cannot leave space.")) responses
  , IsMember (WithStatus 404 (StaticText "Space not found.")) responses
  , IsMember (WithStatus 500 ()) responses
  ) =>
  AuthResult UserAuthenticated ->
  Either String RequestSpaceLeave ->
  m (Union responses)
leaveSpace :: forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseSpaceLeave) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus 403 (StaticText "Owner cannot leave space."))
   responses,
 IsMember
   (WithStatus 404 (StaticText "Space not found.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestSpaceLeave -> m (Union responses)
leaveSpace AuthResult UserAuthenticated
auth Either String RequestSpaceLeave
eitherRequest =
  AuthResult UserAuthenticated
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 401 ErrorBearerAuth) responses) =>
AuthResult a -> (a -> m (Union responses)) -> m (Union responses)
handleAuthBearer AuthResult UserAuthenticated
auth ((UserAuthenticated -> m (Union responses)) -> m (Union responses))
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \UserAuthenticated
authenticated ->
    Either String RequestSpaceLeave
-> (RequestSpaceLeave -> m (Union responses))
-> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses) =>
Either String a
-> (a -> m (Union responses)) -> m (Union responses)
handleBadRequestBody Either String RequestSpaceLeave
eitherRequest ((RequestSpaceLeave -> m (Union responses)) -> m (Union responses))
-> (RequestSpaceLeave -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \RequestSpaceLeave
request -> do
      Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Received request to leave space: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (RequestSpaceLeave -> String
forall a. Show a => a -> String
show RequestSpaceLeave
request)
      SeldaResult Bool
seldaResult <- SeldaTransactionT m Bool -> m (SeldaResult Bool)
forall a. SeldaTransactionT m a -> m (SeldaResult a)
forall (m :: * -> *) a.
MonadSeldaPool m =>
SeldaTransactionT m a -> m (SeldaResult a)
runSeldaTransactionT (SeldaTransactionT m Bool -> m (SeldaResult Bool))
-> SeldaTransactionT m Bool -> m (SeldaResult Bool)
forall a b. (a -> b) -> a -> b
$ do
        IdentifierSpace
spaceIdentifier <-
          case RequestSpaceLeave -> NameOrIdentifier NameSpace IdentifierSpace
requestSpaceLeaveSpace RequestSpaceLeave
request of
            Identifier IdentifierSpace
spaceId -> IdentifierSpace -> SeldaTransactionT m Space
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> SeldaTransactionT m Space
spaceGetFromId IdentifierSpace
spaceId SeldaTransactionT m Space
-> SeldaTransactionT m IdentifierSpace
-> SeldaTransactionT m IdentifierSpace
forall a b.
SeldaTransactionT m a
-> SeldaTransactionT m b -> SeldaTransactionT m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IdentifierSpace -> SeldaTransactionT m IdentifierSpace
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IdentifierSpace
spaceId
            Name NameSpace
name -> NameSpace -> SeldaTransactionT m IdentifierSpace
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
NameSpace -> SeldaTransactionT m IdentifierSpace
spaceLookupId NameSpace
name
        Bool
isOwner <- IdentifierSpace -> IdentifierUser -> SeldaTransactionT m Bool
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> IdentifierUser -> SeldaTransactionT m Bool
spaceUserIsOwner IdentifierSpace
spaceIdentifier (UserAuthenticated -> IdentifierUser
userAuthenticatedId UserAuthenticated
authenticated)
        if Bool
isOwner
          then 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
"User is the owner of the space and can therefore not be removed."
            Bool -> SeldaTransactionT m Bool
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
          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
"Removing user from space."
            IdentifierSpace -> IdentifierUser -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> IdentifierUser -> SeldaTransactionT m ()
spaceUserRemove IdentifierSpace
spaceIdentifier (UserAuthenticated -> IdentifierUser
userAuthenticatedId UserAuthenticated
authenticated)
            Bool -> SeldaTransactionT m Bool
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
      Proxy SqlErrorMensamSpaceNotFound
-> WithStatus 404 (StaticText "Space not found.")
-> SeldaResult Bool
-> (SeldaResult Bool -> m (Union responses))
-> m (Union responses)
forall e r (m :: * -> *) (responses :: [*]) a.
(Exception e, HasStatus r, Applicative m, IsMember r responses) =>
Proxy e
-> r
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException
        (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SqlErrorMensamSpaceNotFound)
        (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @404 (StaticText "Space not found."
 -> WithStatus 404 (StaticText "Space not found."))
-> StaticText "Space not found."
-> WithStatus 404 (StaticText "Space not found.")
forall a b. (a -> b) -> a -> b
$ forall (text :: Symbol). StaticText text
MkStaticText @"Space not found.")
        SeldaResult Bool
seldaResult
        ((SeldaResult Bool -> m (Union responses)) -> m (Union responses))
-> (SeldaResult Bool -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult Bool
seldaResultAfter404 ->
          WithStatus 500 ()
-> SeldaResult Bool
-> (Bool -> m (Union responses))
-> m (Union responses)
forall r (m :: * -> *) (responses :: [*]) a.
(HasStatus r, MonadLogger m, IsMember r responses) =>
r
-> SeldaResult a
-> (a -> m (Union responses))
-> m (Union responses)
handleSeldaSomeException (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @500 ()) SeldaResult Bool
seldaResultAfter404 ((Bool -> m (Union responses)) -> m (Union responses))
-> (Bool -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \Bool
removed ->
            if Bool
removed
              then do
                Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Left space."
                WithStatus 200 ResponseSpaceLeave -> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 200 ResponseSpaceLeave -> m (Union responses))
-> WithStatus 200 ResponseSpaceLeave -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ forall (k :: Nat) a. a -> WithStatus k a
WithStatus @200 MkResponseSpaceLeave {responseSpaceLeaveUnit :: ()
responseSpaceLeaveUnit = ()}
              else do
                Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Failed to leave space as owner."
                WithStatus 403 (StaticText "Owner cannot leave space.")
-> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 403 (StaticText "Owner cannot leave space.")
 -> m (Union responses))
-> WithStatus 403 (StaticText "Owner cannot leave space.")
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ forall (k :: Nat) a. a -> WithStatus k a
WithStatus @403 (StaticText "Owner cannot leave space."
 -> WithStatus 403 (StaticText "Owner cannot leave space."))
-> StaticText "Owner cannot leave space."
-> WithStatus 403 (StaticText "Owner cannot leave space.")
forall a b. (a -> b) -> a -> b
$ forall (text :: Symbol). StaticText text
MkStaticText @"Owner cannot leave space."

kickUser ::
  ( MonadLogger m
  , MonadSeldaPool m
  , IsMember (WithStatus 200 ResponseSpaceKick) responses
  , IsMember (WithStatus 400 ErrorParseBodyJson) responses
  , IsMember (WithStatus 401 ErrorBearerAuth) responses
  , IsMember (WithStatus 403 (ErrorInsufficientPermission MkPermissionEditUser)) responses
  , IsMember (WithStatus 404 (StaticText "Space not found.")) responses
  , IsMember (WithStatus 500 ()) responses
  ) =>
  AuthResult UserAuthenticated ->
  Either String RequestSpaceKick ->
  m (Union responses)
kickUser :: forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseSpaceKick) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionEditUser))
   responses,
 IsMember
   (WithStatus 404 (StaticText "Space not found.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestSpaceKick -> m (Union responses)
kickUser AuthResult UserAuthenticated
auth Either String RequestSpaceKick
eitherRequest =
  AuthResult UserAuthenticated
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 401 ErrorBearerAuth) responses) =>
AuthResult a -> (a -> m (Union responses)) -> m (Union responses)
handleAuthBearer AuthResult UserAuthenticated
auth ((UserAuthenticated -> m (Union responses)) -> m (Union responses))
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \UserAuthenticated
authenticated ->
    Either String RequestSpaceKick
-> (RequestSpaceKick -> m (Union responses)) -> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses) =>
Either String a
-> (a -> m (Union responses)) -> m (Union responses)
handleBadRequestBody Either String RequestSpaceKick
eitherRequest ((RequestSpaceKick -> m (Union responses)) -> m (Union responses))
-> (RequestSpaceKick -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \RequestSpaceKick
request -> do
      Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Received request to kick user from space: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (RequestSpaceKick -> String
forall a. Show a => a -> String
show RequestSpaceKick
request)
      SeldaResult Bool
seldaResult <- SeldaTransactionT m Bool -> m (SeldaResult Bool)
forall a. SeldaTransactionT m a -> m (SeldaResult a)
forall (m :: * -> *) a.
MonadSeldaPool m =>
SeldaTransactionT m a -> m (SeldaResult a)
runSeldaTransactionT (SeldaTransactionT m Bool -> m (SeldaResult Bool))
-> SeldaTransactionT m Bool -> m (SeldaResult Bool)
forall a b. (a -> b) -> a -> b
$ do
        SPermission 'MkPermissionEditUser
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
forall (m :: * -> *) (p :: Permission).
(MonadLogger m, MonadSeldaPool m, Typeable p) =>
SPermission p
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
checkPermission
          SPermission 'MkPermissionEditUser
SMkPermissionEditUser
          (UserAuthenticated -> IdentifierUser
userAuthenticatedId UserAuthenticated
authenticated)
          (RequestSpaceKick -> IdentifierSpace
requestSpaceKickSpace RequestSpaceKick
request)
        Bool
isOwner <- IdentifierSpace -> IdentifierUser -> SeldaTransactionT m Bool
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> IdentifierUser -> SeldaTransactionT m Bool
spaceUserIsOwner (RequestSpaceKick -> IdentifierSpace
requestSpaceKickSpace RequestSpaceKick
request) (RequestSpaceKick -> IdentifierUser
requestSpaceKickUser RequestSpaceKick
request)
        if Bool
isOwner
          then 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
"User is the owner of the space and can therefore not be kicked."
            Bool -> SeldaTransactionT m Bool
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
          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
"Removing user from space."
            IdentifierSpace -> IdentifierUser -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> IdentifierUser -> SeldaTransactionT m ()
spaceUserRemove (RequestSpaceKick -> IdentifierSpace
requestSpaceKickSpace RequestSpaceKick
request) (RequestSpaceKick -> IdentifierUser
requestSpaceKickUser RequestSpaceKick
request)
            Bool -> SeldaTransactionT m Bool
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
      Proxy SqlErrorMensamSpaceNotFound
-> WithStatus 404 (StaticText "Space not found.")
-> SeldaResult Bool
-> (SeldaResult Bool -> m (Union responses))
-> m (Union responses)
forall e r (m :: * -> *) (responses :: [*]) a.
(Exception e, HasStatus r, Applicative m, IsMember r responses) =>
Proxy e
-> r
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException
        (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SqlErrorMensamSpaceNotFound)
        (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @404 (StaticText "Space not found."
 -> WithStatus 404 (StaticText "Space not found."))
-> StaticText "Space not found."
-> WithStatus 404 (StaticText "Space not found.")
forall a b. (a -> b) -> a -> b
$ forall (text :: Symbol). StaticText text
MkStaticText @"Space not found.")
        SeldaResult Bool
seldaResult
        ((SeldaResult Bool -> m (Union responses)) -> m (Union responses))
-> (SeldaResult Bool -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult Bool
seldaResultAfter404 ->
          Proxy 'MkPermissionEditUser
-> SeldaResult Bool
-> (SeldaResult Bool -> m (Union responses))
-> m (Union responses)
forall (p :: Permission) (m :: * -> *) (responses :: [*]) a.
(Typeable p, Applicative m,
 IsMember
   (WithStatus 403 (ErrorInsufficientPermission p)) responses) =>
Proxy p
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException403InsufficientPermission
            (forall {k} (t :: k). Proxy t
forall (t :: Permission). Proxy t
Proxy @MkPermissionEditUser)
            SeldaResult Bool
seldaResultAfter404
            ((SeldaResult Bool -> m (Union responses)) -> m (Union responses))
-> (SeldaResult Bool -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult Bool
seldaResultAfter403 ->
              WithStatus 500 ()
-> SeldaResult Bool
-> (Bool -> m (Union responses))
-> m (Union responses)
forall r (m :: * -> *) (responses :: [*]) a.
(HasStatus r, MonadLogger m, IsMember r responses) =>
r
-> SeldaResult a
-> (a -> m (Union responses))
-> m (Union responses)
handleSeldaSomeException (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @500 ()) SeldaResult Bool
seldaResultAfter403 ((Bool -> m (Union responses)) -> m (Union responses))
-> (Bool -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \Bool
removed ->
                if Bool
removed
                  then do
                    Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Kicked from space."
                    WithStatus 200 ResponseSpaceKick -> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 200 ResponseSpaceKick -> m (Union responses))
-> WithStatus 200 ResponseSpaceKick -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ forall (k :: Nat) a. a -> WithStatus k a
WithStatus @200 MkResponseSpaceKick {responseSpaceKickUnit :: ()
responseSpaceKickUnit = ()}
                  else do
                    Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Failed to kick owner from space."
                    WithStatus 500 () -> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 500 () -> m (Union responses))
-> WithStatus 500 () -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ forall (k :: Nat) a. a -> WithStatus k a
WithStatus @500 () -- TODO: Use HTTP 403

setUserRole ::
  ( MonadLogger m
  , MonadSeldaPool m
  , IsMember (WithStatus 200 ResponseSpaceUserRole) responses
  , IsMember (WithStatus 400 ErrorParseBodyJson) responses
  , IsMember (WithStatus 401 ErrorBearerAuth) responses
  , IsMember (WithStatus 403 (ErrorInsufficientPermission MkPermissionEditUser)) responses
  , IsMember (WithStatus 404 (StaticText "Space not found.")) responses
  , IsMember (WithStatus 500 ()) responses
  ) =>
  AuthResult UserAuthenticated ->
  Either String RequestSpaceUserRole ->
  m (Union responses)
setUserRole :: forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseSpaceUserRole) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionEditUser))
   responses,
 IsMember
   (WithStatus 404 (StaticText "Space not found.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestSpaceUserRole -> m (Union responses)
setUserRole AuthResult UserAuthenticated
auth Either String RequestSpaceUserRole
eitherRequest =
  AuthResult UserAuthenticated
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 401 ErrorBearerAuth) responses) =>
AuthResult a -> (a -> m (Union responses)) -> m (Union responses)
handleAuthBearer AuthResult UserAuthenticated
auth ((UserAuthenticated -> m (Union responses)) -> m (Union responses))
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \UserAuthenticated
authenticated ->
    Either String RequestSpaceUserRole
-> (RequestSpaceUserRole -> m (Union responses))
-> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses) =>
Either String a
-> (a -> m (Union responses)) -> m (Union responses)
handleBadRequestBody Either String RequestSpaceUserRole
eitherRequest ((RequestSpaceUserRole -> m (Union responses))
 -> m (Union responses))
-> (RequestSpaceUserRole -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \RequestSpaceUserRole
request -> do
      Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Received request to change user role for space: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (RequestSpaceUserRole -> String
forall a. Show a => a -> String
show RequestSpaceUserRole
request)
      SeldaResult ()
seldaResult <- SeldaTransactionT m () -> m (SeldaResult ())
forall a. SeldaTransactionT m a -> m (SeldaResult a)
forall (m :: * -> *) a.
MonadSeldaPool m =>
SeldaTransactionT m a -> m (SeldaResult a)
runSeldaTransactionT (SeldaTransactionT m () -> m (SeldaResult ()))
-> SeldaTransactionT m () -> m (SeldaResult ())
forall a b. (a -> b) -> a -> b
$ do
        SPermission 'MkPermissionEditUser
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
forall (m :: * -> *) (p :: Permission).
(MonadLogger m, MonadSeldaPool m, Typeable p) =>
SPermission p
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
checkPermission
          SPermission 'MkPermissionEditUser
SMkPermissionEditUser
          (UserAuthenticated -> IdentifierUser
userAuthenticatedId UserAuthenticated
authenticated)
          (RequestSpaceUserRole -> IdentifierSpace
requestSpaceUserRoleSpace RequestSpaceUserRole
request)
        IdentifierSpace
-> IdentifierUser -> IdentifierRole -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace
-> IdentifierUser -> IdentifierRole -> SeldaTransactionT m ()
spaceUserRoleEdit
          (RequestSpaceUserRole -> IdentifierSpace
requestSpaceUserRoleSpace RequestSpaceUserRole
request)
          (RequestSpaceUserRole -> IdentifierUser
requestSpaceUserRoleUser RequestSpaceUserRole
request)
          (RequestSpaceUserRole -> IdentifierRole
requestSpaceUserRoleRole RequestSpaceUserRole
request)
      Proxy SqlErrorMensamSpaceNotFound
-> WithStatus 404 (StaticText "Space not found.")
-> SeldaResult ()
-> (SeldaResult () -> m (Union responses))
-> m (Union responses)
forall e r (m :: * -> *) (responses :: [*]) a.
(Exception e, HasStatus r, Applicative m, IsMember r responses) =>
Proxy e
-> r
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException
        (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SqlErrorMensamSpaceNotFound)
        (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @404 (StaticText "Space not found."
 -> WithStatus 404 (StaticText "Space not found."))
-> StaticText "Space not found."
-> WithStatus 404 (StaticText "Space not found.")
forall a b. (a -> b) -> a -> b
$ forall (text :: Symbol). StaticText text
MkStaticText @"Space not found.")
        SeldaResult ()
seldaResult
        ((SeldaResult () -> m (Union responses)) -> m (Union responses))
-> (SeldaResult () -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult ()
seldaResultAfter404 ->
          Proxy 'MkPermissionEditUser
-> SeldaResult ()
-> (SeldaResult () -> m (Union responses))
-> m (Union responses)
forall (p :: Permission) (m :: * -> *) (responses :: [*]) a.
(Typeable p, Applicative m,
 IsMember
   (WithStatus 403 (ErrorInsufficientPermission p)) responses) =>
Proxy p
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException403InsufficientPermission
            (forall {k} (t :: k). Proxy t
forall (t :: Permission). Proxy t
Proxy @MkPermissionEditUser)
            SeldaResult ()
seldaResultAfter404
            ((SeldaResult () -> m (Union responses)) -> m (Union responses))
-> (SeldaResult () -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult ()
seldaResultAfter403 ->
              WithStatus 500 ()
-> SeldaResult ()
-> (() -> m (Union responses))
-> m (Union responses)
forall r (m :: * -> *) (responses :: [*]) a.
(HasStatus r, MonadLogger m, IsMember r responses) =>
r
-> SeldaResult a
-> (a -> m (Union responses))
-> m (Union responses)
handleSeldaSomeException (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @500 ()) SeldaResult ()
seldaResultAfter403 ((() -> m (Union responses)) -> m (Union responses))
-> (() -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \() -> do
                Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Set new role successfully."
                WithStatus 200 ResponseSpaceUserRole -> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 200 ResponseSpaceUserRole -> m (Union responses))
-> WithStatus 200 ResponseSpaceUserRole -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ forall (k :: Nat) a. a -> WithStatus k a
WithStatus @200 MkResponseSpaceUserRole {responseSpaceUserRoleUnit :: ()
responseSpaceUserRoleUnit = ()}

viewSpace ::
  ( MonadLogger m
  , MonadSeldaPool m
  , IsMember (WithStatus 200 ResponseSpaceView) responses
  , IsMember (WithStatus 400 ErrorParseBodyJson) responses
  , IsMember (WithStatus 401 ErrorBearerAuth) responses
  , IsMember (WithStatus 403 ResponseSpaceView403) responses
  , IsMember (WithStatus 404 (StaticText "Space not found.")) responses
  , IsMember (WithStatus 500 ()) responses
  ) =>
  AuthResult UserAuthenticated ->
  Either String RequestSpaceView ->
  m (Union responses)
viewSpace :: forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseSpaceView) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember (WithStatus 403 ResponseSpaceView403) responses,
 IsMember
   (WithStatus 404 (StaticText "Space not found.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestSpaceView -> m (Union responses)
viewSpace AuthResult UserAuthenticated
auth Either String RequestSpaceView
eitherRequest =
  AuthResult UserAuthenticated
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 401 ErrorBearerAuth) responses) =>
AuthResult a -> (a -> m (Union responses)) -> m (Union responses)
handleAuthBearer AuthResult UserAuthenticated
auth ((UserAuthenticated -> m (Union responses)) -> m (Union responses))
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \UserAuthenticated
authenticated ->
    Either String RequestSpaceView
-> (RequestSpaceView -> m (Union responses)) -> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses) =>
Either String a
-> (a -> m (Union responses)) -> m (Union responses)
handleBadRequestBody Either String RequestSpaceView
eitherRequest ((RequestSpaceView -> m (Union responses)) -> m (Union responses))
-> (RequestSpaceView -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \RequestSpaceView
request -> do
      Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Received request to view space: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (RequestSpaceView -> String
forall a. Show a => a -> String
show RequestSpaceView
request)
      SeldaResult (Either SpaceView SpaceView)
seldaResult <- SeldaTransactionT m (Either SpaceView SpaceView)
-> m (SeldaResult (Either SpaceView SpaceView))
forall a. SeldaTransactionT m a -> m (SeldaResult a)
forall (m :: * -> *) a.
MonadSeldaPool m =>
SeldaTransactionT m a -> m (SeldaResult a)
runSeldaTransactionT (SeldaTransactionT m (Either SpaceView SpaceView)
 -> m (SeldaResult (Either SpaceView SpaceView)))
-> SeldaTransactionT m (Either SpaceView SpaceView)
-> m (SeldaResult (Either SpaceView SpaceView))
forall a b. (a -> b) -> a -> b
$ do
        Space
_ <- IdentifierSpace -> SeldaTransactionT m Space
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> SeldaTransactionT m Space
spaceGetFromId (IdentifierSpace -> SeldaTransactionT m Space)
-> IdentifierSpace -> SeldaTransactionT m Space
forall a b. (a -> b) -> a -> b
$ RequestSpaceView -> IdentifierSpace
requestSpaceViewId RequestSpaceView
request -- Generate error when space doesn't exist
        SpaceView
spaceViewResult <- IdentifierUser -> IdentifierSpace -> SeldaTransactionT m SpaceView
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierUser -> IdentifierSpace -> SeldaTransactionT m SpaceView
spaceView (UserAuthenticated -> IdentifierUser
userAuthenticatedId UserAuthenticated
authenticated) (RequestSpaceView -> IdentifierSpace
requestSpaceViewId RequestSpaceView
request)
        let permissionCheck :: SeldaTransactionT m ()
permissionCheck =
              SPermission 'MkPermissionViewSpace
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
forall (m :: * -> *) (p :: Permission).
(MonadLogger m, MonadSeldaPool m, Typeable p) =>
SPermission p
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
checkPermission
                SPermission 'MkPermissionViewSpace
SMkPermissionViewSpace
                (UserAuthenticated -> IdentifierUser
userAuthenticatedId UserAuthenticated
authenticated)
                (RequestSpaceView -> IdentifierSpace
requestSpaceViewId RequestSpaceView
request)
        SeldaTransactionT m (Either SpaceView SpaceView)
-> (SqlErrorMensamPermissionNotSatisfied 'MkPermissionViewSpace
    -> SeldaTransactionT m (Either SpaceView SpaceView))
-> SeldaTransactionT m (Either SpaceView SpaceView)
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 (SeldaTransactionT m ()
permissionCheck SeldaTransactionT m ()
-> SeldaTransactionT m (Either SpaceView SpaceView)
-> SeldaTransactionT m (Either SpaceView SpaceView)
forall a b.
SeldaTransactionT m a
-> SeldaTransactionT m b -> SeldaTransactionT m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either SpaceView SpaceView
-> SeldaTransactionT m (Either SpaceView SpaceView)
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SpaceView -> Either SpaceView SpaceView
forall a b. b -> Either a b
Right SpaceView
spaceViewResult)) ((SqlErrorMensamPermissionNotSatisfied 'MkPermissionViewSpace
  -> SeldaTransactionT m (Either SpaceView SpaceView))
 -> SeldaTransactionT m (Either SpaceView SpaceView))
-> (SqlErrorMensamPermissionNotSatisfied 'MkPermissionViewSpace
    -> SeldaTransactionT m (Either SpaceView SpaceView))
-> SeldaTransactionT m (Either SpaceView SpaceView)
forall a b. (a -> b) -> a -> b
$ \case
          MkSqlErrorMensamPermissionNotSatisfied @MkPermissionViewSpace ->
            Either SpaceView SpaceView
-> SeldaTransactionT m (Either SpaceView SpaceView)
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SpaceView SpaceView
 -> SeldaTransactionT m (Either SpaceView SpaceView))
-> Either SpaceView SpaceView
-> SeldaTransactionT m (Either SpaceView SpaceView)
forall a b. (a -> b) -> a -> b
$ SpaceView -> Either SpaceView SpaceView
forall a b. a -> Either a b
Left SpaceView
spaceViewResult
      Proxy SqlErrorMensamSpaceNotFound
-> WithStatus 404 (StaticText "Space not found.")
-> SeldaResult (Either SpaceView SpaceView)
-> (SeldaResult (Either SpaceView SpaceView)
    -> m (Union responses))
-> m (Union responses)
forall e r (m :: * -> *) (responses :: [*]) a.
(Exception e, HasStatus r, Applicative m, IsMember r responses) =>
Proxy e
-> r
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException
        (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SqlErrorMensamSpaceNotFound)
        (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @404 (StaticText "Space not found."
 -> WithStatus 404 (StaticText "Space not found."))
-> StaticText "Space not found."
-> WithStatus 404 (StaticText "Space not found.")
forall a b. (a -> b) -> a -> b
$ forall (text :: Symbol). StaticText text
MkStaticText @"Space not found.")
        SeldaResult (Either SpaceView SpaceView)
seldaResult
        ((SeldaResult (Either SpaceView SpaceView) -> m (Union responses))
 -> m (Union responses))
-> (SeldaResult (Either SpaceView SpaceView)
    -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult (Either SpaceView SpaceView)
seldaResultAfter404 ->
          WithStatus 500 ()
-> SeldaResult (Either SpaceView SpaceView)
-> (Either SpaceView SpaceView -> m (Union responses))
-> m (Union responses)
forall r (m :: * -> *) (responses :: [*]) a.
(HasStatus r, MonadLogger m, IsMember r responses) =>
r
-> SeldaResult a
-> (a -> m (Union responses))
-> m (Union responses)
handleSeldaSomeException (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @500 ()) SeldaResult (Either SpaceView SpaceView)
seldaResultAfter404 ((Either SpaceView SpaceView -> m (Union responses))
 -> m (Union responses))
-> (Either SpaceView SpaceView -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \case
            Left SpaceView
spaceViewResult -> do
              Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"User not permitted to view space fully. Creating reduced space view."
              WithStatus 403 ResponseSpaceView403 -> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 403 ResponseSpaceView403 -> m (Union responses))
-> WithStatus 403 ResponseSpaceView403 -> m (Union responses)
forall a b. (a -> b) -> a -> b
$
                forall (k :: Nat) a. a -> WithStatus k a
WithStatus @403 (ResponseSpaceView403 -> WithStatus 403 ResponseSpaceView403)
-> ResponseSpaceView403 -> WithStatus 403 ResponseSpaceView403
forall a b. (a -> b) -> a -> b
$
                  MkResponseSpaceView403
                    { responseSpaceView403Id :: IdentifierSpace
responseSpaceView403Id = SpaceView -> IdentifierSpace
spaceViewId SpaceView
spaceViewResult
                    , responseSpaceView403Name :: NameSpace
responseSpaceView403Name = SpaceView -> NameSpace
spaceViewName SpaceView
spaceViewResult
                    , responseSpaceView403Timezone :: TZLabel
responseSpaceView403Timezone = SpaceView -> TZLabel
spaceViewTimezone SpaceView
spaceViewResult
                    , responseSpaceView403Visibility :: VisibilitySpace
responseSpaceView403Visibility = SpaceView -> VisibilitySpace
spaceViewVisibility SpaceView
spaceViewResult
                    , responseSpaceView403Roles :: Set Role
responseSpaceView403Roles = SpaceView -> Set Role
spaceViewRoles SpaceView
spaceViewResult
                    , responseSpaceView403YourRole :: Maybe IdentifierRole
responseSpaceView403YourRole = SpaceView -> Maybe IdentifierRole
spaceViewYourRole SpaceView
spaceViewResult
                    }
            Right SpaceView
spaceViewResult -> do
              Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Viewed space."
              WithStatus 200 ResponseSpaceView -> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 200 ResponseSpaceView -> m (Union responses))
-> WithStatus 200 ResponseSpaceView -> m (Union responses)
forall a b. (a -> b) -> a -> b
$
                forall (k :: Nat) a. a -> WithStatus k a
WithStatus @200
                  MkResponseSpaceView
                    { responseSpaceViewId :: IdentifierSpace
responseSpaceViewId = SpaceView -> IdentifierSpace
spaceViewId SpaceView
spaceViewResult
                    , responseSpaceViewName :: NameSpace
responseSpaceViewName = SpaceView -> NameSpace
spaceViewName SpaceView
spaceViewResult
                    , responseSpaceViewTimezone :: TZLabel
responseSpaceViewTimezone = SpaceView -> TZLabel
spaceViewTimezone SpaceView
spaceViewResult
                    , responseSpaceViewVisibility :: VisibilitySpace
responseSpaceViewVisibility = SpaceView -> VisibilitySpace
spaceViewVisibility SpaceView
spaceViewResult
                    , responseSpaceViewOwner :: IdentifierUser
responseSpaceViewOwner = SpaceView -> IdentifierUser
spaceViewOwner SpaceView
spaceViewResult
                    , responseSpaceViewRoles :: Set Role
responseSpaceViewRoles = SpaceView -> Set Role
spaceViewRoles SpaceView
spaceViewResult
                    , responseSpaceViewUsers :: Set SpaceUser
responseSpaceViewUsers = SpaceView -> Set SpaceUser
spaceViewUsers SpaceView
spaceViewResult
                    , responseSpaceViewYourRole :: Maybe IdentifierRole
responseSpaceViewYourRole = SpaceView -> Maybe IdentifierRole
spaceViewYourRole SpaceView
spaceViewResult
                    }

listSpaces ::
  ( MonadLogger m
  , MonadSeldaPool m
  , IsMember (WithStatus 200 ResponseSpaceList) responses
  , IsMember (WithStatus 400 ErrorParseBodyJson) responses
  , IsMember (WithStatus 401 ErrorBearerAuth) responses
  , IsMember (WithStatus 500 ()) responses
  ) =>
  AuthResult UserAuthenticated ->
  Either String RequestSpaceList ->
  m (Union responses)
listSpaces :: forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseSpaceList) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestSpaceList -> m (Union responses)
listSpaces AuthResult UserAuthenticated
auth Either String RequestSpaceList
eitherRequest =
  AuthResult UserAuthenticated
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 401 ErrorBearerAuth) responses) =>
AuthResult a -> (a -> m (Union responses)) -> m (Union responses)
handleAuthBearer AuthResult UserAuthenticated
auth ((UserAuthenticated -> m (Union responses)) -> m (Union responses))
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \UserAuthenticated
authenticated ->
    Either String RequestSpaceList
-> (RequestSpaceList -> m (Union responses)) -> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses) =>
Either String a
-> (a -> m (Union responses)) -> m (Union responses)
handleBadRequestBody Either String RequestSpaceList
eitherRequest ((RequestSpaceList -> m (Union responses)) -> m (Union responses))
-> (RequestSpaceList -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \RequestSpaceList
request -> do
      Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Received request to list spaces: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (RequestSpaceList -> String
forall a. Show a => a -> String
show RequestSpaceList
request)
      SeldaResult [SpaceListSpace]
seldaResult <- SeldaTransactionT m [SpaceListSpace]
-> m (SeldaResult [SpaceListSpace])
forall a. SeldaTransactionT m a -> m (SeldaResult a)
forall (m :: * -> *) a.
MonadSeldaPool m =>
SeldaTransactionT m a -> m (SeldaResult a)
runSeldaTransactionT (SeldaTransactionT m [SpaceListSpace]
 -> m (SeldaResult [SpaceListSpace]))
-> SeldaTransactionT m [SpaceListSpace]
-> m (SeldaResult [SpaceListSpace])
forall a b. (a -> b) -> a -> b
$ do
        [Space]
spaces <- IdentifierUser
-> OrderByCategories SpaceOrderCategory
-> Maybe Bool
-> SeldaTransactionT m [Space]
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierUser
-> OrderByCategories SpaceOrderCategory
-> Maybe Bool
-> SeldaTransactionT m [Space]
spaceListVisible (UserAuthenticated -> IdentifierUser
userAuthenticatedId UserAuthenticated
authenticated) (RequestSpaceList -> OrderByCategories SpaceOrderCategory
requestSpaceListOrder RequestSpaceList
request) (RequestSpaceList -> Maybe Bool
requestSpaceListMember RequestSpaceList
request)
        [Space]
-> (Space -> SeldaTransactionT m SpaceListSpace)
-> SeldaTransactionT m [SpaceListSpace]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Space]
spaces ((Space -> SeldaTransactionT m SpaceListSpace)
 -> SeldaTransactionT m [SpaceListSpace])
-> (Space -> SeldaTransactionT m SpaceListSpace)
-> SeldaTransactionT m [SpaceListSpace]
forall a b. (a -> b) -> a -> b
$ \Space
space -> do
          Nat
userCount <- IdentifierSpace -> SeldaTransactionT m Nat
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> SeldaTransactionT m Nat
spaceCountUsers (IdentifierSpace -> SeldaTransactionT m Nat)
-> IdentifierSpace -> SeldaTransactionT m Nat
forall a b. (a -> b) -> a -> b
$ Space -> IdentifierSpace
spaceId Space
space
          Nat
deskCount <- IdentifierSpace -> SeldaTransactionT m Nat
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> SeldaTransactionT m Nat
spaceCountDesks (IdentifierSpace -> SeldaTransactionT m Nat)
-> IdentifierSpace -> SeldaTransactionT m Nat
forall a b. (a -> b) -> a -> b
$ Space -> IdentifierSpace
spaceId Space
space
          SpaceListSpace -> SeldaTransactionT m SpaceListSpace
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            MkSpaceListSpace
              { spaceListSpaceId :: IdentifierSpace
spaceListSpaceId = Space -> IdentifierSpace
spaceId Space
space
              , spaceListSpaceName :: NameSpace
spaceListSpaceName = Space -> NameSpace
spaceName Space
space
              , spaceListSpaceTimezone :: TZLabel
spaceListSpaceTimezone = Space -> TZLabel
spaceTimezone Space
space
              , spaceListSpaceOwner :: IdentifierUser
spaceListSpaceOwner = Space -> IdentifierUser
spaceOwner Space
space
              , spaceListSpaceUsers :: Nat
spaceListSpaceUsers = Nat
userCount
              , spaceListSpaceDesks :: Nat
spaceListSpaceDesks = Nat
deskCount
              }
      WithStatus 500 ()
-> SeldaResult [SpaceListSpace]
-> ([SpaceListSpace] -> m (Union responses))
-> m (Union responses)
forall r (m :: * -> *) (responses :: [*]) a.
(HasStatus r, MonadLogger m, IsMember r responses) =>
r
-> SeldaResult a
-> (a -> m (Union responses))
-> m (Union responses)
handleSeldaSomeException (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @500 ()) SeldaResult [SpaceListSpace]
seldaResult (([SpaceListSpace] -> m (Union responses)) -> m (Union responses))
-> ([SpaceListSpace] -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \[SpaceListSpace]
spaces -> do
        Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Listed spaces."
        WithStatus 200 ResponseSpaceList -> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 200 ResponseSpaceList -> m (Union responses))
-> WithStatus 200 ResponseSpaceList -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ forall (k :: Nat) a. a -> WithStatus k a
WithStatus @200 MkResponseSpaceList {responseSpaceListSpaces :: [SpaceListSpace]
responseSpaceListSpaces = [SpaceListSpace]
spaces}

createRole ::
  ( MonadIO m
  , MonadLogger m
  , MonadSeldaPool m
  , IsMember (WithStatus 201 ResponseRoleCreate) responses
  , IsMember (WithStatus 400 ErrorParseBodyJson) responses
  , IsMember (WithStatus 401 ErrorBearerAuth) responses
  , IsMember (WithStatus 403 (ErrorInsufficientPermission MkPermissionEditRole)) responses
  , IsMember (WithStatus 404 (StaticText "Space not found.")) responses
  , IsMember (WithStatus 500 ()) responses
  ) =>
  AuthResult UserAuthenticated ->
  Either String RequestRoleCreate ->
  m (Union responses)
createRole :: forall (m :: * -> *) (responses :: [*]).
(MonadIO m, MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 201 ResponseRoleCreate) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionEditRole))
   responses,
 IsMember
   (WithStatus 404 (StaticText "Space not found.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestRoleCreate -> m (Union responses)
createRole AuthResult UserAuthenticated
auth Either String RequestRoleCreate
eitherRequest =
  AuthResult UserAuthenticated
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 401 ErrorBearerAuth) responses) =>
AuthResult a -> (a -> m (Union responses)) -> m (Union responses)
handleAuthBearer AuthResult UserAuthenticated
auth ((UserAuthenticated -> m (Union responses)) -> m (Union responses))
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \UserAuthenticated
authenticated ->
    Either String RequestRoleCreate
-> (RequestRoleCreate -> m (Union responses))
-> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses) =>
Either String a
-> (a -> m (Union responses)) -> m (Union responses)
handleBadRequestBody Either String RequestRoleCreate
eitherRequest ((RequestRoleCreate -> m (Union responses)) -> m (Union responses))
-> (RequestRoleCreate -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \RequestRoleCreate
request -> do
      Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Received request to create role: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (RequestRoleCreate -> String
forall a. Show a => a -> String
show RequestRoleCreate
request)
      SeldaResult IdentifierRole
seldaResult <- SeldaTransactionT m IdentifierRole
-> m (SeldaResult IdentifierRole)
forall a. SeldaTransactionT m a -> m (SeldaResult a)
forall (m :: * -> *) a.
MonadSeldaPool m =>
SeldaTransactionT m a -> m (SeldaResult a)
runSeldaTransactionT (SeldaTransactionT m IdentifierRole
 -> m (SeldaResult IdentifierRole))
-> SeldaTransactionT m IdentifierRole
-> m (SeldaResult IdentifierRole)
forall a b. (a -> b) -> a -> b
$ do
        SPermission 'MkPermissionEditRole
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
forall (m :: * -> *) (p :: Permission).
(MonadLogger m, MonadSeldaPool m, Typeable p) =>
SPermission p
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
checkPermission
          SPermission 'MkPermissionEditRole
SMkPermissionEditRole
          (UserAuthenticated -> IdentifierUser
userAuthenticatedId UserAuthenticated
authenticated)
          (RequestRoleCreate -> IdentifierSpace
requestRoleCreateSpace RequestRoleCreate
request)
        IdentifierRole
roleId <-
          IdentifierSpace
-> NameRole
-> AccessibilityRole
-> Maybe Password
-> SeldaTransactionT m IdentifierRole
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace
-> NameRole
-> AccessibilityRole
-> Maybe Password
-> SeldaTransactionT m IdentifierRole
roleCreate
            (RequestRoleCreate -> IdentifierSpace
requestRoleCreateSpace RequestRoleCreate
request)
            (RequestRoleCreate -> NameRole
requestRoleCreateName RequestRoleCreate
request)
            (RequestRoleCreate -> AccessibilityRole
requestRoleCreateAccessibility RequestRoleCreate
request)
            (Text -> Password
mkPassword (Text -> Password) -> Maybe Text -> Maybe Password
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RequestRoleCreate -> Maybe Text
requestRoleCreatePassword RequestRoleCreate
request)
        (Permission -> SeldaTransactionT m ())
-> Set Permission -> SeldaTransactionT m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IdentifierRole -> Permission -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole -> Permission -> SeldaTransactionT m ()
rolePermissionGive IdentifierRole
roleId) (RequestRoleCreate -> Set Permission
requestRoleCreatePermissions RequestRoleCreate
request)
        IdentifierRole -> SeldaTransactionT m IdentifierRole
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IdentifierRole
roleId
      Proxy SqlErrorMensamSpaceNotFound
-> WithStatus 404 (StaticText "Space not found.")
-> SeldaResult IdentifierRole
-> (SeldaResult IdentifierRole -> m (Union responses))
-> m (Union responses)
forall e r (m :: * -> *) (responses :: [*]) a.
(Exception e, HasStatus r, Applicative m, IsMember r responses) =>
Proxy e
-> r
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException
        (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SqlErrorMensamSpaceNotFound)
        (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @404 (StaticText "Space not found."
 -> WithStatus 404 (StaticText "Space not found."))
-> StaticText "Space not found."
-> WithStatus 404 (StaticText "Space not found.")
forall a b. (a -> b) -> a -> b
$ forall (text :: Symbol). StaticText text
MkStaticText @"Space not found.")
        SeldaResult IdentifierRole
seldaResult
        ((SeldaResult IdentifierRole -> m (Union responses))
 -> m (Union responses))
-> (SeldaResult IdentifierRole -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult IdentifierRole
seldaResultAfter404 ->
          Proxy 'MkPermissionEditRole
-> SeldaResult IdentifierRole
-> (SeldaResult IdentifierRole -> m (Union responses))
-> m (Union responses)
forall (p :: Permission) (m :: * -> *) (responses :: [*]) a.
(Typeable p, Applicative m,
 IsMember
   (WithStatus 403 (ErrorInsufficientPermission p)) responses) =>
Proxy p
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException403InsufficientPermission
            (forall {k} (t :: k). Proxy t
forall (t :: Permission). Proxy t
Proxy @MkPermissionEditRole)
            SeldaResult IdentifierRole
seldaResultAfter404
            ((SeldaResult IdentifierRole -> m (Union responses))
 -> m (Union responses))
-> (SeldaResult IdentifierRole -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult IdentifierRole
seldaResultAfter403 ->
              Proxy SqlErrorMensamRoleAccessibilityAndPasswordDontMatch
-> WithStatus 400 ErrorParseBodyJson
-> SeldaResult IdentifierRole
-> (SeldaResult IdentifierRole -> m (Union responses))
-> m (Union responses)
forall e r (m :: * -> *) (responses :: [*]) a.
(Exception e, HasStatus r, Applicative m, IsMember r responses) =>
Proxy e
-> r
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException
                (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SqlErrorMensamRoleAccessibilityAndPasswordDontMatch)
                (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @400 (ErrorParseBodyJson -> WithStatus 400 ErrorParseBodyJson)
-> ErrorParseBodyJson -> WithStatus 400 ErrorParseBodyJson
forall a b. (a -> b) -> a -> b
$ MkErrorParseBodyJson {errorParseBodyJsonError :: String
errorParseBodyJsonError = String
"accessibility and password don't match"})
                SeldaResult IdentifierRole
seldaResultAfter403
                ((SeldaResult IdentifierRole -> m (Union responses))
 -> m (Union responses))
-> (SeldaResult IdentifierRole -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult IdentifierRole
seldaResultAfter500 ->
                  WithStatus 500 ()
-> SeldaResult IdentifierRole
-> (IdentifierRole -> m (Union responses))
-> m (Union responses)
forall r (m :: * -> *) (responses :: [*]) a.
(HasStatus r, MonadLogger m, IsMember r responses) =>
r
-> SeldaResult a
-> (a -> m (Union responses))
-> m (Union responses)
handleSeldaSomeException (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @500 ()) SeldaResult IdentifierRole
seldaResultAfter500 ((IdentifierRole -> m (Union responses)) -> m (Union responses))
-> (IdentifierRole -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \IdentifierRole
roleIdentifier -> do
                    Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Created role."
                    WithStatus 201 ResponseRoleCreate -> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 201 ResponseRoleCreate -> m (Union responses))
-> WithStatus 201 ResponseRoleCreate -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ forall (k :: Nat) a. a -> WithStatus k a
WithStatus @201 MkResponseRoleCreate {responseRoleCreateId :: IdentifierRole
responseRoleCreateId = IdentifierRole
roleIdentifier}

editRole ::
  ( MonadIO m
  , MonadLogger m
  , MonadSeldaPool m
  , IsMember (WithStatus 200 ResponseRoleEdit) responses
  , IsMember (WithStatus 400 ErrorParseBodyJson) responses
  , IsMember (WithStatus 401 ErrorBearerAuth) responses
  , IsMember (WithStatus 403 (ErrorInsufficientPermission MkPermissionEditRole)) responses
  , IsMember (WithStatus 500 ()) responses
  ) =>
  AuthResult UserAuthenticated ->
  Either String RequestRoleEdit ->
  m (Union responses)
editRole :: forall (m :: * -> *) (responses :: [*]).
(MonadIO m, MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseRoleEdit) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionEditRole))
   responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestRoleEdit -> m (Union responses)
editRole AuthResult UserAuthenticated
auth Either String RequestRoleEdit
eitherRequest =
  AuthResult UserAuthenticated
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 401 ErrorBearerAuth) responses) =>
AuthResult a -> (a -> m (Union responses)) -> m (Union responses)
handleAuthBearer AuthResult UserAuthenticated
auth ((UserAuthenticated -> m (Union responses)) -> m (Union responses))
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \UserAuthenticated
authenticated ->
    Either String RequestRoleEdit
-> (RequestRoleEdit -> m (Union responses)) -> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses) =>
Either String a
-> (a -> m (Union responses)) -> m (Union responses)
handleBadRequestBody Either String RequestRoleEdit
eitherRequest ((RequestRoleEdit -> m (Union responses)) -> m (Union responses))
-> (RequestRoleEdit -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \RequestRoleEdit
request -> do
      Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Received request to delete role: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (RequestRoleEdit -> String
forall a. Show a => a -> String
show RequestRoleEdit
request)
      SeldaResult ()
seldaResult <- SeldaTransactionT m () -> m (SeldaResult ())
forall a. SeldaTransactionT m a -> m (SeldaResult a)
forall (m :: * -> *) a.
MonadSeldaPool m =>
SeldaTransactionT m a -> m (SeldaResult a)
runSeldaTransactionT (SeldaTransactionT m () -> m (SeldaResult ()))
-> SeldaTransactionT m () -> m (SeldaResult ())
forall a b. (a -> b) -> a -> b
$ do
        IdentifierSpace
spaceIdentifier <- Role -> IdentifierSpace
roleSpace (Role -> IdentifierSpace)
-> SeldaTransactionT m Role -> SeldaTransactionT m IdentifierSpace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdentifierRole -> SeldaTransactionT m Role
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole -> SeldaTransactionT m Role
roleGet (RequestRoleEdit -> IdentifierRole
requestRoleEditId RequestRoleEdit
request)
        SPermission 'MkPermissionEditRole
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
forall (m :: * -> *) (p :: Permission).
(MonadLogger m, MonadSeldaPool m, Typeable p) =>
SPermission p
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
checkPermission
          SPermission 'MkPermissionEditRole
SMkPermissionEditRole
          (UserAuthenticated -> IdentifierUser
userAuthenticatedId UserAuthenticated
authenticated)
          IdentifierSpace
spaceIdentifier
        case RequestRoleEdit -> Updatable NameRole
requestRoleEditName RequestRoleEdit
request of
          Updatable NameRole
Preserve -> () -> SeldaTransactionT m ()
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Overwrite NameRole
name -> IdentifierRole -> NameRole -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole -> NameRole -> SeldaTransactionT m ()
roleNameSet (RequestRoleEdit -> IdentifierRole
requestRoleEditId RequestRoleEdit
request) NameRole
name
        case RequestRoleEdit -> Updatable RoleEditAccessibilityAndPassword
requestRoleEditAccessibilityAndPassword RequestRoleEdit
request of
          Updatable RoleEditAccessibilityAndPassword
Preserve -> () -> SeldaTransactionT m ()
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Overwrite RoleEditAccessibilityAndPassword
accessibilityAndPassword ->
            IdentifierRole
-> AccessibilityRole -> Maybe Password -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
IdentifierRole
-> AccessibilityRole -> Maybe Password -> SeldaTransactionT m ()
roleAccessibilityAndPasswordSet
              (RequestRoleEdit -> IdentifierRole
requestRoleEditId RequestRoleEdit
request)
              (RoleEditAccessibilityAndPassword -> AccessibilityRole
roleEditAccessibilityAndPasswordAccessibility RoleEditAccessibilityAndPassword
accessibilityAndPassword)
              (Text -> Password
mkPassword (Text -> Password) -> Maybe Text -> Maybe Password
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RoleEditAccessibilityAndPassword -> Maybe Text
roleEditAccessibilityAndPasswordPassword RoleEditAccessibilityAndPassword
accessibilityAndPassword)
        case RequestRoleEdit -> Updatable (Set Permission)
requestRoleEditPermissions RequestRoleEdit
request of
          Updatable (Set Permission)
Preserve -> () -> SeldaTransactionT m ()
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Overwrite Set Permission
permissions -> IdentifierRole -> Set Permission -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole -> Set Permission -> SeldaTransactionT m ()
rolePermissionsSet (RequestRoleEdit -> IdentifierRole
requestRoleEditId RequestRoleEdit
request) Set Permission
permissions
      Proxy 'MkPermissionEditRole
-> SeldaResult ()
-> (SeldaResult () -> m (Union responses))
-> m (Union responses)
forall (p :: Permission) (m :: * -> *) (responses :: [*]) a.
(Typeable p, Applicative m,
 IsMember
   (WithStatus 403 (ErrorInsufficientPermission p)) responses) =>
Proxy p
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException403InsufficientPermission
        (forall {k} (t :: k). Proxy t
forall (t :: Permission). Proxy t
Proxy @MkPermissionEditRole)
        SeldaResult ()
seldaResult
        ((SeldaResult () -> m (Union responses)) -> m (Union responses))
-> (SeldaResult () -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult ()
seldaResultAfter403 ->
          WithStatus 500 ()
-> SeldaResult ()
-> (() -> m (Union responses))
-> m (Union responses)
forall r (m :: * -> *) (responses :: [*]) a.
(HasStatus r, MonadLogger m, IsMember r responses) =>
r
-> SeldaResult a
-> (a -> m (Union responses))
-> m (Union responses)
handleSeldaSomeException (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @500 ()) SeldaResult ()
seldaResultAfter403 ((() -> m (Union responses)) -> m (Union responses))
-> (() -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \() -> do
            Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Editeded role."
            WithStatus 200 ResponseRoleEdit -> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 200 ResponseRoleEdit -> m (Union responses))
-> WithStatus 200 ResponseRoleEdit -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ forall (k :: Nat) a. a -> WithStatus k a
WithStatus @200 MkResponseRoleEdit {responseRoleEditUnit :: ()
responseRoleEditUnit = ()}

deleteRole ::
  ( MonadLogger m
  , MonadSeldaPool m
  , IsMember (WithStatus 200 ResponseRoleDelete) responses
  , IsMember (WithStatus 400 ErrorParseBodyJson) responses
  , IsMember (WithStatus 401 ErrorBearerAuth) responses
  , IsMember (WithStatus 403 (ErrorInsufficientPermission MkPermissionEditRole)) responses
  , IsMember (WithStatus 500 ()) responses
  ) =>
  AuthResult UserAuthenticated ->
  Either String RequestRoleDelete ->
  m (Union responses)
deleteRole :: forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseRoleDelete) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionEditRole))
   responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestRoleDelete -> m (Union responses)
deleteRole AuthResult UserAuthenticated
auth Either String RequestRoleDelete
eitherRequest =
  AuthResult UserAuthenticated
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 401 ErrorBearerAuth) responses) =>
AuthResult a -> (a -> m (Union responses)) -> m (Union responses)
handleAuthBearer AuthResult UserAuthenticated
auth ((UserAuthenticated -> m (Union responses)) -> m (Union responses))
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \UserAuthenticated
authenticated ->
    Either String RequestRoleDelete
-> (RequestRoleDelete -> m (Union responses))
-> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses) =>
Either String a
-> (a -> m (Union responses)) -> m (Union responses)
handleBadRequestBody Either String RequestRoleDelete
eitherRequest ((RequestRoleDelete -> m (Union responses)) -> m (Union responses))
-> (RequestRoleDelete -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \RequestRoleDelete
request -> do
      Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Received request to delete role: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (RequestRoleDelete -> String
forall a. Show a => a -> String
show RequestRoleDelete
request)
      SeldaResult ()
seldaResult <- SeldaTransactionT m () -> m (SeldaResult ())
forall a. SeldaTransactionT m a -> m (SeldaResult a)
forall (m :: * -> *) a.
MonadSeldaPool m =>
SeldaTransactionT m a -> m (SeldaResult a)
runSeldaTransactionT (SeldaTransactionT m () -> m (SeldaResult ()))
-> SeldaTransactionT m () -> m (SeldaResult ())
forall a b. (a -> b) -> a -> b
$ do
        IdentifierSpace
spaceIdentifier <- Role -> IdentifierSpace
roleSpace (Role -> IdentifierSpace)
-> SeldaTransactionT m Role -> SeldaTransactionT m IdentifierSpace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdentifierRole -> SeldaTransactionT m Role
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole -> SeldaTransactionT m Role
roleGet (RequestRoleDelete -> IdentifierRole
requestRoleDeleteId RequestRoleDelete
request)
        SPermission 'MkPermissionEditRole
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
forall (m :: * -> *) (p :: Permission).
(MonadLogger m, MonadSeldaPool m, Typeable p) =>
SPermission p
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
checkPermission
          SPermission 'MkPermissionEditRole
SMkPermissionEditRole
          (UserAuthenticated -> IdentifierUser
userAuthenticatedId UserAuthenticated
authenticated)
          IdentifierSpace
spaceIdentifier
        IdentifierRole -> IdentifierRole -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierRole -> IdentifierRole -> SeldaTransactionT m ()
roleDeleteWithFallback (RequestRoleDelete -> IdentifierRole
requestRoleDeleteId RequestRoleDelete
request) (RequestRoleDelete -> IdentifierRole
requestRoleDeleteFallbackId RequestRoleDelete
request)
      Proxy 'MkPermissionEditRole
-> SeldaResult ()
-> (SeldaResult () -> m (Union responses))
-> m (Union responses)
forall (p :: Permission) (m :: * -> *) (responses :: [*]) a.
(Typeable p, Applicative m,
 IsMember
   (WithStatus 403 (ErrorInsufficientPermission p)) responses) =>
Proxy p
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException403InsufficientPermission
        (forall {k} (t :: k). Proxy t
forall (t :: Permission). Proxy t
Proxy @MkPermissionEditRole)
        SeldaResult ()
seldaResult
        ((SeldaResult () -> m (Union responses)) -> m (Union responses))
-> (SeldaResult () -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult ()
seldaResultAfter403 ->
          WithStatus 500 ()
-> SeldaResult ()
-> (() -> m (Union responses))
-> m (Union responses)
forall r (m :: * -> *) (responses :: [*]) a.
(HasStatus r, MonadLogger m, IsMember r responses) =>
r
-> SeldaResult a
-> (a -> m (Union responses))
-> m (Union responses)
handleSeldaSomeException (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @500 ()) SeldaResult ()
seldaResultAfter403 ((() -> m (Union responses)) -> m (Union responses))
-> (() -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \() -> do
            Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Deleted role."
            WithStatus 200 ResponseRoleDelete -> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 200 ResponseRoleDelete -> m (Union responses))
-> WithStatus 200 ResponseRoleDelete -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ forall (k :: Nat) a. a -> WithStatus k a
WithStatus @200 MkResponseRoleDelete {responseRoleDeleteUnit :: ()
responseRoleDeleteUnit = ()}

createDesk ::
  ( MonadLogger m
  , MonadSeldaPool m
  , IsMember (WithStatus 201 ResponseDeskCreate) responses
  , IsMember (WithStatus 400 ErrorParseBodyJson) responses
  , IsMember (WithStatus 401 ErrorBearerAuth) responses
  , IsMember (WithStatus 403 (ErrorInsufficientPermission MkPermissionEditDesk)) responses
  , IsMember (WithStatus 404 (StaticText "Space not found.")) responses
  , IsMember (WithStatus 500 ()) responses
  ) =>
  AuthResult UserAuthenticated ->
  Either String RequestDeskCreate ->
  m (Union responses)
createDesk :: forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 201 ResponseDeskCreate) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionEditDesk))
   responses,
 IsMember
   (WithStatus 404 (StaticText "Space not found.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestDeskCreate -> m (Union responses)
createDesk AuthResult UserAuthenticated
auth Either String RequestDeskCreate
eitherRequest =
  AuthResult UserAuthenticated
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 401 ErrorBearerAuth) responses) =>
AuthResult a -> (a -> m (Union responses)) -> m (Union responses)
handleAuthBearer AuthResult UserAuthenticated
auth ((UserAuthenticated -> m (Union responses)) -> m (Union responses))
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \UserAuthenticated
authenticated ->
    Either String RequestDeskCreate
-> (RequestDeskCreate -> m (Union responses))
-> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses) =>
Either String a
-> (a -> m (Union responses)) -> m (Union responses)
handleBadRequestBody Either String RequestDeskCreate
eitherRequest ((RequestDeskCreate -> m (Union responses)) -> m (Union responses))
-> (RequestDeskCreate -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \RequestDeskCreate
request -> do
      Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Received request to create desk: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (RequestDeskCreate -> String
forall a. Show a => a -> String
show RequestDeskCreate
request)
      SeldaResult IdentifierDesk
seldaResult <- SeldaTransactionT m IdentifierDesk
-> m (SeldaResult IdentifierDesk)
forall a. SeldaTransactionT m a -> m (SeldaResult a)
forall (m :: * -> *) a.
MonadSeldaPool m =>
SeldaTransactionT m a -> m (SeldaResult a)
runSeldaTransactionT (SeldaTransactionT m IdentifierDesk
 -> m (SeldaResult IdentifierDesk))
-> SeldaTransactionT m IdentifierDesk
-> m (SeldaResult IdentifierDesk)
forall a b. (a -> b) -> a -> b
$ do
        IdentifierSpace
spaceIdentifier <-
          case RequestDeskCreate -> NameOrIdentifier NameSpace IdentifierSpace
requestDeskCreateSpace RequestDeskCreate
request of
            Identifier IdentifierSpace
spaceId -> IdentifierSpace -> SeldaTransactionT m IdentifierSpace
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IdentifierSpace
spaceId
            Name NameSpace
name -> NameSpace -> SeldaTransactionT m IdentifierSpace
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
NameSpace -> SeldaTransactionT m IdentifierSpace
spaceLookupId NameSpace
name
        SPermission 'MkPermissionEditDesk
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
forall (m :: * -> *) (p :: Permission).
(MonadLogger m, MonadSeldaPool m, Typeable p) =>
SPermission p
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
checkPermission
          SPermission 'MkPermissionEditDesk
SMkPermissionEditDesk
          (UserAuthenticated -> IdentifierUser
userAuthenticatedId UserAuthenticated
authenticated)
          IdentifierSpace
spaceIdentifier
        NameDesk
-> IdentifierSpace
-> Maybe LocationDesk
-> SeldaTransactionT m IdentifierDesk
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
NameDesk
-> IdentifierSpace
-> Maybe LocationDesk
-> SeldaTransactionT m IdentifierDesk
deskCreate (RequestDeskCreate -> NameDesk
requestDeskCreateName RequestDeskCreate
request) IdentifierSpace
spaceIdentifier (RequestDeskCreate -> Maybe LocationDesk
requestDeskCreateLocation RequestDeskCreate
request)
      Proxy SqlErrorMensamSpaceNotFound
-> WithStatus 404 (StaticText "Space not found.")
-> SeldaResult IdentifierDesk
-> (SeldaResult IdentifierDesk -> m (Union responses))
-> m (Union responses)
forall e r (m :: * -> *) (responses :: [*]) a.
(Exception e, HasStatus r, Applicative m, IsMember r responses) =>
Proxy e
-> r
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException
        (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SqlErrorMensamSpaceNotFound)
        (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @404 (StaticText "Space not found."
 -> WithStatus 404 (StaticText "Space not found."))
-> StaticText "Space not found."
-> WithStatus 404 (StaticText "Space not found.")
forall a b. (a -> b) -> a -> b
$ forall (text :: Symbol). StaticText text
MkStaticText @"Space not found.")
        SeldaResult IdentifierDesk
seldaResult
        ((SeldaResult IdentifierDesk -> m (Union responses))
 -> m (Union responses))
-> (SeldaResult IdentifierDesk -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult IdentifierDesk
seldaResultAfter404 ->
          Proxy 'MkPermissionEditDesk
-> SeldaResult IdentifierDesk
-> (SeldaResult IdentifierDesk -> m (Union responses))
-> m (Union responses)
forall (p :: Permission) (m :: * -> *) (responses :: [*]) a.
(Typeable p, Applicative m,
 IsMember
   (WithStatus 403 (ErrorInsufficientPermission p)) responses) =>
Proxy p
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException403InsufficientPermission
            (forall {k} (t :: k). Proxy t
forall (t :: Permission). Proxy t
Proxy @MkPermissionEditDesk)
            SeldaResult IdentifierDesk
seldaResultAfter404
            ((SeldaResult IdentifierDesk -> m (Union responses))
 -> m (Union responses))
-> (SeldaResult IdentifierDesk -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult IdentifierDesk
seldaResultAfter403 ->
              WithStatus 500 ()
-> SeldaResult IdentifierDesk
-> (IdentifierDesk -> m (Union responses))
-> m (Union responses)
forall r (m :: * -> *) (responses :: [*]) a.
(HasStatus r, MonadLogger m, IsMember r responses) =>
r
-> SeldaResult a
-> (a -> m (Union responses))
-> m (Union responses)
handleSeldaSomeException (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @500 ()) SeldaResult IdentifierDesk
seldaResultAfter403 ((IdentifierDesk -> m (Union responses)) -> m (Union responses))
-> (IdentifierDesk -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \IdentifierDesk
deskIdentifier -> do
                Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Created desk."
                WithStatus 201 ResponseDeskCreate -> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 201 ResponseDeskCreate -> m (Union responses))
-> WithStatus 201 ResponseDeskCreate -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ forall (k :: Nat) a. a -> WithStatus k a
WithStatus @201 MkResponseDeskCreate {responseDeskCreateId :: IdentifierDesk
responseDeskCreateId = IdentifierDesk
deskIdentifier}

deleteDesk ::
  ( MonadLogger m
  , MonadSeldaPool m
  , IsMember (WithStatus 200 ResponseDeskDelete) responses
  , IsMember (WithStatus 400 ErrorParseBodyJson) responses
  , IsMember (WithStatus 401 ErrorBearerAuth) responses
  , IsMember (WithStatus 403 (ErrorInsufficientPermission MkPermissionEditDesk)) responses
  , IsMember (WithStatus 404 (StaticText "Desk not found.")) responses
  , IsMember (WithStatus 500 ()) responses
  ) =>
  AuthResult UserAuthenticated ->
  Either String RequestDeskDelete ->
  m (Union responses)
deleteDesk :: forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseDeskDelete) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionEditDesk))
   responses,
 IsMember (WithStatus 404 (StaticText "Desk not found.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestDeskDelete -> m (Union responses)
deleteDesk AuthResult UserAuthenticated
auth Either String RequestDeskDelete
eitherRequest =
  AuthResult UserAuthenticated
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 401 ErrorBearerAuth) responses) =>
AuthResult a -> (a -> m (Union responses)) -> m (Union responses)
handleAuthBearer AuthResult UserAuthenticated
auth ((UserAuthenticated -> m (Union responses)) -> m (Union responses))
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \UserAuthenticated
authenticated ->
    Either String RequestDeskDelete
-> (RequestDeskDelete -> m (Union responses))
-> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses) =>
Either String a
-> (a -> m (Union responses)) -> m (Union responses)
handleBadRequestBody Either String RequestDeskDelete
eitherRequest ((RequestDeskDelete -> m (Union responses)) -> m (Union responses))
-> (RequestDeskDelete -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \RequestDeskDelete
request -> do
      Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Received request to delete desk: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (RequestDeskDelete -> String
forall a. Show a => a -> String
show RequestDeskDelete
request)
      SeldaResult ()
seldaResult <- SeldaTransactionT m () -> m (SeldaResult ())
forall a. SeldaTransactionT m a -> m (SeldaResult a)
forall (m :: * -> *) a.
MonadSeldaPool m =>
SeldaTransactionT m a -> m (SeldaResult a)
runSeldaTransactionT (SeldaTransactionT m () -> m (SeldaResult ()))
-> SeldaTransactionT m () -> m (SeldaResult ())
forall a b. (a -> b) -> a -> b
$ do
        Desk
desk <- IdentifierDesk -> SeldaTransactionT m Desk
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierDesk -> SeldaTransactionT m Desk
deskGetFromId (IdentifierDesk -> SeldaTransactionT m Desk)
-> IdentifierDesk -> SeldaTransactionT m Desk
forall a b. (a -> b) -> a -> b
$ RequestDeskDelete -> IdentifierDesk
requestDeskDeleteId RequestDeskDelete
request
        SPermission 'MkPermissionEditDesk
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
forall (m :: * -> *) (p :: Permission).
(MonadLogger m, MonadSeldaPool m, Typeable p) =>
SPermission p
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
checkPermission
          SPermission 'MkPermissionEditDesk
SMkPermissionEditDesk
          (UserAuthenticated -> IdentifierUser
userAuthenticatedId UserAuthenticated
authenticated)
          (Desk -> IdentifierSpace
deskSpace Desk
desk)
        IdentifierDesk -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierDesk -> SeldaTransactionT m ()
deskDelete (IdentifierDesk -> SeldaTransactionT m ())
-> IdentifierDesk -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Desk -> IdentifierDesk
deskId Desk
desk
      Proxy 'MkPermissionEditDesk
-> SeldaResult ()
-> (SeldaResult () -> m (Union responses))
-> m (Union responses)
forall (p :: Permission) (m :: * -> *) (responses :: [*]) a.
(Typeable p, Applicative m,
 IsMember
   (WithStatus 403 (ErrorInsufficientPermission p)) responses) =>
Proxy p
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException403InsufficientPermission
        (forall {k} (t :: k). Proxy t
forall (t :: Permission). Proxy t
Proxy @MkPermissionEditDesk)
        SeldaResult ()
seldaResult
        ((SeldaResult () -> m (Union responses)) -> m (Union responses))
-> (SeldaResult () -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult ()
seldaResultAfter403 ->
          Proxy SqlErrorMensamDeskNotFound
-> WithStatus 404 (StaticText "Desk not found.")
-> SeldaResult ()
-> (SeldaResult () -> m (Union responses))
-> m (Union responses)
forall e r (m :: * -> *) (responses :: [*]) a.
(Exception e, HasStatus r, Applicative m, IsMember r responses) =>
Proxy e
-> r
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException
            (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SqlErrorMensamDeskNotFound)
            (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @404 (StaticText "Desk not found."
 -> WithStatus 404 (StaticText "Desk not found."))
-> StaticText "Desk not found."
-> WithStatus 404 (StaticText "Desk not found.")
forall a b. (a -> b) -> a -> b
$ forall (text :: Symbol). StaticText text
MkStaticText @"Desk not found.")
            SeldaResult ()
seldaResultAfter403
            ((SeldaResult () -> m (Union responses)) -> m (Union responses))
-> (SeldaResult () -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult ()
seldaResultAfter404 ->
              WithStatus 500 ()
-> SeldaResult ()
-> (() -> m (Union responses))
-> m (Union responses)
forall r (m :: * -> *) (responses :: [*]) a.
(HasStatus r, MonadLogger m, IsMember r responses) =>
r
-> SeldaResult a
-> (a -> m (Union responses))
-> m (Union responses)
handleSeldaSomeException (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @500 ()) SeldaResult ()
seldaResultAfter404 ((() -> m (Union responses)) -> m (Union responses))
-> (() -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \() ->
                WithStatus 200 ResponseDeskDelete -> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 200 ResponseDeskDelete -> m (Union responses))
-> WithStatus 200 ResponseDeskDelete -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ forall (k :: Nat) a. a -> WithStatus k a
WithStatus @200 MkResponseDeskDelete {responseDeskDeleteUnit :: ()
responseDeskDeleteUnit = ()}

editDesk ::
  ( MonadLogger m
  , MonadSeldaPool m
  , IsMember (WithStatus 200 ResponseDeskEdit) responses
  , IsMember (WithStatus 400 ErrorParseBodyJson) responses
  , IsMember (WithStatus 401 ErrorBearerAuth) responses
  , IsMember (WithStatus 403 (ErrorInsufficientPermission MkPermissionEditDesk)) responses
  , IsMember (WithStatus 404 (StaticText "Desk not found.")) responses
  , IsMember (WithStatus 500 ()) responses
  ) =>
  AuthResult UserAuthenticated ->
  Either String RequestDeskEdit ->
  m (Union responses)
editDesk :: forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseDeskEdit) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionEditDesk))
   responses,
 IsMember (WithStatus 404 (StaticText "Desk not found.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestDeskEdit -> m (Union responses)
editDesk AuthResult UserAuthenticated
auth Either String RequestDeskEdit
eitherRequest =
  AuthResult UserAuthenticated
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 401 ErrorBearerAuth) responses) =>
AuthResult a -> (a -> m (Union responses)) -> m (Union responses)
handleAuthBearer AuthResult UserAuthenticated
auth ((UserAuthenticated -> m (Union responses)) -> m (Union responses))
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \UserAuthenticated
authenticated ->
    Either String RequestDeskEdit
-> (RequestDeskEdit -> m (Union responses)) -> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses) =>
Either String a
-> (a -> m (Union responses)) -> m (Union responses)
handleBadRequestBody Either String RequestDeskEdit
eitherRequest ((RequestDeskEdit -> m (Union responses)) -> m (Union responses))
-> (RequestDeskEdit -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \RequestDeskEdit
request -> do
      Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Received request to edit desk: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (RequestDeskEdit -> String
forall a. Show a => a -> String
show RequestDeskEdit
request)
      SeldaResult ()
seldaResult <- SeldaTransactionT m () -> m (SeldaResult ())
forall a. SeldaTransactionT m a -> m (SeldaResult a)
forall (m :: * -> *) a.
MonadSeldaPool m =>
SeldaTransactionT m a -> m (SeldaResult a)
runSeldaTransactionT (SeldaTransactionT m () -> m (SeldaResult ()))
-> SeldaTransactionT m () -> m (SeldaResult ())
forall a b. (a -> b) -> a -> b
$ do
        Desk
desk <- IdentifierDesk -> SeldaTransactionT m Desk
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierDesk -> SeldaTransactionT m Desk
deskGetFromId (IdentifierDesk -> SeldaTransactionT m Desk)
-> IdentifierDesk -> SeldaTransactionT m Desk
forall a b. (a -> b) -> a -> b
$ RequestDeskEdit -> IdentifierDesk
requestDeskEditId RequestDeskEdit
request
        SPermission 'MkPermissionEditDesk
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
forall (m :: * -> *) (p :: Permission).
(MonadLogger m, MonadSeldaPool m, Typeable p) =>
SPermission p
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
checkPermission
          SPermission 'MkPermissionEditDesk
SMkPermissionEditDesk
          (UserAuthenticated -> IdentifierUser
userAuthenticatedId UserAuthenticated
authenticated)
          (Desk -> IdentifierSpace
deskSpace Desk
desk)
        case RequestDeskEdit -> Updatable NameDesk
requestDeskEditName RequestDeskEdit
request of
          Updatable NameDesk
Preserve -> () -> SeldaTransactionT m ()
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Overwrite NameDesk
name -> IdentifierDesk -> NameDesk -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierDesk -> NameDesk -> SeldaTransactionT m ()
deskNameSet (RequestDeskEdit -> IdentifierDesk
requestDeskEditId RequestDeskEdit
request) NameDesk
name
        case RequestDeskEdit -> Updatable (Maybe LocationDesk)
requestDeskEditLocation RequestDeskEdit
request of
          Updatable (Maybe LocationDesk)
Preserve -> () -> SeldaTransactionT m ()
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Overwrite Maybe LocationDesk
location -> IdentifierDesk -> Maybe LocationDesk -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierDesk -> Maybe LocationDesk -> SeldaTransactionT m ()
deskLocationSet (RequestDeskEdit -> IdentifierDesk
requestDeskEditId RequestDeskEdit
request) Maybe LocationDesk
location
      Proxy SqlErrorMensamDeskNotFound
-> WithStatus 404 (StaticText "Desk not found.")
-> SeldaResult ()
-> (SeldaResult () -> m (Union responses))
-> m (Union responses)
forall e r (m :: * -> *) (responses :: [*]) a.
(Exception e, HasStatus r, Applicative m, IsMember r responses) =>
Proxy e
-> r
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException
        (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SqlErrorMensamDeskNotFound)
        (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @404 (StaticText "Desk not found."
 -> WithStatus 404 (StaticText "Desk not found."))
-> StaticText "Desk not found."
-> WithStatus 404 (StaticText "Desk not found.")
forall a b. (a -> b) -> a -> b
$ forall (text :: Symbol). StaticText text
MkStaticText @"Desk not found.")
        SeldaResult ()
seldaResult
        ((SeldaResult () -> m (Union responses)) -> m (Union responses))
-> (SeldaResult () -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult ()
seldaResultAfter404 ->
          Proxy 'MkPermissionEditDesk
-> SeldaResult ()
-> (SeldaResult () -> m (Union responses))
-> m (Union responses)
forall (p :: Permission) (m :: * -> *) (responses :: [*]) a.
(Typeable p, Applicative m,
 IsMember
   (WithStatus 403 (ErrorInsufficientPermission p)) responses) =>
Proxy p
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException403InsufficientPermission
            (forall {k} (t :: k). Proxy t
forall (t :: Permission). Proxy t
Proxy @MkPermissionEditDesk)
            SeldaResult ()
seldaResultAfter404
            ((SeldaResult () -> m (Union responses)) -> m (Union responses))
-> (SeldaResult () -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult ()
seldaResultAfter403 ->
              WithStatus 500 ()
-> SeldaResult ()
-> (() -> m (Union responses))
-> m (Union responses)
forall r (m :: * -> *) (responses :: [*]) a.
(HasStatus r, MonadLogger m, IsMember r responses) =>
r
-> SeldaResult a
-> (a -> m (Union responses))
-> m (Union responses)
handleSeldaSomeException (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @500 ()) SeldaResult ()
seldaResultAfter403 ((() -> m (Union responses)) -> m (Union responses))
-> (() -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \() -> do
                Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Edited space."
                WithStatus 200 ResponseDeskEdit -> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 200 ResponseDeskEdit -> m (Union responses))
-> WithStatus 200 ResponseDeskEdit -> m (Union responses)
forall a b. (a -> b) -> a -> b
$
                  forall (k :: Nat) a. a -> WithStatus k a
WithStatus @200
                    MkResponseDeskEdit {responseDeskEditUnit :: ()
responseDeskEditUnit = ()}

listDesks ::
  ( MonadLogger m
  , MonadSeldaPool m
  , IsMember (WithStatus 200 ResponseDeskList) responses
  , IsMember (WithStatus 400 ErrorParseBodyJson) responses
  , IsMember (WithStatus 401 ErrorBearerAuth) responses
  , IsMember (WithStatus 403 (ErrorInsufficientPermission MkPermissionViewSpace)) responses
  , IsMember (WithStatus 404 (StaticText "Space not found.")) responses
  , IsMember (WithStatus 500 ()) responses
  ) =>
  AuthResult UserAuthenticated ->
  Either String RequestDeskList ->
  m (Union responses)
listDesks :: forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseDeskList) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionViewSpace))
   responses,
 IsMember
   (WithStatus 404 (StaticText "Space not found.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestDeskList -> m (Union responses)
listDesks AuthResult UserAuthenticated
auth Either String RequestDeskList
eitherRequest =
  AuthResult UserAuthenticated
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 401 ErrorBearerAuth) responses) =>
AuthResult a -> (a -> m (Union responses)) -> m (Union responses)
handleAuthBearer AuthResult UserAuthenticated
auth ((UserAuthenticated -> m (Union responses)) -> m (Union responses))
-> (UserAuthenticated -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \UserAuthenticated
authenticated ->
    Either String RequestDeskList
-> (RequestDeskList -> m (Union responses)) -> m (Union responses)
forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses) =>
Either String a
-> (a -> m (Union responses)) -> m (Union responses)
handleBadRequestBody Either String RequestDeskList
eitherRequest ((RequestDeskList -> m (Union responses)) -> m (Union responses))
-> (RequestDeskList -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \RequestDeskList
request -> do
      Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Received request to list desks: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (RequestDeskList -> String
forall a. Show a => a -> String
show RequestDeskList
request)
      SeldaResult [DeskWithInfo]
seldaResult <- SeldaTransactionT m [DeskWithInfo]
-> m (SeldaResult [DeskWithInfo])
forall a. SeldaTransactionT m a -> m (SeldaResult a)
forall (m :: * -> *) a.
MonadSeldaPool m =>
SeldaTransactionT m a -> m (SeldaResult a)
runSeldaTransactionT (SeldaTransactionT m [DeskWithInfo]
 -> m (SeldaResult [DeskWithInfo]))
-> SeldaTransactionT m [DeskWithInfo]
-> m (SeldaResult [DeskWithInfo])
forall a b. (a -> b) -> a -> b
$ do
        IdentifierSpace
spaceIdentifier <-
          case RequestDeskList -> NameOrIdentifier NameSpace IdentifierSpace
requestDeskListSpace RequestDeskList
request of
            Identifier IdentifierSpace
spaceId -> IdentifierSpace -> SeldaTransactionT m Space
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> SeldaTransactionT m Space
spaceGetFromId IdentifierSpace
spaceId SeldaTransactionT m Space
-> SeldaTransactionT m IdentifierSpace
-> SeldaTransactionT m IdentifierSpace
forall a b.
SeldaTransactionT m a
-> SeldaTransactionT m b -> SeldaTransactionT m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IdentifierSpace -> SeldaTransactionT m IdentifierSpace
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IdentifierSpace
spaceId
            Name NameSpace
spaceName -> NameSpace -> SeldaTransactionT m IdentifierSpace
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
NameSpace -> SeldaTransactionT m IdentifierSpace
spaceLookupId NameSpace
spaceName
        SPermission 'MkPermissionViewSpace
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
forall (m :: * -> *) (p :: Permission).
(MonadLogger m, MonadSeldaPool m, Typeable p) =>
SPermission p
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
checkPermission
          SPermission 'MkPermissionViewSpace
SMkPermissionViewSpace
          (UserAuthenticated -> IdentifierUser
userAuthenticatedId UserAuthenticated
authenticated)
          IdentifierSpace
spaceIdentifier
        [Desk]
desks <- IdentifierSpace -> IdentifierUser -> SeldaTransactionT m [Desk]
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace -> IdentifierUser -> SeldaTransactionT m [Desk]
deskList IdentifierSpace
spaceIdentifier (UserAuthenticated -> IdentifierUser
userAuthenticatedId UserAuthenticated
authenticated)
        [Desk]
-> (Desk -> SeldaTransactionT m DeskWithInfo)
-> SeldaTransactionT m [DeskWithInfo]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Desk]
desks ((Desk -> SeldaTransactionT m DeskWithInfo)
 -> SeldaTransactionT m [DeskWithInfo])
-> (Desk -> SeldaTransactionT m DeskWithInfo)
-> SeldaTransactionT m [DeskWithInfo]
forall a b. (a -> b) -> a -> b
$ \Desk
desk -> do
          [Reservation]
reservations <-
            IdentifierDesk
-> IntervalUnbounded UTCTime -> SeldaTransactionT m [Reservation]
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierDesk
-> IntervalUnbounded UTCTime -> SeldaTransactionT m [Reservation]
reservationList
              (Desk -> IdentifierDesk
deskId Desk
desk)
              (RequestDeskList -> IntervalUnbounded UTCTime
requestDeskListTimeWindow RequestDeskList
request)
          DeskWithInfo -> SeldaTransactionT m DeskWithInfo
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            MkDeskWithInfo
              { deskWithInfoDesk :: Desk
deskWithInfoDesk = Desk
desk
              , deskWithInfoReservations :: [Reservation]
deskWithInfoReservations = [Reservation]
reservations
              }
      Proxy SqlErrorMensamSpaceNotFound
-> WithStatus 404 (StaticText "Space not found.")
-> SeldaResult [DeskWithInfo]
-> (SeldaResult [DeskWithInfo] -> m (Union responses))
-> m (Union responses)
forall e r (m :: * -> *) (responses :: [*]) a.
(Exception e, HasStatus r, Applicative m, IsMember r responses) =>
Proxy e
-> r
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException
        (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SqlErrorMensamSpaceNotFound)
        (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @404 (StaticText "Space not found."
 -> WithStatus 404 (StaticText "Space not found."))
-> StaticText "Space not found."
-> WithStatus 404 (StaticText "Space not found.")
forall a b. (a -> b) -> a -> b
$ forall (text :: Symbol). StaticText text
MkStaticText @"Space not found.")
        SeldaResult [DeskWithInfo]
seldaResult
        ((SeldaResult [DeskWithInfo] -> m (Union responses))
 -> m (Union responses))
-> (SeldaResult [DeskWithInfo] -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult [DeskWithInfo]
seldaResultAfter404 ->
          Proxy 'MkPermissionViewSpace
-> SeldaResult [DeskWithInfo]
-> (SeldaResult [DeskWithInfo] -> m (Union responses))
-> m (Union responses)
forall (p :: Permission) (m :: * -> *) (responses :: [*]) a.
(Typeable p, Applicative m,
 IsMember
   (WithStatus 403 (ErrorInsufficientPermission p)) responses) =>
Proxy p
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException403InsufficientPermission
            (forall {k} (t :: k). Proxy t
forall (t :: Permission). Proxy t
Proxy @MkPermissionViewSpace)
            SeldaResult [DeskWithInfo]
seldaResultAfter404
            ((SeldaResult [DeskWithInfo] -> m (Union responses))
 -> m (Union responses))
-> (SeldaResult [DeskWithInfo] -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult [DeskWithInfo]
seldaResultAfter403 ->
              WithStatus 500 ()
-> SeldaResult [DeskWithInfo]
-> ([DeskWithInfo] -> m (Union responses))
-> m (Union responses)
forall r (m :: * -> *) (responses :: [*]) a.
(HasStatus r, MonadLogger m, IsMember r responses) =>
r
-> SeldaResult a
-> (a -> m (Union responses))
-> m (Union responses)
handleSeldaSomeException (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @500 ()) SeldaResult [DeskWithInfo]
seldaResultAfter403 (([DeskWithInfo] -> m (Union responses)) -> m (Union responses))
-> ([DeskWithInfo] -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \[DeskWithInfo]
desksWithInfo -> do
                Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Listed desks."
                WithStatus 200 ResponseDeskList -> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 200 ResponseDeskList -> m (Union responses))
-> WithStatus 200 ResponseDeskList -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ forall (k :: Nat) a. a -> WithStatus k a
WithStatus @200 MkResponseDeskList {responseDeskListDesks :: [DeskWithInfo]
responseDeskListDesks = [DeskWithInfo]
desksWithInfo}

handleBadRequestBody ::
  ( MonadLogger m
  , IsMember (WithStatus 400 ErrorParseBodyJson) responses
  ) =>
  Either String a ->
  (a -> m (Union responses)) ->
  m (Union responses)
handleBadRequestBody :: forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses) =>
Either String a
-> (a -> m (Union responses)) -> m (Union responses)
handleBadRequestBody Either String a
parsedRequestBody a -> m (Union responses)
handler' =
  -- TODO: Rename arguments `handler'` to `handler`
  case Either String a
parsedRequestBody of
    Right a
a -> a -> m (Union responses)
handler' a
a
    Left String
err -> WithStatus 400 ErrorParseBodyJson -> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 400 ErrorParseBodyJson -> m (Union responses))
-> WithStatus 400 ErrorParseBodyJson -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ forall (k :: Nat) a. a -> WithStatus k a
WithStatus @400 (ErrorParseBodyJson -> WithStatus 400 ErrorParseBodyJson)
-> ErrorParseBodyJson -> WithStatus 400 ErrorParseBodyJson
forall a b. (a -> b) -> a -> b
$ String -> ErrorParseBodyJson
MkErrorParseBodyJson String
err

handleBadRequestBodyJpeg ::
  ( MonadLogger m
  , IsMember (WithStatus 400 ErrorParseBodyJpeg) responses
  ) =>
  Either String a ->
  (a -> m (Union responses)) ->
  m (Union responses)
handleBadRequestBodyJpeg :: forall (m :: * -> *) (responses :: [*]) a.
(MonadLogger m,
 IsMember (WithStatus 400 ErrorParseBodyJpeg) responses) =>
Either String a
-> (a -> m (Union responses)) -> m (Union responses)
handleBadRequestBodyJpeg Either String a
parsedRequestBody a -> m (Union responses)
handler' =
  -- TODO: Rename arguments `handler'` to `handler`
  case Either String a
parsedRequestBody of
    Right a
a -> a -> m (Union responses)
handler' a
a
    Left String
err -> WithStatus 400 ErrorParseBodyJpeg -> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 400 ErrorParseBodyJpeg -> m (Union responses))
-> WithStatus 400 ErrorParseBodyJpeg -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ forall (k :: Nat) a. a -> WithStatus k a
WithStatus @400 (ErrorParseBodyJpeg -> WithStatus 400 ErrorParseBodyJpeg)
-> ErrorParseBodyJpeg -> WithStatus 400 ErrorParseBodyJpeg
forall a b. (a -> b) -> a -> b
$ String -> ErrorParseBodyJpeg
MkErrorParseBodyJpeg String
err

handleSeldaException403InsufficientPermission ::
  forall (p :: Permission) m responses a.
  ( Typeable p
  , Applicative m
  , IsMember (WithStatus 403 (ErrorInsufficientPermission p)) responses
  ) =>
  Proxy p ->
  SeldaResult a ->
  (SeldaResult a -> m (Union responses)) ->
  m (Union responses)
handleSeldaException403InsufficientPermission :: forall (p :: Permission) (m :: * -> *) (responses :: [*]) a.
(Typeable p, Applicative m,
 IsMember
   (WithStatus 403 (ErrorInsufficientPermission p)) responses) =>
Proxy p
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException403InsufficientPermission Proxy p
Proxy =
  Proxy (SqlErrorMensamPermissionNotSatisfied p)
-> WithStatus 403 (ErrorInsufficientPermission p)
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
forall e r (m :: * -> *) (responses :: [*]) a.
(Exception e, HasStatus r, Applicative m, IsMember r responses) =>
Proxy e
-> r
-> SeldaResult a
-> (SeldaResult a -> m (Union responses))
-> m (Union responses)
handleSeldaException
    (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(SqlErrorMensamPermissionNotSatisfied p))
    (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @403 (ErrorInsufficientPermission p
 -> WithStatus 403 (ErrorInsufficientPermission p))
-> ErrorInsufficientPermission p
-> WithStatus 403 (ErrorInsufficientPermission p)
forall a b. (a -> b) -> a -> b
$ forall (p :: Permission). ErrorInsufficientPermission p
MkErrorInsufficientPermission @p)