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:
Aditya Manthramurthy 2023-05-22 12:32:34 -07:00 committed by GitHub
parent fa62ed599a
commit 45e88d813b
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
15 changed files with 47 additions and 42 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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 $

View File

@ -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.

View File

@ -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

View File

@ -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 ->

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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)

View File

@ -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] ->

View File

@ -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 $

View File

@ -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

View File

@ -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"