[Haskell-cafe] CURL and threads

[Eugeny N Dzhurinsky]

On Wed, Feb 17, 2010 at 07:34:07PM +0200, Eugene Dzhurinsky wrote:
> Hopefully, someone could help me in overcoming my ignorance :)

I realized that I can share the same Chan instance over all invocations in
main, and wrap internal function into withCurlDo to ensure only one IO action
gets executed with this library. Finally I've come with the following code,
which however still has some memory leaks. May be someone will get an idea
what's wrong below?

=============================================================================================

module NTLMTest where

import System.IO
import Network.Curl
import Control.Concurrent
import Control.Concurrent.Chan

type ResponseState = Either Bool String

type RespChannel = Chan ResponseState

delay = 500 * 1000

isResponseOk :: String -> CurlResponse -> ResponseState
isResponseOk username response = case respCurlCode response of
                            CurlOK  -> Left True
                            _       -> Right $ username ++ " => " ++ respStatusLine response ++ " :: " ++ (show . respStatus $ response)
                        

checkAuthResponse :: RespChannel -> String -> String -> String -> IO ()
checkAuthResponse state user passwd url = do 
                                    response <- curlGetResponse_ url [CurlHttpAuth [HttpAuthAny], CurlUserPwd $ user ++ ":" ++ passwd]
                                    writeChan state $ isResponseOk user response
                                    threadDelay $ delay

runHTTPThread :: RespChannel -> (String,String) -> IO ()
runHTTPThread state (user,passwd) = checkAuthResponse state user passwd url
        

url = "http://localhost:8082/"
credentials = map (\i -> ("user" ++ show i,"123456")) [1..21]

main = do
    chan <- newChan :: IO (RespChannel)
    withCurlDo $ invokeThreads chan
    where 
        invokeThreads chan = do
            mapM_ ( \cred -> forkIO $ runHTTPThread chan cred ) credentials
            dumpChannel chan $ length credentials
            invokeThreads chan
        dumpChannel :: RespChannel -> Int -> IO ()
        dumpChannel _chan n | n == 0    = return ()
                            | otherwise = do    state <- readChan _chan
                                                case state of
                                                    (Left _) -> return () --putStrLn "OK"
                                                    (Right err) -> putStrLn err
                                                dumpChannel _chan $ n-1


=============================================================================================

Thank you in advance!

-- 
Eugene Dzhurinsky
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 196 bytes
Desc: not available
Url : http://www.haskell.org/pipermail/haskell-cafe/attachments/20100217/7b56945f/attachment.bin