{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module      : Network.DO.Spaces
-- Copyright   : (c) 2021 Rory Tyler Hayford
-- License     : BSD-3-Clause
-- Maintainer  : rory.hayford@protonmail.com
-- Stability   : experimental
-- Portability : GHC
--
-- Interacting with DigitalOcean's Spaces API, a (largely) s3-compatible object
-- storage platform. This module exports actions to create a 'Spaces' client
-- configuration as well as several convenience actions. Most of the transactions
-- exposed through the Spaces REST API are supported here, including CRUD operations
-- on buckets and objects, bucket CORS configuration, and manipulating ACLs.
--
-- See the README in this repository for more information on using this library
--
module Network.DO.Spaces
    ( runSpaces
    , newSpaces
      -- * Convenience actions
      -- $conv
      -- ** Object operations
    , uploadObject
    , multipartObject
    , uploadFile
    , getObject
    , getObjectSinkFile
    , getObjectInfo
    , copyObject
    , copyObjectWithin
    , overwriteObject
    , deleteObject
    , getObjectACLs
    , setObjectACLs
      -- ** Bucket operations
    , createBucket
    , deleteBucket
    , getBucketLocation
    , listAllBuckets
    , listBucket
    , listBucketGrouped
    , listBucketRec
    , getBucketCORS
    , deleteBucketCORS
    , setBucketCORS
    , getBucketACLs
    , setBucketACLs
    , getBucketLifecycleRules
    , setBucketLifecycleRules
    , deleteBucketLifecycleRules
      -- * Re-exports
    , Spaces
    , SpacesResponse
    , SpacesMetadata
    , MonadSpaces
    , Bucket
    , mkBucket
    , Object
    , mkObject
    , Region(..)
    , AccessKey(..)
    , SecretKey(..)
    , CredentialSource(..)
    , Profile
    , CORSRule
    , mkCORSRule
    , Grant(..)
    , Grantee(..)
    , Permission(..)
    , LifecycleID
    , mkLifecycleID
    , SpacesException
    , ClientException(..)
    , APIException(..)
    ) where

import           Conduit
                 ( (.|)
                 , await
                 , decodeUtf8C
                 , runConduit
                 , runConduitRes
                 , sinkFileCautious
                 , sinkLazy
                 , sourceFile
                 , sourceLazy
                 , withSourceFile
                 , yield
                 )

import           Control.Monad               ( void )
import           Control.Monad.Catch         ( MonadThrow(throwM) )
import           Control.Monad.Catch.Pure    ( MonadCatch(catch) )
import           Control.Monad.IO.Class      ( MonadIO(liftIO) )
import           Control.Monad.Reader.Class  ( ask )

import           Data.Bifunctor              ( Bifunctor(bimap) )
import           Data.Bool                   ( bool )
import qualified Data.ByteString.Char8       as C
import qualified Data.ByteString.Lazy        as LB
import           Data.Coerce                 ( coerce )
import           Data.Conduit.Binary         ( sinkLbs )
import           Data.Conduit.List           ( consume )
import           Data.Foldable               ( asum )
import           Data.Generics.Product       ( HasField(field) )
import qualified Data.Ini.Config             as I
import           Data.Maybe                  ( fromMaybe )
import           Data.Sequence               ( Seq )
import qualified Data.Text                   as T
import           Data.Text                   ( Text )
import qualified Data.Text.Encoding          as T
import qualified Data.Text.Lazy              as LT

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

import           Network.DO.Spaces.Actions
import           Network.DO.Spaces.Types
import           Network.DO.Spaces.Utils     ( defaultUploadHeaders )
import           Network.HTTP.Client.Conduit ( RequestBody(RequestBodyLBS) )
import           Network.HTTP.Client.TLS     ( getGlobalManager )
import           Network.Mime
                 ( MimeType
                 , defaultMimeMap
                 , defaultMimeType
                 , mimeByExt
                 )

import           System.Environment          ( lookupEnv )
import qualified System.FilePath             as F

-- | Perform a transaction using your 'Spaces' client configuration. Note that
-- this does /not/ perform any exception handling; if caught at the lower level,
-- exceptions are generally re-thrown as 'SpacesException's
--
-- To run a 'SpacesT' action with arguments in the opposite order, you can use
-- 'runSpacesT' directly
runSpaces :: Spaces -> SpacesT m a -> m a
runSpaces :: Spaces -> SpacesT m a -> m a
runSpaces = (SpacesT m a -> Spaces -> m a) -> Spaces -> SpacesT m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip SpacesT m a -> Spaces -> m a
forall (m :: * -> *) a. SpacesT m a -> Spaces -> m a
runSpacesT

-- | Create a new 'Spaces' in a given 'Region' while specifying a method to retrieve
-- your credentials:
--
-- 'FromFile' expects a configuration file in the same format as AWS credentials
-- files, with the same field names. For example:
--
-- > [default]
-- > aws_access_key_id=AKIAIOSFODNN7EXAMPLE
-- > aws_secret_access_key=wJalrXUtnFEMI/K7MDENG/bPxRfiCYEXAMPLEKEY
--
-- 'FromEnv' will look up the following environment variables to find your
-- keys:  @AWS_ACCESS_KEY_ID@ , @SPACES_ACCESS_KEY_ID@ , @SPACES_ACCESS_KEY@
-- for the 'AccessKey', and  @AWS_SECRET_ACCESS_KEY@ , @SPACES_SECRET_ACCESS_KEY@
-- , and @SPACES_SECRET_KEY@ for your 'SecretKey'. Alternatively, you can directly
-- specify the environment variables to consult.
--
-- You can also choose to provide both keys yourself with 'Explicit'
--
newSpaces
    :: (MonadThrow m, MonadIO m) => Region -> CredentialSource -> m Spaces
newSpaces :: Region -> CredentialSource -> m Spaces
newSpaces Region
region CredentialSource
cs = do
    Manager
manager <- IO Manager -> m Manager
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Manager
getGlobalManager
    (AccessKey
accessKey, SecretKey
secretKey) <- IO (AccessKey, SecretKey) -> m (AccessKey, SecretKey)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (AccessKey, SecretKey) -> m (AccessKey, SecretKey))
-> IO (AccessKey, SecretKey) -> m (AccessKey, SecretKey)
forall a b. (a -> b) -> a -> b
$ CredentialSource -> IO (AccessKey, SecretKey)
source CredentialSource
cs
    Spaces -> m Spaces
forall (m :: * -> *) a. Monad m => a -> m a
return Spaces :: AccessKey -> SecretKey -> Region -> Manager -> Spaces
Spaces { Manager
SecretKey
AccessKey
Region
$sel:manager:Spaces :: Manager
$sel:region:Spaces :: Region
$sel:secretKey:Spaces :: SecretKey
$sel:accessKey:Spaces :: AccessKey
secretKey :: SecretKey
accessKey :: AccessKey
manager :: Manager
region :: Region
.. }
  where
    source :: CredentialSource -> IO (AccessKey, SecretKey)
source (Explicit AccessKey
ak SecretKey
sk) = (AccessKey, SecretKey) -> IO (AccessKey, SecretKey)
forall (m :: * -> *) a. Monad m => a -> m a
return (AccessKey
ak, SecretKey
sk)
    source (FromEnv (Just (Text
akEnv, Text
skEnv))) =
        (Maybe String, Maybe String) -> IO (AccessKey, SecretKey)
ensureKeys ((Maybe String, Maybe String) -> IO (AccessKey, SecretKey))
-> IO (Maybe String, Maybe String) -> IO (AccessKey, SecretKey)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (,) (Maybe String -> Maybe String -> (Maybe String, Maybe String))
-> IO (Maybe String)
-> IO (Maybe String -> (Maybe String, Maybe String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> IO (Maybe String)
lookupKey Text
akEnv IO (Maybe String -> (Maybe String, Maybe String))
-> IO (Maybe String) -> IO (Maybe String, Maybe String)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> IO (Maybe String)
lookupKey Text
skEnv
    source (FromEnv Maybe (Text, Text)
Nothing) = do
        Maybe String
ak <- [String] -> IO (Maybe String)
forall (t :: * -> *).
Traversable t =>
t String -> IO (Maybe String)
lookupKeys [ String
"AWS_ACCESS_KEY_ID"
                         , String
"SPACES_ACCESS_KEY_ID"
                         , String
"SPACES_ACCESS_KEY"
                         ]
        Maybe String
sk <- [String] -> IO (Maybe String)
forall (t :: * -> *).
Traversable t =>
t String -> IO (Maybe String)
lookupKeys [ String
"AWS_SECRET_ACCESS_KEY"
                         , String
"SPACES_SECRET_ACCESS_KEY"
                         , String
"SPACES_SECRET_KEY"
                         ]
        (Maybe String, Maybe String) -> IO (AccessKey, SecretKey)
ensureKeys (Maybe String
ak, Maybe String
sk)

    source (FromFile String
fp Maybe Text
profile) = do
        Text
contents <- Text -> Text
LT.toStrict
            (Text -> Text) -> IO Text -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT () Void (ResourceT IO) Text -> IO Text
forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes (String -> ConduitT () ByteString (ResourceT IO) ()
forall (m :: * -> *) i.
MonadResource m =>
String -> ConduitT i ByteString m ()
sourceFile String
fp ConduitT () ByteString (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) Text
-> ConduitT () Void (ResourceT IO) Text
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT ByteString Text (ResourceT IO) ()
forall (m :: * -> *). MonadThrow m => ConduitT ByteString Text m ()
decodeUtf8C ConduitT ByteString Text (ResourceT IO) ()
-> ConduitM Text Void (ResourceT IO) Text
-> ConduitM ByteString Void (ResourceT IO) Text
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM Text Void (ResourceT IO) Text
forall (m :: * -> *) lazy strict o.
(Monad m, LazySequence lazy strict) =>
ConduitT strict o m lazy
sinkLazy)
        case Text -> IniParser (Text, Text) -> Either String (Text, Text)
forall a. Text -> IniParser a -> Either String a
I.parseIniFile Text
contents IniParser (Text, Text)
parseConf of
            Left String
_   ->
                ClientException -> IO (AccessKey, SecretKey)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientException -> IO (AccessKey, SecretKey))
-> ClientException -> IO (AccessKey, SecretKey)
forall a b. (a -> b) -> a -> b
$ Text -> ClientException
ConfigurationError Text
"Failed to read credentials file"
            Right (Text, Text)
ks -> (AccessKey, SecretKey) -> IO (AccessKey, SecretKey)
forall (m :: * -> *) a. Monad m => a -> m a
return
                ((AccessKey, SecretKey) -> IO (AccessKey, SecretKey))
-> (AccessKey, SecretKey) -> IO (AccessKey, SecretKey)
forall a b. (a -> b) -> a -> b
$ (Text -> AccessKey)
-> (Text -> SecretKey) -> (Text, Text) -> (AccessKey, SecretKey)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (ByteString -> AccessKey
coerce (ByteString -> AccessKey)
-> (Text -> ByteString) -> Text -> AccessKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8) (ByteString -> SecretKey
coerce (ByteString -> SecretKey)
-> (Text -> ByteString) -> Text -> SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8) (Text, Text)
ks
      where
        parseConf :: IniParser (Text, Text)
parseConf = Text -> SectionParser (Text, Text) -> IniParser (Text, Text)
forall a. Text -> SectionParser a -> IniParser a
I.section (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"default" Maybe Text
profile)
            (SectionParser (Text, Text) -> IniParser (Text, Text))
-> SectionParser (Text, Text) -> IniParser (Text, Text)
forall a b. (a -> b) -> a -> b
$ (,) (Text -> Text -> (Text, Text))
-> SectionParser Text -> SectionParser (Text -> (Text, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> SectionParser Text
I.field Text
"aws_access_key_id"
            SectionParser (Text -> (Text, Text))
-> SectionParser Text -> SectionParser (Text, Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> SectionParser Text
I.field Text
"aws_secret_access_key"

    throwMissingKeys :: Text -> m a
throwMissingKeys Text
k = ClientException -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ClientException -> m a)
-> (Text -> ClientException) -> Text -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ClientException
ConfigurationError (Text -> m a) -> Text -> m a
forall a b. (a -> b) -> a -> b
$ Text
"Missing " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k

    lookupKeys :: t String -> IO (Maybe String)
lookupKeys t String
xs = t (Maybe String) -> Maybe String
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum (t (Maybe String) -> Maybe String)
-> IO (t (Maybe String)) -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t (IO (Maybe String)) -> IO (t (Maybe String))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (String -> IO (Maybe String)
lookupEnv (String -> IO (Maybe String)) -> t String -> t (IO (Maybe String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t String
xs)

    lookupKey :: Text -> IO (Maybe String)
lookupKey = String -> IO (Maybe String)
lookupEnv (String -> IO (Maybe String))
-> (Text -> String) -> Text -> IO (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

    ensureKeys :: (Maybe String, Maybe String) -> IO (AccessKey, SecretKey)
ensureKeys = \case
        (Just String
a, Just String
s) -> (AccessKey, SecretKey) -> IO (AccessKey, SecretKey)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ByteString -> AccessKey) -> String -> AccessKey
forall c. (ByteString -> c) -> String -> c
mkKey ByteString -> AccessKey
AccessKey String
a, (ByteString -> SecretKey) -> String -> SecretKey
forall c. (ByteString -> c) -> String -> c
mkKey ByteString -> SecretKey
SecretKey String
s)
        (Just String
_, Maybe String
_)      -> Text -> IO (AccessKey, SecretKey)
forall (m :: * -> *) a. MonadThrow m => Text -> m a
throwMissingKeys Text
"secret key"
        (Maybe String
_, Just String
_)      -> Text -> IO (AccessKey, SecretKey)
forall (m :: * -> *) a. MonadThrow m => Text -> m a
throwMissingKeys Text
"access key"
        (Maybe String
_, Maybe String
_)           -> Text -> IO (AccessKey, SecretKey)
forall (m :: * -> *) a. MonadThrow m => Text -> m a
throwMissingKeys Text
"secret and access keys"

    mkKey :: (ByteString -> c) -> String -> c
mkKey ByteString -> c
f = ByteString -> c
f (ByteString -> c) -> (String -> ByteString) -> String -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
C.pack

-- | Upload an 'Object' within a single request
uploadObject :: MonadSpaces m
             => Maybe MimeType
             -> Bucket
             -> Object
             -> BodyBS m
             -> m (SpacesResponse UploadObject)
uploadObject :: Maybe ByteString
-> Bucket -> Object -> BodyBS m -> m (SpacesResponse UploadObject)
uploadObject Maybe ByteString
contentType Bucket
bucket Object
object BodyBS m
rbody = do
    RequestBody
body <- ByteString -> RequestBody
RequestBodyLBS (ByteString -> RequestBody) -> m ByteString -> m RequestBody
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT () Void m ByteString -> m ByteString
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (BodyBS m
rbody BodyBS m
-> ConduitM ByteString Void m ByteString
-> ConduitT () Void m ByteString
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM ByteString Void m ByteString
forall (m :: * -> *) o.
Monad m =>
ConduitT ByteString o m ByteString
sinkLbs)
    WithMetadata -> UploadObject -> m (SpacesResponse UploadObject)
forall a (m :: * -> *).
(MonadSpaces m, Action m a) =>
WithMetadata -> a -> m (SpacesResponse a)
runAction WithMetadata
KeepMetadata
              UploadObject :: Bucket
-> Object
-> RequestBody
-> UploadHeaders
-> Maybe ByteString
-> UploadObject
UploadObject { $sel:optionalHeaders:UploadObject :: UploadHeaders
optionalHeaders = UploadHeaders
defaultUploadHeaders, Maybe ByteString
RequestBody
Object
Bucket
$sel:contentType:UploadObject :: Maybe ByteString
$sel:body:UploadObject :: RequestBody
$sel:object:UploadObject :: Object
$sel:bucket:UploadObject :: Bucket
body :: RequestBody
object :: Object
bucket :: Bucket
contentType :: Maybe ByteString
.. }

-- | Initiate and complete a multipart upload, using default 'UploadHeaders'.
-- If a 'SpacesException' is thrown while performing the transaction, an attempt
-- will be made to runSpaces a 'CancelMultipart' request, and the exception will be
-- rethrown
multipartObject
    :: MonadSpaces m
    => Maybe MimeType
    -> Bucket
    -> Object
    -> Int
    -> BodyBS m
    -> m (SpacesResponse CompleteMultipart)
multipartObject :: Maybe ByteString
-> Bucket
-> Object
-> Int
-> BodyBS m
-> m (SpacesResponse CompleteMultipart)
multipartObject Maybe ByteString
contentType Bucket
bucket Object
object Int
size BodyBS m
body
    | Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
5242880 = ClientException -> m (SpacesResponse CompleteMultipart)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
        (ClientException -> m (SpacesResponse CompleteMultipart))
-> ClientException -> m (SpacesResponse CompleteMultipart)
forall a b. (a -> b) -> a -> b
$ Text -> ClientException
InvalidRequest Text
"multipartObject: Chunk size must be greater than/equal to 5MB"
    | Bool
otherwise = do
        MultipartSession
session <- m (SpacesResponse BeginMultipart)
beginMultipart m (SpacesResponse BeginMultipart)
-> (SpacesResponse BeginMultipart -> MultipartSession)
-> m MultipartSession
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (SpacesResponse BeginMultipart
-> Getting
     MultipartSession (SpacesResponse BeginMultipart) MultipartSession
-> MultipartSession
forall s a. s -> Getting a s a -> a
^. forall s t a b. HasField "result" 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 @"result" ((BeginMultipartResponse
  -> Const MultipartSession BeginMultipartResponse)
 -> SpacesResponse BeginMultipart
 -> Const MultipartSession (SpacesResponse BeginMultipart))
-> ((MultipartSession -> Const MultipartSession MultipartSession)
    -> BeginMultipartResponse
    -> Const MultipartSession BeginMultipartResponse)
-> Getting
     MultipartSession (SpacesResponse BeginMultipart) MultipartSession
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. HasField "session" 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 @"session")
        m (SpacesResponse CompleteMultipart)
-> (SpacesException -> m (SpacesResponse CompleteMultipart))
-> m (SpacesResponse CompleteMultipart)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch @_ @SpacesException (MultipartSession -> m (SpacesResponse CompleteMultipart)
run MultipartSession
session) ((SpacesException -> m (SpacesResponse CompleteMultipart))
 -> m (SpacesResponse CompleteMultipart))
-> (SpacesException -> m (SpacesResponse CompleteMultipart))
-> m (SpacesResponse CompleteMultipart)
forall a b. (a -> b) -> a -> b
$ \SpacesException
e -> do
            m (SpacesResponse CancelMultipart) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (SpacesResponse CancelMultipart) -> m ())
-> (CancelMultipart -> m (SpacesResponse CancelMultipart))
-> CancelMultipart
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithMetadata
-> CancelMultipart -> m (SpacesResponse CancelMultipart)
forall a (m :: * -> *).
(MonadSpaces m, Action m a) =>
WithMetadata -> a -> m (SpacesResponse a)
runAction WithMetadata
NoMetadata (CancelMultipart -> m ()) -> CancelMultipart -> m ()
forall a b. (a -> b) -> a -> b
$ MultipartSession -> CancelMultipart
CancelMultipart MultipartSession
session
            SpacesException -> m (SpacesResponse CompleteMultipart)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SpacesException
e
  where
    run :: MultipartSession -> m (SpacesResponse CompleteMultipart)
run MultipartSession
session = MultipartSession -> [Text] -> m (SpacesResponse CompleteMultipart)
forall (m :: * -> *).
(MonadReader Spaces m, MonadUnliftIO m, MonadCatch m) =>
MultipartSession -> [Text] -> m (SpacesResponse CompleteMultipart)
completeMultipart MultipartSession
session
        ([Text] -> m (SpacesResponse CompleteMultipart))
-> m [Text] -> m (SpacesResponse CompleteMultipart)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ConduitT () Void m [Text] -> m [Text]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (BodyBS m
body BodyBS m
-> ConduitM ByteString Void m [Text] -> ConduitT () Void m [Text]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT ByteString ByteString m ()
inChunks ConduitT ByteString ByteString m ()
-> ConduitM ByteString Void m [Text]
-> ConduitM ByteString Void m [Text]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| MultipartSession -> ConduitT ByteString Text m ()
forall (m :: * -> *).
(MonadIO m, MonadReader Spaces m) =>
MultipartSession -> ConduitT ByteString Text m ()
putPart MultipartSession
session ConduitT ByteString Text m ()
-> ConduitM Text Void m [Text] -> ConduitM ByteString Void m [Text]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM Text Void m [Text]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
consume)

    beginMultipart :: m (SpacesResponse BeginMultipart)
beginMultipart = WithMetadata -> BeginMultipart -> m (SpacesResponse BeginMultipart)
forall a (m :: * -> *).
(MonadSpaces m, Action m a) =>
WithMetadata -> a -> m (SpacesResponse a)
runAction WithMetadata
NoMetadata
                               BeginMultipart :: Bucket
-> Object -> UploadHeaders -> Maybe ByteString -> BeginMultipart
BeginMultipart
                               { $sel:optionalHeaders:BeginMultipart :: UploadHeaders
optionalHeaders = UploadHeaders
defaultUploadHeaders, Maybe ByteString
Object
Bucket
$sel:contentType:BeginMultipart :: Maybe ByteString
$sel:object:BeginMultipart :: Object
$sel:bucket:BeginMultipart :: Bucket
object :: Object
bucket :: Bucket
contentType :: Maybe ByteString
.. }

    completeMultipart :: MultipartSession -> [Text] -> m (SpacesResponse CompleteMultipart)
completeMultipart MultipartSession
session [Text]
tags = WithMetadata
-> CompleteMultipart -> m (SpacesResponse CompleteMultipart)
forall a (m :: * -> *).
(MonadSpaces m, Action m a) =>
WithMetadata -> a -> m (SpacesResponse a)
runAction WithMetadata
KeepMetadata
        (CompleteMultipart -> m (SpacesResponse CompleteMultipart))
-> CompleteMultipart -> m (SpacesResponse CompleteMultipart)
forall a b. (a -> b) -> a -> b
$ MultipartSession -> [(Int, Text)] -> CompleteMultipart
CompleteMultipart MultipartSession
session ([Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ Int
1 .. ] [Text]
tags)

    putPart :: MultipartSession -> ConduitT ByteString Text m ()
putPart MultipartSession
session = Int -> ConduitT ByteString Text m ()
forall (m :: * -> *).
(MonadIO m, MonadReader Spaces m) =>
Int -> ConduitT ByteString Text m ()
go Int
1
      where
        go :: Int -> ConduitT ByteString Text m ()
go Int
n = ConduitT ByteString Text m (Maybe ByteString)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await ConduitT ByteString Text m (Maybe ByteString)
-> (Maybe ByteString -> ConduitT ByteString Text m ())
-> ConduitT ByteString Text m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe ByteString
Nothing -> () -> ConduitT ByteString Text m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just ByteString
v  -> do
                Spaces
spaces <- ConduitT ByteString Text m Spaces
forall r (m :: * -> *). MonadReader r m => m r
ask
                Text
etag <- IO Text -> ConduitT ByteString Text m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
                    (IO Text -> ConduitT ByteString Text m Text)
-> IO Text -> ConduitT ByteString Text m Text
forall a b. (a -> b) -> a -> b
$ Spaces
-> SpacesT IO (SpacesResponse UploadPart)
-> IO (SpacesResponse UploadPart)
forall (m :: * -> *) a. Spaces -> SpacesT m a -> m a
runSpaces Spaces
spaces
                                (WithMetadata
-> UploadPart -> SpacesT IO (SpacesResponse UploadPart)
forall a (m :: * -> *).
(MonadSpaces m, Action m a) =>
WithMetadata -> a -> m (SpacesResponse a)
runAction WithMetadata
NoMetadata
                                 (UploadPart -> SpacesT IO (SpacesResponse UploadPart))
-> UploadPart -> SpacesT IO (SpacesResponse UploadPart)
forall a b. (a -> b) -> a -> b
$ MultipartSession -> Int -> RequestBody -> UploadPart
UploadPart MultipartSession
session Int
n (ByteString -> RequestBody
RequestBodyLBS ByteString
v))
                    IO (SpacesResponse UploadPart)
-> (SpacesResponse UploadPart -> Text) -> IO Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (SpacesResponse UploadPart
-> Getting Text (SpacesResponse UploadPart) Text -> Text
forall s a. s -> Getting a s a -> a
^. forall s t a b. HasField "result" 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 @"result" ((UploadPartResponse -> Const Text UploadPartResponse)
 -> SpacesResponse UploadPart
 -> Const Text (SpacesResponse UploadPart))
-> ((Text -> Const Text Text)
    -> UploadPartResponse -> Const Text UploadPartResponse)
-> Getting Text (SpacesResponse UploadPart) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. HasField "etag" 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 @"etag")
                Text -> ConduitT ByteString Text m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Text
etag ConduitT ByteString Text m ()
-> ConduitT ByteString Text m () -> ConduitT ByteString Text m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ConduitT ByteString Text m ()
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

    inChunks :: ConduitT ByteString ByteString m ()
inChunks = Int -> [ByteString] -> ConduitT ByteString ByteString m ()
loop Int
0 []
      where
        loop :: Int -> [ByteString] -> ConduitT ByteString ByteString m ()
loop Int
n [ByteString]
chunk = ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await ConduitT ByteString ByteString m (Maybe ByteString)
-> (Maybe ByteString -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitT ByteString ByteString m ()
-> (ByteString -> ConduitT ByteString ByteString m ())
-> Maybe ByteString
-> ConduitT ByteString ByteString m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([ByteString] -> ConduitT ByteString ByteString m ()
forall i. [ByteString] -> ConduitT i ByteString m ()
yieldChunk [ByteString]
chunk) ByteString -> ConduitT ByteString ByteString m ()
go
          where
            go :: ByteString -> ConduitT ByteString ByteString m ()
go ByteString
bs = ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
-> Bool
-> ConduitT ByteString ByteString m ()
forall a. a -> a -> Bool -> a
bool (Int -> [ByteString] -> ConduitT ByteString ByteString m ()
loop Int
len [ByteString]
newChunk)
                         ([ByteString] -> ConduitT ByteString ByteString m ()
forall i. [ByteString] -> ConduitT i ByteString m ()
yieldChunk [ByteString]
newChunk ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> [ByteString] -> ConduitT ByteString ByteString m ()
loop Int
0 [])
                         (Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
len)
              where
                len :: Int
len      = ByteString -> Int
C.length ByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n

                newChunk :: [ByteString]
newChunk = ByteString
bs ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
chunk

        yieldChunk :: [ByteString] -> ConduitT i ByteString m ()
yieldChunk = ByteString -> ConduitT i ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (ByteString -> ConduitT i ByteString m ())
-> ([ByteString] -> ByteString)
-> [ByteString]
-> ConduitT i ByteString m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
LB.fromChunks ([ByteString] -> ByteString)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse

-- | Upload a file's contents as an 'Object'. This will attempt to set the
-- correct 'Network.Mime.MimeType' based on the file extension
uploadFile :: forall m.
           MonadSpaces m
           => Bucket
           -> Object
           -> FilePath
           -> m (SpacesResponse UploadObject)
uploadFile :: Bucket -> Object -> String -> m (SpacesResponse UploadObject)
uploadFile Bucket
bucket Object
object String
fp = String
-> (ConduitM () ByteString m () -> m (SpacesResponse UploadObject))
-> m (SpacesResponse UploadObject)
forall (m :: * -> *) (n :: * -> *) i a.
(MonadUnliftIO m, MonadIO n) =>
String -> (ConduitM i ByteString n () -> m a) -> m a
withSourceFile @_ @m String
fp ((ConduitM () ByteString m () -> m (SpacesResponse UploadObject))
 -> m (SpacesResponse UploadObject))
-> (ConduitM () ByteString m () -> m (SpacesResponse UploadObject))
-> m (SpacesResponse UploadObject)
forall a b. (a -> b) -> a -> b
$ \ConduitM () ByteString m ()
body ->
    Maybe ByteString
-> Bucket
-> Object
-> ConduitM () ByteString m ()
-> m (SpacesResponse UploadObject)
forall (m :: * -> *).
MonadSpaces m =>
Maybe ByteString
-> Bucket -> Object -> BodyBS m -> m (SpacesResponse UploadObject)
uploadObject (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
mtype) Bucket
bucket Object
object ConduitM () ByteString m ()
body
  where
    mtype :: ByteString
mtype =
        MimeMap -> ByteString -> Text -> ByteString
mimeByExt MimeMap
defaultMimeMap ByteString
defaultMimeType (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> String
F.takeFileName String
fp

-- | Get information about an 'Object' (does not retrieve the body of the object)
getObjectInfo
    :: MonadSpaces m => Bucket -> Object -> m (SpacesResponse GetObjectInfo)
getObjectInfo :: Bucket -> Object -> m (SpacesResponse GetObjectInfo)
getObjectInfo Bucket
bucket Object
object = WithMetadata -> GetObjectInfo -> m (SpacesResponse GetObjectInfo)
forall a (m :: * -> *).
(MonadSpaces m, Action m a) =>
WithMetadata -> a -> m (SpacesResponse a)
runAction WithMetadata
KeepMetadata GetObjectInfo :: Bucket -> Object -> GetObjectInfo
GetObjectInfo { Object
Bucket
$sel:object:GetObjectInfo :: Object
$sel:bucket:GetObjectInfo :: Bucket
object :: Object
bucket :: Bucket
.. }

-- | Get an 'Object' (retrieves the actual body of the object)
getObject :: MonadSpaces m => Bucket -> Object -> m (SpacesResponse GetObject)
getObject :: Bucket -> Object -> m (SpacesResponse GetObject)
getObject Bucket
bucket Object
object = WithMetadata -> GetObject -> m (SpacesResponse GetObject)
forall a (m :: * -> *).
(MonadSpaces m, Action m a) =>
WithMetadata -> a -> m (SpacesResponse a)
runAction WithMetadata
KeepMetadata GetObject :: Bucket -> Object -> GetObject
GetObject { Object
Bucket
$sel:object:GetObject :: Object
$sel:bucket:GetObject :: Bucket
object :: Object
bucket :: Bucket
.. }

-- | Get an 'Object'\'s data and write it to the provided 'FilePath'
getObjectSinkFile :: MonadSpaces m => Bucket -> Object -> FilePath -> m ()
getObjectSinkFile :: Bucket -> Object -> String -> m ()
getObjectSinkFile Bucket
bucket Object
object String
fp = do
    ByteString
objectData <- Bucket -> Object -> m (SpacesResponse GetObject)
forall (m :: * -> *).
MonadSpaces m =>
Bucket -> Object -> m (SpacesResponse GetObject)
getObject Bucket
bucket Object
object
        m (SpacesResponse GetObject)
-> (SpacesResponse GetObject -> ByteString) -> m ByteString
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (SpacesResponse GetObject
-> Getting ByteString (SpacesResponse GetObject) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. forall s t a b. HasField "result" 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 @"result" ((GetObjectResponse -> Const ByteString GetObjectResponse)
 -> SpacesResponse GetObject
 -> Const ByteString (SpacesResponse GetObject))
-> ((ByteString -> Const ByteString ByteString)
    -> GetObjectResponse -> Const ByteString GetObjectResponse)
-> Getting ByteString (SpacesResponse GetObject) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. HasField "objectData" 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 @"objectData")
    ConduitT () Void (ResourceT m) () -> m ()
forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes (ConduitT () Void (ResourceT m) () -> m ())
-> ConduitT () Void (ResourceT m) () -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ConduitT () ByteString (ResourceT m) ()
forall (m :: * -> *) lazy strict i.
(Monad m, LazySequence lazy strict) =>
lazy -> ConduitT i strict m ()
sourceLazy ByteString
objectData ConduitT () ByteString (ResourceT m) ()
-> ConduitM ByteString Void (ResourceT m) ()
-> ConduitT () Void (ResourceT m) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| String -> ConduitM ByteString Void (ResourceT m) ()
forall (m :: * -> *) o.
MonadResource m =>
String -> ConduitM ByteString o m ()
sinkFileCautious String
fp

-- | Copy an 'Object' from one 'Bucket' to another; this chooses a number of
-- defaults to represent the most common cases and avoid a preponderance of
-- parameters. 'Object's are copied using default ACLs with the COPY metadata
-- directive.
--
-- If you'd like to use a specfic 'CannedACL' or 'MetadataDirective', use
-- 'CopyObject' directly with 'runAction'
copyObject :: MonadSpaces m
           => Bucket -- ^ Source 'Bucket'
           -> Bucket -- ^ Destination 'Bucket'
           -> Object -- ^ Source 'Object'
           -> Object -- ^ Destination 'Object'
           -> m (SpacesResponse CopyObject)
copyObject :: Bucket
-> Bucket -> Object -> Object -> m (SpacesResponse CopyObject)
copyObject Bucket
srcBucket Bucket
destBucket Object
srcObject Object
destObject =
    WithMetadata -> CopyObject -> m (SpacesResponse CopyObject)
forall a (m :: * -> *).
(MonadSpaces m, Action m a) =>
WithMetadata -> a -> m (SpacesResponse a)
runAction WithMetadata
KeepMetadata CopyObject :: Bucket
-> Bucket
-> Object
-> Object
-> MetadataDirective
-> Maybe CannedACL
-> CopyObject
CopyObject { Maybe CannedACL
Object
Bucket
MetadataDirective
forall a. Maybe a
$sel:acl:CopyObject :: Maybe CannedACL
$sel:metadataDirective:CopyObject :: MetadataDirective
$sel:destObject:CopyObject :: Object
$sel:srcObject:CopyObject :: Object
$sel:destBucket:CopyObject :: Bucket
$sel:srcBucket:CopyObject :: Bucket
metadataDirective :: MetadataDirective
acl :: forall a. Maybe a
destObject :: Object
srcObject :: Object
destBucket :: Bucket
srcBucket :: Bucket
.. }
  where
    acl :: Maybe a
acl               = Maybe a
forall a. Maybe a
Nothing

    metadataDirective :: MetadataDirective
metadataDirective = MetadataDirective
Copy

-- | Copy an 'Object' within the same 'Bucket', using defaults for the
-- 'MetadataDirective' and 'CannedACL'
copyObjectWithin :: MonadSpaces m
                 => Bucket
                 -> Object -- ^ Source 'Object'
                 -> Object -- ^ Destination 'Object'
                 -> m (SpacesResponse CopyObject)
copyObjectWithin :: Bucket -> Object -> Object -> m (SpacesResponse CopyObject)
copyObjectWithin Bucket
srcBucket Object
srcObject Object
destObject =
    WithMetadata -> CopyObject -> m (SpacesResponse CopyObject)
forall a (m :: * -> *).
(MonadSpaces m, Action m a) =>
WithMetadata -> a -> m (SpacesResponse a)
runAction WithMetadata
KeepMetadata CopyObject :: Bucket
-> Bucket
-> Object
-> Object
-> MetadataDirective
-> Maybe CannedACL
-> CopyObject
CopyObject { Maybe CannedACL
Object
Bucket
MetadataDirective
forall a. Maybe a
destBucket :: Bucket
metadataDirective :: MetadataDirective
acl :: forall a. Maybe a
destObject :: Object
srcObject :: Object
srcBucket :: Bucket
$sel:acl:CopyObject :: Maybe CannedACL
$sel:metadataDirective:CopyObject :: MetadataDirective
$sel:destObject:CopyObject :: Object
$sel:srcObject:CopyObject :: Object
$sel:destBucket:CopyObject :: Bucket
$sel:srcBucket:CopyObject :: Bucket
.. }
  where
    acl :: Maybe a
acl               = Maybe a
forall a. Maybe a
Nothing

    metadataDirective :: MetadataDirective
metadataDirective = MetadataDirective
Copy

    destBucket :: Bucket
destBucket        = Bucket
srcBucket

-- | Copy an 'Object' to itself, overwriting its associated metadata
overwriteObject
    :: MonadSpaces m => Bucket -> Object -> m (SpacesResponse CopyObject)
overwriteObject :: Bucket -> Object -> m (SpacesResponse CopyObject)
overwriteObject Bucket
srcBucket Object
srcObject = WithMetadata -> CopyObject -> m (SpacesResponse CopyObject)
forall a (m :: * -> *).
(MonadSpaces m, Action m a) =>
WithMetadata -> a -> m (SpacesResponse a)
runAction WithMetadata
KeepMetadata CopyObject :: Bucket
-> Bucket
-> Object
-> Object
-> MetadataDirective
-> Maybe CannedACL
-> CopyObject
CopyObject { Maybe CannedACL
Object
Bucket
MetadataDirective
forall a. Maybe a
destObject :: Object
destBucket :: Bucket
metadataDirective :: MetadataDirective
acl :: forall a. Maybe a
srcObject :: Object
srcBucket :: Bucket
$sel:acl:CopyObject :: Maybe CannedACL
$sel:metadataDirective:CopyObject :: MetadataDirective
$sel:destObject:CopyObject :: Object
$sel:srcObject:CopyObject :: Object
$sel:destBucket:CopyObject :: Bucket
$sel:srcBucket:CopyObject :: Bucket
.. }
  where
    acl :: Maybe a
acl               = Maybe a
forall a. Maybe a
Nothing

    metadataDirective :: MetadataDirective
metadataDirective = MetadataDirective
Copy

    destBucket :: Bucket
destBucket        = Bucket
srcBucket

    destObject :: Object
destObject        = Object
srcObject

-- | Delete a single 'Object'
deleteObject
    :: MonadSpaces m => Bucket -> Object -> m (SpacesResponse DeleteObject)
deleteObject :: Bucket -> Object -> m (SpacesResponse DeleteObject)
deleteObject Bucket
bucket Object
object = WithMetadata -> DeleteObject -> m (SpacesResponse DeleteObject)
forall a (m :: * -> *).
(MonadSpaces m, Action m a) =>
WithMetadata -> a -> m (SpacesResponse a)
runAction WithMetadata
KeepMetadata DeleteObject :: Bucket -> Object -> DeleteObject
DeleteObject { Object
Bucket
$sel:object:DeleteObject :: Object
$sel:bucket:DeleteObject :: Bucket
object :: Object
bucket :: Bucket
.. }

-- | Get an 'Object'\'s Access Control Lists
getObjectACLs
    :: MonadSpaces m => Bucket -> Object -> m (SpacesResponse GetObjectACLs)
getObjectACLs :: Bucket -> Object -> m (SpacesResponse GetObjectACLs)
getObjectACLs Bucket
bucket Object
object = WithMetadata -> GetObjectACLs -> m (SpacesResponse GetObjectACLs)
forall a (m :: * -> *).
(MonadSpaces m, Action m a) =>
WithMetadata -> a -> m (SpacesResponse a)
runAction WithMetadata
KeepMetadata GetObjectACLs :: Bucket -> Object -> GetObjectACLs
GetObjectACLs { Object
Bucket
$sel:object:GetObjectACLs :: Object
$sel:bucket:GetObjectACLs :: Bucket
object :: Object
bucket :: Bucket
.. }

-- | Set an 'Object'\'s Access Control Lists
setObjectACLs :: MonadSpaces m
              => Bucket
              -> Object
              -> Owner
              -> [Grant]
              -> m (SpacesResponse SetObjectACLs)
setObjectACLs :: Bucket
-> Object -> Owner -> [Grant] -> m (SpacesResponse SetObjectACLs)
setObjectACLs Bucket
bucket Object
object Owner
owner [Grant]
acls =
    WithMetadata -> SetObjectACLs -> m (SpacesResponse SetObjectACLs)
forall a (m :: * -> *).
(MonadSpaces m, Action m a) =>
WithMetadata -> a -> m (SpacesResponse a)
runAction WithMetadata
KeepMetadata SetObjectACLs :: Bucket -> Object -> Owner -> [Grant] -> SetObjectACLs
SetObjectACLs { [Grant]
Owner
Object
Bucket
$sel:acls:SetObjectACLs :: [Grant]
$sel:owner:SetObjectACLs :: Owner
$sel:object:SetObjectACLs :: Object
$sel:bucket:SetObjectACLs :: Bucket
acls :: [Grant]
owner :: Owner
object :: Object
bucket :: Bucket
.. }

-- | Create a new 'Bucket'
createBucket :: MonadSpaces m
             => Bucket
             -> Maybe Region -- ^ Overrides the 'Region' in your 'Spaces'
                             -- configuration
             -> Maybe CannedACL
             -> m (SpacesResponse CreateBucket)
createBucket :: Bucket
-> Maybe Region
-> Maybe CannedACL
-> m (SpacesResponse CreateBucket)
createBucket Bucket
bucket Maybe Region
region Maybe CannedACL
acl = WithMetadata -> CreateBucket -> m (SpacesResponse CreateBucket)
forall a (m :: * -> *).
(MonadSpaces m, Action m a) =>
WithMetadata -> a -> m (SpacesResponse a)
runAction WithMetadata
KeepMetadata CreateBucket :: Bucket -> Maybe Region -> Maybe CannedACL -> CreateBucket
CreateBucket { Maybe CannedACL
Maybe Region
Bucket
acl :: Maybe CannedACL
region :: Maybe Region
bucket :: Bucket
acl :: Maybe CannedACL
region :: Maybe Region
bucket :: Bucket
.. }

-- | Delete a 'Bucket'
deleteBucket :: MonadSpaces m => Bucket -> m (SpacesResponse DeleteBucket)
deleteBucket :: Bucket -> m (SpacesResponse DeleteBucket)
deleteBucket Bucket
bucket = WithMetadata -> DeleteBucket -> m (SpacesResponse DeleteBucket)
forall a (m :: * -> *).
(MonadSpaces m, Action m a) =>
WithMetadata -> a -> m (SpacesResponse a)
runAction WithMetadata
KeepMetadata DeleteBucket :: Bucket -> DeleteBucket
DeleteBucket { Bucket
$sel:bucket:DeleteBucket :: Bucket
bucket :: Bucket
.. }

-- | Get the location ('Region') of a 'Bucket'
getBucketLocation
    :: MonadSpaces m => Bucket -> m (SpacesResponse GetBucketLocation)
getBucketLocation :: Bucket -> m (SpacesResponse GetBucketLocation)
getBucketLocation Bucket
bucket = WithMetadata
-> GetBucketLocation -> m (SpacesResponse GetBucketLocation)
forall a (m :: * -> *).
(MonadSpaces m, Action m a) =>
WithMetadata -> a -> m (SpacesResponse a)
runAction WithMetadata
KeepMetadata GetBucketLocation :: Bucket -> GetBucketLocation
GetBucketLocation { Bucket
$sel:bucket:GetBucketLocation :: Bucket
bucket :: Bucket
.. }

-- | List every 'Bucket' associated with your Spaces account
listAllBuckets :: MonadSpaces m => m (SpacesResponse ListAllBuckets)
listAllBuckets :: m (SpacesResponse ListAllBuckets)
listAllBuckets = WithMetadata -> ListAllBuckets -> m (SpacesResponse ListAllBuckets)
forall a (m :: * -> *).
(MonadSpaces m, Action m a) =>
WithMetadata -> a -> m (SpacesResponse a)
runAction WithMetadata
KeepMetadata ListAllBuckets
ListAllBuckets

-- | List the 'Object's of a 'Bucket', without grouping, delimiting, or limiting
-- the keys (i.e. list all 'Object's non-hierarchically, up to the Spaces limit)
listBucket :: MonadSpaces m => Bucket -> m (SpacesResponse ListBucket)
listBucket :: Bucket -> m (SpacesResponse ListBucket)
listBucket Bucket
bucket = WithMetadata -> ListBucket -> m (SpacesResponse ListBucket)
forall a (m :: * -> *).
(MonadSpaces m, Action m a) =>
WithMetadata -> a -> m (SpacesResponse a)
runAction WithMetadata
KeepMetadata ListBucket :: Bucket
-> Maybe Char
-> Maybe Object
-> Maybe Int
-> Maybe Text
-> ListBucket
ListBucket { Maybe Char
Maybe Int
Maybe Text
Maybe Object
Bucket
forall a. Maybe a
$sel:prefix:ListBucket :: Maybe Text
$sel:maxKeys:ListBucket :: Maybe Int
$sel:marker:ListBucket :: Maybe Object
$sel:delimiter:ListBucket :: Maybe Char
$sel:bucket:ListBucket :: Bucket
prefix :: forall a. Maybe a
maxKeys :: forall a. Maybe a
marker :: forall a. Maybe a
delimiter :: forall a. Maybe a
bucket :: Bucket
.. }
  where
    delimiter :: Maybe a
delimiter = Maybe a
forall a. Maybe a
Nothing

    marker :: Maybe a
marker    = Maybe a
forall a. Maybe a
Nothing

    maxKeys :: Maybe a
maxKeys   = Maybe a
forall a. Maybe a
Nothing

    prefix :: Maybe a
prefix    = Maybe a
forall a. Maybe a
Nothing

-- | List the 'Object's of a 'Bucket', using a delimiter and prefix to group
-- objects. For example @\/@ can be used as a delimiter to treat objects as
-- directories within the bucket, which can further be combined with a text
-- prefix
listBucketGrouped :: MonadSpaces m
                  => Bucket
                  -> Char -- ^ Delimiter
                  -> Text -- ^ Prefix used to group object keys
                  -> m (SpacesResponse ListBucket)
listBucketGrouped :: Bucket -> Char -> Text -> m (SpacesResponse ListBucket)
listBucketGrouped Bucket
bucket Char
delimiter Text
prefix =
    WithMetadata -> ListBucket -> m (SpacesResponse ListBucket)
forall a (m :: * -> *).
(MonadSpaces m, Action m a) =>
WithMetadata -> a -> m (SpacesResponse a)
runAction WithMetadata
KeepMetadata
              ListBucket :: Bucket
-> Maybe Char
-> Maybe Object
-> Maybe Int
-> Maybe Text
-> ListBucket
ListBucket
              { $sel:delimiter:ListBucket :: Maybe Char
delimiter = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
delimiter, $sel:prefix:ListBucket :: Maybe Text
prefix = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
prefix, Maybe Int
Maybe Object
Bucket
forall a. Maybe a
marker :: forall a. Maybe a
maxKeys :: forall a. Maybe a
bucket :: Bucket
$sel:maxKeys:ListBucket :: Maybe Int
$sel:marker:ListBucket :: Maybe Object
$sel:bucket:ListBucket :: Bucket
.. }
  where
    maxKeys :: Maybe a
maxKeys = Maybe a
forall a. Maybe a
Nothing

    marker :: Maybe a
marker  = Maybe a
forall a. Maybe a
Nothing

-- | Recursively list /all/ 'Object's in a 'Bucket', calling 'ListBucket' until
-- @isTruncated@ is @False@. This operation may take some time, depending on the
-- total number of objects in your bucket
listBucketRec :: MonadSpaces m => Bucket -> m (Seq ObjectInfo)
listBucketRec :: Bucket -> m (Seq ObjectInfo)
listBucketRec Bucket
bucket = Seq ObjectInfo -> Maybe Object -> m (Seq ObjectInfo)
forall (m :: * -> *).
(MonadReader Spaces m, MonadUnliftIO m, MonadCatch m) =>
Seq ObjectInfo -> Maybe Object -> m (Seq ObjectInfo)
go Seq ObjectInfo
forall a. Monoid a => a
mempty Maybe Object
forall a. Maybe a
Nothing
  where
    go :: Seq ObjectInfo -> Maybe Object -> m (Seq ObjectInfo)
go Seq ObjectInfo
os Maybe Object
marker = do
        SpacesResponse ListBucket
listed <- WithMetadata -> ListBucket -> m (SpacesResponse ListBucket)
forall a (m :: * -> *).
(MonadSpaces m, Action m a) =>
WithMetadata -> a -> m (SpacesResponse a)
runAction WithMetadata
NoMetadata
            (ListBucket -> m (SpacesResponse ListBucket))
-> ListBucket -> m (SpacesResponse ListBucket)
forall a b. (a -> b) -> a -> b
$ ListBucket :: Bucket
-> Maybe Char
-> Maybe Object
-> Maybe Int
-> Maybe Text
-> ListBucket
ListBucket
            { $sel:delimiter:ListBucket :: Maybe Char
delimiter = Maybe Char
forall a. Maybe a
Nothing, $sel:maxKeys:ListBucket :: Maybe Int
maxKeys = Maybe Int
forall a. Maybe a
Nothing, $sel:prefix:ListBucket :: Maybe Text
prefix = Maybe Text
forall a. Maybe a
Nothing, Maybe Object
Bucket
marker :: Maybe Object
bucket :: Bucket
$sel:marker:ListBucket :: Maybe Object
$sel:bucket:ListBucket :: Bucket
.. }
        let r :: ListBucketResponse
r           = SpacesResponse ListBucket
listed SpacesResponse ListBucket
-> Getting
     ListBucketResponse (SpacesResponse ListBucket) ListBucketResponse
-> ListBucketResponse
forall s a. s -> Getting a s a -> a
^. forall s t a b. HasField "result" 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 @"result"
            isTruncated :: Bool
isTruncated = ListBucketResponse
r ListBucketResponse -> Getting Bool ListBucketResponse Bool -> Bool
forall s a. s -> Getting a s a -> a
^. forall s t a b. HasField "isTruncated" 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 @"isTruncated"
            objects :: Seq ObjectInfo
objects     = ListBucketResponse
r ListBucketResponse
-> Getting (Seq ObjectInfo) ListBucketResponse (Seq ObjectInfo)
-> Seq ObjectInfo
forall s a. s -> Getting a s a -> a
^. forall s t a b. HasField "objects" 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 @"objects"
            nextMarker :: Maybe Object
nextMarker  = ListBucketResponse
r ListBucketResponse
-> Getting (Maybe Object) ListBucketResponse (Maybe Object)
-> Maybe Object
forall s a. s -> Getting a s a -> a
^. forall s t a b. HasField "nextMarker" 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 @"nextMarker"
        case Maybe Object
nextMarker of
            Just Object
_
                | Bool
isTruncated -> Seq ObjectInfo -> Maybe Object -> m (Seq ObjectInfo)
go (Seq ObjectInfo
os Seq ObjectInfo -> Seq ObjectInfo -> Seq ObjectInfo
forall a. Semigroup a => a -> a -> a
<> Seq ObjectInfo
objects) Maybe Object
nextMarker
                | Bool
otherwise -> Seq ObjectInfo -> m (Seq ObjectInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Seq ObjectInfo -> m (Seq ObjectInfo))
-> Seq ObjectInfo -> m (Seq ObjectInfo)
forall a b. (a -> b) -> a -> b
$ Seq ObjectInfo
os Seq ObjectInfo -> Seq ObjectInfo -> Seq ObjectInfo
forall a. Semigroup a => a -> a -> a
<> Seq ObjectInfo
objects
            Maybe Object
Nothing -> Seq ObjectInfo -> m (Seq ObjectInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Seq ObjectInfo -> m (Seq ObjectInfo))
-> Seq ObjectInfo -> m (Seq ObjectInfo)
forall a b. (a -> b) -> a -> b
$ Seq ObjectInfo
os Seq ObjectInfo -> Seq ObjectInfo -> Seq ObjectInfo
forall a. Semigroup a => a -> a -> a
<> Seq ObjectInfo
objects

-- | Get the 'CORSRule's configured for a given 'Bucket'
getBucketCORS :: MonadSpaces m => Bucket -> m (SpacesResponse GetBucketCORS)
getBucketCORS :: Bucket -> m (SpacesResponse GetBucketCORS)
getBucketCORS Bucket
bucket = WithMetadata -> GetBucketCORS -> m (SpacesResponse GetBucketCORS)
forall a (m :: * -> *).
(MonadSpaces m, Action m a) =>
WithMetadata -> a -> m (SpacesResponse a)
runAction WithMetadata
KeepMetadata (GetBucketCORS -> m (SpacesResponse GetBucketCORS))
-> GetBucketCORS -> m (SpacesResponse GetBucketCORS)
forall a b. (a -> b) -> a -> b
$ GetBucketCORS :: Bucket -> GetBucketCORS
GetBucketCORS { Bucket
$sel:bucket:GetBucketCORS :: Bucket
bucket :: Bucket
.. }

-- | Set 'CORSRule's for a given 'Bucket'
setBucketCORS :: MonadSpaces m
              => Bucket
              -> [CORSRule]
              -> m (SpacesResponse SetBucketCORS)
setBucketCORS :: Bucket -> [CORSRule] -> m (SpacesResponse SetBucketCORS)
setBucketCORS Bucket
bucket [CORSRule]
rules = WithMetadata -> SetBucketCORS -> m (SpacesResponse SetBucketCORS)
forall a (m :: * -> *).
(MonadSpaces m, Action m a) =>
WithMetadata -> a -> m (SpacesResponse a)
runAction WithMetadata
KeepMetadata (SetBucketCORS -> m (SpacesResponse SetBucketCORS))
-> SetBucketCORS -> m (SpacesResponse SetBucketCORS)
forall a b. (a -> b) -> a -> b
$ SetBucketCORS :: Bucket -> [CORSRule] -> SetBucketCORS
SetBucketCORS { [CORSRule]
Bucket
$sel:rules:SetBucketCORS :: [CORSRule]
$sel:bucket:SetBucketCORS :: Bucket
rules :: [CORSRule]
bucket :: Bucket
.. }

-- | Delete the existing configured 'CORSRule's for a given 'Bucket'
deleteBucketCORS
    :: MonadSpaces m => Bucket -> m (SpacesResponse DeleteBucketCORS)
deleteBucketCORS :: Bucket -> m (SpacesResponse DeleteBucketCORS)
deleteBucketCORS Bucket
bucket = WithMetadata
-> DeleteBucketCORS -> m (SpacesResponse DeleteBucketCORS)
forall a (m :: * -> *).
(MonadSpaces m, Action m a) =>
WithMetadata -> a -> m (SpacesResponse a)
runAction WithMetadata
KeepMetadata (DeleteBucketCORS -> m (SpacesResponse DeleteBucketCORS))
-> DeleteBucketCORS -> m (SpacesResponse DeleteBucketCORS)
forall a b. (a -> b) -> a -> b
$ DeleteBucketCORS :: Bucket -> DeleteBucketCORS
DeleteBucketCORS { Bucket
$sel:bucket:DeleteBucketCORS :: Bucket
bucket :: Bucket
.. }

-- | Get a 'Bucket'\'s Access Control Lists
getBucketACLs :: MonadSpaces m => Bucket -> m (SpacesResponse GetBucketACLs)
getBucketACLs :: Bucket -> m (SpacesResponse GetBucketACLs)
getBucketACLs Bucket
bucket = WithMetadata -> GetBucketACLs -> m (SpacesResponse GetBucketACLs)
forall a (m :: * -> *).
(MonadSpaces m, Action m a) =>
WithMetadata -> a -> m (SpacesResponse a)
runAction WithMetadata
KeepMetadata (GetBucketACLs -> m (SpacesResponse GetBucketACLs))
-> GetBucketACLs -> m (SpacesResponse GetBucketACLs)
forall a b. (a -> b) -> a -> b
$ GetBucketACLs :: Bucket -> GetBucketACLs
GetBucketACLs { Bucket
$sel:bucket:GetBucketACLs :: Bucket
bucket :: Bucket
.. }

-- | Set a 'Bucket'\'s Access Control Lists. Spaces only allows a limited subset
-- of s3 ACLs at the moment. It may be preferable to use a 'CannedACL' when
-- creating new resources rather than using this action, which is provided
-- for the sake of completeness.
--
-- Note that to allow public read-only access to your bucket, you /must/
-- simultaneously set full owner control.
setBucketACLs :: MonadSpaces m
              => Bucket
              -> [Grant]
              -> Owner
              -> m (SpacesResponse SetBucketACLs)
setBucketACLs :: Bucket -> [Grant] -> Owner -> m (SpacesResponse SetBucketACLs)
setBucketACLs Bucket
bucket [Grant]
acls Owner
owner =
    WithMetadata -> SetBucketACLs -> m (SpacesResponse SetBucketACLs)
forall a (m :: * -> *).
(MonadSpaces m, Action m a) =>
WithMetadata -> a -> m (SpacesResponse a)
runAction WithMetadata
KeepMetadata (SetBucketACLs -> m (SpacesResponse SetBucketACLs))
-> SetBucketACLs -> m (SpacesResponse SetBucketACLs)
forall a b. (a -> b) -> a -> b
$ SetBucketACLs :: Bucket -> [Grant] -> Owner -> SetBucketACLs
SetBucketACLs { [Grant]
Owner
Bucket
$sel:owner:SetBucketACLs :: Owner
$sel:acls:SetBucketACLs :: [Grant]
$sel:bucket:SetBucketACLs :: Bucket
owner :: Owner
acls :: [Grant]
bucket :: Bucket
.. }

-- | Get a 'Bucket'\'s 'LifecycleRule' configuration . Note that unless you
-- have explicitly configured lifecycle rules, this will fail with a 404
-- status and an error code of @NoSuchLifecycleConfiguration@
getBucketLifecycleRules
    :: MonadSpaces m => Bucket -> m (SpacesResponse GetBucketLifecycle)
getBucketLifecycleRules :: Bucket -> m (SpacesResponse GetBucketLifecycle)
getBucketLifecycleRules Bucket
bucket =
    WithMetadata
-> GetBucketLifecycle -> m (SpacesResponse GetBucketLifecycle)
forall a (m :: * -> *).
(MonadSpaces m, Action m a) =>
WithMetadata -> a -> m (SpacesResponse a)
runAction WithMetadata
KeepMetadata (GetBucketLifecycle -> m (SpacesResponse GetBucketLifecycle))
-> GetBucketLifecycle -> m (SpacesResponse GetBucketLifecycle)
forall a b. (a -> b) -> a -> b
$ GetBucketLifecycle :: Bucket -> GetBucketLifecycle
GetBucketLifecycle { Bucket
$sel:bucket:GetBucketLifecycle :: Bucket
bucket :: Bucket
.. }

-- | Set a 'Bucket'\'s 'LifecycleRule' configuration
setBucketLifecycleRules :: MonadSpaces m
                        => Bucket
                        -> [LifecycleRule]
                        -> m (SpacesResponse SetBucketLifecycle)
setBucketLifecycleRules :: Bucket -> [LifecycleRule] -> m (SpacesResponse SetBucketLifecycle)
setBucketLifecycleRules Bucket
bucket [LifecycleRule]
rules =
    WithMetadata
-> SetBucketLifecycle -> m (SpacesResponse SetBucketLifecycle)
forall a (m :: * -> *).
(MonadSpaces m, Action m a) =>
WithMetadata -> a -> m (SpacesResponse a)
runAction WithMetadata
KeepMetadata (SetBucketLifecycle -> m (SpacesResponse SetBucketLifecycle))
-> SetBucketLifecycle -> m (SpacesResponse SetBucketLifecycle)
forall a b. (a -> b) -> a -> b
$ SetBucketLifecycle :: Bucket -> [LifecycleRule] -> SetBucketLifecycle
SetBucketLifecycle { [LifecycleRule]
Bucket
$sel:rules:SetBucketLifecycle :: [LifecycleRule]
$sel:bucket:SetBucketLifecycle :: Bucket
rules :: [LifecycleRule]
bucket :: Bucket
.. }

-- | Delete a 'Bucket'\'s 'LifecycleRule' configuration
deleteBucketLifecycleRules
    :: MonadSpaces m => Bucket -> m (SpacesResponse DeleteBucketLifecycle)
deleteBucketLifecycleRules :: Bucket -> m (SpacesResponse DeleteBucketLifecycle)
deleteBucketLifecycleRules Bucket
bucket =
    WithMetadata
-> DeleteBucketLifecycle
-> m (SpacesResponse DeleteBucketLifecycle)
forall a (m :: * -> *).
(MonadSpaces m, Action m a) =>
WithMetadata -> a -> m (SpacesResponse a)
runAction WithMetadata
KeepMetadata (DeleteBucketLifecycle -> m (SpacesResponse DeleteBucketLifecycle))
-> DeleteBucketLifecycle
-> m (SpacesResponse DeleteBucketLifecycle)
forall a b. (a -> b) -> a -> b
$ DeleteBucketLifecycle :: Bucket -> DeleteBucketLifecycle
DeleteBucketLifecycle { Bucket
$sel:bucket:DeleteBucketLifecycle :: Bucket
bucket :: Bucket
.. }
--
-- $conv
-- The following are convenience actions. In most cases, each action is the same
-- as applying 'runAction' to a type that implements the 'Action' typeclass.
-- Information about the response is retained ('SpacesMetadata') in each action.
-- For instance:
--
-- > deleteBucket myBucket
--
-- is the equivalent of
--
-- > runAction KeepMetadata DeleteBucket { bucket = myBucket }
--
-- All of the underlying instances of 'Action' are exposed and can be imported from
-- "Network.DO.Spaces.Actions" and its sub-modules. The convenience actions exposed
-- in the present module attempt to choose sane defaults where applicable.
--
-- The only major exception to the above are actions which involve uploading object
-- data to Spaces. In the case of 'uploadObject', the action converts its 'BodyBS'
-- argument to a 'RequestBodyLBS'. Should you choose to directly construct
-- 'UploadObject', you must do this manually. 'multipartObject' is more complicated,
-- and takes care of chunking the request body, sending each individual request,
-- and completing the multipart request
--
-- In addition to convenience wrappers around 'Action' instances, this module exports
-- several actions which may be of use, including sinking remote 'Object' data into
-- a file, uploading the contents of a file as an 'Object', and recursively listing
-- the entire contents of a 'Bucket'
--
--
--
--