bglib (empty) → 0.1.0.0
raw patch · 7 files changed
+2225/−0 lines, 7 filesdep +basedep +bglibdep +binarysetup-changed
Dependencies added: base, bglib, binary, bytestring, monad-loops, mtl, optparse-applicative, serialport, stm
Files
- LICENSE +30/−0
- README.md +15/−0
- Setup.hs +2/−0
- bglib.cabal +48/−0
- examples/bgapitest.hs +146/−0
- src/BGLib/Commands.hs +1027/−0
- src/BGLib/Types.hs +957/−0
+ LICENSE view
@@ -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.
+ README.md view
@@ -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.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bglib.cabal view
@@ -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
+ examples/bgapitest.hs view
@@ -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
+ src/BGLib/Commands.hs view
@@ -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
+ src/BGLib/Types.hs view
@@ -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