diff --git a/src/Tahoe/SDMF.hs b/src/Tahoe/SDMF.hs index 4a4430cd2e1d4e8a3c214dd6374cf864ecf07754..35466344adecbdbb2d0ddd24a94906ab377d1ad2 100644 --- a/src/Tahoe/SDMF.hs +++ b/src/Tahoe/SDMF.hs @@ -3,6 +3,7 @@ module Tahoe.SDMF ( module Tahoe.SDMF.Internal.Share, module Tahoe.SDMF.Internal.Capability, module Tahoe.SDMF.Internal.Encoding, + module Tahoe.SDMF.Internal.Encrypting, ) where import Tahoe.SDMF.Internal.Capability ( @@ -13,8 +14,10 @@ import Tahoe.SDMF.Internal.Encoding ( decode, encode, ) +import Tahoe.SDMF.Internal.Encrypting ( + decrypt, + encrypt, + ) import Tahoe.SDMF.Internal.Share ( - Reader (..), Share (..), - Writer (..), ) diff --git a/src/Tahoe/SDMF/Internal/Capability.hs b/src/Tahoe/SDMF/Internal/Capability.hs index 56d6ed1616af9478126c40404844e279d0ee43bd..9db37c3339188a2a248743df4d8ff85bf1df1f39 100644 --- a/src/Tahoe/SDMF/Internal/Capability.hs +++ b/src/Tahoe/SDMF/Internal/Capability.hs @@ -4,7 +4,7 @@ module Tahoe.SDMF.Internal.Capability where import Prelude hiding (Read) import qualified Data.ByteString as B -import Tahoe.SDMF.Internal.Keys (Read, Write) +import Tahoe.SDMF.Internal.Keys (Read, Write, deriveReadKey) -- | A read capability for an SDMF object. data Reader = Reader @@ -19,3 +19,7 @@ data Writer = Writer , writerReader :: Reader } deriving (Show) + +-- | Diminish a write key to a read key and wrap it in a reader capability. +deriveReader :: Write -> B.ByteString -> Maybe Reader +deriveReader w fingerprint = Reader <$> deriveReadKey w <*> pure fingerprint diff --git a/src/Tahoe/SDMF/Internal/Encoding.hs b/src/Tahoe/SDMF/Internal/Encoding.hs index 68cd325ce9107049f0b868d47588be1a2a96b284..6414741681c0a38d3b430ecc20f33d65f90e9fbe 100644 --- a/src/Tahoe/SDMF/Internal/Encoding.hs +++ b/src/Tahoe/SDMF/Internal/Encoding.hs @@ -1,21 +1,25 @@ module Tahoe.SDMF.Internal.Encoding where import Control.Monad.IO.Class (MonadIO (liftIO)) -import Crypto.Cipher.AES128 (AESKey128, BlockCipher (buildKey)) -import Crypto.Classes (getIVIO) -import qualified Crypto.PubKey.RSA.Types as RSA -import Crypto.Types (IV) +import Crypto.Cipher.AES (AES128) +import Crypto.Cipher.Types (BlockCipher (blockSize), IV, makeIV) +import Crypto.Random (MonadRandom (getRandomBytes)) import Data.Bifunctor (Bifunctor (bimap)) +import qualified Data.ByteArray as ByteArray import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB import qualified Data.Text as T import Data.Word (Word16, Word64, Word8) import Tahoe.CHK (padCiphertext, zfec, zunfec) -import Tahoe.CHK.Crypto (taggedHash) -import Tahoe.CHK.Encrypt (encrypt) import Tahoe.CHK.Merkle (MerkleTree (MerkleLeaf)) import Tahoe.SDMF.Internal.Capability (Reader (..), Writer (..), deriveReader) -import Tahoe.SDMF.Internal.Share (HashChain (HashChain), Share (..), signatureKeyToBytes, verificationKeyToBytes) +import qualified Tahoe.SDMF.Internal.Keys as Keys +import Tahoe.SDMF.Internal.Share (HashChain (HashChain), Share (..)) + +--- XXX Not sure why I have to nail down AES128 here +randomIV :: MonadRandom m => m (Maybe (IV AES128)) +-- XXX Secure enough random source? +randomIV = (makeIV :: B.ByteString -> Maybe (IV AES128)) <$> getRandomBytes (blockSize (undefined :: AES128)) {- | Given a pre-determined key pair and sequence number, encode some ciphertext into a collection of SDMF shares. @@ -24,23 +28,22 @@ import Tahoe.SDMF.Internal.Share (HashChain (HashChain), Share (..), signatureKe Thus they cannot be re-used for "different" data. Any shares created with a given key pair are part of the same logical data object. -} -encode :: (MonadFail m, MonadIO m) => RSA.KeyPair -> Word64 -> Word16 -> Word16 -> LB.ByteString -> m ([Share], Writer) +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) (LB.toStrict $ padCiphertext required ciphertext) - -- XXX Secure enough random source? - iv <- liftIO (getIVIO :: IO (IV AESKey128)) + (Just iv) <- randomIV -- XXX fromIntegral is going from Word16 to Word8, not safe let makeShare' = flip $ makeShare shareSequenceNumber - iv + (Keys.SDMF_IV iv) (fromIntegral required) (fromIntegral total) (fromIntegral $ LB.length ciphertext) - (RSA.toPublicKey keypair) + (Keys.toVerificationKey keypair) let makeShare'' = makeShare' <$> blocks @@ -50,18 +53,15 @@ encode keypair shareSequenceNumber required total ciphertext = do where -- We can compute a capability immediately. cap = capabilityForKeyPair keypair - encryptedPrivateKey = flip encryptPrivateKey (RSA.toPrivateKey keypair) <$> (writerWriteKey <$> cap) - -encryptPrivateKey :: AESKey128 -> RSA.PrivateKey -> B.ByteString -encryptPrivateKey writeKey = LB.toStrict . encrypt writeKey . LB.fromStrict . signatureKeyToBytes + encryptedPrivateKey = flip Keys.encryptSignatureKey (Keys.toSignatureKey keypair) <$> (writerWriteKey <$> cap) makeShare :: Word64 -> - IV AESKey128 -> + Keys.SDMF_IV -> Word8 -> Word8 -> Word64 -> - RSA.PublicKey -> + Keys.Verification -> B.ByteString -> LB.ByteString -> Share @@ -84,38 +84,19 @@ decode _ s@((_, Share{shareRequiredShares, shareTotalShares, shareSegmentSize}) blocks = bimap fromIntegral (LB.toStrict . shareData) <$> s -- | Compute an SDMF write capability for a given keypair. -capabilityForKeyPair :: RSA.KeyPair -> Either T.Text Writer +capabilityForKeyPair :: Keys.KeyPair -> Either T.Text Writer capabilityForKeyPair keypair = - Writer <$> writerWriteKey <*> writerReader + Writer <$> writerWriteKey <*> maybeToEither' "Failed to derive read capability" writerReader where - writerWriteKey = maybeToEither "Failed to derive write key" . deriveWriteKey . RSA.toPrivateKey $ keypair - verificationKeyHash = hashVerificationKey . RSA.toPublicKey $ keypair + writerWriteKey = maybeToEither "Failed to derive write key" . Keys.deriveWriteKey . Keys.toSignatureKey $ keypair + verificationKeyHash = Keys.deriveVerificationHash . Keys.toVerificationKey $ keypair writerReader = deriveReader <$> writerWriteKey <*> pure verificationKeyHash maybeToEither :: a -> Maybe b -> Either a b maybeToEither a Nothing = Left a maybeToEither _ (Just b) = Right b -{- | The tag used when hashing the signature key to the write key for the - creation of an SDMF capability. --} -mutableWriteKeyTag :: B.ByteString -mutableWriteKeyTag = "allmydata_mutable_privkey_to_writekey_v1" - -writeKeyLength :: Int -writeKeyLength = 16 - -{- | Compute the verification key hash of the given verification key for - inclusion in an SDMF share. --} -hashVerificationKey :: RSA.PublicKey -> B.ByteString -hashVerificationKey = taggedHash verificationKeyHashLength mutableVerificationKeyHashTag . verificationKeyToBytes - -verificationKeyHashLength :: Int -verificationKeyHashLength = 32 - -{- | The tag used when hashing the verification key to the verification key - hash for inclusion in SDMF shares. --} -mutableVerificationKeyHashTag :: B.ByteString -mutableVerificationKeyHashTag = "allmydata_mutable_pubkey_to_fingerprint_v1" +maybeToEither' :: e -> Either e (Maybe a) -> Either e a +maybeToEither' e (Right Nothing) = Left e +maybeToEither' _ (Right (Just r)) = Right r +maybeToEither' _ (Left e) = Left e diff --git a/src/Tahoe/SDMF/Internal/Encrypting.hs b/src/Tahoe/SDMF/Internal/Encrypting.hs index b70be056ec5c6ee0fe0cfbbe88997affe663abfc..e0e402ce32bb98bcac15dc45a2e872ab7ad63ab7 100644 --- a/src/Tahoe/SDMF/Internal/Encrypting.hs +++ b/src/Tahoe/SDMF/Internal/Encrypting.hs @@ -1,3 +1,11 @@ module Tahoe.SDMF.Internal.Encrypting where -encrypt :: LB.ByteString -> LB.ByteString +import Crypto.Cipher.Types (ctrCombine) +import qualified Data.ByteString.Lazy as LB +import qualified Tahoe.SDMF.Internal.Keys as Keys + +encrypt :: Keys.Data -> Keys.SDMF_IV -> LB.ByteString -> LB.ByteString +encrypt Keys.Data{unData} (Keys.SDMF_IV iv) = LB.fromStrict . ctrCombine unData iv . LB.toStrict + +decrypt :: Keys.Data -> Keys.SDMF_IV -> LB.ByteString -> LB.ByteString +decrypt = encrypt diff --git a/src/Tahoe/SDMF/Internal/Keys.hs b/src/Tahoe/SDMF/Internal/Keys.hs index 29f38c6881086c25ab7b3467edd48298d9d77525..f82a31608eb0adc873e1cd70f902f5e4433e068b 100644 --- a/src/Tahoe/SDMF/Internal/Keys.hs +++ b/src/Tahoe/SDMF/Internal/Keys.hs @@ -8,7 +8,7 @@ import Prelude hiding (Read) import Control.Monad (when) import Crypto.Cipher.AES (AES128) -import Crypto.Cipher.Types (Cipher (cipherInit, cipherKeySize), IV, KeySizeSpecifier (KeySizeFixed)) +import Crypto.Cipher.Types (BlockCipher (ctrCombine), Cipher (cipherInit, cipherKeySize), IV, KeySizeSpecifier (KeySizeFixed), nullIV) import Crypto.Error (maybeCryptoError) import qualified Crypto.PubKey.RSA as RSA import Crypto.Random (MonadRandom) @@ -29,7 +29,15 @@ newtype KeyPair = KeyPair {toPrivateKey :: RSA.PrivateKey} deriving newtype (Sho toPublicKey :: KeyPair -> RSA.PublicKey toPublicKey = RSA.private_pub . toPrivateKey +toSignatureKey :: KeyPair -> Signature +toSignatureKey = Signature . toPrivateKey + +toVerificationKey :: KeyPair -> Verification +toVerificationKey = Verification . toPublicKey + newtype Verification = Verification {unVerification :: RSA.PublicKey} + deriving newtype (Eq, Show) + newtype Signature = Signature {unSignature :: RSA.PrivateKey} deriving newtype (Eq, Show) @@ -145,6 +153,18 @@ deriveWriteEnabler peerid (WriteEnablerMaster master) = WriteEnabler bs mutableWriteEnablerTag :: B.ByteString mutableWriteEnablerTag = "allmydata_mutable_write_enabler_master_and_nodeid_to_write_enabler_v1" +{- | Compute the verification key hash of the given verification key for + inclusion in an SDMF share. +-} +deriveVerificationHash :: Verification -> B.ByteString +deriveVerificationHash = taggedHash 32 mutableVerificationKeyHashTag . verificationKeyToBytes + +{- | The tag used when hashing the verification key to the verification key + hash for inclusion in SDMF shares. +-} +mutableVerificationKeyHashTag :: B.ByteString +mutableVerificationKeyHashTag = "allmydata_mutable_pubkey_to_fingerprint_v1" + {- | Encode a public key to the Tahoe-LAFS canonical bytes representation - X.509 SubjectPublicKeyInfo of the ASN.1 DER serialization of an RSA PublicKey. @@ -203,3 +223,7 @@ signatureKeyFromBytes bs = do case key of (PrivKeyRSA privKey) -> Right $ Signature privKey _ -> Left ("Expect RSA private key, found " <> show key) + +-- | Encrypt the signature key for inclusion in the SDMF share itself. +encryptSignatureKey :: Write -> Signature -> B.ByteString +encryptSignatureKey Write{unWrite} = ctrCombine unWrite nullIV . signatureKeyToBytes diff --git a/src/Tahoe/SDMF/Internal/Share.hs b/src/Tahoe/SDMF/Internal/Share.hs index e5862b476f763e1f190cceb91e649f9084bfb9b1..2931fce95fde6459eb6652a57236e33031b13ea3 100644 --- a/src/Tahoe/SDMF/Internal/Share.hs +++ b/src/Tahoe/SDMF/Internal/Share.hs @@ -2,8 +2,7 @@ module Tahoe.SDMF.Internal.Share where import Control.Monad (unless) -import Crypto.Cipher.AES (AES128) -import Crypto.Cipher.Types (IV, makeIV) +import Crypto.Cipher.Types (makeIV) import qualified Crypto.PubKey.RSA.Types as RSA import Data.ASN1.BinaryEncoding (DER (DER)) import Data.ASN1.Encoding (ASN1Encoding (encodeASN1), decodeASN1') @@ -17,7 +16,7 @@ import qualified Data.ByteString.Lazy as LB import Data.Word (Word16, Word64, Word8) import Data.X509 (PrivKey (PrivKeyRSA), PubKey (PubKeyRSA)) import Tahoe.CHK.Merkle (MerkleTree, leafHashes) -import Tahoe.SDMF.Internal.Keys (SDMF_IV (..)) +import qualified Tahoe.SDMF.Internal.Keys as Keys hashSize :: Int hashSize = 32 @@ -59,7 +58,7 @@ data Share = Share , -- | "R" (root of share hash merkle tree) shareRootHash :: B.ByteString , -- | The IV for encryption of share data. - shareIV :: SDMF_IV + shareIV :: Keys.SDMF_IV , -- | The total number of encoded shares (k). shareTotalShares :: Word8 , -- | The number of shares required for decoding (N). @@ -69,7 +68,7 @@ data Share = Share , -- | The length of the original plaintext. shareDataLength :: Word64 , -- | The 2048 bit "verification" RSA key. - shareVerificationKey :: RSA.PublicKey + shareVerificationKey :: Keys.Verification , -- | The RSA signature of -- H('\x00'+shareSequenceNumber+shareRootHash+shareIV+encoding -- parameters) where '\x00' gives the version of this share format (0) @@ -111,7 +110,7 @@ instance Binary Share where putLazyByteString shareData putByteString shareEncryptedPrivateKey where - verificationKeyBytes = verificationKeyToBytes shareVerificationKey + verificationKeyBytes = Keys.verificationKeyToBytes shareVerificationKey blockHashTreeBytes = B.concat . leafHashes $ shareBlockHashTree -- TODO Compute these from all the putting. @@ -129,7 +128,7 @@ instance Binary Share where shareRootHash <- getByteString 32 ivBytes <- getByteString 16 shareIV <- - SDMF_IV <$> case makeIV ivBytes of + Keys.SDMF_IV <$> case makeIV ivBytes of Nothing -> fail "Could not decode IV" Just iv -> pure iv @@ -145,7 +144,7 @@ instance Binary Share where eofOffset <- getWord64be pos <- bytesRead - shareVerificationKey <- isolate (fromIntegral signatureOffset - fromIntegral pos) getSubjectPublicKeyInfo + shareVerificationKey <- Keys.Verification <$> isolate (fromIntegral signatureOffset - fromIntegral pos) getSubjectPublicKeyInfo pos <- bytesRead shareSignature <- getByteString (fromIntegral hashChainOffset - fromIntegral pos) @@ -177,13 +176,6 @@ getSubjectPublicKeyInfo = do let (Right (PubKeyRSA pubKey, [])) = fromASN1 asn1s pure pubKey -{- | Encode a public key to the Tahoe-LAFS canonical bytes representation - - X.509 SubjectPublicKeyInfo of the ASN.1 DER serialization of an RSA - PublicKey. --} -verificationKeyToBytes :: RSA.PublicKey -> B.ByteString -verificationKeyToBytes = LB.toStrict . encodeASN1 DER . flip toASN1 [] . PubKeyRSA - {- | Encode a private key to the Tahoe-LAFS canonical bytes representation - X.509 SubjectPublicKeyInfo of the ASN.1 DER serialization of an RSA PublicKey. diff --git a/src/Tahoe/SDMF/Keys.hs b/src/Tahoe/SDMF/Keys.hs index 165915612de3689305539139b0c0e53807b323da..c9150e75dfd2f61f4edffdedbc9804622b8f1a8e 100644 --- a/src/Tahoe/SDMF/Keys.hs +++ b/src/Tahoe/SDMF/Keys.hs @@ -16,5 +16,6 @@ import Tahoe.SDMF.Internal.Keys ( deriveWriteEnabler, deriveWriteEnablerMaster, deriveWriteKey, - toPublicKey, + toSignatureKey, + toVerificationKey, ) diff --git a/tahoe-ssk.cabal b/tahoe-ssk.cabal index ed50a7cf520f56e797d624c81b281b09807c3531..7b9fa648fd8de6f57f48f6ccc33695a327619b11 100644 --- a/tahoe-ssk.cabal +++ b/tahoe-ssk.cabal @@ -66,6 +66,7 @@ library Tahoe.SDMF Tahoe.SDMF.Internal.Capability Tahoe.SDMF.Internal.Encoding + Tahoe.SDMF.Internal.Encrypting Tahoe.SDMF.Internal.Keys Tahoe.SDMF.Internal.Share Tahoe.SDMF.Keys diff --git a/test/Generators.hs b/test/Generators.hs index ba0fb89bac900c7a51a9cddc1470dc9ff0983c0c..4a84982b661eb9a1e65a8e855b245f2f3d84a584 100644 --- a/test/Generators.hs +++ b/test/Generators.hs @@ -47,7 +47,7 @@ shares = do <*> Gen.word8 Range.exponentialBounded -- shareRequiredShares <*> Gen.word64 Range.exponentialBounded -- shareSegmentSize <*> Gen.word64 Range.exponentialBounded -- shareDataLength - <*> pure (Keys.toPublicKey keypair) -- shareVerificationKey + <*> pure (Keys.toVerificationKey keypair) -- shareVerificationKey <*> Gen.bytes signatureLength -- shareSignature <*> shareHashChains -- shareHashChain <*> merkleTrees (Range.singleton 1) -- shareBlockHashTree diff --git a/test/Spec.hs b/test/Spec.hs index 4ae6646483d6669aa67152b97161606db031e110..df71c875c4f39c6e82dbc66b52bdd3df7324827b 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -11,6 +11,7 @@ import Hedgehog ( tripping, ) +import Control.Monad.IO.Class (liftIO) import Crypto.Cipher.Types (makeIV) import Data.ASN1.BinaryEncoding (DER (DER)) import Data.ASN1.Encoding (decodeASN1') @@ -153,15 +154,23 @@ tests = sequenceNumber <- forAll $ Gen.integral Range.exponentialBounded (required, total) <- forAll encodingParameters - (shares', Tahoe.SDMF.Writer{Tahoe.SDMF.writerReader}) <- Tahoe.SDMF.encode keypair sequenceNumber required total ciphertext + (shares', Tahoe.SDMF.Writer{Tahoe.SDMF.writerReader}) <- liftIO $ Tahoe.SDMF.encode keypair sequenceNumber required total ciphertext annotateShow shares' recovered <- Tahoe.SDMF.decode writerReader (zip [0 ..] shares') diff ciphertext (==) recovered - -- , testProperty "Plaintext round-trips through encrypt . decrypt" $ - -- property $ - -- do + , testProperty "Plaintext round-trips through encrypt . decrypt" $ + property $ + do + keypair <- forAll genRSAKeys + (Just iv) <- fmap Keys.SDMF_IV <$> (makeIV <$> forAll (Gen.bytes (Range.singleton 16))) + let (Just dataKey) = do + writeKey <- Keys.deriveWriteKey (Keys.toSignatureKey keypair) + readKey <- Keys.deriveReadKey writeKey + 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) ] {- | Load a known-correct SDMF bucket and assert that bytes in the slot it