{-# LANGUAGE NamedFieldPuns #-}

module Tahoe.CHK.Capability (CHK (..), Reader (..), Verifier (..), makeReader, pCapability, pVerifier, pReader, dangerRealShow) where

import qualified Data.ByteString as B
import qualified Data.ByteString.Base32 as B
import Data.Serialize (
    encode,
 )
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Void (Void)
import Data.Word (Word16, Word64)
import Text.Megaparsec (ErrorFancy (ErrorFail), Parsec, count, fancyFailure, oneOf, try, (<|>))
import Text.Megaparsec.Char (char, string)
import Text.Megaparsec.Char.Lexer (decimal)

import Crypto.Cipher.AES128 (
    AESKey128,
 )
import Crypto.Classes (buildKey)
import Tahoe.CHK.Crypto (storageIndexHash)
import qualified Tahoe.CHK.Parsing

{- | Define a type in which we will perform parsing.  There is no custom error
 data (Void) and we are parsing T.Text.
-}
type Parser = Parsec Void T.Text

{- | The maximum number of shares it is possible for CHK-encoded data to be
 divided in to.
-}
maxShares :: Word16
maxShares :: Word16
maxShares = Word16
256

-- | The maximum size of the application data represented by a set of shares.
maxDataSize :: Integer
maxDataSize :: Integer
maxDataSize = Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
forall a. Bounded a => a
maxBound :: Word64)

{- | Represent a CHK "verify" capability.  This capability type can be used to
 verify the existence and validity (bit-level) of shares for the associated
 piece of plaintext.

 It can also be used to repair unhealthy data (I think?)
-}
data Verifier = Verifier
    { -- | The storage index of a verify capability is used as the key into the
      -- content-addressable storage system that is a storage server.  It can be
      -- used to ask storage servers for "shares" (ciphertext plus some
      -- metadata) to download.
      Verifier -> ByteString
storageIndex :: B.ByteString
    , -- | The fingerprint (aka "UEB hash" aka "URI extension block hash") is a
      -- cryptographic hash that covers the URI extension block at the end of a
      -- CHK share.  The URI extension block itself contains various other
      -- cryptographic hashes.  Altogether this allows for integrity checking so
      -- shares downloaded from storage servers can be checked for validity (ie,
      -- that they are the same as what was uploaded) before they are processed.
      Verifier -> ByteString
fingerprint :: B.ByteString
    , -- | The number of shares required to ZFEC decode the contents of the
      -- shares.  ZFEC calls this *K*.  It must be that 1 <= required <= 256 and
      -- required <= total.  ZFEC is not defined outside of these bounds.
      Verifier -> Word16
required :: Word16
    , -- | The total number of shares produced by ZFEC encoding.  ZFEC calls
      -- this *n*.  It must be that 1 <= total <= 256 and required <= total.
      Verifier -> Word16
total :: Word16
    , -- | The size (in bytes) of the plaintext encoded in the shares.  It must
      -- be that size >= 0 and in practice it is usually true that size >= 56.
      Verifier -> Integer
size :: Integer
    }
    deriving (Eq Verifier
Eq Verifier
-> (Verifier -> Verifier -> Ordering)
-> (Verifier -> Verifier -> Bool)
-> (Verifier -> Verifier -> Bool)
-> (Verifier -> Verifier -> Bool)
-> (Verifier -> Verifier -> Bool)
-> (Verifier -> Verifier -> Verifier)
-> (Verifier -> Verifier -> Verifier)
-> Ord Verifier
Verifier -> Verifier -> Bool
Verifier -> Verifier -> Ordering
Verifier -> Verifier -> Verifier
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 :: Verifier -> Verifier -> Verifier
$cmin :: Verifier -> Verifier -> Verifier
max :: Verifier -> Verifier -> Verifier
$cmax :: Verifier -> Verifier -> Verifier
>= :: Verifier -> Verifier -> Bool
$c>= :: Verifier -> Verifier -> Bool
> :: Verifier -> Verifier -> Bool
$c> :: Verifier -> Verifier -> Bool
<= :: Verifier -> Verifier -> Bool
$c<= :: Verifier -> Verifier -> Bool
< :: Verifier -> Verifier -> Bool
$c< :: Verifier -> Verifier -> Bool
compare :: Verifier -> Verifier -> Ordering
$ccompare :: Verifier -> Verifier -> Ordering
$cp1Ord :: Eq Verifier
Ord, Verifier -> Verifier -> Bool
(Verifier -> Verifier -> Bool)
-> (Verifier -> Verifier -> Bool) -> Eq Verifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Verifier -> Verifier -> Bool
$c/= :: Verifier -> Verifier -> Bool
== :: Verifier -> Verifier -> Bool
$c== :: Verifier -> Verifier -> Bool
Eq)

{- | Replace most of the tail of a string with a short placeholder.  If the
 string is not much longer than `n` then the result might not actually be
 shorter.
-}
shorten :: Int -> T.Text -> T.Text
shorten :: Int -> Text -> Text
shorten Int
n = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"...") (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.take Int
n

-- | Show a value as Text.
showT :: Show s => s -> T.Text
showT :: s -> Text
showT = 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

-- | Show a ByteString using a base32-encoded representation.
showBase32 :: B.ByteString -> T.Text
showBase32 :: ByteString -> Text
showBase32 = Text -> Text
T.toLower (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
B.encodeBase32Unpadded

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

instance Show Verifier where
    show :: Verifier -> String
show Verifier{ByteString
storageIndex :: ByteString
storageIndex :: Verifier -> ByteString
storageIndex, ByteString
fingerprint :: ByteString
fingerprint :: Verifier -> ByteString
fingerprint, Word16
required :: Word16
required :: Verifier -> Word16
required, Word16
total :: Word16
total :: Verifier -> Word16
total, Integer
size :: Integer
size :: Verifier -> Integer
size} =
        Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
            Text -> [Text] -> Text
T.intercalate
                Text
":"
                [ Text
"URI"
                , Text
"CHK-Verifier"
                , Int -> Text -> Text
shorten Int
4 (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
showBase32 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString
storageIndex
                , Int -> Text -> Text
shorten Int
4 (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
showBase32 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString
fingerprint
                , Word16 -> Text
forall s. Show s => s -> Text
showT Word16
required
                , Word16 -> Text
forall s. Show s => s -> Text
showT Word16
total
                , Integer -> Text
forall s. Show s => s -> Text
showT Integer
size
                ]

{- | Represent a CHK "read" capability.  This capability type can be diminished
 to a verify capability so it confers all of the abilities of a verify
 capability.  It can also be used to decrypt shares to reconstruct the
 original plaintext.  See makeReader for a safe constructor that correctly
 derives the verify capability.
-}
data Reader = Reader
    { -- | The read key of a read capability is used as the symmetric encryption
      -- key to turn the original plaintext into ciphertext and back again.  The
      -- read key is also used to derive the verify key for the verify
      -- capability.  See ``storageIndexHash``.
      Reader -> AESKey128
readKey :: AESKey128
    , -- | The verify capability for this read capability.
      Reader -> Verifier
verifier :: Verifier
    }

-- AESKey128 has no Eq or Ord instances so derive these for Reader manually.
-- We do include the AESKey128 in our comparison by encoding it to bytes
-- first.
instance Eq Reader where
    Reader
left == :: Reader -> Reader -> Bool
== Reader
right = Reader -> (ByteString, Verifier)
readerKey Reader
left (ByteString, Verifier) -> (ByteString, Verifier) -> Bool
forall a. Eq a => a -> a -> Bool
== Reader -> (ByteString, Verifier)
readerKey Reader
right

instance Ord Reader where
    compare :: Reader -> Reader -> Ordering
compare Reader
left Reader
right = (ByteString, Verifier) -> (ByteString, Verifier) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Reader -> (ByteString, Verifier)
readerKey Reader
left) (Reader -> (ByteString, Verifier)
readerKey Reader
right)

{- | Give it a Show instance that elides the sensitive material.  This makes
 it easier to compose with other types and we can still learn a lot of
 useful things about a capability without being able to see the literal
 secret key.
-}
instance Show Reader where
    show :: Reader -> String
show Reader{AESKey128
readKey :: AESKey128
readKey :: Reader -> AESKey128
readKey, Verifier
verifier :: Verifier
verifier :: Reader -> Verifier
verifier} =
        Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
            Text -> [Text] -> Text
T.intercalate
                Text
":"
                [ Text
"URI"
                , Text
"CHK"
                , Int -> Text -> Text
shorten Int
4 (Text -> Text) -> (AESKey128 -> Text) -> AESKey128 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
showBase32 (ByteString -> Text)
-> (AESKey128 -> ByteString) -> AESKey128 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AESKey128 -> ByteString
forall a. Serialize a => a -> ByteString
encode (AESKey128 -> Text) -> AESKey128 -> Text
forall a b. (a -> b) -> a -> b
$ AESKey128
readKey
                , Int -> Text -> Text
shorten Int
4 (Text -> Text) -> (Verifier -> Text) -> Verifier -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
showBase32 (ByteString -> Text)
-> (Verifier -> ByteString) -> Verifier -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verifier -> ByteString
fingerprint (Verifier -> Text) -> Verifier -> Text
forall a b. (a -> b) -> a -> b
$ Verifier
verifier
                , Word16 -> Text
forall s. Show s => s -> Text
showT (Word16 -> Text) -> (Verifier -> Word16) -> Verifier -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verifier -> Word16
required (Verifier -> Text) -> Verifier -> Text
forall a b. (a -> b) -> a -> b
$ Verifier
verifier
                , Word16 -> Text
forall s. Show s => s -> Text
showT (Word16 -> Text) -> (Verifier -> Word16) -> Verifier -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verifier -> Word16
total (Verifier -> Text) -> Verifier -> Text
forall a b. (a -> b) -> a -> b
$ Verifier
verifier
                , Integer -> Text
forall s. Show s => s -> Text
showT (Integer -> Text) -> (Verifier -> Integer) -> Verifier -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verifier -> Integer
size (Verifier -> Text) -> Verifier -> Text
forall a b. (a -> b) -> a -> b
$ Verifier
verifier
                ]

-- Construct a key with Eq and Ord instances for the Reader Eq and Ord
-- instances.
readerKey :: Reader -> (B.ByteString, Verifier)
readerKey :: Reader -> (ByteString, Verifier)
readerKey Reader
r = (AESKey128 -> ByteString
forall a. Serialize a => a -> ByteString
encode (AESKey128 -> ByteString)
-> (Reader -> AESKey128) -> Reader -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reader -> AESKey128
readKey (Reader -> ByteString) -> Reader -> ByteString
forall a b. (a -> b) -> a -> b
$ Reader
r, Reader -> Verifier
verifier Reader
r)

{- | A "Content-Hash-Key" (CHK) capability is small value that can be used to
 perform some operation on a (usually) larger value that may be stored
 somewhere else.  There are two forms of CHK capabilities: verify and read.
 See *Verifier* and *Reader* for details.
-}
data CHK = CHKVerifier Verifier | CHKReader Reader deriving (Eq CHK
Eq CHK
-> (CHK -> CHK -> Ordering)
-> (CHK -> CHK -> Bool)
-> (CHK -> CHK -> Bool)
-> (CHK -> CHK -> Bool)
-> (CHK -> CHK -> Bool)
-> (CHK -> CHK -> CHK)
-> (CHK -> CHK -> CHK)
-> Ord CHK
CHK -> CHK -> Bool
CHK -> CHK -> Ordering
CHK -> CHK -> CHK
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 :: CHK -> CHK -> CHK
$cmin :: CHK -> CHK -> CHK
max :: CHK -> CHK -> CHK
$cmax :: CHK -> CHK -> CHK
>= :: CHK -> CHK -> Bool
$c>= :: CHK -> CHK -> Bool
> :: CHK -> CHK -> Bool
$c> :: CHK -> CHK -> Bool
<= :: CHK -> CHK -> Bool
$c<= :: CHK -> CHK -> Bool
< :: CHK -> CHK -> Bool
$c< :: CHK -> CHK -> Bool
compare :: CHK -> CHK -> Ordering
$ccompare :: CHK -> CHK -> Ordering
$cp1Ord :: Eq CHK
Ord, CHK -> CHK -> Bool
(CHK -> CHK -> Bool) -> (CHK -> CHK -> Bool) -> Eq CHK
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CHK -> CHK -> Bool
$c/= :: CHK -> CHK -> Bool
== :: CHK -> CHK -> Bool
$c== :: CHK -> CHK -> Bool
Eq)

{- | Serialize a CHK capability to text.  This operation is "dangerous" in
 that it will serialize the encryption key of a read capability into the
 text.  Since the encryption key is necessary and (practically) sufficient
 to recover the original plaintext associated with the capability, it must
 be handled carefully to avoid unintentional disclosure.  Serializing the
 key to a string is a good way to accidentally disclose it!  Be warned.

 The text is in the canonical form, originally used by the Python
 implementation of Tahoe-LAFS.
-}
dangerRealShow :: CHK -> T.Text
dangerRealShow :: CHK -> Text
dangerRealShow (CHKVerifier (Verifier{ByteString
storageIndex :: ByteString
storageIndex :: Verifier -> ByteString
storageIndex, ByteString
fingerprint :: ByteString
fingerprint :: Verifier -> ByteString
fingerprint, Word16
required :: Word16
required :: Verifier -> Word16
required, Word16
total :: Word16
total :: Verifier -> Word16
total, Integer
size :: Integer
size :: Verifier -> Integer
size})) =
    Text -> [Text] -> Text
T.intercalate
        Text
":"
        [ Text
"URI"
        , Text
"CHK-Verifier"
        , ByteString -> Text
showBase32 ByteString
storageIndex
        , ByteString -> Text
showBase32 ByteString
fingerprint
        , Word16 -> Text
forall s. Show s => s -> Text
showT Word16
required
        , Word16 -> Text
forall s. Show s => s -> Text
showT Word16
total
        , Integer -> Text
forall s. Show s => s -> Text
showT Integer
size
        ]
dangerRealShow (CHKReader (Reader{AESKey128
readKey :: AESKey128
readKey :: Reader -> AESKey128
readKey, Verifier
verifier :: Verifier
verifier :: Reader -> Verifier
verifier})) =
    Text -> [Text] -> Text
T.intercalate
        Text
":"
        [ Text
"URI"
        , Text
"CHK"
        , ByteString -> Text
showBase32 (ByteString -> Text)
-> (AESKey128 -> ByteString) -> AESKey128 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AESKey128 -> ByteString
forall a. Serialize a => a -> ByteString
encode (AESKey128 -> Text) -> AESKey128 -> Text
forall a b. (a -> b) -> a -> b
$ AESKey128
readKey
        , ByteString -> Text
showBase32 (ByteString -> Text)
-> (Verifier -> ByteString) -> Verifier -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verifier -> ByteString
fingerprint (Verifier -> Text) -> Verifier -> Text
forall a b. (a -> b) -> a -> b
$ Verifier
verifier
        , Word16 -> Text
forall s. Show s => s -> Text
showT (Word16 -> Text) -> (Verifier -> Word16) -> Verifier -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verifier -> Word16
required (Verifier -> Text) -> Verifier -> Text
forall a b. (a -> b) -> a -> b
$ Verifier
verifier
        , Word16 -> Text
forall s. Show s => s -> Text
showT (Word16 -> Text) -> (Verifier -> Word16) -> Verifier -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verifier -> Word16
total (Verifier -> Text) -> Verifier -> Text
forall a b. (a -> b) -> a -> b
$ Verifier
verifier
        , Integer -> Text
forall s. Show s => s -> Text
showT (Integer -> Text) -> (Verifier -> Integer) -> Verifier -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verifier -> Integer
size (Verifier -> Text) -> Verifier -> Text
forall a b. (a -> b) -> a -> b
$ Verifier
verifier
        ]

{- | A parser combinator for parsing either a verify or read CHK capability
 from the canonical format.  This is the moral inverse of dangerRealShow.
-}
pCapability :: Parser CHK
pCapability :: Parser CHK
pCapability = Parser CHK -> Parser CHK
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Verifier -> CHK
CHKVerifier (Verifier -> CHK)
-> ParsecT Void Text Identity Verifier -> Parser CHK
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Verifier
pVerifier) Parser CHK -> Parser CHK -> Parser CHK
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Reader -> CHK
CHKReader (Reader -> CHK) -> ParsecT Void Text Identity Reader -> Parser CHK
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Reader
pReader)

-- | A parser combinator for parsing a CHK verify capability.
pVerifier :: Parser Verifier
pVerifier :: ParsecT Void Text Identity Verifier
pVerifier =
    ByteString -> ByteString -> Word16 -> Word16 -> Integer -> Verifier
Verifier
        (ByteString
 -> ByteString -> Word16 -> Word16 -> Integer -> Verifier)
-> ParsecT Void Text Identity ByteString
-> ParsecT
     Void
     Text
     Identity
     (ByteString -> Word16 -> Word16 -> Integer -> Verifier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"URI:CHK-Verifier:" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity ByteString
-> ParsecT Void Text Identity ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Word16 -> ParsecT Void Text Identity ByteString
pBase32 String
rfc3548Alphabet Word16
128)
        ParsecT
  Void
  Text
  Identity
  (ByteString -> Word16 -> Word16 -> Integer -> Verifier)
-> ParsecT Void Text Identity Char
-> ParsecT
     Void
     Text
     Identity
     (ByteString -> Word16 -> Word16 -> Integer -> Verifier)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':'
        ParsecT
  Void
  Text
  Identity
  (ByteString -> Word16 -> Word16 -> Integer -> Verifier)
-> ParsecT Void Text Identity ByteString
-> ParsecT
     Void Text Identity (Word16 -> Word16 -> Integer -> Verifier)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Word16 -> ParsecT Void Text Identity ByteString
pBase32 String
rfc3548Alphabet Word16
256
        ParsecT
  Void Text Identity (Word16 -> Word16 -> Integer -> Verifier)
-> ParsecT Void Text Identity Char
-> ParsecT
     Void Text Identity (Word16 -> Word16 -> Integer -> Verifier)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':'
        ParsecT
  Void Text Identity (Word16 -> Word16 -> Integer -> Verifier)
-> ParsecT Void Text Identity Word16
-> ParsecT Void Text Identity (Word16 -> Integer -> Verifier)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word16 -> Word16 -> ParsecT Void Text Identity Word16
forall n. (Ord n, Integral n) => n -> n -> Parser n
bounded Word16
1 Word16
maxShares
        ParsecT Void Text Identity (Word16 -> Integer -> Verifier)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Word16 -> Integer -> Verifier)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':'
        ParsecT Void Text Identity (Word16 -> Integer -> Verifier)
-> ParsecT Void Text Identity Word16
-> ParsecT Void Text Identity (Integer -> Verifier)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word16 -> Word16 -> ParsecT Void Text Identity Word16
forall n. (Ord n, Integral n) => n -> n -> Parser n
bounded Word16
1 Word16
maxShares
        ParsecT Void Text Identity (Integer -> Verifier)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Integer -> Verifier)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':'
        ParsecT Void Text Identity (Integer -> Verifier)
-> ParsecT Void Text Identity Integer
-> ParsecT Void Text Identity Verifier
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Integer -> Integer -> ParsecT Void Text Identity Integer
forall n. (Ord n, Integral n) => n -> n -> Parser n
bounded Integer
1 Integer
maxDataSize

-- | A parser combinator for parsing a CHK read capability.
pReader :: Parser Reader
pReader :: ParsecT Void Text Identity Reader
pReader =
    AESKey128 -> ByteString -> Word16 -> Word16 -> Integer -> Reader
makeReader
        (AESKey128 -> ByteString -> Word16 -> Word16 -> Integer -> Reader)
-> ParsecT Void Text Identity AESKey128
-> ParsecT
     Void
     Text
     Identity
     (ByteString -> Word16 -> Word16 -> Integer -> Reader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"URI:CHK:"
                ParsecT Void Text Identity Text
-> ParsecT Void Text Identity ByteString
-> ParsecT Void Text Identity ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> Word16 -> ParsecT Void Text Identity ByteString
pBase32 String
rfc3548Alphabet Word16
128
                ParsecT Void Text Identity ByteString
-> (ByteString -> ParsecT Void Text Identity AESKey128)
-> ParsecT Void Text Identity AESKey128
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParsecT Void Text Identity AESKey128
-> (AESKey128 -> ParsecT Void Text Identity AESKey128)
-> Maybe AESKey128
-> ParsecT Void Text Identity AESKey128
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Set (ErrorFancy Void) -> ParsecT Void Text Identity AESKey128
forall e s (m :: * -> *) a.
MonadParsec e s m =>
Set (ErrorFancy e) -> m a
fancyFailure (Set (ErrorFancy Void) -> ParsecT Void Text Identity AESKey128)
-> (Text -> Set (ErrorFancy Void))
-> Text
-> ParsecT Void Text Identity AESKey128
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorFancy Void -> Set (ErrorFancy Void)
forall a. a -> Set a
Set.singleton (ErrorFancy Void -> Set (ErrorFancy Void))
-> (Text -> ErrorFancy Void) -> Text -> Set (ErrorFancy Void)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ErrorFancy Void
forall e. String -> ErrorFancy e
ErrorFail (String -> ErrorFancy Void)
-> (Text -> String) -> Text -> ErrorFancy Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> ParsecT Void Text Identity AESKey128)
-> Text -> ParsecT Void Text Identity AESKey128
forall a b. (a -> b) -> a -> b
$ Text
"Failed to build AESKey128 from CHK read key bytes") AESKey128 -> ParsecT Void Text Identity AESKey128
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe AESKey128 -> ParsecT Void Text Identity AESKey128)
-> (ByteString -> Maybe AESKey128)
-> ByteString
-> ParsecT Void Text Identity AESKey128
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe AESKey128
forall k. BlockCipher k => ByteString -> Maybe k
buildKey
            )
        ParsecT
  Void
  Text
  Identity
  (ByteString -> Word16 -> Word16 -> Integer -> Reader)
-> ParsecT Void Text Identity Char
-> ParsecT
     Void
     Text
     Identity
     (ByteString -> Word16 -> Word16 -> Integer -> Reader)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':'
        ParsecT
  Void
  Text
  Identity
  (ByteString -> Word16 -> Word16 -> Integer -> Reader)
-> ParsecT Void Text Identity ByteString
-> ParsecT
     Void Text Identity (Word16 -> Word16 -> Integer -> Reader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Word16 -> ParsecT Void Text Identity ByteString
pBase32 String
rfc3548Alphabet Word16
256
        ParsecT Void Text Identity (Word16 -> Word16 -> Integer -> Reader)
-> ParsecT Void Text Identity Char
-> ParsecT
     Void Text Identity (Word16 -> Word16 -> Integer -> Reader)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':'
        ParsecT Void Text Identity (Word16 -> Word16 -> Integer -> Reader)
-> ParsecT Void Text Identity Word16
-> ParsecT Void Text Identity (Word16 -> Integer -> Reader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word16 -> Word16 -> ParsecT Void Text Identity Word16
forall n. (Ord n, Integral n) => n -> n -> Parser n
bounded Word16
1 Word16
256
        ParsecT Void Text Identity (Word16 -> Integer -> Reader)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Word16 -> Integer -> Reader)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':'
        ParsecT Void Text Identity (Word16 -> Integer -> Reader)
-> ParsecT Void Text Identity Word16
-> ParsecT Void Text Identity (Integer -> Reader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word16 -> Word16 -> ParsecT Void Text Identity Word16
forall n. (Ord n, Integral n) => n -> n -> Parser n
bounded Word16
1 Word16
256
        ParsecT Void Text Identity (Integer -> Reader)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Integer -> Reader)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':'
        ParsecT Void Text Identity (Integer -> Reader)
-> ParsecT Void Text Identity Integer
-> ParsecT Void Text Identity Reader
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Integer -> Integer -> ParsecT Void Text Identity Integer
forall n. (Ord n, Integral n) => n -> n -> Parser n
bounded Integer
1 Integer
maxDataSize

{- | Construct a CHK read capability from its components.  This includes the
 correct derivation of the corresponding CHK verify capability.
-}
makeReader :: AESKey128 -> B.ByteString -> Word16 -> Word16 -> Integer -> Reader
makeReader :: AESKey128 -> ByteString -> Word16 -> Word16 -> Integer -> Reader
makeReader AESKey128
readKey ByteString
fingerprint Word16
required Word16
total Integer
size =
    AESKey128 -> Verifier -> Reader
Reader AESKey128
readKey (AESKey128 -> ByteString -> Word16 -> Word16 -> Integer -> Verifier
deriveVerifier AESKey128
readKey ByteString
fingerprint Word16
required Word16
total Integer
size)

{- | Given all of the fields of a CHK read capability, derive and return the
 corresponding CHK verify capability.
-}
deriveVerifier ::
    -- | The read key
    AESKey128 ->
    -- | The fingerprint
    B.ByteString ->
    -- | The required number of shares
    Word16 ->
    -- | The total number of shares
    Word16 ->
    -- | The plaintext size
    Integer ->
    Verifier
deriveVerifier :: AESKey128 -> ByteString -> Word16 -> Word16 -> Integer -> Verifier
deriveVerifier = ByteString -> ByteString -> Word16 -> Word16 -> Integer -> Verifier
Verifier (ByteString
 -> ByteString -> Word16 -> Word16 -> Integer -> Verifier)
-> (AESKey128 -> ByteString)
-> AESKey128
-> ByteString
-> Word16
-> Word16
-> Integer
-> Verifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AESKey128 -> ByteString
storageIndexHash

{- | A parser combinator for an arbitrary byte string of a fixed length,
 encoded using base32.
-}
pBase32 ::
    -- | The alphabet to use.  For example, *rfc3548Alphabet*.
    [Char] ->
    -- | The number of bits in the encoded byte string.
    Word16 ->
    -- | A parser for the byte string.  Strings that are not valid base32 will
    -- be rejected.  Strings that are the wrong length are *not necessarily*
    -- currently rejected!  Please fix that, somebody.
    Parser B.ByteString
pBase32 :: String -> Word16 -> ParsecT Void Text Identity ByteString
pBase32 String
alpha Word16
bits = do
    Text
b32Text <- ParsecT Void Text Identity Text
pBase32Text
    (Text -> ParsecT Void Text Identity ByteString)
-> (ByteString -> ParsecT Void Text Identity ByteString)
-> Either Text ByteString
-> ParsecT Void Text Identity ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Set (ErrorFancy Void) -> ParsecT Void Text Identity ByteString
forall e s (m :: * -> *) a.
MonadParsec e s m =>
Set (ErrorFancy e) -> m a
fancyFailure (Set (ErrorFancy Void) -> ParsecT Void Text Identity ByteString)
-> (Text -> Set (ErrorFancy Void))
-> Text
-> ParsecT Void Text Identity ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorFancy Void -> Set (ErrorFancy Void)
forall a. a -> Set a
Set.singleton (ErrorFancy Void -> Set (ErrorFancy Void))
-> (Text -> ErrorFancy Void) -> Text -> Set (ErrorFancy Void)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ErrorFancy Void
forall e. String -> ErrorFancy e
ErrorFail (String -> ErrorFancy Void)
-> (Text -> String) -> Text -> ErrorFancy Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) ByteString -> ParsecT Void Text Identity ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Either Text ByteString
decodeBase32Text Text
b32Text)
  where
    decodeBase32Text :: Text -> Either Text ByteString
decodeBase32Text = ByteString -> Either Text ByteString
B.decodeBase32Unpadded (ByteString -> Either Text ByteString)
-> (Text -> ByteString) -> Text -> Either Text ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
    pBase32Text :: ParsecT Void Text Identity Text
pBase32Text = Text -> Char -> Text
T.snoc (Text -> Char -> Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Char -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
stem ParsecT Void Text Identity (Char -> Text)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Char
trailer

    -- Determine how many full characters to expect along with how many bits
    -- are left to expect encoded in the final character.
    (Word16
full, Word16
extra) = Word16
bits Word16 -> Word16 -> (Word16, Word16)
forall a. Integral a => a -> a -> (a, a)
`divMod` Word16
5

    -- Match the base32 characters that represent the full 5 bits
    -- possible.  fromIntegral is okay here because `full` is only a
    -- Word16 and will definitely fit safely into the Int count wants.
    stem :: Parser T.Text
    stem :: ParsecT Void Text Identity Text
stem = String -> Text
T.pack (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
full) ([Token Text] -> ParsecT Void Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf String
[Token Text]
alpha)

    -- Match the final character that represents fewer than 5 bits.
    trailer :: Parser Char
    trailer :: ParsecT Void Text Identity Char
trailer = [Token Text] -> ParsecT Void Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf ([Token Text] -> ParsecT Void Text Identity (Token Text))
-> [Token Text] -> ParsecT Void Text Identity (Token Text)
forall a b. (a -> b) -> a -> b
$ String -> Word16 -> String
trailingChars String
alpha Word16
extra

    -- XXX The real trailing character set is smaller than this.  This
    -- parser will let through invalid characters that result in giving us
    -- possibly too many bits.
    trailingChars :: [Char] -> Word16 -> [Char]
    trailingChars :: String -> Word16 -> String
trailingChars String
alpha' Word16
_ = String
alpha'

{- | The RFC3548 standard alphabet used by Gnutella, Content-Addressable Web,
 THEX, Bitzi, Web-Calculus...
-}
rfc3548Alphabet :: [Char]
rfc3548Alphabet :: String
rfc3548Alphabet = String
"abcdefghijklmnopqrstuvwxyz234567"