{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module Tahoe.CHK.URIExtension (
    URIExtension (..),
    codecName,
    codecParams,
    tailCodecParams,
    size,
    segmentSize,
    numSegments,
    neededShares,
    totalShares,
    crypttextHash,
    crypttextRootHash,
    shareRootHash,
    uriExtensionToBytes,
    showBytes,
    pURIExtension,
) where

import Control.Applicative.Combinators (count)
import Control.Applicative.Permutations (runPermutation, toPermutation)
import Control.Lens (view)
import Control.Lens.TH (makeLenses)
import Control.Monad (join, void, (>=>))
import Crypto.Hash (HashAlgorithm, digestFromByteString)
import Data.TreeDiff.Class (ToExpr)
import Data.Void (Void)
import GHC.Generics (Generic)
import Tahoe.CHK.SHA256d (Digest' (Digest'), SHA256d, toBytes)

import Text.Megaparsec (
    MonadParsec (takeP),
    Parsec,
    anySingle,
 )
import Text.Megaparsec.Byte (string)
import Text.Megaparsec.Byte.Lexer (decimal)

import Data.ByteString.Base32 (
    encodeBase32Unpadded,
 )

import qualified Data.ByteString as B
import qualified Data.Text as T
import Data.Text.Encoding (
    decodeLatin1,
    encodeUtf8,
 )

import Data.List (
    sort,
 )

import qualified Tahoe.CHK.Parsing
import Tahoe.CHK.Types (
    CrypttextHash,
    Parameters (..),
    Required,
    SegmentNum,
    Size,
    Total,
 )
import Tahoe.Netstring (
    netstring,
 )

-- | Represent additional metadata that appears at the end of each share.
data URIExtension = URIExtension
    { -- | The name of the encoding function.  Only "zfec" is implemented.
      URIExtension -> ByteString
_codecName :: B.ByteString
    , -- | The parameters for the encoding function for all except the final
      -- segment.
      URIExtension -> Parameters
_codecParams :: Parameters
    , -- | The parameters for the encoding function for the final segment.
      URIExtension -> Parameters
_tailCodecParams :: Parameters
    , -- | The application data size in bytes.
      URIExtension -> Size
_size :: Size
    , -- | The individual segment size in bytes.
      URIExtension -> Size
_segmentSize :: Size
    , -- | The number of segments of application data.  Note the last segment
      -- may be short so it is not necessarily the case that uriExtSize ==
      -- uriExtSegmentSize * uriExtNumSegments.
      URIExtension -> SegmentNum
_numSegments :: SegmentNum
    , -- | The required (K) parameter to the encoding function.  This is a
      -- duplicate of the values in uriExtCodecParams and uriExtTailCodecParams.
      URIExtension -> Required
_neededShares :: Required
    , -- | The total (N) parameter to the encoding function.  This too is a
      -- duplicate.
      URIExtension -> Required
_totalShares :: Total
    , -- | A tagged sha256d hash of the complete ciphertext.
      URIExtension -> CrypttextHash SHA256d
_crypttextHash :: CrypttextHash SHA256d
    , -- | The root hash of a merkle tree where the leaf hashes are of segments of ciphertext.
      URIExtension -> CrypttextHash SHA256d
_crypttextRootHash :: CrypttextHash SHA256d
    , -- | The root hash of a merkle tree where leaf hashes are the root hashes of all of the block hash trees.
      URIExtension -> CrypttextHash SHA256d
_shareRootHash :: CrypttextHash SHA256d
    }
    deriving (URIExtension -> URIExtension -> Bool
(URIExtension -> URIExtension -> Bool)
-> (URIExtension -> URIExtension -> Bool) -> Eq URIExtension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: URIExtension -> URIExtension -> Bool
$c/= :: URIExtension -> URIExtension -> Bool
== :: URIExtension -> URIExtension -> Bool
$c== :: URIExtension -> URIExtension -> Bool
Eq, Eq URIExtension
Eq URIExtension
-> (URIExtension -> URIExtension -> Ordering)
-> (URIExtension -> URIExtension -> Bool)
-> (URIExtension -> URIExtension -> Bool)
-> (URIExtension -> URIExtension -> Bool)
-> (URIExtension -> URIExtension -> Bool)
-> (URIExtension -> URIExtension -> URIExtension)
-> (URIExtension -> URIExtension -> URIExtension)
-> Ord URIExtension
URIExtension -> URIExtension -> Bool
URIExtension -> URIExtension -> Ordering
URIExtension -> URIExtension -> URIExtension
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 :: URIExtension -> URIExtension -> URIExtension
$cmin :: URIExtension -> URIExtension -> URIExtension
max :: URIExtension -> URIExtension -> URIExtension
$cmax :: URIExtension -> URIExtension -> URIExtension
>= :: URIExtension -> URIExtension -> Bool
$c>= :: URIExtension -> URIExtension -> Bool
> :: URIExtension -> URIExtension -> Bool
$c> :: URIExtension -> URIExtension -> Bool
<= :: URIExtension -> URIExtension -> Bool
$c<= :: URIExtension -> URIExtension -> Bool
< :: URIExtension -> URIExtension -> Bool
$c< :: URIExtension -> URIExtension -> Bool
compare :: URIExtension -> URIExtension -> Ordering
$ccompare :: URIExtension -> URIExtension -> Ordering
$cp1Ord :: Eq URIExtension
Ord, (forall x. URIExtension -> Rep URIExtension x)
-> (forall x. Rep URIExtension x -> URIExtension)
-> Generic URIExtension
forall x. Rep URIExtension x -> URIExtension
forall x. URIExtension -> Rep URIExtension x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep URIExtension x -> URIExtension
$cfrom :: forall x. URIExtension -> Rep URIExtension x
Generic, [URIExtension] -> Expr
URIExtension -> Expr
(URIExtension -> Expr)
-> ([URIExtension] -> Expr) -> ToExpr URIExtension
forall a. (a -> Expr) -> ([a] -> Expr) -> ToExpr a
listToExpr :: [URIExtension] -> Expr
$clistToExpr :: [URIExtension] -> Expr
toExpr :: URIExtension -> Expr
$ctoExpr :: URIExtension -> Expr
ToExpr)

$(makeLenses ''URIExtension)

instance Show URIExtension where
    show :: URIExtension -> String
show (URIExtension ByteString
name Parameters
params Parameters
tailParams Size
sz Size
segSize SegmentNum
numSegs Required
needed Required
total CrypttextHash SHA256d
hash1 CrypttextHash SHA256d
hash2 CrypttextHash SHA256d
hash3) =
        Text -> String
T.unpack (Text -> String) -> ([Text] -> Text) -> [Text] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat ([Text] -> String) -> [Text] -> String
forall a b. (a -> b) -> a -> b
$
            [ Text
"URIExtension { "
            , Text
"codec = "
            , ByteString -> Text
decodeLatin1 ByteString
name
            , Text
"; codec-params = "
            , Parameters -> Text
forall s. Show s => s -> Text
showText Parameters
params
            , Text
"; tail-codec-params = "
            , Parameters -> Text
forall s. Show s => s -> Text
showText Parameters
tailParams
            , Text
"; size = "
            , Size -> Text
forall s. Show s => s -> Text
showText Size
sz
            , Text
"; segment-size = "
            , Size -> Text
forall s. Show s => s -> Text
showText Size
segSize
            , Text
"; num-segments = "
            , SegmentNum -> Text
forall s. Show s => s -> Text
showText SegmentNum
numSegs
            , Text
"; needed-shares = "
            , Required -> Text
forall s. Show s => s -> Text
showText Required
needed
            , Text
"; total-shares = "
            , Required -> Text
forall s. Show s => s -> Text
showText Required
total
            , Text
"; crypttext-hash = "
            , Text -> Text
forall s. Show s => s -> Text
showText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ CrypttextHash SHA256d -> Text
b32 CrypttextHash SHA256d
hash1
            , Text
"; crypttext-root-hash = "
            , Text -> Text
forall s. Show s => s -> Text
showText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ CrypttextHash SHA256d -> Text
b32 CrypttextHash SHA256d
hash2
            , Text
"; share-root-hash = "
            , Text -> Text
forall s. Show s => s -> Text
showText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ CrypttextHash SHA256d -> Text
b32 CrypttextHash SHA256d
hash3
            , Text
" }"
            ]
      where
        showText :: Show s => s -> T.Text
        showText :: s -> Text
showText = String -> Text
T.pack (String -> Text) -> (s -> String) -> s -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> String
forall a. Show a => a -> String
show
        b32 :: CrypttextHash SHA256d -> Text
b32 = ByteString -> Text
encodeBase32Unpadded (ByteString -> Text)
-> (CrypttextHash SHA256d -> ByteString)
-> CrypttextHash SHA256d
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CrypttextHash SHA256d -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
toBytes

-- Serialize a URIExtension to bytes in the format it appears in a CHK share.
uriExtensionToBytes :: URIExtension -> B.ByteString
uriExtensionToBytes :: URIExtension -> ByteString
uriExtensionToBytes =
    [(ByteString, URIExtension -> ByteString)]
-> URIExtension -> ByteString
toWeirdString
        -- all of the below values are authenticated by the capability you get when you store data in Tahoe
        [ (ByteString
"codec_name", Getting ByteString URIExtension ByteString
-> URIExtension -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString URIExtension ByteString
Lens' URIExtension ByteString
codecName)
        , (ByteString
"codec_params", Parameters -> ByteString
paramsToBytes (Parameters -> ByteString)
-> (URIExtension -> Parameters) -> URIExtension -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Parameters URIExtension Parameters
-> URIExtension -> Parameters
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Parameters URIExtension Parameters
Lens' URIExtension Parameters
codecParams)
        , (ByteString
"tail_codec_params", Parameters -> ByteString
paramsToBytes (Parameters -> ByteString)
-> (URIExtension -> Parameters) -> URIExtension -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Parameters URIExtension Parameters
-> URIExtension -> Parameters
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Parameters URIExtension Parameters
Lens' URIExtension Parameters
tailCodecParams)
        , (ByteString
"size", Size -> ByteString
forall s. Show s => s -> ByteString
showBytes (Size -> ByteString)
-> (URIExtension -> Size) -> URIExtension -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Size URIExtension Size -> URIExtension -> Size
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Size URIExtension Size
Lens' URIExtension Size
size)
        , (ByteString
"segment_size", Size -> ByteString
forall s. Show s => s -> ByteString
showBytes (Size -> ByteString)
-> (URIExtension -> Size) -> URIExtension -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Size URIExtension Size -> URIExtension -> Size
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Size URIExtension Size
Lens' URIExtension Size
segmentSize)
        , (ByteString
"num_segments", SegmentNum -> ByteString
forall s. Show s => s -> ByteString
showBytes (SegmentNum -> ByteString)
-> (URIExtension -> SegmentNum) -> URIExtension -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting SegmentNum URIExtension SegmentNum
-> URIExtension -> SegmentNum
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting SegmentNum URIExtension SegmentNum
Lens' URIExtension SegmentNum
numSegments)
        , (ByteString
"needed_shares", Required -> ByteString
forall s. Show s => s -> ByteString
showBytes (Required -> ByteString)
-> (URIExtension -> Required) -> URIExtension -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Required URIExtension Required -> URIExtension -> Required
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Required URIExtension Required
Lens' URIExtension Required
neededShares)
        , (ByteString
"total_shares", Required -> ByteString
forall s. Show s => s -> ByteString
showBytes (Required -> ByteString)
-> (URIExtension -> Required) -> URIExtension -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Required URIExtension Required -> URIExtension -> Required
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Required URIExtension Required
Lens' URIExtension Required
totalShares)
        , (ByteString
"crypttext_hash", CrypttextHash SHA256d -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
toBytes (CrypttextHash SHA256d -> ByteString)
-> (URIExtension -> CrypttextHash SHA256d)
-> URIExtension
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (CrypttextHash SHA256d) URIExtension (CrypttextHash SHA256d)
-> URIExtension -> CrypttextHash SHA256d
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (CrypttextHash SHA256d) URIExtension (CrypttextHash SHA256d)
Lens' URIExtension (CrypttextHash SHA256d)
crypttextHash) -- hash of the *entire* cipher text
        , (ByteString
"crypttext_root_hash", CrypttextHash SHA256d -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
toBytes (CrypttextHash SHA256d -> ByteString)
-> (URIExtension -> CrypttextHash SHA256d)
-> URIExtension
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (CrypttextHash SHA256d) URIExtension (CrypttextHash SHA256d)
-> URIExtension -> CrypttextHash SHA256d
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (CrypttextHash SHA256d) URIExtension (CrypttextHash SHA256d)
Lens' URIExtension (CrypttextHash SHA256d)
crypttextRootHash) -- root hash of the *cipher text* merkle tree
        , (ByteString
"share_root_hash", CrypttextHash SHA256d -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
toBytes (CrypttextHash SHA256d -> ByteString)
-> (URIExtension -> CrypttextHash SHA256d)
-> URIExtension
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (CrypttextHash SHA256d) URIExtension (CrypttextHash SHA256d)
-> URIExtension -> CrypttextHash SHA256d
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (CrypttextHash SHA256d) URIExtension (CrypttextHash SHA256d)
Lens' URIExtension (CrypttextHash SHA256d)
shareRootHash) -- root hash of the *share* merkle tree
        ]

type Parser = Parsec Void B.ByteString

-- | A version of bounded specialized to parsing bytestrings.
bounded :: (Ord n, Integral n) => n -> n -> Parser n
bounded :: n -> n -> Parser n
bounded = ParsecT Void ByteString Identity Size -> n -> n -> Parser n
forall e s (m :: * -> *) n.
(MonadParsec e s m, Ord n, Integral n) =>
m Size -> n -> n -> m n
Tahoe.CHK.Parsing.bounded ParsecT Void ByteString Identity Size
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
decimal

{- | Parse the representation of a URIExtension which appears in CHK shares
 back into a URIExtension.
-}
pURIExtension :: Parser URIExtension
pURIExtension :: Parser URIExtension
pURIExtension =
    Permutation (ParsecT Void ByteString Identity) URIExtension
-> Parser URIExtension
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation (ParsecT Void ByteString Identity) URIExtension
 -> Parser URIExtension)
-> Permutation (ParsecT Void ByteString Identity) URIExtension
-> Parser URIExtension
forall a b. (a -> b) -> a -> b
$
        ByteString
-> Parameters
-> Parameters
-> Size
-> Size
-> SegmentNum
-> Required
-> Required
-> CrypttextHash SHA256d
-> CrypttextHash SHA256d
-> CrypttextHash SHA256d
-> URIExtension
URIExtension
            (ByteString
 -> Parameters
 -> Parameters
 -> Size
 -> Size
 -> SegmentNum
 -> Required
 -> Required
 -> CrypttextHash SHA256d
 -> CrypttextHash SHA256d
 -> CrypttextHash SHA256d
 -> URIExtension)
-> Permutation (ParsecT Void ByteString Identity) ByteString
-> Permutation
     (ParsecT Void ByteString Identity)
     (Parameters
      -> Parameters
      -> Size
      -> Size
      -> SegmentNum
      -> Required
      -> Required
      -> CrypttextHash SHA256d
      -> CrypttextHash SHA256d
      -> CrypttextHash SHA256d
      -> URIExtension)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void ByteString Identity ByteString
-> Permutation (ParsecT Void ByteString Identity) ByteString
forall (m :: * -> *) a. Alternative m => m a -> Permutation m a
toPermutation ([Word8] -> ByteString
B.pack ([Word8] -> ByteString)
-> ParsecT Void ByteString Identity [Word8]
-> ParsecT Void ByteString Identity ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString
-> (SegmentNum -> ParsecT Void ByteString Identity [Word8])
-> ParsecT Void ByteString Identity [Word8]
forall a. ByteString -> (SegmentNum -> Parser a) -> Parser a
pField ByteString
"codec_name" (SegmentNum
-> ParsecT Void ByteString Identity Word8
-> ParsecT Void ByteString Identity [Word8]
forall (m :: * -> *) a. Applicative m => SegmentNum -> m a -> m [a]
`count` ParsecT Void ByteString Identity Word8
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle))
            Permutation
  (ParsecT Void ByteString Identity)
  (Parameters
   -> Parameters
   -> Size
   -> Size
   -> SegmentNum
   -> Required
   -> Required
   -> CrypttextHash SHA256d
   -> CrypttextHash SHA256d
   -> CrypttextHash SHA256d
   -> URIExtension)
-> Permutation (ParsecT Void ByteString Identity) Parameters
-> Permutation
     (ParsecT Void ByteString Identity)
     (Parameters
      -> Size
      -> Size
      -> SegmentNum
      -> Required
      -> Required
      -> CrypttextHash SHA256d
      -> CrypttextHash SHA256d
      -> CrypttextHash SHA256d
      -> URIExtension)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void ByteString Identity Parameters
-> Permutation (ParsecT Void ByteString Identity) Parameters
forall (m :: * -> *) a. Alternative m => m a -> Permutation m a
toPermutation (ByteString
-> (SegmentNum -> ParsecT Void ByteString Identity Parameters)
-> ParsecT Void ByteString Identity Parameters
forall a. ByteString -> (SegmentNum -> Parser a) -> Parser a
pField ByteString
"codec_params" ((SegmentNum -> ParsecT Void ByteString Identity Parameters)
 -> ParsecT Void ByteString Identity Parameters)
-> (SegmentNum -> ParsecT Void ByteString Identity Parameters)
-> ParsecT Void ByteString Identity Parameters
forall a b. (a -> b) -> a -> b
$ ParsecT Void ByteString Identity Parameters
-> SegmentNum -> ParsecT Void ByteString Identity Parameters
forall a b. a -> b -> a
const ParsecT Void ByteString Identity Parameters
pParameters)
            Permutation
  (ParsecT Void ByteString Identity)
  (Parameters
   -> Size
   -> Size
   -> SegmentNum
   -> Required
   -> Required
   -> CrypttextHash SHA256d
   -> CrypttextHash SHA256d
   -> CrypttextHash SHA256d
   -> URIExtension)
-> Permutation (ParsecT Void ByteString Identity) Parameters
-> Permutation
     (ParsecT Void ByteString Identity)
     (Size
      -> Size
      -> SegmentNum
      -> Required
      -> Required
      -> CrypttextHash SHA256d
      -> CrypttextHash SHA256d
      -> CrypttextHash SHA256d
      -> URIExtension)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void ByteString Identity Parameters
-> Permutation (ParsecT Void ByteString Identity) Parameters
forall (m :: * -> *) a. Alternative m => m a -> Permutation m a
toPermutation (ByteString
-> (SegmentNum -> ParsecT Void ByteString Identity Parameters)
-> ParsecT Void ByteString Identity Parameters
forall a. ByteString -> (SegmentNum -> Parser a) -> Parser a
pField ByteString
"tail_codec_params" ((SegmentNum -> ParsecT Void ByteString Identity Parameters)
 -> ParsecT Void ByteString Identity Parameters)
-> (SegmentNum -> ParsecT Void ByteString Identity Parameters)
-> ParsecT Void ByteString Identity Parameters
forall a b. (a -> b) -> a -> b
$ ParsecT Void ByteString Identity Parameters
-> SegmentNum -> ParsecT Void ByteString Identity Parameters
forall a b. a -> b -> a
const ParsecT Void ByteString Identity Parameters
pParameters)
            Permutation
  (ParsecT Void ByteString Identity)
  (Size
   -> Size
   -> SegmentNum
   -> Required
   -> Required
   -> CrypttextHash SHA256d
   -> CrypttextHash SHA256d
   -> CrypttextHash SHA256d
   -> URIExtension)
-> Permutation (ParsecT Void ByteString Identity) Size
-> Permutation
     (ParsecT Void ByteString Identity)
     (Size
      -> SegmentNum
      -> Required
      -> Required
      -> CrypttextHash SHA256d
      -> CrypttextHash SHA256d
      -> CrypttextHash SHA256d
      -> URIExtension)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void ByteString Identity Size
-> Permutation (ParsecT Void ByteString Identity) Size
forall (m :: * -> *) a. Alternative m => m a -> Permutation m a
toPermutation (ByteString
-> (SegmentNum -> ParsecT Void ByteString Identity Size)
-> ParsecT Void ByteString Identity Size
forall a. ByteString -> (SegmentNum -> Parser a) -> Parser a
pField ByteString
"size" ((SegmentNum -> ParsecT Void ByteString Identity Size)
 -> ParsecT Void ByteString Identity Size)
-> (SegmentNum -> ParsecT Void ByteString Identity Size)
-> ParsecT Void ByteString Identity Size
forall a b. (a -> b) -> a -> b
$ ParsecT Void ByteString Identity Size
-> SegmentNum -> ParsecT Void ByteString Identity Size
forall a b. a -> b -> a
const ParsecT Void ByteString Identity Size
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
decimal)
            Permutation
  (ParsecT Void ByteString Identity)
  (Size
   -> SegmentNum
   -> Required
   -> Required
   -> CrypttextHash SHA256d
   -> CrypttextHash SHA256d
   -> CrypttextHash SHA256d
   -> URIExtension)
-> Permutation (ParsecT Void ByteString Identity) Size
-> Permutation
     (ParsecT Void ByteString Identity)
     (SegmentNum
      -> Required
      -> Required
      -> CrypttextHash SHA256d
      -> CrypttextHash SHA256d
      -> CrypttextHash SHA256d
      -> URIExtension)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void ByteString Identity Size
-> Permutation (ParsecT Void ByteString Identity) Size
forall (m :: * -> *) a. Alternative m => m a -> Permutation m a
toPermutation (ByteString
-> (SegmentNum -> ParsecT Void ByteString Identity Size)
-> ParsecT Void ByteString Identity Size
forall a. ByteString -> (SegmentNum -> Parser a) -> Parser a
pField ByteString
"segment_size" ((SegmentNum -> ParsecT Void ByteString Identity Size)
 -> ParsecT Void ByteString Identity Size)
-> (SegmentNum -> ParsecT Void ByteString Identity Size)
-> ParsecT Void ByteString Identity Size
forall a b. (a -> b) -> a -> b
$ ParsecT Void ByteString Identity Size
-> SegmentNum -> ParsecT Void ByteString Identity Size
forall a b. a -> b -> a
const ParsecT Void ByteString Identity Size
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
decimal)
            Permutation
  (ParsecT Void ByteString Identity)
  (SegmentNum
   -> Required
   -> Required
   -> CrypttextHash SHA256d
   -> CrypttextHash SHA256d
   -> CrypttextHash SHA256d
   -> URIExtension)
-> Permutation (ParsecT Void ByteString Identity) SegmentNum
-> Permutation
     (ParsecT Void ByteString Identity)
     (Required
      -> Required
      -> CrypttextHash SHA256d
      -> CrypttextHash SHA256d
      -> CrypttextHash SHA256d
      -> URIExtension)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void ByteString Identity SegmentNum
-> Permutation (ParsecT Void ByteString Identity) SegmentNum
forall (m :: * -> *) a. Alternative m => m a -> Permutation m a
toPermutation (ByteString
-> (SegmentNum -> ParsecT Void ByteString Identity SegmentNum)
-> ParsecT Void ByteString Identity SegmentNum
forall a. ByteString -> (SegmentNum -> Parser a) -> Parser a
pField ByteString
"num_segments" ((SegmentNum -> ParsecT Void ByteString Identity SegmentNum)
 -> ParsecT Void ByteString Identity SegmentNum)
-> (SegmentNum -> ParsecT Void ByteString Identity SegmentNum)
-> ParsecT Void ByteString Identity SegmentNum
forall a b. (a -> b) -> a -> b
$ ParsecT Void ByteString Identity SegmentNum
-> SegmentNum -> ParsecT Void ByteString Identity SegmentNum
forall a b. a -> b -> a
const (SegmentNum
-> SegmentNum -> ParsecT Void ByteString Identity SegmentNum
forall n. (Ord n, Integral n) => n -> n -> Parser n
bounded SegmentNum
1 SegmentNum
forall a. Bounded a => a
maxBound))
            Permutation
  (ParsecT Void ByteString Identity)
  (Required
   -> Required
   -> CrypttextHash SHA256d
   -> CrypttextHash SHA256d
   -> CrypttextHash SHA256d
   -> URIExtension)
-> Permutation (ParsecT Void ByteString Identity) Required
-> Permutation
     (ParsecT Void ByteString Identity)
     (Required
      -> CrypttextHash SHA256d
      -> CrypttextHash SHA256d
      -> CrypttextHash SHA256d
      -> URIExtension)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void ByteString Identity Required
-> Permutation (ParsecT Void ByteString Identity) Required
forall (m :: * -> *) a. Alternative m => m a -> Permutation m a
toPermutation (ByteString
-> (SegmentNum -> ParsecT Void ByteString Identity Required)
-> ParsecT Void ByteString Identity Required
forall a. ByteString -> (SegmentNum -> Parser a) -> Parser a
pField ByteString
"needed_shares" ((SegmentNum -> ParsecT Void ByteString Identity Required)
 -> ParsecT Void ByteString Identity Required)
-> (SegmentNum -> ParsecT Void ByteString Identity Required)
-> ParsecT Void ByteString Identity Required
forall a b. (a -> b) -> a -> b
$ ParsecT Void ByteString Identity Required
-> SegmentNum -> ParsecT Void ByteString Identity Required
forall a b. a -> b -> a
const (Required -> Required -> ParsecT Void ByteString Identity Required
forall n. (Ord n, Integral n) => n -> n -> Parser n
bounded Required
1 Required
256))
            Permutation
  (ParsecT Void ByteString Identity)
  (Required
   -> CrypttextHash SHA256d
   -> CrypttextHash SHA256d
   -> CrypttextHash SHA256d
   -> URIExtension)
-> Permutation (ParsecT Void ByteString Identity) Required
-> Permutation
     (ParsecT Void ByteString Identity)
     (CrypttextHash SHA256d
      -> CrypttextHash SHA256d -> CrypttextHash SHA256d -> URIExtension)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void ByteString Identity Required
-> Permutation (ParsecT Void ByteString Identity) Required
forall (m :: * -> *) a. Alternative m => m a -> Permutation m a
toPermutation (ByteString
-> (SegmentNum -> ParsecT Void ByteString Identity Required)
-> ParsecT Void ByteString Identity Required
forall a. ByteString -> (SegmentNum -> Parser a) -> Parser a
pField ByteString
"total_shares" ((SegmentNum -> ParsecT Void ByteString Identity Required)
 -> ParsecT Void ByteString Identity Required)
-> (SegmentNum -> ParsecT Void ByteString Identity Required)
-> ParsecT Void ByteString Identity Required
forall a b. (a -> b) -> a -> b
$ ParsecT Void ByteString Identity Required
-> SegmentNum -> ParsecT Void ByteString Identity Required
forall a b. a -> b -> a
const (Required -> Required -> ParsecT Void ByteString Identity Required
forall n. (Ord n, Integral n) => n -> n -> Parser n
bounded Required
1 Required
256))
            Permutation
  (ParsecT Void ByteString Identity)
  (CrypttextHash SHA256d
   -> CrypttextHash SHA256d -> CrypttextHash SHA256d -> URIExtension)
-> Permutation
     (ParsecT Void ByteString Identity) (CrypttextHash SHA256d)
-> Permutation
     (ParsecT Void ByteString Identity)
     (CrypttextHash SHA256d -> CrypttextHash SHA256d -> URIExtension)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void ByteString Identity (CrypttextHash SHA256d)
-> Permutation
     (ParsecT Void ByteString Identity) (CrypttextHash SHA256d)
forall (m :: * -> *) a. Alternative m => m a -> Permutation m a
toPermutation (ByteString
-> (SegmentNum -> Parser (Maybe (CrypttextHash SHA256d)))
-> ParsecT Void ByteString Identity (CrypttextHash SHA256d)
forall a.
ByteString -> (SegmentNum -> Parser (Maybe a)) -> Parser a
pFieldM ByteString
"crypttext_hash" SegmentNum -> Parser (Maybe (CrypttextHash SHA256d))
forall hash.
HashAlgorithm hash =>
SegmentNum -> Parser (Maybe (Digest' hash))
pDigest)
            Permutation
  (ParsecT Void ByteString Identity)
  (CrypttextHash SHA256d -> CrypttextHash SHA256d -> URIExtension)
-> Permutation
     (ParsecT Void ByteString Identity) (CrypttextHash SHA256d)
-> Permutation
     (ParsecT Void ByteString Identity)
     (CrypttextHash SHA256d -> URIExtension)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void ByteString Identity (CrypttextHash SHA256d)
-> Permutation
     (ParsecT Void ByteString Identity) (CrypttextHash SHA256d)
forall (m :: * -> *) a. Alternative m => m a -> Permutation m a
toPermutation (ByteString
-> (SegmentNum -> Parser (Maybe (CrypttextHash SHA256d)))
-> ParsecT Void ByteString Identity (CrypttextHash SHA256d)
forall a.
ByteString -> (SegmentNum -> Parser (Maybe a)) -> Parser a
pFieldM ByteString
"crypttext_root_hash" SegmentNum -> Parser (Maybe (CrypttextHash SHA256d))
forall hash.
HashAlgorithm hash =>
SegmentNum -> Parser (Maybe (Digest' hash))
pDigest)
            Permutation
  (ParsecT Void ByteString Identity)
  (CrypttextHash SHA256d -> URIExtension)
-> Permutation
     (ParsecT Void ByteString Identity) (CrypttextHash SHA256d)
-> Permutation (ParsecT Void ByteString Identity) URIExtension
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void ByteString Identity (CrypttextHash SHA256d)
-> Permutation
     (ParsecT Void ByteString Identity) (CrypttextHash SHA256d)
forall (m :: * -> *) a. Alternative m => m a -> Permutation m a
toPermutation (ByteString
-> (SegmentNum -> Parser (Maybe (CrypttextHash SHA256d)))
-> ParsecT Void ByteString Identity (CrypttextHash SHA256d)
forall a.
ByteString -> (SegmentNum -> Parser (Maybe a)) -> Parser a
pFieldM ByteString
"share_root_hash" SegmentNum -> Parser (Maybe (CrypttextHash SHA256d))
forall hash.
HashAlgorithm hash =>
SegmentNum -> Parser (Maybe (Digest' hash))
pDigest)

{- | Parse the raw bytes of a hash algorithm digest back into a Digest'.  The
 parser succeeds if exactly the size of the digest exactly matches the
 specified number of tokens to parse.
-}
pDigest :: HashAlgorithm hash => Int -> Parser (Maybe (Digest' hash))
pDigest :: SegmentNum -> Parser (Maybe (Digest' hash))
pDigest = Maybe String
-> SegmentNum
-> ParsecT Void ByteString Identity (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> SegmentNum -> m (Tokens s)
takeP Maybe String
forall a. Maybe a
Nothing (SegmentNum -> ParsecT Void ByteString Identity ByteString)
-> (ByteString -> Parser (Maybe (Digest' hash)))
-> SegmentNum
-> Parser (Maybe (Digest' hash))
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Maybe (Digest' hash) -> Parser (Maybe (Digest' hash))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Digest' hash) -> Parser (Maybe (Digest' hash)))
-> (ByteString -> Maybe (Digest' hash))
-> ByteString
-> Parser (Maybe (Digest' hash))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Digest hash -> Digest' hash
forall a. Digest a -> Digest' a
Digest' (Digest hash -> Digest' hash)
-> Maybe (Digest hash) -> Maybe (Digest' hash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (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)

-- | Parse one field of a serialized URIExtension.
pField ::
    -- | The serialized label for the field.
    B.ByteString ->
    -- | A function that takes the length of the field value and returns a parser for the field value.
    (Int -> Parser a) ->
    -- | A parser for the field.
    Parser a
pField :: ByteString -> (SegmentNum -> Parser a) -> Parser a
pField ByteString
label SegmentNum -> Parser a
pInner = do
    ParsecT Void ByteString Identity ByteString
-> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void ByteString Identity ByteString
 -> ParsecT Void ByteString Identity ())
-> ParsecT Void ByteString Identity ByteString
-> ParsecT Void ByteString Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens ByteString
-> ParsecT Void ByteString Identity (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (ByteString
label ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
":")
    SegmentNum
len <- ParsecT Void ByteString Identity SegmentNum
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
decimal -- XXX Could overflow
    ParsecT Void ByteString Identity ByteString
-> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void ByteString Identity ByteString
 -> ParsecT Void ByteString Identity ())
-> ParsecT Void ByteString Identity ByteString
-> ParsecT Void ByteString Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens ByteString
-> ParsecT Void ByteString Identity (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
":"
    a
result <- SegmentNum -> Parser a
pInner SegmentNum
len
    ParsecT Void ByteString Identity ByteString
-> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void ByteString Identity ByteString
 -> ParsecT Void ByteString Identity ())
-> ParsecT Void ByteString Identity ByteString
-> ParsecT Void ByteString Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens ByteString
-> ParsecT Void ByteString Identity (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
","
    a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result

{- | Flatten a Parser for a value in Maybe to a Parser for just the value.  A
 Nothing result from the inner parser will trigger a Parser error.
-}
pFieldM :: B.ByteString -> (Int -> Parser (Maybe a)) -> Parser a
pFieldM :: ByteString -> (SegmentNum -> Parser (Maybe a)) -> Parser a
pFieldM ByteString
label SegmentNum -> Parser (Maybe a)
pInner = do
    Maybe a
result <- ByteString -> (SegmentNum -> Parser (Maybe a)) -> Parser (Maybe a)
forall a. ByteString -> (SegmentNum -> Parser a) -> Parser a
pField ByteString
label SegmentNum -> Parser (Maybe a)
pInner
    case Maybe a
result of
        Maybe a
Nothing -> String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ String
"parsing " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
label String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" failed to produce a value"
        Just a
r -> a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r

-- | Serialize some named URIExtension fields to bytes.
toWeirdString ::
    -- | A list of pairs of field names and functions to get serialized
    -- field values.
    [(B.ByteString, URIExtension -> B.ByteString)] ->
    -- | The URIExtension to get the field values from.
    URIExtension ->
    -- | The concatenation of all of the serialized fields.
    B.ByteString
toWeirdString :: [(ByteString, URIExtension -> ByteString)]
-> URIExtension -> ByteString
toWeirdString [(ByteString, URIExtension -> ByteString)]
fields URIExtension
ext =
    [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> ([[ByteString]] -> [ByteString]) -> [[ByteString]] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[ByteString]] -> [ByteString]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[ByteString]] -> [ByteString])
-> ([[ByteString]] -> [[ByteString]])
-> [[ByteString]]
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[ByteString]] -> [[ByteString]]
forall a. Ord a => [a] -> [a]
sort ([[ByteString]] -> ByteString) -> [[ByteString]] -> ByteString
forall a b. (a -> b) -> a -> b
$ ((ByteString, URIExtension -> ByteString) -> [ByteString])
-> [(ByteString, URIExtension -> ByteString)] -> [[ByteString]]
forall a b. (a -> b) -> [a] -> [b]
map (URIExtension
-> (ByteString, URIExtension -> ByteString) -> [ByteString]
forall t. t -> (ByteString, t -> ByteString) -> [ByteString]
encodedField URIExtension
ext) [(ByteString, URIExtension -> ByteString)]
fields
  where
    encodedField :: t -> (ByteString, t -> ByteString) -> [ByteString]
encodedField t
ext' (ByteString
name, t -> ByteString
extract) =
        [ByteString
name, ByteString
":", ByteString -> ByteString
netstring (t -> ByteString
extract t
ext')]

-- | Show a value as a UTF-8-encoded byte string.
showBytes :: (Show s) => s -> B.ByteString
showBytes :: s -> ByteString
showBytes = Text -> ByteString
encodeUtf8 (Text -> ByteString) -> (s -> Text) -> s -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (s -> String) -> s -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> String
forall a. Show a => a -> String
show

{- | Serialize Parameters to a byte string in the format it appears within the
 URI extension block in a CHK share.
-}
paramsToBytes :: Parameters -> B.ByteString
paramsToBytes :: Parameters -> ByteString
paramsToBytes Parameters{Size
paramSegmentSize :: Parameters -> Size
paramSegmentSize :: Size
paramSegmentSize, Required
paramTotalShares :: Parameters -> Required
paramTotalShares :: Required
paramTotalShares, Required
paramRequiredShares :: Parameters -> Required
paramRequiredShares :: Required
paramRequiredShares} =
    [ByteString] -> ByteString
B.concat [Size -> ByteString
forall s. Show s => s -> ByteString
showBytes Size
paramSegmentSize, ByteString
"-", Required -> ByteString
forall s. Show s => s -> ByteString
showBytes Required
paramRequiredShares, ByteString
"-", Required -> ByteString
forall s. Show s => s -> ByteString
showBytes Required
paramTotalShares]

{- | Parse a serialized Parameters value in the format produced by
 paramsToBytes.
-}
pParameters :: Parser Parameters
pParameters :: ParsecT Void ByteString Identity Parameters
pParameters =
    (\Size
segSize Required
required Required
total -> Parameters :: Size -> Required -> SegmentNum -> Required -> Parameters
Parameters{paramSegmentSize :: Size
paramSegmentSize = Size
segSize, paramRequiredShares :: Required
paramRequiredShares = Required
required, paramHappyShares :: SegmentNum
paramHappyShares = SegmentNum
1, paramTotalShares :: Required
paramTotalShares = Required
total})
        (Size -> Required -> Required -> Parameters)
-> ParsecT Void ByteString Identity Size
-> ParsecT
     Void ByteString Identity (Required -> Required -> Parameters)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void ByteString Identity Size
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
decimal
        ParsecT
  Void ByteString Identity (Required -> Required -> Parameters)
-> ParsecT Void ByteString Identity ByteString
-> ParsecT
     Void ByteString Identity (Required -> Required -> Parameters)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tokens ByteString
-> ParsecT Void ByteString Identity (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"-"
        ParsecT
  Void ByteString Identity (Required -> Required -> Parameters)
-> ParsecT Void ByteString Identity Required
-> ParsecT Void ByteString Identity (Required -> Parameters)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Required -> Required -> ParsecT Void ByteString Identity Required
forall n. (Ord n, Integral n) => n -> n -> Parser n
bounded Required
1 Required
maxShares
        ParsecT Void ByteString Identity (Required -> Parameters)
-> ParsecT Void ByteString Identity ByteString
-> ParsecT Void ByteString Identity (Required -> Parameters)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tokens ByteString
-> ParsecT Void ByteString Identity (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"-"
        ParsecT Void ByteString Identity (Required -> Parameters)
-> ParsecT Void ByteString Identity Required
-> ParsecT Void ByteString Identity Parameters
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Required -> Required -> ParsecT Void ByteString Identity Required
forall n. (Ord n, Integral n) => n -> n -> Parser n
bounded Required
1 Required
maxShares
  where
    maxShares :: Required
maxShares = Required
256