Upload to rackspace with CURL

Http-Ennumerator.hs

{-# LANGUAGE OverloadedStrings #-}
module Main where

import qualified Data.List as L
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
import qualified Network.HTTP.Enumerator as HTTP
import           Network (withSocketsDo)
import           System.Posix.Env
import           System.IO

rackspaceRequest method host path headers body = HTTP.Request {
  HTTP.method      = method,
  HTTP.path        = path,
  HTTP.host        = host,
  HTTP.port        = 443,
  HTTP.queryString = [],
  HTTP.requestBody = body,
  HTTP.secure      = True,
  HTTP.requestHeaders = headers
}

authRequest api_user api_key =
  rackspaceRequest "GET" "auth.api.rackspacecloud.com" "/v1.0" [
    ("X-Auth-User", B.pack api_user), ("X-Auth-Key", B.pack api_key)
  ] ""
  
main = withSocketsDo . HTTP.withHttpEnumerator $ do
  api_user <- getEnvDefault "RACKSPACE_USER" ""
  api_key  <- getEnvDefault "RACKSPACE_KEY" ""
  authResponse <- withSocketsDo . HTTP.withHttpEnumerator $ HTTP.httpLbs $ authRequest api_user api_key
  case HTTP.statusCode authResponse of
    204 -> do
      let headers      = HTTP.responseHeaders authResponse
      let Just storage = L.find (\header -> fst header == "x-storage-url") headers
      let Just token   = L.find (\header -> fst header == "x-auth-token") headers
      storageUrl     <- HTTP.parseUrl $ B.unpack (snd storage)
      uploadFile storageUrl token "ubuntu-10.04.1-server-amd64.iso"
    otherwise -> putStrLn "Error authenticating with rackspace"

uploadFile storageUrl token path = do
  file <- LB.readFile path
  uploadResponse <- HTTP.httpLbs $ rackspaceRequest "PUT" (HTTP.host storageUrl) (B.concat $ [HTTP.path storageUrl, "/yourwebisonline-files/ubuntu.iso"]) [("X-Auth-Token", snd token), ("X-Storage-Token", snd token)] file
  case HTTP.statusCode uploadResponse of
    201 -> putStrLn "File uploaded"
    otherwise -> putStrLn "Error uploading file"