diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,10 +1,14 @@ TODO ---- - * Decrypt 'RepeatedForm' errors * Show capchas to users if required -* Support simplified runhaskell-style scripting +* Re-implement VK monad as a Free monad special case +* Runhaskell: handle some standard command line arguments +* Support storing access-tokens in a temp file +Version 1.7.2 +------------- +* Initial support for runhaskell mode Version 1.7.1 ------------- diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -97,39 +97,30 @@ ... -VKHS library -============ +VKHS library/Runhaskell mode +============================ -Please, consult the source code of the vkq application. +Starting from 1.7.2 there are initial support for RunHaskell-mode. Consider the +following example: -_Note: Outdated content below_ -Following example illustrates basic usage (please fill client\_id, email and -password with correct values): - - import Web.VKHS.Login - import Web.VKHS.API - - main = do - let client_id = "111111" - let e = env client_id "user@example.com" "password" [Photos,Audio,Groups] - (Right at) <- login e + #!/usr/bin/env runhaskell + {-# LANGUAGE RecordWildCards #-} - let user_of_interest = "222222" - (Right ans) <- api e at "users.get" [ - ("uids",user_of_interest) - , ("fields","first_name,last_name,nickname,screen_name") - , ("name_case","nom") - ] - putStrLn ans + import Prelude () + import Web.VKHS + import Web.VKHS.Imports -client\_id is an application identifier, provided by vk.com. Users receive it -after registering their applications after SMS confirmation. Registration form is -located [here](http://vk.com/editapp?act=create). + main :: IO () + main = runVK_ defaultOptions $ do + Sized cnt cs <- getCountries + forM_ cs $ \Country{..} -> do + liftIO $ putStrLn co_title -Internally, library uses small curl-based HTTP automata and tagsoup for jumping -over relocations and submitting various 'Yes I agree' forms. Curl .so library is -required for vkhs to work. I am using curl-7.26.0 on my system. +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. Debugging ========= @@ -137,22 +128,6 @@ `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. - -_Note: Outdated content below_ - -To authenticate the user, vkhs acts like a browser: it analyzes html but fills -all forms by itself instead of displaying pages. Of cause, would vk.com change -html design, things stop working. - -To deal with that potential problem, Ive included some debugging facilities: -changing: - -writing - - (Right at) <- login e { verbose = Debug } - -will trigger curl output plus html dumping to the current directory. Please, -mail those .html to me if problem appears. Limitations =========== diff --git a/VKHS.cabal b/VKHS.cabal --- a/VKHS.cabal +++ b/VKHS.cabal @@ -1,6 +1,6 @@ name: VKHS -version: 1.7.1 +version: 1.7.2 synopsis: Provides access to Vkontakte social network via public API description: Provides access to Vkontakte API methods. Library requires no interaction @@ -34,6 +34,7 @@ Web.VKHS.Client Web.VKHS.Login Web.VKHS.Error + Web.VKHS.Imports Web.VKHS.API Web.VKHS.API.Types Web.VKHS.API.Base diff --git a/src/Web/VKHS.hs b/src/Web/VKHS.hs --- a/src/Web/VKHS.hs +++ b/src/Web/VKHS.hs @@ -1,10 +1,21 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} -module Web.VKHS where +module Web.VKHS ( + module Web.VKHS + , module Web.VKHS.Client + , module Web.VKHS.Types + , module Web.VKHS.Error + , module Web.VKHS.Monad + , module Web.VKHS.Login + , module Web.VKHS.API.Base + , module Web.VKHS.API.Types + , module Web.VKHS.API.Simple + ) where import Data.List import Data.Maybe @@ -26,17 +37,19 @@ import Web.VKHS.Error import Web.VKHS.Types -import Web.VKHS.Client as Client -import Web.VKHS.Monad +import Web.VKHS.Client hiding (Error, Response) +import qualified Web.VKHS.Client as Client +import Web.VKHS.Monad hiding (catch) +import qualified Web.VKHS.Monad as VKHS import Web.VKHS.Login (MonadLogin, LoginState(..), ToLoginState(..), printForm, login) import qualified Web.VKHS.Login as Login -import Web.VKHS.API (MonadAPI, APIState(..), ToAPIState(..), api) -import qualified Web.VKHS.API as API +import Web.VKHS.API.Base (MonadAPI, APIState(..), ToAPIState(..), api) +import qualified Web.VKHS.API.Base as API +import Web.VKHS.API.Types +import Web.VKHS.API.Simple import Debug.Trace -{- Test -} - data State = State { cs :: ClientState , ls :: LoginState @@ -79,14 +92,14 @@ instance MonadAPI VK r State -- | Run the VK script, return final state and error status -runVK :: VK r r -> StateT State (ExceptT String IO) r -runVK m = runContT (runReaderT (unVK (catch m)) undefined) return +stepVK :: VK r r -> StateT State (ExceptT String IO) r +stepVK m = runContT (runReaderT (unVK (VKHS.catch m)) undefined) return defaultSuperviser :: (Show a) => VK (R VK a) (R VK a) -> StateT State (ExceptT String IO) a defaultSuperviser = go where go m = do GenericOptions{..} <- toGenericOptions <$> get - res <- runVK m + res <- stepVK m res_desc <- pure (describeResult res) case res of Fine a -> return a @@ -113,6 +126,7 @@ evalStateT (defaultSuperviser (login >>= return . Fine)) s +runAPI :: Show b => GenericOptions -> VK (R VK b) b -> ExceptT String IO b runAPI go@GenericOptions{..} m = do s <- initialState go flip evalStateT s $ do @@ -123,3 +137,13 @@ False -> do modify $ modifyAPIState (\as -> as{api_access_token = l_access_token}) defaultSuperviser (m >>= return . Fine) + +runVK :: Show a => GenericOptions -> VK (R VK a) a -> IO (Either String a) +runVK go = runExceptT . runAPI go + +runVK_ :: Show a => GenericOptions -> VK (R VK a) a -> IO () +runVK_ go = do + runVK go >=> \case + Left e -> fail e + Right _ -> return () + diff --git a/src/Web/VKHS/Imports.hs b/src/Web/VKHS/Imports.hs new file mode 100644 --- /dev/null +++ b/src/Web/VKHS/Imports.hs @@ -0,0 +1,14 @@ +module Web.VKHS.Imports ( + module Web.VKHS.Imports + , module Control.Monad + , module Control.Monad.Trans + , module Data.Text + , module Data.Text.IO + , module Prelude + ) where + +import Control.Monad +import Control.Monad.Trans +import Data.Text +import Data.Text.IO +import Prelude (($), IO(..), Bool(..))