diff --git a/AUTHORS b/AUTHORS new file mode 100644 --- /dev/null +++ b/AUTHORS @@ -0,0 +1,3 @@ +The Freepost community . Specifically, the following people: + +fr33domlover diff --git a/COPYING b/COPYING new file mode 100644 --- /dev/null +++ b/COPYING @@ -0,0 +1,121 @@ +Creative Commons Legal Code + +CC0 1.0 Universal + + CREATIVE COMMONS CORPORATION IS NOT A LAW FIRM AND DOES NOT PROVIDE + LEGAL SERVICES. DISTRIBUTION OF THIS DOCUMENT DOES NOT CREATE AN + ATTORNEY-CLIENT RELATIONSHIP. CREATIVE COMMONS PROVIDES THIS + INFORMATION ON AN "AS-IS" BASIS. CREATIVE COMMONS MAKES NO WARRANTIES + REGARDING THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS + PROVIDED HEREUNDER, AND DISCLAIMS LIABILITY FOR DAMAGES RESULTING FROM + THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS PROVIDED + HEREUNDER. + +Statement of Purpose + +The laws of most jurisdictions throughout the world automatically confer +exclusive Copyright and Related Rights (defined below) upon the creator +and subsequent owner(s) (each and all, an "owner") of an original work of +authorship and/or a database (each, a "Work"). + +Certain owners wish to permanently relinquish those rights to a Work for +the purpose of contributing to a commons of creative, cultural and +scientific works ("Commons") that the public can reliably and without fear +of later claims of infringement build upon, modify, incorporate in other +works, reuse and redistribute as freely as possible in any form whatsoever +and for any purposes, including without limitation commercial purposes. +These owners may contribute to the Commons to promote the ideal of a free +culture and the further production of creative, cultural and scientific +works, or to gain reputation or greater distribution for their Work in +part through the use and efforts of others. + +For these and/or other purposes and motivations, and without any +expectation of additional consideration or compensation, the person +associating CC0 with a Work (the "Affirmer"), to the extent that he or she +is an owner of Copyright and Related Rights in the Work, voluntarily +elects to apply CC0 to the Work and publicly distribute the Work under its +terms, with knowledge of his or her Copyright and Related Rights in the +Work and the meaning and intended legal effect of CC0 on those rights. + +1. Copyright and Related Rights. A Work made available under CC0 may be +protected by copyright and related or neighboring rights ("Copyright and +Related Rights"). Copyright and Related Rights include, but are not +limited to, the following: + + i. the right to reproduce, adapt, distribute, perform, display, + communicate, and translate a Work; + ii. moral rights retained by the original author(s) and/or performer(s); +iii. publicity and privacy rights pertaining to a person's image or + likeness depicted in a Work; + iv. rights protecting against unfair competition in regards to a Work, + subject to the limitations in paragraph 4(a), below; + v. rights protecting the extraction, dissemination, use and reuse of data + in a Work; + vi. database rights (such as those arising under Directive 96/9/EC of the + European Parliament and of the Council of 11 March 1996 on the legal + protection of databases, and under any national implementation + thereof, including any amended or successor version of such + directive); and +vii. other similar, equivalent or corresponding rights throughout the + world based on applicable law or treaty, and any national + implementations thereof. + +2. Waiver. To the greatest extent permitted by, but not in contravention +of, applicable law, Affirmer hereby overtly, fully, permanently, +irrevocably and unconditionally waives, abandons, and surrenders all of +Affirmer's Copyright and Related Rights and associated claims and causes +of action, whether now known or unknown (including existing as well as +future claims and causes of action), in the Work (i) in all territories +worldwide, (ii) for the maximum duration provided by applicable law or +treaty (including future time extensions), (iii) in any current or future +medium and for any number of copies, and (iv) for any purpose whatsoever, +including without limitation commercial, advertising or promotional +purposes (the "Waiver"). Affirmer makes the Waiver for the benefit of each +member of the public at large and to the detriment of Affirmer's heirs and +successors, fully intending that such Waiver shall not be subject to +revocation, rescission, cancellation, termination, or any other legal or +equitable action to disrupt the quiet enjoyment of the Work by the public +as contemplated by Affirmer's express Statement of Purpose. + +3. Public License Fallback. Should any part of the Waiver for any reason +be judged legally invalid or ineffective under applicable law, then the +Waiver shall be preserved to the maximum extent permitted taking into +account Affirmer's express Statement of Purpose. In addition, to the +extent the Waiver is so judged Affirmer hereby grants to each affected +person a royalty-free, non transferable, non sublicensable, non exclusive, +irrevocable and unconditional license to exercise Affirmer's Copyright and +Related Rights in the Work (i) in all territories worldwide, (ii) for the +maximum duration provided by applicable law or treaty (including future +time extensions), (iii) in any current or future medium and for any number +of copies, and (iv) for any purpose whatsoever, including without +limitation commercial, advertising or promotional purposes (the +"License"). The License shall be deemed effective as of the date CC0 was +applied by Affirmer to the Work. Should any part of the License for any +reason be judged legally invalid or ineffective under applicable law, such +partial invalidity or ineffectiveness shall not invalidate the remainder +of the License, and in such case Affirmer hereby affirms that he or she +will not (i) exercise any of his or her remaining Copyright and Related +Rights in the Work or (ii) assert any associated claims and causes of +action with respect to the Work, in either case contrary to Affirmer's +express Statement of Purpose. + +4. Limitations and Disclaimers. + + a. No trademark or patent rights held by Affirmer are waived, abandoned, + surrendered, licensed or otherwise affected by this document. + b. Affirmer offers the Work as-is and makes no representations or + warranties of any kind concerning the Work, express, implied, + statutory or otherwise, including without limitation warranties of + title, merchantability, fitness for a particular purpose, non + infringement, or the absence of latent or other defects, accuracy, or + the present or absence of errors, whether or not discoverable, all to + the greatest extent permissible under applicable law. + c. Affirmer disclaims responsibility for clearing rights of other persons + that may apply to the Work or any use thereof, including without + limitation any person's Copyright and Related Rights in the Work. + Further, Affirmer disclaims responsibility for obtaining any necessary + consents, permissions or other rights required for any use of the + Work. + d. Affirmer understands and acknowledges that Creative Commons is not a + party to this document and has no duty or obligation with respect to + this CC0 or use of the Work. diff --git a/ChangeLog b/ChangeLog new file mode 100644 --- /dev/null +++ b/ChangeLog @@ -0,0 +1,6 @@ +If you have a local clone of the repository, you can see a detailed list of +changes using: + + $ git log + +There is also a web interface in NotABug which can display commit history. diff --git a/INSTALL b/INSTALL new file mode 100644 --- /dev/null +++ b/INSTALL @@ -0,0 +1,13 @@ +Install from Hackage: + + $ cabal install funbot-git-hook + +Install from unpacked release tarball or source repo: + + $ cd funbot-git-hook + $ cabal install + +Just play with it without installing: + + $ cabal build + $ cabal repl diff --git a/NEWS b/NEWS new file mode 100644 --- /dev/null +++ b/NEWS @@ -0,0 +1,23 @@ +This file lists the user-visible interesting changes between releases. For a +full list of changes to the source, see the ChangeLog. + + + +funbot-git-hook 0.1 -- 2015-09-28 +================================= + +General, build and documentation changes: + +* (This is the first release, so everything is new) + +New APIs, features and enhancements: + +* (This is the first release, so everything is a new feature) + +Bug fixes: + +* (This is just the first release, many bugs haven't been discovered yet) + +Dependency changes: + +* (This is the first release) diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,280 @@ +# funbot-git-hook + +This is a program to use as a Git post-receive hook, which collects new commits +and tags made in the Git push, and reports them to a running instance of +[FunBot][funbot], so that the bot can announce the event to IRC. + +[funbot]: https://notabug.org/fr33domlover/funbot + +See below for usage instructions. + +The official download location is the Git repository: + + + +Occasionally, releases are made to Hackage, the Haskell package repository. +See . + +This software is free software, and is committed to software freedom. It is +released to the public domain using the CC0 Public Domain Dedication. For the +boring "legal" details see the file `COPYING`. + +See the file `INSTALL` for hints on installation. The file `ChangeLog` explains +how to see the history log of the changes done in the code. `NEWS` provides a +friendly overview of the changes for each release. + +## Usage Instructions + +### Quickstart + +If you feel you already know the details and just want to get the hook working +quickly, here's a usage example you can adapt to your needs. If these quick +instructions are al familiar, great! Otherwise, there is a detailed guide in +the next section. + +The commands below assume manual management of git config and hooks for the +server. If you prefer to use Gitolite's features instead, check the Gitolite +website or read the hints provided in the next sections. + +On the machine where you build the hook program: + + $ sudo add-apt-repository ppa:hvr/ghc + $ sudo apt-get update + $ sudo apt-get install cabal-install-1.22 ghc-7.8.4 + $ echo 'export PATH=~/.cabal/bin:/opt/cabal/1.22/bin:/opt/ghc/7.8.4/bin:$PATH' >> ~/.bashrc + $ PATH=~/.cabal/bin:/opt/cabal/1.22/bin:/opt/ghc/7.8.4/bin:$PATH + $ cabal update + $ cd /home/joe + +If you're using git master: + + $ git clone https://notabug.org/fr33domlover/funbot-git-hook.git + $ cd funbot-git-hook + $ cabal sandbox init + $ cabal install --only-dependencies + $ cabal build + +If you're using the Hackage release: + + $ mkdir funbot-sandbox + $ cd funbot-sandbox + $ cabal sandbox init + $ cabal install funbot-git-hook + +Now copy `dist/build/funbot-client-post-receive/funbot-client-post-receive` to +the server as `/var/lib/gitserver/repos/myrepo.git/hooks/post-receive`. + +On the git server machine: + + # su - git + $ git config --global funbot.commit-url-template 'http://git.rel4tion.org/?p=${repo}.git;a=commitdiff;h=${commit}' + $ cd repos/myrepo.git + $ git config --local funbot.owner johndoe + $ git config --local funbot.bot-url 'http://bot.rel4tion.org/client' + +Run `ldd funbot-client-post-receive` (on the binary) and make sure the listed +libraries are installed. + +### Intro + +Some development platforms, such as Gogs and GitLab, have web hook support. +FunBot supports the web hook data formats of some of them, and then this +package isn't needed. But some platforms are perhaps not supported by FunBot +yet. And some are simple git servers which perhaps don't have web hooks at all, +for example Gitolite. For these cases, `funbot-git-hook` provides the ability +to report events to a FunBot instance. + +I expect that Gitolite will be the primary use case of this package, and the +instructions below explain both the general case, and specific hints for +Gitolite server admins. + +### Git Server + +Suppose you have a git server with repositories placed under +`/var/lib/gitserver/repos`, and they are bare repos. There is a system user +named `git` whose home directory is `/var/lib/gitserver`. We'd like to add a +git hook to a repo named `myrepo`, whose path would be +`/var/lib/gitserver/repos/myrepo.git`. + +### Git Config + +The hook program takes its parameters from the git config. It checks both in +the global user config and in the repo-specific config. + +The following config options are used: + +`funbot.commit-url-template` + +When FunBot announces a commit, it specifies a URL meant to refer to a web page +showing commit details. For example, if you use Gitolite, you probably use +*gitweb* or *cgit* to generate a web interface for browsing the repos. This +config option allows you to specify a template for that URL. The template +contains 3 variables, which will be inserted by the hook program when it runs: + +1. `repo` : the repository name, without a `.git` suffix +2. `branch` : name of the branch the commit belongs to +3. `commit` : commit reference in the form of a SHA hash + +Your template doesn't have to include all 3. Use the ones you need. + +Variables in the template are specified like `$var` or like `${var}`. Use `$$` +to get a literal `$` character. For example, this works with gitweb: + + http://git.rel4tion.org/?p=${repo}.git;a=commitdiff;h=${commit} + +This config option is optional. If you don't specify it, an empty URL will be +assumed. You'll probably want to specify it in the global config +(`~/.gitconfig`), since on a single git server instance your repos most likely +share the same template. + + # su - git + $ git config --global funbot.commit-url-template 'http://git.rel4tion.org/?p=${repo}.git;a=commitdiff;h=${commit}' + +If you use Gitolite, you can set it globally for all the repos in your +`gitolite.conf` like this: + + repo @all + config funbot.commit-url-template = "http://git.rel4tion.org/?p=${repo}.git;a=commitdiff;h=${commit}" + +Note that by default Gitolite will refuse to accept this config line because +the value contains a character considered unsafe, `$`. See the Gitolite config +for more info and instructions how to safely allow `$` to be used. + +`funbot.owner` + +FunBot maintains a list of repositories, and configuration for announcing their +events. For example, to which IRC channel should your repo's commits be +announced? For which branches? What to do if a large amount of commits are +pushed at once? FunBot keeps this information. When a commit is reported to it, +it needs to go to these records, find your repo's name and fetch the +configurations for it. But since different people and servers may have repos +with identical name, FunBot uses two things to identify and find a repo in its +records: + +1. The repo name +2. A repo owner string, i.e. a username of a person responsible for the repo + +This config option allows you to specify the owner string. It is **required**. +If no owner string is found, nothing will be sent to FunBot. Assuming you set +this per-repo, you can do it like this on the command line: + + # su - git + $ cd ~/repos/myrepo.git + $ git config --local funbot.owner johndoe + +Or using Gitolite: + + repo myrepo + RW+ = johndoe + R = daemon + config funbot.owner = johndoe + +The first `johndoe` is matched by Gitolite against the SSH key filenames, while +the second `johndoe` is an arbitrary owner nickname you can pick. They don't +have to be identical, but it may be a good idea to keep them identical for +consistency, and for cases your web UI contains author links etc. + +`funbot.bot-url` + +FunBot accept events from clients through an HTTP based API. This config option +is the URL at which your favorite FunBot instance accepts events. It is +**required**. + +For example, `http://bot.rel4tion.org/client`. + +### Deploying the Hook Program + +There are several ways to deply the hook: + +- Build it somewhere else and copy the binary to the server +- Install it on the server +- Build it in a sandbox on the server +- Run it as a script using the Haskell interpreter + +Technically there could also be "use a distro package" but there is none yet. +Contributions are very welcome, especially for making a `deb` package for +Trisquel. + +If you're not sure which one to pick, I suggest the first option. Build from +the safety and comfort of your personal computer, and just copy the binary. +That binary *does* require some dependency libraries to be present, but most of +them are commonly available and you can use the `ldd` command on it to +determine exactly which dependencies are needed. + +The binary executable contains its Haskell library dependencies, so it's bigger +than a typical git hook, which is often a simple script. On my system, its size +is 19MB. You can try to make it smaller by stripping symbols, if you want. + +#### Building and Deploying the Binary + +I'll assume the distribution used is Trisquel GNU/Linux-libre. The same +commands should probably work for other Debian-based distributions. Adapt to +your system as needed. + +Add a PPA and install a basic Haskell tools (compiler, package +manager, etc.): + + $ sudo add-apt-repository ppa:hvr/ghc + $ sudo apt-get update + $ sudo apt-get install cabal-install-1.22 ghc-7.8.4 + +Add `~/.cabal/bin:/opt/cabal/1.22/bin:/opt/ghc/7.8.4/bin` to your `$PATH` in +`bashrc` or similar. + +Download the package index: + + $ cabal update + +If you'd like to use the package release from Hackage, install it inside a +fresh sandbox: + + $ mkdir funbot-sandbox + $ cd funbot-sandbox + $ cabal sandbox init + $ cabal install funbot-git-hook + +If you're instead working with a git clone, go to the repo directory and create +a cabal sandbox: + + $ cd /home/joe/git-repos/funbot-git-hook + $ cabal sandbox init + +Install dependency packages: + + $ cabal install --only-dependencies + +Build the program: + + $ cabal build + +Now `dist/build/funbot-client-post-receive/` contains a binary executable +`funbot-client-post-receive`. Use `ldd` to determine which libraries it links +to at runtime and make sure they are installed on the server (hopefully most if +not all of them will be available as distro packages). + +Finally, you can put the binary on the server as +`/var/lib/gitserver/repos/myrepo.git/hooks/post-receive`. If you use Gitolite, +you can instead drop it in the `/var/lib/gitserver/local/hooks/repo-specific` +directory, and specify it in `gitolite.conf`: + + repo myrepo + RW+ = johndoe + R = daemon + config funbot.owner = johndoe + option hook.post-receive = funbot-client-post-receive + +#### Running using the Interpreter + +If you want to do that for any reason, here's how. Install the packages from +the PPA on the server. Do the rest as the `git` user. Clone this repo if you +haven't yet. Instead of creating a sandbox, run a single +`cabal install --only-dependencies` which will install the dependencies locally +for the `git` user. + +Now add `#!/usr/bin/env runhaskell` as the first line of `src/Main.hs`, make +this file executable (`chmod +x src/Main.hs`) and copy it to the final location +as explained for the binary at the bottom of the previous section. + +## Bug and Patches + +See [here](https://notabug.org/fr33domlover/funbot#reporting-bugs-and-suggesting-features). diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/funbot-git-hook.cabal b/funbot-git-hook.cabal new file mode 100644 --- /dev/null +++ b/funbot-git-hook.cabal @@ -0,0 +1,51 @@ +name: funbot-git-hook +version: 0.1 +synopsis: Git hook which sends events to FunBot. +description: + This is program to use as a Git post-receive hook, which collects new commits + and tags made in the Git push, and reports them to a running instance of + , so that the bot can + announce the event to IRC. + . + See the /README.md/ for instructions. +homepage: https://notabug.org/fr33domlover/funbot-git-hook/ +bug-reports: https://notabug.org/fr33domlover/funbot-git-hook/issues/ +license: PublicDomain +license-file: COPYING +author: fr33domlover +maintainer: fr33domlover@riseup.net +copyright: ♡ Copying is an act of love. Please copy, reuse and share. +category: Network, Web +build-type: Simple +extra-source-files: AUTHORS ChangeLog COPYING INSTALL NEWS README.md +cabal-version: >=1.10 + +source-repository head + type: git + location: https://notabug.org/fr33domlover/funbot-git-hook.git + +flag network-uri + description: Get Network.URI from the network-uri package + default: True + +executable funbot-client-post-receive + main-is: Main.hs + -- other-modules: + -- other-extensions: + build-depends: base >=4.7 && <5 + , bytestring + , directory + , filepath + , hit >=0.6.3 + , funbot-client + , funbot-ext-events + , template >=0.2 + , text + , utf8-string >=1 + if flag(network-uri) + build-depends: network-uri >=2.6 + else + build-depends: network <2.6 + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,277 @@ +{- This file is part of funbot-git-hook. + - + - Written in 2015 by fr33domlover . + - + - ♡ Copying is an act of love. Please copy, reuse and share. + - + - The author(s) have dedicated all copyright and related and neighboring + - rights to this software to the public domain worldwide. This software is + - distributed without any warranty. + - + - You should have received a copy of the CC0 Public Domain Dedication along + - with this software. If not, see + - . + -} + +-- For pattern matching Data.Text values +{-# LANGUAGE OverloadedStrings #-} + +module Main (main) where + +import Control.Exception (tryJust) +import Control.Monad (guard, forM, liftM) +import Data.Either (partitionEithers) +import Data.Maybe (catMaybes, fromMaybe, mapMaybe) +import Data.Git +import Data.Git.Ref (fromHex) +import Data.Git.Repository (configGet) +import Data.Git.Storage.Object (Object (..)) +import Data.Text.Template +import Network.URI (URI, parseURI) +import System.Directory (getCurrentDirectory) +import System.FilePath (splitExtension, takeFileName) +import System.IO.Error (isEOFError) +import Text.Printf (printf) + +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as BC +import qualified Data.ByteString.UTF8 as BU +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Encoding as T +import qualified FunBot.Client as F +import qualified FunBot.ExtEvents as F hiding (ExtEvent) + +------------------------------------------------------------------------------- +-- Read input lines +------------------------------------------------------------------------------- + +-- | Maximal number of refs to read. The bot will announce only few of them +-- anyway, and we don't want to leave open the option of getting stuck in an +-- infinite loop. Just make sure to set this high enough to be above actual +-- normal use cases. +maxRefs :: Int +maxRefs = 3000 + +-- | Read from stdin one line of reflog data passed by git. Return 'Nothing' if +-- the end of the list has been reached. +readRef :: IO (Maybe (B.ByteString, B.ByteString, B.ByteString)) +readRef = do + res <- tryJust (guard . isEOFError) B.getLine + case res of + Left _ -> return Nothing + Right line -> + case BC.words line of + [old, new, ref] -> return $ Just (old, new, ref) + _ -> error "An input line must contain exactly 3 spaces" + +-- | Read from stdin all the reflog data passed by git. +readRefs :: IO [(B.ByteString, B.ByteString, B.ByteString)] +readRefs = + let f triples 0 = return triples + f triples left = do + mtriple <- readRef + case mtriple of + Just triple -> f (triple : triples) (left - 1) + Nothing -> return triples + in liftM reverse $ f [] maxRefs + +------------------------------------------------------------------------------- +-- Read hash+branch pairs +------------------------------------------------------------------------------- + +-- | Check whether a given change is an update of a ref. Creations and +-- deletions of branches aren't relevant to us. +isUpdate :: B.ByteString -> B.ByteString -> Bool +isUpdate old new = BC.any (/= '0') old || BC.any (/= '0') new + +-- | A 'stripPrefix' variant for byte strings: Strip if prefix exists, +-- otherwise return the input as is. +stripPrefixB :: B.ByteString -> B.ByteString -> B.ByteString +stripPrefixB pref b = + if pref `B.isPrefixOf` b + then B.drop (B.length pref) b + else b + +-- | Get details of a relevant change, or discard if not relevant. +parseChange :: B.ByteString + -> B.ByteString + -> B.ByteString + -> Maybe (B.ByteString, B.ByteString) +parseChange old new name = + if isUpdate old new + then Just (new, stripPrefixB "refs/heads/" name) + else Nothing + +-- | Read input and filter relevant changes. +readChanges :: IO [(B.ByteString, B.ByteString)] +readChanges = + let f (old, new, name) = parseChange old new name + in liftM (mapMaybe f) readRefs + +------------------------------------------------------------------------------- +-- Read commits and tags, filter out the rest +------------------------------------------------------------------------------- + +-- | Determine repo name using the system. +getRepoName :: IO String +getRepoName = do + file <- liftM takeFileName getCurrentDirectory + return $ case splitExtension file of + (name, ".git") -> name + _ -> file + +{- Get commit URL template from program arguments. +getUrlTemplate :: IO (Maybe Template) +getUrlTemplate = do + args <- getArgs + return $ case args of + [] -> Nothing + [arg] -> Just $ template $ T.pack arg + _ -> error "Too many args! Expected at most 1, the URL template."-} + +-- | Get commit URL template from git config. This should probablt be in the +-- global config, not the per-repo one, since the URL template is likely +-- identical for all repos. +getUrlTemplate :: Git -> IO (Maybe Template) +getUrlTemplate git = + liftM (fmap $ template . T.pack) $ + configGet git "funbot" "commit-url-template" + +-- | Get repo owner string from git config. This would usually be in the +-- per-repo config. Gitolite can make it easier, defining it in @gitolite.conf@ +-- at the same place @gitweb.owner@ can be defined. Note that this is data +-- /required/, therefore not finding it in the config causes an 'error'. +getRepoOwner :: Git -> IO String +getRepoOwner git = + liftM (fromMaybe $ error "funbot.owner not found in git config") $ + configGet git "funbot" "owner" + +-- | Apply template. +subst :: Maybe Template -> Context -> TL.Text +subst Nothing _ = TL.empty +subst (Just t) c = render t c + +-- | Create a mapping from URL template variables to their values. +makeContext :: T.Text -> T.Text -> T.Text -> Context +makeContext repo branch commit var = + case var of + "repo" -> repo + "branch" -> branch + "commit" -> T.take 8 commit + _ -> T.pack "NO_SUCH_VAR" + +-- | Read commit and tag data from repo, discard irrelevant input. +readEventData :: Git -> IO ([Either (F.Commit, String) F.Tag], String, String) +readEventData git = do + repo <- getRepoName + let mkCtx = makeContext $ T.pack repo + owner <- getRepoOwner git + templ <- getUrlTemplate git + cs <- readChanges + ms <- forM cs $ \ (hash, branch) -> do + mobj <- getObject git (fromHex hash) True + return $ case mobj of + Just (ObjCommit c) -> + let ctx = mkCtx (T.decodeUtf8 branch) (T.decodeUtf8 hash) + author = BU.toString $ personName $ commitAuthor c + title = + BU.toString $ BC.takeWhile (/= '\n') $ commitMessage c + url = TL.unpack $ subst templ ctx + in Just $ Left + ( F.Commit + { F.commitAuthor = author + , F.commitTitle = title + , F.commitUrl = url + } + , BU.toString branch + ) + Just (ObjTag t) -> + let author = BU.toString $ personName $ tagName t + name = BU.toString $ BC.takeWhile (/= '\n') $ tagS t + in Just $ Right F.Tag + { F.tagAuthor = author + , F.tagRef = name + , F.tagRepo = repo + , F.tagRepoOwner = owner + } + _ -> Nothing + return (catMaybes ms, repo, owner) + +------------------------------------------------------------------------------- +-- Read and collect event data into push and tag events +------------------------------------------------------------------------------- + +-- | Collect consecutive commits to the same branch into lists. +groupCommits :: [Either (F.Commit, String) F.Tag] + -> ([Either ([F.Commit], String) F.Tag], Int, Int) +groupCommits l = + let f (Right t) xs = Right t : xs + f (Left (c, b)) [] = [Left ([c], b)] + f (Left (c, b)) xs@(Right _ : _) = Left ([c], b) : xs + f (Left (c, b)) xs@(Left (cs, b') : r) = + if b == b' + then Left (c : cs, b) : r + else Left ([c], b) : xs + (lc, lt) = partitionEithers l + in (foldr f [] l, length lc, length lt) + +-- | Given grouped event data, prepare event records. +makeEvents :: [Either ([F.Commit], String) F.Tag] + -> String + -> String + -> [F.ExtEvent] +makeEvents gs repo owner = + let mkBranch n = F.Branch + { F.branchName = n + , F.branchRepo = repo + , F.branchRepoOwner = owner + } + mk (Left (cs, b)) = F.mkPushEvent F.Push + { F.pushBranch = mkBranch b + , F.pushCommits = cs + } + mk (Right t) = F.mkTagEvent t + in map mk gs + +-- | Read input, filter relevant events. +readEvents :: Git -> IO ([F.ExtEvent], Int, Int) +readEvents git = do + (ds, repo, owner) <- readEventData git + let (gs, nc, nt) = groupCommits ds + return (makeEvents gs repo owner, nc, nt) + +------------------------------------------------------------------------------- +-- Read input, filter relevant events and send to a funbot +------------------------------------------------------------------------------- + +-- | Read the funbot instance web hook URL from git config +getBotClientHookUrl :: Git -> IO URI +getBotClientHookUrl git = do + ms <- configGet git "funbot" "bot-url" + let s = fromMaybe (error "funbot.bot-url not found in git config") ms + let muri = parseURI s + uri = fromMaybe (error "funbot.bot-url is an invalid URL") muri + return uri + +-- | Like 'when', but takes a 'Just' and passs the value to the action. +whenJust :: Monad m => Maybe a -> (a -> m ()) -> m () +whenJust (Just x) f = f x +whenJust Nothing _ = return () + +-- | Try to send an event to the bot, print a message if failed. +send :: F.Bot -> Int -> F.ExtEvent -> Int -> IO () +send bot total event i = do + merr <- F.sendExtEvent bot event + whenJust merr $ \ err -> putStrLn $ + printf "Failed to send %v of %v: %v" i total (show err) + +main :: IO () +main = withCurrentRepo $ \ git -> do + (events, nc, nt) <- readEvents git + url <- getBotClientHookUrl git + let bot = F.mkBot url False + putStrLn $ printf "Reporting %v commits and %v tags to funbot" nc nt + let len = length events + pairs = zip events [1..] + mapM_ (uncurry $ send bot len) pairs