-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2024 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/>.
module Wire.AuthenticationSubsystem.Error where

import Imports
import Wire.API.Error
import Wire.API.Error.Brig qualified as E
import Wire.Error

-- | Authentication errors.
data AuthError
  = AuthInvalidUser
  | AuthInvalidCredentials
  | AuthSuspended
  | AuthEphemeral
  | AuthPendingInvitation
  deriving (Int -> AuthError -> ShowS
[AuthError] -> ShowS
AuthError -> String
(Int -> AuthError -> ShowS)
-> (AuthError -> String)
-> ([AuthError] -> ShowS)
-> Show AuthError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthError -> ShowS
showsPrec :: Int -> AuthError -> ShowS
$cshow :: AuthError -> String
show :: AuthError -> String
$cshowList :: [AuthError] -> ShowS
showList :: [AuthError] -> ShowS
Show, AuthError -> AuthError -> Bool
(AuthError -> AuthError -> Bool)
-> (AuthError -> AuthError -> Bool) -> Eq AuthError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthError -> AuthError -> Bool
== :: AuthError -> AuthError -> Bool
$c/= :: AuthError -> AuthError -> Bool
/= :: AuthError -> AuthError -> Bool
Eq)

instance Exception AuthError

-- | Re-authentication errors.
data ReAuthError
  = ReAuthError !AuthError
  | ReAuthMissingPassword
  | ReAuthCodeVerificationRequired
  | ReAuthCodeVerificationNoPendingCode
  | ReAuthCodeVerificationNoEmail
  deriving (Int -> ReAuthError -> ShowS
[ReAuthError] -> ShowS
ReAuthError -> String
(Int -> ReAuthError -> ShowS)
-> (ReAuthError -> String)
-> ([ReAuthError] -> ShowS)
-> Show ReAuthError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReAuthError -> ShowS
showsPrec :: Int -> ReAuthError -> ShowS
$cshow :: ReAuthError -> String
show :: ReAuthError -> String
$cshowList :: [ReAuthError] -> ShowS
showList :: [ReAuthError] -> ShowS
Show, ReAuthError -> ReAuthError -> Bool
(ReAuthError -> ReAuthError -> Bool)
-> (ReAuthError -> ReAuthError -> Bool) -> Eq ReAuthError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReAuthError -> ReAuthError -> Bool
== :: ReAuthError -> ReAuthError -> Bool
$c/= :: ReAuthError -> ReAuthError -> Bool
/= :: ReAuthError -> ReAuthError -> Bool
Eq)

instance Exception ReAuthError

data AuthenticationSubsystemError
  = AuthenticationSubsystemInvalidPasswordResetKey
  | AuthenticationSubsystemResetPasswordMustDiffer
  | AuthenticationSubsystemInvalidPasswordResetCode
  | AuthenticationSubsystemInvalidPhone
  | AuthenticationSubsystemAllowListError
  | AuthenticationSubsystemBadCredentials
  deriving (AuthenticationSubsystemError
-> AuthenticationSubsystemError -> Bool
(AuthenticationSubsystemError
 -> AuthenticationSubsystemError -> Bool)
-> (AuthenticationSubsystemError
    -> AuthenticationSubsystemError -> Bool)
-> Eq AuthenticationSubsystemError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthenticationSubsystemError
-> AuthenticationSubsystemError -> Bool
== :: AuthenticationSubsystemError
-> AuthenticationSubsystemError -> Bool
$c/= :: AuthenticationSubsystemError
-> AuthenticationSubsystemError -> Bool
/= :: AuthenticationSubsystemError
-> AuthenticationSubsystemError -> Bool
Eq, Int -> AuthenticationSubsystemError -> ShowS
[AuthenticationSubsystemError] -> ShowS
AuthenticationSubsystemError -> String
(Int -> AuthenticationSubsystemError -> ShowS)
-> (AuthenticationSubsystemError -> String)
-> ([AuthenticationSubsystemError] -> ShowS)
-> Show AuthenticationSubsystemError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthenticationSubsystemError -> ShowS
showsPrec :: Int -> AuthenticationSubsystemError -> ShowS
$cshow :: AuthenticationSubsystemError -> String
show :: AuthenticationSubsystemError -> String
$cshowList :: [AuthenticationSubsystemError] -> ShowS
showList :: [AuthenticationSubsystemError] -> ShowS
Show)

instance Exception AuthenticationSubsystemError

authenticationSubsystemErrorToHttpError :: AuthenticationSubsystemError -> HttpError
authenticationSubsystemErrorToHttpError :: AuthenticationSubsystemError -> HttpError
authenticationSubsystemErrorToHttpError =
  Error -> HttpError
StdError (Error -> HttpError)
-> (AuthenticationSubsystemError -> Error)
-> AuthenticationSubsystemError
-> HttpError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    AuthenticationSubsystemError
AuthenticationSubsystemInvalidPasswordResetKey -> forall {k} (e :: k). KnownError (MapError e) => Error
forall (e :: BrigError). KnownError (MapError e) => Error
errorToWai @E.InvalidPasswordResetKey
    AuthenticationSubsystemError
AuthenticationSubsystemInvalidPasswordResetCode -> forall {k} (e :: k). KnownError (MapError e) => Error
forall (e :: BrigError). KnownError (MapError e) => Error
errorToWai @E.InvalidPasswordResetCode
    AuthenticationSubsystemError
AuthenticationSubsystemResetPasswordMustDiffer -> forall {k} (e :: k). KnownError (MapError e) => Error
forall (e :: BrigError). KnownError (MapError e) => Error
errorToWai @E.ResetPasswordMustDiffer
    AuthenticationSubsystemError
AuthenticationSubsystemInvalidPhone -> forall {k} (e :: k). KnownError (MapError e) => Error
forall (e :: BrigError). KnownError (MapError e) => Error
errorToWai @E.InvalidPhone
    AuthenticationSubsystemError
AuthenticationSubsystemAllowListError -> forall {k} (e :: k). KnownError (MapError e) => Error
forall (e :: BrigError). KnownError (MapError e) => Error
errorToWai @E.AllowlistError
    AuthenticationSubsystemError
AuthenticationSubsystemBadCredentials -> forall {k} (e :: k). KnownError (MapError e) => Error
forall (e :: BrigError). KnownError (MapError e) => Error
errorToWai @E.BadCredentials