diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 888ce4a..43df085 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -29,7 +29,7 @@ jobs: os: [ubuntu-latest, windows-latest] # Removed macos-latest due to cert issues. cabal: ["3.6"] ghc: - # - "9.0.1" + - "9.0.2" - "8.10.7" - "8.8.4" - "8.6.5" @@ -122,13 +122,13 @@ jobs: runs-on: ${{ matrix.os }} strategy: matrix: - stack: ["2.3.1"] - ghc: ["8.8.4"] + stack: ["2.7.3"] + ghc: ["8.10.7"] os: [ubuntu-latest] steps: - uses: actions/checkout@v2 - if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/main' + if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master' - uses: haskell/actions/setup@v1 name: Setup Haskell Stack diff --git a/examples/FileUploader.hs b/examples/FileUploader.hs index 88c4c60..dde340f 100755 --- a/examples/FileUploader.hs +++ b/examples/FileUploader.hs @@ -19,7 +19,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -import Data.Monoid ((<>)) import Data.Text (pack) import Network.Minio import Options.Applicative diff --git a/minio-hs.cabal b/minio-hs.cabal index 759c676..9826ffd 100644 --- a/minio-hs.cabal +++ b/minio-hs.cabal @@ -21,22 +21,52 @@ extra-source-files: examples/*.hs README.md stack.yaml +tested-with: GHC == 8.8.4 + , GHC == 8.10.7 + , GHC == 9.0.2 + +source-repository head + type: git + location: https://github.com/minio/minio-hs.git common base-settings ghc-options: -Wall + -Wcompat + -Widentities + -Wincomplete-uni-patterns + -Wincomplete-record-updates + -haddock + if impl(ghc >= 8.0) + ghc-options: -Wredundant-constraints + if impl(ghc >= 8.2) + ghc-options: -fhide-source-paths + + -- Add this when we have time. Fixing partial-fields requires major version + -- bump at this time. + -- if impl(ghc >= 8.4) + -- ghc-options: -Wpartial-fields + -- -Wmissing-export-lists + + if impl(ghc >= 8.8) + ghc-options: -Wmissing-deriving-strategies + -Werror=missing-deriving-strategies + default-language: Haskell2010 + default-extensions: BangPatterns + , DerivingStrategies , FlexibleContexts , FlexibleInstances , MultiParamTypeClasses , MultiWayIf - , NoImplicitPrelude , OverloadedStrings , RankNTypes , ScopedTypeVariables - , TypeFamilies , TupleSections + , TypeFamilies + + other-modules: Lib.Prelude , Network.Minio.API , Network.Minio.APICommon @@ -55,8 +85,13 @@ common base-settings , Network.Minio.XmlGenerator , Network.Minio.XmlParser , Network.Minio.JsonParser + + mixins: base hiding (Prelude) + , relude (Relude as Prelude) + , relude + build-depends: base >= 4.7 && < 5 - , protolude >= 0.3 && < 0.4 + , relude >= 0.7 && < 2 , aeson >= 1.2 && < 2 , base64-bytestring >= 1.0 , binary >= 0.8.5.0 @@ -292,7 +327,3 @@ executable SetConfig import: examples-settings scope: private main-is: SetConfig.hs - -source-repository head - type: git - location: https://github.com/minio/minio-hs diff --git a/src/Lib/Prelude.hs b/src/Lib/Prelude.hs index a6b6cf7..5d16a89 100644 --- a/src/Lib/Prelude.hs +++ b/src/Lib/Prelude.hs @@ -20,6 +20,7 @@ module Lib.Prelude showBS, toStrictBS, fromStrictBS, + lastMay, ) where @@ -29,14 +30,6 @@ import Data.Time as Exports ( UTCTime (..), diffUTCTime, ) -import Protolude as Exports hiding - ( Handler, - catch, - catches, - throwIO, - try, - yield, - ) import UnliftIO as Exports ( Handler, catch, @@ -50,10 +43,13 @@ both :: (a -> b) -> (a, a) -> (b, b) both f (a, b) = (f a, f b) showBS :: Show a => a -> ByteString -showBS a = toUtf8 (show a :: Text) +showBS a = encodeUtf8 (show a :: Text) toStrictBS :: LByteString -> ByteString toStrictBS = LB.toStrict fromStrictBS :: ByteString -> LByteString fromStrictBS = LB.fromStrict + +lastMay :: [a] -> Maybe a +lastMay a = last <$> nonEmpty a diff --git a/src/Network/Minio.hs b/src/Network/Minio.hs index 7a30d9e..0a882c9 100644 --- a/src/Network/Minio.hs +++ b/src/Network/Minio.hs @@ -225,7 +225,6 @@ This module exports the high-level MinIO API for object storage. import qualified Data.Conduit as C import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.Combinators as CC -import Lib.Prelude import Network.Minio.CopyObject import Network.Minio.Data import Network.Minio.Errors diff --git a/src/Network/Minio/APICommon.hs b/src/Network/Minio/APICommon.hs index 992a9b5..320bf0c 100644 --- a/src/Network/Minio/APICommon.hs +++ b/src/Network/Minio/APICommon.hs @@ -46,7 +46,7 @@ getPayloadSHA256Hash (PayloadC _ _) = throwIO MErrVUnexpectedPayload getRequestBody :: Payload -> NC.RequestBody getRequestBody (PayloadBS bs) = NC.RequestBodyBS bs getRequestBody (PayloadH h off size) = - NC.requestBodySource (fromIntegral size) $ + NC.requestBodySource size $ sourceHandleRange h (return . fromIntegral $ off) diff --git a/src/Network/Minio/AdminAPI.hs b/src/Network/Minio/AdminAPI.hs index 1016537..d27e2d4 100644 --- a/src/Network/Minio/AdminAPI.hs +++ b/src/Network/Minio/AdminAPI.hs @@ -90,7 +90,7 @@ data DriveInfo = DriveInfo diEndpoint :: Text, diState :: Text } - deriving (Eq, Show) + deriving stock (Show, Eq) instance FromJSON DriveInfo where parseJSON = withObject "DriveInfo" $ \v -> @@ -103,7 +103,7 @@ data StorageClass = StorageClass { scParity :: Int, scData :: Int } - deriving (Eq, Show) + deriving stock (Show, Eq) data ErasureInfo = ErasureInfo { eiOnlineDisks :: Int, @@ -112,7 +112,7 @@ data ErasureInfo = ErasureInfo eiReducedRedundancy :: StorageClass, eiSets :: [[DriveInfo]] } - deriving (Eq, Show) + deriving stock (Show, Eq) instance FromJSON ErasureInfo where parseJSON = withObject "ErasureInfo" $ \v -> do @@ -132,7 +132,7 @@ instance FromJSON ErasureInfo where data Backend = BackendFS | BackendErasure ErasureInfo - deriving (Eq, Show) + deriving stock (Show, Eq) instance FromJSON Backend where parseJSON = withObject "Backend" $ \v -> do @@ -146,7 +146,7 @@ data ConnStats = ConnStats { csTransferred :: Int64, csReceived :: Int64 } - deriving (Eq, Show) + deriving stock (Show, Eq) instance FromJSON ConnStats where parseJSON = withObject "ConnStats" $ \v -> @@ -161,7 +161,7 @@ data ServerProps = ServerProps spRegion :: Text, spSqsArns :: [Text] } - deriving (Eq, Show) + deriving stock (Show, Eq) instance FromJSON ServerProps where parseJSON = withObject "SIServer" $ \v -> do @@ -177,7 +177,7 @@ data StorageInfo = StorageInfo { siUsed :: Int64, siBackend :: Backend } - deriving (Eq, Show) + deriving stock (Show, Eq) instance FromJSON StorageInfo where parseJSON = withObject "StorageInfo" $ \v -> @@ -189,7 +189,7 @@ data CountNAvgTime = CountNAvgTime { caCount :: Int64, caAvgDuration :: Text } - deriving (Eq, Show) + deriving stock (Show, Eq) instance FromJSON CountNAvgTime where parseJSON = withObject "CountNAvgTime" $ \v -> @@ -209,7 +209,7 @@ data HttpStats = HttpStats hsTotalDeletes :: CountNAvgTime, hsSuccessDeletes :: CountNAvgTime } - deriving (Eq, Show) + deriving stock (Show, Eq) instance FromJSON HttpStats where parseJSON = withObject "HttpStats" $ \v -> @@ -231,7 +231,7 @@ data SIData = SIData sdHttpStats :: HttpStats, sdProps :: ServerProps } - deriving (Eq, Show) + deriving stock (Show, Eq) instance FromJSON SIData where parseJSON = withObject "SIData" $ \v -> @@ -246,7 +246,7 @@ data ServerInfo = ServerInfo siAddr :: Text, siData :: SIData } - deriving (Eq, Show) + deriving stock (Show, Eq) instance FromJSON ServerInfo where parseJSON = withObject "ServerInfo" $ \v -> @@ -259,7 +259,7 @@ data ServerVersion = ServerVersion { svVersion :: Text, svCommitId :: Text } - deriving (Eq, Show) + deriving stock (Show, Eq) instance FromJSON ServerVersion where parseJSON = withObject "ServerVersion" $ \v -> @@ -271,7 +271,7 @@ data ServiceStatus = ServiceStatus { ssVersion :: ServerVersion, ssUptime :: NominalDiffTime } - deriving (Eq, Show) + deriving stock (Show, Eq) instance FromJSON ServiceStatus where parseJSON = withObject "ServiceStatus" $ \v -> do @@ -283,7 +283,7 @@ instance FromJSON ServiceStatus where data ServiceAction = ServiceActionRestart | ServiceActionStop - deriving (Eq, Show) + deriving stock (Show, Eq) instance ToJSON ServiceAction where toJSON a = object ["action" .= serviceActionToText a] @@ -301,7 +301,7 @@ data HealStartResp = HealStartResp hsrClientAddr :: Text, hsrStartTime :: UTCTime } - deriving (Eq, Show) + deriving stock (Show, Eq) instance FromJSON HealStartResp where parseJSON = withObject "HealStartResp" $ \v -> @@ -314,7 +314,7 @@ data HealOpts = HealOpts { hoRecursive :: Bool, hoDryRun :: Bool } - deriving (Eq, Show) + deriving stock (Show, Eq) instance ToJSON HealOpts where toJSON (HealOpts r d) = @@ -333,7 +333,7 @@ data HealItemType | HealItemBucket | HealItemBucketMetadata | HealItemObject - deriving (Eq, Show) + deriving stock (Show, Eq) instance FromJSON HealItemType where parseJSON = withText "HealItemType" $ \v -> case v of @@ -348,7 +348,7 @@ data NodeSummary = NodeSummary nsErrSet :: Bool, nsErrMessage :: Text } - deriving (Eq, Show) + deriving stock (Show, Eq) instance FromJSON NodeSummary where parseJSON = withObject "NodeSummary" $ \v -> @@ -361,7 +361,7 @@ data SetConfigResult = SetConfigResult { scrStatus :: Bool, scrNodeSummary :: [NodeSummary] } - deriving (Eq, Show) + deriving stock (Show, Eq) instance FromJSON SetConfigResult where parseJSON = withObject "SetConfigResult" $ \v -> @@ -383,7 +383,7 @@ data HealResultItem = HealResultItem hriBefore :: [DriveInfo], hriAfter :: [DriveInfo] } - deriving (Eq, Show) + deriving stock (Show, Eq) instance FromJSON HealResultItem where parseJSON = withObject "HealResultItem" $ \v -> @@ -415,7 +415,7 @@ data HealStatus = HealStatus hsFailureDetail :: Maybe Text, hsItems :: Maybe [HealResultItem] } - deriving (Eq, Show) + deriving stock (Show, Eq) instance FromJSON HealStatus where parseJSON = withObject "HealStatus" $ \v -> @@ -434,7 +434,7 @@ healPath bucket prefix = do encodeUtf8 $ "v1/heal/" <> fromMaybe "" bucket <> "/" <> fromMaybe "" prefix - else encodeUtf8 $ "v1/heal/" + else encodeUtf8 ("v1/heal/" :: Text) -- | Get server version and uptime. serviceStatus :: Minio ServiceStatus diff --git a/src/Network/Minio/CopyObject.hs b/src/Network/Minio/CopyObject.hs index c5adaaa..7454346 100644 --- a/src/Network/Minio/CopyObject.hs +++ b/src/Network/Minio/CopyObject.hs @@ -45,11 +45,10 @@ copyObjectInternal b' o srcInfo = do when ( isJust rangeMay - && or - [ startOffset < 0, - endOffset < startOffset, - endOffset >= fromIntegral srcSize - ] + && ( (startOffset < 0) + || (endOffset < startOffset) + || (endOffset >= srcSize) + ) ) $ throwIO $ MErrVInvalidSrcObjByteRange range @@ -70,8 +69,7 @@ copyObjectInternal b' o srcInfo = do selectCopyRanges :: (Int64, Int64) -> [(PartNumber, (Int64, Int64))] selectCopyRanges (st, end) = zip pns $ - map (\(x, y) -> (st + x, st + x + y - 1)) $ - zip startOffsets partSizes + zipWith (\x y -> (st + x, st + x + y - 1)) startOffsets partSizes where size = end - st + 1 (pns, startOffsets, partSizes) = List.unzip3 $ selectPartSizes size @@ -88,7 +86,7 @@ multiPartCopyObject :: multiPartCopyObject b o cps srcSize = do uid <- newMultipartUpload b o [] - let byteRange = maybe (0, fromIntegral $ srcSize - 1) identity $ srcRange cps + let byteRange = maybe (0, srcSize - 1) identity $ srcRange cps partRanges = selectCopyRanges byteRange partSources = map diff --git a/src/Network/Minio/Data.hs b/src/Network/Minio/Data.hs index 4c976b9..d367d9a 100644 --- a/src/Network/Minio/Data.hs +++ b/src/Network/Minio/Data.hs @@ -22,7 +22,14 @@ module Network.Minio.Data where import qualified Conduit as C import qualified Control.Concurrent.MVar as M +import Control.Monad.Trans.Except (throwE) import Control.Monad.Trans.Resource + ( MonadResource, + MonadThrow (..), + MonadUnliftIO, + ResourceT, + runResourceT, + ) import qualified Data.Aeson as A import qualified Data.ByteArray as BA import qualified Data.ByteString as B @@ -30,12 +37,10 @@ import qualified Data.ByteString.Lazy as LB import Data.CaseInsensitive (mk) import qualified Data.HashMap.Strict as H import qualified Data.Ini as Ini -import Data.String (IsString (..)) import qualified Data.Text as T import qualified Data.Text.Encoding as TE import Data.Time (defaultTimeLocale, formatTime) -import GHC.Show (Show (show)) -import Lib.Prelude +import Lib.Prelude (UTCTime, throwIO) import qualified Network.Connection as Conn import Network.HTTP.Client (defaultManagerSettings) import qualified Network.HTTP.Client.TLS as TLS @@ -49,12 +54,18 @@ import Network.HTTP.Types ) import qualified Network.HTTP.Types as HT import Network.Minio.Data.Crypto -import Network.Minio.Data.Time + ( encodeToBase64, + hashMD5ToBase64, + ) +import Network.Minio.Data.Time (UrlExpiry) import Network.Minio.Errors + ( MErrV (MErrVInvalidEncryptionKeyLength, MErrVMissingCredentials), + MinioErr (..), + ) import System.Directory (doesFileExist, getHomeDirectory) import qualified System.Environment as Env import System.FilePath.Posix (combine) -import Text.XML +import Text.XML (Name (Name)) import qualified UnliftIO as U -- | max obj size is 5TiB @@ -111,7 +122,7 @@ data ConnectInfo = ConnectInfo connectAutoDiscoverRegion :: Bool, connectDisableTLSCertValidation :: Bool } - deriving (Eq, Show) + deriving stock (Eq, Show) instance IsString ConnectInfo where fromString str = @@ -132,7 +143,7 @@ data Credentials = Credentials { cAccessKey :: Text, cSecretKey :: Text } - deriving (Eq, Show) + deriving stock (Eq, Show) -- | A Provider is an action that may return Credentials. Providers -- may be chained together using 'findFirst'. @@ -164,7 +175,7 @@ fromAWSConfigFile = do return $ Ini.lookupValue "default" "aws_secret_access_key" ini return $ Credentials akey skey - return $ hush credsE + return $ either (const Nothing) Just credsE -- | This Provider loads `Credentials` from @AWS_ACCESS_KEY_ID@ and -- @AWS_SECRET_ACCESS_KEY@ environment variables. @@ -224,10 +235,10 @@ disableTLSCertValidation c = c {connectDisableTLSCertValidation = True} getHostAddr :: ConnectInfo -> ByteString getHostAddr ci = if - | port == 80 || port == 443 -> toUtf8 host + | port == 80 || port == 443 -> encodeUtf8 host | otherwise -> - toUtf8 $ - T.concat [host, ":", Lib.Prelude.show port] + encodeUtf8 $ + T.concat [host, ":", show port] where port = connectPort ci host = connectHost ci @@ -276,7 +287,7 @@ type ETag = Text -- | Data type to represent an object encryption key. Create one using -- the `mkSSECKey` function. newtype SSECKey = SSECKey BA.ScrubbedBytes - deriving (Eq, Show) + deriving stock (Eq, Show) -- | Validates that the given ByteString is 32 bytes long and creates -- an encryption key. @@ -407,7 +418,7 @@ data BucketInfo = BucketInfo { biName :: Bucket, biCreationDate :: UTCTime } - deriving (Show, Eq) + deriving stock (Show, Eq) -- | A type alias to represent a part-number for multipart upload type PartNumber = Int16 @@ -425,7 +436,7 @@ data ListPartsResult = ListPartsResult lprNextPart :: Maybe Int, lprParts :: [ObjectPartInfo] } - deriving (Show, Eq) + deriving stock (Show, Eq) -- | Represents information about an object part in an ongoing -- multipart upload. @@ -435,7 +446,7 @@ data ObjectPartInfo = ObjectPartInfo opiSize :: Int64, opiModTime :: UTCTime } - deriving (Show, Eq) + deriving stock (Show, Eq) -- | Represents result from a listing of incomplete uploads to a -- bucket. @@ -446,7 +457,7 @@ data ListUploadsResult = ListUploadsResult lurUploads :: [(Object, UploadId, UTCTime)], lurCPrefixes :: [Text] } - deriving (Show, Eq) + deriving stock (Show, Eq) -- | Represents information about a multipart upload. data UploadInfo = UploadInfo @@ -455,7 +466,7 @@ data UploadInfo = UploadInfo uiInitTime :: UTCTime, uiSize :: Int64 } - deriving (Show, Eq) + deriving stock (Show, Eq) -- | Represents result from a listing of objects in a bucket. data ListObjectsResult = ListObjectsResult @@ -464,7 +475,7 @@ data ListObjectsResult = ListObjectsResult lorObjects :: [ObjectInfo], lorCPrefixes :: [Text] } - deriving (Show, Eq) + deriving stock (Show, Eq) -- | Represents result from a listing of objects version 1 in a bucket. data ListObjectsV1Result = ListObjectsV1Result @@ -473,7 +484,7 @@ data ListObjectsV1Result = ListObjectsV1Result lorObjects' :: [ObjectInfo], lorCPrefixes' :: [Text] } - deriving (Show, Eq) + deriving stock (Show, Eq) -- | Represents information about an object. data ObjectInfo = ObjectInfo @@ -497,7 +508,7 @@ data ObjectInfo = ObjectInfo -- user-metadata pairs) oiMetadata :: H.HashMap Text Text } - deriving (Show, Eq) + deriving stock (Show, Eq) -- | Represents source object in server-side copy object data SourceInfo = SourceInfo @@ -529,7 +540,7 @@ data SourceInfo = SourceInfo -- given time. srcIfUnmodifiedSince :: Maybe UTCTime } - deriving (Show, Eq) + deriving stock (Show, Eq) -- | Provide a default for `SourceInfo` defaultSourceInfo :: SourceInfo @@ -542,7 +553,7 @@ data DestinationInfo = DestinationInfo -- | Destination object key dstObject :: Text } - deriving (Show, Eq) + deriving stock (Show, Eq) -- | Provide a default for `DestinationInfo` defaultDestinationInfo :: DestinationInfo @@ -619,18 +630,18 @@ data Event | ObjectRemovedDelete | ObjectRemovedDeleteMarkerCreated | ReducedRedundancyLostObject - deriving (Eq) + deriving stock (Eq, Show) -instance Show Event where - show ObjectCreated = "s3:ObjectCreated:*" - show ObjectCreatedPut = "s3:ObjectCreated:Put" - show ObjectCreatedPost = "s3:ObjectCreated:Post" - show ObjectCreatedCopy = "s3:ObjectCreated:Copy" - show ObjectCreatedMultipartUpload = "s3:ObjectCreated:MultipartUpload" - show ObjectRemoved = "s3:ObjectRemoved:*" - show ObjectRemovedDelete = "s3:ObjectRemoved:Delete" - show ObjectRemovedDeleteMarkerCreated = "s3:ObjectRemoved:DeleteMarkerCreated" - show ReducedRedundancyLostObject = "s3:ReducedRedundancyLostObject" +instance ToText Event where + toText ObjectCreated = "s3:ObjectCreated:*" + toText ObjectCreatedPut = "s3:ObjectCreated:Put" + toText ObjectCreatedPost = "s3:ObjectCreated:Post" + toText ObjectCreatedCopy = "s3:ObjectCreated:Copy" + toText ObjectCreatedMultipartUpload = "s3:ObjectCreated:MultipartUpload" + toText ObjectRemoved = "s3:ObjectRemoved:*" + toText ObjectRemovedDelete = "s3:ObjectRemoved:Delete" + toText ObjectRemovedDeleteMarkerCreated = "s3:ObjectRemoved:DeleteMarkerCreated" + toText ReducedRedundancyLostObject = "s3:ReducedRedundancyLostObject" textToEvent :: Text -> Maybe Event textToEvent t = case t of @@ -649,7 +660,7 @@ textToEvent t = case t of data Filter = Filter { fFilter :: FilterKey } - deriving (Show, Eq) + deriving stock (Show, Eq) -- | defaultFilter is empty, used to create a notification -- configuration. @@ -660,7 +671,7 @@ defaultFilter = Filter defaultFilterKey data FilterKey = FilterKey { fkKey :: FilterRules } - deriving (Show, Eq) + deriving stock (Show, Eq) -- | defaultFilterKey is empty, used to create notification -- configuration. @@ -671,7 +682,7 @@ defaultFilterKey = FilterKey defaultFilterRules data FilterRules = FilterRules { frFilterRules :: [FilterRule] } - deriving (Show, Eq) + deriving stock (Show, Eq) -- | defaultFilterRules is empty, used to create notification -- configuration. @@ -691,7 +702,7 @@ data FilterRule = FilterRule { frName :: Text, frValue :: Text } - deriving (Show, Eq) + deriving stock (Show, Eq) -- | Arn is an alias of Text type Arn = Text @@ -705,7 +716,7 @@ data NotificationConfig = NotificationConfig ncEvents :: [Event], ncFilter :: Filter } - deriving (Show, Eq) + deriving stock (Show, Eq) -- | A data-type to represent bucket notification configuration. It is -- a collection of queue, topic or lambda function configurations. The @@ -717,7 +728,7 @@ data Notification = Notification nTopicConfigurations :: [NotificationConfig], nCloudFunctionConfigurations :: [NotificationConfig] } - deriving (Eq, Show) + deriving stock (Show, Eq) -- | The default notification configuration is empty. defaultNotification :: Notification @@ -736,10 +747,10 @@ data SelectRequest = SelectRequest srOutputSerialization :: OutputSerialization, srRequestProgressEnabled :: Maybe Bool } - deriving (Eq, Show) + deriving stock (Show, Eq) data ExpressionType = SQL - deriving (Eq, Show) + deriving stock (Show, Eq) -- | InputSerialization represents format information of the input -- object being queried. Use one of the smart constructors such as @@ -749,7 +760,7 @@ data InputSerialization = InputSerialization { isCompressionType :: Maybe CompressionType, isFormatInfo :: InputFormatInfo } - deriving (Eq, Show) + deriving stock (Show, Eq) -- | Data type representing the compression setting in a Select -- request. @@ -757,7 +768,7 @@ data CompressionType = CompressionTypeNone | CompressionTypeGzip | CompressionTypeBzip2 - deriving (Eq, Show) + deriving stock (Show, Eq) -- | Data type representing input object format information in a -- Select request. @@ -765,7 +776,7 @@ data InputFormatInfo = InputFormatCSV CSVInputProp | InputFormatJSON JSONInputProp | InputFormatParquet - deriving (Eq, Show) + deriving stock (Show, Eq) -- | defaultCsvInput returns InputSerialization with default CSV -- format, and without any compression setting. @@ -845,7 +856,7 @@ type CSVInputProp = CSVProp -- | CSVProp represents CSV format properties. It is built up using -- the Monoid instance. data CSVProp = CSVProp (H.HashMap Text Text) - deriving (Eq, Show) + deriving stock (Show, Eq) #if (__GLASGOW_HASKELL__ >= 804) instance Semigroup CSVProp where @@ -890,15 +901,15 @@ data FileHeaderInfo FileHeaderUse | -- | Header are present, but should be ignored FileHeaderIgnore - deriving (Eq, Show) + deriving stock (Show, Eq) -- | Specify the CSV file header info property. fileHeaderInfo :: FileHeaderInfo -> CSVProp -fileHeaderInfo = CSVProp . H.singleton "FileHeaderInfo" . toString +fileHeaderInfo = CSVProp . H.singleton "FileHeaderInfo" . toStr where - toString FileHeaderNone = "NONE" - toString FileHeaderUse = "USE" - toString FileHeaderIgnore = "IGNORE" + toStr FileHeaderNone = "NONE" + toStr FileHeaderUse = "USE" + toStr FileHeaderIgnore = "IGNORE" -- | Specify the CSV comment character property. Lines starting with -- this character are ignored by the server. @@ -918,10 +929,10 @@ outputCSVFromProps :: CSVProp -> OutputSerialization outputCSVFromProps p = OutputSerializationCSV p data JSONInputProp = JSONInputProp {jsonipType :: JSONType} - deriving (Eq, Show) + deriving stock (Show, Eq) data JSONType = JSONTypeDocument | JSONTypeLines - deriving (Eq, Show) + deriving stock (Show, Eq) -- | OutputSerialization represents output serialization settings for -- the SelectRequest. Use `defaultCsvOutput` or `defaultJsonOutput` as @@ -929,7 +940,7 @@ data JSONType = JSONTypeDocument | JSONTypeLines data OutputSerialization = OutputSerializationJSON JSONOutputProp | OutputSerializationCSV CSVOutputProp - deriving (Eq, Show) + deriving stock (Show, Eq) type CSVOutputProp = CSVProp @@ -943,10 +954,10 @@ quoteFields q = CSVProp $ -- | Represent the QuoteField setting. data QuoteFields = QuoteFieldsAsNeeded | QuoteFieldsAlways - deriving (Eq, Show) + deriving stock (Show, Eq) data JSONOutputProp = JSONOutputProp {jsonopRecordDelimiter :: Maybe Text} - deriving (Eq, Show) + deriving stock (Show, Eq) -- | Set the output record delimiter for JSON format outputJSONFromRecordDelimiter :: Text -> OutputSerialization @@ -964,7 +975,7 @@ data EventMessage emErrorMessage :: Text } | RecordPayloadEventMessage {emPayloadBytes :: ByteString} - deriving (Eq, Show) + deriving stock (Show, Eq) data MsgHeaderName = MessageType @@ -972,7 +983,7 @@ data MsgHeaderName | ContentType | ErrorCode | ErrorMessage - deriving (Eq, Show) + deriving stock (Show, Eq) msgHeaderValueType :: Word8 msgHeaderValueType = 7 @@ -985,7 +996,7 @@ data Progress = Progress pBytesProcessed :: Int64, pBytesReturned :: Int64 } - deriving (Eq, Show) + deriving stock (Show, Eq) -- | Represent the stats event returned at the end of the Select -- response. @@ -1043,7 +1054,7 @@ defaultS3ReqInfo = getS3Path :: Maybe Bucket -> Maybe Object -> ByteString getS3Path b o = - let segments = map toUtf8 $ catMaybes $ b : bool [] [o] (isJust b) + let segments = map encodeUtf8 $ catMaybes $ b : bool [] [o] (isJust b) in B.concat ["/", B.intercalate "/" segments] type RegionMap = H.HashMap Bucket Region @@ -1053,7 +1064,7 @@ type RegionMap = H.HashMap Bucket Region newtype Minio a = Minio { unMinio :: ReaderT MinioConn (ResourceT IO) a } - deriving + deriving newtype ( Functor, Applicative, Monad, diff --git a/src/Network/Minio/Data/ByteString.hs b/src/Network/Minio/Data/ByteString.hs index 714b42a..5e57018 100644 --- a/src/Network/Minio/Data/ByteString.hs +++ b/src/Network/Minio/Data/ByteString.hs @@ -25,9 +25,8 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Char8 as BC8 import qualified Data.ByteString.Lazy as LB -import Data.Char (isAsciiLower, isAsciiUpper) +import Data.Char (isAsciiLower, isAsciiUpper, isDigit, isSpace, toUpper) import qualified Data.Text as T -import Lib.Prelude import Numeric (showHex) stripBS :: ByteString -> ByteString @@ -73,4 +72,4 @@ uriEncodeChar ch _ f n = BB.char7 '%' <> BB.string7 hexStr where hexStr = map toUpper $ showHex q $ showHex r "" - (q, r) = divMod (fromIntegral n) (16 :: Word8) + (q, r) = divMod n (16 :: Word8) diff --git a/src/Network/Minio/Data/Crypto.hs b/src/Network/Minio/Data/Crypto.hs index 2ca750a..af51cb3 100644 --- a/src/Network/Minio/Data/Crypto.hs +++ b/src/Network/Minio/Data/Crypto.hs @@ -39,7 +39,6 @@ import Crypto.MAC.HMAC (HMAC, hmac) import Data.ByteArray (ByteArrayAccess, convert) import Data.ByteArray.Encoding (Base (Base16, Base64), convertToBase) import qualified Data.Conduit as C -import Lib.Prelude hashSHA256 :: ByteString -> ByteString hashSHA256 = digestToBase16 . hashWith SHA256 diff --git a/src/Network/Minio/Errors.hs b/src/Network/Minio/Errors.hs index eadeadd..91c6860 100644 --- a/src/Network/Minio/Errors.hs +++ b/src/Network/Minio/Errors.hs @@ -14,10 +14,15 @@ -- limitations under the License. -- -module Network.Minio.Errors where +module Network.Minio.Errors + ( MErrV (..), + ServiceErr (..), + MinioErr (..), + toServiceErr, + ) +where -import Control.Exception -import Lib.Prelude +import Control.Exception (IOException) import qualified Network.HTTP.Conduit as NC --------------------------------- @@ -44,7 +49,7 @@ data MErrV | MErrVInvalidEncryptionKeyLength | MErrVStreamingBodyUnexpectedEOF | MErrVUnexpectedPayload - deriving (Show, Eq) + deriving stock (Show, Eq) instance Exception MErrV @@ -57,7 +62,7 @@ data ServiceErr | NoSuchKey | SelectErr Text Text | ServiceErr Text Text - deriving (Show, Eq) + deriving stock (Show, Eq) instance Exception ServiceErr @@ -75,7 +80,7 @@ data MinioErr | MErrIO IOException | MErrService ServiceErr | MErrValidation MErrV - deriving (Show) + deriving stock (Show) instance Eq MinioErr where MErrHTTP _ == MErrHTTP _ = True diff --git a/src/Network/Minio/JsonParser.hs b/src/Network/Minio/JsonParser.hs index 9d0ce46..4f84f5d 100644 --- a/src/Network/Minio/JsonParser.hs +++ b/src/Network/Minio/JsonParser.hs @@ -34,7 +34,7 @@ data AdminErrJSON = AdminErrJSON { aeCode :: Text, aeMessage :: Text } - deriving (Eq, Show) + deriving stock (Eq, Show) instance FromJSON AdminErrJSON where parseJSON = withObject "AdminErrJSON" $ \v -> diff --git a/src/Network/Minio/ListOps.hs b/src/Network/Minio/ListOps.hs index 723370c..d288af7 100644 --- a/src/Network/Minio/ListOps.hs +++ b/src/Network/Minio/ListOps.hs @@ -19,16 +19,47 @@ module Network.Minio.ListOps where import qualified Data.Conduit as C import qualified Data.Conduit.Combinators as CC import qualified Data.Conduit.List as CL -import Lib.Prelude import Network.Minio.Data + ( Bucket, + ListObjectsResult + ( lorCPrefixes, + lorHasMore, + lorNextToken, + lorObjects + ), + ListObjectsV1Result + ( lorCPrefixes', + lorHasMore', + lorNextMarker, + lorObjects' + ), + ListPartsResult (lprHasMore, lprNextPart, lprParts), + ListUploadsResult + ( lurHasMore, + lurNextKey, + lurNextUpload, + lurUploads + ), + Minio, + Object, + ObjectInfo, + ObjectPartInfo (opiSize), + UploadId, + UploadInfo (UploadInfo), + ) import Network.Minio.S3API + ( listIncompleteParts', + listIncompleteUploads', + listObjects', + listObjectsV1', + ) -- | Represents a list output item - either an object or an object -- prefix (i.e. a directory). data ListItem = ListItemObject ObjectInfo | ListItemPrefix Text - deriving (Show, Eq) + deriving stock (Show, Eq) -- | @'listObjects' bucket prefix recurse@ lists objects in a bucket -- similar to a file system tree traversal. @@ -110,7 +141,7 @@ listIncompleteUploads bucket prefix recurse = loop Nothing Nothing C.runConduit $ listIncompleteParts bucket uKey uId C..| CC.sinkList - return $ foldl (\sizeSofar p -> opiSize p + sizeSofar) 0 partInfos + return $ foldl' (\sizeSofar p -> opiSize p + sizeSofar) 0 partInfos CL.sourceList $ map diff --git a/src/Network/Minio/PresignedOperations.hs b/src/Network/Minio/PresignedOperations.hs index 4ee3256..e08beb0 100644 --- a/src/Network/Minio/PresignedOperations.hs +++ b/src/Network/Minio/PresignedOperations.hs @@ -88,7 +88,7 @@ makePresignedUrl expiry method bucket object region extraQuery extraHeaders = do let uri = NClient.getUri req uriString = uriToString identity uri "" - return $ toUtf8 uriString + return $ encodeUtf8 uriString -- | Generate a URL with authentication signature to PUT (upload) an -- object. Any extra headers if passed, are signed, and so they are @@ -170,7 +170,7 @@ data PostPolicyCondition = PPCStartsWith Text Text | PPCEquals Text Text | PPCRange Text Int64 Int64 - deriving (Show, Eq) + deriving stock (Show, Eq) instance Json.ToJSON PostPolicyCondition where toJSON (PPCStartsWith k v) = Json.toJSON ["starts-with", k, v] @@ -188,7 +188,7 @@ data PostPolicy = PostPolicy { expiration :: UTCTime, conditions :: [PostPolicyCondition] } - deriving (Show, Eq) + deriving stock (Show, Eq) instance Json.ToJSON PostPolicy where toJSON (PostPolicy e c) = @@ -205,7 +205,7 @@ data PostPolicyError | PPEBucketNotSpecified | PPEConditionKeyEmpty | PPERangeInvalid - deriving (Eq, Show) + deriving stock (Show, Eq) -- | Set the bucket name that the upload should use. ppCondBucket :: Bucket -> PostPolicyCondition @@ -283,7 +283,7 @@ presignedPostPolicy p = do signTime <- liftIO $ Time.getCurrentTime let extraConditions = - [ PPCEquals "x-amz-date" (toS $ awsTimeFormat signTime), + [ PPCEquals "x-amz-date" (toText $ awsTimeFormat signTime), PPCEquals "x-amz-algorithm" "AWS4-HMAC-SHA256", PPCEquals "x-amz-credential" @@ -312,7 +312,7 @@ presignedPostPolicy p = do mkPair (PPCEquals k v) = Just (k, v) mkPair _ = Nothing formFromPolicy = - H.map toUtf8 $ + H.map encodeUtf8 $ H.fromList $ catMaybes $ mkPair <$> conditions ppWithCreds diff --git a/src/Network/Minio/PutObject.hs b/src/Network/Minio/PutObject.hs index 447ecbf..e1a8ff3 100644 --- a/src/Network/Minio/PutObject.hs +++ b/src/Network/Minio/PutObject.hs @@ -77,7 +77,7 @@ putObjectInternal b o opts (ODStream src sizeMay) = do | otherwise -> sequentialMultipartUpload b o opts (Just size) src putObjectInternal b o opts (ODFile fp sizeMay) = do hResE <- withNewHandle fp $ \h -> - liftM2 (,) (isHandleSeekable h) (getFileSize h) + liftA2 (,) (isHandleSeekable h) (getFileSize h) (isSeekable, handleSizeMay) <- either diff --git a/src/Network/Minio/S3API.hs b/src/Network/Minio/S3API.hs index 38dfe47..77befdf 100644 --- a/src/Network/Minio/S3API.hs +++ b/src/Network/Minio/S3API.hs @@ -380,7 +380,7 @@ putObjectPart bucket object uploadId partNumber headers payload = do srcInfoToHeaders :: SourceInfo -> [HT.Header] srcInfoToHeaders srcInfo = ( "x-amz-copy-source", - toUtf8 $ + encodeUtf8 $ T.concat [ "/", srcBucket srcInfo, diff --git a/src/Network/Minio/SelectAPI.hs b/src/Network/Minio/SelectAPI.hs index 3863268..01db5e7 100644 --- a/src/Network/Minio/SelectAPI.hs +++ b/src/Network/Minio/SelectAPI.hs @@ -111,7 +111,7 @@ data EventStreamException | ESEInvalidHeaderType | ESEInvalidHeaderValueType | ESEInvalidMessageType - deriving (Eq, Show) + deriving stock (Eq, Show) instance Exception EventStreamException @@ -219,7 +219,7 @@ handleMessage = do hs <- parseHeaders hdrLen let payloadLen = msgLen - hdrLen - 16 - getHdrVal h = fmap snd . headMay . filter ((h ==) . fst) + getHdrVal h = fmap snd . find ((h ==) . fst) eventHdrValue = getHdrVal EventType hs msgHdrValue = getHdrVal MessageType hs errCode = getHdrVal ErrorCode hs diff --git a/src/Network/Minio/Sign/V4.hs b/src/Network/Minio/Sign/V4.hs index 2aaeee8..37e8950 100644 --- a/src/Network/Minio/Sign/V4.hs +++ b/src/Network/Minio/Sign/V4.hs @@ -58,7 +58,7 @@ data SignV4Data = SignV4Data sv4StringToSign :: ByteString, sv4SigningKey :: ByteString } - deriving (Show) + deriving stock (Show) data SignParams = SignParams { spAccessKey :: Text, @@ -68,7 +68,7 @@ data SignParams = SignParams spExpirySecs :: Maybe UrlExpiry, spPayloadHash :: Maybe ByteString } - deriving (Show) + deriving stock (Show) debugPrintSignV4Data :: SignV4Data -> IO () debugPrintSignV4Data (SignV4Data t s cr h2s o sts sk) = do @@ -92,7 +92,7 @@ mkAuthHeader accessKey scope signedHeaderKeys sign = let authValue = B.concat [ "AWS4-HMAC-SHA256 Credential=", - toUtf8 accessKey, + encodeUtf8 accessKey, "/", scope, ", SignedHeaders=", @@ -119,8 +119,8 @@ signV4 !sp !req = let region = fromMaybe "" $ spRegion sp ts = spTimeStamp sp scope = mkScope ts region - accessKey = toUtf8 $ spAccessKey sp - secretKey = toUtf8 $ spSecretKey sp + accessKey = encodeUtf8 $ spAccessKey sp + secretKey = encodeUtf8 $ spSecretKey sp expiry = spExpirySecs sp sha256Hdr = ( "x-amz-content-sha256", @@ -179,8 +179,8 @@ mkScope :: UTCTime -> Text -> ByteString mkScope ts region = B.intercalate "/" - [ toUtf8 $ Time.formatTime Time.defaultTimeLocale "%Y%m%d" ts, - toUtf8 region, + [ encodeUtf8 $ Time.formatTime Time.defaultTimeLocale "%Y%m%d" ts, + encodeUtf8 region, "s3", "aws4_request" ] @@ -239,7 +239,7 @@ mkSigningKey :: UTCTime -> Text -> ByteString -> ByteString mkSigningKey ts region !secretKey = hmacSHA256RawBS "aws4_request" . hmacSHA256RawBS "s3" - . hmacSHA256RawBS (toUtf8 region) + . hmacSHA256RawBS (encodeUtf8 region) . hmacSHA256RawBS (awsDateFormatBS ts) $ B.concat ["AWS4", secretKey] @@ -256,7 +256,7 @@ signV4PostPolicy :: signV4PostPolicy !postPolicyJSON !sp = let stringToSign = Base64.encode postPolicyJSON region = fromMaybe "" $ spRegion sp - signingKey = mkSigningKey (spTimeStamp sp) region $ toUtf8 $ spSecretKey sp + signingKey = mkSigningKey (spTimeStamp sp) region $ encodeUtf8 $ spSecretKey sp signature = computeSignature stringToSign signingKey in Map.fromList [ ("x-amz-signature", signature), @@ -294,7 +294,7 @@ signV4Stream :: signV4Stream !payloadLength !sp !req = let ts = spTimeStamp sp addContentEncoding hs = - let ceMay = headMay $ filter (\(x, _) -> x == "content-encoding") hs + let ceMay = find (\(x, _) -> x == "content-encoding") hs in case ceMay of Nothing -> ("content-encoding", "aws-chunked") : hs Just (_, ce) -> @@ -332,7 +332,7 @@ signV4Stream !payloadLength !sp !req = stringToSign = mkStringToSign ts scope canonicalReq -- 1.3 Compute signature -- 1.3.1 compute signing key - signingKey = mkSigningKey ts region $ toUtf8 secretKey + signingKey = mkSigningKey ts region $ encodeUtf8 secretKey -- 1.3.2 Compute signature seedSignature = computeSignature stringToSign signingKey -- 1.3.3 Compute Auth Header diff --git a/src/Network/Minio/Utils.hs b/src/Network/Minio/Utils.hs index 579b8e1..af0f3c8 100644 --- a/src/Network/Minio/Utils.hs +++ b/src/Network/Minio/Utils.hs @@ -52,7 +52,7 @@ allocateReadFile :: m (R.ReleaseKey, Handle) allocateReadFile fp = do (rk, hdlE) <- R.allocate (openReadFile fp) cleanup - either (\(e :: IOException) -> throwIO e) (return . (rk,)) hdlE + either (\(e :: U.IOException) -> throwIO e) (return . (rk,)) hdlE where openReadFile f = U.try $ IO.openBinaryFile f IO.ReadMode cleanup = either (const $ return ()) IO.hClose @@ -60,25 +60,25 @@ allocateReadFile fp = do -- | Queries the file size from the handle. Catches any file operation -- exceptions and returns Nothing instead. getFileSize :: - (MonadUnliftIO m, R.MonadResource m) => + (MonadUnliftIO m) => Handle -> m (Maybe Int64) getFileSize h = do resE <- liftIO $ try $ fromIntegral <$> IO.hFileSize h case resE of - Left (_ :: IOException) -> return Nothing + Left (_ :: U.IOException) -> return Nothing Right s -> return $ Just s -- | Queries if handle is seekable. Catches any file operation -- exceptions and return False instead. isHandleSeekable :: - (R.MonadResource m, MonadUnliftIO m) => + (R.MonadResource m) => Handle -> m Bool isHandleSeekable h = do resE <- liftIO $ try $ IO.hIsSeekable h case resE of - Left (_ :: IOException) -> return False + Left (_ :: U.IOException) -> return False Right v -> return v -- | Helper function that opens a handle to the filepath and performs @@ -89,7 +89,7 @@ withNewHandle :: (MonadUnliftIO m, R.MonadResource m) => FilePath -> (Handle -> m a) -> - m (Either IOException a) + m (Either U.IOException a) withNewHandle fp fileAction = do -- opening a handle can throw MError exception. handleE <- try $ allocateReadFile fp @@ -106,7 +106,7 @@ mkHeaderFromPairs :: [(ByteString, ByteString)] -> [HT.Header] mkHeaderFromPairs = map ((\(x, y) -> (mk x, y))) lookupHeader :: HT.HeaderName -> [HT.Header] -> Maybe ByteString -lookupHeader hdr = headMay . map snd . filter (\(h, _) -> h == hdr) +lookupHeader hdr = listToMaybe . map snd . filter (\(h, _) -> h == hdr) getETagHeader :: [HT.Header] -> Maybe Text getETagHeader hs = decodeUtf8Lenient <$> lookupHeader Hdr.hETag hs @@ -143,7 +143,7 @@ getLastModifiedHeader hs = do getContentLength :: [HT.Header] -> Maybe Int64 getContentLength hs = do nbs <- decodeUtf8Lenient <$> lookupHeader Hdr.hContentLength hs - fst <$> hush (decimal nbs) + fst <$> either (const Nothing) Just (decimal nbs) decodeUtf8Lenient :: ByteString -> Text decodeUtf8Lenient = decodeUtf8With lenientDecode @@ -280,7 +280,7 @@ selectPartSizes size = fromIntegral size / fromIntegral maxMultipartParts ) - m = fromIntegral partSize + m = partSize loop st sz | st > sz = [] | st + m >= sz = [(st, sz - st)] diff --git a/src/Network/Minio/XmlGenerator.hs b/src/Network/Minio/XmlGenerator.hs index 3efe1b7..a2c381f 100644 --- a/src/Network/Minio/XmlGenerator.hs +++ b/src/Network/Minio/XmlGenerator.hs @@ -24,7 +24,6 @@ where import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T -import Lib.Prelude import Network.Minio.Data import Text.XML @@ -72,7 +71,7 @@ mkCompleteMultipartUploadRequest partInfo = data XNode = XNode Text [XNode] | XLeaf Text Text - deriving (Eq, Show) + deriving stock (Eq, Show) toXML :: Text -> XNode -> ByteString toXML ns node = @@ -94,7 +93,7 @@ class ToXNode a where toXNode :: a -> XNode instance ToXNode Event where - toXNode = XLeaf "Event" . show + toXNode = XLeaf "Event" . toText instance ToXNode Notification where toXNode (Notification qc tc lc) = @@ -104,9 +103,9 @@ instance ToXNode Notification where ++ map (toXNodesWithArnName "CloudFunctionConfiguration" "CloudFunction") lc toXNodesWithArnName :: Text -> Text -> NotificationConfig -> XNode -toXNodesWithArnName eltName arnName (NotificationConfig id arn events fRule) = +toXNodesWithArnName eltName arnName (NotificationConfig itemId arn events fRule) = XNode eltName $ - [XLeaf "Id" id, XLeaf arnName arn] ++ map toXNode events + [XLeaf "Id" itemId, XLeaf arnName arn] ++ map toXNode events ++ [toXNode fRule] instance ToXNode Filter where diff --git a/src/Network/Minio/XmlParser.hs b/src/Network/Minio/XmlParser.hs index fb97874..94a2f29 100644 --- a/src/Network/Minio/XmlParser.hs +++ b/src/Network/Minio/XmlParser.hs @@ -32,7 +32,7 @@ where import qualified Data.ByteString.Lazy as LB import qualified Data.HashMap.Strict as H -import Data.List (zip3, zip4, zip6) +import Data.List (zip4, zip6) import qualified Data.Text as T import Data.Text.Read (decimal) import Data.Time @@ -132,7 +132,7 @@ parseListObjectsV1Response xmldata = do ns <- asks getSvcNamespace let s3Elem' = s3Elem ns hasMore = ["true"] == (r $/ s3Elem' "IsTruncated" &/ content) - nextMarker = headMay $ r $/ s3Elem' "NextMarker" &/ content + nextMarker = listToMaybe $ r $/ s3Elem' "NextMarker" &/ content prefixes = r $/ s3Elem' "CommonPrefixes" &/ s3Elem' "Prefix" &/ content keys = r $/ s3Elem' "Contents" &/ s3Elem' "Key" &/ content modTimeStr = r $/ s3Elem' "Contents" &/ s3Elem' "LastModified" &/ content @@ -158,7 +158,7 @@ parseListObjectsResponse xmldata = do ns <- asks getSvcNamespace let s3Elem' = s3Elem ns hasMore = ["true"] == (r $/ s3Elem' "IsTruncated" &/ content) - nextToken = headMay $ r $/ s3Elem' "NextContinuationToken" &/ content + nextToken = listToMaybe $ r $/ s3Elem' "NextContinuationToken" &/ content prefixes = r $/ s3Elem' "CommonPrefixes" &/ s3Elem' "Prefix" &/ content keys = r $/ s3Elem' "Contents" &/ s3Elem' "Key" &/ content modTimeStr = r $/ s3Elem' "Contents" &/ s3Elem' "LastModified" &/ content @@ -185,8 +185,8 @@ parseListUploadsResponse xmldata = do let s3Elem' = s3Elem ns hasMore = ["true"] == (r $/ s3Elem' "IsTruncated" &/ content) prefixes = r $/ s3Elem' "CommonPrefixes" &/ s3Elem' "Prefix" &/ content - nextKey = headMay $ r $/ s3Elem' "NextKeyMarker" &/ content - nextUpload = headMay $ r $/ s3Elem' "NextUploadIdMarker" &/ content + nextKey = listToMaybe $ r $/ s3Elem' "NextKeyMarker" &/ content + nextUpload = listToMaybe $ r $/ s3Elem' "NextUploadIdMarker" &/ content uploadKeys = r $/ s3Elem' "Upload" &/ s3Elem' "Key" &/ content uploadIds = r $/ s3Elem' "Upload" &/ s3Elem' "UploadId" &/ content uploadInitTimeStr = r $/ s3Elem' "Upload" &/ s3Elem' "Initiated" &/ content @@ -203,7 +203,7 @@ parseListPartsResponse xmldata = do ns <- asks getSvcNamespace let s3Elem' = s3Elem ns hasMore = ["true"] == (r $/ s3Elem' "IsTruncated" &/ content) - nextPartNumStr = headMay $ r $/ s3Elem' "NextPartNumberMarker" &/ content + nextPartNumStr = listToMaybe $ r $/ s3Elem' "NextPartNumberMarker" &/ content partNumberStr = r $/ s3Elem' "Part" &/ s3Elem' "PartNumber" &/ content partModTimeStr = r $/ s3Elem' "Part" &/ s3Elem' "LastModified" &/ content partETags = r $/ s3Elem' "Part" &/ s3Elem' "ETag" &/ content @@ -245,7 +245,7 @@ parseNotification xmldata = do in FilterRule name value parseNode ns arnName nodeData = do let c = fromNode nodeData - id = T.concat $ c $/ s3Elem ns "Id" &/ content + itemId = T.concat $ c $/ s3Elem ns "Id" &/ content arn = T.concat $ c $/ s3Elem ns arnName &/ content events = catMaybes $ map textToEvent $ c $/ s3Elem ns "Event" &/ content rules = @@ -253,7 +253,7 @@ parseNotification xmldata = do &/ s3Elem ns "FilterRule" &| getFilterRule ns return $ NotificationConfig - id + itemId arn events (Filter $ FilterKey $ FilterRules rules) diff --git a/stack.yaml b/stack.yaml index dc4ff19..d3426be 100644 --- a/stack.yaml +++ b/stack.yaml @@ -15,7 +15,7 @@ # resolver: # name: custom-snapshot # location: "./custom-snapshot.yaml" -resolver: lts-16.0 +resolver: lts-18.24 # User packages to be built. # Various formats can be used as shown in the example below. @@ -39,9 +39,7 @@ packages: - '.' # Dependency packages to be pulled from upstream that are not in the resolver # (e.g., acme-missiles-0.3) -extra-deps: -- unliftio-core-0.2.0.1 -- protolude-0.3.0 +extra-deps: [] # Override default flag values for local packages and extra-deps flags: {} diff --git a/stack.yaml.lock b/stack.yaml.lock index a6fcdc8..84717da 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -3,24 +3,10 @@ # For more information, please see the documentation at: # https://docs.haskellstack.org/en/stable/lock_files -packages: -- completed: - hackage: unliftio-core-0.2.0.1@sha256:9b3e44ea9aacacbfc35b3b54015af450091916ac3618a41868ebf6546977659a,1082 - pantry-tree: - size: 328 - sha256: e81c5a1e82ec2cd68cbbbec9cd60567363abe02257fa1370a906f6754b6818b8 - original: - hackage: unliftio-core-0.2.0.1 -- completed: - hackage: protolude-0.3.0@sha256:8361b811b420585b122a7ba715aa5923834db6e8c36309bf267df2dbf66b95ef,2693 - pantry-tree: - size: 1644 - sha256: babf32b414f25f790b7a4ce6bae5c960bc51a11a289e7c47335b222e6762560c - original: - hackage: protolude-0.3.0 +packages: [] snapshots: - completed: - size: 531237 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/0.yaml - sha256: 210e15b7043e2783115afe16b0d54914b1611cdaa73f3ca3ca7f8e0847ff54e5 - original: lts-16.0 + size: 587821 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/24.yaml + sha256: 06d844ba51e49907bd29cb58b4a5f86ee7587a4cd7e6cf395eeec16cba619ce8 + original: lts-18.24 diff --git a/test/LiveServer.hs b/test/LiveServer.hs index 635e6f3..194dbeb 100644 --- a/test/LiveServer.hs +++ b/test/LiveServer.hs @@ -37,7 +37,7 @@ import Network.Minio.Data.Crypto import Network.Minio.S3API import Network.Minio.Utils import System.Directory (getTemporaryDirectory) -import System.Environment (lookupEnv) +import qualified System.Environment as Env import qualified Test.QuickCheck as Q import Test.Tasty import Test.Tasty.HUnit @@ -79,8 +79,8 @@ funTestBucketPrefix = "miniohstest-" loadTestServer :: IO ConnectInfo loadTestServer = do - val <- lookupEnv "MINIO_LOCAL" - isSecure <- lookupEnv "MINIO_SECURE" + val <- Env.lookupEnv "MINIO_LOCAL" + isSecure <- Env.lookupEnv "MINIO_SECURE" return $ case (val, isSecure) of (Just _, Just _) -> setCreds (Credentials "minio" "minio123") "https://localhost:9000" (Just _, Nothing) -> setCreds (Credentials "minio" "minio123") "http://localhost:9000" @@ -616,7 +616,7 @@ presignedUrlFunTest = funTestWithBucket "presigned Url tests" $ headUrl <- presignedHeadObjectUrl bucket obj2 3600 [] headResp <- do - let req = NC.parseRequest_ $ toS $ decodeUtf8 headUrl + let req = NC.parseRequest_ $ decodeUtf8 headUrl NC.httpLbs (req {NC.method = HT.methodHead}) mgr liftIO $ (NC.responseStatus headResp == HT.status200) @@ -644,7 +644,7 @@ presignedUrlFunTest = funTestWithBucket "presigned Url tests" $ mapM_ (removeObject bucket) [obj, obj2] where putR size filePath mgr url = do - let req = NC.parseRequest_ $ toS $ decodeUtf8 url + let req = NC.parseRequest_ $ decodeUtf8 url let req' = req { NC.method = HT.methodPut, @@ -654,7 +654,7 @@ presignedUrlFunTest = funTestWithBucket "presigned Url tests" $ } NC.httpLbs req' mgr getR mgr url = do - let req = NC.parseRequest_ $ toS $ decodeUtf8 url + let req = NC.parseRequest_ $ decodeUtf8 url NC.httpLbs req mgr presignedPostPolicyFunTest :: TestTree @@ -690,7 +690,7 @@ presignedPostPolicyFunTest = funTestWithBucket "Presigned Post Policy tests" $ mapM_ (removeObject bucket) [key] where postForm url formData inputFile = do - req <- NC.parseRequest $ toS $ decodeUtf8 url + req <- NC.parseRequest $ decodeUtf8 url let parts = map (\(x, y) -> Form.partBS x y) $ H.toList formData @@ -739,13 +739,13 @@ bucketPolicyFunTest = funTestWithBucket "Bucket Policy tests" $ [ proto, getHostAddr connInfo, "/", - toUtf8 bucket, + encodeUtf8 bucket, "/", - toUtf8 obj + encodeUtf8 obj ] respE <- liftIO $ - (fmap (Right . toStrictBS) $ NC.simpleHttp $ toS $ decodeUtf8 url) + fmap (Right . toStrictBS) (NC.simpleHttp $ decodeUtf8 url) `catch` (\(e :: NC.HttpException) -> return $ Left (show e :: Text)) case respE of Left err -> liftIO $ assertFailure $ show err diff --git a/test/Network/Minio/API/Test.hs b/test/Network/Minio/API/Test.hs index e35b8a8..81aef01 100644 --- a/test/Network/Minio/API/Test.hs +++ b/test/Network/Minio/API/Test.hs @@ -24,7 +24,6 @@ module Network.Minio.API.Test where import Data.Aeson (eitherDecode) -import Lib.Prelude import Network.Minio.API import Network.Minio.AdminAPI import Test.Tasty diff --git a/test/Network/Minio/TestHelpers.hs b/test/Network/Minio/TestHelpers.hs index 32de0d9..7c0244d 100644 --- a/test/Network/Minio/TestHelpers.hs +++ b/test/Network/Minio/TestHelpers.hs @@ -19,7 +19,6 @@ module Network.Minio.TestHelpers ) where -import Lib.Prelude import Network.Minio.Data newtype TestNS = TestNS {testNamespace :: Text} diff --git a/test/Network/Minio/Utils/Test.hs b/test/Network/Minio/Utils/Test.hs index 1e82308..f8d0633 100644 --- a/test/Network/Minio/Utils/Test.hs +++ b/test/Network/Minio/Utils/Test.hs @@ -19,7 +19,6 @@ module Network.Minio.Utils.Test ) where -import Lib.Prelude import Network.Minio.Utils import Test.Tasty import Test.Tasty.HUnit diff --git a/test/Spec.hs b/test/Spec.hs index 36a7cf9..418e04f 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -73,10 +73,10 @@ qcProps = if | nparts > 1 -> -- last part can be smaller but > 0 all (>= minPartSize) (take (nparts - 1) sizes) - && all (\s -> s > 0) (drop (nparts - 1) sizes) + && all (> 0) (drop (nparts - 1) sizes) | nparts == 1 -> -- size may be 0 here. maybe True (\x -> x >= 0 && x <= minPartSize) $ - headMay sizes + listToMaybe sizes | otherwise -> False in n < 0 || ( isPNumsAscendingFrom1 && isOffsetsAsc && isSumSizeOk @@ -89,16 +89,16 @@ qcProps = -- is last part's snd offset end? isLastPartOk = maybe False ((end ==) . snd) $ lastMay pairs -- is first part's fst offset start - isFirstPartOk = maybe False ((start ==) . fst) $ headMay pairs + isFirstPartOk = maybe False ((start ==) . fst) $ listToMaybe pairs -- each pair is >=64MiB except last, and all those parts -- have same size. - initSizes = maybe [] (map (\(a, b) -> b - a + 1)) $ initMay pairs + initSizes = maybe [] (map (\(a, b) -> b - a + 1)) $ init <$> nonEmpty pairs isPartSizesOk = all (>= minPartSize) initSizes && maybe True (\k -> all (== k) initSizes) - (headMay initSizes) + (listToMaybe initSizes) -- returned offsets are contiguous. fsts = drop 1 $ map fst pairs snds = take (length pairs - 1) $ map snd pairs