diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,8 @@ +# Revision history for tahoe-directory + +## 0.1.0.0 -- 2023-08-17 + +* First version. Released on an unsuspecting world. +* Support for parsing and serializing CHK and SDMF directory capability strings. +* Support for parsing and serializing directories + (lists of name, capability, metadata tuples). diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,32 @@ +Copyright 2023 +Jean-Paul Calderone +Shae Erisson + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Jean-Paul Calderone nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,28 @@ +# tahoe-directory + +## What is it? + +Tahoe-Directory is a Haskell implementation of the [Tahoe-LAFS](https://tahoe-lafs.org/) filesystem directory-like abstraction for managing collections of data objects. +This includes a parser and serializer for the persisted form of these collections. +It also includes Haskell-friendly abstract representations of and operations on the data. +It aims for bit-for-bit compatibility with the original Python implementation. + +It will not include an implementation of any network protocol for transferring directories. +However, its APIs are intended to be easy to integrate with such an implementation. + +### What is the current state? + +* Verify and read CHK directory capability strings can be parsed and serialized. +* Verify, read, and write SDMF directory capability strings can be parsed and serialized. +* Directories themselves can be parsed and serialized. + * However, capability strings and metadata in directory entries are left as byte strings. + +## Why does it exist? + +A Haskell implementation can be used in places the original Python implementation cannot be +(for example, runtime environments where it is difficult to have a Python interpreter). +Additionally, +with the benefit of the experience gained from creating and maintaining the Python implementation, +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. diff --git a/src/Tahoe/Directory.hs b/src/Tahoe/Directory.hs new file mode 100644 --- /dev/null +++ b/src/Tahoe/Directory.hs @@ -0,0 +1,16 @@ +module Tahoe.Directory ( + module Tahoe.Directory.Internal.Parsing, + module Tahoe.Directory.Internal.Types, + module Tahoe.Directory.Internal.Capability, +) where + +import Tahoe.Directory.Internal.Capability ( + DirectoryCapability (..), + pReadCHK, + pReadSDMF, + pVerifyCHK, + pVerifySDMF, + pWriteSDMF, + ) +import Tahoe.Directory.Internal.Parsing (parse, serialize) +import Tahoe.Directory.Internal.Types (Directory (..), Entry (..)) diff --git a/src/Tahoe/Directory/Internal/Capability.hs b/src/Tahoe/Directory/Internal/Capability.hs new file mode 100644 --- /dev/null +++ b/src/Tahoe/Directory/Internal/Capability.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE FlexibleInstances #-} + +module Tahoe.Directory.Internal.Capability where + +import qualified Data.Text as T +import Data.Void (Void) +import qualified Tahoe.CHK.Capability as CHK +import Tahoe.Capability (ConfidentialShowable (..)) +import qualified Tahoe.SDMF as SDMF + +import Text.Megaparsec (Parsec, getInput, setInput) + +{- | A wrapper around some other capability type which signals that the + plaintext is an encoded list of files. +-} +newtype DirectoryCapability a = DirectoryCapability a deriving (Eq, Ord, Show) + +instance ConfidentialShowable (DirectoryCapability CHK.Verifier) where + confidentiallyShow (DirectoryCapability a) = + T.replace "URI:CHK-Verifier:" "URI:DIR2-CHK-Verifier:" (CHK.dangerRealShow (CHK.CHKVerifier a)) + +instance ConfidentialShowable (DirectoryCapability CHK.Reader) where + confidentiallyShow (DirectoryCapability a) = + T.replace "URI:CHK:" "URI:DIR2-CHK:" (CHK.dangerRealShow (CHK.CHKReader a)) + +instance ConfidentialShowable (DirectoryCapability SDMF.Verifier) where + confidentiallyShow (DirectoryCapability a) = + T.replace "URI:SSK-Verifier:" "URI:DIR2-Verifier:" (confidentiallyShow a) + +instance ConfidentialShowable (DirectoryCapability SDMF.Reader) where + confidentiallyShow (DirectoryCapability a) = + T.replace "URI:SSK-RO:" "URI:DIR2-RO:" (confidentiallyShow a) + +instance ConfidentialShowable (DirectoryCapability SDMF.Writer) where + confidentiallyShow (DirectoryCapability a) = + T.replace "URI:SSK:" "URI:DIR2:" (confidentiallyShow a) + +type Parser = Parsec Void T.Text + +{- | Parse a CHK directory verifier capability. + + The implementation is a cheesy hack that does string substitution on the + input before applying the original CHK verifier parser. +-} +pVerifyCHK :: Parser (DirectoryCapability CHK.Verifier) +pVerifyCHK = do + s <- getInput + setInput $ T.replace "URI:DIR2-CHK-Verifier:" "URI:CHK-Verifier:" s + DirectoryCapability <$> CHK.pVerifier + +{- | Parse a CHK directory reader capability. + + The implementation is a cheesy hack that does string substitution on the + input before applying the original CHK reader parser. +-} +pReadCHK :: Parser (DirectoryCapability CHK.Reader) +pReadCHK = do + s <- getInput + setInput $ T.replace "URI:DIR2-CHK:" "URI:CHK:" s + DirectoryCapability <$> CHK.pReader + +{- | Parse an SDMF directory verifier capability. As is the case for the other + directory capability parsers, the implementation is cheesy. +-} +pVerifySDMF :: Parser (DirectoryCapability SDMF.Verifier) +pVerifySDMF = do + s <- getInput + setInput $ T.replace "URI:DIR2-Verifier:" "URI:SSK-Verifier:" s + DirectoryCapability <$> SDMF.pVerifier + +{- | Parse an SDMF directory reader capability. As is the case for the other + directory capability parsers, the implementation is cheesy. +-} +pReadSDMF :: Parser (DirectoryCapability SDMF.Reader) +pReadSDMF = do + s <- getInput + setInput $ T.replace "URI:DIR2-RO:" "URI:SSK-RO:" s + DirectoryCapability <$> SDMF.pReader + +{- | Parse an SDMF directory writer capability. As is the case for the other + directory capability parsers, the implementation is cheesy. +-} +pWriteSDMF :: Parser (DirectoryCapability SDMF.Writer) +pWriteSDMF = do + s <- getInput + setInput $ T.replace "URI:DIR2:" "URI:SSK:" s + DirectoryCapability <$> SDMF.pWriter diff --git a/src/Tahoe/Directory/Internal/Parsing.hs b/src/Tahoe/Directory/Internal/Parsing.hs new file mode 100644 --- /dev/null +++ b/src/Tahoe/Directory/Internal/Parsing.hs @@ -0,0 +1,87 @@ +-- | Parsing and serialization for directories and their entries. +module Tahoe.Directory.Internal.Parsing where + +import Control.Monad (void) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as C8 +import qualified Data.Text as T +import Data.Text.Encoding (decodeUtf8', encodeUtf8) +import Data.Void (Void) +import Tahoe.Directory.Internal.Types (Directory (..), Entry (..)) +import Text.Megaparsec (MonadParsec (eof, label, takeP), ParseErrorBundle, Parsec, many, parse) +import Text.Megaparsec.Byte (string) +import Text.Megaparsec.Byte.Lexer (decimal) + +-- | Parse the serialized form of a directory into a Directory. +parse :: B.ByteString -> Either (ParseErrorBundle B.ByteString Void) Directory +parse = Text.Megaparsec.parse pDirectory "Directory" + +-- | The parser type we will parse in. +type Parser = Parsec Void B.ByteString + +-- XXX This doesn't do bounds checking. + +-- | Parse the base ten representation of a natural number. +natural :: Integral i => Parser i +natural = decimal + +{- | Parse a netstring-encoded value, applying a sub-parser to the encoded + string. +-} +pNetstring :: + -- | A function that takes the length of the string encoded in the + -- netstring and returns a parser for the value the encoded string + -- represents. + (Int -> Parser a) -> + -- | A parser for the value. + Parser a +pNetstring pInner = do + len <- natural + void $ string ":" + result <- pInner len + void $ string "," + pure result + +pDirectory :: Parser Directory +pDirectory = Directory <$> (many pEntry <* eof) + +pEntry :: Parser Entry +pEntry = + label "entry" $ + pNetstring $ \_ -> + Entry + <$> label "name" (pNetstring pUTF8) + <*> label "ro_uri" (pNetstring (takeP Nothing)) + <*> label "rw_uri" (pNetstring (takeP Nothing)) + <*> label "metadata" (pNetstring (takeP Nothing)) + +pUTF8 :: Int -> Parser T.Text +pUTF8 n = do + bs <- takeP Nothing n + either (\e -> fail $ "UTF-8 parsing failed: " <> show e) pure (decodeUtf8' bs) + +-- | Serialize a Directory to the canonical bytes representation. +serialize :: Directory -> B.ByteString +serialize Directory{directoryChildren} = B.concat $ serializeEntry <$> directoryChildren + +serializeEntry :: Entry -> B.ByteString +serializeEntry Entry{..} = + -- XXX The name must be NFC normalized apparently, try unicode-transforms + -- library. Perhaps we should enforce normalization in the Entry + -- constructor? + netstring . B.concat $ + [ netstring . encodeUtf8 $ entryName + , netstring entryReader + , netstring entryEncryptedWriter + , netstring entryMetadata + ] + +-- | Encode a bytestring as a netstring. +netstring :: B.ByteString -> B.ByteString +netstring xs = + B.concat + [ C8.pack . show . B.length $ xs + , ":" + , xs + , "," + ] diff --git a/src/Tahoe/Directory/Internal/Types.hs b/src/Tahoe/Directory/Internal/Types.hs new file mode 100644 --- /dev/null +++ b/src/Tahoe/Directory/Internal/Types.hs @@ -0,0 +1,24 @@ +module Tahoe.Directory.Internal.Types where + +import qualified Data.ByteString as B +import qualified Data.Text as T + +-- | A collection of references to other objects. +newtype Directory = Directory + { directoryChildren :: [Entry] + } + deriving (Eq, Show) + +-- | A reference to an object of any kind. +data Entry = Entry + { -- | The name of this entry in its containing directory. XXX What if UTF-8 decoding fails? + entryName :: T.Text + , -- | A capability for reading the contents of this entry. XXX Structured cap instead + entryReader :: B.ByteString + , -- | An encrypted capability for performing writes to this entry. XXX + -- Document the encryption scheme. + entryEncryptedWriter :: B.ByteString + , -- | Additional metadata about this entry such as last modification time. XXX How to represent this mixed type collection? + entryMetadata :: B.ByteString + } + deriving (Eq, Show) diff --git a/tahoe-directory.cabal b/tahoe-directory.cabal new file mode 100644 --- /dev/null +++ b/tahoe-directory.cabal @@ -0,0 +1,146 @@ +cabal-version: 2.4 + +-- The cabal-version field refers to the version of the .cabal specification, +-- and can be different from the cabal-install (the tool) version and the +-- Cabal (the library) version you are using. As such, the Cabal (the library) +-- version used must be equal or greater than the version stated in this field. +-- Starting from the specification version 2.2, the cabal-version field must be +-- the first thing in the cabal file. + +-- Initial package description 'tahoe-directory' generated by +-- 'cabal init'. For further documentation, see: +-- http://haskell.org/cabal/users-guide/ +-- +-- The name of the package. +name: tahoe-directory + +-- The package version. +-- See the Haskell package versioning policy (PVP) for standards +-- guiding when and how versions should be incremented. +-- https://pvp.haskell.org +-- PVP summary: +-+------- breaking API changes +-- | | +----- non-breaking API additions +-- | | | +--- code changes with no API change +version: 0.1.0.0 + +-- A short (one-line) description of the package. +synopsis: + Tahoe-LAFS directory-like abstraction for collections of data objects. + +-- A longer description of the package. +description: + Tahoe-Directory is an implementation of the Tahoe-LAFS filesystem directory-like abstraction for managing collections of data objects. + This includes a parser and serializer for the persisted form of these collections. + It also includes Haskell-friendly abstract representations of and operations on the data. + It aims for bit-for-bit compatibility with the original Python implementation. + It will not include an implementation of any network protocol for transferring directories. + However, its APIs are intended to be easy to integrate with such an implementation. + +-- URL for the project homepage or repository. +homepage: + https://whetstone.private.storage/PrivateStorage/tahoe-directory + +-- The license under which the package is released. +license: BSD-3-Clause + +-- The file containing the license text. +license-file: LICENSE + +-- The package author(s). +author: Jean-Paul Calderone and others + +-- An email address to which users can send suggestions, bug reports, and patches. +maintainer: exarkun@twistedmatrix.com + +-- A copyright notice. +copyright: 2023 The Authors +category: Cryptography,Library,Parsers,Security +build-type: Simple + +-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README. +extra-doc-files: + CHANGELOG.md + README.md + +-- Extra source files to be distributed with the package, such as examples, or +-- a tutorial module. In our case, test data. +-- extra-source-files: + +common warnings + ghc-options: -Wall + +common language + default-extensions: + DerivingStrategies + GeneralizedNewtypeDeriving + NamedFieldPuns + OverloadedStrings + PackageImports + RecordWildCards + TypeApplications + + default-language: Haskell2010 + +source-repository head + type: git + location: + https://whetstone.private.storage/PrivateStorage/tahoe-directory.git + +library + import: warnings + import: language + hs-source-dirs: src + exposed-modules: + Tahoe.Directory + Tahoe.Directory.Internal.Capability + Tahoe.Directory.Internal.Parsing + Tahoe.Directory.Internal.Types + + build-depends: + , base >=4 && <5.0 + , bytestring >=0.10.8.2 && <0.11 + , megaparsec >=8.0 && <9.3 + , tahoe-capabilities >=0.1 && <0.2 + , tahoe-chk >=0.1 && <0.2 + , tahoe-ssk >=0.2.1.0 && <0.3 + , text >=1.2.3.1 && <1.3 + +test-suite tahoe-directory-test + -- Import common warning flags. + import: warnings + import: language + + -- Base language which the package is written in. + default-language: Haskell2010 + default-extensions: OverloadedStrings + + -- Modules included in this executable, other than Main. + -- other-modules: + + -- LANGUAGE extensions used by modules in this package. + -- other-extensions: + + -- The interface type and version of the test suite. + type: exitcode-stdio-1.0 + + -- Directories containing source files. + hs-source-dirs: test + + -- The entrypoint to the test suite. + main-is: Main.hs + other-modules: + Generators + Spec + + -- Test dependencies. + build-depends: + , base >=4 && <5.0 + , bytestring >=0.10.8.2 && <0.11 + , hedgehog >=1.0.3 && <1.1 + , megaparsec >=8.0 && <9.3 + , tahoe-capabilities >=0.1 && <0.2 + , tahoe-directory + , tasty >=1.2.3 && <1.5 + , tasty-hedgehog >=1.0.0.2 && <1.2 + , tasty-hunit >=0.10.0.2 && <0.11 + , text >=1.2.3.1 && <1.3 diff --git a/test/Generators.hs b/test/Generators.hs new file mode 100644 --- /dev/null +++ b/test/Generators.hs @@ -0,0 +1,26 @@ +module Generators where + +import qualified Data.ByteString as B +import qualified Data.Text as T +import Hedgehog (MonadGen) +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range +import Tahoe.Directory (Directory (..), Entry (..)) + +directories :: MonadGen m => m Directory +directories = Directory <$> Gen.list (Range.exponential 0 100) entries + +entries :: MonadGen m => m Entry +entries = Entry <$> entryNames <*> entryReaders <*> entryEncryptedWriters <*> entryMetadatas + +entryNames :: MonadGen m => m T.Text +entryNames = Gen.text (Range.exponential 1 100) Gen.unicode + +entryReaders :: MonadGen m => m B.ByteString +entryReaders = pure "URI:CHK:blub:blab" + +entryEncryptedWriters :: MonadGen m => m B.ByteString +entryEncryptedWriters = pure "\1\2\3\4\5\6\7\8\9\10" + +entryMetadatas :: MonadGen m => m B.ByteString +entryMetadatas = pure "{stuff: [goes, here]}" diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,3 @@ +module Main (main) where + +import Spec (main) diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,68 @@ +module Spec where + +import qualified Data.ByteString as B +import Generators (directories) +import Hedgehog (forAll, property, tripping) +import System.IO (hSetEncoding, stderr, stdout, utf8) +import Tahoe.Capability (confidentiallyShow) +import qualified Tahoe.Directory as Directory +import Test.Tasty (TestTree, defaultMain, testGroup) +import Test.Tasty.HUnit (assertEqual, testCase) +import Test.Tasty.Hedgehog (testProperty) +import Text.Megaparsec (parse) + +tests :: TestTree +tests = + testGroup + "Directory" + [ testCase "well-known serialized directory round-trips through parse . serialize" $ do + original <- B.readFile "test/example.dir" + let parsed = Directory.parse original + serialized = Directory.serialize <$> parsed + + assertEqual "original /= serialized" (Right original) serialized + , testProperty "Directory round-trips through serialize . parse" $ + property $ do + directory <- forAll directories + tripping directory Directory.serialize Directory.parse + , testCase "well-known directory CHK read capability round-trips through parseCapability . confidentiallyShow" $ do + -- ❯ curl -XPOST http://localhost:3456/uri?t=mkdir-immutable --data '{"foo": ["filenode", {}], "bar": ["filenode", {}], "baz": ["filenode", {}]}' + let original = "URI:DIR2-CHK:46y5edbbxojwg5ez4lelafu5jy:fbgn7ijfxarstdxmr363et4de522n7eslnqxavymfqkoax4lc65q:3:10:63" + let parsed = parse Directory.pReadCHK "" original + let serialized = confidentiallyShow <$> parsed + assertEqual "original /= serialized" (Right original) serialized + , testCase "well-known directory CHK verify capability round-trips through parseCapability . confidentiallyShow" $ do + -- `tahoe ls --json ` to produce verifier + let original = "URI:DIR2-CHK-Verifier:ni4pjcqflws33ikhifsxqwvmya:fbgn7ijfxarstdxmr363et4de522n7eslnqxavymfqkoax4lc65q:3:10:63" + let parsed = parse Directory.pVerifyCHK "" original + let serialized = confidentiallyShow <$> parsed + assertEqual "original /= serialized" (Right original) serialized + , testCase "well-known directory SDMF write capability round-trips through parseCapability . confidentiallyShow" $ do + -- `tahoe mkdir` to produce directory writer + let original = "URI:DIR2:ez2k3glrx46svivnnrmh77uieq:c43fbv5274wmphdykpmpweq4moat5co53fvf42lg2z2xekkghm6a" + parsed = parse Directory.pWriteSDMF "" original + serialized = confidentiallyShow <$> parsed + assertEqual "original /= serialized" (Right original) serialized + , testCase "well-known directory SDMF read capability round-trips through parseCapability . confidentiallyShow" $ do + -- `tahoe ls --json ` to produce reader + let original = "URI:DIR2-RO:g3vdy2tlmpejr2tts7n6pyxbnu:c43fbv5274wmphdykpmpweq4moat5co53fvf42lg2z2xekkghm6a" + parsed = parse Directory.pReadSDMF "" original + serialized = confidentiallyShow <$> parsed + assertEqual "original /= serialized" (Right original) serialized + , testCase "well-known directory SDMF verify capability round-trips through parseCapability . confidentiallyShow" $ do + -- `tahoe ls --json ` to produce verifier + let original = "URI:DIR2-Verifier:aofaktmdrgegdvnq3vsxnccc7q:c43fbv5274wmphdykpmpweq4moat5co53fvf42lg2z2xekkghm6a" + parsed = parse Directory.pVerifySDMF "" original + serialized = confidentiallyShow <$> parsed + assertEqual "original /= serialized" (Right original) serialized + ] + +main :: IO () +main = do + -- Hedgehog writes some non-ASCII and the whole test process will die if + -- it can't be encoded. Increase the chances that all of the output can + -- be encoded by forcing the use of UTF-8 (overriding the LANG-based + -- choice normally made). + hSetEncoding stdout utf8 + hSetEncoding stderr utf8 + defaultMain tests