fa62ed599a
This change adds support for requesting temporary object storage credentials using the STS API. Some breaking changes are introduced to enable this support: - `Credentials` type has been removed. Use the `CredentialValue` type instead. Corresponding to this the type signature for `setCreds` has changed, though the functionality is the same. - The type alias `Provider` has been renamed to `CredentialLoader` to avoid naming confusion.
134 lines
5.0 KiB
Haskell
134 lines
5.0 KiB
Haskell
--
|
|
-- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc.
|
|
--
|
|
-- Licensed under the Apache License, Version 2.0 (the "License");
|
|
-- you may not use this file except in compliance with the License.
|
|
-- You may obtain a copy of the License at
|
|
--
|
|
-- http://www.apache.org/licenses/LICENSE-2.0
|
|
--
|
|
-- Unless required by applicable law or agreed to in writing, software
|
|
-- distributed under the License is distributed on an "AS IS" BASIS,
|
|
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
-- See the License for the specific language governing permissions and
|
|
-- limitations under the License.
|
|
--
|
|
|
|
import qualified Data.ByteString as B
|
|
import qualified Data.List as L
|
|
import Lib.Prelude
|
|
import Network.Minio.API.Test
|
|
import Network.Minio.CopyObject
|
|
import Network.Minio.Data
|
|
import Network.Minio.Utils.Test
|
|
import Network.Minio.XmlGenerator.Test
|
|
import Network.Minio.XmlParser.Test
|
|
import Test.Tasty
|
|
import Test.Tasty.QuickCheck as QC
|
|
|
|
main :: IO ()
|
|
main = defaultMain tests
|
|
|
|
tests :: TestTree
|
|
tests = testGroup "Tests" [properties, unitTests]
|
|
|
|
properties :: TestTree
|
|
properties = testGroup "Properties" [qcProps] -- [scProps]
|
|
|
|
-- scProps = testGroup "(checked by SmallCheck)"
|
|
-- [ SC.testProperty "sort == sort . reverse" $
|
|
-- \list -> sort (list :: [Int]) == sort (reverse list)
|
|
-- , SC.testProperty "Fermat's little theorem" $
|
|
-- \x -> ((x :: Integer)^7 - x) `mod` 7 == 0
|
|
-- -- the following property does not hold
|
|
-- , SC.testProperty "Fermat's last theorem" $
|
|
-- \x y z n ->
|
|
-- (n :: Integer) >= 3 SC.==> x^n + y^n /= (z^n :: Integer)
|
|
-- ]
|
|
|
|
qcProps :: TestTree
|
|
qcProps =
|
|
testGroup
|
|
"(checked by QuickCheck)"
|
|
[ QC.testProperty "selectPartSizes:" $
|
|
\n ->
|
|
let (pns, offs, sizes) = L.unzip3 (selectPartSizes n)
|
|
-- check that pns increments from 1.
|
|
isPNumsAscendingFrom1 = all (uncurry (==)) $ zip pns [1 ..]
|
|
consPairs [] = []
|
|
consPairs [_] = []
|
|
consPairs (a : (b : c)) = (a, b) : consPairs (b : c)
|
|
-- check `offs` is monotonically increasing.
|
|
isOffsetsAsc = all (uncurry (<)) $ consPairs offs
|
|
-- check sizes sums to n.
|
|
isSumSizeOk = sum sizes == n
|
|
-- check sizes are constant except last
|
|
isSizesConstantExceptLast =
|
|
all (uncurry (==)) (consPairs $ L.init sizes)
|
|
-- check each part except last is at least minPartSize;
|
|
-- last part may be 0 only if it is the only part.
|
|
nparts = length sizes
|
|
isMinPartSizeOk =
|
|
if
|
|
| nparts > 1 -> -- last part can be smaller but > 0
|
|
all (>= minPartSize) (take (nparts - 1) sizes)
|
|
&& all (> 0) (drop (nparts - 1) sizes)
|
|
| nparts == 1 -> -- size may be 0 here.
|
|
maybe True (\x -> x >= 0 && x <= minPartSize) $
|
|
listToMaybe sizes
|
|
| otherwise -> False
|
|
in n < 0
|
|
|| ( isPNumsAscendingFrom1
|
|
&& isOffsetsAsc
|
|
&& isSumSizeOk
|
|
&& isSizesConstantExceptLast
|
|
&& isMinPartSizeOk
|
|
),
|
|
QC.testProperty "selectCopyRanges:" $
|
|
\(start, end) ->
|
|
let (_, pairs) = L.unzip (selectCopyRanges (start, end))
|
|
-- 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) $ listToMaybe pairs
|
|
-- each pair is >=64MiB except last, and all those parts
|
|
-- have same size.
|
|
initSizes = maybe [] (map (\(a, b) -> b - a + 1) . init) (nonEmpty pairs)
|
|
isPartSizesOk =
|
|
all (>= minPartSize) initSizes
|
|
&& maybe
|
|
True
|
|
(\k -> all (== k) initSizes)
|
|
(listToMaybe initSizes)
|
|
-- returned offsets are contiguous.
|
|
fsts = drop 1 $ map fst pairs
|
|
snds = take (length pairs - 1) $ map snd pairs
|
|
isContParts =
|
|
length fsts == length snds
|
|
&& all (\(a, b) -> a == b + 1) (zip fsts snds)
|
|
in start < 0
|
|
|| start > end
|
|
|| (isLastPartOk && isFirstPartOk && isPartSizesOk && isContParts),
|
|
QC.testProperty "mkSSECKey:" $
|
|
\w8s ->
|
|
let bs = B.pack w8s
|
|
r = mkSSECKey bs
|
|
in case r of
|
|
Just _ -> B.length bs == 32
|
|
Nothing -> B.length bs /= 32
|
|
]
|
|
|
|
unitTests :: TestTree
|
|
unitTests =
|
|
testGroup
|
|
"Unit tests"
|
|
[ xmlGeneratorTests,
|
|
xmlParserTests,
|
|
bucketNameValidityTests,
|
|
objectNameValidityTests,
|
|
parseServerInfoJSONTest,
|
|
parseHealStatusTest,
|
|
parseHealStartRespTest,
|
|
limitedMapConcurrentlyTests
|
|
]
|