Skip to content
Snippets Groups Projects
Commit ef809058 authored by Jean-Paul Calderone's avatar Jean-Paul Calderone
Browse files

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.
parent 563d4551
No related branches found
No related tags found
1 merge request!4Standardize on cryptonite
Pipeline #4578 failed
...@@ -22,3 +22,72 @@ with the benefit of the experience gained from creating and maintaining the Pyth ...@@ -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. a number of implementation decisions can be made differently to produce a more efficient, more flexible, simpler implementation and API.
Also, Also,
the Python implementation claims no public library API for users outside of the Tahoe-LAFS project itself. 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
...@@ -3,16 +3,20 @@ module Tahoe.SDMF.Internal.Share where ...@@ -3,16 +3,20 @@ module Tahoe.SDMF.Internal.Share where
import Control.Monad (unless) import Control.Monad (unless)
import Crypto.Cipher.AES (AES128) 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 qualified Crypto.PubKey.RSA.Types as RSA
import Crypto.Types (IV (IV, initializationVector))
import Data.ASN1.BinaryEncoding (DER (DER)) import Data.ASN1.BinaryEncoding (DER (DER))
import Data.ASN1.Encoding (ASN1Encoding (encodeASN1), decodeASN1') import Data.ASN1.Encoding (ASN1Encoding (encodeASN1), decodeASN1')
import Data.ASN1.Types (ASN1Object (fromASN1, toASN1)) import Data.ASN1.Types (ASN1Object (fromASN1, toASN1))
import Data.Binary (Binary (..), Get, getWord8) import Data.Binary (Binary (..), Get, getWord8)
import Data.Binary.Get (bytesRead, getByteString, getLazyByteString, getRemainingLazyByteString, getWord16be, getWord32be, getWord64be, isEmpty, isolate) import Data.Binary.Get (bytesRead, getByteString, getLazyByteString, getRemainingLazyByteString, getWord16be, getWord32be, getWord64be, isEmpty, isolate)
import Data.Binary.Put (putByteString, putLazyByteString, putWord16be, putWord32be, putWord64be, putWord8) import Data.Binary.Put (putByteString, putLazyByteString, putWord16be, putWord32be, putWord64be, putWord8)
import qualified Data.ByteArray as ByteArray
import qualified Data.ByteString as B import qualified Data.ByteString as B
import Data.ByteString.Base32 (encodeBase32Unpadded)
import qualified Data.ByteString.Lazy as LB import qualified Data.ByteString.Lazy as LB
import qualified Data.Text as T
import Data.Word (Word16, Word64, Word8) import Data.Word (Word16, Word64, Word8)
import Data.X509 (PubKey (PubKeyRSA)) import Data.X509 (PubKey (PubKeyRSA))
import Tahoe.CHK.Merkle (MerkleTree, leafHashes) import Tahoe.CHK.Merkle (MerkleTree, leafHashes)
...@@ -57,7 +61,7 @@ data Share = Share ...@@ -57,7 +61,7 @@ data Share = Share
, -- | "R" (root of share hash merkle tree) , -- | "R" (root of share hash merkle tree)
shareRootHash :: B.ByteString shareRootHash :: B.ByteString
, -- | The IV for encryption of share data. , -- | The IV for encryption of share data.
shareIV :: IV AES128 shareIV :: SDMF_IV
, -- | The total number of encoded shares (k). , -- | The total number of encoded shares (k).
shareTotalShares :: Word8 shareTotalShares :: Word8
, -- | The number of shares required for decoding (N). , -- | The number of shares required for decoding (N).
...@@ -86,12 +90,19 @@ data Share = Share ...@@ -86,12 +90,19 @@ data Share = Share
} }
deriving (Eq, Show) 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 instance Binary Share where
put Share{..} = do put Share{..} = do
putWord8 0 putWord8 0
putWord64be shareSequenceNumber putWord64be shareSequenceNumber
putByteString shareRootHash putByteString shareRootHash
putByteString . initializationVector $ shareIV putByteString . ByteArray.convert $ shareIV
putWord8 shareTotalShares putWord8 shareTotalShares
putWord8 shareRequiredShares putWord8 shareRequiredShares
putWord64be shareSegmentSize putWord64be shareSegmentSize
...@@ -125,7 +136,12 @@ instance Binary Share where ...@@ -125,7 +136,12 @@ instance Binary Share where
unless (version == 0) (fail $ "Only version 0 is supported; got version " <> show version) unless (version == 0) (fail $ "Only version 0 is supported; got version " <> show version)
shareSequenceNumber <- getWord64be shareSequenceNumber <- getWord64be
shareRootHash <- getByteString 32 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 shareTotalShares <- getWord8
shareRequiredShares <- getWord8 shareRequiredShares <- getWord8
shareSegmentSize <- getWord64be shareSegmentSize <- getWord64be
......
...@@ -69,12 +69,12 @@ library ...@@ -69,12 +69,12 @@ library
, asn1-encoding , asn1-encoding
, asn1-types , asn1-types
, base , base
, base32
, binary , binary
, bytestring , bytestring
, crypto-api
, crypto-pubkey-types
, cryptonite , cryptonite
, RSA , memory
, text
, x509 , x509
-- This dependency isn't ideal. Move common bits out to -- This dependency isn't ideal. Move common bits out to
...@@ -122,11 +122,8 @@ test-suite tahoe-ssk-test ...@@ -122,11 +122,8 @@ test-suite tahoe-ssk-test
, base ^>=4.14.3.0 , base ^>=4.14.3.0
, binary , binary
, bytestring , bytestring
, crypto-api
, crypto-pubkey-types
, cryptonite , cryptonite
, hedgehog , hedgehog
, RSA
, tahoe-chk , tahoe-chk
, tahoe-ssk , tahoe-ssk
, tasty , tasty
...@@ -145,6 +142,4 @@ executable make-keypairs ...@@ -145,6 +142,4 @@ executable make-keypairs
, asn1-types , asn1-types
, base , base
, bytestring , bytestring
, crypto-api , cryptonite
, crypto-pubkey-types
, RSA
module Generators where module Generators where
import Crypto.Cipher.Types (makeIV)
import Crypto.Hash (HashAlgorithm (hashDigestSize)) import Crypto.Hash (HashAlgorithm (hashDigestSize))
import Crypto.Hash.Algorithms (SHA256 (SHA256)) import Crypto.Hash.Algorithms (SHA256 (SHA256))
import qualified Crypto.PubKey.RSA.Types as RSA import qualified Crypto.PubKey.RSA as RSA
import Crypto.Types (IV (..))
import Data.ASN1.BinaryEncoding (DER (DER)) import Data.ASN1.BinaryEncoding (DER (DER))
import Data.ASN1.Encoding (ASN1Decoding (decodeASN1), ASN1Encoding (encodeASN1)) import Data.ASN1.Encoding (ASN1Decoding (decodeASN1), ASN1Encoding (encodeASN1))
import Data.ASN1.Types (ASN1Object (fromASN1, toASN1)) import Data.ASN1.Types (ASN1Object (fromASN1, toASN1))
...@@ -16,8 +16,8 @@ import Hedgehog (MonadGen) ...@@ -16,8 +16,8 @@ import Hedgehog (MonadGen)
import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range import qualified Hedgehog.Range as Range
import Tahoe.CHK.Merkle (MerkleTree (..), makeTreePartial) import Tahoe.CHK.Merkle (MerkleTree (..), makeTreePartial)
import Tahoe.SDMF (Share (..)) import Tahoe.SDMF (KeyPair (..), Share (..), toPublicKey)
import Tahoe.SDMF.Internal.Share (HashChain (HashChain)) import Tahoe.SDMF.Internal.Share (HashChain (HashChain), SDMF_IV (SDMF_IV))
rootHashLength :: Int rootHashLength :: Int
rootHashLength = 32 rootHashLength = 32
...@@ -32,22 +32,26 @@ signatureLength = Range.linear 250 260 ...@@ -32,22 +32,26 @@ signatureLength = Range.linear 250 260
semantically valid. semantically valid.
-} -}
shares :: MonadGen m => m Share shares :: MonadGen m => m Share
shares = shares = do
genRSAKeys >>= \keypair -> keypair <- genRSAKeys
iv <- makeIV <$> Gen.bytes (Range.singleton ivLength)
case iv of
Nothing -> error "Could not build IV for SDMF share"
Just iv' ->
Share Share
<$> Gen.word64 Range.exponentialBounded -- shareSequenceNumber <$> Gen.word64 Range.exponentialBounded -- shareSequenceNumber
<*> Gen.bytes (Range.singleton rootHashLength) -- shareRootHash <*> Gen.bytes (Range.singleton rootHashLength) -- shareRootHash
<*> (IV <$> Gen.bytes (Range.singleton ivLength)) -- shareIV <*> pure (SDMF_IV iv') -- shareIV
<*> Gen.word8 Range.exponentialBounded -- shareTotalShares <*> Gen.word8 Range.exponentialBounded -- shareTotalShares
<*> Gen.word8 Range.exponentialBounded -- shareRequiredShares <*> Gen.word8 Range.exponentialBounded -- shareRequiredShares
<*> Gen.word64 Range.exponentialBounded -- shareSegmentSize <*> Gen.word64 Range.exponentialBounded -- shareSegmentSize
<*> Gen.word64 Range.exponentialBounded -- shareDataLength <*> Gen.word64 Range.exponentialBounded -- shareDataLength
<*> pure (RSA.toPublicKey keypair) -- shareVerificationKey <*> pure (toPublicKey keypair) -- shareVerificationKey
<*> Gen.bytes signatureLength -- shareSignature <*> Gen.bytes signatureLength -- shareSignature
<*> shareHashChains -- shareHashChain <*> shareHashChains -- shareHashChain
<*> merkleTrees (Range.singleton 1) -- shareBlockHashTree <*> merkleTrees (Range.singleton 1) -- shareBlockHashTree
<*> (LB.fromStrict <$> Gen.bytes (Range.exponential 0 1024)) -- shareData <*> (LB.fromStrict <$> Gen.bytes (Range.exponential 0 1024)) -- shareData
<*> (pure . LB.toStrict . toDER . PrivKeyRSA . RSA.toPrivateKey) keypair -- shareEncryptedPrivateKey <*> (pure . LB.toStrict . toDER . PrivKeyRSA . toPrivateKey) keypair -- shareEncryptedPrivateKey
where where
toDER = encodeASN1 DER . flip toASN1 [] toDER = encodeASN1 DER . flip toASN1 []
...@@ -59,7 +63,7 @@ shares = ...@@ -59,7 +63,7 @@ shares =
challenging, this implementation just knows a few RSA key pairs already and challenging, this implementation just knows a few RSA key pairs already and
will give back one of them. will give back one of them.
-} -}
genRSAKeys :: MonadGen m => m RSA.KeyPair genRSAKeys :: MonadGen m => m KeyPair
genRSAKeys = Gen.element (map rsaKeyPair rsaKeyPairBytes) genRSAKeys = Gen.element (map rsaKeyPair rsaKeyPairBytes)
-- I'm not sure how to do IO in MonadGen so do the IO up front unsafely (but -- 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] ...@@ -68,13 +72,13 @@ rsaKeyPairBytes :: [LB.ByteString]
{-# NOINLINE rsaKeyPairBytes #-} {-# NOINLINE rsaKeyPairBytes #-}
rsaKeyPairBytes = unsafePerformIO $ mapM (\n -> LB.readFile ("test/data/rsa-privkey-" <> show n <> ".der")) [0 .. 4 :: Int] 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 rsaKeyPair bs = do
let (Right kp) = do let (Right kp) = do
asn1s <- first show (decodeASN1 DER bs) asn1s <- first show (decodeASN1 DER bs)
(r, _) <- fromASN1 asn1s (r, _) <- fromASN1 asn1s
case r of case r of
PrivKeyRSA pk -> pure $ RSA.KeyPair pk PrivKeyRSA pk -> pure $ KeyPair pk
_ -> error "Expected RSA Private Key" _ -> error "Expected RSA Private Key"
kp kp
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment