{- 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