{-# 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.IoTSiteWise.CreateGateway
-- 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 a gateway, which is a virtual or edge device that delivers
-- industrial data streams from local servers to IoT SiteWise. For more
-- information, see
-- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/gateway-connector.html Ingesting data using a gateway>
-- in the /IoT SiteWise User Guide/.
module Amazonka.IoTSiteWise.CreateGateway
  ( -- * Creating a Request
    CreateGateway (..),
    newCreateGateway,

    -- * Request Lenses
    createGateway_tags,
    createGateway_gatewayName,
    createGateway_gatewayPlatform,

    -- * Destructuring the Response
    CreateGatewayResponse (..),
    newCreateGatewayResponse,

    -- * Response Lenses
    createGatewayResponse_httpStatus,
    createGatewayResponse_gatewayId,
    createGatewayResponse_gatewayArn,
  )
where

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

-- | /See:/ 'newCreateGateway' smart constructor.
data CreateGateway = CreateGateway'
  { -- | A list of key-value pairs that contain metadata for the gateway. For
    -- more information, see
    -- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/tag-resources.html Tagging your IoT SiteWise resources>
    -- in the /IoT SiteWise User Guide/.
    CreateGateway -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A unique, friendly name for the gateway.
    CreateGateway -> Text
gatewayName :: Prelude.Text,
    -- | The gateway\'s platform. You can only specify one platform in a gateway.
    CreateGateway -> GatewayPlatform
gatewayPlatform :: GatewayPlatform
  }
  deriving (CreateGateway -> CreateGateway -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateGateway -> CreateGateway -> Bool
$c/= :: CreateGateway -> CreateGateway -> Bool
== :: CreateGateway -> CreateGateway -> Bool
$c== :: CreateGateway -> CreateGateway -> Bool
Prelude.Eq, ReadPrec [CreateGateway]
ReadPrec CreateGateway
Int -> ReadS CreateGateway
ReadS [CreateGateway]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateGateway]
$creadListPrec :: ReadPrec [CreateGateway]
readPrec :: ReadPrec CreateGateway
$creadPrec :: ReadPrec CreateGateway
readList :: ReadS [CreateGateway]
$creadList :: ReadS [CreateGateway]
readsPrec :: Int -> ReadS CreateGateway
$creadsPrec :: Int -> ReadS CreateGateway
Prelude.Read, Int -> CreateGateway -> ShowS
[CreateGateway] -> ShowS
CreateGateway -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateGateway] -> ShowS
$cshowList :: [CreateGateway] -> ShowS
show :: CreateGateway -> String
$cshow :: CreateGateway -> String
showsPrec :: Int -> CreateGateway -> ShowS
$cshowsPrec :: Int -> CreateGateway -> ShowS
Prelude.Show, forall x. Rep CreateGateway x -> CreateGateway
forall x. CreateGateway -> Rep CreateGateway x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateGateway x -> CreateGateway
$cfrom :: forall x. CreateGateway -> Rep CreateGateway x
Prelude.Generic)

-- |
-- Create a value of 'CreateGateway' 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:
--
-- 'tags', 'createGateway_tags' - A list of key-value pairs that contain metadata for the gateway. For
-- more information, see
-- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/tag-resources.html Tagging your IoT SiteWise resources>
-- in the /IoT SiteWise User Guide/.
--
-- 'gatewayName', 'createGateway_gatewayName' - A unique, friendly name for the gateway.
--
-- 'gatewayPlatform', 'createGateway_gatewayPlatform' - The gateway\'s platform. You can only specify one platform in a gateway.
newCreateGateway ::
  -- | 'gatewayName'
  Prelude.Text ->
  -- | 'gatewayPlatform'
  GatewayPlatform ->
  CreateGateway
newCreateGateway :: Text -> GatewayPlatform -> CreateGateway
newCreateGateway Text
pGatewayName_ GatewayPlatform
pGatewayPlatform_ =
  CreateGateway'
    { $sel:tags:CreateGateway' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:gatewayName:CreateGateway' :: Text
gatewayName = Text
pGatewayName_,
      $sel:gatewayPlatform:CreateGateway' :: GatewayPlatform
gatewayPlatform = GatewayPlatform
pGatewayPlatform_
    }

-- | A list of key-value pairs that contain metadata for the gateway. For
-- more information, see
-- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/tag-resources.html Tagging your IoT SiteWise resources>
-- in the /IoT SiteWise User Guide/.
createGateway_tags :: Lens.Lens' CreateGateway (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createGateway_tags :: Lens' CreateGateway (Maybe (HashMap Text Text))
createGateway_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGateway' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateGateway' :: CreateGateway -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateGateway
s@CreateGateway' {} Maybe (HashMap Text Text)
a -> CreateGateway
s {$sel:tags:CreateGateway' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateGateway) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A unique, friendly name for the gateway.
createGateway_gatewayName :: Lens.Lens' CreateGateway Prelude.Text
createGateway_gatewayName :: Lens' CreateGateway Text
createGateway_gatewayName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGateway' {Text
gatewayName :: Text
$sel:gatewayName:CreateGateway' :: CreateGateway -> Text
gatewayName} -> Text
gatewayName) (\s :: CreateGateway
s@CreateGateway' {} Text
a -> CreateGateway
s {$sel:gatewayName:CreateGateway' :: Text
gatewayName = Text
a} :: CreateGateway)

-- | The gateway\'s platform. You can only specify one platform in a gateway.
createGateway_gatewayPlatform :: Lens.Lens' CreateGateway GatewayPlatform
createGateway_gatewayPlatform :: Lens' CreateGateway GatewayPlatform
createGateway_gatewayPlatform = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGateway' {GatewayPlatform
gatewayPlatform :: GatewayPlatform
$sel:gatewayPlatform:CreateGateway' :: CreateGateway -> GatewayPlatform
gatewayPlatform} -> GatewayPlatform
gatewayPlatform) (\s :: CreateGateway
s@CreateGateway' {} GatewayPlatform
a -> CreateGateway
s {$sel:gatewayPlatform:CreateGateway' :: GatewayPlatform
gatewayPlatform = GatewayPlatform
a} :: CreateGateway)

instance Core.AWSRequest CreateGateway where
  type
    AWSResponse CreateGateway =
      CreateGatewayResponse
  request :: (Service -> Service) -> CreateGateway -> Request CreateGateway
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 CreateGateway
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateGateway)))
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 -> Text -> CreateGatewayResponse
CreateGatewayResponse'
            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
"gatewayId")
            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
"gatewayArn")
      )

instance Prelude.Hashable CreateGateway where
  hashWithSalt :: Int -> CreateGateway -> Int
hashWithSalt Int
_salt CreateGateway' {Maybe (HashMap Text Text)
Text
GatewayPlatform
gatewayPlatform :: GatewayPlatform
gatewayName :: Text
tags :: Maybe (HashMap Text Text)
$sel:gatewayPlatform:CreateGateway' :: CreateGateway -> GatewayPlatform
$sel:gatewayName:CreateGateway' :: CreateGateway -> Text
$sel:tags:CreateGateway' :: CreateGateway -> Maybe (HashMap Text Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
gatewayName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` GatewayPlatform
gatewayPlatform

instance Prelude.NFData CreateGateway where
  rnf :: CreateGateway -> ()
rnf CreateGateway' {Maybe (HashMap Text Text)
Text
GatewayPlatform
gatewayPlatform :: GatewayPlatform
gatewayName :: Text
tags :: Maybe (HashMap Text Text)
$sel:gatewayPlatform:CreateGateway' :: CreateGateway -> GatewayPlatform
$sel:gatewayName:CreateGateway' :: CreateGateway -> Text
$sel:tags:CreateGateway' :: CreateGateway -> Maybe (HashMap Text Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
gatewayName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf GatewayPlatform
gatewayPlatform

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

instance Data.ToJSON CreateGateway where
  toJSON :: CreateGateway -> Value
toJSON CreateGateway' {Maybe (HashMap Text Text)
Text
GatewayPlatform
gatewayPlatform :: GatewayPlatform
gatewayName :: Text
tags :: Maybe (HashMap Text Text)
$sel:gatewayPlatform:CreateGateway' :: CreateGateway -> GatewayPlatform
$sel:gatewayName:CreateGateway' :: CreateGateway -> Text
$sel:tags:CreateGateway' :: CreateGateway -> Maybe (HashMap Text Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"tags" 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 (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"gatewayName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
gatewayName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"gatewayPlatform" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= GatewayPlatform
gatewayPlatform)
          ]
      )

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

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

-- | /See:/ 'newCreateGatewayResponse' smart constructor.
data CreateGatewayResponse = CreateGatewayResponse'
  { -- | The response's http status code.
    CreateGatewayResponse -> Int
httpStatus :: Prelude.Int,
    -- | The ID of the gateway device. You can use this ID when you call other
    -- IoT SiteWise APIs.
    CreateGatewayResponse -> Text
gatewayId :: Prelude.Text,
    -- | The
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
    -- of the gateway, which has the following format.
    --
    -- @arn:${Partition}:iotsitewise:${Region}:${Account}:gateway\/${GatewayId}@
    CreateGatewayResponse -> Text
gatewayArn :: Prelude.Text
  }
  deriving (CreateGatewayResponse -> CreateGatewayResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateGatewayResponse -> CreateGatewayResponse -> Bool
$c/= :: CreateGatewayResponse -> CreateGatewayResponse -> Bool
== :: CreateGatewayResponse -> CreateGatewayResponse -> Bool
$c== :: CreateGatewayResponse -> CreateGatewayResponse -> Bool
Prelude.Eq, ReadPrec [CreateGatewayResponse]
ReadPrec CreateGatewayResponse
Int -> ReadS CreateGatewayResponse
ReadS [CreateGatewayResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateGatewayResponse]
$creadListPrec :: ReadPrec [CreateGatewayResponse]
readPrec :: ReadPrec CreateGatewayResponse
$creadPrec :: ReadPrec CreateGatewayResponse
readList :: ReadS [CreateGatewayResponse]
$creadList :: ReadS [CreateGatewayResponse]
readsPrec :: Int -> ReadS CreateGatewayResponse
$creadsPrec :: Int -> ReadS CreateGatewayResponse
Prelude.Read, Int -> CreateGatewayResponse -> ShowS
[CreateGatewayResponse] -> ShowS
CreateGatewayResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateGatewayResponse] -> ShowS
$cshowList :: [CreateGatewayResponse] -> ShowS
show :: CreateGatewayResponse -> String
$cshow :: CreateGatewayResponse -> String
showsPrec :: Int -> CreateGatewayResponse -> ShowS
$cshowsPrec :: Int -> CreateGatewayResponse -> ShowS
Prelude.Show, forall x. Rep CreateGatewayResponse x -> CreateGatewayResponse
forall x. CreateGatewayResponse -> Rep CreateGatewayResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateGatewayResponse x -> CreateGatewayResponse
$cfrom :: forall x. CreateGatewayResponse -> Rep CreateGatewayResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateGatewayResponse' 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', 'createGatewayResponse_httpStatus' - The response's http status code.
--
-- 'gatewayId', 'createGatewayResponse_gatewayId' - The ID of the gateway device. You can use this ID when you call other
-- IoT SiteWise APIs.
--
-- 'gatewayArn', 'createGatewayResponse_gatewayArn' - The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
-- of the gateway, which has the following format.
--
-- @arn:${Partition}:iotsitewise:${Region}:${Account}:gateway\/${GatewayId}@
newCreateGatewayResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'gatewayId'
  Prelude.Text ->
  -- | 'gatewayArn'
  Prelude.Text ->
  CreateGatewayResponse
newCreateGatewayResponse :: Int -> Text -> Text -> CreateGatewayResponse
newCreateGatewayResponse
  Int
pHttpStatus_
  Text
pGatewayId_
  Text
pGatewayArn_ =
    CreateGatewayResponse'
      { $sel:httpStatus:CreateGatewayResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:gatewayId:CreateGatewayResponse' :: Text
gatewayId = Text
pGatewayId_,
        $sel:gatewayArn:CreateGatewayResponse' :: Text
gatewayArn = Text
pGatewayArn_
      }

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

-- | The ID of the gateway device. You can use this ID when you call other
-- IoT SiteWise APIs.
createGatewayResponse_gatewayId :: Lens.Lens' CreateGatewayResponse Prelude.Text
createGatewayResponse_gatewayId :: Lens' CreateGatewayResponse Text
createGatewayResponse_gatewayId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGatewayResponse' {Text
gatewayId :: Text
$sel:gatewayId:CreateGatewayResponse' :: CreateGatewayResponse -> Text
gatewayId} -> Text
gatewayId) (\s :: CreateGatewayResponse
s@CreateGatewayResponse' {} Text
a -> CreateGatewayResponse
s {$sel:gatewayId:CreateGatewayResponse' :: Text
gatewayId = Text
a} :: CreateGatewayResponse)

-- | The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
-- of the gateway, which has the following format.
--
-- @arn:${Partition}:iotsitewise:${Region}:${Account}:gateway\/${GatewayId}@
createGatewayResponse_gatewayArn :: Lens.Lens' CreateGatewayResponse Prelude.Text
createGatewayResponse_gatewayArn :: Lens' CreateGatewayResponse Text
createGatewayResponse_gatewayArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGatewayResponse' {Text
gatewayArn :: Text
$sel:gatewayArn:CreateGatewayResponse' :: CreateGatewayResponse -> Text
gatewayArn} -> Text
gatewayArn) (\s :: CreateGatewayResponse
s@CreateGatewayResponse' {} Text
a -> CreateGatewayResponse
s {$sel:gatewayArn:CreateGatewayResponse' :: Text
gatewayArn = Text
a} :: CreateGatewayResponse)

instance Prelude.NFData CreateGatewayResponse where
  rnf :: CreateGatewayResponse -> ()
rnf CreateGatewayResponse' {Int
Text
gatewayArn :: Text
gatewayId :: Text
httpStatus :: Int
$sel:gatewayArn:CreateGatewayResponse' :: CreateGatewayResponse -> Text
$sel:gatewayId:CreateGatewayResponse' :: CreateGatewayResponse -> Text
$sel:httpStatus:CreateGatewayResponse' :: CreateGatewayResponse -> 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
gatewayId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
gatewayArn