mirror of
https://github.com/typeable/minio-hs.git
synced 2024-12-01 22:25:54 +03:00
Replace protolude with relude and build with GHC 9.0.2 (#168)
- relude is a better and more commonly used library - Add compiler warnings and fixes - Update stack lts to 18.24 - Add explicit deriving strategies
This commit is contained in:
Aditya Manthramurthy
GitHub
parent
c59b7066fc
commit
bdac380c77
8
.github/workflows/ci.yml
vendored
8
.github/workflows/ci.yml
vendored
@ -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
|
||||
|
||||
@ -19,7 +19,6 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Text (pack)
|
||||
import Network.Minio
|
||||
import Options.Applicative
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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,
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 ->
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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,
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)]
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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: {}
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -19,7 +19,6 @@ module Network.Minio.TestHelpers
|
||||
)
|
||||
where
|
||||
|
||||
import Lib.Prelude
|
||||
import Network.Minio.Data
|
||||
|
||||
newtype TestNS = TestNS {testNamespace :: Text}
|
||||
|
||||
@ -19,7 +19,6 @@ module Network.Minio.Utils.Test
|
||||
)
|
||||
where
|
||||
|
||||
import Lib.Prelude
|
||||
import Network.Minio.Utils
|
||||
import Test.Tasty
|
||||
import Test.Tasty.HUnit
|
||||
|
||||
10
test/Spec.hs
10
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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user