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 :: Digest a -> ByteString
toBytes = [Word8] -> ByteString
B.pack ([Word8] -> ByteString)
-> (Digest a -> [Word8]) -> Digest a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest a -> [Word8]
forall a. ByteArrayAccess a => a -> [Word8]
BA.unpack

sha1 :: B.ByteString -> B.ByteString
sha1 :: ByteString -> ByteString
sha1 ByteString
xs = Digest SHA1 -> ByteString
forall a. Digest a -> ByteString
toBytes (ByteString -> Digest SHA1
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash ByteString
xs :: Digest SHA1)

sha256 :: B.ByteString -> B.ByteString
sha256 :: ByteString -> ByteString
sha256 ByteString
xs = Digest SHA256 -> ByteString
forall a. Digest a -> ByteString
toBytes (ByteString -> Digest SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash ByteString
xs :: Digest SHA256)

sha256d :: B.ByteString -> B.ByteString
sha256d :: ByteString -> ByteString
sha256d = ByteString -> ByteString
sha256 (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
sha256

taggedHash :: Int -> B.ByteString -> B.ByteString -> B.ByteString
taggedHash :: Int -> ByteString -> ByteString -> ByteString
taggedHash Int
size ByteString
tag ByteString
bytes = Int -> ByteString -> ByteString
B.take Int
size (ByteString -> ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
sha256d (ByteString -> ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString -> ByteString
netstring ByteString
tag, ByteString
bytes]

taggedPairHash :: Int -> B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString
taggedPairHash :: Int -> ByteString -> ByteString -> ByteString -> ByteString
taggedPairHash Int
size ByteString
tag ByteString
left ByteString
right = Int -> ByteString -> ByteString
B.take Int
size (ByteString -> ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
sha256d (ByteString -> ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString -> ByteString
netstring ByteString
tag, ByteString -> ByteString
netstring ByteString
left, ByteString -> ByteString
netstring ByteString
right]

blockTag :: B.ByteString
blockTag :: ByteString
blockTag = ByteString
"allmydata_encoded_subshare_v1"

-- allmydata.util.hashutil.block_hash
blockHash :: B.ByteString -> B.ByteString
blockHash :: ByteString -> ByteString
blockHash = Int -> ByteString -> ByteString -> ByteString
taggedHash (SHA256 -> Int
forall a. HashAlgorithm a => a -> Int
hashDigestSize SHA256
SHA256) ByteString
blockTag

storageIndexTag :: B.ByteString
storageIndexTag :: ByteString
storageIndexTag = ByteString
"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 :: AESKey128 -> ByteString
storageIndexHash = Int -> ByteString -> ByteString -> ByteString
taggedHash Int
storageIndexLength ByteString
storageIndexTag (ByteString -> ByteString)
-> (AESKey128 -> ByteString) -> AESKey128 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AESKey128 -> ByteString
forall a. Serialize a => a -> ByteString
encode

ciphertextTag :: B.ByteString
ciphertextTag :: ByteString
ciphertextTag = ByteString
"allmydata_crypttext_v1"

ciphertextSegmentTag :: B.ByteString
ciphertextSegmentTag :: ByteString
ciphertextSegmentTag = ByteString
"allmydata_crypttext_segment_v1"

ciphertextSegmentHash :: B.ByteString -> B.ByteString
ciphertextSegmentHash :: ByteString -> ByteString
ciphertextSegmentHash = Int -> ByteString -> ByteString -> ByteString
taggedHash (SHA256 -> Int
forall a. HashAlgorithm a => a -> Int
hashDigestSize SHA256
SHA256) ByteString
ciphertextSegmentTag

uriExtensionTag :: B.ByteString
uriExtensionTag :: ByteString
uriExtensionTag = ByteString
"allmydata_uri_extension_v1"

uriExtensionHash :: URIExtension -> B.ByteString
uriExtensionHash :: URIExtension -> ByteString
uriExtensionHash = Int -> ByteString -> ByteString -> ByteString
taggedHash (SHA256 -> Int
forall a. HashAlgorithm a => a -> Int
hashDigestSize SHA256
SHA256) ByteString
uriExtensionTag (ByteString -> ByteString)
-> (URIExtension -> ByteString) -> URIExtension -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIExtension -> ByteString
uriExtensionToBytes

convergenceEncryptionTagPrefix :: B.ByteString
convergenceEncryptionTagPrefix :: ByteString
convergenceEncryptionTagPrefix = ByteString
"allmydata_immutable_content_to_key_with_added_secret_v1+"

convergenceEncryptionTag :: B.ByteString -> Parameters -> B.ByteString
convergenceEncryptionTag :: ByteString -> Parameters -> ByteString
convergenceEncryptionTag ByteString
secret (Parameters SegmentSize
segmentSize Total
total Word8
_ Total
required) =
    ByteString
tag
  where
    tag :: ByteString
tag = [ByteString] -> ByteString
B.concat [ByteString
convergenceEncryptionTagPrefix, ByteString -> ByteString
netstring ByteString
secret, ByteString -> ByteString
netstring ByteString
paramTag]
    paramTag :: ByteString
paramTag = ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
"," ([ByteString] -> ByteString)
-> ([SegmentSize] -> [ByteString]) -> [SegmentSize] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SegmentSize -> ByteString) -> [SegmentSize] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map SegmentSize -> ByteString
forall s. Show s => s -> ByteString
showBytes ([SegmentSize] -> ByteString) -> [SegmentSize] -> ByteString
forall a b. (a -> b) -> a -> b
$ [SegmentSize
requiredI, SegmentSize
totalI, SegmentSize
segmentSizeI]
    requiredI :: SegmentSize
requiredI = Total -> SegmentSize
forall a. Integral a => a -> SegmentSize
toInteger Total
required
    totalI :: SegmentSize
totalI = Total -> SegmentSize
forall a. Integral a => a -> SegmentSize
toInteger Total
total
    segmentSizeI :: SegmentSize
segmentSizeI = SegmentSize -> SegmentSize
forall a. Integral a => a -> SegmentSize
toInteger SegmentSize
segmentSize

-- Compute the strict convergence encryption hash on a lazy data parameter.
convergenceEncryptionHashLazy :: B.ByteString -> Parameters -> BL.ByteString -> B.ByteString
convergenceEncryptionHashLazy :: ByteString -> Parameters -> ByteString -> ByteString
convergenceEncryptionHashLazy ByteString
secret Parameters
params ByteString
bytes =
    -- It was somewhat helpful during development/debugging to make this
    -- function return this instead:
    --
    --     BL.toStrict toHash
    --
    Int -> ByteString -> ByteString
B.take Int
convergenceSecretLength ByteString
theSHA256d
  where
    theSHA256d :: ByteString
theSHA256d = Digest SHA256 -> ByteString
forall a. Digest a -> ByteString
toBytes (ByteString -> Digest SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash ByteString
theSHA256 :: Digest SHA256)
    theSHA256 :: ByteString
theSHA256 = Digest SHA256 -> ByteString
forall a. Digest a -> ByteString
toBytes (ByteString -> Digest SHA256
forall a. HashAlgorithm a => ByteString -> Digest a
hashlazy ByteString
toHash :: Digest SHA256)

    toHash :: BL.ByteString
    toHash :: ByteString
toHash = [ByteString] -> ByteString
BL.concat [ByteString
tag, ByteString
bytes]

    tag :: ByteString
tag = ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
netstring (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Parameters -> ByteString
convergenceEncryptionTag ByteString
secret Parameters
params

convergenceSecretLength :: ByteLength
convergenceSecretLength :: Int
convergenceSecretLength = Int
16

storageIndexLength :: ByteLength
storageIndexLength :: Int
storageIndexLength = Int
16