summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authortamasFabian <>2019-06-11 09:41:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-06-11 09:41:00 (GMT)
commit53aa330bcb9c5d8162821487a1000406f0d79965 (patch)
tree325ad3ed4b41c327faedfa730bdc10eaada81edf
version 0.1.0.00.1.0.0
-rw-r--r--LICENSE30
-rw-r--r--README.md15
-rw-r--r--Setup.hs2
-rw-r--r--bglib.cabal48
-rw-r--r--examples/bgapitest.hs146
-rw-r--r--src/BGLib/Commands.hs1027
-rw-r--r--src/BGLib/Types.hs957
7 files changed, 2225 insertions, 0 deletions
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..361e64d
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Tamas Fabian (c) 2018
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Tamas Fabian nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..d53857f
--- /dev/null
+++ b/README.md
@@ -0,0 +1,15 @@
+# haskell-bglib
+
+An implementation of the BGAPI serial protocol.
+
+This protocol is spoken by Silicon Laboratories (formely BlueGiga)
+Bluetooth and Wifi products via UART or USB.
+
+The Bluetooth Smart Software API Reference Manual can be found at:
+
+https://www.silabs.com/products/wireless/bluetooth/bluetooth-low-energy-modules/ble113-bluetooth-smart-module
+
+The library works over a SerialPort, so the hardware need to be
+connected over a standard port that is recognized by the operating
+system.
+
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/bglib.cabal b/bglib.cabal
new file mode 100644
index 0000000..6d1fab6
--- /dev/null
+++ b/bglib.cabal
@@ -0,0 +1,48 @@
+name: bglib
+version: 0.1.0.0
+synopsis: Implementation of the BGAPI serial protocol
+description: This library implements Silicon Labs' (formerly BlueGiga)
+ serial protocol to communicate with certain Bluetooth and
+ Wifi products such as the BLED112 USB dongle or the BLE112
+ and BLE113 Bluetooth Low Energy modules.
+homepage: https://github.com/netom/bgapi#readme
+license: MIT
+license-file: LICENSE
+author: Tamas Fabian
+maintainer: giganetom@gmail.com
+copyright: MIT
+category: library
+build-type: Simple
+extra-source-files: README.md
+cabal-version: >=1.10
+
+library
+ hs-source-dirs: src
+ ghc-options: -Wall
+ exposed-modules: BGLib.Commands
+ , BGLib.Types
+ build-depends: base >= 4.7 && < 5
+ , binary
+ , bytestring
+ , monad-loops
+ , mtl
+ , serialport
+ , stm
+ default-language: Haskell2010
+
+executable bgapitest
+ hs-source-dirs: examples
+ main-is: bgapitest.hs
+ ghc-options: -Wall -threaded
+ build-depends: base >= 4.7 && < 5
+ , bglib
+ , bytestring
+ , mtl
+ , optparse-applicative
+ , serialport
+ , stm
+ default-language: Haskell2010
+
+source-repository head
+ type: git
+ location: https://github.com/netom/haskell-bglib
diff --git a/examples/bgapitest.hs b/examples/bgapitest.hs
new file mode 100644
index 0000000..edc915a
--- /dev/null
+++ b/examples/bgapitest.hs
@@ -0,0 +1,146 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+import BGLib.Commands
+import BGLib.Types
+import Control.Concurrent
+import Control.Concurrent.STM
+import Control.Monad.IO.Class
+import Control.Monad.Reader
+import qualified Data.ByteString.Char8 as BSS
+import Data.Semigroup ((<>))
+import Options.Applicative
+import Prelude hiding (print, putStrLn)
+import qualified Prelude as P
+import System.Exit
+import System.Hardware.Serialport
+
+data AppOptions = AppOptions
+ { appOptSerialPort :: String
+ , appOptDebug :: Bool
+ }
+
+data App = App
+ { appOptions :: AppOptions
+ , appSerialPort :: SerialPort
+ , appBGChan :: TChan BgPacket
+ }
+
+instance HasSerialPort App where
+ getSerialPort = appSerialPort
+
+instance HasBGChan App where
+ getBGChan = appBGChan
+
+instance HasDebug App where
+ getDebug = appOptDebug . appOptions
+
+optParser :: Parser AppOptions
+optParser = AppOptions
+ <$> argument str
+ ( metavar "PORT"
+ <> help "Serial port" )
+ <*> switch
+ ( long "debug"
+ <> short 'd'
+ <> help "Whether to be quiet" )
+
+execApp :: env -> ReaderT env m a -> m a
+execApp = flip runReaderT
+
+putStrLn :: MonadIO m => String -> m ()
+putStrLn = liftIO . P.putStrLn
+
+print :: (MonadIO m, Show a) => a -> m ()
+print = liftIO . P.print
+
+main :: IO ()
+main = do
+ appOpts <- execParser $
+ info
+ ( optParser <**> helper )
+ ( fullDesc
+ <> progDesc "Execute a short battery of test on port PORT"
+ <> header "bgapitest - a short text / example for haskell-bglib"
+ )
+
+ app <- App
+ <$> return appOpts
+ <*> openSerial
+ (appOptSerialPort appOpts)
+ (SerialPortSettings CS115200 8 One NoParity NoFlowControl 1000)
+ <*> atomically newBroadcastTChan
+
+ execApp app $ do
+ -- Register an event handler for protocol errors.
+ _ <- evtSystemProtocolError $ \reason -> do
+ die $ "*** PROTOCOL ERROR " ++ show reason
+
+ -- Starts a thread that keeps reading packets from the serial port,
+ -- pushing them to the broadcast TChan
+ startPacketReader
+
+ putStrLn "Running hello"
+ systemHello
+ putStrLn "If you can read this, we're fine. :)"
+ putStrLn ""
+
+ putStrLn "Getting system information:"
+ (major, minor, patch, build, llVersion, protocolVersion, hw) <- systemGetInfo
+ putStrLn $ "Major version: " ++ show major
+ putStrLn $ "Minor version: " ++ show minor
+ putStrLn $ "Patch version: " ++ show patch
+ putStrLn $ "Build Version: " ++ show build
+ putStrLn $ "Link Layer version: " ++ show llVersion
+ putStrLn $ "Protocol version: " ++ show protocolVersion
+ putStrLn $ "Hardware version: " ++ show hw
+ putStrLn ""
+
+ putStrLn "We should get a \"not connected\" error:"
+ attclientAttributeWrite 0 0 "e" >>= print
+ putStrLn ""
+
+ putStrLn "Getting Bluetooth Address:"
+ systemAddressGet >>= print
+ putStrLn ""
+
+ putStrLn "Running some encryption-decription tests"
+ putStrLn ""
+
+ let aeskey = "abcdefgh12345678"
+ putStrLn $ "Setting AES key to " ++ aeskey
+ systemAesSetkey $ toUInt8Array $ BSS.pack $ aeskey
+ putStrLn ""
+
+ let plaintext = "This is plain"
+ putStrLn $ "Encrypting: " ++ plaintext
+ encrypted <- systemAesEncrypt $ toUInt8Array $ BSS.pack $ plaintext
+ putStrLn $ "Encrypted: " ++ bsShowHex (fromUInt8Array encrypted)
+ putStrLn ""
+
+ putStrLn $ "Decrypting"
+ decrypted <- systemAesDecrypt encrypted
+ putStrLn $ "Decrypted: " ++ BSS.unpack (fromUInt8Array decrypted)
+ putStrLn ""
+
+ -- Register an event handler for scan responses. Can be done anywhere.
+ -- The handler forks a thread that runs forever, and can be terminated
+ -- later if necessary.
+ tid <- evtGapScanResponse $ \rssi _ sender _ _ _ -> do
+ print rssi
+ print sender
+ putStrLn ""
+ return True -- We'd like to listen to further events.
+
+ _ <- gapDiscover GapDiscoverGeneric
+
+ liftIO $ threadDelay 5000000
+
+ _ <- gapEndProcedure
+
+ liftIO $ killThread tid
+
+ -- Let's cause trouble.
+ s <- askSerialPort
+ _ <- liftIO $ send s $ BSS.pack "a"
+ liftIO $ threadDelay 5000000
diff --git a/src/BGLib/Commands.hs b/src/BGLib/Commands.hs
new file mode 100644
index 0000000..64e43ef
--- /dev/null
+++ b/src/BGLib/Commands.hs
@@ -0,0 +1,1027 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module BGLib.Commands
+ ( startPacketReader
+ , attclientAttributeWrite
+ , attclientExecuteWrite
+ , attclientFindByTypeValue
+ , attclientFindInformation
+ , attclientIndicateConfirm
+ , attclientPrepareWrite
+ , attclientReadByGroupType
+ , attclientReadByHandle
+ , attclientReadByType
+ , attclientReadLong
+ , attclientReadMultiple
+ , attclientWriteCommand
+ , evtAttclientAttributeValue
+ , evtAttclientFindInformationFound
+ , evtAttclientGroupFound
+ , evtAttclientIndicated
+ , evtAttclientProcedureCompleted
+ , evtAttclientReadMultipleResponse
+ , attributesRead
+ , attributesReadType
+ , attributesSend
+ , attributesUserReadResponse
+ , attributesUserWriteResponse
+ , attributesWrite
+ , evtAttributesStatus
+ , evtAttributesUserReadRequest
+ , evtAttributesValue
+ , connectionChannelMapGet
+ , connectionChannelMapSet
+ , connectionDisconnect
+ , connectionGetRssi
+ , connectionGetStatus
+ , connectionSlaveLatencyDisable
+ , connectionUpdate
+ , connectionVersionUpdate
+ , evtConnectionDisconnected
+ , evtConnectionFeatureInd
+ , evtConnectionStatus
+ , evtConnectionVersionInd
+ , gapConnectDirect
+ , gapConnectSelective
+ , gapDiscover
+ , gapEndProcedure
+ , gapSetAdvData
+ , gapSetAdvParameters
+ , gapSetDirectedConnectableMode
+ , gapSetFiltering
+ , gapSetInitiatingConParameters
+ , gapSetMode
+ , gapSetNonresolvableAddress
+ , gapSetPrivacyFlags
+ , gapSetScanParameters
+ , evtGapScanResponse
+ , hardwareAdcRead
+ , hardwareAnalogComparatorConfigIrq
+ , hardwareAnalogComparatorEnable
+ , hardwareAnalogComparatorRead
+ , hardwareGetTimestamp
+ , hardwareI2cRead
+ , hardwareI2cWrite
+ , hardwareIoPortConfigDirection
+ , hardwareIoPortConfigFunction
+ , hardwareIoPortConfigIrq
+ , hardwareIoPortConfigPull
+ , hardwareIoPortIrqDirection
+ , hardwareIoPortIrqEnable
+ , hardwareIoPortRead
+ , hardwareIoPortWrite
+ , hardwareSetRxgain
+ , hardwareSetSoftTimer
+ , hardwareSetTxpower
+ , hardwareSleepEnable
+ , hardwareSpiConfig
+ , hardwareSpiTransfer
+ , hardwareTimerComparator
+ , hardwareUsbEnable
+ , evtHardwareAdcResult
+ , evtHardwareAnalogComparatorStatus
+ , evtHardwareIoPortStatus
+ , evtHardwareSoftTimer
+ , flashErasePage
+ , flashPsDefrag
+ , flashPsDump
+ , flashPsEraseAll
+ , flashPsErase
+ , flashPsLoad
+ , flashPsSave
+ , flashReadData
+ , flashWriteData
+ , evtFlashPsKey
+ , smDeleteBonding
+ , smEncryptStart
+ , smGetBonds
+ , smPasskeyEntry
+ , setBondableMode
+ , smSetOobData
+ , smSetPairingDistributionKeys
+ , smSetParameters
+ , smWhitelistBonds
+ , evtSmBondingFail
+ , evtSmBondStatus
+ , evtSmPasskeyDisplay
+ , evtSmPasskeyRequest
+ , systemAddressGet
+ , systemAesDecrypt
+ , systemAesEncrypt
+ , systemAesSetkey
+ , systemDelayReset
+ , systemEndpointRx
+ , systemEndpointSetWatermarks
+ , systemEndpointTx
+ , systemGetBootloaderCrc
+ , systemGetConnections
+ , systemGetCounters
+ , systemGetInfo
+ , systemHello
+ , systemReset
+ , systemUsbEnumerationStatusGet
+ , systemWhitelistAppend
+ , systemWhitelistClear
+ , systemWhitelistRemove
+ , evtSystemBoot
+ , evtSystemEndpointWatermarkRx
+ , evtSystemEndpointWatermarkTx
+ , evtSystemNoLicenseKey
+ , evtSystemProtocolError
+ , evtSystemScriptFailure
+ , evtSystemUsbEnumerated
+ , testChannelMode
+ , testGetChannelMap
+ , testPhyEnd
+ , testPhyRx
+ , testPhyTx
+ , dfuFlashSetAddress
+ , dfuFlashUpload
+ , dfuFlashUploadFinish
+ , dfuReset
+ , evtDfuBoot
+ ) where
+
+import BGLib.Types
+import Control.Concurrent
+import Control.Concurrent.STM.TChan
+import Control.Monad.Loops
+import Control.Monad.STM
+import Data.Binary
+import qualified Data.ByteString.Lazy as BSL
+import qualified Data.ByteString as BSS
+import System.Hardware.Serialport
+import Control.Monad.IO.Class
+import Control.Monad.Reader
+
+-- Write a BgPacket to a SerialPort
+writeBGPacket' :: Bool -> SerialPort -> BgPacket -> IO ()
+writeBGPacket' dbg s p = do
+ let packetBS = BSL.toStrict $ encode p
+ when dbg $ do
+ putStr "[DEBUG] WRITE: "
+ putStrLn $ show p
+ _ <- send s packetBS
+ return ()
+
+-- Write the BgPacket to the SerialPort in env asked from the MonadReader
+writeBGPacket :: (MonadIO m, MonadReader env m, HasSerialPort env, HasDebug env) => BgPacket -> m ()
+writeBGPacket p = do
+ s <- askSerialPort
+ dbg <- askDebug
+ liftIO $ writeBGPacket' dbg s p
+
+-- Read one BgPacket from a SerialPort
+readBGPacket' :: Bool -> SerialPort -> IO BgPacket
+readBGPacket' dbg s = do
+ bgpHeader@BgPacketHeader{..} <- decode <$> BSL.fromStrict <$> recv s 4
+ bgpPayload <- toBgPayload <$> recv s (fromIntegral bghLength)
+ let p = BgPacket {..}
+ when dbg $ do
+ putStr "[DEBUG] READ: "
+ putStrLn $ show p
+ return p
+
+-- Read one BgPacket from the SerialPort in env asked from the MonadReader
+--readBGPacket :: (MonadIO m, MonadReader env m, HasSerialPort env) => m BgPacket
+--readBGPacket = do
+-- s <- askSerialPort
+-- liftIO $ readBGPacket' s
+
+-- Launch a thread that reads packets and sends them down a TChan BgPacket
+startPacketReader :: (MonadIO m, MonadReader env m, HasBGChan env, HasSerialPort env, HasDebug env) => m ()
+startPacketReader = do
+ c <- askBGChan
+ s <- askSerialPort
+ dbg <- askDebug
+ _ <- liftIO $ forkIO $ forever $ do
+ --putStrLn "* READ *"
+ readBGPacket' dbg s >>= atomically . writeTChan c
+ return ()
+
+-- Waits for any BgPacket to appear on the TChan
+waitForAnyPacket :: TChan BgPacket -> IO BgPacket
+waitForAnyPacket chan = do
+ liftIO $ atomically $ readTChan chan
+
+-- Wait for a packet with specific values in it's header
+waitForPacket :: TChan BgPacket -> BgMessageType -> BgTecnologyType -> BgCommandClass -> UInt8 -> IO BgPacket
+waitForPacket chan mt tt cc cid = do
+ untilJust $ do
+ p@BgPacket{..} <- waitForAnyPacket chan
+ return $ if bgHeaderMatches mt tt cc cid bgpHeader then Just p else Nothing
+
+-- eXecute a Command, don't wait for any answer
+xCmd' :: (MonadIO m, MonadReader env m, HasSerialPort env, HasDebug env, Binary a ) => BgMessageType -> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m ()
+xCmd' mt tt cc cid inp = do
+ let inpBS = BSL.toStrict $ encode inp
+ writeBGPacket $ BgPacket (BgPacketHeader mt tt (fromIntegral $ BSS.length inpBS) cc cid) (toBgPayload inpBS)
+
+-- Execute a command, wait for the appropriate answer
+xCmd :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env, Binary a, Binary b) => BgMessageType -> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
+xCmd mt tt cc cid inp = do
+ -- We need to duplicate the channel BEFORE sending the command, so we don't miss the answer by accident
+ chan <- askDupBGChan
+ xCmd' mt tt cc cid inp
+ decode . BSL.fromStrict . fromBgPayload . bgpPayload <$> ( liftIO $ waitForPacket chan mt tt cc cid )
+
+registerEventHandler :: Binary a => (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env) => BgMessageType -> BgTecnologyType -> BgCommandClass -> UInt8 -> (a -> IO Bool) -> m ThreadId
+registerEventHandler mt tt cc cid handler = do
+ chan <- askDupBGChan
+ liftIO $ forkIO $ go chan
+ where
+ go chan = do
+ BgPacket{..} <- waitForPacket chan mt tt cc cid
+ continue <- handler $ decode $ BSL.fromStrict $ fromBgPayload $ bgpPayload
+ if continue then go chan else return ()
+
+curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d
+curry3 func a b c = func (a, b, c)
+
+uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
+uncurry3 func (a, b, c) = func a b c
+
+curry4 :: ((a, b, c, d) -> e) -> a -> b -> c -> d -> e
+curry4 func a b c d = func (a, b, c, d)
+
+uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
+uncurry4 func (a, b, c, d) = func a b c d
+
+curry5 :: ((a, b, c, d, e) -> f) -> a -> b -> c -> d -> e -> f
+curry5 func a b c d e = func (a, b, c, d, e)
+
+uncurry5 :: (a -> b -> c -> d -> e -> f) -> (a, b, c, d, e) -> f
+uncurry5 func (a, b, c, d, e) = func a b c d e
+
+curry6 :: ((a, b, c, d, e, f) -> g) -> a -> b -> c -> d -> e -> f -> g
+curry6 func a b c d e f = func (a, b, c, d, e, f)
+
+uncurry6 :: (a -> b -> c -> d -> e -> f -> g) -> (a, b, c, d, e, f) -> g
+uncurry6 func (a, b, c, d, e, f) = func a b c d e f
+
+uncurry7 :: (a -> b -> c -> d -> e -> f -> g -> h) -> (a, b, c, d, e, f, g) -> h
+uncurry7 func (a, b, c, d, e, f, g) = func a b c d e f g
+
+uncurry8 :: (a -> b -> c -> d -> e -> f -> g -> h -> i) -> (a, b, c, d, e, f, g, h) -> i
+uncurry8 func (a, b, c, d, e, f, g, h) = func a b c d e f g h
+
+-----------------------------------------------------------------------
+-- Attribute Client
+-----------------------------------------------------------------------
+--gapDiscover mode = xCmd BgMsgCR BgBlue BgClsGenericAccessProfile 0x02 mode
+
+
+attclientAttributeWrite
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt16 -> UInt8Array -> m (UInt8, BGResult)
+attclientAttributeWrite = curry3 $ xCmd BgMsgCR BgBlue BgClsAttributeClient 0x05
+
+attclientExecuteWrite
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> Bool -> m (UInt8, BGResult)
+attclientExecuteWrite = curry $ xCmd BgMsgCR BgBlue BgClsAttributeClient 0x0a
+
+attclientFindByTypeValue
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt16 -> UInt16 -> UInt16 -> UInt8Array -> m (UInt8, BGResult)
+attclientFindByTypeValue = curry5 $ xCmd BgMsgCR BgBlue BgClsAttributeClient 0x00
+
+attclientFindInformation
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt16 -> UInt16 -> m (UInt8, BGResult)
+attclientFindInformation = curry3 $ xCmd BgMsgCR BgBlue BgClsAttributeClient 0x03
+
+attclientIndicateConfirm
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> m BGResult
+attclientIndicateConfirm = xCmd BgMsgCR BgBlue BgClsAttributeClient 0x07
+
+attclientPrepareWrite
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt16 -> UInt16 -> UInt8Array -> m (UInt8, BGResult)
+attclientPrepareWrite = curry4 $ xCmd BgMsgCR BgBlue BgClsAttributeClient 0x09
+
+attclientReadByGroupType
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt16 -> UInt16 -> UInt8Array -> m (UInt8, BGResult)
+attclientReadByGroupType = curry4 $ xCmd BgMsgCR BgBlue BgClsAttributeClient 0x01
+
+attclientReadByHandle
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt16 -> m (UInt8, BGResult)
+attclientReadByHandle = curry $ xCmd BgMsgCR BgBlue BgClsAttributeClient 0x04
+
+attclientReadByType
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt16 -> UInt16 -> UInt8Array -> m (UInt8, BGResult)
+attclientReadByType = curry4 $ xCmd BgMsgCR BgBlue BgClsAttributeClient 0x02
+
+attclientReadLong
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt16 -> m (UInt8, BGResult)
+attclientReadLong = curry $ xCmd BgMsgCR BgBlue BgClsAttributeClient 0x08
+
+attclientReadMultiple
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt8Array -> m (UInt8, BGResult)
+attclientReadMultiple = curry $ xCmd BgMsgCR BgBlue BgClsAttributeClient 0x0b
+
+attclientWriteCommand
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt16 -> UInt8Array -> m (UInt8, BGResult)
+attclientWriteCommand = curry3 $ xCmd BgMsgCR BgBlue BgClsAttributeClient 0x06
+
+evtAttclientAttributeValue
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (UInt8 -> UInt16 -> UInt8 -> UInt8Array -> IO Bool) -> m ThreadId
+evtAttclientAttributeValue
+ = registerEventHandler BgMsgEvent BgBlue BgClsAttributeClient 0x05 . uncurry4
+
+evtAttclientFindInformationFound
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (UInt8 -> UInt16 -> UInt8Array -> IO Bool) -> m ThreadId
+evtAttclientFindInformationFound
+ = registerEventHandler BgMsgEvent BgBlue BgClsAttributeClient 0x04 . uncurry3
+
+evtAttclientGroupFound
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (UInt8 -> UInt16 -> UInt16 -> UInt8Array -> IO Bool) -> m ThreadId
+evtAttclientGroupFound
+ = registerEventHandler BgMsgEvent BgBlue BgClsAttributeClient 0x02 . uncurry4
+
+evtAttclientIndicated
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (UInt8 -> UInt16 -> IO Bool) -> m ThreadId
+evtAttclientIndicated
+ = registerEventHandler BgMsgEvent BgBlue BgClsAttributeClient 0x00 . uncurry
+
+evtAttclientProcedureCompleted
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (UInt8 -> BGResult -> UInt16 -> IO Bool) -> m ThreadId
+evtAttclientProcedureCompleted
+ = registerEventHandler BgMsgEvent BgBlue BgClsAttributeClient 0x01 . uncurry3
+
+evtAttclientReadMultipleResponse
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (UInt8 -> UInt8Array -> IO Bool) -> m ThreadId
+evtAttclientReadMultipleResponse
+ = registerEventHandler BgMsgEvent BgBlue BgClsAttributeClient 0x06 . uncurry
+
+-----------------------------------------------------------------------
+-- Attribute Database
+-----------------------------------------------------------------------
+
+attributesRead
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt16 -> UInt16 -> m (UInt16, UInt16, BGResult, UInt8Array)
+attributesRead = curry $ xCmd BgMsgCR BgBlue BgClsAttributeDatabase 0x01
+
+attributesReadType
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt16 -> m (UInt16, BGResult, UInt8Array)
+attributesReadType = xCmd BgMsgCR BgBlue BgClsAttributeDatabase 0x02
+
+attributesSend
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt16 -> UInt8Array -> m BGResult
+attributesSend = curry3 $ xCmd BgMsgCR BgBlue BgClsAttributeDatabase 0x05
+
+attributesUserReadResponse
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt8 -> UInt8Array -> m ()
+attributesUserReadResponse = curry3 $ xCmd BgMsgCR BgBlue BgClsAttributeDatabase 0x03
+
+attributesUserWriteResponse
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt8 -> m ()
+attributesUserWriteResponse = curry $ xCmd BgMsgCR BgBlue BgClsAttributeDatabase 0x04
+
+attributesWrite
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt16 -> UInt8 -> UInt8Array -> m BGResult
+attributesWrite = curry3 $ xCmd BgMsgCR BgBlue BgClsAttributeDatabase 0x00
+
+evtAttributesStatus
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (UInt16 -> UInt8 -> IO Bool) -> m ThreadId
+evtAttributesStatus
+ = registerEventHandler BgMsgEvent BgBlue BgClsAttributeDatabase 0x02 . uncurry
+
+evtAttributesUserReadRequest
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (UInt8 -> UInt16 -> UInt16 -> UInt8 -> IO Bool) -> m ThreadId
+evtAttributesUserReadRequest
+ = registerEventHandler BgMsgEvent BgBlue BgClsAttributeDatabase 0x01 . uncurry4
+
+evtAttributesValue
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (UInt8 -> UInt8 -> UInt16 -> UInt16 -> UInt8Array -> IO Bool) -> m ThreadId
+evtAttributesValue
+ = registerEventHandler BgMsgEvent BgBlue BgClsAttributeDatabase 0x00 . uncurry5
+
+-----------------------------------------------------------------------
+-- Connection
+-----------------------------------------------------------------------
+
+connectionChannelMapGet
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> m (UInt8, UInt8Array)
+connectionChannelMapGet = xCmd BgMsgCR BgBlue BgClsConnection 0x04
+
+connectionChannelMapSet
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt8Array -> m (UInt8, BGResult)
+connectionChannelMapSet = curry $ xCmd BgMsgCR BgBlue BgClsConnection 0x05
+
+connectionDisconnect
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> m (UInt8, BGResult)
+connectionDisconnect = xCmd BgMsgCR BgBlue BgClsConnection 0x00
+
+connectionGetRssi
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> m (UInt8, Int8)
+connectionGetRssi = xCmd BgMsgCR BgBlue BgClsConnection 0x01
+
+connectionGetStatus
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> m UInt8
+connectionGetStatus = xCmd BgMsgCR BgBlue BgClsConnection 0x07
+
+connectionSlaveLatencyDisable
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> m BGResult
+connectionSlaveLatencyDisable = xCmd BgMsgCR BgBlue BgClsConnection 0x09
+
+connectionUpdate
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt16 -> UInt16 -> UInt16 -> UInt16 -> m (UInt8, BGResult)
+connectionUpdate = curry5 $ xCmd BgMsgCR BgBlue BgClsConnection 0x02
+
+connectionVersionUpdate
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> m (UInt8, BGResult)
+connectionVersionUpdate = xCmd BgMsgCR BgBlue BgClsConnection 0x03
+
+evtConnectionDisconnected
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (UInt8 -> BGResult -> IO Bool) -> m ThreadId
+evtConnectionDisconnected
+ = registerEventHandler BgMsgEvent BgBlue BgClsConnection 0x04 . uncurry
+
+evtConnectionFeatureInd
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (UInt8 -> UInt8Array -> IO Bool) -> m ThreadId
+evtConnectionFeatureInd = registerEventHandler BgMsgEvent BgBlue BgClsConnection 0x02 . uncurry
+
+evtConnectionStatus
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (UInt8 -> UInt8 -> BdAddr -> UInt8 -> UInt16 -> UInt16 -> UInt16 -> UInt8 -> IO Bool)
+ -> m ThreadId
+evtConnectionStatus = registerEventHandler BgMsgEvent BgBlue BgClsConnection 0x00 . uncurry8
+
+evtConnectionVersionInd
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (UInt8 -> UInt8 -> UInt16 -> UInt16 -> IO Bool) -> m ThreadId
+evtConnectionVersionInd = registerEventHandler BgMsgEvent BgBlue BgClsConnection 0x01 . uncurry4
+
+-----------------------------------------------------------------------
+-- Generic Access Profile
+-----------------------------------------------------------------------
+
+gapConnectDirect
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => BdAddr -> GapAddressType -> UInt16 -> UInt16 -> UInt16 -> UInt16 -> m (BGResult, UInt8)
+gapConnectDirect = curry6 $ xCmd BgMsgCR BgBlue BgClsGenericAccessProfile 0x03
+
+gapConnectSelective
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt16 -> UInt16 -> UInt16 -> UInt16 -> m (BGResult, UInt8)
+gapConnectSelective = curry4 $ xCmd BgMsgCR BgBlue BgClsGenericAccessProfile 0x05
+
+gapDiscover
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => GapDiscoverMode -> m UInt16
+gapDiscover = xCmd BgMsgCR BgBlue BgClsGenericAccessProfile 0x02
+
+gapEndProcedure
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => m UInt16
+gapEndProcedure = xCmd BgMsgCR BgBlue BgClsGenericAccessProfile 0x04 ()
+
+gapSetAdvData
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt8Array -> m BGResult
+gapSetAdvData = curry $ xCmd BgMsgCR BgBlue BgClsGenericAccessProfile 0x09
+
+gapSetAdvParameters
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt16 -> UInt16 -> UInt8 -> m BGResult
+gapSetAdvParameters = curry3 $ xCmd BgMsgCR BgBlue BgClsGenericAccessProfile 0x08
+
+gapSetDirectedConnectableMode
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => BdAddr -> GapAddressType -> m BGResult
+gapSetDirectedConnectableMode = curry $ xCmd BgMsgCR BgBlue BgClsGenericAccessProfile 0x0a
+
+gapSetFiltering
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => GapScanPolicy -> GapAdvPolicy -> UInt8 -> m BGResult
+gapSetFiltering = curry3 $ xCmd BgMsgCR BgBlue BgClsGenericAccessProfile 0x06
+
+gapSetInitiatingConParameters
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt16 -> UInt16 -> m BGResult
+gapSetInitiatingConParameters = curry $ xCmd BgMsgCR BgBlue BgClsGenericAccessProfile 0x0b
+
+gapSetMode
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => GapDiscoverableMode -> GapConnectableMode -> m BGResult
+gapSetMode = curry $ xCmd BgMsgCR BgBlue BgClsGenericAccessProfile 0x01
+
+gapSetNonresolvableAddress
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => BdAddr -> m BGResult
+gapSetNonresolvableAddress = xCmd BgMsgCR BgBlue BgClsGenericAccessProfile 0x0c
+
+gapSetPrivacyFlags
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt8 -> m ()
+gapSetPrivacyFlags = curry $ xCmd BgMsgCR BgBlue BgClsGenericAccessProfile 0x00
+
+gapSetScanParameters
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt16 -> UInt16 -> UInt8 -> m BGResult
+gapSetScanParameters = curry3 $ xCmd BgMsgCR BgBlue BgClsGenericAccessProfile 0x07
+
+-- Register an event handler for GAP scan responses
+evtGapScanResponse
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (Int8 -> UInt8 -> BdAddr -> UInt8 -> UInt8 -> UInt8Array -> IO Bool) -> m ThreadId
+evtGapScanResponse
+ = registerEventHandler BgMsgEvent BgBlue BgClsGenericAccessProfile 0x00 . uncurry6
+
+-----------------------------------------------------------------------
+-- Hardware
+-----------------------------------------------------------------------
+
+hardwareAdcRead
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt8 -> UInt8 -> m BGResult
+hardwareAdcRead = curry3 $ xCmd BgMsgCR BgBlue BgClsHardware 0x02
+
+hardwareAnalogComparatorConfigIrq
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => Bool -> m BGResult
+hardwareAnalogComparatorConfigIrq = xCmd BgMsgCR BgBlue BgClsHardware 0x12
+
+hardwareAnalogComparatorEnable
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => Bool -> m ()
+hardwareAnalogComparatorEnable = xCmd BgMsgCR BgBlue BgClsHardware 0x10
+
+hardwareAnalogComparatorRead
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => m (BGResult, UInt8)
+hardwareAnalogComparatorRead = xCmd BgMsgCR BgBlue BgClsHardware 0x11 ()
+
+hardwareGetTimestamp
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => m UInt32
+hardwareGetTimestamp = xCmd BgMsgCR BgBlue BgClsHardware 0x16 ()
+
+hardwareI2cRead
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> Bool -> UInt8 -> m (UInt16, UInt8Array)
+hardwareI2cRead = curry3 $ xCmd BgMsgCR BgBlue BgClsHardware 0x0a
+
+hardwareI2cWrite
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> Bool -> UInt8Array -> m UInt8
+hardwareI2cWrite = curry3 $ xCmd BgMsgCR BgBlue BgClsHardware 0x0b
+
+hardwareIoPortConfigDirection
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt8 -> m BGResult
+hardwareIoPortConfigDirection = curry $ xCmd BgMsgCR BgBlue BgClsHardware 0x03
+
+hardwareIoPortConfigFunction
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt8 -> m BGResult
+hardwareIoPortConfigFunction = curry $ xCmd BgMsgCR BgBlue BgClsHardware 0x04
+
+hardwareIoPortConfigIrq
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt8 -> Bool -> m BGResult
+hardwareIoPortConfigIrq = curry3 $ xCmd BgMsgCR BgBlue BgClsHardware 0x00
+
+hardwareIoPortConfigPull
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt8 -> Bool -> m BGResult
+hardwareIoPortConfigPull = curry3 $ xCmd BgMsgCR BgBlue BgClsHardware 0x05
+
+hardwareIoPortIrqDirection
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> Bool -> m BGResult
+hardwareIoPortIrqDirection = curry $ xCmd BgMsgCR BgBlue BgClsHardware 0x0f
+
+hardwareIoPortIrqEnable
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt8 -> m BGResult
+hardwareIoPortIrqEnable = curry $ xCmd BgMsgCR BgBlue BgClsHardware 0x0e
+
+hardwareIoPortRead
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt8 -> m (BGResult, UInt8, UInt8)
+hardwareIoPortRead = curry $ xCmd BgMsgCR BgBlue BgClsHardware 0x07
+
+hardwareIoPortWrite
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt8 -> UInt8 -> m BGResult
+hardwareIoPortWrite = curry3 $ xCmd BgMsgCR BgBlue BgClsHardware 0x06
+
+hardwareSetRxgain
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> m ()
+hardwareSetRxgain = xCmd BgMsgCR BgBlue BgClsHardware 0x13
+
+hardwareSetSoftTimer
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt32 -> UInt8 -> Bool -> m BGResult
+hardwareSetSoftTimer = curry3 $ xCmd BgMsgCR BgBlue BgClsHardware 0x01
+
+hardwareSetTxpower
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> m ()
+hardwareSetTxpower = xCmd BgMsgCR BgBlue BgClsHardware 0x0c
+
+hardwareSleepEnable
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => Bool -> m BGResult
+hardwareSleepEnable = xCmd BgMsgCR BgBlue BgClsHardware 0x15
+
+hardwareSpiConfig
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => Bool -> Bool -> Bool -> Bool -> UInt8 -> UInt8 -> m BGResult
+hardwareSpiConfig = curry6 $ xCmd BgMsgCR BgBlue BgClsHardware 0x08
+
+hardwareSpiTransfer
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt8Array -> m (BGResult, UInt8, UInt8Array)
+hardwareSpiTransfer = curry $ xCmd BgMsgCR BgBlue BgClsHardware 0x09
+
+hardwareTimerComparator
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt8 -> UInt8 -> UInt16 -> m BGResult
+hardwareTimerComparator = curry4 $ xCmd BgMsgCR BgBlue BgClsHardware 0x0d
+
+hardwareUsbEnable
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => Bool -> m BGResult
+hardwareUsbEnable = xCmd BgMsgCR BgBlue BgClsHardware 0x14
+
+evtHardwareAdcResult
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (UInt8 -> UInt16 -> IO Bool) -> m ThreadId
+evtHardwareAdcResult
+ = registerEventHandler BgMsgEvent BgBlue BgClsHardware 0x02 . uncurry
+
+evtHardwareAnalogComparatorStatus
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (UInt32 -> UInt8 -> IO Bool) -> m ThreadId
+evtHardwareAnalogComparatorStatus
+ = registerEventHandler BgMsgEvent BgBlue BgClsHardware 0x03 . uncurry
+
+evtHardwareIoPortStatus
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (UInt32 -> UInt8 -> UInt8 -> UInt8 -> IO Bool) -> m ThreadId
+evtHardwareIoPortStatus
+ = registerEventHandler BgMsgEvent BgBlue BgClsHardware 0x00 . uncurry4
+
+evtHardwareSoftTimer
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (UInt8 -> IO Bool) -> m ThreadId
+evtHardwareSoftTimer
+ = registerEventHandler BgMsgEvent BgBlue BgClsHardware 0x01
+
+-----------------------------------------------------------------------
+-- Persistent Store
+-----------------------------------------------------------------------
+
+flashErasePage
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> m BGResult
+flashErasePage = xCmd BgMsgCR BgBlue BgClsPersistentStore 0x06
+
+flashPsDefrag
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => m ()
+flashPsDefrag = xCmd BgMsgCR BgBlue BgClsPersistentStore 0x00 ()
+
+flashPsDump
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => m ()
+flashPsDump = xCmd BgMsgCR BgBlue BgClsPersistentStore 0x01 ()
+
+flashPsEraseAll
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => m ()
+flashPsEraseAll = xCmd BgMsgCR BgBlue BgClsPersistentStore 0x02 ()
+
+flashPsErase
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt16 -> m ()
+flashPsErase = xCmd BgMsgCR BgBlue BgClsPersistentStore 0x05
+
+flashPsLoad
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt16 -> m (BGResult, UInt8Array)
+flashPsLoad = xCmd BgMsgCR BgBlue BgClsPersistentStore 0x04
+
+flashPsSave
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt16 -> UInt8Array -> m BGResult
+flashPsSave = curry $ xCmd BgMsgCR BgBlue BgClsPersistentStore 0x03
+
+flashReadData
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt32 -> UInt8 -> m UInt8Array
+flashReadData = curry $ xCmd BgMsgCR BgBlue BgClsPersistentStore 0x08
+
+flashWriteData
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt32 -> UInt8Array -> m BGResult
+flashWriteData = curry $ xCmd BgMsgCR BgBlue BgClsPersistentStore 0x07
+
+evtFlashPsKey
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (UInt16 -> UInt8Array -> IO Bool) -> m ThreadId
+evtFlashPsKey
+ = registerEventHandler BgMsgEvent BgBlue BgClsPersistentStore 0x00 . uncurry
+
+-----------------------------------------------------------------------
+-- Security Manager
+-----------------------------------------------------------------------
+
+smDeleteBonding
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> m BGResult
+smDeleteBonding = xCmd BgMsgCR BgBlue BgClsSecurityManager 0x02
+
+smEncryptStart
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> Bool -> m (UInt8, BGResult)
+smEncryptStart = curry $ xCmd BgMsgCR BgBlue BgClsSecurityManager 0x00
+
+smGetBonds
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => m UInt8
+smGetBonds = xCmd BgMsgCR BgBlue BgClsSecurityManager 0x05 ()
+
+smPasskeyEntry
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt32 -> m BGResult
+smPasskeyEntry = curry $ xCmd BgMsgCR BgBlue BgClsSecurityManager 0x04
+
+setBondableMode
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => Bool -> m ()
+setBondableMode = xCmd BgMsgCR BgBlue BgClsSecurityManager 0x01
+
+smSetOobData
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8Array -> m ()
+smSetOobData = xCmd BgMsgCR BgBlue BgClsSecurityManager 0x06
+
+smSetPairingDistributionKeys
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt8 -> m BGResult
+smSetPairingDistributionKeys = curry $ xCmd BgMsgCR BgBlue BgClsSecurityManager 0x08
+
+smSetParameters
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => Bool -> UInt8 -> SMIOCapabilities -> m ()
+smSetParameters = curry3 $ xCmd BgMsgCR BgBlue BgClsSecurityManager 0x03
+
+smWhitelistBonds
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => m (BGResult, UInt8)
+smWhitelistBonds = xCmd BgMsgCR BgBlue BgClsSecurityManager 0x07 ()
+
+evtSmBondingFail
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (UInt8 -> BGResult -> IO Bool) -> m ThreadId
+evtSmBondingFail
+ = registerEventHandler BgMsgEvent BgBlue BgClsSecurityManager 0x01 . uncurry
+
+evtSmBondStatus
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (UInt8 -> UInt8 -> Bool -> UInt8 -> IO Bool) -> m ThreadId
+evtSmBondStatus
+ = registerEventHandler BgMsgEvent BgBlue BgClsSecurityManager 0x04 . uncurry4
+
+evtSmPasskeyDisplay
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (UInt8 -> UInt32 -> IO Bool) -> m ThreadId
+evtSmPasskeyDisplay
+ = registerEventHandler BgMsgEvent BgBlue BgClsSecurityManager 0x02 . uncurry
+
+evtSmPasskeyRequest
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (UInt8 -> IO Bool) -> m ThreadId
+evtSmPasskeyRequest
+ = registerEventHandler BgMsgEvent BgBlue BgClsSecurityManager 0x03
+
+-----------------------------------------------------------------------
+-- System
+-----------------------------------------------------------------------
+
+systemAddressGet
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => m BdAddr
+systemAddressGet = xCmd BgMsgCR BgBlue BgClsSystem 0x02 ()
+
+systemAesDecrypt
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8Array -> m UInt8Array
+systemAesDecrypt = xCmd BgMsgCR BgBlue BgClsSystem 0x11
+
+systemAesEncrypt
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8Array -> m UInt8Array
+systemAesEncrypt = xCmd BgMsgCR BgBlue BgClsSystem 0x10
+
+systemAesSetkey
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8Array -> m ()
+systemAesSetkey = xCmd BgMsgCR BgBlue BgClsSystem 0x0f
+
+systemDelayReset
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => RebootMode -> UInt16 -> m ()
+systemDelayReset = curry $ xCmd' BgMsgCR BgBlue BgClsSystem 0x14
+
+systemEndpointRx
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt8 -> m (BGResult, UInt8Array)
+systemEndpointRx = curry $ xCmd BgMsgCR BgBlue BgClsSystem 0x0d
+
+systemEndpointSetWatermarks
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt8 -> UInt8 -> m BGResult
+systemEndpointSetWatermarks = curry3 $ xCmd BgMsgCR BgBlue BgClsSystem 0x0e
+
+systemEndpointTx
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt8Array -> m BGResult
+systemEndpointTx = curry $ xCmd BgMsgCR BgBlue BgClsSystem 0x09
+
+systemGetBootloaderCrc
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => m UInt16
+systemGetBootloaderCrc = xCmd BgMsgCR BgBlue BgClsSystem 0x13 ()
+
+systemGetConnections
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => m UInt8
+systemGetConnections = xCmd BgMsgCR BgBlue BgClsSystem 0x06 ()
+
+systemGetCounters
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => m (UInt8, UInt8, UInt8, UInt8, UInt8)
+systemGetCounters = xCmd BgMsgCR BgBlue BgClsSystem 0x05 ()
+
+systemGetInfo
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => m (UInt16, UInt16, UInt16, UInt16, UInt16, UInt8, UInt8)
+systemGetInfo = xCmd BgMsgCR BgBlue BgClsSystem 0x08 ()
+
+systemHello
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => m ()
+systemHello = xCmd BgMsgCR BgBlue BgClsSystem 0x01 ()
+
+systemReset
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasDebug env)
+ => RebootMode -> m ()
+systemReset = xCmd' BgMsgCR BgBlue BgClsSystem 0x01
+
+systemUsbEnumerationStatusGet
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => m (BGResult, Bool)
+systemUsbEnumerationStatusGet = xCmd BgMsgCR BgBlue BgClsSystem 0x12 ()
+
+systemWhitelistAppend
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => BdAddr -> GapAddressType -> m BGResult
+systemWhitelistAppend = curry $ xCmd BgMsgCR BgBlue BgClsSystem 0x0a
+
+systemWhitelistClear
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => m ()
+systemWhitelistClear = xCmd BgMsgCR BgBlue BgClsSystem 0x0c ()
+
+systemWhitelistRemove
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => BdAddr -> GapAddressType -> m BGResult
+systemWhitelistRemove = curry $ xCmd BgMsgCR BgBlue BgClsSystem 0x0b
+
+evtSystemBoot
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (UInt16 -> UInt16 -> UInt16 -> UInt16 -> UInt16 -> UInt8 -> UInt8 -> IO Bool) -> m ThreadId
+evtSystemBoot
+ = registerEventHandler BgMsgEvent BgBlue BgClsSystem 0x00 . uncurry7
+
+evtSystemEndpointWatermarkRx
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (UInt8 -> UInt8 -> IO Bool) -> m ThreadId
+evtSystemEndpointWatermarkRx
+ = registerEventHandler BgMsgEvent BgBlue BgClsSystem 0x02 . uncurry
+
+evtSystemEndpointWatermarkTx
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (UInt8 -> UInt8 -> IO Bool) -> m ThreadId
+evtSystemEndpointWatermarkTx
+ = registerEventHandler BgMsgEvent BgBlue BgClsSystem 0x03 . uncurry
+
+evtSystemNoLicenseKey
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (() -> IO Bool) -> m ThreadId
+evtSystemNoLicenseKey
+ = registerEventHandler BgMsgEvent BgBlue BgClsSystem 0x05
+
+evtSystemProtocolError
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (BGResult -> IO Bool) -> m ThreadId
+evtSystemProtocolError
+ = registerEventHandler BgMsgEvent BgBlue BgClsSystem 0x06
+
+evtSystemScriptFailure
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (UInt16 -> BGResult -> IO Bool) -> m ThreadId
+evtSystemScriptFailure
+ = registerEventHandler BgMsgEvent BgBlue BgClsSystem 0x04 . uncurry
+
+evtSystemUsbEnumerated
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (Bool -> IO Bool) -> m ThreadId
+evtSystemUsbEnumerated
+ = registerEventHandler BgMsgEvent BgBlue BgClsSystem 0x07
+
+-----------------------------------------------------------------------
+-- Testing
+-----------------------------------------------------------------------
+
+testChannelMode
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> m ()
+testChannelMode = xCmd BgMsgCR BgBlue BgClsTest 0x06
+
+testGetChannelMap
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => m UInt8Array
+testGetChannelMap = xCmd BgMsgCR BgBlue BgClsTest 0x04 ()
+
+testPhyEnd
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => m UInt16
+testPhyEnd = xCmd BgMsgCR BgBlue BgClsTest 0x02 ()
+
+testPhyRx
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> m ()
+testPhyRx = xCmd BgMsgCR BgBlue BgClsTest 0x01
+
+testPhyTx
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8 -> UInt8 -> UInt8 -> m ()
+testPhyTx = curry3 $ xCmd BgMsgCR BgBlue BgClsTest 0x00
+
+-----------------------------------------------------------------------
+-- Device Firmware Upgrade
+-----------------------------------------------------------------------
+
+dfuFlashSetAddress
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt32 -> m BGResult
+dfuFlashSetAddress = xCmd BgMsgCR BgBlue BgClsDfu 0x01
+
+dfuFlashUpload
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => UInt8Array -> m BGResult
+dfuFlashUpload = xCmd BgMsgCR BgBlue BgClsDfu 0x02
+
+dfuFlashUploadFinish
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => m BGResult
+dfuFlashUploadFinish = xCmd BgMsgCR BgBlue BgClsDfu 0x03 ()
+
+dfuReset
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => Bool -> m ()
+dfuReset = xCmd' BgMsgCR BgBlue BgClsDfu 0x00
+
+evtDfuBoot
+ :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
+ => (UInt32 -> IO Bool) -> m ThreadId
+evtDfuBoot = registerEventHandler BgMsgEvent BgBlue BgClsDfu 0x00
diff --git a/src/BGLib/Types.hs b/src/BGLib/Types.hs
new file mode 100644
index 0000000..a3880c3
--- /dev/null
+++ b/src/BGLib/Types.hs
@@ -0,0 +1,957 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module BGLib.Types
+ ( Int8
+ , UInt8
+ , UInt16
+ , UInt32
+ , UInt8Array(..)
+ , toUInt8Array
+ , BdAddr(..)
+ , BgMessageType(..)
+ , BgTecnologyType(..)
+ , BgCommandClass(..)
+ , BgPacketHeader(..)
+ , bgHeaderMatches
+ , BgPayload
+ , fromBgPayload
+ , toBgPayload
+ , BgPacket(..)
+ , HasSerialPort(..)
+ , askSerialPort
+ , HasBGChan(..)
+ , askBGChan
+ , askDupBGChan
+ , HasDebug(..)
+ , askDebug
+ , bsShowHex
+ , RebootMode(..)
+ , AttributeValueType(..)
+ , AttributeChangeReason(..)
+ , fASNotify
+ , fASIndicate
+ , fCConnected
+ , fCEncrypted
+ , fCCompleted
+ , fCParametersChanged
+ , fADLimitedDiscoverable
+ , fADGeneralDiscoverable
+ , fADBREDRNotSupported
+ , fADSimultaneousLEBREDRCtrl
+ , fADSimultaneousLEBREDRHost
+ , fADMask
+ , GapAdvType(..)
+ , GapAdvPolicy(..)
+ , GapAddressType(..)
+ , GapConnectableMode(..)
+ , GapDiscoverableMode(..)
+ , GapDiscoverMode(..)
+ , GSPScanHeaderFlag(..)
+ , GapScanPolicy(..)
+ , fBKLTK
+ , fBKAddrPublic
+ , fBKAddrStatic
+ , fBKIRK
+ , fBKEDIVRAND
+ , fBKCSRK
+ , fBKMasterId
+ , SMIOCapabilities(..)
+ , SystemEndpoint(..)
+ , BGResult(..)
+ ) where
+
+import Control.Concurrent.STM.TChan
+import Control.Monad.Reader
+import Control.Concurrent.STM
+import Data.Binary
+import Data.Binary.Get
+import Data.Binary.Put
+import Data.Bits
+import qualified Data.ByteString as BSS
+import qualified Data.Int as I
+import Data.String
+import qualified Data.Word as W
+import Numeric
+import System.Hardware.Serialport
+import Text.Printf
+
+-- int8 1 byte Signed 8-bit integer
+type Int8 = I.Int8
+
+-- uint8 1 byte Unsigned 8-bit integer
+type UInt8 = W.Word8
+
+-- uint16 2 bytes Unsigned 16-bit integer
+type UInt16 = W.Word16
+
+-- uint32 4 bytes Unsigned 32-bit integer
+type UInt32 = W.Word32
+
+-- uint8array byte array, first byte is array size
+newtype UInt8Array = UInt8Array { fromUInt8Array :: BSS.ByteString } deriving (Show, IsString)
+
+toUInt8Array :: BSS.ByteString -> UInt8Array
+toUInt8Array s = UInt8Array s
+
+instance Binary UInt8Array where
+ put UInt8Array{..} = do
+ putWord8 $ fromIntegral $ BSS.length fromUInt8Array
+ putByteString fromUInt8Array
+
+ get = do
+ l <- getWord8
+ bs <- getByteString (fromIntegral l)
+ return $ UInt8Array bs
+
+-- bd_addr Bluetooth address in little endian format
+newtype BdAddr = BdAddr { fromBdAddr :: (UInt8, UInt8, UInt8, UInt8, UInt8, UInt8) }
+
+instance Show BdAddr where
+ show (BdAddr (_5, _4, _3, _2, _1, _0)) = printf "%02x:%02x:%02x:%02x:%02x:%02x" _0 _1 _2 _3 _4 _5
+
+instance Binary BdAddr where
+ put BdAddr{..} = put fromBdAddr
+ get = get >>= return . BdAddr
+
+data BgMessageType = BgMsgCR | BgMsgEvent deriving (Eq, Show, Enum)
+
+data BgTecnologyType = BgBlue | BgWifi deriving (Eq, Show, Enum)
+
+data BgCommandClass
+ = BgClsSystem
+ | BgClsPersistentStore
+ | BgClsAttributeDatabase
+ | BgClsConnection
+ | BgClsAttributeClient
+ | BgClsSecurityManager
+ | BgClsGenericAccessProfile
+ | BgClsHardware
+ | BgClsTest
+ | BgClsDfu
+ deriving (Eq, Show, Enum)
+
+data BgPacketHeader = BgPacketHeader
+ { bghMessageType :: BgMessageType
+ , bghTechnologyType :: BgTecnologyType
+ , bghLength :: UInt16 -- Only 11 bits actually
+ , bghCommandClass :: BgCommandClass
+ , bghCommandId :: UInt8
+ } deriving Show
+
+instance Binary BgPacketHeader where
+ put BgPacketHeader{..} = do
+ putWord8
+ $ fromIntegral (fromEnum bghMessageType `shift` 7)
+ .|. fromIntegral (fromEnum bghTechnologyType `shift` 3)
+ .|. fromIntegral ((bghLength .&. 0x0700) `shift` (-8))
+ putWord8 $ fromIntegral $ bghLength .&. 0x00ff
+ putWord8 $ fromIntegral $ fromEnum bghCommandClass
+ putWord8 $ bghCommandId
+
+ get = do
+ oct0 <- getWord8
+ lLow <- getWord8
+ clsId <- getWord8
+ cmdId <- getWord8
+
+ let lHigh = oct0 .&. 0x07
+
+ let bghMessageType = toEnum $ fromIntegral $ oct0 `shift` (-7)
+ let bghTechnologyType = toEnum $ fromIntegral $ (oct0 `shift` (-3)) .&. 0x0f
+ let bghLength = (fromIntegral lHigh `shift` 8) + (fromIntegral lLow) :: UInt16
+ let bghCommandClass = toEnum $ fromIntegral clsId
+ let bghCommandId = cmdId
+
+ return $ BgPacketHeader{..}
+
+bgHeaderMatches :: BgMessageType -> BgTecnologyType -> BgCommandClass -> UInt8 -> BgPacketHeader -> Bool
+bgHeaderMatches mt tt cc cid BgPacketHeader{..}
+ = mt == bghMessageType
+ && tt == bghTechnologyType
+ && cc == bghCommandClass
+ && cid == bghCommandId
+
+newtype BgPayload = BgPayload { fromBgPayload :: BSS.ByteString }
+
+toBgPayload :: BSS.ByteString -> BgPayload
+toBgPayload = BgPayload
+
+instance Show BgPayload where
+ show = bsShowHex . fromBgPayload
+
+data BgPacket = BgPacket
+ { bgpHeader :: BgPacketHeader
+ , bgpPayload :: BgPayload
+ } deriving Show
+
+instance Binary BgPacket where
+ put BgPacket{..} = do
+ put bgpHeader
+ putByteString $ fromBgPayload bgpPayload
+
+ get = do
+ bgpHeader@BgPacketHeader{..} <- get
+ bgpPayload <- toBgPayload <$> getByteString (fromIntegral bghLength)
+ return BgPacket{..}
+
+class HasSerialPort env where
+ getSerialPort :: env -> SerialPort
+
+askSerialPort :: (MonadReader env m, HasSerialPort env) => m SerialPort
+askSerialPort = getSerialPort <$> ask
+
+class HasBGChan env where
+ getBGChan :: env -> TChan BgPacket
+
+askBGChan :: (MonadReader env m, HasBGChan env) => m (TChan BgPacket)
+askBGChan = getBGChan <$> ask
+
+askDupBGChan :: (MonadIO m, MonadReader env m, HasBGChan env) => m (TChan BgPacket)
+askDupBGChan = do
+ chan <- getBGChan <$> ask
+ liftIO $ atomically $ dupTChan chan
+
+class HasDebug env where
+ getDebug :: env -> Bool
+
+askDebug :: (MonadReader env m, HasDebug env) => m (Bool)
+askDebug = getDebug <$> ask
+
+bsShowHex :: BSS.ByteString -> String
+bsShowHex = concatMap (\n -> ' ' : showHex n "") . BSS.unpack
+
+data RebootMode
+ -- Reboot into application
+ = RebootNormal
+ -- Reboot into DFU mode
+ | RebootDfu
+ deriving (Show, Enum)
+
+instance Binary RebootMode where
+ put m = do
+ putWord8 $ fromIntegral $ fromEnum m
+ get = do
+ toEnum . fromIntegral <$> getWord8
+
+data AttributeValueType
+ -- 0: Value was read
+ = AVTRead
+ -- 1: Value was notified
+ | AVTNotify
+ -- 2: Value was indicated
+ | AVTIndicate
+ -- 3: Value was read
+ | AVTReadByType
+ -- 4: Value was part of a long attribute
+ | AVTReadBlob
+ -- 5: Value was indicated and the remote device is
+ -- waiting for a confirmation
+ | AVTIndicateRsqReq
+ deriving (Show, Enum)
+
+instance Binary AttributeValueType where
+ put m = do
+ putWord8 $ fromIntegral $ fromEnum m
+ get = do
+ toEnum . fromIntegral <$> getWord8
+
+data AttributeChangeReason
+ -- 0: Value was written by remote device using write request
+ = ACRWriteRequest
+ -- 1: Value was written by remote device using write command
+ | ACRWriteCommand
+ -- 2: Local attribute value was written by the
+ -- remote device, but the Bluetooth Smart
+ -- stack is waiting for the write to be
+ -- confirmed by the application.
+ -- User Write Response command should
+ -- be used to send the confirmation.
+ | ACRWriteRequestUser
+ deriving (Show, Enum)
+
+instance Binary AttributeChangeReason where
+ put m = do
+ putWord8 $ fromIntegral $ fromEnum m
+ get = do
+ toEnum . fromIntegral <$> getWord8
+
+-- Attribute status flags
+
+-- Notifications are enabled
+fASNotify :: UInt8
+fASNotify = 0x01
+
+-- Indications are enabled
+fASIndicate :: UInt8
+fASIndicate = 0x02
+
+-- Connection status flags
+
+-- This status flag tells the connection exists to a remote device.
+fCConnected :: UInt8
+fCConnected = 0x01
+
+-- This flag tells the connection is encrypted.
+fCEncrypted :: UInt8
+fCEncrypted = 0x02
+
+-- Connection completed flag, which is used to tell a new connection
+-- has been created.
+fCCompleted :: UInt8
+fCCompleted = 0x04
+
+-- This flag tells that connection parameters have changed and. It is
+-- set when connection parameters have changed due to a link layer
+-- operation.
+fCParametersChanged :: UInt8
+fCParametersChanged = 0x08
+
+-- 0x01 GAP_AD_FLAG_LIMITED_DISCOVERABLE Limited discoverability
+fADLimitedDiscoverable :: UInt8
+fADLimitedDiscoverable = 0x01
+
+-- 0x02 GAP_AD_FLAG_GENERAL_DISCOVERABLE General discoverability
+fADGeneralDiscoverable :: UInt8
+fADGeneralDiscoverable = 0x02
+
+-- 0x04 GAP_AD_FLAG_BREDR_NOT_SUPPORTED BR/EDR not supported
+fADBREDRNotSupported :: UInt8
+fADBREDRNotSupported = 0x04
+
+-- 0x10 GAP_AD_FLAG_SIMULTANEOUS_LEBREDR_CTRL BR/EDR controller
+fADSimultaneousLEBREDRCtrl :: UInt8
+fADSimultaneousLEBREDRCtrl = 0x10
+
+-- 0x20 GAP_AD_FLAG_SIMULTANEOUS_LEBREDR_HOST BE/EDR host
+fADSimultaneousLEBREDRHost :: UInt8
+fADSimultaneousLEBREDRHost = 0x20
+
+-- 0x1f GAP_AD_FLAG_MASK -
+fADMask :: UInt8
+fADMask = 0x1f
+
+data GapAdvType
+ = GATNone
+ | GATFlags
+ | GATServices16bitMore
+ | GATServices16bitAll
+ | GATServices32bitMore
+ | GATServices32bitAll
+ | GATServices128bitMore
+ | GATServices128bitAll
+ | GATLocalnameShort
+ | GATLocalnameComplete
+ | GATTxPower
+ deriving (Show, Enum)
+
+instance Binary GapAdvType where
+ put m = do
+ putWord8 $ fromIntegral $ fromEnum m
+ get = do
+ toEnum . fromIntegral <$> getWord8
+
+data GapAdvPolicy
+ -- Respond to scan requests from any master, allow connection
+ -- from any master (default)
+ = GAPAll
+ -- Respond to scan requests from whitelist only, allow connection
+ -- from any
+ | GAPWhitelistScan
+ -- Respond to scan requests from any, allow connection from
+ -- whitelist only
+ | GAPWhitelistConnect
+ -- Respond to scan requests from whitelist only, allow connection
+ -- from whitelist only
+ | GAPWhitelistAll
+ deriving (Show, Enum)
+
+instance Binary GapAdvPolicy where
+ put m = do
+ putWord8 $ fromIntegral $ fromEnum m
+ get = do
+ toEnum . fromIntegral <$> getWord8
+
+
+data GapAddressType
+ = GATPublic
+ | GATRandom
+ deriving (Show, Enum)
+
+instance Binary GapAddressType where
+ put m = do
+ putWord8 $ fromIntegral $ fromEnum m
+ get = do
+ toEnum . fromIntegral <$> getWord8
+
+data GapConnectableMode
+ -- Not connectable
+ = GCMNonConnectable
+ -- Directed Connectable
+ | GCMDirectedConnectable
+ -- Undirected connectable
+ | GCMUndirectedConnectable
+ -- Same as non-connectable, but also supports ADV_SCAN_IND
+ -- packets. Device accepts scan requests (active scanning) but is
+ -- not connectable.
+ | GCMScannableNonConnectable
+ deriving (Show, Enum)
+
+instance Binary GapConnectableMode where
+ put m = do
+ putWord8 $ fromIntegral $ fromEnum m
+ get = do
+ toEnum . fromIntegral <$> getWord8
+
+
+data GapDiscoverableMode
+ -- Non-discoverable mode: the LE Limited Discoverable Mode and the
+ -- LE General Discoverable Mode bits are NOT set in the Flags AD
+ -- type. A master can still connect to the advertising slave in this mode.
+ = GDMNonDiscoverable
+ -- 1 gap_limited_discoverable Discoverable using limited scanning mode: the advertisement
+ -- packets will carry the LE Limited Discoverable Mode bit set in the
+ -- Flags AD type.
+ | GDMLimitedDiscoverable
+ -- 2 gap_general_discoverable Discoverable using general scanning mode: the advertisement
+ -- packets will carry the LE General Discoverable Mode bit set in the
+ -- Flags AD type.
+ | GDMGeneralDiscoverable
+ -- 3 gap_broadcast Same as gap_non_discoverable above.
+ | GDMBroadcast
+ -- 4 gap_user_data In this advertisement the advertisement and scan response data
+ -- defined by user will be used. The user is responsible of building the
+ -- advertisement data so that it also contains the appropriate desired
+ -- Flags AD type.
+ | GDMUserData
+ -- 0x80 gap_enhanced_broadcasting When turning the most highest bit on in GAP discoverable mode, the
+ -- remote devices that send scan request packets to the advertiser are
+ -- reported back to the application through Scan Response event.
+ -- This is so called Enhanced Broadcasting mode.
+ | GDMEnhancedBroadcasting
+ deriving (Show, Enum)
+
+instance Binary GapDiscoverableMode where
+ put m = do
+ putWord8$ case m of
+ GDMEnhancedBroadcasting -> 0x80
+ _ -> fromIntegral $ fromEnum m
+ get = do
+ x <- getWord8
+ return $ case x of
+ 5 -> GDMEnhancedBroadcasting
+ _ -> toEnum $ fromIntegral x
+
+data GapDiscoverMode
+ -- 0: Discover only limited discoverable devices, that is, Slaves which have the
+ -- LE Limited Discoverable Mode bit set in the Flags AD type of their
+ -- advertisement packets.
+ = GapDiscoverLimited
+ -- Discover limited and generic discoverable devices, that is, Slaves which
+ -- have the LE Limited Discoverable Mode or the LE General Discoverable
+ -- Mode bit set in the Flags AD type of their advertisement packets.
+ | GapDiscoverGeneric
+ -- Discover all devices regardless of the Flags AD typ
+ | GapDiscoverOvservation
+ deriving (Show, Enum)
+
+instance Binary GapDiscoverMode where
+ put m = do
+ putWord16le $ fromIntegral $ fromEnum m
+ get = do
+ toEnum . fromIntegral <$> getWord16le
+
+
+-- GAP Scan header flags
+data GSPScanHeaderFlag
+ -- Connectable undirected advertising event
+ = GSHFAdvInd
+ -- Connectable directed advertising event
+ | GSHFAdvDirectInd
+ -- Non-connectable undirected advertising event
+ | GSHFAdvNonConnInd
+ -- Scanner wants information from Advertiser
+ | GSHFScanReq
+ -- Advertiser gives more information to Scanner
+ | GSHFScanRsp
+ -- Initiator wants to connect to Advertiser
+ | GSHFConnectReq
+ -- Non-connectable undirected advertising event
+ | GSHFAdvDiscoverInd
+ deriving (Show, Enum)
+
+instance Binary GSPScanHeaderFlag where
+ put m = do
+ putWord8 $ fromIntegral $ fromEnum m
+ get = do
+ toEnum . fromIntegral <$> getWord8
+
+data GapScanPolicy
+ -- All advertisement Packets (default)
+ = GSPAll
+ -- Ignore advertisement packets from remote slaves not in the running
+ -- whitelist
+ | GSPWhitelist
+ deriving (Show, Enum)
+
+instance Binary GapScanPolicy where
+ put m = do
+ putWord8 $ fromIntegral $ fromEnum m
+ get = do
+ toEnum . fromIntegral <$> getWord8
+
+-- SM Bonding Key flags
+
+-- LTK saved in master
+fBKLTK :: UInt8
+fBKLTK = 0x01
+
+-- Public Address
+fBKAddrPublic :: UInt8
+fBKAddrPublic = 0x02
+
+-- Static Address
+fBKAddrStatic :: UInt8
+fBKAddrStatic = 0x04
+
+-- Identity resolving key for resolvable private addresses
+fBKIRK :: UInt8
+fBKIRK = 0x08
+
+-- EDIV+RAND received from slave
+fBKEDIVRAND :: UInt8
+fBKEDIVRAND = 0x10
+
+-- Connection signature resolving key
+fBKCSRK :: UInt8
+fBKCSRK = 0x20
+
+-- EDIV+RAND sent to master
+fBKMasterId :: UInt8
+fBKMasterId = 0x40
+
+data SMIOCapabilities
+ -- Display Only
+ = SICDisplayOnly
+ -- Display with Yes/No-buttons
+ | SICDisplayYesNo
+ -- Keyboard Only
+ | SICKeyboardOnly
+ -- No Input and No Output
+ | SICNoIO
+ -- Display with Keyboard
+ | SICKeyboardDisplay
+ deriving (Enum, Show)
+
+instance Binary SMIOCapabilities where
+ put m = do
+ putWord8 $ fromIntegral $ fromEnum m
+ get = do
+ toEnum . fromIntegral <$> getWord8
+
+data SystemEndpoint
+ -- Command Parser
+ = SECommandParser
+ -- Radio Test
+ | SETest
+ -- BGScript (not used)
+ | SEScript
+ -- USB Interface
+ | SEUSB
+ -- USART 0
+ | SEUART0
+ -- USART 1
+ | SEUART1
+ deriving (Show, Enum)
+
+instance Binary SystemEndpoint where
+ put m = do
+ putWord8 $ fromIntegral $ fromEnum m
+ get = do
+ toEnum . fromIntegral <$> getWord8
+
+-- Operation result
+data BGResult
+ = BGRSuccess
+ -- Invalid Parameter (0x0180)
+ -- Command contained invalid parameter
+ | BGRInvalidParameter
+
+ -- Device in Wrong State (0x0181)
+ -- Device is in wrong state to receive command
+ | BGRWrongState
+
+ -- Out Of Memory (0x0182)
+ -- Device has run out of memory
+ | BGROutOfMemory
+
+ -- Feature Not Implemented (0x0183)
+ -- Feature is not implemented
+ | BGRNotImplemented
+
+ -- Command Not Recognized (0x0184)
+ -- Command was not recognized
+ | BGRNotRecognized
+
+ -- Timeout (0x0185)
+ -- Command or Procedure failed due to timeout
+ | BGRTimeout
+
+ -- Not Connected (0x0186)
+ -- Connection handle passed is to command is not a valid handle
+ | BGRNotConnected
+
+ -- Flow (0x0187)
+ -- Command would cause either underflow or overflow error
+ | BGRFlow
+
+ -- User Attribute (0x0188)
+ -- User attribute was accessed through API which is not supported
+ | BGRUserAttribute
+
+ -- Invalid License Key (0x0189)
+ -- No valid license key found
+ | BGRInvalidLicenseKey
+
+ -- Command Too Long (0x018A)
+ -- Command maximum length exceeded
+ | BGRCommandTooLong
+
+ -- Out of Bonds (0x018B)
+ -- Bonding procedure can't be started because device has no space left for bond.
+ | BGROutOfBonds
+
+ -- Script Overflow (0x018C)
+ -- Module was reset due to script stack overflow.
+ -- In BLE BGScript there is a script stack overflow detection mechanism. This solution resets module
+ -- when script stack overflow is detected. After next boot script failure event with specific error code is
+ -- generated right after system boot event.
+ -- This feature works only with BLE SDK version 1.7.0 or newer that support script stack overflow
+ -- detection mechanism. For this feature to work correctly update of bootloader is needed.
+ | BGRScriptOverflow
+
+ -- Authentication Failure (0x0205)
+ -- Pairing or authentication failed due to incorrect results in the pairing or authentication procedure. This could be
+ -- due to an incorrect PIN or Link Key
+ | BGRAuthenticationFailure
+
+ -- Pin or Key Missing (0x0206)
+ -- Pairing failed because of missing PIN, or authentication failed because of missing Key.
+ -- Silicon Labs
+ | BGRPinOrKeyMissing
+
+ -- Memory Capacity Exceeded (0x0207)
+ -- Controller is out of memory.
+ | BGRMemoryCapacityExceeded
+
+ -- Connection Timeout (0x0208)
+ -- Link supervision timeout has expired.
+ | BGRConnectionTimeout
+
+ -- Connection Limit Exceeded (0x0209)
+ -- Controller is at limit of connections it can support.
+ | BGRConnectionLimitExceeded
+
+ -- Command Disallowed (0x020C)
+ -- Command requested cannot be executed because the Controller is in a state where it cannot process this
+ -- command at this time.
+ | BGRCommandDisallowed
+
+ -- Invalid Command Parameters (0x0212)
+ -- Command contained invalid parameters.
+ | BGRInvalidCommandParameters
+
+ -- Remote User Terminated Connection (0x0213)
+ -- User on the remote device terminated the connection.
+ | BGRRemoteUserTerminatedConnection
+
+ -- Connection Terminated by Local Host (0x0216)
+ -- Local device terminated the connection.
+ | BGRConnectionTErminagedByLocalHost
+
+ -- LL Response Timeout (0x0222)
+ -- Connection terminated due to link-layer procedure timeout.
+ | BGRLLResponseTimeout
+
+ -- LL Instant Passed (0x0228)
+ -- Received link-layer control packet where instant was in the past.
+ | BGRLLInstantPassed
+
+ -- Controller Busy (0x023A)
+ -- Operation was rejected because the controller is busy and unable to process the request.
+ | BGRControllerBusy
+
+ -- Unacceptable Connection Interval (0x023B)
+ -- The Unacceptable Connection Interval error code indicates that the remote device terminated the connection
+ -- because of an unacceptable connection interval.
+ | BGRUnacceptableConnectionInterval
+
+ -- Directed Advertising Timeout (0x023C)
+ -- Directed advertising completed without a connection being created.
+ | BGRDirectedAdvertisingTimeout
+
+ -- MIC Failure (0x023D)
+ -- Connection was terminated because the Message Integrity Check (MIC) failed on a received packet.
+ | BGRMICFailure
+
+ -- Connection Failed to be Established (0x023E)
+ -- LL initiated a connection but the connection has failed to be established. Controller did not receive any packets
+ -- from remote end.
+ -- More in detail, an attempt to open a connection is made by the master by sending only one CONNECT_REQ ,
+ -- after which the master immediately transitions to connected state (BT4.1 Vol 6 Part B 4.4.4). If the advertiser for
+ -- any reason (like interference) does not catch the packet it will just continue advertising, while the master
+ -- remains in a fast termination mode, where it will only send 6 packets before failing, independent of supervision
+ -- timeout (in fact, a master starts using normal supervision timeout only after it has received at least one packet
+ -- from slave.) If the master does not receive anything by the time its 6 packets are sent, connection establishment
+ -- will be considered failed and this error will be reported to the host or to the BGScript. In a busy environment it is
+ -- normal to see roughly 1-2% error rate when opening connections.
+ | BGRConnectionFailedToBeEstablised
+
+ -- Passkey Entry Failed (0x0301)
+ -- The user input of passkey failed, for example, the user cancelled the operation
+ | BGRPasskeyEntryFailed
+
+ -- OOB Data is not available (0x0302)
+ -- Out of Band data is not available for authentication
+ | BGROOBDataIsNotAvailable
+
+ -- Authentication Requirements (0x0303)
+ -- The pairing procedure cannot be performed as authentication requirements cannot be met due to IO capabilities
+ -- of one or both devices
+ | BGRAuthenticationRequirements
+
+ -- Confirm Value Failed (0x0304)
+ -- The confirm value does not match the calculated compare value
+ | BGRConfirmValueFailed
+
+ -- Pairing Not Supported (0x0305)
+ -- Pairing is not supported by the device
+ | BGRPairingNotSupported
+
+ -- Encryption Key Size (0x0306)
+ -- The resultant encryption key size is insufficient for the security requirements of this device
+ | BGREncryptionKeySize
+
+ -- Command Not Supported (0x0307)
+ -- The SMP command received is not supported on this device
+ | BGRCommandNotSupported
+
+ -- Unspecified Reason (0x0308)
+ -- Pairing failed due to an unspecified reason
+ | BGRUnspecifiedReason
+
+ -- Repeated Attempts (0x0309)
+ -- Pairing or authentication procedure is disallowed because too little time has elapsed since last pairing request
+ -- or security request
+ | BGRRepeatedAttempts
+
+ -- Invalid Parameters (0x030A)
+ -- The Invalid Parameters error code indicates: the command length is invalid or a parameter is outside of the
+ -- specified range.
+ | BGRInvalidParameters
+
+ -- Invalid Handle (0x0401)
+ -- The attribute handle given was not valid on this server
+ | BGRInvalidHandle
+
+ -- Read Not Permitted (0x0402)
+ -- The attribute cannot be read
+ | BGRReadNotPermitted
+
+ -- Write Not Permitted (0x0403)
+ -- The attribute cannot be written
+ | BGRWriteNotPermitted
+
+ -- Invalid PDU (0x0404)
+ -- The attribute PDU was invalid
+ | BGRInvalidPDU
+
+ -- Insufficient Authentication (0x0405)
+ -- The attribute requires authentication before it can be read or written.
+ | BGRInsufficientAuthentication
+
+ -- Request Not Supported (0x0406)
+ -- Attribute Server does not support the request received from the client.
+ | BGRRequestNotSupported
+
+ -- Invalid Offset (0x0407)
+ -- Offset specified was past the end of the attribute
+ | BGRInvalidOffset
+
+ -- Insufficient Authorization (0x0408)
+ -- The attribute requires authorization before it can be read or written.
+ | BGRInsufficientAuthorization
+
+ -- Prepare Queue Full (0x0409)
+ -- Too many prepare writes have been queueud
+ | BGRPrepareQueueFull
+
+ -- Attribute Not Found (0x040A)
+ -- No attribute found within the given attribute handle range.
+ | BGRAttributeNotFound
+
+ -- Attribute Not Long (0x040B)
+ -- The attribute cannot be read or written using the Read Blob Request
+ | BGRAttributeNotLong
+
+ -- Insufficient Encryption Key Size (0x040C)
+ -- The Encryption Key Size used for encrypting this link is insufficient.
+ | BGRInsufficientEncryptionKeySize
+
+ -- Invalid Attribute Value Length (0x040D)
+ -- The attribute value length is invalid for the operation
+ | BGRInvalidAttributeValueLength
+
+ -- Unlikely Error (0x040E)
+ -- The attribute request that was requested has encountered an error that was unlikely, and therefore could not be
+ -- completed as requested.
+ | BGRUnlikelyError
+
+ -- Insufficient Encryption (0x040F)
+ -- The attribute requires encryption before it can be read or written.
+ | BGRInsufficientEncryption
+
+ -- Unsupported Group Type (0x0410)
+ -- The attribute type is not a supported grouping attribute as defined by a higher layer specification.
+ | BGRUnsupportedGroupType
+
+ -- Insufficient Resources (0x0411)
+ -- Insufficient Resources to complete the request
+ | BGRInsufficientResources
+
+ -- Application Error Codes (0x0480)
+ -- Application error code defined by a higher layer specification.
+ -- The error code range 0x80-0x9F is reserved for application level errors.
+ | BGRApplicationErrorCode UInt8
+
+ -- And error code unknown by this library
+ | BGRUnknown UInt16
+ deriving Show
+
+instance Binary BGResult where
+ put m = do
+ putWord16le $ case m of
+ BGRSuccess -> 0x0000
+ BGRInvalidParameter -> 0x0180
+ BGRWrongState -> 0x0181
+ BGROutOfMemory -> 0x0182
+ BGRNotImplemented -> 0x0183
+ BGRNotRecognized -> 0x0184
+ BGRTimeout -> 0x0185
+ BGRNotConnected -> 0x0186
+ BGRFlow -> 0x0187
+ BGRUserAttribute -> 0x0188
+ BGRInvalidLicenseKey -> 0x0189
+ BGRCommandTooLong -> 0x018A
+ BGROutOfBonds -> 0x018B
+ BGRScriptOverflow -> 0x018C
+ BGRAuthenticationFailure -> 0x0205
+ BGRPinOrKeyMissing -> 0x0206
+ BGRMemoryCapacityExceeded -> 0x0207
+ BGRConnectionTimeout -> 0x0208
+ BGRConnectionLimitExceeded -> 0x0209
+ BGRCommandDisallowed -> 0x020C
+ BGRInvalidCommandParameters -> 0x0212
+ BGRRemoteUserTerminatedConnection -> 0x0213
+ BGRConnectionTErminagedByLocalHost -> 0x0216
+ BGRLLResponseTimeout -> 0x0222
+ BGRLLInstantPassed -> 0x0228
+ BGRControllerBusy -> 0x023A
+ BGRUnacceptableConnectionInterval -> 0x023B
+ BGRDirectedAdvertisingTimeout -> 0x023C
+ BGRMICFailure -> 0x023D
+ BGRConnectionFailedToBeEstablised -> 0x023E
+ BGRPasskeyEntryFailed -> 0x0301
+ BGROOBDataIsNotAvailable -> 0x0302
+ BGRAuthenticationRequirements -> 0x0303
+ BGRConfirmValueFailed -> 0x0304
+ BGRPairingNotSupported -> 0x0305
+ BGREncryptionKeySize -> 0x0306
+ BGRCommandNotSupported -> 0x0307
+ BGRUnspecifiedReason -> 0x0308
+ BGRRepeatedAttempts -> 0x0309
+ BGRInvalidParameters -> 0x030A
+ BGRInvalidHandle -> 0x0401
+ BGRReadNotPermitted -> 0x0402
+ BGRWriteNotPermitted -> 0x0403
+ BGRInvalidPDU -> 0x0404
+ BGRInsufficientAuthentication -> 0x0405
+ BGRRequestNotSupported -> 0x0406
+ BGRInvalidOffset -> 0x0407
+ BGRInsufficientAuthorization -> 0x0408
+ BGRPrepareQueueFull -> 0x0409
+ BGRAttributeNotFound -> 0x040A
+ BGRAttributeNotLong -> 0x040B
+ BGRInsufficientEncryptionKeySize -> 0x040C
+ BGRInvalidAttributeValueLength -> 0x040D
+ BGRUnlikelyError -> 0x040E
+ BGRInsufficientEncryption -> 0x040F
+ BGRUnsupportedGroupType -> 0x0410
+ BGRInsufficientResources -> 0x0411
+ BGRApplicationErrorCode errC -> (fromIntegral errC .&. 0x001f) .|. 0x0480
+ BGRUnknown errC -> errC
+
+ get = do
+ errC <- getWord16le
+ return $ case errC of
+ 0x0000 -> BGRSuccess
+ 0x0180 -> BGRInvalidParameter
+ 0x0181 -> BGRWrongState
+ 0x0182 -> BGROutOfMemory
+ 0x0183 -> BGRNotImplemented
+ 0x0184 -> BGRNotRecognized
+ 0x0185 -> BGRTimeout
+ 0x0186 -> BGRNotConnected
+ 0x0187 -> BGRFlow
+ 0x0188 -> BGRUserAttribute
+ 0x0189 -> BGRInvalidLicenseKey
+ 0x018A -> BGRCommandTooLong
+ 0x018B -> BGROutOfBonds
+ 0x018C -> BGRScriptOverflow
+ 0x0205 -> BGRAuthenticationFailure
+ 0x0206 -> BGRPinOrKeyMissing
+ 0x0207 -> BGRMemoryCapacityExceeded
+ 0x0208 -> BGRConnectionTimeout
+ 0x0209 -> BGRConnectionLimitExceeded
+ 0x020C -> BGRCommandDisallowed
+ 0x0212 -> BGRInvalidCommandParameters
+ 0x0213 -> BGRRemoteUserTerminatedConnection
+ 0x0216 -> BGRConnectionTErminagedByLocalHost
+ 0x0222 -> BGRLLResponseTimeout
+ 0x0228 -> BGRLLInstantPassed
+ 0x023A -> BGRControllerBusy
+ 0x023B -> BGRUnacceptableConnectionInterval
+ 0x023C -> BGRDirectedAdvertisingTimeout
+ 0x023D -> BGRMICFailure
+ 0x023E -> BGRConnectionFailedToBeEstablised
+ 0x0301 -> BGRPasskeyEntryFailed
+ 0x0302 -> BGROOBDataIsNotAvailable
+ 0x0303 -> BGRAuthenticationRequirements
+ 0x0304 -> BGRConfirmValueFailed
+ 0x0305 -> BGRPairingNotSupported
+ 0x0306 -> BGREncryptionKeySize
+ 0x0307 -> BGRCommandNotSupported
+ 0x0308 -> BGRUnspecifiedReason
+ 0x0309 -> BGRRepeatedAttempts
+ 0x030A -> BGRInvalidParameters
+ 0x0401 -> BGRInvalidHandle
+ 0x0402 -> BGRReadNotPermitted
+ 0x0403 -> BGRWriteNotPermitted
+ 0x0404 -> BGRInvalidPDU
+ 0x0405 -> BGRInsufficientAuthentication
+ 0x0406 -> BGRRequestNotSupported
+ 0x0407 -> BGRInvalidOffset
+ 0x0408 -> BGRInsufficientAuthorization
+ 0x0409 -> BGRPrepareQueueFull
+ 0x040A -> BGRAttributeNotFound
+ 0x040B -> BGRAttributeNotLong
+ 0x040C -> BGRInsufficientEncryptionKeySize
+ 0x040D -> BGRInvalidAttributeValueLength
+ 0x040E -> BGRUnlikelyError
+ 0x040F -> BGRInsufficientEncryption
+ 0x0410 -> BGRUnsupportedGroupType
+ 0x0411 -> BGRInsufficientResources
+ _ ->
+ if errC >= 0x0480 && errC <= 0x049f
+ then BGRApplicationErrorCode $ fromIntegral (errC .&. 0x1f)
+ else BGRUnknown errC