Parse and serialize one known-correct example from Tahoe-LAFS

At least somewhat.  We get all the fields out but we don't really interpret
most of them yet.

src/Tahoe/Directory.hs

-module Tahoe.Directory where
+module Tahoe.Directory (
+    module Tahoe.Directory.Internal.Parsing,
+) where
+
+import Tahoe.Directory.Internal.Parsing (parse, serialize)

src/Tahoe/Directory/Internal/Parsing.hs

+-- | 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 Text.Megaparsec (MonadParsec (eof, label, takeP), ParseErrorBundle, Parsec, many, parse)
+import Text.Megaparsec.Byte (string)
+import Text.Megaparsec.Byte.Lexer (decimal)
+
+-- | A collection of references to other objects.
+newtype Directory = Directory
+    { directoryChildren :: [Entry]
+    }
+    deriving (Eq)
+
+-- | A reference to an object of any kind.
+data Entry = Entry
+    { -- | The name of this entry in its containing directory.
+      entryName :: T.Text -- XXX What if decoding fails?
+    , -- | A capability for reading the contents of this entry.
+      entryReader :: B.ByteString -- XXX Structured cap instead
+    , -- | 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.
+      entryMetadata :: B.ByteString -- XXX How to represent this mixed type collection?
+    }
+    deriving (Eq)
+
+-- | 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
+        , ","
+        ]

tahoe-directory.cabal

@@ -88,9 +88,15 @@ library
   import:          warnings
   import:          language
   hs-source-dirs:  src
-  exposed-modules: Tahoe.Directory
-  build-depends:   base >=4 && <5.0
+  exposed-modules:
+    Tahoe.Directory
+    Tahoe.Directory.Internal.Parsing
+
   build-depends:
+    , base        >=4 && <5.0
+    , bytestring
+    , megaparsec
+    , text
 
 test-suite tahoe-directory-test
   -- Import common warning flags.
@@ -120,6 +126,7 @@ test-suite tahoe-directory-test
   -- Test dependencies.
   build-depends:
     , base
+    , bytestring
     , tahoe-directory
     , tasty
     , tasty-hunit

test/Spec.hs

 module Spec where
 
+import qualified Data.ByteString as B
 import System.IO (hSetEncoding, stderr, stdout, utf8)
+import qualified Tahoe.Directory as Directory
 import Test.Tasty (TestTree, defaultMain, testGroup)
+import Test.Tasty.HUnit (assertEqual, testCase)
 
 tests :: TestTree
-tests = testGroup "Directory" []
+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
+        ]
 
 main :: IO ()
 main = do