module Main where

import           Data.ByteString
import           Data.Text
import           Data.Text.Encoding as TSE
import           Network.DNS
import           Network.Socket
import           Util

main :: IO ()
main = do -- general structure like sample code at https://book.realworldhaskell.org/read/sockets-and-syslog.html (for UDP server)
  staticData <- readData
  addr : _ <- getAddrInfo (Just defaultHints { addrSocketType = Datagram, addrFamily = AF_INET6, addrFlags = [AI_PASSIVE] }) Nothing (Just "5300")
  sckt <- openSocket addr
  bind sckt (addrAddress addr)
  putStrLn "Starting DNS server (listening on port 5300)"
  procMessages staticData sckt
  where
    procMessages staticData sckt = do
      (m,ad) <- receiveFrom sckt -- Network.DNS

      sendTo sckt (response m) ad
      procMessages staticData sckt
      where
        response m = encode $ case (question m) of
          (Question qh TXT) : _ -> queryAnswer (uid m) qh
          _                     -> m -- ping back question without answering it
                                     -- no other way to generate empty responses without providing a question in this library?

        queryAnswer oid qh = case maybeAnswer qh of
          Just answer -> responseTXT   oid (Question qh TXT) (TSE.encodeUtf8 answer)
          Nothing     -> responseEmpty oid (Question qh TXT)

        uid msg = identifier (header msg)
        maybeAnswer qh = case queryFromQuestionHead qh of
          (q, "RIL100")    -> lookupCode (Ril100 q) (ril100map staticData)
          (q, "LEITPUNKT") -> lookupName q (leitpunktMap staticData)
                              >>= (`lookupCode` (ril100map staticData))
          (_, _) -> Nothing

queryFromQuestionHead :: ByteString -> (Text, String)
queryFromQuestionHead q = case splt of
  quest : questType : _ -- here we could add enforcement that we only query the intended namespace and not arbitrary subspaces (nsst.ril100.a.b.c.d.e.…)
    -> (quest, Data.Text.unpack questType)
  _                     -> (Data.Text.empty, "") -- side question: is a query without a dot even a legal DNS query?
  where
    splt = splitOn dot (toUpper $ TSE.decodeUtf8 q)
    dot = Data.Text.pack "."

responseEmpty :: Identifier -> Question -> DNSMessage
responseEmpty idt q = makeResponse idt q []

responseTXT :: Identifier -> Question -> ByteString -> DNSMessage
responseTXT idt q txt = makeResponse idt q [ans]
  where
    dom = qname q
    ans = ResourceRecord dom TXT classIN 604800 (RD_TXT txt)