Crypto.hs

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