diff --git a/src/Tahoe/CHK.hs b/src/Tahoe/CHK.hs index 434f0dee9104a9a579111673128ec2529bea0be1..f6d5f71aa30110cd7b0af08217896876e555fa4c 100644 --- a/src/Tahoe/CHK.hs +++ b/src/Tahoe/CHK.hs @@ -73,9 +73,7 @@ module Tahoe.CHK ( import qualified Codec.FEC as ZFEC import Control.Applicative (Alternative (empty)) import Control.Lens (view) -import Crypto.Cipher.AES128 ( - AESKey128, - ) +import Crypto.Cipher.AES (AES128) import Crypto.Hash ( Context, HashAlgorithm, @@ -93,6 +91,7 @@ import Data.List.Extra (snoc) import Data.Maybe (fromJust, mapMaybe) import Data.Word (Word64) import qualified Tahoe.CHK.Capability as Cap +import Tahoe.CHK.Cipher (Key) import Tahoe.CHK.Crypto ( blockHash', ciphertextSegmentHash', @@ -293,7 +292,7 @@ padCiphertext requiredShares bs -} encode :: -- | The encryption/decryption key. - AESKey128 -> + Key AES128 -> -- | The ZFEC parameters for this encoding. This determines how many shares -- will come out of this function. Parameters -> diff --git a/src/Tahoe/CHK/Capability.hs b/src/Tahoe/CHK/Capability.hs index b2fa06893d0c6186adaa42d5e54673c856db159d..a0bc62b07b107e43f23b958bd79b3d3be1d9099e 100644 --- a/src/Tahoe/CHK/Capability.hs +++ b/src/Tahoe/CHK/Capability.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} module Tahoe.CHK.Capability ( CHK (..), @@ -23,15 +24,12 @@ module Tahoe.CHK.Capability ( import Control.Lens (view) import Control.Lens.TH (makeLenses) -import Crypto.Cipher.AES128 ( - AESKey128, - ) -import Crypto.Classes (buildKey) +import Crypto.Cipher.AES (AES128) +import Crypto.Cipher.Types (Cipher (cipherInit)) +import Crypto.Error (maybeCryptoError) +import Data.ByteArray (convert) import qualified Data.ByteString as B import qualified Data.ByteString.Base32 as B -import Data.Serialize ( - encode, - ) import qualified Data.Set as Set import qualified Data.Text as T import qualified Data.Text.Encoding as T @@ -39,6 +37,7 @@ import Data.TreeDiff.Class (ToExpr (..)) import Data.Void (Void) import Data.Word (Word16, Word64) import GHC.Generics (Generic) +import Tahoe.CHK.Cipher (Key (..)) import Tahoe.CHK.Crypto (storageIndexHash) import qualified Tahoe.CHK.Parsing import Text.Megaparsec (ErrorFancy (ErrorFail), Parsec, count, fancyFailure, oneOf, try, (<|>)) @@ -138,7 +137,7 @@ data Reader = Reader -- key to turn the original plaintext into ciphertext and back again. The -- read key is also used to derive the verify key for the verify -- capability. See ``storageIndexHash``. - _readKey :: AESKey128 + _readKey :: Key AES128 , -- | The verify capability for this read capability. _verifier :: Verifier } @@ -169,7 +168,7 @@ instance Show Reader where ":" [ "URI" , "CHK" - , shorten 4 . showBase32 . encode $ view readKey reader + , shorten 4 . showBase32 . convert . keyBytes $ view readKey reader , shorten 4 . showBase32 $ view (verifier . fingerprint) reader , showT $ view (verifier . required) reader , showT $ view (verifier . total) reader @@ -179,7 +178,7 @@ instance Show Reader where -- Construct a key with Eq and Ord instances for the Reader Eq and Ord -- instances. readerKey :: Reader -> (B.ByteString, Verifier) -readerKey r = (encode $ view readKey r, view verifier r) +readerKey r = (convert $ view readKey r, view verifier r) {- | A "Content-Hash-Key" (CHK) capability is small value that can be used to perform some operation on a (usually) larger value that may be stored @@ -215,7 +214,7 @@ dangerRealShow (CHKReader r) = ":" [ "URI" , "CHK" - , showBase32 . encode $ view readKey r + , showBase32 . convert $ view readKey r , showBase32 $ view (verifier . fingerprint) r , showT $ view (verifier . required) r , showT $ view (verifier . total) r @@ -248,7 +247,7 @@ pReader = makeReader <$> ( string "URI:CHK:" *> pBase32 rfc3548Alphabet 128 - >>= maybe (fancyFailure . Set.singleton . ErrorFail . T.unpack $ "Failed to build AESKey128 from CHK read key bytes") pure . buildKey + >>= maybe (fancyFailure . Set.singleton . ErrorFail . T.unpack $ "Failed to build AESKey128 from CHK read key bytes") pure . maybeCryptoError . cipherInit ) <* char ':' <*> pBase32 rfc3548Alphabet 256 @@ -262,7 +261,7 @@ pReader = {- | Construct a CHK read capability from its components. This includes the correct derivation of the corresponding CHK verify capability. -} -makeReader :: AESKey128 -> B.ByteString -> Word16 -> Word16 -> Integer -> Reader +makeReader :: Key AES128 -> B.ByteString -> Word16 -> Word16 -> Integer -> Reader makeReader readKey' fingerprint' required' total' size' = Reader readKey' (deriveVerifier readKey' fingerprint' required' total' size') @@ -271,7 +270,7 @@ makeReader readKey' fingerprint' required' total' size' = -} deriveVerifier :: -- | The read key - AESKey128 -> + Key AES128 -> -- | The fingerprint B.ByteString -> -- | The required number of shares diff --git a/src/Tahoe/CHK/Cipher.hs b/src/Tahoe/CHK/Cipher.hs new file mode 100644 index 0000000000000000000000000000000000000000..8bfe38daa9c7ab015d4548a7f11fabe040a3f17a --- /dev/null +++ b/src/Tahoe/CHK/Cipher.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} + +module Tahoe.CHK.Cipher ( + Key (keyBytes, keyCipher), +) where + +import Control.DeepSeq (NFData) +import Crypto.Cipher.Types (Cipher (..)) +import Data.ByteArray (ScrubbedBytes) +import qualified Data.ByteArray as BA +import GHC.Generics (Generic) + +data Key cipher = Key {keyBytes :: ScrubbedBytes, keyCipher :: cipher} + +deriving instance Generic (Key cipher) +deriving instance NFData cipher => NFData (Key cipher) + +instance forall cipher. Cipher cipher => Cipher (Key cipher) where + cipherInit bs = Key (BA.convert bs) <$> cipherInit bs + cipherName _ = cipherName @cipher undefined + cipherKeySize _ = cipherKeySize @cipher undefined + +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 f994f4770e09673fb1f0b30771663bb688fcf6b2..b332c0a8feda32f12fe07b66bb4ce982a8d66476 100644 --- a/src/Tahoe/CHK/Crypto.hs +++ b/src/Tahoe/CHK/Crypto.hs @@ -25,10 +25,6 @@ module Tahoe.CHK.Crypto ( import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL -import Data.Serialize ( - encode, - ) - import Crypto.Hash ( Digest, HashAlgorithm, @@ -37,28 +33,25 @@ import Crypto.Hash ( hashlazy, ) import Crypto.Types (ByteLength) +import Data.ByteArray (convert) +import Crypto.Cipher.AES (AES128) import Crypto.Hash.Algorithms ( SHA1, SHA256 (SHA256), ) -import Crypto.Cipher.AES128 ( - AESKey128, - ) - -import Tahoe.Netstring ( - netstring, - ) - +import Tahoe.CHK.Cipher (Key) +import Tahoe.CHK.SHA256d (Digest' (..), SHA256d, toBytes) +import Tahoe.CHK.Types (Parameters (Parameters), StorageIndex) import Tahoe.CHK.URIExtension ( URIExtension, showBytes, uriExtensionToBytes, ) - -import Tahoe.CHK.SHA256d (Digest' (..), SHA256d, toBytes) -import Tahoe.CHK.Types (Parameters (Parameters), StorageIndex) +import Tahoe.Netstring ( + netstring, + ) sha1 :: B.ByteString -> B.ByteString sha1 xs = toBytes (hash xs :: Digest SHA1) @@ -106,8 +99,8 @@ storageIndexTag = "allmydata_immutable_key_to_storage_index_v1" -- Compute the storage index for a given encryption key -- allmydata.util.hashutil.storage_index_hash -storageIndexHash :: AESKey128 -> StorageIndex -storageIndexHash = taggedHash storageIndexLength storageIndexTag . encode +storageIndexHash :: Key AES128 -> StorageIndex +storageIndexHash = taggedHash storageIndexLength storageIndexTag . convert ciphertextTag :: B.ByteString ciphertextTag = "allmydata_crypttext_v1" diff --git a/src/Tahoe/CHK/Encrypt.hs b/src/Tahoe/CHK/Encrypt.hs index 787903b336341ffc4566d6d021f1ada1af741d30..65a2f231e9d2cdca2921fbe016bece3b8a6a2aae 100644 --- a/src/Tahoe/CHK/Encrypt.hs +++ b/src/Tahoe/CHK/Encrypt.hs @@ -1,8 +1,8 @@ -- | Support the encryption requirements of CHK. module Tahoe.CHK.Encrypt (encrypt, decrypt) where -import Crypto.Cipher.AES128 (AESKey128, BlockCipher (ctrLazy), zeroIV) -import qualified Data.ByteString.Lazy as LB +import Crypto.Cipher.Types (BlockCipher (ctrCombine), nullIV) +import Data.ByteArray (ByteArray) {- | AES128-CTR encrypt a byte string in the manner used by CHK. @@ -10,9 +10,9 @@ import qualified Data.ByteString.Lazy as LB The only noteworthy piece here is that encryption starts with the zero IV. -} -encrypt :: AESKey128 -> LB.ByteString -> LB.ByteString -encrypt key plaintext = fst $ ctrLazy key zeroIV plaintext +encrypt :: (BlockCipher cipher, ByteArray ba) => cipher -> ba -> ba +encrypt key = ctrCombine key nullIV -- | AES128-CTR decrypt a byte string in the manner used by CHK. -decrypt :: AESKey128 -> LB.ByteString -> LB.ByteString +decrypt :: (BlockCipher cipher, ByteArray ba) => cipher -> ba -> ba decrypt = encrypt diff --git a/src/Tahoe/CHK/Upload.hs b/src/Tahoe/CHK/Upload.hs index 56cd72f97f2eed3eb9b19d4e7946a603ad19ad35..2e18f010b39323e2ac3e3e2d50c93a510216d597 100644 --- a/src/Tahoe/CHK/Upload.hs +++ b/src/Tahoe/CHK/Upload.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} module Tahoe.CHK.Upload ( UploadResult (uploadResultReadCap, uploadResultExistingShares, uploadResultShareMap), @@ -48,11 +49,6 @@ import qualified Data.Set as Set import qualified Data.Map.Strict as Map -import Crypto.Classes ( - buildKey, - buildKeyIO, - ) - import qualified Tahoe.CHK.Capability as Cap import System.IO ( @@ -63,10 +59,11 @@ import System.IO ( openFile, ) -import Crypto.Cipher.AES128 ( - AESKey128, - ) +import Crypto.Cipher.AES (AES128) +import Crypto.Cipher.Types (BlockCipher, Cipher (cipherInit)) +import Crypto.Random (getRandomBytes) +import Tahoe.CHK.Cipher (Key) import Tahoe.CHK.Crypto ( convergenceEncryptionHashLazy, storageIndexHash, @@ -85,6 +82,7 @@ import Tahoe.CHK.Types ( import Tahoe.Util (nextMultipleOf) +import Crypto.Error (maybeCryptoError) import Data.Tuple.Extra (thd3) import Tahoe.CHK ( encode, @@ -93,7 +91,7 @@ import Tahoe.CHK.Encrypt (encrypt) -- Some data that can be uploaded. data Uploadable = Uploadable - { uploadableKey :: AESKey128 + { uploadableKey :: Key AES128 , uploadableSize :: Size , uploadableParameters :: Parameters , uploadableReadCleartext :: Integer -> IO B.ByteString @@ -210,7 +208,7 @@ upload :: -- | The servers to consider uploading shares to. [StorageServer] -> -- | The encryption key (to derive the storage index). - AESKey128 -> + Key AES128 -> -- | The encoding parameters (XXX only for happy, right?) Parameters -> -- | The share data to upload. @@ -278,7 +276,7 @@ adjustSegmentSize (Parameters segmentSize total happy required) dataSize = nextMultipleOf required . min segmentSize -- Create an uploadable with the given key. -filesystemUploadable :: AESKey128 -> FilePath -> Parameters -> IO Uploadable +filesystemUploadable :: Key AES128 -> FilePath -> Parameters -> IO Uploadable filesystemUploadable key path params = do fhandle <- openBinaryFile path ReadMode fsize <- hFileSize fhandle @@ -315,7 +313,7 @@ memoryUploadableWithConvergence secret size content params = let key = getConvergentKey secret (adjustSegmentSize params size) content in memoryUploadable key size content params -memoryUploadable :: AESKey128 -> Integer -> BL.ByteString -> Parameters -> IO Uploadable +memoryUploadable :: Key AES128 -> Integer -> BL.ByteString -> Parameters -> IO Uploadable memoryUploadable key size content params = let makeReader :: BL.ByteString -> IO (Integer -> IO BL.ByteString) makeReader allContent = @@ -335,14 +333,19 @@ memoryUploadable key size content params = } -- allmydata.immutable.upload.FileHandle._get_encryption_key_convergent -getConvergentKey :: B.ByteString -> Parameters -> BL.ByteString -> AESKey128 +getConvergentKey :: B.ByteString -> Parameters -> BL.ByteString -> Key AES128 getConvergentKey secret params content = - fromJust . buildKey $ convergenceEncryptionHashLazy secret params content + fromJust . maybeCryptoError . cipherInit $ convergenceEncryptionHashLazy secret params content + +buildKeyIO :: forall cipher. BlockCipher cipher => IO (Key cipher) +buildKeyIO = do + keyBytes <- getRandomBytes (cipherKeySize @cipher undefined) + fromJust . maybeCryptoError . cipherInit $ keyBytes -- Create an uploadable with a random key. filesystemUploadableRandomConvergence :: FilePath -> Parameters -> IO Uploadable filesystemUploadableRandomConvergence path params = do - key <- buildKeyIO :: IO AESKey128 + key <- buildKeyIO :: IO (Key AES128) filesystemUploadable key path params prettyFormatSharemap :: ShareMap -> Text diff --git a/tahoe-chk.cabal b/tahoe-chk.cabal index 570d1785376ae3693009c7a2b005564239f3ddad..05d2890838d06bbcb0bba1d259815fba90b3e27c 100644 --- a/tahoe-chk.cabal +++ b/tahoe-chk.cabal @@ -31,6 +31,7 @@ library exposed-modules: Tahoe.CHK Tahoe.CHK.Capability + Tahoe.CHK.Cipher Tahoe.CHK.Crypto Tahoe.CHK.Encrypt Tahoe.CHK.Merkle @@ -59,11 +60,11 @@ library , binary >=0.8.6 && <0.9 , bytestring >=0.10.8.2 && <0.11 , cereal >=0.5.8.1 && <0.6 - , cipher-aes128 >=0.7.0.5 && <0.8 , 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 , extra >=1.7.7 && <1.8 , fec >=0.1.1 && <0.2 @@ -128,7 +129,6 @@ test-suite tahoe-chk-tests , binary >=0.8.6 && <0.9 , bytestring >=0.10.8.2 && <0.11 , cereal >=0.5.8.1 && <0.6 - , cipher-aes128 >=0.7.0.5 && <0.8 , containers >=0.6.0.1 && <0.7 , crypto-api >=0.13.3 && <0.14 , cryptonite >=0.27 && <0.30