{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
module Tahoe.CHK (
zfec,
zunfec,
encode,
decode,
padCiphertext,
segmentCiphertext,
DecodeError (..),
) where
import qualified Codec.FEC as ZFEC
import Control.Applicative (Alternative (empty))
import Control.Lens (view)
import Crypto.Cipher.AES (AES128)
import Crypto.Hash (
Context,
HashAlgorithm,
hashFinalize,
hashInit,
hashUpdate,
)
import Data.Bifunctor (Bifunctor (bimap), first, second)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
import Data.Foldable (foldlM)
import Data.Int (Int64)
import Data.List (partition, sort, transpose)
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',
ciphertextTag,
uriExtensionHash,
)
import Tahoe.CHK.Merkle (
MerkleTree,
buildTreeOutOfAllTheNodes,
leafHashes,
leafNumberToNodeNumber,
makeTreePartial,
neededHashes,
rootHash,
)
import Tahoe.CHK.SHA256d (Digest' (Digest'), zero)
import Tahoe.CHK.Share (Share (..), crypttextHashTree, uriExtension)
import Tahoe.CHK.Types (
BlockHash,
CrypttextHash,
Parameters (..),
Required,
requiredToInt,
totalToInt,
)
import Tahoe.CHK.URIExtension (
URIExtension (..),
codecParams,
)
import Tahoe.CHK.Validate (
matchingBlockHashRoot,
matchingCrypttextHashRoot,
shareValidBlocks,
validFingerprint,
validSegments,
validShareRootHash,
)
import Tahoe.Netstring (
netstring,
)
import Tahoe.Util (
ceilDiv,
chunkedBy,
nextMultipleOf,
nextPowerOf,
)
zfec ::
Int ->
Int ->
B.ByteString ->
IO [B.ByteString]
zfec :: Int -> Int -> ByteString -> IO [ByteString]
zfec Int
k Int
n ByteString
segment =
[ByteString] -> IO [ByteString]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ByteString] -> IO [ByteString])
-> [ByteString] -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$ [ByteString]
chunks [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ FECParams -> [ByteString] -> [ByteString]
ZFEC.encode (Int -> Int -> FECParams
ZFEC.fec Int
k Int
n) [ByteString]
chunks
where
chunks_ :: [ByteString]
chunks_ = Int -> ByteString -> [ByteString]
chunkedBy (ByteString -> Int
B.length ByteString
segment Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
k) ByteString
segment
_msg :: String
_msg =
String
"zfec"
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" k="
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
k
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" n="
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", segment len "
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
B.length ByteString
segment)
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", chunk lengths "
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Int] -> String
forall a. Show a => a -> String
show ((ByteString -> Int) -> [ByteString] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Int
B.length [ByteString]
chunks_)
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", segment "
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
segment
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"-> chunks "
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [ByteString] -> String
forall a. Show a => a -> String
show [ByteString]
chunks_
chunks :: [ByteString]
chunks = [ByteString]
chunks_
zfecLazy :: Int -> Int -> LB.ByteString -> IO [LB.ByteString]
zfecLazy :: Int -> Int -> ByteString -> IO [ByteString]
zfecLazy Int
k Int
n ByteString
segment = (ByteString -> ByteString
LB.fromStrict (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([ByteString] -> [ByteString])
-> IO [ByteString] -> IO [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> ByteString -> IO [ByteString]
zfec Int
k Int
n (ByteString -> ByteString
LB.toStrict ByteString
segment)
zunfec ::
Int ->
Int ->
[(Int, B.ByteString)] ->
IO B.ByteString
zunfec :: Int -> Int -> [(Int, ByteString)] -> IO ByteString
zunfec Int
k Int
n [(Int, ByteString)]
blocks = ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat (FECParams -> [(Int, ByteString)] -> [ByteString]
ZFEC.decode (Int -> Int -> FECParams
ZFEC.fec Int
k Int
n) [(Int, ByteString)]
blocks)
zunfecLazy :: Int -> Int -> [(Int, LB.ByteString)] -> IO LB.ByteString
zunfecLazy :: Int -> Int -> [(Int, ByteString)] -> IO ByteString
zunfecLazy Int
k Int
n [(Int, ByteString)]
blocks = do
ByteString
segment_ <- ByteString -> ByteString
LB.fromStrict (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> [(Int, ByteString)] -> IO ByteString
zunfec Int
k Int
n ((ByteString -> ByteString)
-> (Int, ByteString) -> (Int, ByteString)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ByteString -> ByteString
LB.toStrict ((Int, ByteString) -> (Int, ByteString))
-> [(Int, ByteString)] -> [(Int, ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, ByteString)]
blocks)
let _msg :: String
_msg =
String
"zunfec"
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" k="
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
k
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" n="
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" blocks="
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [(Int, ByteString)] -> String
forall a. Show a => a -> String
show [(Int, ByteString)]
blocks
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" -> segment "
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
segment_
ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
segment_
data EncodingState hash = CPState
{
EncodingState hash -> Context hash
cpCrypttextHash :: Crypto.Hash.Context hash
,
EncodingState hash -> [CrypttextHash hash]
cpCrypttextHashes :: [CrypttextHash hash]
,
EncodingState hash -> [[BlockHash hash]]
cpBlockHashes :: [[BlockHash hash]]
,
EncodingState hash -> [[ByteString]]
cpBlocks :: [[LB.ByteString]]
}
initEncodingState :: forall hash. HashAlgorithm hash => EncodingState hash
initEncodingState :: EncodingState hash
initEncodingState =
CPState :: forall hash.
Context hash
-> [CrypttextHash hash]
-> [[CrypttextHash hash]]
-> [[ByteString]]
-> EncodingState hash
CPState
{ cpCrypttextHash :: Context hash
cpCrypttextHash = Context hash -> ByteString -> Context hash
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
hashUpdate (HashAlgorithm hash => Context hash
forall a. HashAlgorithm a => Context a
hashInit @hash) (ByteString -> ByteString
netstring ByteString
ciphertextTag)
, cpCrypttextHashes :: [CrypttextHash hash]
cpCrypttextHashes = [CrypttextHash hash]
forall a. Monoid a => a
mempty
, cpBlockHashes :: [[CrypttextHash hash]]
cpBlockHashes = [[CrypttextHash hash]]
forall a. Monoid a => a
mempty
, cpBlocks :: [[ByteString]]
cpBlocks = [[ByteString]]
forall a. Monoid a => a
mempty
}
segmentCiphertext ::
Parameters ->
LB.ByteString ->
[LB.ByteString]
segmentCiphertext :: Parameters -> ByteString -> [ByteString]
segmentCiphertext Parameters{SegmentSize
paramSegmentSize :: Parameters -> SegmentSize
paramSegmentSize :: SegmentSize
paramSegmentSize} ByteString
ciphertext =
[ByteString]
result
where
result :: [ByteString]
result = [ByteString]
result_
result_ :: [ByteString]
result_ = ByteString -> ByteString
LB.fromStrict (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ByteString -> [ByteString]
chunkedBy (SegmentSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral SegmentSize
paramSegmentSize) (ByteString -> ByteString
LB.toStrict ByteString
ciphertext)
processCiphertext :: forall hash. HashAlgorithm hash => Parameters -> [LB.ByteString] -> IO (EncodingState hash)
processCiphertext :: Parameters -> [ByteString] -> IO (EncodingState hash)
processCiphertext Parameters{Required
paramRequiredShares :: Parameters -> Required
paramRequiredShares :: Required
paramRequiredShares, Required
paramTotalShares :: Parameters -> Required
paramTotalShares :: Required
paramTotalShares} =
(EncodingState hash -> ByteString -> IO (EncodingState hash))
-> EncodingState hash -> [ByteString] -> IO (EncodingState hash)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM EncodingState hash -> ByteString -> IO (EncodingState hash)
forall hash.
HashAlgorithm hash =>
EncodingState hash -> ByteString -> IO (EncodingState hash)
processSegment (HashAlgorithm hash => EncodingState hash
forall hash. HashAlgorithm hash => EncodingState hash
initEncodingState @hash)
where
processSegment :: EncodingState hash -> ByteString -> IO (EncodingState hash)
processSegment CPState{[[ByteString]]
[[BlockHash hash]]
[BlockHash hash]
Context hash
cpBlocks :: [[ByteString]]
cpBlockHashes :: [[BlockHash hash]]
cpCrypttextHashes :: [BlockHash hash]
cpCrypttextHash :: Context hash
cpBlocks :: forall hash. EncodingState hash -> [[ByteString]]
cpBlockHashes :: forall hash. EncodingState hash -> [[CrypttextHash hash]]
cpCrypttextHashes :: forall hash. EncodingState hash -> [CrypttextHash hash]
cpCrypttextHash :: forall hash. EncodingState hash -> Context hash
..} ByteString
segment = do
[ByteString]
blocks <-
Int -> Int -> ByteString -> IO [ByteString]
zfecLazy
(Required -> Int
requiredToInt Required
paramRequiredShares)
(Required -> Int
totalToInt Required
paramTotalShares)
(Required -> ByteString -> ByteString
padCiphertext Required
paramRequiredShares ByteString
segment)
EncodingState hash -> IO (EncodingState hash)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncodingState hash -> IO (EncodingState hash))
-> EncodingState hash -> IO (EncodingState hash)
forall a b. (a -> b) -> a -> b
$
CPState :: forall hash.
Context hash
-> [CrypttextHash hash]
-> [[CrypttextHash hash]]
-> [[ByteString]]
-> EncodingState hash
CPState
{ cpCrypttextHash :: Context hash
cpCrypttextHash = Context hash -> ByteString -> Context hash
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
hashUpdate Context hash
cpCrypttextHash (ByteString -> ByteString
LB.toStrict ByteString
segment)
, cpCrypttextHashes :: [BlockHash hash]
cpCrypttextHashes = [BlockHash hash] -> BlockHash hash -> [BlockHash hash]
forall a. [a] -> a -> [a]
snoc [BlockHash hash]
cpCrypttextHashes (ByteString -> BlockHash hash
forall hash. HashAlgorithm hash => ByteString -> Digest' hash
ciphertextSegmentHash' (ByteString -> ByteString
LB.toStrict ByteString
segment))
, cpBlockHashes :: [[BlockHash hash]]
cpBlockHashes = [[BlockHash hash]] -> [BlockHash hash] -> [[BlockHash hash]]
forall a. [a] -> a -> [a]
snoc [[BlockHash hash]]
cpBlockHashes (ByteString -> BlockHash hash
forall hash. HashAlgorithm hash => ByteString -> Digest' hash
blockHash' (ByteString -> BlockHash hash)
-> (ByteString -> ByteString) -> ByteString -> BlockHash hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LB.toStrict (ByteString -> BlockHash hash) -> [ByteString] -> [BlockHash hash]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
blocks)
, cpBlocks :: [[ByteString]]
cpBlocks = [[ByteString]] -> [ByteString] -> [[ByteString]]
forall a. [a] -> a -> [a]
snoc [[ByteString]]
cpBlocks [ByteString]
blocks
}
padCiphertext :: Required -> LB.ByteString -> LB.ByteString
padCiphertext :: Required -> ByteString -> ByteString
padCiphertext Required
requiredShares ByteString
bs
| Int64
paddingLength Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0 = ByteString
bs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int64 -> Word8 -> ByteString
LB.replicate Int64
paddingLength Word8
0x00
| Bool
otherwise = ByteString
bs
where
desiredLength :: Int64
desiredLength = Required -> Int64 -> Int64
forall m v. (Integral m, Integral v) => m -> v -> v
nextMultipleOf Required
requiredShares (ByteString -> Int64
LB.length ByteString
bs)
paddingLength :: Int64
paddingLength = Int64
desiredLength Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- ByteString -> Int64
LB.length ByteString
bs
encode ::
Key AES128 ->
Parameters ->
LB.ByteString ->
IO ([Share], Cap.Reader)
encode :: Key AES128 -> Parameters -> ByteString -> IO ([Share], Reader)
encode Key AES128
readKey initParams :: Parameters
initParams@(Parameters SegmentSize
maximumSegmentSize Required
total Int
_ Required
required) ByteString
ciphertext =
Parameters -> [ByteString] -> IO (EncodingState SHA256d)
forall hash.
HashAlgorithm hash =>
Parameters -> [ByteString] -> IO (EncodingState hash)
processCiphertext Parameters
p (Parameters -> ByteString -> [ByteString]
segmentCiphertext Parameters
p ByteString
ciphertext) IO (EncodingState SHA256d)
-> (EncodingState SHA256d -> IO ([Share], Reader))
-> IO ([Share], Reader)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CPState{[[ByteString]]
[[BlockHash SHA256d]]
[BlockHash SHA256d]
Context SHA256d
cpBlocks :: [[ByteString]]
cpBlockHashes :: [[BlockHash SHA256d]]
cpCrypttextHashes :: [BlockHash SHA256d]
cpCrypttextHash :: Context SHA256d
cpBlocks :: forall hash. EncodingState hash -> [[ByteString]]
cpBlockHashes :: forall hash. EncodingState hash -> [[CrypttextHash hash]]
cpCrypttextHashes :: forall hash. EncodingState hash -> [CrypttextHash hash]
cpCrypttextHash :: forall hash. EncodingState hash -> Context hash
..} ->
let
numSegments :: Int
numSegments = [[ByteString]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[ByteString]]
cpBlocks
effectiveSegments :: Int
effectiveSegments = Int -> Int -> Int
forall p. (Ord p, Num p) => p -> p -> p
nextPowerOf Int
2 Int
numSegments
Just MerkleTree value SHA256d
plaintextHashTree =
[BlockHash SHA256d] -> Maybe (MerkleTree value SHA256d)
forall hash value.
(Show hash, HashAlgorithm hash) =>
[Digest' hash] -> Maybe (MerkleTree value hash)
buildTreeOutOfAllTheNodes
([BlockHash SHA256d] -> Maybe (MerkleTree value SHA256d))
-> (BlockHash SHA256d -> [BlockHash SHA256d])
-> BlockHash SHA256d
-> Maybe (MerkleTree value SHA256d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BlockHash SHA256d -> [BlockHash SHA256d]
forall a. Int -> a -> [a]
replicate (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
effectiveSegments Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
(BlockHash SHA256d -> Maybe (MerkleTree value SHA256d))
-> BlockHash SHA256d -> Maybe (MerkleTree value SHA256d)
forall a b. (a -> b) -> a -> b
$ BlockHash SHA256d
forall hash. HashAlgorithm hash => Digest' hash
zero
shareTree :: MerkleTree (MerkleTree ByteString SHA256d) SHA256d
shareTree =
MerkleTree (MerkleTree ByteString SHA256d) SHA256d
shareTree'
where
shareTree' :: MerkleTree (MerkleTree ByteString SHA256d) SHA256d
shareTree' = [MerkleTree ByteString SHA256d]
-> MerkleTree (MerkleTree ByteString SHA256d) SHA256d
forall hash.
HashAlgorithm hash =>
[MerkleTree ByteString hash]
-> MerkleTree (MerkleTree ByteString hash) hash
makeShareTree ([MerkleTree ByteString SHA256d]
-> MerkleTree (MerkleTree ByteString SHA256d) SHA256d)
-> ([[BlockHash SHA256d]] -> [MerkleTree ByteString SHA256d])
-> [[BlockHash SHA256d]]
-> MerkleTree (MerkleTree ByteString SHA256d) SHA256d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([BlockHash SHA256d] -> MerkleTree ByteString SHA256d)
-> [[BlockHash SHA256d]] -> [MerkleTree ByteString SHA256d]
forall a b. (a -> b) -> [a] -> [b]
map [BlockHash SHA256d] -> MerkleTree ByteString SHA256d
forall hash value.
HashAlgorithm hash =>
[Digest' hash] -> MerkleTree value hash
makeTreePartial ([[BlockHash SHA256d]] -> [MerkleTree ByteString SHA256d])
-> ([[BlockHash SHA256d]] -> [[BlockHash SHA256d]])
-> [[BlockHash SHA256d]]
-> [MerkleTree ByteString SHA256d]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[BlockHash SHA256d]] -> [[BlockHash SHA256d]]
forall a. [[a]] -> [[a]]
transpose ([[BlockHash SHA256d]]
-> MerkleTree (MerkleTree ByteString SHA256d) SHA256d)
-> [[BlockHash SHA256d]]
-> MerkleTree (MerkleTree ByteString SHA256d) SHA256d
forall a b. (a -> b) -> a -> b
$ [[BlockHash SHA256d]]
cpBlockHashes
uriExt :: URIExtension
uriExt =
URIExtension :: ByteString
-> Parameters
-> Parameters
-> SegmentSize
-> SegmentSize
-> Int
-> Required
-> Required
-> BlockHash SHA256d
-> BlockHash SHA256d
-> BlockHash SHA256d
-> URIExtension
URIExtension
{ _codecName :: ByteString
_codecName = ByteString
"crs"
, _codecParams :: Parameters
_codecParams = Parameters
p
, _size :: SegmentSize
_size = Int64 -> SegmentSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> SegmentSize) -> Int64 -> SegmentSize
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
LB.length ByteString
ciphertext
, _segmentSize :: SegmentSize
_segmentSize = SegmentSize
segmentSize
, _neededShares :: Required
_neededShares = Required
required
, _totalShares :: Required
_totalShares = Required
total
, _numSegments :: Int
_numSegments = Int
numSegments
, _tailCodecParams :: Parameters
_tailCodecParams = Parameters -> Int64 -> Parameters
forall a. Integral a => Parameters -> a -> Parameters
tailParams Parameters
p (ByteString -> Int64
LB.length ByteString
ciphertext)
, _crypttextHash :: BlockHash SHA256d
_crypttextHash = Context SHA256d -> BlockHash SHA256d
forall hash.
HashAlgorithm hash =>
Context hash -> CrypttextHash hash
makeCrypttextHash Context SHA256d
cpCrypttextHash
, _crypttextRootHash :: BlockHash SHA256d
_crypttextRootHash = [BlockHash SHA256d] -> BlockHash SHA256d
forall hash.
HashAlgorithm hash =>
[CrypttextHash hash] -> CrypttextHash hash
makeCrypttextRootHash [BlockHash SHA256d]
cpCrypttextHashes
, _shareRootHash :: BlockHash SHA256d
_shareRootHash = MerkleTree (MerkleTree ByteString SHA256d) SHA256d
-> BlockHash SHA256d
forall v a. MerkleTree v a -> Digest' a
rootHash MerkleTree (MerkleTree ByteString SHA256d) SHA256d
shareTree
}
cap :: Reader
cap =
Key AES128
-> ByteString -> Required -> Required -> SegmentSize -> Reader
Cap.makeReader
Key AES128
readKey
(URIExtension -> ByteString
uriExtensionHash URIExtension
uriExt)
Required
required
Required
total
(Int64 -> SegmentSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> SegmentSize) -> Int64 -> SegmentSize
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
LB.length ByteString
ciphertext)
toShare :: Int -> [ByteString] -> [BlockHash SHA256d] -> Share
toShare Int
sharenum [ByteString]
blocks [BlockHash SHA256d]
blockHashes =
Share :: Word64
-> Word64
-> [ByteString]
-> MerkleTree ByteString SHA256d
-> MerkleTree ByteString SHA256d
-> MerkleTree ByteString SHA256d
-> [(Int, BlockHash SHA256d)]
-> URIExtension
-> Share
Share
{ _blockSize :: Word64
_blockSize = Parameters -> Word64
shareBlockSize Parameters
p
, _dataSize :: Word64
_dataSize = Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word64) -> Int64 -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
LB.length ByteString
ciphertext Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`ceilDiv` Required -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Required
required
, _blocks :: [ByteString]
_blocks = [ByteString]
blocks
, _plaintextHashTree :: MerkleTree ByteString SHA256d
_plaintextHashTree = MerkleTree ByteString SHA256d
forall value. MerkleTree value SHA256d
plaintextHashTree
, _crypttextHashTree :: MerkleTree ByteString SHA256d
_crypttextHashTree = [BlockHash SHA256d] -> MerkleTree ByteString SHA256d
forall hash value.
HashAlgorithm hash =>
[Digest' hash] -> MerkleTree value hash
makeTreePartial [BlockHash SHA256d]
cpCrypttextHashes
, _blockHashTree :: MerkleTree ByteString SHA256d
_blockHashTree = [BlockHash SHA256d] -> MerkleTree ByteString SHA256d
forall hash value.
HashAlgorithm hash =>
[Digest' hash] -> MerkleTree value hash
makeTreePartial [BlockHash SHA256d]
blockHashes
, _neededHashes :: [(Int, BlockHash SHA256d)]
_neededHashes = [(Int, BlockHash SHA256d)] -> [(Int, BlockHash SHA256d)]
forall a. Ord a => [a] -> [a]
sort ([(Int, BlockHash SHA256d)] -> [(Int, BlockHash SHA256d)])
-> ([(Int, BlockHash SHA256d)] -> [(Int, BlockHash SHA256d)])
-> [(Int, BlockHash SHA256d)]
-> [(Int, BlockHash SHA256d)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, BlockHash SHA256d) -> (Int, BlockHash SHA256d))
-> [(Int, BlockHash SHA256d)] -> [(Int, BlockHash SHA256d)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Int)
-> (Int, BlockHash SHA256d) -> (Int, BlockHash SHA256d)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([(Int, BlockHash SHA256d)] -> [(Int, BlockHash SHA256d)])
-> [(Int, BlockHash SHA256d)] -> [(Int, BlockHash SHA256d)]
forall a b. (a -> b) -> a -> b
$ MerkleTree (MerkleTree ByteString SHA256d) SHA256d
-> Int -> [(Int, BlockHash SHA256d)]
forall hash.
MerkleTree (MerkleTree ByteString hash) hash
-> Int -> [(Int, Digest' hash)]
computeNeededHashes MerkleTree (MerkleTree ByteString SHA256d) SHA256d
shareTree Int
sharenum
, _uriExtension :: URIExtension
_uriExtension = URIExtension
uriExt
}
shareBlockSize :: Parameters -> Word64
shareBlockSize :: Parameters -> Word64
shareBlockSize Parameters{SegmentSize
paramSegmentSize :: SegmentSize
paramSegmentSize :: Parameters -> SegmentSize
paramSegmentSize, Required
paramRequiredShares :: Required
paramRequiredShares :: Parameters -> Required
paramRequiredShares} =
SegmentSize -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral SegmentSize
paramSegmentSize Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`ceilDiv` Required -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Required
paramRequiredShares
in ([Share], Reader) -> IO ([Share], Reader)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( (Int -> [ByteString] -> [BlockHash SHA256d] -> Share)
-> [Int] -> [[ByteString]] -> [[BlockHash SHA256d]] -> [Share]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Int -> [ByteString] -> [BlockHash SHA256d] -> Share
toShare [Int
0 ..] ([[ByteString]] -> [[ByteString]]
forall a. [[a]] -> [[a]]
transpose [[ByteString]]
cpBlocks) ([[BlockHash SHA256d]] -> [[BlockHash SHA256d]]
forall a. [[a]] -> [[a]]
transpose [[BlockHash SHA256d]]
cpBlockHashes)
, Reader
cap
)
where
p :: Parameters
p@(Parameters SegmentSize
segmentSize Required
_ Int
_ Required
required') =
Parameters
initParams
{ paramSegmentSize :: SegmentSize
paramSegmentSize = Required -> SegmentSize -> SegmentSize
forall m v. (Integral m, Integral v) => m -> v -> v
nextMultipleOf Required
required' (SegmentSize -> SegmentSize) -> SegmentSize -> SegmentSize
forall a b. (a -> b) -> a -> b
$ SegmentSize -> SegmentSize -> SegmentSize
forall a. Ord a => a -> a -> a
min SegmentSize
maximumSegmentSize (Int64 -> SegmentSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> SegmentSize) -> Int64 -> SegmentSize
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
LB.length ByteString
ciphertext)
}
data DecodeError
=
SizeOverflow
|
NotEnoughShares
|
IntegrityError
{ DecodeError -> [(Int, Share, InvalidShare)]
integrityErrorInvalidShares :: [(Int, Share, InvalidShare)]
}
|
BlockHashError
|
CiphertextHashError
deriving (DecodeError -> DecodeError -> Bool
(DecodeError -> DecodeError -> Bool)
-> (DecodeError -> DecodeError -> Bool) -> Eq DecodeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DecodeError -> DecodeError -> Bool
$c/= :: DecodeError -> DecodeError -> Bool
== :: DecodeError -> DecodeError -> Bool
$c== :: DecodeError -> DecodeError -> Bool
Eq, Eq DecodeError
Eq DecodeError
-> (DecodeError -> DecodeError -> Ordering)
-> (DecodeError -> DecodeError -> Bool)
-> (DecodeError -> DecodeError -> Bool)
-> (DecodeError -> DecodeError -> Bool)
-> (DecodeError -> DecodeError -> Bool)
-> (DecodeError -> DecodeError -> DecodeError)
-> (DecodeError -> DecodeError -> DecodeError)
-> Ord DecodeError
DecodeError -> DecodeError -> Bool
DecodeError -> DecodeError -> Ordering
DecodeError -> DecodeError -> DecodeError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DecodeError -> DecodeError -> DecodeError
$cmin :: DecodeError -> DecodeError -> DecodeError
max :: DecodeError -> DecodeError -> DecodeError
$cmax :: DecodeError -> DecodeError -> DecodeError
>= :: DecodeError -> DecodeError -> Bool
$c>= :: DecodeError -> DecodeError -> Bool
> :: DecodeError -> DecodeError -> Bool
$c> :: DecodeError -> DecodeError -> Bool
<= :: DecodeError -> DecodeError -> Bool
$c<= :: DecodeError -> DecodeError -> Bool
< :: DecodeError -> DecodeError -> Bool
$c< :: DecodeError -> DecodeError -> Bool
compare :: DecodeError -> DecodeError -> Ordering
$ccompare :: DecodeError -> DecodeError -> Ordering
$cp1Ord :: Eq DecodeError
Ord, Int -> DecodeError -> String -> String
[DecodeError] -> String -> String
DecodeError -> String
(Int -> DecodeError -> String -> String)
-> (DecodeError -> String)
-> ([DecodeError] -> String -> String)
-> Show DecodeError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [DecodeError] -> String -> String
$cshowList :: [DecodeError] -> String -> String
show :: DecodeError -> String
$cshow :: DecodeError -> String
showsPrec :: Int -> DecodeError -> String -> String
$cshowsPrec :: Int -> DecodeError -> String -> String
Show)
decode ::
Cap.Reader ->
[(Int, Share)] ->
IO (Either DecodeError LB.ByteString)
decode :: Reader -> [(Int, Share)] -> IO (Either DecodeError ByteString)
decode Reader
reader [(Int, Share)]
shares
| Reader -> SegmentSize
size Reader
reader SegmentSize -> SegmentSize -> Bool
forall a. Ord a => a -> a -> Bool
> Int64 -> SegmentSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int64 @Integer Int64
forall a. Bounded a => a
maxBound = Either DecodeError ByteString -> IO (Either DecodeError ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either DecodeError ByteString
-> IO (Either DecodeError ByteString))
-> Either DecodeError ByteString
-> IO (Either DecodeError ByteString)
forall a b. (a -> b) -> a -> b
$ DecodeError -> Either DecodeError ByteString
forall a b. a -> Either a b
Left DecodeError
SizeOverflow
| [(Int, Share)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Share)]
shares Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Required -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Reader -> Required
required Reader
reader) = Either DecodeError ByteString -> IO (Either DecodeError ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either DecodeError ByteString
-> IO (Either DecodeError ByteString))
-> Either DecodeError ByteString
-> IO (Either DecodeError ByteString)
forall a b. (a -> b) -> a -> b
$ DecodeError -> Either DecodeError ByteString
forall a b. a -> Either a b
Left DecodeError
NotEnoughShares
| [(Int, Share)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Share)]
validShares Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Required -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Reader -> Required
required Reader
reader) = Either DecodeError ByteString -> IO (Either DecodeError ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either DecodeError ByteString
-> IO (Either DecodeError ByteString))
-> ([(Int, Share, InvalidShare)] -> Either DecodeError ByteString)
-> [(Int, Share, InvalidShare)]
-> IO (Either DecodeError ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeError -> Either DecodeError ByteString
forall a b. a -> Either a b
Left (DecodeError -> Either DecodeError ByteString)
-> ([(Int, Share, InvalidShare)] -> DecodeError)
-> [(Int, Share, InvalidShare)]
-> Either DecodeError ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Share, InvalidShare)] -> DecodeError
IntegrityError ([(Int, Share, InvalidShare)]
-> IO (Either DecodeError ByteString))
-> [(Int, Share, InvalidShare)]
-> IO (Either DecodeError ByteString)
forall a b. (a -> b) -> a -> b
$ [(Int, Share, InvalidShare)]
invalidShares
| Bool
otherwise = do
let
blocksWithValidity :: [[(Int, Maybe LB.ByteString)]]
blocksWithValidity :: [[(Int, Maybe ByteString)]]
blocksWithValidity = (Int, [Maybe ByteString]) -> [(Int, Maybe ByteString)]
forall a. (Int, [a]) -> [(Int, a)]
fixBlocks ((Int, [Maybe ByteString]) -> [(Int, Maybe ByteString)])
-> ((Int, Share) -> (Int, [Maybe ByteString]))
-> (Int, Share)
-> [(Int, Maybe ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Share -> [Maybe ByteString])
-> (Int, Share) -> (Int, [Maybe ByteString])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Share -> [Maybe ByteString]
shareValidBlocks ((Int, Share) -> [(Int, Maybe ByteString)])
-> [(Int, Share)] -> [[(Int, Maybe ByteString)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Share)]
validShares
explodedBlocks :: [[(Int, Maybe LB.ByteString)]]
explodedBlocks :: [[(Int, Maybe ByteString)]]
explodedBlocks = [[(Int, Maybe ByteString)]] -> [[(Int, Maybe ByteString)]]
forall a. [[a]] -> [[a]]
transpose [[(Int, Maybe ByteString)]]
blocksWithValidity
validBlocks :: [[(Int, LB.ByteString)]]
validBlocks :: [[(Int, ByteString)]]
validBlocks = ((Int, Maybe ByteString) -> Maybe (Int, ByteString))
-> [(Int, Maybe ByteString)] -> [(Int, ByteString)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(Int
num, Maybe ByteString
mbs) -> (Int
num,) (ByteString -> (Int, ByteString))
-> Maybe ByteString -> Maybe (Int, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
mbs) ([(Int, Maybe ByteString)] -> [(Int, ByteString)])
-> [[(Int, Maybe ByteString)]] -> [[(Int, ByteString)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[(Int, Maybe ByteString)]]
explodedBlocks
enoughBlocks :: [Maybe [(Int, LB.ByteString)]]
enoughBlocks :: [Maybe [(Int, ByteString)]]
enoughBlocks = ([(Int, ByteString)] -> Bool)
-> [(Int, ByteString)] -> Maybe [(Int, ByteString)]
forall (f :: * -> *) a. Alternative f => (a -> Bool) -> a -> f a
guarded ((Required -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Reader -> Required
required Reader
reader) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=) (Int -> Bool)
-> ([(Int, ByteString)] -> Int) -> [(Int, ByteString)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, ByteString)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([(Int, ByteString)] -> Maybe [(Int, ByteString)])
-> [[(Int, ByteString)]] -> [Maybe [(Int, ByteString)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[(Int, ByteString)]]
validBlocks
segSize :: SegmentSize
segSize = Parameters -> SegmentSize
paramSegmentSize (Parameters -> SegmentSize)
-> (Share -> Parameters) -> Share -> SegmentSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Parameters Share Parameters -> Share -> Parameters
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((URIExtension -> Const Parameters URIExtension)
-> Share -> Const Parameters Share
Lens' Share URIExtension
uriExtension ((URIExtension -> Const Parameters URIExtension)
-> Share -> Const Parameters Share)
-> ((Parameters -> Const Parameters Parameters)
-> URIExtension -> Const Parameters URIExtension)
-> Getting Parameters Share Parameters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parameters -> Const Parameters Parameters)
-> URIExtension -> Const Parameters URIExtension
Lens' URIExtension Parameters
codecParams) (Share -> SegmentSize) -> Share -> SegmentSize
forall a b. (a -> b) -> a -> b
$ Share
anyValidShare
tailSegSize :: SegmentSize
tailSegSize = case Reader -> SegmentSize
size Reader
reader SegmentSize -> SegmentSize -> SegmentSize
forall a. Integral a => a -> a -> a
`mod` SegmentSize
segSize of
SegmentSize
0 -> SegmentSize
segSize
SegmentSize
n -> SegmentSize
n
zunfec' :: [(Int, ByteString)] -> IO ByteString
zunfec' = (Int64 -> ByteString -> ByteString
LB.take (SegmentSize -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral SegmentSize
segSize) (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO ByteString -> IO ByteString)
-> ([(Int, ByteString)] -> IO ByteString)
-> [(Int, ByteString)]
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> [(Int, ByteString)] -> IO ByteString
zunfecLazy (Required -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Reader -> Required
required Reader
reader)) (Required -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Reader -> Required
total Reader
reader))
getSegments :: [Maybe (IO LB.ByteString)]
getSegments :: [Maybe (IO ByteString)]
getSegments = (Maybe [(Int, ByteString)] -> Maybe (IO ByteString))
-> [Maybe [(Int, ByteString)]] -> [Maybe (IO ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(Int, ByteString)] -> IO ByteString
zunfec' ([(Int, ByteString)] -> IO ByteString)
-> ([(Int, ByteString)] -> [(Int, ByteString)])
-> [(Int, ByteString)]
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(Int, ByteString)] -> [(Int, ByteString)]
forall a. Int -> [a] -> [a]
take (Required -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Reader -> Required
required Reader
reader)) ([(Int, ByteString)] -> IO ByteString)
-> Maybe [(Int, ByteString)] -> Maybe (IO ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) [Maybe [(Int, ByteString)]]
enoughBlocks
[Maybe ByteString]
maybeSegments <- (Maybe (IO ByteString) -> IO (Maybe ByteString))
-> [Maybe (IO ByteString)] -> IO [Maybe ByteString]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Maybe (IO ByteString) -> IO (Maybe ByteString)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Maybe (IO ByteString)]
getSegments :: IO [Maybe LB.ByteString]
Either DecodeError ByteString -> IO (Either DecodeError ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either DecodeError ByteString
-> IO (Either DecodeError ByteString))
-> Either DecodeError ByteString
-> IO (Either DecodeError ByteString)
forall a b. (a -> b) -> a -> b
$ do
[ByteString]
segments <- Either DecodeError [ByteString]
-> ([ByteString] -> Either DecodeError [ByteString])
-> Maybe [ByteString]
-> Either DecodeError [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (DecodeError -> Either DecodeError [ByteString]
forall a b. a -> Either a b
Left DecodeError
BlockHashError) [ByteString] -> Either DecodeError [ByteString]
forall a b. b -> Either a b
Right ([Maybe ByteString] -> Maybe [ByteString]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Maybe ByteString]
maybeSegments)
let maybeValidSegments :: [Maybe ByteString]
maybeValidSegments =
[BlockHash SHA256d] -> [ByteString] -> [Maybe ByteString]
validSegments
(MerkleTree ByteString SHA256d -> [BlockHash SHA256d]
forall v a. MerkleTree v a -> [Digest' a]
leafHashes (MerkleTree ByteString SHA256d -> [BlockHash SHA256d])
-> MerkleTree ByteString SHA256d -> [BlockHash SHA256d]
forall a b. (a -> b) -> a -> b
$ Getting
(MerkleTree ByteString SHA256d)
Share
(MerkleTree ByteString SHA256d)
-> Share -> MerkleTree ByteString SHA256d
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
(MerkleTree ByteString SHA256d)
Share
(MerkleTree ByteString SHA256d)
Lens' Share (MerkleTree ByteString SHA256d)
crypttextHashTree Share
anyValidShare)
(ByteString -> ByteString
LB.toStrict (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> [ByteString] -> [ByteString]
trimTailSegment (SegmentSize -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral SegmentSize
tailSegSize) [ByteString]
segments)
Either DecodeError ByteString
-> ([ByteString] -> Either DecodeError ByteString)
-> Maybe [ByteString]
-> Either DecodeError ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(DecodeError -> Either DecodeError ByteString
forall a b. a -> Either a b
Left DecodeError
CiphertextHashError)
(ByteString -> Either DecodeError ByteString
forall a b. b -> Either a b
Right (ByteString -> Either DecodeError ByteString)
-> ([ByteString] -> ByteString)
-> [ByteString]
-> Either DecodeError ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
LB.concat ([ByteString] -> ByteString)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString
LB.fromStrict (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>))
([Maybe ByteString] -> Maybe [ByteString]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Maybe ByteString]
maybeValidSegments)
where
(validShares :: [(Int, Share)]
validShares@(~((Int
_, Share
anyValidShare) : [(Int, Share)]
_)), [(Int, Share, InvalidShare)]
invalidShares) = Verifier
-> [(Int, Share)] -> ([(Int, Share)], [(Int, Share, InvalidShare)])
partitionShares (Getting Verifier Reader Verifier -> Reader -> Verifier
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Verifier Reader Verifier
Lens' Reader Verifier
Cap.verifier Reader
reader) [(Int, Share)]
shares
fixBlocks :: (Int, [a]) -> [(Int, a)]
fixBlocks :: (Int, [a]) -> [(Int, a)]
fixBlocks (Int
sharenum, [a]
bs) = [Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> [Int]
forall a. a -> [a]
repeat Int
sharenum) [a]
bs
size :: Reader -> SegmentSize
size = Getting SegmentSize Reader SegmentSize -> Reader -> SegmentSize
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Verifier -> Const SegmentSize Verifier)
-> Reader -> Const SegmentSize Reader
Lens' Reader Verifier
Cap.verifier ((Verifier -> Const SegmentSize Verifier)
-> Reader -> Const SegmentSize Reader)
-> ((SegmentSize -> Const SegmentSize SegmentSize)
-> Verifier -> Const SegmentSize Verifier)
-> Getting SegmentSize Reader SegmentSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SegmentSize -> Const SegmentSize SegmentSize)
-> Verifier -> Const SegmentSize Verifier
Lens' Verifier SegmentSize
Cap.size)
required :: Reader -> Required
required = Getting Required Reader Required -> Reader -> Required
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Verifier -> Const Required Verifier)
-> Reader -> Const Required Reader
Lens' Reader Verifier
Cap.verifier ((Verifier -> Const Required Verifier)
-> Reader -> Const Required Reader)
-> ((Required -> Const Required Required)
-> Verifier -> Const Required Verifier)
-> Getting Required Reader Required
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Required -> Const Required Required)
-> Verifier -> Const Required Verifier
Lens' Verifier Required
Cap.required)
total :: Reader -> Required
total = Getting Required Reader Required -> Reader -> Required
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Verifier -> Const Required Verifier)
-> Reader -> Const Required Reader
Lens' Reader Verifier
Cap.verifier ((Verifier -> Const Required Verifier)
-> Reader -> Const Required Reader)
-> ((Required -> Const Required Required)
-> Verifier -> Const Required Verifier)
-> Getting Required Reader Required
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Required -> Const Required Required)
-> Verifier -> Const Required Verifier
Lens' Verifier Required
Cap.total)
trimTailSegment :: Int64 -> [LB.ByteString] -> [LB.ByteString]
trimTailSegment :: Int64 -> [ByteString] -> [ByteString]
trimTailSegment Int64
segSize = (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a. (a -> a) -> [a] -> [a]
mapLast (Int64 -> ByteString -> ByteString
LB.take Int64
segSize)
mapLast :: (a -> a) -> [a] -> [a]
mapLast a -> a
_ [] = []
mapLast a -> a
f [a
x] = [a -> a
f a
x]
mapLast a -> a
f (a
x : [a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> a) -> [a] -> [a]
mapLast a -> a
f [a]
xs
data InvalidShare
=
FingerprintMismatch
|
BlockHashRootMismatch
|
ShareRootHashInvalid
|
CrypttextHashRootMismatch
deriving (Eq InvalidShare
Eq InvalidShare
-> (InvalidShare -> InvalidShare -> Ordering)
-> (InvalidShare -> InvalidShare -> Bool)
-> (InvalidShare -> InvalidShare -> Bool)
-> (InvalidShare -> InvalidShare -> Bool)
-> (InvalidShare -> InvalidShare -> Bool)
-> (InvalidShare -> InvalidShare -> InvalidShare)
-> (InvalidShare -> InvalidShare -> InvalidShare)
-> Ord InvalidShare
InvalidShare -> InvalidShare -> Bool
InvalidShare -> InvalidShare -> Ordering
InvalidShare -> InvalidShare -> InvalidShare
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InvalidShare -> InvalidShare -> InvalidShare
$cmin :: InvalidShare -> InvalidShare -> InvalidShare
max :: InvalidShare -> InvalidShare -> InvalidShare
$cmax :: InvalidShare -> InvalidShare -> InvalidShare
>= :: InvalidShare -> InvalidShare -> Bool
$c>= :: InvalidShare -> InvalidShare -> Bool
> :: InvalidShare -> InvalidShare -> Bool
$c> :: InvalidShare -> InvalidShare -> Bool
<= :: InvalidShare -> InvalidShare -> Bool
$c<= :: InvalidShare -> InvalidShare -> Bool
< :: InvalidShare -> InvalidShare -> Bool
$c< :: InvalidShare -> InvalidShare -> Bool
compare :: InvalidShare -> InvalidShare -> Ordering
$ccompare :: InvalidShare -> InvalidShare -> Ordering
$cp1Ord :: Eq InvalidShare
Ord, InvalidShare -> InvalidShare -> Bool
(InvalidShare -> InvalidShare -> Bool)
-> (InvalidShare -> InvalidShare -> Bool) -> Eq InvalidShare
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvalidShare -> InvalidShare -> Bool
$c/= :: InvalidShare -> InvalidShare -> Bool
== :: InvalidShare -> InvalidShare -> Bool
$c== :: InvalidShare -> InvalidShare -> Bool
Eq, Int -> InvalidShare -> String -> String
[InvalidShare] -> String -> String
InvalidShare -> String
(Int -> InvalidShare -> String -> String)
-> (InvalidShare -> String)
-> ([InvalidShare] -> String -> String)
-> Show InvalidShare
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [InvalidShare] -> String -> String
$cshowList :: [InvalidShare] -> String -> String
show :: InvalidShare -> String
$cshow :: InvalidShare -> String
showsPrec :: Int -> InvalidShare -> String -> String
$cshowsPrec :: Int -> InvalidShare -> String -> String
Show)
partitionShares :: Cap.Verifier -> [(Int, Share)] -> ([(Int, Share)], [(Int, Share, InvalidShare)])
partitionShares :: Verifier
-> [(Int, Share)] -> ([(Int, Share)], [(Int, Share, InvalidShare)])
partitionShares Verifier
verifier [(Int, Share)]
shares =
( [(Int, Share)]
validShares
, ((Int, Share) -> (Int, Share, InvalidShare))
-> [(Int, Share)] -> [(Int, Share, InvalidShare)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Share) -> InvalidShare -> (Int, Share, InvalidShare)
forall a b c. (a, b) -> c -> (a, b, c)
`err` InvalidShare
FingerprintMismatch) [(Int, Share)]
haveInvalidFingerprint
[(Int, Share, InvalidShare)]
-> [(Int, Share, InvalidShare)] -> [(Int, Share, InvalidShare)]
forall a. [a] -> [a] -> [a]
++ ((Int, Share) -> (Int, Share, InvalidShare))
-> [(Int, Share)] -> [(Int, Share, InvalidShare)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Share) -> InvalidShare -> (Int, Share, InvalidShare)
forall a b c. (a, b) -> c -> (a, b, c)
`err` InvalidShare
BlockHashRootMismatch) [(Int, Share)]
haveInvalidBlockHashRoot
[(Int, Share, InvalidShare)]
-> [(Int, Share, InvalidShare)] -> [(Int, Share, InvalidShare)]
forall a. [a] -> [a] -> [a]
++ ((Int, Share) -> (Int, Share, InvalidShare))
-> [(Int, Share)] -> [(Int, Share, InvalidShare)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Share) -> InvalidShare -> (Int, Share, InvalidShare)
forall a b c. (a, b) -> c -> (a, b, c)
`err` InvalidShare
ShareRootHashInvalid) [(Int, Share)]
haveInvalidShareRootHash
[(Int, Share, InvalidShare)]
-> [(Int, Share, InvalidShare)] -> [(Int, Share, InvalidShare)]
forall a. [a] -> [a] -> [a]
++ ((Int, Share) -> (Int, Share, InvalidShare))
-> [(Int, Share)] -> [(Int, Share, InvalidShare)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Share) -> InvalidShare -> (Int, Share, InvalidShare)
forall a b c. (a, b) -> c -> (a, b, c)
`err` InvalidShare
CrypttextHashRootMismatch) [(Int, Share)]
haveMismatchingCrypttextHashRoot
)
where
err :: (a, b) -> c -> (a, b, c)
err = (a -> b -> c -> (a, b, c)) -> (a, b) -> c -> (a, b, c)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (,,)
([(Int, Share)]
haveValidFingerprint, [(Int, Share)]
haveInvalidFingerprint) = ((Int, Share) -> Bool)
-> [(Int, Share)] -> ([(Int, Share)], [(Int, Share)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Verifier -> Share -> Bool
validFingerprint Verifier
verifier (Share -> Bool) -> ((Int, Share) -> Share) -> (Int, Share) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Share) -> Share
forall a b. (a, b) -> b
snd) [(Int, Share)]
shares
([(Int, Share)]
haveValidBlockHashRoot, [(Int, Share)]
haveInvalidBlockHashRoot) = ((Int, Share) -> Bool)
-> [(Int, Share)] -> ([(Int, Share)], [(Int, Share)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((Int -> Share -> Bool) -> (Int, Share) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Share -> Bool
matchingBlockHashRoot) [(Int, Share)]
haveValidFingerprint
([(Int, Share)]
haveMatchingCrypttextHashRoot, [(Int, Share)]
haveMismatchingCrypttextHashRoot) = ((Int, Share) -> Bool)
-> [(Int, Share)] -> ([(Int, Share)], [(Int, Share)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Share -> Bool
matchingCrypttextHashRoot (Share -> Bool) -> ((Int, Share) -> Share) -> (Int, Share) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Share) -> Share
forall a b. (a, b) -> b
snd) [(Int, Share)]
haveValidBlockHashRoot
shareRootValidations :: [(Bool, (Int, Share))]
shareRootValidations = [Bool] -> [(Int, Share)] -> [(Bool, (Int, Share))]
forall a b. [a] -> [b] -> [(a, b)]
zip ([(Int, Share)] -> [Bool]
validShareRootHash [(Int, Share)]
stillValid) [(Int, Share)]
stillValid
where
stillValid :: [(Int, Share)]
stillValid = [(Int, Share)]
haveMatchingCrypttextHashRoot
([(Int, Share)]
haveValidShareRootHash, [(Int, Share)]
haveInvalidShareRootHash) = ([(Bool, (Int, Share))] -> [(Int, Share)])
-> ([(Bool, (Int, Share))] -> [(Int, Share)])
-> ([(Bool, (Int, Share))], [(Bool, (Int, Share))])
-> ([(Int, Share)], [(Int, Share)])
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((Bool, (Int, Share)) -> (Int, Share)
forall a b. (a, b) -> b
snd ((Bool, (Int, Share)) -> (Int, Share))
-> [(Bool, (Int, Share))] -> [(Int, Share)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ((Bool, (Int, Share)) -> (Int, Share)
forall a b. (a, b) -> b
snd ((Bool, (Int, Share)) -> (Int, Share))
-> [(Bool, (Int, Share))] -> [(Int, Share)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (([(Bool, (Int, Share))], [(Bool, (Int, Share))])
-> ([(Int, Share)], [(Int, Share)]))
-> ([(Bool, (Int, Share))], [(Bool, (Int, Share))])
-> ([(Int, Share)], [(Int, Share)])
forall a b. (a -> b) -> a -> b
$ ((Bool, (Int, Share)) -> Bool)
-> [(Bool, (Int, Share))]
-> ([(Bool, (Int, Share))], [(Bool, (Int, Share))])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Bool, (Int, Share)) -> Bool
forall a b. (a, b) -> a
fst [(Bool, (Int, Share))]
shareRootValidations
validShares :: [(Int, Share)]
validShares = [(Int, Share)]
haveValidShareRootHash
makeShareTree :: HashAlgorithm hash => [MerkleTree B.ByteString hash] -> MerkleTree (MerkleTree B.ByteString hash) hash
makeShareTree :: [MerkleTree ByteString hash]
-> MerkleTree (MerkleTree ByteString hash) hash
makeShareTree = [Digest' hash] -> MerkleTree (MerkleTree ByteString hash) hash
forall hash value.
HashAlgorithm hash =>
[Digest' hash] -> MerkleTree value hash
makeTreePartial ([Digest' hash] -> MerkleTree (MerkleTree ByteString hash) hash)
-> ([MerkleTree ByteString hash] -> [Digest' hash])
-> [MerkleTree ByteString hash]
-> MerkleTree (MerkleTree ByteString hash) hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MerkleTree ByteString hash -> Digest' hash)
-> [MerkleTree ByteString hash] -> [Digest' hash]
forall a b. (a -> b) -> [a] -> [b]
map MerkleTree ByteString hash -> Digest' hash
forall v a. MerkleTree v a -> Digest' a
rootHash
makeCrypttextHash :: HashAlgorithm hash => Context hash -> CrypttextHash hash
makeCrypttextHash :: Context hash -> CrypttextHash hash
makeCrypttextHash = Digest hash -> CrypttextHash hash
forall a. Digest a -> Digest' a
Digest' (Digest hash -> CrypttextHash hash)
-> (Context hash -> Digest hash)
-> Context hash
-> CrypttextHash hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context hash -> Digest hash
forall a. HashAlgorithm a => Context a -> Digest a
hashFinalize
makeCrypttextRootHash :: HashAlgorithm hash => [CrypttextHash hash] -> CrypttextHash hash
makeCrypttextRootHash :: [CrypttextHash hash] -> CrypttextHash hash
makeCrypttextRootHash = MerkleTree Any hash -> CrypttextHash hash
forall v a. MerkleTree v a -> Digest' a
rootHash (MerkleTree Any hash -> CrypttextHash hash)
-> ([CrypttextHash hash] -> MerkleTree Any hash)
-> [CrypttextHash hash]
-> CrypttextHash hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CrypttextHash hash] -> MerkleTree Any hash
forall hash value.
HashAlgorithm hash =>
[Digest' hash] -> MerkleTree value hash
makeTreePartial
tailParams :: Integral a => Parameters -> a -> Parameters
tailParams :: Parameters -> a -> Parameters
tailParams p :: Parameters
p@Parameters{SegmentSize
paramSegmentSize :: SegmentSize
paramSegmentSize :: Parameters -> SegmentSize
paramSegmentSize, Required
paramRequiredShares :: Required
paramRequiredShares :: Parameters -> Required
paramRequiredShares} a
dataSize =
Parameters
p{paramSegmentSize :: SegmentSize
paramSegmentSize = Required -> SegmentSize -> SegmentSize
forall m v. (Integral m, Integral v) => m -> v -> v
nextMultipleOf Required
paramRequiredShares SegmentSize
tailSize'}
where
tailSize' :: SegmentSize
tailSize' =
if SegmentSize
tailSize SegmentSize -> SegmentSize -> Bool
forall a. Eq a => a -> a -> Bool
== SegmentSize
0
then SegmentSize
paramSegmentSize
else SegmentSize
tailSize
tailSize :: SegmentSize
tailSize = a -> SegmentSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
dataSize SegmentSize -> SegmentSize -> SegmentSize
forall a. Integral a => a -> a -> a
`mod` SegmentSize
paramSegmentSize
computeNeededHashes :: MerkleTree (MerkleTree B.ByteString hash) hash -> Int -> [(Int, Digest' hash)]
computeNeededHashes :: MerkleTree (MerkleTree ByteString hash) hash
-> Int -> [(Int, Digest' hash)]
computeNeededHashes MerkleTree (MerkleTree ByteString hash) hash
shareTree Int
sharenum =
(MerkleTree (MerkleTree ByteString hash) hash -> Int -> Int
forall v a. MerkleTree v a -> Int -> Int
leafNumberToNodeNumber MerkleTree (MerkleTree ByteString hash) hash
shareTree Int
sharenum Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, MerkleTree (MerkleTree ByteString hash) hash -> Int -> Digest' hash
forall hash.
MerkleTree (MerkleTree ByteString hash) hash -> Int -> Digest' hash
blockHashRoot MerkleTree (MerkleTree ByteString hash) hash
shareTree Int
sharenum) (Int, Digest' hash)
-> [(Int, Digest' hash)] -> [(Int, Digest' hash)]
forall a. a -> [a] -> [a]
: Maybe [(Int, Digest' hash)] -> [(Int, Digest' hash)]
forall a. HasCallStack => Maybe a -> a
fromJust (MerkleTree (MerkleTree ByteString hash) hash
-> Int -> Maybe [(Int, Digest' hash)]
forall v a. MerkleTree v a -> Int -> Maybe [(Int, Digest' a)]
neededHashes MerkleTree (MerkleTree ByteString hash) hash
shareTree Int
sharenum)
blockHashRoot :: MerkleTree (MerkleTree B.ByteString hash) hash -> Int -> Digest' hash
blockHashRoot :: MerkleTree (MerkleTree ByteString hash) hash -> Int -> Digest' hash
blockHashRoot MerkleTree (MerkleTree ByteString hash) hash
tree Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> Digest' hash
forall a. HasCallStack => String -> a
error String
"Cannot have a negative leaf number"
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [Digest' hash] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Digest' hash]
leafs = String -> Digest' hash
forall a. HasCallStack => String -> a
error String
"Leaf number goes past the end of the tree"
| Bool
otherwise = [Digest' hash]
leafs [Digest' hash] -> Int -> Digest' hash
forall a. [a] -> Int -> a
!! Int
n
where
leafs :: [Digest' hash]
leafs = MerkleTree (MerkleTree ByteString hash) hash -> [Digest' hash]
forall v a. MerkleTree v a -> [Digest' a]
leafHashes MerkleTree (MerkleTree ByteString hash) hash
tree
guarded :: Alternative f => (a -> Bool) -> a -> f a
guarded :: (a -> Bool) -> a -> f a
guarded a -> Bool
predicate a
value
| a -> Bool
predicate a
value = a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
value
| Bool
otherwise = f a
forall (f :: * -> *) a. Alternative f => f a
empty