{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
module Tahoe.CHK.Capability (
CHK (..),
Reader,
readKey,
verifier,
Verifier,
storageIndex,
fingerprint,
required,
total,
size,
makeReader,
pCapability,
pVerifier,
pReader,
dangerRealShow,
) where
import Control.Lens (view)
import Control.Lens.TH (makeLenses)
import Crypto.Cipher.AES (AES128)
import Crypto.Cipher.Types (Cipher (cipherInit))
import Crypto.Error (maybeCryptoError)
import Data.ByteArray (convert)
import qualified Data.ByteString as B
import qualified Data.ByteString.Base32 as B
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.TreeDiff.Class (ToExpr (..))
import Data.Void (Void)
import Data.Word (Word16, Word64)
import GHC.Generics (Generic)
import Tahoe.CHK.Cipher (Key (..))
import Tahoe.CHK.Crypto (storageIndexHash)
import qualified Tahoe.CHK.Parsing
import Text.Megaparsec (ErrorFancy (ErrorFail), Parsec, count, fancyFailure, oneOf, try, (<|>))
import Text.Megaparsec.Char (char, string)
import Text.Megaparsec.Char.Lexer (decimal)
type Parser = Parsec Void T.Text
maxShares :: Word16
maxShares :: Word16
maxShares = Word16
256
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)
data Verifier = Verifier
{
Verifier -> ByteString
_storageIndex :: B.ByteString
,
Verifier -> ByteString
_fingerprint :: B.ByteString
,
Verifier -> Word16
_required :: Word16
,
Verifier -> Word16
_total :: Word16
,
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, (forall x. Verifier -> Rep Verifier x)
-> (forall x. Rep Verifier x -> Verifier) -> Generic Verifier
forall x. Rep Verifier x -> Verifier
forall x. Verifier -> Rep Verifier x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Verifier x -> Verifier
$cfrom :: forall x. Verifier -> Rep Verifier x
Generic, [Verifier] -> Expr
Verifier -> Expr
(Verifier -> Expr) -> ([Verifier] -> Expr) -> ToExpr Verifier
forall a. (a -> Expr) -> ([a] -> Expr) -> ToExpr a
listToExpr :: [Verifier] -> Expr
$clistToExpr :: [Verifier] -> Expr
toExpr :: Verifier -> Expr
$ctoExpr :: Verifier -> Expr
ToExpr)
$(makeLenses ''Verifier)
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
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
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
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
v =
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
$ Getting ByteString Verifier ByteString -> Verifier -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString Verifier ByteString
Lens' Verifier ByteString
storageIndex Verifier
v
, 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
$ Getting ByteString Verifier ByteString -> Verifier -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString Verifier ByteString
Lens' Verifier ByteString
fingerprint Verifier
v
, Word16 -> Text
forall s. Show s => s -> Text
showT (Word16 -> Text) -> Word16 -> Text
forall a b. (a -> b) -> a -> b
$ Getting Word16 Verifier Word16 -> Verifier -> Word16
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word16 Verifier Word16
Lens' Verifier Word16
required Verifier
v
, Word16 -> Text
forall s. Show s => s -> Text
showT (Word16 -> Text) -> Word16 -> Text
forall a b. (a -> b) -> a -> b
$ Getting Word16 Verifier Word16 -> Verifier -> Word16
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word16 Verifier Word16
Lens' Verifier Word16
total Verifier
v
, Integer -> Text
forall s. Show s => s -> Text
showT (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ Getting Integer Verifier Integer -> Verifier -> Integer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Integer Verifier Integer
Lens' Verifier Integer
size Verifier
v
]
data Reader = Reader
{
Reader -> Key AES128
_readKey :: Key AES128
,
Reader -> Verifier
_verifier :: Verifier
}
$(makeLenses ''Reader)
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)
instance ToExpr Reader where
toExpr :: Reader -> Expr
toExpr = (ByteString, Verifier) -> Expr
forall a. ToExpr a => a -> Expr
toExpr ((ByteString, Verifier) -> Expr)
-> (Reader -> (ByteString, Verifier)) -> Reader -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reader -> (ByteString, Verifier)
readerKey
instance Show Reader where
show :: Reader -> String
show Reader
reader =
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) -> (Key AES128 -> Text) -> Key AES128 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
showBase32 (ByteString -> Text)
-> (Key AES128 -> ByteString) -> Key AES128 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (ScrubbedBytes -> ByteString)
-> (Key AES128 -> ScrubbedBytes) -> Key AES128 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key AES128 -> ScrubbedBytes
forall cipher. Key cipher -> ScrubbedBytes
keyBytes (Key AES128 -> Text) -> Key AES128 -> Text
forall a b. (a -> b) -> a -> b
$ Getting (Key AES128) Reader (Key AES128) -> Reader -> Key AES128
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Key AES128) Reader (Key AES128)
Lens' Reader (Key AES128)
readKey Reader
reader
, 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
$ Getting ByteString Reader ByteString -> Reader -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Verifier -> Const ByteString Verifier)
-> Reader -> Const ByteString Reader
Lens' Reader Verifier
verifier ((Verifier -> Const ByteString Verifier)
-> Reader -> Const ByteString Reader)
-> Getting ByteString Verifier ByteString
-> Getting ByteString Reader ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ByteString Verifier ByteString
Lens' Verifier ByteString
fingerprint) Reader
reader
, Word16 -> Text
forall s. Show s => s -> Text
showT (Word16 -> Text) -> Word16 -> Text
forall a b. (a -> b) -> a -> b
$ Getting Word16 Reader Word16 -> Reader -> Word16
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Verifier -> Const Word16 Verifier)
-> Reader -> Const Word16 Reader
Lens' Reader Verifier
verifier ((Verifier -> Const Word16 Verifier)
-> Reader -> Const Word16 Reader)
-> Getting Word16 Verifier Word16 -> Getting Word16 Reader Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Word16 Verifier Word16
Lens' Verifier Word16
required) Reader
reader
, Word16 -> Text
forall s. Show s => s -> Text
showT (Word16 -> Text) -> Word16 -> Text
forall a b. (a -> b) -> a -> b
$ Getting Word16 Reader Word16 -> Reader -> Word16
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Verifier -> Const Word16 Verifier)
-> Reader -> Const Word16 Reader
Lens' Reader Verifier
verifier ((Verifier -> Const Word16 Verifier)
-> Reader -> Const Word16 Reader)
-> Getting Word16 Verifier Word16 -> Getting Word16 Reader Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Word16 Verifier Word16
Lens' Verifier Word16
total) Reader
reader
, Integer -> Text
forall s. Show s => s -> Text
showT (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ Getting Integer Reader Integer -> Reader -> Integer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Verifier -> Const Integer Verifier)
-> Reader -> Const Integer Reader
Lens' Reader Verifier
verifier ((Verifier -> Const Integer Verifier)
-> Reader -> Const Integer Reader)
-> Getting Integer Verifier Integer
-> Getting Integer Reader Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Integer Verifier Integer
Lens' Verifier Integer
size) Reader
reader
]
readerKey :: Reader -> (B.ByteString, Verifier)
readerKey :: Reader -> (ByteString, Verifier)
readerKey Reader
r = (Key AES128 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (Key AES128 -> ByteString) -> Key AES128 -> ByteString
forall a b. (a -> b) -> a -> b
$ Getting (Key AES128) Reader (Key AES128) -> Reader -> Key AES128
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Key AES128) Reader (Key AES128)
Lens' Reader (Key AES128)
readKey Reader
r, Getting Verifier Reader Verifier -> Reader -> Verifier
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Verifier Reader Verifier
Lens' Reader Verifier
verifier Reader
r)
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)
dangerRealShow :: CHK -> T.Text
dangerRealShow :: CHK -> Text
dangerRealShow (CHKVerifier Verifier
v) =
Text -> [Text] -> Text
T.intercalate
Text
":"
[ Text
"URI"
, Text
"CHK-Verifier"
, ByteString -> Text
showBase32 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Getting ByteString Verifier ByteString -> Verifier -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString Verifier ByteString
Lens' Verifier ByteString
storageIndex Verifier
v
, ByteString -> Text
showBase32 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Getting ByteString Verifier ByteString -> Verifier -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString Verifier ByteString
Lens' Verifier ByteString
fingerprint Verifier
v
, Word16 -> Text
forall s. Show s => s -> Text
showT (Word16 -> Text) -> Word16 -> Text
forall a b. (a -> b) -> a -> b
$ Getting Word16 Verifier Word16 -> Verifier -> Word16
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word16 Verifier Word16
Lens' Verifier Word16
required Verifier
v
, Word16 -> Text
forall s. Show s => s -> Text
showT (Word16 -> Text) -> Word16 -> Text
forall a b. (a -> b) -> a -> b
$ Getting Word16 Verifier Word16 -> Verifier -> Word16
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word16 Verifier Word16
Lens' Verifier Word16
total Verifier
v
, Integer -> Text
forall s. Show s => s -> Text
showT (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ Getting Integer Verifier Integer -> Verifier -> Integer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Integer Verifier Integer
Lens' Verifier Integer
size Verifier
v
]
dangerRealShow (CHKReader Reader
r) =
Text -> [Text] -> Text
T.intercalate
Text
":"
[ Text
"URI"
, Text
"CHK"
, ByteString -> Text
showBase32 (ByteString -> Text)
-> (Key AES128 -> ByteString) -> Key AES128 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key AES128 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (Key AES128 -> Text) -> Key AES128 -> Text
forall a b. (a -> b) -> a -> b
$ Getting (Key AES128) Reader (Key AES128) -> Reader -> Key AES128
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Key AES128) Reader (Key AES128)
Lens' Reader (Key AES128)
readKey Reader
r
, ByteString -> Text
showBase32 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Getting ByteString Reader ByteString -> Reader -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Verifier -> Const ByteString Verifier)
-> Reader -> Const ByteString Reader
Lens' Reader Verifier
verifier ((Verifier -> Const ByteString Verifier)
-> Reader -> Const ByteString Reader)
-> Getting ByteString Verifier ByteString
-> Getting ByteString Reader ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ByteString Verifier ByteString
Lens' Verifier ByteString
fingerprint) Reader
r
, Word16 -> Text
forall s. Show s => s -> Text
showT (Word16 -> Text) -> Word16 -> Text
forall a b. (a -> b) -> a -> b
$ Getting Word16 Reader Word16 -> Reader -> Word16
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Verifier -> Const Word16 Verifier)
-> Reader -> Const Word16 Reader
Lens' Reader Verifier
verifier ((Verifier -> Const Word16 Verifier)
-> Reader -> Const Word16 Reader)
-> Getting Word16 Verifier Word16 -> Getting Word16 Reader Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Word16 Verifier Word16
Lens' Verifier Word16
required) Reader
r
, Word16 -> Text
forall s. Show s => s -> Text
showT (Word16 -> Text) -> Word16 -> Text
forall a b. (a -> b) -> a -> b
$ Getting Word16 Reader Word16 -> Reader -> Word16
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Verifier -> Const Word16 Verifier)
-> Reader -> Const Word16 Reader
Lens' Reader Verifier
verifier ((Verifier -> Const Word16 Verifier)
-> Reader -> Const Word16 Reader)
-> Getting Word16 Verifier Word16 -> Getting Word16 Reader Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Word16 Verifier Word16
Lens' Verifier Word16
total) Reader
r
, Integer -> Text
forall s. Show s => s -> Text
showT (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ Getting Integer Reader Integer -> Reader -> Integer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Verifier -> Const Integer Verifier)
-> Reader -> Const Integer Reader
Lens' Reader Verifier
verifier ((Verifier -> Const Integer Verifier)
-> Reader -> Const Integer Reader)
-> Getting Integer Verifier Integer
-> Getting Integer Reader Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Integer Verifier Integer
Lens' Verifier Integer
size) Reader
r
]
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)
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
pReader :: Parser Reader
pReader :: ParsecT Void Text Identity Reader
pReader =
Key AES128 -> ByteString -> Word16 -> Word16 -> Integer -> Reader
makeReader
(Key AES128 -> ByteString -> Word16 -> Word16 -> Integer -> Reader)
-> ParsecT Void Text Identity (Key AES128)
-> 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 (Key AES128))
-> ParsecT Void Text Identity (Key AES128)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParsecT Void Text Identity (Key AES128)
-> (Key AES128 -> ParsecT Void Text Identity (Key AES128))
-> Maybe (Key AES128)
-> ParsecT Void Text Identity (Key AES128)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Set (ErrorFancy Void) -> ParsecT Void Text Identity (Key AES128)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
Set (ErrorFancy e) -> m a
fancyFailure (Set (ErrorFancy Void) -> ParsecT Void Text Identity (Key AES128))
-> (Text -> Set (ErrorFancy Void))
-> Text
-> ParsecT Void Text Identity (Key AES128)
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 (Key AES128))
-> Text -> ParsecT Void Text Identity (Key AES128)
forall a b. (a -> b) -> a -> b
$ Text
"Failed to build AESKey128 from CHK read key bytes") Key AES128 -> ParsecT Void Text Identity (Key AES128)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Key AES128) -> ParsecT Void Text Identity (Key AES128))
-> (ByteString -> Maybe (Key AES128))
-> ByteString
-> ParsecT Void Text Identity (Key AES128)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoFailable (Key AES128) -> Maybe (Key AES128)
forall a. CryptoFailable a -> Maybe a
maybeCryptoError (CryptoFailable (Key AES128) -> Maybe (Key AES128))
-> (ByteString -> CryptoFailable (Key AES128))
-> ByteString
-> Maybe (Key AES128)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> CryptoFailable (Key AES128)
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
cipherInit
)
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
makeReader :: Key AES128 -> B.ByteString -> Word16 -> Word16 -> Integer -> Reader
makeReader :: Key AES128 -> ByteString -> Word16 -> Word16 -> Integer -> Reader
makeReader Key AES128
readKey' ByteString
fingerprint' Word16
required' Word16
total' Integer
size' =
Key AES128 -> Verifier -> Reader
Reader Key AES128
readKey' (Key AES128 -> ByteString -> Word16 -> Word16 -> Integer -> Verifier
deriveVerifier Key AES128
readKey' ByteString
fingerprint' Word16
required' Word16
total' Integer
size')
deriveVerifier ::
Key AES128 ->
B.ByteString ->
Word16 ->
Word16 ->
Integer ->
Verifier
deriveVerifier :: Key AES128 -> ByteString -> Word16 -> Word16 -> Integer -> Verifier
deriveVerifier = ByteString -> ByteString -> Word16 -> Word16 -> Integer -> Verifier
Verifier (ByteString
-> ByteString -> Word16 -> Word16 -> Integer -> Verifier)
-> (Key AES128 -> ByteString)
-> Key AES128
-> ByteString
-> Word16
-> Word16
-> Integer
-> Verifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key AES128 -> ByteString
storageIndexHash
pBase32 ::
[Char] ->
Word16 ->
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
(Word16
full, Word16
extra) = Word16
bits Word16 -> Word16 -> (Word16, Word16)
forall a. Integral a => a -> a -> (a, a)
`divMod` Word16
5
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)
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
trailingChars :: [Char] -> Word16 -> [Char]
trailingChars :: String -> Word16 -> String
trailingChars String
alpha' Word16
_ = String
alpha'
rfc3548Alphabet :: [Char]
rfc3548Alphabet :: String
rfc3548Alphabet = String
"abcdefghijklmnopqrstuvwxyz234567"