module Network.Minio.API
( connect,
S3ReqInfo (..),
runMinio,
executeRequest,
buildRequest,
mkStreamRequest,
getLocation,
isValidBucketName,
checkBucketNameValidity,
isValidObjectName,
checkObjectNameValidity,
requestSTSCredential,
)
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 Network.HTTP.Client (defaultManagerSettings)
import qualified Network.HTTP.Client as NClient
import Network.HTTP.Conduit (Response)
import qualified Network.HTTP.Conduit as NC
import Network.HTTP.Types (simpleQueryToQuery)
import qualified Network.HTTP.Types as HT
import Network.HTTP.Types.Header (hHost)
import Network.Minio.APICommon
import Network.Minio.Credentials
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 :: Object -> Minio Object
getLocation Object
bucket = do
Response LByteString
resp <-
S3ReqInfo -> Minio (Response LByteString)
executeRequest forall a b. (a -> b) -> a -> b
$
S3ReqInfo
defaultS3ReqInfo
{ riBucket :: Maybe Object
riBucket = forall a. a -> Maybe a
Just Object
bucket,
riQueryParams :: Query
riQueryParams = [(ByteString
"location", forall a. Maybe a
Nothing)],
riNeedsLocation :: Bool
riNeedsLocation = Bool
False
}
forall (m :: * -> *). MonadIO m => LByteString -> m Object
parseLocation forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
NC.responseBody Response LByteString
resp
discoverRegion :: S3ReqInfo -> Minio (Maybe Region)
discoverRegion :: S3ReqInfo -> Minio (Maybe Object)
discoverRegion S3ReqInfo
ri = forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
Object
bucket <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ S3ReqInfo -> Maybe Object
riBucket S3ReqInfo
ri
Maybe Object
regionMay <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Object -> Minio (Maybe Object)
lookupRegionCache Object
bucket
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
( do
Object
l <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Object -> Minio Object
getLocation Object
bucket
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Object -> Object -> Minio ()
addToRegionCache Object
bucket Object
l
forall (m :: * -> *) a. Monad m => a -> m a
return Object
l
)
forall (m :: * -> *) a. Monad m => a -> m a
return
Maybe Object
regionMay
getRegion :: S3ReqInfo -> Minio (Maybe Region)
getRegion :: S3ReqInfo -> Minio (Maybe Object)
getRegion S3ReqInfo
ri = do
ConnectInfo
ci <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MinioConn -> ConnectInfo
mcConnInfo
if
| Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ S3ReqInfo -> Bool
riNeedsLocation S3ReqInfo
ri ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ConnectInfo -> Object
connectRegion ConnectInfo
ci
| Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ ConnectInfo -> Bool
connectAutoDiscoverRegion ConnectInfo
ci ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ConnectInfo -> Object
connectRegion ConnectInfo
ci
| Bool
otherwise -> S3ReqInfo -> Minio (Maybe Object)
discoverRegion S3ReqInfo
ri
getRegionHost :: Region -> Minio Text
getRegionHost :: Object -> Minio Object
getRegionHost Object
r = do
ConnectInfo
ci <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MinioConn -> ConnectInfo
mcConnInfo
if Object
"amazonaws.com" Object -> Object -> Bool
`T.isSuffixOf` ConnectInfo -> Object
connectHost ConnectInfo
ci
then
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ Object -> MErrV
MErrVRegionNotSupported Object
r)
forall (m :: * -> *) a. Monad m => a -> m a
return
(forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Object
r HashMap Object Object
awsRegionMap)
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ConnectInfo -> Object
connectHost ConnectInfo
ci
getHostPathRegion :: S3ReqInfo -> Minio (Text, ByteString, Maybe Region)
getHostPathRegion :: S3ReqInfo -> Minio (Object, ByteString, Maybe Object)
getHostPathRegion S3ReqInfo
ri = do
ConnectInfo
ci <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MinioConn -> ConnectInfo
mcConnInfo
Maybe Object
regionMay <- S3ReqInfo -> Minio (Maybe Object)
getRegion S3ReqInfo
ri
case S3ReqInfo -> Maybe Object
riBucket S3ReqInfo
ri of
Maybe Object
Nothing ->
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectInfo -> Object
connectHost ConnectInfo
ci, ByteString
"/", Maybe Object
regionMay)
Just Object
bucket -> do
Object
regionHost <- case Maybe Object
regionMay of
Maybe Object
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ConnectInfo -> Object
connectHost ConnectInfo
ci
Just Object
"" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ConnectInfo -> Object
connectHost ConnectInfo
ci
Just Object
r -> Object -> Minio Object
getRegionHost Object
r
let pathStyle :: (Object, ByteString, Maybe Object)
pathStyle =
( Object
regionHost,
Maybe Object -> Maybe Object -> ByteString
getS3Path (S3ReqInfo -> Maybe Object
riBucket S3ReqInfo
ri) (S3ReqInfo -> Maybe Object
riObject S3ReqInfo
ri),
Maybe Object
regionMay
)
virtualStyle :: (Object, ByteString, Maybe Object)
virtualStyle =
( Object
bucket forall a. Semigroup a => a -> a -> a
<> Object
"." forall a. Semigroup a => a -> a -> a
<> Object
regionHost,
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 forall a b. (a -> b) -> a -> b
$ Object
"/" forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a -> a
fromMaybe Object
"" (S3ReqInfo -> Maybe Object
riObject S3ReqInfo
ri),
Maybe Object
regionMay
)
( if ConnectInfo -> Bool
isAWSConnectInfo ConnectInfo
ci
then
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
if Object -> Bool
bucketHasPeriods Object
bucket
then (Object, ByteString, Maybe Object)
pathStyle
else (Object, ByteString, Maybe Object)
virtualStyle
else forall (m :: * -> *) a. Monad m => a -> m a
return (Object, ByteString, Maybe Object)
pathStyle
)
requestSTSCredential :: (STSCredentialProvider p) => p -> IO (CredentialValue, ExpiryTime)
requestSTSCredential :: forall p.
STSCredentialProvider p =>
p -> IO (CredentialValue, ExpiryTime)
requestSTSCredential p
p = do
Object
endpoint <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ MErrV -> MinioErr
MErrValidation MErrV
MErrVSTSEndpointNotFound) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall p. STSCredentialProvider p => p -> Maybe Object
getSTSEndpoint p
p
let endPt :: Request
endPt = String -> Request
NC.parseRequest_ forall a b. (a -> b) -> a -> b
$ forall a. ToString a => a -> String
toString Object
endpoint
settings :: ManagerSettings
settings
| Request -> Bool
NC.secure Request
endPt = ManagerSettings
NC.tlsManagerSettings
| Bool
otherwise = ManagerSettings
defaultManagerSettings
Manager
mgr <- ManagerSettings -> IO Manager
NC.newManager ManagerSettings
settings
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall p.
STSCredentialProvider p =>
p -> Endpoint -> Manager -> IO (CredentialValue, ExpiryTime)
retrieveSTSCredentials p
p (ByteString
"", Int
0, Bool
False) Manager
mgr
buildRequest :: S3ReqInfo -> Minio NC.Request
buildRequest :: S3ReqInfo -> Minio Request
buildRequest S3ReqInfo
ri = do
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall (m :: * -> *). MonadIO m => Object -> m ()
checkBucketNameValidity forall a b. (a -> b) -> a -> b
$ S3ReqInfo -> Maybe Object
riBucket S3ReqInfo
ri
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall (m :: * -> *). MonadIO m => Object -> m ()
checkObjectNameValidity forall a b. (a -> b) -> a -> b
$ S3ReqInfo -> Maybe Object
riObject S3ReqInfo
ri
ConnectInfo
ci <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MinioConn -> ConnectInfo
mcConnInfo
(Object
host, ByteString
path, Maybe Object
regionMay) <- S3ReqInfo -> Minio (Object, ByteString, Maybe Object)
getHostPathRegion S3ReqInfo
ri
let ci' :: ConnectInfo
ci' = ConnectInfo
ci {connectHost :: Object
connectHost = Object
host}
hostHeader :: (HeaderName, ByteString)
hostHeader = (HeaderName
hHost, ConnectInfo -> ByteString
getHostAddr ConnectInfo
ci')
ri' :: S3ReqInfo
ri' =
S3ReqInfo
ri
{ riHeaders :: [(HeaderName, ByteString)]
riHeaders = (HeaderName, ByteString)
hostHeader forall a. a -> [a] -> [a]
: S3ReqInfo -> [(HeaderName, ByteString)]
riHeaders S3ReqInfo
ri,
riRegion :: Maybe Object
riRegion = Maybe Object
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 = forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 forall a b. (a -> b) -> a -> b
$ ConnectInfo -> Object
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 forall a b. (a -> b) -> a -> b
$ S3ReqInfo -> Query
riQueryParams S3ReqInfo
ri'
}
UTCTime
timeStamp <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
Time.getCurrentTime
Manager
mgr <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MinioConn -> Manager
mcConnManager
CredentialValue
cv <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Creds -> Endpoint -> Manager -> IO CredentialValue
getCredential (ConnectInfo -> Creds
connectCreds ConnectInfo
ci') (ConnectInfo -> Endpoint
getEndpoint ConnectInfo
ci') Manager
mgr
let sp :: SignParams
sp =
Object
-> ScrubbedBytes
-> Maybe ScrubbedBytes
-> Service
-> UTCTime
-> Maybe Object
-> Maybe Int
-> Maybe ByteString
-> SignParams
SignParams
(coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ CredentialValue -> AccessKey
cvAccessKey CredentialValue
cv)
(coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ CredentialValue -> SecretKey
cvSecretKey CredentialValue
cv)
(coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ CredentialValue -> Maybe SessionToken
cvSessionToken CredentialValue
cv)
Service
ServiceS3
UTCTime
timeStamp
(S3ReqInfo -> Maybe Object
riRegion S3ReqInfo
ri')
(S3ReqInfo -> Maybe Int
riPresignExpirySecs S3ReqInfo
ri')
forall a. Maybe a
Nothing
if
| forall a. Maybe a -> Bool
isJust (S3ReqInfo -> Maybe Int
riPresignExpirySecs S3ReqInfo
ri') ->
do
let signPairs :: SimpleQuery
signPairs = SignParams -> Request -> SimpleQuery
signV4QueryParams SignParams
sp Request
baseRequest
qpToAdd :: Query
qpToAdd = SimpleQuery -> Query
simpleQueryToQuery SimpleQuery
signPairs
existingQueryParams :: Query
existingQueryParams = ByteString -> Query
HT.parseQuery (Request -> ByteString
NC.queryString Request
baseRequest)
updatedQueryParams :: Query
updatedQueryParams = Query
existingQueryParams forall a. [a] -> [a] -> [a]
++ Query
qpToAdd
forall (m :: * -> *) a. Monad m => a -> m a
return 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int64
l, ConduitT () ByteString (ResourceT IO) ()
src)
Payload
_ -> 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
forall (m :: * -> *) a. Monad m => a -> m a
return 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
forall (m :: * -> *) a. Monad m => a -> m a
return SignParams
sp
else
(
do
ByteString
pHash <- Payload -> Minio ByteString
getPayloadSHA256Hash forall a b. (a -> b) -> a -> b
$ S3ReqInfo -> Payload
riPayload S3ReqInfo
ri'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SignParams
sp {spPayloadHash :: Maybe ByteString
spPayloadHash = forall a. a -> Maybe a
Just ByteString
pHash}
)
)
let signHeaders :: [(HeaderName, ByteString)]
signHeaders = SignParams -> Request -> [(HeaderName, ByteString)]
signV4 SignParams
sp' Request
baseRequest
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
Request
baseRequest
{ requestHeaders :: [(HeaderName, ByteString)]
NC.requestHeaders =
Request -> [(HeaderName, ByteString)]
NC.requestHeaders Request
baseRequest forall a. [a] -> [a] -> [a]
++ [(HeaderName, ByteString)]
signHeaders,
requestBody :: RequestBody
NC.requestBody = Payload -> RequestBody
getRequestBody (S3ReqInfo -> Payload
riPayload S3ReqInfo
ri')
}
retryAPIRequest :: Minio a -> Minio a
retryAPIRequest :: forall a. Minio a -> Minio a
retryAPIRequest Minio a
apiCall = do
Either HttpException a
resE <-
forall (m :: * -> *) b.
MonadIO m =>
RetryPolicyM m
-> (RetryStatus -> b -> m Bool) -> (RetryStatus -> m b) -> m b
retrying RetryPolicyM Minio
retryPolicy (forall a b. a -> b -> a
const forall a. Either HttpException a -> Minio Bool
shouldRetry) forall a b. (a -> b) -> a -> b
$
forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try Minio a
apiCall
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall (m :: * -> *) a. Monad m => a -> m a
return Either HttpException a
resE
where
retryPolicy :: RetryPolicyM Minio
retryPolicy =
forall (m :: * -> *).
Monad m =>
Int -> RetryPolicyM m -> RetryPolicyM m
limitRetriesByCumulativeDelay Int
tenMins forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *). MonadIO m => Int -> RetryPolicyM m
fullJitterBackoff Int
oneMilliSecond
oneMilliSecond :: Int
oneMilliSecond = Int
1000
tenMins :: Int
tenMins = Int
10 forall a. Num a => a -> a -> a
* Int
60 forall a. Num a => a -> a -> a
* Int
1000000
shouldRetry :: Either NC.HttpException a -> Minio Bool
shouldRetry :: forall a. Either HttpException a -> Minio Bool
shouldRetry Either HttpException a
resE =
case Either HttpException a
resE of
Right a
_ -> 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
HttpExceptionContent
NC.ConnectionTimeout -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
NC.ConnectionFailure SomeException
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
HttpExceptionContent
_ -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO HttpException
httpExn
Left HttpException
someOtherExn -> 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 <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MinioConn -> Manager
mcConnManager
forall a. Minio a -> Minio a
retryAPIRequest forall a b. (a -> b) -> a -> b
$ 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 <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MinioConn -> Manager
mcConnManager
forall a. Minio a -> Minio a
retryAPIRequest forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadUnliftIO m, MonadResource m) =>
Request -> Manager -> m (Response (ConduitT () ByteString m ()))
http Request
req Manager
mgr
isValidBucketName :: Bucket -> Bool
isValidBucketName :: Object -> Bool
isValidBucketName Object
bucket =
Bool -> Bool
not
( forall (t :: * -> *). Foldable t => t Bool -> Bool
or
[ Int
len forall a. Ord a => a -> a -> Bool
< Int
3 Bool -> Bool -> Bool
|| Int
len forall a. Ord a => a -> a -> Bool
> Int
63,
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Object -> Bool
labelCheck [Object]
labels,
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Object -> Bool
labelCharsCheck [Object]
labels,
Bool
isIPCheck
]
)
where
len :: Int
len = Object -> Int
T.length Object
bucket
labels :: [Object]
labels = Object -> Object -> [Object]
T.splitOn Object
"." Object
bucket
labelCheck :: Object -> Bool
labelCheck Object
l = Object -> Int
T.length Object
l forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Object -> Char
T.head Object
l forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Object -> Char
T.last Object
l forall a. Eq a => a -> a -> Bool
== Char
'-'
labelCharsCheck :: Object -> Bool
labelCharsCheck Object
l =
forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$
(Char -> Bool) -> Object -> Maybe Char
T.find
( \Char
x ->
Bool -> Bool
not
( Char -> Bool
C.isAsciiLower Char
x
Bool -> Bool -> Bool
|| Char
x forall a. Eq a => a -> a -> Bool
== Char
'-'
Bool -> Bool -> Bool
|| Char -> Bool
C.isDigit Char
x
)
)
Object
l
labelNonDigits :: Object -> Bool
labelNonDigits Object
l = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Object -> Maybe Char
T.find (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
C.isDigit) Object
l
labelAsNums :: [Bool]
labelAsNums = forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Bool
labelNonDigits) [Object]
labels
isIPCheck :: Bool
isIPCheck = forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
labelAsNums Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
labelAsNums forall a. Eq a => a -> a -> Bool
== Int
4
checkBucketNameValidity :: (MonadIO m) => Bucket -> m ()
checkBucketNameValidity :: forall (m :: * -> *). MonadIO m => Object -> m ()
checkBucketNameValidity Object
bucket =
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Object -> Bool
isValidBucketName Object
bucket) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$
Object -> MErrV
MErrVInvalidBucketName Object
bucket
isValidObjectName :: Object -> Bool
isValidObjectName :: Object -> Bool
isValidObjectName Object
object =
Object -> Int
T.length Object
object forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& ByteString -> Int
B.length (forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Object
object) forall a. Ord a => a -> a -> Bool
<= Int
1024
checkObjectNameValidity :: (MonadIO m) => Object -> m ()
checkObjectNameValidity :: forall (m :: * -> *). MonadIO m => Object -> m ()
checkObjectNameValidity Object
object =
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Object -> Bool
isValidObjectName Object
object) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$
Object -> MErrV
MErrVInvalidObjectName Object
object