commit 284fdc12611246ae4fa41d0066f660caf80d3a8b Author: Sven van Heugten Date: Fri Nov 14 20:40:45 2025 +0100 Initial commit diff --git a/.dockerignore b/.dockerignore new file mode 100644 index 0000000..79326b9 --- /dev/null +++ b/.dockerignore @@ -0,0 +1,8 @@ +# directories +**/bin/ +**/obj/ +**/out/ + +# files +Dockerfile* +**/*.md diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..d148c1e --- /dev/null +++ b/.gitignore @@ -0,0 +1,14 @@ +/zigbee2mqtt-data + +.idea +*.suo +*.user +.vs/ +[Bb]in/ +[Oo]bj/ +_UpgradeReport_Files/ +[Pp]ackages/ + +Thumbs.db +Desktop.ini +.DS_Store diff --git a/NightLight.Core/Configuration.fs b/NightLight.Core/Configuration.fs new file mode 100644 index 0000000..6f50b26 --- /dev/null +++ b/NightLight.Core/Configuration.fs @@ -0,0 +1,34 @@ +module internal NightLight.Configuration + +open NightLight.Moods +open NightLight.Lights + +let getDesiredColorAndBrightness bulb mood = + let white = ColorByCoordinates(0.3227, 0.329) + let yellow = ColorByTemperature 454 + let red = ColorByCoordinates(0.6942, 0.2963) + + match bulb, mood with + | IkeaBulb, White -> white, Brightness 254 + | IkeaBulb, Yellow -> yellow, Brightness 210 + | IkeaBulb, Red -> red, Brightness 254 + | PaulmannBulb, White -> white, Brightness 35 + | PaulmannBulb, Yellow -> yellow, Brightness 35 + | PaulmannBulb, Red -> red, Brightness 80 + +let lights = + [ { FriendlyName = "Vardagsrum - Fönsterlampa" + Room = LivingRoom + Bulb = IkeaBulb } + { FriendlyName = "Vardagsrum - Vägglampa" + Room = LivingRoom + Bulb = PaulmannBulb } + { FriendlyName = "Vardagsrum - Golvlampa" + Room = LivingRoom + Bulb = PaulmannBulb } + { FriendlyName = "Badrum - Taklampa" + Room = Bathroom + Bulb = IkeaBulb } + { FriendlyName = "Sovrum - Nattduksbordlampa" + Room = Bedroom + Bulb = IkeaBulb } ] diff --git a/NightLight.Core/Core.fs b/NightLight.Core/Core.fs new file mode 100644 index 0000000..742b43d --- /dev/null +++ b/NightLight.Core/Core.fs @@ -0,0 +1,35 @@ +module NightLight.Core + +open NightLight.PartsOfDay +open NightLight.ZigbeeEvents +open NightLight.ZigbeeCommands +open NightLight.Moods +open NightLight.Lights +open NightLight.Configuration +open FsToolkit.ErrorHandling + +let internal tryFindLight friendlyName = + Seq.tryFind (fun light -> light.FriendlyName = friendlyName) lights + +let internal generateZigbeeCommandToFixLight partOfDay light = + let color, brightness = + getDesiredMood light.Room partOfDay |> getDesiredColorAndBrightness light.Bulb + + generateZigbeeCommand light.FriendlyName color brightness + +let onZigbeeEventReceived (partOfDay: PartOfDay) (decodedPayload: string) = + result { + let! zigbeeEvent = parseZigbeeEvent decodedPayload + + return + match zigbeeEvent with + | DeviceAnnounce friendlyName -> + let maybeLight = tryFindLight friendlyName + + match maybeLight with + | Some light -> generateZigbeeCommandToFixLight partOfDay light |> Seq.singleton + | None -> Seq.empty + } + +let onPartOfDayChanged (partOfDay: PartOfDay) = + lights |> Seq.map (generateZigbeeCommandToFixLight partOfDay) diff --git a/NightLight.Core/Lights.fs b/NightLight.Core/Lights.fs new file mode 100644 index 0000000..be03dbf --- /dev/null +++ b/NightLight.Core/Lights.fs @@ -0,0 +1,18 @@ +module internal NightLight.Lights + +open NightLight.Moods + +type Bulb = + | IkeaBulb + | PaulmannBulb + +type Color = + | ColorByCoordinates of float * float + | ColorByTemperature of int + +type Brightness = Brightness of int + +type Light = + { FriendlyName: string + Room: Room + Bulb: Bulb } diff --git a/NightLight.Core/Moods.fs b/NightLight.Core/Moods.fs new file mode 100644 index 0000000..c9c8d44 --- /dev/null +++ b/NightLight.Core/Moods.fs @@ -0,0 +1,20 @@ +module internal NightLight.Moods + +open NightLight.PartsOfDay + +type Mood = + | White + | Yellow + | Red + +type Room = + | Bathroom + | LivingRoom + | Bedroom + +let getDesiredMood room partOfDay = + match room, partOfDay with + | Bathroom, Day -> White + | LivingRoom, Day -> Yellow + | Bedroom, Day -> Yellow + | _, Night -> Red diff --git a/NightLight.Core/NightLight.Core.fsproj b/NightLight.Core/NightLight.Core.fsproj new file mode 100644 index 0000000..d8796ce --- /dev/null +++ b/NightLight.Core/NightLight.Core.fsproj @@ -0,0 +1,23 @@ + + + + net9.0 + true + + + + + + + + + + + + + + + + + + diff --git a/NightLight.Core/PartsOfDay.fs b/NightLight.Core/PartsOfDay.fs new file mode 100644 index 0000000..f7b47d2 --- /dev/null +++ b/NightLight.Core/PartsOfDay.fs @@ -0,0 +1,12 @@ +module NightLight.PartsOfDay + +open System + +type PartOfDay = + | Day + | Night + +let getPartOfDay (dateTime: DateTime) = + match dateTime with + | _ when dateTime.TimeOfDay >= TimeSpan.FromHours 4.75 && dateTime.TimeOfDay < TimeSpan.FromHours 20.5 -> Day + | _ -> Night diff --git a/NightLight.Core/ZigbeeCommands.fs b/NightLight.Core/ZigbeeCommands.fs new file mode 100644 index 0000000..2ebbb08 --- /dev/null +++ b/NightLight.Core/ZigbeeCommands.fs @@ -0,0 +1,26 @@ +module NightLight.ZigbeeCommands + +open System.Text.Json.Nodes +open NightLight.Lights + +type ZigbeeCommand = ZigbeeCommand of Topic: string * Payload: string + +let internal generateZigbeeCommand friendlyName targetColor targetBrightness = + let commandObj = JsonObject() + + match targetColor with + | ColorByCoordinates(x, y) -> + let colorObj = JsonObject() + colorObj["x"] <- x + colorObj["y"] <- y + commandObj["color"] <- colorObj + | ColorByTemperature t -> commandObj["color_temp"] <- t + + commandObj["brightness"] <- + match targetBrightness with + | Brightness b -> b + + let topic = $"zigbee2mqtt/{friendlyName}/set" + let payload = commandObj.ToJsonString() + + ZigbeeCommand(topic, payload) diff --git a/NightLight.Core/ZigbeeEvents.fs b/NightLight.Core/ZigbeeEvents.fs new file mode 100644 index 0000000..24f0b02 --- /dev/null +++ b/NightLight.Core/ZigbeeEvents.fs @@ -0,0 +1,33 @@ +module NightLight.ZigbeeEvents + +open FsToolkit.ErrorHandling +open FSharp.Data + +type ZigbeeEvent = DeviceAnnounce of FriendlyName: string + +type ParseZigbeeEventError = + | InvalidJson + | MissingTypeField + | MissingDataField + | MissingFriendlyNameField + | InvalidTypeField + | InvalidFriendlyNameField + | UnknownType + +let internal parseZigbeeEvent str = + result { + let! jsonValue = JsonValue.TryParse str |> Result.requireSome InvalidJson + + let! messageType = jsonValue.TryGetProperty "type" |> Result.requireSome MissingTypeField + let! messageData = jsonValue.TryGetProperty "data" |> Result.requireSome MissingDataField + + return! + match messageType with + | JsonValue.String "device_announce" -> + match messageData.TryGetProperty "friendly_name" with + | Some(JsonValue.String friendlyName) -> Ok(DeviceAnnounce friendlyName) + | Some _ -> Error InvalidFriendlyNameField + | None -> Error MissingFriendlyNameField + | JsonValue.String _ -> Error UnknownType + | _ -> Error InvalidTypeField + } diff --git a/NightLight.sln b/NightLight.sln new file mode 100644 index 0000000..0918513 --- /dev/null +++ b/NightLight.sln @@ -0,0 +1,45 @@ + +Microsoft Visual Studio Solution File, Format Version 12.00 +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "NightLight", "NightLight\NightLight.fsproj", "{F64FE81A-080D-41F0-966D-F43D7FCEA824}" +EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "NightLight.Core", "NightLight.Core\NightLight.Core.fsproj", "{FE406BDE-B6C1-4BDA-A29D-54D50A7828A9}" +EndProject +Global + GlobalSection(SolutionConfigurationPlatforms) = preSolution + Debug|Any CPU = Debug|Any CPU + Debug|x64 = Debug|x64 + Debug|x86 = Debug|x86 + Release|Any CPU = Release|Any CPU + Release|x64 = Release|x64 + Release|x86 = Release|x86 + EndGlobalSection + GlobalSection(ProjectConfigurationPlatforms) = postSolution + {F64FE81A-080D-41F0-966D-F43D7FCEA824}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {F64FE81A-080D-41F0-966D-F43D7FCEA824}.Debug|Any CPU.Build.0 = Debug|Any CPU + {F64FE81A-080D-41F0-966D-F43D7FCEA824}.Debug|x64.ActiveCfg = Debug|Any CPU + {F64FE81A-080D-41F0-966D-F43D7FCEA824}.Debug|x64.Build.0 = Debug|Any CPU + {F64FE81A-080D-41F0-966D-F43D7FCEA824}.Debug|x86.ActiveCfg = Debug|Any CPU + {F64FE81A-080D-41F0-966D-F43D7FCEA824}.Debug|x86.Build.0 = Debug|Any CPU + {F64FE81A-080D-41F0-966D-F43D7FCEA824}.Release|Any CPU.ActiveCfg = Release|Any CPU + {F64FE81A-080D-41F0-966D-F43D7FCEA824}.Release|Any CPU.Build.0 = Release|Any CPU + {F64FE81A-080D-41F0-966D-F43D7FCEA824}.Release|x64.ActiveCfg = Release|Any CPU + {F64FE81A-080D-41F0-966D-F43D7FCEA824}.Release|x64.Build.0 = Release|Any CPU + {F64FE81A-080D-41F0-966D-F43D7FCEA824}.Release|x86.ActiveCfg = Release|Any CPU + {F64FE81A-080D-41F0-966D-F43D7FCEA824}.Release|x86.Build.0 = Release|Any CPU + {FE406BDE-B6C1-4BDA-A29D-54D50A7828A9}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {FE406BDE-B6C1-4BDA-A29D-54D50A7828A9}.Debug|Any CPU.Build.0 = Debug|Any CPU + {FE406BDE-B6C1-4BDA-A29D-54D50A7828A9}.Debug|x64.ActiveCfg = Debug|Any CPU + {FE406BDE-B6C1-4BDA-A29D-54D50A7828A9}.Debug|x64.Build.0 = Debug|Any CPU + {FE406BDE-B6C1-4BDA-A29D-54D50A7828A9}.Debug|x86.ActiveCfg = Debug|Any CPU + {FE406BDE-B6C1-4BDA-A29D-54D50A7828A9}.Debug|x86.Build.0 = Debug|Any CPU + {FE406BDE-B6C1-4BDA-A29D-54D50A7828A9}.Release|Any CPU.ActiveCfg = Release|Any CPU + {FE406BDE-B6C1-4BDA-A29D-54D50A7828A9}.Release|Any CPU.Build.0 = Release|Any CPU + {FE406BDE-B6C1-4BDA-A29D-54D50A7828A9}.Release|x64.ActiveCfg = Release|Any CPU + {FE406BDE-B6C1-4BDA-A29D-54D50A7828A9}.Release|x64.Build.0 = Release|Any CPU + {FE406BDE-B6C1-4BDA-A29D-54D50A7828A9}.Release|x86.ActiveCfg = Release|Any CPU + {FE406BDE-B6C1-4BDA-A29D-54D50A7828A9}.Release|x86.Build.0 = Release|Any CPU + EndGlobalSection + GlobalSection(SolutionProperties) = preSolution + HideSolutionNode = FALSE + EndGlobalSection +EndGlobal diff --git a/NightLight/Dockerfile b/NightLight/Dockerfile new file mode 100644 index 0000000..dfad5c3 --- /dev/null +++ b/NightLight/Dockerfile @@ -0,0 +1,13 @@ +FROM mcr.microsoft.com/dotnet/sdk:9.0 AS build +WORKDIR /app +COPY NightLight.sln ./ +COPY NightLight.Core/NightLight.Core.fsproj NightLight.Core/ +COPY NightLight/NightLight.fsproj NightLight/ +RUN dotnet restore +COPY . ./ +RUN dotnet publish NightLight/NightLight.fsproj --no-restore -c Release -o out + +FROM mcr.microsoft.com/dotnet/runtime:9.0 +WORKDIR /app +COPY --from=build /app/out . +ENTRYPOINT ["dotnet", "NightLight.dll"] diff --git a/NightLight/NightLight.fsproj b/NightLight/NightLight.fsproj new file mode 100644 index 0000000..1fbc4af --- /dev/null +++ b/NightLight/NightLight.fsproj @@ -0,0 +1,23 @@ + + + + Exe + net9.0 + true + + + + + + + + + + + + + + + + + diff --git a/NightLight/Program.fs b/NightLight/Program.fs new file mode 100644 index 0000000..9d390d2 --- /dev/null +++ b/NightLight/Program.fs @@ -0,0 +1,103 @@ +open System +open System.Text +open System.Threading.Tasks +open Microsoft.Extensions.Logging +open MQTTnet +open MQTTnet.Protocol +open NightLight.PartsOfDay +open NightLight.ZigbeeEvents +open NightLight.ZigbeeCommands +open NightLight.Core + +let private generateMqttMessage zigbeeCommand = + match zigbeeCommand with + | ZigbeeCommand(topic, payload) -> + MqttApplicationMessageBuilder() + .WithTopic(topic) + .WithPayload(payload) + .WithQualityOfServiceLevel(MqttQualityOfServiceLevel.AtLeastOnce) + .Build() + +let private publishZigbeeCommands (mqttClient: IMqttClient) (logger: ILogger) (commands: ZigbeeCommand seq) = + async { + commands + |> Seq.iter (fun command -> + match command with + | ZigbeeCommand(topic, payload) -> + logger.LogInformation("Publishing message {Payload} to topic {Topic}...", payload, topic)) + + return! + commands + |> Seq.map generateMqttMessage + |> Seq.map mqttClient.PublishAsync + |> Seq.map Async.AwaitTask + |> Async.Sequential + |> Async.Ignore + } + +let private onMqttMessageReceived (mqttClient: IMqttClient) (logger: ILogger) (message: MqttApplicationMessage) = + let payload = message.Payload + let decodedPayload = Encoding.UTF8.GetString(&payload) + + logger.LogInformation("Received message with payload {Payload}", decodedPayload) + + let commandsResult = + decodedPayload |> onZigbeeEventReceived (getPartOfDay DateTime.Now) + + match commandsResult with + | Ok commands -> publishZigbeeCommands mqttClient logger commands + | Error UnknownType -> async.Return() + | Error e -> + logger.LogError("Error {Error} while processing {Payload}", e, payload) + async.Return() + +[] +let mainAsync _ = + // This is still a stateful mess. Needs to be cleaned up a lot. + async { + let loggerFactory = + LoggerFactory.Create(fun builder -> builder.AddConsole().SetMinimumLevel LogLevel.Information |> ignore) + + let logger = loggerFactory.CreateLogger "NightLight" + + logger.LogInformation("Current system time is {Now}", DateTime.Now) + + let mqttFactory = MqttClientFactory() + + use mqttClient = mqttFactory.CreateMqttClient() + + let server = + match Environment.GetEnvironmentVariable "MQTT_SERVER" with + | null -> "localhost" + | value -> value + + let mqttClientOptions = MqttClientOptionsBuilder().WithTcpServer(server).Build() + + mqttClient.add_ApplicationMessageReceivedAsync (fun e -> + onMqttMessageReceived mqttClient logger e.ApplicationMessage + |> Async.StartAsTask + :> Task) + + do! mqttClient.ConnectAsync mqttClientOptions |> Async.AwaitTask |> Async.Ignore + + do! + mqttClient.SubscribeAsync "zigbee2mqtt/bridge/event" + |> Async.AwaitTask + |> Async.Ignore + + let mutable previousPartOfDay: PartOfDay option = None + + while true do + let currentPartOfDay = getPartOfDay DateTime.Now + + if previousPartOfDay <> Some currentPartOfDay then + do! onPartOfDayChanged currentPartOfDay |> publishZigbeeCommands mqttClient logger + previousPartOfDay <- Some currentPartOfDay + + do! Async.Sleep 10_000 + + do! mqttClient.DisconnectAsync() |> Async.AwaitTask + } + |> Async.RunSynchronously + + 0 diff --git a/README.md b/README.md new file mode 100644 index 0000000..1446cf8 --- /dev/null +++ b/README.md @@ -0,0 +1,10 @@ +# night-light + +This is an F# program that turns all the lights in our apartment + +* _red_ at 8.30pm in the evening, and +* _white_/_yellow_ (depending on the room) at 4.45am in the morning. + +`NightLight.Core` is the functional core, and `NightLight` is the imperative shell. + +Runs on a Raspberry Pi 3B+. diff --git a/docker-compose.yaml b/docker-compose.yaml new file mode 100644 index 0000000..a734f44 --- /dev/null +++ b/docker-compose.yaml @@ -0,0 +1,31 @@ +services: + mqtt: + image: eclipse-mosquitto:2.0.21 + restart: always + volumes: + - /mosquitto + ports: + - 1883:1883 + - 9001:9001 + command: "mosquitto -c /mosquitto-no-auth.conf" + zigbee2mqtt: + image: koenkk/zigbee2mqtt:2.6.3 + restart: always + volumes: + - ./zigbee2mqtt-data:/app/data + - /run/udev:/run/udev:ro + ports: + - 8080:8080 + environment: + - TZ=Europe/Stockholm + devices: + - /dev/ttyUSB0:/dev/ttyUSB0 + night-light: + build: + context: . + dockerfile: ./NightLight/Dockerfile + restart: always + environment: + - MQTT_SERVER=mqtt + - TZ=Europe/Stockholm +