lifx-lan 0.0 → 0.1.0.0
raw patch · 10 files changed
+107/−3140 lines, 10 filesdep −ansi-terminaldep −colourdep −transformersdep ~basedep ~bytestringdep ~time
Dependencies removed: ansi-terminal, colour, transformers
Dependency ranges changed: base, bytestring, time
Files
- CHANGELOG.md +2/−42
- README.md +3/−5
- lifx-lan.cabal +4/−25
- src/Lifx/Internal/Colour.hs +0/−50
- src/Lifx/Internal/Product.hs +0/−67
- src/Lifx/Internal/ProductInfo.hs +0/−2103
- src/Lifx/Internal/ProductInfoMap.hs +0/−90
- src/Lifx/Lan.hs +98/−557
- src/Lifx/Lan/Internal.hs +0/−100
- src/Lifx/Lan/Mock/Terminal.hs +0/−101
CHANGELOG.md view
@@ -1,45 +1,5 @@ # Revision history for lifx-lan -## 0.7 -- 2022-02-20-- Drop support for GHC < 9.2.- - If anyone is stuck on an older version of GHC and needs recent features of `lifx-lan` then please let me know. It would be reasonably easy to create a branch for it.-- No field selector functions are provided for any types. Using `OverloadedRecordDot` in client code is recommended. We still export `unLifxT` as a normal function, for backward compatibility.-- Much of the implementation detail of `LifxT` has been moved to `Lifx.Lan.Internal`.-- Add `Lifx.Lan.Mock.Terminal` module for testing programs without a physical LIFX device.-- Use `Text` rather than `ByteString` for `label` field of `LightState`.-- Rename `productId` field of `Product` to `id`.-- Update to latest products list.--## 0.6.2 -- 2022-02-02-- Update to latest products list.--## 0.6.1 -- 2022-02-01-- Update to latest products list.--## 0.6 -- 2021-12-23-- Refactor to expose lower-level product lookup functionality via `Lifx.Internal.ProductInfoMap`.-- To facilitate the above, modify `LifxError` slightly, with a new `ProductLookupError` type.--## 0.5.1 -- 2021-12-12-- Implement `getProductInfo`.-- Expose `LifxT` constructor.--## 0.5.0 -- 2021-08-01-- Fix bug which was causing broadcasting not to work with messages that expect no response.--## 0.4.0 -- 2021-07-30-- Use abstract Device type.-- Use more types from standard libraries where appropriate:- - PortNumber- - NominalDiffTime-- General cleanup and documentation improvements.--## 0.3.0 -- 2021-06-19-- Implement message broadcasting and device discovery.--## 0.2.0 -- 2021-06-18-- Enable querying state (colour or power level).- - Various breaking changes to enable this.+## 0.1.0.0 -- YYYY-mm-dd -## 0.1.0.2-- Basic. Only supports setting power and colour.+* First version. Released on an unsuspecting world.
README.md view
@@ -1,7 +1,5 @@-Haskell bindings to the [LIFX LAN API](https://lan.developer.lifx.com/docs).+Bindings to the LIFX LAN API. -This library provides a reasonably high-level interface, but doesn't try to be *too* clever.-For example, it doesn't check message delivery, and throws an error if a light takes too long to respond.-Messages and response types map directly to the low-level API (with links provided in the documentation).+Currently very basic. No error-handling, for example - we assume all UDP messages will send successfully. -It does not yet cover the full API, but PRs are very welcome and some functionality may be added on request.+Only supports setting power and colour.
lifx-lan.cabal view
@@ -1,37 +1,25 @@ cabal-version: 3.0 name: lifx-lan-version: 0.0+version: 0.1.0.0 license: BSD-3-Clause license-file: LICENSE author: George Thomas maintainer: georgefsthomas@gmail.com synopsis: LIFX LAN API-homepage: https://github.com/georgefst/lifx-lan extra-doc-files: CHANGELOG.md README.md-source-repository head- type: git- location: git://github.com/georgefst/lifx-lan.git library exposed-modules: Lifx.Lan- Lifx.Lan.Mock.Terminal- Lifx.Lan.Internal- Lifx.Internal.Colour- Lifx.Internal.Product- Lifx.Internal.ProductInfo- Lifx.Internal.ProductInfoMap hs-source-dirs: src ghc-options: -Wall build-depends:- base ^>= {4.16},- ansi-terminal ^>= 0.11.1,+ base ^>= 4.14, binary ^>= 0.8.8,- bytestring ^>= {0.10.8, 0.11},- colour ^>= 2.3.6,+ bytestring ^>= 0.10.8, composition ^>= 1.0.2.1, containers ^>= 0.6.2.1, extra ^>= 1.7.1,@@ -41,31 +29,23 @@ random ^>= 1.2.0, safe ^>= 0.3.19, text ^>= 1.2.3,- time ^>= {1.9.3, 1.10, 1.11, 1.12, 1.13},- transformers ^>= {0.5.6, 0.6},+ time ^>= 1.9.3, default-language: Haskell2010 default-extensions:- AllowAmbiguousTypes BlockArguments- ConstraintKinds- DefaultSignatures DeriveAnyClass DeriveFunctor DeriveGeneric DerivingStrategies DerivingVia- DuplicateRecordFields EmptyCase FlexibleContexts FlexibleInstances- GADTs GeneralizedNewtypeDeriving ImportQualifiedPost- ImpredicativeTypes LambdaCase MultiParamTypeClasses NamedFieldPuns- NoMonomorphismRestriction NumericUnderscores OverloadedLabels OverloadedStrings@@ -76,6 +56,5 @@ StandaloneDeriving TupleSections TypeApplications- TypeFamilies TypeOperators ViewPatterns
− src/Lifx/Internal/Colour.hs
@@ -1,50 +0,0 @@-module Lifx.Internal.Colour where--import Control.Applicative-import Data.Colour.SRGB-import Data.Ord-import Data.Word--import Data.Colour.RGBSpace.HSV (hsv)--import Lifx.Lan.Internal--{- |-Note that when 'kelvin' has an effect (i.e. when saturation is any less than maximum), output is somewhat arbitrary.--LIFX's team have never shared an exact forumla, and this implementation is inspired by various conflicting sources.--}-hsbkToRgb :: HSBK -> RGB Float-hsbkToRgb HSBK{..} =- interpolateColour- (fromIntegral saturation / maxWord16)- c- c'- where- c =- hsv- (360 * fromIntegral hue / maxWord16)- (fromIntegral saturation / maxWord16)- (fromIntegral brightness / maxWord16)- c' =- let t =- (log (fromIntegral kelvin) - log minKelvin)- / log (maxKelvin / minKelvin)- in clamp (0, 1)- <$> RGB- { channelRed = 1- , channelGreen = t / 2 + 0.5- , channelBlue = t- }--interpolateColour :: Num a => a -> RGB a -> RGB a -> RGB a-interpolateColour r = liftA2 (\a b -> a * (r + b * (1 - r)))--maxWord16 :: Float-maxWord16 = fromIntegral $ maxBound @Word16--minKelvin :: Num a => a-minKelvin = 1500--maxKelvin :: Num a => a-maxKelvin = 9000
− src/Lifx/Internal/Product.hs
@@ -1,67 +0,0 @@--- | An exact mapping of the types in LIFX's `products.json`. It's easier to just use 'Lifx.Lan.getProductInfo'.-module Lifx.Internal.Product where--import Data.Text (Text)-import Data.Word (Word16, Word32)-import GHC.Generics (Generic)--data VendorInfo = VendorInfo- { vid :: Word32- , name :: Text- , defaults :: Features- , products :: [ProductInfo]- }- deriving (Show)--data ProductInfo = ProductInfo- { pid :: Word32- , name :: Text- , features :: PartialFeatures- , upgrades :: [Upgrade]- }- deriving (Show)--data PartialFeatures = PartialFeatures- { hev :: Maybe Bool- , color :: Maybe Bool- , chain :: Maybe Bool- , matrix :: Maybe Bool- , relays :: Maybe Bool- , buttons :: Maybe Bool- , infrared :: Maybe Bool- , multizone :: Maybe Bool- , temperatureRange :: Maybe (Word16, Word16)- , extendedMultizone :: Maybe Bool- }- deriving (Show)--data Features = Features- { hev :: Bool- -- ^ The light supports emitting HEV light- , color :: Bool- -- ^ The light changes physical appearance when the Hue value is changed- , chain :: Bool- -- ^ The light may be connected to physically separated hardware (currently only the LIFX Tile)- , matrix :: Bool- -- ^ The light supports a 2D matrix of LEDs (the Tile and Candle)- , relays :: Bool- -- ^ The device has relays for controlling physical power to something (the LIFX Switch)- , buttons :: Bool- -- ^ The device has physical buttons to press (the LIFX Switch)- , infrared :: Bool- -- ^ The light supports emitting infrared light- , multizone :: Bool- -- ^ The light supports a 1D linear array of LEDs (the Z and Beam)- , temperatureRange :: Maybe (Word16, Word16)- -- ^ An array of the minimum and maximum kelvin values this device supports. If the numbers are the same then the device does not support variable kelvin values. It is null for devices that aren't lighting products (the LIFX Switch)- , extendedMultizone :: Bool- -- ^ The more capable extended API for multizone control that lets us control all the zones on the device with a single message instead of many.- }- deriving (Eq, Ord, Show, Generic)--data Upgrade = Upgrade- { major :: Word16- , minor :: Word16- , features :: PartialFeatures- }- deriving (Show)
− src/Lifx/Internal/ProductInfo.hs
@@ -1,2103 +0,0 @@--- | This is auto-generated - see the "product-gen" script.-module Lifx.Internal.ProductInfo where--import Lifx.Internal.Product--productInfo :: [VendorInfo]-productInfo =- [ VendorInfo- { vid = 1- , name = "LIFX"- , defaults = Features- { hev = False- , color = False- , chain = False- , matrix = False- , relays = False- , buttons = False- , infrared = False- , multizone = False- , temperatureRange = Nothing- , extendedMultizone = False- }- , products =- [ ProductInfo- { pid = 1- , name = "LIFX Original 1000"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 3- , name = "LIFX Color 650"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 10- , name = "LIFX White 800 (Low Voltage)"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2700- , 6500- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 11- , name = "LIFX White 800 (High Voltage)"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2700- , 6500- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 15- , name = "LIFX Color 1000"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 18- , name = "LIFX White 900 BR30 (Low Voltage)"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 19- , name = "LIFX White 900 BR30 (High Voltage)"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 20- , name = "LIFX Color 1000 BR30"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 22- , name = "LIFX Color 1000"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 27- , name = "LIFX A19"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades =- [ Upgrade- { major = 2- , minor = 80- , features = PartialFeatures- { hev = Nothing- , color = Nothing- , chain = Nothing- , matrix = Nothing- , relays = Nothing- , buttons = Nothing- , infrared = Nothing- , multizone = Nothing- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- }- ]- }- , ProductInfo- { pid = 28- , name = "LIFX BR30"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades =- [ Upgrade- { major = 2- , minor = 80- , features = PartialFeatures- { hev = Nothing- , color = Nothing- , chain = Nothing- , matrix = Nothing- , relays = Nothing- , buttons = Nothing- , infrared = Nothing- , multizone = Nothing- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- }- ]- }- , ProductInfo- { pid = 29- , name = "LIFX A19 Night Vision"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just True- , multizone = Just False- , temperatureRange = Just- ( 2500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades =- [ Upgrade- { major = 2- , minor = 80- , features = PartialFeatures- { hev = Nothing- , color = Nothing- , chain = Nothing- , matrix = Nothing- , relays = Nothing- , buttons = Nothing- , infrared = Nothing- , multizone = Nothing- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- }- ]- }- , ProductInfo- { pid = 30- , name = "LIFX BR30 Night Vision"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just True- , multizone = Just False- , temperatureRange = Just- ( 2500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades =- [ Upgrade- { major = 2- , minor = 80- , features = PartialFeatures- { hev = Nothing- , color = Nothing- , chain = Nothing- , matrix = Nothing- , relays = Nothing- , buttons = Nothing- , infrared = Nothing- , multizone = Nothing- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- }- ]- }- , ProductInfo- { pid = 31- , name = "LIFX Z"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just True- , temperatureRange = Just- ( 2500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 32- , name = "LIFX Z"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just True- , temperatureRange = Just- ( 2500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades =- [ Upgrade- { major = 2- , minor = 77- , features = PartialFeatures- { hev = Nothing- , color = Nothing- , chain = Nothing- , matrix = Nothing- , relays = Nothing- , buttons = Nothing- , infrared = Nothing- , multizone = Nothing- , temperatureRange = Nothing- , extendedMultizone = Just True- }- }- , Upgrade- { major = 2- , minor = 80- , features = PartialFeatures- { hev = Nothing- , color = Nothing- , chain = Nothing- , matrix = Nothing- , relays = Nothing- , buttons = Nothing- , infrared = Nothing- , multizone = Nothing- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- }- ]- }- , ProductInfo- { pid = 36- , name = "LIFX Downlight"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades =- [ Upgrade- { major = 2- , minor = 80- , features = PartialFeatures- { hev = Nothing- , color = Nothing- , chain = Nothing- , matrix = Nothing- , relays = Nothing- , buttons = Nothing- , infrared = Nothing- , multizone = Nothing- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- }- ]- }- , ProductInfo- { pid = 37- , name = "LIFX Downlight"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades =- [ Upgrade- { major = 2- , minor = 80- , features = PartialFeatures- { hev = Nothing- , color = Nothing- , chain = Nothing- , matrix = Nothing- , relays = Nothing- , buttons = Nothing- , infrared = Nothing- , multizone = Nothing- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- }- ]- }- , ProductInfo- { pid = 38- , name = "LIFX Beam"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just True- , temperatureRange = Just- ( 2500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades =- [ Upgrade- { major = 2- , minor = 77- , features = PartialFeatures- { hev = Nothing- , color = Nothing- , chain = Nothing- , matrix = Nothing- , relays = Nothing- , buttons = Nothing- , infrared = Nothing- , multizone = Nothing- , temperatureRange = Nothing- , extendedMultizone = Just True- }- }- , Upgrade- { major = 2- , minor = 80- , features = PartialFeatures- { hev = Nothing- , color = Nothing- , chain = Nothing- , matrix = Nothing- , relays = Nothing- , buttons = Nothing- , infrared = Nothing- , multizone = Nothing- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- }- ]- }- , ProductInfo- { pid = 39- , name = "LIFX Downlight White to Warm"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades =- [ Upgrade- { major = 2- , minor = 80- , features = PartialFeatures- { hev = Nothing- , color = Nothing- , chain = Nothing- , matrix = Nothing- , relays = Nothing- , buttons = Nothing- , infrared = Nothing- , multizone = Nothing- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- }- ]- }- , ProductInfo- { pid = 40- , name = "LIFX Downlight"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades =- [ Upgrade- { major = 2- , minor = 80- , features = PartialFeatures- { hev = Nothing- , color = Nothing- , chain = Nothing- , matrix = Nothing- , relays = Nothing- , buttons = Nothing- , infrared = Nothing- , multizone = Nothing- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- }- ]- }- , ProductInfo- { pid = 43- , name = "LIFX A19"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades =- [ Upgrade- { major = 2- , minor = 80- , features = PartialFeatures- { hev = Nothing- , color = Nothing- , chain = Nothing- , matrix = Nothing- , relays = Nothing- , buttons = Nothing- , infrared = Nothing- , multizone = Nothing- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- }- ]- }- , ProductInfo- { pid = 44- , name = "LIFX BR30"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades =- [ Upgrade- { major = 2- , minor = 80- , features = PartialFeatures- { hev = Nothing- , color = Nothing- , chain = Nothing- , matrix = Nothing- , relays = Nothing- , buttons = Nothing- , infrared = Nothing- , multizone = Nothing- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- }- ]- }- , ProductInfo- { pid = 45- , name = "LIFX A19 Night Vision"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just True- , multizone = Just False- , temperatureRange = Just- ( 2500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades =- [ Upgrade- { major = 2- , minor = 80- , features = PartialFeatures- { hev = Nothing- , color = Nothing- , chain = Nothing- , matrix = Nothing- , relays = Nothing- , buttons = Nothing- , infrared = Nothing- , multizone = Nothing- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- }- ]- }- , ProductInfo- { pid = 46- , name = "LIFX BR30 Night Vision"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just True- , multizone = Just False- , temperatureRange = Just- ( 2500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades =- [ Upgrade- { major = 2- , minor = 80- , features = PartialFeatures- { hev = Nothing- , color = Nothing- , chain = Nothing- , matrix = Nothing- , relays = Nothing- , buttons = Nothing- , infrared = Nothing- , multizone = Nothing- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- }- ]- }- , ProductInfo- { pid = 49- , name = "LIFX Mini Color"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 50- , name = "LIFX Mini White to Warm"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 6500- )- , extendedMultizone = Nothing- }- , upgrades =- [ Upgrade- { major = 3- , minor = 70- , features = PartialFeatures- { hev = Nothing- , color = Nothing- , chain = Nothing- , matrix = Nothing- , relays = Nothing- , buttons = Nothing- , infrared = Nothing- , multizone = Nothing- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- }- ]- }- , ProductInfo- { pid = 51- , name = "LIFX Mini White"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2700- , 2700- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 52- , name = "LIFX GU10"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 53- , name = "LIFX GU10"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 55- , name = "LIFX Tile"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just True- , matrix = Just True- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 57- , name = "LIFX Candle"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just True- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 59- , name = "LIFX Mini Color"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 60- , name = "LIFX Mini White to Warm"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 6500- )- , extendedMultizone = Nothing- }- , upgrades =- [ Upgrade- { major = 3- , minor = 70- , features = PartialFeatures- { hev = Nothing- , color = Nothing- , chain = Nothing- , matrix = Nothing- , relays = Nothing- , buttons = Nothing- , infrared = Nothing- , multizone = Nothing- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- }- ]- }- , ProductInfo- { pid = 61- , name = "LIFX Mini White"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2700- , 2700- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 62- , name = "LIFX A19"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 63- , name = "LIFX BR30"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 64- , name = "LIFX A19 Night Vision"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just True- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 65- , name = "LIFX BR30 Night Vision"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just True- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 66- , name = "LIFX Mini White"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2700- , 2700- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 68- , name = "LIFX Candle"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just True- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 70- , name = "LIFX Switch"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Just True- , buttons = Just True- , infrared = Just False- , multizone = Just False- , temperatureRange = Nothing- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 71- , name = "LIFX Switch"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Just True- , buttons = Just True- , infrared = Just False- , multizone = Just False- , temperatureRange = Nothing- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 81- , name = "LIFX Candle White to Warm"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2200- , 6500- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 82- , name = "LIFX Filament Clear"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2100- , 2100- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 85- , name = "LIFX Filament Amber"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2000- , 2000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 87- , name = "LIFX Mini White"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2700- , 2700- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 88- , name = "LIFX Mini White"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2700- , 2700- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 89- , name = "LIFX Switch"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Just True- , buttons = Just True- , infrared = Just False- , multizone = Just False- , temperatureRange = Nothing- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 90- , name = "LIFX Clean"- , features = PartialFeatures- { hev = Just True- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 91- , name = "LIFX Color"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 92- , name = "LIFX Color"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 93- , name = "LIFX A19 US"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 94- , name = "LIFX BR30"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 96- , name = "LIFX Candle White to Warm"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2200- , 6500- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 97- , name = "LIFX A19"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 98- , name = "LIFX BR30"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 99- , name = "LIFX Clean"- , features = PartialFeatures- { hev = Just True- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 100- , name = "LIFX Filament Clear"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2100- , 2100- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 101- , name = "LIFX Filament Amber"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2000- , 2000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 109- , name = "LIFX A19 Night Vision"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just True- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 110- , name = "LIFX BR30 Night Vision"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just True- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 111- , name = "LIFX A19 Night Vision"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just True- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 112- , name = "LIFX BR30 Night Vision Intl"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just True- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 113- , name = "LIFX Mini WW US"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 114- , name = "LIFX Mini WW Intl"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 115- , name = "LIFX Switch"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Just True- , buttons = Just True- , infrared = Just False- , multizone = Just False- , temperatureRange = Nothing- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 116- , name = "LIFX Switch"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Just True- , buttons = Just True- , infrared = Just False- , multizone = Just False- , temperatureRange = Nothing- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 117- , name = "LIFX Z US"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just True- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Just True- }- , upgrades = []- }- , ProductInfo- { pid = 118- , name = "LIFX Z Intl"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just True- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Just True- }- , upgrades = []- }- , ProductInfo- { pid = 119- , name = "LIFX Beam US"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just True- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Just True- }- , upgrades = []- }- , ProductInfo- { pid = 120- , name = "LIFX Beam Intl"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just True- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Just True- }- , upgrades = []- }- , ProductInfo- { pid = 123- , name = "LIFX Color US"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 124- , name = "LIFX Color Intl"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 125- , name = "LIFX White to Warm US"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 126- , name = "LIFX White to Warm Intl"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 127- , name = "LIFX White US"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2700- , 2700- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 128- , name = "LIFX White Intl"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2700- , 2700- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 129- , name = "LIFX Color US"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 130- , name = "LIFX Color Intl"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 131- , name = "LIFX White To Warm US"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 132- , name = "LIFX White To Warm Intl"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 133- , name = "LIFX White US"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2700- , 2700- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 134- , name = "LIFX White Intl"- , features = PartialFeatures- { hev = Nothing- , color = Just False- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 2700- , 2700- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 135- , name = "LIFX GU10 Color US"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 136- , name = "LIFX GU10 Color Intl"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just False- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 137- , name = "LIFX Candle Color US"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just True- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- , ProductInfo- { pid = 138- , name = "LIFX Candle Color Intl"- , features = PartialFeatures- { hev = Nothing- , color = Just True- , chain = Just False- , matrix = Just True- , relays = Nothing- , buttons = Nothing- , infrared = Just False- , multizone = Just False- , temperatureRange = Just- ( 1500- , 9000- )- , extendedMultizone = Nothing- }- , upgrades = []- }- ]- }- ]
− src/Lifx/Internal/ProductInfoMap.hs
@@ -1,90 +0,0 @@-module Lifx.Internal.ProductInfoMap where--import Control.Applicative-import Data.Functor-import Data.Maybe-import Data.Tuple.Extra-import Data.Word--import Data.Map (Map, (!?))-import Data.Map.Strict qualified as Map-import Data.Text (Text)-import GHC.Generics (Generic)--import Lifx.Internal.Product-import Lifx.Internal.ProductInfo--productInfoMap :: Map Word32 (Features, Map Word32 ProductInfo)-productInfoMap =- Map.fromList $- productInfo <&> \VendorInfo{..} ->- ( vid- ,- ( defaults- , Map.fromList $ ((.pid) &&& id) <$> products- )- )---- | Information about a particular LIFX product.-data Product = Product- { name :: Text- , id :: Word32- , features :: Features- }- deriving (Eq, Ord, Show, Generic)--data ProductLookupError- = UnknownVendorId Word32- | UnknownProductId Word32- deriving (Eq, Ord, Show, Generic)--productLookup :: Word32 -> Word32 -> Word16 -> Word16 -> Either ProductLookupError Product-productLookup vendor prod versionMinor versionMajor =- case productInfoMap !? vendor of- Nothing -> Left $ UnknownVendorId vendor- Just (defaults, products) -> case products !? prod of- Nothing -> Left $ UnknownProductId prod- Just ProductInfo{features = originalFeatures, ..} ->- pure- Product- { name- , id = prod- , features =- completeFeatures defaults $- foldl- ( \old Upgrade{..} ->- if (versionMajor, versionMinor) >= (major, minor)- then addFeatures features old- else old- )- originalFeatures- upgrades- }- where- completeFeatures f pf =- Features- { hev = fromMaybe f.hev pf.hev- , color = fromMaybe f.color pf.color- , chain = fromMaybe f.chain pf.chain- , matrix = fromMaybe f.matrix pf.matrix- , relays = fromMaybe f.relays pf.relays- , buttons = fromMaybe f.buttons pf.buttons- , infrared = fromMaybe f.infrared pf.infrared- , multizone = fromMaybe f.multizone pf.multizone- , temperatureRange = pf.temperatureRange <|> f.temperatureRange- , extendedMultizone = fromMaybe f.extendedMultizone pf.extendedMultizone- }- -- left-biased- addFeatures new old =- PartialFeatures- { hev = new.hev <|> old.hev- , color = new.color <|> old.color- , chain = new.chain <|> old.chain- , matrix = new.matrix <|> old.matrix- , relays = new.relays <|> old.relays- , buttons = new.buttons <|> old.buttons- , infrared = new.infrared <|> old.infrared- , multizone = new.multizone <|> old.multizone- , temperatureRange = new.temperatureRange <|> old.temperatureRange- , extendedMultizone = new.extendedMultizone <|> old.extendedMultizone- }
src/Lifx/Lan.hs view
@@ -1,444 +1,106 @@-{- |-@--- these should be enabled by default in a future version of GHC--- (they aren't entirely necessary here anyway - they just make the example even simpler)-\{\-\# LANGUAGE BlockArguments \#\-\}-\{\-\# LANGUAGE NamedFieldPuns \#\-\}--import Control.Monad.IO.Class (liftIO)-import Data.Foldable (for_)---- | Find all devices on the network, print their addresses, and set their brightness to 50%.-main :: IO ()-main = runLifx do- devs <- discoverDevices Nothing- liftIO $ print devs- for_ devs \\d -> do- LightState{hsbk} <- sendMessage d GetColor- sendMessage d $ SetColor hsbk{brightness = maxBound \`div\` 2} 3-@--} module Lifx.Lan (- Device,- deviceAddress,- deviceFromAddress,+ sendMessage, Message (..), HSBK (..),+ Duration (..), Lifx, runLifx, LifxT, runLifxT,- LifxError (..),- ProductLookupError (..), MonadLifx (..), - -- * Responses- StateService (..),- Service (..),- StateHostFirmware (..),- StatePower (..),- StateVersion (..),- LightState (..),-- -- ** Product info- getProductInfo,- Product (..),- Features (..),-- -- * Message encoding-- -- | These are used internally by `LifxT`'s 'sendMessage' and 'broadcastMessage'.- -- They are exposed in order to support some advanced use cases.+ -- * Low-level encodeMessage, Header (..), ) where 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 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.Binary+import Data.Binary.Put+import Data.Bits 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 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--{- Device -}--{- |->>> deviceFromAddress (192, 168, 0, 1)-192.168.0.1--If we know the IP address of a `Device`, we can create it directly, rather than calling `discoverDevices`.--}-deviceFromAddress :: (Word8, Word8, Word8, Word8) -> Device-deviceFromAddress = Device . tupleToHostAddress--deviceAddress :: Device -> HostAddress-deviceAddress = (.unwrap)+import Network.Socket+import Network.Socket.ByteString+import System.Random {- Core -} lifxPort :: PortNumber lifxPort = 56700 --- | A message we can send to a 'Device'. 'r' is the type of the expected response.-data Message r where- -- | https://lan.developer.lifx.com/docs/querying-the-device-for-data#getservice---packet-2- -- (you shouldn't need this - use 'discoverDevices')- GetService :: Message StateService- -- | https://lan.developer.lifx.com/docs/querying-the-device-for-data#gethostfirmware---packet-14- GetHostFirmware :: Message StateHostFirmware- -- | https://lan.developer.lifx.com/docs/querying-the-device-for-data#getpower---packet-20- GetPower :: Message StatePower- -- | https://lan.developer.lifx.com/docs/changing-a-device#setpower---packet-21- SetPower :: Bool -> Message ()- -- | https://lan.developer.lifx.com/docs/querying-the-device-for-data#getversion---packet-32- GetVersion :: Message StateVersion- -- | https://lan.developer.lifx.com/docs/querying-the-device-for-data#getcolor---packet-101- GetColor :: Message LightState- -- | https://lan.developer.lifx.com/docs/changing-a-device#setcolor---packet-102- SetColor :: HSBK -> NominalDiffTime -> Message ()- -- | https://lan.developer.lifx.com/docs/changing-a-device#setlightpower---packet-117- SetLightPower :: Bool -> NominalDiffTime -> Message ()--deriving instance (Eq (Message r))-deriving instance (Ord (Message r))-deriving instance (Show (Message r))---- | https://lan.developer.lifx.com/docs/field-types#services-data Service- = ServiceUDP- | ServiceReserved1- | ServiceReserved2- | ServiceReserved3- | ServiceReserved4- deriving (Eq, Ord, Show, Generic)---- | https://lan.developer.lifx.com/docs/information-messages#stateservice---packet-3-data StateService = StateService- { service :: Service- , port :: PortNumber- }- deriving (Eq, Ord, Show, Generic)---- | https://lan.developer.lifx.com/docs/information-messages#statehostfirmware---packet-15-data StateHostFirmware = StateHostFirmware- { build :: Word64- -- ^ The timestamp of the firmware that is on the device as an epoch- , versionMinor :: Word16- -- ^ The minor component of the firmware version- , versionMajor :: Word16- -- ^ The major component of the firmware version- }- deriving (Eq, Ord, Show, Generic)---- | https://lan.developer.lifx.com/docs/information-messages#statepower---packet-22-newtype StatePower = StatePower- { power :: Word16- }- deriving (Eq, Ord, Show, Generic)+sendMessage :: MonadLifx m => HostAddress -> Message -> m ()+sendMessage lightAddr msg = do+ sock <- getSocket+ source <- getSource+ sequenceCounter <- getCounter+ incrementCounter+ void . liftIO $+ sendTo+ sock+ (BL.toStrict $ encodeMessage False sequenceCounter source msg)+ (SockAddrInet lifxPort lightAddr) --- | https://lan.developer.lifx.com/docs/information-messages#stateversion---packet-33-data StateVersion = StateVersion- { vendor :: Word32- -- ^ For LIFX products this value is 1. There may be devices in the future with a different vendor value.- , product :: Word32- -- ^ The product id of the device. The available products can be found in our Product Registry.+data HSBK = HSBK+ { hue :: Word16+ , saturation :: Word16+ , brightness :: Word16+ , kelvin :: Word16 } deriving (Eq, Ord, Show, Generic)---- | https://lan.developer.lifx.com/docs/information-messages#lightstate---packet-107-data LightState = LightState- { hsbk :: HSBK- , power :: Word16- , label :: Text- }+newtype Duration = Duration Word32 deriving (Eq, Ord, Show, Generic) -{- Message responses -}--class MessageResult a where- getSendResult :: MonadLifxIO m => Device -> m a- default getSendResult :: (MonadLifxIO m, Response a) => Device -> m a- getSendResult receiver = untilJustM do- timeoutDuration <- getTimeout- (bs, sender0) <- throwEither $ maybeToEither RecvTimeout <$> receiveMessage timeoutDuration (messageSize @a)- sender <- hostAddressFromSock sender0- res <- decodeMessage @a bs- when (isJust res && sender /= deviceAddress receiver) $ lifxThrowIO $ WrongSender receiver sender- pure res- where- throwEither x =- x >>= \case- Left e -> lifxThrowIO e- Right r -> pure r-- broadcastAndGetResult ::- MonadLifxIO 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 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 filter' maybeFinished msg = do- timeoutDuration <- getTimeout- broadcast msg- t0 <- liftIO getCurrentTime- fmap (Map.mapKeysMonotonic Device) . flip execStateT Map.empty $ untilM do- t <- liftIO getCurrentTime- let timeLeft = timeoutDuration - nominalDiffTimeToInt @Micro (diffUTCTime t t0)- if timeLeft < 0- then pure False- else- lift (receiveMessage timeLeft (messageSize @a)) >>= \case- Just (bs, addr) -> do- lift (decodeMessage @a bs) >>= \case- Just x -> do- hostAddr <- lift $ hostAddressFromSock addr- lift (filter' hostAddr x) >>= \case- Just x' -> modify $ Map.insertWith (<>) hostAddr (pure x')- Nothing -> pure ()- Nothing -> pure ()- maybe (pure False) gets maybeFinished- Nothing -> do- -- if we were waiting for a predicate to pass, then we've timed out- when (isJust maybeFinished) $ lift . lifxThrowIO . BroadcastTimeout =<< gets Map.keys- pure True--class Response a where- expectedPacketType :: Word16- messageSize :: Int- getBody :: Get a--instance MessageResult () where- getSendResult = const $ pure ()- broadcastAndGetResult = const $ const $ (Map.empty <$) . broadcast-instance Response StateService where- expectedPacketType = 3- messageSize = 5- getBody = do- service <-- getWord8 >>= \case- 1 -> pure ServiceUDP- 2 -> pure ServiceReserved1- 3 -> pure ServiceReserved2- 4 -> pure ServiceReserved3- 5 -> pure ServiceReserved4- n -> fail $ "unknown service: " <> show n- port <- do- x <- getWord32le- -- `network` lib uses `Word16` for ports, but LIFX StateService uses `Word32`- maybe (fail $ "port out of range: " <> show x) pure $ fromIntegralSafe x- pure StateService{..}-instance MessageResult StateService-instance Response StateHostFirmware where- expectedPacketType = 15- messageSize = 20- getBody = do- build <- getWord64le- skip 8- versionMinor <- getWord16le- versionMajor <- getWord16le- pure StateHostFirmware{..}-instance MessageResult StateHostFirmware-instance Response StatePower where- expectedPacketType = 22- messageSize = 2- getBody = StatePower <$> getWord16le-instance MessageResult StatePower-instance Response StateVersion where- expectedPacketType = 33- messageSize = 20- getBody = do- vendor <- getWord32le- p <- getWord32le- skip 4- pure StateVersion{product = p, ..}-instance MessageResult StateVersion-instance Response LightState where- expectedPacketType = 107- messageSize = 52- getBody = do- hsbk <- HSBK <$> getWord16le <*> getWord16le <*> getWord16le <*> getWord16le- skip 2- power <- getWord16le- label <- decodeUtf8 . BS.takeWhile (/= 0) <$> getByteString 32- skip 8- pure LightState{..}-instance MessageResult LightState--msgResWitness :: (MessageResult r => Message r -> a) -> (Message r -> a)-msgResWitness f m = case m of- GetService{} -> f m- GetHostFirmware{} -> f m- GetPower{} -> f m- SetPower{} -> f m- GetVersion{} -> f m- GetColor{} -> f m- SetColor{} -> f m- SetLightPower{} -> f m+-- | https://lan.developer.lifx.com/docs/changing-a-device+data Message+ = SetPower Bool+ | SetColor HSBK Duration+ | SetLightPower Bool Duration {- Monad -} --- | A simple implementation of 'MonadLifx'. type Lifx = LifxT IO+newtype LifxT m a = LifxT {unLifxT :: StateT Word8 (ReaderT (Socket, Word32) m) a}+ deriving newtype (Functor, Applicative, Monad, MonadIO, MonadReader (Socket, Word32), MonadState Word8) -{- | 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 m =- runLifxT 5_000_000 m >>= \case- Left e -> ioError $ mkIOError userErrorType (show e) Nothing Nothing- Right x -> pure x--runLifxT ::- MonadIO m =>- -- | Timeout for waiting for message responses, in microseconds.- Int ->- LifxT m a ->- m (Either LifxError a)-runLifxT timeoutDuration (LifxT x) = do+runLifx = runLifxT+runLifxT :: MonadIO m => LifxT m a -> m a+runLifxT (LifxT x) = do sock <- liftIO $ socket AF_INET Datagram defaultProtocol- liftIO $ setSocketOption sock Broadcast 1 liftIO . bind sock $ SockAddrInet defaultPort 0 source <- randomIO- runExceptT $ runReaderT (evalStateT x 0) (sock, source, timeoutDuration)--class Monad m => MonadLifx m where- -- | The type of errors associated with 'm'.- type MonadLifxError m-- liftProductLookupError :: ProductLookupError -> MonadLifxError m- lifxThrow :: MonadLifxError m -> m a-- -- | Send a message and wait for a response.- sendMessage :: Device -> Message r -> m r-- -- | Broadcast a message and wait for responses.- broadcastMessage :: Message r -> m [(Device, r)]-- -- | Search for devices on the local network.- -- If an integer argument is given, wait until we have found that number of devices -- -- otherwise just keep waiting until timeout.- discoverDevices :: Maybe Int -> m [Device]+ runReaderT (evalStateT x 0) (sock, source) +class MonadIO m => MonadLifx m where+ getSocket :: m Socket+ getSource :: m Word32+ incrementCounter :: m ()+ getCounter :: m Word8 instance MonadIO m => MonadLifx (LifxT m) where- type MonadLifxError (LifxT m) = LifxError- lifxThrow = lifxThrowIO- liftProductLookupError = ProductLookupError-- sendMessage receiver = msgResWitness \msg -> do- incrementCounter- sendMessage' True receiver.unwrap msg- getSendResult receiver-- broadcastMessage = msgResWitness \msg ->- concatMap (\(a, xs) -> map (a,) $ toList xs) . Map.toList- <$> broadcastAndGetResult (const $ pure . pure) Nothing msg-- discoverDevices nDevices = Map.keys <$> broadcastAndGetResult f p GetService- where- f _addr StateService{..} = do- checkPort port- pure . guard $ service == ServiceUDP- p = nDevices <&> \n -> (>= n) . length-instance MonadLifx m => MonadLifx (MaybeT m) where- type MonadLifxError (MaybeT m) = MonadLifxError m- liftProductLookupError = liftProductLookupError @m- sendMessage = lift .: sendMessage- broadcastMessage = lift . broadcastMessage- discoverDevices = lift . discoverDevices- lifxThrow = lift . lifxThrow-instance MonadLifx m => MonadLifx (ExceptT e m) where- type MonadLifxError (ExceptT e m) = MonadLifxError m- liftProductLookupError = liftProductLookupError @m- sendMessage = lift .: sendMessage- broadcastMessage = lift . broadcastMessage- discoverDevices = lift . discoverDevices- lifxThrow = lift . lifxThrow+ getSocket = asks fst+ getSource = asks snd+ incrementCounter = modify succ'+ getCounter = gets id instance MonadLifx m => MonadLifx (StateT s m) where- type MonadLifxError (StateT s m) = MonadLifxError m- liftProductLookupError = liftProductLookupError @m- sendMessage = lift .: sendMessage- broadcastMessage = lift . broadcastMessage- discoverDevices = lift . discoverDevices- lifxThrow = lift . lifxThrow+ getSocket = lift getSocket+ getSource = lift getSource+ incrementCounter = lift incrementCounter+ getCounter = lift getCounter instance MonadLifx m => MonadLifx (ReaderT e m) where- type MonadLifxError (ReaderT e m) = MonadLifxError m- liftProductLookupError = liftProductLookupError @m- sendMessage = lift .: sendMessage- broadcastMessage = lift . broadcastMessage- discoverDevices = lift . discoverDevices- lifxThrow = lift . lifxThrow+ getSocket = lift getSocket+ getSource = lift getSource+ incrementCounter = lift incrementCounter+ getCounter = lift getCounter -encodeMessage ::- -- | tagged- Bool ->- -- | ackRequired- Bool ->- -- | sequenceCounter- Word8 ->- -- | source- Word32 ->- Message r ->- BL.ByteString-encodeMessage tagged ackRequired sequenceCounter source msg =- runPut $ Binary.put (messageHeader tagged ackRequired sequenceCounter source msg) >> putMessagePayload msg+{- Low level -} +encodeMessage :: Bool -> Word8 -> Word32 -> Message -> BL.ByteString+encodeMessage ackRequired sequenceCounter source msg =+ runPut $ putHeader (messageHeader ackRequired sequenceCounter source msg) >> putMessagePayload msg+ -- | https://lan.developer.lifx.com/docs/encoding-a-packet data Header = Header { size :: Word16@@ -453,88 +115,38 @@ , sequenceCounter :: Word8 , packetType :: Word16 }- deriving (Eq, Ord, Show, Generic) -instance Binary Header where- get = do- size <- getWord16le- protBytes <- getWord16le- let protocol = flip clearBit 12 . flip clearBit 13 . flip clearBit 14 . flip clearBit 15 $ protBytes- addressable = testBit protBytes 12- tagged = testBit protBytes 13- origin = (if testBit protBytes 14 then 0 else 1) + (if testBit protBytes 15 then 0 else 2)- source <- getWord32le- target <- getWord64be- skip 6- resAckByte <- getWord8- let resRequired = testBit resAckByte 0- ackRequired = testBit resAckByte 1- sequenceCounter <- getWord8- skip 8- packetType <- getWord16le- skip 2- pure Header{..}-- put Header{..} = do- putWord16le size- putWord16le $- protocol- .|. bitIf addressable 12- .|. bitIf tagged 13- .|. bitIf (testBit origin 0) 14- .|. bitIf (testBit origin 1) 15- putWord32le source- putWord64be target- replicateM_ 6 $ putWord8 0- putWord8 $- zeroBits- .|. bitIf resRequired 0- .|. bitIf ackRequired 1- putWord8 sequenceCounter- replicateM_ 8 $ putWord8 0- putWord16le packetType- replicateM_ 2 $ putWord8 0- where- bitIf b n = if b then bit n else zeroBits+putHeader :: Header -> Put+putHeader Header{..} = do+ putWord16le size+ putWord16le $+ protocol+ .|. bitIf addressable 12+ .|. bitIf tagged 13+ .|. bitIf (testBit origin 0) 14+ .|. bitIf (testBit origin 1) 15+ putWord32le source+ putWord64be target+ replicateM_ 6 $ putWord8 0+ putWord8 $+ zeroBits+ .|. bitIf resRequired 0+ .|. bitIf ackRequired 1+ putWord8 sequenceCounter+ replicateM_ 8 $ putWord8 0+ putWord16le packetType+ replicateM_ 2 $ putWord8 0+ where+ bitIf b n = if b then bit n else zeroBits -messageHeader :: Bool -> Bool -> Word8 -> Word32 -> Message r -> Header-messageHeader tagged ackRequired sequenceCounter source = \case- GetService{} ->- Header- { size = headerSize- , packetType = 2- , ..- }- GetHostFirmware{} ->- Header- { size = headerSize- , packetType = 14- , ..- }- GetPower{} ->- Header- { size = headerSize- , packetType = 20- , ..- }+messageHeader :: Bool -> Word8 -> Word32 -> Message -> Header+messageHeader ackRequired sequenceCounter source = \case SetPower{} -> Header { size = headerSize + 2 , packetType = 21 , .. }- GetVersion{} ->- Header- { size = headerSize- , packetType = 32- , ..- }- GetColor{} ->- Header- { size = headerSize- , packetType = 101- , ..- } SetColor{} -> Header { size = headerSize + 13@@ -548,104 +160,33 @@ , .. } where- target = 0 :: Word64- protocol = 1024 :: Word16+ target = 0+ headerSize = 36+ protocol = 1024+ tagged = True addressable = True- origin = 0 :: Word8+ origin = 0 resRequired = False -putMessagePayload :: Message r -> Put+putMessagePayload :: Message -> Put putMessagePayload = \case- GetService -> mempty- GetHostFirmware -> mempty- GetPower -> mempty SetPower b -> putWord16le if b then maxBound else minBound- GetVersion -> mempty- GetColor -> mempty- SetColor HSBK{..} d -> do+ SetColor HSBK{..} (Duration d) -> do putWord8 0 putWord16le hue putWord16le saturation putWord16le brightness putWord16le kelvin- putWord32le $ nominalDiffTimeToInt @Milli d- SetLightPower b d -> do+ putWord32le d+ SetLightPower b (Duration d) -> do putWord16le if b then maxBound else minBound- putWord32le $ nominalDiffTimeToInt @Milli d---- | Ask a device for its vendor and product ID, and look up info on it from the official database.-getProductInfo :: forall m. MonadLifx m => Device -> m Product-getProductInfo dev = do- StateHostFirmware{..} <- sendMessage dev GetHostFirmware- v <- sendMessage dev GetVersion- either (lifxThrow . liftProductLookupError @m) pure $ productLookup v.vendor v.product versionMinor versionMajor+ putWord32le d {- Util -} -fromIntegralSafe :: forall a b. (Integral a, Integral b, Bounded b) => a -> Maybe b-fromIntegralSafe x =- guard- ( x <= fromIntegral (maxBound @b)- && x >= fromIntegral (minBound @b)- )- $> fromIntegral x--headerSize :: Num a => a-headerSize = 36--nominalDiffTimeToInt :: forall f a r. (HasResolution r, f ~ Fixed r, Integral a) => NominalDiffTime -> a-nominalDiffTimeToInt t = fromInteger n- where- MkFixed n = realToFrac @Pico @f $ nominalDiffTimeToSeconds t---- | Inverted 'whileM'.-untilM :: Monad m => m Bool -> m ()-untilM = whileM . fmap not--checkPort :: MonadLifxIO f => PortNumber -> f ()-checkPort port = when (port /= lifxPort) . lifxThrowIO $ UnexpectedPort port---- these helpers are all used by 'sendMessage' and 'broadcastMessage'-decodeMessage :: forall b m. (Response b, MonadLifxIO m) => BS.ByteString -> m (Maybe b) -- Nothing means counter mismatch-decodeMessage bs = do- counter <- getCounter- case runGetOrFail Binary.get $ BL.fromStrict bs of- Left e -> throwDecodeFailure e- Right (bs', _, Header{packetType, sequenceCounter}) ->- if sequenceCounter /= counter- then handleOldMessage counter sequenceCounter packetType bs' >> pure Nothing- else do- when (packetType /= expectedPacketType @b) . lifxThrowIO $- WrongPacketType (expectedPacketType @b) packetType- case runGetOrFail getBody bs' of- Left e -> throwDecodeFailure e- Right (_, _, res) -> pure $ Just res- where- throwDecodeFailure (bs', bo, e) = lifxThrowIO $ DecodeFailure (BL.toStrict bs') bo e-sendMessage' :: MonadLifxIO m => Bool -> HostAddress -> Message r -> m ()-sendMessage' tagged receiver msg = do- sock <- getSocket- counter <- getCounter- source <- getSource- void . liftIO $- sendTo- sock- (BL.toStrict $ encodeMessage tagged False counter source msg)- (SockAddrInet lifxPort receiver)-hostAddressFromSock :: MonadLifxIO m => SockAddr -> m HostAddress-hostAddressFromSock = \case- SockAddrInet port ha -> checkPort port >> pure ha- addr -> lifxThrowIO $ UnexpectedSockAddrType addr-receiveMessage :: MonadLifxIO m => Int -> Int -> m (Maybe (BS.ByteString, SockAddr))-receiveMessage t size = do- sock <- getSocket- liftIO- . timeout t- . recvFrom sock- $ headerSize + size--broadcast :: MonadLifxIO m => Message r -> m ()-broadcast msg = do- incrementCounter- sendMessage' False (tupleToHostAddress (255, 255, 255, 255)) msg+-- | Safe, wraparound variant of 'succ'.+succ' :: (Eq a, Bounded a, Enum a) => a -> a+succ' e+ | e == maxBound = minBound+ | otherwise = succ e
− src/Lifx/Lan/Internal.hs
@@ -1,100 +0,0 @@-module Lifx.Lan.Internal where--import Control.Monad.Except-import Control.Monad.Reader-import Control.Monad.State-import Data.Binary.Get-import Data.List-import Data.Tuple.Extra-import Data.Word-import Network.Socket--import Data.ByteString qualified as BS-import Data.ByteString.Lazy qualified as BL-import GHC.Generics (Generic)--import Lifx.Internal.ProductInfoMap (ProductLookupError)---- | A LIFX device, such as a bulb.-newtype Device = Device {unwrap :: HostAddress}- deriving newtype (Eq, Ord)--instance Show Device where- show (Device ha) = let (a, b, c, d) = hostAddressToTuple ha in intercalate "." $ map show [a, b, c, d]---- | A colour. See https://lan.developer.lifx.com/docs/representing-color-with-hsbk.-data HSBK = HSBK- { hue :: Word16- , saturation :: Word16- , brightness :: Word16- , kelvin :: Word16- -- ^ takes values in the range 1500 to 9000- }- deriving (Eq, Ord, Show, 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 Device HostAddress -- expected, then actual- | UnexpectedSockAddrType SockAddr- | UnexpectedPort PortNumber- | ProductLookupError ProductLookupError- deriving (Eq, Ord, Show, Generic)---- | A monad for sending and receiving LIFX messages.-class MonadIO m => MonadLifxIO m where- getSocket :: m Socket- getSource :: m Word32- getTimeout :: m Int- incrementCounter :: m ()- getCounter :: m Word8- lifxThrowIO :: LifxError -> m a- handleOldMessage ::- -- | expected counter value- Word8 ->- -- | actual counter value- Word8 ->- -- | packet type- Word16 ->- -- | payload- BL.ByteString ->- m ()- handleOldMessage _ _ _ _ = pure ()--instance MonadIO m => MonadLifxIO (LifxT m) where- getSocket = LifxT $ asks fst3- getSource = LifxT $ asks snd3- getTimeout = LifxT $ asks thd3- incrementCounter = LifxT $ modify succ'- getCounter = LifxT $ gets id- lifxThrowIO = LifxT . throwError--newtype LifxT m a = LifxT- { unwrap ::- StateT- Word8- ( ReaderT- (Socket, Word32, Int)- ( ExceptT- LifxError- m- )- )- a- }- deriving newtype- ( Functor- , Applicative- , Monad- , MonadIO- )--{- Util -}---- | Safe, wraparound variant of 'succ'.-succ' :: (Eq a, Bounded a, Enum a) => a -> a-succ' e- | e == maxBound = minBound- | otherwise = succ e
− src/Lifx/Lan/Mock/Terminal.hs
@@ -1,101 +0,0 @@--- TODO remove when `OverloadedRecordUpdate` is fully implemented (and simplify some nested updates) - hopefully 9.4-{-# OPTIONS_GHC -Wno-ambiguous-fields #-}---- | Rather than interacting with any bulbs, simulate interactions by printing to a terminal.-module Lifx.Lan.Mock.Terminal (Mock, runMock, MockState (MockState), MockError, runMockFull) where--import Control.Monad.Except-import Control.Monad.Reader-import Control.Monad.State-import Data.Bifunctor-import Data.Colour.RGBSpace-import Data.Colour.SRGB-import Data.Foldable--import Data.Map (Map)-import Data.Map.Strict qualified as Map-import Data.Text (Text)-import Data.Text.IO qualified as T-import System.Console.ANSI hiding (SetColor)--import Lifx.Internal.Colour-import Lifx.Lan--newtype Mock a = Mock (StateT (Map Device MockState) (ReaderT [Device] (ExceptT MockError IO)) a)- deriving newtype- ( Functor- , Applicative- , Monad- , MonadIO- , MonadError MockError- , MonadReader [Device]- , MonadState (Map Device MockState)- )--data MockState = MockState- { light :: LightState- , service :: Maybe StateService- , hostFirmware :: Maybe StateHostFirmware- , version :: Maybe StateVersion- }---- TODO this seems like a GHC bug-dotLabel :: LightState -> Text--- dotLabel = (.label)-dotLabel = \LightState{..} -> label--runMock :: [(Device, Text)] -> Mock a -> IO (Either MockError a)-runMock = runMockFull . fmap (second \t -> MockState (LightState (HSBK 0 0 0 0) 1 t) Nothing Nothing Nothing)--runMockFull :: [(Device, MockState)] -> Mock a -> IO (Either MockError a)-runMockFull ds (Mock x) =- runExceptT- . flip- runReaderT- (fst <$> ds)- . flip- evalStateT- (Map.fromList ds)- $ x--data MockError- = MockNoSuchDevice Device- | MockProductLookupError ProductLookupError- | MockDataNotProvided- deriving (Show)--instance MonadLifx Mock where- type MonadLifxError Mock = MockError- lifxThrow = throwError- liftProductLookupError = MockProductLookupError-- sendMessage d m = do- s <- lookupDevice d- r <- case m of- GetService -> whenProvided s.service- GetHostFirmware -> whenProvided s.hostFirmware- GetPower -> pure $ StatePower s.light.power- SetPower (convertPower -> power) -> modify $ Map.insert d s{light = s.light{power}}- GetVersion -> whenProvided s.version- GetColor -> pure s.light- SetColor hsbk _t -> modify $ Map.insert d s{light = s.light{hsbk}}- SetLightPower (convertPower -> power) _t -> modify $ Map.insert d s{light = s.light{power}}- ds <- ask- for_ ds \d' -> do- s' <- lookupDevice d'- liftIO do- setSGR $ mkSGR s'.light- T.putStr $ dotLabel s'.light- setSGR []- liftIO $ putStrLn ""- pure r- where- lookupDevice = maybe (lifxThrow $ MockNoSuchDevice d) pure <=< gets . Map.lookup- whenProvided = maybe (throwError MockDataNotProvided) pure- convertPower = fromIntegral . fromEnum- mkSGR s =- if s.power /= 0- then [SetRGBColor Background . uncurryRGB sRGB $ hsbkToRgb s.hsbk]- else []- broadcastMessage m = ask >>= traverse \d -> (d,) <$> sendMessage d m- discoverDevices x = maybe id take x <$> ask