{-# LANGUAGE ScopedTypeVariables #-}
module Tahoe.CHK.Validate where
import Control.Lens (view)
import Crypto.Hash (HashAlgorithm)
import Data.Bifunctor (Bifunctor (first))
import qualified Data.ByteString.Lazy as LB
import Tahoe.CHK.Capability (Verifier, fingerprint)
import Tahoe.CHK.Crypto (blockHash', ciphertextSegmentHash', uriExtensionHash)
import Tahoe.CHK.Merkle (checkMerkleProof, heightForLeafCount, leafHashes, rootHash)
import Tahoe.CHK.SHA256d (Digest', SHA256d)
import Tahoe.CHK.Share (Crypttext, Share (..), blockHashTree, blocks, crypttextHashTree, neededHashes, uriExtension)
import Tahoe.CHK.URIExtension (crypttextRootHash, shareRootHash, totalShares)
validFingerprint :: Verifier -> Share -> Bool
validFingerprint :: Verifier -> Share -> Bool
validFingerprint Verifier
cap = (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Getting ByteString Verifier ByteString -> Verifier -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString Verifier ByteString
Lens' Verifier ByteString
fingerprint Verifier
cap) (ByteString -> Bool) -> (Share -> ByteString) -> Share -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIExtension -> ByteString
uriExtensionHash (URIExtension -> ByteString)
-> (Share -> URIExtension) -> Share -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Share -> URIExtension
_uriExtension
matchingCrypttextHashRoot :: Share -> Bool
matchingCrypttextHashRoot :: Share -> Bool
matchingCrypttextHashRoot Share
share = Digest' SHA256d
inShare Digest' SHA256d -> Digest' SHA256d -> Bool
forall a. Eq a => a -> a -> Bool
== Digest' SHA256d
inUEB
where
inShare :: Digest' SHA256d
inShare = MerkleTree ByteString SHA256d -> Digest' SHA256d
forall v a. MerkleTree v a -> Digest' a
rootHash (MerkleTree ByteString SHA256d -> Digest' SHA256d)
-> (Share -> MerkleTree ByteString SHA256d)
-> Share
-> Digest' SHA256d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> Digest' SHA256d) -> Share -> Digest' SHA256d
forall a b. (a -> b) -> a -> b
$ Share
share
inUEB :: Digest' SHA256d
inUEB = Getting (Digest' SHA256d) Share (Digest' SHA256d)
-> Share -> Digest' SHA256d
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((URIExtension -> Const (Digest' SHA256d) URIExtension)
-> Share -> Const (Digest' SHA256d) Share
Lens' Share URIExtension
uriExtension ((URIExtension -> Const (Digest' SHA256d) URIExtension)
-> Share -> Const (Digest' SHA256d) Share)
-> ((Digest' SHA256d -> Const (Digest' SHA256d) (Digest' SHA256d))
-> URIExtension -> Const (Digest' SHA256d) URIExtension)
-> Getting (Digest' SHA256d) Share (Digest' SHA256d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Digest' SHA256d -> Const (Digest' SHA256d) (Digest' SHA256d))
-> URIExtension -> Const (Digest' SHA256d) URIExtension
Lens' URIExtension (Digest' SHA256d)
crypttextRootHash) Share
share
matchingBlockHashRoot :: Int -> Share -> Bool
matchingBlockHashRoot :: Int -> Share -> Bool
matchingBlockHashRoot Int
shareNum Share
share =
Bool
isMatching
where
isMatching :: Bool
isMatching =
[(Int, Digest' SHA256d)] -> Bool
forall a. [(a, Digest' SHA256d)] -> Bool
checkMatch
([(Int, Digest' SHA256d)] -> Bool)
-> ([(Int, Digest' SHA256d)] -> [(Int, Digest' SHA256d)])
-> [(Int, Digest' SHA256d)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Digest' SHA256d)] -> [(Int, Digest' SHA256d)]
forall b. [(Int, b)] -> [(Int, b)]
findOwnHash
([(Int, Digest' SHA256d)] -> Bool)
-> [(Int, Digest' SHA256d)] -> Bool
forall a b. (a -> b) -> a -> b
$ Getting [(Int, Digest' SHA256d)] Share [(Int, Digest' SHA256d)]
-> Share -> [(Int, Digest' SHA256d)]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [(Int, Digest' SHA256d)] Share [(Int, Digest' SHA256d)]
Lens' Share [(Int, Digest' SHA256d)]
neededHashes Share
share
checkMatch :: [(a, Digest' SHA256d)] -> Bool
checkMatch = ([MerkleTree ByteString SHA256d -> Digest' SHA256d
forall v a. MerkleTree v a -> Digest' a
rootHash (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)
blockHashTree Share
share)] [Digest' SHA256d] -> [Digest' SHA256d] -> Bool
forall a. Eq a => a -> a -> Bool
==) ([Digest' SHA256d] -> Bool)
-> ([(a, Digest' SHA256d)] -> [Digest' SHA256d])
-> [(a, Digest' SHA256d)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Digest' SHA256d) -> Digest' SHA256d)
-> [(a, Digest' SHA256d)] -> [Digest' SHA256d]
forall a b. (a -> b) -> [a] -> [b]
map (a, Digest' SHA256d) -> Digest' SHA256d
forall a b. (a, b) -> b
snd
findOwnHash :: [(Int, b)] -> [(Int, b)]
findOwnHash = ((Int, b) -> Bool) -> [(Int, b)] -> [(Int, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
nodeNumber) (Int -> Bool) -> ((Int, b) -> Int) -> (Int, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, b) -> Int
forall a b. (a, b) -> a
fst)
nodeNumber :: Int
nodeNumber :: Int
nodeNumber = Int -> Int
forall a. Num a => a -> a
toNodeNumber Int
shareNum
toNodeNumber :: a -> a
toNodeNumber a
num = a
num a -> a -> a
forall a. Num a => a -> a -> a
+ (a
2 a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
treeHeight) a -> a -> a
forall a. Num a => a -> a -> a
- a
1
treeHeight :: Int
treeHeight = Total -> Int
forall n. Integral n => n -> Int
heightForLeafCount (Total -> Int) -> (Share -> Total) -> Share -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Total Share Total -> Share -> Total
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((URIExtension -> Const Total URIExtension)
-> Share -> Const Total Share
Lens' Share URIExtension
uriExtension ((URIExtension -> Const Total URIExtension)
-> Share -> Const Total Share)
-> ((Total -> Const Total Total)
-> URIExtension -> Const Total URIExtension)
-> Getting Total Share Total
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Total -> Const Total Total)
-> URIExtension -> Const Total URIExtension
Lens' URIExtension Total
totalShares) (Share -> Int) -> Share -> Int
forall a b. (a -> b) -> a -> b
$ Share
share
validShareRootHash :: [(Int, Share)] -> [Bool]
validShareRootHash :: [(Int, Share)] -> [Bool]
validShareRootHash [] = []
validShareRootHash shares :: [(Int, Share)]
shares@((Int
_, Share
aShare) : [(Int, Share)]
_) =
[Bool]
isValid
where
isValid :: [Bool]
isValid = ([(Int, Digest' SHA256d)] -> Digest' SHA256d -> Bool)
-> [[(Int, Digest' SHA256d)]] -> [Digest' SHA256d] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([(Int, Digest' SHA256d)]
-> Digest' SHA256d -> Digest' SHA256d -> Bool
forall n hash.
(Integral n, HashAlgorithm hash) =>
[(n, Digest' hash)] -> Digest' hash -> Digest' hash -> Bool
`checkMerkleProof` Digest' SHA256d
expected) [[(Int, Digest' SHA256d)]]
proofs [Digest' SHA256d]
leafs
expected :: Digest' SHA256d
expected = Getting (Digest' SHA256d) Share (Digest' SHA256d)
-> Share -> Digest' SHA256d
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((URIExtension -> Const (Digest' SHA256d) URIExtension)
-> Share -> Const (Digest' SHA256d) Share
Lens' Share URIExtension
uriExtension ((URIExtension -> Const (Digest' SHA256d) URIExtension)
-> Share -> Const (Digest' SHA256d) Share)
-> ((Digest' SHA256d -> Const (Digest' SHA256d) (Digest' SHA256d))
-> URIExtension -> Const (Digest' SHA256d) URIExtension)
-> Getting (Digest' SHA256d) Share (Digest' SHA256d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Digest' SHA256d -> Const (Digest' SHA256d) (Digest' SHA256d))
-> URIExtension -> Const (Digest' SHA256d) URIExtension
Lens' URIExtension (Digest' SHA256d)
shareRootHash) Share
aShare
proofs :: [[(Int, Digest' SHA256d)]]
proofs = (Int -> Share -> [(Int, Digest' SHA256d)])
-> (Int, Share) -> [(Int, Digest' SHA256d)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Share -> [(Int, Digest' SHA256d)]
oneProof ((Int, Share) -> [(Int, Digest' SHA256d)])
-> [(Int, Share)] -> [[(Int, Digest' SHA256d)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Share)]
shares
leafs :: [Digest' SHA256d]
leafs = MerkleTree ByteString SHA256d -> Digest' SHA256d
forall v a. MerkleTree v a -> Digest' a
rootHash (MerkleTree ByteString SHA256d -> Digest' SHA256d)
-> ((Int, Share) -> MerkleTree ByteString SHA256d)
-> (Int, Share)
-> Digest' SHA256d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)
blockHashTree (Share -> MerkleTree ByteString SHA256d)
-> ((Int, Share) -> Share)
-> (Int, Share)
-> MerkleTree ByteString SHA256d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Share) -> Share
forall a b. (a, b) -> b
snd ((Int, Share) -> Digest' SHA256d)
-> [(Int, Share)] -> [Digest' SHA256d]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Share)]
shares
oneProof :: Int -> Share -> [(Int, Digest' SHA256d)]
oneProof :: Int -> Share -> [(Int, Digest' SHA256d)]
oneProof Int
shareNum Share
share = ((Int, Digest' SHA256d) -> (Int, Digest' SHA256d))
-> [(Int, Digest' SHA256d)] -> [(Int, Digest' SHA256d)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Int) -> (Int, Digest' SHA256d) -> (Int, Digest' SHA256d)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) [(Int, Digest' SHA256d)]
proof
where
treeHeight :: Int
treeHeight = [(Int, Digest' SHA256d)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Getting [(Int, Digest' SHA256d)] Share [(Int, Digest' SHA256d)]
-> Share -> [(Int, Digest' SHA256d)]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [(Int, Digest' SHA256d)] Share [(Int, Digest' SHA256d)]
Lens' Share [(Int, Digest' SHA256d)]
neededHashes Share
share)
firstLeafNum :: Int
firstLeafNum = Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
treeHeight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
nodeNum :: Int
nodeNum = Int
firstLeafNum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
shareNum
proof :: [(Int, Digest' SHA256d)]
proof = ((Int, Digest' SHA256d) -> Bool)
-> [(Int, Digest' SHA256d)] -> [(Int, Digest' SHA256d)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
nodeNum) (Int -> Bool)
-> ((Int, Digest' SHA256d) -> Int)
-> (Int, Digest' SHA256d)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Digest' SHA256d) -> Int
forall a b. (a, b) -> a
fst) ((Int -> Int) -> (Int, Digest' SHA256d) -> (Int, Digest' 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, Digest' SHA256d) -> (Int, Digest' SHA256d))
-> [(Int, Digest' SHA256d)] -> [(Int, Digest' SHA256d)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting [(Int, Digest' SHA256d)] Share [(Int, Digest' SHA256d)]
-> Share -> [(Int, Digest' SHA256d)]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [(Int, Digest' SHA256d)] Share [(Int, Digest' SHA256d)]
Lens' Share [(Int, Digest' SHA256d)]
neededHashes Share
share)
showHashes :: (Show a, Show b) => [(a, b)] -> String
showHashes :: [(a, b)] -> String
showHashes = [String] -> String
unwords ([String] -> String)
-> ([(a, b)] -> [String]) -> [(a, b)] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> String) -> [(a, b)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> String
forall a b. (Show a, Show b) => (a, b) -> String
showHash
showHash :: (Show a, Show b) => (a, b) -> String
showHash :: (a, b) -> String
showHash (a
n, b
bs) = [String] -> String
unwords [a -> String
forall a. Show a => a -> String
show a
n, b -> String
forall a. Show a => a -> String
show b
bs]
shareValidBlocks :: Share -> [Maybe LB.ByteString]
shareValidBlocks :: Share -> [Maybe ByteString]
shareValidBlocks Share
share =
(ByteString -> Digest' SHA256d -> Maybe ByteString)
-> [ByteString] -> [Digest' SHA256d] -> [Maybe ByteString]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ByteString -> Digest' SHA256d -> Maybe ByteString
forall hash.
HashAlgorithm hash =>
ByteString -> Digest' hash -> Maybe ByteString
checkHash (Getting [ByteString] Share [ByteString] -> Share -> [ByteString]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [ByteString] Share [ByteString]
Lens' Share [ByteString]
blocks Share
share) (MerkleTree ByteString SHA256d -> [Digest' SHA256d]
forall v a. MerkleTree v a -> [Digest' a]
leafHashes (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)
blockHashTree Share
share))
where
checkHash :: forall hash. HashAlgorithm hash => LB.ByteString -> Digest' hash -> Maybe LB.ByteString
checkHash :: ByteString -> Digest' hash -> Maybe ByteString
checkHash ByteString
bs Digest' hash
expected
| ByteString -> Digest' hash
forall hash. HashAlgorithm hash => ByteString -> Digest' hash
blockHash' (ByteString -> ByteString
LB.toStrict ByteString
bs) Digest' hash -> Digest' hash -> Bool
forall a. Eq a => a -> a -> Bool
== Digest' hash
expected = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs
| Bool
otherwise = Maybe ByteString
forall a. Maybe a
Nothing
validSegment :: Digest' SHA256d -> Crypttext -> Maybe Crypttext
validSegment :: Digest' SHA256d -> ByteString -> Maybe ByteString
validSegment Digest' SHA256d
expected ByteString
crypttext
| ByteString -> Digest' SHA256d
forall hash. HashAlgorithm hash => ByteString -> Digest' hash
ciphertextSegmentHash' ByteString
crypttext Digest' SHA256d -> Digest' SHA256d -> Bool
forall a. Eq a => a -> a -> Bool
== Digest' SHA256d
expected = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
crypttext
| Bool
otherwise = Maybe ByteString
forall a. Maybe a
Nothing
validSegments :: [Digest' SHA256d] -> [Crypttext] -> [Maybe Crypttext]
validSegments :: [Digest' SHA256d] -> [ByteString] -> [Maybe ByteString]
validSegments = (Digest' SHA256d -> ByteString -> Maybe ByteString)
-> [Digest' SHA256d] -> [ByteString] -> [Maybe ByteString]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Digest' SHA256d -> ByteString -> Maybe ByteString
validSegment