module Mensam.Server.Server.Route.Api.Reservation where

import Mensam.API.Aeson
import Mensam.API.Aeson.StaticText
import Mensam.API.Data.Desk
import Mensam.API.Data.Reservation
import Mensam.API.Data.Space
import Mensam.API.Data.Space.Permission
import Mensam.API.Data.User
import Mensam.API.Pretty
import Mensam.API.Route.Api.Reservation
import Mensam.Server.Application.Email.Class
import Mensam.Server.Application.SeldaPool.Class
import Mensam.Server.Application.SeldaPool.Servant
import Mensam.Server.Reservation
import Mensam.Server.Server.Auth
import Mensam.Server.Space
import Mensam.Server.User

import Control.Monad.IO.Class
import Control.Monad.Logger.CallStack
import Data.Text qualified as T
import Data.Text.Lazy qualified as TL
import Data.Time.Zones qualified as Time
import Data.Time.Zones.All qualified as Time
import Data.Traversable
import Data.Typeable
import Servant hiding (BasicAuthResult (..))
import Servant.Auth.Server
import Servant.Server.Generic
import Text.Blaze.Html.Renderer.Text qualified as T
import Text.Blaze.Html5 qualified as H

handler ::
  (MonadEmail m, MonadIO m, MonadLogger m, MonadSeldaPool m) =>
  Routes (AsServerT m)
handler :: forall (m :: * -> *).
(MonadEmail m, MonadIO m, MonadLogger m, MonadSeldaPool m) =>
Routes (AsServerT m)
handler =
  Routes
    { routeReservationCreate :: AsServerT m
:- (Summary "Create Reservation"
    :> (Description
          "Request a desk reservation.\nA desk can only be reserved by one user at any time.\n"
        :> ("create"
            :> (Auth '[JWTWithSession] UserAuthenticated
                :> (ReqBody' '[Lenient, Required] '[JSON] RequestReservationCreate
                    :> UVerb
                         'PUT
                         '[JSON]
                         '[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 ()])))))
routeReservationCreate = AsServerT m
:- (Summary "Create Reservation"
    :> (Description
          "Request a desk reservation.\nA desk can only be reserved by one user at any time.\n"
        :> ("create"
            :> (Auth '[JWTWithSession] UserAuthenticated
                :> (ReqBody' '[Lenient, Required] '[JSON] RequestReservationCreate
                    :> UVerb
                         'PUT
                         '[JSON]
                         '[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 ()])))))
AuthResult UserAuthenticated
-> Either String RequestReservationCreate
-> m (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 :: * -> *) (responses :: [*]).
(MonadEmail m, MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 201 ResponseReservationCreate) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionCreateReservation))
   responses,
 IsMember
   (WithStatus
      409
      (StaticText "Desk is not available within the given time window."))
   responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestReservationCreate -> m (Union responses)
createReservation
    , routeReservationCancel :: AsServerT m
:- (Summary "Cancel Reservation"
    :> (Description "Cancel a desk reservation.\n"
        :> ("cancel"
            :> (Auth '[JWTWithSession] UserAuthenticated
                :> (ReqBody' '[Lenient, Required] '[JSON] RequestReservationCancel
                    :> UVerb
                         'POST
                         '[JSON]
                         '[WithStatus 200 ResponseReservationCancel,
                           WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                           WithStatus
                             403 (ErrorInsufficientPermission 'MkPermissionCancelReservation),
                           WithStatus 409 (StaticText "Already cancelled."),
                           WithStatus 410 (StaticText "Already happened."),
                           WithStatus 500 ()])))))
routeReservationCancel = AsServerT m
:- (Summary "Cancel Reservation"
    :> (Description "Cancel a desk reservation.\n"
        :> ("cancel"
            :> (Auth '[JWTWithSession] UserAuthenticated
                :> (ReqBody' '[Lenient, Required] '[JSON] RequestReservationCancel
                    :> UVerb
                         'POST
                         '[JSON]
                         '[WithStatus 200 ResponseReservationCancel,
                           WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                           WithStatus
                             403 (ErrorInsufficientPermission 'MkPermissionCancelReservation),
                           WithStatus 409 (StaticText "Already cancelled."),
                           WithStatus 410 (StaticText "Already happened."),
                           WithStatus 500 ()])))))
AuthResult UserAuthenticated
-> Either String RequestReservationCancel
-> m (Union
        '[WithStatus 200 ResponseReservationCancel,
          WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
          WithStatus
            403 (ErrorInsufficientPermission 'MkPermissionCancelReservation),
          WithStatus 409 (StaticText "Already cancelled."),
          WithStatus 410 (StaticText "Already happened."),
          WithStatus 500 ()])
forall (m :: * -> *) (responses :: [*]).
(MonadIO m, MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseReservationCancel) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionCancelReservation))
   responses,
 IsMember
   (WithStatus 409 (StaticText "Already cancelled.")) responses,
 IsMember
   (WithStatus 410 (StaticText "Already happened.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestReservationCancel -> m (Union responses)
cancelReservation
    , routeReservationList :: AsServerT m
:- (Summary "List Reservations"
    :> (Description
          "View all of your desk reservations.\nUse the time-window to restrict the result to overlapping reservations.\n"
        :> ("list"
            :> (Auth '[JWTWithSession] UserAuthenticated
                :> (ReqBody' '[Lenient, Required] '[JSON] RequestReservationList
                    :> UVerb
                         'POST
                         '[JSON]
                         '[WithStatus 200 ResponseReservationList,
                           WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                           WithStatus 500 ()])))))
routeReservationList = AsServerT m
:- (Summary "List Reservations"
    :> (Description
          "View all of your desk reservations.\nUse the time-window to restrict the result to overlapping reservations.\n"
        :> ("list"
            :> (Auth '[JWTWithSession] UserAuthenticated
                :> (ReqBody' '[Lenient, Required] '[JSON] RequestReservationList
                    :> UVerb
                         'POST
                         '[JSON]
                         '[WithStatus 200 ResponseReservationList,
                           WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
                           WithStatus 500 ()])))))
AuthResult UserAuthenticated
-> Either String RequestReservationList
-> m (Union
        '[WithStatus 200 ResponseReservationList,
          WithStatus 400 ErrorParseBodyJson, WithStatus 401 ErrorBearerAuth,
          WithStatus 500 ()])
forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseReservationList) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestReservationList -> m (Union responses)
listReservations
    }

createReservation ::
  ( MonadEmail m
  , MonadLogger m
  , MonadSeldaPool m
  , IsMember (WithStatus 201 ResponseReservationCreate) responses
  , IsMember (WithStatus 400 ErrorParseBodyJson) responses
  , IsMember (WithStatus 401 ErrorBearerAuth) responses
  , IsMember (WithStatus 403 (ErrorInsufficientPermission MkPermissionCreateReservation)) responses
  , IsMember (WithStatus 409 (StaticText "Desk is not available within the given time window.")) responses
  , IsMember (WithStatus 500 ()) responses
  ) =>
  AuthResult UserAuthenticated ->
  Either String RequestReservationCreate ->
  m (Union responses)
createReservation :: forall (m :: * -> *) (responses :: [*]).
(MonadEmail m, MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 201 ResponseReservationCreate) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionCreateReservation))
   responses,
 IsMember
   (WithStatus
      409
      (StaticText "Desk is not available within the given time window."))
   responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestReservationCreate -> m (Union responses)
createReservation AuthResult UserAuthenticated
auth Either String RequestReservationCreate
eitherRequest = do
  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 RequestReservationCreate
-> (RequestReservationCreate -> 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 RequestReservationCreate
eitherRequest ((RequestReservationCreate -> m (Union responses))
 -> m (Union responses))
-> (RequestReservationCreate -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \RequestReservationCreate
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 reservation: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (RequestReservationCreate -> String
forall a. Show a => a -> String
show RequestReservationCreate
request)
      SeldaResult (IdentifierReservation, Maybe Email)
seldaResult <- SeldaTransactionT m (IdentifierReservation, Maybe Email)
-> m (SeldaResult (IdentifierReservation, Maybe Email))
forall a. SeldaTransactionT m a -> m (SeldaResult a)
forall (m :: * -> *) a.
MonadSeldaPool m =>
SeldaTransactionT m a -> m (SeldaResult a)
runSeldaTransactionT (SeldaTransactionT m (IdentifierReservation, Maybe Email)
 -> m (SeldaResult (IdentifierReservation, Maybe Email)))
-> SeldaTransactionT m (IdentifierReservation, Maybe Email)
-> m (SeldaResult (IdentifierReservation, Maybe Email))
forall a b. (a -> b) -> a -> b
$ do
        IdentifierDesk
deskIdentifier <-
          case RequestReservationCreate
-> NameOrIdentifier DeskNameWithContext IdentifierDesk
requestReservationCreateDesk RequestReservationCreate
request of
            Name MkDeskNameWithContext {deskNameWithContextSpace :: DeskNameWithContext -> NameSpace
deskNameWithContextSpace = NameSpace
spaceName, deskNameWithContextDesk :: DeskNameWithContext -> NameDesk
deskNameWithContextDesk = NameDesk
deskName} -> do
              IdentifierSpace
spaceIdentifier <- NameSpace -> SeldaTransactionT m IdentifierSpace
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
NameSpace -> SeldaTransactionT m IdentifierSpace
spaceLookupId NameSpace
spaceName
              IdentifierSpace
-> NameDesk -> SeldaTransactionT m (Maybe IdentifierDesk)
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierSpace
-> NameDesk -> SeldaTransactionT m (Maybe IdentifierDesk)
deskLookupId IdentifierSpace
spaceIdentifier NameDesk
deskName SeldaTransactionT m (Maybe IdentifierDesk)
-> (Maybe IdentifierDesk -> SeldaTransactionT m IdentifierDesk)
-> SeldaTransactionT m IdentifierDesk
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
                Maybe IdentifierDesk
Nothing -> SeldaTransactionT m IdentifierDesk
forall a. HasCallStack => a
undefined
                Just IdentifierDesk
deskId -> IdentifierDesk -> SeldaTransactionT m IdentifierDesk
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IdentifierDesk
deskId
            Identifier IdentifierDesk
deskId -> IdentifierDesk -> SeldaTransactionT m IdentifierDesk
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IdentifierDesk
deskId
        Desk
desk <- IdentifierDesk -> SeldaTransactionT m Desk
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierDesk -> SeldaTransactionT m Desk
deskGetFromId IdentifierDesk
deskIdentifier
        SPermission 'MkPermissionCreateReservation
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
forall (m :: * -> *) (p :: Permission).
(MonadLogger m, MonadSeldaPool m, Typeable p) =>
SPermission p
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
checkPermission
          SPermission 'MkPermissionCreateReservation
SMkPermissionCreateReservation
          (UserAuthenticated -> IdentifierUser
userAuthenticatedId UserAuthenticated
authenticated)
          (Desk -> IdentifierSpace
deskSpace Desk
desk)
        IdentifierReservation
reservationIdentifier <-
          IdentifierDesk
-> IdentifierUser
-> IntervalNonDegenerate UTCTime
-> SeldaTransactionT m IdentifierReservation
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierDesk
-> IdentifierUser
-> IntervalNonDegenerate UTCTime
-> SeldaTransactionT m IdentifierReservation
reservationCreate
            IdentifierDesk
deskIdentifier
            (UserAuthenticated -> IdentifierUser
userAuthenticatedId UserAuthenticated
authenticated)
            (RequestReservationCreate -> IntervalNonDegenerate UTCTime
requestReservationCreateTimeWindow RequestReservationCreate
request)
        Maybe Email
maybeEmail <- do
          Reservation
reservation <- IdentifierReservation -> SeldaTransactionT m Reservation
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierReservation -> SeldaTransactionT m Reservation
reservationGet IdentifierReservation
reservationIdentifier
          User
user <- IdentifierUser -> SeldaTransactionT m User
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierUser -> SeldaTransactionT m User
userGet (IdentifierUser -> SeldaTransactionT m User)
-> IdentifierUser -> SeldaTransactionT m User
forall a b. (a -> b) -> a -> b
$ Reservation -> IdentifierUser
reservationUser Reservation
reservation
          Space
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
$ Desk -> IdentifierSpace
deskSpace Desk
desk
          IdentifierUser -> SeldaTransactionT m EmailPreferences
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierUser -> SeldaTransactionT m EmailPreferences
userNotificationsPreferencesEmailGet (UserAuthenticated -> IdentifierUser
userAuthenticatedId UserAuthenticated
authenticated) SeldaTransactionT m EmailPreferences
-> (EmailPreferences -> SeldaTransactionT m (Maybe Email))
-> SeldaTransactionT m (Maybe Email)
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
            MkEmailPreferencesSend EmailAddress
emailAddress ->
              Maybe Email -> SeldaTransactionT m (Maybe Email)
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Email -> SeldaTransactionT m (Maybe Email))
-> Maybe Email -> SeldaTransactionT m (Maybe Email)
forall a b. (a -> b) -> a -> b
$
                Email -> Maybe Email
forall a. a -> Maybe a
Just
                  MkEmail
                    { emailRecipient :: EmailAddress
emailRecipient = EmailAddress
emailAddress
                    , emailTitle :: Text
emailTitle = Text
"Created Reservation: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IdentifierReservation -> Text
forall a. ToPrettyText a => a -> Text
toPrettyText (Reservation -> IdentifierReservation
reservationId Reservation
reservation)
                    , emailBodyHtml :: Text
emailBodyHtml = Text -> Text
TL.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Html -> Text
T.renderHtml (Html -> Text) -> Html -> Text
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.docTypeHtml (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                        Html -> Html
H.head (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                          Html -> Html
H.title (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
H.text Text
"Created Reservation: " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> IdentifierReservation -> Html
forall a. ToPrettyHtml5 a => a -> Html
toPrettyHtml5 (Reservation -> IdentifierReservation
reservationId Reservation
reservation)
                        Html -> Html
H.body (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                          Html -> Html
H.p (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
H.text Text
"Your reservation was created successfully."
                          Html -> Html
H.p (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
H.text Text
"Reservation: " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> IdentifierReservation -> Html
forall a. ToPrettyHtml5 a => a -> Html
toPrettyHtml5 (Reservation -> IdentifierReservation
reservationId Reservation
reservation)
                          Html -> Html
H.p (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
H.text Text
"Space: " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> NameSpace -> Html
forall a. ToPrettyHtml5 a => a -> Html
toPrettyHtml5 (Space -> NameSpace
spaceName Space
space) Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
" (" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> IdentifierSpace -> Html
forall a. ToPrettyHtml5 a => a -> Html
toPrettyHtml5 (Space -> IdentifierSpace
spaceId Space
space) Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
")"
                          Html -> Html
H.p (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
H.text Text
"Desk: " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> NameDesk -> Html
forall a. ToPrettyHtml5 a => a -> Html
toPrettyHtml5 (Desk -> NameDesk
deskName Desk
desk) Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
" (" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> IdentifierDesk -> Html
forall a. ToPrettyHtml5 a => a -> Html
toPrettyHtml5 (Reservation -> IdentifierDesk
reservationDesk Reservation
reservation) Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
")"
                          Html -> Html
H.p (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
H.text Text
"User: " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Username -> Html
forall a. ToPrettyHtml5 a => a -> Html
toPrettyHtml5 (User -> Username
userName User
user) Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
" (" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> IdentifierUser -> Html
forall a. ToPrettyHtml5 a => a -> Html
toPrettyHtml5 (User -> IdentifierUser
userId User
user) Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
")"
                          Html -> Html
H.p (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
H.text Text
"Timezone: " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> TZLabel -> Html
forall a. ToPrettyHtml5 a => a -> Html
toPrettyHtml5 (Space -> TZLabel
spaceTimezone Space
space)
                          Html -> Html
H.p (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
H.text Text
"From: " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> LocalTime -> Html
forall a. ToPrettyHtml5 a => a -> Html
toPrettyHtml5 (TZ -> UTCTime -> LocalTime
Time.utcToLocalTimeTZ (TZLabel -> TZ
Time.tzByLabel (TZLabel -> TZ) -> TZLabel -> TZ
forall a b. (a -> b) -> a -> b
$ Space -> TZLabel
spaceTimezone Space
space) (UTCTime -> LocalTime) -> UTCTime -> LocalTime
forall a b. (a -> b) -> a -> b
$ Reservation -> UTCTime
reservationTimeBegin Reservation
reservation)
                          Html -> Html
H.p (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
H.text Text
"To: " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> LocalTime -> Html
forall a. ToPrettyHtml5 a => a -> Html
toPrettyHtml5 (TZ -> UTCTime -> LocalTime
Time.utcToLocalTimeTZ (TZLabel -> TZ
Time.tzByLabel (TZLabel -> TZ) -> TZLabel -> TZ
forall a b. (a -> b) -> a -> b
$ Space -> TZLabel
spaceTimezone Space
space) (UTCTime -> LocalTime) -> UTCTime -> LocalTime
forall a b. (a -> b) -> a -> b
$ Reservation -> UTCTime
reservationTimeEnd Reservation
reservation)
                    }
            EmailPreferences
MkEmailPreferencesDontSend ->
              Maybe Email -> SeldaTransactionT m (Maybe Email)
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Email
forall a. Maybe a
Nothing
        (IdentifierReservation, Maybe Email)
-> SeldaTransactionT m (IdentifierReservation, Maybe Email)
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IdentifierReservation
reservationIdentifier, Maybe Email
maybeEmail)
      Proxy 'MkPermissionCreateReservation
-> SeldaResult (IdentifierReservation, Maybe Email)
-> (SeldaResult (IdentifierReservation, Maybe Email)
    -> 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 @MkPermissionCreateReservation)
        SeldaResult (IdentifierReservation, Maybe Email)
seldaResult
        ((SeldaResult (IdentifierReservation, Maybe Email)
  -> m (Union responses))
 -> m (Union responses))
-> (SeldaResult (IdentifierReservation, Maybe Email)
    -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult (IdentifierReservation, Maybe Email)
seldaResultAfter403 ->
          Proxy SqlErrorMensamDeskAlreadyReserved
-> WithStatus
     409
     (StaticText "Desk is not available within the given time window.")
-> SeldaResult (IdentifierReservation, Maybe Email)
-> (SeldaResult (IdentifierReservation, Maybe Email)
    -> 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 @SqlErrorMensamDeskAlreadyReserved)
            (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @409 (StaticText "Desk is not available within the given time window."
 -> WithStatus
      409
      (StaticText "Desk is not available within the given time window."))
-> StaticText "Desk is not available within the given time window."
-> WithStatus
     409
     (StaticText "Desk is not available within the given time window.")
forall a b. (a -> b) -> a -> b
$ forall (text :: Symbol). StaticText text
MkStaticText @"Desk is not available within the given time window.")
            SeldaResult (IdentifierReservation, Maybe Email)
seldaResultAfter403
            ((SeldaResult (IdentifierReservation, Maybe Email)
  -> m (Union responses))
 -> m (Union responses))
-> (SeldaResult (IdentifierReservation, Maybe Email)
    -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult (IdentifierReservation, Maybe Email)
seldaResultAfter409 ->
              WithStatus 500 ()
-> SeldaResult (IdentifierReservation, Maybe Email)
-> ((IdentifierReservation, Maybe Email) -> 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 (IdentifierReservation, Maybe Email)
seldaResultAfter409 (((IdentifierReservation, Maybe Email) -> m (Union responses))
 -> m (Union responses))
-> ((IdentifierReservation, Maybe Email) -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \(IdentifierReservation
reservationIdentifier, Maybe Email
maybeEmail) -> do
                Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Created reservation."
                Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Sending notification email."
                Maybe SendEmailResult
maybeSendEmailResult <-
                  case Maybe Email
maybeEmail of
                    Maybe Email
Nothing -> do
                      Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Not sending a notification email."
                      Maybe SendEmailResult -> m (Maybe SendEmailResult)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SendEmailResult
forall a. Maybe a
Nothing
                    Just Email
email -> SendEmailResult -> Maybe SendEmailResult
forall a. a -> Maybe a
Just (SendEmailResult -> Maybe SendEmailResult)
-> m SendEmailResult -> m (Maybe SendEmailResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Email -> m SendEmailResult
forall (m :: * -> *). MonadEmail m => Email -> m SendEmailResult
sendEmail Email
email
                let emailSent :: Maybe Bool
emailSent =
                      case Maybe SendEmailResult
maybeSendEmailResult of
                        Just SendEmailResult
EmailSent -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
                        Just SendEmailResult
EmailFailedToSend -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
                        Maybe SendEmailResult
Nothing -> Maybe Bool
forall a. Maybe a
Nothing
                WithStatus 201 ResponseReservationCreate -> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 201 ResponseReservationCreate -> m (Union responses))
-> WithStatus 201 ResponseReservationCreate -> m (Union responses)
forall a b. (a -> b) -> a -> b
$
                  forall (k :: Nat) a. a -> WithStatus k a
WithStatus @201
                    MkResponseReservationCreate
                      { responseReservationCreateId :: IdentifierReservation
responseReservationCreateId = IdentifierReservation
reservationIdentifier
                      , responseReservationCreateEmailSent :: Maybe Bool
responseReservationCreateEmailSent = Maybe Bool
emailSent
                      }

cancelReservation ::
  ( MonadIO m
  , MonadLogger m
  , MonadSeldaPool m
  , IsMember (WithStatus 200 ResponseReservationCancel) responses
  , IsMember (WithStatus 400 ErrorParseBodyJson) responses
  , IsMember (WithStatus 401 ErrorBearerAuth) responses
  , IsMember (WithStatus 403 (ErrorInsufficientPermission MkPermissionCancelReservation)) responses
  , IsMember (WithStatus 409 (StaticText "Already cancelled.")) responses
  , IsMember (WithStatus 410 (StaticText "Already happened.")) responses
  , IsMember (WithStatus 500 ()) responses
  ) =>
  AuthResult UserAuthenticated ->
  Either String RequestReservationCancel ->
  m (Union responses)
cancelReservation :: forall (m :: * -> *) (responses :: [*]).
(MonadIO m, MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseReservationCancel) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember
   (WithStatus
      403 (ErrorInsufficientPermission 'MkPermissionCancelReservation))
   responses,
 IsMember
   (WithStatus 409 (StaticText "Already cancelled.")) responses,
 IsMember
   (WithStatus 410 (StaticText "Already happened.")) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestReservationCancel -> m (Union responses)
cancelReservation AuthResult UserAuthenticated
auth Either String RequestReservationCancel
eitherRequest = do
  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 RequestReservationCancel
-> (RequestReservationCancel -> 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 RequestReservationCancel
eitherRequest ((RequestReservationCancel -> m (Union responses))
 -> m (Union responses))
-> (RequestReservationCancel -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \RequestReservationCancel
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 cancel reservation: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (RequestReservationCancel -> String
forall a. Show a => a -> String
show RequestReservationCancel
request)
      let reservationIdentifier :: IdentifierReservation
reservationIdentifier = RequestReservationCancel -> IdentifierReservation
requestReservationCancelId RequestReservationCancel
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
        Reservation
reservation <- IdentifierReservation -> SeldaTransactionT m Reservation
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierReservation -> SeldaTransactionT m Reservation
reservationGet IdentifierReservation
reservationIdentifier
        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
$ Reservation -> IdentifierDesk
reservationDesk Reservation
reservation
        SPermission 'MkPermissionCancelReservation
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
forall (m :: * -> *) (p :: Permission).
(MonadLogger m, MonadSeldaPool m, Typeable p) =>
SPermission p
-> IdentifierUser -> IdentifierSpace -> SeldaTransactionT m ()
checkPermission
          SPermission 'MkPermissionCancelReservation
SMkPermissionCancelReservation
          (UserAuthenticated -> IdentifierUser
userAuthenticatedId UserAuthenticated
authenticated)
          (Desk -> IdentifierSpace
deskSpace Desk
desk)
        IdentifierReservation -> SeldaTransactionT m ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
IdentifierReservation -> SeldaTransactionT m ()
reservationCancel IdentifierReservation
reservationIdentifier
      Proxy 'MkPermissionCancelReservation
-> 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 @MkPermissionCancelReservation)
        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 SqlErrorMensamReservationAlreadyCancelled
-> WithStatus 409 (StaticText "Already cancelled.")
-> 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 @SqlErrorMensamReservationAlreadyCancelled)
            (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @409 (StaticText "Already cancelled."
 -> WithStatus 409 (StaticText "Already cancelled."))
-> StaticText "Already cancelled."
-> WithStatus 409 (StaticText "Already cancelled.")
forall a b. (a -> b) -> a -> b
$ forall (text :: Symbol). StaticText text
MkStaticText @"Already cancelled.")
            SeldaResult ()
seldaResultAfter403
            ((SeldaResult () -> m (Union responses)) -> m (Union responses))
-> (SeldaResult () -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult ()
seldaResultAfter409 ->
              Proxy SqlErrorMensamReservationIsInThePast
-> WithStatus 410 (StaticText "Already happened.")
-> 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 @SqlErrorMensamReservationIsInThePast)
                (forall (k :: Nat) a. a -> WithStatus k a
WithStatus @410 (StaticText "Already happened."
 -> WithStatus 410 (StaticText "Already happened."))
-> StaticText "Already happened."
-> WithStatus 410 (StaticText "Already happened.")
forall a b. (a -> b) -> a -> b
$ forall (text :: Symbol). StaticText text
MkStaticText @"Already happened.")
                SeldaResult ()
seldaResultAfter409
                ((SeldaResult () -> m (Union responses)) -> m (Union responses))
-> (SeldaResult () -> m (Union responses)) -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \SeldaResult ()
seldaResultAfter410 ->
                  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 ()
seldaResultAfter410 ((() -> 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
"Cancelled reservation."
                    WithStatus 200 ResponseReservationCancel -> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 200 ResponseReservationCancel -> m (Union responses))
-> WithStatus 200 ResponseReservationCancel -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ forall (k :: Nat) a. a -> WithStatus k a
WithStatus @200 MkResponseReservationCancel {responseReservationCancelUnit :: ()
responseReservationCancelUnit = ()}

listReservations ::
  ( MonadLogger m
  , MonadSeldaPool m
  , IsMember (WithStatus 200 ResponseReservationList) responses
  , IsMember (WithStatus 400 ErrorParseBodyJson) responses
  , IsMember (WithStatus 401 ErrorBearerAuth) responses
  , IsMember (WithStatus 500 ()) responses
  ) =>
  AuthResult UserAuthenticated ->
  Either String RequestReservationList ->
  m (Union responses)
listReservations :: forall (m :: * -> *) (responses :: [*]).
(MonadLogger m, MonadSeldaPool m,
 IsMember (WithStatus 200 ResponseReservationList) responses,
 IsMember (WithStatus 400 ErrorParseBodyJson) responses,
 IsMember (WithStatus 401 ErrorBearerAuth) responses,
 IsMember (WithStatus 500 ()) responses) =>
AuthResult UserAuthenticated
-> Either String RequestReservationList -> m (Union responses)
listReservations AuthResult UserAuthenticated
auth Either String RequestReservationList
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 RequestReservationList
-> (RequestReservationList -> 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 RequestReservationList
eitherRequest ((RequestReservationList -> m (Union responses))
 -> m (Union responses))
-> (RequestReservationList -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \RequestReservationList
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 a user's reservations: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (RequestReservationList -> String
forall a. Show a => a -> String
show RequestReservationList
request)
      SeldaResult [ReservationWithInfo]
seldaResult <- SeldaTransactionT m [ReservationWithInfo]
-> m (SeldaResult [ReservationWithInfo])
forall a. SeldaTransactionT m a -> m (SeldaResult a)
forall (m :: * -> *) a.
MonadSeldaPool m =>
SeldaTransactionT m a -> m (SeldaResult a)
runSeldaTransactionT (SeldaTransactionT m [ReservationWithInfo]
 -> m (SeldaResult [ReservationWithInfo]))
-> SeldaTransactionT m [ReservationWithInfo]
-> m (SeldaResult [ReservationWithInfo])
forall a b. (a -> b) -> a -> b
$ do
        [Reservation]
reservations <- IdentifierUser
-> IntervalUnbounded UTCTime -> SeldaTransactionT m [Reservation]
forall (m :: * -> *).
(MonadLogger m, MonadSeldaPool m) =>
IdentifierUser
-> IntervalUnbounded UTCTime -> SeldaTransactionT m [Reservation]
reservationListUser (UserAuthenticated -> IdentifierUser
userAuthenticatedId UserAuthenticated
authenticated) (RequestReservationList -> IntervalUnbounded UTCTime
requestReservationListTimeWindow RequestReservationList
request)
        [Reservation]
-> (Reservation -> SeldaTransactionT m ReservationWithInfo)
-> SeldaTransactionT m [ReservationWithInfo]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Reservation]
reservations ((Reservation -> SeldaTransactionT m ReservationWithInfo)
 -> SeldaTransactionT m [ReservationWithInfo])
-> (Reservation -> SeldaTransactionT m ReservationWithInfo)
-> SeldaTransactionT m [ReservationWithInfo]
forall a b. (a -> b) -> a -> b
$ \Reservation
reservation -> 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
$ Reservation -> IdentifierDesk
reservationDesk Reservation
reservation
          Space
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
$ Desk -> IdentifierSpace
deskSpace Desk
desk
          ReservationWithInfo -> SeldaTransactionT m ReservationWithInfo
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            MkReservationWithInfo
              { reservationWithInfoReservation :: Reservation
reservationWithInfoReservation = Reservation
reservation
              , reservationWithInfoDesk :: Desk
reservationWithInfoDesk = Desk
desk
              , reservationWithInfoSpace :: Space
reservationWithInfoSpace = Space
space
              }
      WithStatus 500 ()
-> SeldaResult [ReservationWithInfo]
-> ([ReservationWithInfo] -> 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 [ReservationWithInfo]
seldaResult (([ReservationWithInfo] -> m (Union responses))
 -> m (Union responses))
-> ([ReservationWithInfo] -> m (Union responses))
-> m (Union responses)
forall a b. (a -> b) -> a -> b
$ \[ReservationWithInfo]
reservationsWithInfo -> do
        Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Listed user's reservations."
        WithStatus 200 ResponseReservationList -> m (Union responses)
forall x (xs :: [*]) (f :: * -> *).
(Applicative f, HasStatus x, IsMember x xs) =>
x -> f (Union xs)
respond (WithStatus 200 ResponseReservationList -> m (Union responses))
-> WithStatus 200 ResponseReservationList -> m (Union responses)
forall a b. (a -> b) -> a -> b
$ forall (k :: Nat) a. a -> WithStatus k a
WithStatus @200 MkResponseReservationList {responseReservationListReservations :: [ReservationWithInfo]
responseReservationListReservations = [ReservationWithInfo]
reservationsWithInfo}

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

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)