module Tahoe.CHK.Crypto ( sha1, sha256, sha256d, storageIndexLength, taggedHash, taggedPairHash, blockHash, storageIndexHash, ciphertextTag, ciphertextSegmentHash, uriExtensionHash, convergenceEncryptionTag, convergenceEncryptionHashLazy, convergenceSecretLength, ) where import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified Data.ByteArray as BA import Data.Serialize ( encode, ) import Crypto.Hash ( Digest, hash, hashDigestSize, hashlazy, ) import Crypto.Types (ByteLength) import Crypto.Hash.Algorithms ( SHA1, SHA256 (SHA256), ) import Crypto.Cipher.AES128 ( AESKey128, ) import Tahoe.Netstring ( netstring, ) import Tahoe.CHK.URIExtension ( URIExtension, showBytes, uriExtensionToBytes, ) import Tahoe.CHK.Types (Parameters (Parameters), StorageIndex) toBytes :: Digest a -> B.ByteString toBytes = B.pack . BA.unpack sha1 :: B.ByteString -> B.ByteString sha1 xs = toBytes (hash xs :: Digest SHA1) sha256 :: B.ByteString -> B.ByteString sha256 xs = toBytes (hash xs :: Digest SHA256) sha256d :: B.ByteString -> B.ByteString sha256d = sha256 . sha256 taggedHash :: Int -> B.ByteString -> B.ByteString -> B.ByteString taggedHash size tag bytes = B.take size . sha256d . B.concat $ [netstring tag, bytes] taggedPairHash :: Int -> B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString taggedPairHash size tag left right = B.take size . sha256d . B.concat $ [netstring tag, netstring left, netstring right] blockTag :: B.ByteString blockTag = "allmydata_encoded_subshare_v1" -- allmydata.util.hashutil.block_hash blockHash :: B.ByteString -> B.ByteString blockHash = taggedHash (hashDigestSize SHA256) blockTag storageIndexTag :: B.ByteString 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 ciphertextTag :: B.ByteString ciphertextTag = "allmydata_crypttext_v1" ciphertextSegmentTag :: B.ByteString ciphertextSegmentTag = "allmydata_crypttext_segment_v1" ciphertextSegmentHash :: B.ByteString -> B.ByteString ciphertextSegmentHash = taggedHash (hashDigestSize SHA256) ciphertextSegmentTag uriExtensionTag :: B.ByteString uriExtensionTag = "allmydata_uri_extension_v1" uriExtensionHash :: URIExtension -> B.ByteString uriExtensionHash = taggedHash (hashDigestSize SHA256) uriExtensionTag . uriExtensionToBytes convergenceEncryptionTagPrefix :: B.ByteString convergenceEncryptionTagPrefix = "allmydata_immutable_content_to_key_with_added_secret_v1+" convergenceEncryptionTag :: B.ByteString -> Parameters -> B.ByteString convergenceEncryptionTag secret (Parameters segmentSize total _ required) = tag where tag = B.concat [convergenceEncryptionTagPrefix, netstring secret, netstring paramTag] paramTag = B.intercalate "," . map showBytes $ [requiredI, totalI, segmentSizeI] requiredI = toInteger required totalI = toInteger total segmentSizeI = toInteger segmentSize -- Compute the strict convergence encryption hash on a lazy data parameter. convergenceEncryptionHashLazy :: B.ByteString -> Parameters -> BL.ByteString -> B.ByteString convergenceEncryptionHashLazy secret params bytes = -- It was somewhat helpful during development/debugging to make this -- function return this instead: -- -- BL.toStrict toHash -- B.take convergenceSecretLength theSHA256d where theSHA256d = toBytes (hash theSHA256 :: Digest SHA256) theSHA256 = toBytes (hashlazy toHash :: Digest SHA256) toHash :: BL.ByteString toHash = BL.concat [tag, bytes] tag = BL.fromStrict . netstring $ convergenceEncryptionTag secret params convergenceSecretLength :: ByteLength convergenceSecretLength = 16 storageIndexLength :: ByteLength storageIndexLength = 16