Enable StrictData and bump up version for release (#189)
* Enable StrictData and bump up version for release - Types defined in Credentials.Types and Network.Minio.Data are now strict * ormolu fixes
This commit is contained in:
parent
fa62ed599a
commit
45e88d813b
4
.github/workflows/ci.yml
vendored
4
.github/workflows/ci.yml
vendored
@ -25,7 +25,9 @@ jobs:
|
|||||||
runs-on: ubuntu-latest
|
runs-on: ubuntu-latest
|
||||||
steps:
|
steps:
|
||||||
- uses: actions/checkout@v3
|
- uses: actions/checkout@v3
|
||||||
- uses: mrkkrp/ormolu-action@v8
|
- uses: haskell-actions/run-ormolu@v12
|
||||||
|
with:
|
||||||
|
version: "0.5.0.1"
|
||||||
|
|
||||||
hlint:
|
hlint:
|
||||||
runs-on: ubuntu-latest
|
runs-on: ubuntu-latest
|
||||||
|
|||||||
@ -1,6 +1,6 @@
|
|||||||
cabal-version: 2.4
|
cabal-version: 2.4
|
||||||
name: minio-hs
|
name: minio-hs
|
||||||
version: 1.6.0
|
version: 1.7.0
|
||||||
synopsis: A MinIO Haskell Library for Amazon S3 compatible cloud
|
synopsis: A MinIO Haskell Library for Amazon S3 compatible cloud
|
||||||
storage.
|
storage.
|
||||||
description: The MinIO Haskell client library provides simple APIs to
|
description: The MinIO Haskell client library provides simple APIs to
|
||||||
|
|||||||
@ -42,7 +42,7 @@ import UnliftIO as Exports
|
|||||||
both :: (a -> b) -> (a, a) -> (b, b)
|
both :: (a -> b) -> (a, a) -> (b, b)
|
||||||
both f (a, b) = (f a, f b)
|
both f (a, b) = (f a, f b)
|
||||||
|
|
||||||
showBS :: Show a => a -> ByteString
|
showBS :: (Show a) => a -> ByteString
|
||||||
showBS a = encodeUtf8 (show a :: Text)
|
showBS a = encodeUtf8 (show a :: Text)
|
||||||
|
|
||||||
toStrictBS :: LByteString -> ByteString
|
toStrictBS :: LByteString -> ByteString
|
||||||
|
|||||||
@ -150,7 +150,7 @@ getHostPathRegion ri = do
|
|||||||
-- | requestSTSCredential requests temporary credentials using the Security Token
|
-- | requestSTSCredential requests temporary credentials using the Security Token
|
||||||
-- Service API. The returned credential will include a populated 'SessionToken'
|
-- Service API. The returned credential will include a populated 'SessionToken'
|
||||||
-- and an 'ExpiryTime'.
|
-- and an 'ExpiryTime'.
|
||||||
requestSTSCredential :: STSCredentialProvider p => p -> IO (CredentialValue, ExpiryTime)
|
requestSTSCredential :: (STSCredentialProvider p) => p -> IO (CredentialValue, ExpiryTime)
|
||||||
requestSTSCredential p = do
|
requestSTSCredential p = do
|
||||||
endpoint <- maybe (throwIO $ MErrValidation MErrVSTSEndpointNotFound) return $ getSTSEndpoint p
|
endpoint <- maybe (throwIO $ MErrValidation MErrVSTSEndpointNotFound) return $ getSTSEndpoint p
|
||||||
let endPt = NC.parseRequest_ $ toString endpoint
|
let endPt = NC.parseRequest_ $ toString endpoint
|
||||||
@ -337,7 +337,7 @@ isValidBucketName bucket =
|
|||||||
isIPCheck = and labelAsNums && length labelAsNums == 4
|
isIPCheck = and labelAsNums && length labelAsNums == 4
|
||||||
|
|
||||||
-- Throws exception iff bucket name is invalid according to AWS rules.
|
-- Throws exception iff bucket name is invalid according to AWS rules.
|
||||||
checkBucketNameValidity :: MonadIO m => Bucket -> m ()
|
checkBucketNameValidity :: (MonadIO m) => Bucket -> m ()
|
||||||
checkBucketNameValidity bucket =
|
checkBucketNameValidity bucket =
|
||||||
unless (isValidBucketName bucket) $
|
unless (isValidBucketName bucket) $
|
||||||
throwIO $
|
throwIO $
|
||||||
@ -347,7 +347,7 @@ isValidObjectName :: Object -> Bool
|
|||||||
isValidObjectName object =
|
isValidObjectName object =
|
||||||
T.length object > 0 && B.length (encodeUtf8 object) <= 1024
|
T.length object > 0 && B.length (encodeUtf8 object) <= 1024
|
||||||
|
|
||||||
checkObjectNameValidity :: MonadIO m => Object -> m ()
|
checkObjectNameValidity :: (MonadIO m) => Object -> m ()
|
||||||
checkObjectNameValidity object =
|
checkObjectNameValidity object =
|
||||||
unless (isValidObjectName object) $
|
unless (isValidObjectName object) $
|
||||||
throwIO $
|
throwIO $
|
||||||
|
|||||||
@ -47,7 +47,7 @@ data STSCredentialStore = STSCredentialStore
|
|||||||
refreshAction :: Endpoint -> NC.Manager -> IO (CredentialValue, ExpiryTime)
|
refreshAction :: Endpoint -> NC.Manager -> IO (CredentialValue, ExpiryTime)
|
||||||
}
|
}
|
||||||
|
|
||||||
initSTSCredential :: STSCredentialProvider p => p -> IO STSCredentialStore
|
initSTSCredential :: (STSCredentialProvider p) => p -> IO STSCredentialStore
|
||||||
initSTSCredential p = do
|
initSTSCredential p = do
|
||||||
let action = retrieveSTSCredentials p
|
let action = retrieveSTSCredentials p
|
||||||
-- start with dummy credential, so that refresh happens for first request.
|
-- start with dummy credential, so that refresh happens for first request.
|
||||||
|
|||||||
@ -41,6 +41,8 @@ defaultDurationSeconds :: Second
|
|||||||
defaultDurationSeconds = 3600
|
defaultDurationSeconds = 3600
|
||||||
|
|
||||||
-- | Assume Role API argument.
|
-- | Assume Role API argument.
|
||||||
|
--
|
||||||
|
-- @since 1.7.0
|
||||||
data STSAssumeRole = STSAssumeRole
|
data STSAssumeRole = STSAssumeRole
|
||||||
{ -- | Credentials to use in the AssumeRole STS API.
|
{ -- | Credentials to use in the AssumeRole STS API.
|
||||||
sarCredentials :: CredentialValue,
|
sarCredentials :: CredentialValue,
|
||||||
@ -119,7 +121,7 @@ data AssumeRoleResult = AssumeRoleResult
|
|||||||
-- <RequestId>c6104cbe-af31-11e0-8154-cbc7ccf896c7</RequestId>
|
-- <RequestId>c6104cbe-af31-11e0-8154-cbc7ccf896c7</RequestId>
|
||||||
-- </ResponseMetadata>
|
-- </ResponseMetadata>
|
||||||
-- </AssumeRoleResponse>
|
-- </AssumeRoleResponse>
|
||||||
parseSTSAssumeRoleResult :: MonadIO m => ByteString -> Text -> m AssumeRoleResult
|
parseSTSAssumeRoleResult :: (MonadIO m) => ByteString -> Text -> m AssumeRoleResult
|
||||||
parseSTSAssumeRoleResult xmldata namespace = do
|
parseSTSAssumeRoleResult xmldata namespace = do
|
||||||
r <- parseRoot $ LB.fromStrict xmldata
|
r <- parseRoot $ LB.fromStrict xmldata
|
||||||
let s3Elem' = s3Elem namespace
|
let s3Elem' = s3Elem namespace
|
||||||
|
|||||||
@ -14,6 +14,7 @@
|
|||||||
-- limitations under the License.
|
-- limitations under the License.
|
||||||
--
|
--
|
||||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
|
{-# LANGUAGE StrictData #-}
|
||||||
|
|
||||||
module Network.Minio.Credentials.Types where
|
module Network.Minio.Credentials.Types where
|
||||||
|
|
||||||
@ -37,11 +38,13 @@ newtype SessionToken = SessionToken {unSessionToken :: BA.ScrubbedBytes}
|
|||||||
deriving newtype (Eq, IsString, Semigroup, Monoid)
|
deriving newtype (Eq, IsString, Semigroup, Monoid)
|
||||||
|
|
||||||
-- | Object storage credential data type. It has support for the optional
|
-- | Object storage credential data type. It has support for the optional
|
||||||
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_credentials_temp_use-resources.html
|
-- [SessionToken](https://docs.aws.amazon.com/IAM/latest/UserGuide/id_credentials_temp_use-resources.html)
|
||||||
-- SessionToken> for using temporary credentials requested via STS.
|
-- for using temporary credentials requested via STS.
|
||||||
--
|
--
|
||||||
-- The show instance for this type does not print the value of secrets for
|
-- The show instance for this type does not print the value of secrets for
|
||||||
-- security.
|
-- security.
|
||||||
|
--
|
||||||
|
-- @since 1.7.0
|
||||||
data CredentialValue = CredentialValue
|
data CredentialValue = CredentialValue
|
||||||
{ cvAccessKey :: AccessKey,
|
{ cvAccessKey :: AccessKey,
|
||||||
cvSecretKey :: SecretKey,
|
cvSecretKey :: SecretKey,
|
||||||
@ -70,6 +73,8 @@ credentialValueText cv =
|
|||||||
type Endpoint = (ByteString, Int, Bool)
|
type Endpoint = (ByteString, Int, Bool)
|
||||||
|
|
||||||
-- | Typeclass for STS credential providers.
|
-- | Typeclass for STS credential providers.
|
||||||
|
--
|
||||||
|
-- @since 1.7.0
|
||||||
class STSCredentialProvider p where
|
class STSCredentialProvider p where
|
||||||
retrieveSTSCredentials ::
|
retrieveSTSCredentials ::
|
||||||
p ->
|
p ->
|
||||||
|
|||||||
@ -16,6 +16,7 @@
|
|||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
{-# LANGUAGE GADTs #-}
|
{-# LANGUAGE GADTs #-}
|
||||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
|
{-# LANGUAGE StrictData #-}
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
|
||||||
module Network.Minio.Data where
|
module Network.Minio.Data where
|
||||||
@ -156,15 +157,10 @@ instance IsString ConnectInfo where
|
|||||||
connectDisableTLSCertValidation = False
|
connectDisableTLSCertValidation = False
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Contains access key and secret key to access object storage.
|
|
||||||
data Credentials = Credentials
|
|
||||||
{ cAccessKey :: Text,
|
|
||||||
cSecretKey :: Text
|
|
||||||
}
|
|
||||||
deriving stock (Eq, Show)
|
|
||||||
|
|
||||||
-- | A 'CredentialLoader' is an action that may return a 'CredentialValue'.
|
-- | A 'CredentialLoader' is an action that may return a 'CredentialValue'.
|
||||||
-- Loaders may be chained together using 'findFirst'.
|
-- Loaders may be chained together using 'findFirst'.
|
||||||
|
--
|
||||||
|
-- @since 1.7.0
|
||||||
type CredentialLoader = IO (Maybe CredentialValue)
|
type CredentialLoader = IO (Maybe CredentialValue)
|
||||||
|
|
||||||
-- | Combines the given list of loaders, by calling each one in
|
-- | Combines the given list of loaders, by calling each one in
|
||||||
@ -232,7 +228,7 @@ setCreds cv connInfo =
|
|||||||
-- | 'setSTSCredential' configures `ConnectInfo` to retrieve temporary
|
-- | 'setSTSCredential' configures `ConnectInfo` to retrieve temporary
|
||||||
-- credentials via the STS API on demand. It is automatically refreshed on
|
-- credentials via the STS API on demand. It is automatically refreshed on
|
||||||
-- expiry.
|
-- expiry.
|
||||||
setSTSCredential :: STSCredentialProvider p => p -> ConnectInfo -> IO ConnectInfo
|
setSTSCredential :: (STSCredentialProvider p) => p -> ConnectInfo -> IO ConnectInfo
|
||||||
setSTSCredential p ci = do
|
setSTSCredential p ci = do
|
||||||
store <- initSTSCredential p
|
store <- initSTSCredential p
|
||||||
return ci {connectCreds = CredsSTS store}
|
return ci {connectCreds = CredsSTS store}
|
||||||
@ -308,7 +304,7 @@ newtype SSECKey = SSECKey BA.ScrubbedBytes
|
|||||||
|
|
||||||
-- | Validates that the given ByteString is 32 bytes long and creates
|
-- | Validates that the given ByteString is 32 bytes long and creates
|
||||||
-- an encryption key.
|
-- an encryption key.
|
||||||
mkSSECKey :: MonadThrow m => ByteString -> m SSECKey
|
mkSSECKey :: (MonadThrow m) => ByteString -> m SSECKey
|
||||||
mkSSECKey keyBytes
|
mkSSECKey keyBytes
|
||||||
| B.length keyBytes /= 32 =
|
| B.length keyBytes /= 32 =
|
||||||
throwM MErrVInvalidEncryptionKeyLength
|
throwM MErrVInvalidEncryptionKeyLength
|
||||||
@ -325,7 +321,7 @@ data SSE where
|
|||||||
-- argument is the optional KMS context that must have a
|
-- argument is the optional KMS context that must have a
|
||||||
-- `A.ToJSON` instance - please refer to the AWS S3 documentation
|
-- `A.ToJSON` instance - please refer to the AWS S3 documentation
|
||||||
-- for detailed information.
|
-- for detailed information.
|
||||||
SSEKMS :: A.ToJSON a => Maybe ByteString -> Maybe a -> SSE
|
SSEKMS :: (A.ToJSON a) => Maybe ByteString -> Maybe a -> SSE
|
||||||
-- | Specifies server-side encryption with customer provided
|
-- | Specifies server-side encryption with customer provided
|
||||||
-- key. The argument is the encryption key to be used.
|
-- key. The argument is the encryption key to be used.
|
||||||
SSEC :: SSECKey -> SSE
|
SSEC :: SSECKey -> SSE
|
||||||
|
|||||||
@ -43,26 +43,26 @@ import qualified Data.Conduit as C
|
|||||||
hashSHA256 :: ByteString -> ByteString
|
hashSHA256 :: ByteString -> ByteString
|
||||||
hashSHA256 = digestToBase16 . hashWith SHA256
|
hashSHA256 = digestToBase16 . hashWith SHA256
|
||||||
|
|
||||||
hashSHA256FromSource :: Monad m => C.ConduitM () ByteString m () -> m ByteString
|
hashSHA256FromSource :: (Monad m) => C.ConduitM () ByteString m () -> m ByteString
|
||||||
hashSHA256FromSource src = do
|
hashSHA256FromSource src = do
|
||||||
digest <- C.connect src sinkSHA256Hash
|
digest <- C.connect src sinkSHA256Hash
|
||||||
return $ digestToBase16 digest
|
return $ digestToBase16 digest
|
||||||
where
|
where
|
||||||
-- To help with type inference
|
-- To help with type inference
|
||||||
sinkSHA256Hash :: Monad m => C.ConduitM ByteString Void m (Digest SHA256)
|
sinkSHA256Hash :: (Monad m) => C.ConduitM ByteString Void m (Digest SHA256)
|
||||||
sinkSHA256Hash = sinkHash
|
sinkSHA256Hash = sinkHash
|
||||||
|
|
||||||
-- Returns MD5 hash hex encoded.
|
-- Returns MD5 hash hex encoded.
|
||||||
hashMD5 :: ByteString -> ByteString
|
hashMD5 :: ByteString -> ByteString
|
||||||
hashMD5 = digestToBase16 . hashWith MD5
|
hashMD5 = digestToBase16 . hashWith MD5
|
||||||
|
|
||||||
hashMD5FromSource :: Monad m => C.ConduitM () ByteString m () -> m ByteString
|
hashMD5FromSource :: (Monad m) => C.ConduitM () ByteString m () -> m ByteString
|
||||||
hashMD5FromSource src = do
|
hashMD5FromSource src = do
|
||||||
digest <- C.connect src sinkMD5Hash
|
digest <- C.connect src sinkMD5Hash
|
||||||
return $ digestToBase16 digest
|
return $ digestToBase16 digest
|
||||||
where
|
where
|
||||||
-- To help with type inference
|
-- To help with type inference
|
||||||
sinkMD5Hash :: Monad m => C.ConduitM ByteString Void m (Digest MD5)
|
sinkMD5Hash :: (Monad m) => C.ConduitM ByteString Void m (Digest MD5)
|
||||||
sinkMD5Hash = sinkHash
|
sinkMD5Hash = sinkHash
|
||||||
|
|
||||||
hmacSHA256 :: ByteString -> ByteString -> HMAC SHA256
|
hmacSHA256 :: ByteString -> ByteString -> HMAC SHA256
|
||||||
@ -71,15 +71,15 @@ hmacSHA256 message key = hmac key message
|
|||||||
hmacSHA256RawBS :: ByteString -> ByteString -> ByteString
|
hmacSHA256RawBS :: ByteString -> ByteString -> ByteString
|
||||||
hmacSHA256RawBS message key = convert $ hmacSHA256 message key
|
hmacSHA256RawBS message key = convert $ hmacSHA256 message key
|
||||||
|
|
||||||
digestToBS :: ByteArrayAccess a => a -> ByteString
|
digestToBS :: (ByteArrayAccess a) => a -> ByteString
|
||||||
digestToBS = convert
|
digestToBS = convert
|
||||||
|
|
||||||
digestToBase16 :: ByteArrayAccess a => a -> ByteString
|
digestToBase16 :: (ByteArrayAccess a) => a -> ByteString
|
||||||
digestToBase16 = convertToBase Base16
|
digestToBase16 = convertToBase Base16
|
||||||
|
|
||||||
-- Returns MD5 hash base 64 encoded.
|
-- Returns MD5 hash base 64 encoded.
|
||||||
hashMD5ToBase64 :: ByteArrayAccess a => a -> ByteString
|
hashMD5ToBase64 :: (ByteArrayAccess a) => a -> ByteString
|
||||||
hashMD5ToBase64 = convertToBase Base64 . hashWith MD5
|
hashMD5ToBase64 = convertToBase Base64 . hashWith MD5
|
||||||
|
|
||||||
encodeToBase64 :: ByteArrayAccess a => a -> ByteString
|
encodeToBase64 :: (ByteArrayAccess a) => a -> ByteString
|
||||||
encodeToBase64 = convertToBase Base64
|
encodeToBase64 = convertToBase Base64
|
||||||
|
|||||||
@ -119,7 +119,7 @@ instance Exception EventStreamException
|
|||||||
chunkSize :: Int
|
chunkSize :: Int
|
||||||
chunkSize = 32 * 1024
|
chunkSize = 32 * 1024
|
||||||
|
|
||||||
parseBinary :: Bin.Binary a => ByteString -> IO a
|
parseBinary :: (Bin.Binary a) => ByteString -> IO a
|
||||||
parseBinary b = do
|
parseBinary b = do
|
||||||
case Bin.decodeOrFail $ LB.fromStrict b of
|
case Bin.decodeOrFail $ LB.fromStrict b of
|
||||||
Left (_, _, msg) -> throwIO $ ESEDecodeFail msg
|
Left (_, _, msg) -> throwIO $ ESEDecodeFail msg
|
||||||
@ -135,7 +135,7 @@ bytesToHeaderName t = case t of
|
|||||||
_ -> throwIO ESEInvalidHeaderType
|
_ -> throwIO ESEInvalidHeaderType
|
||||||
|
|
||||||
parseHeaders ::
|
parseHeaders ::
|
||||||
MonadUnliftIO m =>
|
(MonadUnliftIO m) =>
|
||||||
Word32 ->
|
Word32 ->
|
||||||
C.ConduitM ByteString a m [MessageHeader]
|
C.ConduitM ByteString a m [MessageHeader]
|
||||||
parseHeaders 0 = return []
|
parseHeaders 0 = return []
|
||||||
@ -163,7 +163,7 @@ parseHeaders hdrLen = do
|
|||||||
|
|
||||||
-- readNBytes returns N bytes read from the string and throws an
|
-- readNBytes returns N bytes read from the string and throws an
|
||||||
-- exception if N bytes are not present on the stream.
|
-- exception if N bytes are not present on the stream.
|
||||||
readNBytes :: MonadUnliftIO m => Int -> C.ConduitM ByteString a m ByteString
|
readNBytes :: (MonadUnliftIO m) => Int -> C.ConduitM ByteString a m ByteString
|
||||||
readNBytes n = do
|
readNBytes n = do
|
||||||
b <- LB.toStrict <$> (C.takeCE n .| C.sinkLazy)
|
b <- LB.toStrict <$> (C.takeCE n .| C.sinkLazy)
|
||||||
if B.length b /= n
|
if B.length b /= n
|
||||||
@ -171,7 +171,7 @@ readNBytes n = do
|
|||||||
else return b
|
else return b
|
||||||
|
|
||||||
crcCheck ::
|
crcCheck ::
|
||||||
MonadUnliftIO m =>
|
(MonadUnliftIO m) =>
|
||||||
C.ConduitM ByteString ByteString m ()
|
C.ConduitM ByteString ByteString m ()
|
||||||
crcCheck = do
|
crcCheck = do
|
||||||
b <- readNBytes 12
|
b <- readNBytes 12
|
||||||
@ -208,7 +208,7 @@ crcCheck = do
|
|||||||
then accumulateYield n' c'
|
then accumulateYield n' c'
|
||||||
else return c'
|
else return c'
|
||||||
|
|
||||||
handleMessage :: MonadUnliftIO m => C.ConduitT ByteString EventMessage m ()
|
handleMessage :: (MonadUnliftIO m) => C.ConduitT ByteString EventMessage m ()
|
||||||
handleMessage = do
|
handleMessage = do
|
||||||
b1 <- readNBytes 4
|
b1 <- readNBytes 4
|
||||||
msgLen :: Word32 <- liftIO $ parseBinary b1
|
msgLen :: Word32 <- liftIO $ parseBinary b1
|
||||||
@ -254,7 +254,7 @@ handleMessage = do
|
|||||||
passThrough $ n - B.length b
|
passThrough $ n - B.length b
|
||||||
|
|
||||||
selectProtoConduit ::
|
selectProtoConduit ::
|
||||||
MonadUnliftIO m =>
|
(MonadUnliftIO m) =>
|
||||||
C.ConduitT ByteString EventMessage m ()
|
C.ConduitT ByteString EventMessage m ()
|
||||||
selectProtoConduit = crcCheck .| handleMessage
|
selectProtoConduit = crcCheck .| handleMessage
|
||||||
|
|
||||||
@ -281,7 +281,7 @@ selectObjectContent b o r = do
|
|||||||
return $ NC.responseBody resp .| selectProtoConduit
|
return $ NC.responseBody resp .| selectProtoConduit
|
||||||
|
|
||||||
-- | A helper conduit that returns only the record payload bytes.
|
-- | A helper conduit that returns only the record payload bytes.
|
||||||
getPayloadBytes :: MonadIO m => C.ConduitT EventMessage ByteString m ()
|
getPayloadBytes :: (MonadIO m) => C.ConduitT EventMessage ByteString m ()
|
||||||
getPayloadBytes = do
|
getPayloadBytes = do
|
||||||
evM <- C.await
|
evM <- C.await
|
||||||
case evM of
|
case evM of
|
||||||
|
|||||||
@ -346,7 +346,7 @@ chunkSizeConstant = 64 * 1024
|
|||||||
|
|
||||||
-- base16Len computes the number of bytes required to represent @n (> 0)@ in
|
-- base16Len computes the number of bytes required to represent @n (> 0)@ in
|
||||||
-- hexadecimal.
|
-- hexadecimal.
|
||||||
base16Len :: Integral a => a -> Int
|
base16Len :: (Integral a) => a -> Int
|
||||||
base16Len n
|
base16Len n
|
||||||
| n == 0 = 0
|
| n == 0 = 0
|
||||||
| otherwise = 1 + base16Len (n `div` 16)
|
| otherwise = 1 + base16Len (n `div` 16)
|
||||||
|
|||||||
@ -175,7 +175,7 @@ isSuccessStatus sts =
|
|||||||
in (s >= 200 && s < 300)
|
in (s >= 200 && s < 300)
|
||||||
|
|
||||||
httpLbs ::
|
httpLbs ::
|
||||||
MonadIO m =>
|
(MonadIO m) =>
|
||||||
NC.Request ->
|
NC.Request ->
|
||||||
NC.Manager ->
|
NC.Manager ->
|
||||||
m (NC.Response LByteString)
|
m (NC.Response LByteString)
|
||||||
@ -239,7 +239,7 @@ http req mgr = do
|
|||||||
-- Similar to mapConcurrently but limits the number of threads that
|
-- Similar to mapConcurrently but limits the number of threads that
|
||||||
-- can run using a quantity semaphore.
|
-- can run using a quantity semaphore.
|
||||||
limitedMapConcurrently ::
|
limitedMapConcurrently ::
|
||||||
MonadUnliftIO m =>
|
(MonadUnliftIO m) =>
|
||||||
Int ->
|
Int ->
|
||||||
(t -> m a) ->
|
(t -> m a) ->
|
||||||
[t] ->
|
[t] ->
|
||||||
|
|||||||
@ -35,7 +35,7 @@ uncurry6 :: (a -> b -> c -> d -> e -> f -> g) -> (a, b, c, d, e, f) -> g
|
|||||||
uncurry6 f (a, b, c, d, e, g) = f a b c d e g
|
uncurry6 f (a, b, c, d, e, g) = f a b c d e g
|
||||||
|
|
||||||
-- | Parse time strings from XML
|
-- | Parse time strings from XML
|
||||||
parseS3XMLTime :: MonadIO m => Text -> m UTCTime
|
parseS3XMLTime :: (MonadIO m) => Text -> m UTCTime
|
||||||
parseS3XMLTime t =
|
parseS3XMLTime t =
|
||||||
maybe (throwIO $ MErrVXmlParse $ "timestamp parse failure: " <> t) return $
|
maybe (throwIO $ MErrVXmlParse $ "timestamp parse failure: " <> t) return $
|
||||||
iso8601ParseM $
|
iso8601ParseM $
|
||||||
|
|||||||
@ -218,7 +218,7 @@ parseNotification xmldata = do
|
|||||||
events
|
events
|
||||||
(Filter $ FilterKey $ FilterRules rules)
|
(Filter $ FilterKey $ FilterRules rules)
|
||||||
|
|
||||||
parseSelectProgress :: MonadIO m => ByteString -> m Progress
|
parseSelectProgress :: (MonadIO m) => ByteString -> m Progress
|
||||||
parseSelectProgress xmldata = do
|
parseSelectProgress xmldata = do
|
||||||
r <- parseRoot $ LB.fromStrict xmldata
|
r <- parseRoot $ LB.fromStrict xmldata
|
||||||
let bScanned = T.concat $ r $/ element "BytesScanned" &/ content
|
let bScanned = T.concat $ r $/ element "BytesScanned" &/ content
|
||||||
|
|||||||
@ -50,7 +50,7 @@ tests :: TestTree
|
|||||||
tests = testGroup "Tests" [liveServerUnitTests]
|
tests = testGroup "Tests" [liveServerUnitTests]
|
||||||
|
|
||||||
-- conduit that generates random binary stream of given length
|
-- conduit that generates random binary stream of given length
|
||||||
randomDataSrc :: MonadIO m => Int64 -> C.ConduitM () ByteString m ()
|
randomDataSrc :: (MonadIO m) => Int64 -> C.ConduitM () ByteString m ()
|
||||||
randomDataSrc = genBS
|
randomDataSrc = genBS
|
||||||
where
|
where
|
||||||
concatIt bs n =
|
concatIt bs n =
|
||||||
@ -68,7 +68,7 @@ randomDataSrc = genBS
|
|||||||
yield $ concatIt byteArr64 oneMiB
|
yield $ concatIt byteArr64 oneMiB
|
||||||
genBS (s - oneMiB)
|
genBS (s - oneMiB)
|
||||||
|
|
||||||
mkRandFile :: R.MonadResource m => Int64 -> m FilePath
|
mkRandFile :: (R.MonadResource m) => Int64 -> m FilePath
|
||||||
mkRandFile size = do
|
mkRandFile size = do
|
||||||
dir <- liftIO getTemporaryDirectory
|
dir <- liftIO getTemporaryDirectory
|
||||||
C.runConduit $ randomDataSrc size C..| CB.sinkTempFile dir "miniohstest.random"
|
C.runConduit $ randomDataSrc size C..| CB.sinkTempFile dir "miniohstest.random"
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user