Network.HTTPでHTTPSが使えないの知らなくて書いて、結局捨てたコード

Consumer.hs

module Whiteye.OAuth.Consumer (
    Consumer (..),
    oAuthRequest
    ) where

import Data.List
import Control.Applicative
import Network.URI
import Network.HTTP
import qualified System.Time as Time
import qualified System.Random as Rand
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.Digest.Pure.SHA as SHA
import qualified Codec.Binary.Base64 as Base64

data Consumer = Consumer {
    consumerKey :: String,
    consumerSecret :: String,
    accessToken :: String,
    accessTokenSecret :: String
} deriving (Show, Eq)

mkTimestamp :: IO String
mkTimestamp = showSec <$> Time.getClockTime
    where showSec (Time.TOD sec _) = show sec

mkNonce :: IO String
mkNonce = sequence $ replicate 32 $ Rand.randomRIO ('a', 'z')

mkSignature :: String -> String -> RequestMethod -> URI -> [(String, String)] -> String
mkSignature consumerSecret accessTokenSecret method uri params =
  base64encode $ SHA.hmacSha1 (B8.pack key) (B8.pack msg)
    where key = consumerSecret ++ "&" ++ accessTokenSecret
          msg = intercalate "&" $
            map urlEncode [show method, show uri, urlEncodeVars (sort params)]
          base64encode = Base64.encode . B.unpack . SHA.bytestringDigest

oAuthHeaderContent :: [(String, String)] -> String
oAuthHeaderContent params =
  "OAuth " ++ (intercalate ", " $ map encodeParam params)
    where encodeParam (k, v) = urlEncode k ++ "=\"" ++ urlEncode v ++ "\""

mkOAuthHeader :: Consumer -> RequestMethod -> URI -> [(String, String)] ->
                 String -> String -> Header
mkOAuthHeader consumer method uri params timestamp nonce =
  mkHeader HdrAuthorization $
           oAuthHeaderContent $ ("oauth_signature", sig) : oauthParams
    where oauthParams = [ ("oauth_consumer_key", consumerKey consumer),
                          ("oauth_token", accessToken consumer),
                          ("oauth_signature_method", "HMAC-SHA1"),
                          ("oauth_timestamp", timestamp),
                          ("oauth_nonce", nonce),
                          ("oauth_version", "1.0") ]
          sig = mkSignature (consumerSecret consumer)
                            (accessTokenSecret consumer)
                            method uri (oauthParams ++ params)

mkOAuthRequest :: RequestMethod -> URI -> [(String, String)] ->
                  Header -> Request_String
mkOAuthRequest GET uri params authHeader =
  Request {
      rqMethod = GET,
      rqURI = uri { uriQuery = '?' : urlEncodeVars params },
      rqHeaders = [authHeader],
      rqBody = ""
  }
mkOAuthRequest POST uri params authHeader =
  Request {
      rqMethod = POST,
      rqURI = uri,
      rqHeaders = [authHeader, ctypeHeader, clenHeader],
      rqBody = body
  }
    where
      body = urlEncodeVars params
      ctypeHeader = mkHeader HdrContentType "application/x-www-form-urlencoded"
      clenHeader = mkHeader HdrContentType (show $ length body)

oAuthRequest :: Consumer -> RequestMethod -> URI -> [(String, String)] ->
                IO Request_String
oAuthRequest consumer method uri params =
  mkOAuthRequest method uri params <$>
    (mkOAuthHeader consumer method uri params <$> mkTimestamp <*> mkNonce)