module Aws.S3.Commands.DeleteObjects where

import           Aws.Core
import           Aws.S3.Core
import qualified Crypto.Hash          as CH
import qualified Data.Map             as M
import           Data.Maybe
import qualified Data.Text            as T
import qualified Data.Text.Encoding   as T
import qualified Network.HTTP.Conduit as HTTP
import qualified Network.HTTP.Types   as HTTP
import qualified Text.XML             as XML
import qualified Text.XML.Cursor      as Cu
import           Text.XML.Cursor      (($/), (&|))
import qualified Data.ByteString.Char8 as B
import           Data.ByteString.Char8 ({- IsString -})
import           Control.Applicative
import           Prelude

data DeleteObjects
    = DeleteObjects {
        DeleteObjects -> Bucket
dosBucket  :: Bucket
      , DeleteObjects -> [(Bucket, Maybe Bucket)]
dosObjects :: [(Object, Maybe T.Text)] -- snd is an optional versionId
      , DeleteObjects -> Bool
dosQuiet   :: Bool
      , DeleteObjects -> Maybe Bucket
dosMultiFactorAuthentication :: Maybe T.Text
      }
    deriving (Int -> DeleteObjects -> ShowS
[DeleteObjects] -> ShowS
DeleteObjects -> String
(Int -> DeleteObjects -> ShowS)
-> (DeleteObjects -> String)
-> ([DeleteObjects] -> ShowS)
-> Show DeleteObjects
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeleteObjects -> ShowS
showsPrec :: Int -> DeleteObjects -> ShowS
$cshow :: DeleteObjects -> String
show :: DeleteObjects -> String
$cshowList :: [DeleteObjects] -> ShowS
showList :: [DeleteObjects] -> ShowS
Show)

-- simple use case: neither mfa, nor version specified, quiet
deleteObjects :: Bucket -> [T.Text] -> DeleteObjects
deleteObjects :: Bucket -> [Bucket] -> DeleteObjects
deleteObjects Bucket
bucket [Bucket]
objs =
    DeleteObjects {
            dosBucket :: Bucket
dosBucket  = Bucket
bucket
          , dosObjects :: [(Bucket, Maybe Bucket)]
dosObjects = [Bucket] -> [Maybe Bucket] -> [(Bucket, Maybe Bucket)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Bucket]
objs ([Maybe Bucket] -> [(Bucket, Maybe Bucket)])
-> [Maybe Bucket] -> [(Bucket, Maybe Bucket)]
forall a b. (a -> b) -> a -> b
$ Maybe Bucket -> [Maybe Bucket]
forall a. a -> [a]
repeat Maybe Bucket
forall a. Maybe a
Nothing
          , dosQuiet :: Bool
dosQuiet   = Bool
True
          , dosMultiFactorAuthentication :: Maybe Bucket
dosMultiFactorAuthentication = Maybe Bucket
forall a. Maybe a
Nothing
          }

data DeleteObjectsResponse
    = DeleteObjectsResponse {
        DeleteObjectsResponse -> [DORDeleted]
dorDeleted :: [DORDeleted]
      , DeleteObjectsResponse -> [DORErrors]
dorErrors  :: [DORErrors]
      }
    deriving (Int -> DeleteObjectsResponse -> ShowS
[DeleteObjectsResponse] -> ShowS
DeleteObjectsResponse -> String
(Int -> DeleteObjectsResponse -> ShowS)
-> (DeleteObjectsResponse -> String)
-> ([DeleteObjectsResponse] -> ShowS)
-> Show DeleteObjectsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeleteObjectsResponse -> ShowS
showsPrec :: Int -> DeleteObjectsResponse -> ShowS
$cshow :: DeleteObjectsResponse -> String
show :: DeleteObjectsResponse -> String
$cshowList :: [DeleteObjectsResponse] -> ShowS
showList :: [DeleteObjectsResponse] -> ShowS
Show)

--omitting DeleteMarker because it appears superfluous
data DORDeleted
    = DORDeleted {
        DORDeleted -> Bucket
ddKey                   :: T.Text
      , DORDeleted -> Maybe Bucket
ddVersionId             :: Maybe T.Text
      , DORDeleted -> Maybe Bucket
ddDeleteMarkerVersionId :: Maybe T.Text
      }
    deriving (Int -> DORDeleted -> ShowS
[DORDeleted] -> ShowS
DORDeleted -> String
(Int -> DORDeleted -> ShowS)
-> (DORDeleted -> String)
-> ([DORDeleted] -> ShowS)
-> Show DORDeleted
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DORDeleted -> ShowS
showsPrec :: Int -> DORDeleted -> ShowS
$cshow :: DORDeleted -> String
show :: DORDeleted -> String
$cshowList :: [DORDeleted] -> ShowS
showList :: [DORDeleted] -> ShowS
Show)

data DORErrors
    = DORErrors {
        DORErrors -> Bucket
deKey     :: T.Text
      , DORErrors -> Bucket
deCode    :: T.Text
      , DORErrors -> Bucket
deMessage :: T.Text
      }
    deriving (Int -> DORErrors -> ShowS
[DORErrors] -> ShowS
DORErrors -> String
(Int -> DORErrors -> ShowS)
-> (DORErrors -> String)
-> ([DORErrors] -> ShowS)
-> Show DORErrors
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DORErrors -> ShowS
showsPrec :: Int -> DORErrors -> ShowS
$cshow :: DORErrors -> String
show :: DORErrors -> String
$cshowList :: [DORErrors] -> ShowS
showList :: [DORErrors] -> ShowS
Show)

-- | ServiceConfiguration: 'S3Configuration'
instance SignQuery DeleteObjects where
    type ServiceConfiguration DeleteObjects = S3Configuration

    signQuery :: forall queryType.
DeleteObjects
-> ServiceConfiguration DeleteObjects queryType
-> SignatureData
-> SignedQuery
signQuery DeleteObjects {Bool
[(Bucket, Maybe Bucket)]
Maybe Bucket
Bucket
dosBucket :: DeleteObjects -> Bucket
dosObjects :: DeleteObjects -> [(Bucket, Maybe Bucket)]
dosQuiet :: DeleteObjects -> Bool
dosMultiFactorAuthentication :: DeleteObjects -> Maybe Bucket
dosBucket :: Bucket
dosObjects :: [(Bucket, Maybe Bucket)]
dosQuiet :: Bool
dosMultiFactorAuthentication :: Maybe Bucket
..} = S3Query
-> S3Configuration queryType -> SignatureData -> SignedQuery
forall qt.
S3Query -> S3Configuration qt -> SignatureData -> SignedQuery
s3SignQuery S3Query
      {
        s3QMethod :: Method
s3QMethod       = Method
Post
      , s3QBucket :: Maybe ByteString
s3QBucket       = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Bucket -> ByteString
T.encodeUtf8 Bucket
dosBucket
      , s3QSubresources :: [(ByteString, Maybe ByteString)]
s3QSubresources = [(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
forall a. QueryLike a => a -> [(ByteString, Maybe ByteString)]
HTTP.toQuery [(ByteString
"delete" :: B.ByteString, Maybe ByteString
forall a. Maybe a
Nothing :: Maybe B.ByteString)]
      , s3QQuery :: [(ByteString, Maybe ByteString)]
s3QQuery        = []
      , s3QContentType :: Maybe ByteString
s3QContentType  = Maybe ByteString
forall a. Maybe a
Nothing
      , s3QContentMd5 :: Maybe (Digest MD5)
s3QContentMd5   = Digest MD5 -> Maybe (Digest MD5)
forall a. a -> Maybe a
Just (Digest MD5 -> Maybe (Digest MD5))
-> Digest MD5 -> Maybe (Digest MD5)
forall a b. (a -> b) -> a -> b
$ ByteString -> Digest MD5
forall a. HashAlgorithm a => ByteString -> Digest a
CH.hashlazy ByteString
dosBody
      , s3QObject :: Maybe ByteString
s3QObject       = Maybe ByteString
forall a. Maybe a
Nothing
      , s3QAmzHeaders :: RequestHeaders
s3QAmzHeaders   = Maybe Header -> RequestHeaders
forall a. Maybe a -> [a]
maybeToList (Maybe Header -> RequestHeaders) -> Maybe Header -> RequestHeaders
forall a b. (a -> b) -> a -> b
$ ((HeaderName
"x-amz-mfa", ) (ByteString -> Header)
-> (Bucket -> ByteString) -> Bucket -> Header
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bucket -> ByteString
T.encodeUtf8) (Bucket -> Header) -> Maybe Bucket -> Maybe Header
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bucket
dosMultiFactorAuthentication
      , s3QOtherHeaders :: RequestHeaders
s3QOtherHeaders = []
      , s3QRequestBody :: Maybe RequestBody
s3QRequestBody  = RequestBody -> Maybe RequestBody
forall a. a -> Maybe a
Just (RequestBody -> Maybe RequestBody)
-> RequestBody -> Maybe RequestBody
forall a b. (a -> b) -> a -> b
$ ByteString -> RequestBody
HTTP.RequestBodyLBS ByteString
dosBody
      }
        where dosBody :: ByteString
dosBody = RenderSettings -> Document -> ByteString
XML.renderLBS RenderSettings
forall a. Default a => a
XML.def XML.Document {
                    documentPrologue :: Prologue
XML.documentPrologue = [Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
XML.Prologue [] Maybe Doctype
forall a. Maybe a
Nothing []
                  , documentRoot :: Element
XML.documentRoot = Element
root
                  , documentEpilogue :: [Miscellaneous]
XML.documentEpilogue = []
                  }
              root :: Element
root = XML.Element {
                    elementName :: Name
XML.elementName = Name
"Delete"
                  , elementAttributes :: Map Name Bucket
XML.elementAttributes = Map Name Bucket
forall k a. Map k a
M.empty
                  , elementNodes :: [Node]
XML.elementNodes = Bool -> Node
quietNode Bool
dosQuiet Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: ((Bucket, Maybe Bucket) -> Node
objectNode ((Bucket, Maybe Bucket) -> Node)
-> [(Bucket, Maybe Bucket)] -> [Node]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Bucket, Maybe Bucket)]
dosObjects)
                  }
              objectNode :: (Bucket, Maybe Bucket) -> Node
objectNode (Bucket
obj, Maybe Bucket
mbVersion) = Element -> Node
XML.NodeElement XML.Element {
                    elementName :: Name
XML.elementName = Name
"Object"
                  , elementAttributes :: Map Name Bucket
XML.elementAttributes = Map Name Bucket
forall k a. Map k a
M.empty
                  , elementNodes :: [Node]
XML.elementNodes = Bucket -> Node
keyNode Bucket
obj Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: Maybe Node -> [Node]
forall a. Maybe a -> [a]
maybeToList (Bucket -> Node
versionNode (Bucket -> Node) -> Maybe Bucket -> Maybe Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bucket
mbVersion)
                  }
              versionNode :: Bucket -> Node
versionNode = Name -> Bucket -> Node
toNode Name
"VersionId"
              keyNode :: Bucket -> Node
keyNode     = Name -> Bucket -> Node
toNode Name
"Key"
              quietNode :: Bool -> Node
quietNode Bool
b = Name -> Bucket -> Node
toNode Name
"Quiet" (Bucket -> Node) -> Bucket -> Node
forall a b. (a -> b) -> a -> b
$ if Bool
b then Bucket
"true" else Bucket
"false"
              toNode :: Name -> Bucket -> Node
toNode Name
name Bucket
content = Element -> Node
XML.NodeElement XML.Element {
                    elementName :: Name
XML.elementName = Name
name
                  , elementAttributes :: Map Name Bucket
XML.elementAttributes = Map Name Bucket
forall k a. Map k a
M.empty
                  , elementNodes :: [Node]
XML.elementNodes = [Bucket -> Node
XML.NodeContent Bucket
content]
                  }

instance ResponseConsumer DeleteObjects DeleteObjectsResponse where
    type ResponseMetadata DeleteObjectsResponse = S3Metadata

    responseConsumer :: Request
-> DeleteObjects
-> IORef (ResponseMetadata DeleteObjectsResponse)
-> HTTPResponseConsumer DeleteObjectsResponse
responseConsumer Request
_ DeleteObjects
_ = (Cursor -> Response S3Metadata DeleteObjectsResponse)
-> IORef S3Metadata -> HTTPResponseConsumer DeleteObjectsResponse
forall a.
(Cursor -> Response S3Metadata a)
-> IORef S3Metadata -> HTTPResponseConsumer a
s3XmlResponseConsumer Cursor -> Response S3Metadata DeleteObjectsResponse
forall {m :: * -> *}.
MonadThrow m =>
Cursor -> m DeleteObjectsResponse
parse
        where parse :: Cursor -> m DeleteObjectsResponse
parse Cursor
cursor = do
                  [DORDeleted]
dorDeleted <- [m DORDeleted] -> m [DORDeleted]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([m DORDeleted] -> m [DORDeleted])
-> [m DORDeleted] -> m [DORDeleted]
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor -> (Cursor -> [m DORDeleted]) -> [m DORDeleted]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Bucket -> Axis
Cu.laxElement Bucket
"Deleted" Axis -> (Cursor -> m DORDeleted) -> Cursor -> [m DORDeleted]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> m DORDeleted
forall {m :: * -> *}. MonadThrow m => Cursor -> m DORDeleted
parseDeleted
                  [DORErrors]
dorErrors  <- [m DORErrors] -> m [DORErrors]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([m DORErrors] -> m [DORErrors]) -> [m DORErrors] -> m [DORErrors]
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor -> (Cursor -> [m DORErrors]) -> [m DORErrors]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Bucket -> Axis
Cu.laxElement Bucket
"Error" Axis -> (Cursor -> m DORErrors) -> Cursor -> [m DORErrors]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> m DORErrors
forall {m :: * -> *}. MonadThrow m => Cursor -> m DORErrors
parseErrors
                  DeleteObjectsResponse -> m DeleteObjectsResponse
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return DeleteObjectsResponse {[DORErrors]
[DORDeleted]
dorDeleted :: [DORDeleted]
dorErrors :: [DORErrors]
dorDeleted :: [DORDeleted]
dorErrors :: [DORErrors]
..}
              parseDeleted :: Cursor -> m DORDeleted
parseDeleted Cursor
c = do
                  Bucket
ddKey <- String -> [Bucket] -> m Bucket
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing Key" ([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]
$/ Bucket -> Cursor -> [Bucket]
elContent Bucket
"Key"
                  let ddVersionId :: Maybe Bucket
ddVersionId = [Bucket] -> Maybe Bucket
forall a. [a] -> Maybe a
listToMaybe ([Bucket] -> Maybe Bucket) -> [Bucket] -> Maybe Bucket
forall a b. (a -> b) -> a -> b
$ Cursor
c Cursor -> (Cursor -> [Bucket]) -> [Bucket]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Bucket -> Cursor -> [Bucket]
elContent Bucket
"VersionId"
                      ddDeleteMarkerVersionId :: Maybe Bucket
ddDeleteMarkerVersionId = [Bucket] -> Maybe Bucket
forall a. [a] -> Maybe a
listToMaybe ([Bucket] -> Maybe Bucket) -> [Bucket] -> Maybe Bucket
forall a b. (a -> b) -> a -> b
$ Cursor
c Cursor -> (Cursor -> [Bucket]) -> [Bucket]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Bucket -> Cursor -> [Bucket]
elContent Bucket
"DeleteMarkerVersionId"
                  DORDeleted -> m DORDeleted
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return DORDeleted {Maybe Bucket
Bucket
ddKey :: Bucket
ddVersionId :: Maybe Bucket
ddDeleteMarkerVersionId :: Maybe Bucket
ddKey :: Bucket
ddVersionId :: Maybe Bucket
ddDeleteMarkerVersionId :: Maybe Bucket
..}
              parseErrors :: Cursor -> m DORErrors
parseErrors Cursor
c = do
                  Bucket
deKey     <- String -> [Bucket] -> m Bucket
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing Key" ([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]
$/ Bucket -> Cursor -> [Bucket]
elContent Bucket
"Key"
                  Bucket
deCode    <- String -> [Bucket] -> m Bucket
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing Code" ([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]
$/ Bucket -> Cursor -> [Bucket]
elContent Bucket
"Code"
                  Bucket
deMessage <- String -> [Bucket] -> m Bucket
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing Message" ([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]
$/ Bucket -> Cursor -> [Bucket]
elContent Bucket
"Message"
                  DORErrors -> m DORErrors
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return DORErrors {Bucket
deKey :: Bucket
deCode :: Bucket
deMessage :: Bucket
deKey :: Bucket
deCode :: Bucket
deMessage :: Bucket
..}

instance Transaction DeleteObjects DeleteObjectsResponse

instance AsMemoryResponse DeleteObjectsResponse where
    type MemoryResponse DeleteObjectsResponse = DeleteObjectsResponse
    loadToMemory :: DeleteObjectsResponse
-> ResourceT IO (MemoryResponse DeleteObjectsResponse)
loadToMemory = DeleteObjectsResponse
-> ResourceT IO (MemoryResponse DeleteObjectsResponse)
DeleteObjectsResponse -> ResourceT IO DeleteObjectsResponse
forall a. a -> ResourceT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return