{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Module      : Network.DO.Spaces.Actions.ListBucket
-- Copyright   : (c) 2021 Rory Tyler Hayford
-- License     : BSD-3-Clause
-- Maintainer  : rory.hayford@protonmail.com
-- Stability   : experimental
-- Portability : GHC
--
module Network.DO.Spaces.Actions.ListBucket
    ( ListBucket(..)
    , ListBucketResponse(..)
    ) where

import           Control.Monad           ( when )
import           Control.Monad.Catch     ( MonadThrow(throwM) )
import           Control.Monad.Extra     ( orM )
import           Control.Monad.Reader    ( MonadReader(ask) )

import           Data.ByteString         ( ByteString )
import qualified Data.ByteString.Char8   as C
import           Data.Coerce             ( coerce )
import           Data.Sequence           ( Seq )
import qualified Data.Sequence           as S
import           Data.Text               ( Text )
import qualified Data.Text.Encoding      as T

import           GHC.Generics            ( Generic )

import           Network.DO.Spaces.Types
import           Network.DO.Spaces.Utils
import qualified Network.HTTP.Types      as H

import qualified Text.XML.Cursor         as X
import           Text.XML.Cursor         ( ($/), (&/), (&|) )

import           Web.HttpApiData         ( ToHttpApiData(toQueryParam) )

-- | List the contents ('Object's) of a 'Bucket'
data ListBucket = ListBucket
    { ListBucket -> Bucket
bucket    :: Bucket
    , ListBucket -> Maybe Char
delimiter :: Maybe Char -- ^ Character used to group keys
    , ListBucket -> Maybe Object
marker    :: Maybe Object
      -- ^ The 'Object' to start with when listing the bucket's contents
    , ListBucket -> Maybe Int
maxKeys   :: Maybe Int
      -- ^ Max number of 'Object's to return, between 0 and 1,000 (inclusive)
    , ListBucket -> Maybe Text
prefix    :: Maybe Text
      -- ^ String value to group keys. Only objects whose names begin with the
      -- prefix are returned
    }
    deriving stock ( Int -> ListBucket -> ShowS
[ListBucket] -> ShowS
ListBucket -> String
(Int -> ListBucket -> ShowS)
-> (ListBucket -> String)
-> ([ListBucket] -> ShowS)
-> Show ListBucket
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListBucket] -> ShowS
$cshowList :: [ListBucket] -> ShowS
show :: ListBucket -> String
$cshow :: ListBucket -> String
showsPrec :: Int -> ListBucket -> ShowS
$cshowsPrec :: Int -> ListBucket -> ShowS
Show, ListBucket -> ListBucket -> Bool
(ListBucket -> ListBucket -> Bool)
-> (ListBucket -> ListBucket -> Bool) -> Eq ListBucket
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListBucket -> ListBucket -> Bool
$c/= :: ListBucket -> ListBucket -> Bool
== :: ListBucket -> ListBucket -> Bool
$c== :: ListBucket -> ListBucket -> Bool
Eq, (forall x. ListBucket -> Rep ListBucket x)
-> (forall x. Rep ListBucket x -> ListBucket) -> Generic ListBucket
forall x. Rep ListBucket x -> ListBucket
forall x. ListBucket -> Rep ListBucket x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListBucket x -> ListBucket
$cfrom :: forall x. ListBucket -> Rep ListBucket x
Generic )

data ListBucketResponse = ListBucketResponse
    { ListBucketResponse -> Bucket
bucket      :: Bucket
    , ListBucketResponse -> Maybe Text
prefix      :: Maybe Text -- ^ The 'Object' prefix, if supplied as a query param
    , ListBucketResponse -> Maybe Object
marker      :: Maybe Object
      -- ^ An 'Object' indicating where the list of 'Object's begin; 'Nothing'
      -- denotes the beginning of the list
    , ListBucketResponse -> Maybe Object
nextMarker  :: Maybe Object
      -- ^ The 'Object' that should be used as the @marker@ query param in
      -- subsequent requests
    , ListBucketResponse -> Int
maxKeys     :: Int
      -- ^ Maximum number of 'ObjectInfo's to include; based on request parameter
      -- of the same name
    , ListBucketResponse -> Bool
isTruncated :: Bool
      -- ^ Indicates whether the response contains all possible 'Object's
    , ListBucketResponse -> Seq ObjectInfo
objects     :: Seq ObjectInfo
    }
    deriving stock ( Int -> ListBucketResponse -> ShowS
[ListBucketResponse] -> ShowS
ListBucketResponse -> String
(Int -> ListBucketResponse -> ShowS)
-> (ListBucketResponse -> String)
-> ([ListBucketResponse] -> ShowS)
-> Show ListBucketResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListBucketResponse] -> ShowS
$cshowList :: [ListBucketResponse] -> ShowS
show :: ListBucketResponse -> String
$cshow :: ListBucketResponse -> String
showsPrec :: Int -> ListBucketResponse -> ShowS
$cshowsPrec :: Int -> ListBucketResponse -> ShowS
Show, ListBucketResponse -> ListBucketResponse -> Bool
(ListBucketResponse -> ListBucketResponse -> Bool)
-> (ListBucketResponse -> ListBucketResponse -> Bool)
-> Eq ListBucketResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListBucketResponse -> ListBucketResponse -> Bool
$c/= :: ListBucketResponse -> ListBucketResponse -> Bool
== :: ListBucketResponse -> ListBucketResponse -> Bool
$c== :: ListBucketResponse -> ListBucketResponse -> Bool
Eq, (forall x. ListBucketResponse -> Rep ListBucketResponse x)
-> (forall x. Rep ListBucketResponse x -> ListBucketResponse)
-> Generic ListBucketResponse
forall x. Rep ListBucketResponse x -> ListBucketResponse
forall x. ListBucketResponse -> Rep ListBucketResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListBucketResponse x -> ListBucketResponse
$cfrom :: forall x. ListBucketResponse -> Rep ListBucketResponse x
Generic )

instance MonadSpaces m => Action m ListBucket where
    type ConsumedResponse ListBucket = ListBucketResponse

    buildRequest :: ListBucket -> m SpacesRequestBuilder
buildRequest ListBucket { Maybe Char
Maybe Int
Maybe Text
Maybe Object
Bucket
prefix :: Maybe Text
maxKeys :: Maybe Int
marker :: Maybe Object
delimiter :: Maybe Char
bucket :: Bucket
$sel:prefix:ListBucket :: ListBucket -> Maybe Text
$sel:maxKeys:ListBucket :: ListBucket -> Maybe Int
$sel:marker:ListBucket :: ListBucket -> Maybe Object
$sel:delimiter:ListBucket :: ListBucket -> Maybe Char
$sel:bucket:ListBucket :: ListBucket -> Bucket
.. } = do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== [Maybe Bool] -> Maybe Bool
forall (m :: * -> *). Monad m => [m Bool] -> m Bool
orM [ (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) (Int -> Bool) -> Maybe Int -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
maxKeys, (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1000) (Int -> Bool) -> Maybe Int -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
maxKeys ])
            (m () -> m ())
-> (ClientException -> m ()) -> ClientException -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientException -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
            (ClientException -> m ()) -> ClientException -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> ClientException
InvalidRequest Text
"ListBucket: maxKeys must be >= 0 && <= 1000"
        Spaces
spaces <- m Spaces
forall r (m :: * -> *). MonadReader r m => m r
ask

        SpacesRequestBuilder -> m SpacesRequestBuilder
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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:body:SpacesRequestBuilder :: Maybe RequestBody
body           = Maybe RequestBody
forall a. Maybe a
Nothing
             , $sel:object:SpacesRequestBuilder :: Maybe Object
object         = Maybe Object
forall a. Maybe a
Nothing
             , $sel:method:SpacesRequestBuilder :: Maybe Method
method         = Maybe Method
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:overrideRegion:SpacesRequestBuilder :: Maybe Region
overrideRegion = Maybe Region
forall a. Maybe a
Nothing
             , Maybe Query
Spaces
$sel:queryString:SpacesRequestBuilder :: Maybe Query
$sel:spaces:SpacesRequestBuilder :: Spaces
queryString :: Maybe Query
spaces :: Spaces
..
             }
      where
        queryString :: 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
$ [Maybe (ByteString, ByteString)] -> Query
forall a. QueryLike a => a -> Query
H.toQuery [ (ByteString
"delimiter" :: ByteString, ) (ByteString -> (ByteString, ByteString))
-> (Char -> ByteString) -> Char -> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString
C.singleton
                          (Char -> (ByteString, ByteString))
-> Maybe Char -> Maybe (ByteString, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Char
delimiter
                        , (ByteString
"marker", ) (ByteString -> (ByteString, ByteString))
-> (Object -> ByteString) -> Object -> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> (Object -> Text) -> Object -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam
                          (Object -> (ByteString, ByteString))
-> Maybe Object -> Maybe (ByteString, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Object
marker
                        , (ByteString
"max-keys", ) (ByteString -> (ByteString, ByteString))
-> (Int -> ByteString) -> Int -> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString
forall a. Show a => a -> ByteString
bshow (Int -> (ByteString, ByteString))
-> Maybe Int -> Maybe (ByteString, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
maxKeys
                        , (ByteString
"prefix", ) (ByteString -> (ByteString, ByteString))
-> (Text -> ByteString) -> Text -> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> (ByteString, ByteString))
-> Maybe Text -> Maybe (ByteString, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
prefix
                        ]

    consumeResponse :: RawResponse m -> m (ConsumedResponse ListBucket)
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 <- ClientException -> [Bucket] -> m Bucket
forall e (f :: * -> *) a.
(Exception e, MonadThrow f) =>
e -> [a] -> f a
X.force (Text -> ClientException
xmlElemError Text
"Name")
            ([Bucket] -> m Bucket) -> [Bucket] -> m Bucket
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor -> (Cursor -> [Bucket]) -> [Bucket]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
X.laxElement Text
"Name" 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
        Int
maxKeys <- Text -> Cursor -> m Int
forall a (m :: * -> *).
(Num a, MonadThrow m) =>
Text -> Cursor -> m a
xmlNum Text
"MaxKeys" Cursor
cursor
        Bool
isTruncated <- Cursor -> m Bool
forall (m :: * -> *). MonadThrow m => Cursor -> m Bool
isTruncP Cursor
cursor
        Seq ObjectInfo
objects <- [ObjectInfo] -> Seq ObjectInfo
forall a. [a] -> Seq a
S.fromList
            ([ObjectInfo] -> Seq ObjectInfo)
-> m [ObjectInfo] -> m (Seq ObjectInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [m ObjectInfo] -> m [ObjectInfo]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Cursor
cursor Cursor -> (Cursor -> [m ObjectInfo]) -> [m ObjectInfo]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
X.laxElement Text
"Contents" Axis -> (Cursor -> m ObjectInfo) -> Cursor -> [m ObjectInfo]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> m ObjectInfo
forall (m :: * -> *). MonadThrow m => Cursor -> m ObjectInfo
objectInfoP)
        let prefix :: Maybe Text
prefix     = Cursor -> Text -> Maybe Text
xmlMaybeElem Cursor
cursor Text
"Prefix"
            marker :: Maybe Object
marker     = Text -> Object
coerce (Text -> Object) -> Maybe Text -> Maybe Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cursor -> Text -> Maybe Text
xmlMaybeElem Cursor
cursor Text
"Marker"
            nextMarker :: Maybe Object
nextMarker = Text -> Object
coerce (Text -> Object) -> Maybe Text -> Maybe Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cursor -> Text -> Maybe Text
xmlMaybeElem Cursor
cursor Text
"NextMarker"
        ListBucketResponse -> m ListBucketResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListBucketResponse :: Bucket
-> Maybe Text
-> Maybe Object
-> Maybe Object
-> Int
-> Bool
-> Seq ObjectInfo
-> ListBucketResponse
ListBucketResponse { Bool
Int
Maybe Text
Maybe Object
Seq ObjectInfo
Bucket
nextMarker :: Maybe Object
marker :: Maybe Object
prefix :: Maybe Text
objects :: Seq ObjectInfo
isTruncated :: Bool
maxKeys :: Int
bucket :: Bucket
$sel:objects:ListBucketResponse :: Seq ObjectInfo
$sel:isTruncated:ListBucketResponse :: Bool
$sel:maxKeys:ListBucketResponse :: Int
$sel:nextMarker:ListBucketResponse :: Maybe Object
$sel:marker:ListBucketResponse :: Maybe Object
$sel:prefix:ListBucketResponse :: Maybe Text
$sel:bucket:ListBucketResponse :: Bucket
.. }
      where
        objectInfoP :: Cursor -> m ObjectInfo
objectInfoP Cursor
c = do
            Object
object <- 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
            UTCTime
lastModified <- Cursor -> m UTCTime
forall (m :: * -> *). MonadThrow m => Cursor -> m UTCTime
lastModifiedP Cursor
c
            Text
etag <- Cursor -> m Text
forall (m :: * -> *). MonadThrow m => Cursor -> m Text
etagP Cursor
c
            Int
size <- ClientException -> [m Int] -> m Int
forall e (f :: * -> *) a.
(Exception e, MonadThrow f) =>
e -> [f a] -> f a
X.forceM (Text -> ClientException
xmlElemError Text
"Size")
                ([m Int] -> m Int) -> [m Int] -> m Int
forall a b. (a -> b) -> a -> b
$ Cursor
c Cursor -> (Cursor -> [m Int]) -> [m Int]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
X.laxElement Text
"Size" Axis -> (Cursor -> [m Int]) -> Cursor -> [m Int]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
X.content (Cursor -> [Text]) -> (Text -> m Int) -> Cursor -> [m Int]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Text -> m Int
forall (m :: * -> *) a. (MonadThrow m, Num a) => Text -> m a
xmlInt
            Owner
owner <- 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
c 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
            ObjectInfo -> m ObjectInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure ObjectInfo :: Object -> UTCTime -> Text -> Int -> Owner -> ObjectInfo
ObjectInfo { Int
Text
UTCTime
Owner
Object
$sel:owner:ObjectInfo :: Owner
$sel:size:ObjectInfo :: Int
$sel:etag:ObjectInfo :: Text
$sel:lastModified:ObjectInfo :: UTCTime
$sel:object:ObjectInfo :: Object
owner :: Owner
size :: Int
etag :: Text
lastModified :: UTCTime
object :: Object
.. }