{-# LANGUAGE DeriveGeneric #-} module Log where import Types import Hash import Memory import JSON import Data.Char import Data.Time.Clock.POSIX import qualified Data.ByteString.Lazy as L import System.IO -- | One item in a log of a debug-me session. -- -- Note that the time stamp is included to allow replaying logs, but -- it's not part of the provable session. -- -- Note that changing this in ways that change the JSON serialization -- changes debug-me's log file format. data Log = Log { loggedMessage :: AnyMessage , loggedHash :: Maybe Hash , loggedTimestamp :: Timestamp } deriving (Show, Generic) instance DataSize Log where dataSize l = dataSize (loggedMessage l) + maybe 0 dataSize (loggedHash l) + 2 instance ToJSON Log instance FromJSON Log mkLog :: AnyMessage -> POSIXTime -> Log mkLog m now = Log { loggedMessage = m , loggedHash = case m of User (ActivityMessage a) -> Just (hash a) Developer (ActivityMessage a) -> Just (hash a) User (ControlMessage _) -> Nothing Developer (ControlMessage _) -> Nothing , loggedTimestamp = now } type Timestamp = POSIXTime type Logger = AnyMessage -> IO () withLogger :: FilePath -> (Logger -> IO a) -> IO a withLogger logfile a = withFile logfile WriteMode (a . mkLogger) nullLogger :: Logger nullLogger _ = return () mkLogger :: Handle -> Logger mkLogger h a = do l <- mkLog a <$> getPOSIXTime writeLogHandle l h writeLogHandle :: Log -> Handle -> IO () writeLogHandle l h = do L.hPut h (encode l) hPutStr h "\n" hFlush h parseLog :: L.ByteString -> [Either String Log] parseLog = map eitherDecode' . filter (not . L.null) . L.split (fromIntegral (ord '\n')) -- | Streams a log without loading it all into memory. -- When lines cannot be parsed, they will be Left. streamLog :: FilePath -> IO [Either String Log] streamLog f = parseLog <$> L.readFile f