R で LINEBOT を作ろう http://blog.recyclebin.jp/archives/4573

linebot.R

suppressPackageStartupMessages({
   library(magrittr)
   library(stringr)
   library(Rook)
   library(shadowy)
   library(logging)
   library(aws.s3)
   library(ggplot2)
   library(scales)
})

#
# ここにボットの動作を設定する
#
respond <- function(content) {
   # テキストを取得
   text <- content$text

   values <- strsplit(text, ",") %>% unlist() %>% str_trim()
   e <- if (length(values) == 1) {
      .GlobalEnv
   } else {
      asNamespace(values[2])
   }
   if (exists(values[1], envir = e)) {
      data <- get(values[1], envir =  e)
      if (is.data.frame(data)) {
         g <- GGally::ggpairs(data)
         return(list(
            content = g,
            mid = I(as.character(content$from))
         ))
      } else {
         text <- paste(class(data), collapse = ", ")
      }
   }

   list(
      content = as.character(text),
      mid = I(as.character(content$from))
   )
}

#
# 以下は基本的にいじらなくて大丈夫
#

# 設定読み込み
config <- local({
   json <- paste(readLines("config.json"), collapse="")
   jsonlite::fromJSON(json)
})
CHANNEL_ID <- config$channel$id
CHANNEL_SECRET <- config$channel$secret
CHANNEL_MID <- config$channel$mid
PORT <- config$server$port
LOGGING_LEVEL <- config$logging$loglevel

Sys.setenv(
   "AWS_ACCESS_KEY_ID" = config$aws$access_key,
   "AWS_SECRET_ACCESS_KEY" = config$aws$secret_key
)
BUCKET_NAME <- config$aws$s3$bucket
BUCKET_REGION <- config$aws$s3$region
S3_ENDPOINT_URL <- sprintf("https://s3.amazonaws.com/%s", BUCKET_NAME)

# LINE API
build_content <- function(x, ...) {
   UseMethod("build_content")
}

build_content.character <- function(x) {
   logdebug("Preparing text message")

   CONTENT_TYPE <- 1
   TO_TYPE <- 1  # to user

   list(
      "contentType" = CONTENT_TYPE,
      "toType" = TO_TYPE,
      "text" = x
   )
}

build_content.gg <- function(x, width = 1024, height = 1024, ...) {
   logdebug("Preparing image message")

   CONTENT_TYPE <- 2
   TO_TYPE <- 1
   
   arguments <- list(width = width, height = height, ...)
   default_args <- formals(jpeg)

   width <- if (!is.null(arguments$width)) {
      arguments$width
   } else {
      default_args$width
   }
   height <- if (!is.null(arguments$height)) {
      arguments$height
   } else {
      default_args$height
   }
   if (width >= height) {
      thumbnail_width <- 256
      thumbnail_height <- as.integer(256 * (height / width))
   } else {
      thumbnail_width <- as.integer(256 * (width / height))
      thumbnail_height <- 256
   }

   logdebug(sprintf("Image size: {\"original\": [%d, %d], \"thumbnail\": [%d, %d] }", width, height, thumbnail_width, thumbnail_height))
   
   tmpdir <- tempfile()
   dir.create(tmpdir)
   on.exit(unlink(tmpdir, recursive = TRUE, force = TRUE))
   logdebug(sprintf("Temporary directory: %s", tmpdir))
   
   image_file <- tempfile(fileext = ".jpg", tmpdir = tmpdir)
   local({
      jpeg(image_file, width = width, height = height, ...)
      on.exit(dev.off())
      print(x)
   })
   logdebug("Original image is successfully created")
   
   thumbnail_file <- tempfile(fileext = ".jpg", tmpdir = tmpdir)
   original_image <- imager::load.image(image_file)
   thumbnail_image <- imager::resize(original_image, thumbnail_width, thumbnail_height)
   imager::save.image(thumbnail_image, thumbnail_file)
   logdebug("Thumbnail image is successfully created")
   
   prefix <- sprintf("%s/%s/", strftime(Sys.Date(), "%Y-%m-%d"), uuid::UUIDgenerate())
   original_key <- sprintf("%soriginal.jpg", prefix)
   thumbnail_key <- sprintf("%sthumbnail.jpg", prefix)
   aws.s3::put_object(image_file, original_key, BUCKET_NAME)
   logdebug(sprintf("Upload original image: s3://%s/%s", BUCKET_NAME, original_key))
   aws.s3::put_object(thumbnail_file, thumbnail_key, BUCKET_NAME)
   logdebug(sprintf("Upload thumbnail image: s3://%s/%s", BUCKET_NAME, thumbnail_key))

   list(
      "contentType" = CONTENT_TYPE,
      "toType" = TO_TYPE,
      "originalContentUrl" = sprintf("%s/%s", S3_ENDPOINT_URL, original_key),
      "previewImageUrl" = sprintf("%s/%s", S3_ENDPOINT_URL, thumbnail_key)
   )
}

post_message <- function(response) {
   LINE_ENDPOINT <- "https://trialbot-api.line.me/v1/events"

   build_message <- function(content, mid) {
      TO_CHANNEL <- 1383378250
      EVENT_TYPE <- "138311608800106203"

      list(
         "to" = I(mid),
         "toChannel" = TO_CHANNEL,
         "eventType" = EVENT_TYPE,
         "content" = build_content(content)
      )
   }

   message <- build_message(response$content, response$mid)
   logdebug(sprintf("Message: %s", jsonlite::toJSON(message, auto_unbox = TRUE)))
   headers <- c(
      "Content-Type" = "application/json; charset=UTF-8",
      "X-Line-ChannelID" = CHANNEL_ID,
      "X-Line-ChannelSecret" = CHANNEL_SECRET,
      "X-Line-Trusted-User-With-ACL" = CHANNEL_MID
   )

   # POST it!
   response <- httr::POST(LINE_ENDPOINT, httr::add_headers(.headers = headers), body = message, encode = "json", httr::timeout(5))
   logdebug(sprintf("LINE response status: %s", httr::status_code(response)))
}

# リクエストバリデーション
validate_request <- as.http.source(function(context) {
   signature <- context$request$HTTP_X_LINE_CHANNELSIGNATURE

   if (is.null(signature)) {
      logwarn("シグネチャがヘッダに含まれません")
      none
   } else {
      body <- context$request$rook.input$field("postBody")
      secret_bytes <- charToRaw(CHANNEL_SECRET)
      expected <- digest::hmac(secret_bytes, body, "sha256", raw = TRUE)
      expected <- base64enc::base64encode(expected)
      logdebug(sprintf("Signature (actual, expected): (%s, %s)", signature, expected))
      if (signature == expected) {
         loginfo("シグネチャの検証に成功しました")
         some(context)
      } else {
         logwarn("不正なシグネチャを受け取りました")
         none
      }
   }
})

# ボット動作
bot_action <- as.http.source(function(context) {
tryCatch({
   loginfo("メッセージを受信しました")

   body <- context$request$rook.input$field("postBody")
   body <- rawToChar(body)
   Encoding(body) <- "UTF-8"

   logdebug(sprintf("Raw request: %s", body))

   request <- jsonlite::fromJSON(body, FALSE)
   logdebug(sprintf("Request: %s", jsonlite::toJSON(request, auto_unbox = TRUE)))

   if (length(request$result) == 0) {
      logwarn("不正な LINE リクエストです")
      context$response$status <- 400
      context$response$body <- "Invalid Request"
   } else {
      # 1 つずつしかこないと思うけど array なので
      for (content in request$result) {
         logdebug(sprintf("Content: %s", jsonlite::toJSON(content, auto_unbox = TRUE)))
         # do response
         response <- respond(content$content)
         post_message(response)
         loginfo("メッセージを返信しました")
      }
   }

   some(context)
}, error = function(e) {
   logerror(e)
   none
})
})

# アプリケーションルート
app_builder <- route(
   path("/callback") %>>%
      POST %>>%
      validate_request %>>%
      bot_action
)

# ロギング設定
setLevel(LOGGING_LEVEL)
formatter <- function(record) {
    msg <- record$msg
    timestamp <- record$timestamp
    level <- record$level
    levelname <- record$levelname
    sprintf("%s, [%s] [%s] %s", level, timestamp, levelname, msg)
}
addHandler(writeToFile, file = "linebot.log", formatter = formatter, level = LOGGING_LEVEL)
if (interactive()) {
   addHandler(writeToConsole, formatter = formatter, level = LOGGING_LEVEL)
}

# サーバー起動
loginfo("ボットサーバーを起動しています...")
httpd <- Rhttpd$new()
httpd$add(name = "linebot", app = api(app_builder))
httpd$start(port = PORT, quiet = TRUE)
loginfo("ボットサーバーの準備が整いました")
# イベントループ
Sys.sleep(Inf)