From ef8090589c965e915a5cc0aef76dfa2010127180 Mon Sep 17 00:00:00 2001
From: Jean-Paul Calderone <exarkun@twistedmatrix.com>
Date: Fri, 12 May 2023 10:35:15 -0400
Subject: [PATCH] Standardize on cryptonite
This is probably better than pulling in three different crypto libraries for
each of the difference pieces we need. It's certainly simpler to figure out
how to make the pieces play nicely together since we avoid having multiple
kinds of AES128 key defined, multiple types named IV and PublicKey, and even
multiple implementations of the same module.
---
README.md | 69 ++++++++++++++++++++++++++++++++
src/Tahoe/SDMF/Internal/Share.hs | 24 +++++++++--
tahoe-ssk.cabal | 15 +++----
test/Generators.hs | 50 ++++++++++++-----------
4 files changed, 121 insertions(+), 37 deletions(-)
diff --git a/README.md b/README.md
index b5fa4d9..e824e77 100644
--- a/README.md
+++ b/README.md
@@ -22,3 +22,72 @@ with the benefit of the experience gained from creating and maintaining the Pyth
a number of implementation decisions can be made differently to produce a more efficient, more flexible, simpler implementation and API.
Also,
the Python implementation claims no public library API for users outside of the Tahoe-LAFS project itself.
+
+## Cryptographic Library Choice
+
+This library uses cryptonite for cryptography,
+motivated by the following considerations.
+
+SDMF uses
+* SHA256 for tagged hashes for key derivation and for integrity (XXX right word?) checks on some data.
+* AES128 for encryption of the signature key and the application plaintext data.
+* RSA for signatures proving write authority.
+
+There are a number of Haskell libraries that provide all of these:
+
+* Crypto
+ * Does not support the AES mode we require (CTR).
+
+* HsOpenSSL
+ * Bindings to a C library, OpenSSL, which may complicate the build process.
+ * OpenSSL's security and reliability track record also leaves something to be desired.
+
+* cryptonite
+ * Has all of the primitive cryptographic functionality we need.
+
+We want a library that:
+
+* Can be used with reflex-platform
+ * ghc 8.6.5 compatible
+* Can be cross-compiled to different targets from x86_64-linux
+ * Mainly armeabi and armv7
+* Is suitable for real-world security purposes
+ * not a demo or a toy library
+ * avoids real-world pitfalls (side-channel attacks, etc), not just textbook issues
+ * has more than a handful of other users
+
+### SHA256
+
+There are a number of Haskell libraries that provide this primitive:
+
+* Crypto
+* HsOpenSSL
+* SHA
+* cryptohash
+* cryptonite
+* dhall
+* hashing
+* nettle
+* sbv
+* tls
+
+### AES128
+
+* Crypto
+* HsOpenSSL
+* cipher-aes
+* cipher-aes128
+* crypto
+* cryptocipher
+* cryptonite
+* cryptostore
+* nettle
+
+### RSA
+
+SDMF depends on RSA for signatures proving write authority.
+
+* Crypto
+* HsOpenSSL
+* RSA
+* cryptonite
diff --git a/src/Tahoe/SDMF/Internal/Share.hs b/src/Tahoe/SDMF/Internal/Share.hs
index f458795..e5bad88 100644
--- a/src/Tahoe/SDMF/Internal/Share.hs
+++ b/src/Tahoe/SDMF/Internal/Share.hs
@@ -3,16 +3,20 @@ module Tahoe.SDMF.Internal.Share where
import Control.Monad (unless)
import Crypto.Cipher.AES (AES128)
+import Crypto.Cipher.Types (Cipher (cipherInit), IV, makeIV)
+import Crypto.Error (maybeCryptoError)
import qualified Crypto.PubKey.RSA.Types as RSA
-import Crypto.Types (IV (IV, initializationVector))
import Data.ASN1.BinaryEncoding (DER (DER))
import Data.ASN1.Encoding (ASN1Encoding (encodeASN1), decodeASN1')
import Data.ASN1.Types (ASN1Object (fromASN1, toASN1))
import Data.Binary (Binary (..), Get, getWord8)
import Data.Binary.Get (bytesRead, getByteString, getLazyByteString, getRemainingLazyByteString, getWord16be, getWord32be, getWord64be, isEmpty, isolate)
import Data.Binary.Put (putByteString, putLazyByteString, putWord16be, putWord32be, putWord64be, putWord8)
+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.Word (Word16, Word64, Word8)
import Data.X509 (PubKey (PubKeyRSA))
import Tahoe.CHK.Merkle (MerkleTree, leafHashes)
@@ -57,7 +61,7 @@ data Share = Share
, -- | "R" (root of share hash merkle tree)
shareRootHash :: B.ByteString
, -- | The IV for encryption of share data.
- shareIV :: IV AES128
+ shareIV :: SDMF_IV
, -- | The total number of encoded shares (k).
shareTotalShares :: Word8
, -- | The number of shares required for decoding (N).
@@ -86,12 +90,19 @@ data Share = Share
}
deriving (Eq, Show)
+newtype SDMF_IV = SDMF_IV (IV AES128)
+ deriving (Eq)
+ deriving newtype (ByteArray.ByteArrayAccess)
+
+instance Show SDMF_IV where
+ show (SDMF_IV iv) = T.unpack . T.toLower . encodeBase32Unpadded . ByteArray.convert $ iv
+
instance Binary Share where
put Share{..} = do
putWord8 0
putWord64be shareSequenceNumber
putByteString shareRootHash
- putByteString . initializationVector $ shareIV
+ putByteString . ByteArray.convert $ shareIV
putWord8 shareTotalShares
putWord8 shareRequiredShares
putWord64be shareSegmentSize
@@ -125,7 +136,12 @@ instance Binary Share where
unless (version == 0) (fail $ "Only version 0 is supported; got version " <> show version)
shareSequenceNumber <- getWord64be
shareRootHash <- getByteString 32
- shareIV <- IV <$> getByteString 16
+ ivBytes <- getByteString 16
+ shareIV <-
+ SDMF_IV <$> case makeIV ivBytes of
+ Nothing -> fail "Could not decode IV"
+ Just iv -> pure iv
+
shareTotalShares <- getWord8
shareRequiredShares <- getWord8
shareSegmentSize <- getWord64be
diff --git a/tahoe-ssk.cabal b/tahoe-ssk.cabal
index e8e7920..470d125 100644
--- a/tahoe-ssk.cabal
+++ b/tahoe-ssk.cabal
@@ -69,12 +69,12 @@ library
, asn1-encoding
, asn1-types
, base
+ , base32
, binary
, bytestring
- , crypto-api
- , crypto-pubkey-types
, cryptonite
- , RSA
+ , memory
+ , text
, x509
-- This dependency isn't ideal. Move common bits out to
@@ -119,14 +119,11 @@ test-suite tahoe-ssk-test
build-depends:
, asn1-encoding
, asn1-types
- , base ^>=4.14.3.0
+ , base ^>=4.14.3.0
, binary
, bytestring
- , crypto-api
- , crypto-pubkey-types
, cryptonite
, hedgehog
- , RSA
, tahoe-chk
, tahoe-ssk
, tasty
@@ -145,6 +142,4 @@ executable make-keypairs
, asn1-types
, base
, bytestring
- , crypto-api
- , crypto-pubkey-types
- , RSA
+ , cryptonite
diff --git a/test/Generators.hs b/test/Generators.hs
index 9161054..b43ea31 100644
--- a/test/Generators.hs
+++ b/test/Generators.hs
@@ -1,9 +1,9 @@
module Generators where
+import Crypto.Cipher.Types (makeIV)
import Crypto.Hash (HashAlgorithm (hashDigestSize))
import Crypto.Hash.Algorithms (SHA256 (SHA256))
-import qualified Crypto.PubKey.RSA.Types as RSA
-import Crypto.Types (IV (..))
+import qualified Crypto.PubKey.RSA as RSA
import Data.ASN1.BinaryEncoding (DER (DER))
import Data.ASN1.Encoding (ASN1Decoding (decodeASN1), ASN1Encoding (encodeASN1))
import Data.ASN1.Types (ASN1Object (fromASN1, toASN1))
@@ -16,8 +16,8 @@ import Hedgehog (MonadGen)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Tahoe.CHK.Merkle (MerkleTree (..), makeTreePartial)
-import Tahoe.SDMF (Share (..))
-import Tahoe.SDMF.Internal.Share (HashChain (HashChain))
+import Tahoe.SDMF (KeyPair (..), Share (..), toPublicKey)
+import Tahoe.SDMF.Internal.Share (HashChain (HashChain), SDMF_IV (SDMF_IV))
rootHashLength :: Int
rootHashLength = 32
@@ -32,22 +32,26 @@ signatureLength = Range.linear 250 260
semantically valid.
-}
shares :: MonadGen m => m Share
-shares =
- genRSAKeys >>= \keypair ->
- Share
- <$> Gen.word64 Range.exponentialBounded -- shareSequenceNumber
- <*> Gen.bytes (Range.singleton rootHashLength) -- shareRootHash
- <*> (IV <$> Gen.bytes (Range.singleton ivLength)) -- shareIV
- <*> Gen.word8 Range.exponentialBounded -- shareTotalShares
- <*> Gen.word8 Range.exponentialBounded -- shareRequiredShares
- <*> Gen.word64 Range.exponentialBounded -- shareSegmentSize
- <*> Gen.word64 Range.exponentialBounded -- shareDataLength
- <*> pure (RSA.toPublicKey keypair) -- shareVerificationKey
- <*> Gen.bytes signatureLength -- shareSignature
- <*> shareHashChains -- shareHashChain
- <*> merkleTrees (Range.singleton 1) -- shareBlockHashTree
- <*> (LB.fromStrict <$> Gen.bytes (Range.exponential 0 1024)) -- shareData
- <*> (pure . LB.toStrict . toDER . PrivKeyRSA . RSA.toPrivateKey) keypair -- shareEncryptedPrivateKey
+shares = do
+ keypair <- genRSAKeys
+ iv <- makeIV <$> Gen.bytes (Range.singleton ivLength)
+ case iv of
+ Nothing -> error "Could not build IV for SDMF share"
+ Just iv' ->
+ Share
+ <$> Gen.word64 Range.exponentialBounded -- shareSequenceNumber
+ <*> Gen.bytes (Range.singleton rootHashLength) -- shareRootHash
+ <*> pure (SDMF_IV iv') -- shareIV
+ <*> Gen.word8 Range.exponentialBounded -- shareTotalShares
+ <*> Gen.word8 Range.exponentialBounded -- shareRequiredShares
+ <*> Gen.word64 Range.exponentialBounded -- shareSegmentSize
+ <*> Gen.word64 Range.exponentialBounded -- shareDataLength
+ <*> pure (toPublicKey keypair) -- shareVerificationKey
+ <*> Gen.bytes signatureLength -- shareSignature
+ <*> shareHashChains -- shareHashChain
+ <*> merkleTrees (Range.singleton 1) -- shareBlockHashTree
+ <*> (LB.fromStrict <$> Gen.bytes (Range.exponential 0 1024)) -- shareData
+ <*> (pure . LB.toStrict . toDER . PrivKeyRSA . toPrivateKey) keypair -- shareEncryptedPrivateKey
where
toDER = encodeASN1 DER . flip toASN1 []
@@ -59,7 +63,7 @@ shares =
challenging, this implementation just knows a few RSA key pairs already and
will give back one of them.
-}
-genRSAKeys :: MonadGen m => m RSA.KeyPair
+genRSAKeys :: MonadGen m => m KeyPair
genRSAKeys = Gen.element (map rsaKeyPair rsaKeyPairBytes)
-- I'm not sure how to do IO in MonadGen so do the IO up front unsafely (but
@@ -68,13 +72,13 @@ rsaKeyPairBytes :: [LB.ByteString]
{-# NOINLINE rsaKeyPairBytes #-}
rsaKeyPairBytes = unsafePerformIO $ mapM (\n -> LB.readFile ("test/data/rsa-privkey-" <> show n <> ".der")) [0 .. 4 :: Int]
-rsaKeyPair :: LB.ByteString -> RSA.KeyPair
+rsaKeyPair :: LB.ByteString -> KeyPair
rsaKeyPair bs = do
let (Right kp) = do
asn1s <- first show (decodeASN1 DER bs)
(r, _) <- fromASN1 asn1s
case r of
- PrivKeyRSA pk -> pure $ RSA.KeyPair pk
+ PrivKeyRSA pk -> pure $ KeyPair pk
_ -> error "Expected RSA Private Key"
kp
--
GitLab