module Lifx.Lan (
    sendMessage,
    broadcastMessage,
    discoverDevices,
    Message (..),
    HSBK (..),
    Duration (..),
    Lifx,
    runLifx,
    LifxT (..),
    runLifxT,
    LifxError (..),
    MonadLifx (..),

    -- * Responses
    LightState (..),
    StateService (..),
    Service (..),
    StatePower (..),

    -- * Low-level
    encodeMessage,
    Header (..),
) where

import Control.Monad
import Control.Monad.Except
import Control.Monad.Extra
import Control.Monad.Reader
import Control.Monad.State hiding (get, put)
import Control.Monad.Trans.Maybe
import Data.Binary
import Data.Binary.Get hiding (label)
import Data.Binary.Put
import Data.Bits
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as BL
import Data.Either.Extra
import Data.Fixed
import Data.Foldable
import Data.Function
import Data.Functor
import Data.List.NonEmpty (NonEmpty)
import Data.Map (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe
import Data.Time
import Data.Tuple.Extra
import GHC.Generics (Generic)
import GHC.IO.Exception
import Network.Socket
import Network.Socket.ByteString
import System.Random
import System.Timeout

{- Core -}

lifxPort :: PortNumber
lifxPort :: PortNumber
lifxPort = PortNumber
56700

sendMessage :: MonadLifx m => HostAddress -> Message a -> m a
sendMessage :: HostAddress -> Message a -> m a
sendMessage HostAddress
receiver Message a
msg = do
    Int
timeoutDuration <- m Int
forall (m :: * -> *). MonadLifx m => m Int
getTimeout
    m ()
forall (m :: * -> *). MonadLifx m => m ()
incrementCounter
    Bool -> HostAddress -> Message a -> m ()
forall (m :: * -> *) a.
MonadLifx m =>
Bool -> HostAddress -> Message a -> m ()
sendMessage' Bool
True HostAddress
receiver Message a
msg
    Message a -> Either a (Word16, Int, Get a)
forall a. Message a -> Either a (Word16, Int, Get a)
getResponse' Message a
msg Either a (Word16, Int, Get a)
-> (Either a (Word16, Int, Get a) -> m a) -> m a
forall a b. a -> (a -> b) -> b
& (a -> m a)
-> ((Word16, Int, Get a) -> m a)
-> Either a (Word16, Int, Get a)
-> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure \(Word16
expectedPacketType, Int
messageSize, Get a
getBody) -> m (Maybe a) -> m a
forall (m :: * -> *) a. Monad m => m (Maybe a) -> m a
untilJustM do
        (ByteString
bs, SockAddr
sender0) <- m (Either LifxError (ByteString, SockAddr))
-> m (ByteString, SockAddr)
forall (m :: * -> *) b.
MonadLifx m =>
m (Either LifxError b) -> m b
throwEither (m (Either LifxError (ByteString, SockAddr))
 -> m (ByteString, SockAddr))
-> m (Either LifxError (ByteString, SockAddr))
-> m (ByteString, SockAddr)
forall a b. (a -> b) -> a -> b
$ LifxError
-> Maybe (ByteString, SockAddr)
-> Either LifxError (ByteString, SockAddr)
forall a b. a -> Maybe b -> Either a b
maybeToEither LifxError
RecvTimeout (Maybe (ByteString, SockAddr)
 -> Either LifxError (ByteString, SockAddr))
-> m (Maybe (ByteString, SockAddr))
-> m (Either LifxError (ByteString, SockAddr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> m (Maybe (ByteString, SockAddr))
forall (m :: * -> *).
MonadLifx m =>
Int -> Int -> m (Maybe (ByteString, SockAddr))
receiveMessage Int
timeoutDuration Int
messageSize
        HostAddress
sender <- SockAddr -> m HostAddress
forall (m :: * -> *). MonadLifx m => SockAddr -> m HostAddress
hostAddressFromSock SockAddr
sender0
        Maybe a
res <- Get a -> Word16 -> ByteString -> m (Maybe a)
forall (m :: * -> *) b.
MonadLifx m =>
Get b -> Word16 -> ByteString -> m (Maybe b)
decodeMessage Get a
getBody Word16
expectedPacketType ByteString
bs
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
res Bool -> Bool -> Bool
&& HostAddress
sender HostAddress -> HostAddress -> Bool
forall a. Eq a => a -> a -> Bool
/= HostAddress
receiver) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ LifxError -> m ()
forall (m :: * -> *) a. MonadLifx m => LifxError -> m a
lifxThrow (LifxError -> m ()) -> LifxError -> m ()
forall a b. (a -> b) -> a -> b
$ HostAddress -> HostAddress -> LifxError
WrongSender HostAddress
receiver HostAddress
sender
        Maybe a -> m (Maybe a)
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 m (Either LifxError b) -> (Either LifxError b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Left LifxError
e -> LifxError -> m b
forall (m :: * -> *) a. MonadLifx m => LifxError -> m a
lifxThrow LifxError
e
            Right b
r -> b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
r

broadcastMessage :: MonadLifx m => Message a -> m [(HostAddress, a)]
broadcastMessage :: Message a -> m [(HostAddress, a)]
broadcastMessage =
    (Map HostAddress (NonEmpty a) -> [(HostAddress, a)])
-> m (Map HostAddress (NonEmpty a)) -> m [(HostAddress, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((HostAddress, NonEmpty a) -> [(HostAddress, a)])
-> [(HostAddress, NonEmpty a)] -> [(HostAddress, a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(HostAddress
a, NonEmpty a
xs) -> (a -> (HostAddress, a)) -> [a] -> [(HostAddress, a)]
forall a b. (a -> b) -> [a] -> [b]
map (HostAddress
a,) ([a] -> [(HostAddress, a)]) -> [a] -> [(HostAddress, a)]
forall a b. (a -> b) -> a -> b
$ NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty a
xs) ([(HostAddress, NonEmpty a)] -> [(HostAddress, a)])
-> (Map HostAddress (NonEmpty a) -> [(HostAddress, NonEmpty a)])
-> Map HostAddress (NonEmpty a)
-> [(HostAddress, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map HostAddress (NonEmpty a) -> [(HostAddress, NonEmpty a)]
forall k a. Map k a -> [(k, a)]
Map.toList)
        (m (Map HostAddress (NonEmpty a)) -> m [(HostAddress, a)])
-> (Message a -> m (Map HostAddress (NonEmpty a)))
-> Message a
-> m [(HostAddress, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HostAddress -> a -> m (Maybe a))
-> Maybe (Map HostAddress (NonEmpty a) -> Bool)
-> Message a
-> m (Map HostAddress (NonEmpty a))
forall (m :: * -> *) a b.
MonadLifx m =>
(HostAddress -> a -> m (Maybe b))
-> Maybe (Map HostAddress (NonEmpty b) -> Bool)
-> Message a
-> m (Map HostAddress (NonEmpty b))
broadcastMessage' ((a -> m (Maybe a)) -> HostAddress -> a -> m (Maybe a)
forall a b. a -> b -> a
const ((a -> m (Maybe a)) -> HostAddress -> a -> m (Maybe a))
-> (a -> m (Maybe a)) -> HostAddress -> a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> m (Maybe a)) -> (a -> Maybe a) -> a -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) Maybe (Map HostAddress (NonEmpty a) -> Bool)
forall a. Maybe a
Nothing
broadcastMessage' ::
    MonadLifx m =>
    -- | Transform output and discard messages which return 'Nothing'.
    (HostAddress -> a -> m (Maybe b)) ->
    -- | Return once this predicate over received messages passes. Otherwise just keep waiting until timeout.
    Maybe (Map HostAddress (NonEmpty b) -> Bool) ->
    Message a ->
    m (Map HostAddress (NonEmpty b))
broadcastMessage' :: (HostAddress -> a -> m (Maybe b))
-> Maybe (Map HostAddress (NonEmpty b) -> Bool)
-> Message a
-> m (Map HostAddress (NonEmpty b))
broadcastMessage' HostAddress -> a -> m (Maybe b)
filter' Maybe (Map HostAddress (NonEmpty b) -> Bool)
maybeFinished Message a
msg = do
    Int
timeoutDuration <- m Int
forall (m :: * -> *). MonadLifx m => m Int
getTimeout
    m ()
forall (m :: * -> *). MonadLifx m => m ()
incrementCounter
    Bool -> HostAddress -> Message a -> m ()
forall (m :: * -> *) a.
MonadLifx m =>
Bool -> HostAddress -> Message a -> m ()
sendMessage' Bool
False HostAddress
receiver Message a
msg
    Message a -> Either a (Word16, Int, Get a)
forall a. Message a -> Either a (Word16, Int, Get a)
getResponse' Message a
msg Either a (Word16, Int, Get a)
-> (Either a (Word16, Int, Get a)
    -> m (Map HostAddress (NonEmpty b)))
-> m (Map HostAddress (NonEmpty b))
forall a b. a -> (a -> b) -> b
& (a -> m (Map HostAddress (NonEmpty b)))
-> ((Word16, Int, Get a) -> m (Map HostAddress (NonEmpty b)))
-> Either a (Word16, Int, Get a)
-> m (Map HostAddress (NonEmpty b))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> m (Map HostAddress (NonEmpty b))
noResponseNeeded \(Word16
expectedPacketType, Int
messageSize, Get a
getBody) -> do
        UTCTime
t0 <- IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
        (StateT (Map HostAddress (NonEmpty b)) m ()
 -> Map HostAddress (NonEmpty b)
 -> m (Map HostAddress (NonEmpty b)))
-> Map HostAddress (NonEmpty b)
-> StateT (Map HostAddress (NonEmpty b)) m ()
-> m (Map HostAddress (NonEmpty b))
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (Map HostAddress (NonEmpty b)) m ()
-> Map HostAddress (NonEmpty b) -> m (Map HostAddress (NonEmpty b))
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT Map HostAddress (NonEmpty b)
forall k a. Map k a
Map.empty (StateT (Map HostAddress (NonEmpty b)) m ()
 -> m (Map HostAddress (NonEmpty b)))
-> StateT (Map HostAddress (NonEmpty b)) m ()
-> m (Map HostAddress (NonEmpty b))
forall a b. (a -> b) -> a -> b
$ StateT (Map HostAddress (NonEmpty b)) m Bool
-> StateT (Map HostAddress (NonEmpty b)) m ()
forall (m :: * -> *). Monad m => m Bool -> m ()
untilM do
            UTCTime
t <- IO UTCTime -> StateT (Map HostAddress (NonEmpty b)) m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
            let timeLeft :: Int
timeLeft = Int
timeoutDuration Int -> Int -> Int
forall a. Num a => a -> a -> a
- NominalDiffTime -> Int
nominalDiffTimeToMicroSeconds (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
t UTCTime
t0)
            if Int
timeLeft Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
                then Bool -> StateT (Map HostAddress (NonEmpty b)) m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
                else
                    Int
-> Int
-> StateT
     (Map HostAddress (NonEmpty b)) m (Maybe (ByteString, SockAddr))
forall (m :: * -> *).
MonadLifx m =>
Int -> Int -> m (Maybe (ByteString, SockAddr))
receiveMessage Int
timeLeft Int
messageSize StateT
  (Map HostAddress (NonEmpty b)) m (Maybe (ByteString, SockAddr))
-> (Maybe (ByteString, SockAddr)
    -> StateT (Map HostAddress (NonEmpty b)) m Bool)
-> StateT (Map HostAddress (NonEmpty b)) m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                        Just (ByteString
bs, SockAddr
addr) -> do
                            Get a
-> Word16
-> ByteString
-> StateT (Map HostAddress (NonEmpty b)) m (Maybe a)
forall (m :: * -> *) b.
MonadLifx m =>
Get b -> Word16 -> ByteString -> m (Maybe b)
decodeMessage Get a
getBody Word16
expectedPacketType ByteString
bs StateT (Map HostAddress (NonEmpty b)) m (Maybe a)
-> (Maybe a -> StateT (Map HostAddress (NonEmpty b)) m ())
-> StateT (Map HostAddress (NonEmpty b)) m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                                Just a
x -> do
                                    HostAddress
hostAddr <- SockAddr -> StateT (Map HostAddress (NonEmpty b)) m HostAddress
forall (m :: * -> *). MonadLifx m => SockAddr -> m HostAddress
hostAddressFromSock SockAddr
addr
                                    m (Maybe b) -> StateT (Map HostAddress (NonEmpty b)) m (Maybe b)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (HostAddress -> a -> m (Maybe b)
filter' HostAddress
hostAddr a
x) StateT (Map HostAddress (NonEmpty b)) m (Maybe b)
-> (Maybe b -> StateT (Map HostAddress (NonEmpty b)) m ())
-> StateT (Map HostAddress (NonEmpty b)) m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                                        Just b
x' -> (Map HostAddress (NonEmpty b) -> Map HostAddress (NonEmpty b))
-> StateT (Map HostAddress (NonEmpty b)) m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Map HostAddress (NonEmpty b) -> Map HostAddress (NonEmpty b))
 -> StateT (Map HostAddress (NonEmpty b)) m ())
-> (Map HostAddress (NonEmpty b) -> Map HostAddress (NonEmpty b))
-> StateT (Map HostAddress (NonEmpty b)) m ()
forall a b. (a -> b) -> a -> b
$ (NonEmpty b -> NonEmpty b -> NonEmpty b)
-> HostAddress
-> NonEmpty b
-> Map HostAddress (NonEmpty b)
-> Map HostAddress (NonEmpty b)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith NonEmpty b -> NonEmpty b -> NonEmpty b
forall a. Semigroup a => a -> a -> a
(<>) HostAddress
hostAddr (b -> NonEmpty b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
x')
                                        Maybe b
Nothing -> () -> StateT (Map HostAddress (NonEmpty b)) m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                                Maybe a
Nothing -> () -> StateT (Map HostAddress (NonEmpty b)) m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                            StateT (Map HostAddress (NonEmpty b)) m Bool
-> ((Map HostAddress (NonEmpty b) -> Bool)
    -> StateT (Map HostAddress (NonEmpty b)) m Bool)
-> Maybe (Map HostAddress (NonEmpty b) -> Bool)
-> StateT (Map HostAddress (NonEmpty b)) m Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> StateT (Map HostAddress (NonEmpty b)) m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) (Map HostAddress (NonEmpty b) -> Bool)
-> StateT (Map HostAddress (NonEmpty b)) m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Maybe (Map HostAddress (NonEmpty b) -> Bool)
maybeFinished
                        Maybe (ByteString, SockAddr)
Nothing -> do
                            -- if we were waiting for a predicate to pass, then we've timed out
                            Bool
-> StateT (Map HostAddress (NonEmpty b)) m ()
-> StateT (Map HostAddress (NonEmpty b)) m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (Map HostAddress (NonEmpty b) -> Bool) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Map HostAddress (NonEmpty b) -> Bool)
maybeFinished) (StateT (Map HostAddress (NonEmpty b)) m ()
 -> StateT (Map HostAddress (NonEmpty b)) m ())
-> StateT (Map HostAddress (NonEmpty b)) m ()
-> StateT (Map HostAddress (NonEmpty b)) m ()
forall a b. (a -> b) -> a -> b
$ LifxError -> StateT (Map HostAddress (NonEmpty b)) m ()
forall (m :: * -> *) a. MonadLifx m => LifxError -> m a
lifxThrow (LifxError -> StateT (Map HostAddress (NonEmpty b)) m ())
-> ([HostAddress] -> LifxError)
-> [HostAddress]
-> StateT (Map HostAddress (NonEmpty b)) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [HostAddress] -> LifxError
BroadcastTimeout ([HostAddress] -> StateT (Map HostAddress (NonEmpty b)) m ())
-> StateT (Map HostAddress (NonEmpty b)) m [HostAddress]
-> StateT (Map HostAddress (NonEmpty b)) m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Map HostAddress (NonEmpty b) -> [HostAddress])
-> StateT (Map HostAddress (NonEmpty b)) m [HostAddress]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Map HostAddress (NonEmpty b) -> [HostAddress]
forall k a. Map k a -> [k]
Map.keys
                            Bool -> StateT (Map HostAddress (NonEmpty b)) m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
  where
    receiver :: HostAddress
receiver = (Word8, Word8, Word8, Word8) -> HostAddress
tupleToHostAddress (Word8
255, Word8
255, Word8
255, Word8
255)
    noResponseNeeded :: a -> m (Map HostAddress (NonEmpty b))
noResponseNeeded = (Maybe b -> Map HostAddress (NonEmpty b))
-> m (Maybe b) -> m (Map HostAddress (NonEmpty b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map HostAddress (NonEmpty b)
-> (b -> Map HostAddress (NonEmpty b))
-> Maybe b
-> Map HostAddress (NonEmpty b)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map HostAddress (NonEmpty b)
forall k a. Map k a
Map.empty ((b -> Map HostAddress (NonEmpty b))
 -> Maybe b -> Map HostAddress (NonEmpty b))
-> (b -> Map HostAddress (NonEmpty b))
-> Maybe b
-> Map HostAddress (NonEmpty b)
forall a b. (a -> b) -> a -> b
$ HostAddress -> NonEmpty b -> Map HostAddress (NonEmpty b)
forall k a. k -> a -> Map k a
Map.singleton HostAddress
receiver (NonEmpty b -> Map HostAddress (NonEmpty b))
-> (b -> NonEmpty b) -> b -> Map HostAddress (NonEmpty b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> NonEmpty b
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (m (Maybe b) -> m (Map HostAddress (NonEmpty b)))
-> (a -> m (Maybe b)) -> a -> m (Map HostAddress (NonEmpty b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostAddress -> a -> m (Maybe b)
filter' HostAddress
receiver

{- | If an integer argument is given, wait until we have responses from that number of devices.
Otherwise just keep waiting until timeout.
-}
discoverDevices :: MonadLifx m => Maybe Int -> m [HostAddress]
discoverDevices :: Maybe Int -> m [HostAddress]
discoverDevices Maybe Int
nDevices = Map HostAddress (NonEmpty ()) -> [HostAddress]
forall k a. Map k a -> [k]
Map.keys (Map HostAddress (NonEmpty ()) -> [HostAddress])
-> m (Map HostAddress (NonEmpty ())) -> m [HostAddress]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HostAddress -> StateService -> m (Maybe ()))
-> Maybe (Map HostAddress (NonEmpty ()) -> Bool)
-> Message StateService
-> m (Map HostAddress (NonEmpty ()))
forall (m :: * -> *) a b.
MonadLifx m =>
(HostAddress -> a -> m (Maybe b))
-> Maybe (Map HostAddress (NonEmpty b) -> Bool)
-> Message a
-> m (Map HostAddress (NonEmpty b))
broadcastMessage' HostAddress -> StateService -> m (Maybe ())
forall (m :: * -> *) (f :: * -> *) p.
(MonadLifx 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{HostAddress
Service
$sel:port:StateService :: StateService -> HostAddress
$sel:service:StateService :: StateService -> Service
port :: HostAddress
service :: Service
..} = do
        PortNumber -> m ()
forall (f :: * -> *). MonadLifx f => PortNumber -> f ()
checkPort (PortNumber -> m ()) -> PortNumber -> m ()
forall a b. (a -> b) -> a -> b
$ HostAddress -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral HostAddress
port
        f () -> m (f ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f () -> m (f ())) -> (Bool -> f ()) -> Bool -> m (f ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> f ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m (f ())) -> Bool -> m (f ())
forall a b. (a -> b) -> a -> b
$ Service
service Service -> Service -> Bool
forall a. Eq a => a -> a -> Bool
== Service
ServiceUDP
    p :: Maybe (Map HostAddress (NonEmpty ()) -> Bool)
p = Maybe Int
nDevices Maybe Int
-> (Int -> Map HostAddress (NonEmpty ()) -> Bool)
-> Maybe (Map HostAddress (NonEmpty ()) -> Bool)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Int
n -> (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n) (Int -> Bool)
-> (Map HostAddress (NonEmpty ()) -> Int)
-> Map HostAddress (NonEmpty ())
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map HostAddress (NonEmpty ()) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length

data HSBK = HSBK
    { HSBK -> Word16
hue :: Word16
    , HSBK -> Word16
saturation :: Word16
    , HSBK -> Word16
brightness :: Word16
    , HSBK -> Word16
kelvin :: Word16
    }
    deriving (HSBK -> HSBK -> Bool
(HSBK -> HSBK -> Bool) -> (HSBK -> HSBK -> Bool) -> Eq HSBK
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HSBK -> HSBK -> Bool
$c/= :: HSBK -> HSBK -> Bool
== :: HSBK -> HSBK -> Bool
$c== :: HSBK -> HSBK -> Bool
Eq, Eq HSBK
Eq HSBK
-> (HSBK -> HSBK -> Ordering)
-> (HSBK -> HSBK -> Bool)
-> (HSBK -> HSBK -> Bool)
-> (HSBK -> HSBK -> Bool)
-> (HSBK -> HSBK -> Bool)
-> (HSBK -> HSBK -> HSBK)
-> (HSBK -> HSBK -> HSBK)
-> Ord HSBK
HSBK -> HSBK -> Bool
HSBK -> HSBK -> Ordering
HSBK -> HSBK -> HSBK
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 :: HSBK -> HSBK -> HSBK
$cmin :: HSBK -> HSBK -> HSBK
max :: HSBK -> HSBK -> HSBK
$cmax :: HSBK -> HSBK -> HSBK
>= :: HSBK -> HSBK -> Bool
$c>= :: HSBK -> HSBK -> Bool
> :: HSBK -> HSBK -> Bool
$c> :: HSBK -> HSBK -> Bool
<= :: HSBK -> HSBK -> Bool
$c<= :: HSBK -> HSBK -> Bool
< :: HSBK -> HSBK -> Bool
$c< :: HSBK -> HSBK -> Bool
compare :: HSBK -> HSBK -> Ordering
$ccompare :: HSBK -> HSBK -> Ordering
$cp1Ord :: Eq HSBK
Ord, Int -> HSBK -> ShowS
[HSBK] -> ShowS
HSBK -> String
(Int -> HSBK -> ShowS)
-> (HSBK -> String) -> ([HSBK] -> ShowS) -> Show HSBK
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HSBK] -> ShowS
$cshowList :: [HSBK] -> ShowS
show :: HSBK -> String
$cshow :: HSBK -> String
showsPrec :: Int -> HSBK -> ShowS
$cshowsPrec :: Int -> HSBK -> ShowS
Show, (forall x. HSBK -> Rep HSBK x)
-> (forall x. Rep HSBK x -> HSBK) -> Generic HSBK
forall x. Rep HSBK x -> HSBK
forall x. HSBK -> Rep HSBK x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HSBK x -> HSBK
$cfrom :: forall x. HSBK -> Rep HSBK x
Generic)
newtype Duration = Duration Word32
    deriving (Duration -> Duration -> Bool
(Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool) -> Eq Duration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Duration -> Duration -> Bool
$c/= :: Duration -> Duration -> Bool
== :: Duration -> Duration -> Bool
$c== :: Duration -> Duration -> Bool
Eq, Eq Duration
Eq Duration
-> (Duration -> Duration -> Ordering)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool)
-> (Duration -> Duration -> Duration)
-> (Duration -> Duration -> Duration)
-> Ord Duration
Duration -> Duration -> Bool
Duration -> Duration -> Ordering
Duration -> Duration -> Duration
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 :: Duration -> Duration -> Duration
$cmin :: Duration -> Duration -> Duration
max :: Duration -> Duration -> Duration
$cmax :: Duration -> Duration -> Duration
>= :: Duration -> Duration -> Bool
$c>= :: Duration -> Duration -> Bool
> :: Duration -> Duration -> Bool
$c> :: Duration -> Duration -> Bool
<= :: Duration -> Duration -> Bool
$c<= :: Duration -> Duration -> Bool
< :: Duration -> Duration -> Bool
$c< :: Duration -> Duration -> Bool
compare :: Duration -> Duration -> Ordering
$ccompare :: Duration -> Duration -> Ordering
$cp1Ord :: Eq Duration
Ord, Int -> Duration -> ShowS
[Duration] -> ShowS
Duration -> String
(Int -> Duration -> ShowS)
-> (Duration -> String) -> ([Duration] -> ShowS) -> Show Duration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Duration] -> ShowS
$cshowList :: [Duration] -> ShowS
show :: Duration -> String
$cshow :: Duration -> String
showsPrec :: Int -> Duration -> ShowS
$cshowsPrec :: Int -> Duration -> ShowS
Show, (forall x. Duration -> Rep Duration x)
-> (forall x. Rep Duration x -> Duration) -> Generic Duration
forall x. Rep Duration x -> Duration
forall x. Duration -> Rep Duration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Duration x -> Duration
$cfrom :: forall x. Duration -> Rep Duration x
Generic)

data Message a where
    GetService :: Message StateService
    GetPower :: Message StatePower
    SetPower :: Bool -> Message ()
    GetColor :: Message LightState
    SetColor :: HSBK -> Duration -> Message ()
    SetLightPower :: Bool -> Duration -> Message ()
deriving instance (Eq (Message a))
deriving instance (Ord (Message a))
deriving instance (Show (Message a))

data Service
    = ServiceUDP
    | ServiceReserved1
    | ServiceReserved2
    | ServiceReserved3
    | ServiceReserved4
    deriving (Service -> Service -> Bool
(Service -> Service -> Bool)
-> (Service -> Service -> Bool) -> Eq Service
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
Eq Service
-> (Service -> Service -> Ordering)
-> (Service -> Service -> Bool)
-> (Service -> Service -> Bool)
-> (Service -> Service -> Bool)
-> (Service -> Service -> Bool)
-> (Service -> Service -> Service)
-> (Service -> Service -> Service)
-> Ord 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
$cp1Ord :: Eq Service
Ord, Int -> Service -> ShowS
[Service] -> ShowS
Service -> String
(Int -> Service -> ShowS)
-> (Service -> String) -> ([Service] -> ShowS) -> Show Service
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. Service -> Rep Service x)
-> (forall x. Rep Service x -> Service) -> Generic Service
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 -> HostAddress
port :: Word32
    }
    deriving (StateService -> StateService -> Bool
(StateService -> StateService -> Bool)
-> (StateService -> StateService -> Bool) -> Eq StateService
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
Eq StateService
-> (StateService -> StateService -> Ordering)
-> (StateService -> StateService -> Bool)
-> (StateService -> StateService -> Bool)
-> (StateService -> StateService -> Bool)
-> (StateService -> StateService -> Bool)
-> (StateService -> StateService -> StateService)
-> (StateService -> StateService -> StateService)
-> Ord 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
$cp1Ord :: Eq StateService
Ord, Int -> StateService -> ShowS
[StateService] -> ShowS
StateService -> String
(Int -> StateService -> ShowS)
-> (StateService -> String)
-> ([StateService] -> ShowS)
-> Show StateService
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. StateService -> Rep StateService x)
-> (forall x. Rep StateService x -> StateService)
-> Generic StateService
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)
newtype StatePower = StatePower
    { StatePower -> Word16
power :: Word16
    }
    deriving (StatePower -> StatePower -> Bool
(StatePower -> StatePower -> Bool)
-> (StatePower -> StatePower -> Bool) -> Eq StatePower
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
Eq StatePower
-> (StatePower -> StatePower -> Ordering)
-> (StatePower -> StatePower -> Bool)
-> (StatePower -> StatePower -> Bool)
-> (StatePower -> StatePower -> Bool)
-> (StatePower -> StatePower -> Bool)
-> (StatePower -> StatePower -> StatePower)
-> (StatePower -> StatePower -> StatePower)
-> Ord 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
$cp1Ord :: Eq StatePower
Ord, Int -> StatePower -> ShowS
[StatePower] -> ShowS
StatePower -> String
(Int -> StatePower -> ShowS)
-> (StatePower -> String)
-> ([StatePower] -> ShowS)
-> Show StatePower
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. StatePower -> Rep StatePower x)
-> (forall x. Rep StatePower x -> StatePower) -> Generic StatePower
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 LightState = LightState
    { LightState -> HSBK
hsbk :: HSBK
    , LightState -> Word16
power :: Word16
    , LightState -> ByteString
label :: BS.ByteString
    }
    deriving (LightState -> LightState -> Bool
(LightState -> LightState -> Bool)
-> (LightState -> LightState -> Bool) -> Eq LightState
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
Eq LightState
-> (LightState -> LightState -> Ordering)
-> (LightState -> LightState -> Bool)
-> (LightState -> LightState -> Bool)
-> (LightState -> LightState -> Bool)
-> (LightState -> LightState -> Bool)
-> (LightState -> LightState -> LightState)
-> (LightState -> LightState -> LightState)
-> Ord 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
$cp1Ord :: Eq LightState
Ord, Int -> LightState -> ShowS
[LightState] -> ShowS
LightState -> String
(Int -> LightState -> ShowS)
-> (LightState -> String)
-> ([LightState] -> ShowS)
-> Show LightState
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. LightState -> Rep LightState x)
-> (forall x. Rep LightState x -> LightState) -> Generic LightState
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)

data LifxError
    = DecodeFailure BS.ByteString ByteOffset String
    | RecvTimeout
    | BroadcastTimeout [HostAddress] -- contains the addresses which we have received valid responses from
    | WrongPacketType Word16 Word16 -- expected, then actual
    | WrongSender HostAddress HostAddress -- expected, then actual
    | UnexpectedSockAddrType SockAddr
    | UnexpectedPort PortNumber
    deriving (LifxError -> LifxError -> Bool
(LifxError -> LifxError -> Bool)
-> (LifxError -> LifxError -> Bool) -> Eq LifxError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LifxError -> LifxError -> Bool
$c/= :: LifxError -> LifxError -> Bool
== :: LifxError -> LifxError -> Bool
$c== :: LifxError -> LifxError -> Bool
Eq, Eq LifxError
Eq LifxError
-> (LifxError -> LifxError -> Ordering)
-> (LifxError -> LifxError -> Bool)
-> (LifxError -> LifxError -> Bool)
-> (LifxError -> LifxError -> Bool)
-> (LifxError -> LifxError -> Bool)
-> (LifxError -> LifxError -> LifxError)
-> (LifxError -> LifxError -> LifxError)
-> Ord LifxError
LifxError -> LifxError -> Bool
LifxError -> LifxError -> Ordering
LifxError -> LifxError -> LifxError
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 :: LifxError -> LifxError -> LifxError
$cmin :: LifxError -> LifxError -> LifxError
max :: LifxError -> LifxError -> LifxError
$cmax :: LifxError -> LifxError -> LifxError
>= :: LifxError -> LifxError -> Bool
$c>= :: LifxError -> LifxError -> Bool
> :: LifxError -> LifxError -> Bool
$c> :: LifxError -> LifxError -> Bool
<= :: LifxError -> LifxError -> Bool
$c<= :: LifxError -> LifxError -> Bool
< :: LifxError -> LifxError -> Bool
$c< :: LifxError -> LifxError -> Bool
compare :: LifxError -> LifxError -> Ordering
$ccompare :: LifxError -> LifxError -> Ordering
$cp1Ord :: Eq LifxError
Ord, Int -> LifxError -> ShowS
[LifxError] -> ShowS
LifxError -> String
(Int -> LifxError -> ShowS)
-> (LifxError -> String)
-> ([LifxError] -> ShowS)
-> Show LifxError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LifxError] -> ShowS
$cshowList :: [LifxError] -> ShowS
show :: LifxError -> String
$cshow :: LifxError -> String
showsPrec :: Int -> LifxError -> ShowS
$cshowsPrec :: Int -> LifxError -> ShowS
Show, (forall x. LifxError -> Rep LifxError x)
-> (forall x. Rep LifxError x -> LifxError) -> Generic LifxError
forall x. Rep LifxError x -> LifxError
forall x. LifxError -> Rep LifxError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LifxError x -> LifxError
$cfrom :: forall x. LifxError -> Rep LifxError x
Generic)

{- Message responses -}

class Response a where
    getResponse :: Either a (Word16, Int, Get a)

instance Response () where
    getResponse :: Either () (Word16, Int, Get ())
getResponse = () -> Either () (Word16, Int, Get ())
forall a b. a -> Either a b
Left ()
instance Response StateService where
    getResponse :: Either StateService (Word16, Int, Get StateService)
getResponse = (Word16, Int, Get StateService)
-> Either StateService (Word16, Int, Get StateService)
forall a b. b -> Either a b
Right ((Word16, Int, Get StateService)
 -> Either StateService (Word16, Int, Get StateService))
-> (Word16, Int, Get StateService)
-> Either StateService (Word16, Int, Get StateService)
forall a b. (a -> b) -> a -> b
$ (Word16
3,Int
5,) do
        Service
service <-
            Get Word8
getWord8 Get Word8 -> (Word8 -> Get Service) -> Get Service
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Word8
1 -> Service -> Get Service
forall (f :: * -> *) a. Applicative f => a -> f a
pure Service
ServiceUDP
                Word8
2 -> Service -> Get Service
forall (f :: * -> *) a. Applicative f => a -> f a
pure Service
ServiceReserved1
                Word8
3 -> Service -> Get Service
forall (f :: * -> *) a. Applicative f => a -> f a
pure Service
ServiceReserved2
                Word8
4 -> Service -> Get Service
forall (f :: * -> *) a. Applicative f => a -> f a
pure Service
ServiceReserved3
                Word8
5 -> Service -> Get Service
forall (f :: * -> *) a. Applicative f => a -> f a
pure Service
ServiceReserved4
                Word8
n -> String -> Get Service
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Service) -> String -> Get Service
forall a b. (a -> b) -> a -> b
$ String
"unknown service: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
n
        HostAddress
port <- Get HostAddress
getWord32le
        StateService -> Get StateService
forall (f :: * -> *) a. Applicative f => a -> f a
pure StateService :: Service -> HostAddress -> StateService
StateService{HostAddress
Service
port :: HostAddress
service :: Service
$sel:port:StateService :: HostAddress
$sel:service:StateService :: Service
..}
instance Response LightState where
    getResponse :: Either LightState (Word16, Int, Get LightState)
getResponse = (Word16, Int, Get LightState)
-> Either LightState (Word16, Int, Get LightState)
forall a b. b -> Either a b
Right ((Word16, Int, Get LightState)
 -> Either LightState (Word16, Int, Get LightState))
-> (Word16, Int, Get LightState)
-> Either LightState (Word16, Int, Get LightState)
forall a b. (a -> b) -> a -> b
$ (Word16
107,Int
52,) do
        HSBK
hsbk <- Word16 -> Word16 -> Word16 -> Word16 -> HSBK
HSBK (Word16 -> Word16 -> Word16 -> Word16 -> HSBK)
-> Get Word16 -> Get (Word16 -> Word16 -> Word16 -> HSBK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le Get (Word16 -> Word16 -> Word16 -> HSBK)
-> Get Word16 -> Get (Word16 -> Word16 -> HSBK)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16le Get (Word16 -> Word16 -> HSBK)
-> Get Word16 -> Get (Word16 -> HSBK)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16le Get (Word16 -> HSBK) -> Get Word16 -> Get HSBK
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
        ByteString
label <- (Word8 -> Bool) -> ByteString -> ByteString
BS.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) (ByteString -> ByteString) -> Get ByteString -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
32
        Int -> Get ()
skip Int
8
        LightState -> Get LightState
forall (f :: * -> *) a. Applicative f => a -> f a
pure LightState :: HSBK -> Word16 -> ByteString -> LightState
LightState{Word16
ByteString
HSBK
label :: ByteString
power :: Word16
hsbk :: HSBK
$sel:label:LightState :: ByteString
$sel:power:LightState :: Word16
$sel:hsbk:LightState :: HSBK
..}
instance Response StatePower where
    getResponse :: Either StatePower (Word16, Int, Get StatePower)
getResponse =
        (Word16, Int, Get StatePower)
-> Either StatePower (Word16, Int, Get StatePower)
forall a b. b -> Either a b
Right ((Word16, Int, Get StatePower)
 -> Either StatePower (Word16, Int, Get StatePower))
-> (Get StatePower -> (Word16, Int, Get StatePower))
-> Get StatePower
-> Either StatePower (Word16, Int, Get StatePower)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16
22,Int
2,) (Get StatePower -> Either StatePower (Word16, Int, Get StatePower))
-> Get StatePower
-> Either StatePower (Word16, Int, Get StatePower)
forall a b. (a -> b) -> a -> b
$
            Word16 -> StatePower
StatePower (Word16 -> StatePower) -> Get Word16 -> Get StatePower
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le

-- | Seeing as all `Message` response types are instances of `Response`, we can hide that type class from users.
getResponse' :: Message a -> Either a (Word16, Int, Get a)
getResponse' :: Message a -> Either a (Word16, Int, Get a)
getResponse' = \case
    GetService{} -> Either a (Word16, Int, Get a)
forall a. Response a => Either a (Word16, Int, Get a)
getResponse
    GetPower{} -> Either a (Word16, Int, Get a)
forall a. Response a => Either a (Word16, Int, Get a)
getResponse
    SetPower{} -> Either a (Word16, Int, Get a)
forall a. Response a => Either a (Word16, Int, Get a)
getResponse
    GetColor{} -> Either a (Word16, Int, Get a)
forall a. Response a => Either a (Word16, Int, Get a)
getResponse
    SetColor{} -> Either a (Word16, Int, Get a)
forall a. Response a => Either a (Word16, Int, Get a)
getResponse
    SetLightPower{} -> Either a (Word16, Int, Get a)
forall a. Response a => Either a (Word16, Int, Get a)
getResponse

{- Monad -}

type Lifx = LifxT IO
newtype LifxT m a = LifxT
    { LifxT m a
-> StateT
     Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
unLifxT ::
        StateT
            Word8
            ( ReaderT
                (Socket, Word32, Int)
                ( ExceptT
                    LifxError
                    m
                )
            )
            a
    }
    deriving newtype
        ( a -> LifxT m b -> LifxT m a
(a -> b) -> LifxT m a -> LifxT m b
(forall a b. (a -> b) -> LifxT m a -> LifxT m b)
-> (forall a b. a -> LifxT m b -> LifxT m a) -> Functor (LifxT m)
forall a b. a -> LifxT m b -> LifxT m a
forall a b. (a -> b) -> LifxT m a -> LifxT m b
forall (m :: * -> *) a b. Functor m => a -> LifxT m b -> LifxT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> LifxT m a -> LifxT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> LifxT m b -> LifxT m a
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> LifxT m b -> LifxT m a
fmap :: (a -> b) -> LifxT m a -> LifxT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> LifxT m a -> LifxT m b
Functor
        , Functor (LifxT m)
a -> LifxT m a
Functor (LifxT m)
-> (forall a. a -> LifxT m a)
-> (forall a b. LifxT m (a -> b) -> LifxT m a -> LifxT m b)
-> (forall a b c.
    (a -> b -> c) -> LifxT m a -> LifxT m b -> LifxT m c)
-> (forall a b. LifxT m a -> LifxT m b -> LifxT m b)
-> (forall a b. LifxT m a -> LifxT m b -> LifxT m a)
-> Applicative (LifxT m)
LifxT m a -> LifxT m b -> LifxT m b
LifxT m a -> LifxT m b -> LifxT m a
LifxT m (a -> b) -> LifxT m a -> LifxT m b
(a -> b -> c) -> LifxT m a -> LifxT m b -> LifxT m c
forall a. a -> LifxT m a
forall a b. LifxT m a -> LifxT m b -> LifxT m a
forall a b. LifxT m a -> LifxT m b -> LifxT m b
forall a b. LifxT m (a -> b) -> LifxT m a -> LifxT m b
forall a b c. (a -> b -> c) -> LifxT m a -> LifxT m b -> LifxT m c
forall (m :: * -> *). Monad m => Functor (LifxT m)
forall (m :: * -> *) a. Monad m => a -> LifxT m a
forall (m :: * -> *) a b.
Monad m =>
LifxT m a -> LifxT m b -> LifxT m a
forall (m :: * -> *) a b.
Monad m =>
LifxT m a -> LifxT m b -> LifxT m b
forall (m :: * -> *) a b.
Monad m =>
LifxT m (a -> b) -> LifxT m a -> LifxT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> LifxT m a -> LifxT m b -> LifxT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: LifxT m a -> LifxT m b -> LifxT m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
LifxT m a -> LifxT m b -> LifxT m a
*> :: LifxT m a -> LifxT m b -> LifxT m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
LifxT m a -> LifxT m b -> LifxT m b
liftA2 :: (a -> b -> c) -> LifxT m a -> LifxT m b -> LifxT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> LifxT m a -> LifxT m b -> LifxT m c
<*> :: LifxT m (a -> b) -> LifxT m a -> LifxT m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
LifxT m (a -> b) -> LifxT m a -> LifxT m b
pure :: a -> LifxT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> LifxT m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (LifxT m)
Applicative
        , Applicative (LifxT m)
a -> LifxT m a
Applicative (LifxT m)
-> (forall a b. LifxT m a -> (a -> LifxT m b) -> LifxT m b)
-> (forall a b. LifxT m a -> LifxT m b -> LifxT m b)
-> (forall a. a -> LifxT m a)
-> Monad (LifxT m)
LifxT m a -> (a -> LifxT m b) -> LifxT m b
LifxT m a -> LifxT m b -> LifxT m b
forall a. a -> LifxT m a
forall a b. LifxT m a -> LifxT m b -> LifxT m b
forall a b. LifxT m a -> (a -> LifxT m b) -> LifxT m b
forall (m :: * -> *). Monad m => Applicative (LifxT m)
forall (m :: * -> *) a. Monad m => a -> LifxT m a
forall (m :: * -> *) a b.
Monad m =>
LifxT m a -> LifxT m b -> LifxT m b
forall (m :: * -> *) a b.
Monad m =>
LifxT m a -> (a -> LifxT m b) -> LifxT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> LifxT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> LifxT m a
>> :: LifxT m a -> LifxT m b -> LifxT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
LifxT m a -> LifxT m b -> LifxT m b
>>= :: LifxT m a -> (a -> LifxT m b) -> LifxT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
LifxT m a -> (a -> LifxT m b) -> LifxT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (LifxT m)
Monad
        , Monad (LifxT m)
Monad (LifxT m)
-> (forall a. IO a -> LifxT m a) -> MonadIO (LifxT m)
IO a -> LifxT m a
forall a. IO a -> LifxT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (LifxT m)
forall (m :: * -> *) a. MonadIO m => IO a -> LifxT m a
liftIO :: IO a -> LifxT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> LifxT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (LifxT m)
MonadIO
        )

{- | Note that this throws 'LifxError's as 'IOException's, and sets timeout to 5 seconds.
Use 'runLifxT' for more control.
-}
runLifx :: Lifx a -> IO a
runLifx :: Lifx a -> IO a
runLifx Lifx a
m =
    Int -> Lifx a -> IO (Either LifxError a)
forall (m :: * -> *) a.
MonadIO m =>
Int -> LifxT m a -> m (Either LifxError a)
runLifxT Int
5_000_000 Lifx a
m IO (Either LifxError a) -> (Either LifxError a -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left LifxError
e ->
            IOError -> IO a
forall a. IOError -> IO a
ioError
                IOError :: Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOError
IOError
                    { ioe_handle :: Maybe Handle
ioe_handle = Maybe Handle
forall a. Maybe a
Nothing
                    , ioe_type :: IOErrorType
ioe_type = IOErrorType
OtherError
                    , ioe_location :: String
ioe_location = String
"LIFX"
                    , ioe_description :: String
ioe_description = LifxError -> String
forall a. Show a => a -> String
show LifxError
e
                    , ioe_errno :: Maybe CInt
ioe_errno = Maybe CInt
forall a. Maybe a
Nothing
                    , ioe_filename :: Maybe String
ioe_filename = Maybe String
forall a. Maybe a
Nothing
                    }
        Right a
x -> a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

runLifxT :: MonadIO m => Int -> LifxT m a -> m (Either LifxError a)
runLifxT :: 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 <- IO Socket -> m Socket
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Socket -> m Socket) -> IO Socket -> m Socket
forall a b. (a -> b) -> a -> b
$ Family -> SocketType -> CInt -> IO Socket
socket Family
AF_INET SocketType
Datagram CInt
defaultProtocol
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Socket -> SocketOption -> Int -> IO ()
setSocketOption Socket
sock SocketOption
Broadcast Int
1
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (SockAddr -> IO ()) -> SockAddr -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Socket -> SockAddr -> IO ()
bind Socket
sock (SockAddr -> m ()) -> SockAddr -> m ()
forall a b. (a -> b) -> a -> b
$ PortNumber -> HostAddress -> SockAddr
SockAddrInet PortNumber
defaultPort HostAddress
0
    HostAddress
source <- m HostAddress
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
    ExceptT LifxError m a -> m (Either LifxError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT LifxError m a -> m (Either LifxError a))
-> ExceptT LifxError m a -> m (Either LifxError a)
forall a b. (a -> b) -> a -> b
$ ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m) a
-> (Socket, HostAddress, Int) -> ExceptT LifxError m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (StateT
  Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> Word8
-> ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m) a
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 MonadIO m => MonadLifx m where
    getSocket :: m Socket
    getSource :: m Word32
    getTimeout :: m Int
    incrementCounter :: m ()
    getCounter :: m Word8
    lifxThrow :: LifxError -> m a
    handleOldMessage ::
        -- | expected counter value
        Word8 ->
        -- | actual counter value
        Word8 ->
        -- | packet type
        Word16 ->
        -- | payload
        BL.ByteString ->
        m ()
    handleOldMessage Word8
_ Word8
_ Word16
_ ByteString
_ = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
instance MonadIO m => MonadLifx (LifxT m) where
    getSocket :: LifxT m Socket
getSocket = StateT
  Word8
  (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
  Socket
-> LifxT m Socket
forall (m :: * -> *) a.
StateT
  Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
LifxT (StateT
   Word8
   (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
   Socket
 -> LifxT m Socket)
-> StateT
     Word8
     (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
     Socket
-> LifxT m Socket
forall a b. (a -> b) -> a -> b
$ ((Socket, HostAddress, Int) -> Socket)
-> StateT
     Word8
     (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
     Socket
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Socket, HostAddress, Int) -> Socket
forall a b c. (a, b, c) -> a
fst3
    getSource :: LifxT m HostAddress
getSource = StateT
  Word8
  (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
  HostAddress
-> LifxT m HostAddress
forall (m :: * -> *) a.
StateT
  Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
LifxT (StateT
   Word8
   (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
   HostAddress
 -> LifxT m HostAddress)
-> StateT
     Word8
     (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
     HostAddress
-> LifxT m HostAddress
forall a b. (a -> b) -> a -> b
$ ((Socket, HostAddress, Int) -> HostAddress)
-> StateT
     Word8
     (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
     HostAddress
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Socket, HostAddress, Int) -> HostAddress
forall a b c. (a, b, c) -> b
snd3
    getTimeout :: LifxT m Int
getTimeout = StateT
  Word8
  (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
  Int
-> LifxT m Int
forall (m :: * -> *) a.
StateT
  Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
LifxT (StateT
   Word8
   (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
   Int
 -> LifxT m Int)
-> StateT
     Word8
     (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
     Int
-> LifxT m Int
forall a b. (a -> b) -> a -> b
$ ((Socket, HostAddress, Int) -> Int)
-> StateT
     Word8
     (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
     Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Socket, HostAddress, Int) -> Int
forall a b c. (a, b, c) -> c
thd3
    incrementCounter :: LifxT m ()
incrementCounter = StateT
  Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) ()
-> LifxT m ()
forall (m :: * -> *) a.
StateT
  Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
LifxT (StateT
   Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) ()
 -> LifxT m ())
-> StateT
     Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) ()
-> LifxT m ()
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word8)
-> StateT
     Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify Word8 -> Word8
forall a. (Eq a, Bounded a, Enum a) => a -> a
succ'
    getCounter :: LifxT m Word8
getCounter = StateT
  Word8
  (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
  Word8
-> LifxT m Word8
forall (m :: * -> *) a.
StateT
  Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
LifxT (StateT
   Word8
   (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
   Word8
 -> LifxT m Word8)
-> StateT
     Word8
     (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
     Word8
-> LifxT m Word8
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word8)
-> StateT
     Word8
     (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m))
     Word8
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Word8 -> Word8
forall a. a -> a
id
    lifxThrow :: LifxError -> LifxT m a
lifxThrow = StateT
  Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
forall (m :: * -> *) a.
StateT
  Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
-> LifxT m a
LifxT (StateT
   Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
 -> LifxT m a)
-> (LifxError
    -> StateT
         Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a)
-> LifxError
-> LifxT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LifxError
-> StateT
     Word8 (ReaderT (Socket, HostAddress, Int) (ExceptT LifxError m)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
instance MonadLifx m => MonadLifx (MaybeT m) where
    getSocket :: MaybeT m Socket
getSocket = m Socket -> MaybeT m Socket
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Socket
forall (m :: * -> *). MonadLifx m => m Socket
getSocket
    getSource :: MaybeT m HostAddress
getSource = m HostAddress -> MaybeT m HostAddress
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HostAddress
forall (m :: * -> *). MonadLifx m => m HostAddress
getSource
    getTimeout :: MaybeT m Int
getTimeout = m Int -> MaybeT m Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Int
forall (m :: * -> *). MonadLifx m => m Int
getTimeout
    incrementCounter :: MaybeT m ()
incrementCounter = m () -> MaybeT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
forall (m :: * -> *). MonadLifx m => m ()
incrementCounter
    getCounter :: MaybeT m Word8
getCounter = m Word8 -> MaybeT m Word8
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Word8
forall (m :: * -> *). MonadLifx m => m Word8
getCounter
    lifxThrow :: LifxError -> MaybeT m a
lifxThrow = m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> MaybeT m a)
-> (LifxError -> m a) -> LifxError -> MaybeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LifxError -> m a
forall (m :: * -> *) a. MonadLifx m => LifxError -> m a
lifxThrow
instance MonadLifx m => MonadLifx (ExceptT e m) where
    getSocket :: ExceptT e m Socket
getSocket = m Socket -> ExceptT e m Socket
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Socket
forall (m :: * -> *). MonadLifx m => m Socket
getSocket
    getSource :: ExceptT e m HostAddress
getSource = m HostAddress -> ExceptT e m HostAddress
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HostAddress
forall (m :: * -> *). MonadLifx m => m HostAddress
getSource
    getTimeout :: ExceptT e m Int
getTimeout = m Int -> ExceptT e m Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Int
forall (m :: * -> *). MonadLifx m => m Int
getTimeout
    incrementCounter :: ExceptT e m ()
incrementCounter = m () -> ExceptT e m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
forall (m :: * -> *). MonadLifx m => m ()
incrementCounter
    getCounter :: ExceptT e m Word8
getCounter = m Word8 -> ExceptT e m Word8
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Word8
forall (m :: * -> *). MonadLifx m => m Word8
getCounter
    lifxThrow :: LifxError -> ExceptT e m a
lifxThrow = m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ExceptT e m a)
-> (LifxError -> m a) -> LifxError -> ExceptT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LifxError -> m a
forall (m :: * -> *) a. MonadLifx m => LifxError -> m a
lifxThrow
instance MonadLifx m => MonadLifx (StateT s m) where
    getSocket :: StateT s m Socket
getSocket = m Socket -> StateT s m Socket
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Socket
forall (m :: * -> *). MonadLifx m => m Socket
getSocket
    getSource :: StateT s m HostAddress
getSource = m HostAddress -> StateT s m HostAddress
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HostAddress
forall (m :: * -> *). MonadLifx m => m HostAddress
getSource
    getTimeout :: StateT s m Int
getTimeout = m Int -> StateT s m Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Int
forall (m :: * -> *). MonadLifx m => m Int
getTimeout
    incrementCounter :: StateT s m ()
incrementCounter = m () -> StateT s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
forall (m :: * -> *). MonadLifx m => m ()
incrementCounter
    getCounter :: StateT s m Word8
getCounter = m Word8 -> StateT s m Word8
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Word8
forall (m :: * -> *). MonadLifx m => m Word8
getCounter
    lifxThrow :: LifxError -> StateT s m a
lifxThrow = m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT s m a)
-> (LifxError -> m a) -> LifxError -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LifxError -> m a
forall (m :: * -> *) a. MonadLifx m => LifxError -> m a
lifxThrow
instance MonadLifx m => MonadLifx (ReaderT e m) where
    getSocket :: ReaderT e m Socket
getSocket = m Socket -> ReaderT e m Socket
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Socket
forall (m :: * -> *). MonadLifx m => m Socket
getSocket
    getSource :: ReaderT e m HostAddress
getSource = m HostAddress -> ReaderT e m HostAddress
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m HostAddress
forall (m :: * -> *). MonadLifx m => m HostAddress
getSource
    getTimeout :: ReaderT e m Int
getTimeout = m Int -> ReaderT e m Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Int
forall (m :: * -> *). MonadLifx m => m Int
getTimeout
    incrementCounter :: ReaderT e m ()
incrementCounter = m () -> ReaderT e m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
forall (m :: * -> *). MonadLifx m => m ()
incrementCounter
    getCounter :: ReaderT e m Word8
getCounter = m Word8 -> ReaderT e m Word8
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Word8
forall (m :: * -> *). MonadLifx m => m Word8
getCounter
    lifxThrow :: LifxError -> ReaderT e m a
lifxThrow = m a -> ReaderT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT e m a)
-> (LifxError -> m a) -> LifxError -> ReaderT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LifxError -> m a
forall (m :: * -> *) a. MonadLifx m => LifxError -> m a
lifxThrow

{- Low level -}

encodeMessage :: Bool -> Bool -> Word8 -> Word32 -> Message a -> BL.ByteString
encodeMessage :: Bool -> Bool -> Word8 -> HostAddress -> Message a -> ByteString
encodeMessage Bool
tagged Bool
ackRequired Word8
sequenceCounter HostAddress
source Message a
msg =
    Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Header -> Put
forall t. Binary t => t -> Put
put (Bool -> Bool -> Word8 -> HostAddress -> Message a -> Header
forall a.
Bool -> Bool -> Word8 -> HostAddress -> Message a -> Header
messageHeader Bool
tagged Bool
ackRequired Word8
sequenceCounter HostAddress
source Message a
msg) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Message a -> Put
forall a. Message a -> Put
putMessagePayload Message a
msg

-- | https://lan.developer.lifx.com/docs/encoding-a-packet
data Header = Header
    { Header -> Word16
size :: Word16
    , Header -> Word16
protocol :: Word16
    , Header -> Bool
addressable :: Bool
    , Header -> Bool
tagged :: Bool
    , Header -> Word8
origin :: Word8
    , Header -> HostAddress
source :: Word32
    , Header -> Word64
target :: Word64
    , Header -> Bool
resRequired :: Bool
    , Header -> Bool
ackRequired :: Bool
    , Header -> Word8
sequenceCounter :: Word8
    , Header -> Word16
packetType :: Word16
    }
    deriving (Header -> Header -> Bool
(Header -> Header -> Bool)
-> (Header -> Header -> Bool) -> Eq Header
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
Eq Header
-> (Header -> Header -> Ordering)
-> (Header -> Header -> Bool)
-> (Header -> Header -> Bool)
-> (Header -> Header -> Bool)
-> (Header -> Header -> Bool)
-> (Header -> Header -> Header)
-> (Header -> Header -> Header)
-> Ord 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
$cp1Ord :: Eq Header
Ord, Int -> Header -> ShowS
[Header] -> ShowS
Header -> String
(Int -> Header -> ShowS)
-> (Header -> String) -> ([Header] -> ShowS) -> Show Header
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. Header -> Rep Header x)
-> (forall x. Rep Header x -> Header) -> Generic Header
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 = (Word16 -> Int -> Word16) -> Int -> Word16 -> Word16
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
clearBit Int
12 (Word16 -> Word16) -> (Word16 -> Word16) -> Word16 -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16 -> Int -> Word16) -> Int -> Word16 -> Word16
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
clearBit Int
13 (Word16 -> Word16) -> (Word16 -> Word16) -> Word16 -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16 -> Int -> Word16) -> Int -> Word16 -> Word16
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
clearBit Int
14 (Word16 -> Word16) -> (Word16 -> Word16) -> Word16 -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16 -> Int -> Word16) -> Int -> Word16 -> Word16
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
clearBit Int
15 (Word16 -> Word16) -> Word16 -> Word16
forall a b. (a -> b) -> a -> b
$ Word16
protBytes
            addressable :: Bool
addressable = Word16 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word16
protBytes Int
12
            tagged :: Bool
tagged = Word16 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word16
protBytes Int
13
            origin :: Word8
origin = (if Word16 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word16
protBytes Int
14 then Word8
0 else Word8
1) Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ (if Word16 -> Int -> Bool
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 = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
resAckByte Int
0
            ackRequired :: Bool
ackRequired = Word8 -> Int -> Bool
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
        Header -> Get Header
forall (f :: * -> *) a. Applicative f => a -> f a
pure Header :: Word16
-> Word16
-> Bool
-> Bool
-> Word8
-> HostAddress
-> Word64
-> Bool
-> Bool
-> Word8
-> Word16
-> Header
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 (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$
            Word16
protocol
                Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Bool -> Int -> Word16
forall p. Bits p => Bool -> Int -> p
bitIf Bool
addressable Int
12
                Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Bool -> Int -> Word16
forall p. Bits p => Bool -> Int -> p
bitIf Bool
tagged Int
13
                Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Bool -> Int -> Word16
forall p. Bits p => Bool -> Int -> p
bitIf (Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
origin Int
0) Int
14
                Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Bool -> Int -> Word16
forall p. Bits p => Bool -> Int -> p
bitIf (Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
origin Int
1) Int
15
        HostAddress -> Put
putWord32le HostAddress
source
        Word64 -> Put
putWord64be Word64
target
        Int -> Put -> Put
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
6 (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ Word8 -> Put
putWord8 Word8
0
        Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$
            Word8
forall a. Bits a => a
zeroBits
                Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Bool -> Int -> Word8
forall p. Bits p => Bool -> Int -> p
bitIf Bool
resRequired Int
0
                Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Bool -> Int -> Word8
forall p. Bits p => Bool -> Int -> p
bitIf Bool
ackRequired Int
1
        Word8 -> Put
putWord8 Word8
sequenceCounter
        Int -> Put -> Put
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
8 (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ Word8 -> Put
putWord8 Word8
0
        Word16 -> Put
putWord16le Word16
packetType
        Int -> Put -> Put
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
2 (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ Word8 -> Put
putWord8 Word8
0
      where
        bitIf :: Bool -> Int -> p
bitIf Bool
b Int
n = if Bool
b then Int -> p
forall a. Bits a => Int -> a
bit Int
n else p
forall a. Bits a => a
zeroBits

messageHeader :: Bool -> Bool -> Word8 -> Word32 -> Message a -> Header
messageHeader :: Bool -> Bool -> Word8 -> HostAddress -> Message a -> Header
messageHeader Bool
tagged Bool
ackRequired Word8
sequenceCounter HostAddress
source = \case
    GetService{} ->
        Header :: Word16
-> Word16
-> Bool
-> Bool
-> Word8
-> HostAddress
-> Word64
-> Bool
-> Bool
-> Word8
-> Word16
-> Header
Header
            { $sel:size:Header :: Word16
size = Word16
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
..
            }
    GetPower{} ->
        Header :: Word16
-> Word16
-> Bool
-> Bool
-> Word8
-> HostAddress
-> Word64
-> Bool
-> Bool
-> Word8
-> Word16
-> Header
Header
            { $sel:size:Header :: Word16
size = Word16
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 :: Word16
-> Word16
-> Bool
-> Bool
-> Word8
-> HostAddress
-> Word64
-> Bool
-> Bool
-> Word8
-> Word16
-> Header
Header
            { $sel:size:Header :: Word16
size = Word16
forall a. Num a => a
headerSize Word16 -> Word16 -> Word16
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
..
            }
    GetColor{} ->
        Header :: Word16
-> Word16
-> Bool
-> Bool
-> Word8
-> HostAddress
-> Word64
-> Bool
-> Bool
-> Word8
-> Word16
-> Header
Header
            { $sel:size:Header :: Word16
size = Word16
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 :: Word16
-> Word16
-> Bool
-> Bool
-> Word8
-> HostAddress
-> Word64
-> Bool
-> Bool
-> Word8
-> Word16
-> Header
Header
            { $sel:size:Header :: Word16
size = Word16
forall a. Num a => a
headerSize Word16 -> Word16 -> Word16
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 :: Word16
-> Word16
-> Bool
-> Bool
-> Word8
-> HostAddress
-> Word64
-> Bool
-> Bool
-> Word8
-> Word16
-> Header
Header
            { $sel:size:Header :: Word16
size = Word16
forall a. Num a => a
headerSize Word16 -> Word16 -> Word16
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 a -> Put
putMessagePayload :: Message a -> Put
putMessagePayload = \case
    Message a
GetService -> Put
forall a. Monoid a => a
mempty
    Message a
GetPower -> Put
forall a. Monoid a => a
mempty
    SetPower Bool
b ->
        Word16 -> Put
putWord16le if Bool
b then Word16
forall a. Bounded a => a
maxBound else Word16
forall a. Bounded a => a
minBound
    Message a
GetColor -> Put
forall a. Monoid a => a
mempty
    SetColor HSBK{Word16
kelvin :: Word16
brightness :: Word16
saturation :: Word16
hue :: Word16
$sel:kelvin:HSBK :: HSBK -> Word16
$sel:brightness:HSBK :: HSBK -> Word16
$sel:saturation:HSBK :: HSBK -> Word16
$sel:hue:HSBK :: HSBK -> Word16
..} (Duration HostAddress
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 HostAddress
d
    SetLightPower Bool
b (Duration HostAddress
d) -> do
        Word16 -> Put
putWord16le if Bool
b then Word16
forall a. Bounded a => a
maxBound else Word16
forall a. Bounded a => a
minBound
        HostAddress -> Put
putWord32le HostAddress
d

{- Util -}

-- | Safe, wraparound variant of 'succ'.
succ' :: (Eq a, Bounded a, Enum a) => a -> a
succ' :: a -> a
succ' a
e
    | a
e a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Bounded a => a
maxBound = a
forall a. Bounded a => a
minBound
    | Bool
otherwise = a -> a
forall a. Enum a => a -> a
succ a
e

headerSize :: Num a => a
headerSize :: a
headerSize = a
36

-- | For use with 'timeout', 'threadDelay' etc.
nominalDiffTimeToMicroSeconds :: NominalDiffTime -> Int
nominalDiffTimeToMicroSeconds :: NominalDiffTime -> Int
nominalDiffTimeToMicroSeconds NominalDiffTime
t = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Integer
p Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
1_000_000
  where
    MkFixed Integer
p = NominalDiffTime -> Fixed E12
nominalDiffTimeToSeconds NominalDiffTime
t

-- | Inverted 'whileM'.
untilM :: Monad m => m Bool -> m ()
untilM :: m Bool -> m ()
untilM = m Bool -> m ()
forall (m :: * -> *). Monad m => m Bool -> m ()
whileM (m Bool -> m ()) -> (m Bool -> m Bool) -> m Bool -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not

checkPort :: MonadLifx f => PortNumber -> f ()
checkPort :: PortNumber -> f ()
checkPort PortNumber
port = Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PortNumber
port PortNumber -> PortNumber -> Bool
forall a. Eq a => a -> a -> Bool
/= PortNumber -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral PortNumber
lifxPort) (f () -> f ()) -> (LifxError -> f ()) -> LifxError -> f ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LifxError -> f ()
forall (m :: * -> *) a. MonadLifx m => LifxError -> m a
lifxThrow (LifxError -> f ()) -> LifxError -> f ()
forall a b. (a -> b) -> a -> b
$ PortNumber -> LifxError
UnexpectedPort PortNumber
port

-- these helpers are all used by 'sendMessage' and 'broadcastMessage'
decodeMessage :: MonadLifx m => Get b -> Word16 -> BS.ByteString -> m (Maybe b) -- Nothing means counter didnt match
decodeMessage :: Get b -> Word16 -> ByteString -> m (Maybe b)
decodeMessage Get b
getBody Word16
expectedPacketType ByteString
bs = do
    Word8
counter <- m Word8
forall (m :: * -> *). MonadLifx m => m Word8
getCounter
    case Get Header
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, Header)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail Get Header
forall t. Binary t => Get t
get (ByteString
 -> Either
      (ByteString, ByteOffset, String) (ByteString, ByteOffset, Header))
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, Header)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.fromStrict ByteString
bs of
        Left (ByteString, ByteOffset, String)
e -> (ByteString, ByteOffset, String) -> m (Maybe b)
forall (m :: * -> *) a.
MonadLifx 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 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
counter
                then Word8 -> Word8 -> Word16 -> ByteString -> m ()
forall (m :: * -> *).
MonadLifx m =>
Word8 -> Word8 -> Word16 -> ByteString -> m ()
handleOldMessage Word8
counter Word8
sequenceCounter Word16
packetType ByteString
bs' m () -> m (Maybe b) -> m (Maybe b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe b -> m (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing
                else do
                    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word16
packetType Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word16
expectedPacketType) (m () -> m ()) -> (LifxError -> m ()) -> LifxError -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LifxError -> m ()
forall (m :: * -> *) a. MonadLifx m => LifxError -> m a
lifxThrow (LifxError -> m ()) -> LifxError -> m ()
forall a b. (a -> b) -> a -> b
$ Word16 -> Word16 -> LifxError
WrongPacketType Word16
expectedPacketType Word16
packetType
                    case Get b
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, b)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail Get b
getBody ByteString
bs' of
                        Left (ByteString, ByteOffset, String)
e -> (ByteString, ByteOffset, String) -> m (Maybe b)
forall (m :: * -> *) a.
MonadLifx m =>
(ByteString, ByteOffset, String) -> m a
throwDecodeFailure (ByteString, ByteOffset, String)
e
                        Right (ByteString
_, ByteOffset
_, b
res) -> Maybe b -> m (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe b -> m (Maybe b)) -> Maybe b -> m (Maybe b)
forall a b. (a -> b) -> a -> b
$ b -> Maybe b
forall a. a -> Maybe a
Just b
res
  where
    throwDecodeFailure :: (ByteString, ByteOffset, String) -> m a
throwDecodeFailure (ByteString
bs', ByteOffset
bo, String
e) = LifxError -> m a
forall (m :: * -> *) a. MonadLifx m => LifxError -> m a
lifxThrow (LifxError -> m a) -> LifxError -> m a
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteOffset -> String -> LifxError
DecodeFailure (ByteString -> ByteString
BL.toStrict ByteString
bs') ByteOffset
bo String
e
sendMessage' :: MonadLifx m => Bool -> HostAddress -> Message a -> m ()
sendMessage' :: Bool -> HostAddress -> Message a -> m ()
sendMessage' Bool
tagged HostAddress
receiver Message a
msg = do
    Socket
sock <- m Socket
forall (m :: * -> *). MonadLifx m => m Socket
getSocket
    Word8
counter <- m Word8
forall (m :: * -> *). MonadLifx m => m Word8
getCounter
    HostAddress
source <- m HostAddress
forall (m :: * -> *). MonadLifx m => m HostAddress
getSource
    m Int -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Int -> m ()) -> (IO Int -> m Int) -> IO Int -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> m ()) -> IO Int -> m ()
forall a b. (a -> b) -> a -> b
$
        Socket -> ByteString -> SockAddr -> IO Int
sendTo
            Socket
sock
            (ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Word8 -> HostAddress -> Message a -> ByteString
forall a.
Bool -> Bool -> Word8 -> HostAddress -> Message a -> ByteString
encodeMessage Bool
tagged Bool
False Word8
counter HostAddress
source Message a
msg)
            (PortNumber -> HostAddress -> SockAddr
SockAddrInet PortNumber
lifxPort HostAddress
receiver)
hostAddressFromSock :: MonadLifx m => SockAddr -> m HostAddress
hostAddressFromSock :: SockAddr -> m HostAddress
hostAddressFromSock = \case
    SockAddrInet PortNumber
port HostAddress
ha -> PortNumber -> m ()
forall (f :: * -> *). MonadLifx f => PortNumber -> f ()
checkPort PortNumber
port m () -> m HostAddress -> m HostAddress
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HostAddress -> m HostAddress
forall (f :: * -> *) a. Applicative f => a -> f a
pure HostAddress
ha
    SockAddr
addr -> LifxError -> m HostAddress
forall (m :: * -> *) a. MonadLifx m => LifxError -> m a
lifxThrow (LifxError -> m HostAddress) -> LifxError -> m HostAddress
forall a b. (a -> b) -> a -> b
$ SockAddr -> LifxError
UnexpectedSockAddrType SockAddr
addr
receiveMessage :: MonadLifx m => Int -> Int -> m (Maybe (BS.ByteString, SockAddr))
receiveMessage :: Int -> Int -> m (Maybe (ByteString, SockAddr))
receiveMessage Int
t Int
messageSize = do
    Socket
sock <- m Socket
forall (m :: * -> *). MonadLifx m => m Socket
getSocket
    IO (Maybe (ByteString, SockAddr))
-> m (Maybe (ByteString, SockAddr))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        (IO (Maybe (ByteString, SockAddr))
 -> m (Maybe (ByteString, SockAddr)))
-> (Int -> IO (Maybe (ByteString, SockAddr)))
-> Int
-> m (Maybe (ByteString, SockAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> IO (ByteString, SockAddr) -> IO (Maybe (ByteString, SockAddr))
forall a. Int -> IO a -> IO (Maybe a)
timeout Int
t
        (IO (ByteString, SockAddr) -> IO (Maybe (ByteString, SockAddr)))
-> (Int -> IO (ByteString, SockAddr))
-> Int
-> IO (Maybe (ByteString, SockAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Socket -> Int -> IO (ByteString, SockAddr)
recvFrom Socket
sock
        (Int -> m (Maybe (ByteString, SockAddr)))
-> Int -> m (Maybe (ByteString, SockAddr))
forall a b. (a -> b) -> a -> b
$ Int
forall a. Num a => a
headerSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
messageSize