ble 0.4.0.0 → 0.4.1
raw patch · 7 files changed
+97/−37 lines, 7 filesdep +optparse-applicative
Dependencies added: optparse-applicative
Files
- README.md +6/−0
- ble.cabal +2/−1
- examples/HeartRate.hs +42/−7
- examples/HeartRateClient.hs +36/−27
- examples/README.lhs +6/−0
- package.yaml +2/−1
- src/Bluetooth/Internal/DBus.hs +3/−1
README.md view
@@ -75,6 +75,12 @@ bluetoothd --version ``` +Note that for version 5.41 in particular you'll need to run `bluetoothd` with+the experimental flag. (You might have to change `/lib/systemd/system/bluetooth.service`+to add `--experimental` to the `ExecStart` command, and the restart the+bluetoothd service)++ ### Contributing Note that quite a number of tests are protected by a flag (`hasDBus`). This is
ble.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: ble-version: 0.4.0.0+version: 0.4.1 synopsis: Bluetooth Low Energy (BLE) peripherals description: This package provides a Haskell API for writing Bluetooth Low Energy peripherals. stability: alpha@@ -131,6 +131,7 @@ , data-default-class >= 0.0 && < 0.2 , ble , hslogger+ , optparse-applicative >= 0.12 && < 0.14 if flag(hasDBus) cpp-options: -DDBusMock other-modules:
examples/HeartRate.hs view
@@ -3,22 +3,32 @@ -- This example contains a demonstration of the standard Heart Rate Service -- (HRS). It serves as an examples of using notifications.+--+-- The program takes a command line argument to allow using controllers other+-- than the default (hci0). If you have multiple controllers on a single+-- machine (either hardware or virtual with something such as 'btvirt'), you+-- can thus test this service with the heart-rate client executable. import Bluetooth+import Bluetooth.Internal.Interfaces (bluezPath) import Control.Concurrent import Control.Monad import Control.Monad.IO.Class import Data.IORef import Data.Monoid-import System.Random (randomRIO)+import Data.String (fromString)+import Data.Word (Word8) import System.Log.Logger+import System.Random (randomRIO) -import qualified Data.Serialize as S-import qualified Data.ByteString as BS+import qualified Data.ByteString as BS+import qualified Options.Applicative as Opt main :: IO () main = do- updateGlobalLogger rootLoggerName (setLevel DEBUG)+ options <- Opt.execParser opts+ writeIORef bluezPath $ fromString $ "/org/bluez/" ++ controller options+ when (verbose options) $ updateGlobalLogger rootLoggerName (setLevel DEBUG) heartRateRef <- newIORef 0 let s = AppState heartRateRef conn <- connect@@ -39,9 +49,34 @@ threadDelay (10 ^ 7) data AppState = AppState- { currentHeartRate :: IORef Int+ { currentHeartRate :: IORef Word8 } +data Options = Options+ { controller :: String+ , verbose :: Bool+ }++opts :: Opt.ParserInfo Options+opts = Opt.info+ (parser Opt.<**> Opt.helper)+ ( Opt.fullDesc+ <> Opt.progDesc "Print a greeting for TARGET"+ <> Opt.header "hello - a test for optparse-applicative" )++parser :: Opt.Parser Options+parser = Options+ <$> Opt.strOption+ ( Opt.long "controller"+ <> Opt.metavar "HCIX"+ <> Opt.showDefault+ <> Opt.value "hci0"+ <> Opt.help "Controller to use")+ <*> Opt.switch+ ( Opt.long "verbose"+ <> Opt.short 'v'+ <> Opt.help "Print debugging info to console")+ app :: AppState -> Application app appState = "/com/turingjump/example/hrs"@@ -67,8 +102,8 @@ writeIORef (currentHeartRate appState) v return True -heartRateToBS :: Int -> BS.ByteString-heartRateToBS i = "0x06" <> S.encode i+heartRateToBS :: Word8 -> BS.ByteString+heartRateToBS i = BS.singleton 0x06 <> BS.singleton i bodySensorLocation :: CharacteristicBS 'Local bodySensorLocation
examples/HeartRateClient.hs view
@@ -1,9 +1,14 @@ module Main (main) where import Bluetooth-import Data.Maybe-import Control.Monad.IO.Class+import Control.Concurrent+import Data.Bits (testBit)+import Data.Word (Word16) +import qualified Data.ByteString as BS+import qualified Data.Serialize as S++ -- This example contains a demonstration of a client that interacts with a -- Heart Rate Service. @@ -12,41 +17,45 @@ res <- connect >>= runBluetoothM go case res of Left e -> error $ show e- Right () -> return ()+ Right () -> threadDelay 1000000000000 where go = do mhrs <- getService "0000180d-0000-1000-8000-00805f9b34fb"-- let mhandlers = case mhrs of+ let handler = case mhrs of Nothing -> error "No heart rate service found!"- Just hrs -> do- bodyLocChar <- listToMaybe $ filter- (\x -> x ^. uuid == bodySensorLocationUUID)- (hrs ^. characteristics)- readBodyLoc <- bodyLocChar ^. readValue- measurementChar <- listToMaybe $ filter- (\x -> x ^. uuid == heartRateMeasurementUUID)- (hrs ^. characteristics)- readMeasurement <- measurementChar ^. readValue- return (readBodyLoc, readMeasurement)+ Just hrs -> case filter+ (\x -> x ^. uuid == heartRateMeasurementUUID)+ (hrs ^. characteristics) of+ [] -> error "Couldn't find expected characteristics"+ measurementChar:_ -> measurementChar+ handleNotify handler - case mhandlers of- Nothing -> error "Couldn't find expected characteristics, or they're not readable"- Just (rbodyLoc, rmeasurement) -> do- liftIO $ putStrLn "Reading body location"- bodyLoc <- rbodyLoc- liftIO $ print bodyLoc+ handleNotify rmeasurement = startNotify rmeasurement $+ \x -> case deserializeMeasurement x of+ Nothing -> putStrLn "Error decoding value"+ Just v -> do+ putStrLn $ "Received Heart Rate: " ++ show v - liftIO $ putStrLn "Reading heart rate"- measurement <- rmeasurement- liftIO $ print measurement+-- * Types +-- Heart rate in bpm+newtype HeartRate = HeartRate Integer+ deriving (Eq, Show, Read) +-- See https://www.bluetooth.com/specifications/gatt/viewer?attributeXmlFile=org.bluetooth.characteristic.heart_rate_measurement.xml+deserializeMeasurement :: BS.ByteString -> Maybe HeartRate+deserializeMeasurement bs = do+ (flags, dat) <- BS.uncons bs+ if not $ testBit flags 0+ -- Uses uint8+ then HeartRate . toInteger . fst <$> BS.uncons dat+ -- Uses uint16+ else case S.decode $ BS.take 2 dat of+ Left e -> error $ show e+ Right (v :: Word16) -> Just $ HeartRate $ toInteger v+ -- * Constants heartRateMeasurementUUID :: UUID heartRateMeasurementUUID = "00002a37-0000-1000-8000-00805f9b34fb"--bodySensorLocationUUID :: UUID-bodySensorLocationUUID = "00002a38-0000-1000-8000-00805f9b34fb"
examples/README.lhs view
@@ -75,6 +75,12 @@ bluetoothd --version ``` +Note that for version 5.41 in particular you'll need to run `bluetoothd` with+the experimental flag. (You might have to change `/lib/systemd/system/bluetooth.service`+to add `--experimental` to the `ExecStart` command, and the restart the+bluetoothd service)++ ### Contributing Note that quite a number of tests are protected by a flag (`hasDBus`). This is
package.yaml view
@@ -1,5 +1,5 @@ name: ble-version: 0.4.0.0+version: 0.4.1 synopsis: Bluetooth Low Energy (BLE) peripherals description: > This package provides a Haskell API for writing Bluetooth Low Energy@@ -126,6 +126,7 @@ dependencies: - ble - hslogger+ - optparse-applicative >= 0.12 && < 0.14 auth: main: Auth.hs source-dirs: examples
src/Bluetooth/Internal/DBus.hs view
@@ -3,6 +3,7 @@ import Control.Monad.Except import Control.Monad.Reader import Data.IORef (readIORef, writeIORef)+import Data.Maybe (catMaybes) import Data.Monoid ((<>)) import DBus import DBus.Signal (execSignalT)@@ -163,7 +164,8 @@ let unmakeAny :: (Representable a) => DBusValue 'TypeVariant -> Maybe a unmakeAny x = fromRep =<< fromVariant x uuid' :: UUID <- unmakeAny =<< Map.lookup "UUID" dict- properties' <- unmakeAny =<< Map.lookup "Flags" dict+ properties'' :: [DBusValue (RepType T.Text)] <- unmakeAny =<< Map.lookup "Flags" dict+ let properties' = catMaybes $ fmap fromRep properties'' let mrv = if any (`elem` readProps) properties' then Just $ callMethodBM charPath gattCharacteristicIFace "ReadValue" ()