Network/MPD/SocketConn.hs

   1 {-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}
   2 {-
   3     libmpd for Haskell, an MPD client library.
   4     Copyright (C) 2005-2007  Ben Sinclair <bsinclai@turing.une.edu.au>
   5
   6     This library is free software; you can redistribute it and/or
   7     modify it under the terms of the GNU Lesser General Public
   8     License as published by the Free Software Foundation; either
   9     version 2.1 of the License, or (at your option) any later version.
  10
  11     This library is distributed in the hope that it will be useful,
  12     but WITHOUT ANY WARRANTY; without even the implied warranty of
  13     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14     Lesser General Public License for more details.
  15
  16     You should have received a copy of the GNU Lesser General Public
  17     License along with this library; if not, write to the Free Software
  18     Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
  19 -}
  20
  21 -- | Module    : Network.MPD.SocketConn
  22 -- Copyright   : (c) Ben Sinclair 2005-2007
  23 -- License     : LGPL
  24 -- Maintainer  : bsinclai@turing.une.edu.au
  25 -- Stability   : alpha
  26 -- Portability : Haskell 98
  27 --
  28 -- Connection over a network socket.
  29
  30 module Network.MPD.SocketConn (MPD, SocketConn, withMPDEx) where
  31
  32 import Network.MPD.Prim
  33 import Data.IORef (IORef, newIORef, readIORef, writeIORef)
  34 import Network
  35 import System.IO
  36 import Control.Monad (liftM, unless)
  37 import Data.List (isPrefixOf)
  38 import System.IO.Error (isEOFError)
  39 import Control.Monad.Error (MonadError(..))
  40 import Control.Monad.Trans
  41 import Control.Exception (finally)
  42
  43 -- | The AbstractMPD monad specialised to network connections. Almost
  44 -- everybody will want this.
  45 type MPD a = AbstractMPD SocketConn a
  46
  47 -- The field names should not be exported.
  48 -- The accessors 'connPortNum' and 'connHandle' are not used, though
  49 -- the fields are used (see 'reconnect').
  50 -- | A network connection to an MPD server.
  51 data SocketConn = SC String                 -- host name
  52                      Integer                -- port number
  53                      (IORef (Maybe Handle)) -- socket handle
  54                      (IO (Maybe String))    -- password getter
  55
  56 instance Conn SocketConn where
  57     connOpen  = scOpen
  58     connClose = scClose
  59     connRead  = scRead
  60     connWrite = scWrite
  61     connGetPW (SC _ _ _ pw) = pw
  62
  63 -- | Run an MPD action against a server.
  64 withMPDEx :: String            -- ^ Host name.
  65           -> Integer           -- ^ Port number.
  66           -> IO (Maybe String) -- ^ An action that supplies passwords.
  67           -> MPD a             -- ^ The action to run.
  68           -> IO (Response a)
  69 withMPDEx host port getpw m = do
  70     hRef <- newIORef Nothing
  71     let conn = SC host port hRef getpw
  72     connOpen conn
  73     finally (runAbsMPD m conn) (connClose conn)
  74
  75 scOpen :: SocketConn -> IO ()
  76 scOpen conn@(SC host port hRef _) =
  77     withSocketsDo $ do
  78     scClose conn
  79     handle <- safeConnectTo host port
  80     writeIORef hRef handle
  81     maybe (return ()) (\_ -> checkConn conn >>= flip unless (scClose conn))
  82           handle
  83
  84 scClose :: SocketConn -> IO ()
  85 scClose (SC _ _ hRef _) =
  86     readIORef hRef >>= maybe (return ()) sendClose >> writeIORef hRef Nothing
  87     where
  88       sendClose h = catch (hPutStrLn h "close" >> hClose h)
  89                           (\err -> if isEOFError err then return ()
  90                                                      else ioError err)
  91
  92 scRead :: SocketConn -> IO (Response String)
  93 scRead (SC _ _ hRef _) =
  94     readIORef hRef >>= maybe (return $ Left NoMPD) getTO
  95     where
  96       getTO  h = catch (liftM Right $ hGetLine h) markTO
  97       markTO e = if isEOFError e then (return $ Left TimedOut) else ioError e
  98
  99 scWrite :: SocketConn -> String -> IO (Response ())
 100 scWrite (SC _ _ hRef _) str =
 101     readIORef hRef >>=
 102     maybe (return $ Left NoMPD)
 103           (\h -> hPutStrLn h str >> hFlush h >> return (Right ()))
 104
 105 --
 106 -- Helpers
 107 --
 108
 109 safeConnectTo :: String -> Integer -> IO (Maybe Handle)
 110 safeConnectTo host port =
 111     catch (liftM Just . connectTo host . PortNumber $ fromInteger port)
 112           (const $ return Nothing)
 113
 114 -- Check that an MPD daemon is at the other end of a connection.
 115 checkConn :: (Conn a) => a -> IO Bool
 116 checkConn c = connRead c >>= return . either (const False) (isPrefixOf "OK MPD")