module Main (main) where

import Control.Concurrent
import Control.Exception
import Control.Monad
import Data.Maybe
import Network.DNS.Decode
import Network.DNS.Encode
import Network.DNS.Types
import Network.Socket.ByteString (recvFrom,sendAllTo)
import Network.Socket hiding (recvFrom)
import System.Environment
import qualified Data.ByteString.Lazy as LBS

import Database (Database)

import qualified Config
import qualified Database


main :: IO ()
main = do
  [confPath,dbPath] <- getArgs
  c <- Config.readFile "test.conf"
  db <- Database.readFile "test.db"
  addrinfos <-
    getAddrInfo
      (Just (defaultHints { addrFlags = [AI_PASSIVE] }))
      Nothing
      (Just (Config.port c))
  addrinfo <- maybe (fail "no addr info") return (listToMaybe addrinfos)
  bracket
    (socket (addrFamily addrinfo) Datagram defaultProtocol)
    (close)
    $ \sock -> do
      bind sock (addrAddress addrinfo)
      forever $ do
        (s, addr) <- recvFrom sock (Config.bufSize c)
        forkIO $ do
          either
            (putStrLn . ("decode error: " ++))
            (\req -> do
              let res = handleRequest db req
              sendAllTo sock (LBS.toStrict (encode res)) addr)
            (decode (LBS.fromStrict s))

handleRequest :: Database -> DNSMessage -> DNSMessage
handleRequest db DNSMessage{question=qs,header=DNSHeader{identifier=i}} =
    DNSMessage
      { header = DNSHeader
        { identifier = i
        , flags = DNSFlags
          { qOrR = QR_Response
          , opcode = OP_STD
          , authAnswer = True
          , trunCation = False
          , recDesired = True
          , recAvailable = False
          , rcode = if length as == 0 then NameErr else NoErr
          , authenData = False
          }
        }
      , question = qs
      , answer = as
      , authority = []
      , additional = []
      }
  where
    as = concatMap (flip Database.lookup db) qs