@@ -1,5 +1,5 @@
11--
2−-- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc.
2+-- Minio Haskell SDK, (C) 2017 Minio, Inc.
33--
44-- Licensed under the Apache License, Version 2.0 (the "License");
55-- you may not use this file except in compliance with the License.
@@ -13,276 +13,141 @@
1313-- See the License for the specific language governing permissions and
1414-- limitations under the License.
1515--
16−{-# LANGUAGE CPP #-}
17−{-# LANGUAGE GADTs #-}
18−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
19−{-# LANGUAGE StrictData #-}
20−{-# LANGUAGE TypeFamilies #-}
2116
17+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-}
2218module Network.Minio.Data where
2319
24−import qualified Conduit as C
25−import qualified Control.Concurrent.MVar as M
26−import Control.Monad.Trans.Except (throwE)
27−import Control.Monad.Trans.Resource
28− ( MonadResource,
29− MonadThrow (..),
30− MonadUnliftIO,
31− ResourceT,
32− runResourceT,
33− )
34−import qualified Data.Aeson as A
35−import qualified Data.ByteArray as BA
20+import Control.Monad.Base
21+import qualified Control.Monad.Catch as MC
22+import Control.Monad.Trans.Control
23+import Control.Monad.Trans.Resource
24+
3625import qualified Data.ByteString as B
37−import qualified Data.ByteString.Lazy as LB
38−import Data.Default.Class (def)
39−import qualified Data.HashMap.Strict as H
40−import qualified Data.Ini as Ini
41−import qualified Data.List as List
26+import Data.Default (Default(..))
27+import qualified Data.Map as Map
4228import qualified Data.Text as T
43−import qualified Data.Text.Encoding as TE
44−import Data.Time (defaultTimeLocale, formatTime)
45−import Lib.Prelude (UTCTime, throwIO)
46−import qualified Network.Connection as Conn
47−import Network.HTTP.Client (defaultManagerSettings)
48−import qualified Network.HTTP.Client.TLS as TLS
29+import Data.Time (formatTime, defaultTimeLocale)
30+import Network.HTTP.Client (defaultManagerSettings)
4931import qualified Network.HTTP.Conduit as NC
50−import Network.HTTP.Types
51− ( ByteRange,
52− Header,
53− Method,
54− Query,
55− hRange,
56− )
32+import Network.HTTP.Types (Method, Header, Query)
5733import qualified Network.HTTP.Types as HT
58−import Network.Minio.Credentials
59−import Network.Minio.Data.Crypto
60− ( encodeToBase64,
61− hashMD5ToBase64,
62− )
63−import Network.Minio.Data.Time (UrlExpiry)
64−import Network.Minio.Errors
65− ( MErrV (MErrVInvalidEncryptionKeyLength, MErrVMissingCredentials),
66− MinioErr (..),
67− )
68−import Network.Minio.Utils
69−import System.Directory (doesFileExist, getHomeDirectory)
70−import qualified System.Environment as Env
71−import System.FilePath.Posix (combine)
72−import qualified UnliftIO as U
73−import qualified UnliftIO.MVar as UM
74−
75−-- | max obj size is 5TiB
76−maxObjectSize :: Int64
77−maxObjectSize = 5 * 1024 * 1024 * oneMiB
34+import Network.Minio.Errors
35+import Text.XML
7836
79−-- | minimum size of parts used in multipart operations.
80−minPartSize :: Int64
81−minPartSize = 64 * oneMiB
37+import GHC.Show (Show(..))
8238
83−oneMiB :: Int64
84−oneMiB = 1024 * 1024
39+import Lib.Prelude
8540
86−-- | maximum number of parts that can be uploaded for a single object.
87−maxMultipartParts :: Int64
88−maxMultipartParts = 10000
8941
9042-- TODO: Add a type which provides typed constants for region. this
9143-- type should have a IsString instance to infer the appropriate
9244-- constant.
93−
9445-- | awsRegionMap - library constant
95−awsRegionMap :: H.HashMap Text Text
96−awsRegionMap =
97− H.fromList
98− [ ("us-east-1", "s3.us-east-1.amazonaws.com"),
99− ("us-east-2", "s3.us-east-2.amazonaws.com"),
100− ("us-west-1", "s3.us-west-1.amazonaws.com"),
101− ("us-west-2", "s3.us-west-2.amazonaws.com"),
102− ("ca-central-1", "s3.ca-central-1.amazonaws.com"),
103− ("ap-south-1", "s3.ap-south-1.amazonaws.com"),
104− ("ap-south-2", "s3.ap-south-2.amazonaws.com"),
105− ("ap-northeast-1", "s3.ap-northeast-1.amazonaws.com"),
106− ("ap-northeast-2", "s3.ap-northeast-2.amazonaws.com"),
107− ("ap-northeast-3", "s3.ap-northeast-3.amazonaws.com"),
108− ("ap-southeast-1", "s3.ap-southeast-1.amazonaws.com"),
109− ("ap-southeast-2", "s3.ap-southeast-2.amazonaws.com"),
110− ("ap-southeast-3", "s3.ap-southeast-3.amazonaws.com"),
111− ("eu-west-1", "s3.eu-west-1.amazonaws.com"),
112− ("eu-west-2", "s3.eu-west-2.amazonaws.com"),
113− ("eu-west-3", "s3.eu-west-3.amazonaws.com"),
114− ("eu-central-1", "s3.eu-central-1.amazonaws.com"),
115− ("eu-central-2", "s3.eu-central-2.amazonaws.com"),
116− ("eu-south-1", "s3.eu-south-1.amazonaws.com"),
117− ("eu-south-2", "s3.eu-south-2.amazonaws.com"),
118− ("af-south-1", "s3.af-south-1.amazonaws.com"),
119− ("ap-east-1", "s3.ap-east-1.amazonaws.com"),
120− ("cn-north-1", "s3.cn-north-1.amazonaws.com.cn"),
121− ("cn-northwest-1", "s3.cn-northwest-1.amazonaws.com.cn"),
122− ("eu-north-1", "s3.eu-north-1.amazonaws.com"),
123− ("me-south-1", "s3.me-south-1.amazonaws.com"),
124− ("me-central-1", "s3.me-central-1.amazonaws.com"),
125− ("us-gov-east-1", "s3.us-gov-east-1.amazonaws.com"),
126− ("us-gov-west-1", "s3.us-gov-west-1.amazonaws.com"),
127− ("sa-east-1", "s3.sa-east-1.amazonaws.com")
128− ]
129−
130−-- | Connection Info data type. To create a 'ConnectInfo' value,
131−-- enable the @OverloadedStrings@ language extension and use the
132−-- `IsString` instance to provide a URL, for example:
46+awsRegionMap :: Map.Map Text Text
47+awsRegionMap = Map.fromList [
48+ ("us-east-1", "s3.amazonaws.com")
49+ , ("us-east-2", "s3-us-east-2.amazonaws.com")
50+ , ("us-west-1", "s3-us-west-1.amazonaws.com")
51+ , ("us-east-2", "s3-us-west-2.amazonaws.com")
52+ , ("ca-central-1", "s3-ca-central-1.amazonaws.com")
53+ , ("ap-south-1", "s3-ap-south-1.amazonaws.com")
54+ , ("ap-northeast-1", "s3-ap-northeast-1.amazonaws.com")
55+ , ("ap-northeast-2", "s3-ap-northeast-2.amazonaws.com")
56+ , ("ap-southeast-1", "s3-ap-southeast-1.amazonaws.com")
57+ , ("ap-southeast-2", "s3-ap-southeast-2.amazonaws.com")
58+ , ("eu-west-1", "s3-eu-west-1.amazonaws.com")
59+ , ("eu-west-2", "s3-eu-west-2.amazonaws.com")
60+ , ("eu-central-1", "s3-eu-central-1.amazonaws.com")
61+ , ("sa-east-1", "s3-sa-east-1.amazonaws.com")
62+ ]
63+
64+-- | Connection Info data type. To create a 'ConnectInfo' value, use one
65+-- of the provided smart constructors or override fields of the
66+-- Default instance.
67+data ConnectInfo = ConnectInfo {
68+ connectHost :: Text
69+ , connectPort :: Int
70+ , connectAccessKey :: Text
71+ , connectSecretKey :: Text
72+ , connectIsSecure :: Bool
73+ , connectRegion :: Region
74+ , connectAutoDiscoverRegion :: Bool
75+ } deriving (Eq, Show)
76+
77+-- | Connects to a Minio server located at @localhost:9000@ with access
78+-- key /minio/ and secret key /minio123/. It is over __HTTP__ by
79+-- default.
80+instance Default ConnectInfo where
81+ def = ConnectInfo "localhost" 9000 "minio" "minio123" False "us-east-1" True
82+
83+-- | Default AWS ConnectInfo. Connects to "us-east-1". Credentials
84+-- should be supplied before use, for e.g.:
13385--
134−-- > let c :: ConnectInfo = "https://play.min.io"
135−data ConnectInfo = ConnectInfo
136− { connectHost :: Text,
137− connectPort :: Int,
138− connectCreds :: Creds,
139− connectIsSecure :: Bool,
140− connectRegion :: Region,
141− connectAutoDiscoverRegion :: Bool,
142− connectDisableTLSCertValidation :: Bool
86+-- > awsCI {
87+-- > connectAccessKey = "my-access-key"
88+-- > , connectSecretKey = "my-secret-key"
89+-- > }
90+awsCI :: ConnectInfo
91+awsCI = def {
92+ connectHost = "s3.amazonaws.com"
93+ , connectPort = 443
94+ , connectAccessKey = ""
95+ , connectSecretKey = ""
96+ , connectIsSecure = True
14397 }
14498
145−getEndpoint :: ConnectInfo -> Endpoint
146−getEndpoint ci = (encodeUtf8 $ connectHost ci, connectPort ci, connectIsSecure ci)
147−
148−instance IsString ConnectInfo where
149− fromString str =
150− let req = NC.parseRequest_ str
151− in ConnectInfo
152− { connectHost = TE.decodeUtf8 $ NC.host req,
153− connectPort = NC.port req,
154− connectCreds = CredsStatic $ CredentialValue mempty mempty mempty,
155− connectIsSecure = NC.secure req,
156− connectRegion = "",
157− connectAutoDiscoverRegion = True,
158− connectDisableTLSCertValidation = False
159− }
160−
161−-- | A 'CredentialLoader' is an action that may return a 'CredentialValue'.
162−-- Loaders may be chained together using 'findFirst'.
99+-- | AWS ConnectInfo with a specified region. It can optionally
100+-- disable the automatic discovery of a bucket's region via the
101+-- Boolean argument.
163102--
164−-- @since 1.7.0
165−type CredentialLoader = IO (Maybe CredentialValue)
166−
167−-- | Combines the given list of loaders, by calling each one in
168−-- order until a 'CredentialValue' is returned.
169−findFirst :: [CredentialLoader] -> IO (Maybe CredentialValue)
170−findFirst [] = return Nothing
171−findFirst (f : fs) = do
172− c <- f
173− maybe (findFirst fs) (return . Just) c
174−
175−-- | This action returns a 'CredentialValue' populated from
176−-- @~\/.aws\/credentials@
177−fromAWSConfigFile :: CredentialLoader
178−fromAWSConfigFile = do
179− credsE <- runExceptT $ do
180− homeDir <- lift getHomeDirectory
181− let awsCredsFile = homeDir `combine` ".aws" `combine` "credentials"
182− fileExists <- lift $ doesFileExist awsCredsFile
183− bool (throwE "FileNotFound") (return ()) fileExists
184− ini <- ExceptT $ Ini.readIniFile awsCredsFile
185− akey <-
186− ExceptT $
187− return $
188− Ini.lookupValue "default" "aws_access_key_id" ini
189− skey <-
190− ExceptT $
191− return $
192− Ini.lookupValue "default" "aws_secret_access_key" ini
193− return $ CredentialValue (coerce akey) (fromString $ T.unpack skey) Nothing
194− return $ either (const Nothing) Just credsE
195−
196−-- | This action returns a 'CredentialValue` populated from @AWS_ACCESS_KEY_ID@
197−-- and @AWS_SECRET_ACCESS_KEY@ environment variables.
198−fromAWSEnv :: CredentialLoader
199−fromAWSEnv = runMaybeT $ do
200− akey <- MaybeT $ Env.lookupEnv "AWS_ACCESS_KEY_ID"
201− skey <- MaybeT $ Env.lookupEnv "AWS_SECRET_ACCESS_KEY"
202− return $ CredentialValue (fromString akey) (fromString skey) Nothing
203−
204−-- | This action returns a 'CredentialValue' populated from @MINIO_ACCESS_KEY@
205−-- and @MINIO_SECRET_KEY@ environment variables.
206−fromMinioEnv :: CredentialLoader
207−fromMinioEnv = runMaybeT $ do
208− akey <- MaybeT $ Env.lookupEnv "MINIO_ACCESS_KEY"
209− skey <- MaybeT $ Env.lookupEnv "MINIO_SECRET_KEY"
210− return $ CredentialValue (fromString akey) (fromString skey) Nothing
211−
212−-- | setCredsFrom retrieves access credentials from the first action in the
213−-- given list that succeeds and sets it in the 'ConnectInfo'.
214−setCredsFrom :: [CredentialLoader] -> ConnectInfo -> IO ConnectInfo
215−setCredsFrom ps ci = do
216− pMay <- findFirst ps
217− maybe
218− (throwIO MErrVMissingCredentials)
219− (return . (`setCreds` ci))
220− pMay
221−
222−-- | setCreds sets the given `CredentialValue` in the `ConnectInfo`.
223−setCreds :: CredentialValue -> ConnectInfo -> ConnectInfo
224−setCreds cv connInfo =
225− connInfo
226− { connectCreds = CredsStatic cv
227− }
228−
229−-- | 'setSTSCredential' configures `ConnectInfo` to retrieve temporary
230−-- credentials via the STS API on demand. It is automatically refreshed on
231−-- expiry.
232−setSTSCredential :: (STSCredentialProvider p) => p -> ConnectInfo -> IO ConnectInfo
233−setSTSCredential p ci = do
234− store <- initSTSCredential p
235− return ci {connectCreds = CredsSTS store}
236−
237−-- | Set the S3 region parameter in the `ConnectInfo`
238−setRegion :: Region -> ConnectInfo -> ConnectInfo
239−setRegion r connInfo =
240− connInfo
241− { connectRegion = r,
242− connectAutoDiscoverRegion = False
243− }
244−
245−-- | Check if the connection to object storage server is secure
246−-- (i.e. uses TLS)
247−isConnectInfoSecure :: ConnectInfo -> Bool
248−isConnectInfoSecure = connectIsSecure
249−
250−-- | Disable TLS certificate validation completely! This makes TLS
251−-- insecure! Use only for testing with self-signed or temporary
252−-- certificates. Note that this option has no effect, if you provide
253−-- your own Manager in `mkMinioConn`.
254−disableTLSCertValidation :: ConnectInfo -> ConnectInfo
255−disableTLSCertValidation c = c {connectDisableTLSCertValidation = True}
256−
257−getHostAddr :: ConnectInfo -> ByteString
258−getHostAddr ci = getHostHeader (encodeUtf8 $ connectHost ci, connectPort ci)
259−
260−-- | Default Google Compute Storage ConnectInfo. Works only for
261−-- "Simple Migration" use-case with interoperability mode enabled on
262−-- GCP console. For more information -
263−-- https://cloud.google.com/storage/docs/migrating
103+-- > awsWithRegionCI "us-west-1" False {
104+-- > connectAccessKey = "my-access-key"
105+-- > , connectSecretKey = "my-secret-key"
106+-- > }
264107--
265−-- Credentials should be supplied before use.
266−gcsCI :: ConnectInfo
267−gcsCI =
268− setRegion
269− "us"
270− "https://storage.googleapis.com"
108+-- This restricts all operations to the "us-west-1" region and does
109+-- not perform any bucket location requests.
110+awsWithRegionCI :: Region -> Bool -> ConnectInfo
111+awsWithRegionCI region autoDiscoverRegion =
112+ let host = maybe "s3.amazonaws.com" identity $
113+ Map.lookup region awsRegionMap
114+ in awsCI {
115+ connectHost = host
116+ , connectRegion = region
117+ , connectAutoDiscoverRegion = autoDiscoverRegion
118+ }
271119
272−-- | Default AWS S3 ConnectInfo. Connects to "us-east-1". Credentials
273−-- should be supplied before use.
274−awsCI :: ConnectInfo
275−awsCI = "https://s3.amazonaws.com"
276120
277−-- | <https://play.min.io MinIO Play Server>
121+-- | <https://play.minio.io:9000 Minio Play Server>
278122-- ConnectInfo. Credentials are already filled in.
279123minioPlayCI :: ConnectInfo
280−minioPlayCI =
281− let playCreds = CredentialValue "Q3AM3UQ867SPQQA43P2F" "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG" Nothing
282− in setCreds playCreds $
283− setRegion
284− "us-east-1"
285− "https://play.min.io"
124+minioPlayCI = def {
125+ connectHost = "play.minio.io"
126+ , connectPort = 9000
127+ , connectAccessKey = "Q3AM3UQ867SPQQA43P2F"
128+ , connectSecretKey = "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG"
129+ , connectIsSecure = True
130+ , connectAutoDiscoverRegion = False
131+ }
132+
133+-- | ConnectInfo for Minio server. Takes hostname, port and a Boolean
134+-- to enable TLS.
135+--
136+-- > minioCI "minio.example.com" 9000 True {
137+-- > connectAccessKey = "my-access-key"
138+-- > , connectSecretKey = "my-secret-key"
139+-- > }
140+--
141+-- This connects to a Minio server at the given hostname and port over
142+-- HTTPS.
143+minioCI :: Text -> Int -> Bool -> ConnectInfo
144+minioCI host port isSecure = def {
145+ connectHost = host
146+ , connectPort = port
147+ , connectRegion = "us-east-1"
148+ , connectIsSecure = isSecure
149+ , connectAutoDiscoverRegion = False
150+ }
286151
287152-- |
288153-- Represents a bucket in the object store
@@ -292,156 +157,25 @@ type Bucket = Text
292157-- Represents an object name
293158type Object = Text
294159
295−-- | Represents a region
160+-- |
161+-- Represents a region
162+-- TODO: This could be a Sum Type with all defined regions for AWS.
296163type Region = Text
297164
298−-- | A type alias to represent an Entity-Tag returned by S3-compatible APIs.
165+-- | A type alias to represent an Entity-Tag returned by S3-compatible
166+-- APIs.
299167type ETag = Text
300168
301−-- | Data type to represent an object encryption key. Create one using
302−-- the `mkSSECKey` function.
303−newtype SSECKey = SSECKey BA.ScrubbedBytes
304− deriving stock (Eq, Show)
305−
306−-- | Validates that the given ByteString is 32 bytes long and creates
307−-- an encryption key.
308−mkSSECKey :: (MonadThrow m) => ByteString -> m SSECKey
309−mkSSECKey keyBytes
310− | B.length keyBytes /= 32 =
311− throwM MErrVInvalidEncryptionKeyLength
312− | otherwise =
313− return $ SSECKey $ BA.convert keyBytes
314−
315−-- | Data type to represent Server-Side-Encryption settings
316−data SSE where
317− -- | Specifies SSE S3 encryption - server manages encryption keys
318− SSE :: SSE
319− -- | Specifies that KMS service should be used. The first argument
320− -- to the constructor is the Key Id to be used by the server (if
321− -- not specified, the default KMS key id is used). The second
322− -- argument is the optional KMS context that must have a
323− -- `A.ToJSON` instance - please refer to the AWS S3 documentation
324− -- for detailed information.
325− SSEKMS :: (A.ToJSON a) => Maybe ByteString -> Maybe a -> SSE
326− -- | Specifies server-side encryption with customer provided
327− -- key. The argument is the encryption key to be used.
328− SSEC :: SSECKey -> SSE
329−
330−toPutObjectHeaders :: SSE -> [HT.Header]
331−toPutObjectHeaders sseArg =
332− let sseHeader = "x-amz-server-side-encryption"
333− sseKmsIdHeader = sseHeader <> "-aws-kms-key-id"
334− sseKmsContextHeader = sseHeader <> "-context"
335− ssecAlgo = sseHeader <> "-customer-algorithm"
336− ssecKey = sseHeader <> "-customer-key"
337− ssecKeyMD5 = ssecKey <> "-MD5"
338− in case sseArg of
339− SSE -> [(sseHeader, "AES256")]
340− SSEKMS keyIdMay ctxMay ->
341− [(sseHeader, "aws:kms")]
342− ++ maybe [] (\k -> [(sseKmsIdHeader, k)]) keyIdMay
343− ++ maybe [] (\k -> [(sseKmsContextHeader, LB.toStrict $ A.encode k)]) ctxMay
344− SSEC (SSECKey sb) ->
345− [ (ssecAlgo, "AES256"),
346− (ssecKey, encodeToBase64 sb),
347− (ssecKeyMD5, hashMD5ToBase64 sb)
348− ]
349−
350−-- | Data type for options in PutObject call. Start with the empty
351−-- `defaultPutObjectOptions` and use various the various poo*
352−-- accessors.
353−data PutObjectOptions = PutObjectOptions
354− { -- | Set a standard MIME type describing the format of the object.
355− pooContentType :: Maybe Text,
356− -- | Set what content encodings have been applied to the object and thus
357− -- what decoding mechanisms must be applied to obtain the media-type
358− -- referenced by the Content-Type header field.
359− pooContentEncoding :: Maybe Text,
360− -- | Set presentational information for the object.
361− pooContentDisposition :: Maybe Text,
362− -- | Set to specify caching behavior for the object along the
363− -- request/reply chain.
364− pooCacheControl :: Maybe Text,
365− -- | Set to describe the language(s) intended for the audience.
366− pooContentLanguage :: Maybe Text,
367− -- | Set to @STANDARD@ or @REDUCED_REDUNDANCY@ depending on your
368− -- performance needs, storage class is @STANDARD@ by default (i.e
369− -- when Nothing is passed).
370− pooStorageClass :: Maybe Text,
371− -- | Set user defined metadata to store with the object.
372− pooUserMetadata :: [(Text, Text)],
373− -- | Set number of worker threads used to upload an object.
374− pooNumThreads :: Maybe Word,
375− -- | Set object encryption parameters for the request.
376− pooSSE :: Maybe SSE
377− }
378−
379−-- | Provide default `PutObjectOptions`.
380−defaultPutObjectOptions :: PutObjectOptions
381−defaultPutObjectOptions = PutObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing [] Nothing Nothing
382−
383−pooToHeaders :: PutObjectOptions -> [HT.Header]
384−pooToHeaders poo =
385− userMetadata
386− ++ mapMaybe tupToMaybe (zip names values)
387− ++ maybe [] toPutObjectHeaders (pooSSE poo)
388− where
389− tupToMaybe (k, Just v) = Just (k, v)
390− tupToMaybe (_, Nothing) = Nothing
391− userMetadata = mkHeaderFromMetadata $ pooUserMetadata poo
392− names =
393− [ "content-type",
394− "content-encoding",
395− "content-disposition",
396− "content-language",
397− "cache-control",
398− "x-amz-storage-class"
399− ]
400− values =
401− map
402− (fmap encodeUtf8 . (poo &))
403− [ pooContentType,
404− pooContentEncoding,
405− pooContentDisposition,
406− pooContentLanguage,
407− pooCacheControl,
408− pooStorageClass
409− ]
410−
411169-- |
412170-- BucketInfo returned for list buckets call
413−data BucketInfo = BucketInfo
414− { biName :: Bucket,
415− biCreationDate :: UTCTime
416− }
417− deriving stock (Show, Eq)
171+data BucketInfo = BucketInfo {
172+ biName :: Bucket
173+ , biCreationDate :: UTCTime
174+ } deriving (Show, Eq)
418175
419176-- | A type alias to represent a part-number for multipart upload
420177type PartNumber = Int16
421178
422−-- | Select part sizes - the logic is that the minimum part-size will
423−-- be 64MiB.
424−selectPartSizes :: Int64 -> [(PartNumber, Int64, Int64)]
425−selectPartSizes size =
426− uncurry (List.zip3 [1 ..]) $
427− List.unzip $
428− loop 0 size
429− where
430− ceil :: Double -> Int64
431− ceil = ceiling
432− partSize =
433− max
434− minPartSize
435− ( ceil $
436− fromIntegral size
437− / fromIntegral maxMultipartParts
438− )
439− m = partSize
440− loop st sz
441− | st > sz = []
442− | st + m >= sz = [(st, sz - st)]
443− | otherwise = (st, m) : loop (st + m) sz
444−
445179-- | A type alias to represent an upload-id for multipart upload
446180type UploadId = Text
447181
@@ -450,264 +184,163 @@ type PartTuple = (PartNumber, ETag)
450184
451185-- | Represents result from a listing of object parts of an ongoing
452186-- multipart upload.
453−data ListPartsResult = ListPartsResult
454− { lprHasMore :: Bool,
455− lprNextPart :: Maybe Int,
456− lprParts :: [ObjectPartInfo]
457− }
458− deriving stock (Show, Eq)
187+data ListPartsResult = ListPartsResult {
188+ lprHasMore :: Bool
189+ , lprNextPart :: Maybe Int
190+ , lprParts :: [ObjectPartInfo]
191+ } deriving (Show, Eq)
192+
459193
460194-- | Represents information about an object part in an ongoing
461195-- multipart upload.
462−data ObjectPartInfo = ObjectPartInfo
463− { opiNumber :: PartNumber,
464− opiETag :: ETag,
465− opiSize :: Int64,
466− opiModTime :: UTCTime
467− }
468− deriving stock (Show, Eq)
196+data ObjectPartInfo = ObjectPartInfo {
197+ opiNumber :: PartNumber
198+ , opiETag :: ETag
199+ , opiSize :: Int64
200+ , opiModTime :: UTCTime
201+ } deriving (Show, Eq)
469202
470203-- | Represents result from a listing of incomplete uploads to a
471204-- bucket.
472−data ListUploadsResult = ListUploadsResult
473− { lurHasMore :: Bool,
474− lurNextKey :: Maybe Text,
475− lurNextUpload :: Maybe Text,
476− lurUploads :: [(Object, UploadId, UTCTime)],
477− lurCPrefixes :: [Text]
478− }
479− deriving stock (Show, Eq)
205+data ListUploadsResult = ListUploadsResult {
206+ lurHasMore :: Bool
207+ , lurNextKey :: Maybe Text
208+ , lurNextUpload :: Maybe Text
209+ , lurUploads :: [(Object, UploadId, UTCTime)]
210+ , lurCPrefixes :: [Text]
211+ } deriving (Show, Eq)
480212
481213-- | Represents information about a multipart upload.
482−data UploadInfo = UploadInfo
483− { uiKey :: Object,
484− uiUploadId :: UploadId,
485− uiInitTime :: UTCTime,
486− uiSize :: Int64
487− }
488− deriving stock (Show, Eq)
214+data UploadInfo = UploadInfo {
215+ uiKey :: Object
216+ , uiUploadId :: UploadId
217+ , uiInitTime :: UTCTime
218+ , uiSize :: Int64
219+ } deriving (Show, Eq)
489220
490221-- | Represents result from a listing of objects in a bucket.
491−data ListObjectsResult = ListObjectsResult
492− { lorHasMore :: Bool,
493− lorNextToken :: Maybe Text,
494− lorObjects :: [ObjectInfo],
495− lorCPrefixes :: [Text]
496− }
497− deriving stock (Show, Eq)
222+data ListObjectsResult = ListObjectsResult {
223+ lorHasMore :: Bool
224+ , lorNextToken :: Maybe Text
225+ , lorObjects :: [ObjectInfo]
226+ , lorCPrefixes :: [Text]
227+ } deriving (Show, Eq)
498228
499229-- | Represents result from a listing of objects version 1 in a bucket.
500−data ListObjectsV1Result = ListObjectsV1Result
501− { lorHasMore' :: Bool,
502− lorNextMarker :: Maybe Text,
503− lorObjects' :: [ObjectInfo],
504− lorCPrefixes' :: [Text]
505− }
506− deriving stock (Show, Eq)
230+data ListObjectsV1Result = ListObjectsV1Result {
231+ lorHasMore' :: Bool
232+ , lorNextMarker :: Maybe Text
233+ , lorObjects' :: [ObjectInfo]
234+ , lorCPrefixes' :: [Text]
235+ } deriving (Show, Eq)
507236
508237-- | Represents information about an object.
509−data ObjectInfo = ObjectInfo
510− { -- | Object key
511− oiObject :: Object,
512− -- | Modification time of the object
513− oiModTime :: UTCTime,
514− -- | ETag of the object
515− oiETag :: ETag,
516− -- | Size of the object in bytes
517− oiSize :: Int64,
518− -- | A map of user-metadata
519− -- pairs stored with an
520− -- object (keys will not
521− -- have the @X-Amz-Meta-@
522− -- prefix).
523− oiUserMetadata :: H.HashMap Text Text,
524− -- | A map of metadata
525− -- key-value pairs (not
526− -- including the
527− -- user-metadata pairs)
528− oiMetadata :: H.HashMap Text Text
529− }
530− deriving stock (Show, Eq)
531−
532−-- | Represents source object in server-side copy object
533−data SourceInfo = SourceInfo
534− { -- | Bucket containing the source object
535− srcBucket :: Text,
536− -- | Source object key
537− srcObject :: Text,
538− -- | Source object
539− -- byte-range
540− -- (inclusive)
541− srcRange :: Maybe (Int64, Int64),
542− -- | ETag condition on source -
543− -- object is copied only if the
544− -- source object's ETag matches
545− -- this value.
546− srcIfMatch :: Maybe Text,
547− -- | ETag not match condition
548− -- on source - object is copied
549− -- if ETag does not match this
550− -- value.
551− srcIfNoneMatch :: Maybe Text,
552− -- | Copy source object only
553− -- if the source has been
554− -- modified since this time.
555− srcIfModifiedSince :: Maybe UTCTime,
556− -- | Copy source object only
557− -- if the source has been
558− -- un-modified since this
559− -- given time.
560− srcIfUnmodifiedSince :: Maybe UTCTime
561− }
562− deriving stock (Show, Eq)
563−
564−-- | Provide a default for `SourceInfo`
565−defaultSourceInfo :: SourceInfo
566−defaultSourceInfo = SourceInfo "" "" Nothing Nothing Nothing Nothing Nothing
567−
568−-- | Represents destination object in server-side copy object
569−data DestinationInfo = DestinationInfo
570− { -- | Destination bucket
571− dstBucket :: Text,
572− -- | Destination object key
573− dstObject :: Text
574− }
575− deriving stock (Show, Eq)
576−
577−-- | Provide a default for `DestinationInfo`
578−defaultDestinationInfo :: DestinationInfo
579−defaultDestinationInfo = DestinationInfo "" ""
580−
581−-- | Data type for options when getting an object from the
582−-- service. Start with the empty `defaultGetObjectOptions` and modify
583−-- it using the goo* functions.
584−data GetObjectOptions = GetObjectOptions
585− { -- | Set object's data of given offset begin and end,
586− -- [ByteRangeFromTo 0 9] means first ten bytes of the source object.
587− gooRange :: Maybe ByteRange,
588− -- | Set matching ETag condition, GetObject which matches the following
589− -- ETag.
590− gooIfMatch :: Maybe ETag,
591− -- | Set matching ETag none condition, GetObject which does not match
592− -- the following ETag.
593− gooIfNoneMatch :: Maybe ETag,
594− -- | Set object unmodified condition, GetObject unmodified since given time.
595− gooIfUnmodifiedSince :: Maybe UTCTime,
596− -- | Set object modified condition, GetObject modified since given time.
597− gooIfModifiedSince :: Maybe UTCTime,
598− -- | Specify SSE-C key
599− gooSSECKey :: Maybe SSECKey
600− }
601−
602−-- | Provide default `GetObjectOptions`.
603−defaultGetObjectOptions :: GetObjectOptions
604−defaultGetObjectOptions =
605− GetObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing
606−
607−gooToHeaders :: GetObjectOptions -> [HT.Header]
608−gooToHeaders goo =
609− rangeHdr
610− ++ zip names values
611− ++ maybe [] (toPutObjectHeaders . SSEC) (gooSSECKey goo)
238+data ObjectInfo = ObjectInfo {
239+ oiObject :: Object
240+ , oiModTime :: UTCTime
241+ , oiETag :: ETag
242+ , oiSize :: Int64
243+ } deriving (Show, Eq)
244+
245+data CopyPartSource = CopyPartSource {
246+ -- | formatted like "\/sourceBucket\/sourceObject"
247+ cpSource :: Text
248+ -- | (0, 9) means first ten bytes of the source object
249+ , cpSourceRange :: Maybe (Int64, Int64)
250+ , cpSourceIfMatch :: Maybe Text
251+ , cpSourceIfNoneMatch :: Maybe Text
252+ , cpSourceIfUnmodifiedSince :: Maybe UTCTime
253+ , cpSourceIfModifiedSince :: Maybe UTCTime
254+ } deriving (Show, Eq)
255+
256+instance Default CopyPartSource where
257+ def = CopyPartSource "" def def def def def
258+
259+cpsToHeaders :: CopyPartSource -> [HT.Header]
260+cpsToHeaders cps = ("x-amz-copy-source", encodeUtf8 $ cpSource cps) :
261+ rangeHdr ++ zip names values
612262 where
613− names =
614− [ "If-Match",
615− "If-None-Match",
616− "If-Unmodified-Since",
617− "If-Modified-Since"
618− ]
619− values =
620− mapMaybe
621− (fmap encodeUtf8 . (goo &))
622− [ gooIfMatch,
623− gooIfNoneMatch,
624− fmap formatRFC1123 . gooIfUnmodifiedSince,
625− fmap formatRFC1123 . gooIfModifiedSince
626− ]
627− rangeHdr =
628− maybe [] (\a -> [(hRange, HT.renderByteRanges [a])]) $
629− gooRange goo
630−
631−-- | Data type returned by 'getObject' representing the object being
632−-- retrieved. Use the @gor*@ functions to access its contents.
633−data GetObjectResponse = GetObjectResponse
634− { -- | ObjectInfo of the object being retrieved.
635− gorObjectInfo :: ObjectInfo,
636− -- | A conduit of the bytes of the object.
637− gorObjectStream :: C.ConduitM () ByteString Minio ()
638− }
263+ names = ["x-amz-copy-source-if-match", "x-amz-copy-source-if-none-match",
264+ "x-amz-copy-source-if-unmodified-since",
265+ "x-amz-copy-source-if-modified-since"]
266+ values = mapMaybe (fmap encodeUtf8 . (cps &))
267+ [cpSourceIfMatch, cpSourceIfNoneMatch,
268+ fmap formatRFC1123 . cpSourceIfUnmodifiedSince,
269+ fmap formatRFC1123 . cpSourceIfModifiedSince]
270+ rangeHdr = ("x-amz-copy-source-range",)
271+ . HT.renderByteRanges
272+ . (:[])
273+ . uncurry HT.ByteRangeFromTo
274+ <$> map (both fromIntegral) (maybeToList $ cpSourceRange cps)
275+
276+-- | Extract the source bucket and source object name. TODO: validate
277+-- the bucket and object name extracted.
278+cpsToObject :: CopyPartSource -> Maybe (Bucket, Object)
279+cpsToObject cps = do
280+ [_, bucket, object] <- Just splits
281+ return (bucket, object)
282+ where
283+ splits = T.splitOn "/" $ cpSource cps
639284
640285-- | A data-type for events that can occur in the object storage
641286-- server. Reference:
642287-- https://docs.aws.amazon.com/AmazonS3/latest/dev/NotificationHowTo.html#supported-notification-event-types
643−data Event
644− = ObjectCreated
645− | ObjectCreatedPut
646− | ObjectCreatedPost
647− | ObjectCreatedCopy
648− | ObjectCreatedMultipartUpload
649− | ObjectRemoved
650− | ObjectRemovedDelete
651− | ObjectRemovedDeleteMarkerCreated
652− | ReducedRedundancyLostObject
653− deriving stock (Eq, Show)
654−
655−instance ToText Event where
656− toText ObjectCreated = "s3:ObjectCreated:*"
657− toText ObjectCreatedPut = "s3:ObjectCreated:Put"
658− toText ObjectCreatedPost = "s3:ObjectCreated:Post"
659− toText ObjectCreatedCopy = "s3:ObjectCreated:Copy"
660− toText ObjectCreatedMultipartUpload = "s3:ObjectCreated:MultipartUpload"
661− toText ObjectRemoved = "s3:ObjectRemoved:*"
662− toText ObjectRemovedDelete = "s3:ObjectRemoved:Delete"
663− toText ObjectRemovedDeleteMarkerCreated = "s3:ObjectRemoved:DeleteMarkerCreated"
664− toText ReducedRedundancyLostObject = "s3:ReducedRedundancyLostObject"
288+data Event = ObjectCreated
289+ | ObjectCreatedPut
290+ | ObjectCreatedPost
291+ | ObjectCreatedCopy
292+ | ObjectCreatedMultipartUpload
293+ | ObjectRemoved
294+ | ObjectRemovedDelete
295+ | ObjectRemovedDeleteMarkerCreated
296+ | ReducedRedundancyLostObject
297+ deriving (Eq)
298+
299+instance Show Event where
300+ show ObjectCreated = "s3:ObjectCreated:*"
301+ show ObjectCreatedPut = "s3:ObjectCreated:Put"
302+ show ObjectCreatedPost = "s3:ObjectCreated:Post"
303+ show ObjectCreatedCopy = "s3:ObjectCreated:Copy"
304+ show ObjectCreatedMultipartUpload = "s3:ObjectCreated:MultipartUpload"
305+ show ObjectRemoved = "s3:ObjectRemoved:*"
306+ show ObjectRemovedDelete = "s3:ObjectRemoved:Delete"
307+ show ObjectRemovedDeleteMarkerCreated = "s3:ObjectRemoved:DeleteMarkerCreated"
308+ show ReducedRedundancyLostObject = "s3:ReducedRedundancyLostObject"
665309
666310textToEvent :: Text -> Maybe Event
667311textToEvent t = case t of
668− "s3:ObjectCreated:*" -> Just ObjectCreated
669− "s3:ObjectCreated:Put" -> Just ObjectCreatedPut
670− "s3:ObjectCreated:Post" -> Just ObjectCreatedPost
671− "s3:ObjectCreated:Copy" -> Just ObjectCreatedCopy
672− "s3:ObjectCreated:MultipartUpload" -> Just ObjectCreatedMultipartUpload
673− "s3:ObjectRemoved:*" -> Just ObjectRemoved
674− "s3:ObjectRemoved:Delete" -> Just ObjectRemovedDelete
312+ "s3:ObjectCreated:*" -> Just ObjectCreated
313+ "s3:ObjectCreated:Put" -> Just ObjectCreatedPut
314+ "s3:ObjectCreated:Post" -> Just ObjectCreatedPost
315+ "s3:ObjectCreated:Copy" -> Just ObjectCreatedCopy
316+ "s3:ObjectCreated:MultipartUpload" -> Just ObjectCreatedMultipartUpload
317+ "s3:ObjectRemoved:*" -> Just ObjectRemoved
318+ "s3:ObjectRemoved:Delete" -> Just ObjectRemovedDelete
675319 "s3:ObjectRemoved:DeleteMarkerCreated" -> Just ObjectRemovedDeleteMarkerCreated
676− "s3:ReducedRedundancyLostObject" -> Just ReducedRedundancyLostObject
677− _ -> Nothing
320+ "s3:ReducedRedundancyLostObject" -> Just ReducedRedundancyLostObject
321+ _ -> Nothing
322+
678323
679−-- | Filter data type - part of notification configuration
680−newtype Filter = Filter
324+data Filter = Filter
681325 { fFilter :: FilterKey
682− }
683− deriving stock (Show, Eq)
326+ } deriving (Show, Eq)
684327
685−-- | defaultFilter is empty, used to create a notification
686−-- configuration.
687−defaultFilter :: Filter
688−defaultFilter = Filter defaultFilterKey
328+instance Default Filter where
329+ def = Filter def
689330
690−-- | FilterKey contains FilterRules, and is part of a Filter.
691−newtype FilterKey = FilterKey
331+data FilterKey = FilterKey
692332 { fkKey :: FilterRules
693− }
694− deriving stock (Show, Eq)
333+ } deriving (Show, Eq)
695334
696−-- | defaultFilterKey is empty, used to create notification
697−-- configuration.
698−defaultFilterKey :: FilterKey
699−defaultFilterKey = FilterKey defaultFilterRules
335+instance Default FilterKey where
336+ def = FilterKey def
700337
701−-- | FilterRules represents a collection of `FilterRule`s.
702−newtype FilterRules = FilterRules
338+data FilterRules = FilterRules
703339 { frFilterRules :: [FilterRule]
704− }
705− deriving stock (Show, Eq)
340+ } deriving (Show, Eq)
706341
707−-- | defaultFilterRules is empty, used to create notification
708−-- configuration.
709−defaultFilterRules :: FilterRules
710−defaultFilterRules = FilterRules []
342+instance Default FilterRules where
343+ def = FilterRules []
711344
712345-- | A filter rule that can act based on the suffix or prefix of an
713346-- object. As an example, let's create two filter rules:
@@ -715,28 +348,25 @@ defaultFilterRules = FilterRules []
715348-- > let suffixRule = FilterRule "suffix" ".jpg"
716349-- > let prefixRule = FilterRule "prefix" "images/"
717350--
718−-- The @suffixRule@ restricts the notification to be triggered only
719−-- for objects having a suffix of ".jpg", and the @prefixRule@
351+-- The `suffixRule` restricts the notification to be triggered only
352+-- for objects having a suffix of ".jpg", and the `prefixRule`
720353-- restricts it to objects having a prefix of "images/".
721354data FilterRule = FilterRule
722− { frName :: Text,
723− frValue :: Text
724− }
725− deriving stock (Show, Eq)
355+ { frName :: Text
356+ , frValue :: Text
357+ } deriving (Show, Eq)
726358
727−-- | Arn is an alias of Text
728359type Arn = Text
729360
730361-- | A data-type representing the configuration for a particular
731362-- notification system. It could represent a Queue, Topic or Lambda
732363-- Function configuration.
733364data NotificationConfig = NotificationConfig
734− { ncId :: Text,
735− ncArn :: Arn,
736− ncEvents :: [Event],
737− ncFilter :: Filter
738− }
739− deriving stock (Show, Eq)
365+ { ncId :: Text
366+ , ncArn :: Arn
367+ , ncEvents :: [Event]
368+ , ncFilter :: Filter
369+ } deriving (Show, Eq)
740370
741371-- | A data-type to represent bucket notification configuration. It is
742372-- a collection of queue, topic or lambda function configurations. The
@@ -744,448 +374,110 @@ data NotificationConfig = NotificationConfig
744374-- described at
745375-- <https://docs.aws.amazon.com/AmazonS3/latest/API/RESTBucketPUTnotification.html>
746376data Notification = Notification
747− { nQueueConfigurations :: [NotificationConfig],
748− nTopicConfigurations :: [NotificationConfig],
749− nCloudFunctionConfigurations :: [NotificationConfig]
750− }
751− deriving stock (Show, Eq)
752−
753−-- | The default notification configuration is empty.
754−defaultNotification :: Notification
755−defaultNotification = Notification [] [] []
756−
757−--------------------------------------------------------------------------
758−-- Select API Related Types
759−--------------------------------------------------------------------------
760−
761−-- | SelectRequest represents the Select API call. Use the
762−-- `selectRequest` function to create a value of this type.
763−data SelectRequest = SelectRequest
764− { srExpression :: Text,
765− srExpressionType :: ExpressionType,
766− srInputSerialization :: InputSerialization,
767− srOutputSerialization :: OutputSerialization,
768− srRequestProgressEnabled :: Maybe Bool
769− }
770− deriving stock (Show, Eq)
771−
772−data ExpressionType = SQL
773− deriving stock (Show, Eq)
774−
775−-- | InputSerialization represents format information of the input
776−-- object being queried. Use one of the smart constructors such as
777−-- `defaultCsvInput` as a starting value, and add compression info
778−-- using `setInputCompressionType`
779−data InputSerialization = InputSerialization
780− { isCompressionType :: Maybe CompressionType,
781− isFormatInfo :: InputFormatInfo
782− }
783− deriving stock (Show, Eq)
784−
785−-- | Data type representing the compression setting in a Select
786−-- request.
787−data CompressionType
788− = CompressionTypeNone
789− | CompressionTypeGzip
790− | CompressionTypeBzip2
791− deriving stock (Show, Eq)
792−
793−-- | Data type representing input object format information in a
794−-- Select request.
795−data InputFormatInfo
796− = InputFormatCSV CSVInputProp
797− | InputFormatJSON JSONInputProp
798− | InputFormatParquet
799− deriving stock (Show, Eq)
800−
801−-- | defaultCsvInput returns InputSerialization with default CSV
802−-- format, and without any compression setting.
803−defaultCsvInput :: InputSerialization
804−defaultCsvInput = InputSerialization Nothing (InputFormatCSV defaultCSVProp)
805−
806−-- | linesJsonInput returns InputSerialization with JSON line based
807−-- format with no compression setting.
808−linesJsonInput :: InputSerialization
809−linesJsonInput =
810− InputSerialization
811− Nothing
812− (InputFormatJSON $ JSONInputProp JSONTypeLines)
813−
814−-- | documentJsonInput returns InputSerialization with JSON document
815−-- based format with no compression setting.
816−documentJsonInput :: InputSerialization
817−documentJsonInput =
818− InputSerialization
819− Nothing
820− (InputFormatJSON $ JSONInputProp JSONTypeDocument)
821−
822−-- | defaultParquetInput returns InputSerialization with Parquet
823−-- format, and no compression setting.
824−defaultParquetInput :: InputSerialization
825−defaultParquetInput = InputSerialization Nothing InputFormatParquet
826−
827−-- | setInputCompressionType sets the compression type for the input
828−-- of the SelectRequest
829−setInputCompressionType ::
830− CompressionType ->
831− SelectRequest ->
832− SelectRequest
833−setInputCompressionType c i =
834− let is = srInputSerialization i
835− is' = is {isCompressionType = Just c}
836− in i {srInputSerialization = is'}
837−
838−-- | defaultCsvOutput returns OutputSerialization with default CSV
839−-- format.
840−defaultCsvOutput :: OutputSerialization
841−defaultCsvOutput = OutputSerializationCSV defaultCSVProp
842−
843−-- | defaultJsonInput returns OutputSerialization with default JSON
844−-- format.
845−defaultJsonOutput :: OutputSerialization
846−defaultJsonOutput = OutputSerializationJSON (JSONOutputProp Nothing)
847−
848−-- | selectRequest is used to build a `SelectRequest`
849−-- value. @selectRequest query inputSer outputSer@ represents a
850−-- SelectRequest with the SQL query text given by @query@, the input
851−-- serialization settings (compression format and format information)
852−-- @inputSer@ and the output serialization settings @outputSer@.
853−selectRequest ::
854− Text ->
855− InputSerialization ->
856− OutputSerialization ->
857− SelectRequest
858−selectRequest sqlQuery inputSer outputSer =
859− SelectRequest
860− { srExpression = sqlQuery,
861− srExpressionType = SQL,
862− srInputSerialization = inputSer,
863− srOutputSerialization = outputSer,
864− srRequestProgressEnabled = Nothing
865− }
866−
867−-- | setRequestProgressEnabled sets the flag for turning on progress
868−-- messages when the Select response is being streamed back to the
869−-- client.
870−setRequestProgressEnabled :: Bool -> SelectRequest -> SelectRequest
871−setRequestProgressEnabled enabled sr =
872− sr {srRequestProgressEnabled = Just enabled}
873−
874−type CSVInputProp = CSVProp
875−
876−-- | CSVProp represents CSV format properties. It is built up using
877−-- the Monoid instance.
878−newtype CSVProp = CSVProp (H.HashMap Text Text)
879− deriving stock (Show, Eq)
880−
881−instance Semigroup CSVProp where
882− (CSVProp a) <> (CSVProp b) = CSVProp (b <> a)
883−
884−instance Monoid CSVProp where
885− mempty = CSVProp mempty
886−
887−csvPropsList :: CSVProp -> [(Text, Text)]
888−csvPropsList (CSVProp h) = sort $ H.toList h
889−
890−defaultCSVProp :: CSVProp
891−defaultCSVProp = mempty
892−
893−-- | Specify the CSV record delimiter property.
894−recordDelimiter :: Text -> CSVProp
895−recordDelimiter = CSVProp . H.singleton "RecordDelimiter"
896−
897−-- | Specify the CSV field delimiter property.
898−fieldDelimiter :: Text -> CSVProp
899−fieldDelimiter = CSVProp . H.singleton "FieldDelimiter"
900−
901−-- | Specify the CSV quote character property.
902−quoteCharacter :: Text -> CSVProp
903−quoteCharacter = CSVProp . H.singleton "QuoteCharacter"
904−
905−-- | Specify the CSV quote-escape character property.
906−quoteEscapeCharacter :: Text -> CSVProp
907−quoteEscapeCharacter = CSVProp . H.singleton "QuoteEscapeCharacter"
908−
909−-- | FileHeaderInfo specifies information about column headers for CSV
910−-- format.
911−data FileHeaderInfo
912− = -- | No column headers are present
913− FileHeaderNone
914− | -- | Headers are present and they should be used
915− FileHeaderUse
916− | -- | Header are present, but should be ignored
917− FileHeaderIgnore
918− deriving stock (Show, Eq)
919−
920−-- | Specify the CSV file header info property.
921−fileHeaderInfo :: FileHeaderInfo -> CSVProp
922−fileHeaderInfo = CSVProp . H.singleton "FileHeaderInfo" . toStr
923− where
924− toStr FileHeaderNone = "NONE"
925− toStr FileHeaderUse = "USE"
926− toStr FileHeaderIgnore = "IGNORE"
927−
928−-- | Specify the CSV comment character property. Lines starting with
929−-- this character are ignored by the server.
930−commentCharacter :: Text -> CSVProp
931−commentCharacter = CSVProp . H.singleton "Comments"
377+ { nQueueConfigurations :: [NotificationConfig]
378+ , nTopicConfigurations :: [NotificationConfig]
379+ , nCloudFunctionConfigurations :: [NotificationConfig]
380+ } deriving (Eq, Show)
932381
933−-- | Allow quoted record delimiters inside a row using this property.
934−allowQuotedRecordDelimiter :: CSVProp
935−allowQuotedRecordDelimiter = CSVProp $ H.singleton "AllowQuotedRecordDelimiter" "TRUE"
936−
937−-- | Set the CSV format properties in the InputSerialization.
938−setInputCSVProps :: CSVProp -> InputSerialization -> InputSerialization
939−setInputCSVProps p is = is {isFormatInfo = InputFormatCSV p}
940−
941−-- | Set the CSV format properties in the OutputSerialization.
942−outputCSVFromProps :: CSVProp -> OutputSerialization
943−outputCSVFromProps = OutputSerializationCSV
944−
945−newtype JSONInputProp = JSONInputProp {jsonipType :: JSONType}
946− deriving stock (Show, Eq)
947−
948−data JSONType = JSONTypeDocument | JSONTypeLines
949− deriving stock (Show, Eq)
950−
951−-- | OutputSerialization represents output serialization settings for
952−-- the SelectRequest. Use `defaultCsvOutput` or `defaultJsonOutput` as
953−-- a starting point.
954−data OutputSerialization
955− = OutputSerializationJSON JSONOutputProp
956− | OutputSerializationCSV CSVOutputProp
957− deriving stock (Show, Eq)
958−
959−type CSVOutputProp = CSVProp
960−
961−-- | quoteFields is an output serialization parameter
962−quoteFields :: QuoteFields -> CSVProp
963−quoteFields q = CSVProp $
964− H.singleton "QuoteFields" $
965− case q of
966− QuoteFieldsAsNeeded -> "ASNEEDED"
967− QuoteFieldsAlways -> "ALWAYS"
968−
969−-- | Represent the QuoteField setting.
970−data QuoteFields = QuoteFieldsAsNeeded | QuoteFieldsAlways
971− deriving stock (Show, Eq)
972−
973−newtype JSONOutputProp = JSONOutputProp {jsonopRecordDelimiter :: Maybe Text}
974− deriving stock (Show, Eq)
975−
976−-- | Set the output record delimiter for JSON format
977−outputJSONFromRecordDelimiter :: Text -> OutputSerialization
978−outputJSONFromRecordDelimiter t =
979− OutputSerializationJSON (JSONOutputProp $ Just t)
980−
981−-- Response related types
982−
983−-- | An EventMessage represents each kind of message received from the server.
984−data EventMessage
985− = ProgressEventMessage Progress
986− | StatsEventMessage Stats
987− | RequestLevelErrorMessage
988− Text
989− -- ^ Error code
990− Text
991− -- ^ Error message
992− | RecordPayloadEventMessage ByteString
993− deriving stock (Show, Eq)
994−
995−data MsgHeaderName
996− = MessageType
997− | EventType
998− | ContentType
999− | ErrorCode
1000− | ErrorMessage
1001− deriving stock (Show, Eq)
1002−
1003−msgHeaderValueType :: Word8
1004−msgHeaderValueType = 7
1005−
1006−type MessageHeader = (MsgHeaderName, Text)
1007−
1008−-- | Represent the progress event returned in the Select response.
1009−data Progress = Progress
1010− { pBytesScanned :: Int64,
1011− pBytesProcessed :: Int64,
1012− pBytesReturned :: Int64
1013− }
1014− deriving stock (Show, Eq)
1015−
1016−-- | Represent the stats event returned at the end of the Select
1017−-- response.
1018−type Stats = Progress
1019−
1020−--------------------------------------------------------------------------
1021−-- Select API Related Types End
1022−--------------------------------------------------------------------------
382+instance Default Notification where
383+ def = Notification [] [] []
1023384
1024385-- | Represents different kinds of payload that are used with S3 API
1025386-- requests.
1026−data Payload
1027− = PayloadBS ByteString
1028− | PayloadH Handle Int64 Int64 -- file handle, offset and length
1029− | PayloadC Int64 (C.ConduitT () ByteString (ResourceT IO) ()) -- length and byte source
1030−
1031−defaultPayload :: Payload
1032−defaultPayload = PayloadBS ""
1033−
1034−data AdminReqInfo = AdminReqInfo
1035− { ariMethod :: Method,
1036− ariPayloadHash :: Maybe ByteString,
1037− ariPayload :: Payload,
1038− ariPath :: ByteString,
1039− ariHeaders :: [Header],
1040− ariQueryParams :: Query
387+data Payload = PayloadBS ByteString
388+ | PayloadH Handle
389+ Int64 -- offset
390+ Int64 -- size
391+
392+instance Default Payload where
393+ def = PayloadBS ""
394+
395+data RequestInfo = RequestInfo {
396+ riMethod :: Method
397+ , riBucket :: Maybe Bucket
398+ , riObject :: Maybe Object
399+ , riQueryParams :: Query
400+ , riHeaders :: [Header]
401+ , riPayload :: Payload
402+ , riPayloadHash :: Maybe ByteString
403+ , riRegion :: Maybe Region
404+ , riNeedsLocation :: Bool
1041405 }
1042406
1043−data S3ReqInfo = S3ReqInfo
1044− { riMethod :: Method,
1045− riBucket :: Maybe Bucket,
1046− riObject :: Maybe Object,
1047− riQueryParams :: Query,
1048− riHeaders :: [Header],
1049− riPayload :: Payload,
1050− riPayloadHash :: Maybe ByteString,
1051− riRegion :: Maybe Region,
1052− riNeedsLocation :: Bool,
1053− riPresignExpirySecs :: Maybe UrlExpiry
1054− }
407+instance Default RequestInfo where
408+ def = RequestInfo HT.methodGet def def def def def Nothing def True
1055409
1056−defaultS3ReqInfo :: S3ReqInfo
1057−defaultS3ReqInfo =
1058− S3ReqInfo
1059− HT.methodGet
1060− Nothing
1061− Nothing
1062− []
1063− []
1064− defaultPayload
1065− Nothing
1066− Nothing
1067− True
1068− Nothing
410+getPathFromRI :: RequestInfo -> ByteString
411+getPathFromRI ri =
412+ let
413+ b = riBucket ri
414+ o = riObject ri
415+ segments = map toS $ catMaybes $ b : bool [] [o] (isJust b)
416+ in
417+ B.concat ["/", B.intercalate "/" segments]
1069418
1070−getS3Path :: Maybe Bucket -> Maybe Object -> ByteString
1071−getS3Path b o =
1072− let segments = map encodeUtf8 $ catMaybes $ b : bool [] [o] (isJust b)
1073− in B.concat ["/", B.intercalate "/" segments]
419+-- | Time to expire for a presigned URL. It interpreted as a number of
420+-- seconds. The maximum duration that can be specified is 7 days.
421+type UrlExpiry = Int
1074422
1075−type RegionMap = H.HashMap Bucket Region
423+type RegionMap = Map.Map Bucket Region
1076424
1077−-- | The Minio Monad - all computations accessing object storage
1078−-- happens in it.
1079−newtype Minio a = Minio
1080− { unMinio :: ReaderT MinioConn (ResourceT IO) a
425+newtype Minio a = Minio {
426+ unMinio :: ReaderT MinioConn (StateT RegionMap (ResourceT IO)) a
1081427 }
1082− deriving newtype
1083− ( Functor,
1084− Applicative,
1085− Monad,
1086− MonadIO,
1087− MonadReader MinioConn,
1088− MonadResource,
1089− MonadUnliftIO
428+ deriving (
429+ Functor
430+ , Applicative
431+ , Monad
432+ , MonadIO
433+ , MonadReader MinioConn
434+ , MonadState RegionMap
435+ , MonadThrow
436+ , MonadCatch
437+ , MonadBase IO
438+ , MonadResource
1090439 )
1091440
1092−-- | MinioConn holds connection info and a connection pool to allow
1093−-- for efficient resource re-use.
1094−data MinioConn = MinioConn
1095− { mcConnInfo :: ConnectInfo,
1096− mcConnManager :: NC.Manager,
1097− mcRegionMap :: MVar RegionMap
1098− }
1099−
1100−class HasSvcNamespace env where
1101− getSvcNamespace :: env -> Text
441+instance MonadBaseControl IO Minio where
442+ type StM Minio a = (a, RegionMap)
443+ liftBaseWith f = Minio $ liftBaseWith $ \q -> f (q . unMinio)
444+ restoreM = Minio . restoreM
1102445
1103−instance HasSvcNamespace MinioConn where
1104− getSvcNamespace env =
1105− let host = connectHost $ mcConnInfo env
1106− in ( if host == "storage.googleapis.com"
1107− then "http://doc.s3.amazonaws.com/2006-03-01"
1108− else "http://s3.amazonaws.com/doc/2006-03-01/"
1109− )
446+-- | MinioConn holds connection info and a connection pool
447+data MinioConn = MinioConn {
448+ mcConnInfo :: ConnectInfo
449+ , mcConnManager :: NC.Manager
450+ }
1110451
1111452-- | Takes connection information and returns a connection object to
1112−-- be passed to 'runMinio'. The returned value can be kept in the
1113−-- application environment and passed to `runMinioWith` whenever
1114−-- object storage is accessed.
453+-- be passed to 'runMinio'
1115454connect :: ConnectInfo -> IO MinioConn
1116455connect ci = do
1117− let settings
1118− | connectIsSecure ci && connectDisableTLSCertValidation ci =
1119− let badTlsSettings =
1120− case def of
1121− tlsSettings@Conn.TLSSettingsSimple {} ->
1122− tlsSettings {Conn.settingDisableCertificateValidation = True}
1123− _ -> def
1124− in TLS.mkManagerSettings badTlsSettings Nothing
1125− | connectIsSecure ci = NC.tlsManagerSettings
1126− | otherwise = defaultManagerSettings
456+ let settings = bool defaultManagerSettings NC.tlsManagerSettings $
457+ connectIsSecure ci
1127458 mgr <- NC.newManager settings
1128− mkMinioConn ci mgr
1129−
1130−-- | Run the computation accessing object storage using the given
1131−-- `MinioConn`. This reuses connections, but otherwise it is similar
1132−-- to `runMinio`.
1133−runMinioWith :: MinioConn -> Minio a -> IO (Either MinioErr a)
1134−runMinioWith conn m = runResourceT $ runMinioResWith conn m
1135−
1136−-- | Given `ConnectInfo` and a HTTP connection manager, create a
1137−-- `MinioConn`.
1138−mkMinioConn :: ConnectInfo -> NC.Manager -> IO MinioConn
1139−mkMinioConn ci mgr = do
1140− rMapMVar <- M.newMVar H.empty
1141− return $ MinioConn ci mgr rMapMVar
459+ return $ MinioConn ci mgr
1142460
1143461-- | Run the Minio action and return the result or an error.
1144462runMinio :: ConnectInfo -> Minio a -> IO (Either MinioErr a)
1145463runMinio ci m = do
1146− conn <- connect ci
1147− runResourceT $ runMinioResWith conn m
1148−
1149−-- | Similar to 'runMinioWith'. Allows applications to allocate/release
1150−-- its resources along side MinIO's internal resources.
1151−runMinioResWith :: MinioConn -> Minio a -> ResourceT IO (Either MinioErr a)
1152−runMinioResWith conn m =
1153− flip runReaderT conn . unMinio $
1154− fmap Right m
1155− `U.catches` [ U.Handler handlerServiceErr,
1156− U.Handler handlerHE,
1157− U.Handler handlerFE,
1158− U.Handler handlerValidation
1159− ]
464+ conn <- liftIO $ connect ci
465+ runResourceT . flip evalStateT Map.empty . flip runReaderT conn . unMinio $
466+ fmap Right m `MC.catches`
467+ [ MC.Handler handlerServiceErr
468+ , MC.Handler handlerHE
469+ , MC.Handler handlerFE
470+ , MC.Handler handlerValidation
471+ ]
1160472 where
1161473 handlerServiceErr = return . Left . MErrService
1162474 handlerHE = return . Left . MErrHTTP
1163475 handlerFE = return . Left . MErrIO
1164476 handlerValidation = return . Left . MErrValidation
1165477
1166−-- | Similar to 'runMinio'. Allows applications to allocate/release
1167−-- its resources along side MinIO's internal resources.
1168−runMinioRes :: ConnectInfo -> Minio a -> ResourceT IO (Either MinioErr a)
1169−runMinioRes ci m = do
1170− conn <- liftIO $ connect ci
1171− runMinioResWith conn m
478+s3Name :: Text -> Name
479+s3Name s = Name s (Just "http://s3.amazonaws.com/doc/2006-03-01/") Nothing
1172480
1173481-- | Format as per RFC 1123.
1174482formatRFC1123 :: UTCTime -> T.Text
1175483formatRFC1123 = T.pack . formatTime defaultTimeLocale "%a, %d %b %Y %X %Z"
1176−
1177−lookupRegionCache :: Bucket -> Minio (Maybe Region)
1178−lookupRegionCache b = do
1179− rMVar <- asks mcRegionMap
1180− rMap <- UM.readMVar rMVar
1181− return $ H.lookup b rMap
1182−
1183−addToRegionCache :: Bucket -> Region -> Minio ()
1184−addToRegionCache b region = do
1185− rMVar <- asks mcRegionMap
1186− UM.modifyMVar_ rMVar $ return . H.insert b region
1187−
1188−deleteFromRegionCache :: Bucket -> Minio ()
1189−deleteFromRegionCache b = do
1190− rMVar <- asks mcRegionMap
1191− UM.modifyMVar_ rMVar $ return . H.delete b