Network/DNS/Named/Zone.hs

   1 module Network.DNS.Named.Zone
   2     ( ZoneFinder(..)
   3     , fromZones
   4
   5     , Zone(..)
   6     , isInZone
   7
   8     , zoneSOARecord
   9     , zoneNSRecord
  10     )
  11     where
  12
  13 import Data.Maybe
  14 import Network.DNS.Message
  15 import Network.DNS.DomainMap
  16
  17
  18 class ZoneFinder a where
  19     findZone :: a -> DomainName -> IO (Maybe Zone)
  20
  21 instance ZoneFinder (DomainMap Zone) where
  22     findZone = (return .) . flip nearest
  23
  24 instance ZoneFinder (IO (DomainMap Zone)) where
  25     findZone = flip (fmap . nearest)
  26
  27 instance ZoneFinder (DomainName -> Maybe Zone) where
  28     findZone = (return .)
  29
  30 instance ZoneFinder (DomainName -> IO (Maybe Zone)) where
  31     findZone = id
  32
  33
  34 fromZones :: [Zone] -> DomainMap Zone
  35 fromZones = fromList . map toPair
  36     where
  37       toPair z = (zoneName z, z)
  38
  39
  40 data Zone
  41     = Zone {
  42         zoneName        :: !DomainName
  43       , zoneSOA         :: !(Maybe SOAFields)
  44       , zoneRecordNames :: !(IO [DomainName])
  45       , zoneResponder   :: !(DomainName -> IO [SomeRR])
  46       }
  47
  48 isInZone :: DomainName -> Zone -> Bool
  49 isInZone name zone = zoneName zone `isZoneOf` name
  50
  51 zoneSOARecord :: Zone -> Maybe SomeRR
  52 zoneSOARecord zone
  53     = do soa <- zoneSOA zone
  54          return $ wrapRecord
  55                 $ ResourceRecord {
  56                         rrName  = zoneName zone
  57                       , rrType  = SOA
  58                       , rrClass = IN
  59                       , rrTTL   = soaMinimumTTL soa
  60                       , rrData  = soa
  61                       }
  62
  63 zoneNSRecord :: Zone -> Maybe SomeRR
  64 zoneNSRecord zone
  65     = do soa <- zoneSOA zone
  66          return $ wrapRecord
  67                 $ ResourceRecord {
  68                         rrName  = zoneName zone
  69                       , rrType  = NS
  70                       , rrClass = IN
  71                       , rrTTL   = soaMinimumTTL soa
  72                       , rrData  = soaMasterNameServer soa
  73                       }