From 1e661fe3ca0cac7c1d760dc815666a6ec9b3b640 Mon Sep 17 00:00:00 2001
From: Mats Rauhala <mats.rauhala@iki.fi>
Date: Thu, 11 Nov 2021 22:37:18 +0200
Subject: [PATCH] Set the user-agent

---
 FeedMonad/src/Control/Monad/HTTP.hs | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/FeedMonad/src/Control/Monad/HTTP.hs b/FeedMonad/src/Control/Monad/HTTP.hs
index a885b44..e7dca3f 100644
--- a/FeedMonad/src/Control/Monad/HTTP.hs
+++ b/FeedMonad/src/Control/Monad/HTTP.hs
@@ -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