From fe7e4f238cdcdc2773965fbb6dc2f21537f536fc Mon Sep 17 00:00:00 2001
From: Jean-Paul Calderone <exarkun@twistedmatrix.com>
Date: Fri, 26 May 2023 16:55:45 -0400
Subject: [PATCH] write some more of the mutable download property test
---
gbs-downloader.cabal | 1 +
src/Tahoe/Download.hs | 5 +++++
test/Spec.hs | 40 ++++++++++++++++++++++++++++++++++------
3 files changed, 40 insertions(+), 6 deletions(-)
diff --git a/gbs-downloader.cabal b/gbs-downloader.cabal
index e2ae392..c6a8896 100644
--- a/gbs-downloader.cabal
+++ b/gbs-downloader.cabal
@@ -107,6 +107,7 @@ library
, servant-client-core
, tahoe-chk
, tahoe-great-black-swamp >=0.2 && <0.3
+ , tahoe-ssk
, text
, yaml
diff --git a/src/Tahoe/Download.hs b/src/Tahoe/Download.hs
index e957769..a9f31a4 100644
--- a/src/Tahoe/Download.hs
+++ b/src/Tahoe/Download.hs
@@ -8,6 +8,7 @@ module Tahoe.Download (
DiscoverError (..),
discoverShares,
download,
+ downloadMutable,
announcementToStorageServer,
) where
@@ -37,6 +38,7 @@ import Tahoe.CHK.Capability (Reader (..), Verifier (..))
import qualified Tahoe.CHK.Encrypt
import Tahoe.CHK.Server (StorageServer (..), StorageServerID)
import Tahoe.CHK.Types (ShareNum, StorageIndex)
+import qualified Tahoe.SDMF as SDMF
import TahoeLAFS.Storage.API (CBORSet (..), ShareNumber (ShareNumber))
import TahoeLAFS.Storage.Client (getImmutableShareNumbers, readImmutableShare)
import Text.Read (readMaybe)
@@ -100,6 +102,9 @@ data DiscoverError
-}
type LookupServer m = StorageServerAnnouncement -> m (Either LookupError StorageServer)
+downloadMutable :: MonadIO m => Map.Map StorageServerID StorageServerAnnouncement -> SDMF.Reader -> LookupServer m -> m (Either DownloadError LB.ByteString)
+downloadMutable = undefined
+
{- | Recover the application data associated with a given capability from the
given servers, if possible.
-}
diff --git a/test/Spec.hs b/test/Spec.hs
index 73bb09a..727b068 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -3,6 +3,7 @@ module Main where
import Control.Exception (Exception, throwIO)
import Control.Monad (replicateM, zipWithM_)
import Control.Monad.IO.Class (liftIO)
+import Crypto.Cipher.Types (nullIV)
import Crypto.Classes (buildKey)
import qualified Data.Binary as Binary
import qualified Data.ByteString as B
@@ -40,9 +41,9 @@ import Tahoe.Download (
LookupError (..),
LookupServer,
download,
+ downloadMutable,
)
import qualified Tahoe.SDMF as SDMF
-import Tahoe.SDMF.Internal.Capability (deriveReader)
import qualified Tahoe.SDMF.Keys as SDMF.Keys
import Tahoe.Server (memoryStorageServer)
import Test.Tasty (TestTree, defaultMain, testGroup)
@@ -294,7 +295,7 @@ tests =
-- Recover the plaintext from the servers.
result <- liftIO $ download serverAnnouncements cap lookupServer
diff (Right plaintext) (==) result
- , testCase "ssk success" $
+ , testProperty "ssk success" $
property $ do
-- Like "chk success" above, but for SDMF (a case of SSK).
plaintext <- forAll $ BL.fromStrict <$> Gen.bytes (Range.exponential 56 1024)
@@ -302,18 +303,42 @@ tests =
keypair <- SDMF.Keys.KeyPair <$> forAll genRSAKeys
Parameters{paramRequiredShares = required, paramTotalShares = total} <- forAll genParameters
- let ciphertext = SDMF.encrypt dataKey plaintext
+ -- Since multiple shares can be placed on a single server, as long
+ -- as we have one server we have a valid case. Since some shares
+ -- might be placed non-optimally it is also nice to allow for some
+ -- empty servers so allow for that as well.
+ let numServers = Range.linear 1 (fromIntegral total + 1)
+ serverIDs = Gen.text (Range.singleton 2) Gen.ascii
+ serverIDs' <- forAll $ Gen.set numServers serverIDs
+
+ perServerShareCount <-
+ forAll $
+ genListWithSum (length serverIDs') (fromIntegral total)
+
+ -- Make the servers.
+ servers <- liftIO $ replicateM (length serverIDs') memoryStorageServer
+
+ -- Derive the keys, encode the data.
+ let -- Not a very good IV choice in reality but it's okay for
+ -- this test where confidentiality and key secrecy is not
+ -- particularly a concern.
+ iv = SDMF.Keys.SDMF_IV nullIV
+ signatureKey = SDMF.Keys.toSignatureKey keypair
+ (Just writeKey) = SDMF.Keys.deriveWriteKey signatureKey
+ (Just readKey) = SDMF.Keys.deriveReadKey writeKey
+ (Just dataKey) = SDMF.Keys.deriveDataKey iv readKey
+ ciphertext = SDMF.encrypt dataKey plaintext
(shares, writeCap) <- liftIO $ SDMF.encode keypair sequenceNumber required total ciphertext
- let (Just readCap) = deriveReader
+ let readCap = SDMF.writerReader writeCap
-- Distribute the shares.
- liftIO $ placeShares cap (Binary.encode <$> shares) perServerShareCount servers 0
+ liftIO $ placeMutable writeCap (Binary.encode <$> shares) perServerShareCount servers 0
let serverMap = Map.fromList $ zip (Set.toList serverIDs') servers
lookupServer = someServers serverMap
serverAnnouncements = Map.fromSet makeAnn serverIDs'
-- Recover the plaintext from the servers.
- result <- liftIO $ downloadMutable serverAnnouncements cap lookupServer
+ result <- liftIO $ downloadMutable serverAnnouncements readCap lookupServer
diff (Right plaintext) (==) result
, testCase "immutable upload/download to using Great Black Swamp" $ do
pure ()
@@ -347,6 +372,9 @@ tests =
-- Exactly match the nonsense makeAnn spits out
parseURL = T.take 2 . T.drop 5
+ placeMutable :: SDMF.Writer -> [BL.ByteString] -> [Int] -> [StorageServer] -> Int -> IO ()
+ placeMutable = undefined
+
--- PHILOSOFY
-- We wish that share numbers were an opaque type instead of a
-- numeric/integral type. This is not the place to argue the point
--
GitLab