{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE OverloadedStrings          #-}

{-# OPTIONS_GHC -Wall -Werror #-}

-- |
-- Module      : Amazonka.Route53.Internal
-- Copyright   : (c) 2013-2021 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--
module Amazonka.Route53.Internal
    ( Region     (..)
    , ResourceId (..)

      -- * Website Endpoints
    , getHostedZoneId
    ) where

import Amazonka.Core
import Amazonka.Prelude
import qualified Data.Text as Text

-- | A Route53 identifier for resources such as hosted zones and delegation sets.
--
-- Since Route53 outputs prefixed resource identifiers such as
-- @/hostedzone/ABC123@, but expects unprefixed identifiers as inputs, such as
-- @ABC123@, the 'FromXML' instance will strip this prefix take care to ensure
-- the correct input format is observed and @decodeXML . encodeXML == id@ holds.
newtype ResourceId = ResourceId { ResourceId -> Text
fromResourceId :: Text }
    deriving
        ( ResourceId -> ResourceId -> Bool
(ResourceId -> ResourceId -> Bool)
-> (ResourceId -> ResourceId -> Bool) -> Eq ResourceId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResourceId -> ResourceId -> Bool
$c/= :: ResourceId -> ResourceId -> Bool
== :: ResourceId -> ResourceId -> Bool
$c== :: ResourceId -> ResourceId -> Bool
Eq
        , Eq ResourceId
Eq ResourceId
-> (ResourceId -> ResourceId -> Ordering)
-> (ResourceId -> ResourceId -> Bool)
-> (ResourceId -> ResourceId -> Bool)
-> (ResourceId -> ResourceId -> Bool)
-> (ResourceId -> ResourceId -> Bool)
-> (ResourceId -> ResourceId -> ResourceId)
-> (ResourceId -> ResourceId -> ResourceId)
-> Ord ResourceId
ResourceId -> ResourceId -> Bool
ResourceId -> ResourceId -> Ordering
ResourceId -> ResourceId -> ResourceId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ResourceId -> ResourceId -> ResourceId
$cmin :: ResourceId -> ResourceId -> ResourceId
max :: ResourceId -> ResourceId -> ResourceId
$cmax :: ResourceId -> ResourceId -> ResourceId
>= :: ResourceId -> ResourceId -> Bool
$c>= :: ResourceId -> ResourceId -> Bool
> :: ResourceId -> ResourceId -> Bool
$c> :: ResourceId -> ResourceId -> Bool
<= :: ResourceId -> ResourceId -> Bool
$c<= :: ResourceId -> ResourceId -> Bool
< :: ResourceId -> ResourceId -> Bool
$c< :: ResourceId -> ResourceId -> Bool
compare :: ResourceId -> ResourceId -> Ordering
$ccompare :: ResourceId -> ResourceId -> Ordering
$cp1Ord :: Eq ResourceId
Ord
        , ReadPrec [ResourceId]
ReadPrec ResourceId
Int -> ReadS ResourceId
ReadS [ResourceId]
(Int -> ReadS ResourceId)
-> ReadS [ResourceId]
-> ReadPrec ResourceId
-> ReadPrec [ResourceId]
-> Read ResourceId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResourceId]
$creadListPrec :: ReadPrec [ResourceId]
readPrec :: ReadPrec ResourceId
$creadPrec :: ReadPrec ResourceId
readList :: ReadS [ResourceId]
$creadList :: ReadS [ResourceId]
readsPrec :: Int -> ReadS ResourceId
$creadsPrec :: Int -> ReadS ResourceId
Read
        , Int -> ResourceId -> ShowS
[ResourceId] -> ShowS
ResourceId -> String
(Int -> ResourceId -> ShowS)
-> (ResourceId -> String)
-> ([ResourceId] -> ShowS)
-> Show ResourceId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResourceId] -> ShowS
$cshowList :: [ResourceId] -> ShowS
show :: ResourceId -> String
$cshow :: ResourceId -> String
showsPrec :: Int -> ResourceId -> ShowS
$cshowsPrec :: Int -> ResourceId -> ShowS
Show
        , (forall x. ResourceId -> Rep ResourceId x)
-> (forall x. Rep ResourceId x -> ResourceId) -> Generic ResourceId
forall x. Rep ResourceId x -> ResourceId
forall x. ResourceId -> Rep ResourceId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResourceId x -> ResourceId
$cfrom :: forall x. ResourceId -> Rep ResourceId x
Generic
        , String -> ResourceId
(String -> ResourceId) -> IsString ResourceId
forall a. (String -> a) -> IsString a
fromString :: String -> ResourceId
$cfromString :: String -> ResourceId
IsString
        , Text -> Either String ResourceId
(Text -> Either String ResourceId) -> FromText ResourceId
forall a. (Text -> Either String a) -> FromText a
fromText :: Text -> Either String ResourceId
$cfromText :: Text -> Either String ResourceId
FromText
        , ResourceId -> Text
(ResourceId -> Text) -> ToText ResourceId
forall a. (a -> Text) -> ToText a
toText :: ResourceId -> Text
$ctoText :: ResourceId -> Text
ToText
        , ResourceId -> ByteString
(ResourceId -> ByteString) -> ToByteString ResourceId
forall a. (a -> ByteString) -> ToByteString a
toBS :: ResourceId -> ByteString
$ctoBS :: ResourceId -> ByteString
ToByteString
        , ResourceId -> XML
(ResourceId -> XML) -> ToXML ResourceId
forall a. (a -> XML) -> ToXML a
toXML :: ResourceId -> XML
$ctoXML :: ResourceId -> XML
ToXML
        , ResourceId -> QueryString
(ResourceId -> QueryString) -> ToQuery ResourceId
forall a. (a -> QueryString) -> ToQuery a
toQuery :: ResourceId -> QueryString
$ctoQuery :: ResourceId -> QueryString
ToQuery
        , ResourceId -> ByteStringBuilder
(ResourceId -> ByteStringBuilder) -> ToLog ResourceId
forall a. (a -> ByteStringBuilder) -> ToLog a
build :: ResourceId -> ByteStringBuilder
$cbuild :: ResourceId -> ByteStringBuilder
ToLog
        )

instance Hashable ResourceId
instance NFData   ResourceId

-- | Handles prefixed Route53 resource identifiers.
instance FromXML ResourceId where
    parseXML :: [Node] -> Either String ResourceId
parseXML = (Text -> ResourceId)
-> Either String Text -> Either String ResourceId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> ResourceId
ResourceId (Text -> ResourceId) -> (Text -> Text) -> Text -> ResourceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
Text.takeWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/')) (Either String Text -> Either String ResourceId)
-> ([Node] -> Either String Text)
-> [Node]
-> Either String ResourceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Node] -> Either String Text
forall a. FromXML a => [Node] -> Either String a
parseXML

-- | Get the hosted zone identifier for an S3 website endpoint.
--
-- When you configure your bucket as a website, the website is available using
-- a region-specific website endpoint. This hosted zone identifier is used
-- adding an alias record to the website to your hosted zone.
--
-- /See:/ <https://docs.aws.amazon.com/general/latest/gr/s3.html#s3_website_region_endpoints Amazon Simple Storage Service Website Endpoints>.
getHostedZoneId :: Region -> Maybe ResourceId
getHostedZoneId :: Region -> Maybe ResourceId
getHostedZoneId = \case
    Region
Ohio            -> ResourceId -> Maybe ResourceId
forall a. a -> Maybe a
Just ResourceId
"Z2O1EMRO9K5GLX"
    Region
NorthVirginia   -> ResourceId -> Maybe ResourceId
forall a. a -> Maybe a
Just ResourceId
"Z3AQBSTGFYJSTF"
    Region
NorthCalifornia -> ResourceId -> Maybe ResourceId
forall a. a -> Maybe a
Just ResourceId
"Z2F56UZL2M1ACD"
    Region
Oregon          -> ResourceId -> Maybe ResourceId
forall a. a -> Maybe a
Just ResourceId
"Z3BJ6K6RIION7M"
    Region
CapeTown        -> ResourceId -> Maybe ResourceId
forall a. a -> Maybe a
Just ResourceId
"Z11KHD8FBVPUYU"
    Region
HongKong        -> ResourceId -> Maybe ResourceId
forall a. a -> Maybe a
Just ResourceId
"ZNB98KWMFR0R6"
    Region
Mumbai          -> ResourceId -> Maybe ResourceId
forall a. a -> Maybe a
Just ResourceId
"Z11RGJOFQNVJUP"
    Region
Osaka           -> ResourceId -> Maybe ResourceId
forall a. a -> Maybe a
Just ResourceId
"Z2YQB5RD63NC85"
    Region
Seoul           -> ResourceId -> Maybe ResourceId
forall a. a -> Maybe a
Just ResourceId
"Z3W03O7B5YMIYP"
    Region
Singapore       -> ResourceId -> Maybe ResourceId
forall a. a -> Maybe a
Just ResourceId
"Z3O0J2DXBE1FTB"
    Region
Sydney          -> ResourceId -> Maybe ResourceId
forall a. a -> Maybe a
Just ResourceId
"Z1WCIGYICN2BYD"
    Region
Tokyo           -> ResourceId -> Maybe ResourceId
forall a. a -> Maybe a
Just ResourceId
"Z2M4EHUR26P7ZW"
    Region
Montreal        -> ResourceId -> Maybe ResourceId
forall a. a -> Maybe a
Just ResourceId
"Z1QDHH18159H29"
    Region
Ningxia         -> ResourceId -> Maybe ResourceId
forall a. a -> Maybe a
Just ResourceId
"Z282HJ1KT0DH03"
    Region
Frankfurt       -> ResourceId -> Maybe ResourceId
forall a. a -> Maybe a
Just ResourceId
"Z21DNDUVLTQW6Q"
    Region
Ireland         -> ResourceId -> Maybe ResourceId
forall a. a -> Maybe a
Just ResourceId
"Z1BKCTXD74EZPE"
    Region
London          -> ResourceId -> Maybe ResourceId
forall a. a -> Maybe a
Just ResourceId
"Z3GKZC51ZF0DB4"
    Region
Milan           -> ResourceId -> Maybe ResourceId
forall a. a -> Maybe a
Just ResourceId
"Z30OZKI7KPW7MI"
    Region
Paris           -> ResourceId -> Maybe ResourceId
forall a. a -> Maybe a
Just ResourceId
"Z3R1K369G5AVDG"
    Region
Stockholm       -> ResourceId -> Maybe ResourceId
forall a. a -> Maybe a
Just ResourceId
"Z3BAZG2TWCNX0D"
    Region
Bahrain         -> ResourceId -> Maybe ResourceId
forall a. a -> Maybe a
Just ResourceId
"Z1MPMWCPA7YB62"
    Region
SaoPaulo        -> ResourceId -> Maybe ResourceId
forall a. a -> Maybe a
Just ResourceId
"Z7KQH4QJS55SO"
    Region
GovCloudEast    -> ResourceId -> Maybe ResourceId
forall a. a -> Maybe a
Just ResourceId
"Z2NIFVYYW2VKV1"
    Region
GovCloudWest    -> ResourceId -> Maybe ResourceId
forall a. a -> Maybe a
Just ResourceId
"Z31GFT0UA1I2HV"
    Region
_other          -> Maybe ResourceId
forall a. Maybe a
Nothing