module Network.Minio.API
( connect,
S3ReqInfo (..),
runMinio,
executeRequest,
buildRequest,
mkStreamRequest,
getLocation,
isValidBucketName,
checkBucketNameValidity,
isValidObjectName,
checkObjectNameValidity,
)
where
import Control.Retry
( fullJitterBackoff,
limitRetriesByCumulativeDelay,
retrying,
)
import qualified Data.ByteString as B
import qualified Data.Char as C
import qualified Data.Conduit as C
import qualified Data.HashMap.Strict as H
import qualified Data.Text as T
import qualified Data.Time.Clock as Time
import Lib.Prelude
import qualified Network.HTTP.Client as NClient
import Network.HTTP.Conduit (Response)
import qualified Network.HTTP.Conduit as NC
import qualified Network.HTTP.Types as HT
import Network.HTTP.Types.Header (hHost)
import Network.Minio.APICommon
import Network.Minio.Data
import Network.Minio.Errors
import Network.Minio.Sign.V4
import Network.Minio.Utils
import Network.Minio.XmlParser
getLocation :: Bucket -> Minio Region
getLocation :: Bucket -> Minio Bucket
getLocation Bucket
bucket = do
Response LByteString
resp <-
S3ReqInfo -> Minio (Response LByteString)
executeRequest (S3ReqInfo -> Minio (Response LByteString))
-> S3ReqInfo -> Minio (Response LByteString)
forall a b. (a -> b) -> a -> b
$
S3ReqInfo
defaultS3ReqInfo
{ riBucket :: Maybe Bucket
riBucket = Bucket -> Maybe Bucket
forall a. a -> Maybe a
Just Bucket
bucket,
riQueryParams :: Query
riQueryParams = [(ByteString
"location", Maybe ByteString
forall a. Maybe a
Nothing)],
riNeedsLocation :: Bool
riNeedsLocation = Bool
False
}
LByteString -> Minio Bucket
forall (m :: * -> *). MonadIO m => LByteString -> m Bucket
parseLocation (LByteString -> Minio Bucket) -> LByteString -> Minio Bucket
forall a b. (a -> b) -> a -> b
$ Response LByteString -> LByteString
forall body. Response body -> body
NC.responseBody Response LByteString
resp
discoverRegion :: S3ReqInfo -> Minio (Maybe Region)
discoverRegion :: S3ReqInfo -> Minio (Maybe Bucket)
discoverRegion S3ReqInfo
ri = MaybeT Minio Bucket -> Minio (Maybe Bucket)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT Minio Bucket -> Minio (Maybe Bucket))
-> MaybeT Minio Bucket -> Minio (Maybe Bucket)
forall a b. (a -> b) -> a -> b
$ do
Bucket
bucket <- Minio (Maybe Bucket) -> MaybeT Minio Bucket
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Minio (Maybe Bucket) -> MaybeT Minio Bucket)
-> Minio (Maybe Bucket) -> MaybeT Minio Bucket
forall a b. (a -> b) -> a -> b
$ Maybe Bucket -> Minio (Maybe Bucket)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Bucket -> Minio (Maybe Bucket))
-> Maybe Bucket -> Minio (Maybe Bucket)
forall a b. (a -> b) -> a -> b
$ S3ReqInfo -> Maybe Bucket
riBucket S3ReqInfo
ri
Maybe Bucket
regionMay <- Minio (Maybe Bucket) -> MaybeT Minio (Maybe Bucket)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Minio (Maybe Bucket) -> MaybeT Minio (Maybe Bucket))
-> Minio (Maybe Bucket) -> MaybeT Minio (Maybe Bucket)
forall a b. (a -> b) -> a -> b
$ Bucket -> Minio (Maybe Bucket)
lookupRegionCache Bucket
bucket
MaybeT Minio Bucket
-> (Bucket -> MaybeT Minio Bucket)
-> Maybe Bucket
-> MaybeT Minio Bucket
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
( do
Bucket
l <- Minio Bucket -> MaybeT Minio Bucket
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Minio Bucket -> MaybeT Minio Bucket)
-> Minio Bucket -> MaybeT Minio Bucket
forall a b. (a -> b) -> a -> b
$ Bucket -> Minio Bucket
getLocation Bucket
bucket
Minio () -> MaybeT Minio ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Minio () -> MaybeT Minio ()) -> Minio () -> MaybeT Minio ()
forall a b. (a -> b) -> a -> b
$ Bucket -> Bucket -> Minio ()
addToRegionCache Bucket
bucket Bucket
l
Bucket -> MaybeT Minio Bucket
forall (m :: * -> *) a. Monad m => a -> m a
return Bucket
l
)
Bucket -> MaybeT Minio Bucket
forall (m :: * -> *) a. Monad m => a -> m a
return
Maybe Bucket
regionMay
getRegion :: S3ReqInfo -> Minio (Maybe Region)
getRegion :: S3ReqInfo -> Minio (Maybe Bucket)
getRegion S3ReqInfo
ri = do
ConnectInfo
ci <- (MinioConn -> ConnectInfo) -> Minio ConnectInfo
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MinioConn -> ConnectInfo
mcConnInfo
if
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ S3ReqInfo -> Bool
riNeedsLocation S3ReqInfo
ri ->
Maybe Bucket -> Minio (Maybe Bucket)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Bucket -> Minio (Maybe Bucket))
-> Maybe Bucket -> Minio (Maybe Bucket)
forall a b. (a -> b) -> a -> b
$ Bucket -> Maybe Bucket
forall a. a -> Maybe a
Just (Bucket -> Maybe Bucket) -> Bucket -> Maybe Bucket
forall a b. (a -> b) -> a -> b
$ ConnectInfo -> Bucket
connectRegion ConnectInfo
ci
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ConnectInfo -> Bool
connectAutoDiscoverRegion ConnectInfo
ci ->
Maybe Bucket -> Minio (Maybe Bucket)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Bucket -> Minio (Maybe Bucket))
-> Maybe Bucket -> Minio (Maybe Bucket)
forall a b. (a -> b) -> a -> b
$ Bucket -> Maybe Bucket
forall a. a -> Maybe a
Just (Bucket -> Maybe Bucket) -> Bucket -> Maybe Bucket
forall a b. (a -> b) -> a -> b
$ ConnectInfo -> Bucket
connectRegion ConnectInfo
ci
| Bool
otherwise -> S3ReqInfo -> Minio (Maybe Bucket)
discoverRegion S3ReqInfo
ri
getRegionHost :: Region -> Minio Text
getRegionHost :: Bucket -> Minio Bucket
getRegionHost Bucket
r = do
ConnectInfo
ci <- (MinioConn -> ConnectInfo) -> Minio ConnectInfo
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MinioConn -> ConnectInfo
mcConnInfo
if Bucket
"amazonaws.com" Bucket -> Bucket -> Bool
`T.isSuffixOf` ConnectInfo -> Bucket
connectHost ConnectInfo
ci
then
Minio Bucket
-> (Bucket -> Minio Bucket) -> Maybe Bucket -> Minio Bucket
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(MErrV -> Minio Bucket
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (MErrV -> Minio Bucket) -> MErrV -> Minio Bucket
forall a b. (a -> b) -> a -> b
$ Bucket -> MErrV
MErrVRegionNotSupported Bucket
r)
Bucket -> Minio Bucket
forall (m :: * -> *) a. Monad m => a -> m a
return
(Bucket -> HashMap Bucket Bucket -> Maybe Bucket
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Bucket
r HashMap Bucket Bucket
awsRegionMap)
else Bucket -> Minio Bucket
forall (m :: * -> *) a. Monad m => a -> m a
return (Bucket -> Minio Bucket) -> Bucket -> Minio Bucket
forall a b. (a -> b) -> a -> b
$ ConnectInfo -> Bucket
connectHost ConnectInfo
ci
getHostPathRegion :: S3ReqInfo -> Minio (Text, ByteString, Maybe Region)
getHostPathRegion :: S3ReqInfo -> Minio (Bucket, ByteString, Maybe Bucket)
getHostPathRegion S3ReqInfo
ri = do
ConnectInfo
ci <- (MinioConn -> ConnectInfo) -> Minio ConnectInfo
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MinioConn -> ConnectInfo
mcConnInfo
Maybe Bucket
regionMay <- S3ReqInfo -> Minio (Maybe Bucket)
getRegion S3ReqInfo
ri
case S3ReqInfo -> Maybe Bucket
riBucket S3ReqInfo
ri of
Maybe Bucket
Nothing ->
(Bucket, ByteString, Maybe Bucket)
-> Minio (Bucket, ByteString, Maybe Bucket)
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectInfo -> Bucket
connectHost ConnectInfo
ci, ByteString
"/", Maybe Bucket
regionMay)
Just Bucket
bucket -> do
Bucket
regionHost <- case Maybe Bucket
regionMay of
Maybe Bucket
Nothing -> Bucket -> Minio Bucket
forall (m :: * -> *) a. Monad m => a -> m a
return (Bucket -> Minio Bucket) -> Bucket -> Minio Bucket
forall a b. (a -> b) -> a -> b
$ ConnectInfo -> Bucket
connectHost ConnectInfo
ci
Just Bucket
"" -> Bucket -> Minio Bucket
forall (m :: * -> *) a. Monad m => a -> m a
return (Bucket -> Minio Bucket) -> Bucket -> Minio Bucket
forall a b. (a -> b) -> a -> b
$ ConnectInfo -> Bucket
connectHost ConnectInfo
ci
Just Bucket
r -> Bucket -> Minio Bucket
getRegionHost Bucket
r
let pathStyle :: (Bucket, ByteString, Maybe Bucket)
pathStyle =
( Bucket
regionHost,
Maybe Bucket -> Maybe Bucket -> ByteString
getS3Path (S3ReqInfo -> Maybe Bucket
riBucket S3ReqInfo
ri) (S3ReqInfo -> Maybe Bucket
riObject S3ReqInfo
ri),
Maybe Bucket
regionMay
)
virtualStyle :: (Bucket, ByteString, Maybe Bucket)
virtualStyle =
( Bucket
bucket Bucket -> Bucket -> Bucket
forall a. Semigroup a => a -> a -> a
<> Bucket
"." Bucket -> Bucket -> Bucket
forall a. Semigroup a => a -> a -> a
<> Bucket
regionHost,
Bucket -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Bucket -> ByteString) -> Bucket -> ByteString
forall a b. (a -> b) -> a -> b
$ Bucket
"/" Bucket -> Bucket -> Bucket
forall a. Semigroup a => a -> a -> a
<> Bucket -> Maybe Bucket -> Bucket
forall a. a -> Maybe a -> a
fromMaybe Bucket
"" (S3ReqInfo -> Maybe Bucket
riObject S3ReqInfo
ri),
Maybe Bucket
regionMay
)
( if ConnectInfo -> Bool
isAWSConnectInfo ConnectInfo
ci
then
(Bucket, ByteString, Maybe Bucket)
-> Minio (Bucket, ByteString, Maybe Bucket)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Bucket, ByteString, Maybe Bucket)
-> Minio (Bucket, ByteString, Maybe Bucket))
-> (Bucket, ByteString, Maybe Bucket)
-> Minio (Bucket, ByteString, Maybe Bucket)
forall a b. (a -> b) -> a -> b
$
if Bucket -> Bool
bucketHasPeriods Bucket
bucket
then (Bucket, ByteString, Maybe Bucket)
pathStyle
else (Bucket, ByteString, Maybe Bucket)
virtualStyle
else (Bucket, ByteString, Maybe Bucket)
-> Minio (Bucket, ByteString, Maybe Bucket)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bucket, ByteString, Maybe Bucket)
pathStyle
)
buildRequest :: S3ReqInfo -> Minio NC.Request
buildRequest :: S3ReqInfo -> Minio Request
buildRequest S3ReqInfo
ri = do
Minio () -> (Bucket -> Minio ()) -> Maybe Bucket -> Minio ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Minio ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Bucket -> Minio ()
forall (m :: * -> *). MonadIO m => Bucket -> m ()
checkBucketNameValidity (Maybe Bucket -> Minio ()) -> Maybe Bucket -> Minio ()
forall a b. (a -> b) -> a -> b
$ S3ReqInfo -> Maybe Bucket
riBucket S3ReqInfo
ri
Minio () -> (Bucket -> Minio ()) -> Maybe Bucket -> Minio ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Minio ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Bucket -> Minio ()
forall (m :: * -> *). MonadIO m => Bucket -> m ()
checkObjectNameValidity (Maybe Bucket -> Minio ()) -> Maybe Bucket -> Minio ()
forall a b. (a -> b) -> a -> b
$ S3ReqInfo -> Maybe Bucket
riObject S3ReqInfo
ri
ConnectInfo
ci <- (MinioConn -> ConnectInfo) -> Minio ConnectInfo
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MinioConn -> ConnectInfo
mcConnInfo
(Bucket
host, ByteString
path, Maybe Bucket
regionMay) <- S3ReqInfo -> Minio (Bucket, ByteString, Maybe Bucket)
getHostPathRegion S3ReqInfo
ri
let ci' :: ConnectInfo
ci' = ConnectInfo
ci {connectHost :: Bucket
connectHost = Bucket
host}
hostHeader :: (HeaderName, ByteString)
hostHeader = (HeaderName
hHost, ConnectInfo -> ByteString
getHostAddr ConnectInfo
ci')
ri' :: S3ReqInfo
ri' =
S3ReqInfo
ri
{ riHeaders :: [(HeaderName, ByteString)]
riHeaders = (HeaderName, ByteString)
hostHeader (HeaderName, ByteString)
-> [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
forall a. a -> [a] -> [a]
: S3ReqInfo -> [(HeaderName, ByteString)]
riHeaders S3ReqInfo
ri,
riRegion :: Maybe Bucket
riRegion = Maybe Bucket
regionMay
}
baseRequest :: Request
baseRequest =
Request
NC.defaultRequest
{ method :: ByteString
NC.method = S3ReqInfo -> ByteString
riMethod S3ReqInfo
ri',
secure :: Bool
NC.secure = ConnectInfo -> Bool
connectIsSecure ConnectInfo
ci',
host :: ByteString
NC.host = Bucket -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Bucket -> ByteString) -> Bucket -> ByteString
forall a b. (a -> b) -> a -> b
$ ConnectInfo -> Bucket
connectHost ConnectInfo
ci',
port :: Int
NC.port = ConnectInfo -> Int
connectPort ConnectInfo
ci',
path :: ByteString
NC.path = ByteString
path,
requestHeaders :: [(HeaderName, ByteString)]
NC.requestHeaders = S3ReqInfo -> [(HeaderName, ByteString)]
riHeaders S3ReqInfo
ri',
queryString :: ByteString
NC.queryString = Bool -> Query -> ByteString
HT.renderQuery Bool
False (Query -> ByteString) -> Query -> ByteString
forall a b. (a -> b) -> a -> b
$ S3ReqInfo -> Query
riQueryParams S3ReqInfo
ri'
}
UTCTime
timeStamp <- IO UTCTime -> Minio UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
Time.getCurrentTime
let sp :: SignParams
sp =
Bucket
-> Bucket
-> UTCTime
-> Maybe Bucket
-> Maybe Int
-> Maybe ByteString
-> SignParams
SignParams
(ConnectInfo -> Bucket
connectAccessKey ConnectInfo
ci')
(ConnectInfo -> Bucket
connectSecretKey ConnectInfo
ci')
UTCTime
timeStamp
(S3ReqInfo -> Maybe Bucket
riRegion S3ReqInfo
ri')
(S3ReqInfo -> Maybe Int
riPresignExpirySecs S3ReqInfo
ri')
Maybe ByteString
forall a. Maybe a
Nothing
if
| Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (S3ReqInfo -> Maybe Int
riPresignExpirySecs S3ReqInfo
ri') ->
do
let signPairs :: [(ByteString, ByteString)]
signPairs = SignParams -> Request -> [(ByteString, ByteString)]
signV4 SignParams
sp Request
baseRequest
qpToAdd :: Query
qpToAdd = (((ByteString, ByteString) -> (ByteString, Maybe ByteString))
-> [(ByteString, ByteString)] -> Query
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((ByteString, ByteString) -> (ByteString, Maybe ByteString))
-> [(ByteString, ByteString)] -> Query)
-> ((ByteString -> Maybe ByteString)
-> (ByteString, ByteString) -> (ByteString, Maybe ByteString))
-> (ByteString -> Maybe ByteString)
-> [(ByteString, ByteString)]
-> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Maybe ByteString)
-> (ByteString, ByteString) -> (ByteString, Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just [(ByteString, ByteString)]
signPairs
existingQueryParams :: Query
existingQueryParams = ByteString -> Query
HT.parseQuery (Request -> ByteString
NC.queryString Request
baseRequest)
updatedQueryParams :: Query
updatedQueryParams = Query
existingQueryParams Query -> Query -> Query
forall a. [a] -> [a] -> [a]
++ Query
qpToAdd
Request -> Minio Request
forall (m :: * -> *) a. Monad m => a -> m a
return (Request -> Minio Request) -> Request -> Minio Request
forall a b. (a -> b) -> a -> b
$ Query -> Request -> Request
NClient.setQueryString Query
updatedQueryParams Request
baseRequest
| Payload -> Bool
isStreamingPayload (S3ReqInfo -> Payload
riPayload S3ReqInfo
ri') Bool -> Bool -> Bool
&& Bool -> Bool
not (ConnectInfo -> Bool
connectIsSecure ConnectInfo
ci') ->
do
(Int64
pLen, ConduitT () ByteString (ResourceT IO) ()
pSrc) <- case S3ReqInfo -> Payload
riPayload S3ReqInfo
ri of
PayloadC Int64
l ConduitT () ByteString (ResourceT IO) ()
src -> (Int64, ConduitT () ByteString (ResourceT IO) ())
-> Minio (Int64, ConduitT () ByteString (ResourceT IO) ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64
l, ConduitT () ByteString (ResourceT IO) ()
src)
Payload
_ -> MErrV -> Minio (Int64, ConduitT () ByteString (ResourceT IO) ())
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO MErrV
MErrVUnexpectedPayload
let reqFn :: ConduitT () ByteString (ResourceT IO) () -> Request
reqFn = Int64
-> SignParams
-> Request
-> ConduitT () ByteString (ResourceT IO) ()
-> Request
signV4Stream Int64
pLen SignParams
sp Request
baseRequest
Request -> Minio Request
forall (m :: * -> *) a. Monad m => a -> m a
return (Request -> Minio Request) -> Request -> Minio Request
forall a b. (a -> b) -> a -> b
$ ConduitT () ByteString (ResourceT IO) () -> Request
reqFn ConduitT () ByteString (ResourceT IO) ()
pSrc
| Bool
otherwise ->
do
SignParams
sp' <-
( if ConnectInfo -> Bool
connectIsSecure ConnectInfo
ci'
then
SignParams -> Minio SignParams
forall (m :: * -> *) a. Monad m => a -> m a
return SignParams
sp
else
(
do
ByteString
pHash <- Payload -> Minio ByteString
getPayloadSHA256Hash (Payload -> Minio ByteString) -> Payload -> Minio ByteString
forall a b. (a -> b) -> a -> b
$ S3ReqInfo -> Payload
riPayload S3ReqInfo
ri'
SignParams -> Minio SignParams
forall (m :: * -> *) a. Monad m => a -> m a
return (SignParams -> Minio SignParams) -> SignParams -> Minio SignParams
forall a b. (a -> b) -> a -> b
$ SignParams
sp {spPayloadHash :: Maybe ByteString
spPayloadHash = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
pHash}
)
)
let signHeaders :: [(ByteString, ByteString)]
signHeaders = SignParams -> Request -> [(ByteString, ByteString)]
signV4 SignParams
sp' Request
baseRequest
Request -> Minio Request
forall (m :: * -> *) a. Monad m => a -> m a
return (Request -> Minio Request) -> Request -> Minio Request
forall a b. (a -> b) -> a -> b
$
Request
baseRequest
{ requestHeaders :: [(HeaderName, ByteString)]
NC.requestHeaders =
Request -> [(HeaderName, ByteString)]
NC.requestHeaders Request
baseRequest
[(HeaderName, ByteString)]
-> [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
forall a. [a] -> [a] -> [a]
++ [(ByteString, ByteString)] -> [(HeaderName, ByteString)]
mkHeaderFromPairs [(ByteString, ByteString)]
signHeaders,
requestBody :: RequestBody
NC.requestBody = Payload -> RequestBody
getRequestBody (S3ReqInfo -> Payload
riPayload S3ReqInfo
ri')
}
retryAPIRequest :: Minio a -> Minio a
retryAPIRequest :: Minio a -> Minio a
retryAPIRequest Minio a
apiCall = do
Either HttpException a
resE <-
RetryPolicyM Minio
-> (RetryStatus -> Either HttpException a -> Minio Bool)
-> (RetryStatus -> Minio (Either HttpException a))
-> Minio (Either HttpException a)
forall (m :: * -> *) b.
MonadIO m =>
RetryPolicyM m
-> (RetryStatus -> b -> m Bool) -> (RetryStatus -> m b) -> m b
retrying RetryPolicyM Minio
retryPolicy ((Either HttpException a -> Minio Bool)
-> RetryStatus -> Either HttpException a -> Minio Bool
forall a b. a -> b -> a
const Either HttpException a -> Minio Bool
forall a. Either HttpException a -> Minio Bool
shouldRetry) ((RetryStatus -> Minio (Either HttpException a))
-> Minio (Either HttpException a))
-> (RetryStatus -> Minio (Either HttpException a))
-> Minio (Either HttpException a)
forall a b. (a -> b) -> a -> b
$
Minio (Either HttpException a)
-> RetryStatus -> Minio (Either HttpException a)
forall a b. a -> b -> a
const (Minio (Either HttpException a)
-> RetryStatus -> Minio (Either HttpException a))
-> Minio (Either HttpException a)
-> RetryStatus
-> Minio (Either HttpException a)
forall a b. (a -> b) -> a -> b
$
Minio a -> Minio (Either HttpException a)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try Minio a
apiCall
(HttpException -> Minio a)
-> (a -> Minio a) -> Either HttpException a -> Minio a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HttpException -> Minio a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO a -> Minio a
forall (m :: * -> *) a. Monad m => a -> m a
return Either HttpException a
resE
where
retryPolicy :: RetryPolicyM Minio
retryPolicy =
Int -> RetryPolicyM Minio -> RetryPolicyM Minio
forall (m :: * -> *).
Monad m =>
Int -> RetryPolicyM m -> RetryPolicyM m
limitRetriesByCumulativeDelay Int
tenMins (RetryPolicyM Minio -> RetryPolicyM Minio)
-> RetryPolicyM Minio -> RetryPolicyM Minio
forall a b. (a -> b) -> a -> b
$
Int -> RetryPolicyM Minio
forall (m :: * -> *). MonadIO m => Int -> RetryPolicyM m
fullJitterBackoff Int
oneMilliSecond
oneMilliSecond :: Int
oneMilliSecond = Int
1000
tenMins :: Int
tenMins = Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000
shouldRetry :: Either NC.HttpException a -> Minio Bool
shouldRetry :: Either HttpException a -> Minio Bool
shouldRetry Either HttpException a
resE =
case Either HttpException a
resE of
Right a
_ -> Bool -> Minio Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Left httpExn :: HttpException
httpExn@(NC.HttpExceptionRequest Request
_ HttpExceptionContent
exn) ->
case (HttpExceptionContent
exn :: NC.HttpExceptionContent) of
HttpExceptionContent
NC.ResponseTimeout -> Bool -> Minio Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
HttpExceptionContent
NC.ConnectionTimeout -> Bool -> Minio Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
NC.ConnectionFailure SomeException
_ -> Bool -> Minio Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
HttpExceptionContent
_ -> HttpException -> Minio Bool
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO HttpException
httpExn
Left HttpException
someOtherExn -> HttpException -> Minio Bool
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO HttpException
someOtherExn
executeRequest :: S3ReqInfo -> Minio (Response LByteString)
executeRequest :: S3ReqInfo -> Minio (Response LByteString)
executeRequest S3ReqInfo
ri = do
Request
req <- S3ReqInfo -> Minio Request
buildRequest S3ReqInfo
ri
Manager
mgr <- (MinioConn -> Manager) -> Minio Manager
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MinioConn -> Manager
mcConnManager
Minio (Response LByteString) -> Minio (Response LByteString)
forall a. Minio a -> Minio a
retryAPIRequest (Minio (Response LByteString) -> Minio (Response LByteString))
-> Minio (Response LByteString) -> Minio (Response LByteString)
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> Minio (Response LByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> Manager -> m (Response LByteString)
httpLbs Request
req Manager
mgr
mkStreamRequest ::
S3ReqInfo ->
Minio (Response (C.ConduitM () ByteString Minio ()))
mkStreamRequest :: S3ReqInfo -> Minio (Response (ConduitM () ByteString Minio ()))
mkStreamRequest S3ReqInfo
ri = do
Request
req <- S3ReqInfo -> Minio Request
buildRequest S3ReqInfo
ri
Manager
mgr <- (MinioConn -> Manager) -> Minio Manager
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MinioConn -> Manager
mcConnManager
Minio (Response (ConduitM () ByteString Minio ()))
-> Minio (Response (ConduitM () ByteString Minio ()))
forall a. Minio a -> Minio a
retryAPIRequest (Minio (Response (ConduitM () ByteString Minio ()))
-> Minio (Response (ConduitM () ByteString Minio ())))
-> Minio (Response (ConduitM () ByteString Minio ()))
-> Minio (Response (ConduitM () ByteString Minio ()))
forall a b. (a -> b) -> a -> b
$ Request
-> Manager -> Minio (Response (ConduitM () ByteString Minio ()))
forall (m :: * -> *).
(MonadUnliftIO m, MonadResource m) =>
Request -> Manager -> m (Response (ConduitT () ByteString m ()))
http Request
req Manager
mgr
isValidBucketName :: Bucket -> Bool
isValidBucketName :: Bucket -> Bool
isValidBucketName Bucket
bucket =
Bool -> Bool
not
( [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
[ Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3 Bool -> Bool -> Bool
|| Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
63,
(Bucket -> Bool) -> [Bucket] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Bucket -> Bool
labelCheck [Bucket]
labels,
(Bucket -> Bool) -> [Bucket] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Bucket -> Bool
labelCharsCheck [Bucket]
labels,
Bool
isIPCheck
]
)
where
len :: Int
len = Bucket -> Int
T.length Bucket
bucket
labels :: [Bucket]
labels = Bucket -> Bucket -> [Bucket]
T.splitOn Bucket
"." Bucket
bucket
labelCheck :: Bucket -> Bool
labelCheck Bucket
l = Bucket -> Int
T.length Bucket
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Bucket -> Char
T.head Bucket
l Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Bucket -> Char
T.last Bucket
l Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'
labelCharsCheck :: Bucket -> Bool
labelCharsCheck Bucket
l =
Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Char -> Bool) -> Maybe Char -> Bool
forall a b. (a -> b) -> a -> b
$
(Char -> Bool) -> Bucket -> Maybe Char
T.find
( \Char
x ->
Bool -> Bool
not
( Char -> Bool
C.isAsciiLower Char
x
Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'
Bool -> Bool -> Bool
|| Char -> Bool
C.isDigit Char
x
)
)
Bucket
l
labelNonDigits :: Bucket -> Bool
labelNonDigits Bucket
l = Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Char -> Bool) -> Maybe Char -> Bool
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Bucket -> Maybe Char
T.find (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
C.isDigit) Bucket
l
labelAsNums :: [Bool]
labelAsNums = (Bucket -> Bool) -> [Bucket] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Bool
not (Bool -> Bool) -> (Bucket -> Bool) -> Bucket -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bucket -> Bool
labelNonDigits) [Bucket]
labels
isIPCheck :: Bool
isIPCheck = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
labelAsNums Bool -> Bool -> Bool
&& [Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
labelAsNums Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4
checkBucketNameValidity :: MonadIO m => Bucket -> m ()
checkBucketNameValidity :: Bucket -> m ()
checkBucketNameValidity Bucket
bucket =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bucket -> Bool
isValidBucketName Bucket
bucket) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
MErrV -> m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (MErrV -> m ()) -> MErrV -> m ()
forall a b. (a -> b) -> a -> b
$
Bucket -> MErrV
MErrVInvalidBucketName Bucket
bucket
isValidObjectName :: Object -> Bool
isValidObjectName :: Bucket -> Bool
isValidObjectName Bucket
object =
Bucket -> Int
T.length Bucket
object Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& ByteString -> Int
B.length (Bucket -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Bucket
object) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1024
checkObjectNameValidity :: MonadIO m => Object -> m ()
checkObjectNameValidity :: Bucket -> m ()
checkObjectNameValidity Bucket
object =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bucket -> Bool
isValidObjectName Bucket
object) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
MErrV -> m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (MErrV -> m ()) -> MErrV -> m ()
forall a b. (a -> b) -> a -> b
$
Bucket -> MErrV
MErrVInvalidObjectName Bucket
object