-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

-- | Most of the errors thrown by galley are defined as static errors in
-- 'Wire.API.Error.Galley' and declared as part of the API. Errors defined here
-- are dynamic, and mostly internal.
module Galley.API.Error
  ( -- * Internal errors
    InvalidInput (..),
    InternalError (..),
    internalErrorWithDescription,
    internalErrorDescription,
    legalHoldServiceUnavailable,
  )
where

import Data.Id
import Data.Text.Lazy as LT (pack)
import Imports
import Network.HTTP.Types.Status
import Network.Wai.Utilities (Error (message))
import Network.Wai.Utilities.Error qualified as Wai
import Wire.API.Error

data InternalError
  = BadConvState ConvId
  | BadMemberState
  | NoPrekeyForUser
  | CannotCreateManagedConv
  | InternalErrorWithDescription LText
  deriving (InternalError -> InternalError -> Bool
(InternalError -> InternalError -> Bool)
-> (InternalError -> InternalError -> Bool) -> Eq InternalError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InternalError -> InternalError -> Bool
== :: InternalError -> InternalError -> Bool
$c/= :: InternalError -> InternalError -> Bool
/= :: InternalError -> InternalError -> Bool
Eq)

internalErrorDescription :: InternalError -> LText
internalErrorDescription :: InternalError -> LText
internalErrorDescription = Error -> LText
message (Error -> LText)
-> (InternalError -> Error) -> InternalError -> LText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InternalError -> Error
internalErrorToWai

internalErrorToWai :: InternalError -> Wai.Error
internalErrorToWai :: InternalError -> Error
internalErrorToWai (BadConvState ConvId
convId) = ConvId -> Error
badConvState ConvId
convId
internalErrorToWai InternalError
BadMemberState = Status -> LText -> LText -> Error
Wai.mkError Status
status500 LText
"bad-state" LText
"Bad internal member state."
internalErrorToWai InternalError
NoPrekeyForUser = Error
internalError
internalErrorToWai InternalError
CannotCreateManagedConv = Error
internalError
internalErrorToWai (InternalErrorWithDescription LText
t) = LText -> Error
internalErrorWithDescription LText
t

instance APIError InternalError where
  toResponse :: InternalError -> JSONResponse
toResponse = Error -> JSONResponse
forall e. APIError e => e -> JSONResponse
toResponse (Error -> JSONResponse)
-> (InternalError -> Error) -> InternalError -> JSONResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InternalError -> Error
internalErrorToWai

data InvalidInput
  = CustomRolesNotSupported
  | InvalidRange LText
  | InvalidUUID4
  | InvalidPayload LText
  | FederationFunctionNotSupported LText

instance APIError InvalidInput where
  toResponse :: InvalidInput -> JSONResponse
toResponse InvalidInput
CustomRolesNotSupported = Error -> JSONResponse
forall e. APIError e => e -> JSONResponse
toResponse (Error -> JSONResponse) -> Error -> JSONResponse
forall a b. (a -> b) -> a -> b
$ LText -> Error
badRequest LText
"Custom roles not supported"
  toResponse (InvalidRange LText
t) = Error -> JSONResponse
forall e. APIError e => e -> JSONResponse
toResponse (Error -> JSONResponse) -> Error -> JSONResponse
forall a b. (a -> b) -> a -> b
$ LText -> Error
invalidRange LText
t
  toResponse InvalidInput
InvalidUUID4 = Error -> JSONResponse
forall e. APIError e => e -> JSONResponse
toResponse Error
invalidUUID4
  toResponse (InvalidPayload LText
t) = Error -> JSONResponse
forall e. APIError e => e -> JSONResponse
toResponse (Error -> JSONResponse) -> Error -> JSONResponse
forall a b. (a -> b) -> a -> b
$ LText -> Error
invalidPayload LText
t
  toResponse (FederationFunctionNotSupported LText
t) = Error -> JSONResponse
forall e. APIError e => e -> JSONResponse
toResponse (Error -> JSONResponse) -> Error -> JSONResponse
forall a b. (a -> b) -> a -> b
$ LText -> Error
federationFunctionNotSupported LText
t

----------------------------------------------------------------------------
-- Other errors

internalError :: Wai.Error
internalError :: Error
internalError = LText -> Error
internalErrorWithDescription LText
"internal error"

internalErrorWithDescription :: LText -> Wai.Error
internalErrorWithDescription :: LText -> Error
internalErrorWithDescription = Status -> LText -> LText -> Error
Wai.mkError Status
status500 LText
"internal-error"

invalidPayload :: LText -> Wai.Error
invalidPayload :: LText -> Error
invalidPayload = Status -> LText -> LText -> Error
Wai.mkError Status
status400 LText
"invalid-payload"

badRequest :: LText -> Wai.Error
badRequest :: LText -> Error
badRequest = Status -> LText -> LText -> Error
Wai.mkError Status
status400 LText
"bad-request"

federationFunctionNotSupported :: LText -> Wai.Error
federationFunctionNotSupported :: LText -> Error
federationFunctionNotSupported = Status -> LText -> LText -> Error
Wai.mkError Status
status400 LText
"federation-function-not-supported"

invalidUUID4 :: Wai.Error
invalidUUID4 :: Error
invalidUUID4 = Status -> LText -> LText -> Error
Wai.mkError Status
status400 LText
"client-error" LText
"Invalid UUID v4 format"

invalidRange :: LText -> Wai.Error
invalidRange :: LText -> Error
invalidRange = Status -> LText -> LText -> Error
Wai.mkError Status
status400 LText
"client-error"

badConvState :: ConvId -> Wai.Error
badConvState :: ConvId -> Error
badConvState ConvId
cid =
  Status -> LText -> LText -> Error
Wai.mkError Status
status500 LText
"bad-state" (LText -> Error) -> LText -> Error
forall a b. (a -> b) -> a -> b
$
    LText
"Connect conversation with more than 2 members: "
      LText -> LText -> LText
forall a. Semigroup a => a -> a -> a
<> String -> LText
LT.pack (ConvId -> String
forall a. Show a => a -> String
show ConvId
cid)

legalHoldServiceUnavailable :: (Show a) => a -> Wai.Error
legalHoldServiceUnavailable :: forall a. Show a => a -> Error
legalHoldServiceUnavailable a
e = Status -> LText -> LText -> Error
Wai.mkError Status
status412 LText
"legalhold-unavailable" (LText
"legal hold service unavailable with underlying error: " LText -> LText -> LText
forall a. Semigroup a => a -> a -> a
<> (String -> LText
LT.pack (String -> LText) -> (a -> String) -> a -> LText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show (a -> LText) -> a -> LText
forall a b. (a -> b) -> a -> b
$ a
e))