<commit_before>-- Copyright 2016 <NAME>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License version 3. See
-- the licence file in the root of the repository.

{-# LANGUAGE OverloadedStrings #-}

-- This file contains sort-of end-to-end tests for the event loop. Incoming
-- messages are faked (supplied by the test code, as oppsed to received via the
-- web server), but the event loop does run with actual IO with a test
-- repository. The purpose of these tests is not to test the *logic* of the
-- event loop (there are unit tests for that), but to test that the interaction
-- with a real Git process works as expected.

module EventLoopSpec (eventLoopSpec) where

import Control.Concurrent.Async (async, wait)
import Control.Monad (forM_, void)
import Control.Monad.Logger (runNoLoggingT)
import Data.Maybe (isJust)
import Data.Text (Text)
import Data.UUID.V4 (nextRandom)
import Prelude hiding (appendFile, writeFile)
import System.Directory (createDirectoryIfMissing, getTemporaryDirectory, removeDirectoryRecursive)
import System.FilePath ((</>))
import Test.Hspec

import Configuration (Configuration (..))
import Git (Sha (..))
import Project (BuildStatus (..), IntegrationStatus (..), ProjectState, PullRequestId (..))

import qualified Configuration as Config
import qualified Data.Text as Text
import qualified EventLoop
import qualified Git
import qualified Logic
import qualified Prelude
import qualified Project

-- Invokes Git with the given arguments, returns its stdout. Crashes if invoking
-- Git failed. Discards all logging.
callGit :: [String] -> IO Text
callGit args = fmap (either undefined id) $ runNoLoggingT $ Git.callGit args

-- Populates the repository with the following history:
--
--                 .-- c5 -- c6  <-- intro
--                /
--   c0 -- c1 -- c2 -- c3 -- c4  <-- ahead
--                \     ^----------- master
--                 `-- c3'       <-- alternative
--
populateRepository :: FilePath -> IO [Sha]
populateRepository dir =
  let writeFile fname msg  = Prelude.writeFile (dir </> fname) (msg ++ "\n")
      appendFile fname msg = Prelude.appendFile (dir </> fname) (msg ++ "\n")
      git args             = callGit $ ["-C", dir] ++ args
      gitInit              = void $ git ["init"]
      gitConfig key value  = void $ git ["config", key, value]
      gitAdd file          = void $ git ["add", file]
      gitBranch name sha   = void $ git ["checkout", "-b", name, show sha]
      gitCheckout brname   = void $ git ["checkout", brname]
      getHeadSha           = fmap (Sha . Text.strip) $ git ["rev-parse", "@"]
      -- Commits with the given message and returns the sha of the new commit.
      gitCommit message    = git ["commit", "-m", message] >> getHeadSha
  in  do
      gitInit
      gitConfig "user.email" "<EMAIL>"
      gitConfig "user.name" "Testbot"

      writeFile "tyrell.txt" "I'm surprised you didn't come here sooner."
      gitAdd "tyrell.txt"
      c0 <- gitCommit "c0: Initial commit"

      writeFile "roy.txt" "It's not an easy thing to meet your maker."
      gitAdd "roy.txt"
      c1 <- gitCommit "c1: Add new quote"

      appendFile "tyrell.txt" "What can he do for you?"
      gitAdd "tyrell.txt"
      c2 <- gitCommit "c2: Add new Tyrell quote"

      appendFile "roy.txt" "Can the maker repair what he makes?"
      gitAdd "roy.txt"
      c3 <- gitCommit "c3: Add new Roy quote"

      -- Create a branch "ahead", one commit ahead of master.
      gitBranch "ahead" c3
      appendFile "tyrell.txt" "Would you like to be modified?"
      gitAdd "tyrell.txt"
      c4 <- gitCommit "c4: Add Tyrell  response"
      gitCheckout "master"

      -- Now make an alternative commit that conflicts with c3.
      gitBranch "alternative" c2
      appendFile "roy.txt" "You could make me a sandwich."
      gitAdd "roy.txt"
      c3' <- gitCommit "c3': Write alternative ending"

      -- Also add a commit that does not conflict.
      gitBranch "intro" c2
      writeFile "leon.txt" "What do you mean, I'm not helping?"
      gitAdd "leon.txt"
      c5 <- gitCommit "c5: Add more characters"

      writeFile "holden.txt" "I mean, you're not helping! Why is that, Leon?"
      gitAdd "holden.txt"
      c6 <- gitCommit "c6: Add response"

      return [c0, c1, c2, c3, c3', c4, c5, c6]

-- Sets up two repositories: one with a few commits in the origin directory, and
-- a clone of that in the repository directory. The clone ensures that the
-- origin repository is set as the "origin" remote in the cloned repository.
initializeRepository :: FilePath -> FilePath -> IO [Sha]
initializeRepository originDir repoDir = do
  -- Create the directory for the origin repository, and parent directories.
  createDirectoryIfMissing True originDir
  shas <- populateRepository originDir
  _    <- callGit ["clone", "file://" ++ originDir, repoDir]
  -- Set the author details in the cloned repository as well, to ensure that
  -- there is no implicit dependency on a global Git configuration.
  _    <- callGit ["-C", repoDir, "config", "user.email", "<EMAIL>"]
  _    <- callGit ["-C", repoDir, "config", "user.name", "Testbot"]
  return shas

-- Generate a configuration to be used in the test environment.
buildConfig :: FilePath -> Configuration
buildConfig repoDir = Configuration {
  Config.owner      = "ruuda",
  Config.repository = "blog",
  Config.branch     = "master",
  Config.testBranch = "integration",
  Config.port       = 5261,
  Config.checkout   = repoDir
}

-- Runs the main loop in a separate thread, and feeds it the given events.
runMainEventLoop :: Configuration -> ProjectState -> [Logic.Event] -> IO ProjectState
runMainEventLoop config initialState events = do
  -- Like the actual application, start a new thread to run the main event loop.
  -- Use 'async' here, a higher-level wrapper around 'forkIO', to wait for the
  -- thread to stop later. Discard log messages from the event loop, to avoid
  -- polluting the test output. Ignore requests to persist the state.
  --
  -- To aid debugging when a test fails, you can replace 'runNoLoggingT' with
  -- 'runStdoutLoggingT'. You should also remove 'parallel' from main then.
  let persist _     = return ()
  queue            <- Logic.newEventQueue 10
  finalStateAsync  <- async
    $ runNoLoggingT
    $ EventLoop.runLogicEventLoop config persist queue initialState

  -- Enqueue all provided events.
  forM_ events (Logic.enqueueEvent queue)

  -- Tell the worker thread to stop after it has processed all events. Then wait
  -- for it to exit, and return the final state.
  Logic.enqueueStopSignal queue
  wait finalStateAsync

type LoopRunner = ProjectState -> [Logic.Event] -> IO ProjectState
type GitRunner = [String] -> IO ()

-- Sets up a test environment with an actual Git repository on the file system,
-- and a thread running the main event loop. Then invokes the body, and tears
-- down the test environment afterwards. Returns a list of commit message
-- prefixes of the remote master branch log. The body function is provided with
-- the shas of the test repository and a function to run the event loop.
withTestEnv :: ([Sha] -> LoopRunner -> GitRunner -> IO ()) -> IO [Text]
withTestEnv body = do
  -- To run these tests, a real repository has to be made somewhere. Do that in
  -- /tmp because it can be mounted as a ramdisk, so it is fast and we don't
  -- unnecessarily wear out SSDs. Put a uuid in there to ensure we don't
  -- overwrite somebody else's files, and to ensure that the tests do not affect
  -- eachother.
  uuid       <- nextRandom
  tmpBaseDir <- getTemporaryDirectory
  let testDir   = tmpBaseDir </> ("testsuite-" ++ (show uuid))
      originDir = testDir </> "repo-origin"
      repoDir   = testDir </> "repo-local"
  -- Create and populate a test repository with a local remote "origin". Record
  -- the shas of the commits as documented in populateRepository.
  shas <- initializeRepository originDir repoDir

  -- Run the actual test code inside the environment that we just set up,
  -- provide it with the commit shas, the function to run the event loop, and a
  -- function to invoke Git in the cloned repository.
  let config   = buildConfig repoDir
      git args = void $ callGit $ ["-C", repoDir] ++ args
  body shas (runMainEventLoop config) git

  -- Retrieve the log of the remote repository master branch. Only show the
  -- commit message subject lines. The repository has been setup to prefix
  -- messages with a commit number followed by a colon. Strip off the rest.
  -- Commit messages are compared later, rather than shas, because these do not
  -- change when rebased, and they do not depend on the current timestamp.
  -- (Commits do: the same rebase operation can produce commits with different
  -- shas depending on the time of the rebase.)
  masterLog <- callGit ["-C", originDir, "log", "--format=%s", "master"]
  let commits = reverse $ fmap (Text.takeWhile (/= ':')) $ Text.lines masterLog

  removeDirectoryRecursive testDir
  return commits

eventLoopSpec :: Spec
eventLoopSpec = parallel $ do
  describe "The main event loop" $ do

    it "handles a fast-forwardable pull request" $ do
      history <- withTestEnv $ \ shas runLoop _git -> do
        let [_c0, _c1, _c2, _c3, _c3', c4, _c5, _c6] = shas
            pr1 = PullRequestId 1

        -- Commit c4 is one commit ahead of master, so integrating it can be done
        -- with a fast-forward merge. Run the main event loop for these events
        -- and discard the final state by using 'void'.
        void $ runLoop Project.emptyProjectState
          [
            Logic.PullRequestOpened pr1 c4 "decker",
            Logic.CommentAdded pr1 "rachael" $ Text.pack $ "LGTM " ++ (show c4),
            Logic.BuildStatusChanged c4 BuildSucceeded
          ]

      history `shouldBe` ["c0", "c1", "c2", "c3", "c4"]

    it "handles a non-conflicting non-fast-forwardable pull request" $ do
      history <- withTestEnv $ \ shas runLoop _git -> do
        let [_c0, _c1, _c2, _c3, _c3', _c4, _c5, c6] = shas<commit_msg>Make files writable before removing temp directory<commit_after>-- Copyright 2016 <NAME>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License version 3. See
-- the licence file in the root of the repository.

{-# LANGUAGE OverloadedStrings #-}

-- This file contains sort-of end-to-end tests for the event loop. Incoming
-- messages are faked (supplied by the test code, as oppsed to received via the
-- web server), but the event loop does run with actual IO with a test
-- repository. The purpose of these tests is not to test the *logic* of the
-- event loop (there are unit tests for that), but to test that the interaction
-- with a real Git process works as expected.

module EventLoopSpec (eventLoopSpec) where

import Control.Concurrent.Async (async, wait)
import Control.Monad (forM_, void, when)
import Control.Monad.Logger (runNoLoggingT)
import Data.Maybe (isJust)
import Data.Text (Text)
import Data.UUID.V4 (nextRandom)
import Prelude hiding (appendFile, writeFile)
import System.FilePath ((</>))
import Test.Hspec

import qualified System.Directory as FileSystem

import Configuration (Configuration (..))
import Git (Sha (..))
import Project (BuildStatus (..), IntegrationStatus (..), ProjectState, PullRequestId (..))

import qualified Configuration as Config
import qualified Data.Text as Text
import qualified EventLoop
import qualified Git
import qualified Logic
import qualified Prelude
import qualified Project

-- Invokes Git with the given arguments, returns its stdout. Crashes if invoking
-- Git failed. Discards all logging.
callGit :: [String] -> IO Text
callGit args = fmap (either undefined id) $ runNoLoggingT $ Git.callGit args

-- Populates the repository with the following history:
--
--                 .-- c5 -- c6  <-- intro
--                /
--   c0 -- c1 -- c2 -- c3 -- c4  <-- ahead
--                \     ^----------- master
--                 `-- c3'       <-- alternative
--
populateRepository :: FilePath -> IO [Sha]
populateRepository dir =
  let writeFile fname msg  = Prelude.writeFile (dir </> fname) (msg ++ "\n")
      appendFile fname msg = Prelude.appendFile (dir </> fname) (msg ++ "\n")
      git args             = callGit $ ["-C", dir] ++ args
      gitInit              = void $ git ["init"]
      gitConfig key value  = void $ git ["config", key, value]
      gitAdd file          = void $ git ["add", file]
      gitBranch name sha   = void $ git ["checkout", "-b", name, show sha]
      gitCheckout brname   = void $ git ["checkout", brname]
      getHeadSha           = fmap (Sha . Text.strip) $ git ["rev-parse", "@"]
      -- Commits with the given message and returns the sha of the new commit.
      gitCommit message    = git ["commit", "-m", message] >> getHeadSha
  in  do
      gitInit
      gitConfig "user.email" "<EMAIL>"
      gitConfig "user.name" "Testbot"

      writeFile "tyrell.txt" "I'm surprised you didn't come here sooner."
      gitAdd "tyrell.txt"
      c0 <- gitCommit "c0: Initial commit"

      writeFile "roy.txt" "It's not an easy thing to meet your maker."
      gitAdd "roy.txt"
      c1 <- gitCommit "c1: Add new quote"

      appendFile "tyrell.txt" "What can he do for you?"
      gitAdd "tyrell.txt"
      c2 <- gitCommit "c2: Add new Tyrell quote"

      appendFile "roy.txt" "Can the maker repair what he makes?"
      gitAdd "roy.txt"
      c3 <- gitCommit "c3: Add new Roy quote"

      -- Create a branch "ahead", one commit ahead of master.
      gitBranch "ahead" c3
      appendFile "tyrell.txt" "Would you like to be modified?"
      gitAdd "tyrell.txt"
      c4 <- gitCommit "c4: Add Tyrell  response"
      gitCheckout "master"

      -- Now make an alternative commit that conflicts with c3.
      gitBranch "alternative" c2
      appendFile "roy.txt" "You could make me a sandwich."
      gitAdd "roy.txt"
      c3' <- gitCommit "c3': Write alternative ending"

      -- Also add a commit that does not conflict.
      gitBranch "intro" c2
      writeFile "leon.txt" "What do you mean, I'm not helping?"
      gitAdd "leon.txt"
      c5 <- gitCommit "c5: Add more characters"

      writeFile "holden.txt" "I mean, you're not helping! Why is that, Leon?"
      gitAdd "holden.txt"
      c6 <- gitCommit "c6: Add response"

      return [c0, c1, c2, c3, c3', c4, c5, c6]

-- Sets up two repositories: one with a few commits in the origin directory, and
-- a clone of that in the repository directory. The clone ensures that the
-- origin repository is set as the "origin" remote in the cloned repository.
initializeRepository :: FilePath -> FilePath -> IO [Sha]
initializeRepository originDir repoDir = do
  -- Create the directory for the origin repository, and parent directories.
  FileSystem.createDirectoryIfMissing True originDir
  shas <- populateRepository originDir
  _    <- callGit ["clone", "file://" ++ originDir, repoDir]
  -- Set the author details in the cloned repository as well, to ensure that
  -- there is no implicit dependency on a global Git configuration.
  _    <- callGit ["-C", repoDir, "config", "user.email", "<EMAIL>"]
  _    <- callGit ["-C", repoDir, "config", "user.name", "Testbot"]
  return shas

-- Generate a configuration to be used in the test environment.
buildConfig :: FilePath -> Configuration
buildConfig repoDir = Configuration {
  Config.owner      = "ruuda",
  Config.repository = "blog",
  Config.branch     = "master",
  Config.testBranch = "integration",
  Config.port       = 5261,
  Config.checkout   = repoDir
}

-- Runs the main loop in a separate thread, and feeds it the given events.
runMainEventLoop :: Configuration -> ProjectState -> [Logic.Event] -> IO ProjectState
runMainEventLoop config initialState events = do
  -- Like the actual application, start a new thread to run the main event loop.
  -- Use 'async' here, a higher-level wrapper around 'forkIO', to wait for the
  -- thread to stop later. Discard log messages from the event loop, to avoid
  -- polluting the test output. Ignore requests to persist the state.
  --
  -- To aid debugging when a test fails, you can replace 'runNoLoggingT' with
  -- 'runStdoutLoggingT'. You should also remove 'parallel' from main then.
  let persist _     = return ()
  queue            <- Logic.newEventQueue 10
  finalStateAsync  <- async
    $ runNoLoggingT
    $ EventLoop.runLogicEventLoop config persist queue initialState

  -- Enqueue all provided events.
  forM_ events (Logic.enqueueEvent queue)

  -- Tell the worker thread to stop after it has processed all events. Then wait
  -- for it to exit, and return the final state.
  Logic.enqueueStopSignal queue
  wait finalStateAsync

-- Recursively makes all files and directories in a directory writable.
-- On Windows this is required to be able to recursively delete the directory.
makeWritableRecursive :: FilePath -> IO ()
makeWritableRecursive path = do
  permissions <- FileSystem.getPermissions path
  FileSystem.setPermissions path (FileSystem.setOwnerWritable True permissions)
  isDirectory <- FileSystem.doesDirectoryExist path
  when isDirectory $ do
    contents <- FileSystem.listDirectory path
    forM_ contents $ \ item -> makeWritableRecursive (path </> item)

type LoopRunner = ProjectState -> [Logic.Event] -> IO ProjectState
type GitRunner = [String] -> IO ()

-- Sets up a test environment with an actual Git repository on the file system,
-- and a thread running the main event loop. Then invokes the body, and tears
-- down the test environment afterwards. Returns a list of commit message
-- prefixes of the remote master branch log. The body function is provided with
-- the shas of the test repository and a function to run the event loop.
withTestEnv :: ([Sha] -> LoopRunner -> GitRunner -> IO ()) -> IO [Text]
withTestEnv body = do
  -- To run these tests, a real repository has to be made somewhere. Do that in
  -- /tmp because it can be mounted as a ramdisk, so it is fast and we don't
  -- unnecessarily wear out SSDs. Put a uuid in there to ensure we don't
  -- overwrite somebody else's files, and to ensure that the tests do not affect
  -- eachother.
  uuid       <- nextRandom
  tmpBaseDir <- FileSystem.getTemporaryDirectory
  let testDir   = tmpBaseDir </> ("testsuite-" ++ (show uuid))
      originDir = testDir </> "repo-origin"
      repoDir   = testDir </> "repo-local"
  -- Create and populate a test repository with a local remote "origin". Record
  -- the shas of the commits as documented in populateRepository.
  shas <- initializeRepository originDir repoDir

  -- Run the actual test code inside the environment that we just set up,
  -- provide it with the commit shas, the function to run the event loop, and a
  -- function to invoke Git in the cloned repository.
  let config   = buildConfig repoDir
      git args = void $ callGit $ ["-C", repoDir] ++ args
  body shas (runMainEventLoop config) git

  -- Retrieve the log of the remote repository master branch. Only show the
  -- commit message subject lines. The repository has been setup to prefix
  -- messages with a commit number followed by a colon. Strip off the rest.
  -- Commit messages are compared later, rather than shas, because these do not
  -- change when rebased, and they do not depend on the current timestamp.
  -- (Commits do: the same rebase operation can produce commits with different
  -- shas depending on the time of the rebase.)
  masterLog <- callGit ["-C", originDir, "log", "--format=%s", "master"]
  let commits = reverse $ fmap (Text.takeWhile (/= ':')) $ Text.lines masterLog

  makeWritableRecursive testDir
  FileSystem.removeDirectoryRecursive testDir
  return commits

eventLoopSpec :: Spec
eventLoopSpec = parallel $ do
  describe "The main event loop" $ do

    it "handles a fast-forwardable pull request" $ do
      history <- withTestEnv $ \ shas runLoop _git -> do
        let [_c0, _c1, _c2, _c3, _c3', c4, _c5, _c6] = shas
            pr1 = PullRequestId 1

        -- Commit c4 is one commit ahead of master, so integrating it can be done
        -- with a fast-forward merge. Run the main event loop for these events
        -- and discard the final state by using 'void'.
        void $ runLoop Project.emptyProjectState
          [
            Logic.PullRequestOpened pr1 c4 "decker",
            Logic.CommentAdded pr1 "rachael" $ Text.pack $ "LGTM " ++ (show c4),
            Logic.BuildStatusChanged c4 BuildSucceeded
          ]

      history `shouldBe` ["c0", "c1", "c2", "c3", "c4"]

    it "handles a non-conflicting non-fast-forwardable pull request" $ do
      history <- withTestEnv $ \ shas runLoop _git -> do
        let [_c0, _c1, _c2, _c3, _c3', _c4, _c5, c6] = shas
{'fraction_non_alphanumeric': 0.09590688278582078, 'fraction_numerical': 0.007407051127891876, 'mean_word_length': 2.897282099343955, 'pattern_counts': {'":': 0, '<': 71, '<?xml version=': 0, '>': 62, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2722413', 'n_tokens_mistral': 6075, 'n_tokens_neox': 5871, 'n_words': 2560}