diff --git a/src/Tahoe/SDMF/Internal/Keys.hs b/src/Tahoe/SDMF/Internal/Keys.hs new file mode 100644 index 0000000000000000000000000000000000000000..40ab74034f3fd03a7bd005c7b8740122558e61f3 --- /dev/null +++ b/src/Tahoe/SDMF/Internal/Keys.hs @@ -0,0 +1,111 @@ +-- | Key types, derivations, and related functionality for SDMF. +module Tahoe.SDMF.Internal.Keys where + +import Prelude hiding (Read) + +import Crypto.Cipher.AES (AES128) +import Crypto.Cipher.Types (Cipher (cipherInit, cipherKeySize), IV, KeySizeSpecifier (KeySizeFixed)) +import Crypto.Error (maybeCryptoError) +import qualified Crypto.PubKey.RSA as RSA +import Crypto.Random (MonadRandom) +import Data.ASN1.BinaryEncoding (DER (DER)) +import Data.ASN1.Encoding (ASN1Encoding (encodeASN1)) +import Data.ASN1.Types (ASN1Object (toASN1)) +import qualified Data.ByteArray as ByteArray +import qualified Data.ByteString as B +import Data.ByteString.Base32 (encodeBase32Unpadded) +import qualified Data.ByteString.Lazy as LB +import qualified Data.Text as T +import Data.X509 (PrivKey (PrivKeyRSA), PubKey (PubKeyRSA)) +import Tahoe.CHK.Crypto (taggedHash, taggedPairHash) +import Tahoe.CHK.Server (StorageServerID) + +newtype KeyPair = KeyPair {toPrivateKey :: RSA.PrivateKey} + +toPublicKey :: KeyPair -> RSA.PublicKey +toPublicKey = RSA.private_pub . toPrivateKey + +newtype Verification = Verification {unVerification :: RSA.PublicKey} +newtype Signature = Signature {unSignature :: RSA.PrivateKey} +data Write = Write {unWrite :: AES128, writeKeyBytes :: ByteArray.ScrubbedBytes} +data Read = Read {unRead :: AES128, readKeyBytes :: ByteArray.ScrubbedBytes} +newtype StorageIndex = StorageIndex {unStorageIndex :: B.ByteString} + +newtype WriteEnablerMaster = WriteEnablerMaster B.ByteString +data WriteEnabler = WriteEnabler StorageServerID B.ByteString + +data Data = Data {unData :: AES128, dataKeyBytes :: ByteArray.ScrubbedBytes} + +newtype SDMF_IV = SDMF_IV (IV AES128) + deriving (Eq) + deriving newtype (ByteArray.ByteArrayAccess) + +instance Show SDMF_IV where + show (SDMF_IV iv) = T.unpack . T.toLower . encodeBase32Unpadded . ByteArray.convert $ iv + +-- | The size of the public/private key pair to generate. +keyPairBits :: Int +keyPairBits = 2048 + +keyLength :: Int +(KeySizeFixed keyLength) = cipherKeySize (undefined :: AES128) + +{- | Create a new, random key pair (public/private aka verification/signature) + of the appropriate type and size for SDMF encryption. +-} +newKeyPair :: MonadRandom m => m KeyPair +newKeyPair = do + (_, priv) <- RSA.generate keyPairBits e + pure $ KeyPair priv + where + e = 0x10001 + +-- | Compute the write key for a given signature key for an SDMF share. +deriveWriteKey :: Signature -> Maybe Write +deriveWriteKey s = + Write <$> key <*> pure (ByteArray.convert sbs) + where + sbs = taggedHash keyLength mutableWriteKeyTag . signatureKeyToBytes $ s + key = maybeCryptoError . cipherInit $ sbs + +mutableWriteKeyTag :: B.ByteString +mutableWriteKeyTag = "allmydata_mutable_privkey_to_writekey_v1" + +-- | Compute the read key for a given write key for an SDMF share. +deriveReadKey :: Write -> Maybe Read +deriveReadKey w = + Read <$> key <*> pure sbs + where + sbs = writeKeyBytes w + key = maybeCryptoError . cipherInit . taggedHash keyLength mutableReadKeyTag . ByteArray.convert $ sbs + +mutableReadKeyTag :: B.ByteString +mutableReadKeyTag = "allmydata_mutable_writekey_to_readkey_v1" + +-- | Compute the data encryption/decryption key for a given read key for an SDMF share. +deriveDataKey :: SDMF_IV -> Read -> Maybe Data +deriveDataKey (SDMF_IV iv) r = + Data <$> key <*> pure sbs + where + sbs = readKeyBytes r + key = maybeCryptoError . cipherInit . taggedPairHash keyLength mutableDataKeyTag (B.pack . ByteArray.unpack $ iv) . ByteArray.convert $ sbs + +mutableDataKeyTag :: B.ByteString +mutableDataKeyTag = "allmydata_mutable_readkey_to_datakey_v1" + +mutableStorageIndexTag :: B.ByteString +mutableStorageIndexTag = "allmydata_mutable_readkey_to_storage_index_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. +-} +verificationKeyToBytes :: Verification -> B.ByteString +verificationKeyToBytes = LB.toStrict . encodeASN1 DER . flip toASN1 [] . PubKeyRSA . unVerification + +{- | Encode a private key to the Tahoe-LAFS canonical bytes representation - + X.509 SubjectPublicKeyInfo of the ASN.1 DER serialization of an RSA + PublicKey. +-} +signatureKeyToBytes :: Signature -> B.ByteString +signatureKeyToBytes = LB.toStrict . encodeASN1 DER . flip toASN1 [] . PrivKeyRSA . unSignature diff --git a/src/Tahoe/SDMF/Internal/Share.hs b/src/Tahoe/SDMF/Internal/Share.hs index e5bad8830d3d697073ce1a1c0f4cf4f30f44b7c5..8d90b2aaf21576cde2a5d9116c1342187b0e4aeb 100644 --- a/src/Tahoe/SDMF/Internal/Share.hs +++ b/src/Tahoe/SDMF/Internal/Share.hs @@ -3,8 +3,7 @@ module Tahoe.SDMF.Internal.Share where import Control.Monad (unless) import Crypto.Cipher.AES (AES128) -import Crypto.Cipher.Types (Cipher (cipherInit), IV, makeIV) -import Crypto.Error (maybeCryptoError) +import Crypto.Cipher.Types (IV, makeIV) import qualified Crypto.PubKey.RSA.Types as RSA import Data.ASN1.BinaryEncoding (DER (DER)) import Data.ASN1.Encoding (ASN1Encoding (encodeASN1), decodeASN1') @@ -14,12 +13,11 @@ import Data.Binary.Get (bytesRead, getByteString, getLazyByteString, getRemainin import Data.Binary.Put (putByteString, putLazyByteString, putWord16be, putWord32be, putWord64be, putWord8) import qualified Data.ByteArray as ByteArray import qualified Data.ByteString as B -import Data.ByteString.Base32 (encodeBase32Unpadded) import qualified Data.ByteString.Lazy as LB -import qualified Data.Text as T import Data.Word (Word16, Word64, Word8) import Data.X509 (PubKey (PubKeyRSA)) import Tahoe.CHK.Merkle (MerkleTree, leafHashes) +import Tahoe.SDMF.Internal.Keys (SDMF_IV (..)) hashSize :: Int hashSize = 32 @@ -90,13 +88,6 @@ data Share = Share } deriving (Eq, Show) -newtype SDMF_IV = SDMF_IV (IV AES128) - deriving (Eq) - deriving newtype (ByteArray.ByteArrayAccess) - -instance Show SDMF_IV where - show (SDMF_IV iv) = T.unpack . T.toLower . encodeBase32Unpadded . ByteArray.convert $ iv - instance Binary Share where put Share{..} = do putWord8 0 diff --git a/src/Tahoe/SDMF/Keys.hs b/src/Tahoe/SDMF/Keys.hs new file mode 100644 index 0000000000000000000000000000000000000000..f5ba4ce1f1e5bb8d6a7a7a19e59e2cefb847a188 --- /dev/null +++ b/src/Tahoe/SDMF/Keys.hs @@ -0,0 +1,14 @@ +module Tahoe.SDMF.Keys (module Tahoe.SDMF.Internal.Keys) where + +import Tahoe.SDMF.Internal.Keys ( + Data (..), + KeyPair (..), + Read (..), + SDMF_IV (..), + Signature (..), + Write (..), + deriveDataKey, + deriveReadKey, + deriveWriteKey, + toPublicKey, + ) diff --git a/tahoe-ssk.cabal b/tahoe-ssk.cabal index 470d125134527d3a4445321daf0d2105c5e994b5..d25963a529aabf8d749de048332476419d22e7a6 100644 --- a/tahoe-ssk.cabal +++ b/tahoe-ssk.cabal @@ -1,4 +1,4 @@ -cabal-version: 2.4 +cabal-version: 2.4 -- The cabal-version field refers to the version of the .cabal specification, -- and can be different from the cabal-install (the tool) version and the @@ -12,7 +12,7 @@ cabal-version: 2.4 -- http://haskell.org/cabal/users-guide/ -- -- The name of the package. -name: tahoe-ssk +name: tahoe-ssk -- The package version. -- See the Haskell package versioning policy (PVP) for standards @@ -21,7 +21,7 @@ name: tahoe-ssk -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.1.0.0 +version: 0.1.0.0 -- A short (one-line) description of the package. synopsis: @@ -31,30 +31,31 @@ synopsis: -- description: -- URL for the project homepage or repository. -homepage: https://whetstone.private.storage/PrivateStorage/tahoe-ssk +homepage: https://whetstone.private.storage/PrivateStorage/tahoe-ssk -- The license under which the package is released. -license: BSD-3-Clause +license: BSD-3-Clause -- The file containing the license text. -license-file: LICENSE +license-file: LICENSE -- The package author(s). -author: Jean-Paul Calderone +author: Jean-Paul Calderone -- An email address to which users can send suggestions, bug reports, and patches. -maintainer: jean-paul@private.storage +maintainer: jean-paul@private.storage -- A copyright notice. -- copyright: -category: Cryptography,Library,Parsers,Security -build-type: Simple +category: Cryptography,Library,Parsers,Security +build-type: Simple -- Extra doc files to be distributed with the package, such as a CHANGELOG or a README. -extra-doc-files: CHANGELOG.md +extra-doc-files: CHANGELOG.md --- Extra source files to be distributed with the package, such as examples, or a tutorial module. --- extra-source-files: +-- Extra source files to be distributed with the package, such as examples, or +-- a tutorial module. In our case, test data. +extra-source-files: test/data/* common warnings ghc-options: -Wall @@ -63,7 +64,9 @@ library hs-source-dirs: src exposed-modules: Tahoe.SDMF + Tahoe.SDMF.Internal.Keys Tahoe.SDMF.Internal.Share + Tahoe.SDMF.Keys build-depends: , asn1-encoding @@ -120,15 +123,18 @@ test-suite tahoe-ssk-test , asn1-encoding , asn1-types , base ^>=4.14.3.0 + , base32 , binary , bytestring , cryptonite , hedgehog + , memory , tahoe-chk , tahoe-ssk , tasty , tasty-hedgehog , tasty-hunit + , text , x509 -- A helper for generating RSA key pairs for use by the test suite. diff --git a/test/Generators.hs b/test/Generators.hs index b43ea31047f9407fb1ef78b29c3040f191aff917..21bee5bb4b2c369d5f52d99e48feecb242cecbdb 100644 --- a/test/Generators.hs +++ b/test/Generators.hs @@ -3,7 +3,6 @@ module Generators where import Crypto.Cipher.Types (makeIV) import Crypto.Hash (HashAlgorithm (hashDigestSize)) import Crypto.Hash.Algorithms (SHA256 (SHA256)) -import qualified Crypto.PubKey.RSA as RSA import Data.ASN1.BinaryEncoding (DER (DER)) import Data.ASN1.Encoding (ASN1Decoding (decodeASN1), ASN1Encoding (encodeASN1)) import Data.ASN1.Types (ASN1Object (fromASN1, toASN1)) @@ -16,8 +15,9 @@ import Hedgehog (MonadGen) import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import Tahoe.CHK.Merkle (MerkleTree (..), makeTreePartial) -import Tahoe.SDMF (KeyPair (..), Share (..), toPublicKey) -import Tahoe.SDMF.Internal.Share (HashChain (HashChain), SDMF_IV (SDMF_IV)) +import Tahoe.SDMF (Share (..)) +import Tahoe.SDMF.Internal.Share (HashChain (HashChain)) +import qualified Tahoe.SDMF.Keys as Keys rootHashLength :: Int rootHashLength = 32 @@ -41,17 +41,17 @@ shares = do Share <$> Gen.word64 Range.exponentialBounded -- shareSequenceNumber <*> Gen.bytes (Range.singleton rootHashLength) -- shareRootHash - <*> pure (SDMF_IV iv') -- shareIV + <*> pure (Keys.SDMF_IV iv') -- shareIV <*> Gen.word8 Range.exponentialBounded -- shareTotalShares <*> Gen.word8 Range.exponentialBounded -- shareRequiredShares <*> Gen.word64 Range.exponentialBounded -- shareSegmentSize <*> Gen.word64 Range.exponentialBounded -- shareDataLength - <*> pure (toPublicKey keypair) -- shareVerificationKey + <*> pure (Keys.toPublicKey keypair) -- shareVerificationKey <*> Gen.bytes signatureLength -- shareSignature <*> shareHashChains -- shareHashChain <*> merkleTrees (Range.singleton 1) -- shareBlockHashTree <*> (LB.fromStrict <$> Gen.bytes (Range.exponential 0 1024)) -- shareData - <*> (pure . LB.toStrict . toDER . PrivKeyRSA . toPrivateKey) keypair -- shareEncryptedPrivateKey + <*> (pure . LB.toStrict . toDER . PrivKeyRSA . Keys.toPrivateKey) keypair -- shareEncryptedPrivateKey where toDER = encodeASN1 DER . flip toASN1 [] @@ -63,7 +63,7 @@ shares = do challenging, this implementation just knows a few RSA key pairs already and will give back one of them. -} -genRSAKeys :: MonadGen m => m KeyPair +genRSAKeys :: MonadGen m => m Keys.KeyPair genRSAKeys = Gen.element (map rsaKeyPair rsaKeyPairBytes) -- I'm not sure how to do IO in MonadGen so do the IO up front unsafely (but @@ -72,13 +72,13 @@ rsaKeyPairBytes :: [LB.ByteString] {-# NOINLINE rsaKeyPairBytes #-} rsaKeyPairBytes = unsafePerformIO $ mapM (\n -> LB.readFile ("test/data/rsa-privkey-" <> show n <> ".der")) [0 .. 4 :: Int] -rsaKeyPair :: LB.ByteString -> KeyPair +rsaKeyPair :: LB.ByteString -> Keys.KeyPair rsaKeyPair bs = do let (Right kp) = do asn1s <- first show (decodeASN1 DER bs) (r, _) <- fromASN1 asn1s case r of - PrivKeyRSA pk -> pure $ KeyPair pk + PrivKeyRSA pk -> pure $ Keys.KeyPair pk _ -> error "Expected RSA Private Key" kp diff --git a/test/Spec.hs b/test/Spec.hs index 98914dd558e645bf065f40a11f6e8d49e9212e4d..4031d0cfd4382a4b948a1b676cc8c4b9f66374ee 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -6,16 +6,30 @@ import Hedgehog ( tripping, ) +import Crypto.Cipher.Types (makeIV) +import Data.ASN1.BinaryEncoding (DER (DER)) +import Data.ASN1.Encoding (decodeASN1') +import Data.ASN1.Types (ASN1Object (fromASN1)) 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 qualified Data.ByteString.Lazy as LB +import qualified Data.Text as T +import Data.X509 (PrivKey (PrivKeyRSA)) import Generators (shareHashChains, shares) import System.IO (hSetEncoding, stderr, stdout, utf8) import Tahoe.SDMF (Share) +import qualified Tahoe.SDMF.Keys as Keys import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit (assertEqual, testCase) import Test.Tasty.Hedgehog (testProperty) +-- The test suite compares against some hard-coded opaque strings. These +-- expected values were determined using the expected_values.py program in +-- this directory. + tests :: TestTree tests = testGroup @@ -24,6 +38,42 @@ tests = property $ do hashChain <- forAll shareHashChains tripping hashChain Binary.encode decode' + , testCase "derived keys equal known-correct values" $ + -- The path is relative to the root of the package, which is where + -- at least some test runners will run the test process. If + B.readFile "test/data/rsa-privkey-0.der" >>= \privBytes -> + let (Just iv) = Keys.SDMF_IV <$> makeIV (B.replicate 16 0x42) + expectedWriteKey = ("ae6e6cgcllhty4z5l4dp5v7gee" :: T.Text) + expectedReadKey = ("rbx5xh5rztefvazy7sq32sw34y" :: T.Text) + expectedDataKey = ("4ay4y6itvk7cvynpyok3qmxf5y" :: T.Text) + + (Right asn1s) = decodeASN1' DER privBytes + (Right (PrivKeyRSA privKey, [])) = fromASN1 asn1s + (Just w@(Keys.Write _ derivedWriteKey)) = Keys.deriveWriteKey (Keys.Signature privKey) + (Just r@(Keys.Read _ derivedReadKey)) = Keys.deriveReadKey w + (Just d@(Keys.Data _ derivedDataKey)) = Keys.deriveDataKey iv r + + -- Format a key as text for convenient comparison to + -- expected value. + fmtKey = T.toLower . encodeBase32Unpadded . ByteArray.convert + in do + -- In general it might make more sense to convert expected + -- into ScrubbedBytes instead of converting derived into + -- ByteString but ScrubbedBytes doesn't have a useful Show + -- instance so we go the other way. We're not worried about + -- the safety of these test-only keys anyway. + assertEqual + "expected writekey /= derived writekey" + expectedWriteKey + (fmtKey derivedWriteKey) + assertEqual + "expected readkey /= derived readkey" + expectedReadKey + (fmtKey derivedReadKey) + assertEqual + "expected datakey /= derived datakey" + expectedDataKey + (fmtKey derivedDataKey) , testProperty "Share round-trips through bytes" $ property $ do share <- forAll shares diff --git a/test/expected_values.py b/test/expected_values.py new file mode 100644 index 0000000000000000000000000000000000000000..b0be5c977bbcd47755c4d456cc2d347ac20e2253 --- /dev/null +++ b/test/expected_values.py @@ -0,0 +1,24 @@ +# Tested on Python 3.9.15 against Tahoe-LAFS bc79cf0a11f06bbdc02a5bb41c6f41fcff727ea5 +# + +from allmydata.crypto import rsa +from allmydata.mutable.common import derive_mutable_keys +from allmydata.util import base32 +from allmydata.util.hashutil import ssk_readkey_hash, ssk_readkey_data_hash + +# Arbitrarily select an IV. +iv = b"\x42" * 16 + +with open("data/rsa-privkey-0.der", "rb") as f: + (priv, pub) = rsa.create_signing_keypair_from_string(f.read()) + +writekey, encprivkey, fingerprint = derive_mutable_keys((pub, priv)) +readkey = ssk_readkey_hash(writekey) +datakey = ssk_readkey_data_hash(iv, readkey) + +print("SDMF") +print("writekey: ", base32.b2a(writekey)) +print("readkey: ", base32.b2a(readkey)) +print("datakey: ", base32.b2a(datakey)) +print("encrypted private key: ", base32.b2a(encprivkey)) +print("signature key hash: ", base32.b2a(fingerprint))