module Mensam.Client.UI where
import Mensam.API.Aeson
import Mensam.API.Data.Reservation
import Mensam.API.Data.Space
import Mensam.API.Order
import Mensam.API.Route.Api.Reservation qualified as Route.Reservation
import Mensam.API.Route.Api.Space qualified as Route.Space
import Mensam.API.Route.Api.User qualified as Route.User
import Mensam.Client.Application
import Mensam.Client.Application.Event.Class
import Mensam.Client.Application.MensamClient.Class
import Mensam.Client.OrphanInstances
import Mensam.Client.UI.Brick.AttrMap
import Mensam.Client.UI.Brick.Events
import Mensam.Client.UI.Brick.Names
import Mensam.Client.UI.Brick.State
import Mensam.Client.UI.Desks
import Mensam.Client.UI.Login
import Mensam.Client.UI.Menu
import Mensam.Client.UI.Register
import Mensam.Client.UI.Spaces
import Brick
import Brick.BChan
import Brick.Widgets.Border
import Brick.Widgets.Center
import Brick.Widgets.List
import Control.Monad.IO.Class
import Data.SOP
import Data.Sequence qualified as Seq
import Data.Text qualified as T
import Data.Time qualified as T
import Graphics.Vty
import Graphics.Vty.Platform.Unix
import Lens.Micro.Platform
import Servant
ui :: IO ()
ui :: IO ()
ui = do
BChan ClientEvent
chan <- Int -> IO (BChan ClientEvent)
forall a. Int -> IO (BChan a)
newBChan Int
10
BChan ClientEvent -> ApplicationT IO () -> IO ()
forall (m :: * -> *) a.
MonadIO m =>
BChan ClientEvent -> ApplicationT m a -> m a
runApplicationT BChan ClientEvent
chan (ApplicationT IO () -> IO ()) -> ApplicationT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> ApplicationT IO ()
forall a. a -> ApplicationT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
TimeZone
tz <- IO TimeZone -> IO TimeZone
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO TimeZone
T.getCurrentTimeZone
let
app :: App ClientState ClientEvent ClientName
app :: App ClientState ClientEvent ClientName
app =
App
{ appDraw :: ClientState -> [Widget ClientName]
appDraw = ClientState -> [Widget ClientName]
draw
, appChooseCursor :: ClientState
-> [CursorLocation ClientName] -> Maybe (CursorLocation ClientName)
appChooseCursor = ClientState
-> [CursorLocation ClientName] -> Maybe (CursorLocation ClientName)
forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
showFirstCursor
, appHandleEvent :: BrickEvent ClientName ClientEvent
-> EventM ClientName ClientState ()
appHandleEvent = BChan ClientEvent
-> BrickEvent ClientName ClientEvent
-> EventM ClientName ClientState ()
handleEvent BChan ClientEvent
chan
, appStartEvent :: EventM ClientName ClientState ()
appStartEvent = () -> EventM ClientName ClientState ()
forall a. a -> EventM ClientName ClientState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
, appAttrMap :: ClientState -> AttrMap
appAttrMap = AttrMap -> ClientState -> AttrMap
forall a b. a -> b -> a
const AttrMap
attrsDefault
}
initialState :: ClientState
initialState :: ClientState
initialState =
MkClientState
{ _clientStateScreenState :: ClientScreenState
_clientStateScreenState = ScreenLoginState -> ClientScreenState
ClientScreenStateLogin (ScreenLoginState -> ClientScreenState)
-> ScreenLoginState -> ClientScreenState
forall a b. (a -> b) -> a -> b
$ MkScreenLoginState {_screenStateLoginForm :: Form LoginInfo ClientEvent ClientName
_screenStateLoginForm = Form LoginInfo ClientEvent ClientName
forall e. Form LoginInfo e ClientName
loginFormInitial}
, _clientStatePopup :: Maybe Text
_clientStatePopup = Maybe Text
forall a. Maybe a
Nothing
, _clientStateJwt :: Maybe Jwt
_clientStateJwt = Maybe Jwt
forall a. Maybe a
Nothing
, _clientStateTimezone :: TimeZone
_clientStateTimezone = TimeZone
tz
}
initVty :: IO Vty
initVty = VtyUserConfig -> IO Vty
mkVty VtyUserConfig
defaultConfig
Vty
vty <- IO Vty
initVty
ClientState
_finalState <- Vty
-> IO Vty
-> Maybe (BChan ClientEvent)
-> App ClientState ClientEvent ClientName
-> ClientState
-> IO ClientState
forall n e s.
Ord n =>
Vty -> IO Vty -> Maybe (BChan e) -> App s e n -> s -> IO s
customMain Vty
vty IO Vty
initVty (BChan ClientEvent -> Maybe (BChan ClientEvent)
forall a. a -> Maybe a
Just BChan ClientEvent
chan) App ClientState ClientEvent ClientName
app ClientState
initialState
() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
draw :: ClientState -> [Widget ClientName]
draw :: ClientState -> [Widget ClientName]
draw MkClientState {ClientScreenState
_clientStateScreenState :: ClientState -> ClientScreenState
_clientStateScreenState :: ClientScreenState
_clientStateScreenState, Maybe Text
_clientStatePopup :: ClientState -> Maybe Text
_clientStatePopup :: Maybe Text
_clientStatePopup} =
case Maybe Text
_clientStatePopup of
Maybe Text
Nothing -> ClientScreenState -> [Widget ClientName]
drawScreen ClientScreenState
_clientStateScreenState
Just Text
popup ->
let
foreground :: Widget ClientName
foreground =
(AttrMap -> AttrMap) -> Widget ClientName -> Widget ClientName
forall n. (AttrMap -> AttrMap) -> Widget n -> Widget n
updateAttrMap (AttrMap -> AttrMap -> AttrMap
forall a b. a -> b -> a
const AttrMap
attrsForeground) (Widget ClientName -> Widget ClientName)
-> Widget ClientName -> Widget ClientName
forall a b. (a -> b) -> a -> b
$
ClientName -> Location -> Widget ClientName -> Widget ClientName
forall n. n -> Location -> Widget n -> Widget n
putCursor ClientName
ClientNamePopupButton ((Int, Int) -> Location
Location (Int
0, Int
0)) (Widget ClientName -> Widget ClientName)
-> Widget ClientName -> Widget ClientName
forall a b. (a -> b) -> a -> b
$
Int -> Widget ClientName -> Widget ClientName
forall n. Int -> Widget n -> Widget n
hLimitPercent Int
60 (Widget ClientName -> Widget ClientName)
-> Widget ClientName -> Widget ClientName
forall a b. (a -> b) -> a -> b
$
Int -> Widget ClientName -> Widget ClientName
forall n. Int -> Widget n -> Widget n
vLimitPercent Int
60 (Widget ClientName -> Widget ClientName)
-> Widget ClientName -> Widget ClientName
forall a b. (a -> b) -> a -> b
$
[Widget ClientName] -> Widget ClientName
forall n. [Widget n] -> Widget n
vBox
[ Widget ClientName -> Widget ClientName -> Widget ClientName
forall n. Widget n -> Widget n -> Widget n
borderWithLabel (Text -> Widget ClientName
forall n. Text -> Widget n
txt Text
"Error") (Widget ClientName -> Widget ClientName)
-> Widget ClientName -> Widget ClientName
forall a b. (a -> b) -> a -> b
$ Text -> Widget ClientName
forall n. Text -> Widget n
txtWrap Text
popup
, Padding -> Widget ClientName -> Widget ClientName
forall n. Padding -> Widget n -> Widget n
padLeft Padding
Max (Widget ClientName -> Widget ClientName)
-> Widget ClientName -> Widget ClientName
forall a b. (a -> b) -> a -> b
$ Text -> Widget ClientName
forall n. Text -> Widget n
txt Text
" OK (Enter) "
]
backgrounds :: [Widget ClientName]
backgrounds = ((AttrMap -> AttrMap) -> Widget ClientName -> Widget ClientName
forall n. (AttrMap -> AttrMap) -> Widget n -> Widget n
updateAttrMap (AttrMap -> AttrMap -> AttrMap
forall a b. a -> b -> a
const AttrMap
attrsBackground) (Widget ClientName -> Widget ClientName)
-> [Widget ClientName] -> [Widget ClientName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClientScreenState -> [Widget ClientName]
drawScreen ClientScreenState
_clientStateScreenState)
in
Widget ClientName -> Widget ClientName
forall n. Widget n -> Widget n
centerLayer Widget ClientName
foreground Widget ClientName -> [Widget ClientName] -> [Widget ClientName]
forall a. a -> [a] -> [a]
: [Widget ClientName]
backgrounds
where
drawScreen :: ClientScreenState -> [Widget ClientName]
drawScreen :: ClientScreenState -> [Widget ClientName]
drawScreen = \case
ClientScreenStateLogin ScreenLoginState
s -> ScreenLoginState -> [Widget ClientName]
loginDraw ScreenLoginState
s
ClientScreenStateRegister ScreenRegisterState
s -> ScreenRegisterState -> [Widget ClientName]
registerDraw ScreenRegisterState
s
ClientScreenStateSpaces ScreenSpacesState
s -> ScreenSpacesState -> [Widget ClientName]
spacesDraw ScreenSpacesState
s
ClientScreenStateDesks ScreenDesksState
s -> ScreenDesksState -> [Widget ClientName]
desksDraw ScreenDesksState
s
ClientScreenStateMenu ScreenMenuState
s -> ScreenMenuState -> [Widget ClientName]
menuDraw ScreenMenuState
s
handleEvent :: BChan ClientEvent -> BrickEvent ClientName ClientEvent -> EventM ClientName ClientState ()
handleEvent :: BChan ClientEvent
-> BrickEvent ClientName ClientEvent
-> EventM ClientName ClientState ()
handleEvent BChan ClientEvent
chan = \case
AppEvent ClientEvent
event ->
case ClientEvent
event of
ClientEvent
ClientEventExit -> do
ClientState
clientState <- EventM ClientName ClientState ClientState
forall s (m :: * -> *). MonadState s m => m s
get
case ClientState
clientState ClientState
-> Getting (Maybe Jwt) ClientState (Maybe Jwt) -> Maybe Jwt
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Jwt) ClientState (Maybe Jwt)
Lens' ClientState (Maybe Jwt)
clientStateJwt of
Just Jwt
_ -> do
BChan ClientEvent
-> ApplicationT (EventM ClientName ClientState) ()
-> EventM ClientName ClientState ()
forall (m :: * -> *) a.
MonadIO m =>
BChan ClientEvent -> ApplicationT m a -> m a
runApplicationT BChan ClientEvent
chan (ApplicationT (EventM ClientName ClientState) ()
-> EventM ClientName ClientState ())
-> ApplicationT (EventM ClientName ClientState) ()
-> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ ClientEvent -> ApplicationT (EventM ClientName ClientState) ()
forall (m :: * -> *). MonadEvent m => ClientEvent -> m ()
sendEvent ClientEvent
ClientEventSendRequestLogout
BChan ClientEvent
-> ApplicationT (EventM ClientName ClientState) ()
-> EventM ClientName ClientState ()
forall (m :: * -> *) a.
MonadIO m =>
BChan ClientEvent -> ApplicationT m a -> m a
runApplicationT BChan ClientEvent
chan (ApplicationT (EventM ClientName ClientState) ()
-> EventM ClientName ClientState ())
-> ApplicationT (EventM ClientName ClientState) ()
-> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ ClientEvent -> ApplicationT (EventM ClientName ClientState) ()
forall (m :: * -> *). MonadEvent m => ClientEvent -> m ()
sendEvent ClientEvent
ClientEventExit
Maybe Jwt
Nothing -> EventM ClientName ClientState ()
forall n s. EventM n s ()
halt
ClientEvent
ClientEventSwitchToScreenLogin -> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ClientState -> ClientState) -> EventM ClientName ClientState ())
-> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ \ClientState
s -> ClientState
s {_clientStateScreenState = ClientScreenStateLogin $ MkScreenLoginState loginFormInitial}
ClientEvent
ClientEventSwitchToScreenRegister -> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ClientState -> ClientState) -> EventM ClientName ClientState ())
-> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ \ClientState
s -> ClientState
s {_clientStateScreenState = ClientScreenStateRegister $ MkScreenRegisterState registerFormInitial}
ClientEvent
ClientEventSwitchToScreenSpaces -> do
ClientState
clientState <- EventM ClientName ClientState ClientState
forall s (m :: * -> *). MonadState s m => m s
get
case ClientState
clientState ClientState
-> Getting (Maybe Jwt) ClientState (Maybe Jwt) -> Maybe Jwt
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Jwt) ClientState (Maybe Jwt)
Lens' ClientState (Maybe Jwt)
clientStateJwt of
Just Jwt
jwt -> do
Either
ClientError
(Union
'[WithStatus 200 ResponseSpaceList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()])
result <-
BChan ClientEvent
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 200 ResponseSpaceList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()]))
-> EventM
ClientName
ClientState
(Either
ClientError
(Union
'[WithStatus 200 ResponseSpaceList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()]))
forall (m :: * -> *) a.
MonadIO m =>
BChan ClientEvent -> ApplicationT m a -> m a
runApplicationT BChan ClientEvent
chan (ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 200 ResponseSpaceList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()]))
-> EventM
ClientName
ClientState
(Either
ClientError
(Union
'[WithStatus 200 ResponseSpaceList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()])))
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 200 ResponseSpaceList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()]))
-> EventM
ClientName
ClientState
(Either
ClientError
(Union
'[WithStatus 200 ResponseSpaceList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()]))
forall a b. (a -> b) -> a -> b
$
ClientM
(Union
'[WithStatus 200 ResponseSpaceList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()])
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 200 ResponseSpaceList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()]))
forall a.
ClientM a
-> ApplicationT
(EventM ClientName ClientState) (Either ClientError a)
forall (m :: * -> *) a.
MonadMensamClient m =>
ClientM a -> m (Either ClientError a)
mensamCall (ClientM
(Union
'[WithStatus 200 ResponseSpaceList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()])
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 200 ResponseSpaceList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()])))
-> ClientM
(Union
'[WithStatus 200 ResponseSpaceList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()])
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 200 ResponseSpaceList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()]))
forall a b. (a -> b) -> a -> b
$
AuthData '[JWTWithSession]
-> RequestSpaceList
-> ClientM
(Union
'[WithStatus 200 ResponseSpaceList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()])
endpointSpaceList
(Jwt -> AuthData '[JWTWithSession]
forall (auths :: [*]). Jwt -> AuthData (JWTWithSession : auths)
DataJWTWithSession Jwt
jwt)
(OrderByCategories SpaceOrderCategory
-> Maybe Bool -> RequestSpaceList
Route.Space.MkRequestSpaceList ([OrderByCategory SpaceOrderCategory]
-> OrderByCategories SpaceOrderCategory
forall a. [OrderByCategory a] -> OrderByCategories a
MkOrderByCategories []) Maybe Bool
forall a. Maybe a
Nothing)
case Either
ClientError
(Union
'[WithStatus 200 ResponseSpaceList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()])
result of
Right (Z (I (WithStatus @200 (Route.Space.MkResponseSpaceList [SpaceListSpace]
spaceListSpaces)))) -> do
let xs :: [Space]
xs =
[SpaceListSpace]
spaceListSpaces [SpaceListSpace] -> (SpaceListSpace -> Space) -> [Space]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \SpaceListSpace
space ->
MkSpace
{ spaceId :: IdentifierSpace
spaceId = SpaceListSpace -> IdentifierSpace
Route.Space.spaceListSpaceId SpaceListSpace
space
, spaceName :: NameSpace
spaceName = SpaceListSpace -> NameSpace
Route.Space.spaceListSpaceName SpaceListSpace
space
, spaceTimezone :: TZLabel
spaceTimezone = SpaceListSpace -> TZLabel
Route.Space.spaceListSpaceTimezone SpaceListSpace
space
, spaceOwner :: IdentifierUser
spaceOwner = SpaceListSpace -> IdentifierUser
Route.Space.spaceListSpaceOwner SpaceListSpace
space
}
let l :: GenericList ClientName Seq Space
l = Seq Space
-> Maybe Int
-> GenericList ClientName Seq Space
-> GenericList ClientName Seq Space
forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
t e -> Maybe Int -> GenericList n t e -> GenericList n t e
listReplace ([Space] -> Seq Space
forall a. [a] -> Seq a
Seq.fromList [Space]
xs) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0) GenericList ClientName Seq Space
spacesListInitial
(ClientState -> ClientState) -> EventM ClientName ClientState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ClientState -> ClientState) -> EventM ClientName ClientState ())
-> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ \ClientState
s -> ClientState
s {_clientStateScreenState = ClientScreenStateSpaces (MkScreenSpacesState l False Nothing)}
Either
ClientError
(Union
'[WithStatus 200 ResponseSpaceList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()])
err -> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ClientState -> ClientState) -> EventM ClientName ClientState ())
-> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ \ClientState
s -> ClientState
s {_clientStatePopup = Just $ T.pack $ show err}
Maybe Jwt
Nothing -> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ClientState -> ClientState) -> EventM ClientName ClientState ())
-> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ \ClientState
s -> ClientState
s {_clientStatePopup = Just "Error: Not logged in."}
ClientEventSwitchToScreenDesks Space
space -> do
ClientState
clientState <- EventM ClientName ClientState ClientState
forall s (m :: * -> *). MonadState s m => m s
get
case ClientState
clientState ClientState
-> Getting (Maybe Jwt) ClientState (Maybe Jwt) -> Maybe Jwt
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Jwt) ClientState (Maybe Jwt)
Lens' ClientState (Maybe Jwt)
clientStateJwt of
Just Jwt
jwt -> do
Either
ClientError
(Union
'[WithStatus 200 ResponseDeskList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
result <-
BChan ClientEvent
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 200 ResponseDeskList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
WithStatus 404 (StaticText "Space not found."),
WithStatus 500 ()]))
-> EventM
ClientName
ClientState
(Either
ClientError
(Union
'[WithStatus 200 ResponseDeskList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
WithStatus 404 (StaticText "Space not found."),
WithStatus 500 ()]))
forall (m :: * -> *) a.
MonadIO m =>
BChan ClientEvent -> ApplicationT m a -> m a
runApplicationT BChan ClientEvent
chan (ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 200 ResponseDeskList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
WithStatus 404 (StaticText "Space not found."),
WithStatus 500 ()]))
-> EventM
ClientName
ClientState
(Either
ClientError
(Union
'[WithStatus 200 ResponseDeskList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
WithStatus 404 (StaticText "Space not found."),
WithStatus 500 ()])))
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 200 ResponseDeskList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
WithStatus 404 (StaticText "Space not found."),
WithStatus 500 ()]))
-> EventM
ClientName
ClientState
(Either
ClientError
(Union
'[WithStatus 200 ResponseDeskList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
WithStatus 404 (StaticText "Space not found."),
WithStatus 500 ()]))
forall a b. (a -> b) -> a -> b
$
ClientM
(Union
'[WithStatus 200 ResponseDeskList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 200 ResponseDeskList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
WithStatus 404 (StaticText "Space not found."),
WithStatus 500 ()]))
forall a.
ClientM a
-> ApplicationT
(EventM ClientName ClientState) (Either ClientError a)
forall (m :: * -> *) a.
MonadMensamClient m =>
ClientM a -> m (Either ClientError a)
mensamCall (ClientM
(Union
'[WithStatus 200 ResponseDeskList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 200 ResponseDeskList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
WithStatus 404 (StaticText "Space not found."),
WithStatus 500 ()])))
-> ClientM
(Union
'[WithStatus 200 ResponseDeskList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 200 ResponseDeskList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
WithStatus 404 (StaticText "Space not found."),
WithStatus 500 ()]))
forall a b. (a -> b) -> a -> b
$
AuthData '[JWTWithSession]
-> RequestDeskList
-> ClientM
(Union
'[WithStatus 200 ResponseDeskList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
endpointDeskList
(Jwt -> AuthData '[JWTWithSession]
forall (auths :: [*]). Jwt -> AuthData (JWTWithSession : auths)
DataJWTWithSession Jwt
jwt)
( Route.Space.MkRequestDeskList
{ requestDeskListSpace :: NameOrIdentifier NameSpace IdentifierSpace
Route.Space.requestDeskListSpace = IdentifierSpace -> NameOrIdentifier NameSpace IdentifierSpace
forall name identifier.
identifier -> NameOrIdentifier name identifier
Identifier (IdentifierSpace -> NameOrIdentifier NameSpace IdentifierSpace)
-> IdentifierSpace -> NameOrIdentifier NameSpace IdentifierSpace
forall a b. (a -> b) -> a -> b
$ Space -> IdentifierSpace
spaceId Space
space
, requestDeskListTimeWindow :: IntervalUnbounded UTCTime
Route.Space.requestDeskListTimeWindow = IntervalUnbounded UTCTime
forall a. IntervalUnbounded a
unbounded
}
)
case Either
ClientError
(Union
'[WithStatus 200 ResponseDeskList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
result of
Right (Z (I (WithStatus @200 (Route.Space.MkResponseDeskList [DeskWithInfo]
desks)))) -> do
let l :: GenericList ClientName Seq DeskWithInfo
l = Seq DeskWithInfo
-> Maybe Int
-> GenericList ClientName Seq DeskWithInfo
-> GenericList ClientName Seq DeskWithInfo
forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
t e -> Maybe Int -> GenericList n t e -> GenericList n t e
listReplace ([DeskWithInfo] -> Seq DeskWithInfo
forall a. [a] -> Seq a
Seq.fromList [DeskWithInfo]
desks) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0) GenericList ClientName Seq DeskWithInfo
desksListInitial
Day
currentDay <- UTCTime -> Day
T.utctDay (UTCTime -> Day)
-> EventM ClientName ClientState UTCTime
-> EventM ClientName ClientState Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime -> EventM ClientName ClientState UTCTime
forall a. IO a -> EventM ClientName ClientState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
T.getCurrentTime
(ClientState -> ClientState) -> EventM ClientName ClientState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ClientState -> ClientState) -> EventM ClientName ClientState ())
-> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ \ClientState
s -> ClientState
s {_clientStateScreenState = ClientScreenStateDesks (MkScreenDesksState space l False Nothing currentDay (_clientStateTimezone s) Nothing)}
Either
ClientError
(Union
'[WithStatus 200 ResponseDeskList,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionViewSpace),
WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
err ->
(ClientState -> ClientState) -> EventM ClientName ClientState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ClientState -> ClientState) -> EventM ClientName ClientState ())
-> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ \ClientState
s -> ClientState
s {_clientStatePopup = Just $ T.pack $ show err}
Maybe Jwt
Nothing -> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ClientState -> ClientState) -> EventM ClientName ClientState ())
-> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ \ClientState
s -> ClientState
s {_clientStatePopup = Just "Error: Not logged in."}
ClientEvent
ClientEventSwitchToScreenMenu -> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ClientState -> ClientState) -> EventM ClientName ClientState ())
-> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ \ClientState
s -> ClientState
s {_clientStateScreenState = ClientScreenStateMenu $ MkScreenMenuState menuListInitial}
ClientEventSendRequestLogin Credentials
credentials -> do
Either
ClientError
(Union
'[WithStatus 200 ResponseLogin, WithStatus 401 ErrorBasicAuth,
WithStatus 500 ()])
result <- BChan ClientEvent
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 200 ResponseLogin, WithStatus 401 ErrorBasicAuth,
WithStatus 500 ()]))
-> EventM
ClientName
ClientState
(Either
ClientError
(Union
'[WithStatus 200 ResponseLogin, WithStatus 401 ErrorBasicAuth,
WithStatus 500 ()]))
forall (m :: * -> *) a.
MonadIO m =>
BChan ClientEvent -> ApplicationT m a -> m a
runApplicationT BChan ClientEvent
chan (ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 200 ResponseLogin, WithStatus 401 ErrorBasicAuth,
WithStatus 500 ()]))
-> EventM
ClientName
ClientState
(Either
ClientError
(Union
'[WithStatus 200 ResponseLogin, WithStatus 401 ErrorBasicAuth,
WithStatus 500 ()])))
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 200 ResponseLogin, WithStatus 401 ErrorBasicAuth,
WithStatus 500 ()]))
-> EventM
ClientName
ClientState
(Either
ClientError
(Union
'[WithStatus 200 ResponseLogin, WithStatus 401 ErrorBasicAuth,
WithStatus 500 ()]))
forall a b. (a -> b) -> a -> b
$ ClientM
(Union
'[WithStatus 200 ResponseLogin, WithStatus 401 ErrorBasicAuth,
WithStatus 500 ()])
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 200 ResponseLogin, WithStatus 401 ErrorBasicAuth,
WithStatus 500 ()]))
forall a.
ClientM a
-> ApplicationT
(EventM ClientName ClientState) (Either ClientError a)
forall (m :: * -> *) a.
MonadMensamClient m =>
ClientM a -> m (Either ClientError a)
mensamCall (ClientM
(Union
'[WithStatus 200 ResponseLogin, WithStatus 401 ErrorBasicAuth,
WithStatus 500 ()])
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 200 ResponseLogin, WithStatus 401 ErrorBasicAuth,
WithStatus 500 ()])))
-> ClientM
(Union
'[WithStatus 200 ResponseLogin, WithStatus 401 ErrorBasicAuth,
WithStatus 500 ()])
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 200 ResponseLogin, WithStatus 401 ErrorBasicAuth,
WithStatus 500 ()]))
forall a b. (a -> b) -> a -> b
$ AuthData '[BasicAuth, JWTWithSession]
-> ClientM
(Union
'[WithStatus 200 ResponseLogin, WithStatus 401 ErrorBasicAuth,
WithStatus 500 ()])
endpointLogin (AuthData '[BasicAuth, JWTWithSession]
-> ClientM
(Union
'[WithStatus 200 ResponseLogin, WithStatus 401 ErrorBasicAuth,
WithStatus 500 ()]))
-> AuthData '[BasicAuth, JWTWithSession]
-> ClientM
(Union
'[WithStatus 200 ResponseLogin, WithStatus 401 ErrorBasicAuth,
WithStatus 500 ()])
forall a b. (a -> b) -> a -> b
$ Credentials -> AuthData '[BasicAuth, JWTWithSession]
forall (auths :: [*]). Credentials -> AuthData (BasicAuth : auths)
DataBasicAuth Credentials
credentials
case Either
ClientError
(Union
'[WithStatus 200 ResponseLogin, WithStatus 401 ErrorBasicAuth,
WithStatus 500 ()])
result of
Right (Z (I (WithStatus @200 (Route.User.MkResponseLogin Jwt
jwt Maybe UTCTime
_timeout IdentifierUser
_)))) -> do
(ClientState -> ClientState) -> EventM ClientName ClientState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ClientState -> ClientState) -> EventM ClientName ClientState ())
-> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ \ClientState
s -> ClientState
s {_clientStateJwt = Just jwt}
BChan ClientEvent
-> ApplicationT (EventM ClientName ClientState) ()
-> EventM ClientName ClientState ()
forall (m :: * -> *) a.
MonadIO m =>
BChan ClientEvent -> ApplicationT m a -> m a
runApplicationT BChan ClientEvent
chan (ApplicationT (EventM ClientName ClientState) ()
-> EventM ClientName ClientState ())
-> ApplicationT (EventM ClientName ClientState) ()
-> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ ClientEvent -> ApplicationT (EventM ClientName ClientState) ()
forall (m :: * -> *). MonadEvent m => ClientEvent -> m ()
sendEvent ClientEvent
ClientEventSwitchToScreenSpaces
Either
ClientError
(Union
'[WithStatus 200 ResponseLogin, WithStatus 401 ErrorBasicAuth,
WithStatus 500 ()])
err -> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ClientState -> ClientState) -> EventM ClientName ClientState ())
-> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ \ClientState
s -> ClientState
s {_clientStatePopup = Just $ T.pack $ show err}
ClientEvent
ClientEventSendRequestLogout -> do
ClientState
clientState <- EventM ClientName ClientState ClientState
forall s (m :: * -> *). MonadState s m => m s
get
case ClientState
clientState ClientState
-> Getting (Maybe Jwt) ClientState (Maybe Jwt) -> Maybe Jwt
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Jwt) ClientState (Maybe Jwt)
Lens' ClientState (Maybe Jwt)
clientStateJwt of
Just Jwt
jwt -> do
Either
ClientError
(Union
'[WithStatus 200 ResponseLogout, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()])
result <- BChan ClientEvent
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 200 ResponseLogout, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()]))
-> EventM
ClientName
ClientState
(Either
ClientError
(Union
'[WithStatus 200 ResponseLogout, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()]))
forall (m :: * -> *) a.
MonadIO m =>
BChan ClientEvent -> ApplicationT m a -> m a
runApplicationT BChan ClientEvent
chan (ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 200 ResponseLogout, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()]))
-> EventM
ClientName
ClientState
(Either
ClientError
(Union
'[WithStatus 200 ResponseLogout, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()])))
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 200 ResponseLogout, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()]))
-> EventM
ClientName
ClientState
(Either
ClientError
(Union
'[WithStatus 200 ResponseLogout, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()]))
forall a b. (a -> b) -> a -> b
$ ClientM
(Union
'[WithStatus 200 ResponseLogout, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()])
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 200 ResponseLogout, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()]))
forall a.
ClientM a
-> ApplicationT
(EventM ClientName ClientState) (Either ClientError a)
forall (m :: * -> *) a.
MonadMensamClient m =>
ClientM a -> m (Either ClientError a)
mensamCall (ClientM
(Union
'[WithStatus 200 ResponseLogout, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()])
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 200 ResponseLogout, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()])))
-> ClientM
(Union
'[WithStatus 200 ResponseLogout, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()])
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 200 ResponseLogout, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()]))
forall a b. (a -> b) -> a -> b
$ AuthData '[JWTWithSession]
-> ClientM
(Union
'[WithStatus 200 ResponseLogout, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()])
endpointLogout (AuthData '[JWTWithSession]
-> ClientM
(Union
'[WithStatus 200 ResponseLogout, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()]))
-> AuthData '[JWTWithSession]
-> ClientM
(Union
'[WithStatus 200 ResponseLogout, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()])
forall a b. (a -> b) -> a -> b
$ Jwt -> AuthData '[JWTWithSession]
forall (auths :: [*]). Jwt -> AuthData (JWTWithSession : auths)
DataJWTWithSession Jwt
jwt
case Either
ClientError
(Union
'[WithStatus 200 ResponseLogout, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()])
result of
Right (Z (I (WithStatus @200 (Route.User.MkResponseLogout ())))) ->
(ClientState -> ClientState) -> EventM ClientName ClientState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ClientState -> ClientState) -> EventM ClientName ClientState ())
-> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ \ClientState
s -> ClientState
s {_clientStateJwt = Nothing}
Either
ClientError
(Union
'[WithStatus 200 ResponseLogout, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()])
err -> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ClientState -> ClientState) -> EventM ClientName ClientState ())
-> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ \ClientState
s -> ClientState
s {_clientStatePopup = Just $ T.pack $ show err}
Maybe Jwt
Nothing -> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ClientState -> ClientState) -> EventM ClientName ClientState ())
-> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ \ClientState
s -> ClientState
s {_clientStatePopup = Just "Error: Not logged in."}
ClientEventSendRequestRegister RequestRegister
request -> do
Either
ClientError
(Union
'[WithStatus 201 ResponseRegister,
WithStatus 400 ErrorParseBodyJson,
WithStatus 409 (StaticText "Username is taken."),
WithStatus 500 ()])
result <- BChan ClientEvent
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 201 ResponseRegister,
WithStatus 400 ErrorParseBodyJson,
WithStatus 409 (StaticText "Username is taken."),
WithStatus 500 ()]))
-> EventM
ClientName
ClientState
(Either
ClientError
(Union
'[WithStatus 201 ResponseRegister,
WithStatus 400 ErrorParseBodyJson,
WithStatus 409 (StaticText "Username is taken."),
WithStatus 500 ()]))
forall (m :: * -> *) a.
MonadIO m =>
BChan ClientEvent -> ApplicationT m a -> m a
runApplicationT BChan ClientEvent
chan (ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 201 ResponseRegister,
WithStatus 400 ErrorParseBodyJson,
WithStatus 409 (StaticText "Username is taken."),
WithStatus 500 ()]))
-> EventM
ClientName
ClientState
(Either
ClientError
(Union
'[WithStatus 201 ResponseRegister,
WithStatus 400 ErrorParseBodyJson,
WithStatus 409 (StaticText "Username is taken."),
WithStatus 500 ()])))
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 201 ResponseRegister,
WithStatus 400 ErrorParseBodyJson,
WithStatus 409 (StaticText "Username is taken."),
WithStatus 500 ()]))
-> EventM
ClientName
ClientState
(Either
ClientError
(Union
'[WithStatus 201 ResponseRegister,
WithStatus 400 ErrorParseBodyJson,
WithStatus 409 (StaticText "Username is taken."),
WithStatus 500 ()]))
forall a b. (a -> b) -> a -> b
$ ClientM
(Union
'[WithStatus 201 ResponseRegister,
WithStatus 400 ErrorParseBodyJson,
WithStatus 409 (StaticText "Username is taken."),
WithStatus 500 ()])
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 201 ResponseRegister,
WithStatus 400 ErrorParseBodyJson,
WithStatus 409 (StaticText "Username is taken."),
WithStatus 500 ()]))
forall a.
ClientM a
-> ApplicationT
(EventM ClientName ClientState) (Either ClientError a)
forall (m :: * -> *) a.
MonadMensamClient m =>
ClientM a -> m (Either ClientError a)
mensamCall (ClientM
(Union
'[WithStatus 201 ResponseRegister,
WithStatus 400 ErrorParseBodyJson,
WithStatus 409 (StaticText "Username is taken."),
WithStatus 500 ()])
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 201 ResponseRegister,
WithStatus 400 ErrorParseBodyJson,
WithStatus 409 (StaticText "Username is taken."),
WithStatus 500 ()])))
-> ClientM
(Union
'[WithStatus 201 ResponseRegister,
WithStatus 400 ErrorParseBodyJson,
WithStatus 409 (StaticText "Username is taken."),
WithStatus 500 ()])
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 201 ResponseRegister,
WithStatus 400 ErrorParseBodyJson,
WithStatus 409 (StaticText "Username is taken."),
WithStatus 500 ()]))
forall a b. (a -> b) -> a -> b
$ RequestRegister
-> ClientM
(Union
'[WithStatus 201 ResponseRegister,
WithStatus 400 ErrorParseBodyJson,
WithStatus 409 (StaticText "Username is taken."),
WithStatus 500 ()])
endpointRegister RequestRegister
request
case Either
ClientError
(Union
'[WithStatus 201 ResponseRegister,
WithStatus 400 ErrorParseBodyJson,
WithStatus 409 (StaticText "Username is taken."),
WithStatus 500 ()])
result of
Right (Z (I (WithStatus @201 (Route.User.MkResponseRegister Bool
_)))) -> BChan ClientEvent
-> ApplicationT (EventM ClientName ClientState) ()
-> EventM ClientName ClientState ()
forall (m :: * -> *) a.
MonadIO m =>
BChan ClientEvent -> ApplicationT m a -> m a
runApplicationT BChan ClientEvent
chan (ApplicationT (EventM ClientName ClientState) ()
-> EventM ClientName ClientState ())
-> ApplicationT (EventM ClientName ClientState) ()
-> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ ClientEvent -> ApplicationT (EventM ClientName ClientState) ()
forall (m :: * -> *). MonadEvent m => ClientEvent -> m ()
sendEvent ClientEvent
ClientEventSwitchToScreenLogin
Either
ClientError
(Union
'[WithStatus 201 ResponseRegister,
WithStatus 400 ErrorParseBodyJson,
WithStatus 409 (StaticText "Username is taken."),
WithStatus 500 ()])
err -> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ClientState -> ClientState) -> EventM ClientName ClientState ())
-> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ \ClientState
s -> ClientState
s {_clientStatePopup = Just $ T.pack $ show err}
ClientEventSendRequestCreateSpace RequestSpaceCreate
request -> do
ClientState
clientState <- EventM ClientName ClientState ClientState
forall s (m :: * -> *). MonadState s m => m s
get
case ClientState
clientState ClientState
-> Getting (Maybe Jwt) ClientState (Maybe Jwt) -> Maybe Jwt
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Jwt) ClientState (Maybe Jwt)
Lens' ClientState (Maybe Jwt)
clientStateJwt of
Just Jwt
jwt -> do
Either
ClientError
(Union
'[WithStatus 201 ResponseSpaceCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()])
result <- BChan ClientEvent
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 201 ResponseSpaceCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()]))
-> EventM
ClientName
ClientState
(Either
ClientError
(Union
'[WithStatus 201 ResponseSpaceCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()]))
forall (m :: * -> *) a.
MonadIO m =>
BChan ClientEvent -> ApplicationT m a -> m a
runApplicationT BChan ClientEvent
chan (ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 201 ResponseSpaceCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()]))
-> EventM
ClientName
ClientState
(Either
ClientError
(Union
'[WithStatus 201 ResponseSpaceCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()])))
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 201 ResponseSpaceCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()]))
-> EventM
ClientName
ClientState
(Either
ClientError
(Union
'[WithStatus 201 ResponseSpaceCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()]))
forall a b. (a -> b) -> a -> b
$ ClientM
(Union
'[WithStatus 201 ResponseSpaceCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()])
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 201 ResponseSpaceCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()]))
forall a.
ClientM a
-> ApplicationT
(EventM ClientName ClientState) (Either ClientError a)
forall (m :: * -> *) a.
MonadMensamClient m =>
ClientM a -> m (Either ClientError a)
mensamCall (ClientM
(Union
'[WithStatus 201 ResponseSpaceCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()])
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 201 ResponseSpaceCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()])))
-> ClientM
(Union
'[WithStatus 201 ResponseSpaceCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()])
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 201 ResponseSpaceCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()]))
forall a b. (a -> b) -> a -> b
$ AuthData '[JWTWithSession]
-> RequestSpaceCreate
-> ClientM
(Union
'[WithStatus 201 ResponseSpaceCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()])
endpointSpaceCreate (Jwt -> AuthData '[JWTWithSession]
forall (auths :: [*]). Jwt -> AuthData (JWTWithSession : auths)
DataJWTWithSession Jwt
jwt) RequestSpaceCreate
request
case Either
ClientError
(Union
'[WithStatus 201 ResponseSpaceCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()])
result of
Right (Z (I (WithStatus @201 (Route.Space.MkResponseSpaceCreate IdentifierSpace
_)))) -> BChan ClientEvent
-> ApplicationT (EventM ClientName ClientState) ()
-> EventM ClientName ClientState ()
forall (m :: * -> *) a.
MonadIO m =>
BChan ClientEvent -> ApplicationT m a -> m a
runApplicationT BChan ClientEvent
chan (ApplicationT (EventM ClientName ClientState) ()
-> EventM ClientName ClientState ())
-> ApplicationT (EventM ClientName ClientState) ()
-> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ ClientEvent -> ApplicationT (EventM ClientName ClientState) ()
forall (m :: * -> *). MonadEvent m => ClientEvent -> m ()
sendEvent ClientEvent
ClientEventSwitchToScreenSpaces
Either
ClientError
(Union
'[WithStatus 201 ResponseSpaceCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 500 ()])
err -> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ClientState -> ClientState) -> EventM ClientName ClientState ())
-> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ \ClientState
s -> ClientState
s {_clientStatePopup = Just $ T.pack $ show err}
Maybe Jwt
Nothing -> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ClientState -> ClientState) -> EventM ClientName ClientState ())
-> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ \ClientState
s -> ClientState
s {_clientStatePopup = Just "Error: Not logged in."}
ClientEventSendRequestCreateDesk Space
space RequestDeskCreate
request -> do
ClientState
clientState <- EventM ClientName ClientState ClientState
forall s (m :: * -> *). MonadState s m => m s
get
case ClientState
clientState ClientState
-> Getting (Maybe Jwt) ClientState (Maybe Jwt) -> Maybe Jwt
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Jwt) ClientState (Maybe Jwt)
Lens' ClientState (Maybe Jwt)
clientStateJwt of
Just Jwt
jwt -> do
Either
ClientError
(Union
'[WithStatus 201 ResponseDeskCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditDesk),
WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
result <- BChan ClientEvent
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 201 ResponseDeskCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditDesk),
WithStatus 404 (StaticText "Space not found."),
WithStatus 500 ()]))
-> EventM
ClientName
ClientState
(Either
ClientError
(Union
'[WithStatus 201 ResponseDeskCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditDesk),
WithStatus 404 (StaticText "Space not found."),
WithStatus 500 ()]))
forall (m :: * -> *) a.
MonadIO m =>
BChan ClientEvent -> ApplicationT m a -> m a
runApplicationT BChan ClientEvent
chan (ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 201 ResponseDeskCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditDesk),
WithStatus 404 (StaticText "Space not found."),
WithStatus 500 ()]))
-> EventM
ClientName
ClientState
(Either
ClientError
(Union
'[WithStatus 201 ResponseDeskCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditDesk),
WithStatus 404 (StaticText "Space not found."),
WithStatus 500 ()])))
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 201 ResponseDeskCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditDesk),
WithStatus 404 (StaticText "Space not found."),
WithStatus 500 ()]))
-> EventM
ClientName
ClientState
(Either
ClientError
(Union
'[WithStatus 201 ResponseDeskCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditDesk),
WithStatus 404 (StaticText "Space not found."),
WithStatus 500 ()]))
forall a b. (a -> b) -> a -> b
$ ClientM
(Union
'[WithStatus 201 ResponseDeskCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditDesk),
WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 201 ResponseDeskCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditDesk),
WithStatus 404 (StaticText "Space not found."),
WithStatus 500 ()]))
forall a.
ClientM a
-> ApplicationT
(EventM ClientName ClientState) (Either ClientError a)
forall (m :: * -> *) a.
MonadMensamClient m =>
ClientM a -> m (Either ClientError a)
mensamCall (ClientM
(Union
'[WithStatus 201 ResponseDeskCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditDesk),
WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 201 ResponseDeskCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditDesk),
WithStatus 404 (StaticText "Space not found."),
WithStatus 500 ()])))
-> ClientM
(Union
'[WithStatus 201 ResponseDeskCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditDesk),
WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 201 ResponseDeskCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditDesk),
WithStatus 404 (StaticText "Space not found."),
WithStatus 500 ()]))
forall a b. (a -> b) -> a -> b
$ AuthData '[JWTWithSession]
-> RequestDeskCreate
-> ClientM
(Union
'[WithStatus 201 ResponseDeskCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditDesk),
WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
endpointDeskCreate (Jwt -> AuthData '[JWTWithSession]
forall (auths :: [*]). Jwt -> AuthData (JWTWithSession : auths)
DataJWTWithSession Jwt
jwt) RequestDeskCreate
request
case Either
ClientError
(Union
'[WithStatus 201 ResponseDeskCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditDesk),
WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
result of
Right (Z (I (WithStatus @201 (Route.Space.MkResponseDeskCreate IdentifierDesk
_)))) -> BChan ClientEvent
-> ApplicationT (EventM ClientName ClientState) ()
-> EventM ClientName ClientState ()
forall (m :: * -> *) a.
MonadIO m =>
BChan ClientEvent -> ApplicationT m a -> m a
runApplicationT BChan ClientEvent
chan (ApplicationT (EventM ClientName ClientState) ()
-> EventM ClientName ClientState ())
-> ApplicationT (EventM ClientName ClientState) ()
-> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ ClientEvent -> ApplicationT (EventM ClientName ClientState) ()
forall (m :: * -> *). MonadEvent m => ClientEvent -> m ()
sendEvent (Space -> ClientEvent
ClientEventSwitchToScreenDesks Space
space)
Either
ClientError
(Union
'[WithStatus 201 ResponseDeskCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus 403 (ErrorInsufficientPermission 'MkPermissionEditDesk),
WithStatus 404 (StaticText "Space not found."), WithStatus 500 ()])
err -> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ClientState -> ClientState) -> EventM ClientName ClientState ())
-> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ \ClientState
s -> ClientState
s {_clientStatePopup = Just $ T.pack $ show err}
Maybe Jwt
Nothing -> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ClientState -> ClientState) -> EventM ClientName ClientState ())
-> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ \ClientState
s -> ClientState
s {_clientStatePopup = Just "Error: Not logged in."}
ClientEventSendRequestCreateReservation Space
space RequestReservationCreate
request -> do
ClientState
clientState <- EventM ClientName ClientState ClientState
forall s (m :: * -> *). MonadState s m => m s
get
case ClientState
clientState ClientState
-> Getting (Maybe Jwt) ClientState (Maybe Jwt) -> Maybe Jwt
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Jwt) ClientState (Maybe Jwt)
Lens' ClientState (Maybe Jwt)
clientStateJwt of
Just Jwt
jwt -> do
Either
ClientError
(Union
'[WithStatus 201 ResponseReservationCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionCreateReservation),
WithStatus
409
(StaticText "Desk is not available within the given time window."),
WithStatus 500 ()])
result <- BChan ClientEvent
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 201 ResponseReservationCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionCreateReservation),
WithStatus
409
(StaticText "Desk is not available within the given time window."),
WithStatus 500 ()]))
-> EventM
ClientName
ClientState
(Either
ClientError
(Union
'[WithStatus 201 ResponseReservationCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionCreateReservation),
WithStatus
409
(StaticText "Desk is not available within the given time window."),
WithStatus 500 ()]))
forall (m :: * -> *) a.
MonadIO m =>
BChan ClientEvent -> ApplicationT m a -> m a
runApplicationT BChan ClientEvent
chan (ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 201 ResponseReservationCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionCreateReservation),
WithStatus
409
(StaticText "Desk is not available within the given time window."),
WithStatus 500 ()]))
-> EventM
ClientName
ClientState
(Either
ClientError
(Union
'[WithStatus 201 ResponseReservationCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionCreateReservation),
WithStatus
409
(StaticText "Desk is not available within the given time window."),
WithStatus 500 ()])))
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 201 ResponseReservationCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionCreateReservation),
WithStatus
409
(StaticText "Desk is not available within the given time window."),
WithStatus 500 ()]))
-> EventM
ClientName
ClientState
(Either
ClientError
(Union
'[WithStatus 201 ResponseReservationCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionCreateReservation),
WithStatus
409
(StaticText "Desk is not available within the given time window."),
WithStatus 500 ()]))
forall a b. (a -> b) -> a -> b
$ ClientM
(Union
'[WithStatus 201 ResponseReservationCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionCreateReservation),
WithStatus
409
(StaticText "Desk is not available within the given time window."),
WithStatus 500 ()])
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 201 ResponseReservationCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionCreateReservation),
WithStatus
409
(StaticText "Desk is not available within the given time window."),
WithStatus 500 ()]))
forall a.
ClientM a
-> ApplicationT
(EventM ClientName ClientState) (Either ClientError a)
forall (m :: * -> *) a.
MonadMensamClient m =>
ClientM a -> m (Either ClientError a)
mensamCall (ClientM
(Union
'[WithStatus 201 ResponseReservationCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionCreateReservation),
WithStatus
409
(StaticText "Desk is not available within the given time window."),
WithStatus 500 ()])
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 201 ResponseReservationCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionCreateReservation),
WithStatus
409
(StaticText "Desk is not available within the given time window."),
WithStatus 500 ()])))
-> ClientM
(Union
'[WithStatus 201 ResponseReservationCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionCreateReservation),
WithStatus
409
(StaticText "Desk is not available within the given time window."),
WithStatus 500 ()])
-> ApplicationT
(EventM ClientName ClientState)
(Either
ClientError
(Union
'[WithStatus 201 ResponseReservationCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionCreateReservation),
WithStatus
409
(StaticText "Desk is not available within the given time window."),
WithStatus 500 ()]))
forall a b. (a -> b) -> a -> b
$ AuthData '[JWTWithSession]
-> RequestReservationCreate
-> ClientM
(Union
'[WithStatus 201 ResponseReservationCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionCreateReservation),
WithStatus
409
(StaticText "Desk is not available within the given time window."),
WithStatus 500 ()])
endpointReservationCreate (Jwt -> AuthData '[JWTWithSession]
forall (auths :: [*]). Jwt -> AuthData (JWTWithSession : auths)
DataJWTWithSession Jwt
jwt) RequestReservationCreate
request
case Either
ClientError
(Union
'[WithStatus 201 ResponseReservationCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionCreateReservation),
WithStatus
409
(StaticText "Desk is not available within the given time window."),
WithStatus 500 ()])
result of
Right (Z (I (WithStatus @201 (Route.Reservation.MkResponseReservationCreate IdentifierReservation
_ Maybe Bool
_)))) -> BChan ClientEvent
-> ApplicationT (EventM ClientName ClientState) ()
-> EventM ClientName ClientState ()
forall (m :: * -> *) a.
MonadIO m =>
BChan ClientEvent -> ApplicationT m a -> m a
runApplicationT BChan ClientEvent
chan (ApplicationT (EventM ClientName ClientState) ()
-> EventM ClientName ClientState ())
-> ApplicationT (EventM ClientName ClientState) ()
-> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ ClientEvent -> ApplicationT (EventM ClientName ClientState) ()
forall (m :: * -> *). MonadEvent m => ClientEvent -> m ()
sendEvent (Space -> ClientEvent
ClientEventSwitchToScreenDesks Space
space)
Either
ClientError
(Union
'[WithStatus 201 ResponseReservationCreate,
WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
WithStatus
403 (ErrorInsufficientPermission 'MkPermissionCreateReservation),
WithStatus
409
(StaticText "Desk is not available within the given time window."),
WithStatus 500 ()])
err -> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ClientState -> ClientState) -> EventM ClientName ClientState ())
-> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ \ClientState
s -> ClientState
s {_clientStatePopup = Just $ T.pack $ show err}
Maybe Jwt
Nothing -> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ClientState -> ClientState) -> EventM ClientName ClientState ())
-> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ \ClientState
s -> ClientState
s {_clientStatePopup = Just "Error: Not logged in."}
VtyEvent (EvKey Key
KEsc []) -> do
ClientState
s <- EventM ClientName ClientState ClientState
forall s (m :: * -> *). MonadState s m => m s
get
case ClientState -> ClientScreenState
_clientStateScreenState ClientState
s of
ClientScreenStateMenu ScreenMenuState
_ ->
LensLike'
(Zoomed (EventM ClientName ScreenMenuState) ())
ClientState
ScreenMenuState
-> EventM ClientName ScreenMenuState ()
-> EventM ClientName ClientState ()
forall c.
LensLike'
(Zoomed (EventM ClientName ScreenMenuState) c)
ClientState
ScreenMenuState
-> EventM ClientName ScreenMenuState c
-> EventM ClientName ClientState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((ClientScreenState
-> Focusing
(StateT (EventState ClientName) IO) () ClientScreenState)
-> ClientState
-> Focusing (StateT (EventState ClientName) IO) () ClientState
Lens' ClientState ClientScreenState
clientStateScreenState ((ClientScreenState
-> Focusing
(StateT (EventState ClientName) IO) () ClientScreenState)
-> ClientState
-> Focusing (StateT (EventState ClientName) IO) () ClientState)
-> ((ScreenMenuState
-> Focusing (StateT (EventState ClientName) IO) () ScreenMenuState)
-> ClientScreenState
-> Focusing
(StateT (EventState ClientName) IO) () ClientScreenState)
-> (ScreenMenuState
-> Focusing (StateT (EventState ClientName) IO) () ScreenMenuState)
-> ClientState
-> Focusing (StateT (EventState ClientName) IO) () ClientState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScreenMenuState
-> Focusing (StateT (EventState ClientName) IO) () ScreenMenuState)
-> ClientScreenState
-> Focusing
(StateT (EventState ClientName) IO) () ClientScreenState
Traversal' ClientScreenState ScreenMenuState
clientScreenStateMenu) (EventM ClientName ScreenMenuState ()
-> EventM ClientName ClientState ())
-> EventM ClientName ScreenMenuState ()
-> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ BChan ClientEvent
-> ApplicationT (EventM ClientName ScreenMenuState) ()
-> EventM ClientName ScreenMenuState ()
forall (m :: * -> *) a.
MonadIO m =>
BChan ClientEvent -> ApplicationT m a -> m a
runApplicationT BChan ClientEvent
chan (ApplicationT (EventM ClientName ScreenMenuState) ()
-> EventM ClientName ScreenMenuState ())
-> ApplicationT (EventM ClientName ScreenMenuState) ()
-> EventM ClientName ScreenMenuState ()
forall a b. (a -> b) -> a -> b
$ BrickEvent ClientName ClientEvent
-> ApplicationT (EventM ClientName ScreenMenuState) ()
menuHandleEvent (Event -> BrickEvent ClientName ClientEvent
forall n e. Event -> BrickEvent n e
VtyEvent (Key -> [Modifier] -> Event
EvKey Key
KEsc []))
ClientScreenState
_ -> BChan ClientEvent
-> ApplicationT (EventM ClientName ClientState) ()
-> EventM ClientName ClientState ()
forall (m :: * -> *) a.
MonadIO m =>
BChan ClientEvent -> ApplicationT m a -> m a
runApplicationT BChan ClientEvent
chan (ApplicationT (EventM ClientName ClientState) ()
-> EventM ClientName ClientState ())
-> ApplicationT (EventM ClientName ClientState) ()
-> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ ClientEvent -> ApplicationT (EventM ClientName ClientState) ()
forall (m :: * -> *). MonadEvent m => ClientEvent -> m ()
sendEvent ClientEvent
ClientEventSwitchToScreenMenu
VtyEvent (EvKey (KChar Char
'c') [Modifier
MCtrl]) -> EventM ClientName ClientState ()
forall n s. EventM n s ()
halt
BrickEvent ClientName ClientEvent
event -> do
ClientState
clientState <- EventM ClientName ClientState ClientState
forall s (m :: * -> *). MonadState s m => m s
get
case ClientState
clientState of
MkClientState {_clientStatePopup :: ClientState -> Maybe Text
_clientStatePopup = Just Text
_popup} ->
case BrickEvent ClientName ClientEvent
event of
VtyEvent (EvKey Key
KEnter []) ->
(ClientState -> ClientState) -> EventM ClientName ClientState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ClientState -> ClientState) -> EventM ClientName ClientState ())
-> (ClientState -> ClientState) -> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ \ClientState
s -> ClientState
s {_clientStatePopup = Nothing}
BrickEvent ClientName ClientEvent
_ -> () -> EventM ClientName ClientState ()
forall a. a -> EventM ClientName ClientState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
MkClientState {_clientStateScreenState :: ClientState -> ClientScreenState
_clientStateScreenState = ClientScreenStateLogin ScreenLoginState
_} ->
LensLike'
(Zoomed (EventM ClientName ScreenLoginState) ())
ClientState
ScreenLoginState
-> EventM ClientName ScreenLoginState ()
-> EventM ClientName ClientState ()
forall c.
LensLike'
(Zoomed (EventM ClientName ScreenLoginState) c)
ClientState
ScreenLoginState
-> EventM ClientName ScreenLoginState c
-> EventM ClientName ClientState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((ClientScreenState
-> Focusing
(StateT (EventState ClientName) IO) () ClientScreenState)
-> ClientState
-> Focusing (StateT (EventState ClientName) IO) () ClientState
Lens' ClientState ClientScreenState
clientStateScreenState ((ClientScreenState
-> Focusing
(StateT (EventState ClientName) IO) () ClientScreenState)
-> ClientState
-> Focusing (StateT (EventState ClientName) IO) () ClientState)
-> ((ScreenLoginState
-> Focusing
(StateT (EventState ClientName) IO) () ScreenLoginState)
-> ClientScreenState
-> Focusing
(StateT (EventState ClientName) IO) () ClientScreenState)
-> (ScreenLoginState
-> Focusing
(StateT (EventState ClientName) IO) () ScreenLoginState)
-> ClientState
-> Focusing (StateT (EventState ClientName) IO) () ClientState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScreenLoginState
-> Focusing
(StateT (EventState ClientName) IO) () ScreenLoginState)
-> ClientScreenState
-> Focusing
(StateT (EventState ClientName) IO) () ClientScreenState
Traversal' ClientScreenState ScreenLoginState
clientScreenStateLogin) (EventM ClientName ScreenLoginState ()
-> EventM ClientName ClientState ())
-> EventM ClientName ScreenLoginState ()
-> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ BChan ClientEvent
-> ApplicationT (EventM ClientName ScreenLoginState) ()
-> EventM ClientName ScreenLoginState ()
forall (m :: * -> *) a.
MonadIO m =>
BChan ClientEvent -> ApplicationT m a -> m a
runApplicationT BChan ClientEvent
chan (ApplicationT (EventM ClientName ScreenLoginState) ()
-> EventM ClientName ScreenLoginState ())
-> ApplicationT (EventM ClientName ScreenLoginState) ()
-> EventM ClientName ScreenLoginState ()
forall a b. (a -> b) -> a -> b
$ BrickEvent ClientName ClientEvent
-> ApplicationT (EventM ClientName ScreenLoginState) ()
loginHandleEvent BrickEvent ClientName ClientEvent
event
MkClientState {_clientStateScreenState :: ClientState -> ClientScreenState
_clientStateScreenState = ClientScreenStateRegister ScreenRegisterState
_} ->
LensLike'
(Zoomed (EventM ClientName ScreenRegisterState) ())
ClientState
ScreenRegisterState
-> EventM ClientName ScreenRegisterState ()
-> EventM ClientName ClientState ()
forall c.
LensLike'
(Zoomed (EventM ClientName ScreenRegisterState) c)
ClientState
ScreenRegisterState
-> EventM ClientName ScreenRegisterState c
-> EventM ClientName ClientState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((ClientScreenState
-> Focusing
(StateT (EventState ClientName) IO) () ClientScreenState)
-> ClientState
-> Focusing (StateT (EventState ClientName) IO) () ClientState
Lens' ClientState ClientScreenState
clientStateScreenState ((ClientScreenState
-> Focusing
(StateT (EventState ClientName) IO) () ClientScreenState)
-> ClientState
-> Focusing (StateT (EventState ClientName) IO) () ClientState)
-> ((ScreenRegisterState
-> Focusing
(StateT (EventState ClientName) IO) () ScreenRegisterState)
-> ClientScreenState
-> Focusing
(StateT (EventState ClientName) IO) () ClientScreenState)
-> (ScreenRegisterState
-> Focusing
(StateT (EventState ClientName) IO) () ScreenRegisterState)
-> ClientState
-> Focusing (StateT (EventState ClientName) IO) () ClientState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScreenRegisterState
-> Focusing
(StateT (EventState ClientName) IO) () ScreenRegisterState)
-> ClientScreenState
-> Focusing
(StateT (EventState ClientName) IO) () ClientScreenState
Traversal' ClientScreenState ScreenRegisterState
clientScreenStateRegister) (EventM ClientName ScreenRegisterState ()
-> EventM ClientName ClientState ())
-> EventM ClientName ScreenRegisterState ()
-> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ BChan ClientEvent
-> ApplicationT (EventM ClientName ScreenRegisterState) ()
-> EventM ClientName ScreenRegisterState ()
forall (m :: * -> *) a.
MonadIO m =>
BChan ClientEvent -> ApplicationT m a -> m a
runApplicationT BChan ClientEvent
chan (ApplicationT (EventM ClientName ScreenRegisterState) ()
-> EventM ClientName ScreenRegisterState ())
-> ApplicationT (EventM ClientName ScreenRegisterState) ()
-> EventM ClientName ScreenRegisterState ()
forall a b. (a -> b) -> a -> b
$ BrickEvent ClientName ClientEvent
-> ApplicationT (EventM ClientName ScreenRegisterState) ()
registerHandleEvent BrickEvent ClientName ClientEvent
event
MkClientState {_clientStateScreenState :: ClientState -> ClientScreenState
_clientStateScreenState = ClientScreenStateSpaces ScreenSpacesState
_} ->
LensLike'
(Zoomed (EventM ClientName ScreenSpacesState) ())
ClientState
ScreenSpacesState
-> EventM ClientName ScreenSpacesState ()
-> EventM ClientName ClientState ()
forall c.
LensLike'
(Zoomed (EventM ClientName ScreenSpacesState) c)
ClientState
ScreenSpacesState
-> EventM ClientName ScreenSpacesState c
-> EventM ClientName ClientState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((ClientScreenState
-> Focusing
(StateT (EventState ClientName) IO) () ClientScreenState)
-> ClientState
-> Focusing (StateT (EventState ClientName) IO) () ClientState
Lens' ClientState ClientScreenState
clientStateScreenState ((ClientScreenState
-> Focusing
(StateT (EventState ClientName) IO) () ClientScreenState)
-> ClientState
-> Focusing (StateT (EventState ClientName) IO) () ClientState)
-> ((ScreenSpacesState
-> Focusing
(StateT (EventState ClientName) IO) () ScreenSpacesState)
-> ClientScreenState
-> Focusing
(StateT (EventState ClientName) IO) () ClientScreenState)
-> (ScreenSpacesState
-> Focusing
(StateT (EventState ClientName) IO) () ScreenSpacesState)
-> ClientState
-> Focusing (StateT (EventState ClientName) IO) () ClientState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScreenSpacesState
-> Focusing
(StateT (EventState ClientName) IO) () ScreenSpacesState)
-> ClientScreenState
-> Focusing
(StateT (EventState ClientName) IO) () ClientScreenState
Traversal' ClientScreenState ScreenSpacesState
clientScreenStateSpaces) (EventM ClientName ScreenSpacesState ()
-> EventM ClientName ClientState ())
-> EventM ClientName ScreenSpacesState ()
-> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ BChan ClientEvent
-> ApplicationT (EventM ClientName ScreenSpacesState) ()
-> EventM ClientName ScreenSpacesState ()
forall (m :: * -> *) a.
MonadIO m =>
BChan ClientEvent -> ApplicationT m a -> m a
runApplicationT BChan ClientEvent
chan (ApplicationT (EventM ClientName ScreenSpacesState) ()
-> EventM ClientName ScreenSpacesState ())
-> ApplicationT (EventM ClientName ScreenSpacesState) ()
-> EventM ClientName ScreenSpacesState ()
forall a b. (a -> b) -> a -> b
$ BrickEvent ClientName ClientEvent
-> ApplicationT (EventM ClientName ScreenSpacesState) ()
spacesHandleEvent BrickEvent ClientName ClientEvent
event
MkClientState {_clientStateScreenState :: ClientState -> ClientScreenState
_clientStateScreenState = ClientScreenStateDesks ScreenDesksState
_} ->
LensLike'
(Zoomed (EventM ClientName ScreenDesksState) ())
ClientState
ScreenDesksState
-> EventM ClientName ScreenDesksState ()
-> EventM ClientName ClientState ()
forall c.
LensLike'
(Zoomed (EventM ClientName ScreenDesksState) c)
ClientState
ScreenDesksState
-> EventM ClientName ScreenDesksState c
-> EventM ClientName ClientState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((ClientScreenState
-> Focusing
(StateT (EventState ClientName) IO) () ClientScreenState)
-> ClientState
-> Focusing (StateT (EventState ClientName) IO) () ClientState
Lens' ClientState ClientScreenState
clientStateScreenState ((ClientScreenState
-> Focusing
(StateT (EventState ClientName) IO) () ClientScreenState)
-> ClientState
-> Focusing (StateT (EventState ClientName) IO) () ClientState)
-> ((ScreenDesksState
-> Focusing
(StateT (EventState ClientName) IO) () ScreenDesksState)
-> ClientScreenState
-> Focusing
(StateT (EventState ClientName) IO) () ClientScreenState)
-> (ScreenDesksState
-> Focusing
(StateT (EventState ClientName) IO) () ScreenDesksState)
-> ClientState
-> Focusing (StateT (EventState ClientName) IO) () ClientState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScreenDesksState
-> Focusing
(StateT (EventState ClientName) IO) () ScreenDesksState)
-> ClientScreenState
-> Focusing
(StateT (EventState ClientName) IO) () ClientScreenState
Traversal' ClientScreenState ScreenDesksState
clientScreenStateDesks) (EventM ClientName ScreenDesksState ()
-> EventM ClientName ClientState ())
-> EventM ClientName ScreenDesksState ()
-> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ BChan ClientEvent
-> ApplicationT (EventM ClientName ScreenDesksState) ()
-> EventM ClientName ScreenDesksState ()
forall (m :: * -> *) a.
MonadIO m =>
BChan ClientEvent -> ApplicationT m a -> m a
runApplicationT BChan ClientEvent
chan (ApplicationT (EventM ClientName ScreenDesksState) ()
-> EventM ClientName ScreenDesksState ())
-> ApplicationT (EventM ClientName ScreenDesksState) ()
-> EventM ClientName ScreenDesksState ()
forall a b. (a -> b) -> a -> b
$ BrickEvent ClientName ClientEvent
-> ApplicationT (EventM ClientName ScreenDesksState) ()
desksHandleEvent BrickEvent ClientName ClientEvent
event
MkClientState {_clientStateScreenState :: ClientState -> ClientScreenState
_clientStateScreenState = ClientScreenStateMenu ScreenMenuState
_} ->
LensLike'
(Zoomed (EventM ClientName ScreenMenuState) ())
ClientState
ScreenMenuState
-> EventM ClientName ScreenMenuState ()
-> EventM ClientName ClientState ()
forall c.
LensLike'
(Zoomed (EventM ClientName ScreenMenuState) c)
ClientState
ScreenMenuState
-> EventM ClientName ScreenMenuState c
-> EventM ClientName ClientState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((ClientScreenState
-> Focusing
(StateT (EventState ClientName) IO) () ClientScreenState)
-> ClientState
-> Focusing (StateT (EventState ClientName) IO) () ClientState
Lens' ClientState ClientScreenState
clientStateScreenState ((ClientScreenState
-> Focusing
(StateT (EventState ClientName) IO) () ClientScreenState)
-> ClientState
-> Focusing (StateT (EventState ClientName) IO) () ClientState)
-> ((ScreenMenuState
-> Focusing (StateT (EventState ClientName) IO) () ScreenMenuState)
-> ClientScreenState
-> Focusing
(StateT (EventState ClientName) IO) () ClientScreenState)
-> (ScreenMenuState
-> Focusing (StateT (EventState ClientName) IO) () ScreenMenuState)
-> ClientState
-> Focusing (StateT (EventState ClientName) IO) () ClientState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScreenMenuState
-> Focusing (StateT (EventState ClientName) IO) () ScreenMenuState)
-> ClientScreenState
-> Focusing
(StateT (EventState ClientName) IO) () ClientScreenState
Traversal' ClientScreenState ScreenMenuState
clientScreenStateMenu) (EventM ClientName ScreenMenuState ()
-> EventM ClientName ClientState ())
-> EventM ClientName ScreenMenuState ()
-> EventM ClientName ClientState ()
forall a b. (a -> b) -> a -> b
$ BChan ClientEvent
-> ApplicationT (EventM ClientName ScreenMenuState) ()
-> EventM ClientName ScreenMenuState ()
forall (m :: * -> *) a.
MonadIO m =>
BChan ClientEvent -> ApplicationT m a -> m a
runApplicationT BChan ClientEvent
chan (ApplicationT (EventM ClientName ScreenMenuState) ()
-> EventM ClientName ScreenMenuState ())
-> ApplicationT (EventM ClientName ScreenMenuState) ()
-> EventM ClientName ScreenMenuState ()
forall a b. (a -> b) -> a -> b
$ BrickEvent ClientName ClientEvent
-> ApplicationT (EventM ClientName ScreenMenuState) ()
menuHandleEvent BrickEvent ClientName ClientEvent
event