svenvanheugten/night-light
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Initial commit

Browse source
This commit is contained in:
Sven van Heugten 2025-11-14 20:40:45 +01:00
commit 284fdc1261
16 changed files with 448 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

8
.dockerignore Normal file
View file

@ -0,0 +1,8 @@
# directories
**/bin/
**/obj/
**/out/
# files
Dockerfile*
**/*.md

14
.gitignore vendored Normal file
View file

@ -0,0 +1,14 @@
/zigbee2mqtt-data
.idea
*.suo
*.user
.vs/
[Bb]in/
[Oo]bj/
_UpgradeReport_Files/
[Pp]ackages/
Thumbs.db
Desktop.ini
.DS_Store

34
NightLight.Core/Configuration.fs Normal file
View file

@ -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 } ]

35
NightLight.Core/Core.fs Normal file
View file

@ -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)

18
NightLight.Core/Lights.fs Normal file
View file

@ -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 }

20
NightLight.Core/Moods.fs Normal file
View file

@ -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

23
NightLight.Core/NightLight.Core.fsproj Normal file
View file

@ -0,0 +1,23 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net9.0</TargetFramework>
<TreatWarningsAsErrors>true</TreatWarningsAsErrors>
</PropertyGroup>
<ItemGroup>
<Compile Include="PartsOfDay.fs" />
<Compile Include="Moods.fs" />
<Compile Include="Lights.fs" />
<Compile Include="ZigbeeEvents.fs" />
<Compile Include="ZigbeeCommands.fs" />
<Compile Include="Configuration.fs" />
<Compile Include="Core.fs" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="FSharp.Data" Version="6.6.0" />
<PackageReference Include="FsToolkit.ErrorHandling" Version="4.18.0" />
</ItemGroup>
</Project>

12
NightLight.Core/PartsOfDay.fs Normal file
View file

@ -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

26
NightLight.Core/ZigbeeCommands.fs Normal file
View file

@ -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)

33
NightLight.Core/ZigbeeEvents.fs Normal file
View file

@ -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
}

45
NightLight.sln Normal file
View file

@ -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

13
NightLight/Dockerfile Normal file
View file

@ -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"]

23
NightLight/NightLight.fsproj Normal file
View file

@ -0,0 +1,23 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<OutputType>Exe</OutputType>
<TargetFramework>net9.0</TargetFramework>
<TreatWarningsAsErrors>true</TreatWarningsAsErrors>
</PropertyGroup>
<ItemGroup>
<Compile Include="Program.fs" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="Microsoft.Extensions.Logging" Version="9.0.4" />
<PackageReference Include="Microsoft.Extensions.Logging.Console" Version="9.0.4" />
<PackageReference Include="MQTTnet" Version="5.0.1.1416" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="../NightLight.Core/NightLight.Core.fsproj" />
</ItemGroup>
</Project>

103
NightLight/Program.fs Normal file
View file

@ -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()
[<EntryPoint>]
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

10
README.md Normal file
View file

@ -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+.

31
docker-compose.yaml Normal file
View file

@ -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