{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.Transfer.StartFileTransfer
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Begins an outbound file transfer to a remote AS2 server. You specify the
-- @ConnectorId@ and the file paths for where to send the files.
module Amazonka.Transfer.StartFileTransfer
  ( -- * Creating a Request
    StartFileTransfer (..),
    newStartFileTransfer,

    -- * Request Lenses
    startFileTransfer_connectorId,
    startFileTransfer_sendFilePaths,

    -- * Destructuring the Response
    StartFileTransferResponse (..),
    newStartFileTransferResponse,

    -- * Response Lenses
    startFileTransferResponse_httpStatus,
    startFileTransferResponse_transferId,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.Transfer.Types

-- | /See:/ 'newStartFileTransfer' smart constructor.
data StartFileTransfer = StartFileTransfer'
  { -- | The unique identifier for the connector.
    StartFileTransfer -> Text
connectorId :: Prelude.Text,
    -- | An array of strings. Each string represents the absolute path for one
    -- outbound file transfer. For example,
    -- @ @/@DOC-EXAMPLE-BUCKET@/@\/@/@myfile.txt@/@ @.
    StartFileTransfer -> NonEmpty Text
sendFilePaths :: Prelude.NonEmpty Prelude.Text
  }
  deriving (StartFileTransfer -> StartFileTransfer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartFileTransfer -> StartFileTransfer -> Bool
$c/= :: StartFileTransfer -> StartFileTransfer -> Bool
== :: StartFileTransfer -> StartFileTransfer -> Bool
$c== :: StartFileTransfer -> StartFileTransfer -> Bool
Prelude.Eq, ReadPrec [StartFileTransfer]
ReadPrec StartFileTransfer
Int -> ReadS StartFileTransfer
ReadS [StartFileTransfer]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartFileTransfer]
$creadListPrec :: ReadPrec [StartFileTransfer]
readPrec :: ReadPrec StartFileTransfer
$creadPrec :: ReadPrec StartFileTransfer
readList :: ReadS [StartFileTransfer]
$creadList :: ReadS [StartFileTransfer]
readsPrec :: Int -> ReadS StartFileTransfer
$creadsPrec :: Int -> ReadS StartFileTransfer
Prelude.Read, Int -> StartFileTransfer -> ShowS
[StartFileTransfer] -> ShowS
StartFileTransfer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartFileTransfer] -> ShowS
$cshowList :: [StartFileTransfer] -> ShowS
show :: StartFileTransfer -> String
$cshow :: StartFileTransfer -> String
showsPrec :: Int -> StartFileTransfer -> ShowS
$cshowsPrec :: Int -> StartFileTransfer -> ShowS
Prelude.Show, forall x. Rep StartFileTransfer x -> StartFileTransfer
forall x. StartFileTransfer -> Rep StartFileTransfer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartFileTransfer x -> StartFileTransfer
$cfrom :: forall x. StartFileTransfer -> Rep StartFileTransfer x
Prelude.Generic)

-- |
-- Create a value of 'StartFileTransfer' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'connectorId', 'startFileTransfer_connectorId' - The unique identifier for the connector.
--
-- 'sendFilePaths', 'startFileTransfer_sendFilePaths' - An array of strings. Each string represents the absolute path for one
-- outbound file transfer. For example,
-- @ @/@DOC-EXAMPLE-BUCKET@/@\/@/@myfile.txt@/@ @.
newStartFileTransfer ::
  -- | 'connectorId'
  Prelude.Text ->
  -- | 'sendFilePaths'
  Prelude.NonEmpty Prelude.Text ->
  StartFileTransfer
newStartFileTransfer :: Text -> NonEmpty Text -> StartFileTransfer
newStartFileTransfer Text
pConnectorId_ NonEmpty Text
pSendFilePaths_ =
  StartFileTransfer'
    { $sel:connectorId:StartFileTransfer' :: Text
connectorId = Text
pConnectorId_,
      $sel:sendFilePaths:StartFileTransfer' :: NonEmpty Text
sendFilePaths = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pSendFilePaths_
    }

-- | The unique identifier for the connector.
startFileTransfer_connectorId :: Lens.Lens' StartFileTransfer Prelude.Text
startFileTransfer_connectorId :: Lens' StartFileTransfer Text
startFileTransfer_connectorId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartFileTransfer' {Text
connectorId :: Text
$sel:connectorId:StartFileTransfer' :: StartFileTransfer -> Text
connectorId} -> Text
connectorId) (\s :: StartFileTransfer
s@StartFileTransfer' {} Text
a -> StartFileTransfer
s {$sel:connectorId:StartFileTransfer' :: Text
connectorId = Text
a} :: StartFileTransfer)

-- | An array of strings. Each string represents the absolute path for one
-- outbound file transfer. For example,
-- @ @/@DOC-EXAMPLE-BUCKET@/@\/@/@myfile.txt@/@ @.
startFileTransfer_sendFilePaths :: Lens.Lens' StartFileTransfer (Prelude.NonEmpty Prelude.Text)
startFileTransfer_sendFilePaths :: Lens' StartFileTransfer (NonEmpty Text)
startFileTransfer_sendFilePaths = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartFileTransfer' {NonEmpty Text
sendFilePaths :: NonEmpty Text
$sel:sendFilePaths:StartFileTransfer' :: StartFileTransfer -> NonEmpty Text
sendFilePaths} -> NonEmpty Text
sendFilePaths) (\s :: StartFileTransfer
s@StartFileTransfer' {} NonEmpty Text
a -> StartFileTransfer
s {$sel:sendFilePaths:StartFileTransfer' :: NonEmpty Text
sendFilePaths = NonEmpty Text
a} :: StartFileTransfer) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest StartFileTransfer where
  type
    AWSResponse StartFileTransfer =
      StartFileTransferResponse
  request :: (Service -> Service)
-> StartFileTransfer -> Request StartFileTransfer
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy StartFileTransfer
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartFileTransfer)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Int -> Text -> StartFileTransferResponse
StartFileTransferResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"TransferId")
      )

instance Prelude.Hashable StartFileTransfer where
  hashWithSalt :: Int -> StartFileTransfer -> Int
hashWithSalt Int
_salt StartFileTransfer' {NonEmpty Text
Text
sendFilePaths :: NonEmpty Text
connectorId :: Text
$sel:sendFilePaths:StartFileTransfer' :: StartFileTransfer -> NonEmpty Text
$sel:connectorId:StartFileTransfer' :: StartFileTransfer -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
connectorId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
sendFilePaths

instance Prelude.NFData StartFileTransfer where
  rnf :: StartFileTransfer -> ()
rnf StartFileTransfer' {NonEmpty Text
Text
sendFilePaths :: NonEmpty Text
connectorId :: Text
$sel:sendFilePaths:StartFileTransfer' :: StartFileTransfer -> NonEmpty Text
$sel:connectorId:StartFileTransfer' :: StartFileTransfer -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
connectorId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
sendFilePaths

instance Data.ToHeaders StartFileTransfer where
  toHeaders :: StartFileTransfer -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"TransferService.StartFileTransfer" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON StartFileTransfer where
  toJSON :: StartFileTransfer -> Value
toJSON StartFileTransfer' {NonEmpty Text
Text
sendFilePaths :: NonEmpty Text
connectorId :: Text
$sel:sendFilePaths:StartFileTransfer' :: StartFileTransfer -> NonEmpty Text
$sel:connectorId:StartFileTransfer' :: StartFileTransfer -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"ConnectorId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
connectorId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"SendFilePaths" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
sendFilePaths)
          ]
      )

instance Data.ToPath StartFileTransfer where
  toPath :: StartFileTransfer -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery StartFileTransfer where
  toQuery :: StartFileTransfer -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newStartFileTransferResponse' smart constructor.
data StartFileTransferResponse = StartFileTransferResponse'
  { -- | The response's http status code.
    StartFileTransferResponse -> Int
httpStatus :: Prelude.Int,
    -- | Returns the unique identifier for this file transfer.
    StartFileTransferResponse -> Text
transferId :: Prelude.Text
  }
  deriving (StartFileTransferResponse -> StartFileTransferResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartFileTransferResponse -> StartFileTransferResponse -> Bool
$c/= :: StartFileTransferResponse -> StartFileTransferResponse -> Bool
== :: StartFileTransferResponse -> StartFileTransferResponse -> Bool
$c== :: StartFileTransferResponse -> StartFileTransferResponse -> Bool
Prelude.Eq, ReadPrec [StartFileTransferResponse]
ReadPrec StartFileTransferResponse
Int -> ReadS StartFileTransferResponse
ReadS [StartFileTransferResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartFileTransferResponse]
$creadListPrec :: ReadPrec [StartFileTransferResponse]
readPrec :: ReadPrec StartFileTransferResponse
$creadPrec :: ReadPrec StartFileTransferResponse
readList :: ReadS [StartFileTransferResponse]
$creadList :: ReadS [StartFileTransferResponse]
readsPrec :: Int -> ReadS StartFileTransferResponse
$creadsPrec :: Int -> ReadS StartFileTransferResponse
Prelude.Read, Int -> StartFileTransferResponse -> ShowS
[StartFileTransferResponse] -> ShowS
StartFileTransferResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartFileTransferResponse] -> ShowS
$cshowList :: [StartFileTransferResponse] -> ShowS
show :: StartFileTransferResponse -> String
$cshow :: StartFileTransferResponse -> String
showsPrec :: Int -> StartFileTransferResponse -> ShowS
$cshowsPrec :: Int -> StartFileTransferResponse -> ShowS
Prelude.Show, forall x.
Rep StartFileTransferResponse x -> StartFileTransferResponse
forall x.
StartFileTransferResponse -> Rep StartFileTransferResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartFileTransferResponse x -> StartFileTransferResponse
$cfrom :: forall x.
StartFileTransferResponse -> Rep StartFileTransferResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartFileTransferResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'httpStatus', 'startFileTransferResponse_httpStatus' - The response's http status code.
--
-- 'transferId', 'startFileTransferResponse_transferId' - Returns the unique identifier for this file transfer.
newStartFileTransferResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'transferId'
  Prelude.Text ->
  StartFileTransferResponse
newStartFileTransferResponse :: Int -> Text -> StartFileTransferResponse
newStartFileTransferResponse
  Int
pHttpStatus_
  Text
pTransferId_ =
    StartFileTransferResponse'
      { $sel:httpStatus:StartFileTransferResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:transferId:StartFileTransferResponse' :: Text
transferId = Text
pTransferId_
      }

-- | The response's http status code.
startFileTransferResponse_httpStatus :: Lens.Lens' StartFileTransferResponse Prelude.Int
startFileTransferResponse_httpStatus :: Lens' StartFileTransferResponse Int
startFileTransferResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartFileTransferResponse' {Int
httpStatus :: Int
$sel:httpStatus:StartFileTransferResponse' :: StartFileTransferResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: StartFileTransferResponse
s@StartFileTransferResponse' {} Int
a -> StartFileTransferResponse
s {$sel:httpStatus:StartFileTransferResponse' :: Int
httpStatus = Int
a} :: StartFileTransferResponse)

-- | Returns the unique identifier for this file transfer.
startFileTransferResponse_transferId :: Lens.Lens' StartFileTransferResponse Prelude.Text
startFileTransferResponse_transferId :: Lens' StartFileTransferResponse Text
startFileTransferResponse_transferId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartFileTransferResponse' {Text
transferId :: Text
$sel:transferId:StartFileTransferResponse' :: StartFileTransferResponse -> Text
transferId} -> Text
transferId) (\s :: StartFileTransferResponse
s@StartFileTransferResponse' {} Text
a -> StartFileTransferResponse
s {$sel:transferId:StartFileTransferResponse' :: Text
transferId = Text
a} :: StartFileTransferResponse)

instance Prelude.NFData StartFileTransferResponse where
  rnf :: StartFileTransferResponse -> ()
rnf StartFileTransferResponse' {Int
Text
transferId :: Text
httpStatus :: Int
$sel:transferId:StartFileTransferResponse' :: StartFileTransferResponse -> Text
$sel:httpStatus:StartFileTransferResponse' :: StartFileTransferResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
transferId