1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
{- Copyright 2017 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE DeriveGeneric #-}
module Log where
import Types
import Hash
import Memory
import JSON
import SessionID
import DotDir
import Data.Char
import Data.Time.Clock.POSIX
import qualified Data.ByteString.Lazy as L
import System.IO
import System.Directory
import System.FilePath
import Control.Exception
-- | 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 ()
logDir :: IO FilePath
logDir = (</> "log") <$> dotDir
withSessionLogger :: (Maybe FilePath) -> SessionID -> (Logger -> IO a) -> IO a
withSessionLogger subdir sessionid a = bracket setup cleanup go
where
setup = do
basedir <- logDir
let dir = maybe basedir (basedir </>) subdir
createDirectoryIfMissing True dir
return $ sessionLogFile dir sessionid
cleanup logfile = putStrLn $ "** debug-me session was logged to " ++ logfile
go logfile = withFile logfile WriteMode (a . mkLogger)
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
|
