{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}

-- |
-- Module      : Amazonka.S3.Internal
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : This Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
module Amazonka.S3.Internal
  ( -- * BucketName
    BucketName (..),
    _BucketName,

    -- * ETag
    ETag (..),
    _ETag,

    -- * Object Version ID
    ObjectVersionId (..),
    _ObjectVersionId,

    -- * Bucket Location
    LocationConstraint (..),
    _LocationConstraint,
    Region (..),

    -- * Object Key
    Delimiter,
    ObjectKey (..),
    _ObjectKey,
    objectKey_keyPrefix,
    objectKey_keyName,
    objectKey_keyComponents,

    -- * Website Endpoints
    getWebsiteEndpoint,
  )
where

import Amazonka.Core
import Amazonka.Core.Lens.Internal
  ( IndexedTraversal',
    coerced,
    prism,
    traversed,
    _1,
    _2,
  )
import Amazonka.Data
import Amazonka.Prelude
import qualified Data.Text as Text

newtype BucketName = BucketName {BucketName -> Text
fromBucketName :: Text}
  deriving
    ( BucketName -> BucketName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BucketName -> BucketName -> Bool
$c/= :: BucketName -> BucketName -> Bool
== :: BucketName -> BucketName -> Bool
$c== :: BucketName -> BucketName -> Bool
Eq,
      Eq BucketName
BucketName -> BucketName -> Bool
BucketName -> BucketName -> Ordering
BucketName -> BucketName -> BucketName
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 :: BucketName -> BucketName -> BucketName
$cmin :: BucketName -> BucketName -> BucketName
max :: BucketName -> BucketName -> BucketName
$cmax :: BucketName -> BucketName -> BucketName
>= :: BucketName -> BucketName -> Bool
$c>= :: BucketName -> BucketName -> Bool
> :: BucketName -> BucketName -> Bool
$c> :: BucketName -> BucketName -> Bool
<= :: BucketName -> BucketName -> Bool
$c<= :: BucketName -> BucketName -> Bool
< :: BucketName -> BucketName -> Bool
$c< :: BucketName -> BucketName -> Bool
compare :: BucketName -> BucketName -> Ordering
$ccompare :: BucketName -> BucketName -> Ordering
Ord,
      ReadPrec [BucketName]
ReadPrec BucketName
Int -> ReadS BucketName
ReadS [BucketName]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BucketName]
$creadListPrec :: ReadPrec [BucketName]
readPrec :: ReadPrec BucketName
$creadPrec :: ReadPrec BucketName
readList :: ReadS [BucketName]
$creadList :: ReadS [BucketName]
readsPrec :: Int -> ReadS BucketName
$creadsPrec :: Int -> ReadS BucketName
Read,
      Int -> BucketName -> ShowS
[BucketName] -> ShowS
BucketName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BucketName] -> ShowS
$cshowList :: [BucketName] -> ShowS
show :: BucketName -> String
$cshow :: BucketName -> String
showsPrec :: Int -> BucketName -> ShowS
$cshowsPrec :: Int -> BucketName -> ShowS
Show,
      forall x. Rep BucketName x -> BucketName
forall x. BucketName -> Rep BucketName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BucketName x -> BucketName
$cfrom :: forall x. BucketName -> Rep BucketName x
Generic,
      String -> BucketName
forall a. (String -> a) -> IsString a
fromString :: String -> BucketName
$cfromString :: String -> BucketName
IsString,
      Text -> Either String BucketName
forall a. (Text -> Either String a) -> FromText a
fromText :: Text -> Either String BucketName
$cfromText :: Text -> Either String BucketName
FromText,
      BucketName -> Text
forall a. (a -> Text) -> ToText a
toText :: BucketName -> Text
$ctoText :: BucketName -> Text
ToText,
      BucketName -> ByteString
forall a. (a -> ByteString) -> ToByteString a
toBS :: BucketName -> ByteString
$ctoBS :: BucketName -> ByteString
ToByteString,
      [Node] -> Either String BucketName
forall a. ([Node] -> Either String a) -> FromXML a
parseXML :: [Node] -> Either String BucketName
$cparseXML :: [Node] -> Either String BucketName
FromXML,
      BucketName -> XML
forall a. (a -> XML) -> ToXML a
toXML :: BucketName -> XML
$ctoXML :: BucketName -> XML
ToXML,
      BucketName -> QueryString
forall a. (a -> QueryString) -> ToQuery a
toQuery :: BucketName -> QueryString
$ctoQuery :: BucketName -> QueryString
ToQuery,
      BucketName -> ByteStringBuilder
forall a. (a -> ByteStringBuilder) -> ToLog a
build :: BucketName -> ByteStringBuilder
$cbuild :: BucketName -> ByteStringBuilder
ToLog,
      Value -> Parser [BucketName]
Value -> Parser BucketName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [BucketName]
$cparseJSONList :: Value -> Parser [BucketName]
parseJSON :: Value -> Parser BucketName
$cparseJSON :: Value -> Parser BucketName
FromJSON
    )

{-# INLINE _BucketName #-}
_BucketName :: Iso' BucketName Text
_BucketName :: Iso' BucketName Text
_BucketName = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
coerced

instance Hashable BucketName

instance NFData BucketName

-- FIXME: Add the difference between weak + strong ETags and their respective
-- equalities if necessary, see: https://github.com/brendanhay/amazonka/issues/76
newtype ETag = ETag {ETag -> ByteString
fromETag :: ByteString}
  deriving
    ( ETag -> ETag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ETag -> ETag -> Bool
$c/= :: ETag -> ETag -> Bool
== :: ETag -> ETag -> Bool
$c== :: ETag -> ETag -> Bool
Eq,
      Eq ETag
ETag -> ETag -> Bool
ETag -> ETag -> Ordering
ETag -> ETag -> ETag
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 :: ETag -> ETag -> ETag
$cmin :: ETag -> ETag -> ETag
max :: ETag -> ETag -> ETag
$cmax :: ETag -> ETag -> ETag
>= :: ETag -> ETag -> Bool
$c>= :: ETag -> ETag -> Bool
> :: ETag -> ETag -> Bool
$c> :: ETag -> ETag -> Bool
<= :: ETag -> ETag -> Bool
$c<= :: ETag -> ETag -> Bool
< :: ETag -> ETag -> Bool
$c< :: ETag -> ETag -> Bool
compare :: ETag -> ETag -> Ordering
$ccompare :: ETag -> ETag -> Ordering
Ord,
      ReadPrec [ETag]
ReadPrec ETag
Int -> ReadS ETag
ReadS [ETag]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ETag]
$creadListPrec :: ReadPrec [ETag]
readPrec :: ReadPrec ETag
$creadPrec :: ReadPrec ETag
readList :: ReadS [ETag]
$creadList :: ReadS [ETag]
readsPrec :: Int -> ReadS ETag
$creadsPrec :: Int -> ReadS ETag
Read,
      Int -> ETag -> ShowS
[ETag] -> ShowS
ETag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ETag] -> ShowS
$cshowList :: [ETag] -> ShowS
show :: ETag -> String
$cshow :: ETag -> String
showsPrec :: Int -> ETag -> ShowS
$cshowsPrec :: Int -> ETag -> ShowS
Show,
      forall x. Rep ETag x -> ETag
forall x. ETag -> Rep ETag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ETag x -> ETag
$cfrom :: forall x. ETag -> Rep ETag x
Generic,
      String -> ETag
forall a. (String -> a) -> IsString a
fromString :: String -> ETag
$cfromString :: String -> ETag
IsString,
      Text -> Either String ETag
forall a. (Text -> Either String a) -> FromText a
fromText :: Text -> Either String ETag
$cfromText :: Text -> Either String ETag
FromText,
      ETag -> Text
forall a. (a -> Text) -> ToText a
toText :: ETag -> Text
$ctoText :: ETag -> Text
ToText,
      ETag -> ByteString
forall a. (a -> ByteString) -> ToByteString a
toBS :: ETag -> ByteString
$ctoBS :: ETag -> ByteString
ToByteString,
      [Node] -> Either String ETag
forall a. ([Node] -> Either String a) -> FromXML a
parseXML :: [Node] -> Either String ETag
$cparseXML :: [Node] -> Either String ETag
FromXML,
      ETag -> XML
forall a. (a -> XML) -> ToXML a
toXML :: ETag -> XML
$ctoXML :: ETag -> XML
ToXML,
      ETag -> QueryString
forall a. (a -> QueryString) -> ToQuery a
toQuery :: ETag -> QueryString
$ctoQuery :: ETag -> QueryString
ToQuery,
      ETag -> ByteStringBuilder
forall a. (a -> ByteStringBuilder) -> ToLog a
build :: ETag -> ByteStringBuilder
$cbuild :: ETag -> ByteStringBuilder
ToLog
    )

{-# INLINE _ETag #-}
_ETag :: Iso' ETag ByteString
_ETag :: Iso' ETag ByteString
_ETag = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
coerced

instance Hashable ETag

instance NFData ETag

newtype ObjectVersionId = ObjectVersionId {ObjectVersionId -> Text
fromObjectVersionId :: Text}
  deriving
    ( ObjectVersionId -> ObjectVersionId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ObjectVersionId -> ObjectVersionId -> Bool
$c/= :: ObjectVersionId -> ObjectVersionId -> Bool
== :: ObjectVersionId -> ObjectVersionId -> Bool
$c== :: ObjectVersionId -> ObjectVersionId -> Bool
Eq,
      Eq ObjectVersionId
ObjectVersionId -> ObjectVersionId -> Bool
ObjectVersionId -> ObjectVersionId -> Ordering
ObjectVersionId -> ObjectVersionId -> ObjectVersionId
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 :: ObjectVersionId -> ObjectVersionId -> ObjectVersionId
$cmin :: ObjectVersionId -> ObjectVersionId -> ObjectVersionId
max :: ObjectVersionId -> ObjectVersionId -> ObjectVersionId
$cmax :: ObjectVersionId -> ObjectVersionId -> ObjectVersionId
>= :: ObjectVersionId -> ObjectVersionId -> Bool
$c>= :: ObjectVersionId -> ObjectVersionId -> Bool
> :: ObjectVersionId -> ObjectVersionId -> Bool
$c> :: ObjectVersionId -> ObjectVersionId -> Bool
<= :: ObjectVersionId -> ObjectVersionId -> Bool
$c<= :: ObjectVersionId -> ObjectVersionId -> Bool
< :: ObjectVersionId -> ObjectVersionId -> Bool
$c< :: ObjectVersionId -> ObjectVersionId -> Bool
compare :: ObjectVersionId -> ObjectVersionId -> Ordering
$ccompare :: ObjectVersionId -> ObjectVersionId -> Ordering
Ord,
      ReadPrec [ObjectVersionId]
ReadPrec ObjectVersionId
Int -> ReadS ObjectVersionId
ReadS [ObjectVersionId]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ObjectVersionId]
$creadListPrec :: ReadPrec [ObjectVersionId]
readPrec :: ReadPrec ObjectVersionId
$creadPrec :: ReadPrec ObjectVersionId
readList :: ReadS [ObjectVersionId]
$creadList :: ReadS [ObjectVersionId]
readsPrec :: Int -> ReadS ObjectVersionId
$creadsPrec :: Int -> ReadS ObjectVersionId
Read,
      Int -> ObjectVersionId -> ShowS
[ObjectVersionId] -> ShowS
ObjectVersionId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ObjectVersionId] -> ShowS
$cshowList :: [ObjectVersionId] -> ShowS
show :: ObjectVersionId -> String
$cshow :: ObjectVersionId -> String
showsPrec :: Int -> ObjectVersionId -> ShowS
$cshowsPrec :: Int -> ObjectVersionId -> ShowS
Show,
      forall x. Rep ObjectVersionId x -> ObjectVersionId
forall x. ObjectVersionId -> Rep ObjectVersionId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ObjectVersionId x -> ObjectVersionId
$cfrom :: forall x. ObjectVersionId -> Rep ObjectVersionId x
Generic,
      String -> ObjectVersionId
forall a. (String -> a) -> IsString a
fromString :: String -> ObjectVersionId
$cfromString :: String -> ObjectVersionId
IsString,
      Text -> Either String ObjectVersionId
forall a. (Text -> Either String a) -> FromText a
fromText :: Text -> Either String ObjectVersionId
$cfromText :: Text -> Either String ObjectVersionId
FromText,
      ObjectVersionId -> Text
forall a. (a -> Text) -> ToText a
toText :: ObjectVersionId -> Text
$ctoText :: ObjectVersionId -> Text
ToText,
      ObjectVersionId -> ByteString
forall a. (a -> ByteString) -> ToByteString a
toBS :: ObjectVersionId -> ByteString
$ctoBS :: ObjectVersionId -> ByteString
ToByteString,
      [Node] -> Either String ObjectVersionId
forall a. ([Node] -> Either String a) -> FromXML a
parseXML :: [Node] -> Either String ObjectVersionId
$cparseXML :: [Node] -> Either String ObjectVersionId
FromXML,
      ObjectVersionId -> XML
forall a. (a -> XML) -> ToXML a
toXML :: ObjectVersionId -> XML
$ctoXML :: ObjectVersionId -> XML
ToXML,
      ObjectVersionId -> QueryString
forall a. (a -> QueryString) -> ToQuery a
toQuery :: ObjectVersionId -> QueryString
$ctoQuery :: ObjectVersionId -> QueryString
ToQuery,
      ObjectVersionId -> ByteStringBuilder
forall a. (a -> ByteStringBuilder) -> ToLog a
build :: ObjectVersionId -> ByteStringBuilder
$cbuild :: ObjectVersionId -> ByteStringBuilder
ToLog
    )

_ObjectVersionId :: Iso' ObjectVersionId Text
_ObjectVersionId :: Iso' ObjectVersionId Text
_ObjectVersionId = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
coerced

instance Hashable ObjectVersionId

instance NFData ObjectVersionId

newtype LocationConstraint = LocationConstraint {LocationConstraint -> Region
constraintRegion :: Region}
  deriving
    ( LocationConstraint -> LocationConstraint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocationConstraint -> LocationConstraint -> Bool
$c/= :: LocationConstraint -> LocationConstraint -> Bool
== :: LocationConstraint -> LocationConstraint -> Bool
$c== :: LocationConstraint -> LocationConstraint -> Bool
Eq,
      Eq LocationConstraint
LocationConstraint -> LocationConstraint -> Bool
LocationConstraint -> LocationConstraint -> Ordering
LocationConstraint -> LocationConstraint -> LocationConstraint
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 :: LocationConstraint -> LocationConstraint -> LocationConstraint
$cmin :: LocationConstraint -> LocationConstraint -> LocationConstraint
max :: LocationConstraint -> LocationConstraint -> LocationConstraint
$cmax :: LocationConstraint -> LocationConstraint -> LocationConstraint
>= :: LocationConstraint -> LocationConstraint -> Bool
$c>= :: LocationConstraint -> LocationConstraint -> Bool
> :: LocationConstraint -> LocationConstraint -> Bool
$c> :: LocationConstraint -> LocationConstraint -> Bool
<= :: LocationConstraint -> LocationConstraint -> Bool
$c<= :: LocationConstraint -> LocationConstraint -> Bool
< :: LocationConstraint -> LocationConstraint -> Bool
$c< :: LocationConstraint -> LocationConstraint -> Bool
compare :: LocationConstraint -> LocationConstraint -> Ordering
$ccompare :: LocationConstraint -> LocationConstraint -> Ordering
Ord,
      ReadPrec [LocationConstraint]
ReadPrec LocationConstraint
Int -> ReadS LocationConstraint
ReadS [LocationConstraint]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LocationConstraint]
$creadListPrec :: ReadPrec [LocationConstraint]
readPrec :: ReadPrec LocationConstraint
$creadPrec :: ReadPrec LocationConstraint
readList :: ReadS [LocationConstraint]
$creadList :: ReadS [LocationConstraint]
readsPrec :: Int -> ReadS LocationConstraint
$creadsPrec :: Int -> ReadS LocationConstraint
Read,
      Int -> LocationConstraint -> ShowS
[LocationConstraint] -> ShowS
LocationConstraint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LocationConstraint] -> ShowS
$cshowList :: [LocationConstraint] -> ShowS
show :: LocationConstraint -> String
$cshow :: LocationConstraint -> String
showsPrec :: Int -> LocationConstraint -> ShowS
$cshowsPrec :: Int -> LocationConstraint -> ShowS
Show,
      forall x. Rep LocationConstraint x -> LocationConstraint
forall x. LocationConstraint -> Rep LocationConstraint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LocationConstraint x -> LocationConstraint
$cfrom :: forall x. LocationConstraint -> Rep LocationConstraint x
Generic,
      LocationConstraint -> Text
forall a. (a -> Text) -> ToText a
toText :: LocationConstraint -> Text
$ctoText :: LocationConstraint -> Text
ToText,
      LocationConstraint -> ByteString
forall a. (a -> ByteString) -> ToByteString a
toBS :: LocationConstraint -> ByteString
$ctoBS :: LocationConstraint -> ByteString
ToByteString,
      LocationConstraint -> ByteStringBuilder
forall a. (a -> ByteStringBuilder) -> ToLog a
build :: LocationConstraint -> ByteStringBuilder
$cbuild :: LocationConstraint -> ByteStringBuilder
ToLog
    )

{-# INLINE _LocationConstraint #-}
_LocationConstraint :: Iso' LocationConstraint Region
_LocationConstraint :: Iso' LocationConstraint Region
_LocationConstraint = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
coerced

instance Hashable LocationConstraint

instance NFData LocationConstraint

instance FromText LocationConstraint where
  fromText :: Text -> Either String LocationConstraint
fromText Text
text =
    Region -> LocationConstraint
LocationConstraint
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Text -> Text
Text.toLower Text
text of
        Text
"" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Region
NorthVirginia
        Text
"eu" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Region
Ireland
        Text
other -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Region
Region' Text
other

instance FromXML LocationConstraint where
  parseXML :: [Node] -> Either String LocationConstraint
parseXML = \case
    [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Region -> LocationConstraint
LocationConstraint Region
NorthVirginia)
    [Node]
ns -> forall a. FromText a => String -> [Node] -> Either String a
parseXMLText String
"LocationConstraint" [Node]
ns

instance ToXML LocationConstraint where
  toXML :: LocationConstraint -> XML
toXML = \case
    LocationConstraint Region
NorthVirginia -> XML
XNull
    LocationConstraint Region
r -> forall a. ToText a => a -> XML
toXMLText Region
r

newtype ObjectKey = ObjectKey Text
  deriving
    ( ObjectKey -> ObjectKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ObjectKey -> ObjectKey -> Bool
$c/= :: ObjectKey -> ObjectKey -> Bool
== :: ObjectKey -> ObjectKey -> Bool
$c== :: ObjectKey -> ObjectKey -> Bool
Eq,
      Eq ObjectKey
ObjectKey -> ObjectKey -> Bool
ObjectKey -> ObjectKey -> Ordering
ObjectKey -> ObjectKey -> ObjectKey
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 :: ObjectKey -> ObjectKey -> ObjectKey
$cmin :: ObjectKey -> ObjectKey -> ObjectKey
max :: ObjectKey -> ObjectKey -> ObjectKey
$cmax :: ObjectKey -> ObjectKey -> ObjectKey
>= :: ObjectKey -> ObjectKey -> Bool
$c>= :: ObjectKey -> ObjectKey -> Bool
> :: ObjectKey -> ObjectKey -> Bool
$c> :: ObjectKey -> ObjectKey -> Bool
<= :: ObjectKey -> ObjectKey -> Bool
$c<= :: ObjectKey -> ObjectKey -> Bool
< :: ObjectKey -> ObjectKey -> Bool
$c< :: ObjectKey -> ObjectKey -> Bool
compare :: ObjectKey -> ObjectKey -> Ordering
$ccompare :: ObjectKey -> ObjectKey -> Ordering
Ord,
      ReadPrec [ObjectKey]
ReadPrec ObjectKey
Int -> ReadS ObjectKey
ReadS [ObjectKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ObjectKey]
$creadListPrec :: ReadPrec [ObjectKey]
readPrec :: ReadPrec ObjectKey
$creadPrec :: ReadPrec ObjectKey
readList :: ReadS [ObjectKey]
$creadList :: ReadS [ObjectKey]
readsPrec :: Int -> ReadS ObjectKey
$creadsPrec :: Int -> ReadS ObjectKey
Read,
      Int -> ObjectKey -> ShowS
[ObjectKey] -> ShowS
ObjectKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ObjectKey] -> ShowS
$cshowList :: [ObjectKey] -> ShowS
show :: ObjectKey -> String
$cshow :: ObjectKey -> String
showsPrec :: Int -> ObjectKey -> ShowS
$cshowsPrec :: Int -> ObjectKey -> ShowS
Show,
      forall x. Rep ObjectKey x -> ObjectKey
forall x. ObjectKey -> Rep ObjectKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ObjectKey x -> ObjectKey
$cfrom :: forall x. ObjectKey -> Rep ObjectKey x
Generic,
      String -> ObjectKey
forall a. (String -> a) -> IsString a
fromString :: String -> ObjectKey
$cfromString :: String -> ObjectKey
IsString,
      Text -> Either String ObjectKey
forall a. (Text -> Either String a) -> FromText a
fromText :: Text -> Either String ObjectKey
$cfromText :: Text -> Either String ObjectKey
FromText,
      ObjectKey -> Text
forall a. (a -> Text) -> ToText a
toText :: ObjectKey -> Text
$ctoText :: ObjectKey -> Text
ToText,
      ObjectKey -> ByteString
forall a. (a -> ByteString) -> ToByteString a
toBS :: ObjectKey -> ByteString
$ctoBS :: ObjectKey -> ByteString
ToByteString,
      [Node] -> Either String ObjectKey
forall a. ([Node] -> Either String a) -> FromXML a
parseXML :: [Node] -> Either String ObjectKey
$cparseXML :: [Node] -> Either String ObjectKey
FromXML,
      ObjectKey -> XML
forall a. (a -> XML) -> ToXML a
toXML :: ObjectKey -> XML
$ctoXML :: ObjectKey -> XML
ToXML,
      ObjectKey -> QueryString
forall a. (a -> QueryString) -> ToQuery a
toQuery :: ObjectKey -> QueryString
$ctoQuery :: ObjectKey -> QueryString
ToQuery,
      ObjectKey -> ByteString
forall a. (a -> ByteString) -> ToPath a
toPath :: ObjectKey -> ByteString
$ctoPath :: ObjectKey -> ByteString
ToPath,
      ObjectKey -> ByteStringBuilder
forall a. (a -> ByteStringBuilder) -> ToLog a
build :: ObjectKey -> ByteStringBuilder
$cbuild :: ObjectKey -> ByteStringBuilder
ToLog
    )

instance Hashable ObjectKey

instance NFData ObjectKey

type Delimiter = Char

_ObjectKey :: Iso' ObjectKey Text
_ObjectKey :: Iso' ObjectKey Text
_ObjectKey = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
coerced
{-# INLINE _ObjectKey #-}

-- FIXME: Note about laws for combining objectKey_keyPrefix/objectKey_keyName.

-- | Traverse the prefix of an object key.
--
-- The prefix is classified as the entirety of the object key minus the name.
-- A leading prefix in the presence of a name, and no other delimiters is
-- interpreted as a blank prefix.
--
-- >>> "/home/jsmith/base.wiki" ^? objectKey_keyPrefix '/'
-- Just "/home/jsmith"
--
-- >>> "/home/jsmith/" ^? objectKey_keyPrefix '/'
-- Just "/home/jsmith"
--
-- >>> "/home" ^? objectKey_keyPrefix '/'
-- Nothing
--
-- >>> "/" ^? objectKey_keyPrefix '/'
-- Nothing
objectKey_keyPrefix :: Delimiter -> Traversal' ObjectKey Text
objectKey_keyPrefix :: Delimiter -> Traversal' ObjectKey Text
objectKey_keyPrefix Delimiter
c = Bool -> Delimiter -> Prism' ObjectKey (Text, Text)
_ObjectKeySnoc Bool
True Delimiter
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field1 s t a b => Lens s t a b
_1
{-# INLINE objectKey_keyPrefix #-}

-- | Traverse the name of an object key.
--
-- The name is classified as last path component based on the given delimiter.
-- A trailing delimiter is interpreted as a blank name.
--
-- >>> "/home/jsmith/base.wiki" ^? objectKey_keyName '/'
-- Just "base.wiki"
--
-- >>> "/home/jsmith/" ^? objectKey_keyName '/'
-- Just ""
--
-- >>> "/home" ^? objectKey_keyName '/'
-- Just "home"
--
-- >>> "/" ^? objectKey_keyName '/'
-- Just ""
objectKey_keyName :: Delimiter -> Traversal' ObjectKey Text
objectKey_keyName :: Delimiter -> Traversal' ObjectKey Text
objectKey_keyName Delimiter
c = Bool -> Delimiter -> Prism' ObjectKey (Text, Text)
_ObjectKeySnoc Bool
False Delimiter
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2
{-# INLINE objectKey_keyName #-}

-- | Traverse the path components of an object key using the specified delimiter.
objectKey_keyComponents :: Delimiter -> IndexedTraversal' Int ObjectKey Text
objectKey_keyComponents :: Delimiter -> IndexedTraversal' Int ObjectKey Text
objectKey_keyComponents !Delimiter
c p Text (f Text)
f (ObjectKey Text
k) = [Text] -> ObjectKey
cat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed p Text (f Text)
f [Text]
split
  where
    split :: [Text]
split = (Delimiter -> Bool) -> Text -> [Text]
Text.split (forall a. Eq a => a -> a -> Bool
== Delimiter
c) Text
k
    cat :: [Text] -> ObjectKey
cat = Text -> ObjectKey
ObjectKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate (Delimiter -> Text
Text.singleton Delimiter
c)
{-# INLINE objectKey_keyComponents #-}

-- | Modelled on the '_Snoc' type class from "Control.Lens.Cons".
_ObjectKeySnoc :: Bool -> Delimiter -> Prism' ObjectKey (Text, Text)
_ObjectKeySnoc :: Bool -> Delimiter -> Prism' ObjectKey (Text, Text)
_ObjectKeySnoc Bool
dir !Delimiter
c = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (Text -> ObjectKey
ObjectKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> Text
cat) ObjectKey -> Either ObjectKey (Text, Text)
split
  where
    split :: ObjectKey -> Either ObjectKey (Text, Text)
split x :: ObjectKey
x@(ObjectKey Text
k) =
      let (Text
h, Text
t) = Text -> Text -> (Text, Text)
Text.breakOnEnd Text
suf Text
k
       in if
              | Text -> Int
Text.length Text
h forall a. Ord a => a -> a -> Bool
<= Int
1, Bool
dir -> forall a b. a -> Either a b
Left ObjectKey
x
              | Bool
otherwise -> forall a b. b -> Either a b
Right (Int -> Text -> Text
Text.dropEnd Int
1 Text
h, Text
t)

    cat :: Text -> Text -> Text
cat Text
h Text
t
      | Text -> Bool
Text.null Text
h = Text
t
      | Text -> Bool
Text.null Text
t = Text
h
      | Text
suf Text -> Text -> Bool
`Text.isSuffixOf` Text
h = Text
h forall a. Semigroup a => a -> a -> a
<> Text
t
      | Text
suf Text -> Text -> Bool
`Text.isPrefixOf` Text
t = Text
h forall a. Semigroup a => a -> a -> a
<> Text
t
      | Bool
otherwise = Text
h forall a. Semigroup a => a -> a -> a
<> Text
suf forall a. Semigroup a => a -> a -> a
<> Text
t

    suf :: Text
suf = Delimiter -> Text
Text.singleton Delimiter
c

-- | Get the S3 website endpoint for a specific region.
--
-- When you configure your bucket as a website, the website is available using
-- this region-specific website endpoint.
--
-- /See:/ <https://docs.aws.amazon.com/general/latest/gr/s3.html#s3_website_region_endpoints Amazon Simple Storage Service Website Endpoints>.
getWebsiteEndpoint :: Region -> Maybe Text
getWebsiteEndpoint :: Region -> Maybe Text
getWebsiteEndpoint = \case
  Region
Ohio -> forall a. a -> Maybe a
Just Text
"s3-website.us-east-2.amazonaws.com"
  Region
NorthVirginia -> forall a. a -> Maybe a
Just Text
"s3-website-us-east-1.amazonaws.com"
  Region
NorthCalifornia -> forall a. a -> Maybe a
Just Text
"s3-website-us-west-1.amazonaws.com"
  Region
Oregon -> forall a. a -> Maybe a
Just Text
"s3-website-us-west-2.amazonaws.com"
  Region
CapeTown -> forall a. a -> Maybe a
Just Text
"s3-website.af-south-1.amazonaws.com"
  Region
HongKong -> forall a. a -> Maybe a
Just Text
"s3-website.ap-east-1.amazonaws.com"
  Region
Hyderabad -> forall a. a -> Maybe a
Just Text
"s3-website.ap-south-2.amazonaws.com"
  Region
Jakarta -> forall a. a -> Maybe a
Just Text
"s3-website.ap-southeast-3.amazonaws.com"
  Region
Melbourne -> forall a. a -> Maybe a
Just Text
"s3-website.ap-southeast-4.amazonaws.com"
  Region
Mumbai -> forall a. a -> Maybe a
Just Text
"s3-website.ap-south-1.amazonaws.com"
  Region
Osaka -> forall a. a -> Maybe a
Just Text
"s3-website.ap-northeast-3.amazonaws.com"
  Region
Seoul -> forall a. a -> Maybe a
Just Text
"s3-website.ap-northeast-2.amazonaws.com"
  Region
Singapore -> forall a. a -> Maybe a
Just Text
"s3-website-ap-southeast-1.amazonaws.com"
  Region
Sydney -> forall a. a -> Maybe a
Just Text
"s3-website-ap-southeast-2.amazonaws.com"
  Region
Tokyo -> forall a. a -> Maybe a
Just Text
"s3-website-ap-northeast-1.amazonaws.com"
  Region
Montreal -> forall a. a -> Maybe a
Just Text
"s3-website.ca-central-1.amazonaws.com"
  Region
Ningxia -> forall a. a -> Maybe a
Just Text
"s3-website.cn-northwest-1.amazonaws.com.cn"
  Region
Frankfurt -> forall a. a -> Maybe a
Just Text
"s3-website.eu-central-1.amazonaws.com"
  Region
Ireland -> forall a. a -> Maybe a
Just Text
"s3-website-eu-west-1.amazonaws.com"
  Region
London -> forall a. a -> Maybe a
Just Text
"s3-website.eu-west-2.amazonaws.com"
  Region
Milan -> forall a. a -> Maybe a
Just Text
"s3-website.eu-south-1.amazonaws.com"
  Region
Paris -> forall a. a -> Maybe a
Just Text
"s3-website.eu-west-3.amazonaws.com"
  Region
Stockholm -> forall a. a -> Maybe a
Just Text
"s3-website.eu-north-1.amazonaws.com"
  Region
Spain -> forall a. a -> Maybe a
Just Text
"s3-website.eu-south-2.amazonaws.com"
  Region
Zurich -> forall a. a -> Maybe a
Just Text
"s3-website.eu-central-2.amazonaws.com"
  Region
Bahrain -> forall a. a -> Maybe a
Just Text
"s3-website.me-south-1.amazonaws.com"
  Region
UAE -> forall a. a -> Maybe a
Just Text
"s3-website.me-central-1.amazonaws.com"
  Region
SaoPaulo -> forall a. a -> Maybe a
Just Text
"s3-website-sa-east-1.amazonaws.com"
  Region
GovCloudEast -> forall a. a -> Maybe a
Just Text
"s3-website.us-gov-east-1.amazonaws.com"
  Region
GovCloudWest -> forall a. a -> Maybe a
Just Text
"s3-website-us-gov-west-1.amazonaws.com"
  Region' Text
_ -> forall a. Maybe a
Nothing