From a501ffb0389ce389c92d276f0478eabdcbde6448 Mon Sep 17 00:00:00 2001
From: Jean-Paul Calderone <exarkun@twistedmatrix.com>
Date: Sat, 13 May 2023 09:01:30 -0400
Subject: [PATCH] Most of an interoperability test with Tahoe-LAFS data
It doesn't have an assert but it prints the wrong output
---
src/Tahoe/SDMF/Internal/Encoding.hs | 2 +-
src/Tahoe/SDMF/Internal/Keys.hs | 14 ++++++++--
test/Spec.hs | 43 +++++++++++++++++++++++------
3 files changed, 48 insertions(+), 11 deletions(-)
diff --git a/src/Tahoe/SDMF/Internal/Encoding.hs b/src/Tahoe/SDMF/Internal/Encoding.hs
index 6414741..f7c5c89 100644
--- a/src/Tahoe/SDMF/Internal/Encoding.hs
+++ b/src/Tahoe/SDMF/Internal/Encoding.hs
@@ -76,7 +76,7 @@ makeShare shareSequenceNumber shareIV shareRequiredShares shareTotalShares share
decode :: (MonadFail m, MonadIO m) => Reader -> [(Word16, Share)] -> m LB.ByteString
decode _ [] = fail "Cannot decode with no shares"
decode _ s@((_, Share{shareRequiredShares, shareTotalShares, shareSegmentSize}) : shares)
- | length shares < fromIntegral shareRequiredShares = fail $ "got " <> show (length shares) <> " shares, required " <> show shareRequiredShares
+ | length s < fromIntegral shareRequiredShares = fail $ "got " <> show (length shares) <> " shares, required " <> show shareRequiredShares
| otherwise = do
ciphertext <- liftIO $ zunfec (fromIntegral shareRequiredShares) (fromIntegral shareTotalShares) (take (fromIntegral shareRequiredShares) blocks)
pure . LB.take (fromIntegral shareSegmentSize) . LB.fromStrict $ ciphertext
diff --git a/src/Tahoe/SDMF/Internal/Keys.hs b/src/Tahoe/SDMF/Internal/Keys.hs
index f82a316..2617bb4 100644
--- a/src/Tahoe/SDMF/Internal/Keys.hs
+++ b/src/Tahoe/SDMF/Internal/Keys.hs
@@ -8,14 +8,17 @@ import Prelude hiding (Read)
import Control.Monad (when)
import Crypto.Cipher.AES (AES128)
-import Crypto.Cipher.Types (BlockCipher (ctrCombine), Cipher (cipherInit, cipherKeySize), IV, KeySizeSpecifier (KeySizeFixed), nullIV)
-import Crypto.Error (maybeCryptoError)
+import Crypto.Cipher.Types (BlockCipher (ctrCombine), Cipher (cipherInit, cipherKeySize), IV, KeySizeSpecifier (KeySizeFixed), makeIV, nullIV)
+import Crypto.Error (CryptoFailable (CryptoPassed), maybeCryptoError)
import qualified Crypto.PubKey.RSA as RSA
import Crypto.Random (MonadRandom)
import Data.ASN1.BinaryEncoding (DER (DER))
import Data.ASN1.Encoding (ASN1Encoding (encodeASN1), decodeASN1')
import Data.ASN1.Types (ASN1 (End, IntVal, Null, OID, OctetString, Start), ASN1ConstructionType (Sequence), ASN1Object (fromASN1, toASN1))
import Data.Bifunctor (Bifunctor (first))
+import Data.Binary (Binary (get, put))
+import Data.Binary.Get (getByteString)
+import Data.Binary.Put (putByteString)
import qualified Data.ByteArray as ByteArray
import qualified Data.ByteString as B
import Data.ByteString.Base32 (encodeBase32Unpadded)
@@ -43,6 +46,13 @@ newtype Signature = Signature {unSignature :: RSA.PrivateKey}
data Write = Write {unWrite :: AES128, writeKeyBytes :: ByteArray.ScrubbedBytes}
+instance Binary Write where
+ put = putByteString . ByteArray.convert . writeKeyBytes
+ get = do
+ writeKeyBytes <- ByteArray.convert <$> getByteString 16
+ let (CryptoPassed unWrite) = cipherInit writeKeyBytes
+ pure Write{..}
+
instance Show Write where
show (Write _ bs) = T.unpack $ T.concat ["<WriteKey ", encodeBase32Unpadded (ByteArray.convert bs), ">"]
diff --git a/test/Spec.hs b/test/Spec.hs
index df71c87..7f2bd9f 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -11,6 +11,7 @@ import Hedgehog (
tripping,
)
+import Control.Monad (when)
import Control.Monad.IO.Class (liftIO)
import Crypto.Cipher.Types (makeIV)
import Data.ASN1.BinaryEncoding (DER (DER))
@@ -19,7 +20,7 @@ import qualified Data.Binary as Binary
import Data.Binary.Get (ByteOffset)
import qualified Data.ByteArray as ByteArray
import qualified Data.ByteString as B
-import Data.ByteString.Base32 (encodeBase32Unpadded)
+import Data.ByteString.Base32 (decodeBase32Unpadded, encodeBase32Unpadded)
import qualified Data.ByteString.Lazy as LB
import qualified Data.Text as T
import Generators (encodingParameters, genRSAKeys, shareHashChains, shares)
@@ -171,8 +172,33 @@ tests =
Keys.deriveDataKey iv readKey
plaintext <- forAll $ LB.fromStrict <$> Gen.bytes (Range.exponential 1 1024)
tripping plaintext (Tahoe.SDMF.encrypt dataKey iv) (Just . Tahoe.SDMF.decrypt dataKey iv)
+ , testCase "Recover plaintext from a known-correct slot" $ do
+ s0 <- liftIO $ Binary.decode <$> (LB.readFile "test/data/3of10.0" >>= readShareFromBucket)
+ s6 <- liftIO $ Binary.decode <$> (LB.readFile "test/data/3of10.6" >>= readShareFromBucket)
+ s9 <- liftIO $ Binary.decode <$> (LB.readFile "test/data/3of10.9" >>= readShareFromBucket)
+
+ let (Right writeKey) = Binary.decode . LB.fromStrict <$> decodeBase32Unpadded "vdv6pcqkblsguvkagrblr3gopu"
+ (Just readerReadKey) = Keys.deriveReadKey writeKey
+ readerVerificationKeyHash = "junk"
+ reader = Tahoe.SDMF.Reader{..}
+ ciphertext <- Tahoe.SDMF.decode reader [(0, s0), (6, s6), (9, s9)]
+ let (Just dataKey) = Keys.deriveDataKey (Tahoe.SDMF.shareIV s0) readerReadKey
+ plaintext = Tahoe.SDMF.decrypt dataKey (Tahoe.SDMF.shareIV s0) ciphertext
+
+ print plaintext
+ pure ()
]
+readShareFromBucket :: MonadFail m => LB.ByteString -> m LB.ByteString
+readShareFromBucket bucket =
+ let withoutPrefix = LB.drop (32 + 20 + 32 + 8 + 8 + 368) bucket
+ dataSize = LB.length withoutPrefix - 4
+ shareData = LB.take dataSize withoutPrefix
+ suffix = LB.drop dataSize withoutPrefix
+ in do
+ when (suffix /= "\0\0\0\0") (fail "Cannot account for extra leases")
+ pure shareData
+
{- | Load a known-correct SDMF bucket and assert that bytes in the slot it
contains deserializes to a Share and then serializes back to the same bytes
@@ -187,13 +213,14 @@ knownCorrectRoundTrip n = do
-- having to parse the prefix, we assert that the suffix is a
-- predictable size.
bucket <- LB.readFile ("test/data/3of10." <> show n)
- let withoutPrefix = LB.drop (32 + 20 + 32 + 8 + 8 + 368) bucket
- dataSize = LB.length withoutPrefix - 4
- shareData = LB.take dataSize withoutPrefix
- suffix = LB.drop dataSize withoutPrefix
-
- -- Our assumption about the data we're working on...
- assertEqual "Cannot account for extra leases" suffix "\0\0\0\0"
+ shareData <- readShareFromBucket bucket
+ -- let withoutPrefix = LB.drop (32 + 20 + 32 + 8 + 8 + 368) bucket
+ -- dataSize = LB.length withoutPrefix - 4
+ -- shareData = LB.take dataSize withoutPrefix
+ -- suffix = LB.drop dataSize withoutPrefix
+
+ -- -- Our assumption about the data we're working on...
+ -- assertEqual "Cannot account for extra leases" suffix "\0\0\0\0"
let decoded = decode' shareData
let encoded = (Binary.encode :: Tahoe.SDMF.Share -> LB.ByteString) <$> decoded
--
GitLab