HaskellでHTTPクライアントを書く その２

前回の記事では、Network.HTTP.simpleHTTPを使ってHTTPクライアントを書きましたが、これだとプロキシー設定ができず、テキストデータしか取ってこれません。

それに対し、Network.Browserを使うと、プロキシー設定ができ、バイナリーデータも取ってこれます。

テキストデータはStringで、バイナリーデータはByteStringでとってくることにしたのですが、そうすると関数を２系統作らなければなりません。実際にNetwork.Browserを使ってダウンロードしてくる部分は２系統必要ですが、それを呼び出す関数を１つにまとめたいと考えました。

代数的データ型の直和を使って、StringでもByteStringでも、同じ関数名でダウンロードして保存できるようにするようにしてみました。

http_client.hs

{-# OPTIONS -Wall -Werror #-}

import Network.HTTP
import Network.HTTP.Proxy
import Network.Browser
import Data.Maybe (fromJust)
import Network.URI (parseURI,URI)
import Control.Applicative
import qualified Data.ByteString.Lazy as L
import Data.List
import Control.Exception

-- | ----------------------------------------------------
-- | プロキシーサーバ設定
proxyType :: Proxy
proxyType = NoProxy
-- proxyType = fromJust $ parseProxy "127.0.0.1:8080"

-- | ----------------------------------------------------
-- | バイナリ取得Request
binary_request :: String -> Request L.ByteString
binary_request uri = 
     Request {
       rqURI = fromJust $ parseURI uri,
       rqMethod = GET,
       rqHeaders = [],
       rqBody = L.empty }

-- | バイナリの取得action
binary_action :: 
  String -> BrowserAction (HandleStream L.ByteString) (URI, Response L.ByteString)
binary_action uri = 
  (setOutHandler (\_ -> return ())) >>
  (setProxy proxyType) >>
  (request $ binary_request uri)

-- | バイナリの取得browse
binary_browse :: String -> IO L.ByteString
binary_browse uri = do
  (_, res) <- browse $ binary_action uri
  return $ rspBody res
-- | ----------------------------------------------------
-- | テキスト取得Request
text_request :: String -> Request String
text_request uri = 
     Request {
       rqURI = fromJust $ parseURI uri,
       rqMethod = GET,
       rqHeaders = [],
       rqBody = "" }

-- | テキストの取得action
text_action :: 
  String -> BrowserAction (HandleStream String) (URI, Response String)
text_action uri = 
  (setOutHandler (\_ -> return ())) >>
  (setProxy proxyType) >>
  (request $ text_request uri)

-- | テキストの取得browse  do～return版
text_browse' :: String -> IO String
text_browse' uri = do
  (_, res) <- browse $ text_action uri
  return $ rspBody res

-- | テキストの取得browse  アプリカティブスタイル版
text_browse :: String -> IO String
text_browse uri = (rspBody . snd) <$> (browse $ text_action uri)

-- | ----------------------------------------------------
-- | ファイル名の拡張子が候補の中にあったらTrueを返す
foundSuffixIn :: [String] -> String -> Bool
foundSuffixIn suffixes filename =
  or $ map (f filename) suffixes
    where f a b = isSuffixOf b a

-- | リソースの長さを表示する
getLength :: String -> IO ()
getLength uri = 
  if foundSuffixIn [".png",".jpg",".jpeg"] uri 
    then do x <- binary_browse uri
            putStrLn ("bin uri:" ++ uri ++ " length:" ++ (show $ L.length x))
    else do x <- text_browse uri
            putStrLn ("txt uri:" ++ uri ++ " length:" ++ (show $ length x))

-- | ----------------------------------------------------
-- | 代数的データ型を使って、StringでもL.ByteStringでも
-- | 同じ関数名でダウンロードして保存できるようにする
data Resource = S String | B L.ByteString
     deriving (Eq, Show)

getResource :: String -> IO Resource
getResource uri = 
      if foundSuffixIn [".png",".jpg",".jpeg"] uri 
        then do x <- binary_browse uri
                return (B x)
--      else do x <- text_browse uri
--              return (S x)
        else (S <$> (text_browse uri))

saveResource :: Resource -> IO ()
saveResource (S text) = writeFile   "hoge.txt" text
saveResource (B bin)  = L.writeFile "hoge.dat" bin

-- | ----------------------------------------------------
-- | メインプログラム
png_uri :: String
png_uri = "http://www.google.com/intl/en_com/images/srpr/logo1w.png"

text_uri :: String
text_uri = "http://ntp-a1.nict.go.jp/cgi-bin/time"

main :: IO ()
main = catches (
         do getLength text_uri
            getLength png_uri
            getResource text_uri >>= saveResource
            getResource png_uri >>= saveResource
       )
       [Handler ((\e -> putStrLn ("IOException " ++ show e)) :: IOException -> IO ()),
        Handler ((\e -> putStrLn ("SomeException " ++ show e)) :: SomeException -> IO ())]

美しくないですが、プロキシーを使うかどうかはプログラムを書き換えて切り替えます。

実験用ソースコードなので、do～returnとかアプリカティブスタイルとか混ぜて書いてあります。

---

参考サイト
1. HaskellでHTTP -- Kenkov diary
http://d.hatena.ne.jp/kenkov/20110430/1304162021
プロキシーがある場合が説明されています。