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
keyPairBits :: Int
keyPairBits :: Int
keyPairBits = Int
2048
keyLength :: Int
(KeySizeFixed Int
keyLength) = AES128 -> KeySizeSpecifier
forall cipher. Cipher cipher => cipher -> KeySizeSpecifier
cipherKeySize (AES128
forall a. HasCallStack => a
undefined :: AES128)
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
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"
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"
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
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"
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"
deriveWriteEnablerMaster :: Write -> WriteEnablerMaster
deriveWriteEnablerMaster :: Write -> WriteEnablerMaster
deriveWriteEnablerMaster Write
w = ScrubbedBytes -> WriteEnablerMaster
WriteEnablerMaster ScrubbedBytes
bs
where
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"
deriveWriteEnabler :: B.ByteString -> WriteEnablerMaster -> WriteEnabler
deriveWriteEnabler :: ByteString -> WriteEnablerMaster -> WriteEnabler
deriveWriteEnabler ByteString
peerid (WriteEnablerMaster ScrubbedBytes
master) = ScrubbedBytes -> WriteEnabler
WriteEnabler ScrubbedBytes
bs
where
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"
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
mutableVerificationKeyHashTag :: B.ByteString
mutableVerificationKeyHashTag :: ByteString
mutableVerificationKeyHashTag = ByteString
"allmydata_mutable_pubkey_to_fingerprint_v1"
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
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
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
,
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
]
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)
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
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