{-# OPTIONS_GHC -Wno-orphans #-}

module Tahoe.Storage.Testing.Spec (
    ShareNumbers (..),
    SomeShareData (..),
    makeStorageSpec,
    genStorageIndex,
) where

import Control.Exception (Exception, finally, throwIO, try)
import Control.Monad (void, when)
import qualified Data.Base32String as Base32
import Data.Bifunctor (Bifunctor (second))
import Data.Bits (Bits (xor))
import qualified Data.ByteString as B
import Data.Composition ((.:))
import Data.Function (on)
import Data.Interval (
    Boundary (Closed, Open),
    Extended (..),
    Interval,
    interval,
    lowerBound,
    upperBound,
 )
import qualified Data.IntervalSet as IS
import Data.List (foldl', nubBy)
import Data.List.HT (outerProduct)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import Data.Word (Word8)
import Network.HTTP.Types (ByteRange (..), ByteRanges)
import Tahoe.Storage.Backend (
    AllocateBuckets (AllocateBuckets),
    AllocationResult (AllocationResult, allocated, alreadyHave),
    Backend (..),
    CBORSet (CBORSet),
    LeaseSecret (Upload),
    Offset,
    ReadResult,
    ReadTestWriteResult (..),
    ReadTestWriteVectors (..),
    ReadVector (..),
    ShareData,
    ShareNumber (..),
    Size,
    StorageIndex,
    TestOperator (Eq),
    TestVector (..),
    TestWriteVectors (..),
    UploadSecret (..),
    Version (parameters),
    Version1Parameters (maximumImmutableShareSize),
    WriteEnablerSecret (..),
    WriteImmutableError (..),
    WriteMutableError (..),
    WriteVector (..),
    readv,
    testv,
    writev,
 )
import Test.Hspec (Expectation, HasCallStack, Selector, Spec, context, describe, it, shouldBe, shouldReturn, shouldThrow)
import Test.QuickCheck (
    Arbitrary (arbitrary, shrink),
    Gen,
    NonEmptyList (NonEmpty, getNonEmpty),
    NonNegative (NonNegative, getNonNegative),
    Positive (Positive, getPositive),
    Property,
    Testable (property),
    chooseInt,
    chooseInteger,
    counterexample,
    forAll,
    getSize,
    ioProperty,
    label,
    listOf1,
    oneof,
    shuffle,
    suchThatMap,
    vector,
    vectorOf,
    withMaxSuccess,
    (==>),
 )
import Test.QuickCheck.Instances.ByteString ()
import Test.QuickCheck.Monadic (monadicIO, run)

arbNonNeg :: (Arbitrary n, Integral n) => Gen n
arbNonNeg :: Gen n
arbNonNeg = NonNegative n -> n
forall a. NonNegative a -> a
getNonNegative (NonNegative n -> n) -> Gen (NonNegative n) -> Gen n
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NonNegative n)
forall a. Arbitrary a => Gen a
arbitrary

newtype ShareNumbers = ShareNumbers {ShareNumbers -> [ShareNumber]
getShareNumbers :: [ShareNumber]} deriving (ShareNumbers -> ShareNumbers -> Bool
(ShareNumbers -> ShareNumbers -> Bool)
-> (ShareNumbers -> ShareNumbers -> Bool) -> Eq ShareNumbers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShareNumbers -> ShareNumbers -> Bool
$c/= :: ShareNumbers -> ShareNumbers -> Bool
== :: ShareNumbers -> ShareNumbers -> Bool
$c== :: ShareNumbers -> ShareNumbers -> Bool
Eq, Eq ShareNumbers
Eq ShareNumbers
-> (ShareNumbers -> ShareNumbers -> Ordering)
-> (ShareNumbers -> ShareNumbers -> Bool)
-> (ShareNumbers -> ShareNumbers -> Bool)
-> (ShareNumbers -> ShareNumbers -> Bool)
-> (ShareNumbers -> ShareNumbers -> Bool)
-> (ShareNumbers -> ShareNumbers -> ShareNumbers)
-> (ShareNumbers -> ShareNumbers -> ShareNumbers)
-> Ord ShareNumbers
ShareNumbers -> ShareNumbers -> Bool
ShareNumbers -> ShareNumbers -> Ordering
ShareNumbers -> ShareNumbers -> ShareNumbers
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ShareNumbers -> ShareNumbers -> ShareNumbers
$cmin :: ShareNumbers -> ShareNumbers -> ShareNumbers
max :: ShareNumbers -> ShareNumbers -> ShareNumbers
$cmax :: ShareNumbers -> ShareNumbers -> ShareNumbers
>= :: ShareNumbers -> ShareNumbers -> Bool
$c>= :: ShareNumbers -> ShareNumbers -> Bool
> :: ShareNumbers -> ShareNumbers -> Bool
$c> :: ShareNumbers -> ShareNumbers -> Bool
<= :: ShareNumbers -> ShareNumbers -> Bool
$c<= :: ShareNumbers -> ShareNumbers -> Bool
< :: ShareNumbers -> ShareNumbers -> Bool
$c< :: ShareNumbers -> ShareNumbers -> Bool
compare :: ShareNumbers -> ShareNumbers -> Ordering
$ccompare :: ShareNumbers -> ShareNumbers -> Ordering
$cp1Ord :: Eq ShareNumbers
Ord, Int -> ShareNumbers -> ShowS
[ShareNumbers] -> ShowS
ShareNumbers -> String
(Int -> ShareNumbers -> ShowS)
-> (ShareNumbers -> String)
-> ([ShareNumbers] -> ShowS)
-> Show ShareNumbers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShareNumbers] -> ShowS
$cshowList :: [ShareNumbers] -> ShowS
show :: ShareNumbers -> String
$cshow :: ShareNumbers -> String
showsPrec :: Int -> ShareNumbers -> ShowS
$cshowsPrec :: Int -> ShareNumbers -> ShowS
Show)

{- | All legal share numbers for all schemes in real-world use.

 Pre-construct this so that the ShareNumbers Arbitrary instance doesn't have
 to.
-}
allShareNums :: [ShareNumber]
allShareNums :: [ShareNumber]
allShareNums = Integer -> ShareNumber
ShareNumber (Integer -> ShareNumber) -> [Integer] -> [ShareNumber]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Integer
0 .. Integer
255]

{- | An Arbitrary instance that guarantees ShareNumbers are unique and
   non-empty (without invoking discard).
-}
instance Arbitrary ShareNumbers where
    arbitrary :: Gen ShareNumbers
arbitrary = [ShareNumber] -> ShareNumbers
ShareNumbers ([ShareNumber] -> ShareNumbers)
-> Gen [ShareNumber] -> Gen ShareNumbers
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [ShareNumber]
nums
      where
        nums :: Gen [ShareNumber]
nums = Int -> [ShareNumber] -> [ShareNumber]
forall a. Int -> [a] -> [a]
take (Int -> [ShareNumber] -> [ShareNumber])
-> Gen Int -> Gen ([ShareNumber] -> [ShareNumber])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
chooseInt (Int
1, Int
255) Gen ([ShareNumber] -> [ShareNumber])
-> Gen [ShareNumber] -> Gen [ShareNumber]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ShareNumber] -> Gen [ShareNumber]
forall a. [a] -> Gen [a]
shuffle [ShareNumber]
allShareNums

    shrink :: ShareNumbers -> [ShareNumbers]
shrink (ShareNumbers []) = String -> [ShareNumbers]
forall a. HasCallStack => String -> a
error String
"Empty ShareNumbers is not meaningful"
    shrink (ShareNumbers [ShareNumber
_]) = []
    shrink (ShareNumbers (ShareNumber
_ : [ShareNumber]
xs)) = [[ShareNumber] -> ShareNumbers
ShareNumbers [ShareNumber]
xs]

instance Arbitrary ShareNumber where
    arbitrary :: Gen ShareNumber
arbitrary = Integer -> ShareNumber
ShareNumber (Integer -> ShareNumber) -> Gen Integer -> Gen ShareNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall n. (Arbitrary n, Integral n) => Gen n
arbNonNeg

    shrink :: ShareNumber -> [ShareNumber]
shrink (ShareNumber Integer
0) = []
    shrink (ShareNumber Integer
n) = [Integer -> ShareNumber
ShareNumber (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)]

instance Arbitrary ReadTestWriteVectors where
    arbitrary :: Gen ReadTestWriteVectors
arbitrary = Map ShareNumber TestWriteVectors
-> [ReadVector] -> ReadTestWriteVectors
ReadTestWriteVectors (Map ShareNumber TestWriteVectors
 -> [ReadVector] -> ReadTestWriteVectors)
-> Gen (Map ShareNumber TestWriteVectors)
-> Gen ([ReadVector] -> ReadTestWriteVectors)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map ShareNumber TestWriteVectors)
forall a. Arbitrary a => Gen a
arbitrary Gen ([ReadVector] -> ReadTestWriteVectors)
-> Gen [ReadVector] -> Gen ReadTestWriteVectors
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [ReadVector]
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary TestWriteVectors where
    arbitrary :: Gen TestWriteVectors
arbitrary = [TestVector] -> [WriteVector] -> Maybe Integer -> TestWriteVectors
TestWriteVectors ([TestVector]
 -> [WriteVector] -> Maybe Integer -> TestWriteVectors)
-> Gen [TestVector]
-> Gen ([WriteVector] -> Maybe Integer -> TestWriteVectors)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [TestVector]
forall a. Arbitrary a => Gen a
arbitrary Gen ([WriteVector] -> Maybe Integer -> TestWriteVectors)
-> Gen [WriteVector] -> Gen (Maybe Integer -> TestWriteVectors)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [WriteVector]
forall a. Arbitrary a => Gen a
arbitrary Gen (Maybe Integer -> TestWriteVectors)
-> Gen (Maybe Integer) -> Gen TestWriteVectors
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Gen (Maybe Integer)] -> Gen (Maybe Integer)
forall a. [Gen a] -> Gen a
oneof [Maybe Integer -> Gen (Maybe Integer)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Integer
forall a. Maybe a
Nothing, Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer) -> Gen Integer -> Gen (Maybe Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall n. (Arbitrary n, Integral n) => Gen n
arbNonNeg]

instance Arbitrary TestVector where
    arbitrary :: Gen TestVector
arbitrary = Integer -> Integer -> TestOperator -> ShareData -> TestVector
TestVector (Integer -> Integer -> TestOperator -> ShareData -> TestVector)
-> Gen Integer
-> Gen (Integer -> TestOperator -> ShareData -> TestVector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall n. (Arbitrary n, Integral n) => Gen n
arbNonNeg Gen (Integer -> TestOperator -> ShareData -> TestVector)
-> Gen Integer -> Gen (TestOperator -> ShareData -> TestVector)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Integer
forall n. (Arbitrary n, Integral n) => Gen n
arbNonNeg Gen (TestOperator -> ShareData -> TestVector)
-> Gen TestOperator -> Gen (ShareData -> TestVector)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TestOperator -> Gen TestOperator
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestOperator
Eq Gen (ShareData -> TestVector) -> Gen ShareData -> Gen TestVector
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ShareData
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary WriteVector where
    arbitrary :: Gen WriteVector
arbitrary = Integer -> ShareData -> WriteVector
WriteVector (Integer -> ShareData -> WriteVector)
-> Gen Integer -> Gen (ShareData -> WriteVector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall n. (Arbitrary n, Integral n) => Gen n
arbNonNeg Gen (ShareData -> WriteVector) -> Gen ShareData -> Gen WriteVector
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ShareData
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary ReadVector where
    arbitrary :: Gen ReadVector
arbitrary = Integer -> Integer -> ReadVector
ReadVector (Integer -> Integer -> ReadVector)
-> Gen Integer -> Gen (Integer -> ReadVector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall n. (Arbitrary n, Integral n) => Gen n
arbNonNeg Gen (Integer -> ReadVector) -> Gen Integer -> Gen ReadVector
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Positive Integer -> Integer
forall a. Positive a -> a
getPositive (Positive Integer -> Integer)
-> Gen (Positive Integer) -> Gen Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Positive Integer)
forall a. Arbitrary a => Gen a
arbitrary)

newtype ArbStorageIndex = ArbStorageIndex StorageIndex deriving newtype (Int -> ArbStorageIndex -> ShowS
[ArbStorageIndex] -> ShowS
ArbStorageIndex -> String
(Int -> ArbStorageIndex -> ShowS)
-> (ArbStorageIndex -> String)
-> ([ArbStorageIndex] -> ShowS)
-> Show ArbStorageIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArbStorageIndex] -> ShowS
$cshowList :: [ArbStorageIndex] -> ShowS
show :: ArbStorageIndex -> String
$cshow :: ArbStorageIndex -> String
showsPrec :: Int -> ArbStorageIndex -> ShowS
$cshowsPrec :: Int -> ArbStorageIndex -> ShowS
Show)

instance Arbitrary ArbStorageIndex where
    arbitrary :: Gen ArbStorageIndex
arbitrary = String -> ArbStorageIndex
ArbStorageIndex (String -> ArbStorageIndex) -> Gen String -> Gen ArbStorageIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
genStorageIndex

newtype SomeShareData = SomeShareData {SomeShareData -> ShareData
getShareData :: B.ByteString}

instance Show SomeShareData where
    show :: SomeShareData -> String
show (SomeShareData ShareData
bs) = String
"(SomeShareData length=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (ShareData -> Int
B.length ShareData
bs) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"

-- | Generate some fairly short and some fairly long byte strings.
instance Arbitrary SomeShareData where
    arbitrary :: Gen SomeShareData
arbitrary =
        ShareData -> SomeShareData
SomeShareData (ShareData -> SomeShareData)
-> ([Word8] -> ShareData) -> [Word8] -> SomeShareData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ShareData
B.pack
            ([Word8] -> SomeShareData) -> Gen [Word8] -> Gen SomeShareData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen [Word8]] -> Gen [Word8]
forall a. [Gen a] -> Gen a
oneof
                [ Gen Word8 -> Gen [Word8]
forall a. Gen a -> Gen [a]
listOf1 Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
                , Gen Int
exponentialPositiveInt Gen Int -> (Int -> Gen [Word8]) -> Gen [Word8]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Gen Word8 -> Gen [Word8])
-> Gen Word8 -> Int -> Gen [Word8]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
                ]

    -- Shrink to shorter non-empty bytestrings with distinct lengths.
    -- Requiring distinct lengths is an optimization.  I don't think there's
    -- any reason two random ByteStrings of the same length would behave
    -- differently.  If I'm wrong, at least this is only the shrinking logic
    -- so at worst we miss out on a shorter counterexample sometimes.
    shrink :: SomeShareData -> [SomeShareData]
shrink (SomeShareData ShareData
bs) =
        (ShareData -> SomeShareData) -> [ShareData] -> [SomeShareData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShareData -> SomeShareData
SomeShareData ([ShareData] -> [SomeShareData])
-> (ShareData -> [ShareData]) -> ShareData -> [SomeShareData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShareData -> ShareData -> Bool) -> [ShareData] -> [ShareData]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool)
-> (ShareData -> Int) -> ShareData -> ShareData -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ShareData -> Int
B.length) ([ShareData] -> [ShareData])
-> (ShareData -> [ShareData]) -> ShareData -> [ShareData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShareData -> Bool) -> [ShareData] -> [ShareData]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ShareData -> Bool) -> ShareData -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShareData -> Bool
B.null) ([ShareData] -> [ShareData])
-> (ShareData -> [ShareData]) -> ShareData -> [ShareData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShareData -> [ShareData]
shrinkBytes (ShareData -> [SomeShareData]) -> ShareData -> [SomeShareData]
forall a b. (a -> b) -> a -> b
$ ShareData
bs

newtype SmallShareData = SmallShareData {SmallShareData -> ShareData
getSmallShareData :: B.ByteString}
    deriving (Int -> SmallShareData -> ShowS
[SmallShareData] -> ShowS
SmallShareData -> String
(Int -> SmallShareData -> ShowS)
-> (SmallShareData -> String)
-> ([SmallShareData] -> ShowS)
-> Show SmallShareData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SmallShareData] -> ShowS
$cshowList :: [SmallShareData] -> ShowS
show :: SmallShareData -> String
$cshow :: SmallShareData -> String
showsPrec :: Int -> SmallShareData -> ShowS
$cshowsPrec :: Int -> SmallShareData -> ShowS
Show)

-- | Generate some fairly short byte strings.
instance Arbitrary SmallShareData where
    arbitrary :: Gen SmallShareData
arbitrary = Gen Int
getSize Gen Int -> (Int -> Gen SmallShareData) -> Gen SmallShareData
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
size -> ShareData -> SmallShareData
SmallShareData (ShareData -> SmallShareData)
-> ([Word8] -> ShareData) -> [Word8] -> SmallShareData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ShareData
B.pack ([Word8] -> SmallShareData) -> Gen [Word8] -> Gen SmallShareData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
size Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
    shrink :: SmallShareData -> [SmallShareData]
shrink (SmallShareData ShareData
bs) = ShareData -> SmallShareData
SmallShareData (ShareData -> SmallShareData) -> [ShareData] -> [SmallShareData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShareData -> [ShareData]
shrinkBytes ShareData
bs

{- | Shrink B.ByteString more efficiently than QuickCheck-instances can.  This
 implementation should be O(n) in the number of shrinks generated (not the
 size of the bytestring being shrunk).
-}
shrinkBytes :: B.ByteString -> [B.ByteString]
shrinkBytes :: ShareData -> [ShareData]
shrinkBytes ShareData
bs = [Int -> ShareData -> ShareData
B.take Int
n ShareData
bs, Int -> ShareData -> ShareData
B.drop Int
n ShareData
bs]
  where
    n :: Int
n = ShareData -> Int
B.length ShareData
bs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2

exponentialPositiveInt :: Gen Int
exponentialPositiveInt :: Gen Int
exponentialPositiveInt = do
    -- Limit the results to 2 ^ 22 so that allocating a ByteString of this
    -- length doesn't necessarily consume all available memory...
    Int
e <- (Int, Int) -> Gen Int
chooseInt (Int
1, Int
22)
    (Int, Int) -> Gen Int
chooseInt (Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 :: Int), Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
e)

b32table :: B.ByteString
b32table :: ShareData
b32table = ShareData
"abcdefghijklmnopqrstuvwxyz234567"

b32encode :: B.ByteString -> String
b32encode :: ShareData -> String
b32encode = Text -> String
T.unpack (Text -> String) -> (ShareData -> Text) -> ShareData -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base32String -> Text
Base32.toText (Base32String -> Text)
-> (ShareData -> Base32String) -> ShareData -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShareData -> ShareData -> Base32String
Base32.fromBytes ShareData
b32table

genStorageIndex :: Gen StorageIndex
genStorageIndex :: Gen String
genStorageIndex =
    Gen ShareData -> (ShareData -> Maybe String) -> Gen String
forall a b. Gen a -> (a -> Maybe b) -> Gen b
suchThatMap Gen ShareData
gen10ByteString (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (ShareData -> String) -> ShareData -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShareData -> String
b32encode)

gen10ByteString :: Gen B.ByteString
gen10ByteString :: Gen ShareData
gen10ByteString =
    Gen [Word8] -> ([Word8] -> Maybe ShareData) -> Gen ShareData
forall a b. Gen a -> (a -> Maybe b) -> Gen b
suchThatMap (Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
10 (Gen Word8
forall a. Arbitrary a => Gen a
arbitrary :: Gen Word8)) (ShareData -> Maybe ShareData
forall a. a -> Maybe a
Just (ShareData -> Maybe ShareData)
-> ([Word8] -> ShareData) -> [Word8] -> Maybe ShareData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ShareData
B.pack)

shouldThrowAndShow :: forall e a. (HasCallStack, Exception e, Show a) => IO a -> Selector e -> Expectation
shouldThrowAndShow :: IO a -> Selector e -> Expectation
shouldThrowAndShow IO a
action Selector e
selector = do
    Either e a
result <- IO a -> IO (Either e a)
forall e a. Exception e => IO a -> IO (Either e a)
try IO a
action :: IO (Either e a)
    case Either e a
result of
        Left e
exc -> e -> IO Any
forall e a. Exception e => e -> IO a
throwIO e
exc IO Any -> Selector e -> Expectation
forall e a.
(HasCallStack, Exception e) =>
IO a -> Selector e -> Expectation
`shouldThrow` Selector e
selector
        Right a
value -> do
            String -> Expectation
forall a. Show a => a -> Expectation
print (String -> Expectation) -> String -> Expectation
forall a b. (a -> b) -> a -> b
$ String
"Got a value instead of an exception: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
value

{- | Instantiate property tests for the storage backend specification for a
 particular backend.
-}
makeStorageSpec ::
    Backend b =>
    -- | An action that produces a new, empty backend.
    IO b ->
    -- | A function that produces an action to clean up any state that may
    -- have been created in the given backend.
    (b -> IO ()) ->
    -- | A test specification for the backend.
    Spec
makeStorageSpec :: IO b -> (b -> Expectation) -> Spec
makeStorageSpec IO b
makeBackend b -> Expectation
cleanupBackend = do
    let runBackend :: (b -> Expectation) -> Expectation
runBackend = IO b -> (b -> Expectation) -> (b -> Expectation) -> Expectation
forall b.
Backend b =>
IO b -> (b -> Expectation) -> (b -> Expectation) -> Expectation
withBackend IO b
makeBackend b -> Expectation
cleanupBackend
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
context String
"v1" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
        String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
context String
"immutable" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
            String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"allocate a storage index" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
                String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"rejects allocations above the immutable share size limit" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$
                    Int
-> (ArbStorageIndex
    -> ShareNumbers -> ShareData -> Positive Integer -> Expectation)
-> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
few ((ArbStorageIndex
  -> ShareNumbers -> ShareData -> Positive Integer -> Expectation)
 -> Property)
-> (ArbStorageIndex
    -> ShareNumbers -> ShareData -> Positive Integer -> Expectation)
-> Property
forall a b. (a -> b) -> a -> b
$ \(ArbStorageIndex String
storageIndex) (ShareNumbers [ShareNumber]
shareNums) ShareData
secret (Positive Integer
extra) -> do
                        (b -> Expectation) -> Expectation
runBackend ((b -> Expectation) -> Expectation)
-> (b -> Expectation) -> Expectation
forall a b. (a -> b) -> a -> b
$ \b
backend -> do
                            Integer
limit <- Version1Parameters -> Integer
maximumImmutableShareSize (Version1Parameters -> Integer)
-> (Version -> Version1Parameters) -> Version -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Version1Parameters
parameters (Version -> Integer) -> IO Version -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> IO Version
forall b. Backend b => b -> IO Version
version b
backend
                            b
-> String
-> Maybe [LeaseSecret]
-> AllocateBuckets
-> IO AllocationResult
forall b.
Backend b =>
b
-> String
-> Maybe [LeaseSecret]
-> AllocateBuckets
-> IO AllocationResult
createImmutableStorageIndex b
backend String
storageIndex ([LeaseSecret] -> Maybe [LeaseSecret]
forall a. a -> Maybe a
Just [UploadSecret -> LeaseSecret
Upload (ShareData -> UploadSecret
UploadSecret ShareData
secret)]) ([ShareNumber] -> Integer -> AllocateBuckets
AllocateBuckets [ShareNumber]
shareNums (Integer
limit Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
extra))
                                IO AllocationResult -> Selector WriteImmutableError -> Expectation
forall e a.
(HasCallStack, Exception e) =>
IO a -> Selector e -> Expectation
`shouldThrow` (WriteImmutableError -> Selector WriteImmutableError
forall a. Eq a => a -> a -> Bool
== Integer -> Integer -> WriteImmutableError
MaximumShareSizeExceeded Integer
limit (Integer
limit Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
extra))

                String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"accounts for all allocated share numbers" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$
                    Property -> Property
forall prop. Testable prop => prop -> Property
property (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
                        Gen String
-> (String -> ShareNumbers -> Positive Integer -> Property)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen String
genStorageIndex (((b -> Expectation) -> Expectation)
-> String -> ShareNumbers -> Positive Integer -> Property
forall b.
Backend b =>
((b -> Expectation) -> Expectation)
-> String -> ShareNumbers -> Positive Integer -> Property
alreadyHavePlusAllocatedImm (b -> Expectation) -> Expectation
runBackend)

            String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"write a share" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
                String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"disallows writing an unallocated share" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$
                    Int
-> (ArbStorageIndex
    -> ShareNumber -> ShareData -> SmallShareData -> Expectation)
-> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
few ((ArbStorageIndex
  -> ShareNumber -> ShareData -> SmallShareData -> Expectation)
 -> Property)
-> (ArbStorageIndex
    -> ShareNumber -> ShareData -> SmallShareData -> Expectation)
-> Property
forall a b. (a -> b) -> a -> b
$ \(ArbStorageIndex String
storageIndex) ShareNumber
shareNum ShareData
secret (SmallShareData ShareData
shareData) ->
                        (b -> Expectation) -> Expectation
runBackend ((b -> Expectation) -> Expectation)
-> (b -> Expectation) -> Expectation
forall a b. (a -> b) -> a -> b
$ \b
backend -> do
                            b
-> String
-> ShareNumber
-> Maybe [LeaseSecret]
-> ShareData
-> Maybe ByteRanges
-> Expectation
forall b.
Backend b =>
b
-> String
-> ShareNumber
-> Maybe [LeaseSecret]
-> ShareData
-> Maybe ByteRanges
-> Expectation
writeImmutableShare b
backend String
storageIndex ShareNumber
shareNum ([LeaseSecret] -> Maybe [LeaseSecret]
forall a. a -> Maybe a
Just [UploadSecret -> LeaseSecret
Upload (ShareData -> UploadSecret
UploadSecret ShareData
secret)]) ShareData
shareData Maybe ByteRanges
forall a. Maybe a
Nothing
                                Expectation -> Selector WriteImmutableError -> Expectation
forall e a.
(HasCallStack, Exception e) =>
IO a -> Selector e -> Expectation
`shouldThrow` (WriteImmutableError -> Selector WriteImmutableError
forall a. Eq a => a -> a -> Bool
== WriteImmutableError
ShareNotAllocated)

                String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"disallows writes without an upload secret" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$
                    Expectation -> Property
forall prop. Testable prop => prop -> Property
property (Expectation -> Property) -> Expectation -> Property
forall a b. (a -> b) -> a -> b
$
                        (b -> Expectation) -> Expectation
runBackend ((b -> Expectation) -> Expectation)
-> (b -> Expectation) -> Expectation
forall a b. (a -> b) -> a -> b
$ \b
backend -> do
                            AllocationResult [] [ShareNumber Integer
0] <- b
-> String
-> Maybe [LeaseSecret]
-> AllocateBuckets
-> IO AllocationResult
forall b.
Backend b =>
b
-> String
-> Maybe [LeaseSecret]
-> AllocateBuckets
-> IO AllocationResult
createImmutableStorageIndex b
backend String
"storageindex" ([LeaseSecret] -> Maybe [LeaseSecret]
forall a. a -> Maybe a
Just [LeaseSecret
anUploadSecret]) ([ShareNumber] -> Integer -> AllocateBuckets
AllocateBuckets [Integer -> ShareNumber
ShareNumber Integer
0] Integer
100)
                            b
-> String
-> ShareNumber
-> Maybe [LeaseSecret]
-> ShareData
-> Maybe ByteRanges
-> Expectation
forall b.
Backend b =>
b
-> String
-> ShareNumber
-> Maybe [LeaseSecret]
-> ShareData
-> Maybe ByteRanges
-> Expectation
writeImmutableShare b
backend String
"storageindex" (Integer -> ShareNumber
ShareNumber Integer
0) Maybe [LeaseSecret]
forall a. Maybe a
Nothing ShareData
"fooooo" Maybe ByteRanges
forall a. Maybe a
Nothing Expectation -> Selector WriteImmutableError -> Expectation
forall e a.
(HasCallStack, Exception e) =>
IO a -> Selector e -> Expectation
`shouldThrow` (WriteImmutableError -> Selector WriteImmutableError
forall a. Eq a => a -> a -> Bool
== WriteImmutableError
MissingUploadSecret)

                String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"disallows writes without a matching upload secret" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$
                    Expectation -> Property
forall prop. Testable prop => prop -> Property
property (Expectation -> Property) -> Expectation -> Property
forall a b. (a -> b) -> a -> b
$
                        (b -> Expectation) -> Expectation
runBackend ((b -> Expectation) -> Expectation)
-> (b -> Expectation) -> Expectation
forall a b. (a -> b) -> a -> b
$ \b
backend -> do
                            AllocationResult [] [ShareNumber Integer
0] <- b
-> String
-> Maybe [LeaseSecret]
-> AllocateBuckets
-> IO AllocationResult
forall b.
Backend b =>
b
-> String
-> Maybe [LeaseSecret]
-> AllocateBuckets
-> IO AllocationResult
createImmutableStorageIndex b
backend String
"storageindex" ([LeaseSecret] -> Maybe [LeaseSecret]
forall a. a -> Maybe a
Just [LeaseSecret
anUploadSecret]) ([ShareNumber] -> Integer -> AllocateBuckets
AllocateBuckets [Integer -> ShareNumber
ShareNumber Integer
0] Integer
100)
                            -- Supply the wrong secret as an upload secret and the
                            -- right secret marked for some other use - this
                            -- should still fail.
                            b
-> String
-> ShareNumber
-> Maybe [LeaseSecret]
-> ShareData
-> Maybe ByteRanges
-> Expectation
forall b.
Backend b =>
b
-> String
-> ShareNumber
-> Maybe [LeaseSecret]
-> ShareData
-> Maybe ByteRanges
-> Expectation
writeImmutableShare b
backend String
"storageindex" (Integer -> ShareNumber
ShareNumber Integer
0) ([LeaseSecret] -> Maybe [LeaseSecret]
forall a. a -> Maybe a
Just [UploadSecret -> LeaseSecret
Upload (ShareData -> UploadSecret
UploadSecret ShareData
"wrongsecret")]) ShareData
"fooooo" Maybe ByteRanges
forall a. Maybe a
Nothing Expectation -> Selector WriteImmutableError -> Expectation
forall e a.
(HasCallStack, Exception e) =>
IO a -> Selector e -> Expectation
`shouldThrow` (WriteImmutableError -> Selector WriteImmutableError
forall a. Eq a => a -> a -> Bool
== WriteImmutableError
IncorrectUploadSecret)

                String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"returns the share numbers that were written" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$
                    Property -> Property
forall prop. Testable prop => prop -> Property
property (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
                        Gen String
-> (String -> ShareNumbers -> SmallShareData -> Property)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen String
genStorageIndex (((b -> Expectation) -> Expectation)
-> String -> ShareNumbers -> SmallShareData -> Property
forall b.
Backend b =>
((b -> Expectation) -> Expectation)
-> String -> ShareNumbers -> SmallShareData -> Property
immutableWriteAndEnumerateShares (b -> Expectation) -> Expectation
runBackend)

                String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"returns the written data when requested" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$
                    Property -> Property
forall prop. Testable prop => prop -> Property
property (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
                        Gen String
-> (String
    -> ShareNumbers -> NonEmptyList SomeShareData -> Property)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen String
genStorageIndex (((b -> Expectation) -> Expectation)
-> String -> ShareNumbers -> NonEmptyList SomeShareData -> Property
forall b.
Backend b =>
((b -> Expectation) -> Expectation)
-> String -> ShareNumbers -> NonEmptyList SomeShareData -> Property
immutableWriteAndReadShare (b -> Expectation) -> Expectation
runBackend)

                String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"cannot be written more than once" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$
                    Property -> Property
forall prop. Testable prop => prop -> Property
property (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
                        Gen String
-> (String -> ShareNumbers -> SomeShareData -> Property)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen String
genStorageIndex (((b -> Expectation) -> Expectation)
-> String -> ShareNumbers -> SomeShareData -> Property
forall b.
Backend b =>
((b -> Expectation) -> Expectation)
-> String -> ShareNumbers -> SomeShareData -> Property
immutableWriteAndRewriteShare (b -> Expectation) -> Expectation
runBackend)

        String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"aborting uploads" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
            String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"disallows aborts without an upload secret" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$
                Expectation -> Property
forall prop. Testable prop => prop -> Property
property (Expectation -> Property) -> Expectation -> Property
forall a b. (a -> b) -> a -> b
$
                    (b -> Expectation) -> Expectation
runBackend ((b -> Expectation) -> Expectation)
-> (b -> Expectation) -> Expectation
forall a b. (a -> b) -> a -> b
$ \b
backend -> do
                        b -> String -> ShareNumber -> Maybe [LeaseSecret] -> Expectation
forall b.
Backend b =>
b -> String -> ShareNumber -> Maybe [LeaseSecret] -> Expectation
abortImmutableUpload b
backend String
"storageindex" (Integer -> ShareNumber
ShareNumber Integer
0) Maybe [LeaseSecret]
forall a. Maybe a
Nothing Expectation -> Selector WriteImmutableError -> Expectation
forall e a.
(HasCallStack, Exception e) =>
IO a -> Selector e -> Expectation
`shouldThrow` (WriteImmutableError -> Selector WriteImmutableError
forall a. Eq a => a -> a -> Bool
== WriteImmutableError
MissingUploadSecret)

            String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"disallows upload completion after a successful abort" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$
                Int
-> (ArbStorageIndex
    -> ShareNumber
    -> ShareData
    -> SmallShareData
    -> Integer
    -> Expectation)
-> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
few ((ArbStorageIndex
  -> ShareNumber
  -> ShareData
  -> SmallShareData
  -> Integer
  -> Expectation)
 -> Property)
-> (ArbStorageIndex
    -> ShareNumber
    -> ShareData
    -> SmallShareData
    -> Integer
    -> Expectation)
-> Property
forall a b. (a -> b) -> a -> b
$ \(ArbStorageIndex String
storageIndex) ShareNumber
shareNum ShareData
secret (SmallShareData ShareData
shareData) Integer
size ->
                    (b -> Expectation) -> Expectation
runBackend ((b -> Expectation) -> Expectation)
-> (b -> Expectation) -> Expectation
forall a b. (a -> b) -> a -> b
$ \b
backend -> do
                        IO AllocationResult -> Expectation
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO AllocationResult -> Expectation)
-> IO AllocationResult -> Expectation
forall a b. (a -> b) -> a -> b
$ b
-> String
-> Maybe [LeaseSecret]
-> AllocateBuckets
-> IO AllocationResult
forall b.
Backend b =>
b
-> String
-> Maybe [LeaseSecret]
-> AllocateBuckets
-> IO AllocationResult
createImmutableStorageIndex b
backend String
storageIndex ([LeaseSecret] -> Maybe [LeaseSecret]
forall a. a -> Maybe a
Just [UploadSecret -> LeaseSecret
Upload (ShareData -> UploadSecret
UploadSecret ShareData
secret)]) ([ShareNumber] -> Integer -> AllocateBuckets
AllocateBuckets [ShareNumber
shareNum] Integer
size)
                        b -> String -> ShareNumber -> Maybe [LeaseSecret] -> Expectation
forall b.
Backend b =>
b -> String -> ShareNumber -> Maybe [LeaseSecret] -> Expectation
abortImmutableUpload b
backend String
storageIndex ShareNumber
shareNum ([LeaseSecret] -> Maybe [LeaseSecret]
forall a. a -> Maybe a
Just [UploadSecret -> LeaseSecret
Upload (ShareData -> UploadSecret
UploadSecret ShareData
secret)])
                        b
-> String
-> ShareNumber
-> Maybe [LeaseSecret]
-> ShareData
-> Maybe ByteRanges
-> Expectation
forall b.
Backend b =>
b
-> String
-> ShareNumber
-> Maybe [LeaseSecret]
-> ShareData
-> Maybe ByteRanges
-> Expectation
writeImmutableShare b
backend String
storageIndex ShareNumber
shareNum ([LeaseSecret] -> Maybe [LeaseSecret]
forall a. a -> Maybe a
Just [UploadSecret -> LeaseSecret
Upload (ShareData -> UploadSecret
UploadSecret ShareData
secret)]) ShareData
shareData Maybe ByteRanges
forall a. Maybe a
Nothing
                            Expectation -> Selector WriteImmutableError -> Expectation
forall e a.
(HasCallStack, Exception e) =>
IO a -> Selector e -> Expectation
`shouldThrow` (WriteImmutableError -> Selector WriteImmutableError
forall a. Eq a => a -> a -> Bool
== WriteImmutableError
ShareNotAllocated)

            String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"disallows aborts without a matching upload secret" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$
                Expectation -> Property
forall prop. Testable prop => prop -> Property
property (Expectation -> Property) -> Expectation -> Property
forall a b. (a -> b) -> a -> b
$
                    (b -> Expectation) -> Expectation
runBackend ((b -> Expectation) -> Expectation)
-> (b -> Expectation) -> Expectation
forall a b. (a -> b) -> a -> b
$ \b
backend -> do
                        AllocationResult [] [ShareNumber Integer
0] <- b
-> String
-> Maybe [LeaseSecret]
-> AllocateBuckets
-> IO AllocationResult
forall b.
Backend b =>
b
-> String
-> Maybe [LeaseSecret]
-> AllocateBuckets
-> IO AllocationResult
createImmutableStorageIndex b
backend String
"storageindex" ([LeaseSecret] -> Maybe [LeaseSecret]
forall a. a -> Maybe a
Just [LeaseSecret
anUploadSecret]) ([ShareNumber] -> Integer -> AllocateBuckets
AllocateBuckets [Integer -> ShareNumber
ShareNumber Integer
0] Integer
100)
                        b -> String -> ShareNumber -> Maybe [LeaseSecret] -> Expectation
forall b.
Backend b =>
b -> String -> ShareNumber -> Maybe [LeaseSecret] -> Expectation
abortImmutableUpload b
backend String
"storageindex" (Integer -> ShareNumber
ShareNumber Integer
0) ([LeaseSecret] -> Maybe [LeaseSecret]
forall a. a -> Maybe a
Just [UploadSecret -> LeaseSecret
Upload (ShareData -> UploadSecret
UploadSecret ShareData
"wrongsecret")]) Expectation -> Selector WriteImmutableError -> Expectation
forall e a.
(HasCallStack, Exception e) =>
IO a -> Selector e -> Expectation
`shouldThrow` (WriteImmutableError -> Selector WriteImmutableError
forall a. Eq a => a -> a -> Bool
== WriteImmutableError
IncorrectUploadSecret)

            String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"allows aborts with a matching upload secret" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$
                Expectation -> Property
forall prop. Testable prop => prop -> Property
property (Expectation -> Property) -> Expectation -> Property
forall a b. (a -> b) -> a -> b
$
                    (b -> Expectation) -> Expectation
runBackend ((b -> Expectation) -> Expectation)
-> (b -> Expectation) -> Expectation
forall a b. (a -> b) -> a -> b
$ \b
backend -> do
                        AllocationResult [] [ShareNumber Integer
0] <- b
-> String
-> Maybe [LeaseSecret]
-> AllocateBuckets
-> IO AllocationResult
forall b.
Backend b =>
b
-> String
-> Maybe [LeaseSecret]
-> AllocateBuckets
-> IO AllocationResult
createImmutableStorageIndex b
backend String
"storageindex" ([LeaseSecret] -> Maybe [LeaseSecret]
forall a. a -> Maybe a
Just [LeaseSecret
anUploadSecret]) ([ShareNumber] -> Integer -> AllocateBuckets
AllocateBuckets [Integer -> ShareNumber
ShareNumber Integer
0] Integer
100)
                        b -> String -> ShareNumber -> Maybe [LeaseSecret] -> Expectation
forall b.
Backend b =>
b -> String -> ShareNumber -> Maybe [LeaseSecret] -> Expectation
abortImmutableUpload b
backend String
"storageindex" (Integer -> ShareNumber
ShareNumber Integer
0) ([LeaseSecret] -> Maybe [LeaseSecret]
forall a. a -> Maybe a
Just [LeaseSecret
anUploadSecret])

        String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
context String
"mutable" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
            -- XXX There's lots of problems around supplying negative integer
            -- values in most places.  We avoid tripping over those cases here
            -- but we should really fix the implementation to deal with them
            -- sensible.
            String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"write a share" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
                String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"returns the share numbers that were written" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$
                    Property -> Property
forall prop. Testable prop => prop -> Property
property (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
                        Gen String
-> (String -> ShareNumbers -> SmallShareData -> Property)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen String
genStorageIndex (((b -> Expectation) -> Expectation)
-> String -> ShareNumbers -> SmallShareData -> Property
forall b.
Backend b =>
((b -> Expectation) -> Expectation)
-> String -> ShareNumbers -> SmallShareData -> Property
mutableWriteAndEnumerateShares (b -> Expectation) -> Expectation
runBackend)

                String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"rejects an update with the wrong write enabler" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$
                    Gen String
-> (String
    -> ShareNumber
    -> (ShareData, ShareData)
    -> (SmallShareData, SmallShareData)
    -> NonNegative Integer
    -> Property)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen String
genStorageIndex ((String
  -> ShareNumber
  -> (ShareData, ShareData)
  -> (SmallShareData, SmallShareData)
  -> NonNegative Integer
  -> Property)
 -> Property)
-> (String
    -> ShareNumber
    -> (ShareData, ShareData)
    -> (SmallShareData, SmallShareData)
    -> NonNegative Integer
    -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \String
storageIndex ShareNumber
shareNum (ShareData
secret, ShareData
wrongSecret) (SmallShareData ShareData
shareData, SmallShareData ShareData
junkData) (NonNegative Integer
offset) ->
                        (ShareData
secret ShareData -> ShareData -> Bool
forall a. Eq a => a -> a -> Bool
/= ShareData
wrongSecret)
                            Bool -> Bool -> Bool
&& (ShareData
shareData ShareData -> ShareData -> Bool
forall a. Eq a => a -> a -> Bool
/= ShareData
junkData)
                            Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> PropertyM IO () -> Property
forall a. Testable a => PropertyM IO a -> Property
monadicIO
                                (PropertyM IO () -> Property)
-> ((b -> Expectation) -> PropertyM IO ())
-> (b -> Expectation)
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expectation -> PropertyM IO ()
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
run
                                (Expectation -> PropertyM IO ())
-> ((b -> Expectation) -> Expectation)
-> (b -> Expectation)
-> PropertyM IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Expectation) -> Expectation
runBackend
                            ((b -> Expectation) -> Property) -> (b -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \b
backend -> do
                                ReadTestWriteResult
first <- b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> IO ReadTestWriteResult
forall b.
Backend b =>
b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> IO ReadTestWriteResult
readvAndTestvAndWritev b
backend String
storageIndex (ShareData -> WriteEnablerSecret
WriteEnablerSecret ShareData
secret) (ShareNumber -> Integer -> ShareData -> ReadTestWriteVectors
writev ShareNumber
shareNum Integer
offset ShareData
shareData)
                                ReadTestWriteResult -> Bool
success ReadTestWriteResult
first Bool -> Bool -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Bool
True
                                b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> IO ReadTestWriteResult
forall b.
Backend b =>
b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> IO ReadTestWriteResult
readvAndTestvAndWritev b
backend String
storageIndex (ShareData -> WriteEnablerSecret
WriteEnablerSecret ShareData
wrongSecret) (ShareNumber -> Integer -> ShareData -> ReadTestWriteVectors
writev ShareNumber
shareNum Integer
offset ShareData
junkData)
                                    IO ReadTestWriteResult -> Selector WriteMutableError -> Expectation
forall e a.
(HasCallStack, Exception e, Show a) =>
IO a -> Selector e -> Expectation
`shouldThrowAndShow` (WriteMutableError -> Selector WriteMutableError
forall a. Eq a => a -> a -> Bool
== WriteMutableError
IncorrectWriteEnablerSecret)
                                ReadTestWriteResult
third <- b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> IO ReadTestWriteResult
forall b.
Backend b =>
b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> IO ReadTestWriteResult
readvAndTestvAndWritev b
backend String
storageIndex (ShareData -> WriteEnablerSecret
WriteEnablerSecret ShareData
secret) (Integer -> Integer -> ReadTestWriteVectors
readv Integer
offset (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ ShareData -> Int
B.length ShareData
shareData))
                                ReadTestWriteResult -> ReadResult
readData ReadTestWriteResult
third ReadResult -> ReadResult -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` ShareNumber -> [ShareData] -> ReadResult
forall k a. k -> a -> Map k a
Map.singleton ShareNumber
shareNum [ShareData
shareData]

                String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"returns the written data when requested" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$
                    Gen String
-> (String -> ShareData -> MutableWriteExample -> Property)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen String
genStorageIndex (((b -> Expectation) -> Expectation)
-> String -> ShareData -> MutableWriteExample -> Property
forall b.
Backend b =>
((b -> Expectation) -> Expectation)
-> String -> ShareData -> MutableWriteExample -> Property
mutableWriteAndReadShare (b -> Expectation) -> Expectation
runBackend)

                String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"overwrites older data with newer data" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$
                    -- XXX We go out of our way to generate a legal storage
                    -- index here.  Illegal storage indexes aren't checked by
                    -- the system anywhere but they really ought to be.
                    Gen String
-> (String
    -> NonEmptyList ReadVector
    -> ShareData
    -> ShareNumber
    -> Gen Property)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen String
genStorageIndex ((String
  -> NonEmptyList ReadVector
  -> ShareData
  -> ShareNumber
  -> Gen Property)
 -> Property)
-> (String
    -> NonEmptyList ReadVector
    -> ShareData
    -> ShareNumber
    -> Gen Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \String
storageIndex (NonEmptyList ReadVector
readVectors :: NonEmptyList ReadVector) ShareData
secret ShareNumber
shareNum -> do
                        let is :: IntervalSet Integer
is = [ReadVector] -> IntervalSet Integer
readVectorToIntervalSet (NonEmptyList ReadVector -> [ReadVector]
forall a. NonEmptyList a -> [a]
getNonEmpty NonEmptyList ReadVector
readVectors)
                            sp :: Interval Integer
sp = IntervalSet Integer -> Interval Integer
forall r. Ord r => IntervalSet r -> Interval r
IS.span IntervalSet Integer
is
                            (Integer
lower, Integer
upper) = Interval Integer -> (Integer, Integer)
forall r. Show r => Interval r -> (r, r)
toFiniteBounds Interval Integer
sp
                            size :: Integer
size = Integer
upper Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
lower
                        ShareData
bs <- [Word8] -> ShareData
B.pack ([Word8] -> ShareData) -> Gen [Word8] -> Gen ShareData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [Word8]
forall a. Arbitrary a => Int -> Gen [a]
vector (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
size)
                        [WriteVector]
writeVectors <- ShareData -> Integer -> Integer -> Gen [WriteVector]
writesThatResultIn ShareData
bs Integer
lower Integer
size
                        Property -> Gen Property
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Property -> Gen Property) -> Property -> Gen Property
forall a b. (a -> b) -> a -> b
$
                            String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"write vectors: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [WriteVector] -> String
forall a. Show a => a -> String
show [WriteVector]
writeVectors) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
                                Expectation -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (Expectation -> Property) -> Expectation -> Property
forall a b. (a -> b) -> a -> b
$
                                    (b -> Expectation) -> Expectation
runBackend ((b -> Expectation) -> Expectation)
-> (b -> Expectation) -> Expectation
forall a b. (a -> b) -> a -> b
$ \b
backend -> do
                                        let x :: ReadTestWriteVectors
x = (WriteVector -> ReadTestWriteVectors)
-> [WriteVector] -> ReadTestWriteVectors
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(WriteVector Integer
off ShareData
shareData) -> ShareNumber -> Integer -> ShareData -> ReadTestWriteVectors
writev ShareNumber
shareNum Integer
off ShareData
shareData) [WriteVector]
writeVectors
                                        ReadTestWriteResult
writeResult <- b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> IO ReadTestWriteResult
forall b.
Backend b =>
b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> IO ReadTestWriteResult
readvAndTestvAndWritev b
backend String
storageIndex (ShareData -> WriteEnablerSecret
WriteEnablerSecret ShareData
secret) ReadTestWriteVectors
x
                                        ReadTestWriteResult -> Bool
success ReadTestWriteResult
writeResult Bool -> Bool -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Bool
True

                                        let y :: ReadTestWriteVectors
y = (ReadVector -> ReadTestWriteVectors)
-> [ReadVector] -> ReadTestWriteVectors
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(ReadVector Integer
off Integer
sz) -> Integer -> Integer -> ReadTestWriteVectors
readv Integer
off Integer
sz) (NonEmptyList ReadVector -> [ReadVector]
forall a. NonEmptyList a -> [a]
getNonEmpty NonEmptyList ReadVector
readVectors)
                                        ReadTestWriteResult
readResult <- b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> IO ReadTestWriteResult
forall b.
Backend b =>
b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> IO ReadTestWriteResult
readvAndTestvAndWritev b
backend String
storageIndex (ShareData -> WriteEnablerSecret
WriteEnablerSecret ShareData
secret) ReadTestWriteVectors
y
                                        ([ShareData] -> ShareData)
-> ReadResult -> Map ShareNumber ShareData
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map [ShareData] -> ShareData
B.concat (ReadTestWriteResult -> ReadResult
readData ReadTestWriteResult
readResult)
                                            Map ShareNumber ShareData
-> Map ShareNumber ShareData -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` ShareNumber -> ShareData -> Map ShareNumber ShareData
forall k a. k -> a -> Map k a
Map.singleton ShareNumber
shareNum ([ShareData] -> ShareData
B.concat ([ShareData] -> ShareData) -> [ShareData] -> ShareData
forall a b. (a -> b) -> a -> b
$ Integer -> ShareData -> ReadVector -> ShareData
forall a. Integral a => a -> ShareData -> ReadVector -> ShareData
extractRead Integer
lower ShareData
bs (ReadVector -> ShareData) -> [ReadVector] -> [ShareData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmptyList ReadVector -> [ReadVector]
forall a. NonEmptyList a -> [a]
getNonEmpty NonEmptyList ReadVector
readVectors)

                String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"accepts writes for which the test condition succeeds" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$
                    Int -> (ArbStorageIndex -> ShareData -> Expectation) -> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
few ((ArbStorageIndex -> ShareData -> Expectation) -> Property)
-> (ArbStorageIndex -> ShareData -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \(ArbStorageIndex String
storageIndex) ShareData
secret ->
                        (b -> Expectation) -> Expectation
runBackend ((b -> Expectation) -> Expectation)
-> (b -> Expectation) -> Expectation
forall a b. (a -> b) -> a -> b
$ \b
backend -> do
                            b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> Expectation
forall b.
Backend b =>
b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> Expectation
runReadTestWrite_ b
backend String
storageIndex (ShareData -> WriteEnablerSecret
WriteEnablerSecret ShareData
secret) (ShareNumber -> Integer -> ShareData -> ReadTestWriteVectors
writev (Integer -> ShareNumber
ShareNumber Integer
0) Integer
0 ShareData
"abc")
                            b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> Expectation
forall b.
Backend b =>
b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> Expectation
runReadTestWrite_ b
backend String
storageIndex (ShareData -> WriteEnablerSecret
WriteEnablerSecret ShareData
secret) (ShareNumber -> Integer -> ShareData -> ReadTestWriteVectors
testv (Integer -> ShareNumber
ShareNumber Integer
0) Integer
0 ShareData
"abc" ReadTestWriteVectors
-> ReadTestWriteVectors -> ReadTestWriteVectors
forall a. Semigroup a => a -> a -> a
<> ShareNumber -> Integer -> ShareData -> ReadTestWriteVectors
writev (Integer -> ShareNumber
ShareNumber Integer
0) Integer
0 ShareData
"xyz")
                            b -> String -> ShareNumber -> Maybe ByteRanges -> IO ShareData
forall b.
Backend b =>
b -> String -> ShareNumber -> Maybe ByteRanges -> IO ShareData
readMutableShare b
backend String
storageIndex (Integer -> ShareNumber
ShareNumber Integer
0) Maybe ByteRanges
forall a. Maybe a
Nothing IO ShareData -> ShareData -> Expectation
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation
`shouldReturn` ShareData
"xyz"

                String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"rejects writes for which the test condition fails" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$
                    Int -> (ArbStorageIndex -> ShareData -> Expectation) -> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
few ((ArbStorageIndex -> ShareData -> Expectation) -> Property)
-> (ArbStorageIndex -> ShareData -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \(ArbStorageIndex String
storageIndex) ShareData
secret ->
                        (b -> Expectation) -> Expectation
runBackend ((b -> Expectation) -> Expectation)
-> (b -> Expectation) -> Expectation
forall a b. (a -> b) -> a -> b
$ \b
backend -> do
                            b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> Expectation
forall b.
Backend b =>
b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> Expectation
runReadTestWrite_ b
backend String
storageIndex (ShareData -> WriteEnablerSecret
WriteEnablerSecret ShareData
secret) (ShareNumber -> Integer -> ShareData -> ReadTestWriteVectors
writev (Integer -> ShareNumber
ShareNumber Integer
0) Integer
0 ShareData
"abc")
                            b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> IO ReadResult
forall b.
Backend b =>
b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> IO ReadResult
runReadTestWrite b
backend String
storageIndex (ShareData -> WriteEnablerSecret
WriteEnablerSecret ShareData
secret) (ShareNumber -> Integer -> ShareData -> ReadTestWriteVectors
testv (Integer -> ShareNumber
ShareNumber Integer
0) Integer
0 ShareData
"abd" ReadTestWriteVectors
-> ReadTestWriteVectors -> ReadTestWriteVectors
forall a. Semigroup a => a -> a -> a
<> ShareNumber -> Integer -> ShareData -> ReadTestWriteVectors
writev (Integer -> ShareNumber
ShareNumber Integer
0) Integer
0 ShareData
"xyz")
                                IO ReadResult -> Selector WriteRefused -> Expectation
forall e a.
(HasCallStack, Exception e) =>
IO a -> Selector e -> Expectation
`shouldThrow` (\WriteRefused{} -> Bool
True)
                            b -> String -> ShareNumber -> Maybe ByteRanges -> IO ShareData
forall b.
Backend b =>
b -> String -> ShareNumber -> Maybe ByteRanges -> IO ShareData
readMutableShare b
backend String
storageIndex (Integer -> ShareNumber
ShareNumber Integer
0) Maybe ByteRanges
forall a. Maybe a
Nothing IO ShareData -> ShareData -> Expectation
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation
`shouldReturn` ShareData
"abc"

                String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"retrieves share data from before writes are applied" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
                    Int -> (ArbStorageIndex -> ShareData -> Expectation) -> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
few ((ArbStorageIndex -> ShareData -> Expectation) -> Property)
-> (ArbStorageIndex -> ShareData -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \(ArbStorageIndex String
storageIndex) ShareData
secret ->
                        (b -> Expectation) -> Expectation
runBackend ((b -> Expectation) -> Expectation)
-> (b -> Expectation) -> Expectation
forall a b. (a -> b) -> a -> b
$ \b
backend -> do
                            b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> Expectation
forall b.
Backend b =>
b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> Expectation
runReadTestWrite_ b
backend String
storageIndex (ShareData -> WriteEnablerSecret
WriteEnablerSecret ShareData
secret) (ShareNumber -> Integer -> ShareData -> ReadTestWriteVectors
writev (Integer -> ShareNumber
ShareNumber Integer
0) Integer
0 ShareData
"abc")
                            b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> IO ReadResult
forall b.
Backend b =>
b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> IO ReadResult
runReadTestWrite b
backend String
storageIndex (ShareData -> WriteEnablerSecret
WriteEnablerSecret ShareData
secret) (Integer -> Integer -> ReadTestWriteVectors
readv Integer
0 Integer
3 ReadTestWriteVectors
-> ReadTestWriteVectors -> ReadTestWriteVectors
forall a. Semigroup a => a -> a -> a
<> ShareNumber -> Integer -> ShareData -> ReadTestWriteVectors
writev (Integer -> ShareNumber
ShareNumber Integer
0) Integer
0 ShareData
"xyz")
                                IO ReadResult -> ReadResult -> Expectation
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation
`shouldReturn` [(ShareNumber, [ShareData])] -> ReadResult
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Integer -> ShareNumber
ShareNumber Integer
0, [ShareData
"abc"])]
                            b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> IO ReadResult
forall b.
Backend b =>
b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> IO ReadResult
runReadTestWrite b
backend String
storageIndex (ShareData -> WriteEnablerSecret
WriteEnablerSecret ShareData
secret) (Integer -> Integer -> ReadTestWriteVectors
readv Integer
0 Integer
3)
                                IO ReadResult -> ReadResult -> Expectation
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation
`shouldReturn` [(ShareNumber, [ShareData])] -> ReadResult
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Integer -> ShareNumber
ShareNumber Integer
0, [ShareData
"xyz"])]

alreadyHavePlusAllocatedImm ::
    Backend b =>
    ((b -> IO ()) -> IO ()) -> -- Execute a function on the backend.
    StorageIndex -> -- The storage index to use
    ShareNumbers -> -- The share numbers to allocate
    Positive Size -> -- The size of each share
    Property
alreadyHavePlusAllocatedImm :: ((b -> Expectation) -> Expectation)
-> String -> ShareNumbers -> Positive Integer -> Property
alreadyHavePlusAllocatedImm (b -> Expectation) -> Expectation
runBackend String
storageIndex (ShareNumbers [ShareNumber]
shareNumbers) (Positive Integer
size) = PropertyM IO () -> Property
forall a. Testable a => PropertyM IO a -> Property
monadicIO (PropertyM IO () -> Property) -> PropertyM IO () -> Property
forall a b. (a -> b) -> a -> b
$
    Expectation -> PropertyM IO ()
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
run (Expectation -> PropertyM IO ()) -> Expectation -> PropertyM IO ()
forall a b. (a -> b) -> a -> b
$
        (b -> Expectation) -> Expectation
runBackend ((b -> Expectation) -> Expectation)
-> (b -> Expectation) -> Expectation
forall a b. (a -> b) -> a -> b
$ \b
backend -> do
            AllocationResult
result <- b
-> String
-> Maybe [LeaseSecret]
-> AllocateBuckets
-> IO AllocationResult
forall b.
Backend b =>
b
-> String
-> Maybe [LeaseSecret]
-> AllocateBuckets
-> IO AllocationResult
createImmutableStorageIndex b
backend String
storageIndex ([LeaseSecret] -> Maybe [LeaseSecret]
forall a. a -> Maybe a
Just [LeaseSecret
anUploadSecret]) (AllocateBuckets -> IO AllocationResult)
-> AllocateBuckets -> IO AllocationResult
forall a b. (a -> b) -> a -> b
$ [ShareNumber] -> Integer -> AllocateBuckets
AllocateBuckets [ShareNumber]
shareNumbers Integer
size
            Bool -> Expectation -> Expectation
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AllocationResult -> [ShareNumber]
alreadyHave AllocationResult
result [ShareNumber] -> [ShareNumber] -> [ShareNumber]
forall a. [a] -> [a] -> [a]
++ AllocationResult -> [ShareNumber]
allocated AllocationResult
result [ShareNumber] -> [ShareNumber] -> Bool
forall a. Eq a => a -> a -> Bool
/= [ShareNumber]
shareNumbers) (Expectation -> Expectation) -> Expectation -> Expectation
forall a b. (a -> b) -> a -> b
$
                String -> Expectation
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
                    ( [ShareNumber] -> String
forall a. Show a => a -> String
show (AllocationResult -> [ShareNumber]
alreadyHave AllocationResult
result)
                        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ++ "
                        String -> ShowS
forall a. [a] -> [a] -> [a]
++ [ShareNumber] -> String
forall a. Show a => a -> String
show (AllocationResult -> [ShareNumber]
allocated AllocationResult
result)
                        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" /= "
                        String -> ShowS
forall a. [a] -> [a] -> [a]
++ [ShareNumber] -> String
forall a. Show a => a -> String
show [ShareNumber]
shareNumbers
                    )

-- The share numbers of immutable share data written to the shares of a given
-- storage index can be retrieved.
immutableWriteAndEnumerateShares ::
    Backend b =>
    ((b -> IO ()) -> IO ()) -> -- Execute a function on the backend.
    StorageIndex ->
    ShareNumbers ->
    SmallShareData ->
    Property
immutableWriteAndEnumerateShares :: ((b -> Expectation) -> Expectation)
-> String -> ShareNumbers -> SmallShareData -> Property
immutableWriteAndEnumerateShares (b -> Expectation) -> Expectation
runBackend String
storageIndex (ShareNumbers [ShareNumber]
shareNumbers) (SmallShareData ShareData
shareSeed) = do
    let permutedShares :: [[SomeShareData]]
permutedShares = (ShareNumber -> SomeShareData -> SomeShareData)
-> [ShareNumber] -> [SomeShareData] -> [[SomeShareData]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [[c]]
outerProduct ShareNumber -> SomeShareData -> SomeShareData
permuteShare [ShareNumber]
shareNumbers [ShareData -> SomeShareData
SomeShareData ShareData
shareSeed]
        allocate :: AllocateBuckets
allocate = [ShareNumber] -> Integer -> AllocateBuckets
AllocateBuckets [ShareNumber]
shareNumbers (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ ShareData -> Int
B.length ShareData
shareSeed)
    Gen [[(Maybe ByteRanges, SomeShareData)]]
-> ([[(Maybe ByteRanges, SomeShareData)]] -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (([SomeShareData] -> Gen [(Maybe ByteRanges, SomeShareData)])
-> [[SomeShareData]] -> Gen [[(Maybe ByteRanges, SomeShareData)]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse [SomeShareData] -> Gen [(Maybe ByteRanges, SomeShareData)]
jumbleForUpload [[SomeShareData]]
permutedShares) (([[(Maybe ByteRanges, SomeShareData)]] -> Property) -> Property)
-> ([[(Maybe ByteRanges, SomeShareData)]] -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \[[(Maybe ByteRanges, SomeShareData)]]
shareChunks -> PropertyM IO () -> Property
forall a. Testable a => PropertyM IO a -> Property
monadicIO (PropertyM IO () -> Property) -> PropertyM IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
        Expectation -> PropertyM IO ()
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
run (Expectation -> PropertyM IO ()) -> Expectation -> PropertyM IO ()
forall a b. (a -> b) -> a -> b
$
            (b -> Expectation) -> Expectation
runBackend ((b -> Expectation) -> Expectation)
-> (b -> Expectation) -> Expectation
forall a b. (a -> b) -> a -> b
$ \b
backend -> do
                IO AllocationResult -> Expectation
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO AllocationResult -> Expectation)
-> IO AllocationResult -> Expectation
forall a b. (a -> b) -> a -> b
$ b
-> String
-> Maybe [LeaseSecret]
-> AllocateBuckets
-> IO AllocationResult
forall b.
Backend b =>
b
-> String
-> Maybe [LeaseSecret]
-> AllocateBuckets
-> IO AllocationResult
createImmutableStorageIndex b
backend String
storageIndex Maybe [LeaseSecret]
uploadSecret AllocateBuckets
allocate
                let writes :: [(ShareNumber, [(Maybe ByteRanges, ShareData)])]
writes = [ShareNumber]
-> [[(Maybe ByteRanges, ShareData)]]
-> [(ShareNumber, [(Maybe ByteRanges, ShareData)])]
forall a b. [a] -> [b] -> [(a, b)]
zip [ShareNumber]
shareNumbers (((Maybe ByteRanges, SomeShareData)
 -> (Maybe ByteRanges, ShareData))
-> [(Maybe ByteRanges, SomeShareData)]
-> [(Maybe ByteRanges, ShareData)]
forall a b. (a -> b) -> [a] -> [b]
map ((SomeShareData -> ShareData)
-> (Maybe ByteRanges, SomeShareData)
-> (Maybe ByteRanges, ShareData)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second SomeShareData -> ShareData
getShareData) ([(Maybe ByteRanges, SomeShareData)]
 -> [(Maybe ByteRanges, ShareData)])
-> [[(Maybe ByteRanges, SomeShareData)]]
-> [[(Maybe ByteRanges, ShareData)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[(Maybe ByteRanges, SomeShareData)]]
shareChunks)
                (ShareNumber -> ShareData -> Maybe ByteRanges -> Expectation)
-> [(ShareNumber, [(Maybe ByteRanges, ShareData)])] -> Expectation
forall shareData dataRange.
(ShareNumber -> shareData -> dataRange -> Expectation)
-> [(ShareNumber, [(dataRange, shareData)])] -> Expectation
writeShares (\ShareNumber
sn -> b
-> String
-> ShareNumber
-> Maybe [LeaseSecret]
-> ShareData
-> Maybe ByteRanges
-> Expectation
forall b.
Backend b =>
b
-> String
-> ShareNumber
-> Maybe [LeaseSecret]
-> ShareData
-> Maybe ByteRanges
-> Expectation
writeImmutableShare b
backend String
storageIndex ShareNumber
sn Maybe [LeaseSecret]
uploadSecret) [(ShareNumber, [(Maybe ByteRanges, ShareData)])]
writes
                CBORSet ShareNumber
readShareNumbers <- b -> String -> IO (CBORSet ShareNumber)
forall b. Backend b => b -> String -> IO (CBORSet ShareNumber)
getImmutableShareNumbers b
backend String
storageIndex
                Bool -> Expectation -> Expectation
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CBORSet ShareNumber
readShareNumbers CBORSet ShareNumber -> CBORSet ShareNumber -> Bool
forall a. Eq a => a -> a -> Bool
/= (Set ShareNumber -> CBORSet ShareNumber
forall a. Set a -> CBORSet a
CBORSet (Set ShareNumber -> CBORSet ShareNumber)
-> ([ShareNumber] -> Set ShareNumber)
-> [ShareNumber]
-> CBORSet ShareNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ShareNumber] -> Set ShareNumber
forall a. Ord a => [a] -> Set a
Set.fromList ([ShareNumber] -> CBORSet ShareNumber)
-> [ShareNumber] -> CBORSet ShareNumber
forall a b. (a -> b) -> a -> b
$ [ShareNumber]
shareNumbers)) (Expectation -> Expectation) -> Expectation -> Expectation
forall a b. (a -> b) -> a -> b
$
                    String -> Expectation
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (CBORSet ShareNumber -> String
forall a. Show a => a -> String
show CBORSet ShareNumber
readShareNumbers String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" /= " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [ShareNumber] -> String
forall a. Show a => a -> String
show [ShareNumber]
shareNumbers)
  where
    uploadSecret :: Maybe [LeaseSecret]
uploadSecret = [LeaseSecret] -> Maybe [LeaseSecret]
forall a. a -> Maybe a
Just [LeaseSecret
anUploadSecret]

jumbleForUpload :: [SomeShareData] -> Gen [(Maybe ByteRanges, SomeShareData)]
jumbleForUpload :: [SomeShareData] -> Gen [(Maybe ByteRanges, SomeShareData)]
jumbleForUpload =
    ([(Maybe ByteRanges, ShareData)]
 -> [(Maybe ByteRanges, SomeShareData)])
-> Gen [(Maybe ByteRanges, ShareData)]
-> Gen [(Maybe ByteRanges, SomeShareData)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Maybe ByteRanges, ShareData)
 -> (Maybe ByteRanges, SomeShareData))
-> [(Maybe ByteRanges, ShareData)]
-> [(Maybe ByteRanges, SomeShareData)]
forall a b. (a -> b) -> [a] -> [b]
map ((ShareData -> SomeShareData)
-> (Maybe ByteRanges, ShareData)
-> (Maybe ByteRanges, SomeShareData)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ShareData -> SomeShareData
SomeShareData))
        (Gen [(Maybe ByteRanges, ShareData)]
 -> Gen [(Maybe ByteRanges, SomeShareData)])
-> ([SomeShareData] -> Gen [(Maybe ByteRanges, ShareData)])
-> [SomeShareData]
-> Gen [(Maybe ByteRanges, SomeShareData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Maybe ByteRanges, ShareData)]
-> Gen [(Maybe ByteRanges, ShareData)]
forall a. [a] -> Gen [a]
shuffle
        ([(Maybe ByteRanges, ShareData)]
 -> Gen [(Maybe ByteRanges, ShareData)])
-> ([SomeShareData] -> [(Maybe ByteRanges, ShareData)])
-> [SomeShareData]
-> Gen [(Maybe ByteRanges, ShareData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [(Maybe ByteRanges, ShareData)])
-> [(Maybe ByteRanges, ShareData)]
forall a b. (a, b) -> b
snd
        ((Int, [(Maybe ByteRanges, ShareData)])
 -> [(Maybe ByteRanges, ShareData)])
-> ([SomeShareData] -> (Int, [(Maybe ByteRanges, ShareData)]))
-> [SomeShareData]
-> [(Maybe ByteRanges, ShareData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, [(Maybe ByteRanges, ShareData)])
 -> ShareData -> (Int, [(Maybe ByteRanges, ShareData)]))
-> (Int, [(Maybe ByteRanges, ShareData)])
-> [ShareData]
-> (Int, [(Maybe ByteRanges, ShareData)])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, [(Maybe ByteRanges, ShareData)])
-> ShareData -> (Int, [(Maybe ByteRanges, ShareData)])
step (Int
0, [])
        ([ShareData] -> (Int, [(Maybe ByteRanges, ShareData)]))
-> ([SomeShareData] -> [ShareData])
-> [SomeShareData]
-> (Int, [(Maybe ByteRanges, ShareData)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeShareData -> ShareData) -> [SomeShareData] -> [ShareData]
forall a b. (a -> b) -> [a] -> [b]
map SomeShareData -> ShareData
getShareData
  where
    step :: (Int, [(Maybe ByteRanges, ShareData)])
-> ShareData -> (Int, [(Maybe ByteRanges, ShareData)])
step (Int
size, [(Maybe ByteRanges, ShareData)]
accum) ShareData
bs = (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ShareData -> Int
B.length ShareData
bs, (ByteRanges -> Maybe ByteRanges
forall a. a -> Maybe a
Just [Integer -> Integer -> ByteRange
ByteRangeFromTo (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ShareData -> Int
B.length ShareData
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)], ShareData
bs) (Maybe ByteRanges, ShareData)
-> [(Maybe ByteRanges, ShareData)]
-> [(Maybe ByteRanges, ShareData)]
forall a. a -> [a] -> [a]
: [(Maybe ByteRanges, ShareData)]
accum)

-- Immutable share data written to the shares of a given storage index can be
-- retrieved verbatim and associated with the same share numbers as were
-- specified during writing.
immutableWriteAndReadShare ::
    Backend b =>
    ((b -> IO ()) -> IO ()) -> -- Execute a function on the backend.
    StorageIndex ->
    ShareNumbers ->
    NonEmptyList SomeShareData ->
    Property
immutableWriteAndReadShare :: ((b -> Expectation) -> Expectation)
-> String -> ShareNumbers -> NonEmptyList SomeShareData -> Property
immutableWriteAndReadShare (b -> Expectation) -> Expectation
runBackend String
storageIndex (ShareNumbers [ShareNumber]
shareNumbers) (NonEmpty [SomeShareData]
shareSeed) = do
    let permutedShares :: [[SomeShareData]]
permutedShares = (ShareNumber -> SomeShareData -> SomeShareData)
-> [ShareNumber] -> [SomeShareData] -> [[SomeShareData]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [[c]]
outerProduct ShareNumber -> SomeShareData -> SomeShareData
permuteShare [ShareNumber]
shareNumbers [SomeShareData]
shareSeed
        size :: Integer
size = [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer)
-> (SomeShareData -> Int) -> SomeShareData -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShareData -> Int
B.length (ShareData -> Int)
-> (SomeShareData -> ShareData) -> SomeShareData -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeShareData -> ShareData
getShareData (SomeShareData -> Integer) -> [SomeShareData] -> [Integer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SomeShareData]
shareSeed)
        allocate :: AllocateBuckets
allocate = [ShareNumber] -> Integer -> AllocateBuckets
AllocateBuckets [ShareNumber]
shareNumbers Integer
size
    String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
label (String
"Share size: <" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show (Integer
size Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
1024 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" KiB") (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
        Gen [[(Maybe ByteRanges, SomeShareData)]]
-> ([[(Maybe ByteRanges, SomeShareData)]] -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (([SomeShareData] -> Gen [(Maybe ByteRanges, SomeShareData)])
-> [[SomeShareData]] -> Gen [[(Maybe ByteRanges, SomeShareData)]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse [SomeShareData] -> Gen [(Maybe ByteRanges, SomeShareData)]
jumbleForUpload [[SomeShareData]]
permutedShares) (([[(Maybe ByteRanges, SomeShareData)]] -> Property) -> Property)
-> ([[(Maybe ByteRanges, SomeShareData)]] -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \[[(Maybe ByteRanges, SomeShareData)]]
shareChunks -> PropertyM IO () -> Property
forall a. Testable a => PropertyM IO a -> Property
monadicIO (PropertyM IO () -> Property) -> PropertyM IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
            Expectation -> PropertyM IO ()
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
run (Expectation -> PropertyM IO ()) -> Expectation -> PropertyM IO ()
forall a b. (a -> b) -> a -> b
$
                (b -> Expectation) -> Expectation
runBackend ((b -> Expectation) -> Expectation)
-> (b -> Expectation) -> Expectation
forall a b. (a -> b) -> a -> b
$ \b
backend -> do
                    b
-> String
-> Maybe [LeaseSecret]
-> AllocateBuckets
-> IO AllocationResult
forall b.
Backend b =>
b
-> String
-> Maybe [LeaseSecret]
-> AllocateBuckets
-> IO AllocationResult
createImmutableStorageIndex b
backend String
storageIndex Maybe [LeaseSecret]
uploadSecret AllocateBuckets
allocate
                        IO AllocationResult -> AllocationResult -> Expectation
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation
`shouldReturn` AllocationResult :: [ShareNumber] -> [ShareNumber] -> AllocationResult
AllocationResult{alreadyHave :: [ShareNumber]
alreadyHave = [], allocated :: [ShareNumber]
allocated = [ShareNumber]
shareNumbers}
                    let writes :: [(ShareNumber, [(Maybe ByteRanges, ShareData)])]
writes = [ShareNumber]
-> [[(Maybe ByteRanges, ShareData)]]
-> [(ShareNumber, [(Maybe ByteRanges, ShareData)])]
forall a b. [a] -> [b] -> [(a, b)]
zip [ShareNumber]
shareNumbers (((Maybe ByteRanges, SomeShareData)
 -> (Maybe ByteRanges, ShareData))
-> [(Maybe ByteRanges, SomeShareData)]
-> [(Maybe ByteRanges, ShareData)]
forall a b. (a -> b) -> [a] -> [b]
map ((SomeShareData -> ShareData)
-> (Maybe ByteRanges, SomeShareData)
-> (Maybe ByteRanges, ShareData)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second SomeShareData -> ShareData
getShareData) ([(Maybe ByteRanges, SomeShareData)]
 -> [(Maybe ByteRanges, ShareData)])
-> [[(Maybe ByteRanges, SomeShareData)]]
-> [[(Maybe ByteRanges, ShareData)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[(Maybe ByteRanges, SomeShareData)]]
shareChunks)
                    (ShareNumber -> ShareData -> Maybe ByteRanges -> Expectation)
-> [(ShareNumber, [(Maybe ByteRanges, ShareData)])] -> Expectation
forall shareData dataRange.
(ShareNumber -> shareData -> dataRange -> Expectation)
-> [(ShareNumber, [(dataRange, shareData)])] -> Expectation
writeShares (\ShareNumber
sn -> b
-> String
-> ShareNumber
-> Maybe [LeaseSecret]
-> ShareData
-> Maybe ByteRanges
-> Expectation
forall b.
Backend b =>
b
-> String
-> ShareNumber
-> Maybe [LeaseSecret]
-> ShareData
-> Maybe ByteRanges
-> Expectation
writeImmutableShare b
backend String
storageIndex ShareNumber
sn Maybe [LeaseSecret]
uploadSecret) [(ShareNumber, [(Maybe ByteRanges, ShareData)])]
writes
                    [ShareData]
readShares' <- (ShareNumber -> IO ShareData) -> [ShareNumber] -> IO [ShareData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\ShareNumber
sn -> b -> String -> ShareNumber -> Maybe ByteRanges -> IO ShareData
forall b.
Backend b =>
b -> String -> ShareNumber -> Maybe ByteRanges -> IO ShareData
readImmutableShare b
backend String
storageIndex ShareNumber
sn Maybe ByteRanges
forall a. Maybe a
Nothing) [ShareNumber]
shareNumbers
                    Bool -> Expectation -> Expectation
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (([ShareData] -> ShareData) -> [[ShareData]] -> [ShareData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ShareData] -> ShareData
B.concat ((SomeShareData -> ShareData) -> [SomeShareData] -> [ShareData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SomeShareData -> ShareData
getShareData ([SomeShareData] -> [ShareData])
-> [[SomeShareData]] -> [[ShareData]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[SomeShareData]]
permutedShares) [ShareData] -> [ShareData] -> Bool
forall a. Eq a => a -> a -> Bool
/= [ShareData]
readShares') (Expectation -> Expectation) -> Expectation -> Expectation
forall a b. (a -> b) -> a -> b
$
                        String -> Expectation
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ([[SomeShareData]] -> String
forall a. Show a => a -> String
show [[SomeShareData]]
permutedShares String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" /= " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [ShareData] -> String
forall a. Show a => a -> String
show [ShareData]
readShares')
  where
    uploadSecret :: Maybe [LeaseSecret]
uploadSecret = [LeaseSecret] -> Maybe [LeaseSecret]
forall a. a -> Maybe a
Just [LeaseSecret
anUploadSecret]

-- Immutable share data written to the shares of a given storage index cannot
-- be rewritten by a subsequent writeImmutableShare operation.
immutableWriteAndRewriteShare ::
    Backend b =>
    ((b -> IO ()) -> IO ()) -> -- Execute a function on the backend.
    StorageIndex ->
    ShareNumbers ->
    SomeShareData ->
    Property
immutableWriteAndRewriteShare :: ((b -> Expectation) -> Expectation)
-> String -> ShareNumbers -> SomeShareData -> Property
immutableWriteAndRewriteShare (b -> Expectation) -> Expectation
runBackend String
storageIndex (ShareNumbers [ShareNumber]
shareNumbers) SomeShareData
shareSeed = PropertyM IO () -> Property
forall a. Testable a => PropertyM IO a -> Property
monadicIO (PropertyM IO () -> Property) -> PropertyM IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
    let size :: Integer
size = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ShareData -> Int
B.length (SomeShareData -> ShareData
getShareData SomeShareData
shareSeed))
        allocate :: AllocateBuckets
allocate = [ShareNumber] -> Integer -> AllocateBuckets
AllocateBuckets [ShareNumber]
shareNumbers Integer
size
        aShareNumber :: ShareNumber
aShareNumber = [ShareNumber] -> ShareNumber
forall a. [a] -> a
head [ShareNumber]
shareNumbers
        aShare :: SomeShareData
aShare = ShareNumber -> SomeShareData -> SomeShareData
permuteShare ShareNumber
aShareNumber SomeShareData
shareSeed
    Expectation -> PropertyM IO ()
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
run (Expectation -> PropertyM IO ()) -> Expectation -> PropertyM IO ()
forall a b. (a -> b) -> a -> b
$
        (b -> Expectation) -> Expectation
runBackend ((b -> Expectation) -> Expectation)
-> (b -> Expectation) -> Expectation
forall a b. (a -> b) -> a -> b
$ \b
backend -> do
            IO AllocationResult -> Expectation
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO AllocationResult -> Expectation)
-> IO AllocationResult -> Expectation
forall a b. (a -> b) -> a -> b
$ b
-> String
-> Maybe [LeaseSecret]
-> AllocateBuckets
-> IO AllocationResult
forall b.
Backend b =>
b
-> String
-> Maybe [LeaseSecret]
-> AllocateBuckets
-> IO AllocationResult
createImmutableStorageIndex b
backend String
storageIndex Maybe [LeaseSecret]
uploadSecret AllocateBuckets
allocate
            let write :: Expectation
write = b
-> String
-> ShareNumber
-> Maybe [LeaseSecret]
-> ShareData
-> Maybe ByteRanges
-> Expectation
forall b.
Backend b =>
b
-> String
-> ShareNumber
-> Maybe [LeaseSecret]
-> ShareData
-> Maybe ByteRanges
-> Expectation
writeImmutableShare b
backend String
storageIndex ShareNumber
aShareNumber Maybe [LeaseSecret]
uploadSecret (SomeShareData -> ShareData
getShareData SomeShareData
aShare) Maybe ByteRanges
forall a. Maybe a
Nothing
            Expectation
write
            Expectation
write Expectation -> Selector WriteImmutableError -> Expectation
forall e a.
(HasCallStack, Exception e) =>
IO a -> Selector e -> Expectation
`shouldThrow` (WriteImmutableError -> Selector WriteImmutableError
forall a. Eq a => a -> a -> Bool
== WriteImmutableError
ImmutableShareAlreadyWritten)
  where
    uploadSecret :: Maybe [LeaseSecret]
uploadSecret = [LeaseSecret] -> Maybe [LeaseSecret]
forall a. a -> Maybe a
Just [LeaseSecret
anUploadSecret]

-- The share numbers of mutable share data written to the shares of a given
-- storage index can be retrieved.
mutableWriteAndEnumerateShares ::
    Backend b =>
    ((b -> IO ()) -> IO ()) -> -- Execute a function on the backend.
    StorageIndex ->
    ShareNumbers ->
    SmallShareData ->
    Property
mutableWriteAndEnumerateShares :: ((b -> Expectation) -> Expectation)
-> String -> ShareNumbers -> SmallShareData -> Property
mutableWriteAndEnumerateShares (b -> Expectation) -> Expectation
runBackend String
storageIndex (ShareNumbers [ShareNumber]
shareNumbers) (SmallShareData ShareData
shareSeed) = PropertyM IO () -> Property
forall a. Testable a => PropertyM IO a -> Property
monadicIO (PropertyM IO () -> Property) -> PropertyM IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
    let permutedShares :: [SomeShareData]
permutedShares = (ShareNumber -> SomeShareData -> SomeShareData)
-> SomeShareData -> ShareNumber -> SomeShareData
forall a b c. (a -> b -> c) -> b -> a -> c
flip ShareNumber -> SomeShareData -> SomeShareData
permuteShare (ShareData -> SomeShareData
SomeShareData ShareData
shareSeed) (ShareNumber -> SomeShareData) -> [ShareNumber] -> [SomeShareData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ShareNumber]
shareNumbers
    let nullSecret :: WriteEnablerSecret
nullSecret = ShareData -> WriteEnablerSecret
WriteEnablerSecret ShareData
""
    Expectation -> PropertyM IO ()
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
run (Expectation -> PropertyM IO ()) -> Expectation -> PropertyM IO ()
forall a b. (a -> b) -> a -> b
$
        (b -> Expectation) -> Expectation
runBackend ((b -> Expectation) -> Expectation)
-> (b -> Expectation) -> Expectation
forall a b. (a -> b) -> a -> b
$ \b
backend -> do
            b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> IO ReadTestWriteResult
forall b.
Backend b =>
b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> IO ReadTestWriteResult
readvAndTestvAndWritev b
backend String
storageIndex WriteEnablerSecret
nullSecret ([ReadTestWriteVectors] -> ReadTestWriteVectors
forall a. Monoid a => [a] -> a
mconcat ([ReadTestWriteVectors] -> ReadTestWriteVectors)
-> [ReadTestWriteVectors] -> ReadTestWriteVectors
forall a b. (a -> b) -> a -> b
$ (ShareNumber -> Integer -> ShareData -> ReadTestWriteVectors)
-> [ShareNumber]
-> [Integer]
-> [ShareData]
-> [ReadTestWriteVectors]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 ShareNumber -> Integer -> ShareData -> ReadTestWriteVectors
writev [ShareNumber]
shareNumbers [Integer
0 ..] (SomeShareData -> ShareData
getShareData (SomeShareData -> ShareData) -> [SomeShareData] -> [ShareData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SomeShareData]
permutedShares))
                IO ReadTestWriteResult -> ReadTestWriteResult -> Expectation
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation
`shouldReturn` ReadTestWriteResult :: Bool -> ReadResult -> ReadTestWriteResult
ReadTestWriteResult{success :: Bool
success = Bool
True, readData :: ReadResult
readData = ReadResult
forall a. Monoid a => a
mempty}
            (CBORSet Set ShareNumber
readShareNumbers) <- b -> String -> IO (CBORSet ShareNumber)
forall b. Backend b => b -> String -> IO (CBORSet ShareNumber)
getMutableShareNumbers b
backend String
storageIndex
            Bool -> Expectation -> Expectation
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Set ShareNumber
readShareNumbers Set ShareNumber -> Set ShareNumber -> Bool
forall a. Eq a => a -> a -> Bool
/= [ShareNumber] -> Set ShareNumber
forall a. Ord a => [a] -> Set a
Set.fromList [ShareNumber]
shareNumbers) (Expectation -> Expectation) -> Expectation -> Expectation
forall a b. (a -> b) -> a -> b
$
                String -> Expectation
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Set ShareNumber -> String
forall a. Show a => a -> String
show Set ShareNumber
readShareNumbers String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" /= " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [ShareNumber] -> String
forall a. Show a => a -> String
show [ShareNumber]
shareNumbers)

{- | After an arbitrary number of separate writes complete to construct the
 entire share, any range of the share's bytes can be read.
-}
mutableWriteAndReadShare ::
    Backend b =>
    ((b -> IO ()) -> IO ()) -> -- Execute a function on the backend.
    StorageIndex ->
    B.ByteString ->
    MutableWriteExample ->
    Property
mutableWriteAndReadShare :: ((b -> Expectation) -> Expectation)
-> String -> ShareData -> MutableWriteExample -> Property
mutableWriteAndReadShare (b -> Expectation) -> Expectation
runBackend String
storageIndex ShareData
secret MutableWriteExample{[ShareData]
Maybe ByteRanges
ShareNumber
mweReadRange :: MutableWriteExample -> Maybe ByteRanges
mweShareData :: MutableWriteExample -> [ShareData]
mweShareNumber :: MutableWriteExample -> ShareNumber
mweReadRange :: Maybe ByteRanges
mweShareData :: [ShareData]
mweShareNumber :: ShareNumber
..} = PropertyM IO () -> Property
forall a. Testable a => PropertyM IO a -> Property
monadicIO (PropertyM IO () -> Property)
-> ((b -> Expectation) -> PropertyM IO ())
-> (b -> Expectation)
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expectation -> PropertyM IO ()
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
run (Expectation -> PropertyM IO ())
-> ((b -> Expectation) -> Expectation)
-> (b -> Expectation)
-> PropertyM IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Expectation) -> Expectation
runBackend ((b -> Expectation) -> Property) -> (b -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \b
backend -> do
    (ReadTestWriteVectors -> Expectation)
-> [ReadTestWriteVectors] -> Expectation
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> Expectation
forall b.
Backend b =>
b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> Expectation
runReadTestWrite_ b
backend String
storageIndex (ShareData -> WriteEnablerSecret
WriteEnablerSecret ShareData
secret)) ((Integer -> ShareData -> ReadTestWriteVectors)
-> [Integer] -> [ShareData] -> [ReadTestWriteVectors]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (ShareNumber -> Integer -> ShareData -> ReadTestWriteVectors
writev ShareNumber
mweShareNumber) ([ShareData] -> [Integer]
forall b. Num b => [ShareData] -> [b]
offsetsFor [ShareData]
mweShareData) [ShareData]
mweShareData)
    b -> String -> ShareNumber -> Maybe ByteRanges -> IO ShareData
forall b.
Backend b =>
b -> String -> ShareNumber -> Maybe ByteRanges -> IO ShareData
readMutableShare b
backend String
storageIndex ShareNumber
mweShareNumber Maybe ByteRanges
mweReadRange IO ShareData -> ShareData -> Expectation
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation
`shouldReturn` ShareData
shareRange
  where
    offsetsFor :: [ShareData] -> [b]
offsetsFor [ShareData]
ranges = (b -> b -> b) -> b -> [b] -> [b]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl b -> b -> b
forall a. Num a => a -> a -> a
(+) b
0 ([b] -> [b]) -> [b] -> [b]
forall a b. (a -> b) -> a -> b
$ (ShareData -> b) -> [ShareData] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> b) -> (ShareData -> Int) -> ShareData -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShareData -> Int
B.length) [ShareData]
ranges

    shareRange :: ShareData
    shareRange :: ShareData
shareRange = case Maybe ByteRanges
mweReadRange of
        Maybe ByteRanges
Nothing -> [ShareData] -> ShareData
B.concat [ShareData]
mweShareData
        Just ByteRanges
ranges -> [ShareData] -> ShareData
B.concat ([ShareData] -> ShareData) -> [ShareData] -> ShareData
forall a b. (a -> b) -> a -> b
$ ShareData -> ByteRange -> ShareData
readRange ([ShareData] -> ShareData
B.concat [ShareData]
mweShareData) (ByteRange -> ShareData) -> ByteRanges -> [ShareData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteRanges
ranges

    readRange :: ShareData -> ByteRange -> ShareData
readRange ShareData
shareData (ByteRangeFrom Integer
start) = Int -> ShareData -> ShareData
B.drop (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
start) ShareData
shareData
    readRange ShareData
shareData (ByteRangeFromTo Integer
start Integer
end) = Int -> ShareData -> ShareData
B.take (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ (Integer
end Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
start) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) (ShareData -> ShareData)
-> (ShareData -> ShareData) -> ShareData -> ShareData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShareData -> ShareData
B.drop (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
start) (ShareData -> ShareData) -> ShareData -> ShareData
forall a b. (a -> b) -> a -> b
$ ShareData
shareData
    readRange ShareData
shareData (ByteRangeSuffix Integer
len) = Int -> ShareData -> ShareData
B.drop (ShareData -> Int
B.length ShareData
shareData Int -> Int -> Int
forall a. Num a => a -> a -> a
- Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
len) ShareData
shareData

withBackend :: Backend b => IO b -> (b -> IO ()) -> (b -> IO ()) -> IO ()
withBackend :: IO b -> (b -> Expectation) -> (b -> Expectation) -> Expectation
withBackend IO b
b b -> Expectation
cleanup b -> Expectation
action = do
    b
backend <- IO b
b
    b -> Expectation
action b
backend Expectation -> Expectation -> Expectation
forall a b. IO a -> IO b -> IO a
`finally` b -> Expectation
cleanup b
backend

anUploadSecret :: LeaseSecret
anUploadSecret :: LeaseSecret
anUploadSecret = UploadSecret -> LeaseSecret
Upload (UploadSecret -> LeaseSecret) -> UploadSecret -> LeaseSecret
forall a b. (a -> b) -> a -> b
$ ShareData -> UploadSecret
UploadSecret ShareData
"anuploadsecret"

permuteShare :: ShareNumber -> SomeShareData -> SomeShareData
permuteShare :: ShareNumber -> SomeShareData -> SomeShareData
permuteShare (ShareNumber Integer
number) (SomeShareData ShareData
xs) = ShareData -> SomeShareData
SomeShareData ((Word8 -> Word8) -> ShareData -> ShareData
B.map Word8 -> Word8
xor' ShareData
xs)
  where
    xor' :: Word8 -> Word8
    xor' :: Word8 -> Word8
xor' = Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
xor (Word8 -> Word8 -> Word8) -> Word8 -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ Integer -> Word8
forall a. Num a => Integer -> a
fromInteger Integer
number

writeShares ::
    (ShareNumber -> shareData -> dataRange -> IO ()) ->
    [(ShareNumber, [(dataRange, shareData)])] ->
    IO ()
writeShares :: (ShareNumber -> shareData -> dataRange -> Expectation)
-> [(ShareNumber, [(dataRange, shareData)])] -> Expectation
writeShares ShareNumber -> shareData -> dataRange -> Expectation
_write [] = () -> Expectation
forall (m :: * -> *) a. Monad m => a -> m a
return ()
writeShares ShareNumber -> shareData -> dataRange -> Expectation
write ((ShareNumber
shareNumber, [(dataRange, shareData)]
shareDatav) : [(ShareNumber, [(dataRange, shareData)])]
rest) = do
    ((dataRange, shareData) -> Expectation)
-> [(dataRange, shareData)] -> Expectation
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(dataRange
range, shareData
bs) -> ShareNumber -> shareData -> dataRange -> Expectation
write ShareNumber
shareNumber shareData
bs dataRange
range) [(dataRange, shareData)]
shareDatav
    (ShareNumber -> shareData -> dataRange -> Expectation)
-> [(ShareNumber, [(dataRange, shareData)])] -> Expectation
forall shareData dataRange.
(ShareNumber -> shareData -> dataRange -> Expectation)
-> [(ShareNumber, [(dataRange, shareData)])] -> Expectation
writeShares ShareNumber -> shareData -> dataRange -> Expectation
write [(ShareNumber, [(dataRange, shareData)])]
rest

readVectorToIntervalSet :: [ReadVector] -> IS.IntervalSet Integer
readVectorToIntervalSet :: [ReadVector] -> IntervalSet Integer
readVectorToIntervalSet [ReadVector]
rvs = (Interval Integer -> IntervalSet Integer -> IntervalSet Integer)
-> IntervalSet Integer -> [Interval Integer] -> IntervalSet Integer
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Interval Integer -> IntervalSet Integer -> IntervalSet Integer
forall r. Ord r => Interval r -> IntervalSet r -> IntervalSet r
IS.insert IntervalSet Integer
forall r. Ord r => IntervalSet r
IS.empty (ReadVector -> Interval Integer
f (ReadVector -> Interval Integer)
-> [ReadVector] -> [Interval Integer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ReadVector]
rvs)
  where
    f :: ReadVector -> Interval Integer
f (ReadVector Integer
offset Integer
size) = (Extended Integer, Boundary)
-> (Extended Integer, Boundary) -> Interval Integer
forall r.
Ord r =>
(Extended r, Boundary) -> (Extended r, Boundary) -> Interval r
interval (Integer -> Extended Integer
forall r. r -> Extended r
Finite Integer
offset, Boundary
Closed) (Integer -> Extended Integer
forall r. r -> Extended r
Finite (Integer -> Extended Integer) -> Integer -> Extended Integer
forall a b. (a -> b) -> a -> b
$ Integer
offset Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
size, Boundary
Open)

toFiniteBounds :: Show r => Interval r -> (r, r)
toFiniteBounds :: Interval r -> (r, r)
toFiniteBounds Interval r
i = (r
lower, r
upper)
  where
    lower :: r
lower = Extended r -> r
forall p. Show p => Extended p -> p
toFinite (Interval r -> Extended r
forall r. Interval r -> Extended r
lowerBound Interval r
i)
    upper :: r
upper = Extended r -> r
forall p. Show p => Extended p -> p
toFinite (Interval r -> Extended r
forall r. Interval r -> Extended r
upperBound Interval r
i)

    toFinite :: Extended p -> p
toFinite Extended p
n = case Extended p
n of
        Finite p
r -> p
r
        Extended p
e -> String -> p
forall a. HasCallStack => String -> a
error (String
"Non-finite bound " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Extended p -> String
forall a. Show a => a -> String
show Extended p
e)

writesThatResultIn :: ShareData -> Offset -> Size -> Gen [WriteVector]
writesThatResultIn :: ShareData -> Integer -> Integer -> Gen [WriteVector]
writesThatResultIn ShareData
"" Integer
_ Integer
_ = [WriteVector] -> Gen [WriteVector]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
writesThatResultIn ShareData
bs Integer
offset Integer
size =
    [Gen [WriteVector]] -> Gen [WriteVector]
forall a. [Gen a] -> Gen a
oneof
        [ -- The whole thing as one write
          [WriteVector] -> Gen [WriteVector]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Integer -> ShareData -> WriteVector
WriteVector Integer
offset ShareData
bs]
        , -- Or divide and conquer arbitrarily
          do
            Integer
prefixLen <- (Integer, Integer) -> Gen Integer
chooseInteger (Integer
0, Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ ShareData -> Int
B.length ShareData
bs)
            [WriteVector]
pfx <- ShareData -> Integer -> Integer -> Gen [WriteVector]
writesThatResultIn (Int -> ShareData -> ShareData
B.take (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
prefixLen) ShareData
bs) Integer
offset Integer
prefixLen
            [WriteVector]
sfx <- ShareData -> Integer -> Integer -> Gen [WriteVector]
writesThatResultIn (Int -> ShareData -> ShareData
B.drop (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
prefixLen) ShareData
bs) (Integer
offset Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
prefixLen) (Integer
size Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
prefixLen)
            [WriteVector] -> Gen [WriteVector]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([WriteVector] -> Gen [WriteVector])
-> [WriteVector] -> Gen [WriteVector]
forall a b. (a -> b) -> a -> b
$ [WriteVector]
pfx [WriteVector] -> [WriteVector] -> [WriteVector]
forall a. Semigroup a => a -> a -> a
<> [WriteVector]
sfx
        , -- Or write some other random somewhere in this range first, to
          -- later be overwritten.
          (:) (WriteVector -> [WriteVector] -> [WriteVector])
-> Gen WriteVector -> Gen ([WriteVector] -> [WriteVector])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer -> ShareData -> WriteVector
WriteVector (Integer -> ShareData -> WriteVector)
-> Gen Integer -> Gen (ShareData -> WriteVector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> Gen Integer
chooseInteger (Integer
offset, Integer
offset Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
size) Gen (ShareData -> WriteVector) -> Gen ShareData -> Gen WriteVector
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Integer, Integer) -> Gen Integer
chooseInteger (Integer
1, Integer
size) Gen Integer -> (Integer -> Gen ShareData) -> Gen ShareData
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Integer -> Gen ShareData
bytes)) Gen ([WriteVector] -> [WriteVector])
-> Gen [WriteVector] -> Gen [WriteVector]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ShareData -> Integer -> Integer -> Gen [WriteVector]
writesThatResultIn ShareData
bs Integer
offset Integer
size
        ]

bytes :: Integer -> Gen B.ByteString
bytes :: Integer -> Gen ShareData
bytes Integer
len = [Word8] -> ShareData
B.pack ([Word8] -> ShareData) -> Gen [Word8] -> Gen ShareData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [Word8]
forall a. Arbitrary a => Int -> Gen [a]
vector (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
len)

extractRead :: Integral a => a -> ShareData -> ReadVector -> ShareData
extractRead :: a -> ShareData -> ReadVector -> ShareData
extractRead a
lower ShareData
bs (ReadVector Integer
offset Integer
size) = Int -> ShareData -> ShareData
B.take (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
size) (ShareData -> ShareData)
-> (ShareData -> ShareData) -> ShareData -> ShareData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShareData -> ShareData
B.drop (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
lower) (ShareData -> ShareData) -> ShareData -> ShareData
forall a b. (a -> b) -> a -> b
$ ShareData
bs

{- | Define the maximum number of times some "simple" properties will be
 checked.  These are properties where the expectation is that the cardinality
 of the set of paths through the implementation is very small so the cost of
 checking hundreds of different inputs is not worth the benefit.
-}
few :: Int
few :: Int
few = Int
5

data MutableWriteExample = MutableWriteExample
    { MutableWriteExample -> ShareNumber
mweShareNumber :: ShareNumber
    , MutableWriteExample -> [ShareData]
mweShareData :: [ShareData]
    , MutableWriteExample -> Maybe ByteRanges
mweReadRange :: Maybe ByteRanges
    }
    deriving (Int -> MutableWriteExample -> ShowS
[MutableWriteExample] -> ShowS
MutableWriteExample -> String
(Int -> MutableWriteExample -> ShowS)
-> (MutableWriteExample -> String)
-> ([MutableWriteExample] -> ShowS)
-> Show MutableWriteExample
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MutableWriteExample] -> ShowS
$cshowList :: [MutableWriteExample] -> ShowS
show :: MutableWriteExample -> String
$cshow :: MutableWriteExample -> String
showsPrec :: Int -> MutableWriteExample -> ShowS
$cshowsPrec :: Int -> MutableWriteExample -> ShowS
Show)

instance Arbitrary MutableWriteExample where
    arbitrary :: Gen MutableWriteExample
arbitrary = do
        ShareNumber
mweShareNumber <- Gen ShareNumber
forall a. Arbitrary a => Gen a
arbitrary
        [ShareData]
mweShareData <- Gen ShareData -> Gen [ShareData]
forall a. Gen a -> Gen [a]
listOf1 ([Word8] -> ShareData
B.pack ([Word8] -> ShareData) -> Gen [Word8] -> Gen ShareData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word8 -> Gen [Word8]
forall a. Gen a -> Gen [a]
listOf1 Gen Word8
forall a. Arbitrary a => Gen a
arbitrary)
        Maybe ByteRanges
mweReadRange <- Integer -> Gen (Maybe ByteRanges)
byteRanges (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> ([ShareData] -> Int) -> [ShareData] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> ([ShareData] -> [Int]) -> [ShareData] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShareData -> Int) -> [ShareData] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShareData -> Int
B.length ([ShareData] -> Integer) -> [ShareData] -> Integer
forall a b. (a -> b) -> a -> b
$ [ShareData]
mweShareData)
        MutableWriteExample -> Gen MutableWriteExample
forall (f :: * -> *) a. Applicative f => a -> f a
pure MutableWriteExample :: ShareNumber
-> [ShareData] -> Maybe ByteRanges -> MutableWriteExample
MutableWriteExample{[ShareData]
Maybe ByteRanges
ShareNumber
mweReadRange :: Maybe ByteRanges
mweShareData :: [ShareData]
mweShareNumber :: ShareNumber
mweReadRange :: Maybe ByteRanges
mweShareData :: [ShareData]
mweShareNumber :: ShareNumber
..}

-- | ByteRange type lets us use illegal values like -1 but then things go poorly
byteRanges :: Integer -> Gen (Maybe [ByteRange])
byteRanges :: Integer -> Gen (Maybe ByteRanges)
byteRanges Integer
dataSize =
    [Gen (Maybe ByteRanges)] -> Gen (Maybe ByteRanges)
forall a. [Gen a] -> Gen a
oneof
        [ -- A request for all the bytes.
          Maybe ByteRanges -> Gen (Maybe ByteRanges)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteRanges
forall a. Maybe a
Nothing
        , -- A request for bytes starting from and including some zero-indexed
          -- position and running to the end of the data.
          ByteRanges -> Maybe ByteRanges
forall a. a -> Maybe a
Just (ByteRanges -> Maybe ByteRanges)
-> (Integer -> ByteRanges) -> Integer -> Maybe ByteRanges
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteRange -> ByteRanges -> ByteRanges
forall a. a -> [a] -> [a]
: []) (ByteRange -> ByteRanges)
-> (Integer -> ByteRange) -> Integer -> ByteRanges
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ByteRange
ByteRangeFrom (Integer -> Maybe ByteRanges)
-> Gen Integer -> Gen (Maybe ByteRanges)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> Gen Integer
chooseInteger (Integer
0, Integer
dataSize Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
        , -- A request for bytes starting from and including some zero-indexed
          -- position and running to and including another zero-indexed
          -- position.
          ByteRanges -> Maybe ByteRanges
forall a. a -> Maybe a
Just (ByteRanges -> Maybe ByteRanges)
-> (ByteRange -> ByteRanges) -> ByteRange -> Maybe ByteRanges
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteRange -> ByteRanges -> ByteRanges
forall a. a -> [a] -> [a]
: []) (ByteRange -> Maybe ByteRanges)
-> (Integer -> Integer -> ByteRange)
-> Integer
-> Integer
-> Maybe ByteRanges
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: Integer -> Integer -> ByteRange
fromTo (Integer -> Integer -> Maybe ByteRanges)
-> Gen Integer -> Gen (Integer -> Maybe ByteRanges)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> Gen Integer
chooseInteger (Integer
0, Integer
dataSize Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Gen (Integer -> Maybe ByteRanges)
-> Gen Integer -> Gen (Maybe ByteRanges)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Integer, Integer) -> Gen Integer
chooseInteger (Integer
0, Integer
dataSize)
        , -- A request for a certain number of bytes of suffix.
          ByteRanges -> Maybe ByteRanges
forall a. a -> Maybe a
Just (ByteRanges -> Maybe ByteRanges)
-> (Integer -> ByteRanges) -> Integer -> Maybe ByteRanges
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteRange -> ByteRanges -> ByteRanges
forall a. a -> [a] -> [a]
: []) (ByteRange -> ByteRanges)
-> (Integer -> ByteRange) -> Integer -> ByteRanges
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ByteRange
ByteRangeSuffix (Integer -> Maybe ByteRanges)
-> Gen Integer -> Gen (Maybe ByteRanges)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> Gen Integer
chooseInteger (Integer
1, Integer
dataSize Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
        ]
  where
    fromTo :: Integer -> Integer -> ByteRange
fromTo Integer
a Integer
b = Integer -> Integer -> ByteRange
ByteRangeFromTo Integer
a (Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b)

runReadTestWrite :: Backend b => b -> StorageIndex -> WriteEnablerSecret -> ReadTestWriteVectors -> IO ReadResult
runReadTestWrite :: b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> IO ReadResult
runReadTestWrite b
backend String
storageIndex WriteEnablerSecret
secret ReadTestWriteVectors
rtw = do
    ReadTestWriteResult
result <- b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> IO ReadTestWriteResult
forall b.
Backend b =>
b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> IO ReadTestWriteResult
readvAndTestvAndWritev b
backend String
storageIndex WriteEnablerSecret
secret ReadTestWriteVectors
rtw
    if ReadTestWriteResult -> Bool
success ReadTestWriteResult
result then ReadResult -> IO ReadResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReadTestWriteResult -> ReadResult
readData ReadTestWriteResult
result) else WriteRefused -> IO ReadResult
forall e a. Exception e => e -> IO a
throwIO WriteRefused
WriteRefused

runReadTestWrite_ :: Backend b => b -> StorageIndex -> WriteEnablerSecret -> ReadTestWriteVectors -> IO ()
runReadTestWrite_ :: b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> Expectation
runReadTestWrite_ b
backend String
storageIndex WriteEnablerSecret
secret ReadTestWriteVectors
rtw = IO ReadResult -> Expectation
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ReadResult -> Expectation) -> IO ReadResult -> Expectation
forall a b. (a -> b) -> a -> b
$ b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> IO ReadResult
forall b.
Backend b =>
b
-> String
-> WriteEnablerSecret
-> ReadTestWriteVectors
-> IO ReadResult
runReadTestWrite b
backend String
storageIndex WriteEnablerSecret
secret ReadTestWriteVectors
rtw

data WriteRefused = WriteRefused deriving (Int -> WriteRefused -> ShowS
[WriteRefused] -> ShowS
WriteRefused -> String
(Int -> WriteRefused -> ShowS)
-> (WriteRefused -> String)
-> ([WriteRefused] -> ShowS)
-> Show WriteRefused
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WriteRefused] -> ShowS
$cshowList :: [WriteRefused] -> ShowS
show :: WriteRefused -> String
$cshow :: WriteRefused -> String
showsPrec :: Int -> WriteRefused -> ShowS
$cshowsPrec :: Int -> WriteRefused -> ShowS
Show, WriteRefused -> Selector WriteRefused
(WriteRefused -> Selector WriteRefused)
-> (WriteRefused -> Selector WriteRefused) -> Eq WriteRefused
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WriteRefused -> Selector WriteRefused
$c/= :: WriteRefused -> Selector WriteRefused
== :: WriteRefused -> Selector WriteRefused
$c== :: WriteRefused -> Selector WriteRefused
Eq)
instance Exception WriteRefused