From c111f44bcb4ccaaee1c6de044a1adc484f1f519b Mon Sep 17 00:00:00 2001
From: Jean-Paul Calderone <exarkun@twistedmatrix.com>
Date: Fri, 19 May 2023 13:56:49 -0400
Subject: [PATCH] Convert types safely or with the ability to report errors
---
src/Tahoe/SDMF/Internal/Encoding.hs | 56 ++++++++++++++++++++++------
src/Tahoe/SDMF/Internal/Share.hs | 58 ++++++++++++++++++++++-------
2 files changed, 89 insertions(+), 25 deletions(-)
diff --git a/src/Tahoe/SDMF/Internal/Encoding.hs b/src/Tahoe/SDMF/Internal/Encoding.hs
index e9f66dc..db9ef5d 100644
--- a/src/Tahoe/SDMF/Internal/Encoding.hs
+++ b/src/Tahoe/SDMF/Internal/Encoding.hs
@@ -5,22 +5,25 @@
-}
module Tahoe.SDMF.Internal.Encoding where
+import Control.Monad (when)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Crypto.Cipher.Types (BlockCipher (blockSize), IV, makeIV)
import Crypto.Random (MonadRandom (getRandomBytes))
import Data.Bifunctor (Bifunctor (bimap))
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
+import Data.Int (Int64)
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.SDMF.Internal.Capability (Reader (..), Writer (..), deriveReader)
+import Tahoe.SDMF.Internal.Converting (from, tryInto)
import qualified Tahoe.SDMF.Internal.Keys as Keys
import Tahoe.SDMF.Internal.Share (HashChain (HashChain), Share (..))
+-- | Randomly generate a new IV suitable for use with some BlockCipher.
randomIV :: forall c m. (BlockCipher c, MonadRandom m) => m (Maybe (IV c))
--- XXX Secure enough random source?
randomIV = (makeIV :: B.ByteString -> Maybe (IV c)) <$> getRandomBytes (blockSize (undefined :: c))
{- | Given a pre-determined key pair and sequence number, encode some
@@ -32,19 +35,38 @@ randomIV = (makeIV :: B.ByteString -> Maybe (IV c)) <$> getRandomBytes (blockSiz
-}
encode :: (MonadFail m, MonadIO m, MonadRandom m) => Keys.KeyPair -> Word64 -> Word16 -> Word16 -> LB.ByteString -> m ([Share], Writer)
encode keypair shareSequenceNumber required total ciphertext = do
- blocks <- liftIO $ fmap LB.fromStrict <$> zfec (fromIntegral required) (fromIntegral total) paddedCiphertext
+ -- Make sure the encoding parameters fit into a Word8
+ requiredAsWord8 <- tryInto @Word8 ("must have 0 < required < 255 but required == " <> show required) required
+ totalAsWord8 <- tryInto @Word8 ("must have 0 < total < 256 but total == " <> show total) total
+
+ -- And that they make sense together.
+ when (required >= total) (fail $ "must have required < total but required == " <> show required <> ", total == " <> show total)
+
+ -- They look okay, we can proceed.
+ blocks <- liftIO $ fmap LB.fromStrict <$> zfec (from required) (from total) paddedCiphertext
(Just iv) <- randomIV
- -- XXX fromIntegral is going from Word16 to Word8, not safe
+ -- We know the length won't be negative (doesn't make sense) and we
+ -- know all positive values fit into a Word64 so we can do this
+ -- conversion safely. But if it needs to fail for some reason, it
+ -- can do so safely.
+ dataLength <- tryInto @Word64 "must have 0 <= data length" (LB.length ciphertext)
+
+ -- All segments are the same so we can figure the size from any one
+ -- block. This conversion might fail because of Int64 vs Word64 but
+ -- only for truly, truly tremendous share data.
+ shareSegmentSize <- tryInto @Word64 "must have segment size < 2^63" (LB.length (head blocks))
+
let makeShare' =
flip $
makeShare
shareSequenceNumber
(Keys.SDMF_IV iv)
- (fromIntegral required)
- (fromIntegral total)
- (fromIntegral $ LB.length ciphertext)
+ requiredAsWord8
+ totalAsWord8
+ dataLength
+ shareSegmentSize
(Keys.toVerificationKey keypair)
let makeShare'' = makeShare' <$> blocks
@@ -64,14 +86,14 @@ makeShare ::
Word8 ->
Word8 ->
Word64 ->
+ Word64 ->
Keys.Verification ->
B.ByteString ->
LB.ByteString ->
Share
-makeShare shareSequenceNumber shareIV shareRequiredShares shareTotalShares shareDataLength shareVerificationKey shareEncryptedPrivateKey shareData = Share{..}
+makeShare shareSequenceNumber shareIV shareRequiredShares shareTotalShares shareDataLength shareSegmentSize shareVerificationKey shareEncryptedPrivateKey shareData = Share{..}
where
shareRootHash = B.replicate 32 0
- shareSegmentSize = fromIntegral $ LB.length shareData -- XXX Partial
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
@@ -84,12 +106,22 @@ 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, shareDataLength}) : shares)
- | length s < fromIntegral shareRequiredShares = fail $ "got " <> show (length shares) <> " shares, required " <> show shareRequiredShares
+ -- Make sure we have enough shares.
+ | length s < requiredAsInt =
+ 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 shareDataLength) . LB.fromStrict $ ciphertext
+ -- Make sure this implementation can handle the amount of data involved.
+ -- Since we use lazy ByteString we're limited to 2^63-1 bytes rather than
+ -- 2^64-1 bytes so there are some SDMF shares we can't interpret right
+ -- now.
+ shareDataLength' <- tryInto @Int64 ("share data length " <> show shareDataLength <> " is beyond maximum supported by this implementation " <> show (maxBound :: Int64)) shareDataLength
+ ciphertext <- liftIO $ zunfec requiredAsInt totalAsInt (take requiredAsInt blocks)
+ pure . LB.take shareDataLength' . LB.fromStrict $ ciphertext
where
- blocks = bimap fromIntegral (LB.toStrict . shareData) <$> s
+ blocks = bimap (from @Word16) (LB.toStrict . shareData) <$> s
+
+ requiredAsInt = from shareRequiredShares
+ totalAsInt = from shareTotalShares
-- | Compute an SDMF write capability for a given keypair.
capabilityForKeyPair :: Keys.KeyPair -> Either T.Text Writer
diff --git a/src/Tahoe/SDMF/Internal/Share.hs b/src/Tahoe/SDMF/Internal/Share.hs
index d370bbc..e5d3f4d 100644
--- a/src/Tahoe/SDMF/Internal/Share.hs
+++ b/src/Tahoe/SDMF/Internal/Share.hs
@@ -13,9 +13,10 @@ import Data.Binary.Put (putByteString, putLazyByteString, putWord16be, putWord32
import qualified Data.ByteArray as ByteArray
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
-import Data.Word (Word16, Word64, Word8)
+import Data.Word (Word16, Word32, Word64, Word8)
import Data.X509 (PrivKey (PrivKeyRSA), PubKey (PubKeyRSA))
import Tahoe.CHK.Merkle (MerkleTree, leafHashes)
+import Tahoe.SDMF.Internal.Converting (From (from), TryFrom (tryFrom), into, tryInto)
import qualified Tahoe.SDMF.Internal.Keys as Keys
hashSize :: Int
@@ -113,13 +114,43 @@ instance Binary Share where
verificationKeyBytes = Keys.verificationKeyToBytes shareVerificationKey
blockHashTreeBytes = B.concat . leafHashes $ shareBlockHashTree
- -- TODO Compute these from all the putting.
- signatureOffset = fromIntegral $ 1 + 8 + hashSize + 16 + 18 + 32 + B.length verificationKeyBytes
- hashChainOffset = signatureOffset + fromIntegral (B.length shareSignature)
- blockHashTreeOffset = hashChainOffset + fromIntegral (length (hashChain shareHashChain) * (hashSize + 2))
- shareDataOffset = blockHashTreeOffset + fromIntegral (B.length blockHashTreeBytes)
- encryptedPrivateKeyOffset = fromIntegral shareDataOffset + fromIntegral (LB.length shareData)
- eofOffset = encryptedPrivateKeyOffset + fromIntegral (B.length shareEncryptedPrivateKey)
+ -- 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
+ -- mechanism though. Try to provide the best failure behavior we can
+ -- here.
+ signatureOffset =
+ case tryInto @Word32 "" $ 1 + 8 + hashSize + 16 + 18 + 32 + B.length verificationKeyBytes of
+ Nothing -> error "Binary.put Share could not represent signature offset"
+ Just x -> x
+
+ hashChainOffset =
+ signatureOffset
+ + case tryInto @Word32 "" (B.length shareSignature) of
+ Nothing -> error "Binary.put Share could not represent hash chain offset"
+ Just x -> x
+ blockHashTreeOffset =
+ hashChainOffset
+ + case tryInto @Word32 "" (length (hashChain shareHashChain) * (hashSize + 2)) of
+ Nothing -> error "Binary.put Share could not represent block hash tree offset"
+ Just x -> x
+ shareDataOffset =
+ blockHashTreeOffset
+ + case tryInto @Word32 "" (B.length blockHashTreeBytes) of
+ Nothing -> error "Binary.put Share could not represent share data offset"
+ Just x -> x
+
+ -- Then there are a couple 64 bit offsets, represented as Word64s, for
+ -- positions that follow the share data.
+ encryptedPrivateKeyOffset =
+ into @Word64 shareDataOffset
+ + case tryInto @Word64 "" (LB.length shareData) of
+ Nothing -> error "Binary.put Share could not represent share data length"
+ Just x -> x
+ eofOffset =
+ encryptedPrivateKeyOffset
+ + case tryInto @Word64 "" (B.length shareEncryptedPrivateKey) of
+ Nothing -> error "Binary.put Share could not represent encrypted private key length"
+ Just x -> x
get = do
version <- getWord8
@@ -148,12 +179,13 @@ instance Binary Share where
shareVerificationOffset <- bytesRead
-- Read in the values between all those offsets.
- shareVerificationKey <- Keys.Verification <$> isolate (fromIntegral signatureOffset - fromIntegral shareVerificationOffset) getSubjectPublicKeyInfo
- shareSignature <- getByteString (fromIntegral hashChainOffset - fromIntegral signatureOffset)
- shareHashChain <- isolate (fromIntegral blockHashTreeOffset - fromIntegral hashChainOffset) get
- shareBlockHashTree <- isolate (fromIntegral shareDataOffset - fromIntegral blockHashTreeOffset) get
+ shareVerificationKey <- Keys.Verification <$> isolate (from signatureOffset - from shareVerificationOffset) getSubjectPublicKeyInfo
+ shareSignature <- getByteString (from $ hashChainOffset - signatureOffset)
+ shareHashChain <- isolate (from $ blockHashTreeOffset - hashChainOffset) get
+ shareBlockHashTree <- isolate (from $ shareDataOffset - blockHashTreeOffset) get
shareData <- getLazyByteString (fromIntegral encryptedPrivateKeyOffset - fromIntegral shareDataOffset)
- shareEncryptedPrivateKey <- getByteString (fromIntegral eofOffset - fromIntegral encryptedPrivateKeyOffset)
+ keyBytesLength <- tryInto @Int "Binary.get Share cannot represent private key length" (eofOffset - encryptedPrivateKeyOffset)
+ shareEncryptedPrivateKey <- getByteString keyBytesLength
empty <- isEmpty
unless empty (fail "Expected end of input but there are more bytes")
--
GitLab