{-# LINE 1 "src/Network/Protocol/NetSNMP.hsc" #-}

{-# LINE 2 "src/Network/Protocol/NetSNMP.hsc" #-}
{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-}

----------------------------------------------------------------------
-- |
-- Module      : Network.Protocol.NetSNMP
-- Copyright   : 2009 John Dorsey
-- 
-- Maintainer  : John Dorsey <haskell@colquitt.org>
-- Portability : portable
-- Stability   : provisional
-- 
-- This is a binding to Net-SNMP version 5, <http://www.net-snmp.org/>.

-- FIXME:
--   issue better errors using info from snmpError and snmpSessError
--   make better use of catchT
--   write bracketT

{- License: BSD3.  See included LICENSE and README files. -}

module Network.Protocol.NetSNMP (
  -- * Types
  ASNValue(..), SnmpResult(..), SnmpVersion(..),
  Hostname, Community,
  -- * Constants
  snmp_version_1, snmp_version_2c, snmp_version_3,
  -- * Functions
  -- ** Library Initialization
  initialize,
  -- ** Queries
  snmpGet, snmpNext, snmpWalk,
  -- ** Miscellany
  showASNValue,
  -- 
  -- Unexposed:
  --
  -- Trouble(..), SnmpSession, SnmpPDU, OIDPart, readyCommunitySession,
  -- snmp_msg_get, rawvar2cstring, buildPDU, max_oid_len, snmp_stat_success,
  -- snmp_err_noerror, extractVar,
  -- c_init_snmp, c_snmp_sess_init, c_snmp_sess_open, c_snmp_sess_session,
  -- c_snmp_pdu_create, c_get_node, c_read_objid, c_snmp_parse_oid,
  -- c_snmp_add_null_var, c_snmp_sess_synch_response, c_snmp_free_pdu,
  -- c_snmp_sess_close, c_snmp_sess_send, c_print_variable, c_snprint_by_type,
  -- t_init_snmp, t_snmp_sess_init, t_snmp_sess_open, t_snmp_sess_session,
  -- t_snmp_pdu_create, t_get_node, t_read_objid, t_snmp_parse_oid,
  -- t_snmp_add_null_var, t_snmp_sess_synch_response, t_snmp_free_pdu,
  -- t_snmp_sess_close, t_snmp_sess_send, t_print_variable, t_snprint_by_type,
  )
where

import Control.Applicative
import Control.Monad
import Data.List
import Foreign
import Foreign.C.String
import Foreign.C.Types
import Foreign.ForeignPtr
-- import System.IO


{-# LINE 62 "src/Network/Protocol/NetSNMP.hsc" #-}

{-# LINE 63 "src/Network/Protocol/NetSNMP.hsc" #-}

--
-- types and constants
--

-- max length of description string returned from the library
-- this can be safely tweaked up or down
max_string_len = 1023

-- Haskell-land session info, including various C snmp_session pointers
-- and session parameters.  Meeting place for managing session memory.
data Session = Session
  { getVersion       :: SnmpVersion
  , getSession       :: ForeignPtr SnmpSession
  , getSessp         :: Ptr SnmpSession
  , getSptr          :: Ptr SnmpSession
  , sessionHostname  :: ForeignPtr CChar
  , sessionCommunity :: ForeignPtr CChar
  }

data SnmpSession                           -- C struct snmp_session
instance Storable SnmpSession where
  sizeOf    _ = (248)
{-# LINE 86 "src/Network/Protocol/NetSNMP.hsc" #-}
  alignment _ = 16

data SnmpPDU                               -- C struct snmp_pdu
instance Storable SnmpPDU where
  sizeOf    _ = (144)
{-# LINE 91 "src/Network/Protocol/NetSNMP.hsc" #-}
  alignment _ = 16


{-# LINE 96 "src/Network/Protocol/NetSNMP.hsc" #-}
type OIDpart = CULong

{-# LINE 98 "src/Network/Protocol/NetSNMP.hsc" #-}

-- I don't know whether (or which of) net-snmp's library functions
-- account for bytesex; there may be endian bugs lurking here.
data CVarList                           -- C struct variable_list

-- |Typed representation of atomic ASN.1 data types.  Some types are
--     returned in more than one format for different uses.  Some
--     include a descriptive string built by the underlying C library.
data ASNValue
  = OctetString String [Word8] -- ^@ASN_OCTET_STR@ Returned as a character
                               --     string, and as opaque data.
  | OID String String [Word32] -- ^@ASN_OBJECT_ID@ Returned as the C library's
                               --     description, a dotted-decimal string, and
                               --     a numeric list
  | Integer32   Int32          -- ^@ASN_INTEGER@  32bit signed
  | Integer64   Int64          -- ^@ASN_INTEGER64@  64bit signed
  | Counter32   Word32         -- ^@ASN_COUNTER@ 32bit nondecreasing
  | Counter64   Word64         -- ^@ASN_COUNTER64@ 64bit nondecreasing
  | Unsigned32  Word32         -- ^@ASN_UNSIGNED@ 32bit unsigned
  | Unsigned64  Word64         -- ^@ASN_UNSIGNED64@ 64bit unsigned
  | Gauge32     Word32         -- ^@ASN_GAUGE@ 32bit signed with min and max
  | IpAddress   String [Word8] -- ^@ASN_IPADDRESS@ IP address in string
                               --     and numeric form. Example:
                               --     (IpAddress \"1.2.3.4\" [1,2,3,4])
  | Opaque      [Word8]        -- ^@ASN_OPAQUE@ (Deprecated) application
                               --     specific data.  Use OctetString instead.
  | TimeTicks   String Word32  -- ^@ASN_TIMETICKS@ Time interval in 1/100 sec
                               --     ticks.  The C library's description is
                               --     returned along with the raw value.
  | Boolean     Bool           -- ^@ASN_BOOLEAN@ Unimplemented.
  | IEEEFloat   Float          -- ^@ASN_FLOAT@ IEEE float. Unimplemented.
  | IEEEDouble  Double         -- ^@ASN_DOUBLE@ IEEE double. Unimplemented.
  | Null                       -- ^@ASN_NULL@ Null value
  | Unsupported Int String     -- ^Unsupported type from an agent.  Returns
                               --     the numeric type and the C library's
                               --     description of the value.
  deriving (Eq, Show)

-- |An SNMP value together with its OID.  Returned by the query
--     routines 'snmpGet', 'snmpNext', and 'snmpWalk'.
data SnmpResult  = SnmpResult {
  oid   :: String,             -- ^Dotted-decimal ObjectId of the value
  value :: ASNValue            -- ^Typed representation of the value
  } deriving (Eq, Show)

-- |SNMP Protocol version.  It is recommended to use the constants
-- 'snmp_version_1', 'snmp_version_2c', and 'snmp_version_3'.
newtype SnmpVersion = SnmpVersion {
  unSnmpVersion :: CLong -- ^Numeric version.  Generally unneeded.
  } deriving (Eq, Show)

type Hostname  = String
type Community = String

-- SNMP protocol versions, omitting those that will never be supported
-- (see README)
-- I'd prefer to use the more compact #{enum} in place of multiple
-- #{const}'s, but I don't know how to mix #{enum} with haddock.
-- #{enum SnmpVersion, SnmpVersion
--   , snmp_version_1  = SNMP_VERSION_1
--   , snmp_version_2c = SNMP_VERSION_2c
--   , snmp_version_3  = SNMP_VERSION_3
--   }

-- |SNMPv1. The first SNMP standard, using cleartext passwords
--     (\"communities\")
snmp_version_1  :: SnmpVersion
snmp_version_1   = SnmpVersion 0
{-# LINE 166 "src/Network/Protocol/NetSNMP.hsc" #-}

-- |SNMPv2c. Updated SMI and wire protocol, but still uses communities.
snmp_version_2c :: SnmpVersion
snmp_version_2c  = SnmpVersion 1
{-# LINE 170 "src/Network/Protocol/NetSNMP.hsc" #-}

-- |SNMPv3. Same SMI and protocol as SNMPv2c; stronger authentication.
--     Unimplemented.
snmp_version_3  :: SnmpVersion
snmp_version_3   = SnmpVersion 3
{-# LINE 175 "src/Network/Protocol/NetSNMP.hsc" #-}


-- |ASN.1 constants from snmp_impl.h and asn1.h
asn_boolean       :: CUChar
asn_boolean       =  1
asn_integer       :: CUChar
asn_integer       =  2
asn_bit_str       :: CUChar
asn_bit_str       =  3
asn_octet_str     :: CUChar
asn_octet_str     =  4
asn_null          :: CUChar
asn_null          =  5
asn_object_id     :: CUChar
asn_object_id     =  6
asn_sequence      :: CUChar
asn_sequence      =  16
asn_set           :: CUChar
asn_set           =  17
asn_universal     :: CUChar
asn_universal     =  0
asn_application   :: CUChar
asn_application   =  64
asn_context       :: CUChar
asn_context       =  128
asn_private       :: CUChar
asn_private       =  192
asn_primitive     :: CUChar
asn_primitive     =  0
asn_constructor   :: CUChar
asn_constructor   =  32
asn_long_len      :: CUChar
asn_long_len      =  128
asn_extension_id  :: CUChar
asn_extension_id  =  31
asn_bit8          :: CUChar
asn_bit8          =  128
asn_ipaddress     :: CUChar
asn_ipaddress     =  64
asn_counter       :: CUChar
asn_counter       =  65
asn_gauge         :: CUChar
asn_gauge         =  66
asn_unsigned      :: CUChar
asn_unsigned      =  66
asn_timeticks     :: CUChar
asn_timeticks     =  67
asn_opaque        :: CUChar
asn_opaque        =  68
asn_nsap          :: CUChar
asn_nsap          =  69
asn_counter64     :: CUChar
asn_counter64     =  70
asn_uinteger      :: CUChar
asn_uinteger      =  71
asn_float         :: CUChar
asn_float         =  72
asn_double        :: CUChar
asn_double        =  73
asn_integer64     :: CUChar
asn_integer64     =  74
asn_unsigned64    :: CUChar
asn_unsigned64    =  75

{-# LINE 210 "src/Network/Protocol/NetSNMP.hsc" #-}

-- PDUType:           used with:   v1   v2c    v3
-- SNMP_MSG_GET                   Yes   Yes   Yes
-- SNMP_MSG_GETNEXT               Yes   Yes   Yes
-- SNMP_MSG_RESPONSE              Yes   Yes   Yes
-- SNMP_MSG_SET                   Yes   Yes   Yes
-- SNMP_MSG_TRAP                  Yes    -     - 
-- SNMP_MSG_GETBULK                -    Yes   Yes
-- SNMP_MSG_INFORM                 -    Yes   Yes
-- SNMP_MSG_TRAP2                  -    Yes   Yes
-- SNMP_MSG_REPORT                 -     -    Yes
newtype SnmpPDUType = SnmpPDUType { unSnmpPDUType :: CInt }
snmp_msg_get       :: SnmpPDUType
snmp_msg_get       = SnmpPDUType 160
snmp_msg_getnext   :: SnmpPDUType
snmp_msg_getnext   = SnmpPDUType 161
snmp_msg_response  :: SnmpPDUType
snmp_msg_response  = SnmpPDUType 162
snmp_msg_set       :: SnmpPDUType
snmp_msg_set       = SnmpPDUType 163
snmp_msg_trap      :: SnmpPDUType
snmp_msg_trap      = SnmpPDUType 164
snmp_msg_getbulk   :: SnmpPDUType
snmp_msg_getbulk   = SnmpPDUType 165
snmp_msg_inform    :: SnmpPDUType
snmp_msg_inform    = SnmpPDUType 166
snmp_msg_trap2     :: SnmpPDUType
snmp_msg_trap2     = SnmpPDUType 167
snmp_msg_report    :: SnmpPDUType
snmp_msg_report    = SnmpPDUType 168

{-# LINE 233 "src/Network/Protocol/NetSNMP.hsc" #-}

-- Miscellaneous return codes
-- NB: zero return is success in some functions, failure in others,
--   both within this api.

snmp_stat_success  :: CInt
snmp_stat_success  =  0
snmp_err_noerror   :: CInt
snmp_err_noerror   =  0

{-# LINE 242 "src/Network/Protocol/NetSNMP.hsc" #-}

max_oid_len = 128 :: CInt
{-# LINE 244 "src/Network/Protocol/NetSNMP.hsc" #-}

--
-- The Haskell abstraction layer
--

-- |Initialize the Net-SNMP library.  This must be called before any
-- other NetSNMP functions, and before starting extra threads, as the
-- mib compiler is not thread-safe.
initialize :: IO ()
initialize = withCString "Haskell bindings" c_init_snmp

-- |Create an abstract session, suitable for reuse, responsible
-- for freeing the string components
readyCommunitySession
  :: SnmpVersion
  -> Hostname
  -> Community
  -> Trouble Session         -- return abstract session
readyCommunitySession version hostname community = do
  session           <- mallocT
  hostname_cstr     <- hoistT $ newCString hostname
  community_cstr    <- hoistT $ newCString community
  community_len     <- t_strlen community_cstr
  session_foreign   <- hoistT $ newForeignPtr finalizerFree session
  hostname_foreign  <- hoistT $ newForeignPtr finalizerFree hostname_cstr
  community_foreign <- hoistT $ newForeignPtr finalizerFree community_cstr
  t_snmp_sess_init session
  pokeSessPeername  session hostname_cstr
  pokeSessVersion   session (unSnmpVersion version)
  pokeSessCommunity session community_cstr
  pokeSessCommLen   session community_len
  sessp <- t_snmp_sess_open session
  sptr <- t_snmp_sess_session sessp
  return $ Session version session_foreign sessp sptr
              hostname_foreign community_foreign

-- |Immediately destroy/free the Session.
closeSession :: Session -> Trouble ()
closeSession session = hoistT $ do
  c_snmp_sess_close (getSessp session)
  finalizeForeignPtr (sessionCommunity session)
  finalizeForeignPtr (sessionHostname  session)
  finalizeForeignPtr (getSession       session)

-- |Simple community-authenticated SNMP get.  Returns the object
--     queried, or a descriptive error message.
--
-- Examples:
--
-- * snmpGet \"localhost\" \"public\" \".1.3.6.1.2.1.1.1.0\"
--
-- * snmpGet \"tcp:localhost:5161\" \"mypassword\" \".1.3.6.1.2.1.1.1.0\"
snmpGet
  :: SnmpVersion -- ^'snmp_version_1' or 'snmp_version_2c'
  -> Hostname    -- ^IP or hostname of the agent to be queried.  May have
                 --     prefix of @tcp:@ or suffix of @:port@
  -> Community   -- ^SNMP community (password)
  -> String      -- ^OID to be queried
  -> IO (Either String SnmpResult)
snmpGet version hostname community oid = runTrouble $ bracketT
  (readyCommunitySession version hostname community) -- session
  closeSession
  (flip (mkSnmpGet snmp_msg_get) oid)

-- |Simple community-authenticated SNMP getnext.  Returns the first object
--     after the OID queried, or a descriptive error message.
--
-- Examples:
--
-- * snmpNext \"localhost\" \"public\" \".1.3.6.1.2.1.1.1.0\"
--
-- * snmpNext \"tcp:localhost:5161\" \"mypassword\" \".1.3.6.1.2.1.1.1.0\"
snmpNext
  :: SnmpVersion -- ^'snmp_version_1' or 'snmp_version_2c'
  -> Hostname    -- ^IP or hostname of the agent to be queried.  May have
                 --     prefix of @tcp:@ or suffix of @:port@
  -> Community   -- ^SNMP community (password)
  -> String      -- ^OID to be queried
  -> IO (Either String SnmpResult)
snmpNext version hostname community oid = runTrouble $ bracketT
  (readyCommunitySession version hostname community) -- session
  closeSession
  (flip (mkSnmpGet snmp_msg_getnext) oid)

-- |Simple community-authenticated SNMP walk.  Returns a list of objects,
--     starting with the object after the OID queried, and continuing
--     through all objects underneath that OID in the mib tree.
--     On failure, returns a descriptive error message.
--
-- The current implementation uses a series of next operations, but an
-- implementation using bulk requests would be more efficient.
--
-- Examples:
--
-- * snmpWalk \"localhost\" \"public\" \".1.3.6.1.2.1.1\"
--
-- * snmpWalk \"tcp:localhost:5161\" \"mypassword\" \".1.3.6.1.2.1.1\"
snmpWalk
  :: SnmpVersion -- ^'snmp_version_1' or 'snmp_version_2c'
  -> Hostname    -- ^IP or hostname of the agent to be queried.  May have
                 --     prefix of @tcp:@ or suffix of @:port@
  -> Community   -- ^SNMP community (password)
  -> String      -- ^OID to be queried
  -> IO (Either String [SnmpResult])
snmpWalk version hostname community walkoid = runTrouble $ bracketT
    (readyCommunitySession version hostname community) -- session
    closeSession
    (go walkoid . mkSnmpGet snmp_msg_getnext)
  where
    go :: String -> (String -> Trouble SnmpResult) -> Trouble [SnmpResult]
    go oid next = do
      v@(SnmpResult nextoid val) <- next oid
      case () of
        _ | nextoid == oid -> return [] -- throwT "end of mib" -- return []
          | walkoid `isPrefixOf` nextoid -> do
            vs <- go nextoid next
            return (v:vs)
          | otherwise -> return [] -- throwT "end of walk" -- return []

-- get or getnext, using session info from a 'data Session' and
-- the supplied oid
-- It is the caller's obligation to ensure the session's validity.
mkSnmpGet :: SnmpPDUType -> Session -> String -> Trouble SnmpResult
mkSnmpGet pdutype session oid =
  allocaT $ \response_ptr -> do
  allocaArrayT (fromIntegral max_oid_len) $ \oids -> do
  let version = getVersion session
  let sessp = getSessp session
  let sptr = getSptr session
  pokeT response_ptr nullPtr -- probably not needed
  pdu_req <- buildPDU pdutype oid oids version
  t_snmp_sess_synch_response sessp sptr pdu_req response_ptr
  pdu_resp <- peekT response_ptr
  errstat <- peekPDUErrstat pdu_resp
  when (errstat /= snmp_err_noerror) (throwT "response PDU error")
  rawvars <- peekPDUVariables pdu_resp
  vars <- extractVar rawvars
  unless (pdu_resp == nullPtr) $ t_snmp_free_pdu pdu_resp >> return ()
  return vars

-- caller is obliged to ensure rv is valid and non-null
vlist2oid :: Ptr CVarList -> Trouble String
vlist2oid rv = do
  oidptr <- peekVariableName rv
  len    <- peekVariableLen  rv
  oids   <- peekArrayT (fromIntegral len) oidptr :: Trouble [OIDpart]
  return $ concatMap (('.':) . show) oids

extractVars :: Ptr CVarList -> Trouble [SnmpResult]
extractVars rv
  | rv == nullPtr = return []
  | otherwise = do
    v <- extractVar rv
    nextrv <- peekVariableNext rv
    vs <- extractVars nextrv
    return (v : vs)

extractVar :: Ptr CVarList -> Trouble SnmpResult
extractVar rv = do
  oid <- vlist2oid rv
  t <- peekVariableType rv
  v <- case () of
    _ | t == asn_octet_str    -> extractOctetStr     rv
    _ | t == asn_ipaddress    -> extractIpAddress    rv
    _ | t == asn_counter      -> extractIntegralType rv Counter32
    _ | t == asn_gauge        -> extractIntegralType rv Gauge32
    _ | t == asn_timeticks    -> extractTimeTicks    rv
    _ | t == asn_opaque       -> extractOpaque       rv
    _ | t == asn_integer      -> extractIntegralType rv Integer32
    _ | t == asn_unsigned     -> extractIntegralType rv Unsigned32
    _ | t == asn_counter64    -> extractIntegralType rv Counter64
    _ | t == asn_integer64    -> extractIntegralType rv Integer64
    _ | t == asn_unsigned64   -> extractIntegralType rv Unsigned64
    _ | t == asn_object_id    -> extractOID          rv
    -- _ | t == asn_boolean      -> extractBoolean      rv
    -- _ | t == asn_double       -> extractDouble       rv
    -- _ | t == asn_float        -> extractFloat        rv
    _ | t == asn_null         -> return Null
    _ -> do
          descr <- rawvar2cstring rv
          return $ Unsupported (fromIntegral t) descr
  return (SnmpResult oid v)

extractOctetStr rv = do
  ptr <- peekVariableValString rv
  len <- peekVariableValLen rv
  s <- peekCStringLenT (ptr , (fromIntegral len))
  octets <- peekArrayT (fromIntegral len) (castPtr ptr)
  return (OctetString s octets)

extractOpaque rv = do
  ptr <- peekVariableValBits rv
  len <- peekVariableValLen rv
  arr <- peekArrayT (fromIntegral len) ptr
  return (Opaque (map fromIntegral arr))

extractIntegralType rv constructor = do
  intptr <- peekVariableValInt rv
  n <- fromIntegral <$> peekT intptr
  return (constructor n)

extractIpAddress rv = do
  ptr <- peekVariableValInt rv
  octets <- peekArrayT 4 (castPtr ptr) :: Trouble [Word8]
  let str = foldr1 (\a b -> (a++"."++b)) (map show octets)
  return (IpAddress str octets)

extractOID :: Ptr CVarList -> Trouble ASNValue
extractOID rv = do
  oidptr <- peekVariableValObjid rv :: Trouble (Ptr OIDpart)
  len <- peekVariableValLen rv
  let oidlen = (fromIntegral len) `div` (4)
{-# LINE 456 "src/Network/Protocol/NetSNMP.hsc" #-}
  oids <- peekArrayT oidlen oidptr :: Trouble [OIDpart]
  let str = concatMap (('.':) . show) oids
  descr <- rawvar2cstring rv
  return (OID descr str (map fromIntegral oids))

extractTimeTicks rv = do
  intptr <- peekVariableValInt rv
  ticks <- fromIntegral <$> peekT intptr
  descr <- rawvar2cstring rv
  return (TimeTicks descr ticks)

-- |Show ASNValue contents in a simple string, losing type differentiation.
--     Callers should not rely on the format of the message returned,
--     and this function may disappear in a future version.
showASNValue :: ASNValue -> String
showASNValue v = case v of
  OctetString s _     -> s
  IpAddress   s _     -> s
  Counter32   c       -> show c 
  Gauge32     c       -> show c 
  OID         d os ol -> os
  Opaque      cs      -> show cs
  Integer32   c       -> show c
  Unsigned32  c       -> show c 
  Counter64   c       -> show c 
  Integer64   c       -> show c
  Unsigned64  c       -> show c 
  TimeTicks   s _     -> s
  Boolean     c       -> show c
  IEEEDouble  c       -> show c
  IEEEFloat   c       -> show c
  Null                -> "ASN_NULL"
  Unsupported t s     -> "Unknown type " ++ show t ++ ": " ++ s

buildPDU
  :: SnmpPDUType  -- eg. snmp_msg_get
  -> String       -- eg. ".1.3.6.1.2.1.1.1.0"
  -> Ptr OIDpart  -- OIDpart array passed in b/c I don't know when it dallocs
  -> SnmpVersion  -- eg. snmp_version_1 or snmp_version_2c
  -> Trouble (Ptr SnmpPDU) -- returns pdu and oid length
buildPDU pdutype oid oids version =
  withCStringT oid $ \oid_cstr   ->
  allocaT          $ \oidlen_ptr -> do
    pdu_req <- t_snmp_pdu_create pdutype
    pokePDUVersion pdu_req (unSnmpVersion version)
    pokePDUCommand pdu_req (unSnmpPDUType pdutype)
    pokeT oidlen_ptr (fromIntegral max_oid_len)
    t_read_objid oid_cstr oids oidlen_ptr    -- or t_get_node
    oidlen <- peekT oidlen_ptr
    t_snmp_add_null_var pdu_req oids oidlen
    return pdu_req

rawvar2cstring :: Ptr CVarList -> Trouble String
rawvar2cstring rv =
  allocaArray0T max_string_len $ \buf -> do
  rc <- t_snprint_by_type buf (fromIntegral max_string_len) rv
          nullPtr nullPtr nullPtr
  peekCStringT buf

allocaT :: (Storable a) => (Ptr a -> Trouble b) -> Trouble b
allocaT f = Trouble $ alloca $ \p -> runTrouble (f p)

allocaArrayT :: (Storable a) => Int -> (Ptr a -> Trouble b) -> Trouble b
allocaArrayT n f = Trouble $ allocaArray n $ \p -> runTrouble (f p)

allocaArray0T :: (Storable a) => Int -> (Ptr a -> Trouble b) -> Trouble b
allocaArray0T n f = Trouble $ allocaArray0 n $ \p -> runTrouble (f p)

withCStringT :: String -> (CString -> Trouble b) -> Trouble b
withCStringT s f = Trouble $ withCString s $ \p -> runTrouble (f p)

peekCStringT    = hoistT1 peekCString
peekCStringLenT = hoistT1 peekCStringLen

-- Is it worth putting the error check here?  No, for now.
mallocT :: (Storable a) => Trouble (Ptr a)
mallocT       = hoistT  malloc

mallocArrayT :: (Storable a) => Int -> Trouble (Ptr a)
mallocArrayT  = hoistT1 mallocArray

mallocArray0T :: (Storable a) => Int -> Trouble (Ptr a)
mallocArray0T = hoistT1 mallocArray0

peekT :: (Storable a) => Ptr a -> Trouble a
peekT = hoistT1 peek

pokeT :: (Storable a) => Ptr a -> a -> Trouble ()
pokeT = hoistT2 poke

peekArrayT :: (Storable a) => Int -> Ptr a -> Trouble [a]
peekArrayT = hoistT2 peekArray

peekPDUErrstat :: Ptr SnmpPDU -> Trouble CInt
peekPDUErrstat p = hoistT $ (\hsc_ptr -> peekByteOff hsc_ptr 24) p
{-# LINE 551 "src/Network/Protocol/NetSNMP.hsc" #-}

peekPDUVariables :: Ptr SnmpPDU -> Trouble (Ptr CVarList)
peekPDUVariables p = hoistT $ (\hsc_ptr -> peekByteOff hsc_ptr 68) p
{-# LINE 554 "src/Network/Protocol/NetSNMP.hsc" #-}

peekVariableName :: Ptr CVarList -> Trouble (Ptr OIDpart)
peekVariableName rv = hoistT $ (\hsc_ptr -> peekByteOff hsc_ptr 4) rv
{-# LINE 557 "src/Network/Protocol/NetSNMP.hsc" #-}

peekVariableLen :: Ptr CVarList -> Trouble CSize
peekVariableLen rv = hoistT $ (\hsc_ptr -> peekByteOff hsc_ptr 8) rv
{-# LINE 560 "src/Network/Protocol/NetSNMP.hsc" #-}

peekVariableNext :: Ptr CVarList -> Trouble (Ptr CVarList)
peekVariableNext rv = hoistT $ (\hsc_ptr -> peekByteOff hsc_ptr 0) rv
{-# LINE 563 "src/Network/Protocol/NetSNMP.hsc" #-}

peekVariableType :: Ptr CVarList -> Trouble CUChar
peekVariableType rv = hoistT $ (\hsc_ptr -> peekByteOff hsc_ptr 12) rv
{-# LINE 566 "src/Network/Protocol/NetSNMP.hsc" #-}

peekVariableValBits :: Ptr CVarList -> Trouble (Ptr CUChar)
peekVariableValBits rv = hoistT $ (\hsc_ptr -> peekByteOff hsc_ptr 16) rv
{-# LINE 569 "src/Network/Protocol/NetSNMP.hsc" #-}

peekVariableValInt :: Ptr CVarList -> Trouble (Ptr CLong)
peekVariableValInt rv = hoistT $ (\hsc_ptr -> peekByteOff hsc_ptr 16) rv
{-# LINE 572 "src/Network/Protocol/NetSNMP.hsc" #-}

peekVariableValString :: Ptr CVarList -> Trouble CString
peekVariableValString rv = hoistT $ (\hsc_ptr -> peekByteOff hsc_ptr 16) rv
{-# LINE 575 "src/Network/Protocol/NetSNMP.hsc" #-}

peekVariableValObjid :: Ptr CVarList -> Trouble (Ptr OIDpart)
peekVariableValObjid rv = hoistT $ (\hsc_ptr -> peekByteOff hsc_ptr 16) rv
{-# LINE 578 "src/Network/Protocol/NetSNMP.hsc" #-}

peekVariableValLen :: Ptr CVarList -> Trouble CSize
peekVariableValLen rv = hoistT $ (\hsc_ptr -> peekByteOff hsc_ptr 20) rv
{-# LINE 581 "src/Network/Protocol/NetSNMP.hsc" #-}

pokeSessPeername  :: Ptr SnmpSession -> CString -> Trouble ()
pokeSessPeername s h  = hoistT $ (\hsc_ptr -> pokeByteOff hsc_ptr 24) s h
{-# LINE 584 "src/Network/Protocol/NetSNMP.hsc" #-}

pokeSessVersion   :: Ptr SnmpSession -> CLong   -> Trouble ()
pokeSessVersion s v   = hoistT $ (\hsc_ptr -> pokeByteOff hsc_ptr 0) s v
{-# LINE 587 "src/Network/Protocol/NetSNMP.hsc" #-}

pokeSessCommunity :: Ptr SnmpSession -> CString -> Trouble ()
pokeSessCommunity s c = hoistT $ (\hsc_ptr -> pokeByteOff hsc_ptr 64) s c
{-# LINE 590 "src/Network/Protocol/NetSNMP.hsc" #-}

pokeSessCommLen   :: Ptr SnmpSession -> CSize   -> Trouble ()
pokeSessCommLen s l = hoistT $ (\hsc_ptr -> pokeByteOff hsc_ptr 68) s l
{-# LINE 593 "src/Network/Protocol/NetSNMP.hsc" #-}

pokePDUVersion :: Ptr SnmpPDU -> CLong -> Trouble ()
pokePDUVersion p v = hoistT $ (\hsc_ptr -> pokeByteOff hsc_ptr 0) p v
{-# LINE 596 "src/Network/Protocol/NetSNMP.hsc" #-}

pokePDUCommand :: Ptr SnmpPDU -> CInt -> Trouble ()
pokePDUCommand p t = hoistT $ (\hsc_ptr -> pokeByteOff hsc_ptr 4) p t
{-# LINE 599 "src/Network/Protocol/NetSNMP.hsc" #-}

--
-- The C library layer
--
-- FFI C import statements, together with wrappers to put them
-- in the (Trouble a) exception handling monad
--

-- initialize the library
-- This must be called before any other library functions, and before
-- any threads are forked, because the initialization is not thread-safe,
-- specifically the mib tree compiler.
foreign import ccall unsafe "net-snmp/net-snmp-includes.h init_snmp"
    c_init_snmp :: CString -> IO ()

-- t_init_snmp = hoistT1 c_init_snmp

-- "init session"
-- JD: Apparently this only sets parameters in the struct snmp_session.
foreign import ccall unsafe "net-snmp/net-snmp-includes.h snmp_sess_init"
    c_snmp_sess_init :: Ptr SnmpSession -> IO ()

t_snmp_sess_init = hoistT1 c_snmp_sess_init

-- "open session".  How does this differ from the above?  I haven't
-- found any clarifying api docs.
-- JD: Apparently this allocates a socket for UDP, or opens a TCP connection.
foreign import ccall unsafe "net-snmp/net-snmp-includes.h snmp_sess_open"
    c_snmp_sess_open :: Ptr SnmpSession -> IO (Ptr SnmpSession)

t_snmp_sess_open = hoistTE1
  (predToMaybe (== nullPtr) "snmp_sess_open failed") c_snmp_sess_open

-- Third and final session initialization routine.
-- JD: This seems to be used to coordinate asynchronous queries in the
-- (thread safe) session, and in error tracking/reporting.
foreign import ccall unsafe "net-snmp/net-snmp-includes.h snmp_sess_session"
    c_snmp_sess_session :: Ptr SnmpSession -> IO (Ptr SnmpSession)

t_snmp_sess_session = hoistTE1
  (predToMaybe (== nullPtr) "snmp_sess_session failed") c_snmp_sess_session

-- Create PDU structure with defaults by type
foreign import ccall unsafe "net-snmp/net-snmp-includes.h snmp_pdu_create"
    c_snmp_pdu_create :: SnmpPDUType -> IO (Ptr SnmpPDU)

t_snmp_pdu_create = hoistTE1
  (predToMaybe (== nullPtr) "snmp_pdu_create failed")
  c_snmp_pdu_create

-- Parse string argument as OID; populate OIDpart array and size
foreign import ccall unsafe "net-snmp/net-snmp-includes.h get_node"
    c_get_node :: CString -> Ptr OIDpart -> Ptr CSize -> IO CInt

t_get_node = hoistTE3
  (predToMaybe (not . (>0)) "get_node failed")
  -- (\i -> if (i <= 0) then Just "get_node failed" else Nothing)
  c_get_node

-- OID parser/builder script.  How does this differ from get_node?
foreign import ccall unsafe "net-snmp/net-snmp-includes.h read_objid"
    c_read_objid :: CString -> Ptr OIDpart -> Ptr CSize -> IO CInt

t_read_objid = hoistTE3
  (predToMaybe (not . (>0)) "read_objid failed")
  -- (\i -> if (i <= 0) then Just "read_objid failed" else Nothing)
  c_read_objid

-- OID parser/builder script.  How does this differ from get_node?
foreign import ccall unsafe "net-snmp/net-snmp-includes.h snmp_parse_oid"
    c_snmp_parse_oid :: CString -> Ptr OIDpart -> Ptr CSize -> IO CInt

t_snmp_parse_oid = hoistTE3
  (predToMaybe (not . (>0)) "snmp_parse_oid failed")
  -- (\i -> if (i <= 0) then Just "snmp_parse_oid failed" else Nothing)
  c_snmp_parse_oid

-- Add oid with void result; suitable for building a query
foreign import ccall unsafe "net-snmp/net-snmp-includes.h snmp_add_null_var"
    c_snmp_add_null_var :: Ptr SnmpPDU -> Ptr OIDpart -> CSize -> IO ()

t_snmp_add_null_var = hoistT3 c_snmp_add_null_var

-- Send request PDU and wait for response.
foreign import ccall unsafe
    "net-snmp/net-snmp-includes.h snmp_sess_synch_response"
    c_snmp_sess_synch_response :: Ptr SnmpSession -> Ptr SnmpPDU
        -> Ptr (Ptr SnmpPDU) -> IO CInt

-- t_snmp_sess_synch_response = hoistTE3
--   (predToMaybe (/= snmp_stat_success) "snmp_sess_synch_response failed")
--   c_snmp_sess_synch_response

-- improved (?) version with fuller error handling
t_snmp_sess_synch_response :: Ptr SnmpSession -> Ptr SnmpSession
  -> Ptr SnmpPDU -> Ptr (Ptr SnmpPDU) -> Trouble ()
t_snmp_sess_synch_response sessp sptr pdu_req response_ptr = Trouble $ do
  success <- c_snmp_sess_synch_response sessp pdu_req response_ptr
  if (success == snmp_stat_success)
    then return (Right ())
    else Left <$> snmpSessError sptr

-- Deallocate PDU struct
foreign import ccall unsafe "net-snmp/net-snmp-includes.h snmp_free_pdu"
    c_snmp_free_pdu :: Ptr SnmpPDU -> IO ()

t_snmp_free_pdu = hoistT1 c_snmp_free_pdu

-- Deallocate session and free associated resources.
foreign import ccall unsafe "net-snmp/net-snmp-includes.h snmp_sess_close"
    c_snmp_sess_close :: Ptr SnmpSession -> IO ()

t_snmp_sess_close = hoistT1 c_snmp_sess_close

-- Send and enqueue request PDU for asynch use, not currently supported.
-- foreign import ccall unsafe "net-snmp/net-snmp-includes.h snmp_sess_send"
--     c_snmp_sess_send :: Ptr SnmpSession -> Ptr SnmpPDU -> IO CInt

-- Print result value to stdout
foreign import ccall unsafe "net-snmp/net-snmp-includes.h print_variable"
    c_print_variable :: Ptr OIDpart -> CSize -> Ptr CVarList -> IO ()

t_print_variable = hoistT3 c_print_variable

-- t_print_variable :: Ptr OIDpart -> CSize -> Ptr CVarList -> Trouble ()
-- t_print_variable o s r = Trouble $ Right <$> c_print_variable o s r


-- Return library error description
-- This one should only be used for failure of snmp_sess_open; use
-- the (void *) return by that function at other times.
-- library/snmp_api.h
-- void snmp_error(netsnmp_session *, int *, int *, char **);
foreign import ccall unsafe "net-snmp/net-snmp-includes.h snmp_error"
    c_snmp_error :: Ptr SnmpSession -> Ptr CInt -> Ptr CInt
      -> Ptr CString -> IO ()

snmpError :: Ptr SnmpSession -> IO String
snmpError p = do
  alloca $ \libp -> do  -- pointer to library error code
  alloca $ \sysp -> do  -- pointer to system error code
  alloca $ \errp -> do  -- pointer to error CString
  c_snmp_error p libp sysp errp
  liberr <- peek libp
  syserr <- peek sysp
  cserr  <- peek errp
  err    <- peekCString cserr
  free cserr
  return $ "snmpError: lib:" ++ show liberr ++ " ; sys:" ++ show syserr
           ++ " ; " ++ err

-- Return library error description
-- This one is preferred for all single-session api failures except
-- snmp_sess_open failure.  
-- library/snmp_api.h
-- void snmp_sess_error(void *, int *, int *, char **);
foreign import ccall unsafe "net-snmp/net-snmp-includes.h snmp_error"
    c_snmp_sess_error :: Ptr SnmpSession -> Ptr CInt -> Ptr CInt
      -> Ptr CString -> IO ()

snmpSessError :: Ptr SnmpSession -> IO String
snmpSessError p = do
  alloca $ \libp -> do  -- pointer to library error code
  alloca $ \sysp -> do  -- pointer to system error code
  alloca $ \errp -> do  -- pointer to error CString
  c_snmp_sess_error p libp sysp errp
  liberr <- peek libp
  syserr <- peek sysp
  cserr  <- peek errp
  err    <- peekCString cserr
  free cserr
  return $ "snmpSessError: lib:" ++ show liberr ++ " ; sys:" ++ show syserr
           ++ " ; " ++ err

-- int snprint_by_type(char *buf, size_t buf_len, netsnmp_variable_list * var,
--   const struct enum_list *enums, const char *hint, const char *units);
foreign import ccall unsafe "net-snmp/net-snmp-includes.h snprint_by_type"
    c_snprint_by_type :: CString -> CSize -> Ptr CVarList ->
       Ptr () -> Ptr () -> Ptr () -> IO CInt

t_snprint_by_type = hoistT6 c_snprint_by_type

foreign import ccall unsafe "string.h strlen"
    c_strlen :: Ptr CChar -> IO CSize

t_strlen = hoistT1 c_strlen

--
-- Trouble a
--
-- A simple exception handling monad
--

-- Better would be to use ErrorT from the mtl (or other transformer
-- library) but I don't want the dependency before the dust has settled
-- between them; it smells like a compatibility tarpit.
-- type Trouble = ErrorT String IO

newtype Trouble a = Trouble { runTrouble :: IO (Either String a) }

instance Functor Trouble where
  fmap f m = Trouble $ do
    r <- runTrouble m
    case r of (Left s)  -> return (Left s)
              (Right v) -> return (Right (f v))

instance Monad Trouble where
  return a = Trouble $ return (Right a)
  m >>= f  = Trouble $ do
    r <- runTrouble m
    case r of (Left s)  -> return (Left s)
              (Right v) -> runTrouble (f v)

throwT :: String -> Trouble a
throwT s = Trouble $ return (Left s)

catchT :: Trouble a -> (String -> Trouble a) -> Trouble a
catchT m h = Trouble $ do
  r <- runTrouble m
  case r of (Left s)  -> runTrouble (h s)
            (Right v) -> return r

handleT :: (String -> Trouble a) -> Trouble a -> Trouble a
handleT = flip catchT

bracketT :: Trouble a -> (a -> Trouble b) -> (a -> Trouble c) -> Trouble c
bracketT before after thing = do
  a <- before
  handleT (\s -> after a >> throwT s) $ do
    result <- thing a
    after a
    return result

-- Routines to 'hoist' anything with IO return type into the
-- equivalent with (Trouble a) ie. IO (Either String a) return type.

hoistT  :: IO t -> Trouble t
hoistT  f = Trouble $ Right <$> f

hoistT1 :: (a -> IO t) -> a -> Trouble t
hoistT1 f a = hoistT  (f a)
hoistT2 f a = hoistT1 (f a)
hoistT3 f a = hoistT2 (f a)
hoistT4 f a = hoistT3 (f a)
hoistT5 f a = hoistT4 (f a)
hoistT6 f a = hoistT5 (f a)

-- hoist from IO with success check(s)
hoistTE0 :: (t -> Maybe String) -> IO t -> Trouble t
hoistTE0 e f = Trouble $ do
  t <- f
  return $ maybe (Right t) Left (e t)

hoistTE1 e f a = hoistTE0 e (f a)
hoistTE2 e f a = hoistTE1 e (f a)
hoistTE3 e f a = hoistTE2 e (f a)
hoistTE4 e f a = hoistTE3 e (f a)
hoistTE5 e f a = hoistTE4 e (f a)
hoistTE6 e f a = hoistTE5 e (f a)

predToMaybe :: (a -> Bool) -> b -> a -> Maybe b
predToMaybe p b a = if (p a) then Just b else Nothing