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?

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.