From c3caf869c72050123b75b61ae0aca1a975f8e285 Mon Sep 17 00:00:00 2001
From: Jan Sucan <jan@jansucan.com>
Date: Sun, 14 Sep 2025 15:54:53 +0200
Subject: ch23: Add support for HTTPS for easier testing

---
 ch23/support/ch23_https.patch | 77 +++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 77 insertions(+)
 create mode 100644 ch23/support/ch23_https.patch

(limited to 'ch23/support/ch23_https.patch')

diff --git a/ch23/support/ch23_https.patch b/ch23/support/ch23_https.patch
new file mode 100644
index 0000000..e93c83f
--- /dev/null
+++ b/ch23/support/ch23_https.patch
@@ -0,0 +1,77 @@
+diff -rupN ch23/PodDownload.hs new-ch23/PodDownload.hs
+--- ch23/PodDownload.hs	2025-09-14 15:33:15.647379522 +0200
++++ new-ch23/PodDownload.hs	2025-09-14 15:41:54.129935197 +0200
+@@ -3,32 +3,35 @@ module PodDownload where
+ import PodTypes
+ import PodDB
+ import PodParser
+-import Network.HTTP
++import Network.HTTP.Conduit
++import Network.HTTP.Types.Method
++import Network.HTTP.Types.Status
+ import System.IO
+ import Database.HDBC
+ import Data.Maybe
+ import Network.URI
+ 
++import qualified Data.Text.Lazy as LT
++import qualified Data.Text.Lazy.Encoding as LTE
++import qualified Data.Text as T
++import qualified Data.Text.Encoding as TE
++import qualified Data.ByteString.Lazy as LBS
++
+ {- | Download a URL.  (Left errorMessage) if an error,
+ (Right doc) if success. -}
+-downloadURL :: String -> IO (Either String String)
++downloadURL :: String -> IO (Either String LBS.ByteString)
+ downloadURL url =
+-    do resp <- simpleHTTP request
+-       case resp of
+-         Left x -> return $ Left ("Error connecting: " ++ show x)
+-         Right r -> 
+-             case rspCode r of
+-               (2,_,_) -> return $ Right (rspBody r)
+-               (3,_,_) -> -- A HTTP redirect
+-                 case findHeader HdrLocation r of
+-                   Nothing -> return $ Left (show r)
+-                   Just url -> downloadURL url
+-               _ -> return $ Left (show r)
+-    where request = Request {rqURI = uri,
+-                             rqMethod = GET,
+-                             rqHeaders = [],
+-                             rqBody = ""}
+-          uri = fromJust $ parseURI url
++    do initReq <- parseRequest url
++       let request = initReq { method = methodGet }
++       manager <- newManager tlsManagerSettings
++       resp <- httpLbs request manager
++       let status = responseStatus resp
++       -- httpLbs follows redirections (up to the limit specified in the
++       -- request, default is 10). No need to handle redirections explicitly
++       -- here.
++       if statusIsSuccessful status
++         then return $ Right $ responseBody resp
++         else return $ Left $ T.unpack $ TE.decodeUtf8 $ statusMessage status
+ 
+ {- | Update the podcast in the database. -}
+ updatePodcastFromFeed :: IConnection conn => conn -> Podcast -> IO ()
+@@ -36,7 +39,7 @@ updatePodcastFromFeed dbh pc =
+     do resp <- downloadURL (castURL pc)
+        case resp of
+          Left x -> putStrLn x
+-         Right doc -> updateDB doc
++         Right doc -> updateDB $ LT.unpack $ LTE.decodeUtf8 $ doc
+ 
+     where updateDB doc = 
+               do mapM_ (addEpisode dbh) episodes
+@@ -53,9 +56,7 @@ getEpisode dbh ep =
+          Left x -> do putStrLn x
+                       return Nothing
+          Right doc -> 
+-             do file <- openBinaryFile filename WriteMode
+-                hPutStr file doc
+-                hClose file
++             do LBS.writeFile filename doc
+                 updateEpisode dbh (ep {epDone = True})
+                 commit dbh
+                 return (Just filename)
-- 
cgit v1.2.3