doodles

src/Tahoe/Directory/Internal/Parsing.hs

+{-# 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

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

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