X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FDNS%2FNamed%2FZone.hs;h=f313beb3d1aab7c78f3b1fd1d0fdf4b920390719;hb=f3ad40fd6916408dde9b9e6237b41828d90c1e34;hp=6cde400e8f5ce6fdbe49e6575d03468e456f0776;hpb=d24a461f09bd10e3fe148e3b6b86c8e861b09a43;p=haskell-dns.git diff --git a/Network/DNS/Named/Zone.hs b/Network/DNS/Named/Zone.hs index 6cde400..f313beb 100644 --- a/Network/DNS/Named/Zone.hs +++ b/Network/DNS/Named/Zone.hs @@ -1,49 +1,73 @@ module Network.DNS.Named.Zone - ( Zone(..) - , ZoneFinder(..) + ( ZoneFinder(..) + , fromZones + , Zone(..) , isInZone - , defaultRootZone + , zoneSOARecord + , zoneNSRecord ) where import Data.Maybe import Network.DNS.Message -import Network.DNS.Named.Responder +import Network.DNS.DomainMap -data Zone - = Zone { - zoneName :: !DomainName - , zoneResponders :: ![SomeResponder] - , zoneIsAuthoritative :: !Bool - } - class ZoneFinder a where - findZone :: a -> DomainName -> IO Zone + findZone :: a -> DomainName -> IO (Maybe Zone) -instance ZoneFinder (DomainName -> Zone) where - findZone = (return .) +instance ZoneFinder (DomainMap Zone) where + findZone = (return .) . flip nearest -instance ZoneFinder (DomainName -> IO Zone) where - findZone = id +instance ZoneFinder (IO (DomainMap Zone)) where + findZone = flip (fmap . nearest) instance ZoneFinder (DomainName -> Maybe Zone) where - findZone = ((return . fromMaybe defaultRootZone) .) + findZone = (return .) instance ZoneFinder (DomainName -> IO (Maybe Zone)) where - findZone = (fmap (fromMaybe defaultRootZone) .) + findZone = id -isInZone :: DomainName -> Zone -> Bool -isInZone name zone = zoneName zone `isZoneOf` name +fromZones :: [Zone] -> DomainMap Zone +fromZones = fromList . map toPair + where + toPair z = (zoneName z, z) -defaultRootZone :: Zone -defaultRootZone +data Zone = Zone { - zoneName = mkDomainName "." - , zoneResponders = [] -- FIXME - , zoneIsAuthoritative = False + zoneName :: !DomainName + , zoneSOA :: !(Maybe SOAFields) + , zoneRecordNames :: !(IO [DomainName]) + , zoneResponder :: !(DomainName -> IO [SomeRR]) } + +isInZone :: DomainName -> Zone -> Bool +isInZone name zone = zoneName zone `isZoneOf` name + +zoneSOARecord :: Zone -> Maybe SomeRR +zoneSOARecord zone + = do soa <- zoneSOA zone + return $ wrapRecord + $ ResourceRecord { + rrName = zoneName zone + , rrType = SOA + , rrClass = IN + , rrTTL = soaMinimumTTL soa + , rrData = soa + } + +zoneNSRecord :: Zone -> Maybe SomeRR +zoneNSRecord zone + = do soa <- zoneSOA zone + return $ wrapRecord + $ ResourceRecord { + rrName = zoneName zone + , rrType = NS + , rrClass = IN + , rrTTL = soaMinimumTTL soa + , rrData = soaMasterNameServer soa + }