{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
module Tahoe.CHK.Share where
import Control.Exception (Exception, throw)
import Control.Lens (makeLenses)
import Crypto.Hash (HashAlgorithm (hashDigestSize), digestFromByteString)
import Data.Bifunctor (Bifunctor (bimap))
import Data.Binary (
Binary (get, put),
Word32,
Word64,
Word8,
encode,
)
import Data.Binary.Get (
Get,
bytesRead,
getLazyByteString,
isolate,
)
import Data.Binary.Put (Put, putLazyByteString)
import Data.Bits (shiftL, (.|.))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Either (fromRight)
import Data.Int (Int64)
import Data.List.Extra (dropEnd, sumOn')
import Data.Maybe (fromMaybe)
import Data.TreeDiff.Class (ToExpr)
import Debug.Trace ()
import GHC.Generics (Generic)
import Network.ByteOrder (bytestring32, bytestring64)
import Tahoe.CHK.Merkle (MerkleTree)
import Tahoe.CHK.SHA256d (Digest' (Digest'), SHA256d, toBytes)
import Tahoe.CHK.Types (ShareNum)
import Tahoe.CHK.URIExtension (
URIExtension,
pURIExtension,
uriExtensionToBytes,
)
import Tahoe.Util (chunkedBy, toStrictByteString)
import Text.Megaparsec (parse)
type Crypttext = BS.ByteString
data Share = Share
{
Share -> Word64
_blockSize :: Word64
,
Share -> Word64
_dataSize :: Word64
,
Share -> [ByteString]
_blocks :: [LBS.ByteString]
,
Share -> MerkleTree ByteString SHA256d
_plaintextHashTree :: MerkleTree BS.ByteString SHA256d
,
Share -> MerkleTree ByteString SHA256d
_crypttextHashTree :: MerkleTree Crypttext SHA256d
,
Share -> MerkleTree ByteString SHA256d
_blockHashTree :: MerkleTree BS.ByteString SHA256d
,
Share -> [(ShareNum, Digest' SHA256d)]
_neededHashes :: [(ShareNum, Digest' SHA256d)]
,
Share -> URIExtension
_uriExtension :: URIExtension
}
deriving (Share -> Share -> Bool
(Share -> Share -> Bool) -> (Share -> Share -> Bool) -> Eq Share
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Share -> Share -> Bool
$c/= :: Share -> Share -> Bool
== :: Share -> Share -> Bool
$c== :: Share -> Share -> Bool
Eq, Eq Share
Eq Share
-> (Share -> Share -> Ordering)
-> (Share -> Share -> Bool)
-> (Share -> Share -> Bool)
-> (Share -> Share -> Bool)
-> (Share -> Share -> Bool)
-> (Share -> Share -> Share)
-> (Share -> Share -> Share)
-> Ord Share
Share -> Share -> Bool
Share -> Share -> Ordering
Share -> Share -> Share
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 :: Share -> Share -> Share
$cmin :: Share -> Share -> Share
max :: Share -> Share -> Share
$cmax :: Share -> Share -> Share
>= :: Share -> Share -> Bool
$c>= :: Share -> Share -> Bool
> :: Share -> Share -> Bool
$c> :: Share -> Share -> Bool
<= :: Share -> Share -> Bool
$c<= :: Share -> Share -> Bool
< :: Share -> Share -> Bool
$c< :: Share -> Share -> Bool
compare :: Share -> Share -> Ordering
$ccompare :: Share -> Share -> Ordering
$cp1Ord :: Eq Share
Ord, ShareNum -> Share -> ShowS
[Share] -> ShowS
Share -> String
(ShareNum -> Share -> ShowS)
-> (Share -> String) -> ([Share] -> ShowS) -> Show Share
forall a.
(ShareNum -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Share] -> ShowS
$cshowList :: [Share] -> ShowS
show :: Share -> String
$cshow :: Share -> String
showsPrec :: ShareNum -> Share -> ShowS
$cshowsPrec :: ShareNum -> Share -> ShowS
Show, (forall x. Share -> Rep Share x)
-> (forall x. Rep Share x -> Share) -> Generic Share
forall x. Rep Share x -> Share
forall x. Share -> Rep Share x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Share x -> Share
$cfrom :: forall x. Share -> Rep Share x
Generic, [Share] -> Expr
Share -> Expr
(Share -> Expr) -> ([Share] -> Expr) -> ToExpr Share
forall a. (a -> Expr) -> ([a] -> Expr) -> ToExpr a
listToExpr :: [Share] -> Expr
$clistToExpr :: [Share] -> Expr
toExpr :: Share -> Expr
$ctoExpr :: Share -> Expr
ToExpr)
$(makeLenses ''Share)
getWord32 :: Get Word64
getWord32 :: Get Word64
getWord32 = do
Word32
word32 <- Get Word32
forall t. Binary t => Get t
get :: Get Word32
Word64 -> Get Word64
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> Get Word64) -> Word64 -> Get Word64
forall a b. (a -> b) -> a -> b
$ Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
word32
getWord64 :: Get Word64
getWord64 :: Get Word64
getWord64 = Get Word64
forall t. Binary t => Get t
get
word64To4Bytes :: Word64 -> Maybe BS.ByteString
word64To4Bytes :: Word64 -> Maybe ByteString
word64To4Bytes = (Word32 -> ByteString
bytestring32 (Word32 -> ByteString) -> Maybe Word32 -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe Word32 -> Maybe ByteString)
-> (Word64 -> Maybe Word32) -> Word64 -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Maybe Word32
word64ToWord32
word64To4Bytes' :: Word64 -> Either String BS.ByteString
word64To4Bytes' :: Word64 -> Either String ByteString
word64To4Bytes' Word64
w =
case Word64 -> Maybe ByteString
word64To4Bytes Word64
w of
Maybe ByteString
Nothing -> String -> Either String ByteString
forall a b. a -> Either a b
Left String
"Word64 out of bounds in conversion to Word32"
Just ByteString
bs -> ByteString -> Either String ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bs
word64To8Bytes :: Word64 -> BS.ByteString
word64To8Bytes :: Word64 -> ByteString
word64To8Bytes = Word64 -> ByteString
bytestring64
instance Binary Share where
put :: Share -> Put
put
Share{[(ShareNum, Digest' SHA256d)]
[ByteString]
Word64
URIExtension
MerkleTree ByteString SHA256d
_uriExtension :: URIExtension
_neededHashes :: [(ShareNum, Digest' SHA256d)]
_blockHashTree :: MerkleTree ByteString SHA256d
_crypttextHashTree :: MerkleTree ByteString SHA256d
_plaintextHashTree :: MerkleTree ByteString SHA256d
_blocks :: [ByteString]
_dataSize :: Word64
_blockSize :: Word64
_uriExtension :: Share -> URIExtension
_neededHashes :: Share -> [(ShareNum, Digest' SHA256d)]
_blockHashTree :: Share -> MerkleTree ByteString SHA256d
_crypttextHashTree :: Share -> MerkleTree ByteString SHA256d
_plaintextHashTree :: Share -> MerkleTree ByteString SHA256d
_blocks :: Share -> [ByteString]
_dataSize :: Share -> Word64
_blockSize :: Share -> Word64
..} =
let
realSize :: Int64
realSize = (ByteString -> Int64) -> [ByteString] -> Int64
forall b a. Num b => (a -> b) -> [a] -> b
sumOn' ByteString -> Int64
LBS.length [ByteString]
_blocks
(Word8
version, Word64 -> ByteString
encodeWord, Word64 -> Put
putWord) = Word64 -> (Word8, Word64 -> ByteString, Word64 -> Put)
chooseVersion (Word64 -> (Word8, Word64 -> ByteString, Word64 -> Put))
-> Word64 -> (Word8, Word64 -> ByteString, Word64 -> Put)
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
max Word64
_dataSize (Int64 -> Word64
int64ToWord64 Int64
realSize)
header :: [Word64]
header =
[ Word64
_blockSize
, Word64
_dataSize
, (ShareNum -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Word64) ShareNum
headerSize
]
[Word64] -> [Word64] -> [Word64]
forall a. Semigroup a => a -> a -> a
<> [Word64]
trailerFieldOffsets
headerSize :: ShareNum
headerSize = ShareNum
4 ShareNum -> ShareNum -> ShareNum
forall a. Num a => a -> a -> a
+ Word8 -> ShareNum
fieldSizeForVersion Word8
version ShareNum -> ShareNum -> ShareNum
forall a. Num a => a -> a -> a
* [Word64] -> ShareNum
forall (t :: * -> *) a. Foldable t => t a -> ShareNum
length [Word64]
header
trailerOffset :: Word64
trailerOffset = (ShareNum -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Word64) ShareNum
headerSize Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int64 -> Word64
int64ToWord64 Int64
realSize
trailerFieldOffsets :: [Word64]
trailerFieldOffsets = (Word64 -> Word64 -> Word64) -> Word64 -> [Word64] -> [Word64]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
(+) Word64
trailerOffset (ShareNum -> [Word64] -> [Word64]
forall a. ShareNum -> [a] -> [a]
dropEnd ShareNum
1 [Word64]
trailerFieldSizes)
trailerFieldSizes :: [Word64]
trailerFieldSizes = (ByteString -> Word64) -> [ByteString] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (Int64 -> Word64
int64ToWord64 (Int64 -> Word64) -> (ByteString -> Int64) -> ByteString -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
LBS.length) [ByteString]
trailerFields
ueb :: ByteString
ueb = URIExtension -> ByteString
uriExtensionToBytes URIExtension
_uriExtension
trailerFields :: [ByteString]
trailerFields =
[ MerkleTree ByteString SHA256d -> ByteString
forall a. Binary a => a -> ByteString
encode MerkleTree ByteString SHA256d
_plaintextHashTree
, MerkleTree ByteString SHA256d -> ByteString
forall a. Binary a => a -> ByteString
encode MerkleTree ByteString SHA256d
_crypttextHashTree
, MerkleTree ByteString SHA256d -> ByteString
forall a. Binary a => a -> ByteString
encode MerkleTree ByteString SHA256d
_blockHashTree
, ByteString -> ByteString
LBS.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [(ShareNum, Digest' SHA256d)] -> ByteString
forall hash.
HashAlgorithm hash =>
[(ShareNum, Digest' hash)] -> ByteString
serializeNeededShares [(ShareNum, Digest' SHA256d)]
_neededHashes
, ByteString -> ByteString
LBS.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Word64 -> ByteString
encodeWord (ShareNum -> Word64
intToWord64 (ShareNum -> Word64) -> ShareNum -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> ShareNum
BS.length ByteString
ueb) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
ueb
]
in do
Word32 -> Put
forall t. Binary t => t -> Put
put (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
version :: Word32)
(Word64 -> Put) -> [Word64] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word64 -> Put
putWord [Word64]
header
(ByteString -> Put) -> [ByteString] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ByteString -> Put
putLazyByteString [ByteString]
_blocks
(ByteString -> Put) -> [ByteString] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ByteString -> Put
putLazyByteString [ByteString]
trailerFields
get :: Get Share
get = do
(Word8
_version, Get Word64
getWord) <- Get (Word8, Get Word64)
getVersion
Word64
_blockSize <- Get Word64
getWord
Word64
_dataSize <- Get Word64
getWord
Word64
dataOffset <- Get Word64
getWord
Word64
plaintextHashTreeOffset <- Get Word64
getWord
Word64
crypttextHashTreeOffset <- Get Word64
getWord
Word64
blockHashesOffset <- Get Word64
getWord
Word64
shareHashesOffset <- Get Word64
getWord
Word64
uriExtensionLengthOffset <- Get Word64
getWord
ByteString
allShareBlocks <- String -> Word64 -> Word64 -> Get ByteString
getLazyByteStringInBoundsFrom String
"share blocks" Word64
dataOffset Word64
plaintextHashTreeOffset
MerkleTree ByteString SHA256d
_plaintextHashTree <- String
-> Word64
-> Word64
-> Get (MerkleTree ByteString SHA256d)
-> Get (MerkleTree ByteString SHA256d)
forall a. String -> Word64 -> Word64 -> Get a -> Get a
isolateBetween String
"plaintext hash tree" Word64
plaintextHashTreeOffset Word64
crypttextHashTreeOffset Get (MerkleTree ByteString SHA256d)
forall t. Binary t => Get t
get
MerkleTree ByteString SHA256d
_crypttextHashTree <- String
-> Word64
-> Word64
-> Get (MerkleTree ByteString SHA256d)
-> Get (MerkleTree ByteString SHA256d)
forall a. String -> Word64 -> Word64 -> Get a -> Get a
isolateBetween String
"crypttext hash tree" Word64
crypttextHashTreeOffset Word64
blockHashesOffset Get (MerkleTree ByteString SHA256d)
forall t. Binary t => Get t
get
MerkleTree ByteString SHA256d
_blockHashTree <- String
-> Word64
-> Word64
-> Get (MerkleTree ByteString SHA256d)
-> Get (MerkleTree ByteString SHA256d)
forall a. String -> Word64 -> Word64 -> Get a -> Get a
isolateBetween String
"block hash tree" Word64
blockHashesOffset Word64
shareHashesOffset Get (MerkleTree ByteString SHA256d)
forall t. Binary t => Get t
get
[(ShareNum, Digest' SHA256d)]
_neededHashes <- [(ShareNum, Digest' SHA256d)]
-> Maybe [(ShareNum, Digest' SHA256d)]
-> [(ShareNum, Digest' SHA256d)]
forall a. a -> Maybe a -> a
fromMaybe (String -> [(ShareNum, Digest' SHA256d)]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Could not parse `needed hashes`") (Maybe [(ShareNum, Digest' SHA256d)]
-> [(ShareNum, Digest' SHA256d)])
-> (ByteString -> Maybe [(ShareNum, Digest' SHA256d)])
-> ByteString
-> [(ShareNum, Digest' SHA256d)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe [(ShareNum, Digest' SHA256d)]
forall hash.
HashAlgorithm hash =>
ByteString -> Maybe [(ShareNum, Digest' hash)]
unserializeNeededShares (ByteString -> Maybe [(ShareNum, Digest' SHA256d)])
-> (ByteString -> ByteString)
-> ByteString
-> Maybe [(ShareNum, Digest' SHA256d)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict (ByteString -> [(ShareNum, Digest' SHA256d)])
-> Get ByteString -> Get [(ShareNum, Digest' SHA256d)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Word64 -> Word64 -> Get ByteString
getLazyByteStringInBoundsFrom String
"needed shares" Word64
shareHashesOffset Word64
uriExtensionLengthOffset
Int64
uriExtensionLength <- Get Word64
getWord Get Word64 -> (Word64 -> Get Int64) -> Get Int64
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Word64 -> Get Int64
getInt64FromWord64 String
"URI extension length"
ByteString
uriExtensionBytes <- Int64 -> Get ByteString
getLazyByteString Int64
uriExtensionLength
URIExtension
_uriExtension <-
(ParseErrorBundle ByteString Void -> Get URIExtension)
-> (URIExtension -> Get URIExtension)
-> Either (ParseErrorBundle ByteString Void) URIExtension
-> Get URIExtension
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(String -> Get URIExtension
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get URIExtension)
-> (ParseErrorBundle ByteString Void -> String)
-> ParseErrorBundle ByteString Void
-> Get URIExtension
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle ByteString Void -> String
forall a. Show a => a -> String
show)
URIExtension -> Get URIExtension
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(Parsec Void ByteString URIExtension
-> String
-> ByteString
-> Either (ParseErrorBundle ByteString Void) URIExtension
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parsec Void ByteString URIExtension
pURIExtension String
"URI extension" (ByteString
-> Either (ParseErrorBundle ByteString Void) URIExtension)
-> ByteString
-> Either (ParseErrorBundle ByteString Void) URIExtension
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LBS.toStrict ByteString
uriExtensionBytes)
let _blocks :: [ByteString]
_blocks = Int64 -> ByteString -> [ByteString]
segmentLazyBytes (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
_blockSize) ByteString
allShareBlocks
Share -> Get Share
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Share -> Get Share) -> Share -> Get Share
forall a b. (a -> b) -> a -> b
$ Share :: Word64
-> Word64
-> [ByteString]
-> MerkleTree ByteString SHA256d
-> MerkleTree ByteString SHA256d
-> MerkleTree ByteString SHA256d
-> [(ShareNum, Digest' SHA256d)]
-> URIExtension
-> Share
Share{[(ShareNum, Digest' SHA256d)]
[ByteString]
Word64
URIExtension
MerkleTree ByteString SHA256d
_blocks :: [ByteString]
_uriExtension :: URIExtension
_neededHashes :: [(ShareNum, Digest' SHA256d)]
_blockHashTree :: MerkleTree ByteString SHA256d
_crypttextHashTree :: MerkleTree ByteString SHA256d
_plaintextHashTree :: MerkleTree ByteString SHA256d
_dataSize :: Word64
_blockSize :: Word64
_uriExtension :: URIExtension
_neededHashes :: [(ShareNum, Digest' SHA256d)]
_blockHashTree :: MerkleTree ByteString SHA256d
_crypttextHashTree :: MerkleTree ByteString SHA256d
_plaintextHashTree :: MerkleTree ByteString SHA256d
_blocks :: [ByteString]
_dataSize :: Word64
_blockSize :: Word64
..}
segmentLazyBytes :: Int64 -> LBS.ByteString -> [LBS.ByteString]
segmentLazyBytes :: Int64 -> ByteString -> [ByteString]
segmentLazyBytes Int64
_segmentSize ByteString
"" = []
segmentLazyBytes Int64
segmentSize ByteString
bs = ByteString
nextSegment ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: Int64 -> ByteString -> [ByteString]
segmentLazyBytes Int64
segmentSize ByteString
theRest
where
(ByteString
nextSegment, ByteString
theRest) = Int64 -> ByteString -> (ByteString, ByteString)
LBS.splitAt Int64
segmentSize ByteString
bs
isolateBetween :: String -> Word64 -> Word64 -> Get a -> Get a
isolateBetween :: String -> Word64 -> Word64 -> Get a -> Get a
isolateBetween String
name Word64
start Word64
end Get a
g = do
Int64
pos <- Get Int64
bytesRead
if (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int64 -> Word64) Int64
pos Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
start
then String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get a) -> String -> Get a
forall a b. (a -> b) -> a -> b
$ String
"expected to read from " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word64 -> String
forall a. Show a => a -> String
show Word64
start String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" to get " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" but position is " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int64 -> String
forall a. Show a => a -> String
show Int64
pos
else ShareNum -> Get a -> Get a
forall a. ShareNum -> Get a -> Get a
isolate (Word64 -> ShareNum
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
end Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
start)) Get a
g
getLazyByteStringInBoundsFrom :: String -> Word64 -> Word64 -> Get LBS.ByteString
getLazyByteStringInBoundsFrom :: String -> Word64 -> Word64 -> Get ByteString
getLazyByteStringInBoundsFrom String
name Word64
expectedPosition Word64
offset = do
Int64
pos <- Get Int64
bytesRead
if (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int64 -> Word64) Int64
pos Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
expectedPosition
then String -> Get ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ByteString) -> String -> Get ByteString
forall a b. (a -> b) -> a -> b
$ String
"expected to read from " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word64 -> String
forall a. Show a => a -> String
show Word64
expectedPosition String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" to get " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" but position is " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int64 -> String
forall a. Show a => a -> String
show Int64
pos
else do
Int64
offsetInt64 <- String -> Word64 -> Get Int64
getInt64FromWord64 String
name Word64
offset
Int64 -> Get ByteString
getLazyByteString (Int64
offsetInt64 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
pos)
getInt64FromWord64 :: String -> Word64 -> Get Int64
getInt64FromWord64 :: String -> Word64 -> Get Int64
getInt64FromWord64 String
name = Get Int64 -> (Int64 -> Get Int64) -> Maybe Int64 -> Get Int64
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Get Int64
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Int64) -> String -> Get Int64
forall a b. (a -> b) -> a -> b
$ String
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" out of bounds") Int64 -> Get Int64
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Int64 -> Get Int64)
-> (Word64 -> Maybe Int64) -> Word64 -> Get Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Maybe Int64
word64ToInt64
word64ToInt64 :: Word64 -> Maybe Int64
word64ToInt64 :: Word64 -> Maybe Int64
word64ToInt64 Word64
w
| Word64
w Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
maxInt64 = Maybe Int64
forall a. Maybe a
Nothing
| Bool
otherwise = Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w)
where
maxInt64 :: Word64
maxInt64 :: Word64
maxInt64 = Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
forall a. Bounded a => a
maxBound :: Int64)
word64ToWord32 :: Word64 -> Maybe Word32
word64ToWord32 :: Word64 -> Maybe Word32
word64ToWord32 Word64
w
| Word64
w Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
forall i. Integral i => i
maxWord32 = Maybe Word32
forall a. Maybe a
Nothing
| Bool
otherwise = Word32 -> Maybe Word32
forall a. a -> Maybe a
Just (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w)
maxWord32 :: Integral i => i
maxWord32 :: i
maxWord32 = Word32 -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
forall a. Bounded a => a
maxBound :: Word32)
serializeNeededShares :: HashAlgorithm hash => [(ShareNum, Digest' hash)] -> BS.ByteString
serializeNeededShares :: [(ShareNum, Digest' hash)] -> ByteString
serializeNeededShares = [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString)
-> ([(ShareNum, Digest' hash)] -> [ByteString])
-> [(ShareNum, Digest' hash)]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ShareNum, Digest' hash)] -> [ByteString]
forall a a.
(Integral a, ByteArrayAccess a) =>
[(a, a)] -> [ByteString]
pieces
where
pieces :: [(a, a)] -> [ByteString]
pieces [] = []
pieces ((a
sharenum, a
hash) : [(a, a)]
xs) = (Builder -> ByteString
toStrictByteString (Builder -> ByteString) -> (a -> Builder) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Builder
BS.int16BE (Int16 -> Builder) -> (a -> Int16) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> ByteString) -> a -> ByteString
forall a b. (a -> b) -> a -> b
$ a
sharenum) ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: a -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
toBytes a
hash ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [(a, a)] -> [ByteString]
pieces [(a, a)]
xs
unserializeNeededShares :: forall hash. HashAlgorithm hash => BS.ByteString -> Maybe [(ShareNum, Digest' hash)]
unserializeNeededShares :: ByteString -> Maybe [(ShareNum, Digest' hash)]
unserializeNeededShares ByteString
bs =
((ShareNum, Maybe (Digest' hash))
-> Maybe (ShareNum, Digest' hash))
-> [(ShareNum, Maybe (Digest' hash))]
-> Maybe [(ShareNum, Digest' hash)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (ShareNum, Maybe (Digest' hash)) -> Maybe (ShareNum, Digest' hash)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [(ShareNum, Maybe (Digest' hash))]
result
where
chunks :: [ByteString]
chunks = ShareNum -> ByteString -> [ByteString]
chunkedBy (ShareNum
2 ShareNum -> ShareNum -> ShareNum
forall a. Num a => a -> a -> a
+ hash -> ShareNum
forall a. HashAlgorithm a => a -> ShareNum
hashDigestSize (hash
forall a. HasCallStack => a
undefined :: hash)) ByteString
bs
pairs :: [(ByteString, ByteString)]
pairs = (ByteString -> (ByteString, ByteString))
-> [ByteString] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map (ShareNum -> ByteString -> (ByteString, ByteString)
BS.splitAt ShareNum
2) [ByteString]
chunks
result :: [(ShareNum, Maybe (Digest' hash))]
result = (ByteString -> ShareNum)
-> (ByteString -> Maybe (Digest' hash))
-> (ByteString, ByteString)
-> (ShareNum, Maybe (Digest' hash))
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ByteString -> ShareNum
toShareNum ((Digest hash -> Digest' hash)
-> Maybe (Digest hash) -> Maybe (Digest' hash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Digest hash -> Digest' hash
forall a. Digest a -> Digest' a
Digest' (Maybe (Digest hash) -> Maybe (Digest' hash))
-> (ByteString -> Maybe (Digest hash))
-> ByteString
-> Maybe (Digest' hash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Digest hash)
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString) ((ByteString, ByteString) -> (ShareNum, Maybe (Digest' hash)))
-> [(ByteString, ByteString)] -> [(ShareNum, Maybe (Digest' hash))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ByteString, ByteString)]
pairs
toShareNum :: BS.ByteString -> ShareNum
toShareNum :: ByteString -> ShareNum
toShareNum ByteString
x = ShareNum -> ShareNum
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ShareNum -> ShareNum) -> ShareNum -> ShareNum
forall a b. (a -> b) -> a -> b
$ Word8 -> ShareNum
forall a. Enum a => a -> ShareNum
fromEnum Word8
msb ShareNum -> ShareNum -> ShareNum
forall a. Bits a => a -> ShareNum -> a
`shiftL` ShareNum
8 ShareNum -> ShareNum -> ShareNum
forall a. Bits a => a -> a -> a
.|. Word8 -> ShareNum
forall a. Enum a => a -> ShareNum
fromEnum Word8
lsb
where
msb :: Word8
msb = ByteString -> Word8
BS.head ByteString
x
lsb :: Word8
lsb = ByteString -> Word8
BS.last ByteString
x
intToWord64 :: Int -> Word64
intToWord64 :: ShareNum -> Word64
intToWord64 ShareNum
x
| ShareNum
x ShareNum -> ShareNum -> Bool
forall a. Ord a => a -> a -> Bool
< ShareNum
0 = String -> Word64
forall a. HasCallStack => String -> a
error String
"Negative Int cannot be converted to Word64"
| Bool
otherwise = ShareNum -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ShareNum
x
int64ToWord64 :: Int64 -> Word64
int64ToWord64 :: Int64 -> Word64
int64ToWord64 Int64
x
| Int64
x Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
0 = String -> Word64
forall a. HasCallStack => String -> a
error String
"Negative Int64 cannot be converted to Word64"
| Bool
otherwise = Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x
getVersion :: Get (Word8, Get Word64)
getVersion :: Get (Word8, Get Word64)
getVersion = do
Word64
version <- Get Word64
getWord32
(Word8, Get Word64) -> Get (Word8, Get Word64)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
version
, case Word64
version of
Word64
1 -> Get Word64
getWord32
Word64
2 -> Get Word64
getWord64
Word64
_ -> String -> Get Word64
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Word64) -> String -> Get Word64
forall a b. (a -> b) -> a -> b
$ String
"unsupported version: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word64 -> String
forall a. Show a => a -> String
show Word64
version
)
chooseVersion :: Word64 -> (Word8, Word64 -> BS.ByteString, Word64 -> Put)
chooseVersion :: Word64 -> (Word8, Word64 -> ByteString, Word64 -> Put)
chooseVersion Word64
shareDataSize =
(Word8
version, Word64 -> ByteString
encodeWord, Word64 -> Put
putWord)
where
version :: Word8
version = if Word64
shareDataSize Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
forall i. Integral i => i
maxWord32 then Word8
1 else Word8
2
encodeWord :: Word64 -> ByteString
encodeWord
| Word8
version Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
1 = Word64 -> ByteString
word64To4BytesPartial
| Word8
version Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
2 = Word64 -> ByteString
word64To8Bytes
| Bool
otherwise = String -> Word64 -> ByteString
forall a. HasCallStack => String -> a
error (String -> Word64 -> ByteString) -> String -> Word64 -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"unsupported version: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
version
putWord :: Word64 -> Put
putWord = ByteString -> Put
putLazyByteString (ByteString -> Put) -> (Word64 -> ByteString) -> Word64 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.fromStrict (ByteString -> ByteString)
-> (Word64 -> ByteString) -> Word64 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ByteString
encodeWord
fieldSizeForVersion :: Word8 -> Int
fieldSizeForVersion :: Word8 -> ShareNum
fieldSizeForVersion Word8
1 = ShareNum
4
fieldSizeForVersion Word8
2 = ShareNum
8
fieldSizeForVersion Word8
n = String -> ShareNum
forall a. HasCallStack => String -> a
error (String -> ShareNum) -> String -> ShareNum
forall a b. (a -> b) -> a -> b
$ String
"Unsupported version number: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
n
word64To4BytesPartial :: Word64 -> BS.ByteString
word64To4BytesPartial :: Word64 -> ByteString
word64To4BytesPartial Word64
i = ByteString -> Either String ByteString -> ByteString
forall b a. b -> Either a b -> b
fromRight (EncodingError -> ByteString
forall a e. Exception e => e -> a
throw (EncodingError -> ByteString) -> EncodingError -> ByteString
forall a b. (a -> b) -> a -> b
$ Word64 -> EncodingError
Word64OutOfBounds Word64
i) (Word64 -> Either String ByteString
word64To4Bytes' Word64
i)
newtype EncodingError = Word64OutOfBounds Word64 deriving (EncodingError -> EncodingError -> Bool
(EncodingError -> EncodingError -> Bool)
-> (EncodingError -> EncodingError -> Bool) -> Eq EncodingError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EncodingError -> EncodingError -> Bool
$c/= :: EncodingError -> EncodingError -> Bool
== :: EncodingError -> EncodingError -> Bool
$c== :: EncodingError -> EncodingError -> Bool
Eq, Eq EncodingError
Eq EncodingError
-> (EncodingError -> EncodingError -> Ordering)
-> (EncodingError -> EncodingError -> Bool)
-> (EncodingError -> EncodingError -> Bool)
-> (EncodingError -> EncodingError -> Bool)
-> (EncodingError -> EncodingError -> Bool)
-> (EncodingError -> EncodingError -> EncodingError)
-> (EncodingError -> EncodingError -> EncodingError)
-> Ord EncodingError
EncodingError -> EncodingError -> Bool
EncodingError -> EncodingError -> Ordering
EncodingError -> EncodingError -> EncodingError
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 :: EncodingError -> EncodingError -> EncodingError
$cmin :: EncodingError -> EncodingError -> EncodingError
max :: EncodingError -> EncodingError -> EncodingError
$cmax :: EncodingError -> EncodingError -> EncodingError
>= :: EncodingError -> EncodingError -> Bool
$c>= :: EncodingError -> EncodingError -> Bool
> :: EncodingError -> EncodingError -> Bool
$c> :: EncodingError -> EncodingError -> Bool
<= :: EncodingError -> EncodingError -> Bool
$c<= :: EncodingError -> EncodingError -> Bool
< :: EncodingError -> EncodingError -> Bool
$c< :: EncodingError -> EncodingError -> Bool
compare :: EncodingError -> EncodingError -> Ordering
$ccompare :: EncodingError -> EncodingError -> Ordering
$cp1Ord :: Eq EncodingError
Ord, ShareNum -> EncodingError -> ShowS
[EncodingError] -> ShowS
EncodingError -> String
(ShareNum -> EncodingError -> ShowS)
-> (EncodingError -> String)
-> ([EncodingError] -> ShowS)
-> Show EncodingError
forall a.
(ShareNum -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EncodingError] -> ShowS
$cshowList :: [EncodingError] -> ShowS
show :: EncodingError -> String
$cshow :: EncodingError -> String
showsPrec :: ShareNum -> EncodingError -> ShowS
$cshowsPrec :: ShareNum -> EncodingError -> ShowS
Show)
instance Exception EncodingError