From b09db8d9e1db047841563bb6c2f70472b4a07618 Mon Sep 17 00:00:00 2001
From: Jean-Paul Calderone <exarkun@twistedmatrix.com>
Date: Mon, 2 Oct 2023 15:41:39 -0400
Subject: [PATCH] bump tahoe-chk to 0.2.0.0 and make adjustments so this works
---
flake.lock | 12 ++++++------
flake.nix | 2 +-
src/Tahoe/SDMF/Internal/Capability.hs | 13 +++++++------
src/Tahoe/SDMF/Internal/Encoding.hs | 7 ++++---
src/Tahoe/SDMF/Internal/Share.hs | 5 +++--
tahoe-ssk.cabal | 4 ++--
test/Generators.hs | 23 +++++++++++++----------
test/Spec.hs | 3 ++-
8 files changed, 38 insertions(+), 31 deletions(-)
diff --git a/flake.lock b/flake.lock
index 17b6fae..c1bfd53 100644
--- a/flake.lock
+++ b/flake.lock
@@ -516,16 +516,16 @@
]
},
"locked": {
- "lastModified": 1683552888,
- "narHash": "sha256-h9pgP/LYPtUr5CeCAhqt1XJyAqKTnkQxuIygiTulU/U=",
- "ref": "refs/tags/0.1.0.1",
- "rev": "05aeb5a433b85406ca3c0c313c46299a1026ade0",
- "revCount": 344,
+ "lastModified": 1696262854,
+ "narHash": "sha256-0/6VEsjXe7EvYY2BnkWkmHCVzdp1WcFLjx5mvHDMLnM=",
+ "ref": "refs/tags/0.2.0.0",
+ "rev": "42ae52257ec6e6d8eaa9a56662ca5edfbce8074b",
+ "revCount": 487,
"type": "git",
"url": "https://whetstone.private.storage/PrivateStorage/tahoe-chk"
},
"original": {
- "ref": "refs/tags/0.1.0.1",
+ "ref": "refs/tags/0.2.0.0",
"type": "git",
"url": "https://whetstone.private.storage/PrivateStorage/tahoe-chk"
}
diff --git a/flake.nix b/flake.nix
index 4fe75f9..b52496a 100644
--- a/flake.nix
+++ b/flake.nix
@@ -7,7 +7,7 @@
hs-flake-utils.url = "git+https://whetstone.private.storage/jcalderone/hs-flake-utils.git?ref=main";
nixpkgs.follows = "hs-flake-utils/nixpkgs";
tahoe-chk = {
- url = "git+https://whetstone.private.storage/PrivateStorage/tahoe-chk?ref=refs/tags/0.1.0.1";
+ url = "git+https://whetstone.private.storage/PrivateStorage/tahoe-chk?ref=refs/tags/0.2.0.0";
inputs.nixpkgs.follows = "hs-flake-utils/nixpkgs";
};
tahoe-capabilities = {
diff --git a/src/Tahoe/SDMF/Internal/Capability.hs b/src/Tahoe/SDMF/Internal/Capability.hs
index a0a1943..d8b494f 100644
--- a/src/Tahoe/SDMF/Internal/Capability.hs
+++ b/src/Tahoe/SDMF/Internal/Capability.hs
@@ -5,7 +5,7 @@ import Prelude hiding (Read)
import Control.Applicative ((<|>))
import Control.Monad (void)
-import Crypto.Hash (Digest, SHA256, digestFromByteString)
+import Crypto.Hash (digestFromByteString)
import Data.Binary (decode)
import qualified Data.ByteArray as ByteArray
import qualified Data.ByteString as B
@@ -16,6 +16,7 @@ import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Void (Void)
import Data.Word (Word16)
+import Tahoe.CHK.SHA256d (Digest' (Digest'), SHA256d)
import Tahoe.Capability (ConfidentialShowable (..))
import Tahoe.SDMF.Internal.Keys (
Read (readKeyBytes),
@@ -49,7 +50,7 @@ instance ConfidentialShowable SDMF where
-- | A verify capability for an SDMF object.
data Verifier = Verifier
{ verifierStorageIndex :: StorageIndex
- , verifierVerificationKeyHash :: Digest SHA256
+ , verifierVerificationKeyHash :: Digest' SHA256d
}
deriving (Eq, Show)
@@ -86,14 +87,14 @@ instance ConfidentialShowable Writer where
confidentiallyShow = dangerRealShow . SDMFWriter
-- | Diminish a write key to a read key and wrap it in a reader capability.
-deriveReader :: Write -> Digest SHA256 -> Maybe Reader
+deriveReader :: Write -> Digest' SHA256d -> Maybe Reader
deriveReader w fingerprint = Reader <$> readKey <*> verifier
where
readKey = deriveReadKey w
verifier = flip deriveVerifier fingerprint <$> readKey
-- | Diminish a read key to a verify key and wrap it in a verifier capability.
-deriveVerifier :: Read -> Digest SHA256 -> Verifier
+deriveVerifier :: Read -> Digest' SHA256d -> Verifier
deriveVerifier readKey = Verifier storageIndex
where
storageIndex = deriveStorageIndex readKey
@@ -133,7 +134,7 @@ pPieces ::
-- | A function to convert the first bytestring to a result value.
(B.ByteString -> a) ->
-- | A parser for the two pieces of the SDMF capability.
- Parser (a, Digest SHA256)
+ Parser (a, Digest' SHA256d)
pPieces prefix convertSecret = do
void $ string prefix
secret <- convertSecret <$> pBase32 rfc3548Alphabet 128
@@ -142,7 +143,7 @@ pPieces prefix convertSecret = do
case digestFromByteString digestBytes of
Nothing -> failure Nothing mempty
Just verificationKeyHash ->
- pure (secret, verificationKeyHash)
+ pure (secret, Digest' verificationKeyHash)
{- | A parser combinator for an arbitrary byte string of a fixed length,
encoded using base32.
diff --git a/src/Tahoe/SDMF/Internal/Encoding.hs b/src/Tahoe/SDMF/Internal/Encoding.hs
index 5d98a76..f752286 100644
--- a/src/Tahoe/SDMF/Internal/Encoding.hs
+++ b/src/Tahoe/SDMF/Internal/Encoding.hs
@@ -5,8 +5,8 @@
-}
module Tahoe.SDMF.Internal.Encoding where
-import Control.Monad.Fail (MonadFail)
import Control.Monad (when)
+import Control.Monad.Fail (MonadFail)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Crypto.Hash (digestFromByteString)
import Crypto.Random (MonadRandom)
@@ -18,6 +18,7 @@ import qualified Data.Text as T
import Data.Word (Word16, Word64, Word8)
import Tahoe.CHK (padCiphertext, zfec, zunfec)
import Tahoe.CHK.Merkle (MerkleTree (MerkleLeaf))
+import Tahoe.CHK.SHA256d (Digest' (Digest'), zero)
import Tahoe.SDMF.Internal.Capability (Reader (..), Writer (..), deriveReader)
import Tahoe.SDMF.Internal.Converting (from, tryInto)
import qualified Tahoe.SDMF.Internal.Keys as Keys
@@ -91,7 +92,7 @@ makeShare shareSequenceNumber shareIV shareRequiredShares shareTotalShares share
shareRootHash = B.replicate 32 0
shareSignature = B.replicate 32 0 -- XXX Actually compute sig, and is it 32 bytes?
shareHashChain = HashChain []
- shareBlockHashTree = MerkleLeaf (B.replicate 32 0) -- XXX Real hash here, plus length check
+ shareBlockHashTree = MerkleLeaf zero -- XXX Real hash here, plus length check
{- | Decode some SDMF shares to recover the original ciphertext.
@@ -124,7 +125,7 @@ capabilityForKeyPair keypair =
Writer <$> writerWriteKey <*> maybeToEither' "Failed to derive read capability" writerReader
where
writerWriteKey = maybeToEither "Failed to derive write key" . Keys.deriveWriteKey . Keys.toSignatureKey $ keypair
- verificationKeyHash = digestFromByteString . Keys.deriveVerificationHash . Keys.toVerificationKey $ keypair
+ verificationKeyHash = fmap Digest' . digestFromByteString . Keys.deriveVerificationHash . Keys.toVerificationKey $ keypair
writerReader = deriveReader <$> writerWriteKey <*> maybeToEither "Failed to interpret verification hash" verificationKeyHash
maybeToEither :: a -> Maybe b -> Either a b
diff --git a/src/Tahoe/SDMF/Internal/Share.hs b/src/Tahoe/SDMF/Internal/Share.hs
index 685e1f4..dda046d 100644
--- a/src/Tahoe/SDMF/Internal/Share.hs
+++ b/src/Tahoe/SDMF/Internal/Share.hs
@@ -17,6 +17,7 @@ import Data.Int (Int64)
import Data.Word (Word16, Word32, Word64, Word8)
import Data.X509 (PrivKey (PrivKeyRSA), PubKey (PubKeyRSA))
import Tahoe.CHK.Merkle (MerkleTree, leafHashes)
+import Tahoe.CHK.SHA256d (Digest' (Digest'), SHA256d, toBytes)
import Tahoe.SDMF.Internal.Converting (From (from), into, tryInto)
import qualified Tahoe.SDMF.Internal.Keys as Keys
@@ -81,7 +82,7 @@ data Share = Share
-- ... something about verification I dunno. XXX
shareHashChain :: HashChain
, -- | A merkle tree where leaves are the hashes of the blocks in this share.
- shareBlockHashTree :: MerkleTree
+ shareBlockHashTree :: MerkleTree B.ByteString SHA256d
, -- | The share data (erasure encoded ciphertext).
shareData :: LB.ByteString
, -- | The encrypted 2048 bit "signature" RSA key.
@@ -113,7 +114,7 @@ instance Binary Share where
putByteString shareEncryptedPrivateKey
where
verificationKeyBytes = Keys.verificationKeyToBytes shareVerificationKey
- blockHashTreeBytes = B.concat . leafHashes $ shareBlockHashTree
+ blockHashTreeBytes = B.concat . fmap toBytes . leafHashes $ shareBlockHashTree
-- Some conversions could fail because we can't be completely sure of
-- the size of the data we're working with. Put has no good failure
diff --git a/tahoe-ssk.cabal b/tahoe-ssk.cabal
index 6eceb3e..b0c4d8f 100644
--- a/tahoe-ssk.cabal
+++ b/tahoe-ssk.cabal
@@ -132,7 +132,7 @@ library
-- This dependency isn't ideal. Move common bits out to
-- another library.
- build-depends: tahoe-chk >=0.1 && <0.2
+ build-depends: tahoe-chk >=0.2 && <0.3
test-suite tahoe-ssk-test
import:
@@ -167,7 +167,7 @@ test-suite tahoe-ssk-test
, megaparsec >=8.0 && <9.3
, memory >=0.15 && <0.17
, tahoe-capabilities >=0.1 && <0.2
- , tahoe-chk >=0.1 && <0.2
+ , tahoe-chk >=0.2 && <0.3
, tahoe-ssk
, tasty >=1.2.3 && <1.5
, tasty-hedgehog >=1.0.0.2 && <1.2
diff --git a/test/Generators.hs b/test/Generators.hs
index 993edc5..73dea60 100644
--- a/test/Generators.hs
+++ b/test/Generators.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
module Generators where
import Crypto.Cipher.Types (makeIV)
@@ -10,7 +12,7 @@ import Data.Bifunctor (Bifunctor (first))
import qualified Data.Binary as Binary
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
-import Data.Maybe (fromJust)
+import Data.Maybe (fromJust, fromMaybe)
import Data.Word (Word16)
import Data.X509 (PrivKey (PrivKeyRSA))
import GHC.IO.Unsafe (unsafePerformIO)
@@ -18,6 +20,7 @@ import Hedgehog (MonadGen)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Tahoe.CHK.Merkle (MerkleTree (..), makeTreePartial)
+import Tahoe.CHK.SHA256d (Digest' (Digest'), SHA256d)
import Tahoe.SDMF (Reader (..), SDMF (..), Share (..), Verifier (..), Writer (..))
import Tahoe.SDMF.Internal.Capability (deriveReader)
import Tahoe.SDMF.Internal.Keys (keyLength)
@@ -87,12 +90,16 @@ rsaKeyPair bs = do
_ -> error "Expected RSA Private Key"
kp
-merkleTrees :: MonadGen m => Range.Range Int -> m MerkleTree
-merkleTrees r = makeTreePartial <$> Gen.list r genHash
+merkleTrees :: MonadGen m => Range.Range Int -> m (MerkleTree B.ByteString SHA256d)
+merkleTrees r = makeTreePartial <$> Gen.list r digests
--- | Generate ByteStrings which could be sha256d digests.
-genHash :: MonadGen m => m B.ByteString
-genHash = Gen.bytes . Range.singleton . hashDigestSize $ SHA256
+-- | Generate Digest' values for some hash algorithm. Shrinks toward "aaa..."
+digests :: forall m hash. (MonadGen m, HashAlgorithm hash) => m (Digest' hash)
+digests =
+ Digest'
+ . fromMaybe (error "Failed to interpret bytes as digest")
+ . digestFromByteString
+ <$> Gen.bytes (Range.singleton (hashDigestSize (undefined :: hash)))
-- | Generate lists of two-tuples of share identifier and share root hash.
shareHashChains :: MonadGen m => m HashChain
@@ -142,7 +149,3 @@ verifiers = readerVerifier <$> readers
-- | Build SDMF storage indexes.
storageIndexes :: MonadGen m => m Keys.StorageIndex
storageIndexes = Keys.StorageIndex <$> Gen.bytes (Range.singleton keyLength)
-
--- | Build SHA256 digests.
-digests :: MonadGen m => m (Digest SHA256)
-digests = fromJust . digestFromByteString <$> Gen.bytes (Range.singleton 32)
diff --git a/test/Spec.hs b/test/Spec.hs
index 30a209f..a078716 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -27,6 +27,7 @@ import Generators (capabilities, encodingParameters, genRSAKeys, ivLength, share
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import System.IO (hSetEncoding, stderr, stdout, utf8)
+import Tahoe.CHK.SHA256d (Digest' (Digest'))
import Tahoe.Capability (confidentiallyShow)
import qualified Tahoe.SDMF
import Tahoe.SDMF.Internal.Capability (deriveVerifier)
@@ -206,7 +207,7 @@ tests =
let (Right writeKey) = Binary.decode . LB.fromStrict <$> decodeBase32Unpadded "vdv6pcqkblsguvkagrblr3gopu"
(Just readerReadKey) = Keys.deriveReadKey writeKey
- (Just readerVerifier) = deriveVerifier readerReadKey <$> digestFromByteString ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" :: B.ByteString)
+ (Just readerVerifier) = deriveVerifier readerReadKey . Digest' <$> digestFromByteString ("aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" :: B.ByteString)
reader = Tahoe.SDMF.Reader{..}
ciphertext <- Tahoe.SDMF.decode reader [(0, s0), (6, s6), (9, s9)]
let (Right expectedCiphertext) = LB.fromStrict <$> decodeBase32Unpadded "6gutkha6qd4g3lxahth2dw2wjekadwoxvmazrnfq5u5j6a7quu5qy6nz3dvosx2gisdjshdtd5xphqvqjco5pq73qi"
--
GitLab