From 5bdb6aa3ec98d0c7de574e8aba1494e7af95f476 Mon Sep 17 00:00:00 2001
From: Jean-Paul Calderone <exarkun@twistedmatrix.com>
Date: Fri, 29 Sep 2023 11:01:07 -0400
Subject: [PATCH] Finish switching away from cipher-aes128
This also lets us drop dependencies on:
* cereal
* crypto-api
* tagged
And incidentally I noticed we don't actually use monad-loops either.
---
src/Tahoe/CHK/Cipher.hs | 7 +++++--
src/Tahoe/CHK/Crypto.hs | 3 ++-
src/Tahoe/CHK/Encrypt.hs | 19 +++++++++++++++++--
src/Tahoe/CHK/Upload.hs | 4 ++--
tahoe-chk.cabal | 7 -------
test/SpecCHK.hs | 21 +++++++++------------
test/SpecCrypto.hs | 23 ++++++++++++-----------
test/SpecUpload.hs | 6 ++----
8 files changed, 49 insertions(+), 41 deletions(-)
diff --git a/src/Tahoe/CHK/Cipher.hs b/src/Tahoe/CHK/Cipher.hs
index 380c130..43a45ef 100644
--- a/src/Tahoe/CHK/Cipher.hs
+++ b/src/Tahoe/CHK/Cipher.hs
@@ -10,7 +10,7 @@ module Tahoe.CHK.Cipher (
) where
import Control.DeepSeq (NFData)
-import Crypto.Cipher.Types (BlockCipher (..), Cipher (..))
+import Crypto.Cipher.Types (AEAD, BlockCipher (..), Cipher (..))
import Data.ByteArray (ScrubbedBytes)
import qualified Data.ByteArray as BA
import Data.Coerce (coerce)
@@ -37,7 +37,10 @@ instance forall cipher. BlockCipher cipher => BlockCipher (Key cipher) where
cfbDecrypt (Key _ cipher) iv = cfbDecrypt cipher (coerce iv)
ctrCombine (Key _ cipher) iv = ctrCombine cipher (coerce iv)
- aeadInit mode (Key _ cipher) iv = xxx
+ aeadInit mode (Key _ cipher) iv = wrap <$> aeadInit mode cipher iv
+ where
+ wrap = coerce @(AEAD cipher) @(AEAD (Key cipher))
+
instance BA.ByteArrayAccess (Key cipher) where
length (Key ba _) = BA.length ba
withByteArray (Key ba _) = BA.withByteArray ba
diff --git a/src/Tahoe/CHK/Crypto.hs b/src/Tahoe/CHK/Crypto.hs
index b332c0a..e4c727b 100644
--- a/src/Tahoe/CHK/Crypto.hs
+++ b/src/Tahoe/CHK/Crypto.hs
@@ -32,7 +32,6 @@ import Crypto.Hash (
hashDigestSize,
hashlazy,
)
-import Crypto.Types (ByteLength)
import Data.ByteArray (convert)
import Crypto.Cipher.AES (AES128)
@@ -151,6 +150,8 @@ convergenceEncryptionHashLazy secret params bytes =
tag = BL.fromStrict . netstring $ convergenceEncryptionTag secret params
+type ByteLength = Int
+
convergenceSecretLength :: ByteLength
convergenceSecretLength = 16
diff --git a/src/Tahoe/CHK/Encrypt.hs b/src/Tahoe/CHK/Encrypt.hs
index 65a2f23..de9c796 100644
--- a/src/Tahoe/CHK/Encrypt.hs
+++ b/src/Tahoe/CHK/Encrypt.hs
@@ -1,10 +1,13 @@
-- | Support the encryption requirements of CHK.
-module Tahoe.CHK.Encrypt (encrypt, decrypt) where
+module Tahoe.CHK.Encrypt (encrypt, encryptLazy, decrypt, decryptLazy) where
import Crypto.Cipher.Types (BlockCipher (ctrCombine), nullIV)
import Data.ByteArray (ByteArray)
+import qualified Data.ByteString.Lazy as LBS
-{- | AES128-CTR encrypt a byte string in the manner used by CHK.
+{- | CTR-mode encrypt a byte string using some block cipher.
+
+ When used for CHKv1 or CHKv2 the block cipher should be AES128.
This replaces allmydata.immutable.upload.EncryptAnUploadable
@@ -13,6 +16,18 @@ import Data.ByteArray (ByteArray)
encrypt :: (BlockCipher cipher, ByteArray ba) => cipher -> ba -> ba
encrypt key = ctrCombine key nullIV
+{- | Like encrypt but operate on lazy bytestrings. TODO: Make this more
+ efficient than converting to/from strict ByteString!
+-}
+encryptLazy :: BlockCipher cipher => cipher -> LBS.ByteString -> LBS.ByteString
+encryptLazy cipher lbs = LBS.fromStrict (encrypt cipher (LBS.toStrict lbs))
+
-- | AES128-CTR decrypt a byte string in the manner used by CHK.
decrypt :: (BlockCipher cipher, ByteArray ba) => cipher -> ba -> ba
decrypt = encrypt
+
+{- | Like decrypt but operate on lazy bytestrings. TODO: Make this more
+ efficient than converting to/from strict ByteString!
+-}
+decryptLazy :: BlockCipher cipher => cipher -> LBS.ByteString -> LBS.ByteString
+decryptLazy = encryptLazy
diff --git a/src/Tahoe/CHK/Upload.hs b/src/Tahoe/CHK/Upload.hs
index 53290f6..0db1afc 100644
--- a/src/Tahoe/CHK/Upload.hs
+++ b/src/Tahoe/CHK/Upload.hs
@@ -89,7 +89,7 @@ import Data.Tuple.Extra (thd3)
import Tahoe.CHK (
encode,
)
-import Tahoe.CHK.Encrypt (encrypt)
+import Tahoe.CHK.Encrypt (encryptLazy)
-- Some data that can be uploaded.
data Uploadable = Uploadable
@@ -189,7 +189,7 @@ encryptAndEncode ::
IO ([BL.ByteString], Cap.Reader)
encryptAndEncode (Uploadable readKey _ params read') = do
plaintext <- readAll read'
- let ciphertext = encrypt readKey plaintext
+ let ciphertext = encryptLazy readKey plaintext
(shares, cap) <- encode readKey params ciphertext
pure (map Binary.encode shares, cap)
where
diff --git a/tahoe-chk.cabal b/tahoe-chk.cabal
index 05d2890..383af07 100644
--- a/tahoe-chk.cabal
+++ b/tahoe-chk.cabal
@@ -59,10 +59,8 @@ library
, base64-bytestring >=1.0.0.3 && <1.3
, binary >=0.8.6 && <0.9
, bytestring >=0.10.8.2 && <0.11
- , cereal >=0.5.8.1 && <0.6
, concurrency >=1.11 && <2
, containers >=0.6.0.1 && <0.7
- , crypto-api >=0.13.3 && <0.14
, cryptonite >=0.27 && <0.30
, deepseq
, directory >=1.3.3 && <1.4
@@ -72,11 +70,9 @@ library
, lens >=5.0 && <5.3
, megaparsec >=8.0 && <9.3
, memory >=0.15 && <0.17
- , monad-loops >=0.4.3 && <0.5
, network-byte-order >=0.1.5 && <0.2
, parser-combinators >=1.2.1 && <1.4
, primitive >=0.7.0.1 && <0.8
- , tagged >=0.8.6 && <0.9
, text >=1.2.3.1 && <1.3
, tree-diff >=0.1 && <0.3
, utility-ht >=0.0.15 && <0.1
@@ -128,9 +124,7 @@ test-suite tahoe-chk-tests
, base64-bytestring >=1.0.0.3 && <1.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
- , crypto-api >=0.13.3 && <0.14
, cryptonite >=0.27 && <0.30
, directory >=1.3.3 && <1.4
, fec >=0.1.1 && <0.2
@@ -140,7 +134,6 @@ test-suite tahoe-chk-tests
, megaparsec >=8.0 && <9.3
, memory >=0.15 && <0.17
, scientific >=0.3.6.2 && <0.4
- , tagged >=0.8.6 && <0.9
, tahoe-chk
, tasty >=1.2.3 && <1.5
, tasty-hedgehog >=1.0.0.2 && <1.2
diff --git a/test/SpecCHK.hs b/test/SpecCHK.hs
index 157e32c..066ca15 100644
--- a/test/SpecCHK.hs
+++ b/test/SpecCHK.hs
@@ -11,13 +11,9 @@ import Control.Arrow (
)
import Control.Lens (view)
import Control.Monad.IO.Class (MonadIO (liftIO))
-import Crypto.Cipher.AES128 (
- AESKey128,
- )
-import Crypto.Classes (
- encode,
- )
+import Crypto.Cipher.AES (AES128)
import qualified Data.Binary as Binary
+import Data.ByteArray (convert)
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as Base64
import qualified Data.ByteString.Lazy as BL
@@ -54,8 +50,9 @@ import qualified Hedgehog.Range as Range
import Tahoe.CHK (padCiphertext)
import qualified Tahoe.CHK (decode, encode, segmentCiphertext)
import Tahoe.CHK.Capability (Reader, dangerRealShow, pCapability, pReader, verifier)
+import Tahoe.CHK.Cipher (Key)
import Tahoe.CHK.Crypto (ciphertextSegmentHash', convergenceSecretLength)
-import Tahoe.CHK.Encrypt (encrypt)
+import Tahoe.CHK.Encrypt (encryptLazy)
import Tahoe.CHK.Share (
Share (
_blockSize
@@ -112,7 +109,7 @@ import Vectors (
A hard-coded convergence secret is used for simplicity and reproducibility.
-}
makeValidShares :: Parameters -> BL.ByteString -> IO ([Share], Reader)
-makeValidShares params plaintext = Tahoe.CHK.encode key params (encrypt key plaintext)
+makeValidShares params plaintext = Tahoe.CHK.encode key params (encryptLazy key plaintext)
where
key = getConvergentKey "secret" params plaintext
@@ -245,7 +242,7 @@ wellKnownCase :: WellKnown -> Assertion
wellKnownCase WellKnown{..} =
do
uploadable <- memoryUploadableWithConvergence wellKnownConvergenceSecret (fromIntegral $ BL.length wellKnownPlaintext) wellKnownPlaintext wellKnownParameters
- let ciphertext = encrypt (uploadableKey uploadable) wellKnownPlaintext
+ let ciphertext = encryptLazy (uploadableKey uploadable) wellKnownPlaintext
(shares', cap) <- Tahoe.CHK.encode (uploadableKey uploadable) wellKnownParameters ciphertext
let allValid = replicate (fromIntegral $ paramTotalShares wellKnownParameters) True
@@ -331,7 +328,7 @@ testEncrypt =
assertEqual
"expected convergence key"
"oBcuR/wKdCgCV2GKKXqiNg=="
- (Base64.encode $ encode convergenceKey)
+ (Base64.encode $ convert convergenceKey)
let b64ciphertext = Base64.encode (BL.toStrict ciphertext)
assertEqual "known result" knownCorrect b64ciphertext
]
@@ -345,9 +342,9 @@ testEncrypt =
plaintext = "hello world"
ciphertext :: BL.ByteString
- ciphertext = encrypt convergenceKey plaintext
+ ciphertext = encryptLazy convergenceKey plaintext
- convergenceKey :: AESKey128
+ convergenceKey :: Key AES128
convergenceKey = getConvergentKey convergenceSecret params plaintext
convergenceSecret = B.replicate convergenceSecretLength 0x42
diff --git a/test/SpecCrypto.hs b/test/SpecCrypto.hs
index 0b07b6b..09f9366 100644
--- a/test/SpecCrypto.hs
+++ b/test/SpecCrypto.hs
@@ -5,19 +5,14 @@ module SpecCrypto (
tests,
) where
-import Crypto.Cipher.AES128 (
- AESKey128,
- )
-import Crypto.Classes (
- buildKey,
- keyLength,
- )
-import Crypto.Types (ByteLength)
+import Crypto.Cipher.AES (AES128)
+import Crypto.Cipher.Types (Cipher (..), KeySizeSpecifier (..))
+import Crypto.Error (CryptoFailable (CryptoPassed))
import qualified Data.ByteString as B
import Data.Char (
ord,
)
-import Data.Tagged (Tagged, untag)
+import Tahoe.CHK.Cipher (Key)
import Tahoe.CHK.Crypto (
blockHash',
ciphertextSegmentHash',
@@ -64,7 +59,7 @@ tests =
-- Adapted from allmydata.test.test_hashutil.HashUtilTests.test_known_answers
assertEqual
"known value"
- (Just "\xb5\x4c\x60\xc5\xb1\x26\x46\xf0\x77\x0\xc4\x4c\x8b\x75\xb9\x48")
+ (CryptoPassed "\xb5\x4c\x60\xc5\xb1\x26\x46\xf0\x77\x0\xc4\x4c\x8b\x75\xb9\x48")
(storageIndexHash <$> xKey)
, testCase "tagged hash length" $ do
-- The length of the result equals the given size.
@@ -129,4 +124,10 @@ tests =
]
]
where
- xKey = buildKey (B.replicate (untag (keyLength :: Tagged AESKey128 ByteLength)) . fromIntegral . ord $ 'x') :: Maybe AESKey128
+ xKey = cipherInit keyBytes :: CryptoFailable (Key AES128)
+ keyBytes = B.replicate keySize (fromIntegral $ ord 'x')
+ keySize = case cipherKeySize @(Key AES128) undefined of
+ KeySizeRange _ high -> high
+ KeySizeEnum [] -> error "no key sizes!"
+ KeySizeEnum (s : _) -> s
+ KeySizeFixed s -> s
diff --git a/test/SpecUpload.hs b/test/SpecUpload.hs
index 056ddfa..74606a7 100644
--- a/test/SpecUpload.hs
+++ b/test/SpecUpload.hs
@@ -2,13 +2,11 @@ module SpecUpload (
tests,
) where
+import Data.ByteArray (convert)
import Data.ByteString.Base32 (
encodeBase32Unpadded,
)
import Data.Maybe (mapMaybe)
-import Data.Serialize (
- encode,
- )
import Test.Tasty (
TestTree,
@@ -153,7 +151,7 @@ testConvergence =
assertEqual
"The key matches the known correct result"
expectedKeyBytes
- (encodeBase32Unpadded . encode $ key)
+ (encodeBase32Unpadded . convert $ key)
where
key = getConvergentKey secret params (BL.fromStrict dataContent)
--
GitLab