-- SPDX-FileCopyrightText: 2026 Alexandra de Wit
--
-- SPDX-License-Identifier: MIT

{- | The @amazonka@ edge of the transport-fault vocabulary: fold the AWS error sum into
"Ecluse.Core.Fault" at an adapter boundary.

Three adapters face the same 'Amazonka.Error', so the classification lives once, here: the SQS
mirror queue, the advisory sync's S3 transport, and the CodeArtifact store maintenance leaf. A
service-level refusal (a throttle, an access denial, a serialisation surprise) is
'TransportProtocol' with the rendered error as detail: the wire worked, the service said no.
-}
module Ecluse.Runtime.Aws.Fault (
    classifyAwsTransport,
    sendClassified,
) where

import Amazonka qualified as AWS
import Control.Monad.Trans.Resource (runResourceT)

import Ecluse.Core.Fault (TransportCause (TransportProtocol), TransportFault, transportFault)
import Ecluse.Core.Fault.Http (classifyTransport)
import Ecluse.Core.Text (displayExceptionT)

-- | Classify an @amazonka@ error into the core transport vocabulary.
classifyAwsTransport :: AWS.Error -> TransportFault
classifyAwsTransport :: Error -> TransportFault
classifyAwsTransport = \case
    AWS.TransportError HttpException
httpErr -> HttpException -> TransportFault
classifyTransport HttpException
httpErr
    Error
err -> TransportCause -> Text -> TransportFault
transportFault TransportCause
TransportProtocol (Error -> Text
forall e. Exception e => e -> Text
displayExceptionT Error
err)

{- | Send a request with the AWS error kept out of the exception channel and folded into the
caller's own fault type, which is how every adapter here reports a failure as a value.
-}
sendClassified ::
    (AWS.AWSRequest a) =>
    (AWS.Error -> e) ->
    AWS.Env ->
    a ->
    IO (Either e (AWS.AWSResponse a))
sendClassified :: forall a e.
AWSRequest a =>
(Error -> e) -> Env -> a -> IO (Either e (AWSResponse a))
sendClassified Error -> e
classify Env
env = (Either Error (AWSResponse a) -> Either e (AWSResponse a))
-> IO (Either Error (AWSResponse a))
-> IO (Either e (AWSResponse a))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Error -> e)
-> Either Error (AWSResponse a) -> Either e (AWSResponse a)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Error -> e
classify) (IO (Either Error (AWSResponse a))
 -> IO (Either e (AWSResponse a)))
-> (a -> IO (Either Error (AWSResponse a)))
-> a
-> IO (Either e (AWSResponse a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceT IO (Either Error (AWSResponse a))
-> IO (Either Error (AWSResponse a))
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO (Either Error (AWSResponse a))
 -> IO (Either Error (AWSResponse a)))
-> (a -> ResourceT IO (Either Error (AWSResponse a)))
-> a
-> IO (Either Error (AWSResponse a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> a -> ResourceT IO (Either Error (AWSResponse a))
forall (m :: * -> *) a.
(MonadResource m, AWSRequest a) =>
Env -> a -> m (Either Error (AWSResponse a))
AWS.sendEither Env
env