Haskellに入門ついでにPythonに替えて株のシステムトレードプログラムを作る。

続きがあります

MariaDB(MySQL)から取り出した株価からテクニカル指標を計算してチャートをJupyter NotebookとExcel両方で描いてみた。

電子工作をしているとオシロとかが欲しくなってくるでしょ。資金が増えたらええなと株式投資を始めた。 ところが2016年1月から4月までの暴落で損した。 電子工作に使う年間予算の10年分くらいをね。含み損を放置したあげく難平買いまでしたせいでさらに増えた含み損に耐えられなかったのが敗因。損切りは大事だと痛感した。その資金って暑い中エアコンを取付けたりとか、照明器具付けたりとか 電柱に登ったりとか、ユンボで地面を掘って配管を埋めたりとか 地面に接地棒を必死に打ち込んだりとか 絶縁抵抗不良の改修のために、真夏の天井裏に入ったりとかして稼いだのに  なに,この仕打ち。

結論。裁量トレードは自分には無理。仕事中に株価など気にしてられませんって。

裁量トレードが無理ならアルゴリズムトレードしようかと考えて検索してみてもどうも参考にならない。仕方が無いので、電子工作と関係の無いプログラムはやる気にならないけれども、予算がなければ何も出来ないので渋々ながらプログラムでも書こうかと思う。プログラミングは電子工作ほどに金がかからないからね。

資金を貯めるまで仕事優先、趣味は後回しで。

失った資金は消えて無くなったわけでは無くて、この世界に広く薄くばらまかれたわけであるから、またがんばって自分の手に集めてこなければならない。

それはしんどいから人力(裁量)では無く機械力(システム)で行ないたい。都合よくサーバーの学習でVPSを借りていたから自分の管理するサーバー(つまりこのサイト)でデーモンプロセスにしておけば、 人間には不可能な24時間運転で監視が可能だろ、と思いつく。

思いつきはとにかくとして東京証券取引所はAM9:00~AM11:30, PM12:30~PM15:00の1日5時間が取引時間だからその時間以外は見ても仕方が無いですよ。分かっていますよ。

アプリケーションに保有株を監視させるためにAPI接続出来る証券会社はないのか?

「株 API」でググると出てくるkabu.comだけど

「kabu.com API」提供方法
当面は当社と個別に「kabu.com API 利用契約」を締結したトレードツール提供業者様向けに提供して参ります。当社のお客さまが「kabu.com API」を利用するためには、個人・法人問わず当社にて証券口座、信用口座、先物・オプション口座、FX口座を必要に応じてご開設いただき、「kabu.com APIサービス利用規定」にご同意いただいた上で、トレードツール提供業者様のツールを使用していただく形態となります。
トレードツールの提供方法・ご利用方法につきましては、トレードツール開発業者様からの申請に応じて別途審査等により許諾することを予定しておりますが、詳細につきましては今後順次ご案内いたします。
カブドットコム証券

デーモンプロセスから直接API接続が可能とは書いていないです。惜しい。

次は岡三RSS楽天RSS

よく分からないけどcentosサーバーでExcelを動かせないから、それは無しの方向で。

APIが無いなら自動売買ソフトは何をしているのか?と。さらに調べたらスクレイピング(自分はWebプログラマでは無いから今回初めて知った。)技術でAPI接続と似たような事をしているようで。

考えたら、ブラウザの動きをプログラムで模倣したら同じ事やね。

これから作るアプリケーションですること

  1. 証券会社のサイトにログイン
  2. Webページからスクレイピング
  3. データーベースへ格納
  4. データーベースから保有株式の状況を確認する
  5. 含み損なら損失は迅速に損切り、含み益なら適度に利食い

 こんな作業を株式市場の立ち会い時間中に定時でさせるのが目標。買い?手動でええやん。

思いつきのままPythonで書いてみる

ではPythonでぼちぼち書く。ところがさくらのVPS512プランでは動かしてみると重い。どうもメモリ512MBではフルSSLのWordpressの運用は無理があるようで、その上にこのアプリケーションでサーバーの負担を増やすとWebサーバーがエラーを返しかねない。

仕方が無い。Pythonよりも高速度な言語に書き換えるか。

Haskell言語を投入

Pythonよりも高速度な言語といえばこの時に使ったC言語だけども、C言語で文字列処理はとてもしんどいので、それは最終手段に取っておくことにする。そもそもC言語を採用した理由がATMega328Pのメモリー(SRAM)が2kBytesだから(組み込みMCUだぞ)C言語しか選べなかったので。

SRAM Data Memory – ATmeage48A/PA/88A/PA/168A/PA/328/P

出典:ATMEL 8-BIT MICROCONTROLLER DATASHEET 8.3 SRAM Data Memory

それに比べれば無限に近いメモリーを使えるサーパー上のプログラム。テキスト処理に長けていてPythonより高速度な言語(測定していないけど、コンパイルに時間を使っているからスクリプト言語には勝つだろうと思う)という物はHaskell言語しか思いつかなかったんだよ。

ではまずHaskell – Wikipediaを読んで、関数型言語のHelloworldといえるフィボナッチ数列をやってみた。

 > fibs = 0 : 1 : zipWith (+) fibs (tail fibs)
 > take 10 $ fibs
[0,1,1,2,3,5,8,13,21,34]

0,1,1,2,3,5,8,13,21,34だって。こんなの計算してどうなるんだ?と思うけど突然フィボナッチ数列が計算したくなったときのために覚えておく。

カレンダーをもらった。

この時とかこの時とかこの時とかに使ったMATLAB/Octaveとかこの時のPython(今から見るとHaskell学習中の匂いのするコードだな)とかこの時のCとかと違って初めて使う言語なんで本でも買ってこないとね。すでにOcamlに入門しているので入門書はいらないよ。ということで、オライリー本を買ってきたらオライリーのカレンダーをもらった。

PythonからHaskellへポーティング

純粋関数型言語であれなんであれ似たようなもんでしょって気分でいろいろ書いてみると。おおざっぱに言うと関数型言語ってのは写像 = mapping = 関数の操作を繰り返しているんだろ。つまりこの時に使ってるラプラス変換 – Wikipediaみたいな操作を合成しているんだろう。ところでラプラス変換とかはWikipediaにあるとおりこれはオリヴァー・ヘヴィサイドの功績が大きいんだろうね。自分は電気屋なんで結局使えたらええの。理論的証明とか興味ないの。「数学は実験的科学であり、定義が先にくるわけではない」とかそんな感じで前進すんぞ。ところでモナドってなんだ?

通知はSlackでしよう

ここから
Team settings
Menu
Configure Apps
Incoming Webhooks
#generalとかを選択する(何でもいい)
Webhook URLをメモしておく

通知がメールだと遅いから、このアプリケーションからの通知はSlackでやります、流行ってるから。Slackのチームが無い人はhttps://slack.com/にアクセスしてメールアドレスを入れてSign upよろしくです。Slack API Incoming WebHooksを使うのでこの通りにWebhook URLを入手しておいてください。

開発&実行環境

% uname -r -o
3.10.0-514.2.2.el7.x86_64 GNU/Linux

将来的にデーモンプロセスにする予定なので、まずposix環境を用意してください。tmuxとかGNU screenとかがあると便利ですよ。

Stackのインストール

% curl -sSL https://get.haskellstack.org/ | sh
How to install - https://docs.haskellstack.org/en/stable/README/より

Stackのインストールがすんだら、GitHubにて公開しているアプリケーションの配布ファイル一式を取ってきて、stack setup, stack buildしたら自動で依存ファイルのインストールをしてくれる。

% stack build
Downloaded lts-7.10 build plan.
Fetching package index ...remote: Counting objects: 7, done.
remote: Compressing objects: 100% (5/5), done.
remote: Total 7 (delta 2), reused 7 (delta 2), pack-reused 0
Unpacking objects: 100% (7/7), done.
From https://github.com/commercialhaskell/all-cabal-hashes

% stack setup
Preparing to install GHC to an isolated location.
This will not interfere with any system-level installation.
ghc-8.0.1:    3.55 MiB / 108.01 MiB (  3.29%) downloaded...

設定ファイルを用意する

配布ファイル一式に設定ファイルは無いので、実行の前に設定ファイルを用意してください。

% ls
LICENSE  README.md  Setup.hs  app  doc  src  stack.yaml  test  tractor.cabal
% cp test/conf.test.json conf.json
% cat conf.json 
{
    "recordAssetsInterval"  : 10,
    "sendReportInterval"    : 20,
    "loginURL"          : "https://www.deal.matsui.co.jp/ITS/login/MemberLogin.jsp",
    "loginID"           : "enter loginID",
    "loginPassword"     : "enter loginPassword",
    "dealingsPassword"  : "enter dealingsPassword",
    "userAgent"         : "enter userAgent",
    "slack" : {
        "webHookURL"    : "enter webHookURL",
        "channel"       : "enter channel",
        "userName"      : "enter userName"
    }
}
% 
recordAssetsInterval
現在値を見に行く時間間隔(分)
sendReportInterval
通知する時間間隔(分)
loginURL
証券サイトのログインURL
loginID
ログインID
loginPassword
ログインパスワード
dealingsPassword
取引パスワード
userAgent
ユーザーエージェント httpbin.org/user-agentにアクセスすると確認出来る(実際は何を書いてもいいんだけどね)
webHookURL
SlackのWebhook URL 例 https://hooks.slack.com/~~~~
channel
Slackのchannel 例 #general
userName
Slackのuser name

特にhttpbin.orgというサイトはHTTPクライアント(このアプリケーションもそんなもん)の開発中に情報を得るのによく使います、例えばhttpbin.org/headersとかにアクセスするとブラウザがどんなヘッダ情報をサーバーに送ったかが分かる。

ソースの解説

Haskellを初めて3ヶ月の人が説明するのは恐縮だけど、ログイン情報とかパスワードとか資産情報とか個人情報を扱うアプリケーションなので、情報を他に送信していることを疑われるのはいやなのでさらっと説明をする。

HTTP/HTTPSアクセスが出来ないと始まらない

アプリケーションの目的からHTTP/HTTPSでサーバーにアクセスしなければならないのでHaskellライブラリhttp-conduitでする。

HTTPプロトコルについてはその解説を流し読みして、httpアクセス方法はhttp-conduitのマニュアルを参考にプログラムを書く。

HTMLからスクレイピングで情報を取り出す構造上サーバーがどんなページを返してくるかに依存する。

何が返ってくるかは実際に運用して確認するので検証を楽にするために全てのサーバーアクセスはログDBに格納する関数によってサーバーアクセスします。

引用元 fetchPage – WebBot.hs

{- |
    urlに接続して結果を得るついでにDBに記録する
-}
fetchPage   :: M.MonadIO m
            => N.Manager
            -> N.RequestHeaders
            -> Maybe N.CookieJar
            -> [(B8.ByteString, B8.ByteString)]
            -> N.URI
            -> m (N.Response BL8.ByteString)
fetchPage manager header cookie reqBody url = M.liftIO $ do
    -- HTTPリクエストを作る
    -- HTTPヘッダを指定する
    req <- customHeader <$> N.parseRequest (show url)
    -- HTTPリクエストボディを指定する
    let customReq = case reqBody of
                [] -> req
                body -> N.urlEncodedBody body req
    -- 組み立てたHTTPリクエストを発行する
    resp <- N.httpLbs customReq manager
    -- 受信時間
    tm <- getCurrentTime
    -- ログDBへ
    storeLogDB
        Loghttp { loghttpUrl            = show url
                , loghttpScheme         = N.uriScheme url
                , loghttpUserInfo       = maybe "" N.uriUserInfo $ N.uriAuthority url
                , loghttpHost           = maybe "" N.uriRegName $ N.uriAuthority url
                , loghttpPort           = maybe "" N.uriPort $ N.uriAuthority url
                , loghttpPath           = N.uriPath url
                , loghttpQuery          = N.uriQuery url
                , loghttpFragment       = N.uriFragment url
                , loghttpReqCookie      = show cookie
                , loghttpReqBody        = show $ customReq
                , loghttpRespDatetime   = tm
                , loghttpRespStatus     = show $ N.responseStatus resp
                , loghttpRespVersion    = show $ N.responseVersion resp
                , loghttpRespHeader     = show $ N.responseHeaders resp
                , loghttpRespCookie     = show $ N.destroyCookieJar $ N.responseCookieJar resp
                , loghttpRespBody       = BL8.toStrict $ N.responseBody resp
                }
    -- HTTPレスポンスを返却
    return resp
    where
    -- HTTPヘッダを指定する
    customHeader req =
        req { N.cookieJar = cookie
            , N.requestHeaders = header
}

HTTPレスポンスからHTMLを取り出す

このプログラムは文字をUnicodeで扱うので、上の関数の返値(関数宣言の最後をよく見てね)のResponse BL8.ByteString (バイト列)からData.Text.Lezy(Unicode text)に変換する関数を用意してUnicodeのHTMLを取り出さなければならない。

まずこうしてHTTP Accept-CharsetヘッダーにUTF-8を所望するとサーバーに送る。(ちなみにリクエストヘッダ情報はhttpbin.org/getで確認出来るから見てみて)サーバーが対応していたらUTF-8で受け取れるだろうが、期待しても仕方が無いのでサーバーが返してくる文字コードからUTF-8に自分で変換する。

HTMLの文字コードはレスポンスヘッダか本文に入っているので、それを取り出して文字コードを変換する。W3Cの説明によると本文中の指定はHTMLファイルの先頭から1024バイトまでにこんな風に指定してある。

  • <meta http-equiv=”Content-Type” content=”text/html; charset=shift_jis”>
  • <meta charset=”shift_jis”>

さて、受信したHTMLからcharsetを取り出す。

引用元 takeBodyFromResponse – WebBot.hs

type HtmlCharset = String
{- |
    HTTP ResponseからUtf8 HTMLを取り出す関数
-}
takeBodyFromResponse :: N.Response BL8.ByteString -> T.Text
takeBodyFromResponse resp =
    let bodyHtml = N.responseBody resp in
    -- 先頭より1024バイトまでで
    -- <meta http-equiv="Content-Type" content="text/html; charset=shift_jis"> とか
    -- <meta charset="shift_jis">とかが
    -- 無いか探してみる
    let htmlHead1024B = BL8.take 1024 bodyHtml in
    let htmlCS = case P.parse html "(html header)" htmlHead1024B of
                    Left   _ -> Nothing
                    Right "" -> Nothing
                    Right  r -> Just r
    in
    -- HTTPレスポンスヘッダからエンコードを得る
    let respCS = takeCharset $ N.responseHeaders resp in
    -- HTTPレスポンスヘッダの指定 -> 本文中の指定の順番でエンコードを得る
    case Maybe.listToMaybe $ Maybe.catMaybes [respCS, htmlCS] of
        -- エンコード指定がないので文字化けで返す
        Nothing -> forcedConvUtf8 bodyHtml
        -- UTF-8へ
        Just cs ->
            let u = TE.decodeUtf8' $ IConv.convert cs "UTF-8" bodyHtml in
            -- デコードの失敗はおそらくバイナリなので文字化けで返す
            either (const $ forcedConvUtf8 bodyHtml) id u
    where
    -- | 文字化けでも無理やり返す関数
    forcedConvUtf8 :: BL8.ByteString -> T.Text
    forcedConvUtf8 = T.pack . BL8.unpack
    -- | htmlをパースする関数
    html :: P.Parser HtmlCharset
    html =
        P.try (P.spaces >> tag)
        <|>
        P.try (next >> html)
        <|>
        return ""
    -- | 次のタグまで読み飛ばす関数
    next :: P.Parser ()
    next =
        P.skipMany1 (P.noneOf ">") <* P.char '>'
    -- | タグをパースする関数
    tag :: P.Parser HtmlCharset
    tag =
        P.char '<' >> meta
    -- | metaタグをパースする関数
    meta :: P.Parser HtmlCharset
    meta = do
        P.string "meta"
        P.spaces
        P.try charset <|> P.try metaHttpEquiv
    -- | meta http-equivタグをパースする関数
    metaHttpEquiv :: P.Parser HtmlCharset
    metaHttpEquiv = do
        {-
            例 : http-equiv="Content-Type" content="text/html; charset=shift_jis"
            https://www.w3.org/TR/html5/document-metadata.html#meta
        -}
        P.string "http-equiv="
        contentType
    -- | meta http-equiv Content-Typeをパースする関数
    contentType :: P.Parser HtmlCharset
    contentType = do
        P.string "\"Content-Type\""
        P.spaces
        P.string "content="
        P.many (P.char '\"')
        c <- content
        P.many (P.char '\"')
        return c
    {-
        例 : "text/html; charset=shift_jis"
        RFC2616 - 3.7 Media Typesによる定義
        "https://www.w3.org/Protocols/rfc2616/rfc2616-sec3.html#sec3.7"
        media-type     = type "/" subtype *( ";" parameter )
        type           = token
        subtype        = token
    -}
    content :: P.Parser HtmlCharset
    content = do
        _ <- P.many P.alphaNum
        P.char '/'
        _ <- P.many P.alphaNum
        parameter <|> return ""
    -- 
    parameter :: P.Parser HtmlCharset
    parameter = do
        P.char ';'
        P.spaces
        charset <|> P.many P.alphaNum
    -- 
    charset :: P.Parser HtmlCharset
    charset = do
        {-
            例 : charset="utf-8"
            https://www.w3.org/TR/html5/document-metadata.html#meta
        -}
        P.string "charset="
        P.many (P.char '\"')
        cs <- P.many (P.alphaNum <|> P.char '_' <|> P.char '-')
        P.many (P.char '\"')
        return cs

上の方でテキスト処理に長けている言語と書いた通り、Haskellは思いつきのままパーサーを書けるので適当にパーサーで取り出す。(えっ大文字?しらんしw)

    -- | HTTPレスポンスヘッダからcharsetを得る
    takeCharset :: N.ResponseHeaders -> Maybe String
    takeCharset headers = do
        -- HTTPレスポンスヘッダから"Content-Type"を得る
        ct <- List.find (\kv -> "Content-Type"==fst kv) headers
        -- "Content-Type"からcontentを得る
        case P.parse content "(resp header)". BL8.fromStrict . snd $ ct of
            Left   _ -> Nothing
            Right "" -> Nothing
            Right  r -> Just r

これはResponseHeaders (name, value)のタプルのリストからcharsetを取り出す関数

取り出したcharsetをIConvに渡してUTF-8に変換する。これで関数宣言にあるとおりにN.Response BL8.ByteString (バイト列)からData.Text.Lezyを得られた。

ログインページからログイン

ログインページにユーザー名とパスワードをいれてログインボタンをクリックすることをこのプログラムで模倣する。

実験的に自分の管理するサーバーでログインを試してみる。このログインページにアクセスして受け取ったHTMLで唯一のformがこの部分で

<form name="loginform" id="loginform" action="https://ak1211.com/wp-login.php" method="post">
<p>
<label for="user_login">ユーザー名またはメールアドレス<br />
<input type="text" name="log" id="user_login" class="input" value="Mr.Aki" size="20" /></label>
</p>
<p>
<label for="user_pass">パスワード<br />
<input type="password" name="pwd" id="user_pass" class="input" value="" size="20" /></label>
</p>
<p class="forgetmenot"><label for="rememberme"><input name="rememberme" type="checkbox" id="rememberme" value="forever"/> ログイン状態を保存する</label></p>
<p class="submit">
<input type="submit" name="wp-submit" id="wp-submit" class="button button-primary button-large" value="ログイン" />
<input type="hidden" name="redirect_to" value="https://ak1211.com/wp-admin/" />
<input type="hidden" name="testcookie" value="1" />
</p>
</form>

formタグのactionで指定されたページにinputタグの内容をpostで送信すればログインできる。ただしcheckedでないチェックボックスとセレクトボックスは送信しない。

ログインページからログイン

実験はPythonで試して成功しているので、それを踏まえてloginURL(設定ファイルで指定)にアクセスしてログインする関数でclientCD, passwd(名前はHTMLソースを確認してね)をサーバーに送ってログインします。

説明が簡単すぎるのでactionページに送信する所をもう少し詳しくすると、この部分(Haskellは他の言語より1行1行が濃いいのにちょっと長いな)でしてます。

フォームに入力したようなメッセージをサーバーに送る

フォームの解説を流し読みして概要をつかんだら、今回の目的のために関係するのはform, input, select,optgroup,optionあたりと分かったので、それだけを現状の所method=post決め打ちでやります。ここからはHTMLパースのためにtagsoupを使います。

引用元 doPostAction – WebBot.hs

{- |
    formのactionを実行する関数
-}
doPostAction :: N.Manager
                -> N.RequestHeaders
                -> Maybe N.CookieJar
                -> [(B8.ByteString, B8.ByteString)]
                -> N.URI
                -> T.Text
                -> IO (Maybe (N.Response BL8.ByteString))
doPostAction manager reqHeader cookie customPostReq pageURI html = do
    let uTree = TS.universeTree $ TS.tagTree $ TS.parseTags html
    let formTags = [all | all@(TS.TagBranch nm _ _) <- uTree, "form"==T.toLower nm]
    case formTags of
        -- ページ唯一のformタグを取り出す
        x : _ -> action x
        _ -> return Nothing
    where
    action :: TS.TagTree T.Text -> IO (Maybe (N.Response BL8.ByteString))
    action = \case
        form@(TS.TagBranch _  attrs childNodes) -> do
            let defaultPostReqBody = defaultRequest form
            -- formタグの属性を取り出す
            let fmAction = Maybe.listToMaybe [v | (k,v)<-attrs, "action"==T.toLower k]
            let postReqBody = Maybe.catMaybes
                                $ uncurry (List.zipWith chooseDefaultOrCustomReq)
                                $ List.unzip defaultPostReqBody
            -- POSTリクエストを送信するURL
            let postActionURL = toAbsURI pageURI =<< fmAction
            -- フォームのaction属性ページへアクセス
            M.mapM (fetchPage manager reqHeader cookie postReqBody) postActionURL
        _ -> return Nothing
    -- 
    chooseDefaultOrCustomReq :: B8.ByteString -> B8.ByteString -> Maybe (B8.ByteString, B8.ByteString)
    chooseDefaultOrCustomReq k v =
        case List.lookup k customPostReq of
            Just cv -> Just (k, cv)
            -- x yは指定の物以外削除
            Nothing | B8.isSuffixOf ".x" k -> Nothing
            Nothing | B8.isSuffixOf ".y" k -> Nothing
            _ ->  Just (k, v)

    -- 
    takeValue :: [TS.Attribute T.Text] -> T.Text -> Maybe B8.ByteString
    takeValue attrs name =
        B8.pack . T.unpack . snd <$> List.find ((==) (T.toCaseFold name) . T.toCaseFold . fst) attrs
    -- | 未入力時のフォームリクエストを得る
    defaultRequest :: TS.TagTree T.Text -> [(B8.ByteString, B8.ByteString)]
    defaultRequest (TS.TagBranch _  attrs childNodes) =
        let sel = [selectTag all | all@(TS.TagBranch nm _ _) <- TS.universeTree childNodes, "select"==T.toLower nm] in
        let ias = [as | TS.TagOpen nm as <- TS.flattenTree childNodes, "input"==T.toLower nm] in
        let inp = List.concatMap inputTag ias in
        let img = List.concatMap inputTypeImage ias in
        Maybe.catMaybes sel ++ inp ++ img
        where
        -- 
        selectTag :: TS.TagTree T.Text -> Maybe (B8.ByteString, B8.ByteString)
        selectTag (TS.TagBranch _ attrs children) =
            -- タグ内のoptionタグを全て取り出す
            let options = [as | TS.TagOpen nm as <- TS.flattenTree children, "option"==T.toLower nm] in
            List.find (\as -> Maybe.isJust $ takeValue as "selected") options
            >>= \as -> (\k v -> (k,v)) <$> takeValue attrs "name" <*> takeValue as "value"
        -- 
        inputTag :: [TS.Attribute T.Text] -> [(B8.ByteString, B8.ByteString)]
        inputTag attrs =
            let f = takeValue attrs in
            -- (name, value)のタプルを作る
            case f "type" of
                Just "checkbox" | Maybe.isNothing (f "checked") -> []
                Just "radio" | Maybe.isNothing (f "checked") -> []
                _ -> Maybe.maybeToList $ (\a b -> (a,b)) <$> f "name" <*> f "value"
        --
        -- input type="image"
        inputTypeImage :: [TS.Attribute T.Text] -> [(B8.ByteString, B8.ByteString)]
        inputTypeImage attrs =
            let f = takeValue attrs in
            let name = f "name" in
            -- (name, value)のタプルを作る
            case f "type" of
                Just "image" | Maybe.isJust name ->
                    let nm = Maybe.fromJust name in
                    [(nm `B8.append` ".x", "0"), (nm `B8.append` ".y", "0")]
                _ -> []

フォームに未入力時の内容リストを取り出して、それを上書きする形で送信するメッセージを作る。もちろん上書きなんて副作用は認められていないから新規にリストを作るんですが。

ここでinput type=”image”の場合にサーバー側アプリケーションでクリックされた座標を見られているので、きちんと送ってみました。x,yは呼び出し側で指定してくる構造なんで、ここでは適当ですけどね。

ここまでしてログイン部分は完成

HTTP/HTTPSセッション確立

ログインページを通過したら、サーバー側からセッションクッキーが送られてくる。HTTPアクセスって物は本来ステートレス(純粋関数呼び出しのようなもん)だから、ログアウトするまでこのクッキーを添えて通信することでステートフルなセッションによる通信とするのだってね。

ここで自分が何を送って、サーバーから何が返ってきたか見てやろうと思う。全てのサーバーアクセスはログDBに格納しているからね。.outputしているのは、素のHTMLをそのまま出力すると端末が壊れるからで、一旦ファイルに受けてからエディタで見る。

id=1はログインページでid=2はログイン後のホームね

% sqlite3 loghttp.sqlite3                                                 
SQLite version 3.7.17 2013-05-20 00:56:22
Enter ".help" for instructions
Enter SQL statements terminated with a ";"
sqlite> 
sqlite> .tables                                                                                                      
loghttp
sqlite> .header ON
sqlite> .output dump.txt
sqlite> select * from loghttp where id<=2;
sqlite> 
Control-D入力
% vim dump.txt
id|url|scheme|user_info|host|port|path|query|fragment|req_cookie|req_body|resp_datetime|resp_status|resp_version|resp_header|resp_cookie|resp_body
1|https://www.****.******.co.jp/ITS/login/MemberLogin.jsp|https:||www.****.******.co.jp||/ITS/login/MemberLogin.jsp|||Nothing|Request {
  host                 = "www.****.******.co.jp"
  port                 = 443
  secure               = True 
  requestHeaders       = [("Accept","text/html, text/plain, text/css"),("Accept-Charset","UTF-8"),("Accept-Language","ja, en;q=0.5"),("User-Agent","Mozilla/5.0 (Windows NT 10.0; WOW64; rv:50.0) Gecko/20100101 Firefox/50.0")]
  path                 = "/ITS/login/MemberLogin.jsp"
  queryString          = ""
  method               = "GET"
  proxy                = Nothing
  rawBody              = False
  redirectCount        = 10
  responseTimeout      = Just (-3425)
  requestVersion       = HTTP/1.1
}
|2017-02-05T12:31:20.20186|Status {statusCode = 200, statusMessage = "OK"}|HTTP/1.1|[("Cache-Control","no-cache"),("Date","Sun, 05 Feb 2017 12:31:20 GMT"),("Pragma","no-cache"),("Transfer-Encoding","chunked"),("Content-Type","text/html; charset=Shift_JIS"),("Expires","Thu, 01 Jan 1970 00:00:00 GMT")]|[]|<!DOCTYPE html>
<!--MemberLogin-->
<html lang="ja">
<head>
<meta charset="shift_jis">

省略
2|https://www.****.******.co.jp/servlet/ITS/login/MemberLoginEnter|https:||www.****.******.co.jp||/servlet/ITS/login/MemberLoginEnter|||Nothing|Request {
  host                 = "www.****.******.co.jp"
  port                 = 443
  secure               = True
  requestHeaders       = [("Content-Type","application/x-www-form-urlencoded"),("Accept","text/html, text/plain, text/css"),("Accept-Charset","UTF-8"),("Accept-Language","ja, en;q=0.5"),("User-Agent","Mozilla/5.0 (Windows NT 10.0; WOW64; rv:50.0) Gecko/20100101 Firefox/50.0")]
  path                 = "/servlet/ITS/login/MemberLoginEnter"
  queryString          = ""
  method               = "POST"
  proxy                = Nothing
  rawBody              = False
  redirectCount        = 10
  responseTimeout      = Just (-3425)
  requestVersion       = HTTP/1.1
}
|2017-02-05T12:31:20.259706|Status {statusCode = 200, statusMessage = "OK"}|HTTP/1.1|[("Date","Sun, 05 Feb 2017 12:31:20 GMT"),("Content-Length","1007"),("Content-Type","text/html; charset=Shift_JIS")]|[]|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML>
<HEAD>
<TITLE>****************</TITLE>
<META http-equiv="Content-Type" content="text/html; charset=Shift_JIS">
</HEAD>
<FRAMESET border="0" framespacing="0" rows="60,*" frameborder="NO">
<FRAME name="GM" marginwidth="0" marginheight="0" src="/ITS/menu/GlobalMenu.jsp;************************************************************************?menuParam=HOME" noresize scrolling="no">
<FRAMESET border="0" framespacing="0" rows="*" frameborder="no" cols="152,*">
<FRAME name="LM" marginwidth="0" marginheight="0" src="/ITS/menu/LocalMenuHome.jsp;************************************************************************?menuParam=ANNOUNCE" noresize>
<FRAME name="CT" src="/servlet/ITS/home/Announce;*************************************************************************>
</FRAMESET>
<NOFRAMES>
<BODY bgcolor="#FFFFFF">
<P>このページは、フレーム機能をサポートしないブラウザでは表示されません。</P>
</BODY>
</NOFRAMES>
</FRAMESET>
</HTML>

("User-Agent","Mozilla/5.0 (Windows NT 10.0; WOW64; rv:50.0) Gecko/20100101 Firefox/50.0")

オレオレFirefoxホストOSは64ビットWindows10= (Windows NT 10.0; WOW64)よろしくねと自己申告でサーバーへ送っている。(設定ファイルの内容)

これを見ている人だけにこっそり教えよう。当然デタラメだから。だってtractorアプリは64ビットcentos7で動いている。

他言無用だよ。

“2017-02-05T12:31:20.259706” – “2017-02-05T12:31:20.20186” = 57.846 ms

サーバーの応答速度も上々で、ステータスコードは “200 OK”、ヘッダに(“Content-Type”,”text/html; charset=Shift_JIS”)とあるし、本文にもこうある。

<meta charset="shift_jis">
<META http-equiv="Content-Type" content="text/html; charset=Shift_JIS">

なんで大文字?と疑問に思ったけど、調べたらHTML4.0宣言の文書だから

1.2.1 Elements and attributes
Element names are written in uppercase letters (e.g., BODY). Attribute names are written in lowercase letters (e.g., lang, onsubmit). Recall that in HTML, element and attribute names are case-insensitive; the convention is meant to encourage readability.
1.2.1 Elements and attributes – HTML4.01

要素名は大文字、属性は小文字で正しいんやね。

ログインページは”<!DOCTYPE html>"と宣言された(レスポンスの先頭をよく見てね。)html5文書だからこれ。

Many strings in the HTML syntax (e.g. the names of elements and their attributes) are case-insensitive, but only for uppercase ASCII letters and lowercase ASCII letters. For convenience, in this section this is just referred to as “case-insensitive”.
8 The HTML syntax – HTML5

どっちも”case-insensitive”で大文字小文字どっちでもいいのが正解でしょ。上のパーサーは手抜きだから小文字にしかマッチしないけど、返答ヘッダの指定が優先だから気にしないことにする。問題が起きたらその時に対処するつもり。

上で書いたとおり、一旦ファイルに落としているので

% nkf -g dump.txt 
Shift_JIS

UTF-8を所望したけど、これはShift_JIS(ヘッダで指定してきてるから当たり前)。まあ、自前で変換するから問題ないけど。

Cookieはどこにある?

うん。見つからないね。某BI証券バックアップサイトに突撃した時はクッキーを受け取れたけどね。?なんでや?としばらく探す、よ~く見ると本文中にごちゃごちゃしたURLが見つかるでしょ。(これ本当に見つけるまで時間がかかった)

URLパラメータか!その方法は意識に無かったわ。でも分かってしまえばきちんとログインできている事が確認できた。

 

Webページで手順通りにリンクをクリックしながら情報を得る

ここまででログイン後のホームに来ている。上のHTMLが受け取れているのが証拠。HTMLを確認すると3つのFRAMEが確認できるでしょ。

  • FRAME name=”GM”
  • FRAME name=”LM”
  • FRAME name=”CT”

以上の3つ。おそらく”Global Menu”, “Local Menu”, “Contents”だろうと思う。これからはそれぞれのFRAMEタグのsrc属性のページを素直に得ればいい(クッキーが無いからそれをセットする必要も無いし)。

自分の保有株式の現在値を得るには、上のフレーム(“GM”)の”株式取引”をクリックして、左のフレーム(“LM”)の”現物売”をクリックして、右のフレーム(“CT”)に表示される情報にある。

では、自分がサイト上でする行動をプログラムにさせるとする。

 

引用元 fetchFraStkSell – WebBot.hs

{- |
    現在の保有株情報を得る
    "株式取引" -> "現物売" のページからスクレイピングする関数
-}
fetchFraStkSell :: M.ReaderT HTTPSession IO Scraper.FraStkSell
fetchFraStkSell =
    let fM s = M.foldM dispatchFrameSet [sTopPageHTML s]
                [("GM", clickLinkText "株式取引")
                ,("LM", clickLinkText "現物売")
                ,("CT", return)]
    in
    either failureAtScraping pure
    <$> Scraper.scrapingFraStkSell =<< fM =<< M.ask

わかりやすい、かな?自分のした行動をそのまま書いてみた。

  1. トップページのHTMLを種にしてfoldingを始めて
  2. トップページから”GM”フレームのページURLを取り出して、読み込む
  3. ページを受け取って、アクション実行(clickLinkText  "株式取引")はページの"株式取引"リンクのページを読み込む。(FRAMEタグのtarget="_top"だから始まりと同じ処理をしたらいいから)
  4. ページを受け取って”LM”フレームのページURLを取り出して、読み込む
  5. ページを受け取って、アクション実行(clickLinkText  "現物売")はページの"現物売"リンクのページを読み込む。(FRAMEタグのtarget="_top"だから始まりと同じ処理をしたらいいから)
  6. ページを受け取って”CT”フレームのページURLを取り出して、読み込む
  7. ページを受け取って、アクション実行(return)は受け取ったページを返す

自分の保有数ではページの”次へ”のリンクが出てこなかったので、現状1ページ目のみしか読み込まない構造になってます、本当はreturn関数の代わりに”次へ”のリンクをクリックしまくる関数を入れておかないとならないだろうね。あとclickLinkTextは引数のリンクテキストをクリックする関数で、スクレイピング部分は後で説明する。

HTMLフレームのページを読む

このサイトはログインからログアウトまで一貫してフレームでページを表示しているんで(自分調べ)、フレーム処理関数一つを用意したら、全部同じ処理で出来る。その関数がこれ。上の関数でControl.Monad.foldMに渡していた関数でもある。

引用元 dispatchFrameSet – WebBot.hs

{- |
    targetのフレームを処理する
-}
dispatchFrameSet :: M.MonadIO m
                    => [T.Text] -> (T.Text, [T.Text] -> SessionReaderMonadT m)
                    -> SessionReaderMonadT m
dispatchFrameSet htmls (targetFrmName, action) =
    case htmls of
        [] -> return []
        h : hs -> do
            -- frameタグから属性の(name, src)タプルを作る
            let frames = [as | TS.TagOpen nm as <- TS.parseTags h, "frame" == T.toLower nm]
                        >>= Maybe.maybeToList . buildNameSrc
            -- targetのフレームを処理する
            case List.lookup targetFrmName frames of
                Nothing -> return []
                Just linkPath -> do
                    html <- takeBodyFromResponse <$> fetchInRelativePath linkPath
                    r <- action [html]
                    s <- dispatchFrameSet hs (targetFrmName, action)
                    return (r ++ s)
    where
    {- |
        frameタグから属性の(name, src)タプルを作る
    -}
    buildNameSrc :: [TS.Attribute T.Text] -> Maybe (T.Text, T.Text)
    buildNameSrc attrList = do
        name <- Maybe.listToMaybe [v | (k, v) <- attrList, "name"==T.toLower k]
        src  <- Maybe.listToMaybe [v | (k, v) <- attrList, "src"==T.toLower k]
        Just (name, src)

受信したページでFRAMESETが書かれたページがあったでしょ、そのページからターゲット(“GT”とか”LT”とか”CT”とか)のFRAMEのページURLを取り出してそのURLを読み込んだHTMLを返している。

他の実装の詳細はコードを見てもらうとして、次に進もうか

手順通りにリンクをクリックしながら情報を得ているか確認する

ここでログDBに入っている歩みを確認してみる。

% sqlite3 loghttp.sqlite3
SQLite version 3.7.17 2013-05-20 00:56:22
Enter ".help" for instructions
Enter SQL statements terminated with a ";"
sqlite> .output history.txt
sqlite> select datetime(resp_datetime,'localtime'),resp_datetime,url from loghttp;
Control-D入力
% vim history.txt
2017-02-06 06:30:03|2017-02-05T21:30:03.103394|https://www.****.******.co.jp/ITS/login/MemberLogin.jsp
2017-02-06 06:30:03|2017-02-05T21:30:03.196093|https://www.****.******.co.jp/servlet/ITS/login/MemberLoginEnter
2017-02-06 06:30:03|2017-02-05T21:30:03.223421|https://www.****.******.co.jp/ITS/menu/GlobalMenu.jsp;*************************************************************************?menuParam=HOME
2017-02-06 06:30:03|2017-02-05T21:30:03.253339|https://www.****.******.co.jp/ITS/frame/FraHomeAnnounce.jsp;*************************************************************************
2017-02-06 06:30:03|2017-02-05T21:30:03.278476|https://www.****.******.co.jp/ITS/menu/LocalMenuHome.jsp;*************************************************************************?menuParam=ANNOUNCE
2017-02-06 06:30:03|2017-02-05T21:30:03.30611|https://www.****.******.co.jp/ITS/frame/FraHomeAnnounce.jsp;*************************************************************************
2017-02-06 06:30:03|2017-02-05T21:30:03.357581|https://www.****.******.co.jp/servlet/ITS/home/Announce;*************************************************************************
2017-02-06 06:30:03|2017-02-05T21:30:03.413271|https://www.****.******.co.jp/ITS/menu/GlobalMenu.jsp;*************************************************************************?menuParam=HOME
2017-02-06 06:30:03|2017-02-05T21:30:03.444625|https://www.****.******.co.jp/ITS/frame/FraAstSpare.jsp;*************************************************************************
2017-02-06 06:30:03|2017-02-05T21:30:03.471917|https://www.****.******.co.jp/ITS/menu/LocalMenuAsset.jsp;*************************************************************************?menuParam=SPARE
2017-02-06 06:30:03|2017-02-05T21:30:03.504243|https://www.****.******.co.jp/ITS/frame/FraAstSpare.jsp;*************************************************************************
2017-02-06 06:30:03|2017-02-05T21:30:03.564512|https://www.****.******.co.jp/servlet/ITS/asset/MoneyToSpare;*************************************************************************
2017-02-06 06:30:03|2017-02-05T21:30:03.594877|https://www.****.******.co.jp/ITS/menu/GlobalMenu.jsp;*************************************************************************?menuParam=HOME
2017-02-06 06:30:03|2017-02-05T21:30:03.622514|https://www.****.******.co.jp/ITS/frame/FraStkOrder.jsp;*************************************************************************
2017-02-06 06:30:03|2017-02-05T21:30:03.648783|https://www.****.******.co.jp/ITS/menu/LocalMenuStock.jsp;*************************************************************************?menuParam=ORDER
2017-02-06 06:30:03|2017-02-05T21:30:03.6777|https://www.****.******.co.jp/ITS/frame/FraStkSell.jsp;*************************************************************************
2017-02-06 06:30:03|2017-02-05T21:30:03.726262|https://www.****.******.co.jp/servlet/ITS/stock/StkHavingList;*************************************************************************
2017-02-06 06:30:05|2017-02-05T21:30:05.19903|https://www.****.******.co.jp/ITS/menu/GlobalMenu.jsp;*************************************************************************?menuParam=HOME
2017-02-06 06:30:05|2017-02-05T21:30:05.229073|https://www.****.******.co.jp/ITS/login/Logout.jsp;*************************************************************************
2017-02-06 09:00:08|2017-02-06T00:00:08.873435|https://www.****.******.co.jp/ITS/login/MemberLogin.jsp
2017-02-06 09:00:09|2017-02-06T00:00:09.008527|https://www.****.******.co.jp/servlet/ITS/login/MemberLoginEnter
2017-02-06 09:00:09|2017-02-06T00:00:09.032142|https://www.****.******.co.jp/ITS/menu/GlobalMenu.jsp;*************************************************************************?menuParam=HOME
2017-02-06 09:00:09|2017-02-06T00:00:09.057608|https://www.****.******.co.jp/ITS/frame/FraAstSpare.jsp;*************************************************************************
2017-02-06 09:00:09|2017-02-06T00:00:09.10779|https://www.****.******.co.jp/ITS/menu/LocalMenuAsset.jsp;*************************************************************************?menuParam=SPARE
2017-02-06 09:00:09|2017-02-06T00:00:09.133594|https://www.****.******.co.jp/ITS/frame/FraAstSpare.jsp;*************************************************************************
2017-02-06 09:00:09|2017-02-06T00:00:09.217501|https://www.****.******.co.jp/servlet/ITS/asset/MoneyToSpare;*************************************************************************
2017-02-06 09:00:09|2017-02-06T00:00:09.244903|https://www.****.******.co.jp/ITS/menu/GlobalMenu.jsp;*************************************************************************?menuParam=HOME
2017-02-06 09:00:09|2017-02-06T00:00:09.270447|https://www.****.******.co.jp/ITS/frame/FraStkOrder.jsp;*************************************************************************
2017-02-06 09:00:09|2017-02-06T00:00:09.294105|https://www.****.******.co.jp/ITS/menu/LocalMenuStock.jsp;*************************************************************************?menuParam=ORDER
2017-02-06 09:00:09|2017-02-06T00:00:09.333515|https://www.****.******.co.jp/ITS/frame/FraStkSell.jsp;*************************************************************************
2017-02-06 09:00:09|2017-02-06T00:00:09.381627|https://www.****.******.co.jp/servlet/ITS/stock/StkHavingList;*************************************************************************
2017-02-06 09:10:09|2017-02-06T00:10:09.556493|https://www.****.******.co.jp/ITS/menu/GlobalMenu.jsp;*************************************************************************?menuParam=HOME
2017-02-06 09:10:09|2017-02-06T00:10:09.589241|https://www.****.******.co.jp/ITS/frame/FraAstSpare.jsp;*************************************************************************
2017-02-06 09:10:09|2017-02-06T00:10:09.614556|https://www.****.******.co.jp/ITS/menu/LocalMenuAsset.jsp;*************************************************************************?menuParam=SPARE
2017-02-06 09:10:09|2017-02-06T00:10:09.641971|https://www.****.******.co.jp/ITS/frame/FraAstSpare.jsp;*************************************************************************
2017-02-06 09:10:09|2017-02-06T00:10:09.726773|https://www.****.******.co.jp/servlet/ITS/asset/MoneyToSpare;*************************************************************************
2017-02-06 09:10:09|2017-02-06T00:10:09.755394|https://www.****.******.co.jp/ITS/menu/GlobalMenu.jsp;*************************************************************************?menuParam=HOME
2017-02-06 09:10:09|2017-02-06T00:10:09.784322|https://www.****.******.co.jp/ITS/frame/FraStkOrder.jsp;*************************************************************************
2017-02-06 09:10:09|2017-02-06T00:10:09.809184|https://www.****.******.co.jp/ITS/menu/LocalMenuStock.jsp;*************************************************************************?menuParam=ORDER
2017-02-06 09:10:09|2017-02-06T00:10:09.83743|https://www.****.******.co.jp/ITS/frame/FraStkSell.jsp;*************************************************************************
2017-02-06 09:10:09|2017-02-06T00:10:09.892441|https://www.****.******.co.jp/servlet/ITS/stock/StkHavingList;*************************************************************************

長いので省略

2017-02-06 11:31:17|2017-02-06T02:31:17.444404|https://www.****.******.co.jp/ITS/menu/GlobalMenu.jsp;*************************************************************************?menuParam=HOME
2017-02-06 11:31:17|2017-02-06T02:31:17.49057|https://www.****.******.co.jp/ITS/login/Logout.jsp;*************************************************************************

左端のフィールドが日本時間、中がUTC時間、右端がURL

午前6時30分にログインページからログイン後のホームを受け取ったり、資産情報を得てログアウトまでの2秒間。この部分は後の方で登場するので、今は読み飛ばしてください。

  1. 午前9時00分08秒にログインページからログイン
  2. “資産状況”から”余力情報”を見に行く
  3. “株式取引” から”現物売”を見に行く
  4. 2,3の繰り返し
  5. 立会時間終了(前場終了)でログアウト

この歩みがログから確認できる。

MemberLogin, MemberLoginEnter, GlobalMenu?menuParm=HOME, FraAstSpare(余力情報), LocalMenuAsset(余力情報内”LM”), … とかが順番に並んでるからね。

ページをスクレイピングして欲しい情報を得る

スクレイピングを行なう部分を上の関数を例に説明すると、Scraper.scrapingFraStkSellが現物売のページからスクレイピングする関数で、おおざっぱに言うと以下の関数をくりかえしながら、情報を取り出しているだけ

This operation is particularly useful for queries. To collect all “a” tags in a tree, simply do:

[x | x@(TagBranch "a" _ _) <- universeTree tree]

Text.HTML.TagSoup.Tree

引用元 taglist – Scraper.hs

{- |
    タグ名の子をリストで取り出す関数
-}
taglist :: T.Text -> [TS.TagTree T.Text] -> [[TS.TagTree T.Text]]
taglist nm t = [c | TS.TagBranch k _ c <- TS.universeTree t, nm==T.toLower k]

よく似ているでしょ。タグを取り出すか、タグの子要素を取り出すかの違いの物に別名を与えているだけだから。

ここを説明するなら受け取ったHTMLを貼らなければならなくなるので、雰囲気でお察しください。この関数のようなスクレイピング関数は関数宣言にIOがついていないことで分かるように、純粋関数だから変なところにデーターを送信していないことが保証されてます。

引用元 class Contents – Scraper.hs ←でもここにIOがついてるって?

{- |
    ページからスクレイピングした情報の型クラス
-}
class Contents a where
    storeToDB :: UTCTime -> a -> IO ()

型クラスContentsで定義しているとおりにこのクラスのインスタンスはデーターベースに格納する関数を持つんだよ。具体的にスクレイピングで手に入れた情報の型クラスのインスタンスはここで定義している。

引用元 DataBase.hs

{-
    型クラスScraper.Contentsのインスタンスをここで定義する
-}
instance Scraper.Contents Scraper.OrderConfirmed where
    storeToDB _ _ = undefined

instance Scraper.Contents Scraper.FraHomeAnnounce where
    -- こんなんDBに残しても意味ないんとちゃうか?
    storeToDB _ _ = undefined

instance Scraper.Contents Scraper.FraStkSell where
    storeToDB = storeStkSell

instance Scraper.Contents Scraper.FraAstSpare where
storeToDB = storeAssetSpare

資産情報はデーターベースに格納しているだけだから。

他に送信するような事はしてないから、悪意は無いから。

手に入れた情報をデーターベースに格納する

上のコードがそうなんだけど、DBにはSqlite3を使うので、ここでHaskellライブラリpersistentの力を借りる。やっていることはマニュアル通りだからそっちを見て。

Slack Web APIに送信する

WebAPIの使い方はすでにやってる。要するにHTTPヘッダなりボディにデーターを入れてURLにアクセスしたらええんでしょってことで、この知識を使ってSlack Web APIを使うことにする。だいたい似たような物だろう。まずIncoming Webhooks – api.slack.comこのドキュメントをよく読もう。

上で説明した設定ファイルのwebHookURLってあったでしょ。そのURL(こんなの”https://hooks.slack.com/******************”)に送れば通知される

引用元 send – SlackBot.hs

{- |
    Slackへ送信する関数
-}
send :: M.MonadIO m => Conf.InfoSlack -> BS8.ByteString -> m N.Status
send conf payload =
    let rBody = apiReqBody payload in
    M.liftIO $ do
        req <- N.urlEncodedBody rBody <$> (N.parseRequest . Conf.webHookURL $ conf)
        manager <- N.newManager N.tlsManagerSettings
        N.responseStatus <$> N.httpLbs req manager
    where
    -- | Slack APIに送るリクエストボディを組み立てる関数
    apiReqBody :: BS8.ByteString -> [(BS8.ByteString, BS8.ByteString)]
    apiReqBody payload =
        [ ("Content-type", "application/json")
        , ("payload", payload)
]

payloadの組み立て

このアプリケーションが起動する時の挨拶です。

Attaching content and links to messages – api.slack.comにpayloadの組み立て方が書いてある。うまくすると、とってもリッチなメッセージが送れるので。まずはシンプルな方から説明する。

 

引用元 simpleTextMsg – SlackBot.hs

{- |
    ただのテキストをSlackに送るJSONを組み立てる関数
-}
simpleTextMsg :: (Monad m, M.MonadIO m) => Conf.InfoSlack -> C.Conduit T.Text m WebHook
simpleTextMsg conf =
    C.await >>= maybe (return ()) func
    where
    -- 
    func message = do
        C.yield WebHook {
            channel       = Conf.channel conf,
            username      = Conf.userName conf,
            attachments   = [],
            hText         = T.unpack message,
            icon_emoji    = ":tractor:"
        }
C.await >>= maybe (return ()) func

テキストメッセージをconduitで受け取って、iconと設定ファイルで指定したchannelとusernameを追加してconduitへ流している関数。icon_emojiはUsing Slackによるとここで見られる。

アプリケーション名の由来がこのトラクターのアイコンで、大きな株をトラクターで引っ張って抜いたろうと思って。

保有資産の通知

上で説明したことを踏まえてこうしてみた。熱狂の赤,不安の青ってね

 

引用元 reportMsg – SlackBot.hs

{- |
    資産情報をSlackに送るJSONを組み立てる関数
-}
reportMsg :: (Monad m, M.MonadIO m) => Conf.InfoSlack -> C.Conduit Report m WebHook
reportMsg conf =
    C.await >>= maybe (return ()) func
    where
    -- 
    func (Report time total diff profit holdStocks) = do
        let msg = unwords $ Maybe.catMaybes (
                    [ updown <$> diff
                    , Printf.printf "前日比 %+f " <$> diff
                    , Printf.printf "総資産 %f " <$> Just total
                    , Printf.printf "損益合計 %+f" <$> Just profit
                    ] :: [Maybe String])
        C.yield WebHook
            { channel       = Conf.channel conf
            , username      = Conf.userName conf
            , attachments   = map (mkAttach time) holdStocks
            , hText         = msg
            , icon_emoji    = ":tractor:"
            }
        C.await >>= maybe (return ()) func
        where
        -- 
        updown :: Double -> String
        updown diff
            | diff < 0  = ":chart_with_downwards_trend:"
            | otherwise = ":chart_with_upwards_trend:"

    -- 
    mkAttach :: UTCTime -> Scraper.HoldStock -> Attachment
    mkAttach time stock = Attachment
        { color         = if Scraper.hsGain stock >= 0 then "#F63200" else "#0034FF"
        , pretext       = Nothing
        , title         = Nothing
        , text          = show stock
        , footer        = Conf.userName conf
        , footer_icon   = "https://platform.slack-edge.com/img/default_application_icon.png"
        , ts            = round $ POSIX.utcTimeToPOSIXSeconds time
        }

ひととおり部品を用意したので、この部品を組み立ててアプリケーションを作りますよ。

メインモジュール

いずれこのアプリケーションはデーモン化する予定だけど、いまはまだ端末を占有した状態に置いておく。

killしなくても、2回連続でControl-Cを入力することで止められるし。(メインループを見てくれれば分かると思うけど、1回目は実行時例外としてトラップするから)それにtmuxで多重化した端末を占有されても邪魔にならないし。

ではmain関数から動作を始める。

引用元 main – Main.hs

{- |
    エントリポイント
-}
main :: IO ()
main =
    applicationBody "conf.json"

呼び出しているapplicationBodyが本体なんだけど、そこではControl.ConcurrentのforkIOによってマルチスレッドで処理します。

このアプリケーションは基本的に平行運転で動作しますよ。

大概は他の言語の知識なり電子工作の知識を持ってきて進めてきたけど、ここだけはどうしても本を買ってこなければならなかった部分。平行運転は難しい。でも、デーモンプログラムでメインスレッドが停止すると回復不可能な事態に陥るので、マネージャーとワーカーは分離しなければならない。

今のところスレッドはこの4つで

動作してます。

-- | スレッドへ送る指示
data ThMsgSig
    = Run           -- ^ 作業開始指示
    | RunIsOver     -- ^ 作業終了指示
    | Donothing     -- ^ スレッド終了状態

スレッド間の通信はこの指示をMVarに入れて送り合います。それ以外に関わりを持ちません。情報はデータベースに集約していますのでね。

メインスレッド

実行時例外の例 user interrupt 端末でControl-C入力した時
実行時例外の例 サーバーメンテナンス中でログイン失敗

メインスレッドのループが以下のコードです。このループから実行時例外などで抜けても実行時例外をSlackに通知して一定時間待機後に再起動します。きちんと例外(SomeException)をcatchしているでしょ。

 

引用元 applicationBody loop – Main.hs

    loop :: Conf.Info -> [(MVar ThMsgSig, MVar ThMsgSig -> IO ())] -> IO ()
    loop conf threads = do
        ztm <- LT.getZonedTime
        case ztm of
            t| isDeliverAnnounceTime t -> do
                {-
                    お知らせの配信時間
                -}
                myThId <- CC.myThreadId
                mBox <- newMVar Run
                M.void . CC.forkIO . sendAnnounceThread conf myThId $ mBox
             | isDuringWorkingTime t ->
                {-
                    立会時間中
                    スレッドに作業開始指示を送る
                -}
                M.mapM_ sendSigRun threads
            _ ->
                {-
                    立会時間外
                    スレッドに作業終了指示を送る
                -}
                M.mapM_ sendSigRunIsOver threads
        {-
            このスレッドは作業の担当スレッドに
            指示することしかしないので適当に時間をつぶす
        -}
        doSleep 1
        `onException`
            -- 子スレッドに作業終了指示を送っておく
            M.mapM_ sendSigRunIsOver threads
    {- |
        スレッドに作業開始指示を送る関数
        スレッドが終了していたなら起動する
    -}
    sendSigRun :: (MVar ThMsgSig, MVar ThMsgSig -> IO ()) -> IO ()
    sendSigRun (mBox, fnc) = do
        msg <- readMVar mBox
        case msg of
            {-
                スレッドが終了していたなら起動して
                作業開始指示を送る
            -}
            Donothing -> do
                sendMsgSig mBox Run
                CC.forkIO (fnc mBox)
                -- 起動タイミングをずらすために28.657秒待つ
                CC.threadDelay (28657 * 1000)
            {-
                作業開始指示または
                作業終了指示が送られている場合はそのままにする
            -}
            _ -> return ()

    {- |
        スレッドに作業終了指示を送る関数
    -}
    sendSigRunIsOver :: (MVar ThMsgSig, MVar ThMsgSig -> IO ()) -> IO ()
    sendSigRunIsOver (mBox, fnc) = do
        msg <- readMVar mBox
        case msg of
            -- スレッドが終了していたなら書き換えずにそのままにする
            Donothing -> return ()
            -- 作業終了指示を送る
            _ -> sendMsgSig mBox RunIsOver
    {- |
        全ての例外ハンドラ
    -}
    handleCatchAll :: Conf.Info -> SomeException -> IO ()
    handleCatchAll conf ex =
        let errmsg = T.pack . Printf.printf
                        "exception caught, \"%s\""
                        $ show ex
        in
        {-
            Slackへエラーメッセージを送る
        -}
        toSlack (Conf.slack conf) errmsg

コメントに残している通り、時間を見ながらワーカースレッドを起こしたり、指示を送ったりするような管理しかしませんよ。

引用元 isDeliverAnnounceTime – Main.hs

{- |
    お知らせの配信時間か?
-}
isDeliverAnnounceTime :: LT.ZonedTime -> Bool
isDeliverAnnounceTime ztm =
    hm `elem` [630, 1140, 1510]
    where
    hm =
        let t = LT.localTimeOfDay $ LT.zonedTimeToLocalTime ztm in
        LT.todHour t*100 + LT.todMin t

これがお知らせの配信時間で、6時30分、11時40分、15時10分が指定されている。

引用元 isDuringWorkingTime – Main.hs

{- |
    プログラムの作業時間か?
-}
isDuringWorkingTime :: LT.ZonedTime -> Bool
isDuringWorkingTime ztm =
    isMorningSession || isAfternoonSession
    where
    hm =
        let t = LT.localTimeOfDay (LT.zonedTimeToLocalTime ztm) in
        LT.todHour t*100 + LT.todMin t
    isMorningSession   =  900 <= hm && hm <= 1130
    isAfternoonSession = 1230 <= hm && hm <= 1500

これがプログラムの作業時間で、東証の立会時間9時00分から11時30分、12時30分から15時00分が指定されている。

マネージャーはマネジメントが仕事ですもんね。作業はワーカーがする。キリッ

Slackへお知らせを送るスレッド

ログイン後のホームに証券会社からのお知らせがあるんです。これはわりと重要な情報なので、定期的にSlackに送ります。

引用元 sendAnnounceThread – Main.hs

{- |
    Slackへお知らせを送るスレッド
-}
sendAnnounceThread :: Conf.Info -> CC.ThreadId -> MVar ThMsgSig -> IO ()
sendAnnounceThread conf parentThId msgBox =
    do
        -- readMVarによって指示があるまで待機する
        msg <- readMVar msgBox
        case msg of
            {-
                作業開始指示が来た
            -}
            Run -> do
                -- Slackへお知らせを送る
                sendAnnounce conf
                -- このスレッドの実行時間は必ず1分以上かかるようにする
                doSleep 1
            {-
                作業開始指示以外ならスレッドを終了する
            -}
            _ -> return ()
    `catch`
        -- 例外は親スレッドに再送出
        \(SomeException e) -> do
            sendMsgSig msgBox Donothing
            throwTo parentThId e

ループの無いスレッド、呼ばれたらお知らせを送るだけで終了する。スレッド内ではこの関数を呼んでいる

引用元 sendAnnounce – Main.hs

{- |
    Slackへお知らせを送るついでに現在資産評価をDBへ
-}
sendAnnounce :: Conf.Info -> IO ()
sendAnnounce conf = do
    -- 証券会社のサイトにログイン
    session <- loginToSecuritiesSite conf
    -- ホーム -> お知らせを見に行く
    fha <- M.runReaderT WebBot.fetchFraHomeAnnounce session
    -- 現在資産評価を証券会社のサイトから取得してDBへ
    M.runReaderT recordCurrentCondition session
    -- Slackへお知らせを送る
    C.yield (T.pack $ show fha) $= simpleTextMsg conf $$ sinkSlack conf
    -- 証券会社のサイトからログアウト
    WebBot.logout session

ログインしてお知らせをとりだしてSlackに送っている。ついでに資産評価をDBに格納しているのは夜間バッチ処理が終わるまで資産情報が確定しないから、朝の立ち会い時間前の資産情報を得ている。

Slackへレポートを送るスレッド

データベースから取り出した資産情報からレポートを作ってSlackに通知しますよ。

引用元 sendReportThread – Main.hs

{- |
    Slackへレポートを送るスレッド
-}
sendReportThread :: Conf.Info -> CC.ThreadId -> MVar ThMsgSig -> IO ()
sendReportThread conf parentThId msgBox =
    -- readMVarによって指示があるまで待機する
    (loop 0 =<< readMVar msgBox)
    `catch`
        -- 例外は親スレッドに再送出
        \(SomeException e) -> do
            sendMsgSig msgBox Donothing
            throwTo parentThId e
    where
    loop :: Int -> ThMsgSig -> IO ()
    {-
        作業開始指示が来た
    -}
    loop remain Run =
        if remain <= 0
        then do
            -- Slackへレポートを送る
            reportOnCurrentCondition conf
            -- ループ
            loop (Conf.sendReportInterval conf) =<< readMVar msgBox
        else do
            -- 再開までの時間待ち
            doSleep 1
            loop (remain - 1) =<< readMVar msgBox
    {-
        作業終了指示が来たのでスレッドを終了する
    -}
    loop _ RunIsOver = sendMsgSig msgBox Donothing
    {-
        Donothingは終了状態を表しているのでその通りスレッドを終了する
    -}
    loop _ Donothing = return ()

余談だけど、loopなんて関数を再帰呼び出しすると、

loop remain Run =
loop _ RunIsOver =
loop _ Donothing =

これらがラベルで

loop (Conf.sendReportInterval conf) =<< readMVar msgBox

再帰呼び出しであるこれがgotoに見えてくる。

自分はC言語でもdo{}while (0);とかを使う位にgoto排除派の人間。

ついでに空行ループの時のwhile();も嫌い、do{}while();

これの終了条件を間違えると容易に無限ループに陥る危険があるので、ここは余り触らない方がいいと警告しておく。構造上1分未満のアクセスは無いけれども、loop 0 Runとかで大量にアクセスしてサーバーに負担をかける物は異物と見なされて排除されかねない。

余談終わり。設定ファイルに書かれた時間毎に時間待ちをしながら、スレッド内ではこの関数を呼んでレポートを送ってます。

引用元 reportOnCurrentCondition – Main.hs

{- |
    DBから最新の資産評価を取り出してSlackへレポートを送る
-}
reportOnCurrentCondition :: Conf.Info -> IO ()
reportOnCurrentCondition conf = do
    -- DBから最新の資産評価を取り出す
    currents <- DataBase.getTotalAstsDescList Nothing 1 0

    M.mapM_ toReport currents
    where
    {- |
        Slackへレポートを送る関数
    -}
    toReport :: DataBase.TotalAssets -> IO ()
    toReport current = do
        -- 前営業日終わりの資産評価(立ち会い開始時間以前の情報)を取り出す
        (LT.ZonedTime lt tz) <- LT.getZonedTime
        let prevUTCTime = LT.localTimeToUTC tz $
                            lt {LT.localTimeOfDay = LT.TimeOfDay 9 00 00}
        -- DBより前営業日終了時点の資産評価を取り出す
        prevs <- DataBase.getTotalAstsDescList (Just ("<", prevUTCTime)) 1 0
        let prev = Maybe.listToMaybe prevs
        -- 現在値
        let curAsset = DataBase.totalAssetsOfCash current
        -- 前営業日値
        let prvAsset = DataBase.totalAssetsOfCash <$> prev
        -- 前営業日値よりの差
        let diffAsset = (\prv -> curAsset - prv) <$> prvAsset
        -- 最新の資産評価の記録時間
        let tm = DataBase.totalAssetsDateTime current
        -- DBから保有株式を取り出す
        holdStocks <- DataBase.getHoldStockDescList $ Just ("==", tm)
        -- レポートを送る
        let report = SlackBot.Report {
            SlackBot.rTime              = tm,
            SlackBot.rTotalAsset        = curAsset,
            SlackBot.rAssetDiffByDay    = diffAsset,
            SlackBot.rTotalProfit       = DataBase.totalAssetsProfit current,
            SlackBot.rHoldStocks        = holdStocks
        }
        C.yield report $= reportMsg conf $$ sinkSlack conf

立ち会い時間前の資産情報を前日の値として、それと現在の資産情報との差を計算してレポートを作ります。この後はすでに説明した通りSlackで通知します。

DBから資産評価を取り出す

スクレイピングして取り出した情報が入っているDBのテーブルから時間をキーに内部結合して取り出している。内部結合のやり方が分からなかったから素のSQLで取り出している。

引用元 getTotalAstsDescList – DataBase.hs

{- |
    サマリーテーブルと保有株式テーブルを
    日付時間フィールドでinner joinした
    総資産テーブルを逆順(最新が先頭)で取り出す関数
-}
getTotalAstsDescList :: Maybe (String, UTCTime) -> Int -> Int -> IO [TotalAssets]
getTotalAstsDescList predicade limit offset =
    let sql = T.toStrict $ T.unwords
                [ "select"
                , " summary.id,"
                , " summary.date_time,"
                , " summary.quantity,"
                , " summary.profit,"
                , " asset_spare.money_spare,"
                , " asset_spare.stock_money,"
                , " asset_spare.inc_deposits,"
                , " asset_spare.dec_deposits,"
                , " asset_spare.restraint_fee,"
                , " asset_spare.restraint_tax,"
                , " asset_spare.cash"
                , " from summary inner join asset_spare"
                , " on (summary.date_time=asset_spare.date_time)"
                , " where summary.date_time" `has` predicade
                , " order by summary.date_time desc"
                , " limit " `T.append` T.pack (show limit)
                , " offset " `T.append` T.pack (show offset)
                , ";"
                ]
    in
    DB.runSqlite "assets.sqlite3" $
        DB.rawSql sql []
        >>= return . map DB.entityVal
    where
    has :: T.Text -> Maybe (String, UTCTime) -> T.Text
    has partial Nothing = ""
    has partial (Just (op, tm)) = T.concat
        [ partial
        , T.pack op
        , "\""
        , T.pack (iso8601 tm)
        , "\""
]

現在資産評価をDBへ格納するスレッド

こうvolatile宣言したくなるほどに変動する変数である資産情報を定期的にWebサイトに見に行って得たそれをデータベースに格納しますよ。

引用元 recordAssetsThread – Main.hs

{- |
    現在資産評価をDBへ格納するスレッド
-}
recordAssetsThread :: Conf.Info -> CC.ThreadId -> MVar ThMsgSig -> IO ()
recordAssetsThread conf parentThId msgBox =
    do
        -- readMVarによって指示があるまで待機する
        msg <- readMVar msgBox
        -- 証券会社のサイトにログイン
        session <- loginToSecuritiesSite conf
        -- 
        loop 0 msg session
        -- 証券会社のサイトからログアウト
        WebBot.logout session
    `catch`
        -- 例外は親スレッドに再送出
        \(SomeException e) -> do
            sendMsgSig msgBox Donothing
            throwTo parentThId e
    where
    loop :: Int -> ThMsgSig -> WebBot.HTTPSession -> IO ()
    {-
        作業開始指示が来た
    -}
    loop remain Run session =
        if remain <= 0
        then do
            -- 現在資産評価を取得してDBへ
            M.runReaderT recordCurrentCondition session
            -- メッセージの確認をする
            msg <- readMVar msgBox
            -- ループ
            loop (Conf.recordAssetsInterval conf) msg session
        else do
            -- 再開までの時間待ち
            doSleep 1
            -- メッセージの確認をする
            msg <- readMVar msgBox
            loop (remain - 1) msg session
    {-
        作業終了指示が来たのでスレッドを終了する
    -}
    loop _ RunIsOver _ = sendMsgSig msgBox Donothing
    {-
        Donothingは終了状態を表しているのでその通りスレッドを終了する
    -}
loop _ Donothing _ = return ()

設定ファイルに書かれた時間毎に時間待ちをしながら、スレッド内ではこの関数を呼んで現在資産評価を証券会社のサイトから取得してDBへ格納しています。

引用元 recordCurrentCondition – Main.hs

{- |
    現在資産評価を証券会社のサイトから取得してDBへ
-}
recordCurrentCondition :: M.ReaderT WebBot.HTTPSession IO ()
recordCurrentCondition = do
    session <- M.ask
    -- 資産状況 -> 余力情報を見に行く
    spare <- WebBot.fetchFraAstSpare
    -- 株式取引 -> 現物売を見に行く
    sell <- WebBot.fetchFraStkSell

    M.liftIO $ do
        -- 現在時間をキーに全てをデーターベースへ
        tm <- Tm.getCurrentTime
        Scraper.storeToDB tm spare
        Scraper.storeToDB tm sell

人間がするような行動なら儲かってればうれしいし、損していたらいずれ戻るかも、とか思いながら放置。でも戻るときもあるんよな。裁量トレードは一事が万事こんな行動。

こんなのダメ絶対。大損の元や。

人間の感情を排したシステムで機械的に損切りを迅速に行なわないと生き残れない。

保有株式の売り注文を発注する

ということで、そろそろ大詰めに入ってきた。

説明してきた関数とそれ以外の関数。大量に細かい部品(関数)を用意し、その関数を合成しながら徐々に大きく組み立ててきたアプリケーションで、やりたかったこと。

売り注文を発注する関数(指し値専用)を作ってみた

引用元 sellStock – WebBot.hs

{- |
    売り注文を出す関数
-}
sellStock :: SellOrderSet -> M.ReaderT HTTPSession IO Scraper.OrderConfirmed
sellStock order =
    let fM s = M.foldM dispatchFrameSet [sTopPageHTML s]
                [("GM", clickLinkText "株式取引")
                ,("LM", clickLinkText "現物売")
                ,("CT", doSellOrder order)]
    in
    either failureAtScraping pure
    <$> Scraper.scrapingOrderConfirmed =<< fM =<< M.ask
    where
    -- 
    doSellOrder :: M.MonadIO m => SellOrderSet -> [T.Text] -> SessionReaderMonadT m
    doSellOrder os htmls = do
        a <- clickSellOrderLink order htmls
        M.liftIO $ CC.threadDelay (300 * 1000)
        b <- submitSellOrderPage order a
        M.liftIO $ CC.threadDelay (300 * 1000)
        submitConfirmPage order b
    -- 
    clickSellOrderLink :: M.MonadIO m => SellOrderSet -> [T.Text] -> SessionReaderMonadT m
    clickSellOrderLink os htmls = do
        fss <- either failureAtScraping pure $ Scraper.scrapingFraStkSell htmls

        -- 所有株の中からcodeで指定された銘柄の売り注文ページリンクを取り出す
        let eqCode = (==) (osCode os) . Scraper.hsCode
        sellOrderUri <- case List.find eqCode $ Scraper.fsStocks fss of
            Nothing ->
                M.liftIO . throwIO . DontHaveStocksToSellException .
                Printf.printf "証券コード%dの株式を所有してないので売れません" $ osCode os
            Just stock -> pure (Scraper.hsSellOrderUrl stock)
        -- 売り注文ページを読み込む
        sellOrderPage <- case sellOrderUri of
            Nothing ->
                M.liftIO . throwIO . UnexpectedHTMLException .
                Printf.printf "証券コード%dの株式注文ページに行けません" $ osCode os
            Just uri -> takeBodyFromResponse <$> fetchInRelativePath uri
        return [sellOrderPage]
    -- 
    submitSellOrderPage :: M.MonadIO m => SellOrderSet -> [T.Text] -> SessionReaderMonadT m
    submitSellOrderPage os htmls = do
        html <- case htmls of
            []  -> failureAtScraping "株式注文ページを受け取れていません。"
            -- 株式注文ページには次のページが無いので先頭のみを取り出す
            x:_ -> pure x
        {-
            売り注文ページのPOSTリクエストを組み立てる
            以下は初期値のまま
            name="orderNari" 成行チェックボックス
            name="execCondCD" 執行条件ラジオボタン
            name="validDt" 有効期間ラジオボタン
        -}
        let customPostReq = [("orderNominal", B8.pack . show $ osNominal os)    -- 株数
                            ,("orderPrc", B8.pack . show $ osPrice os)          -- 値段
                            ,("tyukakuButton.x", "57")                          -- 注文確認ボタンのクリック位置
                            ,("tyukakuButton.y", "10")                          -- 注文確認ボタンのクリック位置
                            ]
        -- 売り注文ページのフォームを提出する
        session <- M.ask
        M.liftIO $ doPostActionOnSession session customPostReq html
        >>= \case
            Nothing -> M.liftIO . throwIO . UnexpectedHTMLException $
                        Printf.printf "証券コード%dの注文確認ページに行けません" (osCode os)
            Just r -> return [takeBodyFromResponse r]
    -- 
    submitConfirmPage :: M.MonadIO m => SellOrderSet -> [T.Text] -> SessionReaderMonadT m
    submitConfirmPage os htmls = do
        html <- case htmls of
            []  -> failureAtScraping "注文確認ページを受け取れていません。"
            -- 注文確認ページには次のページが無いので先頭のみを取り出す
            x:_ -> pure x
        {-
            注文確認ページのPOSTリクエストを組み立てる
        -}
        let customPostReq = [("pinNo", B8.pack $ osPassword os)]    -- 取引暗証番号
        -- 注文確認ページのフォームを提出する
        session <- M.ask
        M.liftIO $ doPostActionOnSession session customPostReq html
        >>= \case
            Nothing -> M.liftIO . throwIO . UnexpectedHTMLException $
                        Printf.printf "証券コード%dの注文終了ページに行けません" (osCode os)
            Just r -> return [takeBodyFromResponse r]

ここまでで説明してきた事が分かっていたら、動作は理解できるだろうと思う。この関数では

  1. “株式取引”をクリック
  2. “現物売”をクリック
  3. 保有株式リストから売りたい株の”売”をクリック
  4. 株数、値段を入力して注文確認ボタンをクリック
  5. 取引暗証番号を入力して発注ボタンをクリック
  6. 注文終了

この流れをやっています。

引用元 SellOrderSet – WebBot.hs

{- |
    注文情報
-}
data SellOrderSet = SellOrderSet {
    osPassword  :: String,
    osCode      :: Int,
    osNominal   :: Int,
    osPrice     :: Double
}

この注文情報を引数に関数を呼ぶ。

売り注文関数で注文を実行

Slackアプリの定期通知

戦略無しで損切りすると損切り貧乏に陥るので、この関数を呼ぶ関数を用意していない。

現在立会時間外なので、実験的に呼んでみる。

まず、こんな内容の通知を見て「ぎゃぁぁぁあああぁぁ損、損しとるじゃないですか!!。」と焦って、コード1343を10株、1952.0円で売りに出すとする。

 

import Control.Monad.Reader
import Data.Function
import Data.Maybe
import Network.URI
import Conf
import WebBot

main = do
    conf <- either (const Nothing) Just <$> readJSONFile "conf.json"
    let url = parseURI . loginURL =<< conf
    let pw = dealingsPassword . fromJust $ conf
    let order = SellOrderSet pw 1343 10 1952.0
    session <- fromJust $ liftM2 login conf url 
    print =<< (\(Just s) -> runReaderT (sellStock order) s) session
    logout . fromJust $ session

このgistが手元にあるとして、このように呼ぶ。

説明の都合でghciだけどstack runhaskell sellorder.hsでもいい。

% stack ghci
The following GHC options are incompatible with GHCi and have not been passed to it: -threaded
Configuring GHCi with the following packages: tractor
Using main module: 1. Package `tractor' component exe:tractor with main-is file: tractor/app/Main.hs
GHCi, version 8.0.1: http://www.haskell.org/ghc/  :? for help
[1 of 5] Compiling Conf             ( tractor/src/Conf.hs, interpreted )
[2 of 5] Compiling Scraper          ( tractor/src/Scraper.hs, interpreted )
[3 of 5] Compiling DataBase         ( tractor/src/DataBase.hs, interpreted )
[4 of 5] Compiling WebBot           ( tractor/src/WebBot.hs, interpreted )
[5 of 5] Compiling SlackBot         ( tractor/src/SlackBot.hs, interpreted )
Ok, modules loaded: Conf, WebBot, Scraper, DataBase, SlackBot.
[6 of 6] Compiling Main             ( tractor/app/Main.hs, interpreted )
Ok, modules loaded: Conf, WebBot, Scraper, DataBase, SlackBot, Main.
Loaded GHCi configuration from /tmp/ghci21307/ghci-script
*Main Conf DataBase Scraper SlackBot WebBot> :l sellorder.hs
[1 of 5] Compiling Conf             ( tractor/src/Conf.hs, interpreted )
[2 of 5] Compiling Scraper          ( tractor/src/Scraper.hs, interpreted )
[3 of 5] Compiling DataBase         ( tractor/src/DataBase.hs, interpreted )
[4 of 5] Compiling WebBot           ( tractor/src/WebBot.hs, interpreted )
[5 of 5] Compiling Main             ( sellorder.hs, interpreted )
Ok, modules loaded: Conf, WebBot, Scraper, DataBase, Main.
*Main> Main.main
*Main> 

省略

注文結果のHTMLが表示されたでしょ。注文が通ったかサイトで確認してみる。

証券コード1343、売り注文、 発注数10株、指し値1952円できちんと注文が通っているのが確認できた。ついでにこの注文は取り消しておいた。

ここでアプリケーション完成ちゃうの?

ここまでで最初に書いたアプリケーションの目的をほぼ達成してるやろ。

え、東証の休日にも通知を送ってくるって?細かいことを気にするなよ。

本当はYahoo Financeの左上に日時とともに「日本の証券市場は終了しました。」とかが書かれている部分を読もうと考えていた。しかし、「Yahoo!ファイナンス掲載情報の自動取得(スクレイピング)は禁止しています」となっているからこの方法は使えないの。

システムトレード戦略を練る予定

HaskellはPythonより高速度だろうけど。(確かめていない、そもそも初期の物とは全然違う)速度はとにかく、メモリーの問題で(スワップアウトしまくりだったし)VPSを2Gプランに移行した。

安定して毎月1,600円位(資産の1%)を取る戦略を立ててサーバー代に充てるのが第一の目標。

ここまでしてきてなんだけど、スクレイピングでどうにかするのは安心感が無い、サーバーがどんな返答を返してくるのか、その条件と種類が分からない。実行時例外を受信するたびにログDBを確認して対処するのがめんどくさい。

実用的には売り注文の受け付けましたページをスクレイピングしなければならないけど、素のHTMLを返却してくる手抜き。もうめんどくさくてたまらない。ここはトレード戦略を実装するまで放置。ここでkabu.com APIが気になって仕方が無い。ついでにkabu.com カレンダーで東証の営業日を確認できるやんか。

暇なときに東証の適時開示ページをスクレイピングして保有株と関係したら通知するスレッドでも作ろうかなとか、SlackBotをボットにして会話とかボタン付きメッセージを送ってやろうと思っているけど、そもそも自分はアナログ世界の住人やで。電子工作がしたいんだってば。こんなプログラム本気になってでけへんよ。資金難からの例外やで。

今は、システムトレード本でトレード戦略の学習中。Web上にもあるテクニカル分析ABCで。余裕が出来たらこうフィボナッチ数を計算しようかな。計算は得意だろ、Haskellは。C言語のHello, Worldの代わりにフィボナッチ数列を計算することから入門した訳だし。

今期の決算までに引き渡さないとならない現場を大量に抱えているし、仕事しないと資金が回復しないし、ええ加減長いのでこのあたりで終い。

生兵法にて攻勢し痛手を負って一時撤退、減資して本の購入費に充てることになったけど、今後我が軍は機械化を完了し機甲師団となり捲土重来を期すものとする。

コメントを残す

メールアドレスが公開されることはありません。