Servantで認証付きAPIのクライアントを作ってcoincheckから自分の取引履歴をExcelで出力する

やりたいことは表題の通りです。ポイントは以下の2つ

* 認証つきAPIのクライアントを作る
* Excelで出力する

活躍するのは[servant-client](http://hackage.haskell.org/package/servant-client)と[xlsx](http://hackage.haskell.org/package/xlsx)というライブラリです。ServantやLensに慣れていない人は以下のリンクを参考に勉強してみてください :mortar_board: 

* [haskell-servant の利用例とちょっとだけ仕組みの調査](http://krdlab.hatenablog.com/entry/2014/12/31/170158)
* [【型レベルWeb DSL】 Servantの紹介](http://qiita.com/lotz/items/883b41fa79f060e59efa)
* [LensでHaskellをもっと格好良く！](http://www.slideshare.net/itsoutoftunethismymusic/ekmett-17955009)
* [Lensで行こう！](http://myuon-myon.hatenablog.com/entry/20121228/1356708483)

データ構造を定義する
------------------

まずは取得するトランザクションのデータ構造を定義しましょう。今回利用するAPIはcoincheckの[注文の取引履歴のAPI](https://coincheck.jp/documents/exchange/api?locale=ja#order-transactions)です。

```hs:app/Types.hs
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}

module Types where

import GHC.Generics
import Data.Aeson

data Funds = Funds
  { btc :: String
  , jpy :: String
  } deriving (Show, Generic, FromJSON, ToJSON)

data Transaction = Transaction
  { id           :: Int
  , order_id     :: Int
  , created_at   :: String
  , funds        :: Funds
  , pair         :: String
  , rate         :: String
  , fee_currency :: Maybe String
  , fee          :: String
  , liquidity    :: String
  , side         :: String
  } deriving (Show, Generic, FromJSON, ToJSON)

data Transactions = Transactions
  { success      :: Bool
  , transactions :: [Transaction]
  } deriving (Show, Generic, FromJSON, ToJSON)
```

難しいことはしていないので少し眺めてそんなものかと思ってもらえれば大丈夫です。

クライアントを作る
----------------

それではAPIにアクセスするクライアントを作っていきましょう。
これからアクセスするAPIはPrivateで[認証](https://coincheck.jp/documents/exchange/api?locale=ja#auth)がかかっておりアクセスするには[API Key](https://coincheck.jp/api_settings)を発行する必要があります。

coincheckではAPI Keyを作成する際に細かい権限の制御ができます。今回は注文の取引履歴しか取得しないのでそれだけチェックを入れておきます。

![](https://i.gyazo.com/18c2cd4cc9cb68ec03fd00f3e81441f6.png)

API Keyを作ったらいよいよコードを書いていきましょう
まずは作ったAPI Keyを管理するデータ構造を定義します

```hs
import Data.Time
import Data.ByteString.Lazy.Char8 (ByteString)
import qualified Data.ByteString.Lazy.Char8 as BL

data APIKey = APIKey
  { key    :: ByteString
  , secret :: ByteString
  }

type Auth = (APIKey, ByteString)

genAuth :: APIKey ->  IO Auth
genAuth token = do
  nonce <-  BL.pack . formatTime defaultTimeLocale "%s" <$> getCurrentTime
  pure (token, nonce)
```

認証時に使うnonceは時刻を利用しているので副作用を伴う`genAuth`を経由して取得するようにしておきます。`APIKey`と`Auth`を分けることでnonceの生成を必ず行うようにしています。

次にServant DSLを使ってAPIの定義を書いていきます。

```hs
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}

import Data.Digest.Pure.SHA
import Data.Proxy
import Servant.API
import qualified Servant.Common.Req as Req

data Private

type CoincheckAPI = "api" :> "exchange" :> "orders" :> "transactions" :> Private :> Get '[JSON] Transactions

instance (HasClient sublayout) => HasClient (Private :> sublayout) where
  type Client (Private :> sublayout) = Auth -> Client sublayout

  clientWithRoute _ req baseurl (apiKey, nonce) =
    let url = "https://coincheck.jp" ++ Req.reqPath req
        body = maybe "" fst $ Req.reqBody req
        signature = showDigest $ hmacSha256 (secret apiKey) (mconcat [nonce, BL.pack url, body])
        req' = Req.addHeader "ACCESS-KEY" (BL.unpack $ key apiKey)
               . Req.addHeader "ACCESS-NONCE" (BL.unpack nonce)
               . Req.addHeader "ACCESS-SIGNATURE" signature
               $ req
    in clientWithRoute (Proxy :: Proxy sublayout) req' baseurl
```

`Private`という新しいServant DSLを定義しています。今のところ`HasClient`のインスタンスのみ作っており、これがある場合は`Auth`を使って認証情報を付加したリクエストを生成してくれるようになります。今回は一つのエンドポイントしか使いませんが複数ある時でも`Private`というDSLを加えるだけで認証に対応したクライアントを作ってくれるのでとても便利です。

クライアントを作っておきましょう。

```hs
import Control.Monad.Trans.Either
import Data.Proxy
import Servant.Client

coincheckAPI :: Proxy CoincheckAPI
coincheckAPI = Proxy

getExchangeOrdersTransactions :: Auth -> EitherT ServantError IO Transactions
getExchangeOrdersTransactions = client coincheckAPI $ BaseUrl Https "coincheck.jp" 443
```

Excelで出力する
--------------

Excel...
でもHaskellならExcelのファイルを作るのも簡単です！
というか必要があって[xlsx](http://hackage.haskell.org/package/xlsx)を使ったらマジ便利だったので今回の記事を書いた次第です

使い方は`Worksheet`とかのデータ構造を作ってLensで値を突っ込んで終わり！

```hs
import Codec.Xlsx
import Control.Lens
import System.Time

createExcel :: [Transaction] -> IO ()
createExcel ts = do
  ct <- getClockTime
  BL.writeFile "取引履歴.xlsx" $ fromXlsx ct xlsx
    where
      setHeader sheet = sheet & cellValueAt (1,1) ?~ CellText "Order ID"
                              & cellValueAt (1,2) ?~ CellText "Side"
                              & cellValueAt (1,3) ?~ CellText "Rate"
                              & cellValueAt (1,4) ?~ CellText "Liquidity"
                              & cellValueAt (1,5) ?~ CellText "BTC"
                              & cellValueAt (1,6) ?~ CellText "Date"
      setTs (t, n) sheet = sheet & cellValueAt (n,1) ?~ CellDouble (fromIntegral . order_id $ t)
                                 & cellValueAt (n,2) ?~ CellText (Text.pack . side $ t)
                                 & cellValueAt (n,3) ?~ CellText (Text.pack . rate $ t)
                                 & cellValueAt (n,4) ?~ CellText (Text.pack . liquidity $ t)
                                 & cellValueAt (n,5) ?~ CellText (Text.pack . btc . funds $ t)
                                 & cellValueAt (n,6) ?~ CellText (Text.pack . created_at $ t)
      xlsx = def & atSheet "Transactions" ?~ (foldr setTs (setHeader def) $ zip ts [2..])
```

今までの関数を組み合わせて表題のプログラムを完成させましょう。アクセスキーとシークレットは伏せてありますｗ

```hs
main :: IO ()
main = do
  let apiKey = APIKey { key = "access-key", secret = "access-secret" }
  auth <- genAuth apiKey
  ts <- transactions . either (error . show) id <$> (runEitherT $ getExchangeOrdersTransactions auth)
  createExcel ts
```

![](https://i.gyazo.com/d71239bec948d62c58fc67cadb807e3d.png)

成果物をプレビューしようとしたら家のPCにExcelが入ってなかったのでMacのプレビューで確認しました。2件しかありませんがちゃんと取引履歴が出力されていますね！

コメント下さい :bow: 
----

出来あがったコードですがいくつか不満なところがあります。

まず自分で作ったServant DSL `Private`の使い方なのですが今は

```hs
type CoincheckAPI = "api" :> "exchange" :> "orders" :> "transactions" :> Private :> Get '[JSON] Transactions
```

このように使っていますが本当は

```hs
type CoincheckAPI = Private :> "api" :> "exchange" :> "orders" :> "transactions" :> Get '[JSON] Transactions
```

このように先頭で宣言したいです。この方が

```hs
type CoincheckAPI = Private :>
                          ("api" :> "exchange" :> "orders" :> "transactions" :> Get '[JSON] Transactions
                      :<|> "api" :> "exchange" :> "leverage" :> "positions" :> Get '[JSON] Positions
                      :<|> "api" :> "accounts" :> "balance" :> Get '[JSON] Balance)
```

のようにPrivateなAPIだけまとめてしまって見やすく宣言することが出来るはずです。しかし認証情報を作成するにはリクエストのBodyの情報が必要なのですが`Private`を先頭に書いてしまうとそれに対応する`HasClient`のメソッド`clientWithRoute`が実行されるタイミングではまだリクエストのBodyが存在しないということが起こりえます。なので今回は`Get`の直前に書きました。何とかして先頭で宣言する方法はないでしょうか…

次にnonceの生成タイミングなのですが、今回は`genAuth`という関数でごまかしましたが本当はクライアントには`APIKey`だけ渡してしまえば十分なはずです。しかし処理を記述する`clientWithRoute`の型は`Proxy layout -> Req -> BaseUrl -> Client layout`となっていて直接は`IO`が現れていないので`getCurrentTime`が使えずnonceも生成できません。ですが結果的に`Client layout`は`IO`の上にモナド交換子を積んだような型になるので実行は可能なはずです。何とかして`clientWithRoute`の実装でnonceを生成する方法はないでしょうか…

最後は[`time`](http://hackage.haskell.org/package/time)の使い方の話なのですが、nonceを生成している部分の

```hs
formatTime defaultTimeLocale "%s" <$> getCurrentTime
```

ですが、実はこれ秒までしかとれていません。なので実際は1秒以内に複数リクエストを送ると失敗してしまいます :sweat: 修正する方法はとても簡単でミリ秒まで取得するようにすればいいのですが、`time`のフォーマッタではミリ秒を直接手に入れることが出来ず秒より細かい値を取得しようと思ったらいきなりピコ秒になってしまします。ピコ秒にすると今度はcoincheckが設けている値の上限に達してしまうので使えません。結果は文字列なので反転してdropして反転すれば欲しい値は手に入るのですがあまりいい方法ではないと思うのでこの辺を柔軟に取得する方法があったら教えてほしいです :bow:

----

最後にcabalファイルと全コードを載せておきます

```:coincheck-trades-excel.cabal
name:                coincheck-trades-excel
version:             0.1.0.0
synopsis:            Initial project template from stack
license:             BSD3
build-type:          Simple
cabal-version:       >=1.10

executable coincheck-trades-excel-exe
  hs-source-dirs:      app
  main-is:             Main.hs
  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
  build-depends:       base
                     , bytestring
                     , text
                     , time
                     , old-time
                     , transformers
                     , either
                     , aeson
                     , SHA
                     , servant
                     , servant-client
                     , lens
                     , xlsx
  default-language:    Haskell2010
```

```hs:app/Types.hs
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}

module Types where

import GHC.Generics
import Data.Aeson

data Funds = Funds
  { btc :: String
  , jpy :: String
  } deriving (Show, Generic, FromJSON, ToJSON)

data Transaction = Transaction
  { id           :: Int
  , order_id     :: Int
  , created_at   :: String
  , funds        :: Funds
  , pair         :: String
  , rate         :: String
  , fee_currency :: Maybe String
  , fee          :: String
  , liquidity    :: String
  , side         :: String
  } deriving (Show, Generic, FromJSON, ToJSON)

data Transactions = Transactions
  { success      :: Bool
  , transactions :: [Transaction]
  } deriving (Show, Generic, FromJSON, ToJSON)
```

```hs:app/Main.hs
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

import Codec.Xlsx
import Control.Lens
import Control.Monad.Trans.Either
import Data.ByteString.Lazy.Char8 (ByteString)
import qualified Data.ByteString.Lazy.Char8 as BL
import qualified Data.Text as Text
import Data.Time
import Data.Digest.Pure.SHA
import Data.Proxy
import Servant.API
import Servant.Client
import qualified Servant.Common.Req as Req
import System.Time
import Types hiding (id)

data AuthToken = AuthToken
  { key    :: ByteString
  , secret :: ByteString
  }

type Auth = (AuthToken, ByteString)

genAuth :: AuthToken -> IO Auth
genAuth token = do
  nonce <- BL.pack . formatTime defaultTimeLocale "%s" <$> getCurrentTime
  pure (token, nonce)

data Private

type CoincheckAPI = "api" :> "exchange" :> "orders" :> "transactions" :> Private :> Get '[JSON] Transactions

instance (HasClient sublayout) => HasClient (Private :> sublayout) where
  type Client (Private :> sublayout) = Auth -> Client sublayout

  clientWithRoute _ req baseurl (apiKey, nonce) =
    let url = "https://coincheck.jp" ++ Req.reqPath req
        body = maybe "" fst $ Req.reqBody req
        signature = showDigest $ hmacSha256 (secret apiKey) (mconcat [nonce, BL.pack url, body])
        req' = Req.addHeader "ACCESS-KEY" (BL.unpack $ key apiKey)
               . Req.addHeader "ACCESS-NONCE" (BL.unpack nonce)
               . Req.addHeader "ACCESS-SIGNATURE" signature
               $ req
    in clientWithRoute (Proxy :: Proxy sublayout) req' baseurl

coincheckAPI :: Proxy CoincheckAPI
coincheckAPI = Proxy

getExchangeOrdersTransactions :: Auth -> EitherT ServantError IO Transactions
getExchangeOrdersTransactions = client coincheckAPI $ BaseUrl Https "coincheck.jp" 443

createExcel :: [Transaction] -> IO ()
createExcel ts = do
  ct <- getClockTime
  BL.writeFile "取引履歴.xlsx" $ fromXlsx ct xlsx
    where
      setHeader sheet = sheet & cellValueAt (1,1) ?~ CellText "Order ID"
                              & cellValueAt (1,2) ?~ CellText "Side"
                              & cellValueAt (1,3) ?~ CellText "Rate"
                              & cellValueAt (1,4) ?~ CellText "Liquidity"
                              & cellValueAt (1,5) ?~ CellText "BTC"
                              & cellValueAt (1,6) ?~ CellText "Date"
      setTs (t, n) sheet = sheet & cellValueAt (n,1) ?~ CellDouble (fromIntegral . order_id $ t)
                                 & cellValueAt (n,2) ?~ CellText (Text.pack . side $ t)
                                 & cellValueAt (n,3) ?~ CellText (Text.pack . rate $ t)
                                 & cellValueAt (n,4) ?~ CellText (Text.pack . liquidity $ t)
                                 & cellValueAt (n,5) ?~ CellText (Text.pack . btc . funds $ t)
                                 & cellValueAt (n,6) ?~ CellText (Text.pack . created_at $ t)
      xlsx = def & atSheet "Transactions" ?~ (foldr setTs (setHeader def) $ zip ts [2..])

main :: IO ()
main = do
  let apiKey = APIKey { key = "access-key", secret = "access-secret" }
  auth <- genAuth apiKey
  ts <- transactions . either (error . show) id <$> (runEitherT $ getExchangeOrdersTransactions auth)
  createExcel ts
```