Created
June 4, 2014 14:24
-
-
Save patrickt/d39cc82a386050e1e44e to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE OverloadedStrings #-} | |
module Main where | |
-- third-party libraries | |
import qualified Data.Configurator as Config | |
import Network.HTTP.Client | |
import System.IO.Streams as Streams | |
import Control.Concurrent | |
import Control.Concurrent.Thread | |
import Data.ByteString (ByteString) | |
import Data.String | |
import Data.Text | |
import System.Exit | |
-- Text values are unicode-aware, where as ByteStrings are dumb+fast char buffers | |
data Credentials = Credentials { | |
email :: ByteString, | |
password :: ByteString | |
} deriving (Eq, Show) | |
makeRequest :: String -> Credentials -> IO (InputStream ByteString) | |
makeRequest path creds = do | |
conn <- openConnection "http://tacoapp.com" 80 | |
request <- buildRequest $ do | |
http GET path | |
setAuthorizationBasic (email creds) (password creds) | |
sendRequest conn request emptyBody | |
result <- receiveResponse (\resp stream -> stream) | |
closeConnection conn | |
return result | |
requestAndWrite :: String -> Credentials -> FilePath -> IO () | |
requestAndWrite httpPath creds filePath = do | |
stream <- makeRequest httpPath creds | |
withFileAsOutput filePath (Streams.connect stream) | |
main :: IO () | |
main = do | |
cfg <- Config.load ["./myconfig.cfg"] | |
mail <- Config.lookup cfg "email" -- mail has type (Maybe Text) now | |
pass <- Config.lookup cfg "password" -- ditto | |
when ((isNothing mail) || (isNothing pass)) exitFailure | |
-- pattern-matches at this point are safe because we already checked for Nothing | |
let (Just m) = mail | |
let (Just p) = pass | |
let creds = Credentials { email = m, password = p} | |
task1 <- forkIO (requestAndWrite "/path1" creds "file1.txt") | |
task2 <- forkIO (requestAndWrite "/path2" creds "file2.txt") | |
task3 <- forkIO (requestAndWrite "/path3" creds "file3.txt") | |
-- wait for all threads to complete | |
mapM_ wait [task1, task2, task3] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment