Low performance of HTTP request using Haskell wreq

Question

The program makes HTTP requests (checks video stream status) and calls an external program.

{-# LANGUAGE OverloadedStrings #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Lens ((&), (.~), (^.))
import Network.HTTP.Client (HttpException(..))
import Network.Wreq
import Data.Text (Text, null)
import Data.Aeson.Lens (key, _String)
import Control.Exception as E
import System.Process (callCommand)
streamCheckList :: [(String, String)]
streamCheckList = [ ("tempsnip2", "python bot_n.py 2")
 , ("tempsnip3", "python bot.py 3" )
 , ("tempsnip4", "python bot.py 4" )
 ]
tokenAndSignatureBaseUrl :: String -> String
tokenAndSignatureBaseUrl ch = concat [ "https://api.twitch.tv/api/channels/"
 , ch, "/access_token" ]
tokenAndSignature :: String -> IO (Response B.ByteString)
tokenAndSignature ch = get $ tokenAndSignatureBaseUrl ch
hlsPlaylistBaseUrl :: String -> String
hlsPlaylistBaseUrl ch = concat [ "http://usher.twitch.tv/api/channel/hls/"
 , ch, ".m3u8" ]
hlsPlaylist :: (String, Text, Text) -> IO (Response B.ByteString)
hlsPlaylist (ch, token, sig) = let opts = defaults & param "token" .~ [token]
 & param "sig" .~ [sig]
 in getWith opts $ hlsPlaylistBaseUrl ch
restartIfNeeded :: (String, String) -> IO ()
restartIfNeeded (ch, cmd) = do streamAccessible <- isStreamAccessible ch
 if streamAccessible
 then print $ ch ++ " stream is accessible"
 else do print $ "restarting " ++ ch
 restart cmd
restart :: String -> IO ()
restart existingProcessCmd = (callCommand $ concat [ "pkill --full \""
 , existingProcessCmd
 , "\""
 ]) `E.catch` handler
 where
 handler :: E.IOException -> IO ()
 handler e = print e
-- in fact we try to fetch an hls m3u playlist of stream
isStreamAccessible :: String -> IO Bool
isStreamAccessible ch = do
 E.try (tokenAndSignature ch) >>= tsHandler
 where
 tsHandler :: Either HttpException (Response B.ByteString) -> IO Bool
 tsHandler (Left _) = return False
 tsHandler (Right rToSig)
 = let token = rToSig ^. responseBody . key "token" . _String
 sig = rToSig ^. responseBody . key "sig" . _String
 in if Data.Text.null token || Data.Text.null sig
 then return False
 else E.try (hlsPlaylist (ch, token, sig)) >>= pHandler
 pHandler :: Either HttpException (Response B.ByteString) -> IO Bool
 pHandler (Left _) = return False
 pHandler (Right _) = return True
main :: IO ()
main = mapM_ restartIfNeeded streamCheckList

The problem is that the program uses too much CPU. As explained here, I've built with:

stack build --executable-profiling --library-profiling --ghc-options="-Wall -fprof-auto -rtsopts"

tokenAndSignature takes 26.7% of CPU time with 43.2% allocs. Also it happens so that it's the function which result is used later by lens to decode JSON from. Inner functions of tokenAndSignature contain many decodeLenientWithTable functions (from Data.ByteString.Base64.Internal module) with 550000 entries on average which looks awkward to me.

Yes, I use String type here. But it's only because wreq's library get function requires String as its argument.

stack exec -- test +RTS -sstderr shows that almost 1/3 of time is spent on GC:

MUT time 1.604s ( 5.535s elapsed)
GC time 0.514s ( 0.505s elapsed)
...
Productivity 76.9% of total user, 28.2% of total elapsed

What's my mistake?

• Michael: I'm not really sure that this is a code review question. Since you already know something is wrong shouldn't you be asking in one of the programming questions sections.
• ErikR: What kind of response (typical length and JSON structure) is returned by hlsPlaylist?
• AleXoundOS: B.length for responseBody of Response returned by hlsPlaylist returns 713. But it's content type is not JSON: ("Content-Type","application/vnd.apple.mpegurl"). But tokenAndSignature returns Response with ("Content-Type","application/json; charset=utf-8"). And it's responseBody length is 333.
• AleXoundOS: tokenAndSignature JSON response example: { "token":"{\"user_id\":null,\"channel\":\"snipealot2\",\"expires\":1386615270,\"chansub\":{\"view_until\":1924905600,\"restricted_bitrates\":[]},\"private\":{\"allowed_to_view\":true},\"privileged\":false}", "sig":"ca666ec55c72b12ed42bda9bf88b9926ef1f5bfb", "mobile_restricted":false }
• R B: I don't see what the problem is. tokenAndSignature actually makes the network request (get), so it makes sense to me that it would allocate a bunch of memory and utilize the CPU. Check this SO answer about reducing Haskell binary size. "High CPU usage in 'htop'" is too non-specific to address. Edit the actual profiling result into your question, right now we've got nothing concrete to pick over.

Answer 1

I know this is a really old question but, have you tried using a Session instance when calling wreq's getWith? Using the getWith version included in Network.Wreq creates a separate session for each request, hindering resource sharing and heavily increasing memory usage. It can also cause memory fragmentation, which translates into an increasingly larger resident size reported by the OS.

See the API reference.

• AleXoundOS: Thank you for the tip! Someday, I will try this code snippet again.