libmpd-0.9.0: tests/CommandSpec.hs
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
-- This module provides a way of verifying that the interface to the MPD
-- commands is correct. It does so by capturing the data flow between the
-- command and a dummy socket, checking the captured data against a set of
-- predefined values that are known to be correct. Of course, this does not
-- verify that the external behaviour is correct, it's simply a way of
-- catching silly mistakes and subtle bugs in the interface itself, without
-- having to actually send any requests to a real server.
module CommandSpec (main, spec) where
import Arbitrary ()
import StringConn
import TestUtil
import Unparse
import Network.MPD.Core
import Network.MPD.Commands
import Network.MPD.Commands.Types
import Network.MPD.Commands.Extensions
import Prelude hiding (repeat)
main :: IO ()
main = hspec spec
spec :: Spec
spec = do
-- * Admin commands
describe "enableOutput" $ do
it "sends an enableoutput command" $ testEnableOutput
describe "disableOutput" $ do
it "sends an disableoutput command" $ testDisableOutput
describe "outputs" $ do
it "lists available outputs" $ testOutputs
describe "update" $ do
it "updates entire collection by default" $ do
cmd [("update", Right "updating_db: 23\nOK")] (Right 23)
(update Nothing)
it "can update a specific path" $ do
cmd [("update \"foo\"", Right "updating_db: 23\nOK")] (Right 23)
(update $ Just "foo")
describe "rescan" $ do
it "returns entire collection by default" $ do
cmd [("rescan", Right "updating_db: 23\nOK")] (Right 23)
(rescan Nothing)
it "can rescan a specific path" $ do
cmd [("rescan \"foo\"", Right "updating_db: 23\nOK")] (Right 23)
(rescan $ Just "foo")
-- * Database commands
{- XXX: incorrect; fixed in the applicative version
describe "list" $ do
it "returns a list of values for a given metadata type" $ testListAny
it "can constrain listing to entries matching a query" $ testListQuery
-}
describe "listAll" $ do
it "lists everything" $ testListAll
describe "lsInfo" $ do
it "lists information" $ testLsInfo
describe "listAllInfo" $ do
it "lists information" $ testListAllInfo
describe "count" $ do
it "returns a count of items matching a query" $ testCount
-- * Playlist commands
describe "playlistAdd" $ do
it "adds a url to a stored playlist" $ testPlaylistAdd
describe "playlistClear" $ do
it "clears a stored playlist" $ testPlaylistClear
describe "plChangesPosid" $ do
it "does something ..." $ testPlChangesPosId
{- XXX: doesn't work
it "fails on weird input" $ testPlChangesPosIdWeird
-}
-- XXX: this is ill-defined
{-
describe "currentSong" $ do
it "can handle cases where playback is stopped" $ testCurrentSong
-}
describe "playlistDelete" $ do
it "deletes an item from a stored playlist" $ testPlaylistDelete
describe "load" $ do
it "loads a stored playlist" $ testLoad
describe "playlistMove" $ do
it "moves an item within a stored playlist" $ testMove2
describe "rm" $ do
it "deletes a stored playlist" $ testRm
describe "rename" $ do
it "renames a stored playlist" $ testRename
describe "save" $ do
it "creates a stored playlist" $ testSave
describe "shuffle" $ do
it "enables shuffle mode" $ testShuffle
describe "listPlaylist" $ do
it "returns a listing of paths in a stored playlist" $ testListPlaylist
-- * Playback commands
describe "crossfade" $ do
it "sets crossfade between songs" $ testCrossfade
describe "play" $ do
it "toggles playback" $ testPlay
describe "pause" $ do
it "pauses playback" $ testPause
describe "stop" $ do
it "stops playback" $ testStop
describe "next" $ do
it "starts playback of next song" $ testNext
describe "previous" $ do
it "play previous song" $ testPrevious
describe "random" $ do
it "toggles random playback" $ testRandom
describe "repeat" $ do
it "toggles repeating playback" $ testRepeat
describe "setVolume" $ do
it "sets playback volume" $ testSetVolume
describe "consume" $ do
it "toggles consume mode" $ testConsume
describe "single" $ do
it "toggles single mode" $ testSingle
-- * Misc
describe "clearError" $ do
it "removes errors" $ testClearError
describe "commands" $ do
it "lists available commands" $ testCommands
describe "notCommands" $ do
it "lists unavailable commands" $ testNotCommands
describe "tagTypes" $ do
it "lists available tag types" $ testTagTypes
describe "urlHandlers" $ do
it "lists available url handlers" $ testUrlHandlers
describe "password" $ do
it "sends a password to the server" $ testPassword
it "gives access to restricted commmands" $ testPasswordSucceeds
it "returns failure on incorrect password" $ testPasswordFails
describe "ping" $ do
it "sends a ping command" $ testPing
describe "stats" $ do
it "gets database stats" $ testStats
-- * Extensions
describe "toggle" $ do
it "starts playback if paused" $ testTogglePlay
it "stops playback if playing" $ testToggleStop
describe "addMany" $ do
it "adds multiple paths in one go" $ testAddMany0
it "can also add to stored playlists" $ testAddMany1
describe "volume" $ do
it "adjusts volume relative to current volume" $ testVolume
cmd_ :: [(Expect, Response String)] -> StringMPD () -> Expectation
cmd_ expect f = cmd expect (Right ()) f
cmd :: (Eq a, Show a) => [(Expect, Response String)] -> Response a -> StringMPD a -> Expectation
cmd expect resp f = testMPD expect f `shouldBe` resp
--
-- Admin commands
--
testEnableOutput = cmd_ [("enableoutput 1", Right "OK")] (enableOutput 1)
testDisableOutput = cmd_ [("disableoutput 1", Right "OK")] (disableOutput 1)
-- XXX: this should be generalized to arbitrary inputs
testOutputs = do
let obj1 = def { dOutputName = "SoundCard0", dOutputEnabled = True }
obj2 = def { dOutputName = "SoundCard1", dOutputID = 1 }
resp = concatMap unparse [obj1, obj2] ++ "OK"
cmd [("outputs", Right resp)] (Right [obj1, obj2]) outputs
--
-- Database commands
--
{- XXX: this is incorrect
-- XXX: generalize to arbitrary Metadata values
testListAny = cmd [("list Title", Right "Title: Foo\nTitle: Bar\nOK")]
(Right ["Foo", "Bar"])
(list Title anything)
testListQuery = cmd [("list Title Artist \"Muzz\"", Right "Title: Foo\nOK")]
(Right ["Foo"])
(list Title (Artist =? "Muzz"))
-}
testListAll =
cmd [("listall \"\"", Right "directory: FooBand\n\
\directory: FooBand/album1\n\
\file: FooBand/album1/01 - songA.ogg\n\
\file: FooBand/album1/02 - songB.ogg\nOK")]
(Right ["FooBand/album1/01 - songA.ogg"
,"FooBand/album1/02 - songB.ogg"])
(listAll "")
-- XXX: generalize to arbitrary input
testLsInfo = do
let song = defaultSong "Bar.ogg"
cmd [("lsinfo \"\"", Right $ "directory: Foo\n" ++ unparse song ++ "playlist: Quux\nOK")]
(Right [LsDirectory "Foo", LsSong song, LsPlaylist "Quux"])
(lsInfo "")
testListAllInfo =
cmd [("listallinfo \"\"", Right "directory: Foo\ndirectory: Bar\nOK")]
(Right [LsDirectory "Foo", LsDirectory "Bar"])
(listAllInfo "")
-- XXX: generalize to arbitrary input
testCount = do
let obj = Count 1 60
resp = unparse obj ++ "OK"
cmd [("count Title \"Foo\"", Right resp)] (Right obj)
(count (Title =? "Foo"))
--
-- Playlist commands
--
testPlaylistAdd =
cmd_ [("playlistadd \"foo\" \"bar\"", Right "OK")]
(playlistAdd "foo" "bar")
testPlaylistClear =
cmd_ [("playlistclear \"foo\"", Right "OK")]
(playlistClear "foo")
testPlChangesPosId =
cmd [("plchangesposid 10", Right "OK")]
(Right [])
(plChangesPosId 10)
{- XXX:
testPlChangesPosIdWeird =
cmd [("plchangesposid 10", Right "cpos: foo\nId: bar\nOK")]
(Left $ Unexpected "[(\"cpos\",\"foo\"),(\"Id\",\"bar\")]")
(plChangesPosId 10)
-}
-- XXX: this is ill-defined
{-
testCurrentSong = do
let obj = def { stState = Stopped, stPlaylistVersion = 253 }
resp = unparse obj ++ "OK"
cmd [("status", Right resp)] (Right Nothing) currentSong
-}
testPlaylistDelete =
cmd_ [("playlistdelete \"foo\" 1", Right "OK")] (playlistDelete "foo" 1)
testLoad =
cmd_ [("load \"foo\"", Right "OK")] (load "foo")
testMove2 = cmd_ [("playlistmove \"foo\" 23 2", Right "OK")] (playlistMove "foo" (Id 23) 2)
testRm = cmd_ [("rm \"foo\"", Right "OK")] (rm "foo")
testRename = cmd_ [("rename \"foo\" \"bar\"", Right "OK")] (rename "foo" "bar")
testSave = cmd_ [("save \"foo\"", Right "OK")] (save "foo")
testShuffle = cmd_ [("shuffle", Right "OK")] (shuffle Nothing)
testListPlaylist = cmd [("listplaylist \"foo\""
,Right "file: dir/Foo-bar.ogg\n\
\file: dir/Quux-quuz.ogg\n\
\OK")]
(Right ["dir/Foo-bar.ogg", "dir/Quux-quuz.ogg"])
(listPlaylist "foo")
--
-- Playback commands
--
testCrossfade = cmd_ [("crossfade 0", Right "OK")] (crossfade 0)
testPlay = cmd_ [("play", Right "OK")] (play Nothing)
testPause = cmd_ [("pause 0", Right "OK")] (pause False)
testStop = cmd_ [("stop", Right "OK")] stop
testNext = cmd_ [("next", Right "OK")] next
testPrevious = cmd_ [("previous", Right "OK")] previous
testRandom = cmd_ [("random 0", Right "OK")] (random False)
testRepeat = cmd_ [("repeat 0", Right "OK")] (repeat False)
testSetVolume = cmd_ [("setvol 10", Right "OK")] (setVolume 10)
testConsume = cmd_ [("consume 1", Right "OK")] (consume True)
testSingle = cmd_ [("single 1", Right "OK")] (single True)
--
-- Miscellaneous commands
--
testClearError = cmd_ [("clearerror", Right "OK")] clearError
testCommands =
cmd [("commands", Right "command: foo\ncommand: bar")]
(Right ["foo", "bar"])
commands
testNotCommands =
cmd [("notcommands", Right "command: foo\ncommand: bar")]
(Right ["foo", "bar"])
notCommands
testTagTypes =
cmd [("tagtypes", Right "tagtype: foo\ntagtype: bar")]
(Right ["foo", "bar"])
tagTypes
testUrlHandlers =
cmd [("urlhandlers", Right "urlhandler: foo\nurlhandler: bar")]
(Right ["foo", "bar"])
urlHandlers
testPassword = cmd_ [("password foo", Right "OK")] (password "foo")
testPasswordSucceeds =
testMPDWithPassword convo "foo" cmd_in `shouldBe` expected_resp
where
convo = [("lsinfo \"/\"", Right "ACK [4@0] {play} you don't have \
\permission for \"play\"")
,("password foo", Right "OK")
,("lsinfo \"/\"", Right "directory: /bar\nOK")]
expected_resp = Right [LsDirectory "/bar"]
cmd_in = lsInfo "/"
testPasswordFails =
testMPDWithPassword convo "foo" cmd_in `shouldBe` expected_resp
where
convo = [("play", Right "ACK [4@0] {play} you don't have \
\permission for \"play\"")
,("password foo",
Right "ACK [3@0] {password} incorrect password")]
expected_resp =
Left $ ACK InvalidPassword " incorrect password"
cmd_in = play Nothing
testPing = cmd_ [("ping", Right "OK")] ping
testStats = cmd [("stats", Right resp)] (Right obj) stats
where obj = def { stsArtists = 1, stsAlbums = 1, stsSongs = 1
, stsUptime = 100, stsPlaytime = 100, stsDbUpdate = 10
, stsDbPlaytime = 100 }
resp = unparse obj ++ "OK"
--
-- Extensions\/shortcuts
--
testTogglePlay = cmd_
[("status", Right resp)
,("pause 1", Right "OK")]
toggle
where resp = unparse def { stState = Playing }
testToggleStop = cmd_
[("status", Right resp)
,("play", Right "OK")]
toggle
where resp = unparse def { stState = Stopped }
{- this overlaps with testToggleStop, no?
testTogglePause = cmd_
[("status", Right resp)
,("play", Right "OK")]
toggle
where resp = unparse def { stState = Paused }
-}
testAddMany0 = cmd_ [("add \"bar\"", Right "OK")]
(addMany "" ["bar"])
testAddMany1 = cmd_ [("playlistadd \"foo\" \"bar\"", Right "OK")]
(addMany "foo" ["bar"])
testVolume = cmd_ [("status", Right st), ("setvol 90", Right "OK")] (volume (-10))
where st = unparse def { stVolume = Just 100 }