diff options
Diffstat (limited to 'ch23/23_a_1/PodDownload.hs')
| -rw-r--r-- | ch23/23_a_1/PodDownload.hs | 45 |
1 files changed, 23 insertions, 22 deletions
diff --git a/ch23/23_a_1/PodDownload.hs b/ch23/23_a_1/PodDownload.hs index 84e6ab7..2e53c54 100644 --- a/ch23/23_a_1/PodDownload.hs +++ b/ch23/23_a_1/PodDownload.hs @@ -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)
|