diff --git a/src/TahoeLAFS/Storage/API.hs b/src/TahoeLAFS/Storage/API.hs
index 689ce64df9cc14c66185b974618e94a502d59f6e..ad2a9b13209c1452bc46cfe5dee69424ed510b37 100644
--- a/src/TahoeLAFS/Storage/API.hs
+++ b/src/TahoeLAFS/Storage/API.hs
@@ -33,12 +33,12 @@ module TahoeLAFS.Storage.API (
QueryRange,
TestVector (TestVector),
ReadResult,
- CorruptionDetails (CorruptionDetails),
- SlotSecrets (..),
+ CorruptionDetails (..),
TestOperator (..),
StorageAPI,
LeaseSecret (..),
- UploadSecret,
+ UploadSecret (..),
+ WriteEnablerSecret (..),
isUploadSecret,
api,
renewSecretLength,
@@ -408,10 +408,12 @@ instance ToHttpApiData ByteRanges where
toUrlPiece _ = error "Cannot serialize ByteRanges to URL piece"
toQueryParam _ = error "Cannot serialize ByteRanges to query params"
-type UploadSecret = B.ByteString
+newtype UploadSecret = UploadSecret B.ByteString
+newtype WriteEnablerSecret = WriteEnablerSecret B.ByteString
-data LeaseSecret = Renew B.ByteString | Cancel B.ByteString | Upload UploadSecret | Write B.ByteString
+data LeaseSecret = Renew B.ByteString | Cancel B.ByteString | Upload UploadSecret | Write WriteEnablerSecret
+isUploadSecret :: LeaseSecret -> Bool
isUploadSecret (Upload _) = True
isUploadSecret _ = False
@@ -422,8 +424,8 @@ instance FromHttpApiData LeaseSecret where
case key of
"lease-renew-secret" -> bimap T.pack Renew $ Base64.decode val
"lease-cancel-secret" -> bimap T.pack Cancel $ Base64.decode val
- "upload-secret" -> bimap T.pack Upload $ Base64.decode val
- "write-enabler" -> bimap T.pack Write $ Base64.decode val
+ "upload-secret" -> bimap T.pack (Upload . UploadSecret) $ Base64.decode val
+ "write-enabler" -> bimap T.pack (Write . WriteEnablerSecret) $ Base64.decode val
_ -> Left $ T.concat ["Cannot interpret secret: ", T.pack . show $ key]
parseUrlPiece _ = Left "Cannot parse LeaseSecret from URL piece"
@@ -440,8 +442,8 @@ instance FromHttpApiData [LeaseSecret] where
instance ToHttpApiData LeaseSecret where
toHeader (Renew bs) = "lease-renew-secret " <> Base64.encode bs
toHeader (Cancel bs) = "lease-cancel-secret " <> Base64.encode bs
- toHeader (Upload bs) = "lease-cancel-secret " <> Base64.encode bs
- toHeader (Write bs) = "write-enabler " <> Base64.encode bs
+ toHeader (Upload (UploadSecret bs)) = "lease-cancel-secret " <> Base64.encode bs
+ toHeader (Write (WriteEnablerSecret bs)) = "write-enabler " <> Base64.encode bs
toUrlPiece _ = error "Cannot serialize LeaseSecret to URL piece"
toQueryParam _ = error "Cannot serialize LeaseSecret to query params"
@@ -494,7 +496,7 @@ type ReadImmutableShareData = "immutable" :> Capture "storage_index" StorageInde
-- POST .../v1/mutable/:storage_index/read-test-write
-- General purpose read-test-and-write operation.
-type ReadTestWrite = "mutable" :> Capture "storage_index" StorageIndex :> "read-test-write" :> ReqBody '[CBOR, JSON] ReadTestWriteVectors :> Post '[CBOR, JSON] ReadTestWriteResult
+type ReadTestWrite = "mutable" :> Capture "storage_index" StorageIndex :> "read-test-write" :> Authz :> ReqBody '[CBOR, JSON] ReadTestWriteVectors :> Post '[CBOR, JSON] ReadTestWriteResult
-- GET /v1/mutable/:storage_index/:share_number
-- Read from a mutable storage index
@@ -621,27 +623,5 @@ data WriteVector = WriteVector
-- XXX This derived instance is surely not compatible with Tahoe-LAFS.
instance Serialise WriteVector
--- XXX These fields moved to an HTTP Header, this type is probably not useful
--- anymore?
-data SlotSecrets = SlotSecrets
- { writeEnabler :: WriteEnablerSecret
- , leaseRenew :: LeaseRenewSecret
- , leaseCancel :: LeaseCancelSecret
- }
- deriving (Show, Eq, Generic)
-
--- XXX This derived instance is surely not compatible with Tahoe-LAFS.
-instance Serialise SlotSecrets
-
-instance ToJSON SlotSecrets where
- toJSON = genericToJSON tahoeJSONOptions
-
-instance FromJSON SlotSecrets where
- parseJSON = genericParseJSON tahoeJSONOptions
-
-type WriteEnablerSecret = String
-type LeaseRenewSecret = String
-type LeaseCancelSecret = String
-
api :: Proxy StorageAPI
api = Proxy
diff --git a/src/TahoeLAFS/Storage/Backend.hs b/src/TahoeLAFS/Storage/Backend.hs
index f1633a42f294936578cfc26372e885fea023c4af..dd99152eafbd481bab4162b8d8f3d891925e1f1f 100644
--- a/src/TahoeLAFS/Storage/Backend.hs
+++ b/src/TahoeLAFS/Storage/Backend.hs
@@ -25,17 +25,17 @@ import TahoeLAFS.Storage.API (
AllocationResult,
CBORSet (..),
CorruptionDetails,
- LeaseSecret (Upload),
+ LeaseSecret (..),
QueryRange,
ReadTestWriteResult (..),
ReadTestWriteVectors (..),
ShareData,
ShareNumber,
- SlotSecrets,
StorageIndex,
TestWriteVectors (..),
- UploadSecret,
+ UploadSecret (..),
Version,
+ WriteEnablerSecret,
WriteVector (..),
isUploadSecret,
)
@@ -65,7 +65,18 @@ class Backend b where
getImmutableShareNumbers :: b -> StorageIndex -> IO (CBORSet ShareNumber)
readImmutableShare :: b -> StorageIndex -> ShareNumber -> QueryRange -> IO ShareData
- readvAndTestvAndWritev :: b -> StorageIndex -> ReadTestWriteVectors -> IO ReadTestWriteResult
+ -- | Read some ranges of all shares held and/or, if test conditions are
+ -- met, overwrite some ranges of some shares.
+ readvAndTestvAndWritev ::
+ b ->
+ -- | The storage index at which to operate.
+ StorageIndex ->
+ -- | A shared secret which the backend can use to authorize the writes.
+ WriteEnablerSecret ->
+ -- | The reads, tests, and writes to perform.
+ ReadTestWriteVectors ->
+ IO ReadTestWriteResult
+
readMutableShare :: b -> StorageIndex -> ShareNumber -> QueryRange -> IO ShareData
getMutableShareNumbers :: b -> StorageIndex -> IO (CBORSet ShareNumber)
adviseCorruptMutableShare :: b -> StorageIndex -> ShareNumber -> CorruptionDetails -> IO ()
@@ -73,13 +84,13 @@ class Backend b where
writeMutableShare ::
Backend b =>
b ->
- SlotSecrets ->
StorageIndex ->
ShareNumber ->
+ WriteEnablerSecret ->
ShareData ->
Maybe ByteRanges ->
IO ()
-writeMutableShare b _secrets storageIndex shareNumber shareData Nothing = do
+writeMutableShare b storageIndex shareNumber writeEnablerSecret shareData Nothing = do
let testWriteVectors =
fromList
[
@@ -101,7 +112,7 @@ writeMutableShare b _secrets storageIndex shareNumber shareData Nothing = do
{ testWriteVectors = testWriteVectors
, readVector = mempty
}
- result <- readvAndTestvAndWritev b storageIndex vectors
+ result <- readvAndTestvAndWritev b storageIndex writeEnablerSecret vectors
if success result
then return ()
else throw WriteRefused
diff --git a/src/TahoeLAFS/Storage/Backend/Filesystem.hs b/src/TahoeLAFS/Storage/Backend/Filesystem.hs
index a004e3dfd97feadbcba2e129b8c6543cd3283263..6b2babfe56dca1f9b076aa40d0fdf99acca72056 100644
--- a/src/TahoeLAFS/Storage/Backend/Filesystem.hs
+++ b/src/TahoeLAFS/Storage/Backend/Filesystem.hs
@@ -61,7 +61,7 @@ import TahoeLAFS.Storage.API (
ShareNumber,
StorageIndex,
TestWriteVectors (write),
- UploadSecret,
+ UploadSecret (..),
Version (..),
Version1Parameters (..),
WriteVector (WriteVector),
@@ -176,8 +176,10 @@ instance Backend FilesystemBackend where
readvAndTestvAndWritev
(FilesystemBackend root)
storageIndex
+ _secrets
(ReadTestWriteVectors testWritev _readv) = do
-- TODO implement readv and testv parts.
+ -- TODO implement secrets
mapM_ (applyWriteVectors root storageIndex) $ toList testWritev
return
ReadTestWriteResult
@@ -252,7 +254,7 @@ allocate ::
ShareNumber ->
UploadSecret ->
IO ()
-allocate (FilesystemBackend root) storageIndex shareNum secret =
+allocate (FilesystemBackend root) storageIndex shareNum (UploadSecret secret) =
let sharePath = incomingPathOf root storageIndex shareNum
shareDirectory = takeDirectory sharePath
createParents = True
@@ -262,12 +264,22 @@ allocate (FilesystemBackend root) storageIndex shareNum secret =
writeFile sharePath ""
return ()
+{- | Given the path of an immutable share, construct a path to use to hold the
+ upload secret for that share.
+-}
+secretPath :: FilePath -> FilePath
secretPath = (<> ".secret")
+{- | Compare the upload secret for an immutable share at a given path to a
+ given upload secret and produce unit if and only if they are equal.
+
+ If they are not, throw IncorrectUploadSecret.
+-}
checkUploadSecret :: FilePath -> UploadSecret -> IO ()
-checkUploadSecret sharePath uploadSecret = do
+checkUploadSecret sharePath (UploadSecret uploadSecret) = do
matches <- constEq uploadSecret <$> readFile (secretPath sharePath)
unless matches (throwIO IncorrectUploadSecret)
+-- | Partition a list based on the result of a monadic predicate.
partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a])
partitionM pred' items = bimap (fst <$>) (fst <$>) . Data.List.partition snd . zip items <$> mapM pred' items
diff --git a/src/TahoeLAFS/Storage/Backend/Memory.hs b/src/TahoeLAFS/Storage/Backend/Memory.hs
index a0b7a1a5a4152a186dcbb61d015faf00b9d94a00..7efbd7da583cf6bde9c4b52711a4529372b5d32c 100644
--- a/src/TahoeLAFS/Storage/Backend/Memory.hs
+++ b/src/TahoeLAFS/Storage/Backend/Memory.hs
@@ -41,11 +41,11 @@ import TahoeLAFS.Storage.API (
Size,
StorageIndex,
TestWriteVectors (..),
- UploadSecret,
+ UploadSecret (UploadSecret),
Version (..),
Version1Parameters (..),
+ WriteEnablerSecret,
WriteVector (..),
- shareNumbers,
)
import TahoeLAFS.Storage.Backend (
Backend (..),
@@ -57,13 +57,12 @@ import Prelude hiding (
map,
)
-data Share = Complete ShareData | Uploading UploadSecret ShareData deriving (Show)
+data Share = Complete ShareData | Uploading UploadSecret ShareData
data Bucket = Bucket
{ bucketSize :: Size
, bucketShares :: Map ShareNumber Share
}
- deriving (Show)
type ShareStorage = Map StorageIndex (Map ShareNumber ShareData)
@@ -124,7 +123,7 @@ abort ::
UploadSecret ->
MemoryBackend ->
(MemoryBackend, ())
-abort storageIndex shareNumber abortSecret b@MemoryBackend{memoryBackendBuckets} = (b{memoryBackendBuckets = updated memoryBackendBuckets}, ())
+abort storageIndex shareNumber (UploadSecret abortSecret) b@MemoryBackend{memoryBackendBuckets} = (b{memoryBackendBuckets = updated memoryBackendBuckets}, ())
where
updated :: Map StorageIndex Bucket -> Map StorageIndex Bucket
updated = Map.adjust abortIt storageIndex
@@ -133,17 +132,17 @@ abort storageIndex shareNumber abortSecret b@MemoryBackend{memoryBackendBuckets}
abortIt bucket@Bucket{bucketShares} = bucket{bucketShares = Map.update abortIt' shareNumber bucketShares}
abortIt' :: Share -> Maybe Share
- abortIt' (Uploading existingSecret _) = if constEq existingSecret abortSecret then Nothing else throw IncorrectUploadSecret
+ abortIt' (Uploading (UploadSecret existingSecret) _) = if constEq existingSecret abortSecret then Nothing else throw IncorrectUploadSecret
abortIt' _ = throw ImmutableShareAlreadyWritten
writeImm ::
StorageIndex ->
ShareNumber ->
- B.ByteString ->
+ UploadSecret ->
B.ByteString ->
MemoryBackend ->
(MemoryBackend, ())
-writeImm storageIndex shareNum uploadSecret newData b@MemoryBackend{memoryBackendBuckets}
+writeImm storageIndex shareNum (UploadSecret uploadSecret) newData b@MemoryBackend{memoryBackendBuckets}
| isNothing share = throw ShareNotAllocated
| otherwise = (b{memoryBackendBuckets = updated}, ())
where
@@ -154,9 +153,9 @@ writeImm storageIndex shareNum uploadSecret newData b@MemoryBackend{memoryBacken
writeToShare :: Share -> Share
writeToShare (Complete _) = throw ImmutableShareAlreadyWritten
- writeToShare (Uploading existingSecret existingData)
+ writeToShare (Uploading (UploadSecret existingSecret) existingData)
| authorized =
- (if Just True == (complete existingData newData <$> size) then Complete else Uploading existingSecret) (existingData <> newData)
+ (if Just True == (complete existingData newData <$> size) then Complete else Uploading (UploadSecret existingSecret)) (existingData <> newData)
| otherwise = throw IncorrectUploadSecret
where
authorized = constEq existingSecret uploadSecret
@@ -188,12 +187,14 @@ instance Backend (IORef MemoryBackend) where
maybe [] keys $
lookup storageIndex shares'
- readvAndTestvAndWritev :: IORef MemoryBackend -> StorageIndex -> ReadTestWriteVectors -> IO ReadTestWriteResult
+ readvAndTestvAndWritev :: IORef MemoryBackend -> StorageIndex -> WriteEnablerSecret -> ReadTestWriteVectors -> IO ReadTestWriteResult
readvAndTestvAndWritev
backend
storageIndex
+ _secrets
(ReadTestWriteVectors testWritev _readv) = do
-- TODO implement readv and testv parts.
+ -- TODO implement secret check
modifyIORef backend $ \m@MemoryBackend{mutableShares} -> m{mutableShares = addShares storageIndex (shares' testWritev) mutableShares}
return
ReadTestWriteResult
diff --git a/src/TahoeLAFS/Storage/Server.hs b/src/TahoeLAFS/Storage/Server.hs
index 3f74cc9e0ee71c8a182b8a006ad5c7f2beaa30ae..8c9134aaa5424b1a5404048737ef422b24387511 100644
--- a/src/TahoeLAFS/Storage/Server.hs
+++ b/src/TahoeLAFS/Storage/Server.hs
@@ -39,7 +39,7 @@ import TahoeLAFS.Storage.API (
AllocationResult (..),
CBORSet (..),
CorruptionDetails,
- LeaseSecret,
+ LeaseSecret (Write),
QueryRange,
ReadTestWriteResult (..),
ReadTestWriteVectors,
@@ -50,6 +50,7 @@ import TahoeLAFS.Storage.API (
Version (..),
api,
)
+import TahoeLAFS.Storage.Backend (WriteImmutableError (MissingUploadSecret))
import qualified TahoeLAFS.Storage.Backend as Backend
import TahoeLAFS.Storage.Backend.Filesystem (
FilesystemBackend (FilesystemBackend),
@@ -87,9 +88,13 @@ readImmutableShare backend storage_index share_number qr =
-- TODO Need to make sure content-range is set in the header otherwise
liftIO (Backend.readImmutableShare backend storage_index share_number qr)
-readvAndTestvAndWritev :: Backend.Backend b => b -> StorageIndex -> ReadTestWriteVectors -> Handler ReadTestWriteResult
-readvAndTestvAndWritev backend storage_index vectors =
- liftIO (Backend.readvAndTestvAndWritev backend storage_index vectors)
+readvAndTestvAndWritev :: Backend.Backend b => b -> StorageIndex -> Maybe [LeaseSecret] -> ReadTestWriteVectors -> Handler ReadTestWriteResult
+readvAndTestvAndWritev _ _ Nothing _ = throw MissingUploadSecret
+readvAndTestvAndWritev _ _ (Just []) _ = throw MissingUploadSecret
+readvAndTestvAndWritev backend storageIndex (Just (Write secret : _)) vectors =
+ liftIO (Backend.readvAndTestvAndWritev backend storageIndex secret vectors)
+readvAndTestvAndWritev backend storageIndex (Just (_ : ss)) vectors =
+ readvAndTestvAndWritev backend storageIndex (Just ss) vectors
readMutableShare :: Backend.Backend b => b -> StorageIndex -> ShareNumber -> QueryRange -> Handler ShareData
readMutableShare backend storage_index share_numbers params =
diff --git a/test/Lib.hs b/test/Lib.hs
index 8b89168bce52d581a89be81211030091b877fc1f..d33432877382756c98ce145fad3b5e70614ed04f 100644
--- a/test/Lib.hs
+++ b/test/Lib.hs
@@ -38,7 +38,6 @@ import Test.QuickCheck.Instances.ByteString ()
import TahoeLAFS.Storage.API (
ShareNumber (..),
StorageIndex,
- shareNumber,
)
gen10String :: Gen String
diff --git a/test/MiscSpec.hs b/test/MiscSpec.hs
index 14df7033a41613fd05d86dce68d1a2146faf8d3c..bd3e170c82d70b83e9e8747484b3baa84d045a13 100644
--- a/test/MiscSpec.hs
+++ b/test/MiscSpec.hs
@@ -22,20 +22,16 @@ import Test.Hspec (
import qualified Data.ByteString as BS
import Test.QuickCheck (
- Arbitrary (arbitrary),
forAll,
property,
- suchThatMap,
)
import TahoeLAFS.Storage.API (
- ShareNumber,
+ ShareNumber (ShareNumber),
shareNumber,
toInteger,
)
--- We also get the Arbitrary ShareNumber instance from here.
--- We also get the Arbitrary ShareNumber instance from here.
import Lib (
b32decode,
b32encode,
@@ -50,9 +46,6 @@ import TahoeLAFS.Storage.Backend.Filesystem (
storageStartSegment,
)
-instance Arbitrary ShareNumber where
- arbitrary = suchThatMap positiveIntegers shareNumber
-
spec :: Spec
spec = do
describe "partitionM" $
@@ -75,8 +68,8 @@ spec = do
forAll
genStorageIndex
( \storageIndex shareNum ->
- pathOfShare "/foo" storageIndex shareNum
- `shouldBe` printf "/foo/shares/%s/%s/%d" (take 2 storageIndex) storageIndex (toInteger shareNum)
+ pathOfShare "/foo" storageIndex (ShareNumber shareNum)
+ `shouldBe` printf "/foo/shares/%s/%s/%d" (take 2 storageIndex) storageIndex shareNum
)
describe "incomingPathOf" $
@@ -85,8 +78,8 @@ spec = do
forAll
genStorageIndex
( \storageIndex shareNum ->
- incomingPathOf "/foo" storageIndex shareNum
- `shouldBe` printf "/foo/shares/incoming/%s/%s/%d" (take 2 storageIndex) storageIndex (toInteger shareNum)
+ incomingPathOf "/foo" storageIndex (ShareNumber shareNum)
+ `shouldBe` printf "/foo/shares/incoming/%s/%s/%d" (take 2 storageIndex) storageIndex shareNum
)
describe "incomingPathOf vs pathOfShare" $
@@ -95,8 +88,8 @@ spec = do
forAll
genStorageIndex
( \storageIndex shareNum ->
- let path = pathOfShare "/foo" storageIndex shareNum
- incoming = incomingPathOf "/foo" storageIndex shareNum
+ let path = pathOfShare "/foo" storageIndex (ShareNumber shareNum)
+ incoming = incomingPathOf "/foo" storageIndex (ShareNumber shareNum)
in path `shouldNotBe` incoming
)
diff --git a/test/SemanticSpec.hs b/test/SemanticSpec.hs
index bdee556510cdfda3e2f5bd93078eac97630e3d19..c2fd18421c0b3282b6fb34b2538a573fec7c63bb 100644
--- a/test/SemanticSpec.hs
+++ b/test/SemanticSpec.hs
@@ -50,7 +50,6 @@ import Test.QuickCheck (
import Test.QuickCheck.Monadic (
monadicIO,
- pre,
run,
)
@@ -68,8 +67,9 @@ import TahoeLAFS.Storage.API (
ShareData,
ShareNumber (ShareNumber),
Size,
- SlotSecrets (..),
StorageIndex,
+ UploadSecret (UploadSecret),
+ WriteEnablerSecret (WriteEnablerSecret),
allocated,
alreadyHave,
toInteger,
@@ -132,7 +132,7 @@ alreadyHavePlusAllocatedImm ::
alreadyHavePlusAllocatedImm makeBackend storageIndex (ShareNumbers shareNumbers) (Positive size) = monadicIO $
run $
withBackend makeBackend $ \backend -> do
- result <- createImmutableStorageIndex backend storageIndex (Just [Upload "hello world"]) $ AllocateBuckets shareNumbers size
+ result <- createImmutableStorageIndex backend storageIndex (Just [anUploadSecret]) $ AllocateBuckets shareNumbers size
when (alreadyHave result ++ allocated result /= shareNumbers) $
fail
( show (alreadyHave result)
@@ -163,7 +163,7 @@ immutableWriteAndEnumerateShares makeBackend storageIndex (ShareNumbers shareNum
when (readShareNumbers /= (CBORSet . Set.fromList $ shareNumbers)) $
fail (show readShareNumbers ++ " /= " ++ show shareNumbers)
where
- uploadSecret = Just [Upload "hello"]
+ uploadSecret = Just [anUploadSecret]
-- Immutable share data written to the shares of a given storage index cannot
-- be rewritten by a subsequent writeImmutableShare operation.
@@ -186,7 +186,7 @@ immutableWriteAndRewriteShare makeBackend storageIndex (ShareNumbers shareNumber
write
write `shouldThrow` (== ImmutableShareAlreadyWritten)
where
- uploadSecret = Just [Upload "hello"]
+ uploadSecret = Just [anUploadSecret]
-- 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
@@ -210,7 +210,7 @@ immutableWriteAndReadShare makeBackend storageIndex (ShareNumbers shareNumbers)
when (permutedShares /= readShares') $
fail (show permutedShares ++ " /= " ++ show readShares')
where
- uploadSecret = Just [Upload "hello"]
+ uploadSecret = Just [anUploadSecret]
-- The share numbers of mutable share data written to the shares of a given
-- storage index can be retrieved.
@@ -223,15 +223,10 @@ mutableWriteAndEnumerateShares ::
Property
mutableWriteAndEnumerateShares makeBackend storageIndex (ShareNumbers shareNumbers) shareSeed = monadicIO $ do
let permutedShares = Prelude.map (permuteShare shareSeed) shareNumbers
- let nullSecrets =
- SlotSecrets
- { writeEnabler = ""
- , leaseRenew = ""
- , leaseCancel = ""
- }
+ let nullSecret = WriteEnablerSecret ""
run $
withBackend makeBackend $ \backend -> do
- writeShares (writeMutableShare backend nullSecrets storageIndex) (zip shareNumbers permutedShares)
+ writeShares (\sn sh -> writeMutableShare backend storageIndex sn nullSecret sh) (zip shareNumbers permutedShares)
(CBORSet readShareNumbers) <- getMutableShareNumbers backend storageIndex
when (readShareNumbers /= Set.fromList shareNumbers) $
fail (show readShareNumbers ++ " /= " ++ show shareNumbers)
@@ -250,17 +245,17 @@ storageSpec makeBackend =
it "disallows writes without an upload secret" $
property $
withBackend makeBackend $ \backend -> do
- AllocationResult [] [ShareNumber 0] <- createImmutableStorageIndex backend "storageindex" (Just [Upload "thesecret"]) (AllocateBuckets [ShareNumber 0] 100)
+ AllocationResult [] [ShareNumber 0] <- createImmutableStorageIndex backend "storageindex" (Just [anUploadSecret]) (AllocateBuckets [ShareNumber 0] 100)
writeImmutableShare backend "storageindex" (ShareNumber 0) Nothing "fooooo" Nothing `shouldThrow` (== MissingUploadSecret)
it "disallows writes without a matching upload secret" $
property $
withBackend makeBackend $ \backend -> do
- AllocationResult [] [ShareNumber 0] <- createImmutableStorageIndex backend "storageindex" (Just [Upload "thesecret"]) (AllocateBuckets [ShareNumber 0] 100)
+ AllocationResult [] [ShareNumber 0] <- createImmutableStorageIndex backend "storageindex" (Just [anUploadSecret]) (AllocateBuckets [ShareNumber 0] 100)
-- Supply the wrong secret as an upload secret and the
-- right secret marked for some other use - this
-- should still fail.
- writeImmutableShare backend "storageindex" (ShareNumber 0) (Just [Upload "wrongsecret"]) "fooooo" Nothing `shouldThrow` (== IncorrectUploadSecret)
+ writeImmutableShare backend "storageindex" (ShareNumber 0) (Just [Upload (UploadSecret "wrongsecret")]) "fooooo" Nothing `shouldThrow` (== IncorrectUploadSecret)
it "disallows aborts without an upload secret" $
property $
@@ -270,14 +265,14 @@ storageSpec makeBackend =
it "disallows aborts without a matching upload secret" $
property $
withBackend makeBackend $ \backend -> do
- AllocationResult [] [ShareNumber 0] <- createImmutableStorageIndex backend "storageindex" (Just [Upload "thesecret"]) (AllocateBuckets [ShareNumber 0] 100)
- abortImmutableUpload backend "storageindex" (ShareNumber 0) (Just [Upload "wrongsecret"]) `shouldThrow` (== IncorrectUploadSecret)
+ AllocationResult [] [ShareNumber 0] <- createImmutableStorageIndex backend "storageindex" (Just [anUploadSecret]) (AllocateBuckets [ShareNumber 0] 100)
+ abortImmutableUpload backend "storageindex" (ShareNumber 0) (Just [Upload (UploadSecret "wrongsecret")]) `shouldThrow` (== IncorrectUploadSecret)
it "allows aborts with a matching upload secret" $
property $
withBackend makeBackend $ \backend -> do
- AllocationResult [] [ShareNumber 0] <- createImmutableStorageIndex backend "storageindex" (Just [Upload "thesecret"]) (AllocateBuckets [ShareNumber 0] 100)
- abortImmutableUpload backend "storageindex" (ShareNumber 0) (Just [Upload "thesecret"])
+ AllocationResult [] [ShareNumber 0] <- createImmutableStorageIndex backend "storageindex" (Just [anUploadSecret]) (AllocateBuckets [ShareNumber 0] 100)
+ abortImmutableUpload backend "storageindex" (ShareNumber 0) (Just [anUploadSecret])
it "returns the share numbers that were written" $
property $
@@ -303,6 +298,9 @@ spec = do
Test.Hspec.context "filesystem" $ storageSpec filesystemBackend
+anUploadSecret :: LeaseSecret
+anUploadSecret = Upload $ UploadSecret "anuploadsecret"
+
filesystemBackend :: IO FilesystemBackend
filesystemBackend = do
FilesystemBackend <$> createTemporaryDirectory