diff --git a/ble.cabal b/ble.cabal --- a/ble.cabal +++ b/ble.cabal @@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: ble -version: 0.2.0.0 +version: 0.3.0.0 synopsis: Bluetooth Low Energy (BLE) peripherals description: This package provides a Haskell API for writing Bluetooth Low Energy peripherals. stability: alpha @@ -46,7 +46,7 @@ base >= 4.7 && < 4.10 , bytestring >= 0.10 && < 0.11 , text >= 1 && < 2 - , d-bus >= 0.1 && < 0.2 + , d-bus >= 0.1.5 && < 0.2 , uuid >= 1 && < 2 , mtl >= 2.2 && < 2.3 , transformers >= 0.4 && < 0.6 @@ -81,7 +81,7 @@ base >= 4.7 && < 4.10 , bytestring >= 0.10 && < 0.11 , text >= 1 && < 2 - , d-bus >= 0.1 && < 0.2 + , d-bus >= 0.1.5 && < 0.2 , uuid >= 1 && < 2 , mtl >= 2.2 && < 2.3 , transformers >= 0.4 && < 0.6 @@ -110,7 +110,7 @@ base >= 4.7 && < 4.10 , bytestring >= 0.10 && < 0.11 , text >= 1 && < 2 - , d-bus >= 0.1 && < 0.2 + , d-bus >= 0.1.5 && < 0.2 , uuid >= 1 && < 2 , mtl >= 2.2 && < 2.3 , transformers >= 0.4 && < 0.6 @@ -140,7 +140,7 @@ base >= 4.7 && < 4.10 , bytestring >= 0.10 && < 0.11 , text >= 1 && < 2 - , d-bus >= 0.1 && < 0.2 + , d-bus >= 0.1.5 && < 0.2 , uuid >= 1 && < 2 , mtl >= 2.2 && < 2.3 , transformers >= 0.4 && < 0.6 @@ -152,6 +152,7 @@ , cereal >= 0.4 && < 0.6 , data-default-class >= 0.0 && < 0.2 , ble + , hslogger if flag(hasBluez) cpp-options: -DBluez other-modules: @@ -170,7 +171,7 @@ base >= 4.7 && < 4.10 , bytestring >= 0.10 && < 0.11 , text >= 1 && < 2 - , d-bus >= 0.1 && < 0.2 + , d-bus >= 0.1.5 && < 0.2 , uuid >= 1 && < 2 , mtl >= 2.2 && < 2.3 , transformers >= 0.4 && < 0.6 diff --git a/examples/Auth.hs b/examples/Auth.hs --- a/examples/Auth.hs +++ b/examples/Auth.hs @@ -20,7 +20,7 @@ conn <- connect x <- runBluetoothM (registerAndAdvertiseApplication app) conn case x of - Right () -> putStrLn "Started BLE auth application!" + Right _ -> putStrLn "Started BLE auth application!" Left e -> error $ "Error starting application " ++ show e threadDelay maxBound diff --git a/examples/Counter.hs b/examples/Counter.hs --- a/examples/Counter.hs +++ b/examples/Counter.hs @@ -15,7 +15,7 @@ conn <- connect x <- runBluetoothM (registerAndAdvertiseApplication $ app ref) conn case x of - Right () -> putStrLn "Started BLE counter application!" + Right _ -> putStrLn "Started BLE counter application!" Left e -> error $ "Error starting application " ++ show e threadDelay maxBound diff --git a/examples/HeartRate.hs b/examples/HeartRate.hs --- a/examples/HeartRate.hs +++ b/examples/HeartRate.hs @@ -2,38 +2,44 @@ module Main (main) where -- This example contains a demonstration of the standard Heart Rate Service --- (HRS). It serves as an examples of using notifications. (NOT YET FUNCTIONAL) +-- (HRS). It serves as an examples of using notifications. import Bluetooth import Control.Concurrent import Control.Monad import Control.Monad.IO.Class import Data.IORef +import Data.Monoid import System.Random (randomRIO) +import System.Log.Logger +import qualified Data.Serialize as S +import qualified Data.ByteString as BS + main :: IO () main = do + updateGlobalLogger rootLoggerName (setLevel DEBUG) heartRateRef <- newIORef 0 - isNotifyingRef <- newIORef False - let s = AppState heartRateRef isNotifyingRef + let s = AppState heartRateRef conn <- connect x <- runBluetoothM (registerAndAdvertiseApplication $ app s) conn - case x of - Right () -> putStrLn "Started BLE Heart Rate Service application!" + registered <- case x of + Right registered -> do + putStrLn "Started BLE Heart Rate Service application!" + return registered Left e -> error $ "Error starting application" ++ show e forever $ do newValue <- randomRIO (50, 150) - {-writeChrc (heartRateMeasurement s) newValue-} writeIORef heartRateRef newValue - putStrLn "Value updated!" - nots <- readIORef isNotifyingRef - putStrLn $ if nots then "Notifying" else "Not notifying" + res <- runBluetoothM (triggerNotification registered $ heartRateMeasurement s) conn + case res of + Right () -> putStrLn "Notification sent!" + Left e -> error $ "Bluetooth error:\n" ++ show e -- We update the value every ten seconds threadDelay (10 ^ 7) data AppState = AppState { currentHeartRate :: IORef Int - , isNotifying :: IORef Bool } app :: AppState -> Application @@ -49,18 +55,20 @@ heartRateMeasurement :: AppState -> CharacteristicBS heartRateMeasurement appState = "00002a37-0000-1000-8000-00805f9b34fb" - & readValue ?~ encodeRead (liftIO . readIORef $ currentHeartRate appState) + & readValue ?~ fmap heartRateToBS (liftIO . readIORef $ currentHeartRate appState) -- Even though we add a @writeValue@, this does not mean that the -- characteristic is writable (for that, we would need to add the CPWrite -- property to it). Instead, we can use the writeValue internally to -- update the value and send notifications each time the value is changed. & writeValue ?~ encodeWrite (liftIO <$> write) & properties .~ [CPNotify, CPRead] - & notifying ?~ isNotifying appState where write v = do writeIORef (currentHeartRate appState) v return True + +heartRateToBS :: Int -> BS.ByteString +heartRateToBS i = "0x06" <> S.encode i bodySensorLocation :: CharacteristicBS bodySensorLocation diff --git a/package.yaml b/package.yaml --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: ble -version: 0.2.0.0 +version: 0.3.0.0 synopsis: Bluetooth Low Energy (BLE) peripherals description: > This package provides a Haskell API for writing Bluetooth Low Energy @@ -44,7 +44,7 @@ - base >= 4.7 && < 4.10 - bytestring >= 0.10 && < 0.11 - text >= 1 && < 2 - - d-bus >= 0.1 && < 0.2 + - d-bus >= 0.1.5 && < 0.2 - uuid >= 1 && < 2 - mtl >= 2.2 && < 2.3 - transformers >= 0.4 && < 0.6 @@ -111,6 +111,7 @@ source-dirs: examples dependencies: - ble + - hslogger auth: main: Auth.hs source-dirs: examples diff --git a/src/Bluetooth.hs b/src/Bluetooth.hs --- a/src/Bluetooth.hs +++ b/src/Bluetooth.hs @@ -51,13 +51,13 @@ , advertisementFor , connect , runBluetoothM + , runHandler -- * Field lenses , uuid , properties , readValue , writeValue - , notifying , characteristics , services , path @@ -70,8 +70,9 @@ , includeTxPower , connectionName - -- * Updating values with notification - , writeChrc + -- * Notifications + , characteristicIsNotifying + , triggerNotification diff --git a/src/Bluetooth/Internal/DBus.hs b/src/Bluetooth/Internal/DBus.hs --- a/src/Bluetooth/Internal/DBus.hs +++ b/src/Bluetooth/Internal/DBus.hs @@ -1,38 +1,40 @@ module Bluetooth.Internal.DBus where -import Control.Monad.Error.Class (throwError) +import Control.Monad.Except import Control.Monad.Reader -import Data.IORef (readIORef) -import Data.Monoid ((<>)) +import Data.IORef (readIORef, writeIORef) +import Data.Monoid ((<>)) import DBus -import DBus.Signal (execSignalT) +import DBus.Signal (execSignalT) import Lens.Micro -import qualified Data.Map as Map -import qualified Data.Serialize as S -import qualified Data.Text as T +import qualified Data.Map as Map +import qualified Data.Text as T import Bluetooth.Internal.HasInterface import Bluetooth.Internal.Interfaces import Bluetooth.Internal.Types import Bluetooth.Internal.Utils +import Bluetooth.Internal.Errors -- | Registers an application and advertises it. If you would like to have -- finer-grained control of the advertisement, use @registerApplication@ and -- @advertise@. -registerAndAdvertiseApplication :: Application -> BluetoothM () +registerAndAdvertiseApplication :: Application -> BluetoothM ApplicationRegistered registerAndAdvertiseApplication app = do - registerApplication app + reg <- registerApplication app advertise (advertisementFor app) + return reg -- | Registers an application (set of services) with Bluez. -registerApplication :: Application -> BluetoothM () +registerApplication :: Application -> BluetoothM ApplicationRegistered registerApplication app = do conn <- ask addAllObjs conn app - toBluetoothM . const + () <- toBluetoothM . const $ callMethod bluezName bluezPath (T.pack gattManagerIFace) "RegisterApplication" args [] $ dbusConn conn + return ApplicationRegistered where args :: (ObjectPath, Map.Map T.Text Any) args = (app ^. path, Map.empty) @@ -47,11 +49,16 @@ addObject conn p $ (WOP p s `withInterface` gattServiceIFaceP) <> (WOP p s `withInterface` propertiesIFaceP) + registerObjectPath (s ^. uuid) p forM_ (zip [0..] (s ^. characteristics)) $ \(i', c) -> do let p' = characteristicObjectPath p i' addObject conn p' $ (WOP p' c `withInterface` gattCharacteristicIFaceP) <> (WOP p' c `withInterface` propertiesIFaceP) + registerObjectPath (c ^. uuid) p' + where + registerObjectPath :: UUID -> ObjectPath -> IO () + registerObjectPath uuid' op = writeIORef (objectPathOf uuid') (Just op) -- | Advertise a set of services. advertise :: WithObjectPath Advertisement -> BluetoothM () @@ -76,26 +83,29 @@ adv = def & serviceUUIDs .~ (app ^.. services . traversed . uuid) p = app ^. path & toText %~ ( "adv") --- | Write a characteristic (if possible). Returns True if characterstic was --- successfully written. -writeChrc :: S.Serialize x => WithObjectPath CharacteristicBS -> x -> BluetoothM Bool -writeChrc c v = case (c ^. value . writeValue, c ^. value . notifying) of - (Nothing, _) -> return False - (Just f, Nothing) -> runEff . handlerToMethodHandler $ f (S.encode v) - (Just f, Just r) -> runEff $ do - changed <- handlerToMethodHandler (f $ S.encode v) - notify <- liftIO $ readIORef r - when (changed && notify) $ propertyChanged (valProp c) (S.encode v) - return changed + +-- | Triggers notifications or indications. +triggerNotification :: ApplicationRegistered -> CharacteristicBS -> BluetoothM () +triggerNotification ApplicationRegistered c = do + case c ^. readValue of + Nothing -> throwError "Handler does not have a readValue implementation!" + Just readHandler -> do + res' <- liftIO $ runHandler readHandler + res <- case res' of + Left e -> throwError $ BLEError e + Right v -> return v + mPath <- liftIO $ readIORef $ objectPathOf (c ^. uuid) + case mPath of + Nothing -> throwError "UUID not found - are you sure you registered the application containing it?" + Just path' -> runEff $ propertyChanged (valProp $ WOP path' c) res where runEff :: MethodHandlerT IO x -> BluetoothM x runEff act = do conn <- asks dbusConn res <- liftIO $ execSignalT act conn case res of - Left e -> throwError $ MethodErrorMessage $ errorBody e + Left e -> throwError . DBusError . MethodErrorMessage $ errorBody e Right val -> return val - -- * Constants diff --git a/src/Bluetooth/Internal/Errors.hs b/src/Bluetooth/Internal/Errors.hs --- a/src/Bluetooth/Internal/Errors.hs +++ b/src/Bluetooth/Internal/Errors.hs @@ -15,6 +15,9 @@ = Handler { getReadValue :: ExceptT T.Text IO a } deriving (Functor, Applicative, Monad, MonadIO, Generic, MonadError T.Text) +runHandler :: Handler a -> IO (Either T.Text a) +runHandler = runExceptT . getReadValue + -- | Generic failure errorFailed :: Handler a errorFailed = throwError "org.bluez.Error.Failed" diff --git a/src/Bluetooth/Internal/HasInterface.hs b/src/Bluetooth/Internal/HasInterface.hs --- a/src/Bluetooth/Internal/HasInterface.hs +++ b/src/Bluetooth/Internal/HasInterface.hs @@ -1,9 +1,10 @@ module Bluetooth.Internal.HasInterface where +import Control.Concurrent (readMVar, swapMVar, modifyMVar_) import Control.Monad.Except (liftIO, mapExceptT) +import Control.Monad import Control.Monad.Writer.Strict (WriterT) -import Data.IORef import Data.Proxy import Data.Word (Word16) import DBus @@ -71,9 +72,6 @@ -- A helper function for constructing D-Bus Property interfaces. Pass a -- non-Nothing if the object supports the PropertiesChanged signal. --- --- The 'Get' and 'Set' methods don't seem to be used by the Bluez DBus API, but --- are supplied for compliance with the D-Bus Property Interface. defPropIFace :: forall a. ( Representable a , RepType a ~ AnyDBusDict @@ -82,9 +80,6 @@ defPropIFace opath supportedIFaceName val = Interface { interfaceMethods = [getAll] - -- The 'd-bus' library's implementation of @DBus.Property.property@ does - -- not create an independent signal for PropertyChanged, which makes me - -- wonder whether this is the right thing to do. , interfaceSignals = signals , interfaceAnnotations = [] , interfaceProperties = [] @@ -118,9 +113,9 @@ = defPropIFace (Just $ service ^. path) (T.pack gattServiceIFace) service instance HasInterface (WithObjectPath CharacteristicBS) Properties where - getInterface char _ = case char ^. value . notifying of - Nothing -> baseIface - Just _ -> baseIface { interfaceProperties = SomeProperty prop : interfaceProperties baseIface } + getInterface char _ + = baseIface { interfaceProperties = SomeProperty prop + : interfaceProperties baseIface } where baseIface = defPropIFace (Just $ char ^. path) (T.pack gattCharacteristicIFace) char prop = mkProperty (char ^. path) @@ -134,6 +129,7 @@ getInterface adv _ = defPropIFace Nothing (T.pack leAdvertisementIFace) adv + -- * GattService @@ -192,6 +188,7 @@ , interfaceProperties = [ SomeProperty uuid' , SomeProperty service , SomeProperty flags + , SomeProperty notifying , SomeProperty $ valProp char ] } @@ -211,24 +208,22 @@ where go writeTheVal newVal = do res <- handlerToMethodHandler $ writeTheVal newVal - nots <- liftIO $ sequence $ readIORef <$> char ^. value . notifying - liftIO $ print (nots, res) - {-when (nots == Just True && res) $ propertyChanged val newVal-} + nots <- liftIO $ readMVar $ + characteristicIsNotifying (char ^. value . uuid) + when (nots && res) $ propertyChanged (valProp char) newVal return res stopNotify = Method (repMethod go) "StopNotify" Done Done where go :: MethodHandlerT IO () - go = case char ^. value . notifying of - Nothing -> return () - Just r -> liftIO $ writeIORef r False + go = liftIO . void $ + swapMVar (characteristicIsNotifying $ char ^. value . uuid) False startNotify = Method (repMethod go) "StartNotify" Done Done where go :: MethodHandlerT IO () - go = case char ^. value . notifying of - Nothing -> return () - Just r -> liftIO $ writeIORef r True + go = liftIO . void $ + swapMVar (characteristicIsNotifying $ char ^. value . uuid) True uuid' :: Property (RepType UUID) uuid' = Property @@ -260,6 +255,21 @@ , propertySet = Nothing , propertyEmitsChangedSignal = PECSFalse } + + notifying :: Property (RepType Bool) + notifying = Property + { propertyPath = objectPath $ (char ^. path . toText) "Notifying" + , propertyInterface = T.pack gattCharacteristicIFace + , propertyName = "Notifying" + , propertyGet = Just $ liftIO $ toRep <$> readMVar mvar + , propertySet = Just $ \new -> liftIO $ do + case fromRep new of + Nothing -> return False + Just v -> modifyMVar_ mvar (const $ return v) >> return True + , propertyEmitsChangedSignal = PECSFalse + } + where + mvar = characteristicIsNotifying (char ^. value . uuid) valProp :: WithObjectPath (CharacteristicBS) -> Property (RepType BS.ByteString) valProp char = mkProperty (char ^. path) diff --git a/src/Bluetooth/Internal/Types.hs b/src/Bluetooth/Internal/Types.hs --- a/src/Bluetooth/Internal/Types.hs +++ b/src/Bluetooth/Internal/Types.hs @@ -9,7 +9,9 @@ module Bluetooth.Internal.Types where -import Control.Monad.Except (ExceptT (ExceptT), MonadError, runExceptT) +import Control.Concurrent (MVar, modifyMVar, newMVar) +import Control.Monad.Except (ExceptT (ExceptT), MonadError, runExceptT, + withExceptT) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Reader (MonadReader, ReaderT (ReaderT), runReaderT) import Data.Default.Class (Default (def)) @@ -28,6 +30,7 @@ import GHC.Generics (Generic) import Lens.Micro import Lens.Micro.TH (makeFields) +import System.IO.Unsafe (unsafePerformIO) import qualified Data.ByteString as BS import qualified Data.Map as Map @@ -210,20 +213,53 @@ -- | Write a value. Note that the value is only writeable externally if the -- characteristic contains the CPWrite property *and* this is a Just. , characteristicWriteValue :: Maybe (typ -> Handler Bool) - -- | If @Nothing@, this characteristic does not send notifications. - -- If @Just False@, the characteristic does not currently send notifications, but - -- can be made to (with a @StartNotify@ method request). - -- If @Just True@, the characteristic currently sends notifications (and can - -- be made to stop with a @StopNotify@ method request). - -- **NOTE**: Notifications do not currently work. - , characteristicNotifying :: Maybe (IORef Bool) } deriving (Generic) makeFields ''Characteristic +-- This is essentialy the unsafePerformIO memoization trick +characteristicIsNotifying :: UUID -> MVar Bool +characteristicIsNotifying = unsafePerformIO $ do + cm <- newMVar $ Map.empty + return $ \uuid' -> unsafePerformIO $ do + modifyMVar cm $ \curMap -> case Map.lookup uuid' curMap of + Nothing -> do + e <- newMVar False + return (Map.insert uuid' e curMap, e) + Just v -> return (curMap, v) +{-# NOINLINE characteristicIsNotifying #-} + +-- This too is essentialy the unsafePerformIO memoization trick. Keeps track of +-- object paths for registered services and characteristics so that we can +-- expose an API that doesn't require WithObjectPath +objectPathOf :: UUID -> IORef (Maybe ObjectPath) +objectPathOf = unsafePerformIO $ do + cm <- newMVar $ Map.empty + return $ \uuid' -> unsafePerformIO $ do + modifyMVar cm $ \curMap -> case Map.lookup uuid' curMap of + Nothing -> do + e <- newIORef Nothing + return (Map.insert uuid' e curMap, e) + Just v -> return (curMap, v) +{-# NOINLINE objectPathOf #-} + +{- +-- Like 'characteristicIsNotifying', but for cached values. +characteristicValue :: UUID -> MVar BS.ByteString +characteristicValue = unsafePerformIO $ do + cm <- newMVar $ Map.empty + return $ \uuid' -> unsafePerformIO $ do + modifyMVar cm $ \curMap -> case Map.lookup uuid' curMap of + Nothing -> do + e <- newMVar False + return (Map.insert uuid' e curMap, e) + Just v -> return (curMap, v) +{-# NOINLINE characteristicValue #-} +-} + instance IsString (Characteristic a) where - fromString x = Characteristic (fromString x) [] Nothing Nothing Nothing + fromString x = Characteristic (fromString x) [] Nothing Nothing -- Note [WithObjectPath] instance Representable (WithObjectPath (Characteristic a)) where @@ -403,18 +439,38 @@ -- * BluetoothM +data Error + = DBusError MethodError + | BLEError T.Text + deriving (Show, Generic) + +instance IsString Error where + fromString = BLEError . fromString + newtype BluetoothM a - = BluetoothM ( ReaderT Connection (ExceptT MethodError IO) a ) - deriving (Functor, Applicative, Monad, MonadIO, MonadError MethodError, + = BluetoothM ( ReaderT Connection (ExceptT Error IO) a ) + deriving (Functor, Applicative, Monad, MonadIO, MonadError Error, MonadReader Connection) -runBluetoothM :: BluetoothM a -> Connection -> IO (Either MethodError a) +runBluetoothM :: BluetoothM a -> Connection -> IO (Either Error a) runBluetoothM (BluetoothM e) conn = runExceptT $ runReaderT e conn toBluetoothM :: (Connection -> IO (Either MethodError a)) -> BluetoothM a -toBluetoothM = BluetoothM . ReaderT . fmap ExceptT +toBluetoothM = BluetoothM . ReaderT . fmap (withExceptT DBusError . ExceptT) +-- * Assorted + +-- | This datatype, which is kept opaque, is returned when an application is +-- successfully registered, and required as an argument from functions that +-- should only be called after the application has been registered. +data ApplicationRegistered = ApplicationRegistered + deriving (Eq, Show, Read, Generic) + +data Status + = Success + | Failure + deriving (Eq, Show, Read, Ord, Enum, Generic) {- Note [WithObjectPath] ~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/test/Bluetooth/TypesSpec.hs b/test/Bluetooth/TypesSpec.hs --- a/test/Bluetooth/TypesSpec.hs +++ b/test/Bluetooth/TypesSpec.hs @@ -1,10 +1,8 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Bluetooth.TypesSpec (spec) where -import Data.IORef import Data.Proxy (Proxy (Proxy)) import DBus -import System.IO.Unsafe (unsafePerformIO) import Test.Hspec import Test.QuickCheck import Test.QuickCheck.Instances () @@ -83,12 +81,6 @@ <*> arbitrary <*> (fmap return <$> arbitrary) <*> (fmap (fmap return) <$> arbitrary) - <*> genIORef - where - genIORef = do - m <- arbitrary - if m then Just . unsafePerformIO . newIORef <$> arbitrary - else return Nothing instance Arbitrary CharacteristicProperty where arbitrary = elements [minBound..maxBound] diff --git a/test/BluetoothSpec.hs b/test/BluetoothSpec.hs --- a/test/BluetoothSpec.hs +++ b/test/BluetoothSpec.hs @@ -7,13 +7,13 @@ import Bluetooth import Control.Monad.IO.Class +import Data.Either (isRight) import DBus import Test.Hspec import qualified Data.ByteString as BS - spec :: Spec spec = do #ifndef Bluez @@ -21,6 +21,7 @@ #else registerApplicationSpec advertiseSpec + {-notifySpec-} #endif registerApplicationSpec :: Spec @@ -28,7 +29,7 @@ it "registers the service with bluez" $ \conn -> do v <- runBluetoothM (registerApplication testApp) conn - v `shouldBe` Right () + v `shouldSatisfy` isRight -- We verify that the application is in fact registered by checking that -- attempting to register it again throws an AlreadyExists error. Left err <- runBluetoothM (registerApplication testApp) conn @@ -39,7 +40,7 @@ let checkAdvert ad conn = do v <- runBluetoothM (advertise ad) conn - v `shouldBe` Right () + v `shouldSatisfy` isRight -- We verify that the advertisement was registered by checking that -- attempting to register it again throws an AlreadyExists error. Left err <- runBluetoothM (advertise ad) conn @@ -57,7 +58,23 @@ let adv = testAdv & value . manufacturerData . at 1 ?~ "hi" checkAdvert adv conn +{-notifySpec :: Spec-} +{-notifySpec = describe "notification" $ before connect $ do-} + {-it "accepts StartNotify" $ \conn -> do-} + {-readIORef isNotifying `shouldReturn` False-} + {-v <- runBluetoothM (registerApplication testApp) conn-} + {-_ <- runBluetoothM (testCharacteristic ^. startNotify) conn-} + {-readIORef isNotifying `shouldReturn` True-} + + {-it "accepts StopNotify" $ \conn -> do-} + {-readIORef isNotifying `shouldReturn` False-} + {-v <- runBluetoothM (registerApplication testApp) conn-} + {-_ <- runBluetoothM (testCharacteristic ^. startNotify) conn-} + {-readIORef isNotifying `shouldReturn` True-} + {-_ <- runBluetoothM (testCharacteristic ^. stopNotify) conn-} + {-readIORef isNotifying `shouldReturn` False-} + -- * Test service testApp :: Application @@ -74,7 +91,7 @@ testCharacteristic = "cdcb58aa-7e4c-4d22-b0bf-a90cd67ba60b" & readValue ?~ encodeRead go - & properties .~ [CPRead] + & properties .~ [CPRead, CPNotify] where go :: Handler BS.ByteString go = do