feat(journal): add parsing of journal into ast, improve readability o…

…f test output

src/journal/journal.cabal

@@ -34,6 +34,7 @@ library
     , bytestring
     , directory
     , filepath
+    , parsec
     , stm
 
   build-depends:
@@ -46,6 +47,7 @@ library
     Journal
     Journal.CRC32
     Journal.Internal
+    Journal.Internal.Parse
     Journal.Types
     Journal.Types.AtomicCounter
 
@@ -64,8 +66,8 @@ test-suite test
   build-depends:
     , base
     , bytestring
-    , HUnit
     , directory
+    , HUnit
     , journal
     , QuickCheck
     , quickcheck-instances

src/journal/src/Journal.hs

@@ -148,9 +148,13 @@ readJournal jc = do
       writeCounter (jcBytesConsumed jc) 0
       readJournal jc
     else do
+      putStrLn ("readJournal, tag: " ++ tagString tag)
       assertM (BS.head bs == Valid)
       return bs
-  else return bs
+  else do
+    putStrLn ("readJournal, returning: " ++ show bs ++
+              " (" ++ show (BS.length bs) ++ " bytes)")
+    return bs
 
 ------------------------------------------------------------------------
 
@@ -196,4 +200,3 @@ dumpJournal :: Journal -> IO ()
 dumpJournal jour = do
   dumpFile (jDirectory jour </> aCTIVE_FILE)
   dumpFile (jDirectory jour </> dIRTY_FILE)
-  dumpFile (jDirectory jour </> cLEAN_FILE)

src/journal/src/Journal/Internal.hs

@@ -9,6 +9,7 @@ import Control.Exception (assert)
 import Control.Monad (unless, when)
 import Data.Binary (decode, encode)
 import Data.Bits ((.&.))
+import Data.Maybe (catMaybes)
 import qualified Data.ByteString as BS
 import Data.ByteString.Internal (fromForeignPtr)
 import qualified Data.ByteString.Lazy as LBS
@@ -25,6 +26,7 @@ import System.IO.MMap (Mode(ReadWriteEx), mmapFilePtr, munmapFilePtr)
 
 import Journal.Types
 import Journal.Types.AtomicCounter
+import Journal.Internal.Parse
 
 ------------------------------------------------------------------------
 
@@ -35,6 +37,9 @@ hEADER_SIZE :: Int
 hEADER_SIZE = 1 + 1 + 4 -- sizeOf Word8 + sizeOf Word8 + sizeOf Word32
   -- XXX: CRC?
 
+fOOTER_SIZE :: Int
+fOOTER_SIZE = hEADER_SIZE
+
 cURRENT_VERSION :: Word8
 cURRENT_VERSION = 0
 
@@ -58,16 +63,18 @@ aRCHIVE_FILE = "archive"
 claim :: Journal -> Int -> IO Int
 claim jour len = assert (hEADER_SIZE + len <= getMaxByteSize jour) $ do
   offset <- getAndIncrCounter (hEADER_SIZE + len) (jOffset jour)
-  if offset + hEADER_SIZE + len <= getMaxByteSize jour
-  then return offset -- Fits in current file.
+  if offset + hEADER_SIZE + len + fOOTER_SIZE <= getMaxByteSize jour
+  then do
+    putStrLn ("claim, fits in current file, len: " ++ show len)
+    return offset -- Fits in current file.
   else if offset <= getMaxByteSize jour
        then do
          -- First writer that overflowed the file, the second one would have got
          -- an `offset` grather than `getMaxByteSize jour`.
 
+         putStrLn ("claim, first writer to overflow, offset: " ++ show offset)
          ptr <- readJournalPtr jour
-         unless (offset == getMaxByteSize jour) $
-           writePaddingFooter ptr offset (getMaxByteSize jour)
+         writePaddingFooter ptr offset (getMaxByteSize jour)
          rotateFiles jour
          writeCounter (jOffset jour) 0
          return 0
@@ -220,11 +227,14 @@ waitForHeader :: Ptr Word8 -> Int -> IO Int
 waitForHeader ptr offset = go
   where
     go = do
-      -- putStrLn ("waitForHeader: looking for header at offset: " ++ show offset)
+      putStrLn ("waitForHeader: looking for header at offset: " ++ show offset)
       hdr <- readHeader (ptr `plusPtr` offset)
       if jhTag hdr == Empty
       then threadDelay 1000000 >> go -- XXX: wait strategy via options?
-      else return (fromIntegral (jhLength hdr))
+      else do
+        assertM ((jhTag hdr == Valid || jhTag hdr == Padding) &&
+                 0 < jhLength hdr) -- XXX: jhLength hdr <= maxByteSize)
+        return (fromIntegral (jhLength hdr))
 
 mapHeadersUntil :: Word8 -> (JournalHeader -> JournalHeader) -> Ptr Word8 -> Int -> IO ()
 mapHeadersUntil mask f ptr limit = go 0
@@ -244,15 +254,26 @@ mapHeadersUntil mask f ptr limit = go 0
 
 data Inconsistency
   = ActiveFileSizeMismatch Int Int
+  | ActiveFileParseError String
   | PartialReceived
   | PartialRotation
+  deriving Show
+
+inconsistencyString :: Inconsistency -> String
+inconsistencyString = show
+
+inconsistenciesString :: [Inconsistency] -> String
+inconsistenciesString = show . map inconsistencyString
 
 checkForInconsistencies :: Journal -> IO [Inconsistency]
-checkForInconsistencies jour = do
-  bs <- BS.readFile (jDirectory jour </> aCTIVE_FILE)
-  if BS.length bs /= jMaxByteSize jour
-  then return [ActiveFileSizeMismatch (jMaxByteSize jour) (BS.length bs)]
-  else return []
+checkForInconsistencies jour = catMaybes <$> sequence
+  [ do bs <- BS.readFile (jDirectory jour </> aCTIVE_FILE)
+       if BS.length bs /= jMaxByteSize jour
+       then return (Just (ActiveFileSizeMismatch (jMaxByteSize jour) (BS.length bs)))
+       else return Nothing
+  , do eFileAst <- parseFileAST (jDirectory jour </> aCTIVE_FILE)
+       return (either (Just . ActiveFileParseError . show) (const Nothing) eFileAst)
+  ]
 
 fixInconsistency :: Inconsistency -> Journal -> IO ()
 fixInconsistency = undefined

src/journal/src/Journal/Internal/Parse.hs

@@ -0,0 +1,79 @@
+module Journal.Internal.Parse where
+
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Char8 as BSChar8
+import Data.ByteString.Internal (c2w, w2c)
+import Data.Char (digitToInt)
+import Data.List (foldl')
+import Data.Word (Word32, Word8)
+import Text.Parsec
+import Text.Parsec.ByteString (Parser, parseFromFile)
+
+------------------------------------------------------------------------
+
+data JournalAST = JournalAST
+  { jaActiveFile :: FileAST
+  }
+
+data FileAST = FileAST
+  { faContent :: [EntryAST]
+  , faFooter  :: Maybe FooterAST
+  }
+  deriving Show
+
+data EntryAST = EntryAST HeaderAST BodyAST
+  deriving Show
+
+data HeaderAST = HeaderAST
+  { haTag     :: Word8
+  , haVersion :: Word8
+  , haLength  :: Word32
+  }
+  deriving Show
+
+newtype BodyAST = BodyAST ByteString
+  deriving Show
+
+data FooterAST = FooterAST HeaderAST PaddingAST
+  deriving Show
+
+newtype PaddingAST = PaddingAST ByteString
+  deriving Show
+
+------------------------------------------------------------------------
+
+parseFileAST :: FilePath -> IO (Either ParseError FileAST)
+parseFileAST fp = parseFromFile fileASTP fp
+
+fileASTP :: Parser FileAST
+fileASTP = FileAST <$> many1 entryP <*> optionMaybe footerP <?> "fileASTP"
+
+entryP :: Parser EntryAST
+entryP = EntryAST <$> headerP <*> bodyP <?> "entryP"
+
+headerP :: Parser HeaderAST
+headerP = HeaderAST <$> tagP <*> versionP <*> lengthP <?> "headerP"
+
+tagP :: Parser Word8
+tagP = c2w <$> (char (w2c (fromIntegral 0))
+           <|>  char (w2c (fromIntegral 1))
+           <|>  char (w2c (fromIntegral 2))
+           <|>  char (w2c (fromIntegral 4))
+           <?> "tagP")
+
+versionP :: Parser Word8
+versionP = c2w <$> anyToken <?> "versionP"
+
+lengthP :: Parser Word32
+lengthP = fromIntegral . foldl' (\a i -> a * 10 + digitToInt i) 0 <$>
+  count 4 anyToken <?> "lengthP"
+
+bodyP :: Parser BodyAST
+bodyP = BodyAST . BSChar8.pack <$> many1 anyToken <?> "bodyP"
+
+footerP :: Parser FooterAST
+footerP = FooterAST <$> headerP <*> paddingP <?> "footerP"
+
+paddingP :: Parser PaddingAST
+paddingP = PaddingAST . BSChar8.pack <$>
+  (many1 (char '\NUL') <|> eof *> pure "") <?> "paddingP"