{-# LINE 1 "ADNS/Base.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}
{-# LINE 2 "ADNS/Base.hsc" #-}
{- |
   Module      :  ADNS.Base
   Copyright   :  (c) 2008 by Peter Simons
   License     :  LGPL

   Maintainer  :  simons@cryp.to
   Stability   :  provisional
   Portability :  ForeignFunctionInterface

   This module provides bindings to GNU ADNS, a domain name
   resolver library written in C. ADNS is available from
   <http://www.gnu.org/software/adns/>.

   You will most likely not need this module directly: "ADNS"
   provides a simpler API for the Haskell world; this module
   contains mostly marshaling code.
 -}

module ADNS.Base where

import Control.Exception        ( assert, bracket )
import Network                  ( HostName )
import Network.Socket           ( HostAddress )
import Foreign
import Foreign.C
import ADNS.Endian


{-# LINE 30 "ADNS/Base.hsc" #-}

{-# LINE 31 "ADNS/Base.hsc" #-}

-- * Marshaled ADNS Data Types

data OpaqueState
type AdnsState = Ptr OpaqueState

data OpaqueQuery
type Query = Ptr OpaqueQuery

data InitFlag
  = NoEnv         -- ^ do not look at environment
  | NoErrPrint    -- ^ never print output to stderr ('Debug' overrides)
  | NoServerWarn  -- ^ do not warn to stderr about duff nameservers etc
  | Debug         -- ^ enable all output to stderr plus 'Debug' msgs
  | LogPid        -- ^ include process id in diagnostic output
  | NoAutoSys     -- ^ do not make syscalls at every opportunity
  | Eintr         -- ^ allow 'adnsSynch' to return 'eINTR'
  | NoSigPipe     -- ^ application has SIGPIPE set to SIG_IGN, do not protect
  | CheckC_EntEx  -- ^ do consistency checks on entry\/exit to adns functions
  | CheckC_Freq   -- ^ do consistency checks very frequently (slow!)
  deriving (Eq, Bounded, Show)

instance Enum InitFlag where
  toEnum 1        = NoEnv
{-# LINE 55 "ADNS/Base.hsc" #-}
  toEnum 2   = NoErrPrint
{-# LINE 56 "ADNS/Base.hsc" #-}
  toEnum 4 = NoServerWarn
{-# LINE 57 "ADNS/Base.hsc" #-}
  toEnum 8        = Debug
{-# LINE 58 "ADNS/Base.hsc" #-}
  toEnum 128       = LogPid
{-# LINE 59 "ADNS/Base.hsc" #-}
  toEnum 16    = NoAutoSys
{-# LINE 60 "ADNS/Base.hsc" #-}
  toEnum 32        = Eintr
{-# LINE 61 "ADNS/Base.hsc" #-}
  toEnum 64    = NoSigPipe
{-# LINE 62 "ADNS/Base.hsc" #-}
  toEnum 256 = CheckC_EntEx
{-# LINE 63 "ADNS/Base.hsc" #-}
  toEnum 768  = CheckC_Freq
{-# LINE 64 "ADNS/Base.hsc" #-}
  toEnum i = error ("Network.DNS.ADNS.InitFlag cannot be mapped to value " ++ show i)

  fromEnum NoEnv         = 1
{-# LINE 67 "ADNS/Base.hsc" #-}
  fromEnum NoErrPrint    = 2
{-# LINE 68 "ADNS/Base.hsc" #-}
  fromEnum NoServerWarn  = 4
{-# LINE 69 "ADNS/Base.hsc" #-}
  fromEnum Debug         = 8
{-# LINE 70 "ADNS/Base.hsc" #-}
  fromEnum LogPid        = 128
{-# LINE 71 "ADNS/Base.hsc" #-}
  fromEnum NoAutoSys     = 16
{-# LINE 72 "ADNS/Base.hsc" #-}
  fromEnum Eintr         = 32
{-# LINE 73 "ADNS/Base.hsc" #-}
  fromEnum NoSigPipe     = 64
{-# LINE 74 "ADNS/Base.hsc" #-}
  fromEnum CheckC_EntEx  = 256
{-# LINE 75 "ADNS/Base.hsc" #-}
  fromEnum CheckC_Freq   = 768
{-# LINE 76 "ADNS/Base.hsc" #-}

data QueryFlag
  = Search            -- ^ use the searchlist
  | UseVC             -- ^ use a virtual circuit (TCP connection)
  | Owner             -- ^ fill in the owner field in the answer
  | QuoteOk_Query     -- ^ allow special chars in query domain
  | QuoteOk_CName     -- ^ allow special chars in CNAME we go via (default)
  | QuoteOk_AnsHost   -- ^ allow special chars in things supposed to be hostnames
  | QuoteFail_CName   -- ^ refuse if quote-req chars in CNAME we go via
  | CName_Loose       -- ^ allow refs to CNAMEs - without, get _s_cname
  | CName_Forbid      -- ^ don't follow CNAMEs, instead give _s_cname
  deriving (Eq, Bounded, Show)

instance Enum QueryFlag where
  toEnum 1          = Search
{-# LINE 91 "ADNS/Base.hsc" #-}
  toEnum 2           = UseVC
{-# LINE 92 "ADNS/Base.hsc" #-}
  toEnum 4           = Owner
{-# LINE 93 "ADNS/Base.hsc" #-}
  toEnum 16   = QuoteOk_Query
{-# LINE 94 "ADNS/Base.hsc" #-}
  toEnum 0   = QuoteOk_CName
{-# LINE 95 "ADNS/Base.hsc" #-}
  toEnum 64 = QuoteOk_AnsHost
{-# LINE 96 "ADNS/Base.hsc" #-}
  toEnum 128 = QuoteFail_CName
{-# LINE 97 "ADNS/Base.hsc" #-}
  toEnum 256     = CName_Loose
{-# LINE 98 "ADNS/Base.hsc" #-}
  toEnum 512    = CName_Forbid
{-# LINE 99 "ADNS/Base.hsc" #-}
  toEnum i = error ("Network.DNS.ADNS.QueryFlag cannot be mapped to value " ++ show i)

  fromEnum Search          = 1
{-# LINE 102 "ADNS/Base.hsc" #-}
  fromEnum UseVC           = 2
{-# LINE 103 "ADNS/Base.hsc" #-}
  fromEnum Owner           = 4
{-# LINE 104 "ADNS/Base.hsc" #-}
  fromEnum QuoteOk_Query   = 16
{-# LINE 105 "ADNS/Base.hsc" #-}
  fromEnum QuoteOk_CName   = 0
{-# LINE 106 "ADNS/Base.hsc" #-}
  fromEnum QuoteOk_AnsHost = 64
{-# LINE 107 "ADNS/Base.hsc" #-}
  fromEnum QuoteFail_CName = 128
{-# LINE 108 "ADNS/Base.hsc" #-}
  fromEnum CName_Loose     = 256
{-# LINE 109 "ADNS/Base.hsc" #-}
  fromEnum CName_Forbid    = 512
{-# LINE 110 "ADNS/Base.hsc" #-}

-- |The record types we support.

data RRType = A | CNAME | MX | NS | PTR
            | NSEC
            | SRV
            | RRType Int
  deriving (Read)

instance Eq RRType where
  a == b = fromEnum a == fromEnum b

instance Show RRType where
  showsPrec _ x = case toEnum $ fromEnum x of  -- canonify
                   A          -> showString "A"
                   CNAME      -> showString "CNAME"
                   MX         -> showString "MX"
                   NS         -> showString "NS"
                   PTR        -> showString "PTR"
                   NSEC       -> showString "NSEC"
                   SRV        -> showString "SRV"
                   (RRType i) -> showString "TYPE" . shows i

instance Enum RRType where
  toEnum 1   = A
{-# LINE 135 "ADNS/Base.hsc" #-}
  toEnum 5 = CNAME
{-# LINE 136 "ADNS/Base.hsc" #-}
  toEnum 65551  = MX
{-# LINE 137 "ADNS/Base.hsc" #-}
  toEnum 65538  = NS
{-# LINE 138 "ADNS/Base.hsc" #-}
  toEnum 65548 = PTR
{-# LINE 139 "ADNS/Base.hsc" #-}
  toEnum 65569 = SRV
{-# LINE 140 "ADNS/Base.hsc" #-}
  toEnum x = case x .&. 65535 of
{-# LINE 141 "ADNS/Base.hsc" #-}
      	 47 -> NSEC
	 i  -> RRType i

  fromEnum A   = 1
{-# LINE 145 "ADNS/Base.hsc" #-}
  fromEnum CNAME = 5
{-# LINE 146 "ADNS/Base.hsc" #-}
  fromEnum MX  = 65551
{-# LINE 147 "ADNS/Base.hsc" #-}
  fromEnum NS  = 65538
{-# LINE 148 "ADNS/Base.hsc" #-}
  fromEnum PTR = 65548
{-# LINE 149 "ADNS/Base.hsc" #-}
  fromEnum SRV = 65569
{-# LINE 150 "ADNS/Base.hsc" #-}
  fromEnum x = 262144 .|. case x of
{-# LINE 151 "ADNS/Base.hsc" #-}
   	   NSEC       -> 47
  	   (RRType i) -> i
	   _	      -> error "Missing case in fromEnum ADNS.Base.RRType"

instance Storable RRType where
  sizeOf _     = (4)
{-# LINE 157 "ADNS/Base.hsc" #-}
  alignment _  = alignment (undefined :: Word32)
{-# LINE 158 "ADNS/Base.hsc" #-}
  poke ptr t   = let p = castPtr ptr :: Ptr Word32
{-# LINE 159 "ADNS/Base.hsc" #-}
                 in poke p ((toEnum . fromEnum) t)
  peek ptr     = let p = castPtr ptr :: Ptr Word32
{-# LINE 161 "ADNS/Base.hsc" #-}
                 in peek p >>= return . toEnum . fromEnum

-- |The status codes recognized by ADNS vary in different
-- versions of the library. So instead of providing an
-- 'Enum', the 'Status' type contains the numeric value as
-- returned by ADNS itself. For common status codes, helper
-- functions like 'sOK' or 'sNXDOMAIN' are provided. The
-- functions 'adnsErrTypeAbbrev', 'adnsErrAbbrev', and
-- 'adnsStrerror' can also be used to map these codes into
-- human readable strings.

newtype Status  = StatusCode Int
  deriving (Eq, Show)

sOK                    :: Status
sOK                    = StatusCode 0
sNOMEMORY              :: Status
sNOMEMORY              = StatusCode 1
sUNKNOWNRRTYPE         :: Status
sUNKNOWNRRTYPE         = StatusCode 2
sSYSTEMFAIL            :: Status
sSYSTEMFAIL            = StatusCode 3
sMAX_LOCALFAIL         :: Status
sMAX_LOCALFAIL         = StatusCode 29
sTIMEOUT               :: Status
sTIMEOUT               = StatusCode 30
sALLSERVFAIL           :: Status
sALLSERVFAIL           = StatusCode 31
sNORECURSE             :: Status
sNORECURSE             = StatusCode 32
sINVALIDRESPONSE       :: Status
sINVALIDRESPONSE       = StatusCode 33
sUNKNOWNFORMAT         :: Status
sUNKNOWNFORMAT         = StatusCode 34
sMAX_REMOTEFAIL        :: Status
sMAX_REMOTEFAIL        = StatusCode 59
sRCODESERVFAIL         :: Status
sRCODESERVFAIL         = StatusCode 60
sRCODEFORMATERROR      :: Status
sRCODEFORMATERROR      = StatusCode 61
sRCODENOTIMPLEMENTED   :: Status
sRCODENOTIMPLEMENTED   = StatusCode 62
sRCODEREFUSED          :: Status
sRCODEREFUSED          = StatusCode 63
sRCODEUNKNOWN          :: Status
sRCODEUNKNOWN          = StatusCode 64
sMAX_TEMPFAIL          :: Status
sMAX_TEMPFAIL          = StatusCode 99
sINCONSISTENT          :: Status
sINCONSISTENT          = StatusCode 100
sPROHIBITEDCNAME       :: Status
sPROHIBITEDCNAME       = StatusCode 101
sANSWERDOMAININVALID   :: Status
sANSWERDOMAININVALID   = StatusCode 102
sANSWERDOMAINTOOLONG   :: Status
sANSWERDOMAINTOOLONG   = StatusCode 103
sINVALIDDATA           :: Status
sINVALIDDATA           = StatusCode 104
sMAX_MISCONFIG         :: Status
sMAX_MISCONFIG         = StatusCode 199
sQUERYDOMAINWRONG      :: Status
sQUERYDOMAINWRONG      = StatusCode 200
sQUERYDOMAININVALID    :: Status
sQUERYDOMAININVALID    = StatusCode 201
sQUERYDOMAINTOOLONG    :: Status
sQUERYDOMAINTOOLONG    = StatusCode 202
sMAX_MISQUERY          :: Status
sMAX_MISQUERY          = StatusCode 299
sNXDOMAIN              :: Status
sNXDOMAIN              = StatusCode 300
sNODATA                :: Status
sNODATA                = StatusCode 301
sMAX_PERMFAIL          :: Status
sMAX_PERMFAIL          = StatusCode 499

{-# LINE 206 "ADNS/Base.hsc" #-}

-- |Original definition:
--
-- >    typedef struct {
-- >      int len;
-- >      union {
-- >        struct sockaddr sa;
-- >        struct sockaddr_in inet;
-- >      } addr;
-- >    } adns_rr_addr;
--
-- /Note/: Anything but @sockaddr_in@ will cause 'peek' to call 'fail',
-- when marshaling this structure. 'poke' is not defined.

newtype RRAddr = RRAddr HostAddress
  deriving (Eq)

instance Show RRAddr where
  show (RRAddr ha) = shows b1 . ('.':) .
                     shows b2 . ('.':) .
                     shows b3 . ('.':) .
                     shows b4 $ ""
    where
    (b1,b2,b3,b4) = readWord32 ha

instance Storable RRAddr where
  sizeOf _    = (20)
{-# LINE 233 "ADNS/Base.hsc" #-}
  alignment _ = alignment (undefined :: CInt)
  poke _ _    = fail "poke is undefined for Network.DNS.ADNS.RRAddr"
  peek ptr'   = do
    let ptr = (\hsc_ptr -> hsc_ptr `plusPtr` 4) ptr'
{-# LINE 237 "ADNS/Base.hsc" #-}
    t <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr :: IO Word16
{-# LINE 238 "ADNS/Base.hsc" #-}
    if (t /= 2)
{-# LINE 239 "ADNS/Base.hsc" #-}
       then fail ("peek Network.DNS.ADNS.RRAddr: unsupported 'sockaddr' type " ++ show t)
       else (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr >>= return . RRAddr
{-# LINE 241 "ADNS/Base.hsc" #-}

-- |Original definition:
--
-- >    typedef struct {
-- >      char *host;
-- >      adns_status astatus;
-- >      int naddrs; /* temp fail => -1, perm fail => 0, s_ok => >0
-- >      adns_rr_addr *addrs;
-- >    } adns_rr_hostaddr;
--
-- The @naddrs@ field is not available in @RRHostAddr@
-- because I couldn't see how that information wouldn't be
-- available in the @astatus@ field too. If I missed
-- anything, please let me know.
--
-- /Note/: The data type should probably contain
-- 'HostAddress' rather than 'RRAddr'. I'm using the former
-- only because it has nicer output with 'show'. 'poke' is
-- not defined.

data RRHostAddr = RRHostAddr HostName Status [RRAddr]
  deriving (Show)

instance Storable RRHostAddr where
  sizeOf _    = (16)
{-# LINE 266 "ADNS/Base.hsc" #-}
  alignment _ = alignment (undefined :: CString)
  poke _ _    = fail "poke is undefined for Network.DNS.ADNS.RRHostAddr"
  peek ptr    = do
    h <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
{-# LINE 270 "ADNS/Base.hsc" #-}
    hstr <- assert (h /= nullPtr) (peekCString h)
    st <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr :: IO Word32
{-# LINE 272 "ADNS/Base.hsc" #-}
    nadr <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr :: IO CInt
{-# LINE 273 "ADNS/Base.hsc" #-}
    aptr <- (\hsc_ptr -> peekByteOff hsc_ptr 12) ptr
{-# LINE 274 "ADNS/Base.hsc" #-}
    adrs <- if (nadr > 0)
                then peekArray (fromEnum nadr) aptr
                else return []
    return (RRHostAddr hstr (StatusCode (fromEnum st)) adrs)

-- |Original definition:
--
-- >    typedef struct {
-- >      int i;
-- >      adns_rr_hostaddr ha;
-- >    } adns_rr_inthostaddr;

data RRIntHostAddr = RRIntHostAddr Int RRHostAddr
                     deriving (Show)

instance Storable RRIntHostAddr where
    sizeOf _     = (20)
{-# LINE 291 "ADNS/Base.hsc" #-}
    alignment _  = alignment (undefined :: CInt)
    poke _ _     = fail "poke is undefined for Network.DNS.ADNS.RRIntHostAddr"
    peek ptr     = do
      i <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr :: IO CInt
{-# LINE 295 "ADNS/Base.hsc" #-}
      a <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
{-# LINE 296 "ADNS/Base.hsc" #-}
      return (RRIntHostAddr (fromEnum i) a)

-- |Original definition:
--
-- >    typedef struct {
-- >      int len;
-- >      unsigned char *data;
-- >    } adns_rr_byteblock;

data RRByteblock = RRByteblock Int (Ptr CChar)

instance Storable RRByteblock where
    sizeOf _     = (8)
{-# LINE 309 "ADNS/Base.hsc" #-}
    alignment _  = alignment (undefined :: CInt)
    poke _ _     = fail "poke is undefined for Network.DNS.ADNS.RRByteblock"
    peek ptr     = do
      l <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr :: IO CInt
{-# LINE 313 "ADNS/Base.hsc" #-}
      p <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
{-# LINE 314 "ADNS/Base.hsc" #-}
      return (RRByteblock (fromEnum l) p)

-- |Original definition:
--
-- >    typedef struct {
-- >      int priority, weight, port;
-- >      char *host;
-- >    } adns_rr_srvraw;

data RRSrvRaw = RRSrvRaw Int Int Int (Ptr CChar)

instance Storable RRSrvRaw where
    sizeOf _     = (16)
{-# LINE 327 "ADNS/Base.hsc" #-}
    alignment _  = alignment (undefined :: CInt)
    poke _ _     = fail "poke is undefined for Network.DNS.ADNS.RRSrvRaw"
    peek ptr     = do
      pr <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr :: IO CInt
{-# LINE 331 "ADNS/Base.hsc" #-}
      w <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr :: IO CInt
{-# LINE 332 "ADNS/Base.hsc" #-}
      po <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr :: IO CInt
{-# LINE 333 "ADNS/Base.hsc" #-}
      h <- (\hsc_ptr -> peekByteOff hsc_ptr 12) ptr
{-# LINE 334 "ADNS/Base.hsc" #-}
      return (RRSrvRaw (fromEnum pr) (fromEnum w) (fromEnum po) h)

data Answer = Answer
  { status  :: Status
      -- ^ Status code for this query.
  , cname   :: Maybe String
      -- ^ Always 'Nothing' for @CNAME@ queries
  , owner   :: Maybe String
      -- ^ Only set if 'Owner' was requested for query.
  , expires :: CTime
      -- ^ Only defined if status is 'sOK', 'sNXDOMAIN', or 'sNODATA'.
  , rrs     :: [Response]
      -- ^ The list will be empty if an error occured.
  }
  deriving (Show)

data Response
  = RRA RRAddr
  | RRCNAME String
  | RRMX Int RRHostAddr
  | RRNS RRHostAddr
  | RRPTR String
  | RRNSEC String
  | RRUNKNOWN String
  | RRSRV Int Int Int String
  deriving (Show)

instance Storable Answer where
  sizeOf _    = (32)
{-# LINE 363 "ADNS/Base.hsc" #-}
  alignment _ = alignment (undefined :: CInt)
  poke _ _    = fail "poke is not defined for Network.DNS.ADNS.Answer"
  peek ptr    = do
    sc <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr :: IO Word32
{-# LINE 367 "ADNS/Base.hsc" #-}
    cn <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr >>= maybePeek peekCString
{-# LINE 368 "ADNS/Base.hsc" #-}
    ow <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr >>= maybePeek peekCString
{-# LINE 369 "ADNS/Base.hsc" #-}
    et <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
{-# LINE 370 "ADNS/Base.hsc" #-}
    rt <- (\hsc_ptr -> peekByteOff hsc_ptr 12) ptr
{-# LINE 371 "ADNS/Base.hsc" #-}
    rs <- (\hsc_ptr -> peekByteOff hsc_ptr 20) ptr :: IO CInt
{-# LINE 372 "ADNS/Base.hsc" #-}
    sz <- ((\hsc_ptr -> peekByteOff hsc_ptr 24) ptr) :: IO CInt
{-# LINE 373 "ADNS/Base.hsc" #-}
    rrsp <- (\hsc_ptr -> peekByteOff hsc_ptr 28) ptr
{-# LINE 374 "ADNS/Base.hsc" #-}
    r <- peekResp rt rrsp (fromEnum sz) (fromEnum rs)
    return Answer
        { status  = StatusCode (fromEnum sc)
        , cname   = cn
        , owner   = ow
        , expires = et
        , rrs     = r
        }

-- |This function parses the 'Response' union found in
-- 'Answer'. It cannot be defined via 'Storable' because it
-- needs to know the type of the record to expect. This is,
-- by the way, the function to look at, if you want to add
-- support for additional 'RRType' records.

peekResp :: RRType -> Ptr b -> Int -> Int -> IO [Response]
peekResp _ _ _ 0      = return []
peekResp rt ptr off n = do
  r <- parseByType (toEnum $ fromEnum rt)
  rs <- peekResp rt (ptr `plusPtr` off) off (n-1)
  return (r:rs)

  where
  parseByType A   = peek (castPtr ptr) >>= return . RRA . RRAddr
  parseByType NS  = peek (castPtr ptr) >>= return . RRNS
  parseByType PTR = peek (castPtr ptr) >>= peekCString >>= return . RRPTR
  parseByType SRV = do (RRSrvRaw prio weight port host) <- peek (castPtr ptr)
                       host' <- peekCString host
                       return (RRSRV prio weight port host')
  parseByType MX  = do (RRIntHostAddr i addr) <- peek (castPtr ptr)
                       return (RRMX i addr)
  parseByType CNAME = peek (castPtr ptr) >>= peekCString >>= return . RRCNAME
  parseByType NSEC = do RRByteblock len rptr <- peek (castPtr ptr)
                        (name, _) <- peekFQDNAndAdvance rptr len
  	      	     	return $ RRNSEC name
  parseByType (RRType _) = do RRByteblock len rptr <- peek (castPtr ptr)
                              str <- peekCStringLen (rptr, len)
                              return $ RRUNKNOWN str


-- |This function parses a FQDN in uncompressed wire format and advances
-- the pointer to the next byte after the parsed name.

peekFQDNAndAdvance :: Ptr a -> Int -> IO (String, Ptr a)
peekFQDNAndAdvance ptr _ = do
  cc <- peek (castPtr ptr :: Ptr CChar)
  let ptr1 = ptr `plusPtr` 1
  case fromEnum cc of
    c | c == 0 -> return ("", ptr1)
      | c < 64 -> do name <- peekCStringLen (castPtr ptr1, c)
    	       	     (zone, ptr2) <- peekFQDNAndAdvance (ptr1 `plusPtr` c) 0
		     return (name ++ "." ++ zone, ptr2)
      | otherwise -> error "Compressed FQDN must not occur here."



-- * ADNS Library Functions

-- |Run the given 'IO' computation with an initialized
-- resolver. As of now, the diagnose stream is always set to
-- 'System.IO.stderr'. Initialize the library with 'NoErrPrint' if you
-- don't wont to see any error output. All resources are
-- freed when @adnsInit@ returns.

adnsInit :: [InitFlag] -> (AdnsState -> IO a) -> IO a
adnsInit flags =
  bracket
    (wrapAdns (\p -> adns_init p (mkFlags flags) nullPtr) peek)
    adns_finish

-- |Similar to 'adnsInit', but reads the resolver
-- configuration from a string rather than from
-- @\/etc\/resolv.conf@. Supported are the usual commands:
-- @nameserver@, @search@, @domain@, @sortlist@, and
-- @options@.
--
-- Additionally, these non-standard commands may be used:
--
--  * @clearnameservers@: Clears the list of nameservers.
--
--  * @include filename@: The specified file will be read.

adnsInitCfg :: [InitFlag] -> String -> (AdnsState -> IO a) -> IO a
adnsInitCfg flags cfg = bracket mkState adns_finish
  where
  mkState = withCString cfg $ \cstr ->
              wrapAdns
                (\p -> adns_init_strcfg p (mkFlags flags) nullPtr cstr)
                peek

-- |Perform a synchronous query for a record. In case of an
-- I\/O error, an 'System.IO.Error.IOException' is thrown.
-- If the query fails for other reasons, the 'Status' code
-- in the 'Answer' will signify that.

adnsSynch :: AdnsState -> String -> RRType -> [QueryFlag] -> IO Answer
adnsSynch st own rrt flags =
  withCString own $ \o -> do
    let rrt' = (toEnum . fromEnum) rrt
    wrapAdns
        (adns_synchronous st o rrt' (mkFlags flags))
        (\p -> peek p >>= peek)

-- |Submit an asynchronous query. The returned 'Query' can
-- be tested for completion with 'adnsCheck'.

adnsSubmit :: AdnsState -> String -> RRType -> [QueryFlag] -> IO Query
adnsSubmit st own rrt flags =
  withCString own $ \o -> do
    let rrt' = (toEnum . fromEnum) rrt
    wrapAdns
        (adns_submit st o rrt' (mkFlags flags) nullPtr)
        (peek)

-- |Check the status of an asynchronous query. If the query
-- is complete, the 'Answer' will be returned. The 'Query'
-- becomes invalid after that.

adnsCheck :: AdnsState -> Query -> IO (Maybe Answer)
adnsCheck st q =
  alloca $ \qPtr ->
  alloca $ \aPtr -> do
    poke qPtr q
    poke aPtr nullPtr
    rc <- adns_check st qPtr aPtr nullPtr
    case rc of
      0               -> peek aPtr >>= peek >>= return . Just
      11 -> return Nothing
{-# LINE 502 "ADNS/Base.hsc" #-}
      _               -> do p <- adns_strerror rc
                            s <- peekCString p
                            fail ("adnsCheck: " ++ s)

-- |Wait for a response to arrive. The returned 'Query' is
-- invalid and must not be passed to ADNS again. If 'Nothing' is
-- returned, the resolver is empty.

adnsWait :: AdnsState -> IO (Maybe (Query,Answer))
adnsWait st =
  alloca $ \qPtr ->
    alloca $ \aPtr -> do
      poke qPtr nullPtr
      poke aPtr nullPtr
      rc <- adns_wait st qPtr aPtr nullPtr
      case rc of
        0              -> do q <- peek qPtr
                             a' <- peek aPtr
                             a <- peek a'
                             free a'
                             return (Just (q,a))
        3 -> return Nothing
{-# LINE 524 "ADNS/Base.hsc" #-}
        _              -> do p <- adns_strerror rc
                             s <- peekCString p
                             fail ("adnsWait: " ++ s)

-- |Cancel an open 'Query'.

foreign import ccall unsafe "adns_cancel" adnsCancel :: Query -> IO ()

-- |Wait for the next 'Query' to become available.

foreign import ccall safe adns_wait ::
  AdnsState -> Ptr Query -> Ptr (Ptr Answer) -> Ptr (Ptr a) -> IO CInt

-- |Return the list of all currently open queries.

adnsQueries :: AdnsState -> IO [Query]
adnsQueries st = adns_forallqueries_begin st >> walk
  where walk   = do q <- adns_forallqueries_next st nullPtr
                    if (q /= nullPtr)
                       then walk >>= return . ((:) q)
                       else return []


-- |Map a 'Status' code to a human-readable error
-- description. For example:
--
-- >    *ADNS> adnsStrerror sNXDOMAIN >>= print
-- >    "No such domain"
--
-- Use this function with great care: It will crash the
-- process when called with a status code that ADNS doesn't
-- know about. So use it only to print values you got from
-- the resolver!

adnsStrerror :: Status -> IO String
adnsStrerror (StatusCode x) = do
  cstr <- (adns_strerror . toEnum . fromEnum) x
  assert (cstr /= nullPtr) (peekCString cstr)

-- |Map a 'Status' code to a short error name. Don't use
-- this function to print a status code unless you've
-- obtained it from the resolver!

adnsErrAbbrev :: Status -> IO String
adnsErrAbbrev (StatusCode x) = do
  cstr <- (adns_errabbrev . toEnum . fromEnum) x
  assert (cstr /= nullPtr) (peekCString cstr)

-- |Map a 'Status' code to a short description of the type
-- of error. Don't use this function to print a status code
-- unless you've obtained it from the resolver!

adnsErrTypeAbbrev :: Status -> IO String
adnsErrTypeAbbrev (StatusCode x) = do
  cstr <- (adns_errtypeabbrev . toEnum . fromEnum) x
  assert (cstr /= nullPtr) (peekCString cstr)

-- * Unmarshaled Low-Level C Functions

foreign import ccall unsafe adns_init ::
  Ptr AdnsState -> CInt -> Ptr CFile -> IO CInt

foreign import ccall unsafe adns_init_strcfg ::
  Ptr AdnsState -> CInt -> Ptr CFile -> CString-> IO CInt

foreign import ccall unsafe adns_finish ::
  AdnsState -> IO ()

foreign import ccall unsafe adns_submit ::
  AdnsState -> CString -> CInt -> CInt -> Ptr a -> Ptr Query
  -> IO CInt

foreign import ccall unsafe adns_check ::
  AdnsState -> Ptr Query -> Ptr (Ptr Answer) -> Ptr (Ptr a)
  -> IO CInt

foreign import ccall unsafe adns_synchronous ::
  AdnsState -> CString -> CInt -> CInt -> Ptr (Ptr Answer)
  -> IO CInt

foreign import ccall unsafe adns_forallqueries_begin ::
  AdnsState -> IO ()

foreign import ccall unsafe adns_forallqueries_next ::
  AdnsState -> Ptr (Ptr a) -> IO Query

foreign import ccall unsafe adns_strerror      :: CInt -> IO CString
foreign import ccall unsafe adns_errabbrev     :: CInt -> IO CString
foreign import ccall unsafe adns_errtypeabbrev :: CInt -> IO CString

-- * Helper Functions

-- |Internel helper function to handle result passing from
-- ADNS via @Ptr (Ptr a)@, and to generate human-readable IO
-- exceptions in case of an error.

wrapAdns :: (Ptr (Ptr b) -> IO CInt) -> (Ptr (Ptr b) -> IO a) -> IO a
wrapAdns m acc  = alloca $ \resP -> do
  poke resP nullPtr
  rc <- m resP
  if (rc == 0)
     then acc resP
     else do p <- adns_strerror rc
             s <- peekCString p
             fail ("ADNS: " ++ s)

-- |Map a list of flags ('Enum' types) into a 'CInt'
-- suitable for adns calls.

mkFlags :: Enum a => [a] -> CInt
mkFlags = toEnum . sum . map fromEnum


-- ----- Configure Emacs -----
--
-- Local Variables: ***
-- haskell-program-name: "ghci -ladns" ***
-- End: ***