diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,45 @@ +# 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.2 +- Basic. Only supports setting power and colour. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2021, George Thomas + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of George Thomas nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,7 @@ +Haskell bindings to the [LIFX LAN API](https://lan.developer.lifx.com/docs). + +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). + +It does not yet cover the full API, but PRs are very welcome and some functionality may be added on request. diff --git a/lifx-lan.cabal b/lifx-lan.cabal new file mode 100644 --- /dev/null +++ b/lifx-lan.cabal @@ -0,0 +1,81 @@ +cabal-version: 3.0 +name: lifx-lan +version: 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, + binary ^>= 0.8.8, + bytestring ^>= {0.10.8, 0.11}, + colour ^>= 2.3.6, + composition ^>= 1.0.2.1, + containers ^>= 0.6.2.1, + extra ^>= 1.7.1, + monad-loops ^>= 0.4.3, + mtl ^>= 2.2.2, + network ^>= 3.1.1.1, + 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}, + 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 + PartialTypeSignatures + RankNTypes + RecordWildCards + ScopedTypeVariables + StandaloneDeriving + TupleSections + TypeApplications + TypeFamilies + TypeOperators + ViewPatterns diff --git a/src/Lifx/Internal/Colour.hs b/src/Lifx/Internal/Colour.hs new file mode 100644 --- /dev/null +++ b/src/Lifx/Internal/Colour.hs @@ -0,0 +1,50 @@ +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 diff --git a/src/Lifx/Internal/Product.hs b/src/Lifx/Internal/Product.hs new file mode 100644 --- /dev/null +++ b/src/Lifx/Internal/Product.hs @@ -0,0 +1,67 @@ +-- | 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) diff --git a/src/Lifx/Internal/ProductInfo.hs b/src/Lifx/Internal/ProductInfo.hs new file mode 100644 --- /dev/null +++ b/src/Lifx/Internal/ProductInfo.hs @@ -0,0 +1,2103 @@ +-- | 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 = [] + } + ] + } + ] diff --git a/src/Lifx/Internal/ProductInfoMap.hs b/src/Lifx/Internal/ProductInfoMap.hs new file mode 100644 --- /dev/null +++ b/src/Lifx/Internal/ProductInfoMap.hs @@ -0,0 +1,90 @@ +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 + } diff --git a/src/Lifx/Lan.hs b/src/Lifx/Lan.hs new file mode 100644 --- /dev/null +++ b/src/Lifx/Lan.hs @@ -0,0 +1,651 @@ +{- | +@ +-- 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, + Message (..), + HSBK (..), + 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. + 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.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) + +{- 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) + +-- | 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. + } + 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 + } + 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 + +{- Monad -} + +-- | A simple implementation of 'MonadLifx'. +type Lifx = LifxT IO + +{- | 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 + 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] + +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 +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 +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 + +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 + +-- | https://lan.developer.lifx.com/docs/encoding-a-packet +data Header = Header + { size :: Word16 + , protocol :: Word16 + , addressable :: Bool + , tagged :: Bool + , origin :: Word8 + , source :: Word32 + , target :: Word64 + , resRequired :: Bool + , ackRequired :: Bool + , 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 + +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 + , .. + } + SetPower{} -> + Header + { size = headerSize + 2 + , packetType = 21 + , .. + } + GetVersion{} -> + Header + { size = headerSize + , packetType = 32 + , .. + } + GetColor{} -> + Header + { size = headerSize + , packetType = 101 + , .. + } + SetColor{} -> + Header + { size = headerSize + 13 + , packetType = 102 + , .. + } + SetLightPower{} -> + Header + { size = headerSize + 6 + , packetType = 117 + , .. + } + where + target = 0 :: Word64 + protocol = 1024 :: Word16 + addressable = True + origin = 0 :: Word8 + resRequired = False + +putMessagePayload :: Message r -> 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 + putWord8 0 + putWord16le hue + putWord16le saturation + putWord16le brightness + putWord16le kelvin + putWord32le $ nominalDiffTimeToInt @Milli d + SetLightPower b 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 + +{- 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 diff --git a/src/Lifx/Lan/Internal.hs b/src/Lifx/Lan/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Lifx/Lan/Internal.hs @@ -0,0 +1,100 @@ +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 diff --git a/src/Lifx/Lan/Mock/Terminal.hs b/src/Lifx/Lan/Mock/Terminal.hs new file mode 100644 --- /dev/null +++ b/src/Lifx/Lan/Mock/Terminal.hs @@ -0,0 +1,101 @@ +-- 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