From 7833a4ba758a7cf9b2534da1434f1070abcad577 Mon Sep 17 00:00:00 2001
From: Fynn Godau
Date: Sun, 28 Dec 2025 15:20:36 +0100
Subject: serve SOA and NS records

---
 app/BahnhofDNS.hs | 30 ++++++++++++++++++++++++++++++
 1 file changed, 30 insertions(+)

(limited to 'app/BahnhofDNS.hs')

diff --git a/app/BahnhofDNS.hs b/app/BahnhofDNS.hs
index 2111aa0..1b06dc1 100644
--- a/app/BahnhofDNS.hs
+++ b/app/BahnhofDNS.hs
@@ -8,6 +8,29 @@ import           Network.DNS
 import           Network.Socket
 import           Util
 
+mkByteString :: String -> ByteString
+mkByteString = TSE.encodeUtf8 . Data.Text.pack
+
+ourName :: ByteString
+ourName = mkByteString "ns.fynngodau.de."
+
+servedName :: ByteString
+servedName = mkByteString "bahnhof.fynngodau.de."
+
+soa :: ResourceRecord
+soa = ResourceRecord servedName SOA classIN 86400 $ RD_SOA
+  ourName                             -- mname
+  (mkByteString "ns@fynngodau.de")    -- rname
+  2025122800                          -- serial
+  86400                               -- refresh
+  7200                                -- retry
+  3600000                             -- expire
+  3600                                -- minttl
+
+ns :: ResourceRecord
+ns = ResourceRecord servedName NS classIN 86400 $ RD_NS ourName
+
+
 main :: IO ()
 main = do -- general structure like sample code at https://book.realworldhaskell.org/read/sockets-and-syslog.html (for UDP server)
   staticData <- readData
@@ -20,11 +43,18 @@ main = do -- general structure like sample code at https://book.realworldhaskell
     procMessages staticData sckt = do
       (m,ad) <- receiveFrom sckt -- Network.DNS
 
+--    putStrLn $ show (question m)
       sendTo sckt (response m) ad
       procMessages staticData sckt
       where
         response m = encode $ case (question m) of
           (Question qh TXT) : _ -> queryAnswer (uid m) qh
+          (Question qh SOA) : _
+            | qh == servedName  -> makeResponse (uid m) (Question servedName SOA) [soa]
+            | otherwise -> m
+          (Question qh NS ) : _
+            | qh == servedName  -> makeResponse (uid m) (Question servedName NS ) [ns ]
+            | otherwise -> m
           _                     -> m -- ping back question without answering it
                                      -- no other way to generate empty responses without providing a question in this library?
 
-- 
cgit v1.2.3