{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}

module BGLib.Types
    ( Int8
    , UInt8
    , UInt16
    , UInt32
    , UInt8Array(..)
    , toUInt8Array
    , BdAddr(..)
    , BgMessageType(..)
    , BgTecnologyType(..)
    , BgCommandClass(..)
    , BgPacketHeader(..)
    , bgHeaderMatches
    , BgPayload
    , fromBgPayload
    , toBgPayload
    , BgPacket(..)
    , HasSerialPort(..)
    , askSerialPort
    , HasBGChan(..)
    , askBGChan
    , askDupBGChan
    , askCloneBGChan
    , packetBlock
    , packetBlock_
    , packetBlock'
    , packetBlock'_
    , HasDebug(..)
    , askDebug
    , bsShowHex
    , RebootMode(..)
    , AttributeValueType(..)
    , AttributeChangeReason(..)
    , fASNotify
    , fASIndicate
    , fCConnected
    , fCEncrypted
    , fCCompleted
    , fCParametersChanged
    , fADLimitedDiscoverable
    , fADGeneralDiscoverable
    , fADBREDRNotSupported
    , fADSimultaneousLEBREDRCtrl
    , fADSimultaneousLEBREDRHost
    , fADMask
    , GapAdvType(..)
    , GapAdvPolicy(..)
    , GapAddressType(..)
    , GapConnectableMode(..)
    , GapDiscoverableMode(..)
    , GapDiscoverMode(..)
    , GSPScanHeaderFlag(..)
    , GapScanPolicy(..)
    , fBKLTK
    , fBKAddrPublic
    , fBKAddrStatic
    , fBKIRK
    , fBKEDIVRAND
    , fBKCSRK
    , fBKMasterId
    , SMIOCapabilities(..)
    , SystemEndpoint(..)
    , BGResult(..)
    ) where

import           Control.Concurrent.STM.TChan
import           Control.Monad.Reader
import           Control.Concurrent.STM
import           Data.Binary
import           Data.Binary.Get
import           Data.Binary.Put
import           Data.Bits
import qualified Data.ByteString as BSS
import           Data.Data
import qualified Data.Int as I
import           Data.Ix
import           Data.String
import qualified Data.Word as W
import           Foreign.Storable
import           Numeric
import           System.Hardware.Serialport
import           Text.Printf 

-- int8           1 byte Signed 8-bit integer
type Int8 = I.Int8

-- uint8          1 byte Unsigned 8-bit integer
type UInt8 = W.Word8

-- uint16         2 bytes Unsigned 16-bit integer
newtype UInt16 = UInt16 { UInt16 -> Word16
fromUInt16 :: W.Word16 }
    deriving (UInt16
UInt16 -> UInt16 -> Bounded UInt16
forall a. a -> a -> Bounded a
maxBound :: UInt16
$cmaxBound :: UInt16
minBound :: UInt16
$cminBound :: UInt16
Bounded, Int -> UInt16
UInt16 -> Int
UInt16 -> [UInt16]
UInt16 -> UInt16
UInt16 -> UInt16 -> [UInt16]
UInt16 -> UInt16 -> UInt16 -> [UInt16]
(UInt16 -> UInt16)
-> (UInt16 -> UInt16)
-> (Int -> UInt16)
-> (UInt16 -> Int)
-> (UInt16 -> [UInt16])
-> (UInt16 -> UInt16 -> [UInt16])
-> (UInt16 -> UInt16 -> [UInt16])
-> (UInt16 -> UInt16 -> UInt16 -> [UInt16])
-> Enum UInt16
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: UInt16 -> UInt16 -> UInt16 -> [UInt16]
$cenumFromThenTo :: UInt16 -> UInt16 -> UInt16 -> [UInt16]
enumFromTo :: UInt16 -> UInt16 -> [UInt16]
$cenumFromTo :: UInt16 -> UInt16 -> [UInt16]
enumFromThen :: UInt16 -> UInt16 -> [UInt16]
$cenumFromThen :: UInt16 -> UInt16 -> [UInt16]
enumFrom :: UInt16 -> [UInt16]
$cenumFrom :: UInt16 -> [UInt16]
fromEnum :: UInt16 -> Int
$cfromEnum :: UInt16 -> Int
toEnum :: Int -> UInt16
$ctoEnum :: Int -> UInt16
pred :: UInt16 -> UInt16
$cpred :: UInt16 -> UInt16
succ :: UInt16 -> UInt16
$csucc :: UInt16 -> UInt16
Enum, UInt16 -> UInt16 -> Bool
(UInt16 -> UInt16 -> Bool)
-> (UInt16 -> UInt16 -> Bool) -> Eq UInt16
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UInt16 -> UInt16 -> Bool
$c/= :: UInt16 -> UInt16 -> Bool
== :: UInt16 -> UInt16 -> Bool
$c== :: UInt16 -> UInt16 -> Bool
Eq, Enum UInt16
Real UInt16
Real UInt16
-> Enum UInt16
-> (UInt16 -> UInt16 -> UInt16)
-> (UInt16 -> UInt16 -> UInt16)
-> (UInt16 -> UInt16 -> UInt16)
-> (UInt16 -> UInt16 -> UInt16)
-> (UInt16 -> UInt16 -> (UInt16, UInt16))
-> (UInt16 -> UInt16 -> (UInt16, UInt16))
-> (UInt16 -> Integer)
-> Integral UInt16
UInt16 -> Integer
UInt16 -> UInt16 -> (UInt16, UInt16)
UInt16 -> UInt16 -> UInt16
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: UInt16 -> Integer
$ctoInteger :: UInt16 -> Integer
divMod :: UInt16 -> UInt16 -> (UInt16, UInt16)
$cdivMod :: UInt16 -> UInt16 -> (UInt16, UInt16)
quotRem :: UInt16 -> UInt16 -> (UInt16, UInt16)
$cquotRem :: UInt16 -> UInt16 -> (UInt16, UInt16)
mod :: UInt16 -> UInt16 -> UInt16
$cmod :: UInt16 -> UInt16 -> UInt16
div :: UInt16 -> UInt16 -> UInt16
$cdiv :: UInt16 -> UInt16 -> UInt16
rem :: UInt16 -> UInt16 -> UInt16
$crem :: UInt16 -> UInt16 -> UInt16
quot :: UInt16 -> UInt16 -> UInt16
$cquot :: UInt16 -> UInt16 -> UInt16
$cp2Integral :: Enum UInt16
$cp1Integral :: Real UInt16
Integral, Typeable UInt16
DataType
Constr
Typeable UInt16
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> UInt16 -> c UInt16)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c UInt16)
-> (UInt16 -> Constr)
-> (UInt16 -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c UInt16))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UInt16))
-> ((forall b. Data b => b -> b) -> UInt16 -> UInt16)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> UInt16 -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> UInt16 -> r)
-> (forall u. (forall d. Data d => d -> u) -> UInt16 -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> UInt16 -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> UInt16 -> m UInt16)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UInt16 -> m UInt16)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UInt16 -> m UInt16)
-> Data UInt16
UInt16 -> DataType
UInt16 -> Constr
(forall b. Data b => b -> b) -> UInt16 -> UInt16
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UInt16 -> c UInt16
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UInt16
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UInt16 -> u
forall u. (forall d. Data d => d -> u) -> UInt16 -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UInt16 -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UInt16 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UInt16 -> m UInt16
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UInt16 -> m UInt16
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UInt16
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UInt16 -> c UInt16
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UInt16)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UInt16)
$cUInt16 :: Constr
$tUInt16 :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> UInt16 -> m UInt16
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UInt16 -> m UInt16
gmapMp :: (forall d. Data d => d -> m d) -> UInt16 -> m UInt16
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UInt16 -> m UInt16
gmapM :: (forall d. Data d => d -> m d) -> UInt16 -> m UInt16
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UInt16 -> m UInt16
gmapQi :: Int -> (forall d. Data d => d -> u) -> UInt16 -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UInt16 -> u
gmapQ :: (forall d. Data d => d -> u) -> UInt16 -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UInt16 -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UInt16 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UInt16 -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UInt16 -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UInt16 -> r
gmapT :: (forall b. Data b => b -> b) -> UInt16 -> UInt16
$cgmapT :: (forall b. Data b => b -> b) -> UInt16 -> UInt16
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UInt16)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UInt16)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c UInt16)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UInt16)
dataTypeOf :: UInt16 -> DataType
$cdataTypeOf :: UInt16 -> DataType
toConstr :: UInt16 -> Constr
$ctoConstr :: UInt16 -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UInt16
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UInt16
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UInt16 -> c UInt16
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UInt16 -> c UInt16
$cp1Data :: Typeable UInt16
Data, Integer -> UInt16
UInt16 -> UInt16
UInt16 -> UInt16 -> UInt16
(UInt16 -> UInt16 -> UInt16)
-> (UInt16 -> UInt16 -> UInt16)
-> (UInt16 -> UInt16 -> UInt16)
-> (UInt16 -> UInt16)
-> (UInt16 -> UInt16)
-> (UInt16 -> UInt16)
-> (Integer -> UInt16)
-> Num UInt16
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> UInt16
$cfromInteger :: Integer -> UInt16
signum :: UInt16 -> UInt16
$csignum :: UInt16 -> UInt16
abs :: UInt16 -> UInt16
$cabs :: UInt16 -> UInt16
negate :: UInt16 -> UInt16
$cnegate :: UInt16 -> UInt16
* :: UInt16 -> UInt16 -> UInt16
$c* :: UInt16 -> UInt16 -> UInt16
- :: UInt16 -> UInt16 -> UInt16
$c- :: UInt16 -> UInt16 -> UInt16
+ :: UInt16 -> UInt16 -> UInt16
$c+ :: UInt16 -> UInt16 -> UInt16
Num, Eq UInt16
Eq UInt16
-> (UInt16 -> UInt16 -> Ordering)
-> (UInt16 -> UInt16 -> Bool)
-> (UInt16 -> UInt16 -> Bool)
-> (UInt16 -> UInt16 -> Bool)
-> (UInt16 -> UInt16 -> Bool)
-> (UInt16 -> UInt16 -> UInt16)
-> (UInt16 -> UInt16 -> UInt16)
-> Ord UInt16
UInt16 -> UInt16 -> Bool
UInt16 -> UInt16 -> Ordering
UInt16 -> UInt16 -> UInt16
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UInt16 -> UInt16 -> UInt16
$cmin :: UInt16 -> UInt16 -> UInt16
max :: UInt16 -> UInt16 -> UInt16
$cmax :: UInt16 -> UInt16 -> UInt16
>= :: UInt16 -> UInt16 -> Bool
$c>= :: UInt16 -> UInt16 -> Bool
> :: UInt16 -> UInt16 -> Bool
$c> :: UInt16 -> UInt16 -> Bool
<= :: UInt16 -> UInt16 -> Bool
$c<= :: UInt16 -> UInt16 -> Bool
< :: UInt16 -> UInt16 -> Bool
$c< :: UInt16 -> UInt16 -> Bool
compare :: UInt16 -> UInt16 -> Ordering
$ccompare :: UInt16 -> UInt16 -> Ordering
$cp1Ord :: Eq UInt16
Ord, ReadPrec [UInt16]
ReadPrec UInt16
Int -> ReadS UInt16
ReadS [UInt16]
(Int -> ReadS UInt16)
-> ReadS [UInt16]
-> ReadPrec UInt16
-> ReadPrec [UInt16]
-> Read UInt16
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UInt16]
$creadListPrec :: ReadPrec [UInt16]
readPrec :: ReadPrec UInt16
$creadPrec :: ReadPrec UInt16
readList :: ReadS [UInt16]
$creadList :: ReadS [UInt16]
readsPrec :: Int -> ReadS UInt16
$creadsPrec :: Int -> ReadS UInt16
Read, Num UInt16
Ord UInt16
Num UInt16 -> Ord UInt16 -> (UInt16 -> Rational) -> Real UInt16
UInt16 -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: UInt16 -> Rational
$ctoRational :: UInt16 -> Rational
$cp2Real :: Ord UInt16
$cp1Real :: Num UInt16
Real, Int -> UInt16 -> ShowS
[UInt16] -> ShowS
UInt16 -> String
(Int -> UInt16 -> ShowS)
-> (UInt16 -> String) -> ([UInt16] -> ShowS) -> Show UInt16
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UInt16] -> ShowS
$cshowList :: [UInt16] -> ShowS
show :: UInt16 -> String
$cshow :: UInt16 -> String
showsPrec :: Int -> UInt16 -> ShowS
$cshowsPrec :: Int -> UInt16 -> ShowS
Show, Ord UInt16
Ord UInt16
-> ((UInt16, UInt16) -> [UInt16])
-> ((UInt16, UInt16) -> UInt16 -> Int)
-> ((UInt16, UInt16) -> UInt16 -> Int)
-> ((UInt16, UInt16) -> UInt16 -> Bool)
-> ((UInt16, UInt16) -> Int)
-> ((UInt16, UInt16) -> Int)
-> Ix UInt16
(UInt16, UInt16) -> Int
(UInt16, UInt16) -> [UInt16]
(UInt16, UInt16) -> UInt16 -> Bool
(UInt16, UInt16) -> UInt16 -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (UInt16, UInt16) -> Int
$cunsafeRangeSize :: (UInt16, UInt16) -> Int
rangeSize :: (UInt16, UInt16) -> Int
$crangeSize :: (UInt16, UInt16) -> Int
inRange :: (UInt16, UInt16) -> UInt16 -> Bool
$cinRange :: (UInt16, UInt16) -> UInt16 -> Bool
unsafeIndex :: (UInt16, UInt16) -> UInt16 -> Int
$cunsafeIndex :: (UInt16, UInt16) -> UInt16 -> Int
index :: (UInt16, UInt16) -> UInt16 -> Int
$cindex :: (UInt16, UInt16) -> UInt16 -> Int
range :: (UInt16, UInt16) -> [UInt16]
$crange :: (UInt16, UInt16) -> [UInt16]
$cp1Ix :: Ord UInt16
Ix, Bits UInt16
Bits UInt16
-> (UInt16 -> Int)
-> (UInt16 -> Int)
-> (UInt16 -> Int)
-> FiniteBits UInt16
UInt16 -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
countTrailingZeros :: UInt16 -> Int
$ccountTrailingZeros :: UInt16 -> Int
countLeadingZeros :: UInt16 -> Int
$ccountLeadingZeros :: UInt16 -> Int
finiteBitSize :: UInt16 -> Int
$cfiniteBitSize :: UInt16 -> Int
$cp1FiniteBits :: Bits UInt16
FiniteBits, Eq UInt16
UInt16
Eq UInt16
-> (UInt16 -> UInt16 -> UInt16)
-> (UInt16 -> UInt16 -> UInt16)
-> (UInt16 -> UInt16 -> UInt16)
-> (UInt16 -> UInt16)
-> (UInt16 -> Int -> UInt16)
-> (UInt16 -> Int -> UInt16)
-> UInt16
-> (Int -> UInt16)
-> (UInt16 -> Int -> UInt16)
-> (UInt16 -> Int -> UInt16)
-> (UInt16 -> Int -> UInt16)
-> (UInt16 -> Int -> Bool)
-> (UInt16 -> Maybe Int)
-> (UInt16 -> Int)
-> (UInt16 -> Bool)
-> (UInt16 -> Int -> UInt16)
-> (UInt16 -> Int -> UInt16)
-> (UInt16 -> Int -> UInt16)
-> (UInt16 -> Int -> UInt16)
-> (UInt16 -> Int -> UInt16)
-> (UInt16 -> Int -> UInt16)
-> (UInt16 -> Int)
-> Bits UInt16
Int -> UInt16
UInt16 -> Bool
UInt16 -> Int
UInt16 -> Maybe Int
UInt16 -> UInt16
UInt16 -> Int -> Bool
UInt16 -> Int -> UInt16
UInt16 -> UInt16 -> UInt16
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: UInt16 -> Int
$cpopCount :: UInt16 -> Int
rotateR :: UInt16 -> Int -> UInt16
$crotateR :: UInt16 -> Int -> UInt16
rotateL :: UInt16 -> Int -> UInt16
$crotateL :: UInt16 -> Int -> UInt16
unsafeShiftR :: UInt16 -> Int -> UInt16
$cunsafeShiftR :: UInt16 -> Int -> UInt16
shiftR :: UInt16 -> Int -> UInt16
$cshiftR :: UInt16 -> Int -> UInt16
unsafeShiftL :: UInt16 -> Int -> UInt16
$cunsafeShiftL :: UInt16 -> Int -> UInt16
shiftL :: UInt16 -> Int -> UInt16
$cshiftL :: UInt16 -> Int -> UInt16
isSigned :: UInt16 -> Bool
$cisSigned :: UInt16 -> Bool
bitSize :: UInt16 -> Int
$cbitSize :: UInt16 -> Int
bitSizeMaybe :: UInt16 -> Maybe Int
$cbitSizeMaybe :: UInt16 -> Maybe Int
testBit :: UInt16 -> Int -> Bool
$ctestBit :: UInt16 -> Int -> Bool
complementBit :: UInt16 -> Int -> UInt16
$ccomplementBit :: UInt16 -> Int -> UInt16
clearBit :: UInt16 -> Int -> UInt16
$cclearBit :: UInt16 -> Int -> UInt16
setBit :: UInt16 -> Int -> UInt16
$csetBit :: UInt16 -> Int -> UInt16
bit :: Int -> UInt16
$cbit :: Int -> UInt16
zeroBits :: UInt16
$czeroBits :: UInt16
rotate :: UInt16 -> Int -> UInt16
$crotate :: UInt16 -> Int -> UInt16
shift :: UInt16 -> Int -> UInt16
$cshift :: UInt16 -> Int -> UInt16
complement :: UInt16 -> UInt16
$ccomplement :: UInt16 -> UInt16
xor :: UInt16 -> UInt16 -> UInt16
$cxor :: UInt16 -> UInt16 -> UInt16
.|. :: UInt16 -> UInt16 -> UInt16
$c.|. :: UInt16 -> UInt16 -> UInt16
.&. :: UInt16 -> UInt16 -> UInt16
$c.&. :: UInt16 -> UInt16 -> UInt16
$cp1Bits :: Eq UInt16
Bits, Ptr b -> Int -> IO UInt16
Ptr b -> Int -> UInt16 -> IO ()
Ptr UInt16 -> IO UInt16
Ptr UInt16 -> Int -> IO UInt16
Ptr UInt16 -> Int -> UInt16 -> IO ()
Ptr UInt16 -> UInt16 -> IO ()
UInt16 -> Int
(UInt16 -> Int)
-> (UInt16 -> Int)
-> (Ptr UInt16 -> Int -> IO UInt16)
-> (Ptr UInt16 -> Int -> UInt16 -> IO ())
-> (forall b. Ptr b -> Int -> IO UInt16)
-> (forall b. Ptr b -> Int -> UInt16 -> IO ())
-> (Ptr UInt16 -> IO UInt16)
-> (Ptr UInt16 -> UInt16 -> IO ())
-> Storable UInt16
forall b. Ptr b -> Int -> IO UInt16
forall b. Ptr b -> Int -> UInt16 -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr UInt16 -> UInt16 -> IO ()
$cpoke :: Ptr UInt16 -> UInt16 -> IO ()
peek :: Ptr UInt16 -> IO UInt16
$cpeek :: Ptr UInt16 -> IO UInt16
pokeByteOff :: Ptr b -> Int -> UInt16 -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> UInt16 -> IO ()
peekByteOff :: Ptr b -> Int -> IO UInt16
$cpeekByteOff :: forall b. Ptr b -> Int -> IO UInt16
pokeElemOff :: Ptr UInt16 -> Int -> UInt16 -> IO ()
$cpokeElemOff :: Ptr UInt16 -> Int -> UInt16 -> IO ()
peekElemOff :: Ptr UInt16 -> Int -> IO UInt16
$cpeekElemOff :: Ptr UInt16 -> Int -> IO UInt16
alignment :: UInt16 -> Int
$calignment :: UInt16 -> Int
sizeOf :: UInt16 -> Int
$csizeOf :: UInt16 -> Int
Storable, UInt16 -> ModifierParser
UInt16 -> FieldFormatter
(UInt16 -> FieldFormatter)
-> (UInt16 -> ModifierParser) -> PrintfArg UInt16
forall a.
(a -> FieldFormatter) -> (a -> ModifierParser) -> PrintfArg a
parseFormat :: UInt16 -> ModifierParser
$cparseFormat :: UInt16 -> ModifierParser
formatArg :: UInt16 -> FieldFormatter
$cformatArg :: UInt16 -> FieldFormatter
PrintfArg)

instance Binary UInt16 where
    get :: Get UInt16
get = Word16 -> UInt16
UInt16 (Word16 -> UInt16) -> Get Word16 -> Get UInt16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
    put :: UInt16 -> Put
put = Word16 -> Put
putWord16le (Word16 -> Put) -> (UInt16 -> Word16) -> UInt16 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UInt16 -> Word16
fromUInt16

-- uint32         4 bytes Unsigned 32-bit integer
newtype UInt32 = UInt32 { UInt32 -> Word32
fromUInt32 :: W.Word32 }
    deriving (UInt32
UInt32 -> UInt32 -> Bounded UInt32
forall a. a -> a -> Bounded a
maxBound :: UInt32
$cmaxBound :: UInt32
minBound :: UInt32
$cminBound :: UInt32
Bounded, Int -> UInt32
UInt32 -> Int
UInt32 -> [UInt32]
UInt32 -> UInt32
UInt32 -> UInt32 -> [UInt32]
UInt32 -> UInt32 -> UInt32 -> [UInt32]
(UInt32 -> UInt32)
-> (UInt32 -> UInt32)
-> (Int -> UInt32)
-> (UInt32 -> Int)
-> (UInt32 -> [UInt32])
-> (UInt32 -> UInt32 -> [UInt32])
-> (UInt32 -> UInt32 -> [UInt32])
-> (UInt32 -> UInt32 -> UInt32 -> [UInt32])
-> Enum UInt32
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: UInt32 -> UInt32 -> UInt32 -> [UInt32]
$cenumFromThenTo :: UInt32 -> UInt32 -> UInt32 -> [UInt32]
enumFromTo :: UInt32 -> UInt32 -> [UInt32]
$cenumFromTo :: UInt32 -> UInt32 -> [UInt32]
enumFromThen :: UInt32 -> UInt32 -> [UInt32]
$cenumFromThen :: UInt32 -> UInt32 -> [UInt32]
enumFrom :: UInt32 -> [UInt32]
$cenumFrom :: UInt32 -> [UInt32]
fromEnum :: UInt32 -> Int
$cfromEnum :: UInt32 -> Int
toEnum :: Int -> UInt32
$ctoEnum :: Int -> UInt32
pred :: UInt32 -> UInt32
$cpred :: UInt32 -> UInt32
succ :: UInt32 -> UInt32
$csucc :: UInt32 -> UInt32
Enum, UInt32 -> UInt32 -> Bool
(UInt32 -> UInt32 -> Bool)
-> (UInt32 -> UInt32 -> Bool) -> Eq UInt32
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UInt32 -> UInt32 -> Bool
$c/= :: UInt32 -> UInt32 -> Bool
== :: UInt32 -> UInt32 -> Bool
$c== :: UInt32 -> UInt32 -> Bool
Eq, Enum UInt32
Real UInt32
Real UInt32
-> Enum UInt32
-> (UInt32 -> UInt32 -> UInt32)
-> (UInt32 -> UInt32 -> UInt32)
-> (UInt32 -> UInt32 -> UInt32)
-> (UInt32 -> UInt32 -> UInt32)
-> (UInt32 -> UInt32 -> (UInt32, UInt32))
-> (UInt32 -> UInt32 -> (UInt32, UInt32))
-> (UInt32 -> Integer)
-> Integral UInt32
UInt32 -> Integer
UInt32 -> UInt32 -> (UInt32, UInt32)
UInt32 -> UInt32 -> UInt32
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: UInt32 -> Integer
$ctoInteger :: UInt32 -> Integer
divMod :: UInt32 -> UInt32 -> (UInt32, UInt32)
$cdivMod :: UInt32 -> UInt32 -> (UInt32, UInt32)
quotRem :: UInt32 -> UInt32 -> (UInt32, UInt32)
$cquotRem :: UInt32 -> UInt32 -> (UInt32, UInt32)
mod :: UInt32 -> UInt32 -> UInt32
$cmod :: UInt32 -> UInt32 -> UInt32
div :: UInt32 -> UInt32 -> UInt32
$cdiv :: UInt32 -> UInt32 -> UInt32
rem :: UInt32 -> UInt32 -> UInt32
$crem :: UInt32 -> UInt32 -> UInt32
quot :: UInt32 -> UInt32 -> UInt32
$cquot :: UInt32 -> UInt32 -> UInt32
$cp2Integral :: Enum UInt32
$cp1Integral :: Real UInt32
Integral, Typeable UInt32
DataType
Constr
Typeable UInt32
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> UInt32 -> c UInt32)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c UInt32)
-> (UInt32 -> Constr)
-> (UInt32 -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c UInt32))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UInt32))
-> ((forall b. Data b => b -> b) -> UInt32 -> UInt32)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> UInt32 -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> UInt32 -> r)
-> (forall u. (forall d. Data d => d -> u) -> UInt32 -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> UInt32 -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> UInt32 -> m UInt32)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UInt32 -> m UInt32)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UInt32 -> m UInt32)
-> Data UInt32
UInt32 -> DataType
UInt32 -> Constr
(forall b. Data b => b -> b) -> UInt32 -> UInt32
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UInt32 -> c UInt32
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UInt32
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UInt32 -> u
forall u. (forall d. Data d => d -> u) -> UInt32 -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UInt32 -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UInt32 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UInt32 -> m UInt32
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UInt32 -> m UInt32
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UInt32
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UInt32 -> c UInt32
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UInt32)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UInt32)
$cUInt32 :: Constr
$tUInt32 :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> UInt32 -> m UInt32
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UInt32 -> m UInt32
gmapMp :: (forall d. Data d => d -> m d) -> UInt32 -> m UInt32
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UInt32 -> m UInt32
gmapM :: (forall d. Data d => d -> m d) -> UInt32 -> m UInt32
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UInt32 -> m UInt32
gmapQi :: Int -> (forall d. Data d => d -> u) -> UInt32 -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UInt32 -> u
gmapQ :: (forall d. Data d => d -> u) -> UInt32 -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UInt32 -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UInt32 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UInt32 -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UInt32 -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UInt32 -> r
gmapT :: (forall b. Data b => b -> b) -> UInt32 -> UInt32
$cgmapT :: (forall b. Data b => b -> b) -> UInt32 -> UInt32
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UInt32)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UInt32)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c UInt32)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UInt32)
dataTypeOf :: UInt32 -> DataType
$cdataTypeOf :: UInt32 -> DataType
toConstr :: UInt32 -> Constr
$ctoConstr :: UInt32 -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UInt32
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UInt32
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UInt32 -> c UInt32
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UInt32 -> c UInt32
$cp1Data :: Typeable UInt32
Data, Integer -> UInt32
UInt32 -> UInt32
UInt32 -> UInt32 -> UInt32
(UInt32 -> UInt32 -> UInt32)
-> (UInt32 -> UInt32 -> UInt32)
-> (UInt32 -> UInt32 -> UInt32)
-> (UInt32 -> UInt32)
-> (UInt32 -> UInt32)
-> (UInt32 -> UInt32)
-> (Integer -> UInt32)
-> Num UInt32
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> UInt32
$cfromInteger :: Integer -> UInt32
signum :: UInt32 -> UInt32
$csignum :: UInt32 -> UInt32
abs :: UInt32 -> UInt32
$cabs :: UInt32 -> UInt32
negate :: UInt32 -> UInt32
$cnegate :: UInt32 -> UInt32
* :: UInt32 -> UInt32 -> UInt32
$c* :: UInt32 -> UInt32 -> UInt32
- :: UInt32 -> UInt32 -> UInt32
$c- :: UInt32 -> UInt32 -> UInt32
+ :: UInt32 -> UInt32 -> UInt32
$c+ :: UInt32 -> UInt32 -> UInt32
Num, Eq UInt32
Eq UInt32
-> (UInt32 -> UInt32 -> Ordering)
-> (UInt32 -> UInt32 -> Bool)
-> (UInt32 -> UInt32 -> Bool)
-> (UInt32 -> UInt32 -> Bool)
-> (UInt32 -> UInt32 -> Bool)
-> (UInt32 -> UInt32 -> UInt32)
-> (UInt32 -> UInt32 -> UInt32)
-> Ord UInt32
UInt32 -> UInt32 -> Bool
UInt32 -> UInt32 -> Ordering
UInt32 -> UInt32 -> UInt32
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UInt32 -> UInt32 -> UInt32
$cmin :: UInt32 -> UInt32 -> UInt32
max :: UInt32 -> UInt32 -> UInt32
$cmax :: UInt32 -> UInt32 -> UInt32
>= :: UInt32 -> UInt32 -> Bool
$c>= :: UInt32 -> UInt32 -> Bool
> :: UInt32 -> UInt32 -> Bool
$c> :: UInt32 -> UInt32 -> Bool
<= :: UInt32 -> UInt32 -> Bool
$c<= :: UInt32 -> UInt32 -> Bool
< :: UInt32 -> UInt32 -> Bool
$c< :: UInt32 -> UInt32 -> Bool
compare :: UInt32 -> UInt32 -> Ordering
$ccompare :: UInt32 -> UInt32 -> Ordering
$cp1Ord :: Eq UInt32
Ord, ReadPrec [UInt32]
ReadPrec UInt32
Int -> ReadS UInt32
ReadS [UInt32]
(Int -> ReadS UInt32)
-> ReadS [UInt32]
-> ReadPrec UInt32
-> ReadPrec [UInt32]
-> Read UInt32
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UInt32]
$creadListPrec :: ReadPrec [UInt32]
readPrec :: ReadPrec UInt32
$creadPrec :: ReadPrec UInt32
readList :: ReadS [UInt32]
$creadList :: ReadS [UInt32]
readsPrec :: Int -> ReadS UInt32
$creadsPrec :: Int -> ReadS UInt32
Read, Num UInt32
Ord UInt32
Num UInt32 -> Ord UInt32 -> (UInt32 -> Rational) -> Real UInt32
UInt32 -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: UInt32 -> Rational
$ctoRational :: UInt32 -> Rational
$cp2Real :: Ord UInt32
$cp1Real :: Num UInt32
Real, Int -> UInt32 -> ShowS
[UInt32] -> ShowS
UInt32 -> String
(Int -> UInt32 -> ShowS)
-> (UInt32 -> String) -> ([UInt32] -> ShowS) -> Show UInt32
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UInt32] -> ShowS
$cshowList :: [UInt32] -> ShowS
show :: UInt32 -> String
$cshow :: UInt32 -> String
showsPrec :: Int -> UInt32 -> ShowS
$cshowsPrec :: Int -> UInt32 -> ShowS
Show, Ord UInt32
Ord UInt32
-> ((UInt32, UInt32) -> [UInt32])
-> ((UInt32, UInt32) -> UInt32 -> Int)
-> ((UInt32, UInt32) -> UInt32 -> Int)
-> ((UInt32, UInt32) -> UInt32 -> Bool)
-> ((UInt32, UInt32) -> Int)
-> ((UInt32, UInt32) -> Int)
-> Ix UInt32
(UInt32, UInt32) -> Int
(UInt32, UInt32) -> [UInt32]
(UInt32, UInt32) -> UInt32 -> Bool
(UInt32, UInt32) -> UInt32 -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (UInt32, UInt32) -> Int
$cunsafeRangeSize :: (UInt32, UInt32) -> Int
rangeSize :: (UInt32, UInt32) -> Int
$crangeSize :: (UInt32, UInt32) -> Int
inRange :: (UInt32, UInt32) -> UInt32 -> Bool
$cinRange :: (UInt32, UInt32) -> UInt32 -> Bool
unsafeIndex :: (UInt32, UInt32) -> UInt32 -> Int
$cunsafeIndex :: (UInt32, UInt32) -> UInt32 -> Int
index :: (UInt32, UInt32) -> UInt32 -> Int
$cindex :: (UInt32, UInt32) -> UInt32 -> Int
range :: (UInt32, UInt32) -> [UInt32]
$crange :: (UInt32, UInt32) -> [UInt32]
$cp1Ix :: Ord UInt32
Ix, Bits UInt32
Bits UInt32
-> (UInt32 -> Int)
-> (UInt32 -> Int)
-> (UInt32 -> Int)
-> FiniteBits UInt32
UInt32 -> Int
forall b.
Bits b -> (b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
countTrailingZeros :: UInt32 -> Int
$ccountTrailingZeros :: UInt32 -> Int
countLeadingZeros :: UInt32 -> Int
$ccountLeadingZeros :: UInt32 -> Int
finiteBitSize :: UInt32 -> Int
$cfiniteBitSize :: UInt32 -> Int
$cp1FiniteBits :: Bits UInt32
FiniteBits, Eq UInt32
UInt32
Eq UInt32
-> (UInt32 -> UInt32 -> UInt32)
-> (UInt32 -> UInt32 -> UInt32)
-> (UInt32 -> UInt32 -> UInt32)
-> (UInt32 -> UInt32)
-> (UInt32 -> Int -> UInt32)
-> (UInt32 -> Int -> UInt32)
-> UInt32
-> (Int -> UInt32)
-> (UInt32 -> Int -> UInt32)
-> (UInt32 -> Int -> UInt32)
-> (UInt32 -> Int -> UInt32)
-> (UInt32 -> Int -> Bool)
-> (UInt32 -> Maybe Int)
-> (UInt32 -> Int)
-> (UInt32 -> Bool)
-> (UInt32 -> Int -> UInt32)
-> (UInt32 -> Int -> UInt32)
-> (UInt32 -> Int -> UInt32)
-> (UInt32 -> Int -> UInt32)
-> (UInt32 -> Int -> UInt32)
-> (UInt32 -> Int -> UInt32)
-> (UInt32 -> Int)
-> Bits UInt32
Int -> UInt32
UInt32 -> Bool
UInt32 -> Int
UInt32 -> Maybe Int
UInt32 -> UInt32
UInt32 -> Int -> Bool
UInt32 -> Int -> UInt32
UInt32 -> UInt32 -> UInt32
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: UInt32 -> Int
$cpopCount :: UInt32 -> Int
rotateR :: UInt32 -> Int -> UInt32
$crotateR :: UInt32 -> Int -> UInt32
rotateL :: UInt32 -> Int -> UInt32
$crotateL :: UInt32 -> Int -> UInt32
unsafeShiftR :: UInt32 -> Int -> UInt32
$cunsafeShiftR :: UInt32 -> Int -> UInt32
shiftR :: UInt32 -> Int -> UInt32
$cshiftR :: UInt32 -> Int -> UInt32
unsafeShiftL :: UInt32 -> Int -> UInt32
$cunsafeShiftL :: UInt32 -> Int -> UInt32
shiftL :: UInt32 -> Int -> UInt32
$cshiftL :: UInt32 -> Int -> UInt32
isSigned :: UInt32 -> Bool
$cisSigned :: UInt32 -> Bool
bitSize :: UInt32 -> Int
$cbitSize :: UInt32 -> Int
bitSizeMaybe :: UInt32 -> Maybe Int
$cbitSizeMaybe :: UInt32 -> Maybe Int
testBit :: UInt32 -> Int -> Bool
$ctestBit :: UInt32 -> Int -> Bool
complementBit :: UInt32 -> Int -> UInt32
$ccomplementBit :: UInt32 -> Int -> UInt32
clearBit :: UInt32 -> Int -> UInt32
$cclearBit :: UInt32 -> Int -> UInt32
setBit :: UInt32 -> Int -> UInt32
$csetBit :: UInt32 -> Int -> UInt32
bit :: Int -> UInt32
$cbit :: Int -> UInt32
zeroBits :: UInt32
$czeroBits :: UInt32
rotate :: UInt32 -> Int -> UInt32
$crotate :: UInt32 -> Int -> UInt32
shift :: UInt32 -> Int -> UInt32
$cshift :: UInt32 -> Int -> UInt32
complement :: UInt32 -> UInt32
$ccomplement :: UInt32 -> UInt32
xor :: UInt32 -> UInt32 -> UInt32
$cxor :: UInt32 -> UInt32 -> UInt32
.|. :: UInt32 -> UInt32 -> UInt32
$c.|. :: UInt32 -> UInt32 -> UInt32
.&. :: UInt32 -> UInt32 -> UInt32
$c.&. :: UInt32 -> UInt32 -> UInt32
$cp1Bits :: Eq UInt32
Bits, Ptr b -> Int -> IO UInt32
Ptr b -> Int -> UInt32 -> IO ()
Ptr UInt32 -> IO UInt32
Ptr UInt32 -> Int -> IO UInt32
Ptr UInt32 -> Int -> UInt32 -> IO ()
Ptr UInt32 -> UInt32 -> IO ()
UInt32 -> Int
(UInt32 -> Int)
-> (UInt32 -> Int)
-> (Ptr UInt32 -> Int -> IO UInt32)
-> (Ptr UInt32 -> Int -> UInt32 -> IO ())
-> (forall b. Ptr b -> Int -> IO UInt32)
-> (forall b. Ptr b -> Int -> UInt32 -> IO ())
-> (Ptr UInt32 -> IO UInt32)
-> (Ptr UInt32 -> UInt32 -> IO ())
-> Storable UInt32
forall b. Ptr b -> Int -> IO UInt32
forall b. Ptr b -> Int -> UInt32 -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr UInt32 -> UInt32 -> IO ()
$cpoke :: Ptr UInt32 -> UInt32 -> IO ()
peek :: Ptr UInt32 -> IO UInt32
$cpeek :: Ptr UInt32 -> IO UInt32
pokeByteOff :: Ptr b -> Int -> UInt32 -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> UInt32 -> IO ()
peekByteOff :: Ptr b -> Int -> IO UInt32
$cpeekByteOff :: forall b. Ptr b -> Int -> IO UInt32
pokeElemOff :: Ptr UInt32 -> Int -> UInt32 -> IO ()
$cpokeElemOff :: Ptr UInt32 -> Int -> UInt32 -> IO ()
peekElemOff :: Ptr UInt32 -> Int -> IO UInt32
$cpeekElemOff :: Ptr UInt32 -> Int -> IO UInt32
alignment :: UInt32 -> Int
$calignment :: UInt32 -> Int
sizeOf :: UInt32 -> Int
$csizeOf :: UInt32 -> Int
Storable, UInt32 -> ModifierParser
UInt32 -> FieldFormatter
(UInt32 -> FieldFormatter)
-> (UInt32 -> ModifierParser) -> PrintfArg UInt32
forall a.
(a -> FieldFormatter) -> (a -> ModifierParser) -> PrintfArg a
parseFormat :: UInt32 -> ModifierParser
$cparseFormat :: UInt32 -> ModifierParser
formatArg :: UInt32 -> FieldFormatter
$cformatArg :: UInt32 -> FieldFormatter
PrintfArg)

instance Binary UInt32 where
    get :: Get UInt32
get = Word32 -> UInt32
UInt32 (Word32 -> UInt32) -> Get Word32 -> Get UInt32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
    put :: UInt32 -> Put
put = Word32 -> Put
putWord32le (Word32 -> Put) -> (UInt32 -> Word32) -> UInt32 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UInt32 -> Word32
fromUInt32

-- uint8array     byte array, first byte is array size
newtype UInt8Array = UInt8Array { UInt8Array -> ByteString
fromUInt8Array :: BSS.ByteString } deriving (UInt8Array -> UInt8Array -> Bool
(UInt8Array -> UInt8Array -> Bool)
-> (UInt8Array -> UInt8Array -> Bool) -> Eq UInt8Array
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UInt8Array -> UInt8Array -> Bool
$c/= :: UInt8Array -> UInt8Array -> Bool
== :: UInt8Array -> UInt8Array -> Bool
$c== :: UInt8Array -> UInt8Array -> Bool
Eq, Eq UInt8Array
Eq UInt8Array
-> (UInt8Array -> UInt8Array -> Ordering)
-> (UInt8Array -> UInt8Array -> Bool)
-> (UInt8Array -> UInt8Array -> Bool)
-> (UInt8Array -> UInt8Array -> Bool)
-> (UInt8Array -> UInt8Array -> Bool)
-> (UInt8Array -> UInt8Array -> UInt8Array)
-> (UInt8Array -> UInt8Array -> UInt8Array)
-> Ord UInt8Array
UInt8Array -> UInt8Array -> Bool
UInt8Array -> UInt8Array -> Ordering
UInt8Array -> UInt8Array -> UInt8Array
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UInt8Array -> UInt8Array -> UInt8Array
$cmin :: UInt8Array -> UInt8Array -> UInt8Array
max :: UInt8Array -> UInt8Array -> UInt8Array
$cmax :: UInt8Array -> UInt8Array -> UInt8Array
>= :: UInt8Array -> UInt8Array -> Bool
$c>= :: UInt8Array -> UInt8Array -> Bool
> :: UInt8Array -> UInt8Array -> Bool
$c> :: UInt8Array -> UInt8Array -> Bool
<= :: UInt8Array -> UInt8Array -> Bool
$c<= :: UInt8Array -> UInt8Array -> Bool
< :: UInt8Array -> UInt8Array -> Bool
$c< :: UInt8Array -> UInt8Array -> Bool
compare :: UInt8Array -> UInt8Array -> Ordering
$ccompare :: UInt8Array -> UInt8Array -> Ordering
$cp1Ord :: Eq UInt8Array
Ord, String -> UInt8Array
(String -> UInt8Array) -> IsString UInt8Array
forall a. (String -> a) -> IsString a
fromString :: String -> UInt8Array
$cfromString :: String -> UInt8Array
IsString)

toUInt8Array :: BSS.ByteString -> UInt8Array
toUInt8Array :: ByteString -> UInt8Array
toUInt8Array ByteString
s = ByteString -> UInt8Array
UInt8Array ByteString
s

instance Show UInt8Array where
    show :: UInt8Array -> String
show = ByteString -> String
bsShowHex (ByteString -> String)
-> (UInt8Array -> ByteString) -> UInt8Array -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UInt8Array -> ByteString
fromUInt8Array

instance Binary UInt8Array where
    put :: UInt8Array -> Put
put UInt8Array{ByteString
fromUInt8Array :: ByteString
fromUInt8Array :: UInt8Array -> ByteString
..} = do
        Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BSS.length ByteString
fromUInt8Array
        ByteString -> Put
putByteString ByteString
fromUInt8Array

    get :: Get UInt8Array
get = do
        Word8
l <- Get Word8
getWord8
        ByteString
bs <- Int -> Get ByteString
getByteString (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
l)
        UInt8Array -> Get UInt8Array
forall (m :: * -> *) a. Monad m => a -> m a
return (UInt8Array -> Get UInt8Array) -> UInt8Array -> Get UInt8Array
forall a b. (a -> b) -> a -> b
$ ByteString -> UInt8Array
UInt8Array ByteString
bs

-- bd_addr        Bluetooth address in little endian format
newtype BdAddr = BdAddr { BdAddr -> (Word8, Word8, Word8, Word8, Word8, Word8)
fromBdAddr :: (UInt8, UInt8, UInt8, UInt8, UInt8, UInt8) }
    deriving (BdAddr -> BdAddr -> Bool
(BdAddr -> BdAddr -> Bool)
-> (BdAddr -> BdAddr -> Bool) -> Eq BdAddr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BdAddr -> BdAddr -> Bool
$c/= :: BdAddr -> BdAddr -> Bool
== :: BdAddr -> BdAddr -> Bool
$c== :: BdAddr -> BdAddr -> Bool
Eq, Eq BdAddr
Eq BdAddr
-> (BdAddr -> BdAddr -> Ordering)
-> (BdAddr -> BdAddr -> Bool)
-> (BdAddr -> BdAddr -> Bool)
-> (BdAddr -> BdAddr -> Bool)
-> (BdAddr -> BdAddr -> Bool)
-> (BdAddr -> BdAddr -> BdAddr)
-> (BdAddr -> BdAddr -> BdAddr)
-> Ord BdAddr
BdAddr -> BdAddr -> Bool
BdAddr -> BdAddr -> Ordering
BdAddr -> BdAddr -> BdAddr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BdAddr -> BdAddr -> BdAddr
$cmin :: BdAddr -> BdAddr -> BdAddr
max :: BdAddr -> BdAddr -> BdAddr
$cmax :: BdAddr -> BdAddr -> BdAddr
>= :: BdAddr -> BdAddr -> Bool
$c>= :: BdAddr -> BdAddr -> Bool
> :: BdAddr -> BdAddr -> Bool
$c> :: BdAddr -> BdAddr -> Bool
<= :: BdAddr -> BdAddr -> Bool
$c<= :: BdAddr -> BdAddr -> Bool
< :: BdAddr -> BdAddr -> Bool
$c< :: BdAddr -> BdAddr -> Bool
compare :: BdAddr -> BdAddr -> Ordering
$ccompare :: BdAddr -> BdAddr -> Ordering
$cp1Ord :: Eq BdAddr
Ord)

instance Show BdAddr where
    show :: BdAddr -> String
show (BdAddr (Word8
_5, Word8
_4, Word8
_3, Word8
_2, Word8
_1, Word8
_0)) = String
-> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> String
forall r. PrintfType r => String -> r
printf String
"%02x:%02x:%02x:%02x:%02x:%02x" Word8
_0 Word8
_1 Word8
_2 Word8
_3 Word8
_4 Word8
_5

instance Binary BdAddr where
    put :: BdAddr -> Put
put BdAddr{(Word8, Word8, Word8, Word8, Word8, Word8)
fromBdAddr :: (Word8, Word8, Word8, Word8, Word8, Word8)
fromBdAddr :: BdAddr -> (Word8, Word8, Word8, Word8, Word8, Word8)
..} = (Word8, Word8, Word8, Word8, Word8, Word8) -> Put
forall t. Binary t => t -> Put
put (Word8, Word8, Word8, Word8, Word8, Word8)
fromBdAddr
    get :: Get BdAddr
get = Get (Word8, Word8, Word8, Word8, Word8, Word8)
forall t. Binary t => Get t
get Get (Word8, Word8, Word8, Word8, Word8, Word8)
-> ((Word8, Word8, Word8, Word8, Word8, Word8) -> Get BdAddr)
-> Get BdAddr
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BdAddr -> Get BdAddr
forall (m :: * -> *) a. Monad m => a -> m a
return (BdAddr -> Get BdAddr)
-> ((Word8, Word8, Word8, Word8, Word8, Word8) -> BdAddr)
-> (Word8, Word8, Word8, Word8, Word8, Word8)
-> Get BdAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8, Word8, Word8, Word8, Word8, Word8) -> BdAddr
BdAddr

data BgMessageType = BgMsgCR | BgMsgEvent deriving (BgMessageType -> BgMessageType -> Bool
(BgMessageType -> BgMessageType -> Bool)
-> (BgMessageType -> BgMessageType -> Bool) -> Eq BgMessageType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BgMessageType -> BgMessageType -> Bool
$c/= :: BgMessageType -> BgMessageType -> Bool
== :: BgMessageType -> BgMessageType -> Bool
$c== :: BgMessageType -> BgMessageType -> Bool
Eq, Int -> BgMessageType -> ShowS
[BgMessageType] -> ShowS
BgMessageType -> String
(Int -> BgMessageType -> ShowS)
-> (BgMessageType -> String)
-> ([BgMessageType] -> ShowS)
-> Show BgMessageType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BgMessageType] -> ShowS
$cshowList :: [BgMessageType] -> ShowS
show :: BgMessageType -> String
$cshow :: BgMessageType -> String
showsPrec :: Int -> BgMessageType -> ShowS
$cshowsPrec :: Int -> BgMessageType -> ShowS
Show, BgMessageType
BgMessageType -> BgMessageType -> Bounded BgMessageType
forall a. a -> a -> Bounded a
maxBound :: BgMessageType
$cmaxBound :: BgMessageType
minBound :: BgMessageType
$cminBound :: BgMessageType
Bounded, Int -> BgMessageType
BgMessageType -> Int
BgMessageType -> [BgMessageType]
BgMessageType -> BgMessageType
BgMessageType -> BgMessageType -> [BgMessageType]
BgMessageType -> BgMessageType -> BgMessageType -> [BgMessageType]
(BgMessageType -> BgMessageType)
-> (BgMessageType -> BgMessageType)
-> (Int -> BgMessageType)
-> (BgMessageType -> Int)
-> (BgMessageType -> [BgMessageType])
-> (BgMessageType -> BgMessageType -> [BgMessageType])
-> (BgMessageType -> BgMessageType -> [BgMessageType])
-> (BgMessageType
    -> BgMessageType -> BgMessageType -> [BgMessageType])
-> Enum BgMessageType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BgMessageType -> BgMessageType -> BgMessageType -> [BgMessageType]
$cenumFromThenTo :: BgMessageType -> BgMessageType -> BgMessageType -> [BgMessageType]
enumFromTo :: BgMessageType -> BgMessageType -> [BgMessageType]
$cenumFromTo :: BgMessageType -> BgMessageType -> [BgMessageType]
enumFromThen :: BgMessageType -> BgMessageType -> [BgMessageType]
$cenumFromThen :: BgMessageType -> BgMessageType -> [BgMessageType]
enumFrom :: BgMessageType -> [BgMessageType]
$cenumFrom :: BgMessageType -> [BgMessageType]
fromEnum :: BgMessageType -> Int
$cfromEnum :: BgMessageType -> Int
toEnum :: Int -> BgMessageType
$ctoEnum :: Int -> BgMessageType
pred :: BgMessageType -> BgMessageType
$cpred :: BgMessageType -> BgMessageType
succ :: BgMessageType -> BgMessageType
$csucc :: BgMessageType -> BgMessageType
Enum)

data BgTecnologyType = BgBlue | BgWifi deriving (BgTecnologyType -> BgTecnologyType -> Bool
(BgTecnologyType -> BgTecnologyType -> Bool)
-> (BgTecnologyType -> BgTecnologyType -> Bool)
-> Eq BgTecnologyType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BgTecnologyType -> BgTecnologyType -> Bool
$c/= :: BgTecnologyType -> BgTecnologyType -> Bool
== :: BgTecnologyType -> BgTecnologyType -> Bool
$c== :: BgTecnologyType -> BgTecnologyType -> Bool
Eq, Int -> BgTecnologyType -> ShowS
[BgTecnologyType] -> ShowS
BgTecnologyType -> String
(Int -> BgTecnologyType -> ShowS)
-> (BgTecnologyType -> String)
-> ([BgTecnologyType] -> ShowS)
-> Show BgTecnologyType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BgTecnologyType] -> ShowS
$cshowList :: [BgTecnologyType] -> ShowS
show :: BgTecnologyType -> String
$cshow :: BgTecnologyType -> String
showsPrec :: Int -> BgTecnologyType -> ShowS
$cshowsPrec :: Int -> BgTecnologyType -> ShowS
Show, BgTecnologyType
BgTecnologyType -> BgTecnologyType -> Bounded BgTecnologyType
forall a. a -> a -> Bounded a
maxBound :: BgTecnologyType
$cmaxBound :: BgTecnologyType
minBound :: BgTecnologyType
$cminBound :: BgTecnologyType
Bounded, Int -> BgTecnologyType
BgTecnologyType -> Int
BgTecnologyType -> [BgTecnologyType]
BgTecnologyType -> BgTecnologyType
BgTecnologyType -> BgTecnologyType -> [BgTecnologyType]
BgTecnologyType
-> BgTecnologyType -> BgTecnologyType -> [BgTecnologyType]
(BgTecnologyType -> BgTecnologyType)
-> (BgTecnologyType -> BgTecnologyType)
-> (Int -> BgTecnologyType)
-> (BgTecnologyType -> Int)
-> (BgTecnologyType -> [BgTecnologyType])
-> (BgTecnologyType -> BgTecnologyType -> [BgTecnologyType])
-> (BgTecnologyType -> BgTecnologyType -> [BgTecnologyType])
-> (BgTecnologyType
    -> BgTecnologyType -> BgTecnologyType -> [BgTecnologyType])
-> Enum BgTecnologyType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BgTecnologyType
-> BgTecnologyType -> BgTecnologyType -> [BgTecnologyType]
$cenumFromThenTo :: BgTecnologyType
-> BgTecnologyType -> BgTecnologyType -> [BgTecnologyType]
enumFromTo :: BgTecnologyType -> BgTecnologyType -> [BgTecnologyType]
$cenumFromTo :: BgTecnologyType -> BgTecnologyType -> [BgTecnologyType]
enumFromThen :: BgTecnologyType -> BgTecnologyType -> [BgTecnologyType]
$cenumFromThen :: BgTecnologyType -> BgTecnologyType -> [BgTecnologyType]
enumFrom :: BgTecnologyType -> [BgTecnologyType]
$cenumFrom :: BgTecnologyType -> [BgTecnologyType]
fromEnum :: BgTecnologyType -> Int
$cfromEnum :: BgTecnologyType -> Int
toEnum :: Int -> BgTecnologyType
$ctoEnum :: Int -> BgTecnologyType
pred :: BgTecnologyType -> BgTecnologyType
$cpred :: BgTecnologyType -> BgTecnologyType
succ :: BgTecnologyType -> BgTecnologyType
$csucc :: BgTecnologyType -> BgTecnologyType
Enum)

data BgCommandClass
    = BgClsSystem
    | BgClsPersistentStore
    | BgClsAttributeDatabase
    | BgClsConnection
    | BgClsAttributeClient
    | BgClsSecurityManager
    | BgClsGenericAccessProfile
    | BgClsHardware
    | BgClsTest
    | BgClsDfu
    deriving (BgCommandClass -> BgCommandClass -> Bool
(BgCommandClass -> BgCommandClass -> Bool)
-> (BgCommandClass -> BgCommandClass -> Bool) -> Eq BgCommandClass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BgCommandClass -> BgCommandClass -> Bool
$c/= :: BgCommandClass -> BgCommandClass -> Bool
== :: BgCommandClass -> BgCommandClass -> Bool
$c== :: BgCommandClass -> BgCommandClass -> Bool
Eq, Int -> BgCommandClass -> ShowS
[BgCommandClass] -> ShowS
BgCommandClass -> String
(Int -> BgCommandClass -> ShowS)
-> (BgCommandClass -> String)
-> ([BgCommandClass] -> ShowS)
-> Show BgCommandClass
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BgCommandClass] -> ShowS
$cshowList :: [BgCommandClass] -> ShowS
show :: BgCommandClass -> String
$cshow :: BgCommandClass -> String
showsPrec :: Int -> BgCommandClass -> ShowS
$cshowsPrec :: Int -> BgCommandClass -> ShowS
Show, BgCommandClass
BgCommandClass -> BgCommandClass -> Bounded BgCommandClass
forall a. a -> a -> Bounded a
maxBound :: BgCommandClass
$cmaxBound :: BgCommandClass
minBound :: BgCommandClass
$cminBound :: BgCommandClass
Bounded, Int -> BgCommandClass
BgCommandClass -> Int
BgCommandClass -> [BgCommandClass]
BgCommandClass -> BgCommandClass
BgCommandClass -> BgCommandClass -> [BgCommandClass]
BgCommandClass
-> BgCommandClass -> BgCommandClass -> [BgCommandClass]
(BgCommandClass -> BgCommandClass)
-> (BgCommandClass -> BgCommandClass)
-> (Int -> BgCommandClass)
-> (BgCommandClass -> Int)
-> (BgCommandClass -> [BgCommandClass])
-> (BgCommandClass -> BgCommandClass -> [BgCommandClass])
-> (BgCommandClass -> BgCommandClass -> [BgCommandClass])
-> (BgCommandClass
    -> BgCommandClass -> BgCommandClass -> [BgCommandClass])
-> Enum BgCommandClass
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BgCommandClass
-> BgCommandClass -> BgCommandClass -> [BgCommandClass]
$cenumFromThenTo :: BgCommandClass
-> BgCommandClass -> BgCommandClass -> [BgCommandClass]
enumFromTo :: BgCommandClass -> BgCommandClass -> [BgCommandClass]
$cenumFromTo :: BgCommandClass -> BgCommandClass -> [BgCommandClass]
enumFromThen :: BgCommandClass -> BgCommandClass -> [BgCommandClass]
$cenumFromThen :: BgCommandClass -> BgCommandClass -> [BgCommandClass]
enumFrom :: BgCommandClass -> [BgCommandClass]
$cenumFrom :: BgCommandClass -> [BgCommandClass]
fromEnum :: BgCommandClass -> Int
$cfromEnum :: BgCommandClass -> Int
toEnum :: Int -> BgCommandClass
$ctoEnum :: Int -> BgCommandClass
pred :: BgCommandClass -> BgCommandClass
$cpred :: BgCommandClass -> BgCommandClass
succ :: BgCommandClass -> BgCommandClass
$csucc :: BgCommandClass -> BgCommandClass
Enum)

data BgPacketHeader = BgPacketHeader
    { BgPacketHeader -> BgMessageType
bghMessageType    :: BgMessageType
    , BgPacketHeader -> BgTecnologyType
bghTechnologyType :: BgTecnologyType
    , BgPacketHeader -> UInt16
bghLength         :: UInt16 -- Only 11 bits actually
    , BgPacketHeader -> BgCommandClass
bghCommandClass   :: BgCommandClass
    , BgPacketHeader -> Word8
bghCommandId      :: UInt8
    } deriving (BgPacketHeader -> BgPacketHeader -> Bool
(BgPacketHeader -> BgPacketHeader -> Bool)
-> (BgPacketHeader -> BgPacketHeader -> Bool) -> Eq BgPacketHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BgPacketHeader -> BgPacketHeader -> Bool
$c/= :: BgPacketHeader -> BgPacketHeader -> Bool
== :: BgPacketHeader -> BgPacketHeader -> Bool
$c== :: BgPacketHeader -> BgPacketHeader -> Bool
Eq, Int -> BgPacketHeader -> ShowS
[BgPacketHeader] -> ShowS
BgPacketHeader -> String
(Int -> BgPacketHeader -> ShowS)
-> (BgPacketHeader -> String)
-> ([BgPacketHeader] -> ShowS)
-> Show BgPacketHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BgPacketHeader] -> ShowS
$cshowList :: [BgPacketHeader] -> ShowS
show :: BgPacketHeader -> String
$cshow :: BgPacketHeader -> String
showsPrec :: Int -> BgPacketHeader -> ShowS
$cshowsPrec :: Int -> BgPacketHeader -> ShowS
Show)

enumFromIntegral :: forall a b. (Integral a, Bounded b, Enum b) => a -> Get b
enumFromIntegral :: a -> Get b
enumFromIntegral a
i = do
    let mi :: Int
mi = b -> Int
forall a. Enum a => a -> Int
fromEnum (b
forall a. Bounded a => a
minBound :: b)
    let ma :: Int
ma = b -> Int
forall a. Enum a => a -> Int
fromEnum (b
forall a. Bounded a => a
maxBound :: b)
    let ii :: Int
ii = a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i
    if Int
ii Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mi Bool -> Bool -> Bool
&& Int
ii Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
ma
        then b -> Get b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Get b) -> b -> Get b
forall a b. (a -> b) -> a -> b
$ Int -> b
forall a. Enum a => Int -> a
toEnum Int
ii
        else String -> Get b
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get b) -> String -> Get b
forall a b. (a -> b) -> a -> b
$ String
"Value out of bounds: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
mi String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" <= " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
ii String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" <= " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
ma

instance Binary BgPacketHeader where
    put :: BgPacketHeader -> Put
put BgPacketHeader{Word8
BgCommandClass
BgTecnologyType
BgMessageType
UInt16
bghCommandId :: Word8
bghCommandClass :: BgCommandClass
bghLength :: UInt16
bghTechnologyType :: BgTecnologyType
bghMessageType :: BgMessageType
bghCommandId :: BgPacketHeader -> Word8
bghCommandClass :: BgPacketHeader -> BgCommandClass
bghLength :: BgPacketHeader -> UInt16
bghTechnologyType :: BgPacketHeader -> BgTecnologyType
bghMessageType :: BgPacketHeader -> BgMessageType
..} = do
        Word8 -> Put
putWord8
            (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$   Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (BgMessageType -> Int
forall a. Enum a => a -> Int
fromEnum BgMessageType
bghMessageType Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shift` Int
7)
            Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (BgTecnologyType -> Int
forall a. Enum a => a -> Int
fromEnum BgTecnologyType
bghTechnologyType Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shift` Int
3)
            Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. UInt16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((UInt16
bghLength UInt16 -> UInt16 -> UInt16
forall a. Bits a => a -> a -> a
.&. UInt16
0x0700) UInt16 -> Int -> UInt16
forall a. Bits a => a -> Int -> a
`shift` (-Int
8))
        Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ UInt16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UInt16 -> Word8) -> UInt16 -> Word8
forall a b. (a -> b) -> a -> b
$ UInt16
bghLength UInt16 -> UInt16 -> UInt16
forall a. Bits a => a -> a -> a
.&. UInt16
0x00ff
        Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ BgCommandClass -> Int
forall a. Enum a => a -> Int
fromEnum BgCommandClass
bghCommandClass
        Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Word8
bghCommandId

    get :: Get BgPacketHeader
get = do
        Word8
oct0  <- Get Word8
getWord8
        Word8
lLow  <- Get Word8
getWord8
        Word8
clsId <- Get Word8
getWord8
        Word8
cmdId <- Get Word8
getWord8
    
        let lHigh :: Word8
lHigh = Word8
oct0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x07

        BgMessageType
bghMessageType    <- Word8 -> Get BgMessageType
forall a b. (Integral a, Bounded b, Enum b) => a -> Get b
enumFromIntegral (Word8 -> Get BgMessageType) -> Word8 -> Get BgMessageType
forall a b. (a -> b) -> a -> b
$ Word8
oct0 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shift` (-Int
7)
        BgTecnologyType
bghTechnologyType <- Word8 -> Get BgTecnologyType
forall a b. (Integral a, Bounded b, Enum b) => a -> Get b
enumFromIntegral (Word8 -> Get BgTecnologyType) -> Word8 -> Get BgTecnologyType
forall a b. (a -> b) -> a -> b
$ (Word8
oct0 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shift` (-Int
3)) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x0f
        let bghLength :: UInt16
bghLength     =  (Word8 -> UInt16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
lHigh UInt16 -> Int -> UInt16
forall a. Bits a => a -> Int -> a
`shift` Int
8) UInt16 -> UInt16 -> UInt16
forall a. Num a => a -> a -> a
+ (Word8 -> UInt16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
lLow) :: UInt16
        BgCommandClass
bghCommandClass   <- Word8 -> Get BgCommandClass
forall a b. (Integral a, Bounded b, Enum b) => a -> Get b
enumFromIntegral Word8
clsId
        let bghCommandId :: Word8
bghCommandId  =  Word8
cmdId

        BgPacketHeader -> Get BgPacketHeader
forall (m :: * -> *) a. Monad m => a -> m a
return (BgPacketHeader -> Get BgPacketHeader)
-> BgPacketHeader -> Get BgPacketHeader
forall a b. (a -> b) -> a -> b
$ BgPacketHeader :: BgMessageType
-> BgTecnologyType
-> UInt16
-> BgCommandClass
-> Word8
-> BgPacketHeader
BgPacketHeader{Word8
BgCommandClass
BgTecnologyType
BgMessageType
UInt16
bghCommandId :: Word8
bghCommandClass :: BgCommandClass
bghLength :: UInt16
bghTechnologyType :: BgTecnologyType
bghMessageType :: BgMessageType
bghCommandId :: Word8
bghCommandClass :: BgCommandClass
bghLength :: UInt16
bghTechnologyType :: BgTecnologyType
bghMessageType :: BgMessageType
..}

bgHeaderMatches :: BgMessageType -> BgTecnologyType -> BgCommandClass -> UInt8 -> BgPacketHeader -> Bool
bgHeaderMatches :: BgMessageType
-> BgTecnologyType
-> BgCommandClass
-> Word8
-> BgPacketHeader
-> Bool
bgHeaderMatches BgMessageType
mt BgTecnologyType
tt BgCommandClass
cc Word8
cid BgPacketHeader{Word8
BgCommandClass
BgTecnologyType
BgMessageType
UInt16
bghCommandId :: Word8
bghCommandClass :: BgCommandClass
bghLength :: UInt16
bghTechnologyType :: BgTecnologyType
bghMessageType :: BgMessageType
bghCommandId :: BgPacketHeader -> Word8
bghCommandClass :: BgPacketHeader -> BgCommandClass
bghLength :: BgPacketHeader -> UInt16
bghTechnologyType :: BgPacketHeader -> BgTecnologyType
bghMessageType :: BgPacketHeader -> BgMessageType
..}
    =  BgMessageType
mt  BgMessageType -> BgMessageType -> Bool
forall a. Eq a => a -> a -> Bool
== BgMessageType
bghMessageType
    Bool -> Bool -> Bool
&& BgTecnologyType
tt  BgTecnologyType -> BgTecnologyType -> Bool
forall a. Eq a => a -> a -> Bool
== BgTecnologyType
bghTechnologyType
    Bool -> Bool -> Bool
&& BgCommandClass
cc  BgCommandClass -> BgCommandClass -> Bool
forall a. Eq a => a -> a -> Bool
== BgCommandClass
bghCommandClass
    Bool -> Bool -> Bool
&& Word8
cid Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bghCommandId

newtype BgPayload = BgPayload { BgPayload -> ByteString
fromBgPayload :: BSS.ByteString } deriving BgPayload -> BgPayload -> Bool
(BgPayload -> BgPayload -> Bool)
-> (BgPayload -> BgPayload -> Bool) -> Eq BgPayload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BgPayload -> BgPayload -> Bool
$c/= :: BgPayload -> BgPayload -> Bool
== :: BgPayload -> BgPayload -> Bool
$c== :: BgPayload -> BgPayload -> Bool
Eq

toBgPayload :: BSS.ByteString -> BgPayload
toBgPayload :: ByteString -> BgPayload
toBgPayload = ByteString -> BgPayload
BgPayload

instance Show BgPayload where
    show :: BgPayload -> String
show = ByteString -> String
bsShowHex (ByteString -> String)
-> (BgPayload -> ByteString) -> BgPayload -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BgPayload -> ByteString
fromBgPayload

data BgPacket = BgPacket
    { BgPacket -> BgPacketHeader
bgpHeader  :: BgPacketHeader
    , BgPacket -> BgPayload
bgpPayload :: BgPayload
    } deriving (BgPacket -> BgPacket -> Bool
(BgPacket -> BgPacket -> Bool)
-> (BgPacket -> BgPacket -> Bool) -> Eq BgPacket
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BgPacket -> BgPacket -> Bool
$c/= :: BgPacket -> BgPacket -> Bool
== :: BgPacket -> BgPacket -> Bool
$c== :: BgPacket -> BgPacket -> Bool
Eq, Int -> BgPacket -> ShowS
[BgPacket] -> ShowS
BgPacket -> String
(Int -> BgPacket -> ShowS)
-> (BgPacket -> String) -> ([BgPacket] -> ShowS) -> Show BgPacket
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BgPacket] -> ShowS
$cshowList :: [BgPacket] -> ShowS
show :: BgPacket -> String
$cshow :: BgPacket -> String
showsPrec :: Int -> BgPacket -> ShowS
$cshowsPrec :: Int -> BgPacket -> ShowS
Show)

instance Binary BgPacket where
    put :: BgPacket -> Put
put BgPacket{BgPayload
BgPacketHeader
bgpPayload :: BgPayload
bgpHeader :: BgPacketHeader
bgpPayload :: BgPacket -> BgPayload
bgpHeader :: BgPacket -> BgPacketHeader
..} = do
        BgPacketHeader -> Put
forall t. Binary t => t -> Put
put BgPacketHeader
bgpHeader
        ByteString -> Put
putByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ BgPayload -> ByteString
fromBgPayload BgPayload
bgpPayload

    get :: Get BgPacket
get = do
        bgpHeader :: BgPacketHeader
bgpHeader@BgPacketHeader{Word8
BgCommandClass
BgTecnologyType
BgMessageType
UInt16
bghCommandId :: Word8
bghCommandClass :: BgCommandClass
bghLength :: UInt16
bghTechnologyType :: BgTecnologyType
bghMessageType :: BgMessageType
bghCommandId :: BgPacketHeader -> Word8
bghCommandClass :: BgPacketHeader -> BgCommandClass
bghLength :: BgPacketHeader -> UInt16
bghTechnologyType :: BgPacketHeader -> BgTecnologyType
bghMessageType :: BgPacketHeader -> BgMessageType
..} <- Get BgPacketHeader
forall t. Binary t => Get t
get
        BgPayload
bgpPayload <- ByteString -> BgPayload
toBgPayload (ByteString -> BgPayload) -> Get ByteString -> Get BgPayload
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString (UInt16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt16
bghLength)
        BgPacket -> Get BgPacket
forall (m :: * -> *) a. Monad m => a -> m a
return BgPacket :: BgPacketHeader -> BgPayload -> BgPacket
BgPacket{BgPayload
BgPacketHeader
bgpPayload :: BgPayload
bgpHeader :: BgPacketHeader
bgpPayload :: BgPayload
bgpHeader :: BgPacketHeader
..}

class HasSerialPort env where
    getSerialPort :: env -> SerialPort

askSerialPort :: (MonadReader env m, HasSerialPort env) => m SerialPort
askSerialPort :: m SerialPort
askSerialPort = env -> SerialPort
forall env. HasSerialPort env => env -> SerialPort
getSerialPort (env -> SerialPort) -> m env -> m SerialPort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m env
forall r (m :: * -> *). MonadReader r m => m r
ask

class HasBGChan env where
    getBGChan :: env -> TChan BgPacket
    updateBGChan :: TChan BgPacket -> env -> env

askBGChan :: (MonadReader env m, HasBGChan env) => m (TChan BgPacket)
askBGChan :: m (TChan BgPacket)
askBGChan = env -> TChan BgPacket
forall env. HasBGChan env => env -> TChan BgPacket
getBGChan (env -> TChan BgPacket) -> m env -> m (TChan BgPacket)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m env
forall r (m :: * -> *). MonadReader r m => m r
ask

askDupBGChan :: (MonadIO m, MonadReader env m, HasBGChan env) => m (TChan BgPacket)
askDupBGChan :: m (TChan BgPacket)
askDupBGChan = do
    TChan BgPacket
chan <- env -> TChan BgPacket
forall env. HasBGChan env => env -> TChan BgPacket
getBGChan (env -> TChan BgPacket) -> m env -> m (TChan BgPacket)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m env
forall r (m :: * -> *). MonadReader r m => m r
ask
    IO (TChan BgPacket) -> m (TChan BgPacket)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TChan BgPacket) -> m (TChan BgPacket))
-> IO (TChan BgPacket) -> m (TChan BgPacket)
forall a b. (a -> b) -> a -> b
$ STM (TChan BgPacket) -> IO (TChan BgPacket)
forall a. STM a -> IO a
atomically (STM (TChan BgPacket) -> IO (TChan BgPacket))
-> STM (TChan BgPacket) -> IO (TChan BgPacket)
forall a b. (a -> b) -> a -> b
$ TChan BgPacket -> STM (TChan BgPacket)
forall a. TChan a -> STM (TChan a)
dupTChan TChan BgPacket
chan

askCloneBGChan :: (MonadIO m, MonadReader env m, HasBGChan env) => m (TChan BgPacket)
askCloneBGChan :: m (TChan BgPacket)
askCloneBGChan = do
    TChan BgPacket
chan <- env -> TChan BgPacket
forall env. HasBGChan env => env -> TChan BgPacket
getBGChan (env -> TChan BgPacket) -> m env -> m (TChan BgPacket)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m env
forall r (m :: * -> *). MonadReader r m => m r
ask
    IO (TChan BgPacket) -> m (TChan BgPacket)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TChan BgPacket) -> m (TChan BgPacket))
-> IO (TChan BgPacket) -> m (TChan BgPacket)
forall a b. (a -> b) -> a -> b
$ STM (TChan BgPacket) -> IO (TChan BgPacket)
forall a. STM a -> IO a
atomically (STM (TChan BgPacket) -> IO (TChan BgPacket))
-> STM (TChan BgPacket) -> IO (TChan BgPacket)
forall a b. (a -> b) -> a -> b
$ TChan BgPacket -> STM (TChan BgPacket)
forall a. TChan a -> STM (TChan a)
cloneTChan TChan BgPacket
chan
    
packetBlock :: (MonadIO m, MonadReader env m, HasBGChan env) => m a -> m a
packetBlock :: m a -> m a
packetBlock m a
act = do
    TChan BgPacket
newChan <- m (TChan BgPacket)
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasBGChan env) =>
m (TChan BgPacket)
askDupBGChan
    (env -> env) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (TChan BgPacket -> env -> env
forall env. HasBGChan env => TChan BgPacket -> env -> env
updateBGChan TChan BgPacket
newChan) m a
act

packetBlock_ :: (MonadIO m, MonadReader env m, HasBGChan env) => m a -> m ()
packetBlock_ :: m a -> m ()
packetBlock_ m a
act = m a -> m a
forall (m :: * -> *) env a.
(MonadIO m, MonadReader env m, HasBGChan env) =>
m a -> m a
packetBlock m a
act m a -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

packetBlock' :: (MonadIO m, MonadReader env m, HasBGChan env) => m a -> m a
packetBlock' :: m a -> m a
packetBlock' m a
act = do
    TChan BgPacket
newChan <- m (TChan BgPacket)
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasBGChan env) =>
m (TChan BgPacket)
askCloneBGChan
    (env -> env) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (TChan BgPacket -> env -> env
forall env. HasBGChan env => TChan BgPacket -> env -> env
updateBGChan TChan BgPacket
newChan) m a
act

packetBlock'_ :: (MonadIO m, MonadReader env m, HasBGChan env) => m a -> m ()
packetBlock'_ :: m a -> m ()
packetBlock'_ m a
act = m a -> m a
forall (m :: * -> *) env a.
(MonadIO m, MonadReader env m, HasBGChan env) =>
m a -> m a
packetBlock' m a
act m a -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

class HasDebug env where
    getDebug :: env -> Bool

askDebug :: (MonadReader env m, HasDebug env) => m (Bool)
askDebug :: m Bool
askDebug = env -> Bool
forall env. HasDebug env => env -> Bool
getDebug (env -> Bool) -> m env -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m env
forall r (m :: * -> *). MonadReader r m => m r
ask

bsShowHex :: BSS.ByteString -> String
bsShowHex :: ByteString -> String
bsShowHex = (Word8 -> String) -> [Word8] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Word8
n -> Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: Word8 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Word8
n String
"") ([Word8] -> String)
-> (ByteString -> [Word8]) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BSS.unpack

data RebootMode
    -- Reboot into application
    = RebootNormal
    -- Reboot into DFU mode
    | RebootDfu
    deriving (RebootMode -> RebootMode -> Bool
(RebootMode -> RebootMode -> Bool)
-> (RebootMode -> RebootMode -> Bool) -> Eq RebootMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RebootMode -> RebootMode -> Bool
$c/= :: RebootMode -> RebootMode -> Bool
== :: RebootMode -> RebootMode -> Bool
$c== :: RebootMode -> RebootMode -> Bool
Eq, Int -> RebootMode -> ShowS
[RebootMode] -> ShowS
RebootMode -> String
(Int -> RebootMode -> ShowS)
-> (RebootMode -> String)
-> ([RebootMode] -> ShowS)
-> Show RebootMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RebootMode] -> ShowS
$cshowList :: [RebootMode] -> ShowS
show :: RebootMode -> String
$cshow :: RebootMode -> String
showsPrec :: Int -> RebootMode -> ShowS
$cshowsPrec :: Int -> RebootMode -> ShowS
Show, Int -> RebootMode
RebootMode -> Int
RebootMode -> [RebootMode]
RebootMode -> RebootMode
RebootMode -> RebootMode -> [RebootMode]
RebootMode -> RebootMode -> RebootMode -> [RebootMode]
(RebootMode -> RebootMode)
-> (RebootMode -> RebootMode)
-> (Int -> RebootMode)
-> (RebootMode -> Int)
-> (RebootMode -> [RebootMode])
-> (RebootMode -> RebootMode -> [RebootMode])
-> (RebootMode -> RebootMode -> [RebootMode])
-> (RebootMode -> RebootMode -> RebootMode -> [RebootMode])
-> Enum RebootMode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: RebootMode -> RebootMode -> RebootMode -> [RebootMode]
$cenumFromThenTo :: RebootMode -> RebootMode -> RebootMode -> [RebootMode]
enumFromTo :: RebootMode -> RebootMode -> [RebootMode]
$cenumFromTo :: RebootMode -> RebootMode -> [RebootMode]
enumFromThen :: RebootMode -> RebootMode -> [RebootMode]
$cenumFromThen :: RebootMode -> RebootMode -> [RebootMode]
enumFrom :: RebootMode -> [RebootMode]
$cenumFrom :: RebootMode -> [RebootMode]
fromEnum :: RebootMode -> Int
$cfromEnum :: RebootMode -> Int
toEnum :: Int -> RebootMode
$ctoEnum :: Int -> RebootMode
pred :: RebootMode -> RebootMode
$cpred :: RebootMode -> RebootMode
succ :: RebootMode -> RebootMode
$csucc :: RebootMode -> RebootMode
Enum)

instance Binary RebootMode where
    put :: RebootMode -> Put
put RebootMode
m = do
        Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ RebootMode -> Int
forall a. Enum a => a -> Int
fromEnum RebootMode
m
    get :: Get RebootMode
get = do
        Int -> RebootMode
forall a. Enum a => Int -> a
toEnum (Int -> RebootMode) -> (Word8 -> Int) -> Word8 -> RebootMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> RebootMode) -> Get Word8 -> Get RebootMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8

data AttributeValueType
    -- 0: Value was read
    = AVTRead
    -- 1: Value was notified
    | AVTNotify
    -- 2: Value was indicated
    | AVTIndicate
    -- 3: Value was read
    | AVTReadByType
    -- 4: Value was part of a long attribute
    | AVTReadBlob
    -- 5: Value was indicated and the remote device is
    -- waiting for a confirmation
    | AVTIndicateRsqReq
    deriving (AttributeValueType -> AttributeValueType -> Bool
(AttributeValueType -> AttributeValueType -> Bool)
-> (AttributeValueType -> AttributeValueType -> Bool)
-> Eq AttributeValueType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeValueType -> AttributeValueType -> Bool
$c/= :: AttributeValueType -> AttributeValueType -> Bool
== :: AttributeValueType -> AttributeValueType -> Bool
$c== :: AttributeValueType -> AttributeValueType -> Bool
Eq, Int -> AttributeValueType -> ShowS
[AttributeValueType] -> ShowS
AttributeValueType -> String
(Int -> AttributeValueType -> ShowS)
-> (AttributeValueType -> String)
-> ([AttributeValueType] -> ShowS)
-> Show AttributeValueType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeValueType] -> ShowS
$cshowList :: [AttributeValueType] -> ShowS
show :: AttributeValueType -> String
$cshow :: AttributeValueType -> String
showsPrec :: Int -> AttributeValueType -> ShowS
$cshowsPrec :: Int -> AttributeValueType -> ShowS
Show, Int -> AttributeValueType
AttributeValueType -> Int
AttributeValueType -> [AttributeValueType]
AttributeValueType -> AttributeValueType
AttributeValueType -> AttributeValueType -> [AttributeValueType]
AttributeValueType
-> AttributeValueType -> AttributeValueType -> [AttributeValueType]
(AttributeValueType -> AttributeValueType)
-> (AttributeValueType -> AttributeValueType)
-> (Int -> AttributeValueType)
-> (AttributeValueType -> Int)
-> (AttributeValueType -> [AttributeValueType])
-> (AttributeValueType
    -> AttributeValueType -> [AttributeValueType])
-> (AttributeValueType
    -> AttributeValueType -> [AttributeValueType])
-> (AttributeValueType
    -> AttributeValueType
    -> AttributeValueType
    -> [AttributeValueType])
-> Enum AttributeValueType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: AttributeValueType
-> AttributeValueType -> AttributeValueType -> [AttributeValueType]
$cenumFromThenTo :: AttributeValueType
-> AttributeValueType -> AttributeValueType -> [AttributeValueType]
enumFromTo :: AttributeValueType -> AttributeValueType -> [AttributeValueType]
$cenumFromTo :: AttributeValueType -> AttributeValueType -> [AttributeValueType]
enumFromThen :: AttributeValueType -> AttributeValueType -> [AttributeValueType]
$cenumFromThen :: AttributeValueType -> AttributeValueType -> [AttributeValueType]
enumFrom :: AttributeValueType -> [AttributeValueType]
$cenumFrom :: AttributeValueType -> [AttributeValueType]
fromEnum :: AttributeValueType -> Int
$cfromEnum :: AttributeValueType -> Int
toEnum :: Int -> AttributeValueType
$ctoEnum :: Int -> AttributeValueType
pred :: AttributeValueType -> AttributeValueType
$cpred :: AttributeValueType -> AttributeValueType
succ :: AttributeValueType -> AttributeValueType
$csucc :: AttributeValueType -> AttributeValueType
Enum)

instance Binary AttributeValueType where
    put :: AttributeValueType -> Put
put AttributeValueType
m = do
        Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ AttributeValueType -> Int
forall a. Enum a => a -> Int
fromEnum AttributeValueType
m
    get :: Get AttributeValueType
get = do
        Int -> AttributeValueType
forall a. Enum a => Int -> a
toEnum (Int -> AttributeValueType)
-> (Word8 -> Int) -> Word8 -> AttributeValueType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> AttributeValueType)
-> Get Word8 -> Get AttributeValueType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8

data AttributeChangeReason
    -- 0: Value was written by remote device using write request
    = ACRWriteRequest
    -- 1: Value was written by remote device using write command
    | ACRWriteCommand
    -- 2: Local attribute value was written by the
    -- remote device, but the Bluetooth Smart
    -- stack is waiting for the write to be
    -- confirmed by the application.
    -- User Write Response command should
    -- be used to send the confirmation.
    | ACRWriteRequestUser
    deriving (AttributeChangeReason -> AttributeChangeReason -> Bool
(AttributeChangeReason -> AttributeChangeReason -> Bool)
-> (AttributeChangeReason -> AttributeChangeReason -> Bool)
-> Eq AttributeChangeReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeChangeReason -> AttributeChangeReason -> Bool
$c/= :: AttributeChangeReason -> AttributeChangeReason -> Bool
== :: AttributeChangeReason -> AttributeChangeReason -> Bool
$c== :: AttributeChangeReason -> AttributeChangeReason -> Bool
Eq, Int -> AttributeChangeReason -> ShowS
[AttributeChangeReason] -> ShowS
AttributeChangeReason -> String
(Int -> AttributeChangeReason -> ShowS)
-> (AttributeChangeReason -> String)
-> ([AttributeChangeReason] -> ShowS)
-> Show AttributeChangeReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeChangeReason] -> ShowS
$cshowList :: [AttributeChangeReason] -> ShowS
show :: AttributeChangeReason -> String
$cshow :: AttributeChangeReason -> String
showsPrec :: Int -> AttributeChangeReason -> ShowS
$cshowsPrec :: Int -> AttributeChangeReason -> ShowS
Show, Int -> AttributeChangeReason
AttributeChangeReason -> Int
AttributeChangeReason -> [AttributeChangeReason]
AttributeChangeReason -> AttributeChangeReason
AttributeChangeReason
-> AttributeChangeReason -> [AttributeChangeReason]
AttributeChangeReason
-> AttributeChangeReason
-> AttributeChangeReason
-> [AttributeChangeReason]
(AttributeChangeReason -> AttributeChangeReason)
-> (AttributeChangeReason -> AttributeChangeReason)
-> (Int -> AttributeChangeReason)
-> (AttributeChangeReason -> Int)
-> (AttributeChangeReason -> [AttributeChangeReason])
-> (AttributeChangeReason
    -> AttributeChangeReason -> [AttributeChangeReason])
-> (AttributeChangeReason
    -> AttributeChangeReason -> [AttributeChangeReason])
-> (AttributeChangeReason
    -> AttributeChangeReason
    -> AttributeChangeReason
    -> [AttributeChangeReason])
-> Enum AttributeChangeReason
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: AttributeChangeReason
-> AttributeChangeReason
-> AttributeChangeReason
-> [AttributeChangeReason]
$cenumFromThenTo :: AttributeChangeReason
-> AttributeChangeReason
-> AttributeChangeReason
-> [AttributeChangeReason]
enumFromTo :: AttributeChangeReason
-> AttributeChangeReason -> [AttributeChangeReason]
$cenumFromTo :: AttributeChangeReason
-> AttributeChangeReason -> [AttributeChangeReason]
enumFromThen :: AttributeChangeReason
-> AttributeChangeReason -> [AttributeChangeReason]
$cenumFromThen :: AttributeChangeReason
-> AttributeChangeReason -> [AttributeChangeReason]
enumFrom :: AttributeChangeReason -> [AttributeChangeReason]
$cenumFrom :: AttributeChangeReason -> [AttributeChangeReason]
fromEnum :: AttributeChangeReason -> Int
$cfromEnum :: AttributeChangeReason -> Int
toEnum :: Int -> AttributeChangeReason
$ctoEnum :: Int -> AttributeChangeReason
pred :: AttributeChangeReason -> AttributeChangeReason
$cpred :: AttributeChangeReason -> AttributeChangeReason
succ :: AttributeChangeReason -> AttributeChangeReason
$csucc :: AttributeChangeReason -> AttributeChangeReason
Enum)

instance Binary AttributeChangeReason where
    put :: AttributeChangeReason -> Put
put AttributeChangeReason
m = do
        Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ AttributeChangeReason -> Int
forall a. Enum a => a -> Int
fromEnum AttributeChangeReason
m
    get :: Get AttributeChangeReason
get = do
        Int -> AttributeChangeReason
forall a. Enum a => Int -> a
toEnum (Int -> AttributeChangeReason)
-> (Word8 -> Int) -> Word8 -> AttributeChangeReason
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> AttributeChangeReason)
-> Get Word8 -> Get AttributeChangeReason
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
 
-- Attribute status flags

-- Notifications are enabled
fASNotify :: UInt8
fASNotify :: Word8
fASNotify = Word8
0x01

-- Indications are enabled
fASIndicate :: UInt8
fASIndicate :: Word8
fASIndicate = Word8
0x02

-- Connection status flags

-- This status flag tells the connection exists to a remote device.
fCConnected :: UInt8
fCConnected :: Word8
fCConnected = Word8
0x01

-- This flag tells the connection is encrypted.
fCEncrypted :: UInt8
fCEncrypted :: Word8
fCEncrypted = Word8
0x02

-- Connection completed flag, which is used to tell a new connection
-- has been created.
fCCompleted :: UInt8
fCCompleted :: Word8
fCCompleted = Word8
0x04

-- This flag tells that connection parameters have changed and. It is
-- set when connection parameters have changed due to a link layer
-- operation.
fCParametersChanged :: UInt8
fCParametersChanged :: Word8
fCParametersChanged = Word8
0x08

-- 0x01 GAP_AD_FLAG_LIMITED_DISCOVERABLE Limited discoverability
fADLimitedDiscoverable :: UInt8
fADLimitedDiscoverable :: Word8
fADLimitedDiscoverable = Word8
0x01

-- 0x02 GAP_AD_FLAG_GENERAL_DISCOVERABLE General discoverability
fADGeneralDiscoverable :: UInt8
fADGeneralDiscoverable :: Word8
fADGeneralDiscoverable = Word8
0x02

-- 0x04 GAP_AD_FLAG_BREDR_NOT_SUPPORTED BR/EDR not supported
fADBREDRNotSupported :: UInt8
fADBREDRNotSupported :: Word8
fADBREDRNotSupported = Word8
0x04

-- 0x10 GAP_AD_FLAG_SIMULTANEOUS_LEBREDR_CTRL BR/EDR controller
fADSimultaneousLEBREDRCtrl :: UInt8
fADSimultaneousLEBREDRCtrl :: Word8
fADSimultaneousLEBREDRCtrl = Word8
0x10

-- 0x20 GAP_AD_FLAG_SIMULTANEOUS_LEBREDR_HOST BE/EDR host
fADSimultaneousLEBREDRHost :: UInt8
fADSimultaneousLEBREDRHost :: Word8
fADSimultaneousLEBREDRHost = Word8
0x20

-- 0x1f GAP_AD_FLAG_MASK -
fADMask :: UInt8
fADMask :: Word8
fADMask = Word8
0x1f

data GapAdvType
    = GATNone
    | GATFlags
    | GATServices16bitMore
    | GATServices16bitAll
    | GATServices32bitMore
    | GATServices32bitAll
    | GATServices128bitMore
    | GATServices128bitAll
    | GATLocalnameShort
    | GATLocalnameComplete
    | GATTxPower
    deriving (GapAdvType -> GapAdvType -> Bool
(GapAdvType -> GapAdvType -> Bool)
-> (GapAdvType -> GapAdvType -> Bool) -> Eq GapAdvType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GapAdvType -> GapAdvType -> Bool
$c/= :: GapAdvType -> GapAdvType -> Bool
== :: GapAdvType -> GapAdvType -> Bool
$c== :: GapAdvType -> GapAdvType -> Bool
Eq, Int -> GapAdvType -> ShowS
[GapAdvType] -> ShowS
GapAdvType -> String
(Int -> GapAdvType -> ShowS)
-> (GapAdvType -> String)
-> ([GapAdvType] -> ShowS)
-> Show GapAdvType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GapAdvType] -> ShowS
$cshowList :: [GapAdvType] -> ShowS
show :: GapAdvType -> String
$cshow :: GapAdvType -> String
showsPrec :: Int -> GapAdvType -> ShowS
$cshowsPrec :: Int -> GapAdvType -> ShowS
Show, Int -> GapAdvType
GapAdvType -> Int
GapAdvType -> [GapAdvType]
GapAdvType -> GapAdvType
GapAdvType -> GapAdvType -> [GapAdvType]
GapAdvType -> GapAdvType -> GapAdvType -> [GapAdvType]
(GapAdvType -> GapAdvType)
-> (GapAdvType -> GapAdvType)
-> (Int -> GapAdvType)
-> (GapAdvType -> Int)
-> (GapAdvType -> [GapAdvType])
-> (GapAdvType -> GapAdvType -> [GapAdvType])
-> (GapAdvType -> GapAdvType -> [GapAdvType])
-> (GapAdvType -> GapAdvType -> GapAdvType -> [GapAdvType])
-> Enum GapAdvType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GapAdvType -> GapAdvType -> GapAdvType -> [GapAdvType]
$cenumFromThenTo :: GapAdvType -> GapAdvType -> GapAdvType -> [GapAdvType]
enumFromTo :: GapAdvType -> GapAdvType -> [GapAdvType]
$cenumFromTo :: GapAdvType -> GapAdvType -> [GapAdvType]
enumFromThen :: GapAdvType -> GapAdvType -> [GapAdvType]
$cenumFromThen :: GapAdvType -> GapAdvType -> [GapAdvType]
enumFrom :: GapAdvType -> [GapAdvType]
$cenumFrom :: GapAdvType -> [GapAdvType]
fromEnum :: GapAdvType -> Int
$cfromEnum :: GapAdvType -> Int
toEnum :: Int -> GapAdvType
$ctoEnum :: Int -> GapAdvType
pred :: GapAdvType -> GapAdvType
$cpred :: GapAdvType -> GapAdvType
succ :: GapAdvType -> GapAdvType
$csucc :: GapAdvType -> GapAdvType
Enum)

instance Binary GapAdvType where
    put :: GapAdvType -> Put
put GapAdvType
m = do
        Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ GapAdvType -> Int
forall a. Enum a => a -> Int
fromEnum GapAdvType
m
    get :: Get GapAdvType
get = do
        Int -> GapAdvType
forall a. Enum a => Int -> a
toEnum (Int -> GapAdvType) -> (Word8 -> Int) -> Word8 -> GapAdvType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> GapAdvType) -> Get Word8 -> Get GapAdvType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8

data GapAdvPolicy
    -- Respond to scan requests from any master, allow connection
    -- from any master (default)
    = GAPAll
    -- Respond to scan requests from whitelist only, allow connection
    -- from any
    | GAPWhitelistScan
    -- Respond to scan requests from any, allow connection from
    -- whitelist only
    | GAPWhitelistConnect
    -- Respond to scan requests from whitelist only, allow connection
    -- from whitelist only
    | GAPWhitelistAll
    deriving (GapAdvPolicy -> GapAdvPolicy -> Bool
(GapAdvPolicy -> GapAdvPolicy -> Bool)
-> (GapAdvPolicy -> GapAdvPolicy -> Bool) -> Eq GapAdvPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GapAdvPolicy -> GapAdvPolicy -> Bool
$c/= :: GapAdvPolicy -> GapAdvPolicy -> Bool
== :: GapAdvPolicy -> GapAdvPolicy -> Bool
$c== :: GapAdvPolicy -> GapAdvPolicy -> Bool
Eq, Int -> GapAdvPolicy -> ShowS
[GapAdvPolicy] -> ShowS
GapAdvPolicy -> String
(Int -> GapAdvPolicy -> ShowS)
-> (GapAdvPolicy -> String)
-> ([GapAdvPolicy] -> ShowS)
-> Show GapAdvPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GapAdvPolicy] -> ShowS
$cshowList :: [GapAdvPolicy] -> ShowS
show :: GapAdvPolicy -> String
$cshow :: GapAdvPolicy -> String
showsPrec :: Int -> GapAdvPolicy -> ShowS
$cshowsPrec :: Int -> GapAdvPolicy -> ShowS
Show, Int -> GapAdvPolicy
GapAdvPolicy -> Int
GapAdvPolicy -> [GapAdvPolicy]
GapAdvPolicy -> GapAdvPolicy
GapAdvPolicy -> GapAdvPolicy -> [GapAdvPolicy]
GapAdvPolicy -> GapAdvPolicy -> GapAdvPolicy -> [GapAdvPolicy]
(GapAdvPolicy -> GapAdvPolicy)
-> (GapAdvPolicy -> GapAdvPolicy)
-> (Int -> GapAdvPolicy)
-> (GapAdvPolicy -> Int)
-> (GapAdvPolicy -> [GapAdvPolicy])
-> (GapAdvPolicy -> GapAdvPolicy -> [GapAdvPolicy])
-> (GapAdvPolicy -> GapAdvPolicy -> [GapAdvPolicy])
-> (GapAdvPolicy -> GapAdvPolicy -> GapAdvPolicy -> [GapAdvPolicy])
-> Enum GapAdvPolicy
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GapAdvPolicy -> GapAdvPolicy -> GapAdvPolicy -> [GapAdvPolicy]
$cenumFromThenTo :: GapAdvPolicy -> GapAdvPolicy -> GapAdvPolicy -> [GapAdvPolicy]
enumFromTo :: GapAdvPolicy -> GapAdvPolicy -> [GapAdvPolicy]
$cenumFromTo :: GapAdvPolicy -> GapAdvPolicy -> [GapAdvPolicy]
enumFromThen :: GapAdvPolicy -> GapAdvPolicy -> [GapAdvPolicy]
$cenumFromThen :: GapAdvPolicy -> GapAdvPolicy -> [GapAdvPolicy]
enumFrom :: GapAdvPolicy -> [GapAdvPolicy]
$cenumFrom :: GapAdvPolicy -> [GapAdvPolicy]
fromEnum :: GapAdvPolicy -> Int
$cfromEnum :: GapAdvPolicy -> Int
toEnum :: Int -> GapAdvPolicy
$ctoEnum :: Int -> GapAdvPolicy
pred :: GapAdvPolicy -> GapAdvPolicy
$cpred :: GapAdvPolicy -> GapAdvPolicy
succ :: GapAdvPolicy -> GapAdvPolicy
$csucc :: GapAdvPolicy -> GapAdvPolicy
Enum)

instance Binary GapAdvPolicy where
    put :: GapAdvPolicy -> Put
put GapAdvPolicy
m = do
        Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ GapAdvPolicy -> Int
forall a. Enum a => a -> Int
fromEnum GapAdvPolicy
m
    get :: Get GapAdvPolicy
get = do
        Int -> GapAdvPolicy
forall a. Enum a => Int -> a
toEnum (Int -> GapAdvPolicy) -> (Word8 -> Int) -> Word8 -> GapAdvPolicy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> GapAdvPolicy) -> Get Word8 -> Get GapAdvPolicy
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8


data GapAddressType
    = GATPublic
    | GATRandom
    deriving (GapAddressType -> GapAddressType -> Bool
(GapAddressType -> GapAddressType -> Bool)
-> (GapAddressType -> GapAddressType -> Bool) -> Eq GapAddressType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GapAddressType -> GapAddressType -> Bool
$c/= :: GapAddressType -> GapAddressType -> Bool
== :: GapAddressType -> GapAddressType -> Bool
$c== :: GapAddressType -> GapAddressType -> Bool
Eq, Int -> GapAddressType -> ShowS
[GapAddressType] -> ShowS
GapAddressType -> String
(Int -> GapAddressType -> ShowS)
-> (GapAddressType -> String)
-> ([GapAddressType] -> ShowS)
-> Show GapAddressType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GapAddressType] -> ShowS
$cshowList :: [GapAddressType] -> ShowS
show :: GapAddressType -> String
$cshow :: GapAddressType -> String
showsPrec :: Int -> GapAddressType -> ShowS
$cshowsPrec :: Int -> GapAddressType -> ShowS
Show, Int -> GapAddressType
GapAddressType -> Int
GapAddressType -> [GapAddressType]
GapAddressType -> GapAddressType
GapAddressType -> GapAddressType -> [GapAddressType]
GapAddressType
-> GapAddressType -> GapAddressType -> [GapAddressType]
(GapAddressType -> GapAddressType)
-> (GapAddressType -> GapAddressType)
-> (Int -> GapAddressType)
-> (GapAddressType -> Int)
-> (GapAddressType -> [GapAddressType])
-> (GapAddressType -> GapAddressType -> [GapAddressType])
-> (GapAddressType -> GapAddressType -> [GapAddressType])
-> (GapAddressType
    -> GapAddressType -> GapAddressType -> [GapAddressType])
-> Enum GapAddressType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GapAddressType
-> GapAddressType -> GapAddressType -> [GapAddressType]
$cenumFromThenTo :: GapAddressType
-> GapAddressType -> GapAddressType -> [GapAddressType]
enumFromTo :: GapAddressType -> GapAddressType -> [GapAddressType]
$cenumFromTo :: GapAddressType -> GapAddressType -> [GapAddressType]
enumFromThen :: GapAddressType -> GapAddressType -> [GapAddressType]
$cenumFromThen :: GapAddressType -> GapAddressType -> [GapAddressType]
enumFrom :: GapAddressType -> [GapAddressType]
$cenumFrom :: GapAddressType -> [GapAddressType]
fromEnum :: GapAddressType -> Int
$cfromEnum :: GapAddressType -> Int
toEnum :: Int -> GapAddressType
$ctoEnum :: Int -> GapAddressType
pred :: GapAddressType -> GapAddressType
$cpred :: GapAddressType -> GapAddressType
succ :: GapAddressType -> GapAddressType
$csucc :: GapAddressType -> GapAddressType
Enum)

instance Binary GapAddressType where
    put :: GapAddressType -> Put
put GapAddressType
m = do
        Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ GapAddressType -> Int
forall a. Enum a => a -> Int
fromEnum GapAddressType
m
    get :: Get GapAddressType
get = do
        Int -> GapAddressType
forall a. Enum a => Int -> a
toEnum (Int -> GapAddressType)
-> (Word8 -> Int) -> Word8 -> GapAddressType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> GapAddressType) -> Get Word8 -> Get GapAddressType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8

data GapConnectableMode
    -- Not connectable
    = GCMNonConnectable
    -- Directed Connectable
    | GCMDirectedConnectable
    -- Undirected connectable
    | GCMUndirectedConnectable
    -- Same as non-connectable, but also supports ADV_SCAN_IND
    -- packets. Device accepts scan requests (active scanning) but is
    -- not connectable.
    | GCMScannableNonConnectable
    deriving (GapConnectableMode -> GapConnectableMode -> Bool
(GapConnectableMode -> GapConnectableMode -> Bool)
-> (GapConnectableMode -> GapConnectableMode -> Bool)
-> Eq GapConnectableMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GapConnectableMode -> GapConnectableMode -> Bool
$c/= :: GapConnectableMode -> GapConnectableMode -> Bool
== :: GapConnectableMode -> GapConnectableMode -> Bool
$c== :: GapConnectableMode -> GapConnectableMode -> Bool
Eq, Int -> GapConnectableMode -> ShowS
[GapConnectableMode] -> ShowS
GapConnectableMode -> String
(Int -> GapConnectableMode -> ShowS)
-> (GapConnectableMode -> String)
-> ([GapConnectableMode] -> ShowS)
-> Show GapConnectableMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GapConnectableMode] -> ShowS
$cshowList :: [GapConnectableMode] -> ShowS
show :: GapConnectableMode -> String
$cshow :: GapConnectableMode -> String
showsPrec :: Int -> GapConnectableMode -> ShowS
$cshowsPrec :: Int -> GapConnectableMode -> ShowS
Show, Int -> GapConnectableMode
GapConnectableMode -> Int
GapConnectableMode -> [GapConnectableMode]
GapConnectableMode -> GapConnectableMode
GapConnectableMode -> GapConnectableMode -> [GapConnectableMode]
GapConnectableMode
-> GapConnectableMode -> GapConnectableMode -> [GapConnectableMode]
(GapConnectableMode -> GapConnectableMode)
-> (GapConnectableMode -> GapConnectableMode)
-> (Int -> GapConnectableMode)
-> (GapConnectableMode -> Int)
-> (GapConnectableMode -> [GapConnectableMode])
-> (GapConnectableMode
    -> GapConnectableMode -> [GapConnectableMode])
-> (GapConnectableMode
    -> GapConnectableMode -> [GapConnectableMode])
-> (GapConnectableMode
    -> GapConnectableMode
    -> GapConnectableMode
    -> [GapConnectableMode])
-> Enum GapConnectableMode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GapConnectableMode
-> GapConnectableMode -> GapConnectableMode -> [GapConnectableMode]
$cenumFromThenTo :: GapConnectableMode
-> GapConnectableMode -> GapConnectableMode -> [GapConnectableMode]
enumFromTo :: GapConnectableMode -> GapConnectableMode -> [GapConnectableMode]
$cenumFromTo :: GapConnectableMode -> GapConnectableMode -> [GapConnectableMode]
enumFromThen :: GapConnectableMode -> GapConnectableMode -> [GapConnectableMode]
$cenumFromThen :: GapConnectableMode -> GapConnectableMode -> [GapConnectableMode]
enumFrom :: GapConnectableMode -> [GapConnectableMode]
$cenumFrom :: GapConnectableMode -> [GapConnectableMode]
fromEnum :: GapConnectableMode -> Int
$cfromEnum :: GapConnectableMode -> Int
toEnum :: Int -> GapConnectableMode
$ctoEnum :: Int -> GapConnectableMode
pred :: GapConnectableMode -> GapConnectableMode
$cpred :: GapConnectableMode -> GapConnectableMode
succ :: GapConnectableMode -> GapConnectableMode
$csucc :: GapConnectableMode -> GapConnectableMode
Enum)

instance Binary GapConnectableMode where
    put :: GapConnectableMode -> Put
put GapConnectableMode
m = do
        Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ GapConnectableMode -> Int
forall a. Enum a => a -> Int
fromEnum GapConnectableMode
m
    get :: Get GapConnectableMode
get = do
        Int -> GapConnectableMode
forall a. Enum a => Int -> a
toEnum (Int -> GapConnectableMode)
-> (Word8 -> Int) -> Word8 -> GapConnectableMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> GapConnectableMode)
-> Get Word8 -> Get GapConnectableMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
    

data GapDiscoverableMode
    -- Non-discoverable mode: the LE Limited Discoverable Mode and the
    -- LE General Discoverable Mode bits are NOT set in the Flags AD
    -- type. A master can still connect to the advertising slave in this mode.
    = GDMNonDiscoverable
    -- 1 gap_limited_discoverable Discoverable using limited scanning mode: the advertisement
    -- packets will carry the LE Limited Discoverable Mode bit set in the
    -- Flags AD type.
    | GDMLimitedDiscoverable
    -- 2 gap_general_discoverable Discoverable using general scanning mode: the advertisement
    -- packets will carry the LE General Discoverable Mode bit set in the
    -- Flags AD type.
    | GDMGeneralDiscoverable
    -- 3 gap_broadcast Same as gap_non_discoverable above.
    | GDMBroadcast
    -- 4 gap_user_data In this advertisement the advertisement and scan response data
    -- defined by user will be used. The user is responsible of building the
    -- advertisement data so that it also contains the appropriate desired
    -- Flags AD type.
    | GDMUserData
    -- 0x80 gap_enhanced_broadcasting When turning the most highest bit on in GAP discoverable mode, the
    -- remote devices that send scan request packets to the advertiser are
    -- reported back to the application through Scan Response event.
    -- This is so called Enhanced Broadcasting mode.
    | GDMEnhancedBroadcasting
    deriving (GapDiscoverableMode -> GapDiscoverableMode -> Bool
(GapDiscoverableMode -> GapDiscoverableMode -> Bool)
-> (GapDiscoverableMode -> GapDiscoverableMode -> Bool)
-> Eq GapDiscoverableMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GapDiscoverableMode -> GapDiscoverableMode -> Bool
$c/= :: GapDiscoverableMode -> GapDiscoverableMode -> Bool
== :: GapDiscoverableMode -> GapDiscoverableMode -> Bool
$c== :: GapDiscoverableMode -> GapDiscoverableMode -> Bool
Eq, Int -> GapDiscoverableMode -> ShowS
[GapDiscoverableMode] -> ShowS
GapDiscoverableMode -> String
(Int -> GapDiscoverableMode -> ShowS)
-> (GapDiscoverableMode -> String)
-> ([GapDiscoverableMode] -> ShowS)
-> Show GapDiscoverableMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GapDiscoverableMode] -> ShowS
$cshowList :: [GapDiscoverableMode] -> ShowS
show :: GapDiscoverableMode -> String
$cshow :: GapDiscoverableMode -> String
showsPrec :: Int -> GapDiscoverableMode -> ShowS
$cshowsPrec :: Int -> GapDiscoverableMode -> ShowS
Show, Int -> GapDiscoverableMode
GapDiscoverableMode -> Int
GapDiscoverableMode -> [GapDiscoverableMode]
GapDiscoverableMode -> GapDiscoverableMode
GapDiscoverableMode -> GapDiscoverableMode -> [GapDiscoverableMode]
GapDiscoverableMode
-> GapDiscoverableMode
-> GapDiscoverableMode
-> [GapDiscoverableMode]
(GapDiscoverableMode -> GapDiscoverableMode)
-> (GapDiscoverableMode -> GapDiscoverableMode)
-> (Int -> GapDiscoverableMode)
-> (GapDiscoverableMode -> Int)
-> (GapDiscoverableMode -> [GapDiscoverableMode])
-> (GapDiscoverableMode
    -> GapDiscoverableMode -> [GapDiscoverableMode])
-> (GapDiscoverableMode
    -> GapDiscoverableMode -> [GapDiscoverableMode])
-> (GapDiscoverableMode
    -> GapDiscoverableMode
    -> GapDiscoverableMode
    -> [GapDiscoverableMode])
-> Enum GapDiscoverableMode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GapDiscoverableMode
-> GapDiscoverableMode
-> GapDiscoverableMode
-> [GapDiscoverableMode]
$cenumFromThenTo :: GapDiscoverableMode
-> GapDiscoverableMode
-> GapDiscoverableMode
-> [GapDiscoverableMode]
enumFromTo :: GapDiscoverableMode -> GapDiscoverableMode -> [GapDiscoverableMode]
$cenumFromTo :: GapDiscoverableMode -> GapDiscoverableMode -> [GapDiscoverableMode]
enumFromThen :: GapDiscoverableMode -> GapDiscoverableMode -> [GapDiscoverableMode]
$cenumFromThen :: GapDiscoverableMode -> GapDiscoverableMode -> [GapDiscoverableMode]
enumFrom :: GapDiscoverableMode -> [GapDiscoverableMode]
$cenumFrom :: GapDiscoverableMode -> [GapDiscoverableMode]
fromEnum :: GapDiscoverableMode -> Int
$cfromEnum :: GapDiscoverableMode -> Int
toEnum :: Int -> GapDiscoverableMode
$ctoEnum :: Int -> GapDiscoverableMode
pred :: GapDiscoverableMode -> GapDiscoverableMode
$cpred :: GapDiscoverableMode -> GapDiscoverableMode
succ :: GapDiscoverableMode -> GapDiscoverableMode
$csucc :: GapDiscoverableMode -> GapDiscoverableMode
Enum)

instance Binary GapDiscoverableMode where
    put :: GapDiscoverableMode -> Put
put GapDiscoverableMode
m = do
        Word8 -> Put
putWord8(Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ case GapDiscoverableMode
m of
            GapDiscoverableMode
GDMEnhancedBroadcasting -> Word8
0x80
            GapDiscoverableMode
_ -> Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ GapDiscoverableMode -> Int
forall a. Enum a => a -> Int
fromEnum GapDiscoverableMode
m
    get :: Get GapDiscoverableMode
get = do
        Word8
x <- Get Word8
getWord8
        GapDiscoverableMode -> Get GapDiscoverableMode
forall (m :: * -> *) a. Monad m => a -> m a
return (GapDiscoverableMode -> Get GapDiscoverableMode)
-> GapDiscoverableMode -> Get GapDiscoverableMode
forall a b. (a -> b) -> a -> b
$ case Word8
x of
            Word8
5 -> GapDiscoverableMode
GDMEnhancedBroadcasting
            Word8
_ -> Int -> GapDiscoverableMode
forall a. Enum a => Int -> a
toEnum (Int -> GapDiscoverableMode) -> Int -> GapDiscoverableMode
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x

data GapDiscoverMode
    -- 0: Discover only limited discoverable devices, that is, Slaves which have the
    -- LE Limited Discoverable Mode bit set in the Flags AD type of their
    -- advertisement packets.
    = GapDiscoverLimited
    -- Discover limited and generic discoverable devices, that is, Slaves which
    -- have the LE Limited Discoverable Mode or the LE General Discoverable
    -- Mode bit set in the Flags AD type of their advertisement packets.
    | GapDiscoverGeneric
    -- Discover all devices regardless of the Flags AD typ
    | GapDiscoverOvservation
    deriving (GapDiscoverMode -> GapDiscoverMode -> Bool
(GapDiscoverMode -> GapDiscoverMode -> Bool)
-> (GapDiscoverMode -> GapDiscoverMode -> Bool)
-> Eq GapDiscoverMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GapDiscoverMode -> GapDiscoverMode -> Bool
$c/= :: GapDiscoverMode -> GapDiscoverMode -> Bool
== :: GapDiscoverMode -> GapDiscoverMode -> Bool
$c== :: GapDiscoverMode -> GapDiscoverMode -> Bool
Eq, Int -> GapDiscoverMode -> ShowS
[GapDiscoverMode] -> ShowS
GapDiscoverMode -> String
(Int -> GapDiscoverMode -> ShowS)
-> (GapDiscoverMode -> String)
-> ([GapDiscoverMode] -> ShowS)
-> Show GapDiscoverMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GapDiscoverMode] -> ShowS
$cshowList :: [GapDiscoverMode] -> ShowS
show :: GapDiscoverMode -> String
$cshow :: GapDiscoverMode -> String
showsPrec :: Int -> GapDiscoverMode -> ShowS
$cshowsPrec :: Int -> GapDiscoverMode -> ShowS
Show, Int -> GapDiscoverMode
GapDiscoverMode -> Int
GapDiscoverMode -> [GapDiscoverMode]
GapDiscoverMode -> GapDiscoverMode
GapDiscoverMode -> GapDiscoverMode -> [GapDiscoverMode]
GapDiscoverMode
-> GapDiscoverMode -> GapDiscoverMode -> [GapDiscoverMode]
(GapDiscoverMode -> GapDiscoverMode)
-> (GapDiscoverMode -> GapDiscoverMode)
-> (Int -> GapDiscoverMode)
-> (GapDiscoverMode -> Int)
-> (GapDiscoverMode -> [GapDiscoverMode])
-> (GapDiscoverMode -> GapDiscoverMode -> [GapDiscoverMode])
-> (GapDiscoverMode -> GapDiscoverMode -> [GapDiscoverMode])
-> (GapDiscoverMode
    -> GapDiscoverMode -> GapDiscoverMode -> [GapDiscoverMode])
-> Enum GapDiscoverMode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GapDiscoverMode
-> GapDiscoverMode -> GapDiscoverMode -> [GapDiscoverMode]
$cenumFromThenTo :: GapDiscoverMode
-> GapDiscoverMode -> GapDiscoverMode -> [GapDiscoverMode]
enumFromTo :: GapDiscoverMode -> GapDiscoverMode -> [GapDiscoverMode]
$cenumFromTo :: GapDiscoverMode -> GapDiscoverMode -> [GapDiscoverMode]
enumFromThen :: GapDiscoverMode -> GapDiscoverMode -> [GapDiscoverMode]
$cenumFromThen :: GapDiscoverMode -> GapDiscoverMode -> [GapDiscoverMode]
enumFrom :: GapDiscoverMode -> [GapDiscoverMode]
$cenumFrom :: GapDiscoverMode -> [GapDiscoverMode]
fromEnum :: GapDiscoverMode -> Int
$cfromEnum :: GapDiscoverMode -> Int
toEnum :: Int -> GapDiscoverMode
$ctoEnum :: Int -> GapDiscoverMode
pred :: GapDiscoverMode -> GapDiscoverMode
$cpred :: GapDiscoverMode -> GapDiscoverMode
succ :: GapDiscoverMode -> GapDiscoverMode
$csucc :: GapDiscoverMode -> GapDiscoverMode
Enum)

instance Binary GapDiscoverMode where
    put :: GapDiscoverMode -> Put
put GapDiscoverMode
m = do
        Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ GapDiscoverMode -> Int
forall a. Enum a => a -> Int
fromEnum GapDiscoverMode
m
    get :: Get GapDiscoverMode
get = do
        Int -> GapDiscoverMode
forall a. Enum a => Int -> a
toEnum (Int -> GapDiscoverMode)
-> (Word16 -> Int) -> Word16 -> GapDiscoverMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> GapDiscoverMode) -> Get Word16 -> Get GapDiscoverMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le


-- GAP Scan header flags
data GSPScanHeaderFlag
    -- Connectable undirected advertising event
    = GSHFAdvInd
    -- Connectable directed advertising event
    | GSHFAdvDirectInd
    -- Non-connectable undirected advertising event
    | GSHFAdvNonConnInd
    -- Scanner wants information from Advertiser
    | GSHFScanReq
    -- Advertiser gives more information to Scanner
    | GSHFScanRsp
    -- Initiator wants to connect to Advertiser
    | GSHFConnectReq
    -- Non-connectable undirected advertising event
    | GSHFAdvDiscoverInd
    deriving (GSPScanHeaderFlag -> GSPScanHeaderFlag -> Bool
(GSPScanHeaderFlag -> GSPScanHeaderFlag -> Bool)
-> (GSPScanHeaderFlag -> GSPScanHeaderFlag -> Bool)
-> Eq GSPScanHeaderFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GSPScanHeaderFlag -> GSPScanHeaderFlag -> Bool
$c/= :: GSPScanHeaderFlag -> GSPScanHeaderFlag -> Bool
== :: GSPScanHeaderFlag -> GSPScanHeaderFlag -> Bool
$c== :: GSPScanHeaderFlag -> GSPScanHeaderFlag -> Bool
Eq, Int -> GSPScanHeaderFlag -> ShowS
[GSPScanHeaderFlag] -> ShowS
GSPScanHeaderFlag -> String
(Int -> GSPScanHeaderFlag -> ShowS)
-> (GSPScanHeaderFlag -> String)
-> ([GSPScanHeaderFlag] -> ShowS)
-> Show GSPScanHeaderFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GSPScanHeaderFlag] -> ShowS
$cshowList :: [GSPScanHeaderFlag] -> ShowS
show :: GSPScanHeaderFlag -> String
$cshow :: GSPScanHeaderFlag -> String
showsPrec :: Int -> GSPScanHeaderFlag -> ShowS
$cshowsPrec :: Int -> GSPScanHeaderFlag -> ShowS
Show, Int -> GSPScanHeaderFlag
GSPScanHeaderFlag -> Int
GSPScanHeaderFlag -> [GSPScanHeaderFlag]
GSPScanHeaderFlag -> GSPScanHeaderFlag
GSPScanHeaderFlag -> GSPScanHeaderFlag -> [GSPScanHeaderFlag]
GSPScanHeaderFlag
-> GSPScanHeaderFlag -> GSPScanHeaderFlag -> [GSPScanHeaderFlag]
(GSPScanHeaderFlag -> GSPScanHeaderFlag)
-> (GSPScanHeaderFlag -> GSPScanHeaderFlag)
-> (Int -> GSPScanHeaderFlag)
-> (GSPScanHeaderFlag -> Int)
-> (GSPScanHeaderFlag -> [GSPScanHeaderFlag])
-> (GSPScanHeaderFlag -> GSPScanHeaderFlag -> [GSPScanHeaderFlag])
-> (GSPScanHeaderFlag -> GSPScanHeaderFlag -> [GSPScanHeaderFlag])
-> (GSPScanHeaderFlag
    -> GSPScanHeaderFlag -> GSPScanHeaderFlag -> [GSPScanHeaderFlag])
-> Enum GSPScanHeaderFlag
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GSPScanHeaderFlag
-> GSPScanHeaderFlag -> GSPScanHeaderFlag -> [GSPScanHeaderFlag]
$cenumFromThenTo :: GSPScanHeaderFlag
-> GSPScanHeaderFlag -> GSPScanHeaderFlag -> [GSPScanHeaderFlag]
enumFromTo :: GSPScanHeaderFlag -> GSPScanHeaderFlag -> [GSPScanHeaderFlag]
$cenumFromTo :: GSPScanHeaderFlag -> GSPScanHeaderFlag -> [GSPScanHeaderFlag]
enumFromThen :: GSPScanHeaderFlag -> GSPScanHeaderFlag -> [GSPScanHeaderFlag]
$cenumFromThen :: GSPScanHeaderFlag -> GSPScanHeaderFlag -> [GSPScanHeaderFlag]
enumFrom :: GSPScanHeaderFlag -> [GSPScanHeaderFlag]
$cenumFrom :: GSPScanHeaderFlag -> [GSPScanHeaderFlag]
fromEnum :: GSPScanHeaderFlag -> Int
$cfromEnum :: GSPScanHeaderFlag -> Int
toEnum :: Int -> GSPScanHeaderFlag
$ctoEnum :: Int -> GSPScanHeaderFlag
pred :: GSPScanHeaderFlag -> GSPScanHeaderFlag
$cpred :: GSPScanHeaderFlag -> GSPScanHeaderFlag
succ :: GSPScanHeaderFlag -> GSPScanHeaderFlag
$csucc :: GSPScanHeaderFlag -> GSPScanHeaderFlag
Enum)

instance Binary GSPScanHeaderFlag where
    put :: GSPScanHeaderFlag -> Put
put GSPScanHeaderFlag
m = do
        Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ GSPScanHeaderFlag -> Int
forall a. Enum a => a -> Int
fromEnum GSPScanHeaderFlag
m
    get :: Get GSPScanHeaderFlag
get = do
        Int -> GSPScanHeaderFlag
forall a. Enum a => Int -> a
toEnum (Int -> GSPScanHeaderFlag)
-> (Word8 -> Int) -> Word8 -> GSPScanHeaderFlag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> GSPScanHeaderFlag) -> Get Word8 -> Get GSPScanHeaderFlag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8

data GapScanPolicy
    -- All advertisement Packets (default)
    = GSPAll
    -- Ignore advertisement packets from remote slaves not in the running
    -- whitelist
    | GSPWhitelist
    deriving (GapScanPolicy -> GapScanPolicy -> Bool
(GapScanPolicy -> GapScanPolicy -> Bool)
-> (GapScanPolicy -> GapScanPolicy -> Bool) -> Eq GapScanPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GapScanPolicy -> GapScanPolicy -> Bool
$c/= :: GapScanPolicy -> GapScanPolicy -> Bool
== :: GapScanPolicy -> GapScanPolicy -> Bool
$c== :: GapScanPolicy -> GapScanPolicy -> Bool
Eq, Int -> GapScanPolicy -> ShowS
[GapScanPolicy] -> ShowS
GapScanPolicy -> String
(Int -> GapScanPolicy -> ShowS)
-> (GapScanPolicy -> String)
-> ([GapScanPolicy] -> ShowS)
-> Show GapScanPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GapScanPolicy] -> ShowS
$cshowList :: [GapScanPolicy] -> ShowS
show :: GapScanPolicy -> String
$cshow :: GapScanPolicy -> String
showsPrec :: Int -> GapScanPolicy -> ShowS
$cshowsPrec :: Int -> GapScanPolicy -> ShowS
Show, Int -> GapScanPolicy
GapScanPolicy -> Int
GapScanPolicy -> [GapScanPolicy]
GapScanPolicy -> GapScanPolicy
GapScanPolicy -> GapScanPolicy -> [GapScanPolicy]
GapScanPolicy -> GapScanPolicy -> GapScanPolicy -> [GapScanPolicy]
(GapScanPolicy -> GapScanPolicy)
-> (GapScanPolicy -> GapScanPolicy)
-> (Int -> GapScanPolicy)
-> (GapScanPolicy -> Int)
-> (GapScanPolicy -> [GapScanPolicy])
-> (GapScanPolicy -> GapScanPolicy -> [GapScanPolicy])
-> (GapScanPolicy -> GapScanPolicy -> [GapScanPolicy])
-> (GapScanPolicy
    -> GapScanPolicy -> GapScanPolicy -> [GapScanPolicy])
-> Enum GapScanPolicy
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GapScanPolicy -> GapScanPolicy -> GapScanPolicy -> [GapScanPolicy]
$cenumFromThenTo :: GapScanPolicy -> GapScanPolicy -> GapScanPolicy -> [GapScanPolicy]
enumFromTo :: GapScanPolicy -> GapScanPolicy -> [GapScanPolicy]
$cenumFromTo :: GapScanPolicy -> GapScanPolicy -> [GapScanPolicy]
enumFromThen :: GapScanPolicy -> GapScanPolicy -> [GapScanPolicy]
$cenumFromThen :: GapScanPolicy -> GapScanPolicy -> [GapScanPolicy]
enumFrom :: GapScanPolicy -> [GapScanPolicy]
$cenumFrom :: GapScanPolicy -> [GapScanPolicy]
fromEnum :: GapScanPolicy -> Int
$cfromEnum :: GapScanPolicy -> Int
toEnum :: Int -> GapScanPolicy
$ctoEnum :: Int -> GapScanPolicy
pred :: GapScanPolicy -> GapScanPolicy
$cpred :: GapScanPolicy -> GapScanPolicy
succ :: GapScanPolicy -> GapScanPolicy
$csucc :: GapScanPolicy -> GapScanPolicy
Enum)

instance Binary GapScanPolicy where
    put :: GapScanPolicy -> Put
put GapScanPolicy
m = do
        Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ GapScanPolicy -> Int
forall a. Enum a => a -> Int
fromEnum GapScanPolicy
m
    get :: Get GapScanPolicy
get = do
        Int -> GapScanPolicy
forall a. Enum a => Int -> a
toEnum (Int -> GapScanPolicy) -> (Word8 -> Int) -> Word8 -> GapScanPolicy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> GapScanPolicy) -> Get Word8 -> Get GapScanPolicy
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8

-- SM Bonding Key flags

-- LTK saved in master
fBKLTK :: UInt8
fBKLTK :: Word8
fBKLTK = Word8
0x01

-- Public Address
fBKAddrPublic :: UInt8
fBKAddrPublic :: Word8
fBKAddrPublic = Word8
0x02

-- Static Address
fBKAddrStatic :: UInt8
fBKAddrStatic :: Word8
fBKAddrStatic = Word8
0x04

-- Identity resolving key for resolvable private addresses
fBKIRK :: UInt8
fBKIRK :: Word8
fBKIRK = Word8
0x08

-- EDIV+RAND received from slave
fBKEDIVRAND :: UInt8
fBKEDIVRAND :: Word8
fBKEDIVRAND = Word8
0x10

-- Connection signature resolving key
fBKCSRK :: UInt8
fBKCSRK :: Word8
fBKCSRK = Word8
0x20

-- EDIV+RAND sent to master
fBKMasterId :: UInt8
fBKMasterId :: Word8
fBKMasterId = Word8
0x40

data SMIOCapabilities
    -- Display Only
    = SICDisplayOnly
    -- Display with Yes/No-buttons
    | SICDisplayYesNo
    -- Keyboard Only
    | SICKeyboardOnly
    -- No Input and No Output
    | SICNoIO
    -- Display with Keyboard
    | SICKeyboardDisplay
    deriving (SMIOCapabilities -> SMIOCapabilities -> Bool
(SMIOCapabilities -> SMIOCapabilities -> Bool)
-> (SMIOCapabilities -> SMIOCapabilities -> Bool)
-> Eq SMIOCapabilities
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SMIOCapabilities -> SMIOCapabilities -> Bool
$c/= :: SMIOCapabilities -> SMIOCapabilities -> Bool
== :: SMIOCapabilities -> SMIOCapabilities -> Bool
$c== :: SMIOCapabilities -> SMIOCapabilities -> Bool
Eq, Int -> SMIOCapabilities
SMIOCapabilities -> Int
SMIOCapabilities -> [SMIOCapabilities]
SMIOCapabilities -> SMIOCapabilities
SMIOCapabilities -> SMIOCapabilities -> [SMIOCapabilities]
SMIOCapabilities
-> SMIOCapabilities -> SMIOCapabilities -> [SMIOCapabilities]
(SMIOCapabilities -> SMIOCapabilities)
-> (SMIOCapabilities -> SMIOCapabilities)
-> (Int -> SMIOCapabilities)
-> (SMIOCapabilities -> Int)
-> (SMIOCapabilities -> [SMIOCapabilities])
-> (SMIOCapabilities -> SMIOCapabilities -> [SMIOCapabilities])
-> (SMIOCapabilities -> SMIOCapabilities -> [SMIOCapabilities])
-> (SMIOCapabilities
    -> SMIOCapabilities -> SMIOCapabilities -> [SMIOCapabilities])
-> Enum SMIOCapabilities
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SMIOCapabilities
-> SMIOCapabilities -> SMIOCapabilities -> [SMIOCapabilities]
$cenumFromThenTo :: SMIOCapabilities
-> SMIOCapabilities -> SMIOCapabilities -> [SMIOCapabilities]
enumFromTo :: SMIOCapabilities -> SMIOCapabilities -> [SMIOCapabilities]
$cenumFromTo :: SMIOCapabilities -> SMIOCapabilities -> [SMIOCapabilities]
enumFromThen :: SMIOCapabilities -> SMIOCapabilities -> [SMIOCapabilities]
$cenumFromThen :: SMIOCapabilities -> SMIOCapabilities -> [SMIOCapabilities]
enumFrom :: SMIOCapabilities -> [SMIOCapabilities]
$cenumFrom :: SMIOCapabilities -> [SMIOCapabilities]
fromEnum :: SMIOCapabilities -> Int
$cfromEnum :: SMIOCapabilities -> Int
toEnum :: Int -> SMIOCapabilities
$ctoEnum :: Int -> SMIOCapabilities
pred :: SMIOCapabilities -> SMIOCapabilities
$cpred :: SMIOCapabilities -> SMIOCapabilities
succ :: SMIOCapabilities -> SMIOCapabilities
$csucc :: SMIOCapabilities -> SMIOCapabilities
Enum, Int -> SMIOCapabilities -> ShowS
[SMIOCapabilities] -> ShowS
SMIOCapabilities -> String
(Int -> SMIOCapabilities -> ShowS)
-> (SMIOCapabilities -> String)
-> ([SMIOCapabilities] -> ShowS)
-> Show SMIOCapabilities
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SMIOCapabilities] -> ShowS
$cshowList :: [SMIOCapabilities] -> ShowS
show :: SMIOCapabilities -> String
$cshow :: SMIOCapabilities -> String
showsPrec :: Int -> SMIOCapabilities -> ShowS
$cshowsPrec :: Int -> SMIOCapabilities -> ShowS
Show)

instance Binary SMIOCapabilities where
    put :: SMIOCapabilities -> Put
put SMIOCapabilities
m = do
        Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ SMIOCapabilities -> Int
forall a. Enum a => a -> Int
fromEnum SMIOCapabilities
m
    get :: Get SMIOCapabilities
get = do
        Int -> SMIOCapabilities
forall a. Enum a => Int -> a
toEnum (Int -> SMIOCapabilities)
-> (Word8 -> Int) -> Word8 -> SMIOCapabilities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> SMIOCapabilities) -> Get Word8 -> Get SMIOCapabilities
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8

data SystemEndpoint
    -- Command Parser
     = SECommandParser
    -- Radio Test
    | SETest
    -- BGScript (not used)
    | SEScript
    -- USB Interface
    | SEUSB
    -- USART 0
    | SEUART0
    -- USART 1
    | SEUART1
    deriving (SystemEndpoint -> SystemEndpoint -> Bool
(SystemEndpoint -> SystemEndpoint -> Bool)
-> (SystemEndpoint -> SystemEndpoint -> Bool) -> Eq SystemEndpoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemEndpoint -> SystemEndpoint -> Bool
$c/= :: SystemEndpoint -> SystemEndpoint -> Bool
== :: SystemEndpoint -> SystemEndpoint -> Bool
$c== :: SystemEndpoint -> SystemEndpoint -> Bool
Eq, Int -> SystemEndpoint -> ShowS
[SystemEndpoint] -> ShowS
SystemEndpoint -> String
(Int -> SystemEndpoint -> ShowS)
-> (SystemEndpoint -> String)
-> ([SystemEndpoint] -> ShowS)
-> Show SystemEndpoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SystemEndpoint] -> ShowS
$cshowList :: [SystemEndpoint] -> ShowS
show :: SystemEndpoint -> String
$cshow :: SystemEndpoint -> String
showsPrec :: Int -> SystemEndpoint -> ShowS
$cshowsPrec :: Int -> SystemEndpoint -> ShowS
Show, Int -> SystemEndpoint
SystemEndpoint -> Int
SystemEndpoint -> [SystemEndpoint]
SystemEndpoint -> SystemEndpoint
SystemEndpoint -> SystemEndpoint -> [SystemEndpoint]
SystemEndpoint
-> SystemEndpoint -> SystemEndpoint -> [SystemEndpoint]
(SystemEndpoint -> SystemEndpoint)
-> (SystemEndpoint -> SystemEndpoint)
-> (Int -> SystemEndpoint)
-> (SystemEndpoint -> Int)
-> (SystemEndpoint -> [SystemEndpoint])
-> (SystemEndpoint -> SystemEndpoint -> [SystemEndpoint])
-> (SystemEndpoint -> SystemEndpoint -> [SystemEndpoint])
-> (SystemEndpoint
    -> SystemEndpoint -> SystemEndpoint -> [SystemEndpoint])
-> Enum SystemEndpoint
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SystemEndpoint
-> SystemEndpoint -> SystemEndpoint -> [SystemEndpoint]
$cenumFromThenTo :: SystemEndpoint
-> SystemEndpoint -> SystemEndpoint -> [SystemEndpoint]
enumFromTo :: SystemEndpoint -> SystemEndpoint -> [SystemEndpoint]
$cenumFromTo :: SystemEndpoint -> SystemEndpoint -> [SystemEndpoint]
enumFromThen :: SystemEndpoint -> SystemEndpoint -> [SystemEndpoint]
$cenumFromThen :: SystemEndpoint -> SystemEndpoint -> [SystemEndpoint]
enumFrom :: SystemEndpoint -> [SystemEndpoint]
$cenumFrom :: SystemEndpoint -> [SystemEndpoint]
fromEnum :: SystemEndpoint -> Int
$cfromEnum :: SystemEndpoint -> Int
toEnum :: Int -> SystemEndpoint
$ctoEnum :: Int -> SystemEndpoint
pred :: SystemEndpoint -> SystemEndpoint
$cpred :: SystemEndpoint -> SystemEndpoint
succ :: SystemEndpoint -> SystemEndpoint
$csucc :: SystemEndpoint -> SystemEndpoint
Enum)

instance Binary SystemEndpoint where
    put :: SystemEndpoint -> Put
put SystemEndpoint
m = do
        Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ SystemEndpoint -> Int
forall a. Enum a => a -> Int
fromEnum SystemEndpoint
m
    get :: Get SystemEndpoint
get = do
        Int -> SystemEndpoint
forall a. Enum a => Int -> a
toEnum (Int -> SystemEndpoint)
-> (Word8 -> Int) -> Word8 -> SystemEndpoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> SystemEndpoint) -> Get Word8 -> Get SystemEndpoint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8

-- Operation result
data BGResult
    = BGRSuccess
    -- Invalid Parameter (0x0180)
    -- Command contained invalid parameter
    | BGRInvalidParameter

    -- Device in Wrong State (0x0181)
    -- Device is in wrong state to receive command
    | BGRWrongState

    -- Out Of Memory (0x0182)
    -- Device has run out of memory
    | BGROutOfMemory

    -- Feature Not Implemented (0x0183)
    -- Feature is not implemented
    | BGRNotImplemented

    -- Command Not Recognized (0x0184)
    -- Command was not recognized
    | BGRNotRecognized

    -- Timeout (0x0185)
    -- Command or Procedure failed due to timeout
    | BGRTimeout

    -- Not Connected (0x0186)
    -- Connection handle passed is to command is not a valid handle
    | BGRNotConnected

    -- Flow (0x0187)
    -- Command would cause either underflow or overflow error
    | BGRFlow

    -- User Attribute (0x0188)
    -- User attribute was accessed through API which is not supported
    | BGRUserAttribute

    -- Invalid License Key (0x0189)
    -- No valid license key found
    | BGRInvalidLicenseKey

    -- Command Too Long (0x018A)
    -- Command maximum length exceeded
    | BGRCommandTooLong

    -- Out of Bonds (0x018B)
    -- Bonding procedure can't be started because device has no space left for bond.
    | BGROutOfBonds

    -- Script Overflow (0x018C)
    -- Module was reset due to script stack overflow.
    -- In BLE BGScript there is a script stack overflow detection mechanism. This solution resets module
    -- when script stack overflow is detected. After next boot script failure event with specific error code is
    -- generated right after system boot event.
    -- This feature works only with BLE SDK version 1.7.0 or newer that support script stack overflow
    -- detection mechanism. For this feature to work correctly update of bootloader is needed.
    | BGRScriptOverflow

    -- Authentication Failure (0x0205)
    -- Pairing or authentication failed due to incorrect results in the pairing or authentication procedure. This could be
    -- due to an incorrect PIN or Link Key
    | BGRAuthenticationFailure

    -- Pin or Key Missing (0x0206)
    -- Pairing failed because of missing PIN, or authentication failed because of missing Key.
    -- Silicon Labs
    | BGRPinOrKeyMissing

    -- Memory Capacity Exceeded (0x0207)
    -- Controller is out of memory.
    | BGRMemoryCapacityExceeded

    -- Connection Timeout (0x0208)
    -- Link supervision timeout has expired.
    | BGRConnectionTimeout

    -- Connection Limit Exceeded (0x0209)
    -- Controller is at limit of connections it can support.
    | BGRConnectionLimitExceeded

    -- Command Disallowed (0x020C)
    -- Command requested cannot be executed because the Controller is in a state where it cannot process this
    -- command at this time.
    | BGRCommandDisallowed

    -- Invalid Command Parameters (0x0212)
    -- Command contained invalid parameters.
    | BGRInvalidCommandParameters

    -- Remote User Terminated Connection (0x0213)
    -- User on the remote device terminated the connection.
    | BGRRemoteUserTerminatedConnection

    -- Connection Terminated by Local Host (0x0216)
    -- Local device terminated the connection.
    | BGRConnectionTErminagedByLocalHost

    -- LL Response Timeout (0x0222)
    -- Connection terminated due to link-layer procedure timeout.
    | BGRLLResponseTimeout

    -- LL Instant Passed (0x0228)
    -- Received link-layer control packet where instant was in the past.
    | BGRLLInstantPassed

    -- Controller Busy (0x023A)
    -- Operation was rejected because the controller is busy and unable to process the request.
    | BGRControllerBusy

    -- Unacceptable Connection Interval (0x023B)
    -- The Unacceptable Connection Interval error code indicates that the remote device terminated the connection
    -- because of an unacceptable connection interval.
    | BGRUnacceptableConnectionInterval

    -- Directed Advertising Timeout (0x023C)
    -- Directed advertising completed without a connection being created.
    | BGRDirectedAdvertisingTimeout

    -- MIC Failure (0x023D)
    -- Connection was terminated because the Message Integrity Check (MIC) failed on a received packet.
    | BGRMICFailure

    -- Connection Failed to be Established (0x023E)
    -- LL initiated a connection but the connection has failed to be established. Controller did not receive any packets
    -- from remote end.
    -- More in detail, an attempt to open a connection is made by the master by sending only one CONNECT_REQ ,
    -- after which the master immediately transitions to connected state (BT4.1 Vol 6 Part B 4.4.4). If the advertiser for
    -- any reason (like interference) does not catch the packet it will just continue advertising, while the master
    -- remains in a fast termination mode, where it will only send 6 packets before failing, independent of supervision
    -- timeout (in fact, a master starts using normal supervision timeout only after it has received at least one packet
    -- from slave.) If the master does not receive anything by the time its 6 packets are sent, connection establishment
    -- will be considered failed and this error will be reported to the host or to the BGScript. In a busy environment it is
    -- normal to see roughly 1-2% error rate when opening connections.
    | BGRConnectionFailedToBeEstablised

    -- Passkey Entry Failed (0x0301)
    -- The user input of passkey failed, for example, the user cancelled the operation
    | BGRPasskeyEntryFailed

    -- OOB Data is not available (0x0302)
    -- Out of Band data is not available for authentication
    | BGROOBDataIsNotAvailable

    -- Authentication Requirements (0x0303)
    -- The pairing procedure cannot be performed as authentication requirements cannot be met due to IO capabilities
    -- of one or both devices
    | BGRAuthenticationRequirements

    -- Confirm Value Failed (0x0304)
    -- The confirm value does not match the calculated compare value
    | BGRConfirmValueFailed

    -- Pairing Not Supported (0x0305)
    -- Pairing is not supported by the device
    | BGRPairingNotSupported

    -- Encryption Key Size (0x0306)
    -- The resultant encryption key size is insufficient for the security requirements of this device
    | BGREncryptionKeySize

    -- Command Not Supported (0x0307)
    -- The SMP command received is not supported on this device
    | BGRCommandNotSupported

    -- Unspecified Reason (0x0308)
    -- Pairing failed due to an unspecified reason
    | BGRUnspecifiedReason

    -- Repeated Attempts (0x0309)
    -- Pairing or authentication procedure is disallowed because too little time has elapsed since last pairing request
    -- or security request
    | BGRRepeatedAttempts

    -- Invalid Parameters (0x030A)
    -- The Invalid Parameters error code indicates: the command length is invalid or a parameter is outside of the
    -- specified range.
    | BGRInvalidParameters

    -- Invalid Handle (0x0401)
    -- The attribute handle given was not valid on this server
    | BGRInvalidHandle

    -- Read Not Permitted (0x0402)
    -- The attribute cannot be read
    | BGRReadNotPermitted

    -- Write Not Permitted (0x0403)
    -- The attribute cannot be written
    | BGRWriteNotPermitted

    -- Invalid PDU (0x0404)
    -- The attribute PDU was invalid
    | BGRInvalidPDU

    -- Insufficient Authentication (0x0405)
    -- The attribute requires authentication before it can be read or written.
    | BGRInsufficientAuthentication

    -- Request Not Supported (0x0406)
    -- Attribute Server does not support the request received from the client.
    | BGRRequestNotSupported

    -- Invalid Offset (0x0407)
    -- Offset specified was past the end of the attribute
    | BGRInvalidOffset

    -- Insufficient Authorization (0x0408)
    -- The attribute requires authorization before it can be read or written.
    | BGRInsufficientAuthorization

    -- Prepare Queue Full (0x0409)
    -- Too many prepare writes have been queueud
    | BGRPrepareQueueFull

    -- Attribute Not Found (0x040A)
    -- No attribute found within the given attribute handle range.
    | BGRAttributeNotFound

    -- Attribute Not Long (0x040B)
    -- The attribute cannot be read or written using the Read Blob Request
    | BGRAttributeNotLong

    -- Insufficient Encryption Key Size (0x040C)
    -- The Encryption Key Size used for encrypting this link is insufficient.
    | BGRInsufficientEncryptionKeySize

    -- Invalid Attribute Value Length (0x040D)
    -- The attribute value length is invalid for the operation
    | BGRInvalidAttributeValueLength

    -- Unlikely Error (0x040E)
    -- The attribute request that was requested has encountered an error that was unlikely, and therefore could not be
    -- completed as requested.
    | BGRUnlikelyError

    -- Insufficient Encryption (0x040F)
    -- The attribute requires encryption before it can be read or written.
    | BGRInsufficientEncryption

    -- Unsupported Group Type (0x0410)
    -- The attribute type is not a supported grouping attribute as defined by a higher layer specification.
    | BGRUnsupportedGroupType

    -- Insufficient Resources (0x0411)
    -- Insufficient Resources to complete the request
    | BGRInsufficientResources

    -- Application Error Codes (0x0480)
    -- Application error code defined by a higher layer specification.
    -- The error code range 0x80-0x9F is reserved for application level errors.
    | BGRApplicationErrorCode UInt8

    -- And error code unknown by this library
    | BGRUnknown UInt16
    deriving (BGResult -> BGResult -> Bool
(BGResult -> BGResult -> Bool)
-> (BGResult -> BGResult -> Bool) -> Eq BGResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BGResult -> BGResult -> Bool
$c/= :: BGResult -> BGResult -> Bool
== :: BGResult -> BGResult -> Bool
$c== :: BGResult -> BGResult -> Bool
Eq, Int -> BGResult -> ShowS
[BGResult] -> ShowS
BGResult -> String
(Int -> BGResult -> ShowS)
-> (BGResult -> String) -> ([BGResult] -> ShowS) -> Show BGResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BGResult] -> ShowS
$cshowList :: [BGResult] -> ShowS
show :: BGResult -> String
$cshow :: BGResult -> String
showsPrec :: Int -> BGResult -> ShowS
$cshowsPrec :: Int -> BGResult -> ShowS
Show)

instance Binary BGResult where
    put :: BGResult -> Put
put BGResult
m = do
        Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ case BGResult
m of
            BGResult
BGRSuccess                         -> Word16
0x0000
            BGResult
BGRInvalidParameter                -> Word16
0x0180
            BGResult
BGRWrongState                      -> Word16
0x0181
            BGResult
BGROutOfMemory                     -> Word16
0x0182
            BGResult
BGRNotImplemented                  -> Word16
0x0183
            BGResult
BGRNotRecognized                   -> Word16
0x0184
            BGResult
BGRTimeout                         -> Word16
0x0185
            BGResult
BGRNotConnected                    -> Word16
0x0186
            BGResult
BGRFlow                            -> Word16
0x0187
            BGResult
BGRUserAttribute                   -> Word16
0x0188
            BGResult
BGRInvalidLicenseKey               -> Word16
0x0189
            BGResult
BGRCommandTooLong                  -> Word16
0x018A
            BGResult
BGROutOfBonds                      -> Word16
0x018B
            BGResult
BGRScriptOverflow                  -> Word16
0x018C
            BGResult
BGRAuthenticationFailure           -> Word16
0x0205
            BGResult
BGRPinOrKeyMissing                 -> Word16
0x0206
            BGResult
BGRMemoryCapacityExceeded          -> Word16
0x0207
            BGResult
BGRConnectionTimeout               -> Word16
0x0208
            BGResult
BGRConnectionLimitExceeded         -> Word16
0x0209
            BGResult
BGRCommandDisallowed               -> Word16
0x020C
            BGResult
BGRInvalidCommandParameters        -> Word16
0x0212
            BGResult
BGRRemoteUserTerminatedConnection  -> Word16
0x0213
            BGResult
BGRConnectionTErminagedByLocalHost -> Word16
0x0216
            BGResult
BGRLLResponseTimeout               -> Word16
0x0222
            BGResult
BGRLLInstantPassed                 -> Word16
0x0228
            BGResult
BGRControllerBusy                  -> Word16
0x023A
            BGResult
BGRUnacceptableConnectionInterval  -> Word16
0x023B
            BGResult
BGRDirectedAdvertisingTimeout      -> Word16
0x023C
            BGResult
BGRMICFailure                      -> Word16
0x023D
            BGResult
BGRConnectionFailedToBeEstablised  -> Word16
0x023E
            BGResult
BGRPasskeyEntryFailed              -> Word16
0x0301
            BGResult
BGROOBDataIsNotAvailable           -> Word16
0x0302
            BGResult
BGRAuthenticationRequirements      -> Word16
0x0303
            BGResult
BGRConfirmValueFailed              -> Word16
0x0304
            BGResult
BGRPairingNotSupported             -> Word16
0x0305
            BGResult
BGREncryptionKeySize               -> Word16
0x0306
            BGResult
BGRCommandNotSupported             -> Word16
0x0307
            BGResult
BGRUnspecifiedReason               -> Word16
0x0308
            BGResult
BGRRepeatedAttempts                -> Word16
0x0309
            BGResult
BGRInvalidParameters               -> Word16
0x030A
            BGResult
BGRInvalidHandle                   -> Word16
0x0401
            BGResult
BGRReadNotPermitted                -> Word16
0x0402
            BGResult
BGRWriteNotPermitted               -> Word16
0x0403
            BGResult
BGRInvalidPDU                      -> Word16
0x0404
            BGResult
BGRInsufficientAuthentication      -> Word16
0x0405
            BGResult
BGRRequestNotSupported             -> Word16
0x0406
            BGResult
BGRInvalidOffset                   -> Word16
0x0407
            BGResult
BGRInsufficientAuthorization       -> Word16
0x0408
            BGResult
BGRPrepareQueueFull                -> Word16
0x0409
            BGResult
BGRAttributeNotFound               -> Word16
0x040A
            BGResult
BGRAttributeNotLong                -> Word16
0x040B
            BGResult
BGRInsufficientEncryptionKeySize   -> Word16
0x040C
            BGResult
BGRInvalidAttributeValueLength     -> Word16
0x040D
            BGResult
BGRUnlikelyError                   -> Word16
0x040E
            BGResult
BGRInsufficientEncryption          -> Word16
0x040F
            BGResult
BGRUnsupportedGroupType            -> Word16
0x0410
            BGResult
BGRInsufficientResources           -> Word16
0x0411
            BGRApplicationErrorCode Word8
errC       -> (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
errC Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0x001f) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16
0x0480
            BGRUnknown UInt16
errC                    -> UInt16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt16
errC

    get :: Get BGResult
get = do
        Word16
errC <- Get Word16
getWord16le
        BGResult -> Get BGResult
forall (m :: * -> *) a. Monad m => a -> m a
return (BGResult -> Get BGResult) -> BGResult -> Get BGResult
forall a b. (a -> b) -> a -> b
$ case Word16
errC of
            Word16
0x0000 -> BGResult
BGRSuccess
            Word16
0x0180 -> BGResult
BGRInvalidParameter
            Word16
0x0181 -> BGResult
BGRWrongState
            Word16
0x0182 -> BGResult
BGROutOfMemory
            Word16
0x0183 -> BGResult
BGRNotImplemented
            Word16
0x0184 -> BGResult
BGRNotRecognized
            Word16
0x0185 -> BGResult
BGRTimeout
            Word16
0x0186 -> BGResult
BGRNotConnected
            Word16
0x0187 -> BGResult
BGRFlow
            Word16
0x0188 -> BGResult
BGRUserAttribute
            Word16
0x0189 -> BGResult
BGRInvalidLicenseKey
            Word16
0x018A -> BGResult
BGRCommandTooLong
            Word16
0x018B -> BGResult
BGROutOfBonds
            Word16
0x018C -> BGResult
BGRScriptOverflow
            Word16
0x0205 -> BGResult
BGRAuthenticationFailure
            Word16
0x0206 -> BGResult
BGRPinOrKeyMissing
            Word16
0x0207 -> BGResult
BGRMemoryCapacityExceeded
            Word16
0x0208 -> BGResult
BGRConnectionTimeout
            Word16
0x0209 -> BGResult
BGRConnectionLimitExceeded
            Word16
0x020C -> BGResult
BGRCommandDisallowed
            Word16
0x0212 -> BGResult
BGRInvalidCommandParameters
            Word16
0x0213 -> BGResult
BGRRemoteUserTerminatedConnection
            Word16
0x0216 -> BGResult
BGRConnectionTErminagedByLocalHost
            Word16
0x0222 -> BGResult
BGRLLResponseTimeout
            Word16
0x0228 -> BGResult
BGRLLInstantPassed
            Word16
0x023A -> BGResult
BGRControllerBusy
            Word16
0x023B -> BGResult
BGRUnacceptableConnectionInterval
            Word16
0x023C -> BGResult
BGRDirectedAdvertisingTimeout
            Word16
0x023D -> BGResult
BGRMICFailure
            Word16
0x023E -> BGResult
BGRConnectionFailedToBeEstablised
            Word16
0x0301 -> BGResult
BGRPasskeyEntryFailed
            Word16
0x0302 -> BGResult
BGROOBDataIsNotAvailable
            Word16
0x0303 -> BGResult
BGRAuthenticationRequirements
            Word16
0x0304 -> BGResult
BGRConfirmValueFailed
            Word16
0x0305 -> BGResult
BGRPairingNotSupported
            Word16
0x0306 -> BGResult
BGREncryptionKeySize
            Word16
0x0307 -> BGResult
BGRCommandNotSupported
            Word16
0x0308 -> BGResult
BGRUnspecifiedReason
            Word16
0x0309 -> BGResult
BGRRepeatedAttempts
            Word16
0x030A -> BGResult
BGRInvalidParameters
            Word16
0x0401 -> BGResult
BGRInvalidHandle
            Word16
0x0402 -> BGResult
BGRReadNotPermitted
            Word16
0x0403 -> BGResult
BGRWriteNotPermitted
            Word16
0x0404 -> BGResult
BGRInvalidPDU
            Word16
0x0405 -> BGResult
BGRInsufficientAuthentication
            Word16
0x0406 -> BGResult
BGRRequestNotSupported
            Word16
0x0407 -> BGResult
BGRInvalidOffset
            Word16
0x0408 -> BGResult
BGRInsufficientAuthorization
            Word16
0x0409 -> BGResult
BGRPrepareQueueFull
            Word16
0x040A -> BGResult
BGRAttributeNotFound
            Word16
0x040B -> BGResult
BGRAttributeNotLong
            Word16
0x040C -> BGResult
BGRInsufficientEncryptionKeySize
            Word16
0x040D -> BGResult
BGRInvalidAttributeValueLength
            Word16
0x040E -> BGResult
BGRUnlikelyError
            Word16
0x040F -> BGResult
BGRInsufficientEncryption
            Word16
0x0410 -> BGResult
BGRUnsupportedGroupType
            Word16
0x0411 -> BGResult
BGRInsufficientResources
            Word16
_      ->
                if Word16
errC Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word16
0x0480 Bool -> Bool -> Bool
&& Word16
errC Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16
0x049f
                    then Word8 -> BGResult
BGRApplicationErrorCode (Word8 -> BGResult) -> Word8 -> BGResult
forall a b. (a -> b) -> a -> b
$ Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
errC Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0x1f)
                    else UInt16 -> BGResult
BGRUnknown (UInt16 -> BGResult) -> UInt16 -> BGResult
forall a b. (a -> b) -> a -> b
$ Word16 -> UInt16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
errC