From f19a13f982368bd45eea86249f58e593bf2f228f Mon Sep 17 00:00:00 2001
From: Jean-Paul Calderone <exarkun@twistedmatrix.com>
Date: Sun, 21 May 2023 13:14:39 -0400
Subject: [PATCH] doodles
---
src/Tahoe/Directory/Internal/Parsing.hs | 16 +++++++++++++++-
src/Tahoe/Directory/Internal/Types.hs | 8 ++++----
test/Spec.hs | 11 +++++++++++
3 files changed, 30 insertions(+), 5 deletions(-)
diff --git a/src/Tahoe/Directory/Internal/Parsing.hs b/src/Tahoe/Directory/Internal/Parsing.hs
index 8b81065..889c22e 100644
--- a/src/Tahoe/Directory/Internal/Parsing.hs
+++ b/src/Tahoe/Directory/Internal/Parsing.hs
@@ -1,3 +1,6 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FunctionalDependencies #-}
+
-- | Parsing and serialization for directories and their entries.
module Tahoe.Directory.Internal.Parsing where
@@ -13,12 +16,15 @@ 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 :: B.ByteString -> Either ParseError Directory
parse = Text.Megaparsec.parse pDirectory "Directory"
-- | The parser type we will parse in.
type Parser = Parsec Void B.ByteString
+-- | The type for parse errors.
+type ParseError = ParseErrorBundle B.ByteString Void
+
-- XXX This doesn't do bounds checking.
-- | Parse the base ten representation of a natural number.
@@ -85,3 +91,11 @@ netstring xs =
, xs
, ","
]
+
+class ReadCapability c s m | c -> s where
+ read :: c -> [s] -> m B.ByteString
+
+data CapabilityParser = forall c. CapabilityParser (Parser c)
+
+parserWithCapabilities :: ReadCapability c s m => [Parser c] -> Parser (Directory c s (m a))
+parserWithCapabilities parsers = undefined
diff --git a/src/Tahoe/Directory/Internal/Types.hs b/src/Tahoe/Directory/Internal/Types.hs
index 8a4c723..ff4b7c6 100644
--- a/src/Tahoe/Directory/Internal/Types.hs
+++ b/src/Tahoe/Directory/Internal/Types.hs
@@ -4,17 +4,17 @@ import qualified Data.ByteString as B
import qualified Data.Text as T
-- | A collection of references to other objects.
-newtype Directory = Directory
- { directoryChildren :: [Entry]
+newtype Directory c s m = Directory
+ { directoryChildren :: [Entry c s m]
}
deriving (Eq, Show)
-- | A reference to an object of any kind.
-data Entry = Entry
+data Entry c s m = 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
+ entryReader :: c
, -- | An encrypted capability for performing writes to this entry. XXX
-- Document the encryption scheme.
entryEncryptedWriter :: B.ByteString
diff --git a/test/Spec.hs b/test/Spec.hs
index ca23fb8..cb4f983 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -9,6 +9,16 @@ import Test.Tasty (TestTree, defaultMain, testGroup)
import Test.Tasty.HUnit (assertEqual, testCase)
import Test.Tasty.Hedgehog (testProperty)
+data CapabilityType c = Verify (Parser c) | Read (Parser c) | Write (Parser c)
+
+chk :: [CapabilityType]
+chk = [Verify CHK.pVerifier, Read CHK.pReader]
+
+sdmf :: [CapabilityType]
+sdmf = [Verify SDMF.pVerifier, Read SDMF.pReader, Write SDMF.pWriter]
+
+capParsers = chk <> sdmf
+
tests :: TestTree
tests =
testGroup
@@ -16,6 +26,7 @@ tests =
[ testCase "well-known serialized directory round-trips through parse . serialize" $ do
original <- B.readFile "test/example.dir"
let parsed = Directory.parse original
+ parsed' = Directory.parseWithCapabilities capParsers original
serialized = Directory.serialize <$> parsed
assertEqual "original /= serialized" (Right original) serialized
--
GitLab