Improve initializing ConnectInfo (#101)
- Remove ConnectInfo's Default instance - Add support for reading from well-known credential files and environment variables
This commit is contained in:
Krishnan Parthasarathi
Aditya Manthramurthy
parent
8273910084
commit
44bbd66719
@ -57,11 +57,12 @@ library
|
||||
, containers >= 0.5
|
||||
, cryptonite >= 0.25
|
||||
, cryptonite-conduit >= 0.2
|
||||
, data-default >= 0.7
|
||||
, directory
|
||||
, filepath >= 1.4
|
||||
, http-client >= 0.5
|
||||
, http-conduit >= 2.3
|
||||
, http-types >= 0.12
|
||||
, ini
|
||||
, memory >= 0.14
|
||||
, resourcet >= 1.2
|
||||
, text >= 1.2
|
||||
@ -142,12 +143,12 @@ test-suite minio-hs-live-server-test
|
||||
, containers
|
||||
, cryptonite
|
||||
, cryptonite-conduit
|
||||
, data-default
|
||||
, directory
|
||||
, filepath
|
||||
, http-client
|
||||
, http-conduit
|
||||
, http-types
|
||||
, ini
|
||||
, memory
|
||||
, QuickCheck
|
||||
, resourcet
|
||||
@ -181,11 +182,12 @@ test-suite minio-hs-test
|
||||
, containers
|
||||
, cryptonite
|
||||
, cryptonite-conduit
|
||||
, data-default
|
||||
, filepath
|
||||
, directory
|
||||
, http-client
|
||||
, http-conduit
|
||||
, http-types
|
||||
, ini
|
||||
, memory
|
||||
, QuickCheck
|
||||
, resourcet
|
||||
|
||||
@ -18,18 +18,27 @@
|
||||
|
||||
module Network.Minio
|
||||
(
|
||||
-- * Credentials
|
||||
Credentials (..)
|
||||
, fromAWSConfigFile
|
||||
, fromAWSEnv
|
||||
, fromMinioEnv
|
||||
|
||||
-- * Connecting to object storage
|
||||
---------------------------------
|
||||
ConnectInfo(..)
|
||||
, awsCI
|
||||
, gcsCI
|
||||
, ConnectInfo
|
||||
, setRegion
|
||||
, setCreds
|
||||
, setCredsFrom
|
||||
, MinioConn
|
||||
, mkMinioConn
|
||||
|
||||
-- ** Connection helpers
|
||||
------------------------
|
||||
, awsWithRegionCI
|
||||
, minioPlayCI
|
||||
, minioCI
|
||||
, awsCI
|
||||
, gcsCI
|
||||
|
||||
|
||||
-- * Minio Monad
|
||||
----------------
|
||||
@ -39,8 +48,9 @@ module Network.Minio
|
||||
-- this Monad.
|
||||
|
||||
, Minio
|
||||
, runMinioWith
|
||||
, runMinio
|
||||
, def
|
||||
|
||||
|
||||
-- * Bucket Operations
|
||||
----------------------
|
||||
@ -76,12 +86,16 @@ module Network.Minio
|
||||
|
||||
-- ** Bucket Notifications
|
||||
, Notification(..)
|
||||
, defaultNotification
|
||||
, NotificationConfig(..)
|
||||
, Arn
|
||||
, Event(..)
|
||||
, Filter(..)
|
||||
, defaultFilter
|
||||
, FilterKey(..)
|
||||
, defaultFilterKey
|
||||
, FilterRules(..)
|
||||
, defaultFilterRules
|
||||
, FilterRule(..)
|
||||
, getBucketNotification
|
||||
, putBucketNotification
|
||||
@ -99,6 +113,7 @@ module Network.Minio
|
||||
, putObject
|
||||
-- | Input data type represents PutObject options.
|
||||
, PutObjectOptions
|
||||
, defaultPutObjectOptions
|
||||
, pooContentType
|
||||
, pooContentEncoding
|
||||
, pooContentDisposition
|
||||
@ -111,6 +126,7 @@ module Network.Minio
|
||||
, getObject
|
||||
-- | Input data type represents GetObject options.
|
||||
, GetObjectOptions
|
||||
, defaultGetObjectOptions
|
||||
, gooRange
|
||||
, gooIfMatch
|
||||
, gooIfNoneMatch
|
||||
@ -120,6 +136,7 @@ module Network.Minio
|
||||
-- ** Server-side copying
|
||||
, copyObject
|
||||
, SourceInfo
|
||||
, defaultSourceInfo
|
||||
, srcBucket
|
||||
, srcObject
|
||||
, srcRange
|
||||
@ -128,6 +145,7 @@ module Network.Minio
|
||||
, srcIfModifiedSince
|
||||
, srcIfUnmodifiedSince
|
||||
, DestinationInfo
|
||||
, defaultDestinationInfo
|
||||
, dstBucket
|
||||
, dstObject
|
||||
|
||||
@ -178,7 +196,6 @@ This module exports the high-level Minio API for object storage.
|
||||
import qualified Data.Conduit as C
|
||||
import qualified Data.Conduit.Binary as CB
|
||||
import qualified Data.Conduit.Combinators as CC
|
||||
import Data.Default (def)
|
||||
|
||||
import Lib.Prelude
|
||||
|
||||
|
||||
@ -31,7 +31,6 @@ module Network.Minio.API
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.Char as C
|
||||
import qualified Data.Conduit as C
|
||||
import Data.Default (def)
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Time.Clock as Time
|
||||
@ -53,7 +52,7 @@ import Network.Minio.XmlParser
|
||||
-- | Fetch bucket location (region)
|
||||
getLocation :: Bucket -> Minio Region
|
||||
getLocation bucket = do
|
||||
resp <- executeRequest $ def {
|
||||
resp <- executeRequest $ defaultS3ReqInfo {
|
||||
riBucket = Just bucket
|
||||
, riQueryParams = [("location", Nothing)]
|
||||
, riNeedsLocation = False
|
||||
|
||||
@ -16,7 +16,6 @@
|
||||
|
||||
module Network.Minio.CopyObject where
|
||||
|
||||
import Data.Default (def)
|
||||
import qualified Data.List as List
|
||||
|
||||
import Lib.Prelude
|
||||
@ -81,7 +80,7 @@ multiPartCopyObject b o cps srcSize = do
|
||||
partRanges = selectCopyRanges byteRange
|
||||
partSources = map (\(x, (start, end)) -> (x, cps {srcRange = Just (start, end) }))
|
||||
partRanges
|
||||
dstInfo = def { dstBucket = b, dstObject = o}
|
||||
dstInfo = defaultDestinationInfo { dstBucket = b, dstObject = o}
|
||||
|
||||
copiedParts <- limitedMapConcurrently 10
|
||||
(\(pn, cps') -> do
|
||||
|
||||
@ -25,9 +25,11 @@ import Control.Monad.IO.Unlift (MonadUnliftIO, UnliftIO (..),
|
||||
import Control.Monad.Trans.Resource
|
||||
import qualified Data.ByteString as B
|
||||
import Data.CaseInsensitive (mk)
|
||||
import Data.Default (Default (..))
|
||||
import qualified Data.Ini as Ini
|
||||
import qualified Data.Map as Map
|
||||
import Data.String (IsString (..))
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as TE
|
||||
import Data.Time (defaultTimeLocale, formatTime)
|
||||
import GHC.Show (Show (show))
|
||||
import Network.HTTP.Client (defaultManagerSettings)
|
||||
@ -36,6 +38,9 @@ import Network.HTTP.Types (ByteRange, Header, Method, Query,
|
||||
hRange)
|
||||
import qualified Network.HTTP.Types as HT
|
||||
import Network.Minio.Errors
|
||||
import System.Directory (doesFileExist, getHomeDirectory)
|
||||
import qualified System.Environment as Env
|
||||
import System.FilePath.Posix (combine)
|
||||
import Text.XML
|
||||
import qualified UnliftIO as U
|
||||
|
||||
@ -92,11 +97,73 @@ data ConnectInfo = ConnectInfo {
|
||||
} deriving (Eq, Show)
|
||||
|
||||
|
||||
-- | Connects to a Minio server located at @localhost:9000@ with access
|
||||
-- key /minio/ and secret key /minio123/. It is over __HTTP__ by
|
||||
-- default.
|
||||
instance Default ConnectInfo where
|
||||
def = ConnectInfo "localhost" 9000 "minio" "minio123" False "us-east-1" True
|
||||
instance IsString ConnectInfo where
|
||||
fromString str = let req = NC.parseRequest_ str
|
||||
in ConnectInfo
|
||||
{ connectHost = TE.decodeUtf8 $ NC.host req
|
||||
, connectPort = NC.port req
|
||||
, connectAccessKey = ""
|
||||
, connectSecretKey = ""
|
||||
, connectIsSecure = NC.secure req
|
||||
, connectRegion = ""
|
||||
, connectAutoDiscoverRegion = True
|
||||
}
|
||||
|
||||
data Credentials = Credentials { cAccessKey :: Text
|
||||
, cSecretKey :: Text
|
||||
} deriving (Eq, Show)
|
||||
|
||||
type Provider = IO (Maybe Credentials)
|
||||
|
||||
findFirst :: [Provider] -> Provider
|
||||
findFirst [] = return Nothing
|
||||
findFirst (f:fs) = do c <- f
|
||||
maybe (findFirst fs) (return . Just) c
|
||||
|
||||
fromAWSConfigFile :: Provider
|
||||
fromAWSConfigFile = do
|
||||
credsE <- runExceptT $ do
|
||||
homeDir <- lift $ getHomeDirectory
|
||||
let awsCredsFile = homeDir `combine` ".aws" `combine` "credentials"
|
||||
fileExists <- lift $ doesFileExist awsCredsFile
|
||||
bool (throwE "FileNotFound") (return ()) fileExists
|
||||
ini <- ExceptT $ Ini.readIniFile awsCredsFile
|
||||
akey <- ExceptT $ return
|
||||
$ Ini.lookupValue "default" "aws_access_key_id" ini
|
||||
skey <- ExceptT $ return
|
||||
$ Ini.lookupValue "default" "aws_secret_access_key" ini
|
||||
return $ Credentials akey skey
|
||||
return $ hush credsE
|
||||
|
||||
fromAWSEnv :: Provider
|
||||
fromAWSEnv = runMaybeT $ do
|
||||
akey <- MaybeT $ Env.lookupEnv "AWS_ACCESS_KEY_ID"
|
||||
skey <- MaybeT $ Env.lookupEnv "AWS_SECRET_ACCESS_KEY"
|
||||
return $ Credentials (T.pack akey) (T.pack skey)
|
||||
|
||||
fromMinioEnv :: Provider
|
||||
fromMinioEnv = runMaybeT $ do
|
||||
akey <- MaybeT $ Env.lookupEnv "MINIO_ACCESS_KEY"
|
||||
skey <- MaybeT $ Env.lookupEnv "MINIO_SECRET_KEY"
|
||||
return $ Credentials (T.pack akey) (T.pack skey)
|
||||
|
||||
setCredsFrom :: [Provider] -> ConnectInfo -> IO ConnectInfo
|
||||
setCredsFrom ps ci = do pMay <- findFirst ps
|
||||
maybe
|
||||
(throwIO MErrVMissingCredentials)
|
||||
(return . (flip setCreds ci))
|
||||
pMay
|
||||
|
||||
setCreds :: Credentials -> ConnectInfo -> ConnectInfo
|
||||
setCreds (Credentials accessKey secretKey) connInfo =
|
||||
connInfo { connectAccessKey = accessKey
|
||||
, connectSecretKey = secretKey
|
||||
}
|
||||
|
||||
setRegion :: Region -> ConnectInfo -> ConnectInfo
|
||||
setRegion r connInfo = connInfo { connectRegion = r
|
||||
, connectAutoDiscoverRegion = False
|
||||
}
|
||||
|
||||
getHostAddr :: ConnectInfo -> ByteString
|
||||
getHostAddr ci = if | port == 80 || port == 443 -> toS host
|
||||
@ -110,92 +177,25 @@ getHostAddr ci = if | port == 80 || port == 443 -> toS host
|
||||
-- | Default GCS ConnectInfo. Works only for "Simple Migration"
|
||||
-- use-case with interoperability mode enabled on GCP console. For
|
||||
-- more information - https://cloud.google.com/storage/docs/migrating
|
||||
-- Credentials should be supplied before use, for e.g.:
|
||||
--
|
||||
-- > gcsCI {
|
||||
-- > connectAccessKey = "my-access-key"
|
||||
-- > , connectSecretKey = "my-secret-key"
|
||||
-- > }
|
||||
|
||||
-- Credentials should be supplied before use.
|
||||
gcsCI :: ConnectInfo
|
||||
gcsCI = def {
|
||||
connectHost = "storage.googleapis.com"
|
||||
, connectPort = 443
|
||||
, connectRegion = "us" -- picking region with Multi-Regional support
|
||||
, connectAccessKey = ""
|
||||
, connectSecretKey = ""
|
||||
, connectIsSecure = True
|
||||
, connectAutoDiscoverRegion = True
|
||||
}
|
||||
gcsCI = setRegion "us"
|
||||
"https://storage.googleapis.com"
|
||||
|
||||
|
||||
-- | Default AWS ConnectInfo. Connects to "us-east-1". Credentials
|
||||
-- should be supplied before use, for e.g.:
|
||||
--
|
||||
-- > awsCI {
|
||||
-- > connectAccessKey = "my-access-key"
|
||||
-- > , connectSecretKey = "my-secret-key"
|
||||
-- > }
|
||||
-- should be supplied before use.
|
||||
awsCI :: ConnectInfo
|
||||
awsCI = def {
|
||||
connectHost = "s3.amazonaws.com"
|
||||
, connectPort = 443
|
||||
, connectAccessKey = ""
|
||||
, connectSecretKey = ""
|
||||
, connectIsSecure = True
|
||||
}
|
||||
|
||||
-- | AWS ConnectInfo with a specified region. It can optionally
|
||||
-- disable the automatic discovery of a bucket's region via the
|
||||
-- Boolean argument.
|
||||
--
|
||||
-- > awsWithRegionCI "us-west-1" False {
|
||||
-- > connectAccessKey = "my-access-key"
|
||||
-- > , connectSecretKey = "my-secret-key"
|
||||
-- > }
|
||||
--
|
||||
-- This restricts all operations to the "us-west-1" region and does
|
||||
-- not perform any bucket location requests.
|
||||
awsWithRegionCI :: Region -> Bool -> ConnectInfo
|
||||
awsWithRegionCI region autoDiscoverRegion =
|
||||
let host = maybe "s3.amazonaws.com" identity $
|
||||
Map.lookup region awsRegionMap
|
||||
in awsCI {
|
||||
connectHost = host
|
||||
, connectRegion = region
|
||||
, connectAutoDiscoverRegion = autoDiscoverRegion
|
||||
}
|
||||
awsCI = "https://s3.amazonaws.com"
|
||||
|
||||
|
||||
-- | <https://play.minio.io:9000 Minio Play Server>
|
||||
-- ConnectInfo. Credentials are already filled in.
|
||||
minioPlayCI :: ConnectInfo
|
||||
minioPlayCI = def {
|
||||
connectHost = "play.minio.io"
|
||||
, connectPort = 9000
|
||||
, connectAccessKey = "Q3AM3UQ867SPQQA43P2F"
|
||||
, connectSecretKey = "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG"
|
||||
, connectIsSecure = True
|
||||
, connectAutoDiscoverRegion = False
|
||||
}
|
||||
|
||||
-- | ConnectInfo for Minio server. Takes hostname, port and a Boolean
|
||||
-- to enable TLS.
|
||||
--
|
||||
-- > minioCI "minio.example.com" 9000 True {
|
||||
-- > connectAccessKey = "my-access-key"
|
||||
-- > , connectSecretKey = "my-secret-key"
|
||||
-- > }
|
||||
--
|
||||
-- This connects to a Minio server at the given hostname and port over
|
||||
-- HTTPS.
|
||||
minioCI :: Text -> Int -> Bool -> ConnectInfo
|
||||
minioCI host port isSecure = def {
|
||||
connectHost = host
|
||||
, connectPort = port
|
||||
, connectRegion = "us-east-1"
|
||||
, connectIsSecure = isSecure
|
||||
, connectAutoDiscoverRegion = False
|
||||
}
|
||||
minioPlayCI = let playCreds = Credentials "Q3AM3UQ867SPQQA43P2F" "zuf+tfteSlswRu7BJ86wekitnifILbZam1KYY3TG"
|
||||
in setCreds playCreds
|
||||
$ setRegion "us-east-1"
|
||||
"https://play.minio.io:9000"
|
||||
|
||||
-- |
|
||||
-- Represents a bucket in the object store
|
||||
@ -241,8 +241,8 @@ data PutObjectOptions = PutObjectOptions {
|
||||
} deriving (Show, Eq)
|
||||
|
||||
-- Provide a default instance
|
||||
instance Default PutObjectOptions where
|
||||
def = PutObjectOptions def def def def def def [] def
|
||||
defaultPutObjectOptions :: PutObjectOptions
|
||||
defaultPutObjectOptions = PutObjectOptions Nothing Nothing Nothing Nothing Nothing Nothing [] Nothing
|
||||
|
||||
addXAmzMetaPrefix :: Text -> Text
|
||||
addXAmzMetaPrefix s = do
|
||||
@ -361,17 +361,17 @@ data SourceInfo = SourceInfo {
|
||||
, srcIfUnmodifiedSince :: Maybe UTCTime
|
||||
} deriving (Show, Eq)
|
||||
|
||||
instance Default SourceInfo where
|
||||
def = SourceInfo "" "" def def def def def
|
||||
defaultSourceInfo :: SourceInfo
|
||||
defaultSourceInfo = SourceInfo "" "" Nothing Nothing Nothing Nothing Nothing
|
||||
|
||||
-- | Represents destination object in server-side copy object
|
||||
data DestinationInfo = DestinationInfo {
|
||||
dstBucket :: Text
|
||||
, dstObject :: Text
|
||||
} deriving (Show, Eq)
|
||||
data DestinationInfo = DestinationInfo
|
||||
{ dstBucket :: Text
|
||||
, dstObject :: Text
|
||||
} deriving (Show, Eq)
|
||||
|
||||
instance Default DestinationInfo where
|
||||
def = DestinationInfo "" ""
|
||||
defaultDestinationInfo :: DestinationInfo
|
||||
defaultDestinationInfo = DestinationInfo "" ""
|
||||
|
||||
data GetObjectOptions = GetObjectOptions {
|
||||
-- | Set object's data of given offset begin and end,
|
||||
@ -389,8 +389,8 @@ data GetObjectOptions = GetObjectOptions {
|
||||
, gooIfModifiedSince :: Maybe UTCTime
|
||||
} deriving (Show, Eq)
|
||||
|
||||
instance Default GetObjectOptions where
|
||||
def = GetObjectOptions def def def def def
|
||||
defaultGetObjectOptions :: GetObjectOptions
|
||||
defaultGetObjectOptions = GetObjectOptions Nothing Nothing Nothing Nothing Nothing
|
||||
|
||||
gooToHeaders :: GetObjectOptions -> [HT.Header]
|
||||
gooToHeaders goo = rangeHdr ++ zip names values
|
||||
@ -450,22 +450,23 @@ data Filter = Filter
|
||||
{ fFilter :: FilterKey
|
||||
} deriving (Show, Eq)
|
||||
|
||||
instance Default Filter where
|
||||
def = Filter def
|
||||
defaultFilter :: Filter
|
||||
defaultFilter = Filter defaultFilterKey
|
||||
|
||||
data FilterKey = FilterKey
|
||||
{ fkKey :: FilterRules
|
||||
} deriving (Show, Eq)
|
||||
|
||||
instance Default FilterKey where
|
||||
def = FilterKey def
|
||||
defaultFilterKey :: FilterKey
|
||||
defaultFilterKey = FilterKey defaultFilterRules
|
||||
|
||||
data FilterRules = FilterRules
|
||||
{ frFilterRules :: [FilterRule]
|
||||
} deriving (Show, Eq)
|
||||
|
||||
instance Default FilterRules where
|
||||
def = FilterRules []
|
||||
defaultFilterRules :: FilterRules
|
||||
defaultFilterRules = FilterRules []
|
||||
|
||||
|
||||
-- | A filter rule that can act based on the suffix or prefix of an
|
||||
-- object. As an example, let's create two filter rules:
|
||||
@ -504,8 +505,8 @@ data Notification = Notification
|
||||
, nCloudFunctionConfigurations :: [NotificationConfig]
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance Default Notification where
|
||||
def = Notification [] [] []
|
||||
defaultNotification :: Notification
|
||||
defaultNotification = Notification [] [] []
|
||||
|
||||
-- | Represents different kinds of payload that are used with S3 API
|
||||
-- requests.
|
||||
@ -514,8 +515,8 @@ data Payload = PayloadBS ByteString
|
||||
Int64 -- offset
|
||||
Int64 -- size
|
||||
|
||||
instance Default Payload where
|
||||
def = PayloadBS ""
|
||||
defaultPayload :: Payload
|
||||
defaultPayload = PayloadBS ""
|
||||
|
||||
data AdminReqInfo = AdminReqInfo {
|
||||
ariMethod :: Method
|
||||
@ -538,8 +539,9 @@ data S3ReqInfo = S3ReqInfo {
|
||||
, riNeedsLocation :: Bool
|
||||
}
|
||||
|
||||
instance Default S3ReqInfo where
|
||||
def = S3ReqInfo HT.methodGet def def def def def Nothing def True
|
||||
defaultS3ReqInfo :: S3ReqInfo
|
||||
defaultS3ReqInfo = S3ReqInfo HT.methodGet Nothing Nothing
|
||||
[] [] defaultPayload Nothing Nothing True
|
||||
|
||||
getS3Path :: Maybe Bucket -> Maybe Object -> ByteString
|
||||
getS3Path b o =
|
||||
@ -594,14 +596,11 @@ connect ci = do
|
||||
let settings | connectIsSecure ci = NC.tlsManagerSettings
|
||||
| otherwise = defaultManagerSettings
|
||||
mgr <- NC.newManager settings
|
||||
rMapMVar <- M.newMVar Map.empty
|
||||
return $ MinioConn ci mgr rMapMVar
|
||||
mkMinioConn ci mgr
|
||||
|
||||
-- | Run the Minio action and return the result or an error.
|
||||
runMinio :: ConnectInfo -> Minio a -> IO (Either MinioErr a)
|
||||
runMinio ci m = do
|
||||
conn <- liftIO $ connect ci
|
||||
runResourceT . flip runReaderT conn . unMinio $
|
||||
|
||||
runMinioWith :: MinioConn -> Minio a -> IO (Either MinioErr a)
|
||||
runMinioWith conn m = runResourceT . flip runReaderT conn . unMinio $
|
||||
fmap Right m `U.catches`
|
||||
[ U.Handler handlerServiceErr
|
||||
, U.Handler handlerHE
|
||||
@ -614,6 +613,17 @@ runMinio ci m = do
|
||||
handlerFE = return . Left . MErrIO
|
||||
handlerValidation = return . Left . MErrValidation
|
||||
|
||||
mkMinioConn :: ConnectInfo -> NC.Manager -> IO MinioConn
|
||||
mkMinioConn ci mgr = do
|
||||
rMapMVar <- M.newMVar Map.empty
|
||||
return $ MinioConn ci mgr rMapMVar
|
||||
|
||||
-- | Run the Minio action and return the result or an error.
|
||||
runMinio :: ConnectInfo -> Minio a -> IO (Either MinioErr a)
|
||||
runMinio ci m = do
|
||||
conn <- connect ci
|
||||
runMinioWith conn m
|
||||
|
||||
s3Name :: Text -> Text -> Name
|
||||
s3Name ns s = Name s (Just ns) Nothing
|
||||
|
||||
|
||||
@ -40,6 +40,7 @@ data MErrV = MErrVSinglePUTSizeExceeded Int64
|
||||
| MErrVInvalidUrlExpiry Int
|
||||
| MErrVJsonParse Text
|
||||
| MErrVInvalidHealPath
|
||||
| MErrVMissingCredentials
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance Exception MErrV
|
||||
|
||||
@ -92,7 +92,6 @@ module Network.Minio.S3API
|
||||
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.Conduit as C
|
||||
import Data.Default (def)
|
||||
import qualified Data.Text as T
|
||||
import qualified Network.HTTP.Conduit as NC
|
||||
import qualified Network.HTTP.Types as HT
|
||||
@ -112,7 +111,7 @@ import Network.Minio.XmlParser
|
||||
-- | Fetch all buckets from the service.
|
||||
getService :: Minio [BucketInfo]
|
||||
getService = do
|
||||
resp <- executeRequest $ def {
|
||||
resp <- executeRequest $ defaultS3ReqInfo {
|
||||
riNeedsLocation = False
|
||||
}
|
||||
parseListBuckets $ NC.responseBody resp
|
||||
@ -125,7 +124,7 @@ getObject' bucket object queryParams headers = do
|
||||
resp <- mkStreamRequest reqInfo
|
||||
return (NC.responseHeaders resp, NC.responseBody resp)
|
||||
where
|
||||
reqInfo = def { riBucket = Just bucket
|
||||
reqInfo = defaultS3ReqInfo { riBucket = Just bucket
|
||||
, riObject = Just object
|
||||
, riQueryParams = queryParams
|
||||
, riHeaders = headers
|
||||
@ -136,7 +135,7 @@ putBucket :: Bucket -> Region -> Minio ()
|
||||
putBucket bucket location = do
|
||||
ns <- asks getSvcNamespace
|
||||
void $ executeRequest $
|
||||
def { riMethod = HT.methodPut
|
||||
defaultS3ReqInfo { riMethod = HT.methodPut
|
||||
, riBucket = Just bucket
|
||||
, riPayload = PayloadBS $ mkCreateBucketConfig ns location
|
||||
, riNeedsLocation = False
|
||||
@ -155,7 +154,7 @@ putObjectSingle' bucket object headers bs = do
|
||||
|
||||
-- content-length header is automatically set by library.
|
||||
resp <- executeRequest $
|
||||
def { riMethod = HT.methodPut
|
||||
defaultS3ReqInfo { riMethod = HT.methodPut
|
||||
, riBucket = Just bucket
|
||||
, riObject = Just object
|
||||
, riHeaders = headers
|
||||
@ -179,7 +178,7 @@ putObjectSingle bucket object headers h offset size = do
|
||||
|
||||
-- content-length header is automatically set by library.
|
||||
resp <- executeRequest $
|
||||
def { riMethod = HT.methodPut
|
||||
defaultS3ReqInfo { riMethod = HT.methodPut
|
||||
, riBucket = Just bucket
|
||||
, riObject = Just object
|
||||
, riHeaders = headers
|
||||
@ -197,7 +196,7 @@ putObjectSingle bucket object headers h offset size = do
|
||||
listObjectsV1' :: Bucket -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Int
|
||||
-> Minio ListObjectsV1Result
|
||||
listObjectsV1' bucket prefix nextMarker delimiter maxKeys = do
|
||||
resp <- executeRequest $ def { riMethod = HT.methodGet
|
||||
resp <- executeRequest $ defaultS3ReqInfo { riMethod = HT.methodGet
|
||||
, riBucket = Just bucket
|
||||
, riQueryParams = mkOptionalParams params
|
||||
}
|
||||
@ -215,7 +214,7 @@ listObjectsV1' bucket prefix nextMarker delimiter maxKeys = do
|
||||
listObjects' :: Bucket -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Int
|
||||
-> Minio ListObjectsResult
|
||||
listObjects' bucket prefix nextToken delimiter maxKeys = do
|
||||
resp <- executeRequest $ def { riMethod = HT.methodGet
|
||||
resp <- executeRequest $ defaultS3ReqInfo { riMethod = HT.methodGet
|
||||
, riBucket = Just bucket
|
||||
, riQueryParams = mkOptionalParams params
|
||||
}
|
||||
@ -233,7 +232,7 @@ listObjects' bucket prefix nextToken delimiter maxKeys = do
|
||||
deleteBucket :: Bucket -> Minio ()
|
||||
deleteBucket bucket = void $
|
||||
executeRequest $
|
||||
def { riMethod = HT.methodDelete
|
||||
defaultS3ReqInfo { riMethod = HT.methodDelete
|
||||
, riBucket = Just bucket
|
||||
}
|
||||
|
||||
@ -241,7 +240,7 @@ deleteBucket bucket = void $
|
||||
deleteObject :: Bucket -> Object -> Minio ()
|
||||
deleteObject bucket object = void $
|
||||
executeRequest $
|
||||
def { riMethod = HT.methodDelete
|
||||
defaultS3ReqInfo { riMethod = HT.methodDelete
|
||||
, riBucket = Just bucket
|
||||
, riObject = Just object
|
||||
}
|
||||
@ -249,7 +248,7 @@ deleteObject bucket object = void $
|
||||
-- | Create a new multipart upload.
|
||||
newMultipartUpload :: Bucket -> Object -> [HT.Header] -> Minio UploadId
|
||||
newMultipartUpload bucket object headers = do
|
||||
resp <- executeRequest $ def { riMethod = HT.methodPost
|
||||
resp <- executeRequest $ defaultS3ReqInfo { riMethod = HT.methodPost
|
||||
, riBucket = Just bucket
|
||||
, riObject = Just object
|
||||
, riQueryParams = [("uploads", Nothing)]
|
||||
@ -262,7 +261,7 @@ putObjectPart :: Bucket -> Object -> UploadId -> PartNumber -> [HT.Header]
|
||||
-> Payload -> Minio PartTuple
|
||||
putObjectPart bucket object uploadId partNumber headers payload = do
|
||||
resp <- executeRequest $
|
||||
def { riMethod = HT.methodPut
|
||||
defaultS3ReqInfo { riMethod = HT.methodPut
|
||||
, riBucket = Just bucket
|
||||
, riObject = Just object
|
||||
, riQueryParams = mkOptionalParams params
|
||||
@ -304,7 +303,7 @@ copyObjectPart :: DestinationInfo -> SourceInfo -> UploadId
|
||||
-> PartNumber -> [HT.Header] -> Minio (ETag, UTCTime)
|
||||
copyObjectPart dstInfo srcInfo uploadId partNumber headers = do
|
||||
resp <- executeRequest $
|
||||
def { riMethod = HT.methodPut
|
||||
defaultS3ReqInfo { riMethod = HT.methodPut
|
||||
, riBucket = Just $ dstBucket dstInfo
|
||||
, riObject = Just $ dstObject dstInfo
|
||||
, riQueryParams = mkOptionalParams params
|
||||
@ -328,7 +327,7 @@ copyObjectSingle bucket object srcInfo headers = do
|
||||
when (isJust $ srcRange srcInfo) $
|
||||
throwIO MErrVCopyObjSingleNoRangeAccepted
|
||||
resp <- executeRequest $
|
||||
def { riMethod = HT.methodPut
|
||||
defaultS3ReqInfo { riMethod = HT.methodPut
|
||||
, riBucket = Just bucket
|
||||
, riObject = Just object
|
||||
, riHeaders = headers ++ srcInfoToHeaders srcInfo
|
||||
@ -340,7 +339,7 @@ completeMultipartUpload :: Bucket -> Object -> UploadId -> [PartTuple]
|
||||
-> Minio ETag
|
||||
completeMultipartUpload bucket object uploadId partTuple = do
|
||||
resp <- executeRequest $
|
||||
def { riMethod = HT.methodPost
|
||||
defaultS3ReqInfo { riMethod = HT.methodPost
|
||||
, riBucket = Just bucket
|
||||
, riObject = Just object
|
||||
, riQueryParams = mkOptionalParams params
|
||||
@ -354,7 +353,7 @@ completeMultipartUpload bucket object uploadId partTuple = do
|
||||
-- | Abort a multipart upload.
|
||||
abortMultipartUpload :: Bucket -> Object -> UploadId -> Minio ()
|
||||
abortMultipartUpload bucket object uploadId = void $
|
||||
executeRequest $ def { riMethod = HT.methodDelete
|
||||
executeRequest $ defaultS3ReqInfo { riMethod = HT.methodDelete
|
||||
, riBucket = Just bucket
|
||||
, riObject = Just object
|
||||
, riQueryParams = mkOptionalParams params
|
||||
@ -366,7 +365,7 @@ abortMultipartUpload bucket object uploadId = void $
|
||||
listIncompleteUploads' :: Bucket -> Maybe Text -> Maybe Text -> Maybe Text
|
||||
-> Maybe Text -> Maybe Int -> Minio ListUploadsResult
|
||||
listIncompleteUploads' bucket prefix delimiter keyMarker uploadIdMarker maxKeys = do
|
||||
resp <- executeRequest $ def { riMethod = HT.methodGet
|
||||
resp <- executeRequest $ defaultS3ReqInfo { riMethod = HT.methodGet
|
||||
, riBucket = Just bucket
|
||||
, riQueryParams = params
|
||||
}
|
||||
@ -386,7 +385,7 @@ listIncompleteUploads' bucket prefix delimiter keyMarker uploadIdMarker maxKeys
|
||||
listIncompleteParts' :: Bucket -> Object -> UploadId -> Maybe Text
|
||||
-> Maybe Text -> Minio ListPartsResult
|
||||
listIncompleteParts' bucket object uploadId maxParts partNumMarker = do
|
||||
resp <- executeRequest $ def { riMethod = HT.methodGet
|
||||
resp <- executeRequest $ defaultS3ReqInfo { riMethod = HT.methodGet
|
||||
, riBucket = Just bucket
|
||||
, riObject = Just object
|
||||
, riQueryParams = mkOptionalParams params
|
||||
@ -403,7 +402,7 @@ listIncompleteParts' bucket object uploadId maxParts partNumMarker = do
|
||||
-- | Get metadata of an object.
|
||||
headObject :: Bucket -> Object -> Minio ObjectInfo
|
||||
headObject bucket object = do
|
||||
resp <- executeRequest $ def { riMethod = HT.methodHead
|
||||
resp <- executeRequest $ defaultS3ReqInfo { riMethod = HT.methodHead
|
||||
, riBucket = Just bucket
|
||||
, riObject = Just object
|
||||
}
|
||||
@ -439,7 +438,7 @@ headBucket bucket = headBucketEx `catches`
|
||||
handleStatus404 e = throwIO e
|
||||
|
||||
headBucketEx = do
|
||||
resp <- executeRequest $ def { riMethod = HT.methodHead
|
||||
resp <- executeRequest $ defaultS3ReqInfo { riMethod = HT.methodHead
|
||||
, riBucket = Just bucket
|
||||
}
|
||||
return $ NC.responseStatus resp == HT.ok200
|
||||
@ -448,7 +447,7 @@ headBucket bucket = headBucketEx `catches`
|
||||
putBucketNotification :: Bucket -> Notification -> Minio ()
|
||||
putBucketNotification bucket ncfg = do
|
||||
ns <- asks getSvcNamespace
|
||||
void $ executeRequest $ def { riMethod = HT.methodPut
|
||||
void $ executeRequest $ defaultS3ReqInfo { riMethod = HT.methodPut
|
||||
, riBucket = Just bucket
|
||||
, riQueryParams = [("notification", Nothing)]
|
||||
, riPayload = PayloadBS $
|
||||
@ -458,7 +457,7 @@ putBucketNotification bucket ncfg = do
|
||||
-- | Retrieve the notification configuration on a bucket.
|
||||
getBucketNotification :: Bucket -> Minio Notification
|
||||
getBucketNotification bucket = do
|
||||
resp <- executeRequest $ def { riMethod = HT.methodGet
|
||||
resp <- executeRequest $ defaultS3ReqInfo { riMethod = HT.methodGet
|
||||
, riBucket = Just bucket
|
||||
, riQueryParams = [("notification", Nothing)]
|
||||
}
|
||||
@ -466,12 +465,12 @@ getBucketNotification bucket = do
|
||||
|
||||
-- | Remove all notifications configured on a bucket.
|
||||
removeAllBucketNotification :: Bucket -> Minio ()
|
||||
removeAllBucketNotification = flip putBucketNotification def
|
||||
removeAllBucketNotification = flip putBucketNotification defaultNotification
|
||||
|
||||
-- | Fetch the policy if any on a bucket.
|
||||
getBucketPolicy :: Bucket -> Minio Text
|
||||
getBucketPolicy bucket = do
|
||||
resp <- executeRequest $ def { riMethod = HT.methodGet
|
||||
resp <- executeRequest $ defaultS3ReqInfo { riMethod = HT.methodGet
|
||||
, riBucket = Just bucket
|
||||
, riQueryParams = [("policy", Nothing)]
|
||||
}
|
||||
@ -489,7 +488,7 @@ setBucketPolicy bucket policy = do
|
||||
-- | Save a new policy on a bucket.
|
||||
putBucketPolicy :: Bucket -> Text -> Minio()
|
||||
putBucketPolicy bucket policy = do
|
||||
void $ executeRequest $ def { riMethod = HT.methodPut
|
||||
void $ executeRequest $ defaultS3ReqInfo { riMethod = HT.methodPut
|
||||
, riBucket = Just bucket
|
||||
, riQueryParams = [("policy", Nothing)]
|
||||
, riPayload = PayloadBS $ encodeUtf8 policy
|
||||
@ -498,7 +497,7 @@ putBucketPolicy bucket policy = do
|
||||
-- | Delete any policy set on a bucket.
|
||||
deleteBucketPolicy :: Bucket -> Minio()
|
||||
deleteBucketPolicy bucket = do
|
||||
void $ executeRequest $ def { riMethod = HT.methodDelete
|
||||
void $ executeRequest $ defaultS3ReqInfo { riMethod = HT.methodDelete
|
||||
, riBucket = Just bucket
|
||||
, riQueryParams = [("policy", Nothing)]
|
||||
}
|
||||
|
||||
@ -43,7 +43,6 @@ import qualified Network.HTTP.Types.Header as H
|
||||
|
||||
import Lib.Prelude
|
||||
|
||||
import Network.Minio.Data
|
||||
import Network.Minio.Data.ByteString
|
||||
import Network.Minio.Data.Crypto
|
||||
import Network.Minio.Data.Time
|
||||
@ -72,7 +71,7 @@ data SignParams = SignParams {
|
||||
spAccessKey :: Text
|
||||
, spSecretKey :: Text
|
||||
, spTimeStamp :: UTCTime
|
||||
, spRegion :: Maybe Region
|
||||
, spRegion :: Maybe Text
|
||||
, spExpirySecs :: Maybe Int
|
||||
, spPayloadHash :: Maybe ByteString
|
||||
} deriving (Show)
|
||||
@ -174,7 +173,7 @@ signV4 !sp !req =
|
||||
in output
|
||||
|
||||
|
||||
mkScope :: UTCTime -> Region -> ByteString
|
||||
mkScope :: UTCTime -> Text -> ByteString
|
||||
mkScope ts region = B.intercalate "/"
|
||||
[ toS $ Time.formatTime Time.defaultTimeLocale "%Y%m%d" ts
|
||||
, toS region
|
||||
@ -222,7 +221,7 @@ mkStringToSign ts !scope !canonicalRequest = B.intercalate "\n"
|
||||
, hashSHA256 canonicalRequest
|
||||
]
|
||||
|
||||
mkSigningKey :: UTCTime -> Region -> ByteString -> ByteString
|
||||
mkSigningKey :: UTCTime -> Text -> ByteString -> ByteString
|
||||
mkSigningKey ts region !secretKey = hmacSHA256RawBS "aws4_request"
|
||||
. hmacSHA256RawBS "s3"
|
||||
. hmacSHA256RawBS (toS region)
|
||||
|
||||
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
--
|
||||
-- Minio Haskell SDK, (C) 2017, 2018 Minio, Inc.
|
||||
--
|
||||
@ -26,7 +27,6 @@ import Data.Conduit (yield)
|
||||
import qualified Data.Conduit as C
|
||||
import qualified Data.Conduit.Binary as CB
|
||||
import Data.Conduit.Combinators (sinkList)
|
||||
import Data.Default (Default (..))
|
||||
import qualified Data.Map.Strict as Map
|
||||
import qualified Data.Text as T
|
||||
import Data.Time (fromGregorian)
|
||||
@ -83,12 +83,15 @@ funTestWithBucket t minioTest = testCaseSteps t $ \step -> do
|
||||
bktSuffix <- liftIO $ generate $ Q.vectorOf 10 (Q.choose ('a', 'z'))
|
||||
let b = T.concat [funTestBucketPrefix, T.pack bktSuffix]
|
||||
liftStep = liftIO . step
|
||||
connInfo <- maybe minioPlayCI (const def) <$> lookupEnv "MINIO_LOCAL"
|
||||
connInfo <- ( bool minioPlayCI
|
||||
( setCreds (Credentials "minio" "minio123") "http://localhost:9000" )
|
||||
. isJust
|
||||
) <$> lookupEnv "MINIO_LOCAL"
|
||||
ret <- runMinio connInfo $ do
|
||||
liftStep $ "Creating bucket for test - " ++ t
|
||||
foundBucket <- bucketExists b
|
||||
liftIO $ foundBucket @?= False
|
||||
makeBucket b def
|
||||
makeBucket b Nothing
|
||||
minioTest liftStep b
|
||||
deleteBucket b
|
||||
isRight ret @? ("Functional test " ++ t ++ " failed => " ++ show ret)
|
||||
@ -116,7 +119,7 @@ lowLevelMultipartTest = funTestWithBucket "Low-level Multipart Test" $
|
||||
|
||||
destFile <- mkRandFile 0
|
||||
step "Retrieve the created object and check size"
|
||||
fGetObject bucket object destFile def
|
||||
fGetObject bucket object destFile defaultGetObjectOptions
|
||||
gotSize <- withNewHandle destFile getFileSize
|
||||
liftIO $ gotSize == Right (Just mb15) @?
|
||||
"Wrong file size of put file after getting"
|
||||
@ -135,11 +138,11 @@ putObjectSizeTest = funTestWithBucket "PutObject of conduit source with size" $
|
||||
rFile <- mkRandFile mb1
|
||||
|
||||
step "Upload single file."
|
||||
putObject bucket obj (CB.sourceFile rFile) (Just mb1) def
|
||||
putObject bucket obj (CB.sourceFile rFile) (Just mb1) defaultPutObjectOptions
|
||||
|
||||
step "Retrieve and verify file size"
|
||||
destFile <- mkRandFile 0
|
||||
fGetObject bucket obj destFile def
|
||||
fGetObject bucket obj destFile defaultGetObjectOptions
|
||||
gotSize <- withNewHandle destFile getFileSize
|
||||
liftIO $ gotSize == Right (Just mb1) @?
|
||||
"Wrong file size of put file after getting"
|
||||
@ -158,11 +161,11 @@ putObjectNoSizeTest = funTestWithBucket "PutObject of conduit source with no siz
|
||||
rFile <- mkRandFile mb70
|
||||
|
||||
step "Upload multipart file."
|
||||
putObject bucket obj (CB.sourceFile rFile) Nothing def
|
||||
putObject bucket obj (CB.sourceFile rFile) Nothing defaultPutObjectOptions
|
||||
|
||||
step "Retrieve and verify file size"
|
||||
destFile <- mkRandFile 0
|
||||
fGetObject bucket obj destFile def
|
||||
fGetObject bucket obj destFile defaultGetObjectOptions
|
||||
gotSize <- withNewHandle destFile getFileSize
|
||||
liftIO $ gotSize == Right (Just mb70) @?
|
||||
"Wrong file size of put file after getting"
|
||||
@ -177,7 +180,7 @@ highLevelListingTest = funTestWithBucket "High-level listObjects Test" $
|
||||
step "put 3 objects"
|
||||
let expectedObjects = ["dir/o1", "dir/dir1/o2", "dir/dir2/o3"]
|
||||
forM_ expectedObjects $
|
||||
\obj -> fPutObject bucket obj "/etc/lsb-release" def
|
||||
\obj -> fPutObject bucket obj "/etc/lsb-release" defaultPutObjectOptions
|
||||
|
||||
step "High-level listing of objects"
|
||||
objects <- C.runConduit $ listObjects bucket Nothing True C..| sinkList
|
||||
@ -241,7 +244,7 @@ listingTest = funTestWithBucket "Listing Test" $ \step bucket -> do
|
||||
let objects = (\s ->T.concat ["lsb-release", T.pack (show s)]) <$> [1..10::Int]
|
||||
|
||||
forM_ [1..10::Int] $ \s ->
|
||||
fPutObject bucket (T.concat ["lsb-release", T.pack (show s)]) "/etc/lsb-release" def
|
||||
fPutObject bucket (T.concat ["lsb-release", T.pack (show s)]) "/etc/lsb-release" defaultPutObjectOptions
|
||||
|
||||
step "Simple list"
|
||||
res <- listObjects' bucket Nothing Nothing Nothing Nothing
|
||||
@ -312,11 +315,11 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
|
||||
let mb80 = 80 * 1024 * 1024
|
||||
obj = "mpart"
|
||||
|
||||
void $ putObjectInternal bucket obj def $ ODFile "/dev/zero" (Just mb80)
|
||||
void $ putObjectInternal bucket obj defaultPutObjectOptions $ ODFile "/dev/zero" (Just mb80)
|
||||
|
||||
step "Retrieve and verify file size"
|
||||
destFile <- mkRandFile 0
|
||||
fGetObject bucket obj destFile def
|
||||
fGetObject bucket obj destFile defaultGetObjectOptions
|
||||
gotSize <- withNewHandle destFile getFileSize
|
||||
liftIO $ gotSize == Right (Just mb80) @?
|
||||
"Wrong file size of put file after getting"
|
||||
@ -356,7 +359,7 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
|
||||
|
||||
step "create server object with content-type"
|
||||
inputFile <- mkRandFile size1
|
||||
fPutObject bucket object inputFile def{
|
||||
fPutObject bucket object inputFile defaultPutObjectOptions {
|
||||
pooContentType = Just "application/javascript"
|
||||
}
|
||||
|
||||
@ -368,7 +371,7 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
|
||||
liftIO $ assertEqual "Content-Type did not match" (Just "application/javascript") (Map.lookup "Content-Type" m)
|
||||
|
||||
step "upload object with content-encoding set to identity"
|
||||
fPutObject bucket object inputFile def {
|
||||
fPutObject bucket object inputFile defaultPutObjectOptions {
|
||||
pooContentEncoding = Just "identity"
|
||||
}
|
||||
|
||||
@ -390,7 +393,7 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
|
||||
|
||||
step "create server object with content-language"
|
||||
inputFile <- mkRandFile size1
|
||||
fPutObject bucket object inputFile def{
|
||||
fPutObject bucket object inputFile defaultPutObjectOptions {
|
||||
pooContentLanguage = Just "en-US"
|
||||
}
|
||||
|
||||
@ -418,11 +421,11 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
|
||||
inputFile' <- mkRandFile size1
|
||||
inputFile'' <- mkRandFile size0
|
||||
|
||||
fPutObject bucket object inputFile def{
|
||||
fPutObject bucket object inputFile defaultPutObjectOptions {
|
||||
pooStorageClass = Just "STANDARD"
|
||||
}
|
||||
|
||||
fPutObject bucket object' inputFile' def{
|
||||
fPutObject bucket object' inputFile' defaultPutObjectOptions {
|
||||
pooStorageClass = Just "REDUCED_REDUNDANCY"
|
||||
}
|
||||
|
||||
@ -436,7 +439,7 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
|
||||
liftIO $ assertEqual "storageClass did not match" (Just "REDUCED_REDUNDANCY")
|
||||
(Map.lookup "X-Amz-Storage-Class" m')
|
||||
|
||||
fpE <- try $ fPutObject bucket object'' inputFile'' def{
|
||||
fpE <- try $ fPutObject bucket object'' inputFile'' defaultPutObjectOptions {
|
||||
pooStorageClass = Just "INVALID_STORAGE_CLASS"
|
||||
}
|
||||
case fpE of
|
||||
@ -455,10 +458,10 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
|
||||
|
||||
step "create server object to copy"
|
||||
inputFile <- mkRandFile size1
|
||||
fPutObject bucket object inputFile def
|
||||
fPutObject bucket object inputFile defaultPutObjectOptions
|
||||
|
||||
step "copy object"
|
||||
let srcInfo = def { srcBucket = bucket, srcObject = object}
|
||||
let srcInfo = defaultSourceInfo { srcBucket = bucket, srcObject = object}
|
||||
(etag, modTime) <- copyObjectSingle bucket objCopy srcInfo []
|
||||
|
||||
-- retrieve obj info to check
|
||||
@ -484,15 +487,15 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
|
||||
let mb15 = 15 * 1024 * 1024
|
||||
mb5 = 5 * 1024 * 1024
|
||||
randFile <- mkRandFile mb15
|
||||
fPutObject bucket srcObj randFile def
|
||||
fPutObject bucket srcObj randFile defaultPutObjectOptions
|
||||
|
||||
step "create new multipart upload"
|
||||
uid <- newMultipartUpload bucket copyObj []
|
||||
liftIO $ (T.length uid > 0) @? "Got an empty multipartUpload Id."
|
||||
|
||||
step "put object parts 1-3"
|
||||
let srcInfo' = def { srcBucket = bucket, srcObject = srcObj }
|
||||
dstInfo' = def { dstBucket = bucket, dstObject = copyObj }
|
||||
let srcInfo' = defaultSourceInfo { srcBucket = bucket, srcObject = srcObj }
|
||||
dstInfo' = defaultDestinationInfo { dstBucket = bucket, dstObject = copyObj }
|
||||
parts <- forM [1..3] $ \p -> do
|
||||
(etag', _) <- copyObjectPart dstInfo' srcInfo'{
|
||||
srcRange = Just $ (,) ((p-1)*mb5) ((p-1)*mb5 + (mb5 - 1))
|
||||
@ -520,11 +523,11 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
|
||||
step "Prepare"
|
||||
forM_ (zip srcs sizes) $ \(src, size) -> do
|
||||
inputFile' <- mkRandFile size
|
||||
fPutObject bucket src inputFile' def
|
||||
fPutObject bucket src inputFile' defaultPutObjectOptions
|
||||
|
||||
step "make small and large object copy"
|
||||
forM_ (zip copyObjs srcs) $ \(cp, src) ->
|
||||
copyObject def {dstBucket = bucket, dstObject = cp} def{srcBucket = bucket, srcObject = src}
|
||||
copyObject defaultDestinationInfo {dstBucket = bucket, dstObject = cp} defaultSourceInfo {srcBucket = bucket, srcObject = src}
|
||||
|
||||
step "verify uploaded objects"
|
||||
uploadedSizes <- fmap oiSize <$> forM copyObjs (headObject bucket)
|
||||
@ -539,10 +542,10 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
|
||||
|
||||
step "Prepare"
|
||||
inputFile' <- mkRandFile size
|
||||
fPutObject bucket src inputFile' def
|
||||
fPutObject bucket src inputFile' defaultPutObjectOptions
|
||||
|
||||
step "copy last 10MiB of object"
|
||||
copyObject def { dstBucket = bucket, dstObject = copyObj } def{
|
||||
copyObject defaultDestinationInfo { dstBucket = bucket, dstObject = copyObj } defaultSourceInfo {
|
||||
srcBucket = bucket
|
||||
, srcObject = src
|
||||
, srcRange = Just $ (,) (5 * 1024 * 1024) (size - 1)
|
||||
@ -586,21 +589,21 @@ basicTests = funTestWithBucket "Basic tests" $ \step bucket -> do
|
||||
liftIO $ region == "us-east-1" @? ("Got unexpected region => " ++ show region)
|
||||
|
||||
step "singlepart putObject works"
|
||||
fPutObject bucket "lsb-release" "/etc/lsb-release" def
|
||||
fPutObject bucket "lsb-release" "/etc/lsb-release" defaultPutObjectOptions
|
||||
|
||||
step "fPutObject onto a non-existent bucket and check for NoSuchBucket exception"
|
||||
fpE <- try $ fPutObject "nosuchbucket" "lsb-release" "/etc/lsb-release" def
|
||||
fpE <- try $ fPutObject "nosuchbucket" "lsb-release" "/etc/lsb-release" defaultPutObjectOptions
|
||||
case fpE of
|
||||
Left exn -> liftIO $ exn @?= NoSuchBucket
|
||||
_ -> return ()
|
||||
|
||||
outFile <- mkRandFile 0
|
||||
step "simple fGetObject works"
|
||||
fGetObject bucket "lsb-release" outFile def
|
||||
fGetObject bucket "lsb-release" outFile defaultGetObjectOptions
|
||||
|
||||
let unmodifiedTime = UTCTime (fromGregorian 2010 11 26) 69857
|
||||
step "fGetObject an object which is modified now but requesting as un-modified in past, check for exception"
|
||||
resE <- try $ fGetObject bucket "lsb-release" outFile def{
|
||||
resE <- try $ fGetObject bucket "lsb-release" outFile defaultGetObjectOptions {
|
||||
gooIfUnmodifiedSince = (Just unmodifiedTime)
|
||||
}
|
||||
case resE of
|
||||
@ -608,7 +611,7 @@ basicTests = funTestWithBucket "Basic tests" $ \step bucket -> do
|
||||
_ -> return ()
|
||||
|
||||
step "fGetObject an object with no matching etag, check for exception"
|
||||
resE1 <- try $ fGetObject bucket "lsb-release" outFile def{
|
||||
resE1 <- try $ fGetObject bucket "lsb-release" outFile defaultGetObjectOptions {
|
||||
gooIfMatch = (Just "invalid-etag")
|
||||
}
|
||||
case resE1 of
|
||||
@ -616,7 +619,7 @@ basicTests = funTestWithBucket "Basic tests" $ \step bucket -> do
|
||||
_ -> return ()
|
||||
|
||||
step "fGetObject an object with no valid range, check for exception"
|
||||
resE2 <- try $ fGetObject bucket "lsb-release" outFile def{
|
||||
resE2 <- try $ fGetObject bucket "lsb-release" outFile defaultGetObjectOptions {
|
||||
gooRange = (Just $ HT.ByteRangeFromTo 100 200)
|
||||
}
|
||||
case resE2 of
|
||||
@ -624,12 +627,12 @@ basicTests = funTestWithBucket "Basic tests" $ \step bucket -> do
|
||||
_ -> return ()
|
||||
|
||||
step "fGetObject on object with a valid range"
|
||||
fGetObject bucket "lsb-release" outFile def{
|
||||
fGetObject bucket "lsb-release" outFile defaultGetObjectOptions {
|
||||
gooRange = (Just $ HT.ByteRangeFrom 1)
|
||||
}
|
||||
|
||||
step "fGetObject a non-existent object and check for NoSuchKey exception"
|
||||
resE3 <- try $ fGetObject bucket "noSuchKey" outFile def
|
||||
resE3 <- try $ fGetObject bucket "noSuchKey" outFile defaultGetObjectOptions
|
||||
case resE3 of
|
||||
Left exn -> liftIO $ exn @?= NoSuchKey
|
||||
_ -> return ()
|
||||
@ -648,7 +651,7 @@ basicTests = funTestWithBucket "Basic tests" $ \step bucket -> do
|
||||
let object = "sample"
|
||||
step "create an object"
|
||||
inputFile <- mkRandFile 0
|
||||
fPutObject bucket object inputFile def
|
||||
fPutObject bucket object inputFile defaultPutObjectOptions
|
||||
|
||||
step "get metadata of the object"
|
||||
res <- statObject bucket object
|
||||
@ -814,7 +817,7 @@ bucketPolicyFunTest = funTestWithBucket "Bucket Policy tests" $
|
||||
let obj = "myobject"
|
||||
|
||||
step "verify bucket policy: (1) create `myobject`"
|
||||
putObject bucket obj (replicateC 100 "c") Nothing def
|
||||
putObject bucket obj (replicateC 100 "c") Nothing defaultPutObjectOptions
|
||||
|
||||
step "verify bucket policy: (2) get `myobject` anonymously"
|
||||
connInfo <- asks mcConnInfo
|
||||
|
||||
@ -23,8 +23,6 @@ import Test.Tasty.HUnit
|
||||
|
||||
import Lib.Prelude
|
||||
|
||||
import Data.Default (def)
|
||||
|
||||
import Network.Minio.Data
|
||||
import Network.Minio.TestHelpers
|
||||
import Network.Minio.XmlGenerator
|
||||
@ -74,7 +72,7 @@ testMkPutNotificationRequest =
|
||||
[ NotificationConfig
|
||||
"YjVkM2Y0YmUtNGI3NC00ZjQyLWEwNGItNDIyYWUxY2I0N2M4"
|
||||
"arn:aws:sns:us-east-1:account-id:s3notificationtopic2"
|
||||
[ReducedRedundancyLostObject, ObjectCreated] def
|
||||
[ReducedRedundancyLostObject, ObjectCreated] defaultFilter
|
||||
]
|
||||
[]
|
||||
, Notification
|
||||
@ -86,14 +84,14 @@ testMkPutNotificationRequest =
|
||||
, FilterRule "suffix" ".jpg"])
|
||||
, NotificationConfig
|
||||
"" "arn:aws:sqs:us-east-1:356671443308:s3notificationqueue"
|
||||
[ObjectCreated] def
|
||||
[ObjectCreated] defaultFilter
|
||||
]
|
||||
[ NotificationConfig
|
||||
"" "arn:aws:sns:us-east-1:356671443308:s3notificationtopic2"
|
||||
[ReducedRedundancyLostObject] def
|
||||
[ReducedRedundancyLostObject] defaultFilter
|
||||
]
|
||||
[ NotificationConfig
|
||||
"ObjectCreatedEvents" "arn:aws:lambda:us-west-2:35667example:function:CreateThumbnail"
|
||||
[ObjectCreated] def
|
||||
[ObjectCreated] defaultFilter
|
||||
]
|
||||
]
|
||||
|
||||
@ -19,7 +19,6 @@ module Network.Minio.XmlParser.Test
|
||||
xmlParserTests
|
||||
) where
|
||||
|
||||
import Data.Default (def)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Time (fromGregorian)
|
||||
import Test.Tasty
|
||||
@ -299,7 +298,7 @@ testParseNotification = do
|
||||
[ NotificationConfig
|
||||
"YjVkM2Y0YmUtNGI3NC00ZjQyLWEwNGItNDIyYWUxY2I0N2M4"
|
||||
"arn:aws:sns:us-east-1:account-id:s3notificationtopic2"
|
||||
[ReducedRedundancyLostObject, ObjectCreated] def
|
||||
[ReducedRedundancyLostObject, ObjectCreated] defaultFilter
|
||||
]
|
||||
[])
|
||||
, ("<NotificationConfiguration xmlns=\"http://s3.amazonaws.com/doc/2006-03-01/\">\
|
||||
@ -342,15 +341,15 @@ testParseNotification = do
|
||||
FilterRule "suffix" ".jpg"])
|
||||
, NotificationConfig
|
||||
"" "arn:aws:sqs:us-east-1:356671443308:s3notificationqueue"
|
||||
[ObjectCreated] def
|
||||
[ObjectCreated] defaultFilter
|
||||
]
|
||||
[ NotificationConfig
|
||||
"" "arn:aws:sns:us-east-1:356671443308:s3notificationtopic2"
|
||||
[ReducedRedundancyLostObject] def
|
||||
[ReducedRedundancyLostObject] defaultFilter
|
||||
]
|
||||
[ NotificationConfig
|
||||
"ObjectCreatedEvents" "arn:aws:lambda:us-west-2:35667example:function:CreateThumbnail"
|
||||
[ObjectCreated] def
|
||||
[ObjectCreated] defaultFilter
|
||||
])
|
||||
]
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user