module Bluetooth.Internal.Device where import Control.Monad.Except (throwError) import Control.Monad.IO.Class (liftIO) import Control.Monad.Reader (ask) import Data.IORef (readIORef) import DBus (DBusType, RemoteProperty (..), Representable, callMethod, getProperty, setProperty, ObjectPath) import Lens.Micro import qualified Data.Text as T import qualified Data.Map as Map import Bluetooth.Internal.Interfaces import Bluetooth.Internal.Lenses import Bluetooth.Internal.Types -- | Retrieves the list of all known devices. This does not by itself do device -- discovery; instead, it just lists devices that have already been discovered. -- -- Usually device discovery happens at regular intervals and automatically. getAllDevices :: BluetoothM [Device] getAllDevices = do conn <- ask bluezName' <- liftIO $ readIORef bluezName objects :: Map.Map ObjectPath (Map.Map T.Text (Map.Map T.Text DontCareFromRep)) <- toBluetoothM . const $ callMethod bluezName' "/" (T.pack objectManagerIFace) "GetManagedObjects" () [] (dbusConn conn) let devices = Map.keys $ Map.filter (T.pack deviceIFace `Map.member`) objects return $ Device <$> devices -- Prepositional bestiary -- | Connect to a bluetooth device connectTo :: Device -> BluetoothM () connectTo dev = callDeviceMethod dev "Connect" -- | Disconnect from a bluetooth device disconnectFrom :: Device -> BluetoothM () disconnectFrom dev = callDeviceMethod dev "Disonnect" -- | Is a device connected? isConnected :: Device -> BluetoothM Bool isConnected dev = getDeviceProperty dev "Connected" -- | Pair with a device pairWith :: Device -> BluetoothM () pairWith dev = callDeviceMethod dev "Pair" -- | Is device paired? isPaired :: Device -> BluetoothM Bool isPaired dev = getDeviceProperty dev "Paired" -- | Trust device trust :: Device -> BluetoothM () trust dev = setDeviceProperty dev "Trusted" True -- | Stop trusting device distrust :: Device -> BluetoothM () distrust dev = setDeviceProperty dev "Trusted" False -- | Is device trusted? isTrusted :: Device -> BluetoothM Bool isTrusted dev = getDeviceProperty dev "Trusted" getDeviceServiceUUIDs :: Device -> BluetoothM [UUID] getDeviceServiceUUIDs dev = getDeviceProperty dev "UUIDs" -- * Helpers callDeviceMethod :: Device -> T.Text -> BluetoothM () callDeviceMethod dev methodName = do conn <- ask bluezName' <- liftIO $ readIORef bluezName toBluetoothM . const $ callMethod bluezName' (dev ^. path) (T.pack deviceIFace) methodName () [] (dbusConn conn) setDeviceProperty :: Representable a => Device -> T.Text -> a -> BluetoothM () setDeviceProperty dev propertyName newValue = do conn <- ask prop <- liftIO $ deviceRemoteProperty dev propertyName liftIO (setProperty prop newValue $ dbusConn conn) >>= \r -> case r of Left e -> throwError $ DBusError e Right () -> return () getDeviceProperty :: Representable a => Device -> T.Text -> BluetoothM a getDeviceProperty dev propertyName = do conn <- ask prop <- liftIO $ deviceRemoteProperty dev propertyName liftIO (getProperty prop $ dbusConn conn) >>= \r -> case r of Left e -> throwError $ DBusError e Right v -> return v deviceRemoteProperty :: Device -> T.Text -> IO (RemoteProperty (b :: DBusType)) deviceRemoteProperty dev propertyName = do bluezName' <- readIORef bluezName return $ RP { rpEntity = bluezName' -- Is this the right entity? , rpObject = dev ^. path , rpInterface = T.pack deviceIFace , rpName = propertyName }