ble-0.3.4.0: Bluetooth Low Energy (BLE) peripherals

Safe HaskellNone
LanguageHaskell2010

Bluetooth

Contents

Description

This module exports all you should need to build a Bluetooth Low Energy (BLE) peripheral.

The core concepts involved are:

Application
This contains the entirety of your application, and is composed of zero or more Services.
Service
A set of zero or more conceptually related Characteristics. Identified by it's UUID.
Characteristic
Characteristics represent the actual data of your application. They may allow reading, writing, and subscribing. Also identified by it's UUID.
Advertisement
This describes how an application will advertise itself to other BLE devices.

All three have IsString instances and lens field accessors. The recommended way of using this library is by using the OverloadedStrings pragma and lenses. A complete example can be found here.

{-# LANGUAGE OverloadedStrings #-}
import Bluetooth
import Control.Concurrent (threadDelay)

app :: Application
app = "/com/turingjump/example" & services .~ [aService]

aService :: Service
aService = "d0bc6707-e9a5-4c85-8d22-d73d33f0330c"
    & characteristics .~ [aCharacteristic]

aCharacteristic :: CharacteristicBS
aCharacteristic = "b3170df6-1770-4d60-86db-a487534cbcc3"
    & readValue ?~ encodeRead (return (32::Int))
    & properties .~ [CPRead]

main :: IO ()
main = do
  conn <- connect
  runBluetoothM (registerAndAdverstiseApplication app) conn
  threadDelay maxBound

Synopsis

Documentation

registerApplication :: Application -> BluetoothM ApplicationRegistered Source #

Registers an application (set of services) with Bluez.

registerAndAdvertiseApplication :: Application -> BluetoothM ApplicationRegistered Source #

Registers an application and advertises it. If you would like to have finer-grained control of the advertisement, use registerApplication and advertise.

advertise :: WithObjectPath Advertisement -> BluetoothM () Source #

Advertise a set of services.

advertisementFor :: Application -> WithObjectPath Advertisement Source #

Create an advertisement for all of an application's services. The advertisement will be for peripheral (not broadcast) by default.

unadvertise :: WithObjectPath Advertisement -> BluetoothM () Source #

Unregister an adverstisement.

connect :: IO Connection Source #

Creates a connection to DBus. This does *not* represent Bluetooth connection.

Field lenses

uuid :: HasUuid s a => Lens' s a Source #

The UUID of an entity

properties :: HasProperties s a => Lens' s a Source #

The properties of e.g. a characteristic.

readValue :: HasReadValue s a => Lens' s a Source #

Access the handler for reading a value, if there is one.

writeValue :: HasWriteValue s a => Lens' s a Source #

Access the handler for writing a value, if there is one. The handler should return True if the value was successfully update.

characteristics :: HasCharacteristics s a => Lens' s a Source #

An access for the list of characteristics.

services :: HasServices s a => Lens' s a Source #

An access for the list of services.

path :: HasPath s a => Lens' s a Source #

Returns the ObjectPath of an entity.

type_ :: HasType_ s a => Lens' s a Source #

value :: HasValue s a => Lens' s a Source #

Returns the actual value of an entity that is wrapped in an

solicitUUIDs :: HasSolicitUUIDs s a => Lens' s a Source #

Accessor for solicit UUIDs. These are UUIDs that an application or service expects to be available.

serviceUUIDs :: HasServiceUUIDs s a => Lens' s a Source #

Accessor for service UUIDs

manufacturerData :: HasManufacturerData s a => Lens' s a Source #

Accessor for manufacting data.

serviceData :: HasServiceData s a => Lens' s a Source #

Accessor for manufacting data.

includeTxPower :: HasIncludeTxPower s a => Lens' s a Source #

Accessor for indicating whether an Advertisement announces TX power (transmission power).

connectionName :: Connection -> Text Source #

The unique DBus connection name, Useful for monitoring activity with 'dbus-monitor'. For information on how to setup dbus-monitor for debugging, see DebuggingDBus.

Since: 0.1.3.0

Notifications

triggerNotification :: ApplicationRegistered -> CharacteristicBS -> BluetoothM () Source #

Triggers notifications or indications.

BLE Types

Types representing components of a BLE application.

data Application Source #

An application. Can be created from it's IsString instance. The string (application path) is used only for the DBus API, and will not have relevance within Bluetooth.

data ApplicationRegistered Source #

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 Service Source #

Instances

IsString Service Source # 

Methods

fromString :: String -> Service #

Generic Service Source # 

Associated Types

type Rep Service :: * -> * #

Methods

from :: Service -> Rep Service x #

to :: Rep Service x -> Service #

HasUuid Service UUID Source # 
HasServices Application [Service] Source # 
HasCharacteristics Service [CharacteristicBS] Source # 
Representable (WithObjectPath Service) Source # 
HasInterface (WithObjectPath Service) GattService Source # 
HasInterface (WithObjectPath Service) Properties Source # 
type Rep Service Source # 
type Rep Service = D1 (MetaData "Service" "Bluetooth.Internal.Types" "ble-0.3.4.0-FK43JGOfOYfLQ1e1O1Vx0V" False) (C1 (MetaCons "Service" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "serviceUuid") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 UUID)) (S1 (MetaSel (Just Symbol "serviceCharacteristics") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [CharacteristicBS]))))
type RepType (WithObjectPath Service) Source # 

data UUID Source #

UUIDs, used for services and characteristics.

Unofficial UUIDs will have 128-bits, and will look this:

d45e83fb-c772-459e-91a8-43cbf1443af4

Official UUIDs will have either 32 or 16 bits.

See ITU-T Rec. X.677 for more information on the format and generation of these UUIDs. You can use the Online UUID Generator to generate UUIDs.

Constructors

UUID UUID 

Instances

Eq UUID Source # 

Methods

(==) :: UUID -> UUID -> Bool #

(/=) :: UUID -> UUID -> Bool #

Ord UUID Source # 

Methods

compare :: UUID -> UUID -> Ordering #

(<) :: UUID -> UUID -> Bool #

(<=) :: UUID -> UUID -> Bool #

(>) :: UUID -> UUID -> Bool #

(>=) :: UUID -> UUID -> Bool #

max :: UUID -> UUID -> UUID #

min :: UUID -> UUID -> UUID #

Show UUID Source # 

Methods

showsPrec :: Int -> UUID -> ShowS #

show :: UUID -> String #

showList :: [UUID] -> ShowS #

IsString UUID Source # 

Methods

fromString :: String -> UUID #

Generic UUID Source # 

Associated Types

type Rep UUID :: * -> * #

Methods

from :: UUID -> Rep UUID x #

to :: Rep UUID x -> UUID #

Representable UUID Source # 

Associated Types

type RepType UUID :: DBusType #

Random UUID Source # 

Methods

randomR :: RandomGen g => (UUID, UUID) -> g -> (UUID, g) #

random :: RandomGen g => g -> (UUID, g) #

randomRs :: RandomGen g => (UUID, UUID) -> g -> [UUID] #

randoms :: RandomGen g => g -> [UUID] #

randomRIO :: (UUID, UUID) -> IO UUID #

randomIO :: IO UUID #

HasUuid Service UUID Source # 
HasSolicitUUIDs Advertisement [UUID] Source # 
HasServiceUUIDs Advertisement [UUID] Source # 
HasServiceData Advertisement (Map UUID ByteString) Source # 
HasUuid (Characteristic typ0) UUID Source # 
type Rep UUID Source # 
type Rep UUID = D1 (MetaData "UUID" "Bluetooth.Internal.Types" "ble-0.3.4.0-FK43JGOfOYfLQ1e1O1Vx0V" False) (C1 (MetaCons "UUID" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 UUID)))
type RepType UUID Source # 

data CharacteristicProperty Source #

Instances

Bounded CharacteristicProperty Source # 
Enum CharacteristicProperty Source # 
Eq CharacteristicProperty Source # 
Ord CharacteristicProperty Source # 
Read CharacteristicProperty Source # 
Show CharacteristicProperty Source # 
Generic CharacteristicProperty Source # 
Representable CharacteristicProperty Source # 
HasProperties (Characteristic typ0) [CharacteristicProperty] Source # 
type Rep CharacteristicProperty Source # 
type Rep CharacteristicProperty = D1 (MetaData "CharacteristicProperty" "Bluetooth.Internal.Types" "ble-0.3.4.0-FK43JGOfOYfLQ1e1O1Vx0V" False) ((:+:) ((:+:) ((:+:) (C1 (MetaCons "CPBroadcast" PrefixI False) U1) ((:+:) (C1 (MetaCons "CPRead" PrefixI False) U1) (C1 (MetaCons "CPEncryptRead" PrefixI False) U1))) ((:+:) (C1 (MetaCons "CPEncryptAuthenticatedRead" PrefixI False) U1) ((:+:) (C1 (MetaCons "CPWriteWithoutResponse" PrefixI False) U1) (C1 (MetaCons "CPWrite" PrefixI False) U1)))) ((:+:) ((:+:) (C1 (MetaCons "CPEncryptWrite" PrefixI False) U1) ((:+:) (C1 (MetaCons "CPEncryptAuthenticatedWrite" PrefixI False) U1) (C1 (MetaCons "CPAuthenticatedSignedWrites" PrefixI False) U1))) ((:+:) (C1 (MetaCons "CPNotify" PrefixI False) U1) ((:+:) (C1 (MetaCons "CPIndicate" PrefixI False) U1) (C1 (MetaCons "CPSignedWriteCommand" PrefixI False) U1)))))
type RepType CharacteristicProperty Source # 

data Characteristic typ Source #

Instances

HasCharacteristics Service [CharacteristicBS] Source # 
IsString (Characteristic a) Source # 
Generic (Characteristic typ) Source # 

Associated Types

type Rep (Characteristic typ) :: * -> * #

Methods

from :: Characteristic typ -> Rep (Characteristic typ) x #

to :: Rep (Characteristic typ) x -> Characteristic typ #

Representable (WithObjectPath (Characteristic a)) Source # 
HasUuid (Characteristic typ0) UUID Source # 
HasInterface (WithObjectPath CharacteristicBS) GattCharacteristic Source # 
HasInterface (WithObjectPath CharacteristicBS) Properties Source # 
HasWriteValue (Characteristic typ0) (Maybe (typ0 -> Handler Bool)) Source # 

Methods

writeValue :: Lens' (Characteristic typ0) (Maybe (typ0 -> Handler Bool)) Source #

HasReadValue (Characteristic typ0) (Maybe (Handler typ0)) Source # 

Methods

readValue :: Lens' (Characteristic typ0) (Maybe (Handler typ0)) Source #

HasProperties (Characteristic typ0) [CharacteristicProperty] Source # 
type Rep (Characteristic typ) Source # 
type Rep (Characteristic typ) = D1 (MetaData "Characteristic" "Bluetooth.Internal.Types" "ble-0.3.4.0-FK43JGOfOYfLQ1e1O1Vx0V" False) (C1 (MetaCons "Characteristic" PrefixI True) ((:*:) ((:*:) (S1 (MetaSel (Just Symbol "characteristicUuid") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 UUID)) (S1 (MetaSel (Just Symbol "characteristicProperties") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [CharacteristicProperty]))) ((:*:) (S1 (MetaSel (Just Symbol "characteristicReadValue") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Maybe (Handler typ)))) (S1 (MetaSel (Just Symbol "characteristicWriteValue") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Maybe (typ -> Handler Bool)))))))
type RepType (WithObjectPath (Characteristic a)) Source # 

data Advertisement Source #

An advertisement can be generated automatically with advertisementFor, or with the IsList instance. Both of these by default assume the advertisement is for a peripheral.

You can also, of course, use the constructor.

Instances

IsList Advertisement Source # 
Eq Advertisement Source # 
Show Advertisement Source # 
Generic Advertisement Source # 

Associated Types

type Rep Advertisement :: * -> * #

Representable Advertisement Source # 
Default Advertisement Source # 

Methods

def :: Advertisement #

HasType_ Advertisement AdvertisementType Source # 
HasIncludeTxPower Advertisement Bool Source # 
HasInterface Advertisement Properties Source # 
HasSolicitUUIDs Advertisement [UUID] Source # 
HasServiceUUIDs Advertisement [UUID] Source # 
HasServiceData Advertisement (Map UUID ByteString) Source # 
HasManufacturerData Advertisement (Map Word16 ByteString) Source # 
HasInterface (WithObjectPath Advertisement) LEAdvertisement Source # 
type Rep Advertisement Source # 
type Rep Advertisement = D1 (MetaData "Advertisement" "Bluetooth.Internal.Types" "ble-0.3.4.0-FK43JGOfOYfLQ1e1O1Vx0V" False) (C1 (MetaCons "Advertisement" PrefixI True) ((:*:) ((:*:) (S1 (MetaSel (Just Symbol "advertisementType_") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 AdvertisementType)) ((:*:) (S1 (MetaSel (Just Symbol "advertisementServiceUUIDs") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [UUID])) (S1 (MetaSel (Just Symbol "advertisementSolicitUUIDs") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [UUID])))) ((:*:) (S1 (MetaSel (Just Symbol "advertisementManufacturerData") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Map Word16 ByteString))) ((:*:) (S1 (MetaSel (Just Symbol "advertisementServiceData") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Map UUID ByteString))) (S1 (MetaSel (Just Symbol "advertisementIncludeTxPower") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Bool))))))
type Item Advertisement Source # 
type RepType Advertisement Source # 

data WithObjectPath a Source #

Instances

Functor WithObjectPath Source # 

Methods

fmap :: (a -> b) -> WithObjectPath a -> WithObjectPath b #

(<$) :: a -> WithObjectPath b -> WithObjectPath a #

Eq a => Eq (WithObjectPath a) Source # 
Show a => Show (WithObjectPath a) Source # 
Generic (WithObjectPath a) Source # 

Associated Types

type Rep (WithObjectPath a) :: * -> * #

Representable (WithObjectPath (Characteristic a)) Source # 
Representable (WithObjectPath Service) Source # 
HasValue (WithObjectPath a0) a0 Source # 

Methods

value :: Lens' (WithObjectPath a0) a0 Source #

HasPath (WithObjectPath a0) ObjectPath Source # 
HasInterface (WithObjectPath CharacteristicBS) GattCharacteristic Source # 
HasInterface (WithObjectPath CharacteristicBS) Properties Source # 
HasInterface (WithObjectPath Service) GattService Source # 
HasInterface (WithObjectPath Service) Properties Source # 
HasInterface (WithObjectPath Advertisement) LEAdvertisement Source # 
type Rep (WithObjectPath a) Source # 
type Rep (WithObjectPath a) = D1 (MetaData "WithObjectPath" "Bluetooth.Internal.Types" "ble-0.3.4.0-FK43JGOfOYfLQ1e1O1Vx0V" False) (C1 (MetaCons "WOP" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "withObjectPathPath") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 ObjectPath)) (S1 (MetaSel (Just Symbol "withObjectPathValue") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 a))))
type RepType (WithObjectPath (Characteristic a)) Source # 
type RepType (WithObjectPath Service) Source # 

Encoding and decoding

Helpers for readValue and writeValue.

Handler

Handler is the monad BLE handlers run in.

data Handler a Source #

Instances

Monad Handler Source # 

Methods

(>>=) :: Handler a -> (a -> Handler b) -> Handler b #

(>>) :: Handler a -> Handler b -> Handler b #

return :: a -> Handler a #

fail :: String -> Handler a #

Functor Handler Source # 

Methods

fmap :: (a -> b) -> Handler a -> Handler b #

(<$) :: a -> Handler b -> Handler a #

Applicative Handler Source # 

Methods

pure :: a -> Handler a #

(<*>) :: Handler (a -> b) -> Handler a -> Handler b #

(*>) :: Handler a -> Handler b -> Handler b #

(<*) :: Handler a -> Handler b -> Handler a #

MonadIO Handler Source # 

Methods

liftIO :: IO a -> Handler a #

MonadError Text Handler Source # 

Methods

throwError :: Text -> Handler a #

catchError :: Handler a -> (Text -> Handler a) -> Handler a #

Generic (Handler a) Source # 

Associated Types

type Rep (Handler a) :: * -> * #

Methods

from :: Handler a -> Rep (Handler a) x #

to :: Rep (Handler a) x -> Handler a #

HasWriteValue (Characteristic typ0) (Maybe (typ0 -> Handler Bool)) Source # 

Methods

writeValue :: Lens' (Characteristic typ0) (Maybe (typ0 -> Handler Bool)) Source #

HasReadValue (Characteristic typ0) (Maybe (Handler typ0)) Source # 

Methods

readValue :: Lens' (Characteristic typ0) (Maybe (Handler typ0)) Source #

type Rep (Handler a) Source # 
type Rep (Handler a) = D1 (MetaData "Handler" "Bluetooth.Internal.Errors" "ble-0.3.4.0-FK43JGOfOYfLQ1e1O1Vx0V" True) (C1 (MetaCons "Handler" PrefixI True) (S1 (MetaSel (Just Symbol "getReadValue") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (ExceptT Text IO a))))

Handler errors

errorFailed :: Handler a Source #

Generic failure

errorInvalidValueLength :: Handler a Source #

Indicates that the argument has invalid length. Should not be used from a read handler

Re-exports

module Lens.Micro