diff --git a/cabal.project b/cabal.project
index 55be17a13a683db9dd1f7743b243c5f56a0f587a..80fc512d3f3319213956e32b7fef370e50b09ec5 100644
--- a/cabal.project
+++ b/cabal.project
@@ -2,6 +2,7 @@ packages: .
-- These aren't released on hackage yet so we have to grab them
-- straight from the vcs host. Probably should do some releases
-- soon.
+ ../tahoe-ssk
https://whetstone.private.storage/privatestorage/tahoe-chk/-/archive/0.1.0.1/tahoe-chk-0.1.0.1.tar.gz
https://whetstone.private.storage/privatestorage/tahoe-great-black-swamp/-/archive/0.2.0.2/tahoe-great-black-swamp-0.2.0.2.tar.gz
diff --git a/gbs-downloader.cabal b/gbs-downloader.cabal
index 0312e51907c814bf571180adc41e61977864d352..e2ae392fa57145a3d2450382aad5ef0f9f5dcdc3 100644
--- a/gbs-downloader.cabal
+++ b/gbs-downloader.cabal
@@ -172,18 +172,23 @@ test-suite gbs-downloader-test
-- Test dependencies.
build-depends:
+ , asn1-encoding
+ , asn1-types
, base
, base32
, binary
, bytestring
, containers
, crypto-api
+ , cryptonite
, data-default-class
, gbs-downloader
, hedgehog
, tahoe-chk
+ , tahoe-ssk
, tasty
, tasty-hedgehog
, tasty-hunit
, text
+ , x509
, yaml
diff --git a/test/Generators.hs b/test/Generators.hs
index 3adc7c662bbccce84fecc99c0cb6251bac5eb1fa..7827221f4e4200997a4ff55165e44577bdcb0af1 100644
--- a/test/Generators.hs
+++ b/test/Generators.hs
@@ -1,11 +1,19 @@
module Generators where
+import qualified Crypto.PubKey.RSA as RSA
+import Data.ASN1.BinaryEncoding (DER (DER))
+import Data.ASN1.Encoding (ASN1Decoding (decodeASN1))
+import Data.ASN1.Types (ASN1Object (fromASN1))
+import Data.Bifunctor (Bifunctor (first))
import Data.ByteString.Base32 (encodeBase32Unpadded)
+import qualified Data.ByteString.Lazy as LB
import Data.Int (Int64)
import qualified Data.Text as T
+import Data.X509 (PrivKey (PrivKeyRSA))
import Hedgehog (MonadGen)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
+import System.IO.Unsafe (unsafePerformIO)
import Tahoe.Announcement (Announcements (..), StorageServerAnnouncement (..))
import Tahoe.CHK.Types (Parameters (..))
@@ -37,3 +45,30 @@ genStorageServerAnnouncements =
<$> Gen.maybe (Gen.text (Range.linear 16 32) Gen.ascii)
<*> Gen.maybe (Gen.text (Range.linear 16 32) Gen.ascii)
<*> Gen.maybe (Gen.bytes $ Range.singleton 32)
+
+{- | Build RSA key pairs.
+
+ Because the specific bits of the key pair shouldn't make any difference to
+ any application logic, generating new RSA key pairs is expensive, and
+ generating new RSA key pairs in a way that makes sense in Hedgehog is
+ challenging, this implementation just knows a few RSA key pairs already and
+ will give back one of them.
+-}
+genRSAKeys :: MonadGen m => m RSA.PrivateKey
+genRSAKeys = Gen.element (map rsaKeyPair rsaKeyPairBytes)
+
+-- I'm not sure how to do IO in MonadGen so do the IO up front unsafely (but
+-- hopefully not really unsafely).
+rsaKeyPairBytes :: [LB.ByteString]
+{-# NOINLINE rsaKeyPairBytes #-}
+rsaKeyPairBytes = unsafePerformIO $ mapM (\n -> LB.readFile ("test/data/rsa-privkey-" <> show n <> ".der")) [0 .. 4 :: Int]
+
+rsaKeyPair :: LB.ByteString -> RSA.PrivateKey
+rsaKeyPair bs = do
+ let (Right kp) = do
+ asn1s <- first show (decodeASN1 DER bs)
+ (r, _) <- fromASN1 asn1s
+ case r of
+ PrivKeyRSA pk -> pure pk
+ _ -> error "Expected RSA Private Key"
+ kp
diff --git a/test/Spec.hs b/test/Spec.hs
index 91a9191fd9cb0223b4fb905c9838bf9d612c93df..73bb09a219d4f02ddb5406075cc229d2f0fed770 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -15,7 +15,7 @@ import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.Word (Word16)
import qualified Data.Yaml as Yaml
-import Generators (genAnnouncements, genParameters)
+import Generators (genAnnouncements, genParameters, genRSAKeys)
import Hedgehog (MonadGen, diff, forAll, property, tripping)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
@@ -41,6 +41,9 @@ import Tahoe.Download (
LookupServer,
download,
)
+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)
import Test.Tasty.HUnit (assertEqual, testCase)
@@ -244,7 +247,7 @@ tests =
"download should fail with details about unreachable server"
(Left (NotEnoughDecodedShares{notEnoughDecodedSharesNeeded = 3, notEnoughDecodedSharesFound = 0}))
result
- , testProperty "success" $
+ , testProperty "chk success" $
property $ do
-- If we can recover enough distinct, decodeable shares from the
-- configured servers then we can recover the application data.
@@ -291,6 +294,27 @@ tests =
-- Recover the plaintext from the servers.
result <- liftIO $ download serverAnnouncements cap lookupServer
diff (Right plaintext) (==) result
+ , testCase "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)
+ sequenceNumber <- forAll $ Gen.integral (Range.exponential 1 10000)
+ keypair <- SDMF.Keys.KeyPair <$> forAll genRSAKeys
+ Parameters{paramRequiredShares = required, paramTotalShares = total} <- forAll genParameters
+
+ let ciphertext = SDMF.encrypt dataKey plaintext
+ (shares, writeCap) <- liftIO $ SDMF.encode keypair sequenceNumber required total ciphertext
+ let (Just readCap) = deriveReader
+ -- Distribute the shares.
+ liftIO $ placeShares cap (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
+ diff (Right plaintext) (==) result
, testCase "immutable upload/download to using Great Black Swamp" $ do
pure ()
-- Consider moving these tests to another module, they're pretty