{-# 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.SageMaker.AddAssociation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates an /association/ between the source and the destination. A
-- source can be associated with multiple destinations, and a destination
-- can be associated with multiple sources. An association is a lineage
-- tracking entity. For more information, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/lineage-tracking.html Amazon SageMaker ML Lineage Tracking>.
module Amazonka.SageMaker.AddAssociation
  ( -- * Creating a Request
    AddAssociation (..),
    newAddAssociation,

    -- * Request Lenses
    addAssociation_associationType,
    addAssociation_sourceArn,
    addAssociation_destinationArn,

    -- * Destructuring the Response
    AddAssociationResponse (..),
    newAddAssociationResponse,

    -- * Response Lenses
    addAssociationResponse_destinationArn,
    addAssociationResponse_sourceArn,
    addAssociationResponse_httpStatus,
  )
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.SageMaker.Types

-- | /See:/ 'newAddAssociation' smart constructor.
data AddAssociation = AddAssociation'
  { -- | The type of association. The following are suggested uses for each type.
    -- Amazon SageMaker places no restrictions on their use.
    --
    -- -   ContributedTo - The source contributed to the destination or had a
    --     part in enabling the destination. For example, the training data
    --     contributed to the training job.
    --
    -- -   AssociatedWith - The source is connected to the destination. For
    --     example, an approval workflow is associated with a model deployment.
    --
    -- -   DerivedFrom - The destination is a modification of the source. For
    --     example, a digest output of a channel input for a processing job is
    --     derived from the original inputs.
    --
    -- -   Produced - The source generated the destination. For example, a
    --     training job produced a model artifact.
    AddAssociation -> Maybe AssociationEdgeType
associationType :: Prelude.Maybe AssociationEdgeType,
    -- | The ARN of the source.
    AddAssociation -> Text
sourceArn :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the destination.
    AddAssociation -> Text
destinationArn :: Prelude.Text
  }
  deriving (AddAssociation -> AddAssociation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddAssociation -> AddAssociation -> Bool
$c/= :: AddAssociation -> AddAssociation -> Bool
== :: AddAssociation -> AddAssociation -> Bool
$c== :: AddAssociation -> AddAssociation -> Bool
Prelude.Eq, ReadPrec [AddAssociation]
ReadPrec AddAssociation
Int -> ReadS AddAssociation
ReadS [AddAssociation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddAssociation]
$creadListPrec :: ReadPrec [AddAssociation]
readPrec :: ReadPrec AddAssociation
$creadPrec :: ReadPrec AddAssociation
readList :: ReadS [AddAssociation]
$creadList :: ReadS [AddAssociation]
readsPrec :: Int -> ReadS AddAssociation
$creadsPrec :: Int -> ReadS AddAssociation
Prelude.Read, Int -> AddAssociation -> ShowS
[AddAssociation] -> ShowS
AddAssociation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddAssociation] -> ShowS
$cshowList :: [AddAssociation] -> ShowS
show :: AddAssociation -> String
$cshow :: AddAssociation -> String
showsPrec :: Int -> AddAssociation -> ShowS
$cshowsPrec :: Int -> AddAssociation -> ShowS
Prelude.Show, forall x. Rep AddAssociation x -> AddAssociation
forall x. AddAssociation -> Rep AddAssociation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddAssociation x -> AddAssociation
$cfrom :: forall x. AddAssociation -> Rep AddAssociation x
Prelude.Generic)

-- |
-- Create a value of 'AddAssociation' 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:
--
-- 'associationType', 'addAssociation_associationType' - The type of association. The following are suggested uses for each type.
-- Amazon SageMaker places no restrictions on their use.
--
-- -   ContributedTo - The source contributed to the destination or had a
--     part in enabling the destination. For example, the training data
--     contributed to the training job.
--
-- -   AssociatedWith - The source is connected to the destination. For
--     example, an approval workflow is associated with a model deployment.
--
-- -   DerivedFrom - The destination is a modification of the source. For
--     example, a digest output of a channel input for a processing job is
--     derived from the original inputs.
--
-- -   Produced - The source generated the destination. For example, a
--     training job produced a model artifact.
--
-- 'sourceArn', 'addAssociation_sourceArn' - The ARN of the source.
--
-- 'destinationArn', 'addAssociation_destinationArn' - The Amazon Resource Name (ARN) of the destination.
newAddAssociation ::
  -- | 'sourceArn'
  Prelude.Text ->
  -- | 'destinationArn'
  Prelude.Text ->
  AddAssociation
newAddAssociation :: Text -> Text -> AddAssociation
newAddAssociation Text
pSourceArn_ Text
pDestinationArn_ =
  AddAssociation'
    { $sel:associationType:AddAssociation' :: Maybe AssociationEdgeType
associationType = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceArn:AddAssociation' :: Text
sourceArn = Text
pSourceArn_,
      $sel:destinationArn:AddAssociation' :: Text
destinationArn = Text
pDestinationArn_
    }

-- | The type of association. The following are suggested uses for each type.
-- Amazon SageMaker places no restrictions on their use.
--
-- -   ContributedTo - The source contributed to the destination or had a
--     part in enabling the destination. For example, the training data
--     contributed to the training job.
--
-- -   AssociatedWith - The source is connected to the destination. For
--     example, an approval workflow is associated with a model deployment.
--
-- -   DerivedFrom - The destination is a modification of the source. For
--     example, a digest output of a channel input for a processing job is
--     derived from the original inputs.
--
-- -   Produced - The source generated the destination. For example, a
--     training job produced a model artifact.
addAssociation_associationType :: Lens.Lens' AddAssociation (Prelude.Maybe AssociationEdgeType)
addAssociation_associationType :: Lens' AddAssociation (Maybe AssociationEdgeType)
addAssociation_associationType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddAssociation' {Maybe AssociationEdgeType
associationType :: Maybe AssociationEdgeType
$sel:associationType:AddAssociation' :: AddAssociation -> Maybe AssociationEdgeType
associationType} -> Maybe AssociationEdgeType
associationType) (\s :: AddAssociation
s@AddAssociation' {} Maybe AssociationEdgeType
a -> AddAssociation
s {$sel:associationType:AddAssociation' :: Maybe AssociationEdgeType
associationType = Maybe AssociationEdgeType
a} :: AddAssociation)

-- | The ARN of the source.
addAssociation_sourceArn :: Lens.Lens' AddAssociation Prelude.Text
addAssociation_sourceArn :: Lens' AddAssociation Text
addAssociation_sourceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddAssociation' {Text
sourceArn :: Text
$sel:sourceArn:AddAssociation' :: AddAssociation -> Text
sourceArn} -> Text
sourceArn) (\s :: AddAssociation
s@AddAssociation' {} Text
a -> AddAssociation
s {$sel:sourceArn:AddAssociation' :: Text
sourceArn = Text
a} :: AddAssociation)

-- | The Amazon Resource Name (ARN) of the destination.
addAssociation_destinationArn :: Lens.Lens' AddAssociation Prelude.Text
addAssociation_destinationArn :: Lens' AddAssociation Text
addAssociation_destinationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddAssociation' {Text
destinationArn :: Text
$sel:destinationArn:AddAssociation' :: AddAssociation -> Text
destinationArn} -> Text
destinationArn) (\s :: AddAssociation
s@AddAssociation' {} Text
a -> AddAssociation
s {$sel:destinationArn:AddAssociation' :: Text
destinationArn = Text
a} :: AddAssociation)

instance Core.AWSRequest AddAssociation where
  type
    AWSResponse AddAssociation =
      AddAssociationResponse
  request :: (Service -> Service) -> AddAssociation -> Request AddAssociation
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 AddAssociation
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse AddAssociation)))
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 ->
          Maybe Text -> Maybe Text -> Int -> AddAssociationResponse
AddAssociationResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"DestinationArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"SourceArn")
            forall (f :: * -> *) a b. Applicative f => 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))
      )

instance Prelude.Hashable AddAssociation where
  hashWithSalt :: Int -> AddAssociation -> Int
hashWithSalt Int
_salt AddAssociation' {Maybe AssociationEdgeType
Text
destinationArn :: Text
sourceArn :: Text
associationType :: Maybe AssociationEdgeType
$sel:destinationArn:AddAssociation' :: AddAssociation -> Text
$sel:sourceArn:AddAssociation' :: AddAssociation -> Text
$sel:associationType:AddAssociation' :: AddAssociation -> Maybe AssociationEdgeType
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AssociationEdgeType
associationType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sourceArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
destinationArn

instance Prelude.NFData AddAssociation where
  rnf :: AddAssociation -> ()
rnf AddAssociation' {Maybe AssociationEdgeType
Text
destinationArn :: Text
sourceArn :: Text
associationType :: Maybe AssociationEdgeType
$sel:destinationArn:AddAssociation' :: AddAssociation -> Text
$sel:sourceArn:AddAssociation' :: AddAssociation -> Text
$sel:associationType:AddAssociation' :: AddAssociation -> Maybe AssociationEdgeType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AssociationEdgeType
associationType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
sourceArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
destinationArn

instance Data.ToHeaders AddAssociation where
  toHeaders :: AddAssociation -> 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
"SageMaker.AddAssociation" :: 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 AddAssociation where
  toJSON :: AddAssociation -> Value
toJSON AddAssociation' {Maybe AssociationEdgeType
Text
destinationArn :: Text
sourceArn :: Text
associationType :: Maybe AssociationEdgeType
$sel:destinationArn:AddAssociation' :: AddAssociation -> Text
$sel:sourceArn:AddAssociation' :: AddAssociation -> Text
$sel:associationType:AddAssociation' :: AddAssociation -> Maybe AssociationEdgeType
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AssociationType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe AssociationEdgeType
associationType,
            forall a. a -> Maybe a
Prelude.Just (Key
"SourceArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
sourceArn),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"DestinationArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
destinationArn)
          ]
      )

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

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

-- | /See:/ 'newAddAssociationResponse' smart constructor.
data AddAssociationResponse = AddAssociationResponse'
  { -- | The Amazon Resource Name (ARN) of the destination.
    AddAssociationResponse -> Maybe Text
destinationArn :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the source.
    AddAssociationResponse -> Maybe Text
sourceArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    AddAssociationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AddAssociationResponse -> AddAssociationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddAssociationResponse -> AddAssociationResponse -> Bool
$c/= :: AddAssociationResponse -> AddAssociationResponse -> Bool
== :: AddAssociationResponse -> AddAssociationResponse -> Bool
$c== :: AddAssociationResponse -> AddAssociationResponse -> Bool
Prelude.Eq, ReadPrec [AddAssociationResponse]
ReadPrec AddAssociationResponse
Int -> ReadS AddAssociationResponse
ReadS [AddAssociationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddAssociationResponse]
$creadListPrec :: ReadPrec [AddAssociationResponse]
readPrec :: ReadPrec AddAssociationResponse
$creadPrec :: ReadPrec AddAssociationResponse
readList :: ReadS [AddAssociationResponse]
$creadList :: ReadS [AddAssociationResponse]
readsPrec :: Int -> ReadS AddAssociationResponse
$creadsPrec :: Int -> ReadS AddAssociationResponse
Prelude.Read, Int -> AddAssociationResponse -> ShowS
[AddAssociationResponse] -> ShowS
AddAssociationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddAssociationResponse] -> ShowS
$cshowList :: [AddAssociationResponse] -> ShowS
show :: AddAssociationResponse -> String
$cshow :: AddAssociationResponse -> String
showsPrec :: Int -> AddAssociationResponse -> ShowS
$cshowsPrec :: Int -> AddAssociationResponse -> ShowS
Prelude.Show, forall x. Rep AddAssociationResponse x -> AddAssociationResponse
forall x. AddAssociationResponse -> Rep AddAssociationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddAssociationResponse x -> AddAssociationResponse
$cfrom :: forall x. AddAssociationResponse -> Rep AddAssociationResponse x
Prelude.Generic)

-- |
-- Create a value of 'AddAssociationResponse' 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:
--
-- 'destinationArn', 'addAssociationResponse_destinationArn' - The Amazon Resource Name (ARN) of the destination.
--
-- 'sourceArn', 'addAssociationResponse_sourceArn' - The ARN of the source.
--
-- 'httpStatus', 'addAssociationResponse_httpStatus' - The response's http status code.
newAddAssociationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AddAssociationResponse
newAddAssociationResponse :: Int -> AddAssociationResponse
newAddAssociationResponse Int
pHttpStatus_ =
  AddAssociationResponse'
    { $sel:destinationArn:AddAssociationResponse' :: Maybe Text
destinationArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:sourceArn:AddAssociationResponse' :: Maybe Text
sourceArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AddAssociationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the destination.
addAssociationResponse_destinationArn :: Lens.Lens' AddAssociationResponse (Prelude.Maybe Prelude.Text)
addAssociationResponse_destinationArn :: Lens' AddAssociationResponse (Maybe Text)
addAssociationResponse_destinationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddAssociationResponse' {Maybe Text
destinationArn :: Maybe Text
$sel:destinationArn:AddAssociationResponse' :: AddAssociationResponse -> Maybe Text
destinationArn} -> Maybe Text
destinationArn) (\s :: AddAssociationResponse
s@AddAssociationResponse' {} Maybe Text
a -> AddAssociationResponse
s {$sel:destinationArn:AddAssociationResponse' :: Maybe Text
destinationArn = Maybe Text
a} :: AddAssociationResponse)

-- | The ARN of the source.
addAssociationResponse_sourceArn :: Lens.Lens' AddAssociationResponse (Prelude.Maybe Prelude.Text)
addAssociationResponse_sourceArn :: Lens' AddAssociationResponse (Maybe Text)
addAssociationResponse_sourceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddAssociationResponse' {Maybe Text
sourceArn :: Maybe Text
$sel:sourceArn:AddAssociationResponse' :: AddAssociationResponse -> Maybe Text
sourceArn} -> Maybe Text
sourceArn) (\s :: AddAssociationResponse
s@AddAssociationResponse' {} Maybe Text
a -> AddAssociationResponse
s {$sel:sourceArn:AddAssociationResponse' :: Maybe Text
sourceArn = Maybe Text
a} :: AddAssociationResponse)

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

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