module Lifx.Lan (
Device,
deviceAddress,
deviceFromAddress,
Message (..),
HSBK (..),
Lifx,
runLifx,
LifxT,
runLifxT,
LifxError (..),
ProductLookupError (..),
MonadLifx (..),
sendMessageAndWait,
StateService (..),
Service (..),
StateHostFirmware (..),
StatePower (..),
StateVersion (..),
LightState (..),
getProductInfo,
Product (..),
Features (..),
encodeMessage,
Header (..),
) where
import Control.Concurrent
import Control.Monad
import Control.Monad.Except
import Control.Monad.Extra
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Trans.Maybe
import Control.Monad.Writer hiding (Product)
import Data.Composition
import Data.Either.Extra
import Data.Fixed
import Data.Foldable
import Data.Functor
import Data.Maybe
import Data.Time
import Data.Word
import Network.Socket
import System.IO.Error
import Data.Binary (Binary)
import Data.Binary qualified as Binary
import Data.Binary.Get (
Get,
getByteString,
getWord16le,
getWord32le,
getWord64be,
getWord64le,
getWord8,
runGetOrFail,
skip,
)
import Data.Binary.Put (
Put,
putWord16le,
putWord32le,
putWord64be,
putWord8,
runPut,
)
import Data.Bits (Bits (..))
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as BL
import Data.List.NonEmpty (NonEmpty)
import Data.Map (Map)
import Data.Map.Strict qualified as Map
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8')
import Data.Text.Encoding.Error (UnicodeException (DecodeError))
import GHC.Generics (Generic)
import Network.Socket.ByteString (recvFrom, sendTo)
import System.Random (randomIO)
import System.Timeout (timeout)
import Lifx.Internal.Product
import Lifx.Internal.ProductInfoMap
import Lifx.Lan.Internal
deviceFromAddress :: (Word8, Word8, Word8, Word8) -> Device
deviceFromAddress :: (Word8, Word8, Word8, Word8) -> Device
deviceFromAddress = HostAddress -> Device
Device forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8, Word8, Word8, Word8) -> HostAddress
tupleToHostAddress
deviceAddress :: Device -> HostAddress
deviceAddress :: Device -> HostAddress
deviceAddress = (.unwrap)
lifxPort :: PortNumber
lifxPort :: PortNumber
lifxPort = PortNumber
56700
data Message r where
GetService :: Message StateService
GetHostFirmware :: Message StateHostFirmware
GetPower :: Message StatePower
SetPower :: Bool -> Message ()
GetVersion :: Message StateVersion
GetColor :: Message LightState
SetColor :: HSBK -> NominalDiffTime -> Message ()
SetLightPower :: Bool -> NominalDiffTime -> Message ()
deriving instance (Eq (Message r))
deriving instance (Ord (Message r))
deriving instance (Show (Message r))
data Service
= ServiceUDP
| ServiceReserved1
| ServiceReserved2
| ServiceReserved3
| ServiceReserved4
deriving (Service -> Service -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Service -> Service -> Bool
$c/= :: Service -> Service -> Bool
== :: Service -> Service -> Bool
$c== :: Service -> Service -> Bool
Eq, Eq Service
Service -> Service -> Bool
Service -> Service -> Ordering
Service -> Service -> Service
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 :: Service -> Service -> Service
$cmin :: Service -> Service -> Service
max :: Service -> Service -> Service
$cmax :: Service -> Service -> Service
>= :: Service -> Service -> Bool
$c>= :: Service -> Service -> Bool
> :: Service -> Service -> Bool
$c> :: Service -> Service -> Bool
<= :: Service -> Service -> Bool
$c<= :: Service -> Service -> Bool
< :: Service -> Service -> Bool
$c< :: Service -> Service -> Bool
compare :: Service -> Service -> Ordering
$ccompare :: Service -> Service -> Ordering
Ord, Int -> Service -> ShowS
[Service] -> ShowS
Service -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Service] -> ShowS
$cshowList :: [Service] -> ShowS
show :: Service -> String
$cshow :: Service -> String
showsPrec :: Int -> Service -> ShowS
$cshowsPrec :: Int -> Service -> ShowS
Show, forall x. Rep Service x -> Service
forall x. Service -> Rep Service x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Service x -> Service
$cfrom :: forall x. Service -> Rep Service x
Generic)
data StateService = StateService
{ StateService -> Service
service :: Service
, StateService -> PortNumber
port :: PortNumber
}
deriving (StateService -> StateService -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StateService -> StateService -> Bool
$c/= :: StateService -> StateService -> Bool
== :: StateService -> StateService -> Bool
$c== :: StateService -> StateService -> Bool
Eq, Eq StateService
StateService -> StateService -> Bool
StateService -> StateService -> Ordering
StateService -> StateService -> StateService
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 :: StateService -> StateService -> StateService
$cmin :: StateService -> StateService -> StateService
max :: StateService -> StateService -> StateService
$cmax :: StateService -> StateService -> StateService
>= :: StateService -> StateService -> Bool
$c>= :: StateService -> StateService -> Bool
> :: StateService -> StateService -> Bool
$c> :: StateService -> StateService -> Bool
<= :: StateService -> StateService -> Bool
$c<= :: StateService -> StateService -> Bool
< :: StateService -> StateService -> Bool
$c< :: StateService -> StateService -> Bool
compare :: StateService -> StateService -> Ordering
$ccompare :: StateService -> StateService -> Ordering
Ord, Int -> StateService -> ShowS
[StateService] -> ShowS
StateService -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StateService] -> ShowS
$cshowList :: [StateService] -> ShowS
show :: StateService -> String
$cshow :: StateService -> String
showsPrec :: Int -> StateService -> ShowS
$cshowsPrec :: Int -> StateService -> ShowS
Show, forall x. Rep StateService x -> StateService
forall x. StateService -> Rep StateService x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StateService x -> StateService
$cfrom :: forall x. StateService -> Rep StateService x
Generic)
data StateHostFirmware = StateHostFirmware
{ StateHostFirmware -> Word64
build :: Word64
, StateHostFirmware -> Word16
versionMinor :: Word16
, StateHostFirmware -> Word16
versionMajor :: Word16
}
deriving (StateHostFirmware -> StateHostFirmware -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StateHostFirmware -> StateHostFirmware -> Bool
$c/= :: StateHostFirmware -> StateHostFirmware -> Bool
== :: StateHostFirmware -> StateHostFirmware -> Bool
$c== :: StateHostFirmware -> StateHostFirmware -> Bool
Eq, Eq StateHostFirmware
StateHostFirmware -> StateHostFirmware -> Bool
StateHostFirmware -> StateHostFirmware -> Ordering
StateHostFirmware -> StateHostFirmware -> StateHostFirmware
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 :: StateHostFirmware -> StateHostFirmware -> StateHostFirmware
$cmin :: StateHostFirmware -> StateHostFirmware -> StateHostFirmware
max :: StateHostFirmware -> StateHostFirmware -> StateHostFirmware
$cmax :: StateHostFirmware -> StateHostFirmware -> StateHostFirmware
>= :: StateHostFirmware -> StateHostFirmware -> Bool
$c>= :: StateHostFirmware -> StateHostFirmware -> Bool
> :: StateHostFirmware -> StateHostFirmware -> Bool
$c> :: StateHostFirmware -> StateHostFirmware -> Bool
<= :: StateHostFirmware -> StateHostFirmware -> Bool
$c<= :: StateHostFirmware -> StateHostFirmware -> Bool
< :: StateHostFirmware -> StateHostFirmware -> Bool
$c< :: StateHostFirmware -> StateHostFirmware -> Bool
compare :: StateHostFirmware -> StateHostFirmware -> Ordering
$ccompare :: StateHostFirmware -> StateHostFirmware -> Ordering
Ord, Int -> StateHostFirmware -> ShowS
[StateHostFirmware] -> ShowS
StateHostFirmware -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StateHostFirmware] -> ShowS
$cshowList :: [StateHostFirmware] -> ShowS
show :: StateHostFirmware -> String
$cshow :: StateHostFirmware -> String
showsPrec :: Int -> StateHostFirmware -> ShowS
$cshowsPrec :: Int -> StateHostFirmware -> ShowS
Show, forall x. Rep StateHostFirmware x -> StateHostFirmware
forall x. StateHostFirmware -> Rep StateHostFirmware x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StateHostFirmware x -> StateHostFirmware
$cfrom :: forall x. StateHostFirmware -> Rep StateHostFirmware x
Generic)
newtype StatePower = StatePower
{ StatePower -> Word16
power :: Word16
}
deriving (StatePower -> StatePower -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StatePower -> StatePower -> Bool
$c/= :: StatePower -> StatePower -> Bool
== :: StatePower -> StatePower -> Bool
$c== :: StatePower -> StatePower -> Bool
Eq, Eq StatePower
StatePower -> StatePower -> Bool
StatePower -> StatePower -> Ordering
StatePower -> StatePower -> StatePower
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 :: StatePower -> StatePower -> StatePower
$cmin :: StatePower -> StatePower -> StatePower
max :: StatePower -> StatePower -> StatePower
$cmax :: StatePower -> StatePower -> StatePower
>= :: StatePower -> StatePower -> Bool
$c>= :: StatePower -> StatePower -> Bool
> :: StatePower -> StatePower -> Bool
$c> :: StatePower -> StatePower -> Bool
<= :: StatePower -> StatePower -> Bool
$c<= :: StatePower -> StatePower -> Bool
< :: StatePower -> StatePower -> Bool
$c< :: StatePower -> StatePower -> Bool
compare :: StatePower -> StatePower -> Ordering
$ccompare :: StatePower -> StatePower -> Ordering
Ord, Int -> StatePower -> ShowS
[StatePower] -> ShowS
StatePower -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StatePower] -> ShowS
$cshowList :: [StatePower] -> ShowS
show :: StatePower -> String
$cshow :: StatePower -> String
showsPrec :: Int -> StatePower -> ShowS
$cshowsPrec :: Int -> StatePower -> ShowS
Show, forall x. Rep StatePower x -> StatePower
forall x. StatePower -> Rep StatePower x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StatePower x -> StatePower
$cfrom :: forall x. StatePower -> Rep StatePower x
Generic)
data StateVersion = StateVersion
{ StateVersion -> HostAddress
vendor :: Word32
, StateVersion -> HostAddress
product :: Word32
}
deriving (StateVersion -> StateVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StateVersion -> StateVersion -> Bool
$c/= :: StateVersion -> StateVersion -> Bool
== :: StateVersion -> StateVersion -> Bool
$c== :: StateVersion -> StateVersion -> Bool
Eq, Eq StateVersion
StateVersion -> StateVersion -> Bool
StateVersion -> StateVersion -> Ordering
StateVersion -> StateVersion -> StateVersion
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 :: StateVersion -> StateVersion -> StateVersion
$cmin :: StateVersion -> StateVersion -> StateVersion
max :: StateVersion -> StateVersion -> StateVersion
$cmax :: StateVersion -> StateVersion -> StateVersion
>= :: StateVersion -> StateVersion -> Bool
$c>= :: StateVersion -> StateVersion -> Bool
> :: StateVersion -> StateVersion -> Bool
$c> :: StateVersion -> StateVersion -> Bool
<= :: StateVersion -> StateVersion -> Bool
$c<= :: StateVersion -> StateVersion -> Bool
< :: StateVersion -> StateVersion -> Bool
$c< :: StateVersion -> StateVersion -> Bool
compare :: StateVersion -> StateVersion -> Ordering
$ccompare :: StateVersion -> StateVersion -> Ordering
Ord, Int -> StateVersion -> ShowS
[StateVersion] -> ShowS
StateVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StateVersion] -> ShowS
$cshowList :: [StateVersion] -> ShowS
show :: StateVersion -> String
$cshow :: StateVersion -> String
showsPrec :: Int -> StateVersion -> ShowS
$cshowsPrec :: Int -> StateVersion -> ShowS
Show, forall x. Rep StateVersion x -> StateVersion
forall x. StateVersion -> Rep StateVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StateVersion x -> StateVersion
$cfrom :: forall x. StateVersion -> Rep StateVersion x
Generic)
data LightState = LightState
{ LightState -> HSBK
hsbk :: HSBK
, LightState -> Word16
power :: Word16
, LightState -> Text
label :: Text
}
deriving (LightState -> LightState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LightState -> LightState -> Bool
$c/= :: LightState -> LightState -> Bool
== :: LightState -> LightState -> Bool
$c== :: LightState -> LightState -> Bool
Eq, Eq LightState
LightState -> LightState -> Bool
LightState -> LightState -> Ordering
LightState -> LightState -> LightState
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 :: LightState -> LightState -> LightState
$cmin :: LightState -> LightState -> LightState
max :: LightState -> LightState -> LightState
$cmax :: LightState -> LightState -> LightState
>= :: LightState -> LightState -> Bool
$c>= :: LightState -> LightState -> Bool
> :: LightState -> LightState -> Bool
$c> :: LightState -> LightState -> Bool
<= :: LightState -> LightState -> Bool
$c<= :: LightState -> LightState -> Bool
< :: LightState -> LightState -> Bool
$c< :: LightState -> LightState -> Bool
compare :: LightState -> LightState -> Ordering
$ccompare :: LightState -> LightState -> Ordering
Ord, Int -> LightState -> ShowS
[LightState] -> ShowS
LightState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LightState] -> ShowS
$cshowList :: [LightState] -> ShowS
show :: LightState -> String
$cshow :: LightState -> String
showsPrec :: Int -> LightState -> ShowS
$cshowsPrec :: Int -> LightState -> ShowS
Show, forall x. Rep LightState x -> LightState
forall x. LightState -> Rep LightState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LightState x -> LightState
$cfrom :: forall x. LightState -> Rep LightState x
Generic)
class MessageResult a where
getSendResult :: MonadLifxIO m => Device -> m a
default getSendResult :: (MonadLifxIO m, Response a) => Device -> m a
getSendResult Device
receiver = forall (m :: * -> *) a. Monad m => m (Maybe a) -> m a
untilJustM do
Int
timeoutDuration <- forall (m :: * -> *). MonadLifxIO m => m Int
getTimeout
(ByteString
bs, SockAddr
sender0) <- forall {m :: * -> *} {b}.
MonadLifxIO m =>
m (Either LifxError b) -> m b
throwEither forall a b. (a -> b) -> a -> b
$ forall a b. a -> Maybe b -> Either a b
maybeToEither LifxError
RecvTimeout forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadLifxIO m =>
Int -> Int -> m (Maybe (ByteString, SockAddr))
receiveMessage Int
timeoutDuration (forall a. Response a => Int
messageSize @a)
HostAddress
sender <- forall (m :: * -> *). MonadLifxIO m => SockAddr -> m HostAddress
hostAddressFromSock SockAddr
sender0
Maybe a
res <- forall b (m :: * -> *).
(Response b, MonadLifxIO m) =>
ByteString -> m (Maybe b)
decodeMessage @a ByteString
bs
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe a
res Bool -> Bool -> Bool
&& HostAddress
sender forall a. Eq a => a -> a -> Bool
/= Device -> HostAddress
deviceAddress Device
receiver) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadLifxIO m => LifxError -> m a
lifxThrowIO forall a b. (a -> b) -> a -> b
$ Device -> HostAddress -> LifxError
WrongSender Device
receiver HostAddress
sender
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
res
where
throwEither :: m (Either LifxError b) -> m b
throwEither m (Either LifxError b)
x =
m (Either LifxError b)
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left LifxError
e -> forall (m :: * -> *) a. MonadLifxIO m => LifxError -> m a
lifxThrowIO LifxError
e
Right b
r -> forall (f :: * -> *) a. Applicative f => a -> f a
pure b
r
broadcastAndGetResult ::
MonadLifxIO m =>
(HostAddress -> a -> m (Maybe b)) ->
Maybe (Map HostAddress (NonEmpty b) -> Bool) ->
Message r ->
m (Map Device (NonEmpty b))
default broadcastAndGetResult ::
(MonadLifxIO m, Response a) =>
(HostAddress -> a -> m (Maybe b)) ->
Maybe (Map HostAddress (NonEmpty b) -> Bool) ->
Message r ->
m (Map Device (NonEmpty b))
broadcastAndGetResult HostAddress -> a -> m (Maybe b)
filter' Maybe (Map HostAddress (NonEmpty b) -> Bool)
maybeFinished Message r
msg = do
Int
timeoutDuration <- forall (m :: * -> *). MonadLifxIO m => m Int
getTimeout
forall (m :: * -> *) r. MonadLifxIO m => Message r -> m ()
broadcast Message r
msg
UTCTime
t0 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic HostAddress -> Device
Device) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT forall k a. Map k a
Map.empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Monad m => m Bool -> m ()
untilM forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Maybe (Map HostAddress (NonEmpty b) -> Bool)
maybeFinished forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just Bool
True -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
Maybe Bool
_ -> do
UTCTime
t <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
let timeLeft :: Int
timeLeft = Int
timeoutDuration forall a. Num a => a -> a -> a
- forall f a r.
(HasResolution r, f ~ Fixed r, Integral a) =>
NominalDiffTime -> a
nominalDiffTimeToInt @Micro (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
t UTCTime
t0)
if Int
timeLeft forall a. Ord a => a -> a -> Bool
< Int
0
then forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
else
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *).
MonadLifxIO m =>
Int -> Int -> m (Maybe (ByteString, SockAddr))
receiveMessage Int
timeLeft (forall a. Response a => Int
messageSize @a)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just (ByteString
bs, SockAddr
addr) -> do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall b (m :: * -> *).
(Response b, MonadLifxIO m) =>
ByteString -> m (Maybe b)
decodeMessage @a ByteString
bs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just a
x -> do
HostAddress
hostAddr <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadLifxIO m => SockAddr -> m HostAddress
hostAddressFromSock SockAddr
addr
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (HostAddress -> a -> m (Maybe b)
filter' HostAddress
hostAddr a
x) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just b
x' -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall a. Semigroup a => a -> a -> a
(<>) HostAddress
hostAddr (forall (f :: * -> *) a. Applicative f => a -> f a
pure b
x')) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Maybe b
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Maybe a
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Maybe (ByteString, SockAddr)
Nothing -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe (Map HostAddress (NonEmpty b) -> Bool)
maybeFinished) forall a b. (a -> b) -> a -> b
$
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadLifxIO m => LifxError -> m a
lifxThrowIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. [HostAddress] -> LifxError
BroadcastTimeout
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall k a. Map k a -> [k]
Map.keys
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
class Response a where
expectedPacketType :: Word16
messageSize :: Int
getBody :: Get a
instance MessageResult () where
getSendResult :: forall (m :: * -> *). MonadLifxIO m => Device -> m ()
getSendResult = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
broadcastAndGetResult :: forall (m :: * -> *) b r.
MonadLifxIO m =>
(HostAddress -> () -> m (Maybe b))
-> Maybe (Map HostAddress (NonEmpty b) -> Bool)
-> Message r
-> m (Map Device (NonEmpty b))
broadcastAndGetResult = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ (forall k a. Map k a
Map.empty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. MonadLifxIO m => Message r -> m ()
broadcast
instance Response StateService where
expectedPacketType :: Word16
expectedPacketType = Word16
3
messageSize :: Int
messageSize = Int
5
getBody :: Get StateService
getBody = do
Service
service <-
Get Word8
getWord8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Word8
1 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Service
ServiceUDP
Word8
2 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Service
ServiceReserved1
Word8
3 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Service
ServiceReserved2
Word8
4 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Service
ServiceReserved3
Word8
5 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Service
ServiceReserved4
Word8
n -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"unknown service: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Word8
n
PortNumber
port <- do
HostAddress
x <- Get HostAddress
getWord32le
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"port out of range: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show HostAddress
x) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Integral b, Bounded b) => a -> Maybe b
fromIntegralSafe HostAddress
x
forall (f :: * -> *) a. Applicative f => a -> f a
pure StateService{PortNumber
Service
port :: PortNumber
service :: Service
$sel:port:StateService :: PortNumber
$sel:service:StateService :: Service
..}
instance MessageResult StateService
instance Response StateHostFirmware where
expectedPacketType :: Word16
expectedPacketType = Word16
15
messageSize :: Int
messageSize = Int
20
getBody :: Get StateHostFirmware
getBody = do
Word64
build <- Get Word64
getWord64le
Int -> Get ()
skip Int
8
Word16
versionMinor <- Get Word16
getWord16le
Word16
versionMajor <- Get Word16
getWord16le
forall (f :: * -> *) a. Applicative f => a -> f a
pure StateHostFirmware{Word16
Word64
versionMajor :: Word16
versionMinor :: Word16
build :: Word64
$sel:versionMajor:StateHostFirmware :: Word16
$sel:versionMinor:StateHostFirmware :: Word16
$sel:build:StateHostFirmware :: Word64
..}
instance MessageResult StateHostFirmware
instance Response StatePower where
expectedPacketType :: Word16
expectedPacketType = Word16
22
messageSize :: Int
messageSize = Int
2
getBody :: Get StatePower
getBody = Word16 -> StatePower
StatePower forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
instance MessageResult StatePower
instance Response StateVersion where
expectedPacketType :: Word16
expectedPacketType = Word16
33
messageSize :: Int
messageSize = Int
20
getBody :: Get StateVersion
getBody = do
HostAddress
vendor <- Get HostAddress
getWord32le
HostAddress
p <- Get HostAddress
getWord32le
Int -> Get ()
skip Int
4
forall (f :: * -> *) a. Applicative f => a -> f a
pure StateVersion{$sel:product:StateVersion :: HostAddress
product = HostAddress
p, HostAddress
vendor :: HostAddress
$sel:vendor:StateVersion :: HostAddress
..}
instance MessageResult StateVersion
instance Response LightState where
expectedPacketType :: Word16
expectedPacketType = Word16
107
messageSize :: Int
messageSize = Int
52
getBody :: Get LightState
getBody = do
HSBK
hsbk <- Word16 -> Word16 -> Word16 -> Word16 -> HSBK
HSBK forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16le forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16le forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16le
Int -> Get ()
skip Int
2
Word16
power <- Get Word16
getWord16le
Text
label <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnicodeException -> String
showDecodeError) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
decodeUtf8' forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> ByteString
BS.takeWhile (forall a. Eq a => a -> a -> Bool
/= Word8
0) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Get ByteString
getByteString Int
32
Int -> Get ()
skip Int
8
forall (f :: * -> *) a. Applicative f => a -> f a
pure LightState{Word16
Text
HSBK
label :: Text
power :: Word16
hsbk :: HSBK
$sel:label:LightState :: Text
$sel:power:LightState :: Word16
$sel:hsbk:LightState :: HSBK
..}
where
showDecodeError :: UnicodeException -> String
showDecodeError = \case
DecodeError String
s Maybe Word8
_ -> String
s
UnicodeException
_ -> String
"impossible"
instance MessageResult LightState
msgResWitness :: (MessageResult r => Message r -> a) -> (Message r -> a)
msgResWitness :: forall r a. (MessageResult r => Message r -> a) -> Message r -> a
msgResWitness MessageResult r => Message r -> a
f Message r
m = case Message r
m of
GetService{} -> MessageResult r => Message r -> a
f Message r
m
GetHostFirmware{} -> MessageResult r => Message r -> a
f Message r
m
GetPower{} -> MessageResult r => Message r -> a
f Message r
m
SetPower{} -> MessageResult r => Message r -> a
f Message r
m
GetVersion{} -> MessageResult r => Message r -> a
f Message r
m
GetColor{} -> MessageResult r => Message r -> a
f Message r
m
SetColor{} -> MessageResult r => Message r -> a
f Message r
m
SetLightPower{} -> MessageResult r => Message r -> a
f Message r
m
type Lifx = LifxT IO
runLifx :: Lifx a -> IO a
runLifx :: forall a. Lifx a -> IO a
runLifx Lifx a
m =
forall (m :: * -> *) a.
MonadIO m =>
Int -> LifxT m a -> m (Either LifxError a)
runLifxT Int
5_000_000 Lifx a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left LifxError
e -> forall a. IOError -> IO a
ioError forall a b. (a -> b) -> a -> b
$ IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
userErrorType (String
"LIFX LAN: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show LifxError
e) forall a. Maybe a
Nothing forall a. Maybe a
Nothing
Right a
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
runLifxT ::
MonadIO m =>
Int ->
LifxT m a ->
m (Either LifxError a)
runLifxT :: forall (m :: * -> *) a.
MonadIO m =>
Int -> LifxT m a -> m (Either LifxError a)
runLifxT Int
timeoutDuration (LifxT StateT
Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
x) = do
Socket
sock <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Family -> SocketType -> ProtocolNumber -> IO Socket
socket Family
AF_INET SocketType
Datagram ProtocolNumber
defaultProtocol
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Socket -> SocketOption -> Int -> IO ()
setSocketOption Socket
sock SocketOption
Broadcast Int
1
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Socket -> SockAddr -> IO ()
bind Socket
sock forall a b. (a -> b) -> a -> b
$ PortNumber -> HostAddress -> SockAddr
SockAddrInet PortNumber
defaultPort HostAddress
0
HostAddress
source <- forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT
Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
x Word8
0) (Socket
sock, HostAddress
source, Int
timeoutDuration)
class Monad m => MonadLifx m where
type MonadLifxError m
liftProductLookupError :: ProductLookupError -> MonadLifxError m
lifxThrow :: MonadLifxError m -> m a
sendMessage :: Device -> Message r -> m r
broadcastMessage :: Message r -> m [(Device, r)]
discoverDevices :: Maybe Int -> m [Device]
instance MonadIO m => MonadLifx (LifxT m) where
type MonadLifxError (LifxT m) = LifxError
lifxThrow :: forall a. MonadLifxError (LifxT m) -> LifxT m a
lifxThrow = forall (m :: * -> *) a. MonadLifxIO m => LifxError -> m a
lifxThrowIO
liftProductLookupError :: ProductLookupError -> MonadLifxError (LifxT m)
liftProductLookupError = ProductLookupError -> LifxError
ProductLookupError
sendMessage :: forall r. Device -> Message r -> LifxT m r
sendMessage Device
receiver = forall r a. (MessageResult r => Message r -> a) -> Message r -> a
msgResWitness \Message r
msg -> do
forall (m :: * -> *). MonadLifxIO m => m ()
incrementCounter
forall (m :: * -> *) r.
MonadLifxIO m =>
Bool -> HostAddress -> Message r -> m ()
sendMessage' Bool
True Device
receiver.unwrap Message r
msg
forall a (m :: * -> *).
(MessageResult a, MonadLifxIO m) =>
Device -> m a
getSendResult Device
receiver
broadcastMessage :: forall r. Message r -> LifxT m [(Device, r)]
broadcastMessage =
forall r a. (MessageResult r => Message r -> a) -> Message r -> a
msgResWitness forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Device
a, NonEmpty r
xs) -> forall a b. (a -> b) -> [a] -> [b]
map (Device
a,) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty r
xs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *) b r.
(MessageResult a, MonadLifxIO m) =>
(HostAddress -> a -> m (Maybe b))
-> Maybe (Map HostAddress (NonEmpty b) -> Bool)
-> Message r
-> m (Map Device (NonEmpty b))
broadcastAndGetResult (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure) forall a. Maybe a
Nothing
discoverDevices :: Maybe Int -> LifxT m [Device]
discoverDevices Maybe Int
nDevices = forall k a. Map k a -> [k]
Map.keys forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *) b r.
(MessageResult a, MonadLifxIO m) =>
(HostAddress -> a -> m (Maybe b))
-> Maybe (Map HostAddress (NonEmpty b) -> Bool)
-> Message r
-> m (Map Device (NonEmpty b))
broadcastAndGetResult forall {m :: * -> *} {f :: * -> *} {p}.
(MonadLifxIO m, Alternative f) =>
p -> StateService -> m (f ())
f Maybe (Map HostAddress (NonEmpty ()) -> Bool)
p Message StateService
GetService
where
f :: p -> StateService -> m (f ())
f p
_addr StateService{PortNumber
Service
port :: PortNumber
service :: Service
$sel:port:StateService :: StateService -> PortNumber
$sel:service:StateService :: StateService -> Service
..} = do
forall (f :: * -> *). MonadLifxIO f => PortNumber -> f ()
checkPort PortNumber
port
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Service
service forall a. Eq a => a -> a -> Bool
== Service
ServiceUDP
p :: Maybe (Map HostAddress (NonEmpty ()) -> Bool)
p = Maybe Int
nDevices forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Int
n -> (forall a. Ord a => a -> a -> Bool
>= Int
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length
instance MonadLifx m => MonadLifx (MaybeT m) where
type MonadLifxError (MaybeT m) = MonadLifxError m
liftProductLookupError :: ProductLookupError -> MonadLifxError (MaybeT m)
liftProductLookupError = forall (m :: * -> *).
MonadLifx m =>
ProductLookupError -> MonadLifxError m
liftProductLookupError @m
sendMessage :: forall r. Device -> Message r -> MaybeT m r
sendMessage = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (m :: * -> *) r. MonadLifx m => Device -> Message r -> m r
sendMessage
broadcastMessage :: forall r. Message r -> MaybeT m [(Device, r)]
broadcastMessage = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. MonadLifx m => Message r -> m [(Device, r)]
broadcastMessage
discoverDevices :: Maybe Int -> MaybeT m [Device]
discoverDevices = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadLifx m => Maybe Int -> m [Device]
discoverDevices
lifxThrow :: forall a. MonadLifxError (MaybeT m) -> MaybeT m a
lifxThrow = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadLifx m => MonadLifxError m -> m a
lifxThrow
instance MonadLifx m => MonadLifx (ExceptT e m) where
type MonadLifxError (ExceptT e m) = MonadLifxError m
liftProductLookupError :: ProductLookupError -> MonadLifxError (ExceptT e m)
liftProductLookupError = forall (m :: * -> *).
MonadLifx m =>
ProductLookupError -> MonadLifxError m
liftProductLookupError @m
sendMessage :: forall r. Device -> Message r -> ExceptT e m r
sendMessage = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (m :: * -> *) r. MonadLifx m => Device -> Message r -> m r
sendMessage
broadcastMessage :: forall r. Message r -> ExceptT e m [(Device, r)]
broadcastMessage = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. MonadLifx m => Message r -> m [(Device, r)]
broadcastMessage
discoverDevices :: Maybe Int -> ExceptT e m [Device]
discoverDevices = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadLifx m => Maybe Int -> m [Device]
discoverDevices
lifxThrow :: forall a. MonadLifxError (ExceptT e m) -> ExceptT e m a
lifxThrow = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadLifx m => MonadLifxError m -> m a
lifxThrow
instance MonadLifx m => MonadLifx (StateT s m) where
type MonadLifxError (StateT s m) = MonadLifxError m
liftProductLookupError :: ProductLookupError -> MonadLifxError (StateT s m)
liftProductLookupError = forall (m :: * -> *).
MonadLifx m =>
ProductLookupError -> MonadLifxError m
liftProductLookupError @m
sendMessage :: forall r. Device -> Message r -> StateT s m r
sendMessage = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (m :: * -> *) r. MonadLifx m => Device -> Message r -> m r
sendMessage
broadcastMessage :: forall r. Message r -> StateT s m [(Device, r)]
broadcastMessage = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. MonadLifx m => Message r -> m [(Device, r)]
broadcastMessage
discoverDevices :: Maybe Int -> StateT s m [Device]
discoverDevices = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadLifx m => Maybe Int -> m [Device]
discoverDevices
lifxThrow :: forall a. MonadLifxError (StateT s m) -> StateT s m a
lifxThrow = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadLifx m => MonadLifxError m -> m a
lifxThrow
instance (MonadLifx m, Monoid t) => MonadLifx (WriterT t m) where
type MonadLifxError (WriterT t m) = MonadLifxError m
liftProductLookupError :: ProductLookupError -> MonadLifxError (WriterT t m)
liftProductLookupError = forall (m :: * -> *).
MonadLifx m =>
ProductLookupError -> MonadLifxError m
liftProductLookupError @m
sendMessage :: forall r. Device -> Message r -> WriterT t m r
sendMessage = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (m :: * -> *) r. MonadLifx m => Device -> Message r -> m r
sendMessage
broadcastMessage :: forall r. Message r -> WriterT t m [(Device, r)]
broadcastMessage = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. MonadLifx m => Message r -> m [(Device, r)]
broadcastMessage
discoverDevices :: Maybe Int -> WriterT t m [Device]
discoverDevices = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadLifx m => Maybe Int -> m [Device]
discoverDevices
lifxThrow :: forall a. MonadLifxError (WriterT t m) -> WriterT t m a
lifxThrow = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadLifx m => MonadLifxError m -> m a
lifxThrow
instance MonadLifx m => MonadLifx (ReaderT e m) where
type MonadLifxError (ReaderT e m) = MonadLifxError m
liftProductLookupError :: ProductLookupError -> MonadLifxError (ReaderT e m)
liftProductLookupError = forall (m :: * -> *).
MonadLifx m =>
ProductLookupError -> MonadLifxError m
liftProductLookupError @m
sendMessage :: forall r. Device -> Message r -> ReaderT e m r
sendMessage = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (m :: * -> *) r. MonadLifx m => Device -> Message r -> m r
sendMessage
broadcastMessage :: forall r. Message r -> ReaderT e m [(Device, r)]
broadcastMessage = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. MonadLifx m => Message r -> m [(Device, r)]
broadcastMessage
discoverDevices :: Maybe Int -> ReaderT e m [Device]
discoverDevices = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadLifx m => Maybe Int -> m [Device]
discoverDevices
lifxThrow :: forall a. MonadLifxError (ReaderT e m) -> ReaderT e m a
lifxThrow = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadLifx m => MonadLifxError m -> m a
lifxThrow
encodeMessage ::
Bool ->
Bool ->
Word8 ->
Word32 ->
Message r ->
BL.ByteString
encodeMessage :: forall r.
Bool -> Bool -> Word8 -> HostAddress -> Message r -> ByteString
encodeMessage Bool
tagged Bool
ackRequired Word8
sequenceCounter HostAddress
source Message r
msg =
Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ forall t. Binary t => t -> Put
Binary.put (forall r.
Bool -> Bool -> Word8 -> HostAddress -> Message r -> Header
messageHeader Bool
tagged Bool
ackRequired Word8
sequenceCounter HostAddress
source Message r
msg) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall r. Message r -> Put
putMessagePayload Message r
msg
data =
{ :: Word16
, :: Word16
, :: Bool
, :: Bool
, :: Word8
, :: Word32
, :: Word64
, :: Bool
, :: Bool
, :: Word8
, :: Word16
}
deriving (Header -> Header -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Header -> Header -> Bool
$c/= :: Header -> Header -> Bool
== :: Header -> Header -> Bool
$c== :: Header -> Header -> Bool
Eq, Eq Header
Header -> Header -> Bool
Header -> Header -> Ordering
Header -> Header -> Header
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 :: Header -> Header -> Header
$cmin :: Header -> Header -> Header
max :: Header -> Header -> Header
$cmax :: Header -> Header -> Header
>= :: Header -> Header -> Bool
$c>= :: Header -> Header -> Bool
> :: Header -> Header -> Bool
$c> :: Header -> Header -> Bool
<= :: Header -> Header -> Bool
$c<= :: Header -> Header -> Bool
< :: Header -> Header -> Bool
$c< :: Header -> Header -> Bool
compare :: Header -> Header -> Ordering
$ccompare :: Header -> Header -> Ordering
Ord, Int -> Header -> ShowS
[Header] -> ShowS
Header -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Header] -> ShowS
$cshowList :: [Header] -> ShowS
show :: Header -> String
$cshow :: Header -> String
showsPrec :: Int -> Header -> ShowS
$cshowsPrec :: Int -> Header -> ShowS
Show, forall x. Rep Header x -> Header
forall x. Header -> Rep Header x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Header x -> Header
$cfrom :: forall x. Header -> Rep Header x
Generic)
instance Binary Header where
get :: Get Header
get = do
Word16
size <- Get Word16
getWord16le
Word16
protBytes <- Get Word16
getWord16le
let protocol :: Word16
protocol = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Bits a => a -> Int -> a
clearBit Int
12 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Bits a => a -> Int -> a
clearBit Int
13 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Bits a => a -> Int -> a
clearBit Int
14 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Bits a => a -> Int -> a
clearBit Int
15 forall a b. (a -> b) -> a -> b
$ Word16
protBytes
addressable :: Bool
addressable = forall a. Bits a => a -> Int -> Bool
testBit Word16
protBytes Int
12
tagged :: Bool
tagged = forall a. Bits a => a -> Int -> Bool
testBit Word16
protBytes Int
13
origin :: Word8
origin = (if forall a. Bits a => a -> Int -> Bool
testBit Word16
protBytes Int
14 then Word8
0 else Word8
1) forall a. Num a => a -> a -> a
+ (if forall a. Bits a => a -> Int -> Bool
testBit Word16
protBytes Int
15 then Word8
0 else Word8
2)
HostAddress
source <- Get HostAddress
getWord32le
Word64
target <- Get Word64
getWord64be
Int -> Get ()
skip Int
6
Word8
resAckByte <- Get Word8
getWord8
let resRequired :: Bool
resRequired = forall a. Bits a => a -> Int -> Bool
testBit Word8
resAckByte Int
0
ackRequired :: Bool
ackRequired = forall a. Bits a => a -> Int -> Bool
testBit Word8
resAckByte Int
1
Word8
sequenceCounter <- Get Word8
getWord8
Int -> Get ()
skip Int
8
Word16
packetType <- Get Word16
getWord16le
Int -> Get ()
skip Int
2
forall (f :: * -> *) a. Applicative f => a -> f a
pure Header{Bool
Word8
Word16
HostAddress
Word64
packetType :: Word16
sequenceCounter :: Word8
ackRequired :: Bool
resRequired :: Bool
target :: Word64
source :: HostAddress
origin :: Word8
tagged :: Bool
addressable :: Bool
protocol :: Word16
size :: Word16
$sel:packetType:Header :: Word16
$sel:sequenceCounter:Header :: Word8
$sel:ackRequired:Header :: Bool
$sel:resRequired:Header :: Bool
$sel:target:Header :: Word64
$sel:source:Header :: HostAddress
$sel:origin:Header :: Word8
$sel:tagged:Header :: Bool
$sel:addressable:Header :: Bool
$sel:protocol:Header :: Word16
$sel:size:Header :: Word16
..}
put :: Header -> Put
put Header{Bool
Word8
Word16
HostAddress
Word64
packetType :: Word16
sequenceCounter :: Word8
ackRequired :: Bool
resRequired :: Bool
target :: Word64
source :: HostAddress
origin :: Word8
tagged :: Bool
addressable :: Bool
protocol :: Word16
size :: Word16
$sel:packetType:Header :: Header -> Word16
$sel:sequenceCounter:Header :: Header -> Word8
$sel:ackRequired:Header :: Header -> Bool
$sel:resRequired:Header :: Header -> Bool
$sel:target:Header :: Header -> Word64
$sel:source:Header :: Header -> HostAddress
$sel:origin:Header :: Header -> Word8
$sel:tagged:Header :: Header -> Bool
$sel:addressable:Header :: Header -> Bool
$sel:protocol:Header :: Header -> Word16
$sel:size:Header :: Header -> Word16
..} = do
Word16 -> Put
putWord16le Word16
size
Word16 -> Put
putWord16le forall a b. (a -> b) -> a -> b
$
Word16
protocol
forall a. Bits a => a -> a -> a
.|. forall {a}. Bits a => Bool -> Int -> a
bitIf Bool
addressable Int
12
forall a. Bits a => a -> a -> a
.|. forall {a}. Bits a => Bool -> Int -> a
bitIf Bool
tagged Int
13
forall a. Bits a => a -> a -> a
.|. forall {a}. Bits a => Bool -> Int -> a
bitIf (forall a. Bits a => a -> Int -> Bool
testBit Word8
origin Int
0) Int
14
forall a. Bits a => a -> a -> a
.|. forall {a}. Bits a => Bool -> Int -> a
bitIf (forall a. Bits a => a -> Int -> Bool
testBit Word8
origin Int
1) Int
15
HostAddress -> Put
putWord32le HostAddress
source
Word64 -> Put
putWord64be Word64
target
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
6 forall a b. (a -> b) -> a -> b
$ Word8 -> Put
putWord8 Word8
0
Word8 -> Put
putWord8 forall a b. (a -> b) -> a -> b
$
forall a. Bits a => a
zeroBits
forall a. Bits a => a -> a -> a
.|. forall {a}. Bits a => Bool -> Int -> a
bitIf Bool
resRequired Int
0
forall a. Bits a => a -> a -> a
.|. forall {a}. Bits a => Bool -> Int -> a
bitIf Bool
ackRequired Int
1
Word8 -> Put
putWord8 Word8
sequenceCounter
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
8 forall a b. (a -> b) -> a -> b
$ Word8 -> Put
putWord8 Word8
0
Word16 -> Put
putWord16le Word16
packetType
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
2 forall a b. (a -> b) -> a -> b
$ Word8 -> Put
putWord8 Word8
0
where
bitIf :: Bool -> Int -> a
bitIf Bool
b Int
n = if Bool
b then forall a. Bits a => Int -> a
bit Int
n else forall a. Bits a => a
zeroBits
messageHeader :: Bool -> Bool -> Word8 -> Word32 -> Message r -> Header
Bool
tagged Bool
ackRequired Word8
sequenceCounter HostAddress
source = \case
GetService{} ->
Header
{ $sel:size:Header :: Word16
size = forall a. Num a => a
headerSize
, $sel:packetType:Header :: Word16
packetType = Word16
2
, Bool
Word8
Word16
HostAddress
Word64
resRequired :: Bool
origin :: Word8
addressable :: Bool
protocol :: Word16
target :: Word64
source :: HostAddress
sequenceCounter :: Word8
ackRequired :: Bool
tagged :: Bool
$sel:sequenceCounter:Header :: Word8
$sel:ackRequired:Header :: Bool
$sel:resRequired:Header :: Bool
$sel:target:Header :: Word64
$sel:source:Header :: HostAddress
$sel:origin:Header :: Word8
$sel:tagged:Header :: Bool
$sel:addressable:Header :: Bool
$sel:protocol:Header :: Word16
..
}
GetHostFirmware{} ->
Header
{ $sel:size:Header :: Word16
size = forall a. Num a => a
headerSize
, $sel:packetType:Header :: Word16
packetType = Word16
14
, Bool
Word8
Word16
HostAddress
Word64
resRequired :: Bool
origin :: Word8
addressable :: Bool
protocol :: Word16
target :: Word64
source :: HostAddress
sequenceCounter :: Word8
ackRequired :: Bool
tagged :: Bool
$sel:sequenceCounter:Header :: Word8
$sel:ackRequired:Header :: Bool
$sel:resRequired:Header :: Bool
$sel:target:Header :: Word64
$sel:source:Header :: HostAddress
$sel:origin:Header :: Word8
$sel:tagged:Header :: Bool
$sel:addressable:Header :: Bool
$sel:protocol:Header :: Word16
..
}
GetPower{} ->
Header
{ $sel:size:Header :: Word16
size = forall a. Num a => a
headerSize
, $sel:packetType:Header :: Word16
packetType = Word16
20
, Bool
Word8
Word16
HostAddress
Word64
resRequired :: Bool
origin :: Word8
addressable :: Bool
protocol :: Word16
target :: Word64
source :: HostAddress
sequenceCounter :: Word8
ackRequired :: Bool
tagged :: Bool
$sel:sequenceCounter:Header :: Word8
$sel:ackRequired:Header :: Bool
$sel:resRequired:Header :: Bool
$sel:target:Header :: Word64
$sel:source:Header :: HostAddress
$sel:origin:Header :: Word8
$sel:tagged:Header :: Bool
$sel:addressable:Header :: Bool
$sel:protocol:Header :: Word16
..
}
SetPower{} ->
Header
{ $sel:size:Header :: Word16
size = forall a. Num a => a
headerSize forall a. Num a => a -> a -> a
+ Word16
2
, $sel:packetType:Header :: Word16
packetType = Word16
21
, Bool
Word8
Word16
HostAddress
Word64
resRequired :: Bool
origin :: Word8
addressable :: Bool
protocol :: Word16
target :: Word64
source :: HostAddress
sequenceCounter :: Word8
ackRequired :: Bool
tagged :: Bool
$sel:sequenceCounter:Header :: Word8
$sel:ackRequired:Header :: Bool
$sel:resRequired:Header :: Bool
$sel:target:Header :: Word64
$sel:source:Header :: HostAddress
$sel:origin:Header :: Word8
$sel:tagged:Header :: Bool
$sel:addressable:Header :: Bool
$sel:protocol:Header :: Word16
..
}
GetVersion{} ->
Header
{ $sel:size:Header :: Word16
size = forall a. Num a => a
headerSize
, $sel:packetType:Header :: Word16
packetType = Word16
32
, Bool
Word8
Word16
HostAddress
Word64
resRequired :: Bool
origin :: Word8
addressable :: Bool
protocol :: Word16
target :: Word64
source :: HostAddress
sequenceCounter :: Word8
ackRequired :: Bool
tagged :: Bool
$sel:sequenceCounter:Header :: Word8
$sel:ackRequired:Header :: Bool
$sel:resRequired:Header :: Bool
$sel:target:Header :: Word64
$sel:source:Header :: HostAddress
$sel:origin:Header :: Word8
$sel:tagged:Header :: Bool
$sel:addressable:Header :: Bool
$sel:protocol:Header :: Word16
..
}
GetColor{} ->
Header
{ $sel:size:Header :: Word16
size = forall a. Num a => a
headerSize
, $sel:packetType:Header :: Word16
packetType = Word16
101
, Bool
Word8
Word16
HostAddress
Word64
resRequired :: Bool
origin :: Word8
addressable :: Bool
protocol :: Word16
target :: Word64
source :: HostAddress
sequenceCounter :: Word8
ackRequired :: Bool
tagged :: Bool
$sel:sequenceCounter:Header :: Word8
$sel:ackRequired:Header :: Bool
$sel:resRequired:Header :: Bool
$sel:target:Header :: Word64
$sel:source:Header :: HostAddress
$sel:origin:Header :: Word8
$sel:tagged:Header :: Bool
$sel:addressable:Header :: Bool
$sel:protocol:Header :: Word16
..
}
SetColor{} ->
Header
{ $sel:size:Header :: Word16
size = forall a. Num a => a
headerSize forall a. Num a => a -> a -> a
+ Word16
13
, $sel:packetType:Header :: Word16
packetType = Word16
102
, Bool
Word8
Word16
HostAddress
Word64
resRequired :: Bool
origin :: Word8
addressable :: Bool
protocol :: Word16
target :: Word64
source :: HostAddress
sequenceCounter :: Word8
ackRequired :: Bool
tagged :: Bool
$sel:sequenceCounter:Header :: Word8
$sel:ackRequired:Header :: Bool
$sel:resRequired:Header :: Bool
$sel:target:Header :: Word64
$sel:source:Header :: HostAddress
$sel:origin:Header :: Word8
$sel:tagged:Header :: Bool
$sel:addressable:Header :: Bool
$sel:protocol:Header :: Word16
..
}
SetLightPower{} ->
Header
{ $sel:size:Header :: Word16
size = forall a. Num a => a
headerSize forall a. Num a => a -> a -> a
+ Word16
6
, $sel:packetType:Header :: Word16
packetType = Word16
117
, Bool
Word8
Word16
HostAddress
Word64
resRequired :: Bool
origin :: Word8
addressable :: Bool
protocol :: Word16
target :: Word64
source :: HostAddress
sequenceCounter :: Word8
ackRequired :: Bool
tagged :: Bool
$sel:sequenceCounter:Header :: Word8
$sel:ackRequired:Header :: Bool
$sel:resRequired:Header :: Bool
$sel:target:Header :: Word64
$sel:source:Header :: HostAddress
$sel:origin:Header :: Word8
$sel:tagged:Header :: Bool
$sel:addressable:Header :: Bool
$sel:protocol:Header :: Word16
..
}
where
target :: Word64
target = Word64
0 :: Word64
protocol :: Word16
protocol = Word16
1024 :: Word16
addressable :: Bool
addressable = Bool
True
origin :: Word8
origin = Word8
0 :: Word8
resRequired :: Bool
resRequired = Bool
False
putMessagePayload :: Message r -> Put
putMessagePayload :: forall r. Message r -> Put
putMessagePayload = \case
Message r
GetService -> forall a. Monoid a => a
mempty
Message r
GetHostFirmware -> forall a. Monoid a => a
mempty
Message r
GetPower -> forall a. Monoid a => a
mempty
SetPower Bool
b ->
Word16 -> Put
putWord16le if Bool
b then forall a. Bounded a => a
maxBound else forall a. Bounded a => a
minBound
Message r
GetVersion -> forall a. Monoid a => a
mempty
Message r
GetColor -> forall a. Monoid a => a
mempty
SetColor HSBK{Word16
$sel:kelvin:HSBK :: HSBK -> Word16
$sel:brightness:HSBK :: HSBK -> Word16
$sel:saturation:HSBK :: HSBK -> Word16
$sel:hue:HSBK :: HSBK -> Word16
kelvin :: Word16
brightness :: Word16
saturation :: Word16
hue :: Word16
..} NominalDiffTime
d -> do
Word8 -> Put
putWord8 Word8
0
Word16 -> Put
putWord16le Word16
hue
Word16 -> Put
putWord16le Word16
saturation
Word16 -> Put
putWord16le Word16
brightness
Word16 -> Put
putWord16le Word16
kelvin
HostAddress -> Put
putWord32le forall a b. (a -> b) -> a -> b
$ forall f a r.
(HasResolution r, f ~ Fixed r, Integral a) =>
NominalDiffTime -> a
nominalDiffTimeToInt @Milli NominalDiffTime
d
SetLightPower Bool
b NominalDiffTime
d -> do
Word16 -> Put
putWord16le if Bool
b then forall a. Bounded a => a
maxBound else forall a. Bounded a => a
minBound
HostAddress -> Put
putWord32le forall a b. (a -> b) -> a -> b
$ forall f a r.
(HasResolution r, f ~ Fixed r, Integral a) =>
NominalDiffTime -> a
nominalDiffTimeToInt @Milli NominalDiffTime
d
getProductInfo :: forall m. MonadLifx m => Device -> m Product
getProductInfo :: forall (m :: * -> *). MonadLifx m => Device -> m Product
getProductInfo Device
dev = do
StateHostFirmware{Word16
Word64
versionMajor :: Word16
versionMinor :: Word16
build :: Word64
$sel:versionMajor:StateHostFirmware :: StateHostFirmware -> Word16
$sel:versionMinor:StateHostFirmware :: StateHostFirmware -> Word16
$sel:build:StateHostFirmware :: StateHostFirmware -> Word64
..} <- forall (m :: * -> *) r. MonadLifx m => Device -> Message r -> m r
sendMessage Device
dev Message StateHostFirmware
GetHostFirmware
StateVersion
v <- forall (m :: * -> *) r. MonadLifx m => Device -> Message r -> m r
sendMessage Device
dev Message StateVersion
GetVersion
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadLifx m => MonadLifxError m -> m a
lifxThrow forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadLifx m =>
ProductLookupError -> MonadLifxError m
liftProductLookupError @m) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ HostAddress
-> HostAddress
-> Word16
-> Word16
-> Either ProductLookupError Product
productLookup StateVersion
v.vendor StateVersion
v.product Word16
versionMinor Word16
versionMajor
sendMessageAndWait :: (MonadLifx m, MonadIO m) => Device -> Message () -> m ()
sendMessageAndWait :: forall (m :: * -> *).
(MonadLifx m, MonadIO m) =>
Device -> Message () -> m ()
sendMessageAndWait Device
d Message ()
m = do
forall (m :: * -> *) r. MonadLifx m => Device -> Message r -> m r
sendMessage Device
d Message ()
m
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IO ()
threadDelay forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {b}. (RealFrac a, Integral b) => a -> b
timeMicros) Maybe NominalDiffTime
mt
where
mt :: Maybe NominalDiffTime
mt = case Message ()
m of
SetPower{} -> forall a. Maybe a
Nothing
SetColor HSBK
_ NominalDiffTime
t -> forall a. a -> Maybe a
Just NominalDiffTime
t
SetLightPower Bool
_ NominalDiffTime
t -> forall a. a -> Maybe a
Just NominalDiffTime
t
timeMicros :: a -> b
timeMicros a
t = forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ a
t forall a. Num a => a -> a -> a
* a
1_000_000
fromIntegralSafe :: forall a b. (Integral a, Integral b, Bounded b) => a -> Maybe b
fromIntegralSafe :: forall a b. (Integral a, Integral b, Bounded b) => a -> Maybe b
fromIntegralSafe a
x =
forall (f :: * -> *). Alternative f => Bool -> f ()
guard
( a
x forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound @b)
Bool -> Bool -> Bool
&& a
x forall a. Ord a => a -> a -> Bool
>= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound @b)
)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x
headerSize :: Num a => a
= a
36
nominalDiffTimeToInt :: forall f a r. (HasResolution r, f ~ Fixed r, Integral a) => NominalDiffTime -> a
nominalDiffTimeToInt :: forall f a r.
(HasResolution r, f ~ Fixed r, Integral a) =>
NominalDiffTime -> a
nominalDiffTimeToInt NominalDiffTime
t = forall a. Num a => Integer -> a
fromInteger Integer
n
where
MkFixed Integer
n = forall a b. (Real a, Fractional b) => a -> b
realToFrac @Pico @f forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> Pico
nominalDiffTimeToSeconds NominalDiffTime
t
untilM :: Monad m => m Bool -> m ()
untilM :: forall (m :: * -> *). Monad m => m Bool -> m ()
untilM = forall (m :: * -> *). Monad m => m Bool -> m ()
whileM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not
checkPort :: MonadLifxIO f => PortNumber -> f ()
checkPort :: forall (f :: * -> *). MonadLifxIO f => PortNumber -> f ()
checkPort PortNumber
port = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PortNumber
port forall a. Eq a => a -> a -> Bool
/= PortNumber
lifxPort) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadLifxIO m => LifxError -> m a
lifxThrowIO forall a b. (a -> b) -> a -> b
$ PortNumber -> LifxError
UnexpectedPort PortNumber
port
decodeMessage :: forall b m. (Response b, MonadLifxIO m) => BS.ByteString -> m (Maybe b)
decodeMessage :: forall b (m :: * -> *).
(Response b, MonadLifxIO m) =>
ByteString -> m (Maybe b)
decodeMessage ByteString
bs = do
Word8
counter <- forall (m :: * -> *). MonadLifxIO m => m Word8
getCounter
case forall a.
Get a
-> ByteString
-> Either
(ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail forall t. Binary t => Get t
Binary.get forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.fromStrict ByteString
bs of
Left (ByteString, ByteOffset, String)
e -> forall {m :: * -> *} {a}.
MonadLifxIO m =>
(ByteString, ByteOffset, String) -> m a
throwDecodeFailure (ByteString, ByteOffset, String)
e
Right (ByteString
bs', ByteOffset
_, Header{Word16
packetType :: Word16
$sel:packetType:Header :: Header -> Word16
packetType, Word8
sequenceCounter :: Word8
$sel:sequenceCounter:Header :: Header -> Word8
sequenceCounter}) ->
if Word8
sequenceCounter forall a. Eq a => a -> a -> Bool
/= Word8
counter
then forall (m :: * -> *).
MonadLifxIO m =>
Word8 -> Word8 -> Word16 -> ByteString -> m ()
handleOldMessage Word8
counter Word8
sequenceCounter Word16
packetType ByteString
bs' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
else do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word16
packetType forall a. Eq a => a -> a -> Bool
/= forall a. Response a => Word16
expectedPacketType @b) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadLifxIO m => LifxError -> m a
lifxThrowIO forall a b. (a -> b) -> a -> b
$
Word16 -> Word16 -> LifxError
WrongPacketType (forall a. Response a => Word16
expectedPacketType @b) Word16
packetType
case forall a.
Get a
-> ByteString
-> Either
(ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail forall a. Response a => Get a
getBody ByteString
bs' of
Left (ByteString, ByteOffset, String)
e -> forall {m :: * -> *} {a}.
MonadLifxIO m =>
(ByteString, ByteOffset, String) -> m a
throwDecodeFailure (ByteString, ByteOffset, String)
e
Right (ByteString
_, ByteOffset
_, b
res) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just b
res
where
throwDecodeFailure :: (ByteString, ByteOffset, String) -> m a
throwDecodeFailure (ByteString
bs', ByteOffset
bo, String
e) = forall (m :: * -> *) a. MonadLifxIO m => LifxError -> m a
lifxThrowIO forall a b. (a -> b) -> a -> b
$ ByteString -> ByteOffset -> String -> LifxError
DecodeFailure (ByteString -> ByteString
BL.toStrict ByteString
bs') ByteOffset
bo String
e
sendMessage' :: MonadLifxIO m => Bool -> HostAddress -> Message r -> m ()
sendMessage' :: forall (m :: * -> *) r.
MonadLifxIO m =>
Bool -> HostAddress -> Message r -> m ()
sendMessage' Bool
tagged HostAddress
receiver Message r
msg = do
Socket
sock <- forall (m :: * -> *). MonadLifxIO m => m Socket
getSocket
Word8
counter <- forall (m :: * -> *). MonadLifxIO m => m Word8
getCounter
HostAddress
source <- forall (m :: * -> *). MonadLifxIO m => m HostAddress
getSource
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
Socket -> ByteString -> SockAddr -> IO Int
sendTo
Socket
sock
(ByteString -> ByteString
BL.toStrict forall a b. (a -> b) -> a -> b
$ forall r.
Bool -> Bool -> Word8 -> HostAddress -> Message r -> ByteString
encodeMessage Bool
tagged Bool
False Word8
counter HostAddress
source Message r
msg)
(PortNumber -> HostAddress -> SockAddr
SockAddrInet PortNumber
lifxPort HostAddress
receiver)
hostAddressFromSock :: MonadLifxIO m => SockAddr -> m HostAddress
hostAddressFromSock :: forall (m :: * -> *). MonadLifxIO m => SockAddr -> m HostAddress
hostAddressFromSock = \case
SockAddrInet PortNumber
port HostAddress
ha -> forall (f :: * -> *). MonadLifxIO f => PortNumber -> f ()
checkPort PortNumber
port forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure HostAddress
ha
SockAddr
addr -> forall (m :: * -> *) a. MonadLifxIO m => LifxError -> m a
lifxThrowIO forall a b. (a -> b) -> a -> b
$ SockAddr -> LifxError
UnexpectedSockAddrType SockAddr
addr
receiveMessage :: MonadLifxIO m => Int -> Int -> m (Maybe (BS.ByteString, SockAddr))
receiveMessage :: forall (m :: * -> *).
MonadLifxIO m =>
Int -> Int -> m (Maybe (ByteString, SockAddr))
receiveMessage Int
t Int
size = do
Socket
sock <- forall (m :: * -> *). MonadLifxIO m => m Socket
getSocket
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> IO a -> IO (Maybe a)
timeout Int
t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Socket -> Int -> IO (ByteString, SockAddr)
recvFrom Socket
sock
forall a b. (a -> b) -> a -> b
$ forall a. Num a => a
headerSize forall a. Num a => a -> a -> a
+ Int
size
broadcast :: MonadLifxIO m => Message r -> m ()
broadcast :: forall (m :: * -> *) r. MonadLifxIO m => Message r -> m ()
broadcast Message r
msg = do
forall (m :: * -> *). MonadLifxIO m => m ()
incrementCounter
forall (m :: * -> *) r.
MonadLifxIO m =>
Bool -> HostAddress -> Message r -> m ()
sendMessage' Bool
False ((Word8, Word8, Word8, Word8) -> HostAddress
tupleToHostAddress (Word8
255, Word8
255, Word8
255, Word8
255)) Message r
msg