--
-- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc.
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
--     http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.
--

module Network.Minio.Errors
  ( MErrV (..),
    ServiceErr (..),
    MinioErr (..),
    toServiceErr,
  )
where

import Control.Exception (IOException)
import qualified Network.HTTP.Conduit as NC

---------------------------------
-- Errors
---------------------------------

-- | Various validation errors
data MErrV
  = MErrVSinglePUTSizeExceeded Int64
  | MErrVPutSizeExceeded Int64
  | MErrVETagHeaderNotFound
  | MErrVInvalidObjectInfoResponse
  | MErrVInvalidSrcObjSpec Text
  | MErrVInvalidSrcObjByteRange (Int64, Int64)
  | MErrVCopyObjSingleNoRangeAccepted
  | MErrVRegionNotSupported Text
  | MErrVXmlParse Text
  | MErrVInvalidBucketName Text
  | MErrVInvalidObjectName Text
  | MErrVInvalidUrlExpiry Int
  | MErrVJsonParse Text
  | MErrVInvalidHealPath
  | MErrVMissingCredentials
  | MErrVInvalidEncryptionKeyLength
  | MErrVStreamingBodyUnexpectedEOF
  | MErrVUnexpectedPayload
  | MErrVSTSEndpointNotFound
  deriving stock (Int -> MErrV -> ShowS
[MErrV] -> ShowS
MErrV -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MErrV] -> ShowS
$cshowList :: [MErrV] -> ShowS
show :: MErrV -> String
$cshow :: MErrV -> String
showsPrec :: Int -> MErrV -> ShowS
$cshowsPrec :: Int -> MErrV -> ShowS
Show, MErrV -> MErrV -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MErrV -> MErrV -> Bool
$c/= :: MErrV -> MErrV -> Bool
== :: MErrV -> MErrV -> Bool
$c== :: MErrV -> MErrV -> Bool
Eq)

instance Exception MErrV

-- | Errors returned by S3 compatible service
data ServiceErr
  = BucketAlreadyExists
  | BucketAlreadyOwnedByYou
  | NoSuchBucket
  | InvalidBucketName
  | NoSuchKey
  | SelectErr Text Text
  | ServiceErr Text Text
  deriving stock (Int -> ServiceErr -> ShowS
[ServiceErr] -> ShowS
ServiceErr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServiceErr] -> ShowS
$cshowList :: [ServiceErr] -> ShowS
show :: ServiceErr -> String
$cshow :: ServiceErr -> String
showsPrec :: Int -> ServiceErr -> ShowS
$cshowsPrec :: Int -> ServiceErr -> ShowS
Show, ServiceErr -> ServiceErr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServiceErr -> ServiceErr -> Bool
$c/= :: ServiceErr -> ServiceErr -> Bool
== :: ServiceErr -> ServiceErr -> Bool
$c== :: ServiceErr -> ServiceErr -> Bool
Eq)

instance Exception ServiceErr

toServiceErr :: Text -> Text -> ServiceErr
toServiceErr :: Text -> Text -> ServiceErr
toServiceErr Text
"NoSuchKey" Text
_ = ServiceErr
NoSuchKey
toServiceErr Text
"NoSuchBucket" Text
_ = ServiceErr
NoSuchBucket
toServiceErr Text
"InvalidBucketName" Text
_ = ServiceErr
InvalidBucketName
toServiceErr Text
"BucketAlreadyOwnedByYou" Text
_ = ServiceErr
BucketAlreadyOwnedByYou
toServiceErr Text
"BucketAlreadyExists" Text
_ = ServiceErr
BucketAlreadyExists
toServiceErr Text
code Text
message = Text -> Text -> ServiceErr
ServiceErr Text
code Text
message

-- | Errors thrown by the library
data MinioErr
  = MErrHTTP NC.HttpException
  | MErrIO IOException
  | MErrService ServiceErr
  | MErrValidation MErrV
  deriving stock (Int -> MinioErr -> ShowS
[MinioErr] -> ShowS
MinioErr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MinioErr] -> ShowS
$cshowList :: [MinioErr] -> ShowS
show :: MinioErr -> String
$cshow :: MinioErr -> String
showsPrec :: Int -> MinioErr -> ShowS
$cshowsPrec :: Int -> MinioErr -> ShowS
Show)

instance Eq MinioErr where
  MErrHTTP HttpException
_ == :: MinioErr -> MinioErr -> Bool
== MErrHTTP HttpException
_ = Bool
True
  MErrHTTP HttpException
_ == MinioErr
_ = Bool
False
  MErrIO IOException
_ == MErrIO IOException
_ = Bool
True
  MErrIO IOException
_ == MinioErr
_ = Bool
False
  MErrService ServiceErr
a == MErrService ServiceErr
b = ServiceErr
a forall a. Eq a => a -> a -> Bool
== ServiceErr
b
  MErrService ServiceErr
_ == MinioErr
_ = Bool
False
  MErrValidation MErrV
a == MErrValidation MErrV
b = MErrV
a forall a. Eq a => a -> a -> Bool
== MErrV
b
  MErrValidation MErrV
_ == MinioErr
_ = Bool
False

instance Exception MinioErr