Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Enable StrictData and bump up version for release #189

Merged
merged 2 commits into from
May 22, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 3 additions & 1 deletion .github/workflows/ci.yml
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,9 @@ jobs:
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v3
- uses: mrkkrp/ormolu-action@v8
- uses: haskell-actions/run-ormolu@v12
with:
version: "0.5.0.1"

hlint:
runs-on: ubuntu-latest
Expand Down
2 changes: 1 addition & 1 deletion minio-hs.cabal
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
cabal-version: 2.4
name: minio-hs
version: 1.6.0
version: 1.7.0
synopsis: A MinIO Haskell Library for Amazon S3 compatible cloud
storage.
description: The MinIO Haskell client library provides simple APIs to
Expand Down
2 changes: 1 addition & 1 deletion src/Lib/Prelude.hs
Original file line number Diff line number Diff line change
Expand Up @@ -42,7 +42,7 @@ import UnliftIO as Exports
both :: (a -> b) -> (a, a) -> (b, 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)

toStrictBS :: LByteString -> ByteString
Expand Down
6 changes: 3 additions & 3 deletions src/Network/Minio/API.hs
Original file line number Diff line number Diff line change
Expand Up @@ -150,7 +150,7 @@ getHostPathRegion ri = do
-- | requestSTSCredential requests temporary credentials using the Security Token
-- Service API. The returned credential will include a populated 'SessionToken'
-- and an 'ExpiryTime'.
requestSTSCredential :: STSCredentialProvider p => p -> IO (CredentialValue, ExpiryTime)
requestSTSCredential :: (STSCredentialProvider p) => p -> IO (CredentialValue, ExpiryTime)
requestSTSCredential p = do
endpoint <- maybe (throwIO $ MErrValidation MErrVSTSEndpointNotFound) return $ getSTSEndpoint p
let endPt = NC.parseRequest_ $ toString endpoint
Expand Down Expand Up @@ -337,7 +337,7 @@ isValidBucketName bucket =
isIPCheck = and labelAsNums && length labelAsNums == 4

-- Throws exception iff bucket name is invalid according to AWS rules.
checkBucketNameValidity :: MonadIO m => Bucket -> m ()
checkBucketNameValidity :: (MonadIO m) => Bucket -> m ()
checkBucketNameValidity bucket =
unless (isValidBucketName bucket) $
throwIO $
Expand All @@ -347,7 +347,7 @@ isValidObjectName :: Object -> Bool
isValidObjectName object =
T.length object > 0 && B.length (encodeUtf8 object) <= 1024

checkObjectNameValidity :: MonadIO m => Object -> m ()
checkObjectNameValidity :: (MonadIO m) => Object -> m ()
checkObjectNameValidity object =
unless (isValidObjectName object) $
throwIO $
Expand Down
2 changes: 1 addition & 1 deletion src/Network/Minio/Credentials.hs
Original file line number Diff line number Diff line change
Expand Up @@ -47,7 +47,7 @@ data STSCredentialStore = STSCredentialStore
refreshAction :: Endpoint -> NC.Manager -> IO (CredentialValue, ExpiryTime)
}

initSTSCredential :: STSCredentialProvider p => p -> IO STSCredentialStore
initSTSCredential :: (STSCredentialProvider p) => p -> IO STSCredentialStore
initSTSCredential p = do
let action = retrieveSTSCredentials p
-- start with dummy credential, so that refresh happens for first request.
Expand Down
4 changes: 3 additions & 1 deletion src/Network/Minio/Credentials/AssumeRole.hs
Original file line number Diff line number Diff line change
Expand Up @@ -41,6 +41,8 @@ defaultDurationSeconds :: Second
defaultDurationSeconds = 3600

-- | Assume Role API argument.
--
-- @since 1.7.0
data STSAssumeRole = STSAssumeRole
{ -- | Credentials to use in the AssumeRole STS API.
sarCredentials :: CredentialValue,
Expand Down Expand Up @@ -119,7 +121,7 @@ data AssumeRoleResult = AssumeRoleResult
-- <RequestId>c6104cbe-af31-11e0-8154-cbc7ccf896c7</RequestId>
-- </ResponseMetadata>
-- </AssumeRoleResponse>
parseSTSAssumeRoleResult :: MonadIO m => ByteString -> Text -> m AssumeRoleResult
parseSTSAssumeRoleResult :: (MonadIO m) => ByteString -> Text -> m AssumeRoleResult
parseSTSAssumeRoleResult xmldata namespace = do
r <- parseRoot $ LB.fromStrict xmldata
let s3Elem' = s3Elem namespace
Expand Down
9 changes: 7 additions & 2 deletions src/Network/Minio/Credentials/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,7 @@
-- limitations under the License.
--
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StrictData #-}

module Network.Minio.Credentials.Types where

Expand All @@ -37,11 +38,13 @@ newtype SessionToken = SessionToken {unSessionToken :: BA.ScrubbedBytes}
deriving newtype (Eq, IsString, Semigroup, Monoid)

-- | 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> for using temporary credentials requested via STS.
-- [SessionToken](https://docs.aws.amazon.com/IAM/latest/UserGuide/id_credentials_temp_use-resources.html)
-- for using temporary credentials requested via STS.
--
-- The show instance for this type does not print the value of secrets for
-- security.
--
-- @since 1.7.0
data CredentialValue = CredentialValue
{ cvAccessKey :: AccessKey,
cvSecretKey :: SecretKey,
Expand Down Expand Up @@ -70,6 +73,8 @@ credentialValueText cv =
type Endpoint = (ByteString, Int, Bool)

-- | Typeclass for STS credential providers.
--
-- @since 1.7.0
class STSCredentialProvider p where
retrieveSTSCredentials ::
p ->
Expand Down
16 changes: 6 additions & 10 deletions src/Network/Minio/Data.hs
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,7 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}

module Network.Minio.Data where
Expand Down Expand Up @@ -156,15 +157,10 @@ instance IsString ConnectInfo where
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'.
-- Loaders may be chained together using 'findFirst'.
--
-- @since 1.7.0
type CredentialLoader = IO (Maybe CredentialValue)

-- | Combines the given list of loaders, by calling each one in
Expand Down Expand Up @@ -232,7 +228,7 @@ setCreds cv connInfo =
-- | 'setSTSCredential' configures `ConnectInfo` to retrieve temporary
-- credentials via the STS API on demand. It is automatically refreshed on
-- expiry.
setSTSCredential :: STSCredentialProvider p => p -> ConnectInfo -> IO ConnectInfo
setSTSCredential :: (STSCredentialProvider p) => p -> ConnectInfo -> IO ConnectInfo
setSTSCredential p ci = do
store <- initSTSCredential p
return ci {connectCreds = CredsSTS store}
Expand Down Expand Up @@ -308,7 +304,7 @@ newtype SSECKey = SSECKey BA.ScrubbedBytes

-- | Validates that the given ByteString is 32 bytes long and creates
-- an encryption key.
mkSSECKey :: MonadThrow m => ByteString -> m SSECKey
mkSSECKey :: (MonadThrow m) => ByteString -> m SSECKey
mkSSECKey keyBytes
| B.length keyBytes /= 32 =
throwM MErrVInvalidEncryptionKeyLength
Expand All @@ -325,7 +321,7 @@ data SSE where
-- argument is the optional KMS context that must have a
-- `A.ToJSON` instance - please refer to the AWS S3 documentation
-- 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
-- key. The argument is the encryption key to be used.
SSEC :: SSECKey -> SSE
Expand Down
16 changes: 8 additions & 8 deletions src/Network/Minio/Data/Crypto.hs
Original file line number Diff line number Diff line change
Expand Up @@ -43,26 +43,26 @@ import qualified Data.Conduit as C
hashSHA256 :: ByteString -> ByteString
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
digest <- C.connect src sinkSHA256Hash
return $ digestToBase16 digest
where
-- 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

-- Returns MD5 hash hex encoded.
hashMD5 :: ByteString -> ByteString
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
digest <- C.connect src sinkMD5Hash
return $ digestToBase16 digest
where
-- 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

hmacSHA256 :: ByteString -> ByteString -> HMAC SHA256
Expand All @@ -71,15 +71,15 @@ hmacSHA256 message key = hmac key message
hmacSHA256RawBS :: ByteString -> ByteString -> ByteString
hmacSHA256RawBS message key = convert $ hmacSHA256 message key

digestToBS :: ByteArrayAccess a => a -> ByteString
digestToBS :: (ByteArrayAccess a) => a -> ByteString
digestToBS = convert

digestToBase16 :: ByteArrayAccess a => a -> ByteString
digestToBase16 :: (ByteArrayAccess a) => a -> ByteString
digestToBase16 = convertToBase Base16

-- Returns MD5 hash base 64 encoded.
hashMD5ToBase64 :: ByteArrayAccess a => a -> ByteString
hashMD5ToBase64 :: (ByteArrayAccess a) => a -> ByteString
hashMD5ToBase64 = convertToBase Base64 . hashWith MD5

encodeToBase64 :: ByteArrayAccess a => a -> ByteString
encodeToBase64 :: (ByteArrayAccess a) => a -> ByteString
encodeToBase64 = convertToBase Base64
14 changes: 7 additions & 7 deletions src/Network/Minio/SelectAPI.hs
Original file line number Diff line number Diff line change
Expand Up @@ -119,7 +119,7 @@ instance Exception EventStreamException
chunkSize :: Int
chunkSize = 32 * 1024

parseBinary :: Bin.Binary a => ByteString -> IO a
parseBinary :: (Bin.Binary a) => ByteString -> IO a
parseBinary b = do
case Bin.decodeOrFail $ LB.fromStrict b of
Left (_, _, msg) -> throwIO $ ESEDecodeFail msg
Expand All @@ -135,7 +135,7 @@ bytesToHeaderName t = case t of
_ -> throwIO ESEInvalidHeaderType

parseHeaders ::
MonadUnliftIO m =>
(MonadUnliftIO m) =>
Word32 ->
C.ConduitM ByteString a m [MessageHeader]
parseHeaders 0 = return []
Expand Down Expand Up @@ -163,15 +163,15 @@ parseHeaders hdrLen = do

-- readNBytes returns N bytes read from the string and throws an
-- 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
b <- LB.toStrict <$> (C.takeCE n .| C.sinkLazy)
if B.length b /= n
then throwIO ESEUnexpectedEndOfStream
else return b

crcCheck ::
MonadUnliftIO m =>
(MonadUnliftIO m) =>
C.ConduitM ByteString ByteString m ()
crcCheck = do
b <- readNBytes 12
Expand Down Expand Up @@ -208,7 +208,7 @@ crcCheck = do
then accumulateYield n' c'
else return c'

handleMessage :: MonadUnliftIO m => C.ConduitT ByteString EventMessage m ()
handleMessage :: (MonadUnliftIO m) => C.ConduitT ByteString EventMessage m ()
handleMessage = do
b1 <- readNBytes 4
msgLen :: Word32 <- liftIO $ parseBinary b1
Expand Down Expand Up @@ -254,7 +254,7 @@ handleMessage = do
passThrough $ n - B.length b

selectProtoConduit ::
MonadUnliftIO m =>
(MonadUnliftIO m) =>
C.ConduitT ByteString EventMessage m ()
selectProtoConduit = crcCheck .| handleMessage

Expand All @@ -281,7 +281,7 @@ selectObjectContent b o r = do
return $ NC.responseBody resp .| selectProtoConduit

-- | 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
evM <- C.await
case evM of
Expand Down
2 changes: 1 addition & 1 deletion src/Network/Minio/Sign/V4.hs
Original file line number Diff line number Diff line change
Expand Up @@ -346,7 +346,7 @@ chunkSizeConstant = 64 * 1024

-- base16Len computes the number of bytes required to represent @n (> 0)@ in
-- hexadecimal.
base16Len :: Integral a => a -> Int
base16Len :: (Integral a) => a -> Int
base16Len n
| n == 0 = 0
| otherwise = 1 + base16Len (n `div` 16)
Expand Down
4 changes: 2 additions & 2 deletions src/Network/Minio/Utils.hs
Original file line number Diff line number Diff line change
Expand Up @@ -175,7 +175,7 @@ isSuccessStatus sts =
in (s >= 200 && s < 300)

httpLbs ::
MonadIO m =>
(MonadIO m) =>
NC.Request ->
NC.Manager ->
m (NC.Response LByteString)
Expand Down Expand Up @@ -239,7 +239,7 @@ http req mgr = do
-- Similar to mapConcurrently but limits the number of threads that
-- can run using a quantity semaphore.
limitedMapConcurrently ::
MonadUnliftIO m =>
(MonadUnliftIO m) =>
Int ->
(t -> m a) ->
[t] ->
Expand Down
2 changes: 1 addition & 1 deletion src/Network/Minio/XmlCommon.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

-- | Parse time strings from XML
parseS3XMLTime :: MonadIO m => Text -> m UTCTime
parseS3XMLTime :: (MonadIO m) => Text -> m UTCTime
parseS3XMLTime t =
maybe (throwIO $ MErrVXmlParse $ "timestamp parse failure: " <> t) return $
iso8601ParseM $
Expand Down
2 changes: 1 addition & 1 deletion src/Network/Minio/XmlParser.hs
Original file line number Diff line number Diff line change
Expand Up @@ -218,7 +218,7 @@ parseNotification xmldata = do
events
(Filter $ FilterKey $ FilterRules rules)

parseSelectProgress :: MonadIO m => ByteString -> m Progress
parseSelectProgress :: (MonadIO m) => ByteString -> m Progress
parseSelectProgress xmldata = do
r <- parseRoot $ LB.fromStrict xmldata
let bScanned = T.concat $ r $/ element "BytesScanned" &/ content
Expand Down
4 changes: 2 additions & 2 deletions test/LiveServer.hs
Original file line number Diff line number Diff line change
Expand Up @@ -50,7 +50,7 @@ tests :: TestTree
tests = testGroup "Tests" [liveServerUnitTests]

-- 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
where
concatIt bs n =
Expand All @@ -68,7 +68,7 @@ randomDataSrc = genBS
yield $ concatIt byteArr64 oneMiB
genBS (s - oneMiB)

mkRandFile :: R.MonadResource m => Int64 -> m FilePath
mkRandFile :: (R.MonadResource m) => Int64 -> m FilePath
mkRandFile size = do
dir <- liftIO getTemporaryDirectory
C.runConduit $ randomDataSrc size C..| CB.sinkTempFile dir "miniohstest.random"
Expand Down