packages feed

tahoe-directory (empty) → 0.1.0.0

raw patch · 11 files changed

+525/−0 lines, 11 filesdep +basedep +bytestringdep +hedgehog

Dependencies added: base, bytestring, hedgehog, megaparsec, tahoe-capabilities, tahoe-chk, tahoe-directory, tahoe-ssk, tasty, tasty-hedgehog, tasty-hunit, text

Files

+ CHANGELOG.md view
@@ -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).
+ LICENSE view
@@ -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.
+ README.md view
@@ -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.
+ src/Tahoe/Directory.hs view
@@ -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 (..))
+ src/Tahoe/Directory/Internal/Capability.hs view
@@ -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
+ src/Tahoe/Directory/Internal/Parsing.hs view
@@ -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+        , ","+        ]
+ src/Tahoe/Directory/Internal/Types.hs view
@@ -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)
+ tahoe-directory.cabal view
@@ -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
+ test/Generators.hs view
@@ -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]}"
+ test/Main.hs view
@@ -0,0 +1,3 @@+module Main (main) where++import Spec (main)
+ test/Spec.hs view
@@ -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 <read cap>` 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 <write cap>` 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 <write cap>` 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