content: {-# LANGUAGE NumericUnderscores #-}
  {-# LANGUAGE TypeApplications #-}
  module GitHUD.Daemon.Runner (
      runDaemon
      ) where
  
  import Control.Concurrent (forkIO, threadDelay)
  import Control.Concurrent.MVar (MVar, readMVar, newMVar, swapMVar)
  import qualified Control.Exception as E
  import Control.Monad (when, forever, void, unless)
  import qualified Data.ByteString.UTF8 as BSU
  import Data.Maybe (fromMaybe)
  import System.Directory (removeFile)
  import System.Exit (exitFailure)
  import System.Posix.Daemon (brutalKill, isRunning, runDetached, Redirection(DevNull, ToFile))
  import System.Posix.Files (fileExist)
  
  import GitHUD.Config.Types
  import GitHUD.Daemon.Network
  import GitHUD.Debug
  import GitHUD.Git.Command
  
  runDaemon :: Config
            -> Maybe String
            -> IO ()
  runDaemon = tryRunDaemon 5
  
  tryRunDaemon :: Int
               -> Config
               -> Maybe String
               -> IO ()
  tryRunDaemon attempt config mArg = do
    let pathToPoll = (fromMaybe "/" mArg)
    -- If there are exception trying to access the pid file or the socket,
    -- we just kill the process and start again
    success <- E.try @E.SomeException $ do
      ensureDaemonRunning config socketFile pathToPoll
      sendOnSocket socketFile pathToPoll
    restartIfNeeded attempt success
    where
      socketFile = confGithuddSocketFilePath config
      pidFilePath = confGithuddPidFilePath config
      restartIfNeeded 0 _ = void exitFailure
      restartIfNeeded _ (Right _) = return ()
      restartIfNeeded attempt (Left e) = do
        debugOnStderr $ show e
        debugOnStderr "Error on client. Restarting daemon"
        E.try @E.SomeException (brutalKill pidFilePath)   -- ignore possible errors
        threadDelay 100_000
        pidFileExists <- fileExist pidFilePath
        when pidFileExists (removeFile pidFilePath)
        tryRunDaemon (attempt - 1) config mArg
  
  ensureDaemonRunning :: Config
                      -> FilePath
                      -> FilePath
                      -> IO ()
  ensureDaemonRunning config socketPath pathToPoll = do
    running <- isRunning pidFilePath
    unless running $ do
      removeLogFile stdoutFile
      runDetached (Just pidFilePath) stdoutFile (daemon delaySec pathToPoll socketPath)
      threadDelay 100_000     -- Give the daemon some time to start
    where
      stdoutFile = confGithuddLogFilePath config
      pidFilePath = confGithuddPidFilePath config
      delaySec = confGithuddSleepSeconds config
  
  removeLogFile :: Redirection
                -> IO ()
  removeLogFile DevNull = return ()
  removeLogFile (ToFile file) = do
      debugFileExists <- fileExist file
      when debugFileExists (removeFile file)
  
  daemon :: Int
         -> FilePath
         -> FilePath
         -> IO ()
  daemon delaySec path socket = do
    pathToPoll <- newMVar path
    forkIO $ socketServer socket pathToPoll
    forever $ fetcher delaySec pathToPoll
  
  socketServer :: FilePath
               -> MVar String
               -> IO ()
  socketServer socketPath mvar = do
    success <- E.try @E.SomeException (receiveOnSocket socketPath withMessage)
    restartIfNeeded success
      where
        withMessage = swapMVar mvar
        restartIfNeeded (Right _) = return ()
        restartIfNeeded (Left e) = do
          debug "Error on server. Restarting socket"
          debug $ show e
          threadDelay 100_000
          socketServer socketPath mvar
  
  fetcher :: Int
          -> MVar String
          -> IO ()
  fetcher delaySec mvar = do
    path <- readMVar mvar
    gitCmdFetch path
    threadDelay $ delaySec * 1_000_000
    return ()
  