-- | This module contains definitions of various VK API bindings. It is desigend -- to be as simple as possible. The collection is not even close to be complete. -- The user is expected to copy-and-paste any function from this module into -- their 'runhaskell' script and customize it as required. -- -- Runhaskell script may looks like the following: -- @ -- #!/usr/bin/env runhaskell -- {-# LANGUAGE RecordWildCards #-} -- {-# LANGUAGE OverloadedStrings #-} -- -- import Web.VKHS -- import Web.VKHS.Imports -- -- main :: IO () -- main = runVK_ defaultOptions $ do -- Sized cnt gs <- groupSearch "Котики" -- forM_ gs $ \gr@GroupRecord{..} -> do -- liftIO $ tputStrLn gr_name -- liftIO $ tputStrLn "--------------" -- Sized wc ws <- getGroupWall gr -- forM_ ws $ \WallRecord{..} -> do -- liftIO $ tputStrLn wr_text -- liftIO $ tputStrLn "--------------" -- @ -- -- See also a collection of scripts in the @./app/runhaskell@ folder of -- the distribution package. -- {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} module Web.VKHS.API.Simple where import qualified Data.Text as Text import qualified Data.ByteString.Char8 as BS import qualified Data.Aeson as Aeson import qualified Data.Aeson.Types as Aeson import Web.VKHS.Imports import Web.VKHS.Types import Web.VKHS.API.Base import Web.VKHS.API.Types max_count :: Integer max_count = 1000 -- | We are using API v5.44 by default ver :: Text ver = "5.44" users_fields = "can_post,members_count,city,country,education,sex,photo_50,photo_100,photo_200,photo_400_orig,photo_max" -- | Versioned aliases for api caller functions -- apiSimpleF nm args f = apiRf nm (("v",ver):args) f apiSimple1 :: (MonadAPI m x s, FromJSON a) => MethodName -> [(String, Text)] -> API m x a apiSimple1 nm args = api1 nm (("v",ver):args) apiSimple2 :: (MonadAPI m x s, FromJSON b, FromJSON a) => MethodName -> [(String, Text)] -> API m x (Either a b) apiSimple2 nm args = api2 nm (("v",ver):args) -- apiSimpleHM nm args handler = apiHM nm (("v",ver):args) handler apiSimple :: (FromJSON a, MonadAPI m x s) => MethodName -> [(String, Text)] -> API m x a apiSimple nm args = apiSimple1 nm args -- apiSimpleE nm args handler = do apiSimpleH :: (FromJSON t, MonadAPI m x s) => MethodName -> [(String, Text)] -> (t -> b) -> (APIErrorRecord -> Either Text b) -> m (R m x) b apiSimpleH nm args handlerA handlerB = do res <- apiSimple2 nm args case res of Left e -> case handlerB e of Left text -> terminate $ APIFailed $ APIUnhandledError nm e text Right a -> return a Right a -> return (handlerA a) -- | Wrapper for 'groups.search' handler. The function demonstrates -- pure-functional error handling. groupSearch :: (MonadAPI m x s) => Text -> API m x [GroupRecord] groupSearch q = trace (\gr -> case length gr < 10 of True -> "groupSearch: keyword \"" <> q <> "\" returns: " <> Text.intercalate "," (map gr_name gr) False -> "groupSearch: keyword \"" <> q <> "\" returns: " <> tshow (length gr) <> " groups" ) $ do sortBy (compare `on` gr_members_count) <$> do m_items <$> do apiSimpleH "groups.search" [("q",q), ("fields", "can_post,members_count"), ("count", tpack (show max_count))] id (\APIErrorRecord{..} -> case er_code of AccessDenied -> Right (Sized 0 []) _ -> Left "" ) data UsersSearchArgs = UsersSearchArgs { usa_q :: Text , usa_city :: Maybe City , usa_coid :: Maybe CountryId , usa_sex :: Maybe Sex } deriving (Show) defaultUsersSearchArgs = UsersSearchArgs "" Nothing Nothing Nothing usersSearch :: (MonadAPI m x s) => UsersSearchArgs -> Integer -> API m x [UserRecord] usersSearch UsersSearchArgs{..} offset = trace (\r -> case length r < 10 of True -> "usersSearch: keyword \"" <> usa_q <> "\" returns: " <> Text.intercalate "," (map ur_first_name r) False -> "usersSearch: keyword \"" <> usa_q <> "\" returns: " <> tshow (length r) <> " users" ) $ do m_items <$> do apiSimpleH "users.search" ([("q",usa_q) ,("fields", users_fields) ,("offset", tshow offset) ,("count", tshow max_count) ,("sort", "0") -- popularity ] <> concat [ maybe [] ((:[]) . ("sex",) . tshow . sexId) usa_sex , maybe [] ((:[]) . ("country",) . tshow . coid_id) usa_coid ]) id (\APIErrorRecord{..} -> case er_code of AccessDenied -> Right (mempty :: Sized [UserRecord]) _ -> Left "" ) -- | Get list of countries, known to VK getCountries :: (MonadAPI m x s) => API m x [Country] getCountries = sortBy (compare `on` co_title) <$> do m_items <$> do apiSimple "database.getCountries" [("v",ver), ("need_all", "1"), ("count", tpack (show max_count)) ] -- | Get list of country cities, known to VK getCities :: (MonadAPI m x s) => Country -> Maybe Text -> API m x (Sized [City]) getCities Country{..} mq = apiSimple "database.getCities" $ [("country_id", tshow $ coid_id $ co_coid), ("count", tpack (show max_count)) ] ++ maybe [] (\q -> [("q",q)]) mq -- | Wrapper for [https://vk.com/dev/wall.get] function -- This function demonstrates monadic error handling getGroupWall :: forall m x s . (MonadAPI m x s) => GroupRecord -> API m x (Sized [WallRecord]) getGroupWall GroupRecord{..} = apiSimpleH "wall.get" [("owner_id", "-" <> (tshow $ gid_id $ gr_gid)), ("count", "100") ] id (\APIErrorRecord{..} -> case er_code of AccessDenied -> (Right $ Sized 0 []) _ -> Left "" ) -- | Wrapper for [https://vk.com/dev/wall.get] function getWall :: forall m x s . (MonadAPI m x s) => Int -> Int -> API m x (Sized [WallRecord]) getWall owner_id count = apiSimpleH "wall.get" [("owner_id", tshow owner_id), ("count", tshow count) ] id (\APIErrorRecord{..} -> case er_code of AccessDenied -> Right $ Sized 0 [] _ -> Left "" ) -- | https://vk.com/dev/wall.getById getWallById :: (MonadAPI m x s) => (Int, Int) -> API m x (Maybe WallRecord) getWallById (owner_id, post_id) = do apiSimpleH "wall.getById" [("posts", tshow owner_id <> "_" <> tshow post_id) ] Just (\APIErrorRecord{..} -> case er_code of AccessDenied -> Right Nothing _ -> Left "" ) -- | Return modified and unmodified reposts of this wall recor. Algorithm is -- based on the following methods: -- https://vk.com/dev/wall.getReposts -- https://vk.com/dev/likes.getList -- See also https://habrahabr.ru/post/177641 (in Russian) for explanation getWallReposts :: (MonadAPI m x s) => WallRecord -> API m x [WallRecord] getWallReposts wr = do modified_reposts <- apiSimple "wall.getReposts" $ [ ("owner_id",tshow (wr_owner_id wr)) , ("post_id",tshow (wr_id wr)) , ("count",tshow max_count) ] (Sized cnt owners :: Sized [Int]) <- apiSimple "likes.getList" $ [ ("type","post") , ("owner_id",tshow (wr_owner_id wr)) , ("item_id",tshow (wr_id wr)) , ("filter","copies") , ("count",tshow max_count) ] unmodified_reposts <- concat <$> do forM owners $ \o -> do (Sized _ wrs) <- getWall o 20 return [ x | x <- wrs, (wr_id wr) `elem`(map wr_id (wr_copy_history x))] return $ (rr_items modified_reposts) <> unmodified_reposts -- TODO: Take User as argument for more type-safety getAlbums :: (MonadAPI m x s) => Maybe Integer -> API m x (Sized [Album]) getAlbums muid = apiSimpleH "photos.getAlbums" ((case muid of Just uid -> [("owner_id", tshow uid)] Nothing -> []) <> [("need_system", "1")]) id (\APIErrorRecord{..} -> case er_code of AccessDenied -> Right (Sized 0 []) _ -> Left "" ) getPhotoUploadServer :: (MonadAPI m x s) => Album -> API m x PhotoUploadServer getPhotoUploadServer Album{..} = apiSimple "photos.getUploadServer" [("album_id", tshow al_id)] getUsers :: (MonadAPI m x s) => [UserId] -> API m x [UserRecord] getUsers [] = return [] getUsers uids = do apiSimple "users.get" [ ("user_ids", Text.intercalate "," [tshow x | UserId x <- uids]) , ("fields", users_fields) ] -- | Get current user getCurrentUser :: (MonadAPI m x s) => API m x UserRecord getCurrentUser = do trace (\UserRecord{..} -> "getCurrentUser: returned " <> tshow ur_uid) $ do users <- apiSimple "users.get" [] case (length users == 1) of False -> terminate $ APIFailed $ APIUnexpected "users.get" "should be and array containing a single user record" True -> return $ head users -- * FIXME move low-level upload code to API.Base setUserPhoto :: (MonadAPI m x s) => UserRecord -> FilePath -> API m x () setUserPhoto UserRecord{..} photo_path = do OwnerUploadServer{..} <- (fst . resp_data) <$> apiSimple "photos.getOwnerPhotoUploadServer" [("owner_id", tshow $ uid_id $ ur_uid)] UploadRecord{..} <- upload ous_upload_url photo_path APIResponse{..} <- apiSimple "photos.saveOwnerPhoto" [ ("server", tshow upl_server) , ("hash", upl_hash) , ("photo", upl_photo) ] PhotoSaveResult{..} <- pure (fst resp_data) return () getGroupMembersN :: (MonadAPI m x s) => Integer -> GroupId -> API m x [UserId] getGroupMembersN offset GroupId{..} = trace (\uids -> "getGroupMembers: group " <> tshow gid_id <> " offset " <> tshow offset <> " includes : " <> ( case length uids < 10 of True -> tshow uids False -> tshow (length uids) <> " users") ) $ do m_items <$> (apiSimple "groups.getMembers" [ ("group_id", tshow gid_id) , ("offset", tshow offset) , ("count", tshow max_count) , ("fileds", "bdate,city,education") ]) getGroupMembers :: (MonadAPI m x s) => GroupId -> API m x [UserId] getGroupMembers = getGroupMembersN 0