{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Network.DO.Spaces.Actions.UploadMultipart
( BeginMultipart(..)
, BeginMultipartResponse(..)
, UploadPart(..)
, UploadPartResponse(..)
, ListParts(..)
, Part(..)
, ListPartsResponse(..)
, UploadID
, CancelMultipart(..)
, MultipartSession(..)
, CancelMultipartResponse
, CompleteMultipart(..)
, CompleteMultipartResponse(..)
) where
import Control.Monad.Catch ( MonadThrow(throwM) )
import Control.Monad.Reader ( MonadReader(ask) )
import Control.Monad.Trans.Maybe ( MaybeT(runMaybeT) )
import Data.ByteString ( ByteString )
import qualified Data.CaseInsensitive as CI
import Data.Generics.Product ( HasField(field) )
import Data.Sequence ( Seq )
import qualified Data.Sequence as S
import Data.Text ( Text )
import Data.Time ( UTCTime )
import GHC.Generics ( Generic )
import Lens.Micro ( (^.), (^?) )
import Network.DO.Spaces.Types
( Action(..)
, Bucket
, ClientException(OtherError)
, ETag
, Method(POST, DELETE, PUT)
, MonadSpaces
, Object
, SpacesRequestBuilder(..)
, UploadHeaders
)
import Network.DO.Spaces.Utils
( bucketP
, etagP
, isTruncP
, lastModifiedP
, lookupHeader
, mkNode
, objectP
, quote
, readEtag
, renderUploadHeaders
, tshow
, xmlDocCursor
, xmlElemError
, xmlNum
)
import Network.HTTP.Client.Conduit ( RequestBody(RequestBodyLBS) )
import qualified Network.HTTP.Types as H
import Network.Mime ( MimeType )
import qualified Text.XML as X
import qualified Text.XML.Cursor as X
import Text.XML.Cursor ( ($/), (&/), (&|) )
data Part = Part
{ Part -> Int
partNumber :: Int
, Part -> UTCTime
lastModified :: UTCTime
, Part -> ETag
etag :: ETag
, Part -> Int
size :: Int
}
deriving ( Int -> Part -> ShowS
[Part] -> ShowS
Part -> String
(Int -> Part -> ShowS)
-> (Part -> String) -> ([Part] -> ShowS) -> Show Part
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Part] -> ShowS
$cshowList :: [Part] -> ShowS
show :: Part -> String
$cshow :: Part -> String
showsPrec :: Int -> Part -> ShowS
$cshowsPrec :: Int -> Part -> ShowS
Show, Part -> Part -> Bool
(Part -> Part -> Bool) -> (Part -> Part -> Bool) -> Eq Part
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Part -> Part -> Bool
$c/= :: Part -> Part -> Bool
== :: Part -> Part -> Bool
$c== :: Part -> Part -> Bool
Eq, (forall x. Part -> Rep Part x)
-> (forall x. Rep Part x -> Part) -> Generic Part
forall x. Rep Part x -> Part
forall x. Part -> Rep Part x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Part x -> Part
$cfrom :: forall x. Part -> Rep Part x
Generic )
data MultipartSession = MultipartSession
{ MultipartSession -> Bucket
bucket :: Bucket
, MultipartSession -> Object
object :: Object
, MultipartSession -> ETag
uploadID :: UploadID
}
deriving ( Int -> MultipartSession -> ShowS
[MultipartSession] -> ShowS
MultipartSession -> String
(Int -> MultipartSession -> ShowS)
-> (MultipartSession -> String)
-> ([MultipartSession] -> ShowS)
-> Show MultipartSession
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MultipartSession] -> ShowS
$cshowList :: [MultipartSession] -> ShowS
show :: MultipartSession -> String
$cshow :: MultipartSession -> String
showsPrec :: Int -> MultipartSession -> ShowS
$cshowsPrec :: Int -> MultipartSession -> ShowS
Show, MultipartSession -> MultipartSession -> Bool
(MultipartSession -> MultipartSession -> Bool)
-> (MultipartSession -> MultipartSession -> Bool)
-> Eq MultipartSession
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MultipartSession -> MultipartSession -> Bool
$c/= :: MultipartSession -> MultipartSession -> Bool
== :: MultipartSession -> MultipartSession -> Bool
$c== :: MultipartSession -> MultipartSession -> Bool
Eq, (forall x. MultipartSession -> Rep MultipartSession x)
-> (forall x. Rep MultipartSession x -> MultipartSession)
-> Generic MultipartSession
forall x. Rep MultipartSession x -> MultipartSession
forall x. MultipartSession -> Rep MultipartSession x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MultipartSession x -> MultipartSession
$cfrom :: forall x. MultipartSession -> Rep MultipartSession x
Generic )
type UploadID = Text
data BeginMultipart = BeginMultipart
{ BeginMultipart -> Bucket
bucket :: Bucket
, BeginMultipart -> Object
object :: Object
, :: UploadHeaders
, BeginMultipart -> Maybe MimeType
contentType :: Maybe MimeType
}
deriving ( Int -> BeginMultipart -> ShowS
[BeginMultipart] -> ShowS
BeginMultipart -> String
(Int -> BeginMultipart -> ShowS)
-> (BeginMultipart -> String)
-> ([BeginMultipart] -> ShowS)
-> Show BeginMultipart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BeginMultipart] -> ShowS
$cshowList :: [BeginMultipart] -> ShowS
show :: BeginMultipart -> String
$cshow :: BeginMultipart -> String
showsPrec :: Int -> BeginMultipart -> ShowS
$cshowsPrec :: Int -> BeginMultipart -> ShowS
Show, BeginMultipart -> BeginMultipart -> Bool
(BeginMultipart -> BeginMultipart -> Bool)
-> (BeginMultipart -> BeginMultipart -> Bool) -> Eq BeginMultipart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BeginMultipart -> BeginMultipart -> Bool
$c/= :: BeginMultipart -> BeginMultipart -> Bool
== :: BeginMultipart -> BeginMultipart -> Bool
$c== :: BeginMultipart -> BeginMultipart -> Bool
Eq, (forall x. BeginMultipart -> Rep BeginMultipart x)
-> (forall x. Rep BeginMultipart x -> BeginMultipart)
-> Generic BeginMultipart
forall x. Rep BeginMultipart x -> BeginMultipart
forall x. BeginMultipart -> Rep BeginMultipart x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BeginMultipart x -> BeginMultipart
$cfrom :: forall x. BeginMultipart -> Rep BeginMultipart x
Generic )
newtype BeginMultipartResponse =
BeginMultipartResponse { BeginMultipartResponse -> MultipartSession
session :: MultipartSession }
deriving ( Int -> BeginMultipartResponse -> ShowS
[BeginMultipartResponse] -> ShowS
BeginMultipartResponse -> String
(Int -> BeginMultipartResponse -> ShowS)
-> (BeginMultipartResponse -> String)
-> ([BeginMultipartResponse] -> ShowS)
-> Show BeginMultipartResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BeginMultipartResponse] -> ShowS
$cshowList :: [BeginMultipartResponse] -> ShowS
show :: BeginMultipartResponse -> String
$cshow :: BeginMultipartResponse -> String
showsPrec :: Int -> BeginMultipartResponse -> ShowS
$cshowsPrec :: Int -> BeginMultipartResponse -> ShowS
Show, BeginMultipartResponse -> BeginMultipartResponse -> Bool
(BeginMultipartResponse -> BeginMultipartResponse -> Bool)
-> (BeginMultipartResponse -> BeginMultipartResponse -> Bool)
-> Eq BeginMultipartResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BeginMultipartResponse -> BeginMultipartResponse -> Bool
$c/= :: BeginMultipartResponse -> BeginMultipartResponse -> Bool
== :: BeginMultipartResponse -> BeginMultipartResponse -> Bool
$c== :: BeginMultipartResponse -> BeginMultipartResponse -> Bool
Eq, (forall x. BeginMultipartResponse -> Rep BeginMultipartResponse x)
-> (forall x.
Rep BeginMultipartResponse x -> BeginMultipartResponse)
-> Generic BeginMultipartResponse
forall x. Rep BeginMultipartResponse x -> BeginMultipartResponse
forall x. BeginMultipartResponse -> Rep BeginMultipartResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BeginMultipartResponse x -> BeginMultipartResponse
$cfrom :: forall x. BeginMultipartResponse -> Rep BeginMultipartResponse x
Generic )
instance MonadSpaces m => Action m BeginMultipart where
type (ConsumedResponse BeginMultipart) = BeginMultipartResponse
buildRequest :: BeginMultipart -> m SpacesRequestBuilder
buildRequest BeginMultipart { Maybe MimeType
UploadHeaders
Object
Bucket
contentType :: Maybe MimeType
optionalHeaders :: UploadHeaders
object :: Object
bucket :: Bucket
$sel:contentType:BeginMultipart :: BeginMultipart -> Maybe MimeType
$sel:optionalHeaders:BeginMultipart :: BeginMultipart -> UploadHeaders
$sel:object:BeginMultipart :: BeginMultipart -> Object
$sel:bucket:BeginMultipart :: BeginMultipart -> Bucket
.. } = do
Spaces
spaces <- m Spaces
forall r (m :: * -> *). MonadReader r m => m r
ask
SpacesRequestBuilder -> m SpacesRequestBuilder
forall (m :: * -> *) a. Monad m => a -> m a
return SpacesRequestBuilder :: Spaces
-> Maybe RequestBody
-> Maybe Method
-> [Header]
-> Maybe Bucket
-> Maybe Object
-> Maybe Query
-> Maybe Query
-> Maybe Region
-> SpacesRequestBuilder
SpacesRequestBuilder
{ $sel:bucket:SpacesRequestBuilder :: Maybe Bucket
bucket = Bucket -> Maybe Bucket
forall a. a -> Maybe a
Just Bucket
bucket
, $sel:object:SpacesRequestBuilder :: Maybe Object
object = Object -> Maybe Object
forall a. a -> Maybe a
Just Object
object
, $sel:method:SpacesRequestBuilder :: Maybe Method
method = Method -> Maybe Method
forall a. a -> Maybe a
Just Method
POST
, $sel:body:SpacesRequestBuilder :: Maybe RequestBody
body = Maybe RequestBody
forall a. Maybe a
Nothing
, $sel:overrideRegion:SpacesRequestBuilder :: Maybe Region
overrideRegion = Maybe Region
forall a. Maybe a
Nothing
, $sel:queryString:SpacesRequestBuilder :: Maybe Query
queryString = Maybe Query
forall a. Maybe a
Nothing
, $sel:subresources:SpacesRequestBuilder :: Maybe Query
subresources = Query -> Maybe Query
forall a. a -> Maybe a
Just
(Query -> Maybe Query) -> Query -> Maybe Query
forall a b. (a -> b) -> a -> b
$ Query -> Query
forall a. QueryLike a => a -> Query
H.toQuery [ ( MimeType
"uploads" :: ByteString
, Maybe MimeType
forall a. Maybe a
Nothing :: Maybe ByteString
)
]
, [Header]
Spaces
$sel:headers:SpacesRequestBuilder :: [Header]
$sel:spaces:SpacesRequestBuilder :: Spaces
headers :: [Header]
spaces :: Spaces
..
}
where
headers :: [Header]
headers = ([Header] -> [Header])
-> (MimeType -> [Header] -> [Header])
-> Maybe MimeType
-> [Header]
-> [Header]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Header] -> [Header]
forall a. a -> a
id
(\MimeType
ct -> (:) (MimeType -> CI MimeType
forall s. FoldCase s => s -> CI s
CI.mk MimeType
"Content-Type", MimeType
ct))
Maybe MimeType
contentType
(UploadHeaders -> [Header]
renderUploadHeaders UploadHeaders
optionalHeaders)
consumeResponse :: RawResponse m -> m (ConsumedResponse BeginMultipart)
consumeResponse RawResponse m
raw = do
Cursor
cursor <- RawResponse m -> m Cursor
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
RawResponse m -> m Cursor
xmlDocCursor RawResponse m
raw
Object
object <- Cursor -> m Object
forall (m :: * -> *). MonadThrow m => Cursor -> m Object
objectP Cursor
cursor
Bucket
bucket <- Cursor -> m Bucket
forall (m :: * -> *). MonadThrow m => Cursor -> m Bucket
bucketP Cursor
cursor
ETag
uploadID <- ClientException -> [ETag] -> m ETag
forall e (f :: * -> *) a.
(Exception e, MonadThrow f) =>
e -> [a] -> f a
X.force (ETag -> ClientException
xmlElemError ETag
"UploadId")
([ETag] -> m ETag) -> [ETag] -> m ETag
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor -> (Cursor -> [ETag]) -> [ETag]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ ETag -> Axis
X.laxElement ETag
"UploadId" Axis -> (Cursor -> [ETag]) -> Cursor -> [ETag]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [ETag]
X.content
BeginMultipartResponse -> m BeginMultipartResponse
forall (m :: * -> *) a. Monad m => a -> m a
return (BeginMultipartResponse -> m BeginMultipartResponse)
-> BeginMultipartResponse -> m BeginMultipartResponse
forall a b. (a -> b) -> a -> b
$ BeginMultipartResponse :: MultipartSession -> BeginMultipartResponse
BeginMultipartResponse { $sel:session:BeginMultipartResponse :: MultipartSession
session = MultipartSession :: Bucket -> Object -> ETag -> MultipartSession
MultipartSession { ETag
Object
Bucket
uploadID :: ETag
bucket :: Bucket
object :: Object
$sel:uploadID:MultipartSession :: ETag
$sel:object:MultipartSession :: Object
$sel:bucket:MultipartSession :: Bucket
.. } }
data UploadPart = UploadPart
{ UploadPart -> MultipartSession
session :: MultipartSession, UploadPart -> Int
partNumber :: Int, UploadPart -> RequestBody
body :: RequestBody }
deriving ( (forall x. UploadPart -> Rep UploadPart x)
-> (forall x. Rep UploadPart x -> UploadPart) -> Generic UploadPart
forall x. Rep UploadPart x -> UploadPart
forall x. UploadPart -> Rep UploadPart x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UploadPart x -> UploadPart
$cfrom :: forall x. UploadPart -> Rep UploadPart x
Generic )
data UploadPartResponse = UploadPartResponse { UploadPartResponse -> ETag
etag :: ETag }
deriving ( Int -> UploadPartResponse -> ShowS
[UploadPartResponse] -> ShowS
UploadPartResponse -> String
(Int -> UploadPartResponse -> ShowS)
-> (UploadPartResponse -> String)
-> ([UploadPartResponse] -> ShowS)
-> Show UploadPartResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UploadPartResponse] -> ShowS
$cshowList :: [UploadPartResponse] -> ShowS
show :: UploadPartResponse -> String
$cshow :: UploadPartResponse -> String
showsPrec :: Int -> UploadPartResponse -> ShowS
$cshowsPrec :: Int -> UploadPartResponse -> ShowS
Show, UploadPartResponse -> UploadPartResponse -> Bool
(UploadPartResponse -> UploadPartResponse -> Bool)
-> (UploadPartResponse -> UploadPartResponse -> Bool)
-> Eq UploadPartResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UploadPartResponse -> UploadPartResponse -> Bool
$c/= :: UploadPartResponse -> UploadPartResponse -> Bool
== :: UploadPartResponse -> UploadPartResponse -> Bool
$c== :: UploadPartResponse -> UploadPartResponse -> Bool
Eq, (forall x. UploadPartResponse -> Rep UploadPartResponse x)
-> (forall x. Rep UploadPartResponse x -> UploadPartResponse)
-> Generic UploadPartResponse
forall x. Rep UploadPartResponse x -> UploadPartResponse
forall x. UploadPartResponse -> Rep UploadPartResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UploadPartResponse x -> UploadPartResponse
$cfrom :: forall x. UploadPartResponse -> Rep UploadPartResponse x
Generic )
instance MonadSpaces m => Action m UploadPart where
type (ConsumedResponse UploadPart) = UploadPartResponse
buildRequest :: UploadPart -> m SpacesRequestBuilder
buildRequest UploadPart { Int
RequestBody
MultipartSession
body :: RequestBody
partNumber :: Int
session :: MultipartSession
$sel:body:UploadPart :: UploadPart -> RequestBody
$sel:partNumber:UploadPart :: UploadPart -> Int
$sel:session:UploadPart :: UploadPart -> MultipartSession
.. } = do
Spaces
spaces <- m Spaces
forall r (m :: * -> *). MonadReader r m => m r
ask
SpacesRequestBuilder -> m SpacesRequestBuilder
forall (m :: * -> *) a. Monad m => a -> m a
return SpacesRequestBuilder :: Spaces
-> Maybe RequestBody
-> Maybe Method
-> [Header]
-> Maybe Bucket
-> Maybe Object
-> Maybe Query
-> Maybe Query
-> Maybe Region
-> SpacesRequestBuilder
SpacesRequestBuilder
{ $sel:bucket:SpacesRequestBuilder :: Maybe Bucket
bucket = MultipartSession
session MultipartSession
-> Getting (First Bucket) MultipartSession Bucket -> Maybe Bucket
forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s t a b. HasField "bucket" 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 @"bucket"
, $sel:object:SpacesRequestBuilder :: Maybe Object
object = MultipartSession
session MultipartSession
-> Getting (First Object) MultipartSession Object -> Maybe Object
forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s t a b. HasField "object" 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 @"object"
, $sel:body:SpacesRequestBuilder :: Maybe RequestBody
body = RequestBody -> Maybe RequestBody
forall a. a -> Maybe a
Just RequestBody
body
, $sel:method:SpacesRequestBuilder :: Maybe Method
method = Method -> Maybe Method
forall a. a -> Maybe a
Just Method
PUT
, $sel:overrideRegion:SpacesRequestBuilder :: Maybe Region
overrideRegion = Maybe Region
forall a. Maybe a
Nothing
, $sel:subresources:SpacesRequestBuilder :: Maybe Query
subresources = Maybe Query
forall a. Maybe a
Nothing
, $sel:headers:SpacesRequestBuilder :: [Header]
headers = [Header]
forall a. Monoid a => a
mempty
, $sel:queryString:SpacesRequestBuilder :: Maybe Query
queryString = Query -> Maybe Query
forall a. a -> Maybe a
Just
(Query -> Maybe Query) -> Query -> Maybe Query
forall a b. (a -> b) -> a -> b
$ [(ETag, ETag)] -> Query
forall a. QueryLike a => a -> Query
H.toQuery [ (ETag
"partNumber" :: Text, Int -> ETag
forall a. Show a => a -> ETag
tshow Int
partNumber)
, (ETag
"uploadId", MultipartSession
session MultipartSession -> Getting ETag MultipartSession ETag -> ETag
forall s a. s -> Getting a s a -> a
^. forall s t a b. HasField "uploadID" 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 @"uploadID")
]
, Spaces
spaces :: Spaces
$sel:spaces:SpacesRequestBuilder :: Spaces
..
}
consumeResponse :: RawResponse m -> m (ConsumedResponse UploadPart)
consumeResponse RawResponse m
raw =
MaybeT m UploadPartResponse -> m (Maybe UploadPartResponse)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (ETag -> UploadPartResponse
UploadPartResponse
(ETag -> UploadPartResponse)
-> MaybeT m ETag -> MaybeT m UploadPartResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MimeType -> MaybeT m ETag
forall (m :: * -> *). Monad m => MimeType -> MaybeT m ETag
readEtag (MimeType -> MaybeT m ETag) -> MaybeT m MimeType -> MaybeT m ETag
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RawResponse m -> CI MimeType -> MaybeT m MimeType
forall (m :: * -> *).
Monad m =>
RawResponse m -> CI MimeType -> MaybeT m MimeType
lookupHeader RawResponse m
raw CI MimeType
"etag"))
m (Maybe UploadPartResponse)
-> (Maybe UploadPartResponse -> m UploadPartResponse)
-> m UploadPartResponse
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe UploadPartResponse
Nothing -> ClientException -> m UploadPartResponse
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientException -> m UploadPartResponse)
-> ClientException -> m UploadPartResponse
forall a b. (a -> b) -> a -> b
$ ETag -> ClientException
OtherError ETag
"Missing/malformed headers"
Just UploadPartResponse
r -> UploadPartResponse -> m UploadPartResponse
forall (m :: * -> *) a. Monad m => a -> m a
return UploadPartResponse
r
data CompleteMultipart = CompleteMultipart
{ CompleteMultipart -> MultipartSession
session :: MultipartSession
, CompleteMultipart -> [(Int, ETag)]
parts :: [(Int, ETag)]
}
deriving ( Int -> CompleteMultipart -> ShowS
[CompleteMultipart] -> ShowS
CompleteMultipart -> String
(Int -> CompleteMultipart -> ShowS)
-> (CompleteMultipart -> String)
-> ([CompleteMultipart] -> ShowS)
-> Show CompleteMultipart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompleteMultipart] -> ShowS
$cshowList :: [CompleteMultipart] -> ShowS
show :: CompleteMultipart -> String
$cshow :: CompleteMultipart -> String
showsPrec :: Int -> CompleteMultipart -> ShowS
$cshowsPrec :: Int -> CompleteMultipart -> ShowS
Show, CompleteMultipart -> CompleteMultipart -> Bool
(CompleteMultipart -> CompleteMultipart -> Bool)
-> (CompleteMultipart -> CompleteMultipart -> Bool)
-> Eq CompleteMultipart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompleteMultipart -> CompleteMultipart -> Bool
$c/= :: CompleteMultipart -> CompleteMultipart -> Bool
== :: CompleteMultipart -> CompleteMultipart -> Bool
$c== :: CompleteMultipart -> CompleteMultipart -> Bool
Eq, (forall x. CompleteMultipart -> Rep CompleteMultipart x)
-> (forall x. Rep CompleteMultipart x -> CompleteMultipart)
-> Generic CompleteMultipart
forall x. Rep CompleteMultipart x -> CompleteMultipart
forall x. CompleteMultipart -> Rep CompleteMultipart x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CompleteMultipart x -> CompleteMultipart
$cfrom :: forall x. CompleteMultipart -> Rep CompleteMultipart x
Generic )
data CompleteMultipartResponse = CompleteMultipartResponse
{ CompleteMultipartResponse -> ETag
location :: Text
, CompleteMultipartResponse -> Bucket
bucket :: Bucket
, CompleteMultipartResponse -> Object
object :: Object
, CompleteMultipartResponse -> ETag
etag :: ETag
}
deriving ( Int -> CompleteMultipartResponse -> ShowS
[CompleteMultipartResponse] -> ShowS
CompleteMultipartResponse -> String
(Int -> CompleteMultipartResponse -> ShowS)
-> (CompleteMultipartResponse -> String)
-> ([CompleteMultipartResponse] -> ShowS)
-> Show CompleteMultipartResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompleteMultipartResponse] -> ShowS
$cshowList :: [CompleteMultipartResponse] -> ShowS
show :: CompleteMultipartResponse -> String
$cshow :: CompleteMultipartResponse -> String
showsPrec :: Int -> CompleteMultipartResponse -> ShowS
$cshowsPrec :: Int -> CompleteMultipartResponse -> ShowS
Show, CompleteMultipartResponse -> CompleteMultipartResponse -> Bool
(CompleteMultipartResponse -> CompleteMultipartResponse -> Bool)
-> (CompleteMultipartResponse -> CompleteMultipartResponse -> Bool)
-> Eq CompleteMultipartResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompleteMultipartResponse -> CompleteMultipartResponse -> Bool
$c/= :: CompleteMultipartResponse -> CompleteMultipartResponse -> Bool
== :: CompleteMultipartResponse -> CompleteMultipartResponse -> Bool
$c== :: CompleteMultipartResponse -> CompleteMultipartResponse -> Bool
Eq, (forall x.
CompleteMultipartResponse -> Rep CompleteMultipartResponse x)
-> (forall x.
Rep CompleteMultipartResponse x -> CompleteMultipartResponse)
-> Generic CompleteMultipartResponse
forall x.
Rep CompleteMultipartResponse x -> CompleteMultipartResponse
forall x.
CompleteMultipartResponse -> Rep CompleteMultipartResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CompleteMultipartResponse x -> CompleteMultipartResponse
$cfrom :: forall x.
CompleteMultipartResponse -> Rep CompleteMultipartResponse x
Generic )
instance MonadSpaces m => Action m CompleteMultipart where
type ConsumedResponse CompleteMultipart = CompleteMultipartResponse
buildRequest :: CompleteMultipart -> m SpacesRequestBuilder
buildRequest CompleteMultipart { [(Int, ETag)]
MultipartSession
parts :: [(Int, ETag)]
session :: MultipartSession
$sel:parts:CompleteMultipart :: CompleteMultipart -> [(Int, ETag)]
$sel:session:CompleteMultipart :: CompleteMultipart -> MultipartSession
.. } = do
Spaces
spaces <- m Spaces
forall r (m :: * -> *). MonadReader r m => m r
ask
SpacesRequestBuilder -> m SpacesRequestBuilder
forall (m :: * -> *) a. Monad m => a -> m a
return SpacesRequestBuilder :: Spaces
-> Maybe RequestBody
-> Maybe Method
-> [Header]
-> Maybe Bucket
-> Maybe Object
-> Maybe Query
-> Maybe Query
-> Maybe Region
-> SpacesRequestBuilder
SpacesRequestBuilder
{ $sel:bucket:SpacesRequestBuilder :: Maybe Bucket
bucket = MultipartSession
session MultipartSession
-> Getting (First Bucket) MultipartSession Bucket -> Maybe Bucket
forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s t a b. HasField "bucket" 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 @"bucket"
, $sel:object:SpacesRequestBuilder :: Maybe Object
object = MultipartSession
session MultipartSession
-> Getting (First Object) MultipartSession Object -> Maybe Object
forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s t a b. HasField "object" 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 @"object"
, $sel:method:SpacesRequestBuilder :: Maybe Method
method = Method -> Maybe Method
forall a. a -> Maybe a
Just Method
POST
, $sel:overrideRegion:SpacesRequestBuilder :: Maybe Region
overrideRegion = Maybe Region
forall a. Maybe a
Nothing
, $sel:subresources:SpacesRequestBuilder :: Maybe Query
subresources = Maybe Query
forall a. Maybe a
Nothing
, $sel:headers:SpacesRequestBuilder :: [Header]
headers = [Header]
forall a. Monoid a => a
mempty
, $sel:queryString:SpacesRequestBuilder :: Maybe Query
queryString = Query -> Maybe Query
forall a. a -> Maybe a
Just
(Query -> Maybe Query) -> Query -> Maybe Query
forall a b. (a -> b) -> a -> b
$ [(ETag, ETag)] -> Query
forall a. QueryLike a => a -> Query
H.toQuery [ ( ETag
"uploadId" :: Text
, MultipartSession
session MultipartSession -> Getting ETag MultipartSession ETag -> ETag
forall s a. s -> Getting a s a -> a
^. forall s t a b. HasField "uploadID" 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 @"uploadID"
)
]
, Maybe RequestBody
Spaces
body :: Maybe RequestBody
spaces :: Spaces
$sel:spaces:SpacesRequestBuilder :: Spaces
$sel:body:SpacesRequestBuilder :: Maybe RequestBody
..
}
where
body :: Maybe RequestBody
body = RequestBody -> Maybe RequestBody
forall a. a -> Maybe a
Just (RequestBody -> Maybe RequestBody)
-> (Document -> RequestBody) -> Document -> Maybe RequestBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> RequestBody
RequestBodyLBS (ByteString -> RequestBody)
-> (Document -> ByteString) -> Document -> RequestBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderSettings -> Document -> ByteString
X.renderLBS RenderSettings
forall a. Default a => a
X.def
(Document -> Maybe RequestBody) -> Document -> Maybe RequestBody
forall a b. (a -> b) -> a -> b
$ Prologue -> Element -> [Miscellaneous] -> Document
X.Document Prologue
prologue Element
root [Miscellaneous]
forall a. Monoid a => a
mempty
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 ETag -> [Node] -> Element
X.Element Name
"CompleteMultipartUpload" Map Name ETag
forall a. Monoid a => a
mempty ((Int, ETag) -> Node
forall a. Show a => (a, ETag) -> Node
partNode ((Int, ETag) -> Node) -> [(Int, ETag)] -> [Node]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, ETag)]
parts)
partNode :: (a, ETag) -> Node
partNode (a
n, ETag
etag) = Element -> Node
X.NodeElement
(Element -> Node) -> Element -> Node
forall a b. (a -> b) -> a -> b
$ Name -> Map Name ETag -> [Node] -> Element
X.Element Name
"Part"
Map Name ETag
forall a. Monoid a => a
mempty
[ Name -> ETag -> Node
mkNode Name
"PartNumber" (a -> ETag
forall a. Show a => a -> ETag
tshow a
n)
, Name -> ETag -> Node
mkNode Name
"ETag" (ETag -> ETag
forall a. (IsString a, Monoid a) => a -> a
quote ETag
etag)
]
consumeResponse :: RawResponse m -> m (ConsumedResponse CompleteMultipart)
consumeResponse RawResponse m
raw = do
Cursor
cursor <- RawResponse m -> m Cursor
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
RawResponse m -> m Cursor
xmlDocCursor RawResponse m
raw
Bucket
bucket <- Cursor -> m Bucket
forall (m :: * -> *). MonadThrow m => Cursor -> m Bucket
bucketP Cursor
cursor
ETag
location <- ClientException -> [ETag] -> m ETag
forall e (f :: * -> *) a.
(Exception e, MonadThrow f) =>
e -> [a] -> f a
X.force (ETag -> ClientException
xmlElemError ETag
"Location")
([ETag] -> m ETag) -> [ETag] -> m ETag
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor -> (Cursor -> [ETag]) -> [ETag]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ ETag -> Axis
X.laxElement ETag
"Location" Axis -> (Cursor -> [ETag]) -> Cursor -> [ETag]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [ETag]
X.content
Object
object <- Cursor -> m Object
forall (m :: * -> *). MonadThrow m => Cursor -> m Object
objectP Cursor
cursor
ETag
etag <- Cursor -> m ETag
forall (m :: * -> *). MonadThrow m => Cursor -> m ETag
etagP Cursor
cursor
CompleteMultipartResponse -> m CompleteMultipartResponse
forall (m :: * -> *) a. Monad m => a -> m a
return CompleteMultipartResponse :: ETag -> Bucket -> Object -> ETag -> CompleteMultipartResponse
CompleteMultipartResponse { ETag
Object
Bucket
etag :: ETag
object :: Object
location :: ETag
bucket :: Bucket
$sel:etag:CompleteMultipartResponse :: ETag
$sel:object:CompleteMultipartResponse :: Object
$sel:bucket:CompleteMultipartResponse :: Bucket
$sel:location:CompleteMultipartResponse :: ETag
.. }
newtype CancelMultipart = CancelMultipart { CancelMultipart -> MultipartSession
session :: MultipartSession }
deriving ( Int -> CancelMultipart -> ShowS
[CancelMultipart] -> ShowS
CancelMultipart -> String
(Int -> CancelMultipart -> ShowS)
-> (CancelMultipart -> String)
-> ([CancelMultipart] -> ShowS)
-> Show CancelMultipart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CancelMultipart] -> ShowS
$cshowList :: [CancelMultipart] -> ShowS
show :: CancelMultipart -> String
$cshow :: CancelMultipart -> String
showsPrec :: Int -> CancelMultipart -> ShowS
$cshowsPrec :: Int -> CancelMultipart -> ShowS
Show, CancelMultipart -> CancelMultipart -> Bool
(CancelMultipart -> CancelMultipart -> Bool)
-> (CancelMultipart -> CancelMultipart -> Bool)
-> Eq CancelMultipart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CancelMultipart -> CancelMultipart -> Bool
$c/= :: CancelMultipart -> CancelMultipart -> Bool
== :: CancelMultipart -> CancelMultipart -> Bool
$c== :: CancelMultipart -> CancelMultipart -> Bool
Eq, (forall x. CancelMultipart -> Rep CancelMultipart x)
-> (forall x. Rep CancelMultipart x -> CancelMultipart)
-> Generic CancelMultipart
forall x. Rep CancelMultipart x -> CancelMultipart
forall x. CancelMultipart -> Rep CancelMultipart x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CancelMultipart x -> CancelMultipart
$cfrom :: forall x. CancelMultipart -> Rep CancelMultipart x
Generic )
type CancelMultipartResponse = ()
instance MonadSpaces m => Action m CancelMultipart where
type (ConsumedResponse CancelMultipart) = CancelMultipartResponse
buildRequest :: CancelMultipart -> m SpacesRequestBuilder
buildRequest CancelMultipart { MultipartSession
session :: MultipartSession
$sel:session:CancelMultipart :: CancelMultipart -> MultipartSession
.. } = do
Spaces
spaces <- m Spaces
forall r (m :: * -> *). MonadReader r m => m r
ask
SpacesRequestBuilder -> m SpacesRequestBuilder
forall (m :: * -> *) a. Monad m => a -> m a
return SpacesRequestBuilder :: Spaces
-> Maybe RequestBody
-> Maybe Method
-> [Header]
-> Maybe Bucket
-> Maybe Object
-> Maybe Query
-> Maybe Query
-> Maybe Region
-> SpacesRequestBuilder
SpacesRequestBuilder
{ $sel:bucket:SpacesRequestBuilder :: Maybe Bucket
bucket = MultipartSession
session MultipartSession
-> Getting (First Bucket) MultipartSession Bucket -> Maybe Bucket
forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s t a b. HasField "bucket" 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 @"bucket"
, $sel:object:SpacesRequestBuilder :: Maybe Object
object = MultipartSession
session MultipartSession
-> Getting (First Object) MultipartSession Object -> Maybe Object
forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s t a b. HasField "object" 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 @"object"
, $sel:method:SpacesRequestBuilder :: Maybe Method
method = Method -> Maybe Method
forall a. a -> Maybe a
Just Method
DELETE
, $sel:body:SpacesRequestBuilder :: Maybe RequestBody
body = Maybe RequestBody
forall a. Maybe a
Nothing
, $sel:overrideRegion:SpacesRequestBuilder :: Maybe Region
overrideRegion = Maybe Region
forall a. Maybe a
Nothing
, $sel:headers:SpacesRequestBuilder :: [Header]
headers = [Header]
forall a. Monoid a => a
mempty
, $sel:subresources:SpacesRequestBuilder :: Maybe Query
subresources = Maybe Query
forall a. Maybe a
Nothing
, $sel:queryString:SpacesRequestBuilder :: Maybe Query
queryString = Query -> Maybe Query
forall a. a -> Maybe a
Just
(Query -> Maybe Query) -> Query -> Maybe Query
forall a b. (a -> b) -> a -> b
$ [(ETag, ETag)] -> Query
forall a. QueryLike a => a -> Query
H.toQuery [ ( ETag
"uploadId" :: Text
, MultipartSession
session MultipartSession -> Getting ETag MultipartSession ETag -> ETag
forall s a. s -> Getting a s a -> a
^. forall s t a b. HasField "uploadID" 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 @"uploadID"
)
]
, Spaces
spaces :: Spaces
$sel:spaces:SpacesRequestBuilder :: Spaces
..
}
consumeResponse :: RawResponse m -> m (ConsumedResponse CancelMultipart)
consumeResponse RawResponse m
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
newtype ListParts = ListParts { ListParts -> MultipartSession
session :: MultipartSession }
deriving ( Int -> ListParts -> ShowS
[ListParts] -> ShowS
ListParts -> String
(Int -> ListParts -> ShowS)
-> (ListParts -> String)
-> ([ListParts] -> ShowS)
-> Show ListParts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListParts] -> ShowS
$cshowList :: [ListParts] -> ShowS
show :: ListParts -> String
$cshow :: ListParts -> String
showsPrec :: Int -> ListParts -> ShowS
$cshowsPrec :: Int -> ListParts -> ShowS
Show, ListParts -> ListParts -> Bool
(ListParts -> ListParts -> Bool)
-> (ListParts -> ListParts -> Bool) -> Eq ListParts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListParts -> ListParts -> Bool
$c/= :: ListParts -> ListParts -> Bool
== :: ListParts -> ListParts -> Bool
$c== :: ListParts -> ListParts -> Bool
Eq, (forall x. ListParts -> Rep ListParts x)
-> (forall x. Rep ListParts x -> ListParts) -> Generic ListParts
forall x. Rep ListParts x -> ListParts
forall x. ListParts -> Rep ListParts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListParts x -> ListParts
$cfrom :: forall x. ListParts -> Rep ListParts x
Generic )
data ListPartsResponse = ListPartsResponse
{ ListPartsResponse -> Bucket
bucket :: Bucket
, ListPartsResponse -> Object
object :: Object
, ListPartsResponse -> ETag
uploadID :: UploadID
, ListPartsResponse -> Seq Part
parts :: Seq Part
, ListPartsResponse -> Int
partMarker :: Int
, ListPartsResponse -> Int
nextPartMarker :: Int
, ListPartsResponse -> Int
maxParts :: Int
, ListPartsResponse -> Bool
isTruncated :: Bool
}
deriving ( Int -> ListPartsResponse -> ShowS
[ListPartsResponse] -> ShowS
ListPartsResponse -> String
(Int -> ListPartsResponse -> ShowS)
-> (ListPartsResponse -> String)
-> ([ListPartsResponse] -> ShowS)
-> Show ListPartsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListPartsResponse] -> ShowS
$cshowList :: [ListPartsResponse] -> ShowS
show :: ListPartsResponse -> String
$cshow :: ListPartsResponse -> String
showsPrec :: Int -> ListPartsResponse -> ShowS
$cshowsPrec :: Int -> ListPartsResponse -> ShowS
Show, ListPartsResponse -> ListPartsResponse -> Bool
(ListPartsResponse -> ListPartsResponse -> Bool)
-> (ListPartsResponse -> ListPartsResponse -> Bool)
-> Eq ListPartsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListPartsResponse -> ListPartsResponse -> Bool
$c/= :: ListPartsResponse -> ListPartsResponse -> Bool
== :: ListPartsResponse -> ListPartsResponse -> Bool
$c== :: ListPartsResponse -> ListPartsResponse -> Bool
Eq, (forall x. ListPartsResponse -> Rep ListPartsResponse x)
-> (forall x. Rep ListPartsResponse x -> ListPartsResponse)
-> Generic ListPartsResponse
forall x. Rep ListPartsResponse x -> ListPartsResponse
forall x. ListPartsResponse -> Rep ListPartsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListPartsResponse x -> ListPartsResponse
$cfrom :: forall x. ListPartsResponse -> Rep ListPartsResponse x
Generic )
instance MonadSpaces m => Action m ListParts where
type (ConsumedResponse ListParts) = ListPartsResponse
buildRequest :: ListParts -> m SpacesRequestBuilder
buildRequest ListParts { MultipartSession
session :: MultipartSession
$sel:session:ListParts :: ListParts -> MultipartSession
.. } = do
Spaces
spaces <- m Spaces
forall r (m :: * -> *). MonadReader r m => m r
ask
SpacesRequestBuilder -> m SpacesRequestBuilder
forall (m :: * -> *) a. Monad m => a -> m a
return SpacesRequestBuilder :: Spaces
-> Maybe RequestBody
-> Maybe Method
-> [Header]
-> Maybe Bucket
-> Maybe Object
-> Maybe Query
-> Maybe Query
-> Maybe Region
-> SpacesRequestBuilder
SpacesRequestBuilder
{ $sel:bucket:SpacesRequestBuilder :: Maybe Bucket
bucket = MultipartSession
session MultipartSession
-> Getting (First Bucket) MultipartSession Bucket -> Maybe Bucket
forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s t a b. HasField "bucket" 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 @"bucket"
, $sel:object:SpacesRequestBuilder :: Maybe Object
object = MultipartSession
session MultipartSession
-> Getting (First Object) MultipartSession Object -> Maybe Object
forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s t a b. HasField "object" 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 @"object"
, $sel:method:SpacesRequestBuilder :: Maybe Method
method = Maybe Method
forall a. Maybe a
Nothing
, $sel:body:SpacesRequestBuilder :: Maybe RequestBody
body = Maybe RequestBody
forall a. Maybe a
Nothing
, $sel:overrideRegion:SpacesRequestBuilder :: Maybe Region
overrideRegion = Maybe Region
forall a. Maybe a
Nothing
, $sel:subresources:SpacesRequestBuilder :: Maybe Query
subresources = Maybe Query
forall a. Maybe a
Nothing
, $sel:headers:SpacesRequestBuilder :: [Header]
headers = [Header]
forall a. Monoid a => a
mempty
, $sel:queryString:SpacesRequestBuilder :: Maybe Query
queryString = Query -> Maybe Query
forall a. a -> Maybe a
Just
(Query -> Maybe Query) -> Query -> Maybe Query
forall a b. (a -> b) -> a -> b
$ [(ETag, ETag)] -> Query
forall a. QueryLike a => a -> Query
H.toQuery [ ( ETag
"uploadId" :: Text
, MultipartSession
session MultipartSession -> Getting ETag MultipartSession ETag -> ETag
forall s a. s -> Getting a s a -> a
^. forall s t a b. HasField "uploadID" 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 @"uploadID"
)
]
, Spaces
spaces :: Spaces
$sel:spaces:SpacesRequestBuilder :: Spaces
..
}
consumeResponse :: RawResponse m -> m (ConsumedResponse ListParts)
consumeResponse RawResponse m
raw = do
Cursor
cursor <- RawResponse m -> m Cursor
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
RawResponse m -> m Cursor
xmlDocCursor RawResponse m
raw
Bucket
bucket <- Cursor -> m Bucket
forall (m :: * -> *). MonadThrow m => Cursor -> m Bucket
bucketP Cursor
cursor
Object
object <- Cursor -> m Object
forall (m :: * -> *). MonadThrow m => Cursor -> m Object
objectP Cursor
cursor
ETag
uploadID <- ClientException -> [ETag] -> m ETag
forall e (f :: * -> *) a.
(Exception e, MonadThrow f) =>
e -> [a] -> f a
X.force (ETag -> ClientException
xmlElemError ETag
"UploadId")
([ETag] -> m ETag) -> [ETag] -> m ETag
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor -> (Cursor -> [ETag]) -> [ETag]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ ETag -> Axis
X.laxElement ETag
"UploadId" Axis -> (Cursor -> [ETag]) -> Cursor -> [ETag]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [ETag]
X.content
Bool
isTruncated <- Cursor -> m Bool
forall (m :: * -> *). MonadThrow m => Cursor -> m Bool
isTruncP Cursor
cursor
Int
maxParts <- ETag -> Cursor -> m Int
forall a (m :: * -> *).
(Num a, MonadThrow m) =>
ETag -> Cursor -> m a
xmlNum ETag
"MaxParts" Cursor
cursor
Seq Part
parts <- [Part] -> Seq Part
forall a. [a] -> Seq a
S.fromList
([Part] -> Seq Part) -> m [Part] -> m (Seq Part)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [m Part] -> m [Part]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Cursor
cursor Cursor -> (Cursor -> [m Part]) -> [m Part]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ ETag -> Axis
X.laxElement ETag
"Part" Axis -> (Cursor -> m Part) -> Cursor -> [m Part]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> m Part
forall (f :: * -> *). MonadThrow f => Cursor -> f Part
partP)
Int
partMarker <- ETag -> Cursor -> m Int
forall a (m :: * -> *).
(Num a, MonadThrow m) =>
ETag -> Cursor -> m a
xmlNum ETag
"PartNumberMarker" Cursor
cursor
Int
nextPartMarker <- ETag -> Cursor -> m Int
forall a (m :: * -> *).
(Num a, MonadThrow m) =>
ETag -> Cursor -> m a
xmlNum ETag
"NextPartNumberMarker" Cursor
cursor
ListPartsResponse -> m ListPartsResponse
forall (m :: * -> *) a. Monad m => a -> m a
return ListPartsResponse :: Bucket
-> Object
-> ETag
-> Seq Part
-> Int
-> Int
-> Int
-> Bool
-> ListPartsResponse
ListPartsResponse { Bool
Int
ETag
Seq Part
Object
Bucket
nextPartMarker :: Int
partMarker :: Int
parts :: Seq Part
maxParts :: Int
isTruncated :: Bool
uploadID :: ETag
object :: Object
bucket :: Bucket
$sel:isTruncated:ListPartsResponse :: Bool
$sel:maxParts:ListPartsResponse :: Int
$sel:nextPartMarker:ListPartsResponse :: Int
$sel:partMarker:ListPartsResponse :: Int
$sel:parts:ListPartsResponse :: Seq Part
$sel:uploadID:ListPartsResponse :: ETag
$sel:object:ListPartsResponse :: Object
$sel:bucket:ListPartsResponse :: Bucket
.. }
where
partP :: Cursor -> f Part
partP Cursor
c = Int -> UTCTime -> ETag -> Int -> Part
Part (Int -> UTCTime -> ETag -> Int -> Part)
-> f Int -> f (UTCTime -> ETag -> Int -> Part)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ETag -> Cursor -> f Int
forall a (m :: * -> *).
(Num a, MonadThrow m) =>
ETag -> Cursor -> m a
xmlNum ETag
"PartNumber" Cursor
c
f (UTCTime -> ETag -> Int -> Part)
-> f UTCTime -> f (ETag -> Int -> Part)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Cursor -> f UTCTime
forall (m :: * -> *). MonadThrow m => Cursor -> m UTCTime
lastModifiedP Cursor
c
f (ETag -> Int -> Part) -> f ETag -> f (Int -> Part)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Cursor -> f ETag
forall (m :: * -> *). MonadThrow m => Cursor -> m ETag
etagP Cursor
c
f (Int -> Part) -> f Int -> f Part
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ETag -> Cursor -> f Int
forall a (m :: * -> *).
(Num a, MonadThrow m) =>
ETag -> Cursor -> m a
xmlNum ETag
"Size" Cursor
c