tahoe-ssk (empty) → 0.2.1.0

raw patch · 33 files changed

+1921/−0 lines, 33 filesdep +asn1-encodingdep +asn1-typesdep +basebinary-added

Dependencies added: asn1-encoding, asn1-types, base, base32, binary, bytestring, cereal, containers, cryptonite, hedgehog, megaparsec, memory, tahoe-capabilities, tahoe-chk, tahoe-ssk, tasty, tasty-hedgehog, tasty-hunit, text, x509

Files

CHANGELOG.md +19/−0
LICENSE +31/−0
README.md +108/−0
encode-ssk/Main.hs +30/−0
make-keypairs/Main.hs +30/−0
src/Tahoe/SDMF.hs +31/−0
src/Tahoe/SDMF/Internal/Capability.hs +217/−0
src/Tahoe/SDMF/Internal/Converting.hs +97/−0
src/Tahoe/SDMF/Internal/Encoding.hs +137/−0
src/Tahoe/SDMF/Internal/Encrypting.hs +44/−0
src/Tahoe/SDMF/Internal/Keys.hs +305/−0
src/Tahoe/SDMF/Internal/Share.hs +214/−0
src/Tahoe/SDMF/Keys.hs +21/−0
tahoe-ssk.cabal +210/−0
test/Generators.hs +148/−0
test/Main.hs +3/−0
test/Spec.hs +276/−0
test/data/3of10.0 binary
test/data/3of10.1 binary
test/data/3of10.2 binary
test/data/3of10.3 binary
test/data/3of10.4 binary
test/data/3of10.5 binary
test/data/3of10.6 binary
test/data/3of10.7 binary
test/data/3of10.8 binary
test/data/3of10.9 binary
test/data/rsa-privkey-0.der binary
test/data/rsa-privkey-1.der binary
test/data/rsa-privkey-2.der binary
test/data/rsa-privkey-3.der binary
test/data/rsa-privkey-4.der binary
test/data/tahoe-lafs-generated-rsa-privkey.der binary

+ CHANGELOG.md view

@@ -0,0 +1,19 @@+# Changelog for tahoe-ssk++## 0.2.1.0++* Add Ord instances for StorageIndex, Verifier, Reader, and Writer.+* Add ConfidentialShowable instances for SDMF, Verifier, Reader, and Writer.+* Deprecate dangerRealShow.++## 0.2.0.0++* Add the IV as a parameter to Tahoe.SDMF.encode.+  The IV must be the value used to create the ciphertext so Tahoe.SDMF.encode cannot randomly generate one.+* Add Tahoe.SDMF.randomIV for randomly generating a new IV.++## 0.1.0.0++* Initial release.+* Very basic non-verifying decoding support.+* Enough encoding support for simple round-trip tests for the decoding functionality.

+ LICENSE view

@@ -0,0 +1,31 @@+Copyright 2023+Jean-Paul Calderone++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Jean-Paul Calderone nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,108 @@+# tahoe-ssk++## What is it?++Tahoe-SSK is a Haskell implementation of the [Tahoe-LAFS](https://tahoe-lafs.org/) SSK crytographic protocols.+This includes (S)mall (D)istributed (M)utable (F)iles (SDMF) and (M)edium (D)istributed (M)utable (F)iles (MDMF).+It aims for bit-for-bit compatibility with the original Python implementation.++It will not include an implementation of any network protocol for transferring SSK shares.+However, its APIs are intended to be easy to integrate with such an implementation.++### What is the current state?++* SDMF write, read, and verify capabilities can be parsed and serialized.+* SDMF shares can be deserialized, decoded, and decrypted.+  * The cryptographic integrity and authenticity is not verified.+* Plaintext can be encrypted, encoded into shares, and the shares serialized to bytes.+  * Not all fields of the shares contain correctly initialized values.+  * Enough fields are correctly populated to recover the original plaintext.++## Why does it exist?++A Haskell implementation can be used in places the original Python implementation cannot be+(for example, runtime environments where it is difficult to have a Python interpreter).+Additionally,+with the benefit of the experience gained from creating and maintaining the Python implementation,+a number of implementation decisions can be made differently to produce a more efficient, more flexible, simpler implementation and API.+Also,+the Python implementation claims no public library API for users outside of the Tahoe-LAFS project itself.++## Cryptographic Library Choice++This library uses cryptonite for cryptography,+motivated by the following considerations.++SDMF uses+* SHA256 for tagged hashes for key derivation and for integrity (XXX right word?) checks on some data.+* AES128 for encryption of the signature key and the application plaintext data.+* RSA for signatures proving write authority.++There are a number of Haskell libraries that provide all of these:++* Crypto+  * Does not support the AES mode we require (CTR).++* HsOpenSSL+  * Bindings to a C library, OpenSSL, which may complicate the build process.+  * OpenSSL's security and reliability track record also leaves something to be desired.++* cryptonite+  * Has all of the primitive cryptographic functionality we need.++We want a library that:++* Can be used with reflex-platform+  * ghc 8.6.5 compatible+* Can be cross-compiled to different targets from x86_64-linux+  * Mainly armeabi and armv7+* Is suitable for real-world security purposes+  * not a demo or a toy library+    * documents its limitations+  * is well-tested+  * avoids real-world pitfalls (side-channel attacks, etc), not just textbook issues+  * has more than a handful of other users+  * is well-maintained+    * developers are responsive to security reports+    * has a channel for security-related disclosures+	* has sound documentation for proper, safe usage++And,+of course,+implements the required functionality.++### SHA256++There are a number of Haskell libraries that provide this primitive:++* Crypto+* HsOpenSSL+* SHA+* cryptohash+* cryptonite+* dhall+* hashing+* nettle+* sbv+* tls++### AES128++* Crypto+* HsOpenSSL+* cipher-aes+* cipher-aes128+* crypto+* cryptocipher+* cryptonite+* cryptostore+* nettle++### RSA++SDMF depends on RSA for signatures proving write authority.++* Crypto+* HsOpenSSL+* RSA+* cryptonite

+ encode-ssk/Main.hs view

@@ -0,0 +1,30 @@+module Main where++import qualified Crypto.PubKey.RSA as RSA+import Data.Binary (encode)+import Data.ByteString.Base32 (encodeBase32Unpadded)+import qualified Data.ByteString.Lazy as LB+import qualified Data.Text as T+import qualified Data.Text.IO as T+import System.IO (stdin)+import Tahoe.Capability (confidentiallyShow)+import qualified Tahoe.SDMF as SDMF+import qualified Tahoe.SDMF.Keys as SDMF.Keys++main :: IO ()+main = do+    plaintext <- LB.hGetContents stdin+    keypair <- SDMF.Keys.KeyPair . snd <$> RSA.generate (2048 `div` 8) e+    Just iv <- SDMF.randomIV++    let ciphertext = SDMF.encrypt keypair iv plaintext+    (shares, writeCap) <- SDMF.encode keypair iv 1 3 5 ciphertext+    let shareBytes = encode <$> shares++    let si = SDMF.Keys.unStorageIndex . SDMF.verifierStorageIndex . SDMF.readerVerifier . SDMF.writerReader $ writeCap++    mapM_ (uncurry (writeShare si)) (zip [0 :: Int ..] shareBytes)+    T.putStrLn $ confidentiallyShow writeCap+  where+    e = 0x10001+    writeShare si shnum = LB.writeFile $ (T.unpack . T.toLower . encodeBase32Unpadded $ si) <> "." <> show shnum

+ make-keypairs/Main.hs view

@@ -0,0 +1,30 @@+module Main where++import qualified Crypto.PubKey.RSA as RSA+import qualified Data.ByteString as B+import Tahoe.SDMF.Internal.Keys (signatureKeyToBytes)+import Tahoe.SDMF.Keys (Signature (..))++-- | The size of the keys to generate.+bits :: Int+bits = 2048++-- | The number of keys to generate.+count :: Int+count = 5++main :: IO ()+main = do+    mapM_ genKey [0 .. count - 1]++genKey :: Show a => a -> IO ()+genKey n = do+    print "Generating RSA key..."+    (_, priv) <- RSA.generate (bits `div` 8) e+    print $ "Serializing key " <> show n+    let bytes = signatureKeyToBytes (Signature priv)+    print $ "Generated them (" <> show (B.length bytes) <> " bytes)"+    B.writeFile ("test/data/rsa-privkey-" <> show n <> ".der") bytes+    print "Wrote them to the file."+  where+    e = 0x10001

+ src/Tahoe/SDMF.hs view

@@ -0,0 +1,31 @@+-- | Expose the library's public interface.+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 (+    Reader (..),+    SDMF (..),+    Verifier (..),+    Writer (..),+    dangerRealShow,+    pCapability,+    pReader,+    pVerifier,+    pWriter,+ )+import Tahoe.SDMF.Internal.Encoding (+    decode,+    encode,+ )+import Tahoe.SDMF.Internal.Encrypting (+    decrypt,+    encrypt,+    randomIV,+ )+import Tahoe.SDMF.Internal.Share (+    Share (..),+ )

+ src/Tahoe/SDMF/Internal/Capability.hs view

@@ -0,0 +1,217 @@+-- | Structured representations of SDMF capabilities.+module Tahoe.SDMF.Internal.Capability where++import Prelude hiding (Read)++import Control.Applicative ((<|>))+import Control.Monad (void)+import Crypto.Hash (Digest, SHA256, digestFromByteString)+import Data.Binary (decode)+import qualified Data.ByteArray as ByteArray+import qualified Data.ByteString as B+import qualified Data.ByteString.Base32 as B+import qualified Data.ByteString.Lazy as LB+import qualified Data.Set as Set+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Data.Void (Void)+import Data.Word (Word16)+import Tahoe.Capability (ConfidentialShowable (..))+import Tahoe.SDMF.Internal.Keys (+    Read (readKeyBytes),+    StorageIndex (StorageIndex, unStorageIndex),+    Write (writeKeyBytes),+    deriveReadKey,+    deriveStorageIndex,+    readKeyBytes,+    showBase32,+ )+import Text.Megaparsec (+    ErrorFancy (ErrorFail),+    Parsec,+    count,+    failure,+    fancyFailure,+    oneOf,+ )+import Text.Megaparsec.Char (char, string)++-- | Any kind of SDMF capability.+data SDMF+    = SDMFVerifier Verifier+    | SDMFReader Reader+    | SDMFWriter Writer+    deriving (Eq, Show)++instance ConfidentialShowable SDMF where+    confidentiallyShow = dangerRealShow++-- | A verify capability for an SDMF object.+data Verifier = Verifier+    { verifierStorageIndex :: StorageIndex+    , verifierVerificationKeyHash :: Digest SHA256+    }+    deriving (Eq, Show)++instance Ord Verifier where+    a <= b = verifierStorageIndex a <= verifierStorageIndex b++instance ConfidentialShowable Verifier where+    confidentiallyShow = dangerRealShow . SDMFVerifier++-- | A read capability for an SDMF object.+data Reader = Reader+    { readerReadKey :: Read+    , readerVerifier :: Verifier+    }+    deriving (Eq, Show)++instance Ord Reader where+    a <= b = readerVerifier a <= readerVerifier b++instance ConfidentialShowable Reader where+    confidentiallyShow = dangerRealShow . SDMFReader++-- | A write capability for an SDMF object.+data Writer = Writer+    { writerWriteKey :: Write+    , writerReader :: Reader+    }+    deriving (Eq, Show)++instance Ord Writer where+    a <= b = writerReader a <= writerReader b++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 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 readKey = Verifier storageIndex+  where+    storageIndex = deriveStorageIndex readKey++type Parser = Parsec Void T.Text++-- | A parser for any kind of SDMF capability type.+pCapability :: Parser SDMF+pCapability = (SDMFVerifier <$> pVerifier) <|> (SDMFReader <$> pReader) <|> (SDMFWriter <$> pWriter)++-- | A parser for an SDMF verifier capability.+pVerifier :: Parser Verifier+pVerifier = uncurry Verifier <$> pPieces "URI:SSK-Verifier:" StorageIndex++-- | A parser for an SDMF reader capability.+pReader :: Parser Reader+pReader = do+    (readKey, verificationKeyHash) <- pPieces "URI:SSK-RO:" (decode . LB.fromStrict)+    let verifier = deriveVerifier readKey verificationKeyHash+    pure $ Reader readKey verifier++-- | A parser for an SDMF writer capability.+pWriter :: Parser Writer+pWriter = do+    (writeKey, verificationKeyHash) <- pPieces "URI:SSK:" (decode . LB.fromStrict)+    let reader = deriveReader writeKey verificationKeyHash+    case Writer writeKey <$> reader of+        Nothing -> failure Nothing mempty+        Just writer -> pure writer++{- | A parser for two base32-encoded bytestrings with some given prefix,+ formatted as they are in the string representation of an SDMF capability.+-}+pPieces ::+    -- | The prefix to expect.+    T.Text ->+    -- | 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)+pPieces prefix convertSecret = do+    void $ string prefix+    secret <- convertSecret <$> pBase32 rfc3548Alphabet 128+    void $ char ':'+    digestBytes <- pBase32 rfc3548Alphabet 256+    case digestFromByteString digestBytes of+        Nothing -> failure Nothing mempty+        Just verificationKeyHash ->+            pure (secret, verificationKeyHash)++{- | A parser combinator for an arbitrary byte string of a fixed length,+ encoded using base32.++ TODO: Avoid duplicating this implementation here and in tahoe-chk.+-}+pBase32 ::+    -- | The alphabet to use.  For example, *rfc3548Alphabet*.+    [Char] ->+    -- | The number of bits in the encoded byte string.+    Word16 ->+    -- | A parser for the byte string.  Strings that are not valid base32 will+    -- be rejected.  Strings that are the wrong length are *not necessarily*+    -- currently rejected!  Please fix that, somebody.+    Parser B.ByteString+pBase32 alpha bits = do+    b32Text <- pBase32Text+    either (fancyFailure . Set.singleton . ErrorFail . T.unpack) pure (decodeBase32Text b32Text)+  where+    decodeBase32Text = B.decodeBase32Unpadded . T.encodeUtf8+    pBase32Text = T.snoc <$> stem <*> trailer++    -- Determine how many full characters to expect along with how many bits+    -- are left to expect encoded in the final character.+    (full, extra) = bits `divMod` 5++    -- Match the base32 characters that represent the full 5 bits+    -- possible.  fromIntegral is okay here because `full` is only a+    -- Word16 and will definitely fit safely into the Int count wants.+    stem :: Parser T.Text+    stem = T.pack <$> count (fromIntegral full) (oneOf alpha)++    -- Match the final character that represents fewer than 5 bits.+    trailer :: Parser Char+    trailer = oneOf $ trailingChars alpha extra++    -- XXX The real trailing character set is smaller than this.  This+    -- parser will let through invalid characters that result in giving us+    -- possibly too many bits.+    trailingChars :: [Char] -> Word16 -> [Char]+    trailingChars alpha' _ = alpha'++{- | The RFC3548 standard alphabet used by Gnutella, Content-Addressable Web,+ THEX, Bitzi, Web-Calculus...+-}+rfc3548Alphabet :: [Char]+rfc3548Alphabet = "abcdefghijklmnopqrstuvwxyz234567"++-- | Show an SDMF capability, including all secret information.+{-# DEPRECATED dangerRealShow "Use the ConfidentialShowable instance" #-}+dangerRealShow :: SDMF -> T.Text+dangerRealShow (SDMFVerifier Verifier{verifierStorageIndex, verifierVerificationKeyHash}) =+    T.concat+        [ "URI:SSK-Verifier:"+        , showBase32 . unStorageIndex $ verifierStorageIndex+        , ":"+        , showBase32 . ByteArray.convert $ verifierVerificationKeyHash+        ]+dangerRealShow (SDMFReader Reader{readerReadKey, readerVerifier}) =+    T.concat+        [ "URI:SSK-RO:"+        , showBase32 . ByteArray.convert . readKeyBytes $ readerReadKey+        , ":"+        , showBase32 . ByteArray.convert . verifierVerificationKeyHash $ readerVerifier+        ]+dangerRealShow (SDMFWriter Writer{writerWriteKey, writerReader}) =+    T.concat+        [ "URI:SSK:"+        , showBase32 . ByteArray.convert . writeKeyBytes $ writerWriteKey+        , ":"+        , showBase32 . ByteArray.convert . verifierVerificationKeyHash . readerVerifier $ writerReader+        ]

+ src/Tahoe/SDMF/Internal/Converting.hs view

@@ -0,0 +1,97 @@+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++{- | Conversion between types with a known level of safety.  *Heavily* inspired+ by `witch` (which has dependencies that make it hard for us to use just yet).+-}+module Tahoe.SDMF.Internal.Converting where++import Control.Monad.Fail (MonadFail)+import Data.Int (Int64)+import Data.Word (Word16, Word32, Word64, Word8)++-- | Precise, infallible conversion between two types.+class From a b where+    from :: a -> b++-- | Precise, fallible conversion between two types.+class TryFrom a b m where+    tryFrom ::+        -- | An error message for context if the conversion fails.+        String ->+        -- | The value to convert.+        a ->+        m b++instance MonadFail m => TryFrom Int Word32 m where+    tryFrom msg n+        | n < 0 = fail msg+        | n > maxWord32 = fail msg+        | otherwise = pure $ fromIntegral n+      where+        maxWord32 = from @Word32 @Int maxBound++instance MonadFail m => TryFrom Int Word64 m where+    tryFrom msg n+        | n < 0 = fail msg+        | otherwise = pure $ fromIntegral n++instance MonadFail m => TryFrom Int64 Word64 m where+    tryFrom msg n+        | n < 0 = fail msg+        | otherwise = pure $ fromIntegral n++instance From Word16 Int where+    from = fromIntegral++instance From Word8 Int where+    from = fromIntegral++instance From Word8 Word16 where+    from = fromIntegral++instance From Word32 Word64 where+    from = fromIntegral++instance From Word32 Int where+    from = fromIntegral++instance From Int64 Int where+    from = fromIntegral++instance From Int Int64 where+    from = fromIntegral++instance MonadFail m => TryFrom Word64 Int m where+    tryFrom msg n+        | n > maxInt = fail msg+        | otherwise = pure $ fromIntegral n+      where+        maxInt = fromIntegral (maxBound :: Int) :: Word64++instance MonadFail m => TryFrom Word16 Word8 m where+    tryFrom msg n+        | n > maxWord8 = fail msg+        | otherwise = pure $ fromIntegral n+      where+        maxWord8 = from @Word8 @Word16 maxBound++instance MonadFail m => TryFrom Word64 Int64 m where+    tryFrom msg n+        | n > maxInt64 = fail msg+        | otherwise = pure $ fromIntegral n+      where+        maxInt64 = fromIntegral (maxBound :: Int64) :: Word64++{- | Like `from` but with the order of the input/output type parameters+ reversed.+-}+into :: forall b a. From a b => a -> b+into = from++{- | Like `tryFrom` but with the order of the input/output type parameters+ reverse.+-}+tryInto :: forall b a m. TryFrom a b m => String -> a -> m b+tryInto = tryFrom

+ src/Tahoe/SDMF/Internal/Encoding.hs view

@@ -0,0 +1,137 @@+{-# LANGUAGE ScopedTypeVariables #-}++{- | Implement the scheme for encoding ciphertext into SDMF shares (and+ decoding it again).+-}+module Tahoe.SDMF.Internal.Encoding where++import Control.Monad.Fail (MonadFail)+import Control.Monad (when)+import Control.Monad.IO.Class (MonadIO (liftIO))+import Crypto.Hash (digestFromByteString)+import Crypto.Random (MonadRandom)+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 (..))++{- | Given a pre-determined key pair and sequence number, encode some+ ciphertext into a collection of SDMF shares.++ A key pair *uniquely identifies* a "slot" (the storage location for the shares).+ 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, MonadRandom m) => Keys.KeyPair -> Keys.SDMF_IV -> Word64 -> Word16 -> Word16 -> LB.ByteString -> m ([Share], Writer)+encode keypair iv shareSequenceNumber required total ciphertext = do+    -- 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++    -- 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+                    iv+                    requiredAsWord8+                    totalAsWord8+                    dataLength+                    shareSegmentSize+                    (Keys.toVerificationKey keypair)++    let makeShare'' = makeShare' <$> blocks++        resultE :: Either T.Text [Share]+        resultE = (traverse . flip fmap) encryptedPrivateKey makeShare''+    either (fail . T.unpack) pure ((,) <$> resultE <*> cap)+  where+    paddedCiphertext = LB.toStrict $ padCiphertext required ciphertext+    -- We can compute a capability immediately.+    cap = capabilityForKeyPair keypair+    encryptedPrivateKey = flip Keys.encryptSignatureKey (Keys.toSignatureKey keypair) <$> (writerWriteKey <$> cap)++makeShare ::+    Word64 ->+    Keys.SDMF_IV ->+    Word8 ->+    Word8 ->+    Word64 ->+    Word64 ->+    Keys.Verification ->+    B.ByteString ->+    LB.ByteString ->+    Share+makeShare shareSequenceNumber shareIV shareRequiredShares shareTotalShares shareDataLength shareSegmentSize shareVerificationKey shareEncryptedPrivateKey shareData = Share{..}+  where+    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++{- | Decode some SDMF shares to recover the original ciphertext.++ TODO: Use the read capability to verify the shares were constructed with+ information from the matching write capability.+-}+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)+    -- Make sure we have enough shares.+    | length s < requiredAsInt =+        fail $ "got " <> show (length shares) <> " shares, required " <> show shareRequiredShares+    | otherwise = do+        -- 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 (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+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+    writerReader = deriveReader <$> writerWriteKey <*> maybeToEither "Failed to interpret verification hash" verificationKeyHash++maybeToEither :: a -> Maybe b -> Either a b+maybeToEither a Nothing = Left a+maybeToEither _ (Just b) = Right b++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

+ src/Tahoe/SDMF/Internal/Encrypting.hs view

@@ -0,0 +1,44 @@+-- | Implement the encryption scheme used by SDMF.+module Tahoe.SDMF.Internal.Encrypting where++import Crypto.Cipher.AES (AES128)+import Crypto.Cipher.Types (BlockCipher (blockSize), ctrCombine, makeIV, nullIV)+import Crypto.Random (MonadRandom (getRandomBytes))+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as LB+import qualified Tahoe.SDMF.Internal.Keys as Keys++-- | Randomly generate a new IV suitable for use with the block cipher used by SDMF.+randomIV :: MonadRandom m => m (Maybe Keys.SDMF_IV)+randomIV = (fmap Keys.SDMF_IV . makeIV :: B.ByteString -> Maybe Keys.SDMF_IV) <$> getRandomBytes (blockSize (undefined :: AES128))++{- | Encrypt plaintext bytes according to the scheme used for SDMF share+ construction.+-}+encrypt :: Keys.KeyPair -> Keys.SDMF_IV -> LB.ByteString -> LB.ByteString+encrypt keypair iv = encryptWithDataKey dataKey+  where+    signatureKey = Keys.toSignatureKey keypair+    (Just writeKey) = Keys.deriveWriteKey signatureKey+    (Just readKey) = Keys.deriveReadKey writeKey+    (Just dataKey) = Keys.deriveDataKey iv readKey++{- | Decrypt ciphertext bytes according to the scheme used for SDMF share+ construction.+-}+decrypt :: Keys.Read -> Keys.SDMF_IV -> LB.ByteString -> LB.ByteString+decrypt readKey iv = decryptWithDataKey dataKey+  where+    (Just dataKey) = Keys.deriveDataKey iv readKey++{- | Encrypt plaintext bytes according to the scheme used for SDMF share+ construction using a pre-computed data encryption key.+-}+encryptWithDataKey :: Keys.Data -> LB.ByteString -> LB.ByteString+encryptWithDataKey Keys.Data{unData} = LB.fromStrict . ctrCombine unData nullIV . LB.toStrict++{- | Decrypt ciphertext bytes according to the scheme used for SDMF share+ construction using a pre-computed data encryption key.+-}+decryptWithDataKey :: Keys.Data -> LB.ByteString -> LB.ByteString+decryptWithDataKey = encryptWithDataKey

+ src/Tahoe/SDMF/Internal/Keys.hs view

@@ -0,0 +1,305 @@+{- | Key types, derivations, and related functionality for SDMF.++ See docs/specifications/mutable.rst for details.+-}+module Tahoe.SDMF.Internal.Keys where++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 (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)+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)++newtype KeyPair = KeyPair {toPrivateKey :: RSA.PrivateKey} deriving newtype (Show)++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)++data Write = Write {unWrite :: AES128, writeKeyBytes :: ByteArray.ScrubbedBytes}++instance Eq Write where+    (Write _ left) == (Write _ right) = left == right++instance Binary Write where+    put = putByteString . ByteArray.convert . writeKeyBytes+    get = do+        writeKeyBytes <- ByteArray.convert <$> getByteString keyLength+        let (CryptoPassed unWrite) = cipherInit writeKeyBytes+        pure Write{..}++instance Show Write where+    show (Write _ bs) =+        T.unpack $+            T.concat+                [ "<WriteKey "+                , shorten 4 . showBase32 . ByteArray.convert $ bs+                , ">"+                ]++data Read = Read {unRead :: AES128, readKeyBytes :: ByteArray.ScrubbedBytes}++instance Eq Read where+    (Read _ left) == (Read _ right) = left == right++instance Show Read where+    show (Read _ bs) =+        T.unpack $+            T.concat+                [ "<ReadKey "+                , shorten 4 . showBase32 . ByteArray.convert $ bs+                , ">"+                ]++instance Binary Read where+    put = putByteString . ByteArray.convert . readKeyBytes+    get = do+        readKeyBytes <- ByteArray.convert <$> getByteString keyLength+        let (CryptoPassed unRead) = cipherInit readKeyBytes+        pure Read{..}++newtype StorageIndex = StorageIndex {unStorageIndex :: B.ByteString} deriving newtype (Eq, Ord)++instance Show StorageIndex where+    show (StorageIndex si) =+        T.unpack $+            T.concat+                [ "<SI "+                , shorten 4 . showBase32 . ByteArray.convert $ si+                , ">"+                ]++newtype WriteEnablerMaster = WriteEnablerMaster ByteArray.ScrubbedBytes++newtype WriteEnabler = WriteEnabler ByteArray.ScrubbedBytes++data Data = Data {unData :: AES128, dataKeyBytes :: ByteArray.ScrubbedBytes}++instance Show Data where+    show (Data _ bs) =+        T.unpack $+            T.concat+                [ "<DataKey "+                , shorten 4 . showBase32 . ByteArray.convert $ bs+                , ">"+                ]++instance Eq Data where+    (Data _ left) == (Data _ right) = left == right++instance Binary Data where+    put = putByteString . ByteArray.convert . dataKeyBytes+    get = do+        dataKeyBytes <- ByteArray.convert <$> getByteString keyLength+        let (CryptoPassed unData) = cipherInit dataKeyBytes+        pure Data{..}++newtype SDMF_IV = SDMF_IV (IV AES128)+    deriving (Eq)+    deriving newtype (ByteArray.ByteArrayAccess)++instance Show SDMF_IV where+    show (SDMF_IV iv) = T.unpack . showBase32 . ByteArray.convert $ iv++-- | The size of the public/private key pair to generate.+keyPairBits :: Int+keyPairBits = 2048++-- | The number of bytes in the block cipher key.+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 (ByteArray.convert sbs)+  where+    sbs = taggedHash keyLength mutableReadKeyTag . ByteArray.convert . writeKeyBytes $ w+    key = maybeCryptoError . cipherInit $ 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 (ByteArray.convert sbs)+  where+    -- XXX taggedPairHash has a bug where it doesn't ever truncate so we+    -- truncate for it.+    sbs = B.take keyLength . taggedPairHash keyLength mutableDataKeyTag (B.pack . ByteArray.unpack $ iv) . ByteArray.convert . readKeyBytes $ r+    key = maybeCryptoError . cipherInit $ sbs++mutableDataKeyTag :: B.ByteString+mutableDataKeyTag = "allmydata_mutable_readkey_to_datakey_v1"++-- | Compute the storage index for a given read key for an SDMF share.+deriveStorageIndex :: Read -> StorageIndex+deriveStorageIndex r = StorageIndex si+  where+    si = taggedHash keyLength mutableStorageIndexTag . ByteArray.convert . readKeyBytes $ r++mutableStorageIndexTag :: B.ByteString+mutableStorageIndexTag = "allmydata_mutable_readkey_to_storage_index_v1"++{- | Derive the "write enabler master" secret for a given write key for an+ SDMF share.+-}+deriveWriteEnablerMaster :: Write -> WriteEnablerMaster+deriveWriteEnablerMaster w = WriteEnablerMaster bs+  where+    -- This one shouldn't be truncated.  Set the length to the size of sha256d+    -- output.+    bs = ByteArray.convert . taggedHash 32 mutableWriteEnablerMasterTag . ByteArray.convert . writeKeyBytes $ w++mutableWriteEnablerMasterTag :: B.ByteString+mutableWriteEnablerMasterTag = "allmydata_mutable_writekey_to_write_enabler_master_v1"++{- | Derive the "write enabler" secret for a given peer and "write enabler+ master" for an SDMF share.+-}+deriveWriteEnabler :: B.ByteString -> WriteEnablerMaster -> WriteEnabler+deriveWriteEnabler peerid (WriteEnablerMaster master) = WriteEnabler bs+  where+    -- This one shouldn't be truncated.  Set the length to the size of sha256d+    -- output.+    bs = ByteArray.convert . taggedPairHash 32 mutableWriteEnablerTag (ByteArray.convert master) $ peerid++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.+-}+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 . toPKCS8+  where+    -- The ASN1Object instance for PrivKeyRSA can interpret an x509+    -- "Private-Key Information" (aka PKCS8; see RFC 5208, section 5)+    -- structure but it _produces_ some other format.  We must have exactly+    -- this format.+    --+    -- XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX+    --+    -- RFC 5208 says:+    --+    --    privateKey is an octet string whose contents are the value of the+    --    private key.  The interpretation of the contents is defined in the+    --    registration of the private-key algorithm.  For an RSA private key,+    --    for example, the contents are a BER encoding of a value of type+    --    RSAPrivateKey.+    --+    -- The ASN.1 BER encoding for a given structure is *not guaranteed to be+    -- unique*.  This means that in general there is no guarantee of a unique+    -- bytes representation of a signature key in this scheme so *key+    -- derivations are not unique*.  If any two implementations disagree on+    -- this encoding (which BER allows them to do) they will not interoperate.+    toPKCS8 (Signature privKey) =+        [ Start Sequence+        , IntVal 0+        , Start Sequence+        , OID [1, 2, 840, 113549, 1, 1, 1]+        , Null+        , End Sequence+        , -- Our ASN.1 encoder doesn't even pretend to support BER.  Use DER!+          -- It results in the same bytes as Tahoe-LAFS is working with so ...+          -- Maybe we're lucky or maybe Tahoe-LAFS isn't actually following+          -- the spec.+          OctetString (LB.toStrict . encodeASN1 DER . toASN1 (PrivKeyRSA privKey) $ [])+        , End Sequence+        ]++-- | Decode a private key from the Tahoe-LAFS canonical bytes representation.+signatureKeyFromBytes :: B.ByteString -> Either String Signature+signatureKeyFromBytes bs = do+    asn1s <- first show $ decodeASN1' DER bs+    (key, extra) <- fromASN1 asn1s+    when (extra /= []) (Left $ "left over data: " <> show extra)+    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++{- | Replace most of the tail of a string with a short placeholder.  If the+ string is not much longer than `n` then the result might not actually be+ shorter.++ TODO: Deduplicate this between here and tahoe-chk.+-}+shorten :: Int -> T.Text -> T.Text+shorten n = (<> "...") . T.take n++showBase32 :: B.ByteString -> T.Text+showBase32 = T.toLower . encodeBase32Unpadded

@@ -0,0 +1,214 @@+-- | Deal with details related to the structural layout of an SDMF share.+module Tahoe.SDMF.Internal.Share where++import Control.Monad (unless)+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')+import Data.ASN1.Types (ASN1Object (fromASN1, toASN1))+import Data.Binary (Binary (..), Get, getWord8)+import Data.Binary.Get (bytesRead, getByteString, getLazyByteString, getRemainingLazyByteString, getWord16be, getWord32be, getWord64be, isEmpty, isolate)+import Data.Binary.Put (putByteString, putLazyByteString, putWord16be, putWord32be, putWord64be, putWord8)+import qualified Data.ByteArray as ByteArray+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as LB+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.SDMF.Internal.Converting (From (from), into, tryInto)+import qualified Tahoe.SDMF.Internal.Keys as Keys++hashSize :: Int+hashSize = 32++newtype HashChain = HashChain+    { hashChain :: [(Word16, B.ByteString)]+    }+    deriving newtype (Eq, Show, Semigroup)++instance Binary HashChain where+    put (HashChain []) = mempty+    put (HashChain ((n, h) : c)) = do+        putWord16be n+        putByteString h+        put (HashChain c)++    get = do+        empty <- isEmpty+        if empty+            then pure $ HashChain []+            else do+                n <- getWord16be+                h <- getByteString hashSize+                (HashChain [(n, h)] <>) <$> get++{- | Structured representation of a single version SDMF share.++ See Tahoe-LAFS "mutable" specification document, section title "SDMF Slot+ Format".++ Since the only version of SDMF that is specified uses version 0, this+ implicitly represents a version 0 SDMF.  If new versions of SDMF are+ specified then new constructors may be added.+-}+data Share = Share+    { -- | sequence number. 2^64-1 must be handled specially, TBD+      shareSequenceNumber :: Word64+    , -- | "R" (root of share hash merkle tree)+      shareRootHash :: B.ByteString+    , -- | The IV for encryption of share data.+      shareIV :: Keys.SDMF_IV+    , -- | The total number of encoded shares (k).+      shareTotalShares :: Word8+    , -- | The number of shares required for decoding (N).+      shareRequiredShares :: Word8+    , -- | The size of a single ciphertext segment.  This differs from+      -- shareDataLength in that it includes padding.+      shareSegmentSize :: Word64+    , -- | The length of the original plaintext.+      shareDataLength :: Word64+    , -- | The 2048 bit "verification" RSA key.+      shareVerificationKey :: Keys.Verification+    , -- | The RSA signature of+      -- H('\x00'+shareSequenceNumber+shareRootHash+shareIV+encoding+      -- parameters) where '\x00' gives the version of this share format (0)+      -- and the encoding parameters are a certain serialization of+      -- shareRequiredShares and shareTotalShares.+      shareSignature :: B.ByteString+    , -- | The share numbers and shareRootHash values which are required to+      -- ... something about verification I dunno. XXX+      shareHashChain :: HashChain+    , -- | A merkle tree where leaves are the hashes of the blocks in this share.+      shareBlockHashTree :: MerkleTree+    , -- | The share data (erasure encoded ciphertext).+      shareData :: LB.ByteString+    , -- | The encrypted 2048 bit "signature" RSA key.+      shareEncryptedPrivateKey :: B.ByteString+    }+    deriving (Eq, Show)++instance Binary Share where+    put Share{..} = do+        putWord8 0+        putWord64be shareSequenceNumber+        putByteString shareRootHash+        putByteString . ByteArray.convert $ shareIV+        putWord8 shareRequiredShares+        putWord8 shareTotalShares+        putWord64be shareSegmentSize+        putWord64be shareDataLength+        putWord32be signatureOffset+        putWord32be hashChainOffset+        putWord32be blockHashTreeOffset+        putWord32be shareDataOffset+        putWord64be encryptedPrivateKeyOffset+        putWord64be eofOffset+        putByteString verificationKeyBytes+        putByteString shareSignature+        put shareHashChain+        put shareBlockHashTree+        putLazyByteString shareData+        putByteString shareEncryptedPrivateKey+      where+        verificationKeyBytes = Keys.verificationKeyToBytes shareVerificationKey+        blockHashTreeBytes = B.concat . 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+        -- 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+        unless (version == 0) (fail $ "Only version 0 is supported; got version " <> show version)+        shareSequenceNumber <- getWord64be+        shareRootHash <- getByteString 32+        ivBytes <- getByteString 16+        shareIV <- case makeIV ivBytes of+            Nothing -> fail "Could not decode IV"+            Just iv -> pure (Keys.SDMF_IV iv)++        shareRequiredShares <- getWord8+        shareTotalShares <- getWord8+        shareSegmentSize <- getWord64be+        shareDataLength <- getWord64be+        signatureOffset <- getWord32be+        hashChainOffset <- getWord32be+        blockHashTreeOffset <- getWord32be+        shareDataOffset <- getWord32be+        encryptedPrivateKeyOffset <- getWord64be+        eofOffset <- getWord64be++        -- This offset is not the encoded share but it's defined as being+        -- right where we've read to.  Give it a name that follows the+        -- pattern.+        shareVerificationOffset <- bytesRead++        -- Read in the values between all those offsets.+        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++        blockLength <- tryInto @Int64 "Binary.get Share could not represent share block length" (encryptedPrivateKeyOffset - into @Word64 shareDataOffset)+        shareData <- getLazyByteString blockLength++        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")++        pure Share{..}++{- | Read an X.509v3-encoded SubjectPublicKeyInfo structure carrying an ASN.1+ DER encoded RSA public key.+-}+getSubjectPublicKeyInfo :: Get RSA.PublicKey+getSubjectPublicKeyInfo = do+    bytes <- getRemainingLazyByteString+    let (Right asn1s) = decodeASN1' DER . LB.toStrict $ bytes+    let (Right (PubKeyRSA pubKey, [])) = fromASN1 asn1s+    pure pubKey++{- | 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 :: RSA.PrivateKey -> B.ByteString+signatureKeyToBytes = LB.toStrict . encodeASN1 DER . flip toASN1 [] . PrivKeyRSA

+ src/Tahoe/SDMF/Keys.hs view

@@ -0,0 +1,21 @@+module Tahoe.SDMF.Keys (module Tahoe.SDMF.Internal.Keys) where++import Tahoe.SDMF.Internal.Keys (+    Data (..),+    KeyPair (..),+    Read (..),+    SDMF_IV (..),+    Signature (..),+    StorageIndex (..),+    Write (..),+    WriteEnabler (..),+    WriteEnablerMaster (..),+    deriveDataKey,+    deriveReadKey,+    deriveStorageIndex,+    deriveWriteEnabler,+    deriveWriteEnablerMaster,+    deriveWriteKey,+    toSignatureKey,+    toVerificationKey,+ )

+ tahoe-ssk.cabal view

@@ -0,0 +1,210 @@+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+-- Cabal (the library) version you are using. As such, the Cabal (the library)+-- version used must be equal or greater than the version stated in this field.+-- Starting from the specification version 2.2, the cabal-version field must be+-- the first thing in the cabal file.++-- Initial package description 'tahoe-ssk' generated by+-- 'cabal init'. For further documentation, see:+--   http://haskell.org/cabal/users-guide/+--+-- The name of the package.+name:               tahoe-ssk++-- The package version.+-- See the Haskell package versioning policy (PVP) for standards+-- guiding when and how versions should be incremented.+-- https://pvp.haskell.org+-- PVP summary:     +-+------- breaking API changes+--                  | | +----- non-breaking API additions+--                  | | | +--- code changes with no API change+version:            0.2.1.0++-- A short (one-line) description of the package.+synopsis:+  An implementation of the Tahoe-LAFS SSK cryptographic protocols++-- A longer description of the package.+description:+  This currently includes a partial implementation of SDMF.  A future version+  may include an implementation of MDMF.++-- URL for the project homepage or repository.+homepage:           https://whetstone.private.storage/PrivateStorage/tahoe-ssk++-- The license under which the package is released.+license:            BSD-3-Clause++-- The file containing the license text.+license-file:       LICENSE++-- The package author(s).+author:             Jean-Paul Calderone++-- An email address to which users can send suggestions, bug reports, and patches.+maintainer:         exarkun@twistedmatrix.com++-- A copyright notice.+-- copyright:+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+  README.md++-- Extra source files to be distributed with the package, such as examples, or+-- a tutorial module.+extra-source-files:+  test/data/3of10.0+  test/data/3of10.1+  test/data/3of10.2+  test/data/3of10.3+  test/data/3of10.4+  test/data/3of10.5+  test/data/3of10.6+  test/data/3of10.7+  test/data/3of10.8+  test/data/3of10.9+  test/data/rsa-privkey-0.der+  test/data/rsa-privkey-1.der+  test/data/rsa-privkey-2.der+  test/data/rsa-privkey-3.der+  test/data/rsa-privkey-4.der+  test/data/tahoe-lafs-generated-rsa-privkey.der++source-repository head+  type:     git+  location:+    gitlab@whetstone.private.storage:privatestorage/tahoe-ssk.git++common warnings+  ghc-options: -Wall -Werror=missing-fields++common language+  default-extensions:+    DerivingStrategies+    GeneralizedNewtypeDeriving+    NamedFieldPuns+    OverloadedStrings+    PackageImports+    RecordWildCards+    TypeApplications++  -- Base language which the package is written in.+  default-language:   Haskell2010++library+  import:+    warnings+    , language++  hs-source-dirs:  src+  exposed-modules:+    Tahoe.SDMF+    Tahoe.SDMF.Internal.Capability+    Tahoe.SDMF.Internal.Converting+    Tahoe.SDMF.Internal.Encoding+    Tahoe.SDMF.Internal.Encrypting+    Tahoe.SDMF.Internal.Keys+    Tahoe.SDMF.Internal.Share+    Tahoe.SDMF.Keys++  build-depends:+    , asn1-encoding       >=0.9.6    && <0.10+    , asn1-types          >=0.3.4    && <0.4+    , base                >=4.7      && <5+    , base32              >=0.2.1    && <0.3+    , binary              >=0.8.6    && <0.9+    , bytestring          >=0.10.8.2 && <0.11+    , cereal              >=0.5.8.1  && <0.6+    , containers          >=0.6.0.1  && <0.7+    , cryptonite          >=0.27     && <0.30+    , megaparsec          >=8.0      && <9.3+    , memory              >=0.15     && <0.17+    , tahoe-capabilities  >=0.1      && <0.2+    , text                >=1.2.3.1  && <1.3+    , x509                >=1.7.5    && <1.8++  -- This dependency isn't ideal.  Move common bits out to+  -- another library.+  build-depends:   tahoe-chk >=0.1 && <0.2++test-suite tahoe-ssk-test+  import:+    warnings+    , language++  -- LANGUAGE extensions used by modules in this package.+  -- other-extensions:++  -- The interface type and version of the test suite.+  type:           exitcode-stdio-1.0++  -- Directories containing source files.+  hs-source-dirs: test++  -- The entrypoint to the test suite.+  main-is:        Main.hs+  other-modules:+    Generators+    Spec++  -- Test dependencies.+  build-depends:+    , asn1-encoding       >=0.9.6    && <0.10+    , asn1-types          >=0.3.4    && <0.4+    , base                >=4.7      && <5+    , base32              >=0.2.1    && <0.3+    , binary              >=0.8.6    && <0.9+    , bytestring          >=0.10.8.2 && <0.11+    , cryptonite          >=0.27     && <0.30+    , hedgehog            >=1.0.3    && <1.1+    , megaparsec          >=8.0      && <9.3+    , memory              >=0.15     && <0.17+    , tahoe-capabilities  >=0.1      && <0.2+    , tahoe-chk           >=0.1      && <0.2+    , tahoe-ssk+    , tasty               >=1.2.3    && <1.5+    , tasty-hedgehog      >=1.0.0.2  && <1.2+    , tasty-hunit         >=0.10.0.2 && <0.11+    , text                >=1.2.3.1  && <1.3+    , x509                >=1.7.5    && <1.8++-- A helper for generating RSA key pairs for use by the test suite.+executable make-keypairs+  import:+    warnings+    , language++  main-is:        Main.hs+  hs-source-dirs: make-keypairs+  build-depends:+    , asn1-encoding  >=0.9.6    && <0.10+    , asn1-types     >=0.3.4    && <0.4+    , base           >=4.7      && <5+    , bytestring     >=0.10.8.2 && <0.11+    , cryptonite     >=0.27     && <0.30+    , tahoe-ssk+    , x509           >=1.7.5    && <1.8++executable encode-ssk+  import:+    warnings+    , language++  main-is:        Main.hs+  hs-source-dirs: encode-ssk+  build-depends:+    , base                >=4.7      && <5+    , base32              >=0.2.1    && <0.3+    , binary              >=0.8.6    && <0.9+    , bytestring          >=0.10.8.2 && <0.11+    , cryptonite          >=0.27     && <0.30+    , tahoe-capabilities  >=0.1      && <0.2+    , tahoe-ssk+    , text                >=1.2.3.1  && <1.3

+ test/Generators.hs view

@@ -0,0 +1,148 @@+module Generators where++import Crypto.Cipher.Types (makeIV)+import Crypto.Hash (Digest, HashAlgorithm (hashDigestSize), SHA256, digestFromByteString)+import Crypto.Hash.Algorithms (SHA256 (SHA256))+import Data.ASN1.BinaryEncoding (DER (DER))+import Data.ASN1.Encoding (ASN1Decoding (decodeASN1), ASN1Encoding (encodeASN1))+import Data.ASN1.Types (ASN1Object (fromASN1, toASN1))+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.Word (Word16)+import Data.X509 (PrivKey (PrivKeyRSA))+import GHC.IO.Unsafe (unsafePerformIO)+import Hedgehog (MonadGen)+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import Tahoe.CHK.Merkle (MerkleTree (..), makeTreePartial)+import Tahoe.SDMF (Reader (..), SDMF (..), Share (..), Verifier (..), Writer (..))+import Tahoe.SDMF.Internal.Capability (deriveReader)+import Tahoe.SDMF.Internal.Keys (keyLength)+import Tahoe.SDMF.Internal.Share (HashChain (HashChain))+import qualified Tahoe.SDMF.Keys as Keys++rootHashLength :: Int+rootHashLength = 32++ivLength :: Int+ivLength = 16++signatureLength :: Range.Range Int+signatureLength = Range.linear 250 260++{- | Generate SDMF shares.  The contents of the share are not necessarily+ semantically valid.+-}+shares :: MonadGen m => m Share+shares = do+    keypair <- genRSAKeys+    iv <- makeIV <$> Gen.bytes (Range.singleton ivLength)+    case iv of+        Nothing -> error "Could not build IV for SDMF share"+        Just iv' ->+            Share+                <$> Gen.word64 Range.exponentialBounded -- shareSequenceNumber+                <*> Gen.bytes (Range.singleton rootHashLength) -- shareRootHash+                <*> 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 (Keys.toVerificationKey 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 . Keys.toPrivateKey) keypair -- shareEncryptedPrivateKey+  where+    toDER = encodeASN1 DER . flip toASN1 []++{- | Build RSA key pairs.++ Because the specific bits of the key pair shouldn't make any difference to+ any application logic, generating new RSA key pairs is expensive, and+ generating new RSA key pairs in a way that makes sense in Hedgehog is+ challenging, this implementation just knows a few RSA key pairs already and+ will give back one of them.+-}+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+-- hopefully not really unsafely).+rsaKeyPairBytes :: [LB.ByteString]+{-# NOINLINE rsaKeyPairBytes #-}+rsaKeyPairBytes = unsafePerformIO $ mapM (\n -> LB.readFile ("test/data/rsa-privkey-" <> show n <> ".der")) [0 .. 4 :: Int]++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 $ Keys.KeyPair pk+                _ -> error "Expected RSA Private Key"+    kp++merkleTrees :: MonadGen m => Range.Range Int -> m MerkleTree+merkleTrees r = makeTreePartial <$> Gen.list r genHash++-- | Generate ByteStrings which could be sha256d digests.+genHash :: MonadGen m => m B.ByteString+genHash = Gen.bytes . Range.singleton . hashDigestSize $ SHA256++-- | Generate lists of two-tuples of share identifier and share root hash.+shareHashChains :: MonadGen m => m HashChain+shareHashChains = HashChain <$> Gen.list range element+  where+    range = Range.exponential 1 5+    element = (,) <$> Gen.integral (Range.exponential 0 255) <*> Gen.bytes (Range.singleton 32)++-- | Build a valid pair of (required, total) encoding parameters.+encodingParameters :: MonadGen m => m (Word16, Word16)+encodingParameters = do+    required <- Gen.integral (Range.exponential 1 254)+    total <- Gen.integral (Range.exponential (required + 1) 255)+    pure (required, total)++-- | Build all kinds of SDMF capabilities values.+capabilities :: MonadGen m => m SDMF+capabilities =+    Gen.choice+        [ SDMFVerifier <$> verifiers+        , SDMFReader <$> readers+        , SDMFWriter <$> writers+        ]++-- | Build SDMF writer capabilities.+writers :: MonadGen m => m Writer+writers = do+    writeKey <- writeKeys+    reader <- deriveReader writeKey <$> digests+    pure $ Writer writeKey (fromJust reader)++-- | Build SDMF writer capability keys.+writeKeys :: MonadGen m => m Keys.Write+writeKeys = key+  where+    writeBytes = Gen.bytes (Range.singleton 16)+    key = Binary.decode . LB.fromStrict <$> writeBytes++-- | Build SDMF reader capabilities.+readers :: MonadGen m => m Reader+readers = writerReader <$> writers++-- | Build SDMF verifier capabilities.+verifiers :: MonadGen m => m Verifier+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)

+ test/Main.hs view

@@ -0,0 +1,3 @@+module Main (main) where++import Spec (main)

+ test/Spec.hs view

@@ -0,0 +1,276 @@+module Spec where++import Hedgehog (+    annotateShow,+    diff,+    forAll,+    property,+    tripping,+ )++import Control.Monad (when)+import Control.Monad.Fail (MonadFail)+import Control.Monad.IO.Class (liftIO)+import Crypto.Cipher.Types (makeIV)+import Crypto.Hash (digestFromByteString)+import Data.ASN1.BinaryEncoding (DER (DER))+import Data.ASN1.Encoding (decodeASN1')+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 (decodeBase32Unpadded, encodeBase32Unpadded)+import qualified Data.ByteString.Lazy as LB+import Data.Either (rights)+import qualified Data.Text as T+import Generators (capabilities, encodingParameters, genRSAKeys, ivLength, shareHashChains, shares)+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import System.IO (hSetEncoding, stderr, stdout, utf8)+import Tahoe.Capability (confidentiallyShow)+import qualified Tahoe.SDMF+import Tahoe.SDMF.Internal.Capability (deriveVerifier)+import Tahoe.SDMF.Internal.Keys (signatureKeyFromBytes, signatureKeyToBytes)+import qualified Tahoe.SDMF.Keys as Keys+import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.HUnit (assertEqual, testCase)+import Test.Tasty.Hedgehog (testProperty)+import Text.Megaparsec (parse)++-- 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+        "SSK"+        [ testProperty "Hash chain round-trips through bytes" $+            property $ do+                hashChain <- forAll shareHashChains+                tripping hashChain Binary.encode decode'+        , testProperty "Signatures round-trip through signatureKeyToBytes . signatureKeyFromBytes" $+            property $ do+                key <- forAll genRSAKeys+                tripping (Keys.Signature . Keys.toPrivateKey $ key) signatureKeyToBytes signatureKeyFromBytes+        , testCase "Signature byte-serializations round-trip through signatureKeyFromBytes . signatureKeyToBytes" $ do+            let keyPaths =+                    [ -- Check ours+                      "test/data/rsa-privkey-0.der"+                    , "test/data/rsa-privkey-1.der"+                    , "test/data/rsa-privkey-2.der"+                    , "test/data/rsa-privkey-3.der"+                    , "test/data/rsa-privkey-4.der"+                    , -- And one from Tahoe-LAFS+                      "test/data/tahoe-lafs-generated-rsa-privkey.der"+                    ]+                checkSignatureRoundTrip p =+                    B.readFile p >>= \original ->+                        let (Right sigKey) = signatureKeyFromBytes original+                            serialized = signatureKeyToBytes sigKey+                         in do+                                -- They should decode to the same structure.  This+                                -- has the advantage of representing differences a+                                -- little more transparently than the next+                                -- assertion.+                                assertEqual+                                    "decodeASN1 original /= decodeASN1 serialized"+                                    (decodeASN1' DER original)+                                    (decodeASN1' DER serialized)+                                -- Also check the raw bytes in case there+                                -- are different representations of the+                                -- structure possible.  The raw bytes+                                -- matter because we hash them in key+                                -- derivations.+                                assertEqual "original /= serialized" original serialized+            -- Check them all+            mapM_ checkSignatureRoundTrip keyPaths+        , 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 -- Load the test key.+                    (Right sigKey) = signatureKeyFromBytes privBytes++                    -- Hard-code the expected result.+                    expectedWriteKey = ("v7iymuxkc5yv2fomi3xwbjdd4e" :: T.Text)+                    expectedReadKey = ("6ir6husgx6ubro3tbimmzskqri" :: T.Text)+                    expectedDataKey = ("bbj67exlrkfcaqutwlgwvukbfe" :: T.Text)+                    expectedStorageIndex = ("cmkuloz2t6fhsh7npxxteba6sq" :: T.Text)+                    expectedWriteEnablerMaster = ("qgptod5dsanfep2kbimvxl2yixndnoks7ndoeamczj7g33gokcvq" :: T.Text)+                    expectedWriteEnabler = ("bg4ldrgfyiffufltcuttr3cnrmrjfpoxc65qdoqa6d5izkzofl5q" :: T.Text)++                    -- Constants involved in the derivation.  These agree with+                    -- those used to generate the above expected values.+                    (Just iv) = Keys.SDMF_IV <$> makeIV (B.replicate 16 0x42)+                    peerid = B.replicate 20 0x42++                    -- Derive all the keys.+                    (Just w@(Keys.Write _ derivedWriteKey)) = Keys.deriveWriteKey sigKey+                    (Just r@(Keys.Read _ derivedReadKey)) = Keys.deriveReadKey w+                    (Just (Keys.Data _ derivedDataKey)) = Keys.deriveDataKey iv r+                    (Keys.StorageIndex derivedStorageIndex) = Keys.deriveStorageIndex r+                    wem@(Keys.WriteEnablerMaster derivedWriteEnablerMaster) = Keys.deriveWriteEnablerMaster w+                    (Keys.WriteEnabler derivedWriteEnabler) = Keys.deriveWriteEnabler peerid wem+                    -- A helper to 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+                            "writekey: expected /= derived"+                            expectedWriteKey+                            (fmtKey derivedWriteKey)+                        assertEqual+                            "readkey: expected /= derived"+                            expectedReadKey+                            (fmtKey derivedReadKey)+                        assertEqual+                            "datakey: expected /= derived"+                            expectedDataKey+                            (fmtKey derivedDataKey)+                        assertEqual+                            "storage index: expected /= derived"+                            expectedStorageIndex+                            (T.toLower . encodeBase32Unpadded $ derivedStorageIndex)+                        assertEqual+                            "write enabler master: expected /= derived"+                            expectedWriteEnablerMaster+                            (fmtKey derivedWriteEnablerMaster)+                        assertEqual+                            "write enabler: expected /= derived"+                            expectedWriteEnabler+                            (fmtKey derivedWriteEnabler)+        , testCase "known-correct SDMF capability strings round-trip through parse . confidentiallyShow" $ do+            let validWrite = "URI:SSK:vbopclzrkxces6okoqfarapmou:xlwog3jxbgsuaddh3bsofwmyhncv7fanmo7ujhqiy26usx2v2neq"+                validRead = "URI:SSK-RO:ro7pnpq6duaduuolookwbv5lqy:xlwog3jxbgsuaddh3bsofwmyhncv7fanmo7ujhqiy26usx2v2neq"+                validVerify = "URI:SSK-Verifier:gz4s2zkkqy2geblvv77atyoppi:xlwog3jxbgsuaddh3bsofwmyhncv7fanmo7ujhqiy26usx2v2neq"++                parsed = rights $ parse Tahoe.SDMF.pCapability "<test>" <$> [validWrite, validRead, validVerify]+                serialized = confidentiallyShow <$> parsed++            assertEqual "parsing failed" 3 (length parsed)+            assertEqual "original /= serialized" [validWrite, validRead, validVerify] serialized++            let [Tahoe.SDMF.SDMFWriter writeCap, Tahoe.SDMF.SDMFReader readCap, Tahoe.SDMF.SDMFVerifier verifyCap] = parsed+                derivedReader = Tahoe.SDMF.writerReader writeCap+                derivedVerifier = Tahoe.SDMF.readerVerifier readCap++            assertEqual "derived reader /= parsed reader" derivedReader readCap+            assertEqual "serialized derived reader /= original" (confidentiallyShow derivedReader) validRead+            assertEqual "derived verifier /= parsed verifier" derivedVerifier verifyCap+            assertEqual "serialized derived verifier /= original" (confidentiallyShow derivedVerifier) validVerify+        , testProperty "SDMF capabilities round-trip through confidentiallyShow . parse pCapability" $+            property $ do+                cap <- forAll capabilities+                tripping cap confidentiallyShow (parse Tahoe.SDMF.pCapability "<text>")+        , testProperty "Share round-trips through bytes" $+            property $ do+                share <- forAll shares+                tripping share Binary.encode decode'+        , testCase "known-correct serialized shares round-trip though Share" $+            mapM_ knownCorrectRoundTrip [0 :: Int .. 9]+        , testProperty "Ciphertext round-trips through encode . decode" $+            property $ do+                keypair <- forAll genRSAKeys+                ivBytes <- forAll $ Gen.bytes (Range.singleton ivLength)+                let Just iv = Keys.SDMF_IV <$> makeIV ivBytes+                ciphertext <- forAll $ LB.fromStrict <$> Gen.bytes (Range.exponential 1 1024)+                sequenceNumber <- forAll $ Gen.integral Range.exponentialBounded+                (required, total) <- forAll encodingParameters++                (shares', Tahoe.SDMF.Writer{Tahoe.SDMF.writerReader}) <- liftIO $ Tahoe.SDMF.encode keypair iv 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+                    keypair <- forAll genRSAKeys+                    (Just iv) <- fmap Keys.SDMF_IV <$> (makeIV <$> forAll (Gen.bytes (Range.singleton 16)))+                    let (Just readKey) = do+                            writeKey <- Keys.deriveWriteKey (Keys.toSignatureKey keypair)+                            Keys.deriveReadKey writeKey+                    plaintext <- forAll $ LB.fromStrict <$> Gen.bytes (Range.exponential 1 1024)+                    tripping plaintext (Tahoe.SDMF.encrypt keypair iv) (Just . Tahoe.SDMF.decrypt readKey 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+                (Just readerVerifier) = deriveVerifier readerReadKey <$> 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"+                (Right (Just expectedIV)) = fmap (fmap Keys.SDMF_IV . makeIV) . decodeBase32Unpadded $ "xkczackg4djsvtx5brgy4z3pse"+                (Right expectedReadKey) = Binary.decode . LB.fromStrict <$> decodeBase32Unpadded "g4fimjxgdpwrvpfguyz5a6hvz4"+                (Right expectedDataKey) = Binary.decode . LB.fromStrict <$> decodeBase32Unpadded "crblibtnjacos5xwjpxb2d5hla"+                expectedPlaintext = "abcdefghijklmnopqrstuvwxyzZYXWVUTSRQPONMLKJIJHGRFCBA1357"++                (Just dataKey) = Keys.deriveDataKey (Tahoe.SDMF.shareIV s0) readerReadKey+                recoveredPlaintext = Tahoe.SDMF.decrypt readerReadKey (Tahoe.SDMF.shareIV s0) ciphertext++            assertEqual "read key: expected /= derived" expectedReadKey readerReadKey+            assertEqual "data key: expected /= derived" expectedDataKey dataKey+            assertEqual "iv: expected /= loaded" expectedIV (Tahoe.SDMF.shareIV s0)+            assertEqual "ciphertext: expected /= decoded" expectedCiphertext ciphertext++            assertEqual "expected /= recovered" expectedPlaintext recoveredPlaintext+        ]++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++ Note: The capability for the test data is:++   URI:SSK:vdv6pcqkblsguvkagrblr3gopu:6pd5r2qrsb3zuq2n6ocvcsg2a6b47ehclqxidkzd5awdabhtdo6a+-}+knownCorrectRoundTrip :: Show a => a -> IO ()+knownCorrectRoundTrip n = do+    -- The files are in "bucket" format.  We need to extract the+    -- "slot".  We do so by stripping a prefix and suffix.  To avoid+    -- having to parse the prefix, we assert that the suffix is a+    -- predictable size.+    bucket <- LB.readFile ("test/data/3of10." <> show n)+    shareData <- readShareFromBucket bucket++    let decoded = decode' shareData+    let encoded = (Binary.encode :: Tahoe.SDMF.Share -> LB.ByteString) <$> decoded+    assertEqual "original /= encoded" (Right shareData) encoded++    -- We also know some specific things about the know-correct shares.+    let (Right sh) = decoded+    assertEqual "3 /= required" 3 (Tahoe.SDMF.shareRequiredShares sh)+    assertEqual "10 /= total" 10 (Tahoe.SDMF.shareTotalShares sh)++-- | Like `Binary.Binary.decodeOrFail` but only return the decoded value.+decode' :: Binary.Binary b => LB.ByteString -> Either (LB.ByteString, ByteOffset, String) b+decode' = ((\(_, _, a) -> a) <$>) . Binary.decodeOrFail++main :: IO ()+main = do+    -- Hedgehog writes some non-ASCII and the whole test process will die if+    -- it can't be encoded.  Increase the chances that all of the output can+    -- be encoded by forcing the use of UTF-8 (overriding the LANG-based+    -- choice normally made).+    hSetEncoding stdout utf8+    hSetEncoding stderr utf8+    defaultMain tests

+ test/data/3of10.0 view