|
| 1 | +--- |
| 2 | +title: リベンジ・オブ・毎時更新 Haskell Antenna |
| 3 | +headingBackgroundImage: ../../img/background.png |
| 4 | +headingDivClass: post-heading |
| 5 | +author: Nobutada MATSUBARA |
| 6 | +postedBy: <a href="https://matsubara0507.github.io/whoami">Nobutada MATSUBARA(@matsubara0507)</a> |
| 7 | +date: January 19, 2020 |
| 8 | +tags: Antenna |
| 9 | +... |
| 10 | +--- |
| 11 | + |
| 12 | +Haskell-jpのコンテンツの一つとして[Haskell Antenna](https://haskell.jp/antenna/)というWebページの開発・運用をしております。 |
| 13 | + |
| 14 | +<img src="../../img/2019/hourly-antenna/antenna-page.jpg" style="width: 100%;"> |
| 15 | + |
| 16 | +[2019年の今頃、これを自動毎時更新しようと Drone Cloudによる毎時更新を設定しました](https://haskell.jp/blog/posts/2019/hourly-antenna.html)。 |
| 17 | + |
| 18 | +しかし。。。なんと去年の3月ぐらいからこれが止まっています(どうやら、[Drone Cloudのこの機能を利用してマイニングをした人がいたらしく止めてしまった](https://discourse.drone.io/t/cron-on-cloud-drone-io/3899/2)ようです)。 |
| 19 | +現在は**僕がだいたい毎朝1回、手動でCIを回しています**。。。 |
| 20 | + |
| 21 | +ずっとなんとかしなきゃなぁと思い続けてはや9ヶ月。 |
| 22 | +やっと重い腰をあげてなんとかしました! |
| 23 | +というよりは、なんとかする方法を思い付いたので実装してみました。 |
| 24 | + |
| 25 | +# どうするか? |
| 26 | + |
| 27 | +[GCPにはalways freeプランというのがあり](https://cloud.google.com/free/docs/gcp-free-tier?hl=ja#always-free)、GCEインスタンスの場合はf1-microであれば一台だけ無料です(2020/1現在)。 |
| 28 | +これに、毎時実行して更新をプッシュするantennaプログラムを仕込んでおけば良いではないかということに気づきました。 |
| 29 | + |
| 30 | +Haskell Antenna自体はGitHub Pagesであり、HTMLなどは[haskell-jp/antenna](https://github.com/haskell-jp/antenna)という Haskell製CLIアプリケーションで生成しています。 |
| 31 | +これをcronか何かで毎時実行すればいいんですけど |
| 32 | + |
| 33 | +1. cronとDockerの組み合わせが割とめんどくさい(antennaはDocker Imageとして提供している) |
| 34 | +2. cronにした場合更新をGitHubにどうやってプッシュしようかなどを考えるのがめんどくさい |
| 35 | + |
| 36 | +という問題があります。 |
| 37 | + |
| 38 | +そこで、(2) のプッシュの部分も含めて毎時実行の処理をantennaアプリケーションに閉じ込めてしまえば、`docker run` しておくだけで良いのではないか?というのを思い付きました! |
| 39 | +ということで、そういう風にantennaを改良します。 |
| 40 | + |
| 41 | +# 実装する |
| 42 | + |
| 43 | +antennaプログラムに「gitコマンドを使ってGitHubリポジトリに更新をプッシュする機能」と「全てを毎時実行する機能」の2つを組み込む必要があります。 |
| 44 | +ここで後方互換性を維持するために、これらはオプションでオンする機能にしましょう。 |
| 45 | +なのでまずは、antenna CLIアプリケーションのオプションを整理するところから始めます。 |
| 46 | + |
| 47 | +## オプションの整理 |
| 48 | + |
| 49 | +改修前のantennaはオプションを持っていません。 |
| 50 | +`getArgs` で引数(設定ファイルのパス)を受け取るだけです |
| 51 | + |
| 52 | +```haskell |
| 53 | +import System.Environment (getArgs) |
| 54 | + |
| 55 | +-- generate 関数が設定から HTML ファイル群を生成する IO アクション |
| 56 | +main :: IO () |
| 57 | +main = (listToMaybe <$> getArgs) >>= \case |
| 58 | + Nothing -> error "please input config file path." |
| 59 | + Just path -> generate path =<< readConfig path |
| 60 | +``` |
| 61 | + |
| 62 | +これを [extensible の `GetOpt`](https://hackage.haskell.org/package/extensible-0.7/docs/Data-Extensible-GetOpt.html) を使ってオプションを貰えるように拡張します |
| 63 | + |
| 64 | +```haskell |
| 65 | +-- withGetOpt' は usage を独自で扱えるように拡張した Data.Extensible.withGetOpt です |
| 66 | +main :: IO () |
| 67 | +main = withGetOpt' "[options] [input-file]" opts $ \r args usage -> |
| 68 | + if | r ^. #help -> hPutBuilder stdout (fromString usage) |
| 69 | + | r ^. #version -> hPutBuilder stdout (Version.build version) |
| 70 | + | otherwise -> runCmd r $ listToMaybe args |
| 71 | + where |
| 72 | + opts = #help @= helpOpt |
| 73 | + <: #version @= versionOpt |
| 74 | + <: #verbose @= verboseOpt |
| 75 | + <: nil |
| 76 | + |
| 77 | +type Options = Record |
| 78 | + '[ "help" >: Bool |
| 79 | + , "version" >: Bool |
| 80 | + , "verbose" >: Bool |
| 81 | + ] |
| 82 | + |
| 83 | +helpOpt :: OptDescr' Bool |
| 84 | +helpOpt = optFlag ['h'] ["help"] "Show this help text" |
| 85 | + |
| 86 | +versionOpt :: OptDescr' Bool |
| 87 | +versionOpt = optFlag [] ["version"] "Show version" |
| 88 | + |
| 89 | +verboseOpt :: OptDescr' Bool |
| 90 | +verboseOpt = optFlag ['v'] ["verbose"] "Enable verbose mode: verbosity level \"debug\"" |
| 91 | +``` |
| 92 | + |
| 93 | +差分全体はこの[PR](https://github.com/haskell-jp/antenna/pull/20)で確認することができます。 |
| 94 | +興味のある人はみてみてください。 |
| 95 | +`generate` 関数は以下の `runCmd` 関数から呼ばれています |
| 96 | + |
| 97 | +```haskell |
| 98 | +import Mix |
| 99 | +import Mix.Plugin.Logger as MixLogger |
| 100 | + |
| 101 | +runCmd :: Options -> Maybe FilePath -> IO () |
| 102 | +runCmd _ Nothing = error "please input config file path." |
| 103 | +runCmd opts (Just path) = do |
| 104 | + config <- readConfig path |
| 105 | + let plugin = hsequence |
| 106 | + $ #logger <@=> MixLogger.buildPlugin logOpts |
| 107 | + <: #config <@=> pure config |
| 108 | + <: nil |
| 109 | + Mix.run plugin $ generate path |
| 110 | + where |
| 111 | + logOpts = #handle @= stdout |
| 112 | + <: #verbose @= (opts ^. #verbose) |
| 113 | + <: nil |
| 114 | +``` |
| 115 | + |
| 116 | +`runCmd` 関数は[mix.hs](https://github.com/matsubara0507/mix.hs)を使って `RIO env ()` のボイラーテンプレートを減らしています。 |
| 117 | + |
| 118 | +## git コマンドを呼ぶ |
| 119 | + |
| 120 | +Haskellアプリケーションからgitコマンドを実行するには[Shelly](https://hackage.haskell.org/package/shelly)を使うことにします。 |
| 121 | +Shellyはmix.hsのshellプラグインを使うことで簡単に使用することができます。 |
| 122 | +まずはコミットを作る部分を実装しましょう |
| 123 | + |
| 124 | +```haskell |
| 125 | +import qualified Git -- 自作Shelly製gitコマンド関数群 |
| 126 | +import qualified Mix.Plugin.Shell as MixShell |
| 127 | + |
| 128 | +runCmd :: Options -> Maybe FilePath -> IO () |
| 129 | +runCmd opts (Just path) = do |
| 130 | + config <- readConfig path |
| 131 | + let plugin = hsequence |
| 132 | + $ #logger <@=> MixLogger.buildPlugin logOpts |
| 133 | + <: #config <@=> pure config |
| 134 | + <: #work <@=> pure "." |
| 135 | + <: nil |
| 136 | + Mix.run plugin $ do |
| 137 | + when (opts ^. #withCommit) $ MixShell.exec (Git.pull []) |
| 138 | + generate path |
| 139 | + when (opts ^. #withCommit) $ commitGeneratedFiles |
| 140 | + where |
| 141 | + logOpts = ... |
| 142 | + |
| 143 | +commitGeneratedFiles :: RIO Env () |
| 144 | +commitGeneratedFiles = do |
| 145 | + files <- view #files <$> asks (gitConfig . view #config) |
| 146 | + MixShell.exec $ do |
| 147 | + Git.add files |
| 148 | + changes <- Git.diffFileNames ["--staged"] |
| 149 | + when (not $ null changes) $ Git.commit ["-m", message] |
| 150 | + where |
| 151 | + message = ... |
| 152 | +``` |
| 153 | + |
| 154 | +全ての差分はこの[PR](https://github.com/haskell-jp/antenna/pull/21)から確認できます。 |
| 155 | +`runCmd` 関数に追記したのは `when (opts ^. #withCommit)` から始まる2行です(`Options` に `#withCommit` を追加しています)。 |
| 156 | +mix.hsのshellプラグインを使うことでShellyのログをだいたいそれっぽくrioのロガーに流してくれます。 |
| 157 | + |
| 158 | +次に、`git push`も実装します |
| 159 | + |
| 160 | +```haskell |
| 161 | +runCmd :: Options -> Maybe FilePath -> IO () |
| 162 | +runCmd opts (Just path) = do |
| 163 | + ... |
| 164 | + Mix.run plugin $ do |
| 165 | + when (opts ^. #withCommit) $ MixShell.exec (Git.pull []) |
| 166 | + generate path |
| 167 | + when (opts ^. #withCommit) $ commitGeneratedFiles |
| 168 | + when (opts ^. #withPush) $ pushCommit |
| 169 | + |
| 170 | +pushCommit :: RIO Env () |
| 171 | +pushCommit = do |
| 172 | + branch <- view #branch <$> asks (gitConfig . view #config) |
| 173 | + MixShell.exec (Git.push ["origin", branch]) |
| 174 | +``` |
| 175 | + |
| 176 | +前から使っている `gitConfig` は設定ファイルからgitコマンドに関する設定を取ってきています(例えば、どのファイルをコミットするかやどのブランチにプッシュするかなど)。 |
| 177 | + |
| 178 | +これで、差分があった場合は`git commit`を実行し、最後に`git push`するようなオプション、`--with-commit`と`--with-push`を実装できました(他にも実装していますが割愛)。 |
| 179 | + |
| 180 | +## 毎時実行 |
| 181 | + |
| 182 | +メインディッシュである毎時実行です。 |
| 183 | +Haskell-jp Slackで、スケジューリング実行をHaskellアプリケーション内で行うのにちょうど良いパッケージはありますか?と尋ねたところ[cron](https://hackage.haskell.org/package/cron)というパッケージを紹介してもらいました(名前がややこしい笑)。 |
| 184 | +調べてみたところ、ちょうど良さそうなのでこれを使うことにします |
| 185 | + |
| 186 | +```haskell |
| 187 | +import System.Cron (addJob, execSchedule) |
| 188 | + |
| 189 | +main :: IO () |
| 190 | +main = withGetOpt' "[options] [input-file]" opts $ \r args usage -> |
| 191 | + if | r ^. #help -> hPutBuilder stdout (fromString usage) |
| 192 | + | r ^. #version -> hPutBuilder stdout (Version.build version) |
| 193 | + | r ^. #hourly -> runCmd r (listToMaybe args) `withCron` "0 * * * *" |
| 194 | + | otherwise -> runCmd r (listToMaybe args) |
| 195 | + where |
| 196 | + opts = ... |
| 197 | + |
| 198 | +withCron :: IO () -> Text -> IO () |
| 199 | +withCron act t = do |
| 200 | + _ <- execSchedule $ addJob act t |
| 201 | + forever $ threadDelay maxBound -- 無限ループ |
| 202 | +``` |
| 203 | + |
| 204 | +全ての差分はこの[PR](https://github.com/haskell-jp/antenna/pull/22)から確認できます。 |
| 205 | +すっごい簡単ですね。 |
| 206 | +ついでに、毎日実行と毎分実行するオプションも追加しています。 |
| 207 | + |
| 208 | +これでアプリケーションの方は出来上がったので、こいつをGCEインスタンスで動作させてみましょう。 |
| 209 | + |
| 210 | +# インスタンスで起動する |
| 211 | + |
| 212 | +まずはGCP Consoleからインスタンス作成します。 |
| 213 | +構成は次の通りです |
| 214 | + |
| 215 | +- f1-micro |
| 216 | +- オレゴンリージョン |
| 217 | +- 30GBの標準ストレージ |
| 218 | +- OSはUbuntu 18.04 |
| 219 | + |
| 220 | +GCP ConsoleからSSHして、docker コマンドをインストールします(やり方は[公式サイト](https://docs.docker.com/install/linux/docker-ce/ubuntu/)のをそのまま)。 |
| 221 | +ここまでできたら試しに `sudo docker pull haskelljp/antenna` して最新のイメージを取得してみましょう。 |
| 222 | + |
| 223 | +次に、GitHubにプッシュするためにSSH Keyを生成してデプロイキーを haskell-jp/antenna リポジトリに設定します。 |
| 224 | +できたら適当に `git clone [email protected]:haskell-jp/antenna.git` してブランチを `gh-pages` に切り替えます。 |
| 225 | + |
| 226 | +あとは次のコマンドでantennaプログラムを実行するだけです |
| 227 | + |
| 228 | +``` |
| 229 | +$ sudo docker run -d \ |
| 230 | + -v `pwd`:/work |
| 231 | + -v `echo $HOME`/.ssh:/root/.ssh \ |
| 232 | + haskelljp/antenna antenna --verbose --with-commit --with-push --with-copy --hourly sites.yaml |
| 233 | +``` |
| 234 | + |
| 235 | +`docker logs` を使って様子をみてましたが、うまくいってるようです! |
| 236 | + |
| 237 | +# 今後やりたいこと |
| 238 | + |
| 239 | +igrep氏が[Issue](https://github.com/haskell-jp/antenna/issues/16)にしてくれてるように、Haskell Antennaの正しい差分をHaskell-jp Slackに通知する仕組みを整備しようと考えてます。 |
| 240 | + |
| 241 | +実はコミットをHaskellアプリケーション内で組み立てるようになった結果、Haskellアプリケーション側でいい感じに差分を調べ上げ、その結果をコミットメッセージに組み込むことができるようになりました。 |
| 242 | +さすがにHTMLやフィードの `git diff` を解析するのは大変なので、いい感じに各サイトの最終更新ログを残すようにしてみようかなって考えてます。 |
0 commit comments