{-# LANGUAGE AllowAmbiguousTypes #-}

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module      : Network.DO.Spaces.Utils
-- Copyright   : (c) 2021 Rory Tyler Hayford
-- License     : BSD-3-Clause
-- Maintainer  : rory.hayford@protonmail.com
-- Stability   : experimental
-- Portability : GHC
--
-- Small utilities
module Network.DO.Spaces.Utils
    ( -- * General utilities
      tshow
    , bshow
    , unquote
    , quote
    , bodyLBS
    , toLowerBS
    , handleMaybe
    , regionSlug
    , showCannedACL
    , renderUploadHeaders
    , defaultUploadHeaders
    , slugToRegion
    , getResponseMetadata
    , mkNode
    , showPermission
      -- * Parsing/reading
      -- ** XML
    , xmlDocCursor
    , xmlInt
    , xmlElemError
    , xmlUTCTime
    , xmlNum
    , xmlMaybeElem
    , isTruncP
    , bucketP
    , objectP
    , etagP
    , ownerP
    , lastModifiedP
    , aclP
    , writeACLSetter
      -- ** Response headers
    , lookupObjectMetadata
    , lookupHeader
    , readEtag
    , readContentLen
    ) where

import           Conduit                   ( (.|), runConduit )

import           Control.Monad.Catch
                 ( MonadCatch
                 , MonadThrow(throwM)
                 , handleAll
                 )
import           Control.Monad.IO.Class    ( MonadIO )
import           Control.Monad.Trans.Maybe ( MaybeT(MaybeT, runMaybeT) )

import           Data.Bifunctor            ( Bifunctor(first, second) )
import           Data.Bool                 ( bool )
import           Data.ByteString           ( ByteString )
import qualified Data.ByteString.Char8     as C
import qualified Data.ByteString.Lazy      as LB
import qualified Data.CaseInsensitive      as CI
import           Data.Char                 ( toLower )
import           Data.Coerce               ( coerce )
import           Data.Either.Extra         ( eitherToMaybe )
import           Data.Generics.Product     ( HasField'(field')
                                           , HasField(field)
                                           )
import qualified Data.Map                  as M
import           Data.Maybe                ( catMaybes, listToMaybe )
import           Data.String               ( IsString )
import           Data.Text                 ( Text )
import qualified Data.Text                 as T
import qualified Data.Text.Encoding        as T
import           Data.Time
                 ( UTCTime
                 , defaultTimeLocale
                 , parseTimeM
                 )
import           Data.Time.Format.ISO8601  ( iso8601ParseM )

import           Lens.Micro                ( (&), (^.) )

import           Network.DO.Spaces.Types
import           Network.HTTP.Conduit
                 ( RequestBody(RequestBodyBS, RequestBodyLBS)
                 )
import           Network.HTTP.Types        ( Header, HeaderName, Status )

import           Text.Read                 ( readMaybe )
import           Text.XML                  ( Node )
import qualified Text.XML                  as X
import qualified Text.XML.Cursor           as X
import           Text.XML.Cursor           ( ($/), (&/), (&|) )
import           Text.XML.Cursor.Generic   ( Cursor )

-- | Convert a 'Region' to its equivalent slug
regionSlug :: IsString a => Region -> a
regionSlug :: Region -> a
regionSlug = \case
    Region
NewYork      -> a
"nyc3"
    Region
Amsterdam    -> a
"ams3"
    Region
SanFrancisco -> a
"sfo3"
    Region
Singapore    -> a
"sgp1"
    Region
Frankfurt    -> a
"fra1"

slugToRegion :: (MonadThrow m, IsString a, Eq a) => a -> m Region
slugToRegion :: a -> m Region
slugToRegion = \case
    a
"nyc3" -> Region -> m Region
forall (f :: * -> *) a. Applicative f => a -> f a
pure Region
NewYork
    a
"ams3" -> Region -> m Region
forall (f :: * -> *) a. Applicative f => a -> f a
pure Region
Amsterdam
    a
"sfo3" -> Region -> m Region
forall (f :: * -> *) a. Applicative f => a -> f a
pure Region
SanFrancisco
    a
"sgp1" -> Region -> m Region
forall (f :: * -> *) a. Applicative f => a -> f a
pure Region
Singapore
    a
"fra1" -> Region -> m Region
forall (f :: * -> *) a. Applicative f => a -> f a
pure Region
Frankfurt
    a
_      -> ClientException -> m Region
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientException -> m Region)
-> (Text -> ClientException) -> Text -> m Region
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ClientException
OtherError (Text -> m Region) -> Text -> m Region
forall a b. (a -> b) -> a -> b
$ Text
"Unrecognized region "

-- | Map 'ByteString' chars to lower-case
toLowerBS :: ByteString -> ByteString
toLowerBS :: ByteString -> ByteString
toLowerBS = String -> ByteString
C.pack (String -> ByteString)
-> (ByteString -> String) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower (String -> String)
-> (ByteString -> String) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
C.unpack

-- | Show a 'ByteString'
bshow :: Show a => a -> ByteString
bshow :: a -> ByteString
bshow = String -> ByteString
C.pack (String -> ByteString) -> (a -> String) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | Show some 'Text'
tshow :: Show a => a -> Text
tshow :: a -> Text
tshow = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | Strip leading and trailing double quotes from a 'Text'
unquote :: Text -> Text
unquote :: Text -> Text
unquote = (Char -> Bool) -> Text -> Text
T.dropAround (Char
'"' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==)

quote :: (IsString a, Monoid a) => a -> a
quote :: a -> a
quote a
x = a
"\"" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"\""

showCannedACL :: IsString a => CannedACL -> a
showCannedACL :: CannedACL -> a
showCannedACL = \case
    CannedACL
Private    -> a
"private"
    CannedACL
PublicRead -> a
"public-read"

showPermission :: IsString a => Permission -> a
showPermission :: Permission -> a
showPermission = \case
    Permission
ReadOnly    -> a
"READ"
    Permission
FullControl -> a
"FULL_CONTROL"

handleMaybe :: MonadCatch m => (a -> m b) -> a -> m (Maybe b)
handleMaybe :: (a -> m b) -> a -> m (Maybe b)
handleMaybe a -> m b
g a
x = (SomeException -> m (Maybe b)) -> m (Maybe b) -> m (Maybe b)
forall (m :: * -> *) a.
MonadCatch m =>
(SomeException -> m a) -> m a -> m a
handleAll (\SomeException
_ -> Maybe b -> m (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing) (b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> m b -> m (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m b
g a
x)

-- | Convert a 'RequestBody' to a 'Data.ByteString.Lazy.ByteString'
bodyLBS :: MonadThrow m => RequestBody -> m LB.ByteString
bodyLBS :: RequestBody -> m ByteString
bodyLBS (RequestBodyBS ByteString
b)   = ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LB.fromStrict ByteString
b
bodyLBS (RequestBodyLBS ByteString
lb) = ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
lb
bodyLBS RequestBody
_                   =
    ClientException -> m ByteString
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientException -> m ByteString)
-> ClientException -> m ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ClientException
InvalidRequest Text
"Unsupported request body type"

-- | Convert 'UploadHeaders' to a list of request 'Header's
renderUploadHeaders :: UploadHeaders -> [Header]
renderUploadHeaders :: UploadHeaders -> [Header]
renderUploadHeaders UploadHeaders { UserMetadata
Maybe Text
Maybe CannedACL
$sel:metadata:UploadHeaders :: UploadHeaders -> UserMetadata
$sel:contentEncoding:UploadHeaders :: UploadHeaders -> Maybe Text
$sel:contentDisposition:UploadHeaders :: UploadHeaders -> Maybe Text
$sel:cacheControl:UploadHeaders :: UploadHeaders -> Maybe Text
$sel:acl:UploadHeaders :: UploadHeaders -> Maybe CannedACL
metadata :: UserMetadata
contentEncoding :: Maybe Text
contentDisposition :: Maybe Text
cacheControl :: Maybe Text
acl :: Maybe CannedACL
.. } = (Text -> ByteString) -> (CI ByteString, Text) -> Header
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Text -> ByteString
T.encodeUtf8
    ((CI ByteString, Text) -> Header)
-> [(CI ByteString, Text)] -> [Header]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe (CI ByteString, Text)] -> [(CI ByteString, Text)]
forall a. [Maybe a] -> [a]
catMaybes [ (CI ByteString
"x-amz-acl", ) (Text -> (CI ByteString, Text))
-> (CannedACL -> Text) -> CannedACL -> (CI ByteString, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CannedACL -> Text
forall a. IsString a => CannedACL -> a
showCannedACL (CannedACL -> (CI ByteString, Text))
-> Maybe CannedACL -> Maybe (CI ByteString, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CannedACL
acl
                  , (CI ByteString
"Cache-Control", ) (Text -> (CI ByteString, Text))
-> Maybe Text -> Maybe (CI ByteString, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
cacheControl
                  , (CI ByteString
"Content-Disposition", ) (Text -> (CI ByteString, Text))
-> Maybe Text -> Maybe (CI ByteString, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
contentDisposition
                  , (CI ByteString
"Content-Encoding", ) (Text -> (CI ByteString, Text))
-> Maybe Text -> Maybe (CI ByteString, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
contentEncoding
                  ]
    [(CI ByteString, Text)]
-> [(CI ByteString, Text)] -> [(CI ByteString, Text)]
forall a. Semigroup a => a -> a -> a
<> ((Text -> CI ByteString) -> (Text, Text) -> (CI ByteString, Text)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk (ByteString -> CI ByteString)
-> (Text -> ByteString) -> Text -> CI ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> (Text -> Text) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"x-amz-meta-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)) ((Text, Text) -> (CI ByteString, Text))
-> UserMetadata -> [(CI ByteString, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserMetadata
metadata)

-- | Create an XML 'Node'
mkNode :: X.Name -> Text -> Node
mkNode :: Name -> Text -> Node
mkNode Name
name Text
nc = Element -> Node
X.NodeElement (Element -> Node) -> Element -> Node
forall a b. (a -> b) -> a -> b
$ Name -> Map Name Text -> [Node] -> Element
X.Element Name
name Map Name Text
forall a. Monoid a => a
mempty [ Text -> Node
X.NodeContent Text
nc ]

xmlDocCursor :: (MonadIO m, MonadThrow m) => RawResponse m -> m X.Cursor
xmlDocCursor :: RawResponse m -> m Cursor
xmlDocCursor RawResponse { [Header]
BodyBS m
$sel:body:RawResponse :: forall (m :: * -> *). RawResponse m -> BodyBS m
$sel:headers:RawResponse :: forall (m :: * -> *). RawResponse m -> [Header]
body :: BodyBS m
headers :: [Header]
.. } = Document -> Cursor
X.fromDocument
    (Document -> Cursor) -> m Document -> m Cursor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT () Void m Document -> m Document
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (BodyBS m
body BodyBS m
-> ConduitM ByteString Void m Document
-> ConduitT () Void m Document
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ParseSettings -> ConduitM ByteString Void m Document
forall (m :: * -> *) o.
MonadThrow m =>
ParseSettings -> ConduitT ByteString o m Document
X.sinkDoc ParseSettings
forall a. Default a => a
X.def)

-- | XML parser for 'Owner' attribute
ownerP :: MonadThrow m => Cursor Node -> m Owner
ownerP :: Cursor -> m Owner
ownerP Cursor
c = do
    OwnerID
ownerID <- ClientException -> [m OwnerID] -> m OwnerID
forall e (f :: * -> *) a.
(Exception e, MonadThrow f) =>
e -> [f a] -> f a
X.forceM (Text -> ClientException
xmlElemError Text
"ID")
        ([m OwnerID] -> m OwnerID) -> [m OwnerID] -> m OwnerID
forall a b. (a -> b) -> a -> b
$ Cursor
c Cursor -> (Cursor -> [m OwnerID]) -> [m OwnerID]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
X.laxElement Text
"ID" Axis -> (Cursor -> [m OwnerID]) -> Cursor -> [m OwnerID]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
X.content (Cursor -> [Text]) -> (Text -> m OwnerID) -> Cursor -> [m OwnerID]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| (MonadThrow m, Num OwnerID) => Text -> m OwnerID
forall (m :: * -> *) a. (MonadThrow m, Num a) => Text -> m a
xmlInt @_ @OwnerID
    Owner -> m Owner
forall (f :: * -> *) a. Applicative f => a -> f a
pure Owner :: OwnerID -> OwnerID -> Owner
Owner { $sel:displayName:Owner :: OwnerID
displayName = OwnerID
ownerID, OwnerID
$sel:ownerID:Owner :: OwnerID
ownerID :: OwnerID
ownerID }

-- | XML parser for 'ETag' attribute
etagP :: MonadThrow m => Cursor Node -> m ETag
etagP :: Cursor -> m Text
etagP Cursor
c = ClientException -> [Text] -> m Text
forall e (f :: * -> *) a.
(Exception e, MonadThrow f) =>
e -> [a] -> f a
X.force (Text -> ClientException
xmlElemError Text
"ETag")
    ([Text] -> m Text) -> [Text] -> m Text
forall a b. (a -> b) -> a -> b
$ Cursor
c Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
X.laxElement Text
"ETag" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
X.content (Cursor -> [Text]) -> (Text -> Text) -> Cursor -> [Text]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Text -> Text
unquote

-- | XML parser for @LastModified@ attribute
lastModifiedP :: MonadThrow m => Cursor Node -> m UTCTime
lastModifiedP :: Cursor -> m UTCTime
lastModifiedP Cursor
c = ClientException -> [m UTCTime] -> m UTCTime
forall e (f :: * -> *) a.
(Exception e, MonadThrow f) =>
e -> [f a] -> f a
X.forceM (Text -> ClientException
xmlElemError Text
"LastModified")
    ([m UTCTime] -> m UTCTime) -> [m UTCTime] -> m UTCTime
forall a b. (a -> b) -> a -> b
$ Cursor
c Cursor -> (Cursor -> [m UTCTime]) -> [m UTCTime]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
X.laxElement Text
"LastModified" Axis -> (Cursor -> [m UTCTime]) -> Cursor -> [m UTCTime]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
X.content (Cursor -> [Text]) -> (Text -> m UTCTime) -> Cursor -> [m UTCTime]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Text -> m UTCTime
forall (m :: * -> *). MonadThrow m => Text -> m UTCTime
xmlUTCTime

-- | Read a 'Num' type from 'Text'
xmlInt :: (MonadThrow m, Num a) => Text -> m a
xmlInt :: Text -> m a
xmlInt Text
txt = case String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Integer) -> String -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
txt of
    Just Integer
n  -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
n
    Maybe Integer
Nothing -> ClientException -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientException -> m a) -> ClientException -> m a
forall a b. (a -> b) -> a -> b
$ Text -> ClientException
InvalidXML Text
"Failed to read integer value"

-- | Read a 'Num' type, encoded as an integer, from XML
xmlNum :: Num a => MonadThrow m => Text -> Cursor Node -> m a
xmlNum :: Text -> Cursor -> m a
xmlNum Text
name Cursor
c = ClientException -> [m a] -> m a
forall e (f :: * -> *) a.
(Exception e, MonadThrow f) =>
e -> [f a] -> f a
X.forceM (Text -> ClientException
xmlElemError Text
name)
    ([m a] -> m a) -> [m a] -> m a
forall a b. (a -> b) -> a -> b
$ Cursor
c Cursor -> (Cursor -> [m a]) -> [m a]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
X.laxElement Text
name Axis -> (Cursor -> [m a]) -> Cursor -> [m a]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
X.content (Cursor -> [Text]) -> (Text -> m a) -> Cursor -> [m a]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Text -> m a
forall (m :: * -> *) a. (MonadThrow m, Num a) => Text -> m a
xmlInt

-- | Read a 'UTCTime' from an ISO-O8601-formatted 'Text'
xmlUTCTime :: MonadThrow m => Text -> m UTCTime
xmlUTCTime :: Text -> m UTCTime
xmlUTCTime Text
txt = case String -> Maybe UTCTime
forall (m :: * -> *) t. (MonadFail m, ISO8601 t) => String -> m t
iso8601ParseM (String -> Maybe UTCTime) -> String -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
txt of
    Just UTCTime
t  -> UTCTime -> m UTCTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure UTCTime
t
    Maybe UTCTime
Nothing -> ClientException -> m UTCTime
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientException -> m UTCTime) -> ClientException -> m UTCTime
forall a b. (a -> b) -> a -> b
$ Text -> ClientException
InvalidXML Text
"Failed to read ISO-8601 value"

isTruncP :: MonadThrow m => Cursor Node -> m Bool
isTruncP :: Cursor -> m Bool
isTruncP Cursor
c = ClientException -> [Bool] -> m Bool
forall e (f :: * -> *) a.
(Exception e, MonadThrow f) =>
e -> [a] -> f a
X.force (Text -> ClientException
xmlElemError Text
"IsTruncated")
    ([Bool] -> m Bool) -> [Bool] -> m Bool
forall a b. (a -> b) -> a -> b
$ Cursor
c Cursor -> (Cursor -> [Bool]) -> [Bool]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
X.laxElement Text
"IsTruncated" Axis -> (Cursor -> [Bool]) -> Cursor -> [Bool]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
X.content (Cursor -> [Text]) -> (Text -> Bool) -> Cursor -> [Bool]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Text -> Bool
forall a. (Eq a, IsString a) => a -> Bool
truncP
  where
    truncP :: a -> Bool
truncP a
t = Bool -> Bool -> Bool -> Bool
forall a. a -> a -> Bool -> a
bool Bool
False Bool
True (a
t a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"true")

-- | Helper to build exceptions during XML parsing
xmlElemError :: Text -> ClientException
xmlElemError :: Text -> ClientException
xmlElemError Text
txt = Text -> ClientException
InvalidXML (Text -> ClientException) -> Text -> ClientException
forall a b. (a -> b) -> a -> b
$ Text
"Missing " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt

-- | Parse the name of a 'Bucket' from XML
bucketP :: MonadThrow m => Cursor Node -> m Bucket
bucketP :: Cursor -> m Bucket
bucketP Cursor
c = ClientException -> [Bucket] -> m Bucket
forall e (f :: * -> *) a.
(Exception e, MonadThrow f) =>
e -> [a] -> f a
X.force (Text -> ClientException
xmlElemError Text
"Bucket")
    ([Bucket] -> m Bucket) -> [Bucket] -> m Bucket
forall a b. (a -> b) -> a -> b
$ Cursor
c Cursor -> (Cursor -> [Bucket]) -> [Bucket]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
X.laxElement Text
"Bucket" Axis -> (Cursor -> [Bucket]) -> Cursor -> [Bucket]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
X.content (Cursor -> [Text]) -> (Text -> Bucket) -> Cursor -> [Bucket]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Text -> Bucket
coerce

-- | Parse the name of an 'Object' from XML
objectP :: MonadThrow m => Cursor Node -> m Object
objectP :: Cursor -> m Object
objectP Cursor
c = ClientException -> [Object] -> m Object
forall e (f :: * -> *) a.
(Exception e, MonadThrow f) =>
e -> [a] -> f a
X.force (Text -> ClientException
xmlElemError Text
"Key")
    ([Object] -> m Object) -> [Object] -> m Object
forall a b. (a -> b) -> a -> b
$ Cursor
c Cursor -> (Cursor -> [Object]) -> [Object]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
X.laxElement Text
"Key" Axis -> (Cursor -> [Object]) -> Cursor -> [Object]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
X.content (Cursor -> [Text]) -> (Text -> Object) -> Cursor -> [Object]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Text -> Object
coerce

xmlMaybeElem :: Cursor Node -> Text -> Maybe Text
xmlMaybeElem :: Cursor -> Text -> Maybe Text
xmlMaybeElem Cursor
cursor Text
name =
    [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe ([Text] -> Maybe Text) -> [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
X.laxElement Text
name Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
X.content

lookupObjectMetadata :: MonadThrow m => RawResponse m -> m ObjectMetadata
lookupObjectMetadata :: RawResponse m -> m ObjectMetadata
lookupObjectMetadata RawResponse m
raw = do
    Maybe ObjectMetadata
metadata <- MaybeT m ObjectMetadata -> m (Maybe ObjectMetadata)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT
        (MaybeT m ObjectMetadata -> m (Maybe ObjectMetadata))
-> MaybeT m ObjectMetadata -> m (Maybe ObjectMetadata)
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> Text -> UTCTime -> ObjectMetadata
ObjectMetadata
        (Int -> ByteString -> Text -> UTCTime -> ObjectMetadata)
-> MaybeT m Int
-> MaybeT m (ByteString -> Text -> UTCTime -> ObjectMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> MaybeT m Int
forall (m :: * -> *). Monad m => ByteString -> MaybeT m Int
readContentLen (ByteString -> MaybeT m Int) -> MaybeT m ByteString -> MaybeT m Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CI ByteString -> MaybeT m ByteString
lookupHeader' CI ByteString
"Content-Length")
        MaybeT m (ByteString -> Text -> UTCTime -> ObjectMetadata)
-> MaybeT m ByteString
-> MaybeT m (Text -> UTCTime -> ObjectMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CI ByteString -> MaybeT m ByteString
lookupHeader' CI ByteString
"Content-Type"
        MaybeT m (Text -> UTCTime -> ObjectMetadata)
-> MaybeT m Text -> MaybeT m (UTCTime -> ObjectMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ByteString -> MaybeT m Text
forall (m :: * -> *). Monad m => ByteString -> MaybeT m Text
readEtag (ByteString -> MaybeT m Text)
-> MaybeT m ByteString -> MaybeT m Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CI ByteString -> MaybeT m ByteString
lookupHeader' CI ByteString
"Etag")
        MaybeT m (UTCTime -> ObjectMetadata)
-> MaybeT m UTCTime -> MaybeT m ObjectMetadata
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ByteString -> MaybeT m UTCTime
readDate (ByteString -> MaybeT m UTCTime)
-> MaybeT m ByteString -> MaybeT m UTCTime
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CI ByteString -> MaybeT m ByteString
lookupHeader' CI ByteString
"Last-Modified")
    case Maybe ObjectMetadata
metadata of
        Just ObjectMetadata
md -> ObjectMetadata -> m ObjectMetadata
forall (f :: * -> *) a. Applicative f => a -> f a
pure ObjectMetadata
md
        Maybe ObjectMetadata
Nothing -> ClientException -> m ObjectMetadata
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientException -> m ObjectMetadata)
-> ClientException -> m ObjectMetadata
forall a b. (a -> b) -> a -> b
$ Text -> ClientException
OtherError Text
"Missing/malformed headers"
  where
    lookupHeader' :: CI ByteString -> MaybeT m ByteString
lookupHeader' = RawResponse m -> CI ByteString -> MaybeT m ByteString
forall (m :: * -> *).
Monad m =>
RawResponse m -> CI ByteString -> MaybeT m ByteString
lookupHeader RawResponse m
raw

    readDate :: ByteString -> MaybeT m UTCTime
readDate      = m (Maybe UTCTime) -> MaybeT m UTCTime
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe UTCTime) -> MaybeT m UTCTime)
-> (ByteString -> m (Maybe UTCTime))
-> ByteString
-> MaybeT m UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe UTCTime -> m (Maybe UTCTime)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe UTCTime -> m (Maybe UTCTime))
-> (ByteString -> Maybe UTCTime) -> ByteString -> m (Maybe UTCTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe UTCTime
parseAmzTime (String -> Maybe UTCTime)
-> (ByteString -> String) -> ByteString -> Maybe UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
C.unpack

parseAmzTime :: [Char] -> Maybe UTCTime
parseAmzTime :: String -> Maybe UTCTime
parseAmzTime = Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
"%a, %d %b %Y %H:%M:%S %EZ"

-- | Lookup the value of a 'HeaderName' from a 'RawResponse' in a monadic context
lookupHeader :: Monad m => RawResponse m -> HeaderName -> MaybeT m ByteString
lookupHeader :: RawResponse m -> CI ByteString -> MaybeT m ByteString
lookupHeader RawResponse m
raw = m (Maybe ByteString) -> MaybeT m ByteString
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe ByteString) -> MaybeT m ByteString)
-> (CI ByteString -> m (Maybe ByteString))
-> CI ByteString
-> MaybeT m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ByteString -> m (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString -> m (Maybe ByteString))
-> (CI ByteString -> Maybe ByteString)
-> CI ByteString
-> m (Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CI ByteString -> [Header] -> Maybe ByteString)
-> [Header] -> CI ByteString -> Maybe ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip CI ByteString -> [Header] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (RawResponse m
raw RawResponse m
-> Getting [Header] (RawResponse m) [Header] -> [Header]
forall s a. s -> Getting a s a -> a
^. forall s t a b. HasField "headers" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"headers")

-- | Transform a 'Header' value into an 'ETag'
readEtag :: Monad m => ByteString -> MaybeT m ETag
readEtag :: ByteString -> MaybeT m Text
readEtag = m (Maybe Text) -> MaybeT m Text
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe Text) -> MaybeT m Text)
-> (ByteString -> m (Maybe Text)) -> ByteString -> MaybeT m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> m (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> m (Maybe Text))
-> (ByteString -> Maybe Text) -> ByteString -> m (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
unquote (Maybe Text -> Maybe Text)
-> (ByteString -> Maybe Text) -> ByteString -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either UnicodeException Text -> Maybe Text
forall a b. Either a b -> Maybe b
eitherToMaybe (Either UnicodeException Text -> Maybe Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
T.decodeUtf8'

-- | Transform a 'Header' value into an 'Int' (for @Content-Length@)
readContentLen :: Monad m => ByteString -> MaybeT m Int
readContentLen :: ByteString -> MaybeT m Int
readContentLen = m (Maybe Int) -> MaybeT m Int
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe Int) -> MaybeT m Int)
-> (ByteString -> m (Maybe Int)) -> ByteString -> MaybeT m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> m (Maybe Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Int -> m (Maybe Int))
-> (ByteString -> Maybe Int) -> ByteString -> m (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Read Int => String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe @Int (String -> Maybe Int)
-> (ByteString -> String) -> ByteString -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
C.unpack

aclP :: MonadThrow m => Cursor Node -> m ACLResponse
aclP :: Cursor -> m ACLResponse
aclP Cursor
cursor = Owner -> [Grant] -> ACLResponse
ACLResponse
    (Owner -> [Grant] -> ACLResponse)
-> m Owner -> m ([Grant] -> ACLResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ClientException -> [m Owner] -> m Owner
forall e (f :: * -> *) a.
(Exception e, MonadThrow f) =>
e -> [f a] -> f a
X.forceM (Text -> ClientException
xmlElemError Text
"Owner")
         ([m Owner] -> m Owner) -> [m Owner] -> m Owner
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor -> (Cursor -> [m Owner]) -> [m Owner]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
X.laxElement Text
"Owner" Axis -> (Cursor -> m Owner) -> Cursor -> [m Owner]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> m Owner
forall (m :: * -> *). MonadThrow m => Cursor -> m Owner
ownerP)
    m ([Grant] -> ACLResponse) -> m [Grant] -> m ACLResponse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ClientException -> [[Grant]] -> m [Grant]
forall e (f :: * -> *) a.
(Exception e, MonadThrow f) =>
e -> [a] -> f a
X.force (Text -> ClientException
xmlElemError Text
"AccessControlList")
         ([[Grant]] -> m [Grant]) -> [[Grant]] -> m [Grant]
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor -> (Cursor -> [[Grant]]) -> [[Grant]]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
X.laxElement Text
"AccessControlList" Axis -> (Cursor -> [Grant]) -> Cursor -> [[Grant]]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> [Grant]
grantsP)
  where
    grantsP :: Cursor -> [Grant]
grantsP Cursor
c = ClientException -> [[Grant]] -> [Grant]
forall e (f :: * -> *) a.
(Exception e, MonadThrow f) =>
e -> [f a] -> f a
X.forceM (Text -> ClientException
xmlElemError Text
"Grant") ([[Grant]] -> [Grant])
-> ([[Grant]] -> [[Grant]]) -> [[Grant]] -> [Grant]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Grant]] -> [[Grant]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
        ([[Grant]] -> [Grant]) -> [[Grant]] -> [Grant]
forall a b. (a -> b) -> a -> b
$ Cursor
c Cursor -> (Cursor -> [[Grant]]) -> [[Grant]]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
X.laxElement Text
"Grant" Axis -> (Cursor -> [Grant]) -> Cursor -> [[Grant]]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> [Grant]
forall (f :: * -> *). MonadThrow f => Cursor -> f Grant
grantP

    grantP :: Cursor -> f Grant
grantP Cursor
c = Permission -> Grantee -> Grant
Grant
        (Permission -> Grantee -> Grant)
-> f Permission -> f (Grantee -> Grant)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ClientException -> [f Permission] -> f Permission
forall e (f :: * -> *) a.
(Exception e, MonadThrow f) =>
e -> [f a] -> f a
X.forceM (Text -> ClientException
xmlElemError Text
"Permission")
             ([f Permission] -> f Permission) -> [f Permission] -> f Permission
forall a b. (a -> b) -> a -> b
$ Cursor
c Cursor -> (Cursor -> [f Permission]) -> [f Permission]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
X.laxElement Text
"Permission" Axis -> (Cursor -> [f Permission]) -> Cursor -> [f Permission]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
X.content (Cursor -> [Text])
-> (Text -> f Permission) -> Cursor -> [f Permission]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Text -> f Permission
readPerm)
        f (Grantee -> Grant) -> f Grantee -> f Grant
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ClientException -> [f Grantee] -> f Grantee
forall e (f :: * -> *) a.
(Exception e, MonadThrow f) =>
e -> [f a] -> f a
X.forceM (Text -> ClientException
xmlElemError Text
"Grantee")
             ([f Grantee] -> f Grantee) -> [f Grantee] -> f Grantee
forall a b. (a -> b) -> a -> b
$ Cursor
c Cursor -> (Cursor -> [f Grantee]) -> [f Grantee]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
X.laxElement Text
"Grantee" Axis -> (Cursor -> f Grantee) -> Cursor -> [f Grantee]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> f Grantee
forall (f :: * -> *). MonadThrow f => Cursor -> f Grantee
granteeP)
      where
        readPerm :: Text -> f Permission
readPerm = \case
            Text
"FULL_CONTROL" -> Permission -> f Permission
forall (f :: * -> *) a. Applicative f => a -> f a
pure Permission
FullControl
            Text
"READ"         -> Permission -> f Permission
forall (f :: * -> *) a. Applicative f => a -> f a
pure Permission
ReadOnly
            Text
_              ->
                ClientException -> f Permission
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientException -> f Permission)
-> ClientException -> f Permission
forall a b. (a -> b) -> a -> b
$ Text -> ClientException
InvalidXML Text
"Unrecognized ACL Permission"

    granteeP :: Cursor -> f Grantee
granteeP Cursor
c = case Cursor -> Node
forall node. Cursor node -> node
X.node Cursor
c of
        X.NodeElement (X.Element Name
_ Map Name Text
as [Node]
_) -> case Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
typeName Map Name Text
as of
            Just Text
"Group" -> Grantee -> f Grantee
forall (f :: * -> *) a. Applicative f => a -> f a
pure Grantee
Group
            Just Text
"CanonicalUser" -> Owner -> Grantee
CanonicalUser (Owner -> Grantee) -> f Owner -> f Grantee
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cursor -> f Owner
forall (m :: * -> *). MonadThrow m => Cursor -> m Owner
ownerP Cursor
c
            Maybe Text
_ -> ClientException -> f Grantee
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientException -> f Grantee) -> ClientException -> f Grantee
forall a b. (a -> b) -> a -> b
$ Text -> ClientException
InvalidXML Text
"Invalid ACL Grantee type"
        Node
_ -> ClientException -> f Grantee
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientException -> f Grantee) -> ClientException -> f Grantee
forall a b. (a -> b) -> a -> b
$ Text -> ClientException
InvalidXML Text
"Invalid ACL Grantee"
      where
        typeName :: Name
typeName = Text -> Maybe Text -> Maybe Text -> Name
X.Name Text
"type"
                          (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://www.w3.org/2001/XMLSchema-instance")
                          (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"xsi")

writeACLSetter :: (HasField' "owner" r Owner, HasField' "acls" r [Grant])
               => r
               -> LB.ByteString
writeACLSetter :: r -> ByteString
writeACLSetter r
r = RenderSettings -> Document -> ByteString
X.renderLBS RenderSettings
forall a. Default a => a
X.def (Document -> ByteString) -> Document -> ByteString
forall a b. (a -> b) -> a -> b
$ Prologue -> Element -> [Miscellaneous] -> Document
X.Document Prologue
prologue Element
root [Miscellaneous]
forall a. Monoid a => a
mempty
  where
    prologue :: Prologue
prologue = [Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
X.Prologue [Miscellaneous]
forall a. Monoid a => a
mempty Maybe Doctype
forall a. Maybe a
Nothing [Miscellaneous]
forall a. Monoid a => a
mempty

    root :: Element
root = Name -> Map Name Text -> [Node] -> Element
X.Element Name
name Map Name Text
forall a. Monoid a => a
mempty [Node]
nodes
      where
        name :: Name
name = Text -> Maybe Text -> Maybe Text -> Name
X.Name Text
"AccessControlPolicy"
                      (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://s3.amazonaws.com/doc/2006-03-01/")
                      Maybe Text
forall a. Maybe a
Nothing

    nodes :: [Node]
nodes = [ Element -> Node
X.NodeElement
              (Element -> Node) -> Element -> Node
forall a b. (a -> b) -> a -> b
$ Name -> Map Name Text -> [Node] -> Element
X.Element Name
"Owner"
                          Map Name Text
forall a. Monoid a => a
mempty
                          [ Name -> Text -> Node
mkNode Name
"ID"
                                   (r
r r -> Getting OwnerID r OwnerID -> OwnerID
forall s a. s -> Getting a s a -> a
^. forall s a. HasField' "owner" s a => Lens s s a a
forall (field :: Symbol) s a. HasField' field s a => Lens s s a a
field' @"owner" ((Owner -> Const OwnerID Owner) -> r -> Const OwnerID r)
-> ((OwnerID -> Const OwnerID OwnerID)
    -> Owner -> Const OwnerID Owner)
-> Getting OwnerID r OwnerID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. HasField "ownerID" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"ownerID"
                                    OwnerID -> (OwnerID -> Int) -> Int
forall a b. a -> (a -> b) -> b
& Coercible OwnerID Int => OwnerID -> Int
coerce @_ @Int
                                    Int -> (Int -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Int -> Text
forall a. Show a => a -> Text
tshow)
                          ]
            , Element -> Node
X.NodeElement
              (Element -> Node) -> Element -> Node
forall a b. (a -> b) -> a -> b
$ Name -> Map Name Text -> [Node] -> Element
X.Element Name
"AccessControlList"
                          Map Name Text
forall a. Monoid a => a
mempty
                          (Grant -> Node
aclNode (Grant -> Node) -> [Grant] -> [Node]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> r
r r -> Getting [Grant] r [Grant] -> [Grant]
forall s a. s -> Getting a s a -> a
^. forall s a. HasField' "acls" s a => Lens s s a a
forall (field :: Symbol) s a. HasField' field s a => Lens s s a a
field' @"acls")
            ]

    aclNode :: Grant -> Node
aclNode Grant { Grantee
Permission
$sel:grantee:Grant :: Grant -> Grantee
$sel:permission:Grant :: Grant -> Permission
grantee :: Grantee
permission :: Permission
.. } = Element -> Node
X.NodeElement
        (Element -> Node) -> Element -> Node
forall a b. (a -> b) -> a -> b
$ Name -> Map Name Text -> [Node] -> Element
X.Element Name
"Grant"
                    Map Name Text
forall a. Monoid a => a
mempty
                    [ Grantee -> Node
granteeNode Grantee
grantee
                    , Name -> Text -> Node
mkNode Name
"Permission" (Permission -> Text
forall a. IsString a => Permission -> a
showPermission Permission
permission)
                    ]

    granteeNode :: Grantee -> Node
granteeNode = \case
        CanonicalUser Owner
owner -> Element -> Node
X.NodeElement
            (Element -> Node) -> Element -> Node
forall a b. (a -> b) -> a -> b
$ Name -> Map Name Text -> [Node] -> Element
X.Element Name
"Grantee"
                        (Text -> Map Name Text
forall a. a -> Map Name a
granteeAttrs Text
"CanonicalUser")
                        [ Name -> Text -> Node
mkNode Name
"ID"
                                 (Owner
owner Owner
-> ((OwnerID -> Const OwnerID OwnerID)
    -> Owner -> Const OwnerID Owner)
-> OwnerID
forall s a. s -> Getting a s a -> a
^. forall s t a b. HasField "ownerID" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"ownerID"
                                  OwnerID -> (OwnerID -> Int) -> Int
forall a b. a -> (a -> b) -> b
& Coercible OwnerID Int => OwnerID -> Int
coerce @_ @Int
                                  Int -> (Int -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Int -> Text
forall a. Show a => a -> Text
tshow)
                        ]
        Grantee
Group               -> Element -> Node
X.NodeElement
            (Element -> Node) -> Element -> Node
forall a b. (a -> b) -> a -> b
$ Name -> Map Name Text -> [Node] -> Element
X.Element Name
"Grantee"
                        (Text -> Map Name Text
forall a. a -> Map Name a
granteeAttrs Text
"Group")
                        [ Name -> Text -> Node
mkNode Name
"URI"
                                 Text
"http://acs.amazonaws.com/groups/global/AllUsers"
                        ]
      where
        granteeAttrs :: a -> Map Name a
granteeAttrs a
ty =
            [(Name, a)] -> Map Name a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ ( Text -> Maybe Text -> Maybe Text -> Name
X.Name Text
"type"
                                  (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://www.w3.org/2001/XMLSchema-instance")
                                  (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"xsi")
                         , a
ty
                         )
                       ]

defaultUploadHeaders :: UploadHeaders
defaultUploadHeaders :: UploadHeaders
defaultUploadHeaders = UploadHeaders :: Maybe CannedACL
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> UserMetadata
-> UploadHeaders
UploadHeaders
    { $sel:acl:UploadHeaders :: Maybe CannedACL
acl                = Maybe CannedACL
forall a. Maybe a
Nothing
    , $sel:cacheControl:UploadHeaders :: Maybe Text
cacheControl       = Maybe Text
forall a. Maybe a
Nothing
    , $sel:contentDisposition:UploadHeaders :: Maybe Text
contentDisposition = Maybe Text
forall a. Maybe a
Nothing
    , $sel:contentEncoding:UploadHeaders :: Maybe Text
contentEncoding    = Maybe Text
forall a. Maybe a
Nothing
    , $sel:metadata:UploadHeaders :: UserMetadata
metadata           = UserMetadata
forall a. Monoid a => a
mempty
    }

-- | Create a 'SpacesMetadata' by reading response 'Header's, after passing the
-- 'Status'
getResponseMetadata :: Status -> RawResponse m -> SpacesMetadata
getResponseMetadata :: Status -> RawResponse m -> SpacesMetadata
getResponseMetadata Status
status RawResponse { [Header]
BodyBS m
body :: BodyBS m
headers :: [Header]
$sel:body:RawResponse :: forall (m :: * -> *). RawResponse m -> BodyBS m
$sel:headers:RawResponse :: forall (m :: * -> *). RawResponse m -> [Header]
.. } = SpacesMetadata :: Maybe Text -> Maybe UTCTime -> Status -> SpacesMetadata
SpacesMetadata { Maybe Text
Maybe UTCTime
Status
$sel:status:SpacesMetadata :: Status
$sel:date:SpacesMetadata :: Maybe UTCTime
$sel:requestID:SpacesMetadata :: Maybe Text
date :: Maybe UTCTime
requestID :: Maybe Text
status :: Status
.. }
  where
    requestID :: Maybe Text
requestID =
        Either UnicodeException Text -> Maybe Text
forall a b. Either a b -> Maybe b
eitherToMaybe (Either UnicodeException Text -> Maybe Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
T.decodeUtf8' (ByteString -> Maybe Text) -> Maybe ByteString -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CI ByteString -> [Header] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI ByteString
"x-amz-request-id" [Header]
headers

    date :: Maybe UTCTime
date      = String -> Maybe UTCTime
parseAmzTime (String -> Maybe UTCTime)
-> (ByteString -> String) -> ByteString -> Maybe UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
C.unpack (ByteString -> Maybe UTCTime) -> Maybe ByteString -> Maybe UTCTime
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CI ByteString -> [Header] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI ByteString
"Date" [Header]
headers