{- | Key types, derivations, and related functionality for SDMF.

 See docs/specifications/mutable.rst for details.
-}
module Tahoe.SDMF.Internal.Keys where

import Prelude hiding (Read)

import Control.Monad (when)
import Crypto.Cipher.AES (AES128)
import Crypto.Cipher.Types (BlockCipher (ctrCombine), Cipher (cipherInit, cipherKeySize), IV, KeySizeSpecifier (KeySizeFixed), nullIV)
import Crypto.Error (CryptoFailable (CryptoPassed), maybeCryptoError)
import qualified Crypto.PubKey.RSA as RSA
import Crypto.Random (MonadRandom)
import Data.ASN1.BinaryEncoding (DER (DER))
import Data.ASN1.Encoding (ASN1Encoding (encodeASN1), decodeASN1')
import Data.ASN1.Types (ASN1 (End, IntVal, Null, OID, OctetString, Start), ASN1ConstructionType (Sequence), ASN1Object (fromASN1, toASN1))
import Data.Bifunctor (Bifunctor (first))
import Data.Binary (Binary (get, put))
import Data.Binary.Get (getByteString)
import Data.Binary.Put (putByteString)
import qualified Data.ByteArray as ByteArray
import qualified Data.ByteString as B
import Data.ByteString.Base32 (encodeBase32Unpadded)
import qualified Data.ByteString.Lazy as LB
import qualified Data.Text as T
import Data.X509 (PrivKey (PrivKeyRSA), PubKey (PubKeyRSA))
import Tahoe.CHK.Crypto (taggedHash, taggedPairHash)

newtype KeyPair = KeyPair {KeyPair -> PrivateKey
toPrivateKey :: RSA.PrivateKey} deriving newtype (Int -> KeyPair -> ShowS
[KeyPair] -> ShowS
KeyPair -> String
(Int -> KeyPair -> ShowS)
-> (KeyPair -> String) -> ([KeyPair] -> ShowS) -> Show KeyPair
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyPair] -> ShowS
$cshowList :: [KeyPair] -> ShowS
show :: KeyPair -> String
$cshow :: KeyPair -> String
showsPrec :: Int -> KeyPair -> ShowS
$cshowsPrec :: Int -> KeyPair -> ShowS
Show)

toPublicKey :: KeyPair -> RSA.PublicKey
toPublicKey :: KeyPair -> PublicKey
toPublicKey = PrivateKey -> PublicKey
RSA.private_pub (PrivateKey -> PublicKey)
-> (KeyPair -> PrivateKey) -> KeyPair -> PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair -> PrivateKey
toPrivateKey

toSignatureKey :: KeyPair -> Signature
toSignatureKey :: KeyPair -> Signature
toSignatureKey = PrivateKey -> Signature
Signature (PrivateKey -> Signature)
-> (KeyPair -> PrivateKey) -> KeyPair -> Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair -> PrivateKey
toPrivateKey

toVerificationKey :: KeyPair -> Verification
toVerificationKey :: KeyPair -> Verification
toVerificationKey = PublicKey -> Verification
Verification (PublicKey -> Verification)
-> (KeyPair -> PublicKey) -> KeyPair -> Verification
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair -> PublicKey
toPublicKey

newtype Verification = Verification {Verification -> PublicKey
unVerification :: RSA.PublicKey}
    deriving newtype (Verification -> Verification -> Bool
(Verification -> Verification -> Bool)
-> (Verification -> Verification -> Bool) -> Eq Verification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Verification -> Verification -> Bool
$c/= :: Verification -> Verification -> Bool
== :: Verification -> Verification -> Bool
$c== :: Verification -> Verification -> Bool
Eq, Int -> Verification -> ShowS
[Verification] -> ShowS
Verification -> String
(Int -> Verification -> ShowS)
-> (Verification -> String)
-> ([Verification] -> ShowS)
-> Show Verification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Verification] -> ShowS
$cshowList :: [Verification] -> ShowS
show :: Verification -> String
$cshow :: Verification -> String
showsPrec :: Int -> Verification -> ShowS
$cshowsPrec :: Int -> Verification -> ShowS
Show)

newtype Signature = Signature {Signature -> PrivateKey
unSignature :: RSA.PrivateKey}
    deriving newtype (Signature -> Signature -> Bool
(Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool) -> Eq Signature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Signature -> Signature -> Bool
$c/= :: Signature -> Signature -> Bool
== :: Signature -> Signature -> Bool
$c== :: Signature -> Signature -> Bool
Eq, Int -> Signature -> ShowS
[Signature] -> ShowS
Signature -> String
(Int -> Signature -> ShowS)
-> (Signature -> String)
-> ([Signature] -> ShowS)
-> Show Signature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Signature] -> ShowS
$cshowList :: [Signature] -> ShowS
show :: Signature -> String
$cshow :: Signature -> String
showsPrec :: Int -> Signature -> ShowS
$cshowsPrec :: Int -> Signature -> ShowS
Show)

data Write = Write {Write -> AES128
unWrite :: AES128, Write -> ScrubbedBytes
writeKeyBytes :: ByteArray.ScrubbedBytes}

instance Eq Write where
    (Write AES128
_ ScrubbedBytes
left) == :: Write -> Write -> Bool
== (Write AES128
_ ScrubbedBytes
right) = ScrubbedBytes
left ScrubbedBytes -> ScrubbedBytes -> Bool
forall a. Eq a => a -> a -> Bool
== ScrubbedBytes
right

instance Binary Write where
    put :: Write -> Put
put = ByteString -> Put
putByteString (ByteString -> Put) -> (Write -> ByteString) -> Write -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (ScrubbedBytes -> ByteString)
-> (Write -> ScrubbedBytes) -> Write -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Write -> ScrubbedBytes
writeKeyBytes
    get :: Get Write
get = do
        ScrubbedBytes
writeKeyBytes <- ByteString -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (ByteString -> ScrubbedBytes)
-> Get ByteString -> Get ScrubbedBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
keyLength
        let (CryptoPassed AES128
unWrite) = ScrubbedBytes -> CryptoFailable AES128
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
cipherInit ScrubbedBytes
writeKeyBytes
        Write -> Get Write
forall (f :: * -> *) a. Applicative f => a -> f a
pure Write :: AES128 -> ScrubbedBytes -> Write
Write{ScrubbedBytes
AES128
unWrite :: AES128
writeKeyBytes :: ScrubbedBytes
writeKeyBytes :: ScrubbedBytes
unWrite :: AES128
..}

instance Show Write where
    show :: Write -> String
show (Write AES128
_ ScrubbedBytes
bs) =
        Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
            [Text] -> Text
T.concat
                [ Text
"<WriteKey "
                , Int -> Text -> Text
shorten Int
4 (Text -> Text) -> (ScrubbedBytes -> Text) -> ScrubbedBytes -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
showBase32 (ByteString -> Text)
-> (ScrubbedBytes -> ByteString) -> ScrubbedBytes -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (ScrubbedBytes -> Text) -> ScrubbedBytes -> Text
forall a b. (a -> b) -> a -> b
$ ScrubbedBytes
bs
                , Text
">"
                ]

data Read = Read {Read -> AES128
unRead :: AES128, Read -> ScrubbedBytes
readKeyBytes :: ByteArray.ScrubbedBytes}

instance Eq Read where
    (Read AES128
_ ScrubbedBytes
left) == :: Read -> Read -> Bool
== (Read AES128
_ ScrubbedBytes
right) = ScrubbedBytes
left ScrubbedBytes -> ScrubbedBytes -> Bool
forall a. Eq a => a -> a -> Bool
== ScrubbedBytes
right

instance Show Read where
    show :: Read -> String
show (Read AES128
_ ScrubbedBytes
bs) =
        Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
            [Text] -> Text
T.concat
                [ Text
"<ReadKey "
                , Int -> Text -> Text
shorten Int
4 (Text -> Text) -> (ScrubbedBytes -> Text) -> ScrubbedBytes -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
showBase32 (ByteString -> Text)
-> (ScrubbedBytes -> ByteString) -> ScrubbedBytes -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (ScrubbedBytes -> Text) -> ScrubbedBytes -> Text
forall a b. (a -> b) -> a -> b
$ ScrubbedBytes
bs
                , Text
">"
                ]

instance Binary Read where
    put :: Read -> Put
put = ByteString -> Put
putByteString (ByteString -> Put) -> (Read -> ByteString) -> Read -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (ScrubbedBytes -> ByteString)
-> (Read -> ScrubbedBytes) -> Read -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Read -> ScrubbedBytes
readKeyBytes
    get :: Get Read
get = do
        ScrubbedBytes
readKeyBytes <- ByteString -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (ByteString -> ScrubbedBytes)
-> Get ByteString -> Get ScrubbedBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
keyLength
        let (CryptoPassed AES128
unRead) = ScrubbedBytes -> CryptoFailable AES128
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
cipherInit ScrubbedBytes
readKeyBytes
        Read -> Get Read
forall (f :: * -> *) a. Applicative f => a -> f a
pure Read :: AES128 -> ScrubbedBytes -> Read
Read{ScrubbedBytes
AES128
unRead :: AES128
readKeyBytes :: ScrubbedBytes
readKeyBytes :: ScrubbedBytes
unRead :: AES128
..}

newtype StorageIndex = StorageIndex {StorageIndex -> ByteString
unStorageIndex :: B.ByteString} deriving newtype (StorageIndex -> StorageIndex -> Bool
(StorageIndex -> StorageIndex -> Bool)
-> (StorageIndex -> StorageIndex -> Bool) -> Eq StorageIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StorageIndex -> StorageIndex -> Bool
$c/= :: StorageIndex -> StorageIndex -> Bool
== :: StorageIndex -> StorageIndex -> Bool
$c== :: StorageIndex -> StorageIndex -> Bool
Eq, Eq StorageIndex
Eq StorageIndex
-> (StorageIndex -> StorageIndex -> Ordering)
-> (StorageIndex -> StorageIndex -> Bool)
-> (StorageIndex -> StorageIndex -> Bool)
-> (StorageIndex -> StorageIndex -> Bool)
-> (StorageIndex -> StorageIndex -> Bool)
-> (StorageIndex -> StorageIndex -> StorageIndex)
-> (StorageIndex -> StorageIndex -> StorageIndex)
-> Ord StorageIndex
StorageIndex -> StorageIndex -> Bool
StorageIndex -> StorageIndex -> Ordering
StorageIndex -> StorageIndex -> StorageIndex
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 :: StorageIndex -> StorageIndex -> StorageIndex
$cmin :: StorageIndex -> StorageIndex -> StorageIndex
max :: StorageIndex -> StorageIndex -> StorageIndex
$cmax :: StorageIndex -> StorageIndex -> StorageIndex
>= :: StorageIndex -> StorageIndex -> Bool
$c>= :: StorageIndex -> StorageIndex -> Bool
> :: StorageIndex -> StorageIndex -> Bool
$c> :: StorageIndex -> StorageIndex -> Bool
<= :: StorageIndex -> StorageIndex -> Bool
$c<= :: StorageIndex -> StorageIndex -> Bool
< :: StorageIndex -> StorageIndex -> Bool
$c< :: StorageIndex -> StorageIndex -> Bool
compare :: StorageIndex -> StorageIndex -> Ordering
$ccompare :: StorageIndex -> StorageIndex -> Ordering
$cp1Ord :: Eq StorageIndex
Ord)

instance Show StorageIndex where
    show :: StorageIndex -> String
show (StorageIndex ByteString
si) =
        Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
            [Text] -> Text
T.concat
                [ Text
"<SI "
                , 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 -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString
si
                , Text
">"
                ]

newtype WriteEnablerMaster = WriteEnablerMaster ByteArray.ScrubbedBytes

newtype WriteEnabler = WriteEnabler ByteArray.ScrubbedBytes

data Data = Data {Data -> AES128
unData :: AES128, Data -> ScrubbedBytes
dataKeyBytes :: ByteArray.ScrubbedBytes}

instance Show Data where
    show :: Data -> String
show (Data AES128
_ ScrubbedBytes
bs) =
        Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
            [Text] -> Text
T.concat
                [ Text
"<DataKey "
                , Int -> Text -> Text
shorten Int
4 (Text -> Text) -> (ScrubbedBytes -> Text) -> ScrubbedBytes -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
showBase32 (ByteString -> Text)
-> (ScrubbedBytes -> ByteString) -> ScrubbedBytes -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (ScrubbedBytes -> Text) -> ScrubbedBytes -> Text
forall a b. (a -> b) -> a -> b
$ ScrubbedBytes
bs
                , Text
">"
                ]

instance Eq Data where
    (Data AES128
_ ScrubbedBytes
left) == :: Data -> Data -> Bool
== (Data AES128
_ ScrubbedBytes
right) = ScrubbedBytes
left ScrubbedBytes -> ScrubbedBytes -> Bool
forall a. Eq a => a -> a -> Bool
== ScrubbedBytes
right

instance Binary Data where
    put :: Data -> Put
put = ByteString -> Put
putByteString (ByteString -> Put) -> (Data -> ByteString) -> Data -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (ScrubbedBytes -> ByteString)
-> (Data -> ScrubbedBytes) -> Data -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data -> ScrubbedBytes
dataKeyBytes
    get :: Get Data
get = do
        ScrubbedBytes
dataKeyBytes <- ByteString -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (ByteString -> ScrubbedBytes)
-> Get ByteString -> Get ScrubbedBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
keyLength
        let (CryptoPassed AES128
unData) = ScrubbedBytes -> CryptoFailable AES128
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
cipherInit ScrubbedBytes
dataKeyBytes
        Data -> Get Data
forall (f :: * -> *) a. Applicative f => a -> f a
pure Data :: AES128 -> ScrubbedBytes -> Data
Data{ScrubbedBytes
AES128
unData :: AES128
dataKeyBytes :: ScrubbedBytes
dataKeyBytes :: ScrubbedBytes
unData :: AES128
..}

newtype SDMF_IV = SDMF_IV (IV AES128)
    deriving (SDMF_IV -> SDMF_IV -> Bool
(SDMF_IV -> SDMF_IV -> Bool)
-> (SDMF_IV -> SDMF_IV -> Bool) -> Eq SDMF_IV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SDMF_IV -> SDMF_IV -> Bool
$c/= :: SDMF_IV -> SDMF_IV -> Bool
== :: SDMF_IV -> SDMF_IV -> Bool
$c== :: SDMF_IV -> SDMF_IV -> Bool
Eq)
    deriving newtype (SDMF_IV -> Int
SDMF_IV -> Ptr p -> IO ()
SDMF_IV -> (Ptr p -> IO a) -> IO a
(SDMF_IV -> Int)
-> (forall p a. SDMF_IV -> (Ptr p -> IO a) -> IO a)
-> (forall p. SDMF_IV -> Ptr p -> IO ())
-> ByteArrayAccess SDMF_IV
forall p. SDMF_IV -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall p a. SDMF_IV -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: SDMF_IV -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall p. SDMF_IV -> Ptr p -> IO ()
withByteArray :: SDMF_IV -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall p a. SDMF_IV -> (Ptr p -> IO a) -> IO a
length :: SDMF_IV -> Int
$clength :: SDMF_IV -> Int
ByteArray.ByteArrayAccess)

instance Show SDMF_IV where
    show :: SDMF_IV -> String
show (SDMF_IV IV AES128
iv) = Text -> String
T.unpack (Text -> String) -> (IV AES128 -> Text) -> IV AES128 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
showBase32 (ByteString -> Text)
-> (IV AES128 -> ByteString) -> IV AES128 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IV AES128 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (IV AES128 -> String) -> IV AES128 -> String
forall a b. (a -> b) -> a -> b
$ IV AES128
iv

-- | The size of the public/private key pair to generate.
keyPairBits :: Int
keyPairBits :: Int
keyPairBits = Int
2048

-- | The number of bytes in the block cipher key.
keyLength :: Int
(KeySizeFixed Int
keyLength) = AES128 -> KeySizeSpecifier
forall cipher. Cipher cipher => cipher -> KeySizeSpecifier
cipherKeySize (AES128
forall a. HasCallStack => a
undefined :: AES128)

{- | Create a new, random key pair (public/private aka verification/signature)
 of the appropriate type and size for SDMF encryption.
-}
newKeyPair :: MonadRandom m => m KeyPair
newKeyPair :: m KeyPair
newKeyPair = do
    (PublicKey
_, PrivateKey
priv) <- Int -> Integer -> m (PublicKey, PrivateKey)
forall (m :: * -> *).
MonadRandom m =>
Int -> Integer -> m (PublicKey, PrivateKey)
RSA.generate Int
keyPairBits Integer
e
    KeyPair -> m KeyPair
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyPair -> m KeyPair) -> KeyPair -> m KeyPair
forall a b. (a -> b) -> a -> b
$ PrivateKey -> KeyPair
KeyPair PrivateKey
priv
  where
    e :: Integer
e = Integer
0x10001

-- | Compute the write key for a given signature key for an SDMF share.
deriveWriteKey :: Signature -> Maybe Write
deriveWriteKey :: Signature -> Maybe Write
deriveWriteKey Signature
s =
    AES128 -> ScrubbedBytes -> Write
Write (AES128 -> ScrubbedBytes -> Write)
-> Maybe AES128 -> Maybe (ScrubbedBytes -> Write)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AES128
key Maybe (ScrubbedBytes -> Write)
-> Maybe ScrubbedBytes -> Maybe Write
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ScrubbedBytes -> Maybe ScrubbedBytes
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert ByteString
sbs)
  where
    sbs :: ByteString
sbs = Int -> ByteString -> ByteString -> ByteString
taggedHash Int
keyLength ByteString
mutableWriteKeyTag (ByteString -> ByteString)
-> (Signature -> ByteString) -> Signature -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> ByteString
signatureKeyToBytes (Signature -> ByteString) -> Signature -> ByteString
forall a b. (a -> b) -> a -> b
$ Signature
s
    key :: Maybe AES128
key = CryptoFailable AES128 -> Maybe AES128
forall a. CryptoFailable a -> Maybe a
maybeCryptoError (CryptoFailable AES128 -> Maybe AES128)
-> (ByteString -> CryptoFailable AES128)
-> ByteString
-> Maybe AES128
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> CryptoFailable AES128
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
cipherInit (ByteString -> Maybe AES128) -> ByteString -> Maybe AES128
forall a b. (a -> b) -> a -> b
$ ByteString
sbs

mutableWriteKeyTag :: B.ByteString
mutableWriteKeyTag :: ByteString
mutableWriteKeyTag = ByteString
"allmydata_mutable_privkey_to_writekey_v1"

-- | Compute the read key for a given write key for an SDMF share.
deriveReadKey :: Write -> Maybe Read
deriveReadKey :: Write -> Maybe Read
deriveReadKey Write
w =
    AES128 -> ScrubbedBytes -> Read
Read (AES128 -> ScrubbedBytes -> Read)
-> Maybe AES128 -> Maybe (ScrubbedBytes -> Read)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AES128
key Maybe (ScrubbedBytes -> Read) -> Maybe ScrubbedBytes -> Maybe Read
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ScrubbedBytes -> Maybe ScrubbedBytes
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert ByteString
sbs)
  where
    sbs :: ByteString
sbs = Int -> ByteString -> ByteString -> ByteString
taggedHash Int
keyLength ByteString
mutableReadKeyTag (ByteString -> ByteString)
-> (Write -> ByteString) -> Write -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (ScrubbedBytes -> ByteString)
-> (Write -> ScrubbedBytes) -> Write -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Write -> ScrubbedBytes
writeKeyBytes (Write -> ByteString) -> Write -> ByteString
forall a b. (a -> b) -> a -> b
$ Write
w
    key :: Maybe AES128
key = CryptoFailable AES128 -> Maybe AES128
forall a. CryptoFailable a -> Maybe a
maybeCryptoError (CryptoFailable AES128 -> Maybe AES128)
-> (ByteString -> CryptoFailable AES128)
-> ByteString
-> Maybe AES128
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> CryptoFailable AES128
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
cipherInit (ByteString -> Maybe AES128) -> ByteString -> Maybe AES128
forall a b. (a -> b) -> a -> b
$ ByteString
sbs

mutableReadKeyTag :: B.ByteString
mutableReadKeyTag :: ByteString
mutableReadKeyTag = ByteString
"allmydata_mutable_writekey_to_readkey_v1"

-- | Compute the data encryption/decryption key for a given read key for an SDMF share.
deriveDataKey :: SDMF_IV -> Read -> Maybe Data
deriveDataKey :: SDMF_IV -> Read -> Maybe Data
deriveDataKey (SDMF_IV IV AES128
iv) Read
r =
    AES128 -> ScrubbedBytes -> Data
Data (AES128 -> ScrubbedBytes -> Data)
-> Maybe AES128 -> Maybe (ScrubbedBytes -> Data)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AES128
key Maybe (ScrubbedBytes -> Data) -> Maybe ScrubbedBytes -> Maybe Data
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ScrubbedBytes -> Maybe ScrubbedBytes
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert ByteString
sbs)
  where
    -- XXX taggedPairHash has a bug where it doesn't ever truncate so we
    -- truncate for it.
    sbs :: ByteString
sbs = Int -> ByteString -> ByteString
B.take Int
keyLength (ByteString -> ByteString)
-> (Read -> ByteString) -> Read -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString -> ByteString -> ByteString
taggedPairHash Int
keyLength ByteString
mutableDataKeyTag ([Word8] -> ByteString
B.pack ([Word8] -> ByteString)
-> (IV AES128 -> [Word8]) -> IV AES128 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IV AES128 -> [Word8]
forall a. ByteArrayAccess a => a -> [Word8]
ByteArray.unpack (IV AES128 -> ByteString) -> IV AES128 -> ByteString
forall a b. (a -> b) -> a -> b
$ IV AES128
iv) (ByteString -> ByteString)
-> (Read -> ByteString) -> Read -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (ScrubbedBytes -> ByteString)
-> (Read -> ScrubbedBytes) -> Read -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Read -> ScrubbedBytes
readKeyBytes (Read -> ByteString) -> Read -> ByteString
forall a b. (a -> b) -> a -> b
$ Read
r
    key :: Maybe AES128
key = CryptoFailable AES128 -> Maybe AES128
forall a. CryptoFailable a -> Maybe a
maybeCryptoError (CryptoFailable AES128 -> Maybe AES128)
-> (ByteString -> CryptoFailable AES128)
-> ByteString
-> Maybe AES128
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> CryptoFailable AES128
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
cipherInit (ByteString -> Maybe AES128) -> ByteString -> Maybe AES128
forall a b. (a -> b) -> a -> b
$ ByteString
sbs

mutableDataKeyTag :: B.ByteString
mutableDataKeyTag :: ByteString
mutableDataKeyTag = ByteString
"allmydata_mutable_readkey_to_datakey_v1"

-- | Compute the storage index for a given read key for an SDMF share.
deriveStorageIndex :: Read -> StorageIndex
deriveStorageIndex :: Read -> StorageIndex
deriveStorageIndex Read
r = ByteString -> StorageIndex
StorageIndex ByteString
si
  where
    si :: ByteString
si = Int -> ByteString -> ByteString -> ByteString
taggedHash Int
keyLength ByteString
mutableStorageIndexTag (ByteString -> ByteString)
-> (Read -> ByteString) -> Read -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (ScrubbedBytes -> ByteString)
-> (Read -> ScrubbedBytes) -> Read -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Read -> ScrubbedBytes
readKeyBytes (Read -> ByteString) -> Read -> ByteString
forall a b. (a -> b) -> a -> b
$ Read
r

mutableStorageIndexTag :: B.ByteString
mutableStorageIndexTag :: ByteString
mutableStorageIndexTag = ByteString
"allmydata_mutable_readkey_to_storage_index_v1"

{- | Derive the "write enabler master" secret for a given write key for an
 SDMF share.
-}
deriveWriteEnablerMaster :: Write -> WriteEnablerMaster
deriveWriteEnablerMaster :: Write -> WriteEnablerMaster
deriveWriteEnablerMaster Write
w = ScrubbedBytes -> WriteEnablerMaster
WriteEnablerMaster ScrubbedBytes
bs
  where
    -- This one shouldn't be truncated.  Set the length to the size of sha256d
    -- output.
    bs :: ScrubbedBytes
bs = ByteString -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (ByteString -> ScrubbedBytes)
-> (Write -> ByteString) -> Write -> ScrubbedBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString -> ByteString
taggedHash Int
32 ByteString
mutableWriteEnablerMasterTag (ByteString -> ByteString)
-> (Write -> ByteString) -> Write -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (ScrubbedBytes -> ByteString)
-> (Write -> ScrubbedBytes) -> Write -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Write -> ScrubbedBytes
writeKeyBytes (Write -> ScrubbedBytes) -> Write -> ScrubbedBytes
forall a b. (a -> b) -> a -> b
$ Write
w

mutableWriteEnablerMasterTag :: B.ByteString
mutableWriteEnablerMasterTag :: ByteString
mutableWriteEnablerMasterTag = ByteString
"allmydata_mutable_writekey_to_write_enabler_master_v1"

{- | Derive the "write enabler" secret for a given peer and "write enabler
 master" for an SDMF share.
-}
deriveWriteEnabler :: B.ByteString -> WriteEnablerMaster -> WriteEnabler
deriveWriteEnabler :: ByteString -> WriteEnablerMaster -> WriteEnabler
deriveWriteEnabler ByteString
peerid (WriteEnablerMaster ScrubbedBytes
master) = ScrubbedBytes -> WriteEnabler
WriteEnabler ScrubbedBytes
bs
  where
    -- This one shouldn't be truncated.  Set the length to the size of sha256d
    -- output.
    bs :: ScrubbedBytes
bs = ByteString -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (ByteString -> ScrubbedBytes)
-> (ByteString -> ByteString) -> ByteString -> ScrubbedBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString -> ByteString -> ByteString
taggedPairHash Int
32 ByteString
mutableWriteEnablerTag (ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert ScrubbedBytes
master) (ByteString -> ScrubbedBytes) -> ByteString -> ScrubbedBytes
forall a b. (a -> b) -> a -> b
$ ByteString
peerid

mutableWriteEnablerTag :: B.ByteString
mutableWriteEnablerTag :: ByteString
mutableWriteEnablerTag = ByteString
"allmydata_mutable_write_enabler_master_and_nodeid_to_write_enabler_v1"

{- | Compute the verification key hash of the given verification key for
 inclusion in an SDMF share.
-}
deriveVerificationHash :: Verification -> B.ByteString
deriveVerificationHash :: Verification -> ByteString
deriveVerificationHash = Int -> ByteString -> ByteString -> ByteString
taggedHash Int
32 ByteString
mutableVerificationKeyHashTag (ByteString -> ByteString)
-> (Verification -> ByteString) -> Verification -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verification -> ByteString
verificationKeyToBytes

{- | The tag used when hashing the verification key to the verification key
 hash for inclusion in SDMF shares.
-}
mutableVerificationKeyHashTag :: B.ByteString
mutableVerificationKeyHashTag :: ByteString
mutableVerificationKeyHashTag = ByteString
"allmydata_mutable_pubkey_to_fingerprint_v1"

{- | Encode a public key to the Tahoe-LAFS canonical bytes representation -
 X.509 SubjectPublicKeyInfo of the ASN.1 DER serialization of an RSA
 PublicKey.
-}
verificationKeyToBytes :: Verification -> B.ByteString
verificationKeyToBytes :: Verification -> ByteString
verificationKeyToBytes = ByteString -> ByteString
LB.toStrict (ByteString -> ByteString)
-> (Verification -> ByteString) -> Verification -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DER -> [ASN1] -> ByteString
forall a. ASN1Encoding a => a -> [ASN1] -> ByteString
encodeASN1 DER
DER ([ASN1] -> ByteString)
-> (Verification -> [ASN1]) -> Verification -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PubKey -> [ASN1] -> [ASN1]) -> [ASN1] -> PubKey -> [ASN1]
forall a b c. (a -> b -> c) -> b -> a -> c
flip PubKey -> [ASN1] -> [ASN1]
forall a. ASN1Object a => a -> [ASN1] -> [ASN1]
toASN1 [] (PubKey -> [ASN1])
-> (Verification -> PubKey) -> Verification -> [ASN1]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> PubKey
PubKeyRSA (PublicKey -> PubKey)
-> (Verification -> PublicKey) -> Verification -> PubKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verification -> PublicKey
unVerification

{- | Encode a private key to the Tahoe-LAFS canonical bytes representation -
 X.509 SubjectPublicKeyInfo of the ASN.1 DER serialization of an RSA
 PublicKey.
-}
signatureKeyToBytes :: Signature -> B.ByteString
signatureKeyToBytes :: Signature -> ByteString
signatureKeyToBytes = ByteString -> ByteString
LB.toStrict (ByteString -> ByteString)
-> (Signature -> ByteString) -> Signature -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DER -> [ASN1] -> ByteString
forall a. ASN1Encoding a => a -> [ASN1] -> ByteString
encodeASN1 DER
DER ([ASN1] -> ByteString)
-> (Signature -> [ASN1]) -> Signature -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> [ASN1]
toPKCS8
  where
    -- The ASN1Object instance for PrivKeyRSA can interpret an x509
    -- "Private-Key Information" (aka PKCS8; see RFC 5208, section 5)
    -- structure but it _produces_ some other format.  We must have exactly
    -- this format.
    --
    -- XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
    --
    -- RFC 5208 says:
    --
    --    privateKey is an octet string whose contents are the value of the
    --    private key.  The interpretation of the contents is defined in the
    --    registration of the private-key algorithm.  For an RSA private key,
    --    for example, the contents are a BER encoding of a value of type
    --    RSAPrivateKey.
    --
    -- The ASN.1 BER encoding for a given structure is *not guaranteed to be
    -- unique*.  This means that in general there is no guarantee of a unique
    -- bytes representation of a signature key in this scheme so *key
    -- derivations are not unique*.  If any two implementations disagree on
    -- this encoding (which BER allows them to do) they will not interoperate.
    toPKCS8 :: Signature -> [ASN1]
toPKCS8 (Signature PrivateKey
privKey) =
        [ ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence
        , Integer -> ASN1
IntVal Integer
0
        , ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence
        , OID -> ASN1
OID [Integer
1, Integer
2, Integer
840, Integer
113549, Integer
1, Integer
1, Integer
1]
        , ASN1
Null
        , ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence
        , -- Our ASN.1 encoder doesn't even pretend to support BER.  Use DER!
          -- It results in the same bytes as Tahoe-LAFS is working with so ...
          -- Maybe we're lucky or maybe Tahoe-LAFS isn't actually following
          -- the spec.
          ByteString -> ASN1
OctetString (ByteString -> ByteString
LB.toStrict (ByteString -> ByteString)
-> ([ASN1] -> ByteString) -> [ASN1] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DER -> [ASN1] -> ByteString
forall a. ASN1Encoding a => a -> [ASN1] -> ByteString
encodeASN1 DER
DER ([ASN1] -> ByteString)
-> ([ASN1] -> [ASN1]) -> [ASN1] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivKey -> [ASN1] -> [ASN1]
forall a. ASN1Object a => a -> [ASN1] -> [ASN1]
toASN1 (PrivateKey -> PrivKey
PrivKeyRSA PrivateKey
privKey) ([ASN1] -> ByteString) -> [ASN1] -> ByteString
forall a b. (a -> b) -> a -> b
$ [])
        , ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence
        ]

-- | Decode a private key from the Tahoe-LAFS canonical bytes representation.
signatureKeyFromBytes :: B.ByteString -> Either String Signature
signatureKeyFromBytes :: ByteString -> Either String Signature
signatureKeyFromBytes ByteString
bs = do
    [ASN1]
asn1s <- (ASN1Error -> String)
-> Either ASN1Error [ASN1] -> Either String [ASN1]
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ASN1Error -> String
forall a. Show a => a -> String
show (Either ASN1Error [ASN1] -> Either String [ASN1])
-> Either ASN1Error [ASN1] -> Either String [ASN1]
forall a b. (a -> b) -> a -> b
$ DER -> ByteString -> Either ASN1Error [ASN1]
forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' DER
DER ByteString
bs
    (PrivKey
key, [ASN1]
extra) <- [ASN1] -> Either String (PrivKey, [ASN1])
forall a. ASN1Object a => [ASN1] -> Either String (a, [ASN1])
fromASN1 [ASN1]
asn1s
    Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([ASN1]
extra [ASN1] -> [ASN1] -> Bool
forall a. Eq a => a -> a -> Bool
/= []) (String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ String
"left over data: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [ASN1] -> String
forall a. Show a => a -> String
show [ASN1]
extra)
    case PrivKey
key of
        (PrivKeyRSA PrivateKey
privKey) -> Signature -> Either String Signature
forall a b. b -> Either a b
Right (Signature -> Either String Signature)
-> Signature -> Either String Signature
forall a b. (a -> b) -> a -> b
$ PrivateKey -> Signature
Signature PrivateKey
privKey
        PrivKey
_ -> String -> Either String Signature
forall a b. a -> Either a b
Left (String
"Expect RSA private key, found " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PrivKey -> String
forall a. Show a => a -> String
show PrivKey
key)

-- | Encrypt the signature key for inclusion in the SDMF share itself.
encryptSignatureKey :: Write -> Signature -> B.ByteString
encryptSignatureKey :: Write -> Signature -> ByteString
encryptSignatureKey Write{AES128
unWrite :: AES128
unWrite :: Write -> AES128
unWrite} = AES128 -> IV AES128 -> ByteString -> ByteString
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
ctrCombine AES128
unWrite IV AES128
forall c. BlockCipher c => IV c
nullIV (ByteString -> ByteString)
-> (Signature -> ByteString) -> Signature -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> ByteString
signatureKeyToBytes

{- | 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.

 TODO: Deduplicate this between here and tahoe-chk.
-}
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

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
encodeBase32Unpadded