diff --git a/README.md b/README.md
index 173dc50acc465539b4bcfc940c923d30227c690b..c6c90a641e67bb4d1f31bb563ae01d7eaa4c9851 100644
--- a/README.md
+++ b/README.md
@@ -11,7 +11,11 @@ However, its APIs are intended to be easy to integrate with such an implementati
### What is the current state?
-* All implementation tasks are pending.
+* SDMF write, read, and verify capabilities can be parsed and serialized.
+* SDMF shares can be deserialized, decoded, and decrypted.
+* 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?
diff --git a/encode-ssk/Main.hs b/encode-ssk/Main.hs
new file mode 100644
index 0000000000000000000000000000000000000000..cc50fb611105491eef02c21ce3c8d22e89af94e7
--- /dev/null
+++ b/encode-ssk/Main.hs
@@ -0,0 +1,29 @@
+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 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 (SDMF.dangerRealShow (SDMF.SDMFWriter writeCap))
+ where
+ e = 0x10001
+ writeShare si shnum = LB.writeFile $ (T.unpack . T.toLower . encodeBase32Unpadded $ si) <> "." <> show shnum
diff --git a/flake.nix b/flake.nix
index f5feba570df0b1b4aec8cd7a77f11c664b788aca..cc2531248b496c8e322a472788860b38f0d8d648 100644
--- a/flake.nix
+++ b/flake.nix
@@ -58,7 +58,7 @@
text = ''
cabal update hackage.haskell.org
- cabal build
+ cabal build all
cabal run tests
'';
}
diff --git a/src/Tahoe/SDMF.hs b/src/Tahoe/SDMF.hs
index 3f2cce62d7c113a0a8ee6d806c1fde9cdfca97fb..3367f1189837e66a839c12000d07b5d79be7a18b 100644
--- a/src/Tahoe/SDMF.hs
+++ b/src/Tahoe/SDMF.hs
@@ -24,6 +24,7 @@ import Tahoe.SDMF.Internal.Encoding (
import Tahoe.SDMF.Internal.Encrypting (
decrypt,
encrypt,
+ randomIV,
)
import Tahoe.SDMF.Internal.Share (
Share (..),
diff --git a/src/Tahoe/SDMF/Internal/Capability.hs b/src/Tahoe/SDMF/Internal/Capability.hs
index bc2f24312917598ba54b4a99e11ee04d4286319c..ba5acbf0698e6e9247aa60d0c52d992fcb6104c2 100644
--- a/src/Tahoe/SDMF/Internal/Capability.hs
+++ b/src/Tahoe/SDMF/Internal/Capability.hs
@@ -23,7 +23,6 @@ import Tahoe.SDMF.Internal.Keys (
deriveReadKey,
deriveStorageIndex,
readKeyBytes,
- shorten,
showBase32,
)
import Text.Megaparsec (
diff --git a/src/Tahoe/SDMF/Internal/Encoding.hs b/src/Tahoe/SDMF/Internal/Encoding.hs
index f95b90d4d43406f36be94e6c10ac97a431bb7365..b34b91c56e0028f61b4bc5d2200993ccde4eb5c9 100644
--- a/src/Tahoe/SDMF/Internal/Encoding.hs
+++ b/src/Tahoe/SDMF/Internal/Encoding.hs
@@ -7,9 +7,8 @@ module Tahoe.SDMF.Internal.Encoding where
import Control.Monad (when)
import Control.Monad.IO.Class (MonadIO (liftIO))
-import Crypto.Cipher.Types (BlockCipher (blockSize), IV, makeIV)
import Crypto.Hash (digestFromByteString)
-import Crypto.Random (MonadRandom (getRandomBytes))
+import Crypto.Random (MonadRandom)
import Data.Bifunctor (Bifunctor (bimap))
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
@@ -23,10 +22,6 @@ import Tahoe.SDMF.Internal.Converting (from, tryInto)
import qualified Tahoe.SDMF.Internal.Keys as Keys
import Tahoe.SDMF.Internal.Share (HashChain (HashChain), Share (..))
--- | Randomly generate a new IV suitable for use with some BlockCipher.
-randomIV :: forall c m. (BlockCipher c, MonadRandom m) => m (Maybe (IV c))
-randomIV = (makeIV :: B.ByteString -> Maybe (IV c)) <$> getRandomBytes (blockSize (undefined :: c))
-
{- | Given a pre-determined key pair and sequence number, encode some
ciphertext into a collection of SDMF shares.
@@ -34,8 +29,8 @@ randomIV = (makeIV :: B.ByteString -> Maybe (IV c)) <$> getRandomBytes (blockSiz
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 -> Word64 -> Word16 -> Word16 -> LB.ByteString -> m ([Share], Writer)
-encode keypair shareSequenceNumber required total ciphertext = do
+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
@@ -46,8 +41,6 @@ encode keypair shareSequenceNumber required total ciphertext = do
-- They look okay, we can proceed.
blocks <- liftIO $ fmap LB.fromStrict <$> zfec (from required) (from total) paddedCiphertext
- (Just iv) <- randomIV
-
-- 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
@@ -63,7 +56,7 @@ encode keypair shareSequenceNumber required total ciphertext = do
flip $
makeShare
shareSequenceNumber
- (Keys.SDMF_IV iv)
+ iv
requiredAsWord8
totalAsWord8
dataLength
diff --git a/src/Tahoe/SDMF/Internal/Encrypting.hs b/src/Tahoe/SDMF/Internal/Encrypting.hs
index b3b1db8155d1335b82029aacc6a36515e202df01..93bd5ed75eaf6003b487505e7e6402f79ce60e67 100644
--- a/src/Tahoe/SDMF/Internal/Encrypting.hs
+++ b/src/Tahoe/SDMF/Internal/Encrypting.hs
@@ -1,18 +1,44 @@
-- | Implement the encryption scheme used by SDMF.
module Tahoe.SDMF.Internal.Encrypting where
-import Crypto.Cipher.Types (ctrCombine, nullIV)
+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.Data -> LB.ByteString -> LB.ByteString
-encrypt Keys.Data{unData} = LB.fromStrict . ctrCombine unData nullIV . LB.toStrict
+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.Data -> LB.ByteString -> LB.ByteString
-decrypt = encrypt
+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
diff --git a/tahoe-ssk.cabal b/tahoe-ssk.cabal
index 68fbb5a1214c4eb5f111df540624ce86a0ad69f0..bd04c33880d49b8ad7b4a3eb16633a001d330818 100644
--- a/tahoe-ssk.cabal
+++ b/tahoe-ssk.cabal
@@ -164,3 +164,19 @@ executable make-keypairs
, cryptonite
, tahoe-ssk
, x509
+
+executable encode-ssk
+ import:
+ warnings
+ , language
+
+ main-is: Main.hs
+ hs-source-dirs: encode-ssk
+ build-depends:
+ , base
+ , base32
+ , binary
+ , bytestring
+ , cryptonite
+ , tahoe-ssk
+ , text
diff --git a/test/Spec.hs b/test/Spec.hs
index 0b3c1648c4318bd6506d2a27db06733d511bbf6e..17d43b89b6f9c4a6b1013e57da86cc539b6f3ab6 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -22,7 +22,7 @@ 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, shareHashChains, shares)
+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)
@@ -175,11 +175,13 @@ tests =
, 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 sequenceNumber required total ciphertext
+ (shares', Tahoe.SDMF.Writer{Tahoe.SDMF.writerReader}) <- liftIO $ Tahoe.SDMF.encode keypair iv sequenceNumber required total ciphertext
annotateShow shares'
@@ -190,12 +192,11 @@ tests =
do
keypair <- forAll genRSAKeys
(Just iv) <- fmap Keys.SDMF_IV <$> (makeIV <$> forAll (Gen.bytes (Range.singleton 16)))
- let (Just dataKey) = do
+ let (Just readKey) = do
writeKey <- Keys.deriveWriteKey (Keys.toSignatureKey keypair)
- readKey <- Keys.deriveReadKey writeKey
- Keys.deriveDataKey iv readKey
+ Keys.deriveReadKey writeKey
plaintext <- forAll $ LB.fromStrict <$> Gen.bytes (Range.exponential 1 1024)
- tripping plaintext (Tahoe.SDMF.encrypt dataKey) (Just . Tahoe.SDMF.decrypt dataKey)
+ 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)
@@ -213,7 +214,7 @@ tests =
expectedPlaintext = "abcdefghijklmnopqrstuvwxyzZYXWVUTSRQPONMLKJIJHGRFCBA1357"
(Just dataKey) = Keys.deriveDataKey (Tahoe.SDMF.shareIV s0) readerReadKey
- recoveredPlaintext = Tahoe.SDMF.decrypt dataKey ciphertext
+ recoveredPlaintext = Tahoe.SDMF.decrypt readerReadKey (Tahoe.SDMF.shareIV s0) ciphertext
assertEqual "read key: expected /= derived" expectedReadKey readerReadKey
assertEqual "data key: expected /= derived" expectedDataKey dataKey