diff --git a/src/Tahoe/SDMF.hs b/src/Tahoe/SDMF.hs index fc31ca9dd98230f2a447c2d85a45898f994e180e..3f2cce62d7c113a0a8ee6d806c1fde9cdfca97fb 100644 --- a/src/Tahoe/SDMF.hs +++ b/src/Tahoe/SDMF.hs @@ -11,6 +11,7 @@ import Tahoe.SDMF.Internal.Capability ( SDMF (..), Verifier (..), Writer (..), + dangerRealShow, pCapability, pReader, pVerifier, diff --git a/src/Tahoe/SDMF/Internal/Capability.hs b/src/Tahoe/SDMF/Internal/Capability.hs index 8d42e1c951d8dc8af75bd7fb173252215bc3fe50..f0452237477bb874256c778a850a34ed140864f6 100644 --- a/src/Tahoe/SDMF/Internal/Capability.hs +++ b/src/Tahoe/SDMF/Internal/Capability.hs @@ -7,6 +7,7 @@ import Control.Applicative ((<|>)) import Control.Monad (void) import Crypto.Hash (Digest, SHA256, digestFromByteString) import Data.Binary (decode) +import qualified Data.ByteArray as ByteArray import qualified Data.ByteString as B import qualified Data.ByteString.Base32 as B import qualified Data.ByteString.Lazy as LB @@ -15,10 +16,20 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T import Data.Void (Void) import Data.Word (Word16) -import Tahoe.SDMF.Internal.Keys (Read, StorageIndex (StorageIndex), Write, deriveReadKey, deriveStorageIndex) +import Tahoe.SDMF.Internal.Keys ( + Read (readKeyBytes), + StorageIndex (StorageIndex, unStorageIndex), + Write (writeKeyBytes), + deriveReadKey, + deriveStorageIndex, + readKeyBytes, + shorten, + showBase32, + ) import Text.Megaparsec (ErrorFancy (ErrorFail), Parsec, count, failure, fancyFailure, oneOf) import Text.Megaparsec.Char (char, string) +-- | A verify capability for an SDMF object. data Verifier = Verifier { verifierStorageIndex :: StorageIndex , verifierVerificationKeyHash :: Digest SHA256 @@ -51,7 +62,7 @@ deriveVerifier readKey = Verifier storageIndex where storageIndex = deriveStorageIndex readKey -data SDMF = SDMFVerifier Verifier | SDMFReader Reader | SDMFWriter Writer +data SDMF = SDMFVerifier Verifier | SDMFReader Reader | SDMFWriter Writer deriving (Eq, Show) type Parser = Parsec Void T.Text @@ -136,3 +147,27 @@ pBase32 alpha bits = do -} rfc3548Alphabet :: [Char] rfc3548Alphabet = "abcdefghijklmnopqrstuvwxyz234567" + +-- | Show an SDMF capability, including all secret information. +dangerRealShow :: SDMF -> T.Text +dangerRealShow (SDMFVerifier Verifier{verifierStorageIndex, verifierVerificationKeyHash}) = + T.concat + [ "URI:SSK-Verifier:" + , showBase32 . unStorageIndex $ verifierStorageIndex + , ":" + , showBase32 . ByteArray.convert $ verifierVerificationKeyHash + ] +dangerRealShow (SDMFReader Reader{readerReadKey, readerVerifier}) = + T.concat + [ "URI:SSK-RO:" + , showBase32 . ByteArray.convert . readKeyBytes $ readerReadKey + , ":" + , showBase32 . ByteArray.convert . verifierVerificationKeyHash $ readerVerifier + ] +dangerRealShow (SDMFWriter Writer{writerWriteKey, writerReader}) = + T.concat + [ "URI:SSK:" + , showBase32 . ByteArray.convert . writeKeyBytes $ writerWriteKey + , ":" + , showBase32 . ByteArray.convert . verifierVerificationKeyHash . readerVerifier $ writerReader + ] diff --git a/src/Tahoe/SDMF/Internal/Keys.hs b/src/Tahoe/SDMF/Internal/Keys.hs index 5711b4def2516af8994284e0710e90565bebdb5a..fbe3068211e516a502c7c6f0708ad9130ad2de79 100644 --- a/src/Tahoe/SDMF/Internal/Keys.hs +++ b/src/Tahoe/SDMF/Internal/Keys.hs @@ -61,8 +61,7 @@ instance Show Write where T.unpack $ T.concat [ "<WriteKey " - , T.take 4 . encodeBase32Unpadded . ByteArray.convert $ bs - , "..." + , shorten 4 . showBase32 . ByteArray.convert $ bs , ">" ] @@ -76,8 +75,7 @@ instance Show Read where T.unpack $ T.concat [ "<ReadKey " - , T.take 4 . encodeBase32Unpadded . ByteArray.convert $ bs - , "..." + , shorten 4 . showBase32 . ByteArray.convert $ bs , ">" ] @@ -95,8 +93,7 @@ instance Show StorageIndex where T.unpack $ T.concat [ "<SI " - , T.take 4 . encodeBase32Unpadded . ByteArray.convert $ si - , "..." + , shorten 4 . showBase32 . ByteArray.convert $ si , ">" ] @@ -105,10 +102,19 @@ newtype WriteEnablerMaster = WriteEnablerMaster ByteArray.ScrubbedBytes newtype WriteEnabler = WriteEnabler ByteArray.ScrubbedBytes data Data = Data {unData :: AES128, dataKeyBytes :: ByteArray.ScrubbedBytes} + instance Show Data where - show (Data _ bs) = T.unpack $ T.concat ["<DataKey ", encodeBase32Unpadded (ByteArray.convert bs), ">"] + show (Data _ bs) = + T.unpack $ + T.concat + [ "<DataKey " + , shorten 4 . showBase32 . ByteArray.convert $ bs + , ">" + ] + instance Eq Data where (Data _ left) == (Data _ right) = left == right + instance Binary Data where put = putByteString . ByteArray.convert . dataKeyBytes get = do @@ -121,12 +127,13 @@ newtype SDMF_IV = SDMF_IV (IV AES128) deriving newtype (ByteArray.ByteArrayAccess) instance Show SDMF_IV where - show (SDMF_IV iv) = T.unpack . T.toLower . encodeBase32Unpadded . ByteArray.convert $ iv + show (SDMF_IV iv) = T.unpack . showBase32 . ByteArray.convert $ iv -- | The size of the public/private key pair to generate. keyPairBits :: Int keyPairBits = 2048 +-- | The number of bytes in the block cipher key. keyLength :: Int (KeySizeFixed keyLength) = cipherKeySize (undefined :: AES128) @@ -293,3 +300,6 @@ encryptSignatureKey Write{unWrite} = ctrCombine unWrite nullIV . signatureKeyToB -} shorten :: Int -> T.Text -> T.Text shorten n = (<> "...") . T.take n + +showBase32 :: B.ByteString -> T.Text +showBase32 = T.toLower . encodeBase32Unpadded diff --git a/tahoe-ssk.cabal b/tahoe-ssk.cabal index d7562cc18d12616e20db662e56104c2839b128a3..68fbb5a1214c4eb5f111df540624ce86a0ad69f0 100644 --- a/tahoe-ssk.cabal +++ b/tahoe-ssk.cabal @@ -113,9 +113,6 @@ test-suite tahoe-ssk-test warnings , language - -- Modules included in this executable, other than Main. - -- other-modules: - -- LANGUAGE extensions used by modules in this package. -- other-extensions: diff --git a/test/Generators.hs b/test/Generators.hs index a002c501a4905a9703688d780f7650c84d5a9ff6..993edc5b3d9f3b3c41191be77289888a776794ec 100644 --- a/test/Generators.hs +++ b/test/Generators.hs @@ -1,14 +1,16 @@ module Generators where import Crypto.Cipher.Types (makeIV) -import Crypto.Hash (HashAlgorithm (hashDigestSize)) +import Crypto.Hash (Digest, HashAlgorithm (hashDigestSize), SHA256, digestFromByteString) import Crypto.Hash.Algorithms (SHA256 (SHA256)) import Data.ASN1.BinaryEncoding (DER (DER)) import Data.ASN1.Encoding (ASN1Decoding (decodeASN1), ASN1Encoding (encodeASN1)) import Data.ASN1.Types (ASN1Object (fromASN1, toASN1)) import Data.Bifunctor (Bifunctor (first)) +import qualified Data.Binary as Binary import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB +import Data.Maybe (fromJust) import Data.Word (Word16) import Data.X509 (PrivKey (PrivKeyRSA)) import GHC.IO.Unsafe (unsafePerformIO) @@ -16,7 +18,9 @@ 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 (Reader (..), SDMF (..), Share (..), Verifier (..), Writer (..)) +import Tahoe.SDMF.Internal.Capability (deriveReader) +import Tahoe.SDMF.Internal.Keys (keyLength) import Tahoe.SDMF.Internal.Share (HashChain (HashChain)) import qualified Tahoe.SDMF.Keys as Keys @@ -103,3 +107,42 @@ encodingParameters = do required <- Gen.integral (Range.exponential 1 254) total <- Gen.integral (Range.exponential (required + 1) 255) pure (required, total) + +-- | Build all kinds of SDMF capabilities values. +capabilities :: MonadGen m => m SDMF +capabilities = + Gen.choice + [ SDMFVerifier <$> verifiers + , SDMFReader <$> readers + , SDMFWriter <$> writers + ] + +-- | Build SDMF writer capabilities. +writers :: MonadGen m => m Writer +writers = do + writeKey <- writeKeys + reader <- deriveReader writeKey <$> digests + pure $ Writer writeKey (fromJust reader) + +-- | Build SDMF writer capability keys. +writeKeys :: MonadGen m => m Keys.Write +writeKeys = key + where + writeBytes = Gen.bytes (Range.singleton 16) + key = Binary.decode . LB.fromStrict <$> writeBytes + +-- | Build SDMF reader capabilities. +readers :: MonadGen m => m Reader +readers = writerReader <$> writers + +-- | Build SDMF verifier capabilities. +verifiers :: MonadGen m => m Verifier +verifiers = readerVerifier <$> readers + +-- | Build SDMF storage indexes. +storageIndexes :: MonadGen m => m Keys.StorageIndex +storageIndexes = Keys.StorageIndex <$> Gen.bytes (Range.singleton keyLength) + +-- | Build SHA256 digests. +digests :: MonadGen m => m (Digest SHA256) +digests = fromJust . digestFromByteString <$> Gen.bytes (Range.singleton 32) diff --git a/test/Spec.hs b/test/Spec.hs index 0519fe026e534c2817fa26afad506e15ea542a3e..0b3c1648c4318bd6506d2a27db06733d511bbf6e 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -22,7 +22,7 @@ import Data.ByteString.Base32 (decodeBase32Unpadded, encodeBase32Unpadded) import qualified Data.ByteString.Lazy as LB import Data.Either (rights) import qualified Data.Text as T -import Generators (encodingParameters, genRSAKeys, shareHashChains, shares) +import Generators (capabilities, encodingParameters, genRSAKeys, shareHashChains, shares) import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import System.IO (hSetEncoding, stderr, stdout, utf8) @@ -143,18 +143,29 @@ tests = "write enabler: expected /= derived" expectedWriteEnabler (fmtKey derivedWriteEnabler) - , testCase "known-correct SDMF capabilities can be parsed" $ do + , testCase "known-correct SDMF capability strings round-trip through parse . dangerRealShow" $ do let validWrite = "URI:SSK:vbopclzrkxces6okoqfarapmou:xlwog3jxbgsuaddh3bsofwmyhncv7fanmo7ujhqiy26usx2v2neq" validRead = "URI:SSK-RO:ro7pnpq6duaduuolookwbv5lqy:xlwog3jxbgsuaddh3bsofwmyhncv7fanmo7ujhqiy26usx2v2neq" validVerify = "URI:SSK-Verifier:gz4s2zkkqy2geblvv77atyoppi:xlwog3jxbgsuaddh3bsofwmyhncv7fanmo7ujhqiy26usx2v2neq" parsed = rights $ parse Tahoe.SDMF.pCapability "<test>" <$> [validWrite, validRead, validVerify] + serialized = Tahoe.SDMF.dangerRealShow <$> parsed assertEqual "parsing failed" 3 (length parsed) + assertEqual "original /= serialized" [validWrite, validRead, validVerify] serialized + let [Tahoe.SDMF.SDMFWriter writeCap, Tahoe.SDMF.SDMFReader readCap, Tahoe.SDMF.SDMFVerifier verifyCap] = parsed + derivedReader = Tahoe.SDMF.writerReader writeCap + derivedVerifier = Tahoe.SDMF.readerVerifier readCap - assertEqual "derived reader /= parsed reader" (Tahoe.SDMF.writerReader writeCap) readCap - assertEqual "derived verifier /= parsed verifier" (Tahoe.SDMF.readerVerifier readCap) verifyCap + assertEqual "derived reader /= parsed reader" derivedReader readCap + assertEqual "serialized derived reader /= original" (Tahoe.SDMF.dangerRealShow . Tahoe.SDMF.SDMFReader $ derivedReader) validRead + assertEqual "derived verifier /= parsed verifier" derivedVerifier verifyCap + assertEqual "serialized derived verifier /= original" (Tahoe.SDMF.dangerRealShow . Tahoe.SDMF.SDMFVerifier $ derivedVerifier) validVerify + , testProperty "SDMF capabilities round-trip through dangerRealShow . parse pCapability" $ + property $ do + cap <- forAll capabilities + tripping cap Tahoe.SDMF.dangerRealShow (parse Tahoe.SDMF.pCapability "<text>") , testProperty "Share round-trips through bytes" $ property $ do share <- forAll shares