VKHS 0.2.0 → 0.3.0
raw patch · 8 files changed
+502/−70 lines, 8 filesdep +aesondep +directorydep +filepath
Dependencies added: aeson, directory, filepath, pretty-show, regexpr, text, vector
Files
- VKHS.cabal +13/−4
- src/VKQ.hs +221/−18
- src/Web/VKHS/API.hs +6/−8
- src/Web/VKHS/API/Aeson.hs +66/−0
- src/Web/VKHS/API/JSON.hs +0/−20
- src/Web/VKHS/API/Types.hs +45/−0
- src/Web/VKHS/Curl.hs +142/−11
- src/Web/VKHS/Login.hs +9/−9
VKHS.cabal view
@@ -1,7 +1,7 @@ name: VKHS-version: 0.2.0-synopsis: Provides access to Vkontakte social network+version: 0.3.0+synopsis: Provides access to Vkontakte social network via public API description: Provides access to Vkontakte API methods. Library requires no interaction with the user during Implicit-flow authentication.@@ -29,7 +29,8 @@ other-modules: Test.Debug, Test.Data, Test.API, Network.Shpider.Forms, Network.Protocol.Uri, Network.Protocol.Mime, Network.Protocol.Http, Network.Protocol.Cookie, Network.Protocol.Uri.Remap, Network.Protocol.Uri.Query, Network.Protocol.Uri.Printer, Network.Protocol.Uri.Path, Network.Protocol.Uri.Parser, Network.Protocol.Uri.Encode, Network.Protocol.Uri.Data, Network.Protocol.Uri.Chars, Network.Protocol.Http.Status, Network.Protocol.Http.Printer, Network.Protocol.Http.Parser, Network.Protocol.Http.Headers, Network.Protocol.Http.Data exposed-modules: Web.VKHS Web.VKHS.API- Web.VKHS.API.JSON+ Web.VKHS.API.Aeson+ Web.VKHS.API.Types Web.VKHS.Curl Web.VKHS.Login Web.VKHS.Types@@ -51,5 +52,13 @@ template-haskell ==2.8.*, transformers ==0.3.*, fclabels >=1.1.4 && <1.1.6,- optparse-applicative >=0.4 && <0.6+ optparse-applicative >=0.4 && <0.6,+ aeson >= 0.6 && < 0.7,+ filepath,+ directory,+ regexpr,+ pretty-show,+ vector,+ text+
src/VKQ.hs view
@@ -1,13 +1,35 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+ module Main where import Control.Monad+import Control.Monad.Error+import Data.Aeson as A import Data.Label.Abstract+import Data.Typeable+import Data.Data+import Data.List+import Data.Maybe+import qualified Data.ByteString as BS+import qualified Data.ByteString.UTF8 as U import Network.Protocol.Uri.Query import Options.Applicative+import System.Directory import System.Exit+import System.FilePath+import System.Environment import System.IO import Text.Printf+import Text.PFormat (pformat)+import Text.Namefilter (namefilter)+import Text.Show.Pretty as PP import Web.VKHS+import Web.VKHS.Curl+import Web.VKHS.API.Aeson as A+import Web.VKHS.API as STR data Options = Options { verb :: Verbosity@@ -17,6 +39,9 @@ data CmdOptions = Login LoginOptions | Call CallOptions+ | Music MusicOptions+ | UserQ UserOptions+ | WallQ WallOptions deriving(Show) data LoginOptions = LoginOptions@@ -25,50 +50,228 @@ , password :: String } deriving(Show) -data CallOptions = CallOptions+data CallOptions = CO { accessToken :: String+ , parse :: Bool , method :: String , args :: String } deriving(Show) +data MusicOptions = MO+ { accessToken_m :: String+ , list_music :: Bool+ , search_string :: String+ , name_format :: String+ , output_format :: String+ , out_dir :: String+ , records_id :: [String]+ } deriving(Show)++data UserOptions = UO+ { accessToken_u :: String+ , queryString :: String+ } deriving(Show)++data WallOptions = WO+ { accessToken_w :: String+ , oid :: String+ } deriving(Show)+ loginOptions :: Parser CmdOptions loginOptions = Login <$> (LoginOptions- <$> argument str (metavar "APPID" & help "Application identifier (provided to you by vk.com)")+ <$> strOption (metavar "APPID" & short 'a' & value "3128877" & help "Application ID, defaults to VKHS" ) <*> argument str (metavar "USER" & help "User name or email") <*> argument str (metavar "PASS" & help "User password")) -callOptions :: Parser CmdOptions-callOptions = Call <$> (CallOptions- <$> argument str (metavar "ACCESS_TOKEN" & help "access_token")- <*> argument str (metavar "METHOD" & help "Method to call")- <*> argument str (metavar "PARAMS" & help "Method arguments, KEY=VALUE[,KEY2=VALUE2[,,,]]"))--opts :: Parser Options-opts = Options+opts m =+ let access_token_flag = strOption (short 'a' & m & metavar "ACCESS_TOKEN" &+ help "Access token. Honores VKQ_ACCESS_TOKEN environment variable")+ in Options <$> flag Normal Debug (long "verbose" & help "Be verbose") <*> subparser ( command "login" (info loginOptions- ( progDesc "Login into vk.com (see --help for details); Print access_token (among user_id and expiration time) on success" ))- & command "call" (info callOptions- ( progDesc "call VK API method (see --help for details)" ))+ ( progDesc "Login and print access token (also prints user_id and expiriration time)" ))+ & command "call" (info (Call <$> (CO+ <$> access_token_flag+ <*> switch (long "preparse" & short 'p' & help "Preparse into Aeson format")+ <*> argument str (metavar "METHOD" & help "Method name")+ <*> argument str (metavar "PARAMS" & help "Method arguments, KEY=VALUE[,KEY2=VALUE2[,,,]]")))+ ( progDesc "Call VK API method" ))+ & command "music" (info ( Music <$> (MO+ <$> access_token_flag+ <*> switch (long "list" & short 'l' & help "List music files")+ <*> strOption+ ( metavar "STR"+ & long "query" & short 'q' & value [] & help "Query string")+ <*> strOption+ ( metavar "FORMAT"+ & short 'f'+ & value "%o_%i %u\t%t"+ & help "Listing format, supported tags: %i %o %a %t %d %u"+ )+ <*> strOption+ ( metavar "FORMAT"+ & short 'F'+ & value "%a - %t"+ & help "FileName format, supported tags: %i %o %a %t %d %u"+ )+ <*> strOption (metavar "DIR" & short 'o' & help "Output directory" & value "")+ <*> arguments str (metavar "RECORD_ID" & help "Download records")+ ))+ ( progDesc "List or download music files"))+ & command "user" (info ( UserQ <$> (UO+ <$> access_token_flag+ <*> strOption (long "query" & short 'q' & help "String to query")+ ))+ ( progDesc "Extract various user information"))+ & command "wall" (info ( WallQ <$> (WO+ <$> access_token_flag+ <*> strOption (long "id" & short 'i' & help "Owner id")+ ))+ ( progDesc "Extract wall information")) ) +api_ :: (A.FromJSON a) => Env CallEnv -> String -> [(String,String)] -> IO a+api_ a b c = do+ r <- A.api' a b c+ case r of+ Right x -> return x+ Left e -> hPutStrLn stderr e >> exitFailure++api_str :: Env CallEnv -> String -> [(String,String)] -> IO String+api_str a b c = do+ r <- STR.api a b c+ case r of+ Right x -> return (U.toString x)+ Left e -> hPutStrLn stderr e >> exitFailure++mr_format :: String -> MusicRecord -> String+mr_format s mr = pformat '%'+ [ ('i', show . aid)+ , ('o', show . owner_id)+ , ('a', namefilter . artist)+ , ('t', namefilter . title)+ , ('d', show . duration)+ , ('u', url)+ ] s mr+ ifeither e fl fr = either fl fr e errexit e = hPutStrLn stderr e >> exitFailure +checkRight (Left e) = hPutStrLn stderr e >> exitFailure+checkRight (Right a) = return a++main :: IO ()+main = do+ m <- maybe (idm) (value) <$> lookupEnv "VKQ_ACCESS_TOKEN"+ execParser (info (opts m) idm) >>= cmd+ cmd :: Options -> IO ()++-- Login cmd (Options v (Login (LoginOptions a u p))) = do let e = (env a u p allAccess) { verbose = v } ea <- login e ifeither ea errexit $ \(at,uid,expin) -> do printf "%s %s %s\n" at uid expin -cmd (Options v (Call (CallOptions act mn args))) = do+-- Call user-specified API+cmd (Options v (Call (CO act pp mn args))) = do let e = (envcall act) { verbose = v }- ea <- api e mn (fw (keyValues "," "=") args)- ifeither ea errexit putStrLn+ let s = fw (keyValues "," "=") args+ case pp of+ False -> do+ ea <- api_str e mn s+ putStrLn (show ea)+ True -> do+ (ea :: A.Value) <- api_ e mn s+ putStrLn $ PP.ppShow ea -main :: IO ()-main = execParser (info opts idm) >>= cmd+-- Query audio files+cmd (Options v (Music mo@(MO act _ q@(_:_) fmt _ _ _))) = do+ let e = (envcall act) { verbose = v }+ Response (SL len ms) <- api_ e "audio.search" [("q",q)]+ forM_ ms $ \m -> do+ printf "%s\n" (mr_format fmt m)+ printf "total %d\n" len++-- List audio files +cmd (Options v (Music mo@(MO act True [] fmt _ _ _))) = do+ let e = (envcall act) { verbose = v }+ (Response ms) <- api_ e "audio.get" []+ forM_ ms $ \m -> do+ printf "%s\n" (mr_format fmt m)+cmd (Options v (Music mo@(MO act False [] _ ofmt odir []))) = do+ errexit "Music record ID is not specified (see --help)"++-- Download audio files+cmd (Options v (Music mo@(MO act False [] _ ofmt odir rid))) = do+ let e = (envcall act) { verbose = v }+ Response ms <- api_ e "audio.getById" [("audios", concat $ intersperse "," rid)]+ forM_ ms $ \m -> do+ (fp, h) <- openFileMR odir ofmt m+ r <- vk_curl_file e (url m) $ \ bs -> do+ BS.hPut h bs+ checkRight r+ printf "%d_%d\n" (owner_id m) (aid m)+ printf "%s\n" (title m)+ printf "%s\n" fp++cmd (Options v (UserQ uo@(UO act qs))) = do+ let e = (envcall act) { verbose = v }+ print qs+ ea <- A.api e "users.search" [("q",qs),("fields","uid,first_name,last_name,photo,education")]+ putStrLn $ show ea+ -- ae <- checkRight ea+ -- processUQ uo ae++-- List wall messages+cmd (Options v (WallQ mo@(WO act wid))) = do+ let e = (envcall act) { verbose = v }+ (Response (SL len ws)) <- api_ e "wall.get" [("owner_id",wid)]+ forM_ ws $ \w -> do+ putStrLn (show $ wdate w)+ putStrLn (wtext w)+ printf "total %d\n" len++type NameFormat = String++openFileMR :: FilePath -> NameFormat -> MusicRecord -> IO (FilePath, Handle)+openFileMR [] _ m = do+ let (_,ext) = splitExtension (url m)+ temp <- getTemporaryDirectory+ (fp,h) <- openBinaryTempFile temp ("vkqmusic"++ext)+ return (fp,h)+openFileMR dir fmt m = do+ let (_,ext) = splitExtension (url m)+ let name = mr_format fmt m+ let name' = replaceExtension name ext+ let fp = (dir </> name') + h <- openBinaryFile fp WriteMode+ return (fp,h)++-- data Collection a = MC {+-- response :: [a]+-- } deriving (Show,Data,Typeable)++-- processMC :: MusicOptions -> Collection MusicRecord -> IO ()+-- processMC (MO _ _ _) (MC r) = do+-- forM_ r $ \m -> do+-- printf "%d_%d|%s|%s|%s\n" (owner_id m) (aid m) (artist m) (title m) (url m)++-- processMC (MO _ rid False) (MC r) = do+-- print r++-- parseUsers :: JSValue -> Maybe [JSValue]+-- parseUsers (JSObject (JSONObject [("response",(JSArray a))])) = Just a+-- parseUsers _ = Nothing++-- processUQ :: UserOptions -> JSValue -> IO ()+-- processUQ (UO _ _) j = do+ -- let (Just u) = parseUsers j+ -- a <- fromJS (u !! 1)+ -- print $ show (a :: UserRecord)+ -- print $ show $ j+
src/Web/VKHS/API.hs view
@@ -9,7 +9,8 @@ import Control.Monad.Error import Data.Label-import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.UTF8 as U+import qualified Data.ByteString as BS import Network.Curlhs.Core @@ -35,12 +36,9 @@ -- ^ API method name -> [(String, String)] -- ^ API method parameters (name-value pairs)- -> IO (Either String String)+ -> IO (Either String BS.ByteString) api e mn mp =- let uri = BS.pack $ showUri $ (\f -> f $ toUri $ printf "https://api.vk.com/method/%s" mn) $- set query $ bw params (("access_token",(access_token . sub) e):mp)- in runErrorT $ do- r <- ErrorT $ vk_curl e (tell [CURLOPT_URL uri])- (_,b) <- ErrorT $ return $ parseResponse r- return b+ let uri = showUri $ (\f -> f $ toUri $ printf "https://api.vk.com/method/%s" mn) $+ set query $ bw params (("access_token",(access_token . sub) e):mp)+ in vk_curl_payload e (tell [CURLOPT_URL $ U.fromString uri])
+ src/Web/VKHS/API/Aeson.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}++module Web.VKHS.API.Aeson+ ( api+ , api'+ , module Web.VKHS.API.Types+ ) where++import Control.Applicative+import Control.Monad+import Control.Monad.Trans+import Control.Monad.Writer+import Control.Monad.Error++import Data.Aeson as A+import qualified Data.Aeson.Types as A+import Data.Aeson (FromJSON, (.:), (.:?))+import Data.Aeson.Generic as AG+import Data.ByteString.Lazy as BS+import Data.Typeable+import Data.Data+import Data.Vector as V (head, tail, toList)++import Web.VKHS.Types+import Web.VKHS.API.Types+import qualified Web.VKHS.API as Base++instance (FromJSON a) => FromJSON (Response a) where+ parseJSON (A.Object v) = do+ a <- v .: "response"+ x <- A.parseJSON a+ return (Response x)++parseGeneric a =+ case AG.fromJSON a of+ A.Success a -> return a+ A.Error s -> fail $ "parseGeneric fails:" ++ s++instance FromJSON MusicRecord where+ parseJSON = parseGeneric++instance FromJSON WallRecord where+ parseJSON (Object o) = + WR <$> (o .: "id")+ <*> (o .: "to_id")+ <*> (o .: "from_id")+ <*> (o .: "text")+ <*> (o .: "date")++instance (FromJSON a) => FromJSON (SizedList [a]) where+ parseJSON (A.Array v) = do+ n <- A.parseJSON (V.head v)+ t <- A.parseJSON (A.Array (V.tail v))+ return (SL n t)++api' :: (A.FromJSON a) => Env CallEnv -> String -> [(String,String)] -> IO (Either String a)+api' e mn mp = runErrorT $ do+ e <- ErrorT (Base.api e mn mp)+ let check (Just x) = return x+ check (Nothing) = fail $ "AESON: error parsing JSON: " ++ show e+ check $ A.decode $ BS.fromStrict e++api :: Env CallEnv -> String -> [(String,String)] -> IO (Either String A.Value)+api = api'+
− src/Web/VKHS/API/JSON.hs
@@ -1,20 +0,0 @@-module Web.VKHS.API.JSON- ( api- ) where--import Control.Monad-import Control.Monad.Trans-import Control.Monad.Writer-import Control.Monad.Error--import Text.JSON as J--import Web.VKHS.Types-import qualified Web.VKHS.API as Base--liftR (Ok a) = return a-liftR (Error s) = fail s--api :: Env CallEnv -> String -> [(String,String)] -> IO (Either String JSValue)-api e mn mp = runErrorT $ ErrorT (Base.api e mn mp) >>= liftR . J.decode-
+ src/Web/VKHS/API/Types.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE DeriveDataTypeable #-}++module Web.VKHS.API.Types where++import Data.Typeable+import Data.Data+import Data.Text++data Response a = Response a+ deriving(Show)++data SizedList a = SL Int a++data MusicRecord = MR+ { aid :: Int+ , owner_id :: Int+ , artist :: String+ , title :: String+ , duration :: Int+ , url :: String+ } deriving (Show, Data, Typeable)+++data UserRecord = UR+ { uid :: Int+ , first_name :: String+ , last_name :: String+ , photo :: String+ , university :: Maybe Int+ , university_name :: Maybe String+ , faculty :: Maybe Int+ , faculty_name :: Maybe String+ , graduation :: Maybe Int+ } deriving(Show,Data,Typeable)+++data WallRecord = WR+ { wid :: Int+ , to_id :: Int+ , from_id :: Int+ , wtext :: String+ , wdate :: Int+ } deriving(Show)++
src/Web/VKHS/Curl.hs view
@@ -1,22 +1,36 @@ {-# LANGUAGE ScopedTypeVariables #-} -module Web.VKHS.Curl (vk_curl) where+module Web.VKHS.Curl+ ( vk_curl+ , vk_curl_file+ , vk_curl_payload+ , pack+ , unpack+ ) where -import Prelude hiding (catch)+import Data.IORef (newIORef, readIORef, atomicModifyIORef)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Internal as BS (c2w, w2c)++import Control.Applicative import Control.Exception (catch,bracket) import Control.Concurrent (threadDelay) import Control.Monad.Writer-import Data.IORef (newIORef, readIORef, atomicModifyIORef)-import qualified Data.ByteString.UTF8 as U+ import Network.Curlhs.Core +import Prelude hiding (catch)++import System.IO+ import Web.VKHS.Types -import qualified Data.ByteString.Char8 as BS --- | Generic request sender. Uses delay to prevent application from being--- blocked for flooding-vk_curl :: Env a -> Writer [CURLoption] () -> IO (Either String String)+pack = BS.pack . map BS.c2w+unpack = map BS.w2c . BS.unpack++-- | Generic request sender. Returns whole HTTP answer as a ByteString+vk_curl :: Env a -> Writer [CURLoption] () -> IO (Either String BS.ByteString) vk_curl e w = do let askE x = return (x e) v <- askE verbose@@ -33,13 +47,130 @@ [ CURLOPT_HEADER True , CURLOPT_WRITEFUNCTION (Just $ memwrite) , CURLOPT_SSL_VERIFYPEER False- , CURLOPT_USERAGENT $ BS.pack a+ , CURLOPT_USERAGENT $ BS.pack $ map BS.c2w a , CURLOPT_VERBOSE (v == Debug ) ] ++ (execWriter w); curl_easy_perform curl;- threadDelay (1000 * d); -- delay in microseconds+ threadDelay (1000 * d); -- convert ms to us b <- readIORef buff ;- return (Right $ U.toString b) ;+ return (Right b) ;+ } `catch`+ (\(e::CURLcode) -> return $ Left ("CURL error: " ++ (show e)))++scanPattern pat s =+ let (_,o,x,n) = BS.foldl' check (False, BS.empty, BS.empty, BS.empty) s+ in (BS.reverse o, x, BS.reverse n)+ where + check (False, old, st, new) b+ | BS.length st < BS.length pat = (False, old, st`BS.snoc`b, new)+ | st == pat = (True, old, st, b`BS.cons`new) + | otherwise = (False, (BS.head st)`BS.cons`old, (BS.tail st)`BS.snoc`b, new)+ check (True, old, st, new) b = (True, old, st, b`BS.cons`new)++cutheader :: BS.ByteString -> BS.ByteString -> Maybe (BS.ByteString, BS.ByteString)+cutheader buf new =+ let+ buf' = BS.append buf new+ overfill = BS.length buf' >= 1024+ (_,p,t) = scanPattern (BS.pack $ map BS.c2w "\r\n\r\n") buf'+ in case (overfill, BS.null t) of+ (True, True) -> Nothing+ (False, True) -> Just (buf', t)+ (_, False) -> Just (buf', t)++data State = Pending BS.ByteString | Working BS.ByteString | FailNoHeader++process :: State -> BS.ByteString -> State+process s@(Pending b) bs =+ case cutheader b bs of+ Nothing -> FailNoHeader+ Just (b', t)+ | BS.null t -> (Pending b')+ | otherwise -> (Working t)+process s@(Working _) bs = (Working bs)+process s _ = s++-- | Downloads the file and saves it on disk+vk_curl_file+ :: Env a+ -- ^ User environment+ -> String+ -- ^ URL+ -> (BS.ByteString -> IO ())+ -- ^ File write handler+ -> IO (Either String ())+vk_curl_file e url cb = do+ let askE x = return (x e)+ v <- askE verbose+ a <- askE useragent+ d <- askE delay_ms+ do+ sr <- newIORef =<< (Pending <$> pure BS.empty)++ bracket (curl_easy_init) (curl_easy_cleanup) $ \curl -> do {+ let + filewrite bs = do+ s' <- atomicModifyIORef sr (\s -> let s' = process s bs in (s',s'))+ case s' of+ FailNoHeader -> return CURL_WRITEFUNC_FAIL+ Pending b -> return CURL_WRITEFUNC_OK+ Working t -> do+ cb t+ return CURL_WRITEFUNC_OK + in+ curl_easy_setopt curl $+ [ CURLOPT_HEADER True+ , CURLOPT_WRITEFUNCTION (Just $ filewrite)+ , CURLOPT_SSL_VERIFYPEER False+ , CURLOPT_USERAGENT $ BS.pack $ map BS.c2w a+ , CURLOPT_VERBOSE (v == Debug)+ , CURLOPT_URL (BS.pack $ map BS.c2w url)+ ]; ++ curl_easy_perform curl;+ threadDelay (1000 * d); -- convert ms to us+ s <- readIORef sr;+ case s of+ Working _ -> return $ Right ()+ _ -> return $ Left "HTTP header detection failure"+ } `catch`+ (\(e::CURLcode) -> return $ Left ("CURL error: " ++ (show e)))+++-- | Return HTTP payload, ignore headers+vk_curl_payload :: Env a -> Writer [CURLoption] () -> IO (Either String BS.ByteString)+vk_curl_payload e w = do+ let askE x = return (x e)+ v <- askE verbose+ a <- askE useragent+ d <- askE delay_ms+ do+ sr <- newIORef (BS.empty, Pending BS.empty)++ bracket (curl_easy_init) (curl_easy_cleanup) $ \curl -> do {+ let + writer bs = do+ atomicModifyIORef sr (\(buff,s) -> let s' = process s bs ; paired x =(x,x) in + case s' of+ FailNoHeader -> paired (buff,s')+ Pending b -> paired (buff,s')+ Working t -> paired (BS.append buff t,s'))+ return CURL_WRITEFUNC_OK++ in+ curl_easy_setopt curl $+ [ CURLOPT_HEADER True+ , CURLOPT_WRITEFUNCTION (Just $ writer)+ , CURLOPT_SSL_VERIFYPEER False+ , CURLOPT_USERAGENT $ BS.pack $ map BS.c2w a+ , CURLOPT_VERBOSE (v == Debug)+ ] ++ (execWriter w); + curl_easy_perform curl;+ threadDelay (1000 * d); -- convert ms to us+ (buff,s) <- readIORef sr;+ case s of+ Working _ -> return $ Right buff+ _ -> return $ Left "HTTP header detection failure" } `catch` (\(e::CURLcode) -> return $ Left ("CURL error: " ++ (show e)))
src/Web/VKHS/Login.hs view
@@ -17,7 +17,7 @@ import Control.Monad.Writer import qualified Control.Monad.State as S -import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString as BS import Data.List import Data.String import Data.Char@@ -40,7 +40,7 @@ import System.IO import Web.VKHS.Types-import Web.VKHS.Curl+import Web.VKHS.Curl as VKHS -- Test applications: --@@ -129,8 +129,8 @@ -- | Send a get-request to the server vk_get :: Uri -> Cookies -> VK Page vk_get u c = let- c' = (BS.pack $ bw cookie $ map toShort $ bw gather c )- u' = (BS.pack $ showUri u)+ c' = (VKHS.pack $ bw cookie $ map toShort $ bw gather c )+ u' = (VKHS.pack $ showUri u) in do e <- ask s <- liftEIO $ vk_curl e $ do@@ -138,14 +138,14 @@ tell [CURLOPT_COOKIE c'] when ((not . BS.null) u') $ do tell [CURLOPT_URL u']- liftVK (return $ parseResponse s)+ liftVK (return $ parseResponse $ VKHS.unpack s) -- | Send a form to the server. vk_post :: FilledForm -> Cookies -> VK Page vk_post f c = let- c' = (BS.pack $ bw cookie $ map toShort $ bw gather c )- p' = (BS.pack $ bw params $ M.toList $ inputs f)- u' = (BS.pack $ action f)+ c' = (VKHS.pack $ bw cookie $ map toShort $ bw gather c )+ p' = (VKHS.pack $ bw params $ M.toList $ inputs f)+ u' = (VKHS.pack $ action f) in do e <- ask s <- liftEIO $ vk_curl e $ do@@ -155,7 +155,7 @@ tell [CURLOPT_URL u'] tell [CURLOPT_POST True] tell [CURLOPT_COPYPOSTFIELDS p']- liftVK (return $ parseResponse s)+ liftVK (return $ parseResponse $ VKHS.unpack s) -- | Splits parameters into 3 categories: -- 1)without a value, 2)filled from user dictionary, 3)with default values