{-# 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.IO.Class
import           Control.Monad.Loops
import           Control.Monad.Reader
import           Control.Monad.STM
import           Data.Binary
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString as BSS
import           System.Hardware.Serialport

-- Read an exact amount of bytes from a serial port
readData :: SerialPort -> Int -> IO BSS.ByteString
readData :: SerialPort -> Int -> IO ByteString
readData SerialPort
s Int
n = do
    ByteString
bs <- SerialPort -> Int -> IO ByteString
recv SerialPort
s Int
n
    let received :: Int
received = ByteString -> Int
BSS.length ByteString
bs
    if  Int
received Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
        then ByteString -> ByteString -> ByteString
BSS.append ByteString
bs (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SerialPort -> Int -> IO ByteString
readData SerialPort
s ( Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
received )
        else ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs

-- Write all the data to a serial port
writeData :: SerialPort -> BSS.ByteString -> IO ()
writeData :: SerialPort -> ByteString -> IO ()
writeData SerialPort
s ByteString
bs = do
    Int
sent <- SerialPort -> ByteString -> IO Int
send SerialPort
s ByteString
bs
    if Int
sent Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ByteString -> Int
BSS.length ByteString
bs
        then SerialPort -> ByteString -> IO ()
writeData SerialPort
s ( Int -> ByteString -> ByteString
BSS.drop Int
sent ByteString
bs )
        else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- Write the BgPacket to the Handle in env asked from the MonadReader
writeBGPacket :: (MonadIO m, MonadReader env m, HasSerialPort env, HasDebug env) => BgPacket -> m ()
writeBGPacket :: BgPacket -> m ()
writeBGPacket BgPacket
p = do
    SerialPort
s <- m SerialPort
forall env (m :: * -> *).
(MonadReader env m, HasSerialPort env) =>
m SerialPort
askSerialPort
    Bool
dbg <- m Bool
forall env (m :: * -> *).
(MonadReader env m, HasDebug env) =>
m Bool
askDebug
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        let packetBS :: ByteString
packetBS = ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ BgPacket -> ByteString
forall a. Binary a => a -> ByteString
encode BgPacket
p
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
dbg (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            String -> IO ()
putStr String
"[DEBUG] WRITE: "
            String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ BgPacket -> String
forall a. Show a => a -> String
show BgPacket
p
        SerialPort -> ByteString -> IO ()
writeData SerialPort
s ByteString
packetBS
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- Read one BgPacket from a Handle
readBGPacket :: Bool -> SerialPort -> IO (Either String BgPacket)
readBGPacket :: Bool -> SerialPort -> IO (Either String BgPacket)
readBGPacket Bool
dbg SerialPort
h = do
    ByteString
bsHeader <- SerialPort -> Int -> IO ByteString
readData SerialPort
h Int
4
    let eHeader :: Either
  (ByteString, ByteOffset, String)
  (ByteString, ByteOffset, BgPacketHeader)
eHeader = ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, BgPacketHeader)
forall a.
Binary a =>
ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
decodeOrFail (ByteString
 -> Either
      (ByteString, ByteOffset, String)
      (ByteString, ByteOffset, BgPacketHeader))
-> ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, BgPacketHeader)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.fromStrict ByteString
bsHeader

    case Either
  (ByteString, ByteOffset, String)
  (ByteString, ByteOffset, BgPacketHeader)
eHeader of
        Left (ByteString, ByteOffset, String)
_ -> do
            let err :: String
err = String
"could not decode header: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
bsShowHex ByteString
bsHeader
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
dbg (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"[DEBUG] ERROR: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err
            Either String BgPacket -> IO (Either String BgPacket)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String BgPacket -> IO (Either String BgPacket))
-> Either String BgPacket -> IO (Either String BgPacket)
forall a b. (a -> b) -> a -> b
$ String -> Either String BgPacket
forall a b. a -> Either a b
Left String
err
        Right (ByteString
_, ByteOffset
_, bgpHeader :: BgPacketHeader
bgpHeader@BgPacketHeader{UInt8
BgCommandClass
BgTecnologyType
BgMessageType
UInt16
bghCommandId :: BgPacketHeader -> UInt8
bghCommandClass :: BgPacketHeader -> BgCommandClass
bghLength :: BgPacketHeader -> UInt16
bghTechnologyType :: BgPacketHeader -> BgTecnologyType
bghMessageType :: BgPacketHeader -> BgMessageType
bghCommandId :: UInt8
bghCommandClass :: BgCommandClass
bghLength :: UInt16
bghTechnologyType :: BgTecnologyType
bghMessageType :: BgMessageType
..}) -> do
            ByteString
bsPayload <- SerialPort -> Int -> IO ByteString
readData SerialPort
h (UInt16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt16
bghLength)
            let bgpPayload :: BgPayload
bgpPayload = ByteString -> BgPayload
toBgPayload ByteString
bsPayload
            let p :: BgPacket
p = BgPacket :: BgPacketHeader -> BgPayload -> BgPacket
BgPacket {BgPayload
BgPacketHeader
bgpPayload :: BgPayload
bgpHeader :: BgPacketHeader
bgpPayload :: BgPayload
bgpHeader :: BgPacketHeader
..}
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
dbg (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                String -> IO ()
putStr String
"[DEBUG]  READ: "
                String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ BgPacket -> String
forall a. Show a => a -> String
show BgPacket
p
            Either String BgPacket -> IO (Either String BgPacket)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String BgPacket -> IO (Either String BgPacket))
-> Either String BgPacket -> IO (Either String BgPacket)
forall a b. (a -> b) -> a -> b
$ BgPacket -> Either String BgPacket
forall a b. b -> Either a b
Right BgPacket
p

-- 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) => (String -> IO ()) -> m () 
startPacketReader :: (String -> IO ()) -> m ()
startPacketReader String -> IO ()
errorHandler = do
    TChan BgPacket
c <- m (TChan BgPacket)
forall env (m :: * -> *).
(MonadReader env m, HasBGChan env) =>
m (TChan BgPacket)
askBGChan
    SerialPort
h <- m SerialPort
forall env (m :: * -> *).
(MonadReader env m, HasSerialPort env) =>
m SerialPort
askSerialPort
    Bool
dbg <- m Bool
forall env (m :: * -> *).
(MonadReader env m, HasDebug env) =>
m Bool
askDebug
    ThreadId
_ <- IO ThreadId -> m ThreadId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadId -> m ThreadId) -> IO ThreadId -> m ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Either String BgPacket
packetOrErr <- Bool -> SerialPort -> IO (Either String BgPacket)
readBGPacket Bool
dbg SerialPort
h
        case Either String BgPacket
packetOrErr of
            Left String
err -> String -> IO ()
errorHandler String
err
            Right BgPacket
p -> STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TChan BgPacket -> BgPacket -> STM ()
forall a. TChan a -> a -> STM ()
writeTChan TChan BgPacket
c BgPacket
p
    () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- Waits for any BgPacket to appear on the TChan
waitForAnyPacket :: TChan BgPacket -> IO BgPacket
waitForAnyPacket :: TChan BgPacket -> IO BgPacket
waitForAnyPacket TChan BgPacket
chan = do
    IO BgPacket -> IO BgPacket
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BgPacket -> IO BgPacket) -> IO BgPacket -> IO BgPacket
forall a b. (a -> b) -> a -> b
$ STM BgPacket -> IO BgPacket
forall a. STM a -> IO a
atomically (STM BgPacket -> IO BgPacket) -> STM BgPacket -> IO BgPacket
forall a b. (a -> b) -> a -> b
$ TChan BgPacket -> STM BgPacket
forall a. TChan a -> STM a
readTChan TChan BgPacket
chan

-- Wait for a packet with specific values in it's header
waitForPacket :: TChan BgPacket -> BgMessageType -> BgTecnologyType -> BgCommandClass -> UInt8 -> IO BgPacket
waitForPacket :: TChan BgPacket
-> BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> IO BgPacket
waitForPacket TChan BgPacket
chan BgMessageType
mt BgTecnologyType
tt BgCommandClass
cc UInt8
cid = do
    IO (Maybe BgPacket) -> IO BgPacket
forall (m :: * -> *) a. Monad m => m (Maybe a) -> m a
untilJust (IO (Maybe BgPacket) -> IO BgPacket)
-> IO (Maybe BgPacket) -> IO BgPacket
forall a b. (a -> b) -> a -> b
$ do
        p :: BgPacket
p@BgPacket{BgPayload
BgPacketHeader
bgpPayload :: BgPayload
bgpHeader :: BgPacketHeader
bgpPayload :: BgPacket -> BgPayload
bgpHeader :: BgPacket -> BgPacketHeader
..} <- TChan BgPacket -> IO BgPacket
waitForAnyPacket TChan BgPacket
chan
        Maybe BgPacket -> IO (Maybe BgPacket)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BgPacket -> IO (Maybe BgPacket))
-> Maybe BgPacket -> IO (Maybe BgPacket)
forall a b. (a -> b) -> a -> b
$ if BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> BgPacketHeader
-> Bool
bgHeaderMatches BgMessageType
mt BgTecnologyType
tt BgCommandClass
cc UInt8
cid BgPacketHeader
bgpHeader then BgPacket -> Maybe BgPacket
forall a. a -> Maybe a
Just BgPacket
p else Maybe BgPacket
forall a. Maybe a
Nothing

-- eXecute a Command, don't wait for answer
xCmd' :: (MonadIO m, MonadReader env m, HasSerialPort env, HasDebug env, Binary a ) => BgMessageType -> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m ()
xCmd' :: BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m ()
xCmd' BgMessageType
mt BgTecnologyType
tt BgCommandClass
cc UInt8
cid a
inp = do
    let inpBS :: ByteString
inpBS = ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. Binary a => a -> ByteString
encode a
inp
    BgPacket -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasSerialPort env, HasDebug env) =>
BgPacket -> m ()
writeBGPacket (BgPacket -> m ()) -> BgPacket -> m ()
forall a b. (a -> b) -> a -> b
$ BgPacketHeader -> BgPayload -> BgPacket
BgPacket (BgMessageType
-> BgTecnologyType
-> UInt16
-> BgCommandClass
-> UInt8
-> BgPacketHeader
BgPacketHeader BgMessageType
mt BgTecnologyType
tt (Int -> UInt16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt16) -> Int -> UInt16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BSS.length ByteString
inpBS) BgCommandClass
cc UInt8
cid) (ByteString -> BgPayload
toBgPayload ByteString
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 :: BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
mt BgTecnologyType
tt BgCommandClass
cc UInt8
cid a
inp = do
    -- We need to duplicate the channel BEFORE sending the command, so we don't miss the answer by accident
    TChan BgPacket
chan <- m (TChan BgPacket)
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasBGChan env) =>
m (TChan BgPacket)
askDupBGChan
    BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m ()
forall (m :: * -> *) env a.
(MonadIO m, MonadReader env m, HasSerialPort env, HasDebug env,
 Binary a) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m ()
xCmd' BgMessageType
mt BgTecnologyType
tt BgCommandClass
cc UInt8
cid a
inp
    BgPacket
p <- IO BgPacket -> m BgPacket
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BgPacket -> m BgPacket) -> IO BgPacket -> m BgPacket
forall a b. (a -> b) -> a -> b
$ TChan BgPacket
-> BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> IO BgPacket
waitForPacket TChan BgPacket
chan BgMessageType
mt BgTecnologyType
tt BgCommandClass
cc UInt8
cid
    let eRes :: Either (ByteString, ByteOffset, String) (ByteString, ByteOffset, b)
eRes = ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, b)
forall a.
Binary a =>
ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
decodeOrFail (ByteString
 -> Either
      (ByteString, ByteOffset, String) (ByteString, ByteOffset, b))
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, b)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ BgPayload -> ByteString
fromBgPayload (BgPayload -> ByteString) -> BgPayload -> ByteString
forall a b. (a -> b) -> a -> b
$ BgPacket -> BgPayload
bgpPayload BgPacket
p
    case Either (ByteString, ByteOffset, String) (ByteString, ByteOffset, b)
eRes of
        Left (ByteString, ByteOffset, String)
_ -> do
            String -> m b
forall a. HasCallStack => String -> a
error String
"ERROR decoding packet."
        Right (ByteString
_, ByteOffset
_, b
res) -> 
            b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
res

-- Handle a specific type of packet
--
-- Event handler block by waiting on the TChan provided by the
-- environment. One can use forkIO to make event handler run in
-- independent threads, or use race with threadDelay to wait for an
-- event with a timeout.
handlePacket
    :: (Binary a, MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env)
    => BgMessageType -> BgTecnologyType -> BgCommandClass -> UInt8 -> (a -> m (Maybe b)) -> m b
handlePacket :: BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
mt BgTecnologyType
tt BgCommandClass
cc UInt8
cid a -> m (Maybe b)
handler = do
    TChan BgPacket
chan <- m (TChan BgPacket)
forall env (m :: * -> *).
(MonadReader env m, HasBGChan env) =>
m (TChan BgPacket)
askBGChan
    TChan BgPacket -> m b
go TChan BgPacket
chan
    where
        go :: TChan BgPacket -> m b
go TChan BgPacket
chan = do
            BgPacket{BgPayload
BgPacketHeader
bgpPayload :: BgPayload
bgpHeader :: BgPacketHeader
bgpPayload :: BgPacket -> BgPayload
bgpHeader :: BgPacket -> BgPacketHeader
..} <- IO BgPacket -> m BgPacket
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BgPacket -> m BgPacket) -> IO BgPacket -> m BgPacket
forall a b. (a -> b) -> a -> b
$ TChan BgPacket
-> BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> IO BgPacket
waitForPacket TChan BgPacket
chan BgMessageType
mt BgTecnologyType
tt BgCommandClass
cc UInt8
cid
            Maybe b
mbResult <- a -> m (Maybe b)
handler (a -> m (Maybe b)) -> a -> m (Maybe b)
forall a b. (a -> b) -> a -> b
$ ByteString -> a
forall a. Binary a => ByteString -> a
decode (ByteString -> a) -> ByteString -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ BgPayload -> ByteString
fromBgPayload (BgPayload -> ByteString) -> BgPayload -> ByteString
forall a b. (a -> b) -> a -> b
$ BgPayload
bgpPayload
            case Maybe b
mbResult of
                Maybe b
Nothing -> TChan BgPacket -> m b
go TChan BgPacket
chan
                Just b
r  -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
r

curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d
curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d
curry3 (a, b, c) -> d
func a
a b
b c
c = (a, b, c) -> d
func (a
a, b
b, c
c)

uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 a -> b -> c -> d
func (a
a, b
b, c
c) = a -> b -> c -> d
func a
a b
b c
c

curry4 :: ((a, b, c, d) -> e) -> a -> b -> c -> d -> e
curry4 :: ((a, b, c, d) -> e) -> a -> b -> c -> d -> e
curry4 (a, b, c, d) -> e
func a
a b
b c
c d
d = (a, b, c, d) -> e
func (a
a, b
b, c
c, d
d)

uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
uncurry4 a -> b -> c -> d -> e
func (a
a, b
b, c
c, d
d) = a -> b -> c -> d -> e
func a
a b
b c
c d
d

curry5 :: ((a, b, c, d, e) -> f) -> a -> b -> c -> d -> e -> f
curry5 :: ((a, b, c, d, e) -> f) -> a -> b -> c -> d -> e -> f
curry5 (a, b, c, d, e) -> f
func a
a b
b c
c d
d e
e = (a, b, c, d, e) -> f
func (a
a, b
b, c
c, d
d, e
e)

uncurry5 :: (a -> b -> c -> d -> e -> f) -> (a, b, c, d, e) -> f
uncurry5 :: (a -> b -> c -> d -> e -> f) -> (a, b, c, d, e) -> f
uncurry5 a -> b -> c -> d -> e -> f
func (a
a, b
b, c
c, d
d, e
e) = a -> b -> c -> d -> e -> f
func a
a b
b c
c d
d e
e

curry6 :: ((a, b, c, d, e, f) -> g) -> a -> b -> c -> d -> e -> f -> g
curry6 :: ((a, b, c, d, e, f) -> g) -> a -> b -> c -> d -> e -> f -> g
curry6 (a, b, c, d, e, f) -> g
func a
a b
b c
c d
d e
e f
f = (a, b, c, d, e, f) -> g
func (a
a, b
b, c
c, d
d, e
e, f
f)

uncurry6 :: (a -> b -> c -> d -> e -> f -> g) -> (a, b, c, d, e, f) -> g
uncurry6 :: (a -> b -> c -> d -> e -> f -> g) -> (a, b, c, d, e, f) -> g
uncurry6 a -> b -> c -> d -> e -> f -> g
func (a
a, b
b, c
c, d
d, e
e, f
f) = a -> b -> c -> d -> e -> f -> g
func a
a b
b c
c d
d e
e f
f

uncurry7 :: (a -> b -> c -> d -> e -> f -> g -> h) -> (a, b, c, d, e, f, g) -> h
uncurry7 :: (a -> b -> c -> d -> e -> f -> g -> h)
-> (a, b, c, d, e, f, g) -> h
uncurry7 a -> b -> c -> d -> e -> f -> g -> h
func (a
a, b
b, c
c, d
d, e
e, f
f, g
g) = a -> b -> c -> d -> e -> f -> g -> h
func a
a b
b c
c d
d e
e f
f g
g

uncurry8 :: (a -> b -> c -> d -> e -> f -> g -> h -> i) -> (a, b, c, d, e, f, g, h) -> i
uncurry8 :: (a -> b -> c -> d -> e -> f -> g -> h -> i)
-> (a, b, c, d, e, f, g, h) -> i
uncurry8 a -> b -> c -> d -> e -> f -> g -> h -> i
func (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h) = a -> b -> c -> d -> e -> f -> g -> h -> i
func a
a b
b c
c d
d e
e f
f g
g h
h

-----------------------------------------------------------------------
-- Attribute Client
-----------------------------------------------------------------------

attclientAttributeWrite
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt16 -> UInt8Array -> m (UInt8, BGResult)
attclientAttributeWrite :: UInt8 -> UInt16 -> UInt8Array -> m (UInt8, BGResult)
attclientAttributeWrite = ((UInt8, UInt16, UInt8Array) -> m (UInt8, BGResult))
-> UInt8 -> UInt16 -> UInt8Array -> m (UInt8, BGResult)
forall a b c d. ((a, b, c) -> d) -> a -> b -> c -> d
curry3 (((UInt8, UInt16, UInt8Array) -> m (UInt8, BGResult))
 -> UInt8 -> UInt16 -> UInt8Array -> m (UInt8, BGResult))
-> ((UInt8, UInt16, UInt8Array) -> m (UInt8, BGResult))
-> UInt8
-> UInt16
-> UInt8Array
-> m (UInt8, BGResult)
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt16, UInt8Array)
-> m (UInt8, BGResult)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsAttributeClient UInt8
0x05

attclientExecuteWrite
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> Bool -> m (UInt8, BGResult)
attclientExecuteWrite :: UInt8 -> Bool -> m (UInt8, BGResult)
attclientExecuteWrite = ((UInt8, Bool) -> m (UInt8, BGResult))
-> UInt8 -> Bool -> m (UInt8, BGResult)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((UInt8, Bool) -> m (UInt8, BGResult))
 -> UInt8 -> Bool -> m (UInt8, BGResult))
-> ((UInt8, Bool) -> m (UInt8, BGResult))
-> UInt8
-> Bool
-> m (UInt8, BGResult)
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, Bool)
-> m (UInt8, BGResult)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsAttributeClient UInt8
0x0a

attclientFindByTypeValue
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt16 -> UInt16 -> UInt16 -> UInt8Array -> m (UInt8, BGResult)
attclientFindByTypeValue :: UInt8
-> UInt16 -> UInt16 -> UInt16 -> UInt8Array -> m (UInt8, BGResult)
attclientFindByTypeValue = ((UInt8, UInt16, UInt16, UInt16, UInt8Array)
 -> m (UInt8, BGResult))
-> UInt8
-> UInt16
-> UInt16
-> UInt16
-> UInt8Array
-> m (UInt8, BGResult)
forall a b c d e f.
((a, b, c, d, e) -> f) -> a -> b -> c -> d -> e -> f
curry5 (((UInt8, UInt16, UInt16, UInt16, UInt8Array)
  -> m (UInt8, BGResult))
 -> UInt8
 -> UInt16
 -> UInt16
 -> UInt16
 -> UInt8Array
 -> m (UInt8, BGResult))
-> ((UInt8, UInt16, UInt16, UInt16, UInt8Array)
    -> m (UInt8, BGResult))
-> UInt8
-> UInt16
-> UInt16
-> UInt16
-> UInt8Array
-> m (UInt8, BGResult)
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt16, UInt16, UInt16, UInt8Array)
-> m (UInt8, BGResult)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsAttributeClient UInt8
0x00

attclientFindInformation
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt16 -> UInt16 -> m (UInt8, BGResult)
attclientFindInformation :: UInt8 -> UInt16 -> UInt16 -> m (UInt8, BGResult)
attclientFindInformation = ((UInt8, UInt16, UInt16) -> m (UInt8, BGResult))
-> UInt8 -> UInt16 -> UInt16 -> m (UInt8, BGResult)
forall a b c d. ((a, b, c) -> d) -> a -> b -> c -> d
curry3 (((UInt8, UInt16, UInt16) -> m (UInt8, BGResult))
 -> UInt8 -> UInt16 -> UInt16 -> m (UInt8, BGResult))
-> ((UInt8, UInt16, UInt16) -> m (UInt8, BGResult))
-> UInt8
-> UInt16
-> UInt16
-> m (UInt8, BGResult)
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt16, UInt16)
-> m (UInt8, BGResult)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsAttributeClient UInt8
0x03

attclientIndicateConfirm
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> m BGResult
attclientIndicateConfirm :: UInt8 -> m BGResult
attclientIndicateConfirm = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> UInt8
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsAttributeClient UInt8
0x07

attclientPrepareWrite
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt16 -> UInt16 -> UInt8Array -> m (UInt8, BGResult)
attclientPrepareWrite :: UInt8 -> UInt16 -> UInt16 -> UInt8Array -> m (UInt8, BGResult)
attclientPrepareWrite = ((UInt8, UInt16, UInt16, UInt8Array) -> m (UInt8, BGResult))
-> UInt8 -> UInt16 -> UInt16 -> UInt8Array -> m (UInt8, BGResult)
forall a b c d e. ((a, b, c, d) -> e) -> a -> b -> c -> d -> e
curry4 (((UInt8, UInt16, UInt16, UInt8Array) -> m (UInt8, BGResult))
 -> UInt8 -> UInt16 -> UInt16 -> UInt8Array -> m (UInt8, BGResult))
-> ((UInt8, UInt16, UInt16, UInt8Array) -> m (UInt8, BGResult))
-> UInt8
-> UInt16
-> UInt16
-> UInt8Array
-> m (UInt8, BGResult)
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt16, UInt16, UInt8Array)
-> m (UInt8, BGResult)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsAttributeClient UInt8
0x09

attclientReadByGroupType
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt16 -> UInt16 -> UInt8Array -> m (UInt8, BGResult)
attclientReadByGroupType :: UInt8 -> UInt16 -> UInt16 -> UInt8Array -> m (UInt8, BGResult)
attclientReadByGroupType = ((UInt8, UInt16, UInt16, UInt8Array) -> m (UInt8, BGResult))
-> UInt8 -> UInt16 -> UInt16 -> UInt8Array -> m (UInt8, BGResult)
forall a b c d e. ((a, b, c, d) -> e) -> a -> b -> c -> d -> e
curry4 (((UInt8, UInt16, UInt16, UInt8Array) -> m (UInt8, BGResult))
 -> UInt8 -> UInt16 -> UInt16 -> UInt8Array -> m (UInt8, BGResult))
-> ((UInt8, UInt16, UInt16, UInt8Array) -> m (UInt8, BGResult))
-> UInt8
-> UInt16
-> UInt16
-> UInt8Array
-> m (UInt8, BGResult)
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt16, UInt16, UInt8Array)
-> m (UInt8, BGResult)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsAttributeClient UInt8
0x01

attclientReadByHandle
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt16 -> m (UInt8, BGResult)
attclientReadByHandle :: UInt8 -> UInt16 -> m (UInt8, BGResult)
attclientReadByHandle = ((UInt8, UInt16) -> m (UInt8, BGResult))
-> UInt8 -> UInt16 -> m (UInt8, BGResult)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((UInt8, UInt16) -> m (UInt8, BGResult))
 -> UInt8 -> UInt16 -> m (UInt8, BGResult))
-> ((UInt8, UInt16) -> m (UInt8, BGResult))
-> UInt8
-> UInt16
-> m (UInt8, BGResult)
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt16)
-> m (UInt8, BGResult)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsAttributeClient UInt8
0x04

attclientReadByType
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt16 -> UInt16 -> UInt8Array -> m (UInt8, BGResult)
attclientReadByType :: UInt8 -> UInt16 -> UInt16 -> UInt8Array -> m (UInt8, BGResult)
attclientReadByType = ((UInt8, UInt16, UInt16, UInt8Array) -> m (UInt8, BGResult))
-> UInt8 -> UInt16 -> UInt16 -> UInt8Array -> m (UInt8, BGResult)
forall a b c d e. ((a, b, c, d) -> e) -> a -> b -> c -> d -> e
curry4 (((UInt8, UInt16, UInt16, UInt8Array) -> m (UInt8, BGResult))
 -> UInt8 -> UInt16 -> UInt16 -> UInt8Array -> m (UInt8, BGResult))
-> ((UInt8, UInt16, UInt16, UInt8Array) -> m (UInt8, BGResult))
-> UInt8
-> UInt16
-> UInt16
-> UInt8Array
-> m (UInt8, BGResult)
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt16, UInt16, UInt8Array)
-> m (UInt8, BGResult)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsAttributeClient UInt8
0x02

attclientReadLong
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt16 -> m (UInt8, BGResult)
attclientReadLong :: UInt8 -> UInt16 -> m (UInt8, BGResult)
attclientReadLong = ((UInt8, UInt16) -> m (UInt8, BGResult))
-> UInt8 -> UInt16 -> m (UInt8, BGResult)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((UInt8, UInt16) -> m (UInt8, BGResult))
 -> UInt8 -> UInt16 -> m (UInt8, BGResult))
-> ((UInt8, UInt16) -> m (UInt8, BGResult))
-> UInt8
-> UInt16
-> m (UInt8, BGResult)
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt16)
-> m (UInt8, BGResult)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsAttributeClient UInt8
0x08

attclientReadMultiple
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt8Array -> m (UInt8, BGResult)
attclientReadMultiple :: UInt8 -> UInt8Array -> m (UInt8, BGResult)
attclientReadMultiple = ((UInt8, UInt8Array) -> m (UInt8, BGResult))
-> UInt8 -> UInt8Array -> m (UInt8, BGResult)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((UInt8, UInt8Array) -> m (UInt8, BGResult))
 -> UInt8 -> UInt8Array -> m (UInt8, BGResult))
-> ((UInt8, UInt8Array) -> m (UInt8, BGResult))
-> UInt8
-> UInt8Array
-> m (UInt8, BGResult)
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt8Array)
-> m (UInt8, BGResult)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsAttributeClient UInt8
0x0b

attclientWriteCommand
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt16 -> UInt8Array -> m (UInt8, BGResult)
attclientWriteCommand :: UInt8 -> UInt16 -> UInt8Array -> m (UInt8, BGResult)
attclientWriteCommand = ((UInt8, UInt16, UInt8Array) -> m (UInt8, BGResult))
-> UInt8 -> UInt16 -> UInt8Array -> m (UInt8, BGResult)
forall a b c d. ((a, b, c) -> d) -> a -> b -> c -> d
curry3 (((UInt8, UInt16, UInt8Array) -> m (UInt8, BGResult))
 -> UInt8 -> UInt16 -> UInt8Array -> m (UInt8, BGResult))
-> ((UInt8, UInt16, UInt8Array) -> m (UInt8, BGResult))
-> UInt8
-> UInt16
-> UInt8Array
-> m (UInt8, BGResult)
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt16, UInt8Array)
-> m (UInt8, BGResult)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsAttributeClient UInt8
0x06

evtAttclientAttributeValue
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (UInt8 -> UInt16 -> UInt8 -> UInt8Array -> m (Maybe a)) -> m a
evtAttclientAttributeValue :: (UInt8 -> UInt16 -> UInt8 -> UInt8Array -> m (Maybe a)) -> m a
evtAttclientAttributeValue
    = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ((UInt8, UInt16, UInt8, UInt8Array) -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsAttributeClient UInt8
0x05 (((UInt8, UInt16, UInt8, UInt8Array) -> m (Maybe a)) -> m a)
-> ((UInt8 -> UInt16 -> UInt8 -> UInt8Array -> m (Maybe a))
    -> (UInt8, UInt16, UInt8, UInt8Array) -> m (Maybe a))
-> (UInt8 -> UInt16 -> UInt8 -> UInt8Array -> m (Maybe a))
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt8 -> UInt16 -> UInt8 -> UInt8Array -> m (Maybe a))
-> (UInt8, UInt16, UInt8, UInt8Array) -> m (Maybe a)
forall a b c d e. (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
uncurry4

evtAttclientFindInformationFound
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (UInt8 -> UInt16 -> UInt8Array -> m (Maybe a)) -> m a
evtAttclientFindInformationFound :: (UInt8 -> UInt16 -> UInt8Array -> m (Maybe a)) -> m a
evtAttclientFindInformationFound
    = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ((UInt8, UInt16, UInt8Array) -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsAttributeClient UInt8
0x04 (((UInt8, UInt16, UInt8Array) -> m (Maybe a)) -> m a)
-> ((UInt8 -> UInt16 -> UInt8Array -> m (Maybe a))
    -> (UInt8, UInt16, UInt8Array) -> m (Maybe a))
-> (UInt8 -> UInt16 -> UInt8Array -> m (Maybe a))
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt8 -> UInt16 -> UInt8Array -> m (Maybe a))
-> (UInt8, UInt16, UInt8Array) -> m (Maybe a)
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3

evtAttclientGroupFound
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (UInt8 -> UInt16 -> UInt16 -> UInt8Array -> m (Maybe a)) -> m a
evtAttclientGroupFound :: (UInt8 -> UInt16 -> UInt16 -> UInt8Array -> m (Maybe a)) -> m a
evtAttclientGroupFound
    = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ((UInt8, UInt16, UInt16, UInt8Array) -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsAttributeClient UInt8
0x02 (((UInt8, UInt16, UInt16, UInt8Array) -> m (Maybe a)) -> m a)
-> ((UInt8 -> UInt16 -> UInt16 -> UInt8Array -> m (Maybe a))
    -> (UInt8, UInt16, UInt16, UInt8Array) -> m (Maybe a))
-> (UInt8 -> UInt16 -> UInt16 -> UInt8Array -> m (Maybe a))
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt8 -> UInt16 -> UInt16 -> UInt8Array -> m (Maybe a))
-> (UInt8, UInt16, UInt16, UInt8Array) -> m (Maybe a)
forall a b c d e. (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
uncurry4

evtAttclientIndicated
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (UInt8 -> UInt16 -> m (Maybe a)) -> m a
evtAttclientIndicated :: (UInt8 -> UInt16 -> m (Maybe a)) -> m a
evtAttclientIndicated
    = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ((UInt8, UInt16) -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsAttributeClient UInt8
0x00 (((UInt8, UInt16) -> m (Maybe a)) -> m a)
-> ((UInt8 -> UInt16 -> m (Maybe a))
    -> (UInt8, UInt16) -> m (Maybe a))
-> (UInt8 -> UInt16 -> m (Maybe a))
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt8 -> UInt16 -> m (Maybe a)) -> (UInt8, UInt16) -> m (Maybe a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry

evtAttclientProcedureCompleted
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (UInt8 -> BGResult -> UInt16 -> m (Maybe a)) -> m a
evtAttclientProcedureCompleted :: (UInt8 -> BGResult -> UInt16 -> m (Maybe a)) -> m a
evtAttclientProcedureCompleted
    = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ((UInt8, BGResult, UInt16) -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsAttributeClient UInt8
0x01 (((UInt8, BGResult, UInt16) -> m (Maybe a)) -> m a)
-> ((UInt8 -> BGResult -> UInt16 -> m (Maybe a))
    -> (UInt8, BGResult, UInt16) -> m (Maybe a))
-> (UInt8 -> BGResult -> UInt16 -> m (Maybe a))
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt8 -> BGResult -> UInt16 -> m (Maybe a))
-> (UInt8, BGResult, UInt16) -> m (Maybe a)
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3

evtAttclientReadMultipleResponse
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (UInt8 -> UInt8Array -> m (Maybe a)) -> m a
evtAttclientReadMultipleResponse :: (UInt8 -> UInt8Array -> m (Maybe a)) -> m a
evtAttclientReadMultipleResponse
    = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ((UInt8, UInt8Array) -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsAttributeClient UInt8
0x06 (((UInt8, UInt8Array) -> m (Maybe a)) -> m a)
-> ((UInt8 -> UInt8Array -> m (Maybe a))
    -> (UInt8, UInt8Array) -> m (Maybe a))
-> (UInt8 -> UInt8Array -> m (Maybe a))
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt8 -> UInt8Array -> m (Maybe a))
-> (UInt8, UInt8Array) -> m (Maybe a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry

-----------------------------------------------------------------------
-- Attribute Database
-----------------------------------------------------------------------

attributesRead
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt16 -> UInt16 -> m (UInt16, UInt16, BGResult, UInt8Array)
attributesRead :: UInt16 -> UInt16 -> m (UInt16, UInt16, BGResult, UInt8Array)
attributesRead = ((UInt16, UInt16) -> m (UInt16, UInt16, BGResult, UInt8Array))
-> UInt16 -> UInt16 -> m (UInt16, UInt16, BGResult, UInt8Array)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((UInt16, UInt16) -> m (UInt16, UInt16, BGResult, UInt8Array))
 -> UInt16 -> UInt16 -> m (UInt16, UInt16, BGResult, UInt8Array))
-> ((UInt16, UInt16) -> m (UInt16, UInt16, BGResult, UInt8Array))
-> UInt16
-> UInt16
-> m (UInt16, UInt16, BGResult, UInt8Array)
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt16, UInt16)
-> m (UInt16, UInt16, BGResult, UInt8Array)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsAttributeDatabase UInt8
0x01

attributesReadType
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt16 -> m (UInt16, BGResult, UInt8Array)
attributesReadType :: UInt16 -> m (UInt16, BGResult, UInt8Array)
attributesReadType = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> UInt16
-> m (UInt16, BGResult, UInt8Array)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsAttributeDatabase UInt8
0x02

attributesSend
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt16 -> UInt8Array -> m BGResult
attributesSend :: UInt8 -> UInt16 -> UInt8Array -> m BGResult
attributesSend = ((UInt8, UInt16, UInt8Array) -> m BGResult)
-> UInt8 -> UInt16 -> UInt8Array -> m BGResult
forall a b c d. ((a, b, c) -> d) -> a -> b -> c -> d
curry3 (((UInt8, UInt16, UInt8Array) -> m BGResult)
 -> UInt8 -> UInt16 -> UInt8Array -> m BGResult)
-> ((UInt8, UInt16, UInt8Array) -> m BGResult)
-> UInt8
-> UInt16
-> UInt8Array
-> m BGResult
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt16, UInt8Array)
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsAttributeDatabase UInt8
0x05

attributesUserReadResponse
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt8 -> UInt8Array -> m ()
attributesUserReadResponse :: UInt8 -> UInt8 -> UInt8Array -> m ()
attributesUserReadResponse = ((UInt8, UInt8, UInt8Array) -> m ())
-> UInt8 -> UInt8 -> UInt8Array -> m ()
forall a b c d. ((a, b, c) -> d) -> a -> b -> c -> d
curry3 (((UInt8, UInt8, UInt8Array) -> m ())
 -> UInt8 -> UInt8 -> UInt8Array -> m ())
-> ((UInt8, UInt8, UInt8Array) -> m ())
-> UInt8
-> UInt8
-> UInt8Array
-> m ()
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt8, UInt8Array)
-> m ()
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsAttributeDatabase UInt8
0x03

attributesUserWriteResponse
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt8 -> m ()
attributesUserWriteResponse :: UInt8 -> UInt8 -> m ()
attributesUserWriteResponse = ((UInt8, UInt8) -> m ()) -> UInt8 -> UInt8 -> m ()
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((UInt8, UInt8) -> m ()) -> UInt8 -> UInt8 -> m ())
-> ((UInt8, UInt8) -> m ()) -> UInt8 -> UInt8 -> m ()
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt8)
-> m ()
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsAttributeDatabase UInt8
0x04

attributesWrite
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt16 -> UInt8 -> UInt8Array -> m BGResult
attributesWrite :: UInt16 -> UInt8 -> UInt8Array -> m BGResult
attributesWrite = ((UInt16, UInt8, UInt8Array) -> m BGResult)
-> UInt16 -> UInt8 -> UInt8Array -> m BGResult
forall a b c d. ((a, b, c) -> d) -> a -> b -> c -> d
curry3 (((UInt16, UInt8, UInt8Array) -> m BGResult)
 -> UInt16 -> UInt8 -> UInt8Array -> m BGResult)
-> ((UInt16, UInt8, UInt8Array) -> m BGResult)
-> UInt16
-> UInt8
-> UInt8Array
-> m BGResult
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt16, UInt8, UInt8Array)
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsAttributeDatabase UInt8
0x00

evtAttributesStatus
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (UInt16 -> UInt8 -> m (Maybe a)) -> m a
evtAttributesStatus :: (UInt16 -> UInt8 -> m (Maybe a)) -> m a
evtAttributesStatus
    = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ((UInt16, UInt8) -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsAttributeDatabase UInt8
0x02 (((UInt16, UInt8) -> m (Maybe a)) -> m a)
-> ((UInt16 -> UInt8 -> m (Maybe a))
    -> (UInt16, UInt8) -> m (Maybe a))
-> (UInt16 -> UInt8 -> m (Maybe a))
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt16 -> UInt8 -> m (Maybe a)) -> (UInt16, UInt8) -> m (Maybe a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry

evtAttributesUserReadRequest
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (UInt8 -> UInt16 -> UInt16 -> UInt8 -> m (Maybe a)) -> m a
evtAttributesUserReadRequest :: (UInt8 -> UInt16 -> UInt16 -> UInt8 -> m (Maybe a)) -> m a
evtAttributesUserReadRequest
    = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ((UInt8, UInt16, UInt16, UInt8) -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsAttributeDatabase UInt8
0x01 (((UInt8, UInt16, UInt16, UInt8) -> m (Maybe a)) -> m a)
-> ((UInt8 -> UInt16 -> UInt16 -> UInt8 -> m (Maybe a))
    -> (UInt8, UInt16, UInt16, UInt8) -> m (Maybe a))
-> (UInt8 -> UInt16 -> UInt16 -> UInt8 -> m (Maybe a))
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt8 -> UInt16 -> UInt16 -> UInt8 -> m (Maybe a))
-> (UInt8, UInt16, UInt16, UInt8) -> m (Maybe a)
forall a b c d e. (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
uncurry4

evtAttributesValue
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (UInt8 -> UInt8 -> UInt16 -> UInt16 -> UInt8Array -> m (Maybe a)) -> m a
evtAttributesValue :: (UInt8 -> UInt8 -> UInt16 -> UInt16 -> UInt8Array -> m (Maybe a))
-> m a
evtAttributesValue
    = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ((UInt8, UInt8, UInt16, UInt16, UInt8Array) -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsAttributeDatabase UInt8
0x00 (((UInt8, UInt8, UInt16, UInt16, UInt8Array) -> m (Maybe a))
 -> m a)
-> ((UInt8
     -> UInt8 -> UInt16 -> UInt16 -> UInt8Array -> m (Maybe a))
    -> (UInt8, UInt8, UInt16, UInt16, UInt8Array) -> m (Maybe a))
-> (UInt8
    -> UInt8 -> UInt16 -> UInt16 -> UInt8Array -> m (Maybe a))
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt8 -> UInt8 -> UInt16 -> UInt16 -> UInt8Array -> m (Maybe a))
-> (UInt8, UInt8, UInt16, UInt16, UInt8Array) -> m (Maybe a)
forall a b c d e f.
(a -> b -> c -> d -> e -> f) -> (a, b, c, d, e) -> f
uncurry5

-----------------------------------------------------------------------
-- Connection
-----------------------------------------------------------------------

connectionChannelMapGet
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> m (UInt8, UInt8Array)
connectionChannelMapGet :: UInt8 -> m (UInt8, UInt8Array)
connectionChannelMapGet = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> UInt8
-> m (UInt8, UInt8Array)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsConnection UInt8
0x04

connectionChannelMapSet
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt8Array -> m (UInt8, BGResult)
connectionChannelMapSet :: UInt8 -> UInt8Array -> m (UInt8, BGResult)
connectionChannelMapSet = ((UInt8, UInt8Array) -> m (UInt8, BGResult))
-> UInt8 -> UInt8Array -> m (UInt8, BGResult)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((UInt8, UInt8Array) -> m (UInt8, BGResult))
 -> UInt8 -> UInt8Array -> m (UInt8, BGResult))
-> ((UInt8, UInt8Array) -> m (UInt8, BGResult))
-> UInt8
-> UInt8Array
-> m (UInt8, BGResult)
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt8Array)
-> m (UInt8, BGResult)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsConnection UInt8
0x05

connectionDisconnect
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> m (UInt8, BGResult)
connectionDisconnect :: UInt8 -> m (UInt8, BGResult)
connectionDisconnect = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> UInt8
-> m (UInt8, BGResult)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsConnection UInt8
0x00

connectionGetRssi
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> m (UInt8, Int8)
connectionGetRssi :: UInt8 -> m (UInt8, Int8)
connectionGetRssi = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> UInt8
-> m (UInt8, Int8)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsConnection UInt8
0x01

connectionGetStatus
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> m UInt8
connectionGetStatus :: UInt8 -> m UInt8
connectionGetStatus = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> UInt8 -> m UInt8
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsConnection UInt8
0x07

connectionSlaveLatencyDisable
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> m BGResult
connectionSlaveLatencyDisable :: UInt8 -> m BGResult
connectionSlaveLatencyDisable = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> UInt8
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsConnection UInt8
0x09

connectionUpdate
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt16 -> UInt16 -> UInt16 -> UInt16 -> m (UInt8, BGResult)
connectionUpdate :: UInt8
-> UInt16 -> UInt16 -> UInt16 -> UInt16 -> m (UInt8, BGResult)
connectionUpdate = ((UInt8, UInt16, UInt16, UInt16, UInt16) -> m (UInt8, BGResult))
-> UInt8
-> UInt16
-> UInt16
-> UInt16
-> UInt16
-> m (UInt8, BGResult)
forall a b c d e f.
((a, b, c, d, e) -> f) -> a -> b -> c -> d -> e -> f
curry5 (((UInt8, UInt16, UInt16, UInt16, UInt16) -> m (UInt8, BGResult))
 -> UInt8
 -> UInt16
 -> UInt16
 -> UInt16
 -> UInt16
 -> m (UInt8, BGResult))
-> ((UInt8, UInt16, UInt16, UInt16, UInt16) -> m (UInt8, BGResult))
-> UInt8
-> UInt16
-> UInt16
-> UInt16
-> UInt16
-> m (UInt8, BGResult)
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt16, UInt16, UInt16, UInt16)
-> m (UInt8, BGResult)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsConnection UInt8
0x02

connectionVersionUpdate
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> m (UInt8, BGResult)
connectionVersionUpdate :: UInt8 -> m (UInt8, BGResult)
connectionVersionUpdate = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> UInt8
-> m (UInt8, BGResult)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsConnection UInt8
0x03

evtConnectionDisconnected
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (UInt8 -> BGResult -> m (Maybe a)) -> m a
evtConnectionDisconnected :: (UInt8 -> BGResult -> m (Maybe a)) -> m a
evtConnectionDisconnected
    = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ((UInt8, BGResult) -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsConnection UInt8
0x04 (((UInt8, BGResult) -> m (Maybe a)) -> m a)
-> ((UInt8 -> BGResult -> m (Maybe a))
    -> (UInt8, BGResult) -> m (Maybe a))
-> (UInt8 -> BGResult -> m (Maybe a))
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt8 -> BGResult -> m (Maybe a))
-> (UInt8, BGResult) -> m (Maybe a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry

evtConnectionFeatureInd
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (UInt8 -> UInt8Array -> m (Maybe a)) -> m a
evtConnectionFeatureInd :: (UInt8 -> UInt8Array -> m (Maybe a)) -> m a
evtConnectionFeatureInd = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ((UInt8, UInt8Array) -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsConnection UInt8
0x02 (((UInt8, UInt8Array) -> m (Maybe a)) -> m a)
-> ((UInt8 -> UInt8Array -> m (Maybe a))
    -> (UInt8, UInt8Array) -> m (Maybe a))
-> (UInt8 -> UInt8Array -> m (Maybe a))
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt8 -> UInt8Array -> m (Maybe a))
-> (UInt8, UInt8Array) -> m (Maybe a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry

evtConnectionStatus
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (UInt8 -> UInt8 -> BdAddr -> UInt8 -> UInt16 -> UInt16 -> UInt16 -> UInt8 -> m (Maybe a))
    -> m a
evtConnectionStatus :: (UInt8
 -> UInt8
 -> BdAddr
 -> UInt8
 -> UInt16
 -> UInt16
 -> UInt16
 -> UInt8
 -> m (Maybe a))
-> m a
evtConnectionStatus = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ((UInt8, UInt8, BdAddr, UInt8, UInt16, UInt16, UInt16, UInt8)
    -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsConnection UInt8
0x00 (((UInt8, UInt8, BdAddr, UInt8, UInt16, UInt16, UInt16, UInt8)
  -> m (Maybe a))
 -> m a)
-> ((UInt8
     -> UInt8
     -> BdAddr
     -> UInt8
     -> UInt16
     -> UInt16
     -> UInt16
     -> UInt8
     -> m (Maybe a))
    -> (UInt8, UInt8, BdAddr, UInt8, UInt16, UInt16, UInt16, UInt8)
    -> m (Maybe a))
-> (UInt8
    -> UInt8
    -> BdAddr
    -> UInt8
    -> UInt16
    -> UInt16
    -> UInt16
    -> UInt8
    -> m (Maybe a))
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt8
 -> UInt8
 -> BdAddr
 -> UInt8
 -> UInt16
 -> UInt16
 -> UInt16
 -> UInt8
 -> m (Maybe a))
-> (UInt8, UInt8, BdAddr, UInt8, UInt16, UInt16, UInt16, UInt8)
-> m (Maybe a)
forall a b c d e f g h i.
(a -> b -> c -> d -> e -> f -> g -> h -> i)
-> (a, b, c, d, e, f, g, h) -> i
uncurry8

evtConnectionVersionInd
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (UInt8 -> UInt8 -> UInt16 -> UInt16 -> m (Maybe a)) -> m a
evtConnectionVersionInd :: (UInt8 -> UInt8 -> UInt16 -> UInt16 -> m (Maybe a)) -> m a
evtConnectionVersionInd = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ((UInt8, UInt8, UInt16, UInt16) -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsConnection UInt8
0x01 (((UInt8, UInt8, UInt16, UInt16) -> m (Maybe a)) -> m a)
-> ((UInt8 -> UInt8 -> UInt16 -> UInt16 -> m (Maybe a))
    -> (UInt8, UInt8, UInt16, UInt16) -> m (Maybe a))
-> (UInt8 -> UInt8 -> UInt16 -> UInt16 -> m (Maybe a))
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt8 -> UInt8 -> UInt16 -> UInt16 -> m (Maybe a))
-> (UInt8, UInt8, UInt16, UInt16) -> m (Maybe a)
forall a b c d e. (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
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 :: BdAddr
-> GapAddressType
-> UInt16
-> UInt16
-> UInt16
-> UInt16
-> m (BGResult, UInt8)
gapConnectDirect = ((BdAddr, GapAddressType, UInt16, UInt16, UInt16, UInt16)
 -> m (BGResult, UInt8))
-> BdAddr
-> GapAddressType
-> UInt16
-> UInt16
-> UInt16
-> UInt16
-> m (BGResult, UInt8)
forall a b c d e f g.
((a, b, c, d, e, f) -> g) -> a -> b -> c -> d -> e -> f -> g
curry6 (((BdAddr, GapAddressType, UInt16, UInt16, UInt16, UInt16)
  -> m (BGResult, UInt8))
 -> BdAddr
 -> GapAddressType
 -> UInt16
 -> UInt16
 -> UInt16
 -> UInt16
 -> m (BGResult, UInt8))
-> ((BdAddr, GapAddressType, UInt16, UInt16, UInt16, UInt16)
    -> m (BGResult, UInt8))
-> BdAddr
-> GapAddressType
-> UInt16
-> UInt16
-> UInt16
-> UInt16
-> m (BGResult, UInt8)
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (BdAddr, GapAddressType, UInt16, UInt16, UInt16, UInt16)
-> m (BGResult, UInt8)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsGenericAccessProfile UInt8
0x03

gapConnectSelective
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt16 -> UInt16 -> UInt16 -> UInt16 -> m (BGResult, UInt8)
gapConnectSelective :: UInt16 -> UInt16 -> UInt16 -> UInt16 -> m (BGResult, UInt8)
gapConnectSelective = ((UInt16, UInt16, UInt16, UInt16) -> m (BGResult, UInt8))
-> UInt16 -> UInt16 -> UInt16 -> UInt16 -> m (BGResult, UInt8)
forall a b c d e. ((a, b, c, d) -> e) -> a -> b -> c -> d -> e
curry4 (((UInt16, UInt16, UInt16, UInt16) -> m (BGResult, UInt8))
 -> UInt16 -> UInt16 -> UInt16 -> UInt16 -> m (BGResult, UInt8))
-> ((UInt16, UInt16, UInt16, UInt16) -> m (BGResult, UInt8))
-> UInt16
-> UInt16
-> UInt16
-> UInt16
-> m (BGResult, UInt8)
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt16, UInt16, UInt16, UInt16)
-> m (BGResult, UInt8)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsGenericAccessProfile UInt8
0x05

gapDiscover
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => GapDiscoverMode -> m UInt16
gapDiscover :: GapDiscoverMode -> m UInt16
gapDiscover = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> GapDiscoverMode
-> m UInt16
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsGenericAccessProfile UInt8
0x02

gapEndProcedure
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => m UInt16
gapEndProcedure :: m UInt16
gapEndProcedure = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> () -> m UInt16
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsGenericAccessProfile UInt8
0x04 ()

gapSetAdvData
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt8Array -> m BGResult
gapSetAdvData :: UInt8 -> UInt8Array -> m BGResult
gapSetAdvData = ((UInt8, UInt8Array) -> m BGResult)
-> UInt8 -> UInt8Array -> m BGResult
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((UInt8, UInt8Array) -> m BGResult)
 -> UInt8 -> UInt8Array -> m BGResult)
-> ((UInt8, UInt8Array) -> m BGResult)
-> UInt8
-> UInt8Array
-> m BGResult
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt8Array)
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsGenericAccessProfile UInt8
0x09

gapSetAdvParameters
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt16 -> UInt16 -> UInt8 -> m BGResult
gapSetAdvParameters :: UInt16 -> UInt16 -> UInt8 -> m BGResult
gapSetAdvParameters = ((UInt16, UInt16, UInt8) -> m BGResult)
-> UInt16 -> UInt16 -> UInt8 -> m BGResult
forall a b c d. ((a, b, c) -> d) -> a -> b -> c -> d
curry3 (((UInt16, UInt16, UInt8) -> m BGResult)
 -> UInt16 -> UInt16 -> UInt8 -> m BGResult)
-> ((UInt16, UInt16, UInt8) -> m BGResult)
-> UInt16
-> UInt16
-> UInt8
-> m BGResult
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt16, UInt16, UInt8)
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsGenericAccessProfile UInt8
0x08

gapSetDirectedConnectableMode
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => BdAddr -> GapAddressType -> m BGResult
gapSetDirectedConnectableMode :: BdAddr -> GapAddressType -> m BGResult
gapSetDirectedConnectableMode = ((BdAddr, GapAddressType) -> m BGResult)
-> BdAddr -> GapAddressType -> m BGResult
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((BdAddr, GapAddressType) -> m BGResult)
 -> BdAddr -> GapAddressType -> m BGResult)
-> ((BdAddr, GapAddressType) -> m BGResult)
-> BdAddr
-> GapAddressType
-> m BGResult
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (BdAddr, GapAddressType)
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsGenericAccessProfile UInt8
0x0a

gapSetFiltering
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => GapScanPolicy -> GapAdvPolicy -> UInt8 -> m BGResult
gapSetFiltering :: GapScanPolicy -> GapAdvPolicy -> UInt8 -> m BGResult
gapSetFiltering = ((GapScanPolicy, GapAdvPolicy, UInt8) -> m BGResult)
-> GapScanPolicy -> GapAdvPolicy -> UInt8 -> m BGResult
forall a b c d. ((a, b, c) -> d) -> a -> b -> c -> d
curry3 (((GapScanPolicy, GapAdvPolicy, UInt8) -> m BGResult)
 -> GapScanPolicy -> GapAdvPolicy -> UInt8 -> m BGResult)
-> ((GapScanPolicy, GapAdvPolicy, UInt8) -> m BGResult)
-> GapScanPolicy
-> GapAdvPolicy
-> UInt8
-> m BGResult
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (GapScanPolicy, GapAdvPolicy, UInt8)
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsGenericAccessProfile UInt8
0x06

gapSetInitiatingConParameters
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt16 -> UInt16 -> m BGResult
gapSetInitiatingConParameters :: UInt16 -> UInt16 -> m BGResult
gapSetInitiatingConParameters = ((UInt16, UInt16) -> m BGResult) -> UInt16 -> UInt16 -> m BGResult
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((UInt16, UInt16) -> m BGResult)
 -> UInt16 -> UInt16 -> m BGResult)
-> ((UInt16, UInt16) -> m BGResult)
-> UInt16
-> UInt16
-> m BGResult
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt16, UInt16)
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsGenericAccessProfile UInt8
0x0b

gapSetMode
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => GapDiscoverableMode -> GapConnectableMode -> m BGResult
gapSetMode :: GapDiscoverableMode -> GapConnectableMode -> m BGResult
gapSetMode = ((GapDiscoverableMode, GapConnectableMode) -> m BGResult)
-> GapDiscoverableMode -> GapConnectableMode -> m BGResult
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((GapDiscoverableMode, GapConnectableMode) -> m BGResult)
 -> GapDiscoverableMode -> GapConnectableMode -> m BGResult)
-> ((GapDiscoverableMode, GapConnectableMode) -> m BGResult)
-> GapDiscoverableMode
-> GapConnectableMode
-> m BGResult
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (GapDiscoverableMode, GapConnectableMode)
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsGenericAccessProfile UInt8
0x01

gapSetNonresolvableAddress
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => BdAddr -> m BGResult
gapSetNonresolvableAddress :: BdAddr -> m BGResult
gapSetNonresolvableAddress = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> BdAddr
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsGenericAccessProfile UInt8
0x0c

gapSetPrivacyFlags
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt8 -> m ()
gapSetPrivacyFlags :: UInt8 -> UInt8 -> m ()
gapSetPrivacyFlags = ((UInt8, UInt8) -> m ()) -> UInt8 -> UInt8 -> m ()
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((UInt8, UInt8) -> m ()) -> UInt8 -> UInt8 -> m ())
-> ((UInt8, UInt8) -> m ()) -> UInt8 -> UInt8 -> m ()
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt8)
-> m ()
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsGenericAccessProfile UInt8
0x00

gapSetScanParameters
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt16 -> UInt16 -> UInt8 -> m BGResult
gapSetScanParameters :: UInt16 -> UInt16 -> UInt8 -> m BGResult
gapSetScanParameters = ((UInt16, UInt16, UInt8) -> m BGResult)
-> UInt16 -> UInt16 -> UInt8 -> m BGResult
forall a b c d. ((a, b, c) -> d) -> a -> b -> c -> d
curry3 (((UInt16, UInt16, UInt8) -> m BGResult)
 -> UInt16 -> UInt16 -> UInt8 -> m BGResult)
-> ((UInt16, UInt16, UInt8) -> m BGResult)
-> UInt16
-> UInt16
-> UInt8
-> m BGResult
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt16, UInt16, UInt8)
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsGenericAccessProfile UInt8
0x07

-- Register an event handler for GAP scan responses
evtGapScanResponse
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (Int8 -> UInt8 -> BdAddr -> GapAddressType -> UInt8 -> UInt8Array -> m (Maybe a)) -> m a
evtGapScanResponse :: (Int8
 -> UInt8
 -> BdAddr
 -> GapAddressType
 -> UInt8
 -> UInt8Array
 -> m (Maybe a))
-> m a
evtGapScanResponse
    = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ((Int8, UInt8, BdAddr, GapAddressType, UInt8, UInt8Array)
    -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsGenericAccessProfile UInt8
0x00 (((Int8, UInt8, BdAddr, GapAddressType, UInt8, UInt8Array)
  -> m (Maybe a))
 -> m a)
-> ((Int8
     -> UInt8
     -> BdAddr
     -> GapAddressType
     -> UInt8
     -> UInt8Array
     -> m (Maybe a))
    -> (Int8, UInt8, BdAddr, GapAddressType, UInt8, UInt8Array)
    -> m (Maybe a))
-> (Int8
    -> UInt8
    -> BdAddr
    -> GapAddressType
    -> UInt8
    -> UInt8Array
    -> m (Maybe a))
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int8
 -> UInt8
 -> BdAddr
 -> GapAddressType
 -> UInt8
 -> UInt8Array
 -> m (Maybe a))
-> (Int8, UInt8, BdAddr, GapAddressType, UInt8, UInt8Array)
-> m (Maybe a)
forall a b c d e f g.
(a -> b -> c -> d -> e -> f -> g) -> (a, b, c, d, e, f) -> g
uncurry6

-----------------------------------------------------------------------
-- Hardware
-----------------------------------------------------------------------

hardwareAdcRead
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt8 -> UInt8 -> m BGResult
hardwareAdcRead :: UInt8 -> UInt8 -> UInt8 -> m BGResult
hardwareAdcRead = ((UInt8, UInt8, UInt8) -> m BGResult)
-> UInt8 -> UInt8 -> UInt8 -> m BGResult
forall a b c d. ((a, b, c) -> d) -> a -> b -> c -> d
curry3 (((UInt8, UInt8, UInt8) -> m BGResult)
 -> UInt8 -> UInt8 -> UInt8 -> m BGResult)
-> ((UInt8, UInt8, UInt8) -> m BGResult)
-> UInt8
-> UInt8
-> UInt8
-> m BGResult
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt8, UInt8)
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsHardware UInt8
0x02

hardwareAnalogComparatorConfigIrq
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => Bool -> m BGResult
hardwareAnalogComparatorConfigIrq :: Bool -> m BGResult
hardwareAnalogComparatorConfigIrq = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> Bool -> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsHardware UInt8
0x12

hardwareAnalogComparatorEnable
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => Bool -> m ()
hardwareAnalogComparatorEnable :: Bool -> m ()
hardwareAnalogComparatorEnable = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> Bool -> m ()
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsHardware UInt8
0x10

hardwareAnalogComparatorRead
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => m (BGResult, UInt8)
hardwareAnalogComparatorRead :: m (BGResult, UInt8)
hardwareAnalogComparatorRead = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ()
-> m (BGResult, UInt8)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsHardware UInt8
0x11 ()

hardwareGetTimestamp
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => m UInt32
hardwareGetTimestamp :: m UInt32
hardwareGetTimestamp = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> () -> m UInt32
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsHardware UInt8
0x16 ()

hardwareI2cRead
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> Bool -> UInt8 -> m (UInt16, UInt8Array)
hardwareI2cRead :: UInt8 -> Bool -> UInt8 -> m (UInt16, UInt8Array)
hardwareI2cRead = ((UInt8, Bool, UInt8) -> m (UInt16, UInt8Array))
-> UInt8 -> Bool -> UInt8 -> m (UInt16, UInt8Array)
forall a b c d. ((a, b, c) -> d) -> a -> b -> c -> d
curry3 (((UInt8, Bool, UInt8) -> m (UInt16, UInt8Array))
 -> UInt8 -> Bool -> UInt8 -> m (UInt16, UInt8Array))
-> ((UInt8, Bool, UInt8) -> m (UInt16, UInt8Array))
-> UInt8
-> Bool
-> UInt8
-> m (UInt16, UInt8Array)
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, Bool, UInt8)
-> m (UInt16, UInt8Array)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsHardware UInt8
0x0a

hardwareI2cWrite
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> Bool -> UInt8Array -> m UInt8
hardwareI2cWrite :: UInt8 -> Bool -> UInt8Array -> m UInt8
hardwareI2cWrite = ((UInt8, Bool, UInt8Array) -> m UInt8)
-> UInt8 -> Bool -> UInt8Array -> m UInt8
forall a b c d. ((a, b, c) -> d) -> a -> b -> c -> d
curry3 (((UInt8, Bool, UInt8Array) -> m UInt8)
 -> UInt8 -> Bool -> UInt8Array -> m UInt8)
-> ((UInt8, Bool, UInt8Array) -> m UInt8)
-> UInt8
-> Bool
-> UInt8Array
-> m UInt8
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, Bool, UInt8Array)
-> m UInt8
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsHardware UInt8
0x0b

hardwareIoPortConfigDirection
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt8 -> m BGResult
hardwareIoPortConfigDirection :: UInt8 -> UInt8 -> m BGResult
hardwareIoPortConfigDirection = ((UInt8, UInt8) -> m BGResult) -> UInt8 -> UInt8 -> m BGResult
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((UInt8, UInt8) -> m BGResult) -> UInt8 -> UInt8 -> m BGResult)
-> ((UInt8, UInt8) -> m BGResult) -> UInt8 -> UInt8 -> m BGResult
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt8)
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsHardware UInt8
0x03

hardwareIoPortConfigFunction
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt8 -> m BGResult
hardwareIoPortConfigFunction :: UInt8 -> UInt8 -> m BGResult
hardwareIoPortConfigFunction = ((UInt8, UInt8) -> m BGResult) -> UInt8 -> UInt8 -> m BGResult
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((UInt8, UInt8) -> m BGResult) -> UInt8 -> UInt8 -> m BGResult)
-> ((UInt8, UInt8) -> m BGResult) -> UInt8 -> UInt8 -> m BGResult
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt8)
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsHardware UInt8
0x04

hardwareIoPortConfigIrq
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt8 -> Bool -> m BGResult
hardwareIoPortConfigIrq :: UInt8 -> UInt8 -> Bool -> m BGResult
hardwareIoPortConfigIrq = ((UInt8, UInt8, Bool) -> m BGResult)
-> UInt8 -> UInt8 -> Bool -> m BGResult
forall a b c d. ((a, b, c) -> d) -> a -> b -> c -> d
curry3 (((UInt8, UInt8, Bool) -> m BGResult)
 -> UInt8 -> UInt8 -> Bool -> m BGResult)
-> ((UInt8, UInt8, Bool) -> m BGResult)
-> UInt8
-> UInt8
-> Bool
-> m BGResult
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt8, Bool)
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsHardware UInt8
0x00

hardwareIoPortConfigPull
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt8 -> Bool -> m BGResult
hardwareIoPortConfigPull :: UInt8 -> UInt8 -> Bool -> m BGResult
hardwareIoPortConfigPull = ((UInt8, UInt8, Bool) -> m BGResult)
-> UInt8 -> UInt8 -> Bool -> m BGResult
forall a b c d. ((a, b, c) -> d) -> a -> b -> c -> d
curry3 (((UInt8, UInt8, Bool) -> m BGResult)
 -> UInt8 -> UInt8 -> Bool -> m BGResult)
-> ((UInt8, UInt8, Bool) -> m BGResult)
-> UInt8
-> UInt8
-> Bool
-> m BGResult
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt8, Bool)
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsHardware UInt8
0x05

hardwareIoPortIrqDirection
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> Bool -> m BGResult
hardwareIoPortIrqDirection :: UInt8 -> Bool -> m BGResult
hardwareIoPortIrqDirection = ((UInt8, Bool) -> m BGResult) -> UInt8 -> Bool -> m BGResult
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((UInt8, Bool) -> m BGResult) -> UInt8 -> Bool -> m BGResult)
-> ((UInt8, Bool) -> m BGResult) -> UInt8 -> Bool -> m BGResult
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, Bool)
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsHardware UInt8
0x0f

hardwareIoPortIrqEnable
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt8 -> m BGResult
hardwareIoPortIrqEnable :: UInt8 -> UInt8 -> m BGResult
hardwareIoPortIrqEnable = ((UInt8, UInt8) -> m BGResult) -> UInt8 -> UInt8 -> m BGResult
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((UInt8, UInt8) -> m BGResult) -> UInt8 -> UInt8 -> m BGResult)
-> ((UInt8, UInt8) -> m BGResult) -> UInt8 -> UInt8 -> m BGResult
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt8)
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsHardware UInt8
0x0e

hardwareIoPortRead
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt8 -> m (BGResult, UInt8, UInt8)
hardwareIoPortRead :: UInt8 -> UInt8 -> m (BGResult, UInt8, UInt8)
hardwareIoPortRead = ((UInt8, UInt8) -> m (BGResult, UInt8, UInt8))
-> UInt8 -> UInt8 -> m (BGResult, UInt8, UInt8)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((UInt8, UInt8) -> m (BGResult, UInt8, UInt8))
 -> UInt8 -> UInt8 -> m (BGResult, UInt8, UInt8))
-> ((UInt8, UInt8) -> m (BGResult, UInt8, UInt8))
-> UInt8
-> UInt8
-> m (BGResult, UInt8, UInt8)
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt8)
-> m (BGResult, UInt8, UInt8)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsHardware UInt8
0x07

hardwareIoPortWrite
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt8 -> UInt8 -> m BGResult
hardwareIoPortWrite :: UInt8 -> UInt8 -> UInt8 -> m BGResult
hardwareIoPortWrite = ((UInt8, UInt8, UInt8) -> m BGResult)
-> UInt8 -> UInt8 -> UInt8 -> m BGResult
forall a b c d. ((a, b, c) -> d) -> a -> b -> c -> d
curry3 (((UInt8, UInt8, UInt8) -> m BGResult)
 -> UInt8 -> UInt8 -> UInt8 -> m BGResult)
-> ((UInt8, UInt8, UInt8) -> m BGResult)
-> UInt8
-> UInt8
-> UInt8
-> m BGResult
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt8, UInt8)
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsHardware UInt8
0x06

hardwareSetRxgain
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> m ()
hardwareSetRxgain :: UInt8 -> m ()
hardwareSetRxgain = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> UInt8 -> m ()
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsHardware UInt8
0x13

hardwareSetSoftTimer
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt32 -> UInt8 -> Bool -> m BGResult
hardwareSetSoftTimer :: UInt32 -> UInt8 -> Bool -> m BGResult
hardwareSetSoftTimer = ((UInt32, UInt8, Bool) -> m BGResult)
-> UInt32 -> UInt8 -> Bool -> m BGResult
forall a b c d. ((a, b, c) -> d) -> a -> b -> c -> d
curry3 (((UInt32, UInt8, Bool) -> m BGResult)
 -> UInt32 -> UInt8 -> Bool -> m BGResult)
-> ((UInt32, UInt8, Bool) -> m BGResult)
-> UInt32
-> UInt8
-> Bool
-> m BGResult
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt32, UInt8, Bool)
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsHardware UInt8
0x01

hardwareSetTxpower
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> m ()
hardwareSetTxpower :: UInt8 -> m ()
hardwareSetTxpower = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> UInt8 -> m ()
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsHardware UInt8
0x0c

hardwareSleepEnable
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => Bool -> m BGResult
hardwareSleepEnable :: Bool -> m BGResult
hardwareSleepEnable = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> Bool -> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsHardware UInt8
0x15

hardwareSpiConfig
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => Bool -> Bool -> Bool -> Bool -> UInt8 -> UInt8 -> m BGResult
hardwareSpiConfig :: Bool -> Bool -> Bool -> Bool -> UInt8 -> UInt8 -> m BGResult
hardwareSpiConfig = ((Bool, Bool, Bool, Bool, UInt8, UInt8) -> m BGResult)
-> Bool -> Bool -> Bool -> Bool -> UInt8 -> UInt8 -> m BGResult
forall a b c d e f g.
((a, b, c, d, e, f) -> g) -> a -> b -> c -> d -> e -> f -> g
curry6 (((Bool, Bool, Bool, Bool, UInt8, UInt8) -> m BGResult)
 -> Bool -> Bool -> Bool -> Bool -> UInt8 -> UInt8 -> m BGResult)
-> ((Bool, Bool, Bool, Bool, UInt8, UInt8) -> m BGResult)
-> Bool
-> Bool
-> Bool
-> Bool
-> UInt8
-> UInt8
-> m BGResult
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (Bool, Bool, Bool, Bool, UInt8, UInt8)
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsHardware UInt8
0x08

hardwareSpiTransfer
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt8Array -> m (BGResult, UInt8, UInt8Array)
hardwareSpiTransfer :: UInt8 -> UInt8Array -> m (BGResult, UInt8, UInt8Array)
hardwareSpiTransfer = ((UInt8, UInt8Array) -> m (BGResult, UInt8, UInt8Array))
-> UInt8 -> UInt8Array -> m (BGResult, UInt8, UInt8Array)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((UInt8, UInt8Array) -> m (BGResult, UInt8, UInt8Array))
 -> UInt8 -> UInt8Array -> m (BGResult, UInt8, UInt8Array))
-> ((UInt8, UInt8Array) -> m (BGResult, UInt8, UInt8Array))
-> UInt8
-> UInt8Array
-> m (BGResult, UInt8, UInt8Array)
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt8Array)
-> m (BGResult, UInt8, UInt8Array)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsHardware UInt8
0x09

hardwareTimerComparator
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt8 -> UInt8 -> UInt16 -> m BGResult
hardwareTimerComparator :: UInt8 -> UInt8 -> UInt8 -> UInt16 -> m BGResult
hardwareTimerComparator = ((UInt8, UInt8, UInt8, UInt16) -> m BGResult)
-> UInt8 -> UInt8 -> UInt8 -> UInt16 -> m BGResult
forall a b c d e. ((a, b, c, d) -> e) -> a -> b -> c -> d -> e
curry4 (((UInt8, UInt8, UInt8, UInt16) -> m BGResult)
 -> UInt8 -> UInt8 -> UInt8 -> UInt16 -> m BGResult)
-> ((UInt8, UInt8, UInt8, UInt16) -> m BGResult)
-> UInt8
-> UInt8
-> UInt8
-> UInt16
-> m BGResult
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt8, UInt8, UInt16)
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsHardware UInt8
0x0d

hardwareUsbEnable
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => Bool -> m BGResult
hardwareUsbEnable :: Bool -> m BGResult
hardwareUsbEnable = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> Bool -> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsHardware UInt8
0x14

evtHardwareAdcResult
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (UInt8 -> UInt16 -> m (Maybe a)) -> m a
evtHardwareAdcResult :: (UInt8 -> UInt16 -> m (Maybe a)) -> m a
evtHardwareAdcResult
    = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ((UInt8, UInt16) -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsHardware UInt8
0x02 (((UInt8, UInt16) -> m (Maybe a)) -> m a)
-> ((UInt8 -> UInt16 -> m (Maybe a))
    -> (UInt8, UInt16) -> m (Maybe a))
-> (UInt8 -> UInt16 -> m (Maybe a))
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt8 -> UInt16 -> m (Maybe a)) -> (UInt8, UInt16) -> m (Maybe a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry

evtHardwareAnalogComparatorStatus
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (UInt32 -> UInt8 -> m (Maybe a)) -> m a
evtHardwareAnalogComparatorStatus :: (UInt32 -> UInt8 -> m (Maybe a)) -> m a
evtHardwareAnalogComparatorStatus
    = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ((UInt32, UInt8) -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsHardware UInt8
0x03 (((UInt32, UInt8) -> m (Maybe a)) -> m a)
-> ((UInt32 -> UInt8 -> m (Maybe a))
    -> (UInt32, UInt8) -> m (Maybe a))
-> (UInt32 -> UInt8 -> m (Maybe a))
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt32 -> UInt8 -> m (Maybe a)) -> (UInt32, UInt8) -> m (Maybe a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry

evtHardwareIoPortStatus
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (UInt32 -> UInt8 -> UInt8 -> UInt8 -> m (Maybe a)) -> m a
evtHardwareIoPortStatus :: (UInt32 -> UInt8 -> UInt8 -> UInt8 -> m (Maybe a)) -> m a
evtHardwareIoPortStatus
    = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ((UInt32, UInt8, UInt8, UInt8) -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsHardware UInt8
0x00 (((UInt32, UInt8, UInt8, UInt8) -> m (Maybe a)) -> m a)
-> ((UInt32 -> UInt8 -> UInt8 -> UInt8 -> m (Maybe a))
    -> (UInt32, UInt8, UInt8, UInt8) -> m (Maybe a))
-> (UInt32 -> UInt8 -> UInt8 -> UInt8 -> m (Maybe a))
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt32 -> UInt8 -> UInt8 -> UInt8 -> m (Maybe a))
-> (UInt32, UInt8, UInt8, UInt8) -> m (Maybe a)
forall a b c d e. (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
uncurry4

evtHardwareSoftTimer
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (UInt8 -> m (Maybe a)) -> m a
evtHardwareSoftTimer :: (UInt8 -> m (Maybe a)) -> m a
evtHardwareSoftTimer
    = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8 -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsHardware UInt8
0x01

-----------------------------------------------------------------------
-- Persistent Store
-----------------------------------------------------------------------

flashErasePage
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> m BGResult
flashErasePage :: UInt8 -> m BGResult
flashErasePage = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> UInt8
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsPersistentStore UInt8
0x06

flashPsDefrag
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => m ()
flashPsDefrag :: m ()
flashPsDefrag = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> () -> m ()
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsPersistentStore UInt8
0x00 ()

flashPsDump
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => m ()
flashPsDump :: m ()
flashPsDump = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> () -> m ()
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsPersistentStore UInt8
0x01 ()

flashPsEraseAll
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => m ()
flashPsEraseAll :: m ()
flashPsEraseAll = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> () -> m ()
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsPersistentStore UInt8
0x02 ()

flashPsErase
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt16 -> m ()
flashPsErase :: UInt16 -> m ()
flashPsErase = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> UInt16 -> m ()
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsPersistentStore UInt8
0x05

flashPsLoad
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt16 -> m (BGResult, UInt8Array)
flashPsLoad :: UInt16 -> m (BGResult, UInt8Array)
flashPsLoad = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> UInt16
-> m (BGResult, UInt8Array)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsPersistentStore UInt8
0x04

flashPsSave
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt16 -> UInt8Array -> m BGResult
flashPsSave :: UInt16 -> UInt8Array -> m BGResult
flashPsSave = ((UInt16, UInt8Array) -> m BGResult)
-> UInt16 -> UInt8Array -> m BGResult
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((UInt16, UInt8Array) -> m BGResult)
 -> UInt16 -> UInt8Array -> m BGResult)
-> ((UInt16, UInt8Array) -> m BGResult)
-> UInt16
-> UInt8Array
-> m BGResult
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt16, UInt8Array)
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsPersistentStore UInt8
0x03

flashReadData
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt32 -> UInt8 -> m UInt8Array
flashReadData :: UInt32 -> UInt8 -> m UInt8Array
flashReadData = ((UInt32, UInt8) -> m UInt8Array)
-> UInt32 -> UInt8 -> m UInt8Array
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((UInt32, UInt8) -> m UInt8Array)
 -> UInt32 -> UInt8 -> m UInt8Array)
-> ((UInt32, UInt8) -> m UInt8Array)
-> UInt32
-> UInt8
-> m UInt8Array
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt32, UInt8)
-> m UInt8Array
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsPersistentStore UInt8
0x08

flashWriteData
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt32 -> UInt8Array -> m BGResult
flashWriteData :: UInt32 -> UInt8Array -> m BGResult
flashWriteData = ((UInt32, UInt8Array) -> m BGResult)
-> UInt32 -> UInt8Array -> m BGResult
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((UInt32, UInt8Array) -> m BGResult)
 -> UInt32 -> UInt8Array -> m BGResult)
-> ((UInt32, UInt8Array) -> m BGResult)
-> UInt32
-> UInt8Array
-> m BGResult
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt32, UInt8Array)
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsPersistentStore UInt8
0x07

evtFlashPsKey
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (UInt16 -> UInt8Array -> m (Maybe a)) -> m a
evtFlashPsKey :: (UInt16 -> UInt8Array -> m (Maybe a)) -> m a
evtFlashPsKey
    = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ((UInt16, UInt8Array) -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsPersistentStore UInt8
0x00 (((UInt16, UInt8Array) -> m (Maybe a)) -> m a)
-> ((UInt16 -> UInt8Array -> m (Maybe a))
    -> (UInt16, UInt8Array) -> m (Maybe a))
-> (UInt16 -> UInt8Array -> m (Maybe a))
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt16 -> UInt8Array -> m (Maybe a))
-> (UInt16, UInt8Array) -> m (Maybe a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry

-----------------------------------------------------------------------
-- Security Manager
-----------------------------------------------------------------------

smDeleteBonding
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> m BGResult
smDeleteBonding :: UInt8 -> m BGResult
smDeleteBonding = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> UInt8
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsSecurityManager UInt8
0x02

smEncryptStart
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> Bool -> m (UInt8, BGResult)
smEncryptStart :: UInt8 -> Bool -> m (UInt8, BGResult)
smEncryptStart = ((UInt8, Bool) -> m (UInt8, BGResult))
-> UInt8 -> Bool -> m (UInt8, BGResult)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((UInt8, Bool) -> m (UInt8, BGResult))
 -> UInt8 -> Bool -> m (UInt8, BGResult))
-> ((UInt8, Bool) -> m (UInt8, BGResult))
-> UInt8
-> Bool
-> m (UInt8, BGResult)
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, Bool)
-> m (UInt8, BGResult)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsSecurityManager UInt8
0x00

smGetBonds
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => m UInt8
smGetBonds :: m UInt8
smGetBonds = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> () -> m UInt8
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsSecurityManager UInt8
0x05 ()

smPasskeyEntry
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt32 -> m BGResult
smPasskeyEntry :: UInt8 -> UInt32 -> m BGResult
smPasskeyEntry = ((UInt8, UInt32) -> m BGResult) -> UInt8 -> UInt32 -> m BGResult
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((UInt8, UInt32) -> m BGResult) -> UInt8 -> UInt32 -> m BGResult)
-> ((UInt8, UInt32) -> m BGResult) -> UInt8 -> UInt32 -> m BGResult
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt32)
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsSecurityManager UInt8
0x04

setBondableMode
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => Bool -> m ()
setBondableMode :: Bool -> m ()
setBondableMode = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> Bool -> m ()
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsSecurityManager UInt8
0x01

smSetOobData
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8Array -> m ()
smSetOobData :: UInt8Array -> m ()
smSetOobData = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> UInt8Array -> m ()
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsSecurityManager UInt8
0x06

smSetPairingDistributionKeys
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt8 -> m BGResult
smSetPairingDistributionKeys :: UInt8 -> UInt8 -> m BGResult
smSetPairingDistributionKeys = ((UInt8, UInt8) -> m BGResult) -> UInt8 -> UInt8 -> m BGResult
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((UInt8, UInt8) -> m BGResult) -> UInt8 -> UInt8 -> m BGResult)
-> ((UInt8, UInt8) -> m BGResult) -> UInt8 -> UInt8 -> m BGResult
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt8)
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsSecurityManager UInt8
0x08

smSetParameters
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => Bool -> UInt8 -> SMIOCapabilities -> m ()
smSetParameters :: Bool -> UInt8 -> SMIOCapabilities -> m ()
smSetParameters = ((Bool, UInt8, SMIOCapabilities) -> m ())
-> Bool -> UInt8 -> SMIOCapabilities -> m ()
forall a b c d. ((a, b, c) -> d) -> a -> b -> c -> d
curry3 (((Bool, UInt8, SMIOCapabilities) -> m ())
 -> Bool -> UInt8 -> SMIOCapabilities -> m ())
-> ((Bool, UInt8, SMIOCapabilities) -> m ())
-> Bool
-> UInt8
-> SMIOCapabilities
-> m ()
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (Bool, UInt8, SMIOCapabilities)
-> m ()
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsSecurityManager UInt8
0x03

smWhitelistBonds
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => m (BGResult, UInt8)
smWhitelistBonds :: m (BGResult, UInt8)
smWhitelistBonds = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ()
-> m (BGResult, UInt8)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsSecurityManager UInt8
0x07 ()

evtSmBondingFail
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (UInt8 -> BGResult -> m (Maybe a)) -> m a
evtSmBondingFail :: (UInt8 -> BGResult -> m (Maybe a)) -> m a
evtSmBondingFail
    = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ((UInt8, BGResult) -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsSecurityManager UInt8
0x01 (((UInt8, BGResult) -> m (Maybe a)) -> m a)
-> ((UInt8 -> BGResult -> m (Maybe a))
    -> (UInt8, BGResult) -> m (Maybe a))
-> (UInt8 -> BGResult -> m (Maybe a))
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt8 -> BGResult -> m (Maybe a))
-> (UInt8, BGResult) -> m (Maybe a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry

evtSmBondStatus
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (UInt8 -> UInt8 -> Bool -> UInt8 -> m (Maybe a)) -> m a
evtSmBondStatus :: (UInt8 -> UInt8 -> Bool -> UInt8 -> m (Maybe a)) -> m a
evtSmBondStatus
    = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ((UInt8, UInt8, Bool, UInt8) -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsSecurityManager UInt8
0x04 (((UInt8, UInt8, Bool, UInt8) -> m (Maybe a)) -> m a)
-> ((UInt8 -> UInt8 -> Bool -> UInt8 -> m (Maybe a))
    -> (UInt8, UInt8, Bool, UInt8) -> m (Maybe a))
-> (UInt8 -> UInt8 -> Bool -> UInt8 -> m (Maybe a))
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt8 -> UInt8 -> Bool -> UInt8 -> m (Maybe a))
-> (UInt8, UInt8, Bool, UInt8) -> m (Maybe a)
forall a b c d e. (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
uncurry4

evtSmPasskeyDisplay
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (UInt8 -> UInt32 -> m (Maybe a)) -> m a
evtSmPasskeyDisplay :: (UInt8 -> UInt32 -> m (Maybe a)) -> m a
evtSmPasskeyDisplay
    = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ((UInt8, UInt32) -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsSecurityManager UInt8
0x02 (((UInt8, UInt32) -> m (Maybe a)) -> m a)
-> ((UInt8 -> UInt32 -> m (Maybe a))
    -> (UInt8, UInt32) -> m (Maybe a))
-> (UInt8 -> UInt32 -> m (Maybe a))
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt8 -> UInt32 -> m (Maybe a)) -> (UInt8, UInt32) -> m (Maybe a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry

evtSmPasskeyRequest
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (UInt8 -> m (Maybe a)) -> m a
evtSmPasskeyRequest :: (UInt8 -> m (Maybe a)) -> m a
evtSmPasskeyRequest
    = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8 -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsSecurityManager UInt8
0x03

-----------------------------------------------------------------------
-- System
-----------------------------------------------------------------------

systemAddressGet
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => m BdAddr
systemAddressGet :: m BdAddr
systemAddressGet = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> () -> m BdAddr
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsSystem UInt8
0x02 ()

systemAesDecrypt
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8Array -> m UInt8Array
systemAesDecrypt :: UInt8Array -> m UInt8Array
systemAesDecrypt = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> UInt8Array
-> m UInt8Array
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsSystem UInt8
0x11

systemAesEncrypt
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8Array -> m UInt8Array
systemAesEncrypt :: UInt8Array -> m UInt8Array
systemAesEncrypt = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> UInt8Array
-> m UInt8Array
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsSystem UInt8
0x10

systemAesSetkey
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8Array -> m ()
systemAesSetkey :: UInt8Array -> m ()
systemAesSetkey = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> UInt8Array -> m ()
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsSystem UInt8
0x0f

systemDelayReset
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => RebootMode -> UInt16 -> m ()
systemDelayReset :: RebootMode -> UInt16 -> m ()
systemDelayReset = ((RebootMode, UInt16) -> m ()) -> RebootMode -> UInt16 -> m ()
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((RebootMode, UInt16) -> m ()) -> RebootMode -> UInt16 -> m ())
-> ((RebootMode, UInt16) -> m ()) -> RebootMode -> UInt16 -> m ()
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (RebootMode, UInt16)
-> m ()
forall (m :: * -> *) env a.
(MonadIO m, MonadReader env m, HasSerialPort env, HasDebug env,
 Binary a) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m ()
xCmd' BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsSystem UInt8
0x14

systemEndpointRx
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt8 -> m (BGResult, UInt8Array)
systemEndpointRx :: UInt8 -> UInt8 -> m (BGResult, UInt8Array)
systemEndpointRx = ((UInt8, UInt8) -> m (BGResult, UInt8Array))
-> UInt8 -> UInt8 -> m (BGResult, UInt8Array)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((UInt8, UInt8) -> m (BGResult, UInt8Array))
 -> UInt8 -> UInt8 -> m (BGResult, UInt8Array))
-> ((UInt8, UInt8) -> m (BGResult, UInt8Array))
-> UInt8
-> UInt8
-> m (BGResult, UInt8Array)
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt8)
-> m (BGResult, UInt8Array)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsSystem UInt8
0x0d

systemEndpointSetWatermarks
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt8 -> UInt8 -> m BGResult
systemEndpointSetWatermarks :: UInt8 -> UInt8 -> UInt8 -> m BGResult
systemEndpointSetWatermarks = ((UInt8, UInt8, UInt8) -> m BGResult)
-> UInt8 -> UInt8 -> UInt8 -> m BGResult
forall a b c d. ((a, b, c) -> d) -> a -> b -> c -> d
curry3 (((UInt8, UInt8, UInt8) -> m BGResult)
 -> UInt8 -> UInt8 -> UInt8 -> m BGResult)
-> ((UInt8, UInt8, UInt8) -> m BGResult)
-> UInt8
-> UInt8
-> UInt8
-> m BGResult
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt8, UInt8)
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsSystem UInt8
0x0e

systemEndpointTx
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt8Array -> m BGResult
systemEndpointTx :: UInt8 -> UInt8Array -> m BGResult
systemEndpointTx = ((UInt8, UInt8Array) -> m BGResult)
-> UInt8 -> UInt8Array -> m BGResult
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((UInt8, UInt8Array) -> m BGResult)
 -> UInt8 -> UInt8Array -> m BGResult)
-> ((UInt8, UInt8Array) -> m BGResult)
-> UInt8
-> UInt8Array
-> m BGResult
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt8Array)
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsSystem UInt8
0x09

systemGetBootloaderCrc
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => m UInt16
systemGetBootloaderCrc :: m UInt16
systemGetBootloaderCrc = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> () -> m UInt16
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsSystem UInt8
0x13 ()

systemGetConnections
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => m UInt8
systemGetConnections :: m UInt8
systemGetConnections = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> () -> m UInt8
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsSystem UInt8
0x06 ()

systemGetCounters
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => m (UInt8, UInt8, UInt8, UInt8, UInt8)
systemGetCounters :: m (UInt8, UInt8, UInt8, UInt8, UInt8)
systemGetCounters = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ()
-> m (UInt8, UInt8, UInt8, UInt8, UInt8)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsSystem UInt8
0x05 ()

systemGetInfo
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => m (UInt16, UInt16, UInt16, UInt16, UInt16, UInt8, UInt8)
systemGetInfo :: m (UInt16, UInt16, UInt16, UInt16, UInt16, UInt8, UInt8)
systemGetInfo = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ()
-> m (UInt16, UInt16, UInt16, UInt16, UInt16, UInt8, UInt8)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsSystem UInt8
0x08 ()

systemHello
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => m ()
systemHello :: m ()
systemHello = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> () -> m ()
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsSystem UInt8
0x01 ()

systemReset
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasDebug env)
    => RebootMode -> m ()
systemReset :: RebootMode -> m ()
systemReset = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> RebootMode -> m ()
forall (m :: * -> *) env a.
(MonadIO m, MonadReader env m, HasSerialPort env, HasDebug env,
 Binary a) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m ()
xCmd' BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsSystem UInt8
0x01

systemUsbEnumerationStatusGet
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => m (BGResult, Bool)
systemUsbEnumerationStatusGet :: m (BGResult, Bool)
systemUsbEnumerationStatusGet = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ()
-> m (BGResult, Bool)
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsSystem UInt8
0x12 ()

systemWhitelistAppend
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => BdAddr -> GapAddressType -> m BGResult
systemWhitelistAppend :: BdAddr -> GapAddressType -> m BGResult
systemWhitelistAppend = ((BdAddr, GapAddressType) -> m BGResult)
-> BdAddr -> GapAddressType -> m BGResult
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((BdAddr, GapAddressType) -> m BGResult)
 -> BdAddr -> GapAddressType -> m BGResult)
-> ((BdAddr, GapAddressType) -> m BGResult)
-> BdAddr
-> GapAddressType
-> m BGResult
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (BdAddr, GapAddressType)
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsSystem UInt8
0x0a

systemWhitelistClear
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => m ()
systemWhitelistClear :: m ()
systemWhitelistClear = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> () -> m ()
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsSystem UInt8
0x0c ()

systemWhitelistRemove
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => BdAddr -> GapAddressType -> m BGResult
systemWhitelistRemove :: BdAddr -> GapAddressType -> m BGResult
systemWhitelistRemove = ((BdAddr, GapAddressType) -> m BGResult)
-> BdAddr -> GapAddressType -> m BGResult
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((BdAddr, GapAddressType) -> m BGResult)
 -> BdAddr -> GapAddressType -> m BGResult)
-> ((BdAddr, GapAddressType) -> m BGResult)
-> BdAddr
-> GapAddressType
-> m BGResult
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (BdAddr, GapAddressType)
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsSystem UInt8
0x0b

evtSystemBoot
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (UInt16 -> UInt16 -> UInt16 -> UInt16 -> UInt16 -> UInt8 -> UInt8 -> m (Maybe a)) -> m a
evtSystemBoot :: (UInt16
 -> UInt16
 -> UInt16
 -> UInt16
 -> UInt16
 -> UInt8
 -> UInt8
 -> m (Maybe a))
-> m a
evtSystemBoot
    = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ((UInt16, UInt16, UInt16, UInt16, UInt16, UInt8, UInt8)
    -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsSystem UInt8
0x00 (((UInt16, UInt16, UInt16, UInt16, UInt16, UInt8, UInt8)
  -> m (Maybe a))
 -> m a)
-> ((UInt16
     -> UInt16
     -> UInt16
     -> UInt16
     -> UInt16
     -> UInt8
     -> UInt8
     -> m (Maybe a))
    -> (UInt16, UInt16, UInt16, UInt16, UInt16, UInt8, UInt8)
    -> m (Maybe a))
-> (UInt16
    -> UInt16
    -> UInt16
    -> UInt16
    -> UInt16
    -> UInt8
    -> UInt8
    -> m (Maybe a))
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt16
 -> UInt16
 -> UInt16
 -> UInt16
 -> UInt16
 -> UInt8
 -> UInt8
 -> m (Maybe a))
-> (UInt16, UInt16, UInt16, UInt16, UInt16, UInt8, UInt8)
-> m (Maybe a)
forall a b c d e f g h.
(a -> b -> c -> d -> e -> f -> g -> h)
-> (a, b, c, d, e, f, g) -> h
uncurry7

evtSystemEndpointWatermarkRx
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (UInt8 -> UInt8 -> m (Maybe a)) -> m a
evtSystemEndpointWatermarkRx :: (UInt8 -> UInt8 -> m (Maybe a)) -> m a
evtSystemEndpointWatermarkRx
    = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ((UInt8, UInt8) -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsSystem UInt8
0x02 (((UInt8, UInt8) -> m (Maybe a)) -> m a)
-> ((UInt8 -> UInt8 -> m (Maybe a))
    -> (UInt8, UInt8) -> m (Maybe a))
-> (UInt8 -> UInt8 -> m (Maybe a))
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt8 -> UInt8 -> m (Maybe a)) -> (UInt8, UInt8) -> m (Maybe a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry

evtSystemEndpointWatermarkTx
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (UInt8 -> UInt8 -> m (Maybe a)) -> m a
evtSystemEndpointWatermarkTx :: (UInt8 -> UInt8 -> m (Maybe a)) -> m a
evtSystemEndpointWatermarkTx
    = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ((UInt8, UInt8) -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsSystem UInt8
0x03 (((UInt8, UInt8) -> m (Maybe a)) -> m a)
-> ((UInt8 -> UInt8 -> m (Maybe a))
    -> (UInt8, UInt8) -> m (Maybe a))
-> (UInt8 -> UInt8 -> m (Maybe a))
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt8 -> UInt8 -> m (Maybe a)) -> (UInt8, UInt8) -> m (Maybe a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry

evtSystemNoLicenseKey
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (() -> m (Maybe a)) -> m a
evtSystemNoLicenseKey :: (() -> m (Maybe a)) -> m a
evtSystemNoLicenseKey
    = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (() -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsSystem UInt8
0x05

evtSystemProtocolError
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (BGResult -> m (Maybe a)) -> m a
evtSystemProtocolError :: (BGResult -> m (Maybe a)) -> m a
evtSystemProtocolError
    = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (BGResult -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsSystem UInt8
0x06

evtSystemScriptFailure
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (UInt16 -> BGResult -> m (Maybe a)) -> m a
evtSystemScriptFailure :: (UInt16 -> BGResult -> m (Maybe a)) -> m a
evtSystemScriptFailure
    = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> ((UInt16, BGResult) -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsSystem UInt8
0x04 (((UInt16, BGResult) -> m (Maybe a)) -> m a)
-> ((UInt16 -> BGResult -> m (Maybe a))
    -> (UInt16, BGResult) -> m (Maybe a))
-> (UInt16 -> BGResult -> m (Maybe a))
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt16 -> BGResult -> m (Maybe a))
-> (UInt16, BGResult) -> m (Maybe a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry

evtSystemUsbEnumerated
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (Bool -> m (Maybe a)) -> m a
evtSystemUsbEnumerated :: (Bool -> m (Maybe a)) -> m a
evtSystemUsbEnumerated
    = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (Bool -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsSystem UInt8
0x07

-----------------------------------------------------------------------
-- Testing
-----------------------------------------------------------------------

testChannelMode
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> m ()
testChannelMode :: UInt8 -> m ()
testChannelMode = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> UInt8 -> m ()
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsTest UInt8
0x06

testGetChannelMap
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => m UInt8Array
testGetChannelMap :: m UInt8Array
testGetChannelMap = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> () -> m UInt8Array
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsTest UInt8
0x04 ()

testPhyEnd
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => m UInt16
testPhyEnd :: m UInt16
testPhyEnd = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> () -> m UInt16
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsTest UInt8
0x02 ()

testPhyRx
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> m ()
testPhyRx :: UInt8 -> m ()
testPhyRx = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> UInt8 -> m ()
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsTest UInt8
0x01

testPhyTx
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8 -> UInt8 -> UInt8 -> m ()
testPhyTx :: UInt8 -> UInt8 -> UInt8 -> m ()
testPhyTx = ((UInt8, UInt8, UInt8) -> m ()) -> UInt8 -> UInt8 -> UInt8 -> m ()
forall a b c d. ((a, b, c) -> d) -> a -> b -> c -> d
curry3 (((UInt8, UInt8, UInt8) -> m ())
 -> UInt8 -> UInt8 -> UInt8 -> m ())
-> ((UInt8, UInt8, UInt8) -> m ())
-> UInt8
-> UInt8
-> UInt8
-> m ()
forall a b. (a -> b) -> a -> b
$ BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt8, UInt8, UInt8)
-> m ()
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsTest UInt8
0x00

-----------------------------------------------------------------------
-- Device Firmware Upgrade
-----------------------------------------------------------------------

dfuFlashSetAddress
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt32 -> m BGResult
dfuFlashSetAddress :: UInt32 -> m BGResult
dfuFlashSetAddress = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> UInt32
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsDfu UInt8
0x01

dfuFlashUpload
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => UInt8Array -> m BGResult
dfuFlashUpload :: UInt8Array -> m BGResult
dfuFlashUpload = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> UInt8Array
-> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsDfu UInt8
0x02

dfuFlashUploadFinish
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => m BGResult
dfuFlashUploadFinish :: m BGResult
dfuFlashUploadFinish = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> () -> m BGResult
forall (m :: * -> *) env a b.
(MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env,
 HasDebug env, Binary a, Binary b) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m b
xCmd BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsDfu UInt8
0x03 ()

dfuReset
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => Bool -> m ()
dfuReset :: Bool -> m ()
dfuReset = BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> Bool -> m ()
forall (m :: * -> *) env a.
(MonadIO m, MonadReader env m, HasSerialPort env, HasDebug env,
 Binary a) =>
BgMessageType
-> BgTecnologyType -> BgCommandClass -> UInt8 -> a -> m ()
xCmd' BgMessageType
BgMsgCR BgTecnologyType
BgBlue BgCommandClass
BgClsDfu UInt8
0x00

evtDfuBoot
    :: (MonadIO m, MonadReader env m, HasSerialPort env, HasBGChan env, HasDebug env)
    => (UInt32 -> m (Maybe a)) -> m a
evtDfuBoot :: (UInt32 -> m (Maybe a)) -> m a
evtDfuBoot = BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (UInt32 -> m (Maybe a))
-> m a
forall a (m :: * -> *) env b.
(Binary a, MonadIO m, MonadReader env m, HasSerialPort env,
 HasBGChan env) =>
BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> UInt8
-> (a -> m (Maybe b))
-> m b
handlePacket BgMessageType
BgMsgEvent BgTecnologyType
BgBlue BgCommandClass
BgClsDfu UInt8
0x00