{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module Tahoe.CHK.Share where
import Control.Exception (Exception, throw)
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.TreeDiff.Class (ToExpr)
import Data.Tuple.HT (mapFst)
import Debug.Trace ()
import GHC.Generics (Generic)
import Network.ByteOrder (bytestring32, bytestring64)
import Tahoe.CHK.Merkle (MerkleTree)
import Tahoe.CHK.Types (ShareNum)
import Tahoe.CHK.URIExtension (
URIExtension,
pURIExtension,
uriExtensionToBytes,
)
import Tahoe.Util (chunkedBy, toStrictByteString)
import Text.Megaparsec (parse)
data Share = Share
{
Share -> Word64
shareBlockSize :: Word64
,
Share -> Word64
shareDataSize :: Word64
,
Share -> [ByteString]
shareBlocks :: [LBS.ByteString]
,
Share -> MerkleTree
sharePlaintextHashTree :: MerkleTree
,
Share -> MerkleTree
shareCrypttextHashTree :: MerkleTree
,
Share -> MerkleTree
shareBlockHashTree :: MerkleTree
,
Share -> [(ShareNum, ByteString)]
shareNeededHashes :: [(ShareNum, BS.ByteString)]
,
Share -> URIExtension
shareURIExtension :: 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, Int -> Share -> ShowS
[Share] -> ShowS
Share -> String
(Int -> Share -> ShowS)
-> (Share -> String) -> ([Share] -> ShowS) -> Show Share
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Share] -> ShowS
$cshowList :: [Share] -> ShowS
show :: Share -> String
$cshow :: Share -> String
showsPrec :: Int -> Share -> ShowS
$cshowsPrec :: Int -> 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)
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
{ Word64
shareBlockSize :: Word64
shareBlockSize :: Share -> Word64
shareBlockSize
, Word64
shareDataSize :: Word64
shareDataSize :: Share -> Word64
shareDataSize
, [ByteString]
shareBlocks :: [ByteString]
shareBlocks :: Share -> [ByteString]
shareBlocks
, MerkleTree
sharePlaintextHashTree :: MerkleTree
sharePlaintextHashTree :: Share -> MerkleTree
sharePlaintextHashTree
, MerkleTree
shareCrypttextHashTree :: MerkleTree
shareCrypttextHashTree :: Share -> MerkleTree
shareCrypttextHashTree
, MerkleTree
shareBlockHashTree :: MerkleTree
shareBlockHashTree :: Share -> MerkleTree
shareBlockHashTree
, [(ShareNum, ByteString)]
shareNeededHashes :: [(ShareNum, ByteString)]
shareNeededHashes :: Share -> [(ShareNum, ByteString)]
shareNeededHashes
, URIExtension
shareURIExtension :: URIExtension
shareURIExtension :: Share -> URIExtension
shareURIExtension
} =
let
realSize :: Int64
realSize = (ByteString -> Int64) -> [ByteString] -> Int64
forall b a. Num b => (a -> b) -> [a] -> b
sumOn' ByteString -> Int64
LBS.length [ByteString]
shareBlocks
(ShareNum
version, Word64 -> ByteString
encodeWord, Word64 -> Put
putWord) = Word64 -> (ShareNum, Word64 -> ByteString, Word64 -> Put)
chooseVersion (Word64 -> (ShareNum, Word64 -> ByteString, Word64 -> Put))
-> Word64 -> (ShareNum, Word64 -> ByteString, Word64 -> Put)
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
max Word64
shareDataSize (Int64 -> Word64
int64ToWord64 Int64
realSize)
header :: [Word64]
header =
[ Word64
shareBlockSize
, Word64
shareDataSize
, (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Word64) Int
headerSize
]
[Word64] -> [Word64] -> [Word64]
forall a. Semigroup a => a -> a -> a
<> [Word64]
trailerFieldOffsets
headerSize :: Int
headerSize = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ShareNum -> Int
fieldSizeForVersion ShareNum
version Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Word64] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word64]
header
trailerOffset :: Word64
trailerOffset = (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Word64) Int
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 (Int -> [Word64] -> [Word64]
forall a. Int -> [a] -> [a]
dropEnd Int
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
shareURIExtension
trailerFields :: [ByteString]
trailerFields =
[ MerkleTree -> ByteString
forall a. Binary a => a -> ByteString
encode MerkleTree
sharePlaintextHashTree
, MerkleTree -> ByteString
forall a. Binary a => a -> ByteString
encode MerkleTree
shareCrypttextHashTree
, MerkleTree -> ByteString
forall a. Binary a => a -> ByteString
encode MerkleTree
shareBlockHashTree
, ByteString -> ByteString
LBS.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [(ShareNum, ByteString)] -> ByteString
serializeNeededShares [(ShareNum, ByteString)]
shareNeededHashes
, ByteString -> ByteString
LBS.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Word64 -> ByteString
encodeWord (Int -> Word64
intToWord64 (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
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 (ShareNum -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ShareNum
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]
shareBlocks
(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
(ShareNum
_version, Get Word64
getWord) <- Get (ShareNum, Get Word64)
getVersion
Word64
shareBlockSize <- Get Word64
getWord
Word64
shareDataSize <- 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
sharePlaintextHashTree <- String -> Word64 -> Word64 -> Get MerkleTree -> Get MerkleTree
forall a. String -> Word64 -> Word64 -> Get a -> Get a
isolateBetween String
"plaintext hash tree" Word64
plaintextHashTreeOffset Word64
crypttextHashTreeOffset (Get MerkleTree
forall t. Binary t => Get t
get :: Get MerkleTree)
MerkleTree
shareCrypttextHashTree <- String -> Word64 -> Word64 -> Get MerkleTree -> Get MerkleTree
forall a. String -> Word64 -> Word64 -> Get a -> Get a
isolateBetween String
"crypttext hash tree" Word64
crypttextHashTreeOffset Word64
blockHashesOffset (Get MerkleTree
forall t. Binary t => Get t
get :: Get MerkleTree)
MerkleTree
shareBlockHashTree <- String -> Word64 -> Word64 -> Get MerkleTree -> Get MerkleTree
forall a. String -> Word64 -> Word64 -> Get a -> Get a
isolateBetween String
"block hash tree" Word64
blockHashesOffset Word64
shareHashesOffset (Get MerkleTree
forall t. Binary t => Get t
get :: Get MerkleTree)
[(ShareNum, ByteString)]
shareNeededHashes <- ByteString -> [(ShareNum, ByteString)]
unserializeNeededShares (ByteString -> [(ShareNum, ByteString)])
-> (ByteString -> ByteString)
-> ByteString
-> [(ShareNum, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict (ByteString -> [(ShareNum, ByteString)])
-> Get ByteString -> Get [(ShareNum, ByteString)]
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
shareURIExtension <-
(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 shareBlocks :: [ByteString]
shareBlocks = Int64 -> ByteString -> [ByteString]
segmentLazyBytes (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
shareBlockSize) 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
-> MerkleTree
-> MerkleTree
-> [(ShareNum, ByteString)]
-> URIExtension
-> Share
Share{[(ShareNum, ByteString)]
[ByteString]
Word64
URIExtension
MerkleTree
shareBlocks :: [ByteString]
shareURIExtension :: URIExtension
shareNeededHashes :: [(ShareNum, ByteString)]
shareBlockHashTree :: MerkleTree
shareCrypttextHashTree :: MerkleTree
sharePlaintextHashTree :: MerkleTree
shareDataSize :: Word64
shareBlockSize :: Word64
shareURIExtension :: URIExtension
shareNeededHashes :: [(ShareNum, ByteString)]
shareBlockHashTree :: MerkleTree
shareCrypttextHashTree :: MerkleTree
sharePlaintextHashTree :: MerkleTree
shareBlocks :: [ByteString]
shareDataSize :: Word64
shareBlockSize :: 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 Int -> Get a -> Get a
forall a. Int -> Get a -> Get a
isolate (Word64 -> Int
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 :: [(ShareNum, BS.ByteString)] -> BS.ByteString
serializeNeededShares :: [(ShareNum, ByteString)] -> ByteString
serializeNeededShares = [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString)
-> ([(ShareNum, ByteString)] -> [ByteString])
-> [(ShareNum, ByteString)]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ShareNum, ByteString)] -> [ByteString]
forall a. Integral a => [(a, ByteString)] -> [ByteString]
pieces
where
pieces :: [(a, ByteString)] -> [ByteString]
pieces [] = []
pieces ((a
sharenum, ByteString
hash) : [(a, ByteString)]
xs)
| ByteString -> Int
BS.length ByteString
hash Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32 =
(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]
: ByteString
hash ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [(a, ByteString)] -> [ByteString]
pieces [(a, ByteString)]
xs
| Bool
otherwise =
String -> [ByteString]
forall a. HasCallStack => String -> a
error (String -> [ByteString]) -> String -> [ByteString]
forall a b. (a -> b) -> a -> b
$ String
"A 'needed shares' hash had length " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
BS.length ByteString
hash)
unserializeNeededShares :: BS.ByteString -> [(ShareNum, BS.ByteString)]
unserializeNeededShares :: ByteString -> [(ShareNum, ByteString)]
unserializeNeededShares ByteString
bs =
[(ShareNum, ByteString)]
result
where
chunks :: [ByteString]
chunks = Int -> ByteString -> [ByteString]
chunkedBy (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
32) ByteString
bs
pairs :: [(ByteString, ByteString)]
pairs = (ByteString -> (ByteString, ByteString))
-> [ByteString] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
2) [ByteString]
chunks
result :: [(ShareNum, ByteString)]
result = ((ByteString, ByteString) -> (ShareNum, ByteString))
-> [(ByteString, ByteString)] -> [(ShareNum, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString -> ShareNum)
-> (ByteString, ByteString) -> (ShareNum, ByteString)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst ByteString -> ShareNum
toShareNum) [(ByteString, ByteString)]
pairs
toShareNum :: BS.ByteString -> ShareNum
toShareNum :: ByteString -> ShareNum
toShareNum ByteString
x = Int -> ShareNum
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ShareNum) -> Int -> ShareNum
forall a b. (a -> b) -> a -> b
$ ShareNum -> Int
forall a. Enum a => a -> Int
fromEnum ShareNum
msb Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. ShareNum -> Int
forall a. Enum a => a -> Int
fromEnum ShareNum
lsb
where
msb :: ShareNum
msb = ByteString -> ShareNum
BS.head ByteString
x
lsb :: ShareNum
lsb = ByteString -> ShareNum
BS.last ByteString
x
intToWord64 :: Int -> Word64
intToWord64 :: Int -> Word64
intToWord64 Int
x
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> Word64
forall a. HasCallStack => String -> a
error String
"Negative Int cannot be converted to Word64"
| Bool
otherwise = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
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 (ShareNum, Get Word64)
getVersion = do
Word64
version <- Get Word64
getWord32
(ShareNum, Get Word64) -> Get (ShareNum, Get Word64)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( Word64 -> ShareNum
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 -> (ShareNum, Word64 -> ByteString, Word64 -> Put)
chooseVersion Word64
shareDataSize =
(ShareNum
version, Word64 -> ByteString
encodeWord, Word64 -> Put
putWord)
where
version :: ShareNum
version = if Word64
shareDataSize Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
forall i. Integral i => i
maxWord32 then ShareNum
1 else ShareNum
2
encodeWord :: Word64 -> ByteString
encodeWord
| ShareNum
version ShareNum -> ShareNum -> Bool
forall a. Eq a => a -> a -> Bool
== ShareNum
1 = Word64 -> ByteString
word64To4BytesPartial
| ShareNum
version ShareNum -> ShareNum -> Bool
forall a. Eq a => a -> a -> Bool
== ShareNum
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
<> ShareNum -> String
forall a. Show a => a -> String
show ShareNum
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 :: ShareNum -> Int
fieldSizeForVersion ShareNum
1 = Int
4
fieldSizeForVersion ShareNum
2 = Int
8
fieldSizeForVersion ShareNum
n = String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
"Unsupported version number: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShareNum -> String
forall a. Show a => a -> String
show ShareNum
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, Int -> EncodingError -> ShowS
[EncodingError] -> ShowS
EncodingError -> String
(Int -> EncodingError -> ShowS)
-> (EncodingError -> String)
-> ([EncodingError] -> ShowS)
-> Show EncodingError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EncodingError] -> ShowS
$cshowList :: [EncodingError] -> ShowS
show :: EncodingError -> String
$cshow :: EncodingError -> String
showsPrec :: Int -> EncodingError -> ShowS
$cshowsPrec :: Int -> EncodingError -> ShowS
Show)
instance Exception EncodingError