Haskell-jpのコンテンツの一つとしてHaskell AntennaというWebページの開発・運用をしております。

2019年の今頃、これを自動毎時更新しようと Drone Cloudによる毎時更新を設定しました。

しかし。。。なんと去年の3月ぐらいからこれが止まっています（どうやら、Drone Cloudのこの機能を利用してマイニングをした人がいたらしく止めてしまったようです）。現在は僕がだいたい毎朝1回、手動でCIを回しています。。。

ずっとなんとかしなきゃなぁと思い続けてはや9ヶ月。やっと重い腰をあげてなんとかしました！というよりは、なんとかする方法を思い付いたので実装してみました。

Contents

どうするか？
実装する
インスタンスで起動する
今後やりたいこと

Link to
hereどうするか？

GCPにはalways freeプランというのがあり、GCEインスタンスの場合はf1-microであれば一台だけ無料です（2020/1現在）。これに、毎時実行して更新をプッシュするantennaプログラムを仕込んでおけば良いではないかということに気づきました。

Haskell Antenna自体はGitHub Pagesであり、HTMLなどはhaskell-jp/antennaという Haskell製CLIアプリケーションで生成しています。これをcronか何かで毎時実行すればいいんですけど

cronとDockerの組み合わせが割とめんどくさい（antennaはDocker Imageとして提供している）
cronにした場合更新をGitHubにどうやってプッシュしようかなどを考えるのがめんどくさい

という問題があります。

そこで、(2) のプッシュの部分も含めて毎時実行の処理をantennaアプリケーションに閉じ込めてしまえば、docker run しておくだけで良いのではないか？というのを思い付きました！ということで、そういう風にantennaを改良します。

Link to
here実装する

antennaプログラムに「gitコマンドを使ってGitHubリポジトリに更新をプッシュする機能」と「全てを毎時実行する機能」の2つを組み込む必要があります。ここで後方互換性を維持するために、これらはオプションでオンする機能にしましょう。なのでまずは、antenna CLIアプリケーションのオプションを整理するところから始めます。

Link to
hereオプションの整理

改修前のantennaはオプションを持っていません。 getArgs で引数（設定ファイルのパス）を受け取るだけです

import System.Environment (getArgs)

-- generate 関数が設定から HTML ファイル群を生成する IO アクション
main :: IO ()
main = (listToMaybe <$> getArgs) >>= \case
  Nothing   -> error "please input config file path."
  Just path -> generate path =<< readConfig path

これを extensible の GetOpt を使ってオプションを貰えるように拡張します

-- withGetOpt' は usage を独自で扱えるように拡張した Data.Extensible.withGetOpt です
main :: IO ()
main = withGetOpt' "[options] [input-file]" opts $ \r args usage ->
  if | r ^. #help    -> hPutBuilder stdout (fromString usage)
     | r ^. #version -> hPutBuilder stdout (Version.build version)
     | otherwise     -> runCmd r $ listToMaybe args
  where
    opts = #help    @= helpOpt
        <: #version @= versionOpt
        <: #verbose @= verboseOpt
        <: nil

type Options = Record
  '[ "help"    >: Bool
   , "version" >: Bool
   , "verbose" >: Bool
   ]

helpOpt :: OptDescr' Bool
helpOpt = optFlag ['h'] ["help"] "Show this help text"

versionOpt :: OptDescr' Bool
versionOpt = optFlag [] ["version"] "Show version"

verboseOpt :: OptDescr' Bool
verboseOpt = optFlag ['v'] ["verbose"] "Enable verbose mode: verbosity level \"debug\""

差分全体はこのPRで確認することができます。興味のある人はみてみてください。 generate 関数は以下の runCmd 関数から呼ばれています

import Mix
import Mix.Plugin.Logger as MixLogger

runCmd :: Options -> Maybe FilePath -> IO ()
runCmd _ Nothing        = error "please input config file path."
runCmd opts (Just path) = do
  config <- readConfig path
  let plugin = hsequence
             $ #logger <@=> MixLogger.buildPlugin logOpts
            <: #config <@=> pure config
            <: nil
  Mix.run plugin $ generate path
  where
    logOpts = #handle  @= stdout
           <: #verbose @= (opts ^. #verbose)
           <: nil

runCmd 関数はmix.hsを使って RIO env () のボイラーテンプレートを減らしています。

Link to
heregit コマンドを呼ぶ

Haskellアプリケーションからgitコマンドを実行するにはShellyを使うことにします。 Shellyはmix.hsのshellプラグインを使うことで簡単に使用することができます。まずはコミットを作る部分を実装しましょう

import qualified Git -- 自作Shelly製gitコマンド関数群
import qualified Mix.Plugin.Shell as MixShell

runCmd :: Options -> Maybe FilePath -> IO ()
runCmd opts (Just path) = do
  config <- readConfig path
  let plugin = hsequence
             $ #logger <@=> MixLogger.buildPlugin logOpts
            <: #config <@=> pure config
            <: #work   <@=> pure "."
            <: nil
  Mix.run plugin $ do
    when (opts ^. #withCommit) $ MixShell.exec (Git.pull [])
    generate path
    when (opts ^. #withCommit) $ commitGeneratedFiles
  where
    logOpts = ...

commitGeneratedFiles :: RIO Env ()
commitGeneratedFiles = do
  files <- view #files <$> asks (gitConfig . view #config)
  MixShell.exec $ do
    Git.add files
    changes <- Git.diffFileNames ["--staged"]
    when (not $ null changes) $ Git.commit ["-m", message]
  where
    message = ...

全ての差分はこのPRから確認できます。 runCmd 関数に追記したのは when (opts ^. #withCommit) から始まる2行です（Options に #withCommit を追加しています）。 mix.hsのshellプラグインを使うことでShellyのログをだいたいそれっぽくrioのロガーに流してくれます。

次に、git pushも実装します

runCmd :: Options -> Maybe FilePath -> IO ()
runCmd opts (Just path) = do
  ...
  Mix.run plugin $ do
    when (opts ^. #withCommit) $ MixShell.exec (Git.pull [])
    generate path
    when (opts ^. #withCommit) $ commitGeneratedFiles
    when (opts ^. #withPush)   $ pushCommit

pushCommit :: RIO Env ()
pushCommit = do
  branch <- view #branch <$> asks (gitConfig . view #config)
  MixShell.exec (Git.push ["origin", branch])

前から使っている gitConfig は設定ファイルからgitコマンドに関する設定を取ってきています（例えば、どのファイルをコミットするかやどのブランチにプッシュするかなど）。

これで、差分があった場合はgit commitを実行し、最後にgit pushするようなオプション、--with-commitと--with-pushを実装できました（他にも実装していますが割愛）。

Link to
here毎時実行

メインディッシュである毎時実行です。 Haskell-jp Slackで、スケジューリング実行をHaskellアプリケーション内で行うのにちょうど良いパッケージはありますか？と尋ねたところcronというパッケージを紹介してもらいました（名前がややこしい笑）。調べてみたところ、ちょうど良さそうなのでこれを使うことにします

import System.Cron (addJob, execSchedule)

main :: IO ()
main = withGetOpt' "[options] [input-file]" opts $ \r args usage ->
  if | r ^. #help     -> hPutBuilder stdout (fromString usage)
     | r ^. #version  -> hPutBuilder stdout (Version.build version)
     | r ^. #hourly   -> runCmd r (listToMaybe args) `withCron` "0 * * * *"
     | otherwise      -> runCmd r (listToMaybe args)
  where
    opts = ...

withCron :: IO () -> Text -> IO ()
withCron act t = do
  _ <- execSchedule $ addJob act t
  forever $ threadDelay maxBound -- 無限ループ

全ての差分はこのPRから確認できます。すっごい簡単ですね。ついでに、毎日実行と毎分実行するオプションも追加しています。

これでアプリケーションの方は出来上がったので、こいつをGCEインスタンスで動作させてみましょう。

Link to
hereインスタンスで起動する

まずはGCP Consoleからインスタンス作成します。構成は次の通りです

f1-micro
オレゴンリージョン
30GBの標準ストレージ
OSはUbuntu 18.04

GCP ConsoleからSSHして、docker コマンドをインストールします（やり方は公式サイトのをそのまま）。ここまでできたら試しに sudo docker pull haskelljp/antenna して最新のイメージを取得してみましょう。

次に、GitHubにプッシュするためにSSH Keyを生成してデプロイキーを haskell-jp/antenna リポジトリに設定します。できたら適当に git clone [email protected]:haskell-jp/antenna.git してブランチを gh-pages に切り替えます。

あとは次のコマンドでantennaプログラムを実行するだけです

$ sudo docker run -d \
  -v `pwd`:/work
  -v `echo $HOME`/.ssh:/root/.ssh \
  haskelljp/antenna antenna --verbose --with-commit --with-push --with-copy --hourly sites.yaml

docker logs を使って様子をみてましたが、うまくいってるようです！

Link to
here今後やりたいこと

igrep氏がIssueにしてくれてるように、Haskell Antennaの正しい差分をHaskell-jp Slackに通知する仕組みを整備しようと考えてます。

実はコミットをHaskellアプリケーション内で組み立てるようになった結果、Haskellアプリケーション側でいい感じに差分を調べ上げ、その結果をコミットメッセージに組み込むことができるようになりました。さすがにHTMLやフィードの git diff を解析するのは大変なので、いい感じに各サイトの最終更新ログを残すようにしてみようかなって考えてます。

Link to hereどうするか？

Link to here実装する

Link to hereオプションの整理

Link to heregit コマンドを呼ぶ

Link to here毎時実行

Link to hereインスタンスで起動する

Link to here今後やりたいこと