Set the user-agent

This commit is contained in:
Mats Rauhala 2021-11-11 22:37:18 +02:00
parent b79fa52b25
commit 1e661fe3ca
1 changed files with 6 additions and 2 deletions

View File

@ -1,10 +1,11 @@
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Control.Monad.HTTP where
import Data.ByteString.Lazy (ByteString)
import Data.URL (URL (URL))
import Control.Monad.Free.Church (F, liftF, foldF)
import Network.HTTP.Client (Manager, httpLbs, parseRequest, responseBody)
import Network.HTTP.Client (Manager, httpLbs, parseRequest, responseBody, Request (requestHeaders))
import System.IO.Unsafe (unsafeInterleaveIO)
data OpsF f = Fetch URL (ByteString -> f)
@ -28,10 +29,13 @@ fetch u = liftF (Fetch u id)
--
-- The requests are executed lazily, both as an atomic request and as
-- a lazy bytestring. Be careful.
--
-- A custom user-agent is set for each request
execute :: Manager -> FetchM a -> IO a
execute manager = foldF $ \case
Fetch (URL u) k -> k <$> unsafeInterleaveIO (fetchR u)
where
ua = ("User-Agent", "FeedMonad")
fetchR u = do
req <- parseRequest u
responseBody <$> httpLbs req manager
responseBody <$> httpLbs req{requestHeaders=[ua]} manager