{-# 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.MigrationHubConfig.GetHomeRegion
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the calling account’s home region, if configured. This API is
-- used by other AWS services to determine the regional endpoint for
-- calling AWS Application Discovery Service and Migration Hub. You must
-- call @GetHomeRegion@ at least once before you call any other AWS
-- Application Discovery Service and AWS Migration Hub APIs, to obtain the
-- account\'s Migration Hub home region.
module Amazonka.MigrationHubConfig.GetHomeRegion
  ( -- * Creating a Request
    GetHomeRegion (..),
    newGetHomeRegion,

    -- * Destructuring the Response
    GetHomeRegionResponse (..),
    newGetHomeRegionResponse,

    -- * Response Lenses
    getHomeRegionResponse_homeRegion,
    getHomeRegionResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetHomeRegion' smart constructor.
data GetHomeRegion = GetHomeRegion'
  {
  }
  deriving (GetHomeRegion -> GetHomeRegion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetHomeRegion -> GetHomeRegion -> Bool
$c/= :: GetHomeRegion -> GetHomeRegion -> Bool
== :: GetHomeRegion -> GetHomeRegion -> Bool
$c== :: GetHomeRegion -> GetHomeRegion -> Bool
Prelude.Eq, ReadPrec [GetHomeRegion]
ReadPrec GetHomeRegion
Int -> ReadS GetHomeRegion
ReadS [GetHomeRegion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetHomeRegion]
$creadListPrec :: ReadPrec [GetHomeRegion]
readPrec :: ReadPrec GetHomeRegion
$creadPrec :: ReadPrec GetHomeRegion
readList :: ReadS [GetHomeRegion]
$creadList :: ReadS [GetHomeRegion]
readsPrec :: Int -> ReadS GetHomeRegion
$creadsPrec :: Int -> ReadS GetHomeRegion
Prelude.Read, Int -> GetHomeRegion -> ShowS
[GetHomeRegion] -> ShowS
GetHomeRegion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetHomeRegion] -> ShowS
$cshowList :: [GetHomeRegion] -> ShowS
show :: GetHomeRegion -> String
$cshow :: GetHomeRegion -> String
showsPrec :: Int -> GetHomeRegion -> ShowS
$cshowsPrec :: Int -> GetHomeRegion -> ShowS
Prelude.Show, forall x. Rep GetHomeRegion x -> GetHomeRegion
forall x. GetHomeRegion -> Rep GetHomeRegion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetHomeRegion x -> GetHomeRegion
$cfrom :: forall x. GetHomeRegion -> Rep GetHomeRegion x
Prelude.Generic)

-- |
-- Create a value of 'GetHomeRegion' 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.
newGetHomeRegion ::
  GetHomeRegion
newGetHomeRegion :: GetHomeRegion
newGetHomeRegion = GetHomeRegion
GetHomeRegion'

instance Core.AWSRequest GetHomeRegion where
  type
    AWSResponse GetHomeRegion =
      GetHomeRegionResponse
  request :: (Service -> Service) -> GetHomeRegion -> Request GetHomeRegion
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 GetHomeRegion
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetHomeRegion)))
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 -> Int -> GetHomeRegionResponse
GetHomeRegionResponse'
            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
"HomeRegion")
            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 GetHomeRegion where
  hashWithSalt :: Int -> GetHomeRegion -> Int
hashWithSalt Int
_salt GetHomeRegion
_ =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ()

instance Prelude.NFData GetHomeRegion where
  rnf :: GetHomeRegion -> ()
rnf GetHomeRegion
_ = ()

instance Data.ToHeaders GetHomeRegion where
  toHeaders :: GetHomeRegion -> 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
"AWSMigrationHubMultiAccountService.GetHomeRegion" ::
                          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 GetHomeRegion where
  toJSON :: GetHomeRegion -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

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

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

-- | /See:/ 'newGetHomeRegionResponse' smart constructor.
data GetHomeRegionResponse = GetHomeRegionResponse'
  { -- | The name of the home region of the calling account.
    GetHomeRegionResponse -> Maybe Text
homeRegion :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetHomeRegionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetHomeRegionResponse -> GetHomeRegionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetHomeRegionResponse -> GetHomeRegionResponse -> Bool
$c/= :: GetHomeRegionResponse -> GetHomeRegionResponse -> Bool
== :: GetHomeRegionResponse -> GetHomeRegionResponse -> Bool
$c== :: GetHomeRegionResponse -> GetHomeRegionResponse -> Bool
Prelude.Eq, ReadPrec [GetHomeRegionResponse]
ReadPrec GetHomeRegionResponse
Int -> ReadS GetHomeRegionResponse
ReadS [GetHomeRegionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetHomeRegionResponse]
$creadListPrec :: ReadPrec [GetHomeRegionResponse]
readPrec :: ReadPrec GetHomeRegionResponse
$creadPrec :: ReadPrec GetHomeRegionResponse
readList :: ReadS [GetHomeRegionResponse]
$creadList :: ReadS [GetHomeRegionResponse]
readsPrec :: Int -> ReadS GetHomeRegionResponse
$creadsPrec :: Int -> ReadS GetHomeRegionResponse
Prelude.Read, Int -> GetHomeRegionResponse -> ShowS
[GetHomeRegionResponse] -> ShowS
GetHomeRegionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetHomeRegionResponse] -> ShowS
$cshowList :: [GetHomeRegionResponse] -> ShowS
show :: GetHomeRegionResponse -> String
$cshow :: GetHomeRegionResponse -> String
showsPrec :: Int -> GetHomeRegionResponse -> ShowS
$cshowsPrec :: Int -> GetHomeRegionResponse -> ShowS
Prelude.Show, forall x. Rep GetHomeRegionResponse x -> GetHomeRegionResponse
forall x. GetHomeRegionResponse -> Rep GetHomeRegionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetHomeRegionResponse x -> GetHomeRegionResponse
$cfrom :: forall x. GetHomeRegionResponse -> Rep GetHomeRegionResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetHomeRegionResponse' 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:
--
-- 'homeRegion', 'getHomeRegionResponse_homeRegion' - The name of the home region of the calling account.
--
-- 'httpStatus', 'getHomeRegionResponse_httpStatus' - The response's http status code.
newGetHomeRegionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetHomeRegionResponse
newGetHomeRegionResponse :: Int -> GetHomeRegionResponse
newGetHomeRegionResponse Int
pHttpStatus_ =
  GetHomeRegionResponse'
    { $sel:homeRegion:GetHomeRegionResponse' :: Maybe Text
homeRegion =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetHomeRegionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The name of the home region of the calling account.
getHomeRegionResponse_homeRegion :: Lens.Lens' GetHomeRegionResponse (Prelude.Maybe Prelude.Text)
getHomeRegionResponse_homeRegion :: Lens' GetHomeRegionResponse (Maybe Text)
getHomeRegionResponse_homeRegion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetHomeRegionResponse' {Maybe Text
homeRegion :: Maybe Text
$sel:homeRegion:GetHomeRegionResponse' :: GetHomeRegionResponse -> Maybe Text
homeRegion} -> Maybe Text
homeRegion) (\s :: GetHomeRegionResponse
s@GetHomeRegionResponse' {} Maybe Text
a -> GetHomeRegionResponse
s {$sel:homeRegion:GetHomeRegionResponse' :: Maybe Text
homeRegion = Maybe Text
a} :: GetHomeRegionResponse)

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

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