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 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
        , ","
        ]