appId :: Int appId = 123456 main :: IO () main = execVKAPI () (createSettings appId "myname" "mypass" (Just [Audio])) $ do -- (AR (Items (sar:_) _)) <- toAPI $ def{searchQ = "ABBA" , searchCount = Just 2 , searchLyrics = Just 1 } -- (AR (gar:_)) <- toAPI $ GetById [(audioOwnerId sar, audioId sar)] -- (AR aid) <- toAPI $ Add (audioId gar) (audioOwnerId gar) Nothing Just uid <- liftState $ gets getUserId -- toAPI $ def{editOwnerId = UserId uid , editAudioId = aid , editTitle = Just "My Added Record" } return ()
class (Queryable q, Receivable a) => Routable qa | q -> a where toRoute :: q -> Route toAPI :: (MonadIO m, ErrorReceivable e) => q -> APIT sema toAPI = runRoute . toRoute
-- audio.getLyrics instance Routable GetLyrics (ActionResponse Lyrics) where toRoute q = Route ["audio.getLyrics"] (toURLParams q) "GET"
class Queryable a where toURLParams :: a -> [URLParam]
data GetLyrics = GetLyrics {getlyricsLyricsId :: !Int} deriving Show $(deriveQueryable' (standard . dropLPrefix) ''GetLyrics)
runQ [d| instance Queryable Lyrics where toURLParams r = [("lyrics_id" =. lyricsLyricsId r), ("text" =. lyricsText r)] |]
[InstanceD [] (AppT (ConT Queryable) (ConT Lyrics)) [FunD toURLParams [Clause [VarP r_2] (NormalB (ListE [InfixE (Just (LitE (StringL "lyrics_id"))) (VarE =.) (Just (AppE (VarE lyricsLyricsId) (VarE r_2))), InfixE (Just (LitE (StringL "text"))) (VarE =.) (Just (AppE (VarE lyricsText) (VarE r_2)))])) []]]]
instance Default Save where def = Save 0 "" "" Nothing Nothing
data Lyrics = Lyrics { lyricsLyricsId :: Int , lyricsText :: T.Text } deriving (Show, Generic) instance FromJSON Lyrics where parseJSON = genericParseJSON $ aesonPrefix snakeCase instance Receivable Lyrics where receive = useFromJSON
-- | Upload audio file 'fn' to VKontakte. Register optional 'artist' -- and 'title' for it. uploadAudio :: T.Text -> Maybe T.Text -> Maybe T.Text -> API s VKError (ActionResponse SavedAudio) uploadAudio fn artist title = do (AR (UploadServer uploadURL)) <- toAPI GetUploadServer let msrv = uriToRoute <$> (parseURI $ T.unpack uploadURL) (srvURL, srvArgs, srvRoute) <- hoistEither $ note (mkError "bad upload url") msrv -- , let fnPart = partFileSource "file" $ T.unpack fn parts = Multipart $ (fnPart:srvArgs) mreq <- sendMultipart (basicBuilder "audioUpload" srvURL) srvRoute parts req <- hoistEither $ note (mkError "can't construct request") mreq -- manager <- liftManager ask resp <- liftIO $ try $ httpLbs req manager res <- hoistEither $ first HTTPError resp -- 'Save' save <- hoistEither $ receive res toAPI save{saveArtist = artist, saveTitle = title} ...
data Privacy = AllowAll | AllowFriends | AllowFriendsOfFriends | AllowFriendsOfFriendsOnly | AllowNobody | AllowOnlyMe | AllowList Int | AllowUser Int | DenyList Int | DenyUser Int deriving Show instance FromJSON Privacy where parseJSON = withText "Privacy" doParse where doParse txt = case parse parser "" txt of Left _ -> mempty Right v -> pure v parser = try (string "friends_of_friends_only" >> return AllowFriendsOfFriendsOnly) <|> try (string "friends_of_friends" >> return AllowFriendsOfFriends) <|> (string "friends" >> return AllowFriends) <|> (string "nobody" >> return AllowNobody) <|> (string "only_me" >> return AllowOnlyMe) <|> (string "list" >> many1 digit >>= return . AllowList . read) <|> (many1 digit >>= return . AllowUser . read) <|> (string "all" >> return AllowAll) <|> (string "-" >> ((many1 digit >>= return . DenyUser . read) <|> (string "list" >> many1 digit >>= return . DenyList . read)))
spec :: Spec spec = do describe "OAuth authorization" $ do it "doesn't ask for any permissions" $ do execVKAPI () (vksettings Nothing) getAuthToken >>= (`shouldSatisfy` checkAuthToken) it "asks for some permissions" $ do execVKAPI () (vksettings $ Just [Audio, Video]) getAuthToken >>= (`shouldSatisfy` checkAuthToken) where getAuthToken = liftState $ gets _vkAuthToken checkAuthToken :: Either (APIError VKError) (Maybe AuthToken) -> Bool checkAuthToken (Right (Just (AuthToken _ _ _))) = True checkAuthToken _ = False vksettings :: Maybe [AuthPermissions] -> VKSettings vksettings scope = createSettings appId userName userPass scope
<div id={audioVolumeBarContainerId} ref="audioVolumeBarContainer" className="audio-volume-bar-container"> <Button id={toggleBtnId} ref="toggleButton" bsSize="small" onClick={this.toggle}> <Glyphicon glyph={toggleIcon}/> </Button> <div className={audioVolumeBarClasses}> <div className="audio-volume-min-max" onClick={this.volumeToMax}> <Glyphicon glyph="volume-up" /> </div> <div ref="audioVolumePercentContainer" className="audio-volume-percent-container" onClick={this.adjustVolumeTo}> <div className="audio-volume-percent" style={style}></div> </div> <div className="audio-volume-min-max" onClick={this.volumeToMin}> <Glyphicon glyph="volume-off" /> </div> </div> </div>
div_ (("className" $= "audio-volume-bar-container"):mouseLeaveHlr) $ do bootstrap_ "Button" ["bsSize" $= "small" , onClick toggleHlr ] $ bootstrap_ "Glyphicon" ["glyph" $= toggleIcon] mempty div_ ["className" $= classes] $ do div_ ["className" $= "audio-volume-min-max" , onClick (\_ _ -> dispatch st (AdjustVolume $ fromFactor (1::Int)))] $ bootstrap_ "Glyphicon" ["glyph" $= "volume-up"] mempty div_ ["className" $= "audio-volume-percent-container" , onClick adjustVolumeToHlr] $ div_ ["className" $= "audio-volume-percent" , "style" @= style] mempty div_ ["className" $= "audio-volume-min-max" , onClick (\_ _ -> dispatch st (AdjustVolume $ fromFactor (0::Int)))] $ bootstrap_ "Glyphicon" ["glyph" $= "volume-off"] mempty
runAPI :: State -> VKAction -> VK.VKAPI ApiState a -> (a -> VKAction) -> IO () runAPI State{..} action apiAction hlr = void . forkIO $ do res <- runMaybeT $ do -- ? as <- hoistMaybe apiState _ <- hoistMaybe $ if VK.isAuthorized as then Just True else Nothing lift $ do -- AJAX , alterStore store (SetAjaxRunning True) -- (res, nas) <- VK.runVKAPI as apiAction alterStore store (SetApiState nas) -- , alterStore store (SetAjaxRunning False) -- either apiError handleAction res -- , when (isNothing res) $ alterStore store (Authorize action) where handleAction v = alterStore store (hlr v)
$(derivePathInfo ''VKAction)
a_ ["href" $= actionRoute store parentRouter (Audios $ SetAudioSelector asel)] label
foreign import javascript unsafe "window.onhashchange = function() {$1(location.hash.toString());}" js_attachtLocationHashCb :: (Callback (JSVal -> IO ())) -> IO () onLocationHashChange :: (String -> IO ()) -> IO () onLocationHashChange fn = do cb <- syncCallback1 ThrowWouldBlock (fn . JSS.unpack . unsafeCoerce) js_attachtLocationHashCb cb
spec :: Spec spec = session "VK application tests" $ using Chrome $ do it "login to Vkontakte with user credentials" $ runWD $ do dir <- liftIO getCurrentDirectory openPage $ "file://" ++ dir ++ "/example/vk.html" cw <- getCurrentWindow findElem (ByCSS "div.authorization > div.panel-body > a.btn") >>= click liftIO $ threadDelay 3000000 ws <- windows length ws `shouldBe` 2 let Just vkW = find (/= cw) ws focusWindow vkW findElem (ByName "email") >>= sendKeys userName findElem (ByName "pass") >>= sendKeys userPass findElem (ByCSS "form input.button") >>= click authUrl <- getCurrentURL closeWindow vkW focusWindow cw findElem (ByCSS "input.form-control") >>= sendKeys (T.pack authUrl) liftIO $ threadDelay 3000000 findElem (ByCSS "button") >>= click liftIO $ threadDelay 3000000 it "selects \"AnyAudio\"" $ runWD $ do findElem (ByCSS "a[href=\"#/audios/set-audio-selector/any-audio\"]") >>= click liftIO $ threadDelay 3000000 pagerEls <- findElems (ByCSS "a[href^=\"#/audios/get-audio/\"]") length pagerEls `shouldBe` 11 activeEls <- findElems (ByCSS "li.active a[href=\"#\"]") length activeEls `shouldBe` 1
Source: https://habr.com/ru/post/272871/
All Articles