diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,10 @@ +## 0.3.0.0 + +* Now supports http-client version >= 0.4.30 and + http-client-tls version >= 0.2.4 +* Work around MyAnimeList update: `exportLists` now also returns the CookieJar + which is required in order to access the download URL(s) + ## 0.2.0.0 * Clearer error messages on crash diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -1,4 +1,4 @@ --- Copyright (C) 2017 Matthew Harm Bekkema +-- Copyright (C) 2017-2018 Matthew Harm Bekkema -- -- This file is part of myanimelist-export. -- @@ -43,12 +43,11 @@ import System.Directory (XdgDirectory(XdgConfig), getXdgDirectory) -import Network.URI (URI) -import Network.HTTP.Client (BodyReader, Manager, brRead, - defaultRequest, withResponse, - responseBody) -import Network.HTTP.Client.TLS (newTlsManager) -import Network.HTTP.Client.Internal (setUri) +import Network.URI (URI, uriToString) +import Network.HTTP.Client (Manager, BodyReader, CookieJar, + withResponse, parseRequest, + responseBody, brRead, cookieJar) +import Network.HTTP.Client.TLS (getGlobalManager) import MyAnimeList.Export @@ -66,20 +65,22 @@ main = do configPath <- getXdgDirectory XdgConfig "myanimelist-export.yaml" Config {..} <- either throwIO pure =<< decodeFileEither configPath - manager <- newTlsManager + manager <- getGlobalManager putStrLn "exporting" let wanted = mapMaybe sequence [ (Anime, animeXmlPath) , (Manga, mangaXmlPath) ] - Compose uris <- exportLists username password manager $ Compose $ + (cj, Compose uris) <- exportLists username password manager $ Compose $ fmap (\x -> (x, fst x)) wanted forM_ uris $ \((mt, fp), uri) -> do putStrLn $ "downloading " ++ mediaTypeString mt ++ " list" - downloadList manager uri fp + downloadList manager cj uri fp -downloadList :: Manager -> URI -> FilePath -> IO () -downloadList manager uri fp = do - request <- setUri defaultRequest uri +downloadList :: Manager -> CookieJar -> URI -> FilePath -> IO () +downloadList manager cj uri fp = do + request <- fmap (\x -> x { cookieJar = Just cj }) $ + parseRequest $ + uriToString id uri "" withResponse request manager $ \res -> runConduitRes $ sourceBodyReader (responseBody res) .| ungzip diff --git a/myanimelist-export.cabal b/myanimelist-export.cabal --- a/myanimelist-export.cabal +++ b/myanimelist-export.cabal @@ -1,5 +1,5 @@ name: myanimelist-export -version: 0.2.0.0 +version: 0.3.0.0 synopsis: Export from MyAnimeList description: Export anime or manga lists from MyAnimeList in XML format. Uses the web @@ -11,30 +11,33 @@ license-file: LICENSE author: Matthew Harm Bekkema maintainer: mbekkema97@gmail.com -copyright: 2017 Matthew Harm Bekkema +copyright: 2017-2018 Matthew Harm Bekkema category: Web build-type: Simple extra-source-files: README.md , ChangeLog.md cabal-version: >=1.10 -tested-with: GHC >= 8.0.0 && <= 8.2.2 +tested-with: GHC == 8.0.2 + , GHC == 8.2.2 + , GHC == 8.4.3 library hs-source-dirs: src exposed-modules: MyAnimeList.Export other-modules: MemoizedTraverse ghc-options: -Wall - build-depends: base >= 4.9 && < 4.11 - , async >= 2.1 && < 2.2 - , bytestring >= 0.10 && < 0.11 - , conduit >= 1.2 && < 1.3 - , containers >= 0.5 && < 0.6 - , exceptions >= 0.4 && < 0.9 - , http-client >= 0.5 && < 0.6 - , network-uri >= 2.6 && < 2.7 - , tagstream-conduit >= 0.5 && < 0.6 - , text >= 1.2 && < 1.3 + build-depends: base >= 4.9 && < 4.12 + , async >= 2.1 && < 2.3 + , bytestring >= 0.10 && < 0.11 + , conduit >= 1.2 && < 1.4 + , containers >= 0.5 && < 0.7 + , exceptions >= 0.4 && < 0.11 + , http-client >= 0.4.30 && < 0.6 + , network-uri >= 2.6 && < 2.7 + , tagstream-conduit >= 0.5 && < 0.6 + , text >= 1.2 && < 1.3 default-language: Haskell2010 + other-extensions: OverloadedStrings executable myanimelist-export hs-source-dirs: app @@ -48,12 +51,15 @@ , network-uri , text - , aeson >= 0.7 && < 1.2 - , conduit-extra >= 1.1 && < 1.2 + , aeson >= 0.7 && < 1.5 + , conduit-extra >= 1.1 && < 1.4 , directory >= 1.2.3 && < 1.4 - , http-client-tls >= 0.3.4 && < 0.4 + , http-client-tls >= 0.2.4 && < 0.4 , yaml >= 0.8.4 && < 0.9 default-language: Haskell2010 + other-extensions: TemplateHaskell + OverloadedStrings + RecordWildCards source-repository head type: git diff --git a/src/MemoizedTraverse.hs b/src/MemoizedTraverse.hs --- a/src/MemoizedTraverse.hs +++ b/src/MemoizedTraverse.hs @@ -1,4 +1,4 @@ --- Copyright (C) 2017 Matthew Harm Bekkema +-- Copyright (C) 2017-2018 Matthew Harm Bekkema -- -- This file is part of myanimelist-export. -- @@ -30,7 +30,7 @@ memoizedTraverse f xs = vals <&> \vals' -> lookupErr "myanimelist-export:memoizedTraverse: lookup error" vals' <$> xs where - keys = foldl' (flip (flip M.insert ())) M.empty xs + keys = foldl' (\acc x -> M.insert x () acc) M.empty xs vals = M.traverseWithKey (\k () -> f k) keys lookupErr :: Ord a => String -> Map a b -> a -> b diff --git a/src/MyAnimeList/Export.hs b/src/MyAnimeList/Export.hs --- a/src/MyAnimeList/Export.hs +++ b/src/MyAnimeList/Export.hs @@ -1,4 +1,4 @@ --- Copyright (C) 2017 Matthew Harm Bekkema +-- Copyright (C) 2017-2018 Matthew Harm Bekkema -- -- This file is part of myanimelist-export. -- @@ -24,7 +24,6 @@ -- Stability : experimental ----------------------------------------------------------------------------- -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} module MyAnimeList.Export @@ -58,7 +57,10 @@ import Network.URI (URI, parseURIReference, uriPath, relativeTo) -import Network.HTTP.Client +import Network.HTTP.Client (Manager, Request, BodyReader, CookieJar, + withResponse, parseRequest_, + urlEncodedBody, getUri, path, cookieJar, + responseBody, responseCookieJar, brRead) import MemoizedTraverse (memoizedTraverse) @@ -77,7 +79,7 @@ malHomePage :: Request -malHomePage = "https://myanimelist.net/" +malHomePage = parseRequest_ "https://myanimelist.net/" malLoginPage :: Request malLoginPage = malHomePage { path = "/login.php" } @@ -100,18 +102,20 @@ ((_, e):_) -> Just e --- | Export list(s) and return URL(s) to gzipped XML +-- | Export list(s) and return URL(s) to gzipped XML and a CookieJar which must +-- be used in order to access them. exportLists :: (Functor f, Foldable f) => Text -- ^ Username -> Text -- ^ Password -> Manager -- ^ Manager (must support TLS) -> f MediaType -- ^ Which list(s) to export - -> IO (f URI) + -> IO (CookieJar, f URI) exportLists username password manager mediaTypes = do (cj, csrf) <- getCsrf manager cj' <- login username password cj csrf manager - runConcurrently $ memoizedTraverse + urls <- runConcurrently $ memoizedTraverse (Concurrently . exportList cj' csrf manager) mediaTypes + pure (cj', urls) login :: Text -- ^ Username -> Text -- ^ Password @@ -173,7 +177,7 @@ tagToCsrf :: Token -> Maybe CSRF -tagToCsrf (TagOpen "meta" xs False) = case (lookup "name" xs) of +tagToCsrf (TagOpen "meta" xs False) = case lookup "name" xs of Just "csrf_token" -> CSRF <$> lookup "content" xs _ -> Nothing tagToCsrf _ = Nothing