VKHS 1.8.2 → 1.8.3

raw patch · 10 files changed

+106/−44 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +45/−25
• VKHS.cabal +1/−1
• app/vkq/Main.hs +2/−2
• src/Web/VKHS.hs +4/−1
• src/Web/VKHS/API/Base.hs +25/−9
• src/Web/VKHS/API/Simple.hs +3/−2
• src/Web/VKHS/API/Types.hs +3/−0
• src/Web/VKHS/Client.hs +14/−3
• src/Web/VKHS/Imports.hs +3/−1
• src/Web/VKHS/Types.hs +6/−0

@@ -12,14 +12,22 @@  * Provide access to VK API. Interface options include: VK monad and `vkq` command   line tool.-* Connection uses HTTPS protocol-* Automatic login form solving, may be used to operate on new/disposable-  accounts.-* The VK monad is designed as an interruptable coroutine. Default superwiser-  supports ondemand re-login and may be used for long-running tasks.-* Project includes a set of simplified API wrappers which are designed to be-  copied into `runhaskell` script and tweaked according to user needs.+* Use HTTPS protocol.+* Solve login form interaction, may be used to operate new/disposable VK accounts.+* VK monad is an interruptable coroutine. The superwiser supports ondemand+  re-login, and may be used for long-running tasks.+* Project includes a set of `Web.VKHS.API.Simple` wrappers designed to be+  copied into `runhaskell` scripts and tweaked according to ones need. +Issues+======++* Still no support for captchas, one probably should hack `defaultSuperwiser`+  and add them+* Network connection timeout is not handled by superwiser+* Minor issues here and there. Use `git grep FIXME` to find them+* File uploading still not functioning+ Installing ========== @@ -45,20 +53,29 @@ Developing using Nix -------------------- -We use [Nix](http://nixos.org) as a main development platform. In order to open-development environment, do the following:+The author of this project uses [Nix](http://nixos.org) as a main development+platform. Typical development procedure includes the following steps:      $ git clone https://github.com/grwlf/vkhs     $ cd vkhs+    $     $ nix-shell-    $ ...++      .. Entering Nix shell environment+     $ ghci -isrc:app/vkq:app/common-    $ cabal build+    $ exit +      ..  Now exiting from the Nix shell++    $ nix-build++The `default.nix` file contain Nix expression describing the environment+ Building ctags file ------------------- -./mktags.sh script may be used to build ctags file. It used `haskdogs` tool,+`./mktags.sh` script may be used to build ctags file. It used `haskdogs` tool, which should be installed from Hackage.      $ haskdogs@@ -68,8 +85,9 @@ VKQ command line application ============================ -VKQ is a command line tool which demonstrates API usage. It can be used for-logging in, downloading music and reading wall messages.+`vkq` is a command line tool which demonstrates API usage. It can be used for+logging in, downloading music and reading wall messages. Call `vkq --help` or+`vkq --help [command]` to read online help.   Log in to VK@@ -80,9 +98,9 @@     $ vkq login user@mail.org pass123     d8a41221616ef5ba19537125dc0349bad9d529fa15314ad765911726fe98b15185ac41a7ca2c62f3bf4b9 -VKQ returns three values. First is a access token which is required to execute-future API requests. VKQ reads it from VKQ\_ACCESS\_TOKEN environment variable so-we have to set it up+VKQ returns three values. First one is an access token required to execute all+API requests. `vkq` tries to reads it from `VKQ_ACCESS_TOKEN` environment variable or+from `.vkhs-access-token` file (may be changed using options).      $ export VKQ_ACCESS_TOKEN=d785932b871f096bd73aac6a35d7a7c469dd788d796463a871e5beb5c61bc6c96788ec2 @@ -94,7 +112,10 @@      $ vkq call groups.search q=Beatles --pretty --access-token-file=.access-token +Latest versions of the library have `--access-token-flag` option enabled by+default. Set it to empty value to disable the caching feature. + Performing custom API calls --------------------------- @@ -126,7 +147,7 @@ VKHS library/runhaskell mode ============================ -Starting from 1.7.2 there are initial support for RunHaskell-mode. Consider the+Starting from 1.7.2 the library supports RunHaskell-mode. Consider the following example:  @@ -143,17 +164,16 @@       forM_ cs $ \Country{..} -> do         liftIO $ putStrLn co_title -When executed, the program should ask for login and password and output list of-countries known to VK. Consider reviewing  Web.VKHS.API.Simple where-`getCountries` and several other methods are defined. Also, check the source-code of the `vkq` application for more elaborated usage example.+When executed, the program asks for login/password and outputs list of countries+known to VK.  `getCountries` and several other methods are defined in+`Web.VKHS.API.Simple`. `vkq` application may be used as a more elaborated+example.  Debugging ========= -`RepatedForm` message means that VKHS tries to fill the web form with available-data, but the form appears again. Typically, that means that the password wa-invalid or captcha is required.+Verbosity may be increased using `--verbose` flag or `o_verbose` field of+`GenericOptions`. Login automata saves `latest.html` file during operation.  References ==========

@@ -1,6 +1,6 @@  name:                VKHS-version:             1.8.2+version:             1.8.3 synopsis:            Provides access to Vkontakte social network via public API description:     Provides access to Vkontakte API methods. Library requires no interaction

@@ -202,9 +202,9 @@     x <- apiJ a_method (map (id *** tpack) $ splitFragments "," "=" a_args)     if a_pretty       then do-        liftIO $ BS.putStrLn $ jsonEncodePretty x+        liftIO $ putStrLn $ jsonEncodePretty x       else-        liftIO $ BS.putStrLn $ jsonEncode x+        liftIO $ putStrLn $ jsonEncode x   return ()  cmd (Music go@GenericOptions{..} mo@MusicOptions{..}) = do

@@ -150,7 +150,10 @@                 alert $ "Too many requests per second, consider changing options"                 go (k $ ReExec m args)               ErrorCode ec -> do-                alert $ "Unknown error code " <> tshow ec+                alert $  "Unhandled error code " <> tshow ec <> "\n"+                      <> "Consider improving 'defaultSuperwiser' or applying \n"+                      <> "custom error filters using `apiH` ,`apiHS` or their \n"+                      <> "high-level wrappers `apiSimpleH` / `apiSimpleHM`"                 lift $ throwError res_desc        _ -> do

@@ -19,6 +19,7 @@ import Control.Exception (catch, SomeException)  import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text import Data.ByteString.Lazy (fromStrict,toChunks) import qualified Data.ByteString.Char8 as BS @@ -148,7 +149,7 @@         ReParse j -> do           pure j     case parseJSON j of-      (Right a) -> return a+      (Right (Response _ a)) -> return a       (Left e) -> do         recovery <- raise (CallFailure (m0, args0, j, e))         go recovery@@ -169,7 +170,9 @@         ReParse j -> do           pure j     case (parseJSON j, parseJSON j) of-      (Right (Response _ a), _) -> return a+      (Left e1, Left e2) -> do+        recovery <- raise (CallFailure (m0, args0, j, e1 <> ";" <> e2))+        go recovery       (Left e, Right (Response _ err)) -> do         ma <- (handler err)         case ma of@@ -177,9 +180,16 @@           Nothing -> do             recovery <- raise (CallFailure (m0, args0, j, e))             go recovery-      (Left e1, Left e2) -> do-        recovery <- raise (CallFailure (m0, args0, j, e1 <> ";" <> e2))-        go recovery+      (Right _, Right (Response _ err)) -> do+        ma <- (handler err)+        case ma of+          Just a -> return a+          Nothing -> do+            recovery <- raise (CallFailure (m0, args0, j,+              "Response matches both error and result object"))+            go recovery+      (Right (Response _ a), _) -> do+        return a  apiH :: forall m x a s . (Aeson.FromJSON a, MonadAPI m x s)     => MethodName -- ^ API method name@@ -224,9 +234,15 @@ api_S m args = api m (map (id *** tpack) args)  -- Encode JSON back to string-jsonEncode :: JSON -> ByteString-jsonEncode JSON{..} = BS.concat $ toChunks $ Aeson.encode js_aeson+jsonEncodeBS :: JSON -> ByteString+jsonEncodeBS JSON{..} = BS.concat $ toChunks $ Aeson.encode js_aeson -jsonEncodePretty :: JSON -> ByteString-jsonEncodePretty JSON{..} = BS.concat $ toChunks $ Aeson.encodePretty js_aeson+jsonEncode :: JSON -> Text+jsonEncode JSON{..} = Text.decodeUtf8 $ BS.concat $ toChunks $ Aeson.encode js_aeson++jsonEncodePrettyBS :: JSON -> ByteString+jsonEncodePrettyBS JSON{..} = BS.concat $ toChunks $ Aeson.encodePretty js_aeson++jsonEncodePretty :: JSON -> Text+jsonEncodePretty JSON{..} = Text.decodeUtf8 $ BS.concat $ toChunks $ Aeson.encodePretty js_aeson 

@@ -3,7 +3,7 @@ -- function from this module into their 'runhaskell' script and customize -- as required. ----- Runhaskell script may look like the following:+-- Runhaskell script may looks like the following: -- @ --     #!/usr/bin/env runhaskell --     {-# LANGUAGE RecordWildCards #-}@@ -50,7 +50,7 @@ max_count = 1000 ver = "5.44" -apiSimple nm args = resp_data <$> apiR nm (("v",ver):args)+apiSimple nm args = apiR nm (("v",ver):args) apiSimpleH nm args handler = apiH nm (("v",ver):args) handler apiSimpleHM nm args handler = apiHM nm (("v",ver):args) handler apiVer nm args = api nm (("v",ver):args)@@ -87,6 +87,7 @@     ] ++     maybe [] (\q -> [("q",q)]) mq +-- | See [https://vk.com/dev/wall.get] getGroupWall :: forall m x s . (MonadAPI m x s) => GroupRecord -> API m x (Sized [WallRecord]) getGroupWall GroupRecord{..} =   apiSimpleHM "wall.get"

@@ -124,6 +124,9 @@       <$> (o .: "error_code")       <*> (o .: "error_msg") +-- | Wall post representation (partial)+--+-- See also https://vk.com/dev/objects/post data WallRecord = WallRecord   { wr_id :: Int   , wr_from_id :: Int

@@ -1,3 +1,4 @@+-- | This module mainly contains HTTP wrappers required to operate VK monad {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-}@@ -135,7 +136,7 @@     Nothing -> Left (ErrorParseURL s "Client.parseURI failed")     Just u -> Right (URL u) --- | * FIXME Convert to BS+-- | * FIXME Convert to ByteString /  Text splitFragments :: String -> String -> String -> [(String,String)] splitFragments sep eqs =     filter (\(a, b) -> not (null a))@@ -150,7 +151,7 @@         trim = rev (dropWhile (`elem` (" \t\n\r" :: String)))           where rev f = reverse . f . reverse . f --- | * FIXME Convert to BS+-- | * FIXME Convert to ByteString / Text urlFragments :: URL -> [(String,String)] urlFragments URL{..} = splitFragments "&" "=" $  unsharp $ Client.uriFragment uri where   unsharp ('#':x) = x@@ -183,6 +184,7 @@   , req_jar :: Client.CookieJar   } +-- | Create HTTP(S) GET request requestCreateGet :: (MonadClient m s) => URL -> Cookies -> m (Either Error Request) requestCreateGet URL{..} Cookies{..} = do   case setUri Client.defaultRequest uri of@@ -199,6 +201,7 @@           req_jar = jar       } +-- | Create HTTP(S) POST request requestCreatePost :: (MonadClient m s) => FilledForm -> Cookies -> m (Either Error Request) requestCreatePost (FilledForm tit Shpider.Form{..}) c = do   case Client.parseURI (Client.escapeURIString Client.isAllowedInURI action) of@@ -211,6 +214,11 @@         Right Request{..} -> do           return $ Right $ Request (Client.urlEncodedBody (map (BS.pack *** BS.pack) $ Map.toList inputs) req) req_jar +-- | Upload the bytestring data @bs@ to the server @text_url@+--+-- * FIXME This function is not working. Looks like VK requires some other+--   FIXME method rather than urlEncodedBody.+-- * FIXME Use 'URL' rather than Text requestUploadPhoto :: (MonadClient m s) => Text -> ByteString -> m (Either Error Request) requestUploadPhoto text_url bs = do   case Client.parseURI (Text.unpack text_url) of@@ -260,6 +268,7 @@ responseOK r = c == 200 where   c = responseCode r +-- | Execute the 'Request' created by 'requestCreatePost' or 'requestCreateGet' requestExecute :: (MonadClient m s) => Request -> m (Response, Cookies) requestExecute Request{..} = do   jar <- pure req_jar@@ -269,7 +278,8 @@     let interval_ns = toNanoSecs (clk `diffTimeSpec` cl_last_execute)     when (interval_ns < cl_minimum_interval_ns) $ do       when cl_verbose $ do-        hPutStrLn stderr $ "Delaying execution to match the request threshold limit of " <> show cl_minimum_interval_ns <> " ns"+        hPutStrLn stderr $  "Delaying execution to match the request threshold limit of "+                         <> show cl_minimum_interval_ns <> " ns"       threadDelay (fromInteger $ (cl_minimum_interval_ns - interval_ns) `div` 1000); -- convert ns to us     return clk @@ -282,6 +292,7 @@       let (jar', resp') = Client.updateCookieJar resp req now jar       return (Response resp resp_body, Cookies jar') +-- | Download helper downloadFileWith :: (MonadClient m s) => URL -> (ByteString -> IO ()) -> m () downloadFileWith url h = do   (ClientState{..}) <- toClientState <$> get

@@ -47,7 +47,9 @@ import Data.Text (Text(..), pack, unpack) import Data.Text.IO (putStrLn, hPutStrLn) import Data.List (head, length, sortBy, (++))-import Prelude (Integer, FilePath, (==), (.), Show(..), String, ($), IO(..), Bool(..), compare, Ordering(..))+import Prelude (error, Integer, FilePath, (==), (.), Show(..), String,+                ($), IO(..), Bool(..), compare, Ordering(..),+                Read(..)) import Text.Printf import Text.Show.Pretty import Text.Read (readMaybe)

@@ -98,8 +98,14 @@   deriving(Show, Eq, Ord)  +-- | JSON wrapper.+--+-- * FIXME  Implement full set of helper functions data JSON = JSON { js_aeson :: Aeson.Value }   deriving(Show, Data, Typeable)++instance FromJSON JSON where+  parseJSON v = return $ JSON v  parseJSON :: (Aeson.FromJSON a) => JSON -> Either String a parseJSON j = Aeson.parseEither Aeson.parseJSON (js_aeson j)