myanimelist-export 0.1.0.1 → 0.2.0.0

raw patch · 4 files changed

+58/−9 lines, 4 filesdep +exceptionsdep ~aesondep ~asyncdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: exceptions

Dependency ranges changed: aeson, async, base, conduit, conduit-extra

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• myanimelist-export.cabal +2/−1
• src/MemoizedTraverse.hs +1/−1
• src/MyAnimeList/Export.hs +49/−7

@@ -1,3 +1,9 @@+## 0.2.0.0++* Clearer error messages on crash+* Exception on invalid credentials+* Exception on too many failed logins+ ## 0.1.0.1  * Executable: support for only downloading one list

@@ -1,5 +1,5 @@ name:                myanimelist-export-version:             0.1.0.1+version:             0.2.0.0 synopsis:            Export from MyAnimeList description:     Export anime or manga lists from MyAnimeList in XML format.  Uses the web@@ -29,6 +29,7 @@                      , 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

@@ -28,7 +28,7 @@                  -> t a                  -> f (t b) memoizedTraverse f xs = vals <&> \vals' ->-    lookupErr "memoizedTraverse" vals' <$> xs+    lookupErr "myanimelist-export:memoizedTraverse: lookup error" vals' <$> xs   where     keys = foldl' (flip (flip M.insert ())) M.empty xs     vals = M.traverseWithKey (\k () -> f k) keys

@@ -30,6 +30,7 @@ module MyAnimeList.Export     ( MediaType(..)     , exportLists+    , MyAnimeListException(..)     ) where  import           Data.Function@@ -37,6 +38,8 @@ import           Control.Monad import           Control.Monad.IO.Class +import           Control.Monad.Catch (MonadThrow, Exception, throwM)+ import           Control.Concurrent.Async (Concurrently(Concurrently),                                            runConcurrently) @@ -51,7 +54,7 @@ import qualified Data.Conduit.List as C  import           Text.HTML.TagStream.ByteString (Token, tokenStream)-import           Text.HTML.TagStream            (Token' (TagOpen))+import           Text.HTML.TagStream            (Token' (TagOpen, Text))  import           Network.URI         (URI, parseURIReference, uriPath,                                       relativeTo)@@ -64,6 +67,12 @@ data MediaType = Anime | Manga   deriving (Read, Show, Eq, Ord, Enum) +-- | Possible exceptions that could be raised by `exportLists`+data MyAnimeListException = InvalidCredentials -- ^ Wrong username/password+                          | TooManyAttempts    -- ^ Too many failed logins+  deriving (Read, Show, Eq, Ord)+instance Exception MyAnimeListException+ newtype CSRF = CSRF { unCsrf :: ByteString }  @@ -79,7 +88,18 @@ malExportPath :: String malExportPath = "/export/download.php" +-- | Known MyAnimeList error messages with the corresponding exceptions+malErrorMap :: [(ByteString, MyAnimeListException)]+malErrorMap = [ ("Your username or password is incorrect.", InvalidCredentials)+              , ("Too many failed login attempts, your IP address has been blocked for several hours.", TooManyAttempts)+              ] +lookupErrorMap :: ByteString -> Maybe MyAnimeListException+lookupErrorMap t = case filter (\(m,_) -> BS.isInfixOf m t) malErrorMap of+    []         -> Nothing+    ((_, e):_) -> Just e++ -- | Export list(s) and return URL(s) to gzipped XML exportLists :: (Functor f, Foldable f)             => Text        -- ^ Username@@ -99,8 +119,11 @@       -> CSRF       -> Manager       -> IO CookieJar-login username password cj csrf manager = withResponse req manager $-    pure . responseCookieJar+login username password cj csrf manager = withResponse req manager $ \res -> do+    runConduit $ sourceBodyReader (responseBody res)+              .| tokenStream+              .| awaitForever tagToLoginError+    pure $ responseCookieJar res   where     req = urlEncodedBody [ ("user_name", encodeUtf8 username)                          , ("password", encodeUtf8 password)@@ -116,8 +139,9 @@     runConduit $ sourceBodyReader (responseBody res)               .| tokenStream               .| C.mapMaybe tagToCsrf-              .| (await >>= maybe (fail "getCsrf")-                                  (pure . (,) (responseCookieJar res))+              .| (await >>= maybe+                           (fail $ moduleName ++ ".getCsrf: couldn't find csrf")+                           (pure . (,) (responseCookieJar res))                  )  exportList :: CookieJar@@ -131,8 +155,9 @@               .| C.mapMaybe tagToUri               .| C.filter ((malExportPath ==) . uriPath)               .| C.map (`relativeTo` getUri malHomePage)-              .| (await >>= maybe (fail "exportList")-                                  pure+              .| (await >>= maybe+                         (fail $ moduleName ++ ".exportList: couldn't find uri")+                         pure                  )   where     req = urlEncodedBody [ ("type", mediaTypeValue mediaType)@@ -158,6 +183,23 @@     parseURIReference . B8.unpack =<< lookup "href" xs tagToUri _ = Nothing +tagToLoginError :: MonadThrow m => Token -> ConduitM Token o m ()+tagToLoginError (TagOpen "div" xs False)+    | lookup "class" xs == Just "badresult" = do+        nextTag <- await+        case nextTag of+            Just (Text t)+                | Just e <- lookupErrorMap t -> throwM e+            Just e -> failM $ moduleName ++ ".login: unknown error: " ++ show e+            Nothing -> failM $ moduleName ++ ".login: unexpected end of stream"+tagToLoginError _ = pure ()+ mediaTypeValue :: MediaType -> ByteString mediaTypeValue Anime = "1" mediaTypeValue Manga = "2"++moduleName :: String+moduleName = "MyAnimeList.Export"++failM :: MonadThrow m => String -> m a+failM = throwM . userError