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

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

----------------------------------------------------------------------
-- |
-- Module      : Network.Protocol.NetSNMP
--
-- Maintainer  : Pavlo Kerestey <pavlo@kerestey.net>
-- Portability : portable
--
-- This is a binding to Net-SNMP version 5, <http://www.net-snmp.org/>.

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

module Network.Protocol.NetSNMP (
  -- * Types
  ASNValue(..), SnmpResult(..), SnmpVersion(..), RawOID, OIDpart,
  Hostname, Community,
  -- * Constants
  snmp_version_1, snmp_version_2c, snmp_version_3,
  -- * Functions
  -- ** Library Initialization
  initialize,
  -- ** Queries
  snmpGet, snmpNext, snmpWalk, snmpBulkWalk,
  -- ** Miscellany
  showASNValue,
  )
where

import           Control.Monad
import           Data.ByteString (ByteString)
import qualified Data.ByteString as B
import           Data.ByteString.Char8 ()
import qualified Data.ByteString.UTF8 as Utf8
import           Data.List
import           Foreign hiding (void)
import           Foreign.C.String
import           Foreign.C.Types


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

{-# LINE 43 "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
  , getSessp         :: Ptr SnmpSession
  , getSptr          :: Ptr SnmpSession
  }

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

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

-- |The net-snmp C library on 64-bit OS X systems still uses 32-bit oid parts in
--    the responses. Please make sure that the library produces sane
--    results on your system by cloning the source code and running `make test`.

{-# LINE 76 "src/Network/Protocol/NetSNMP.hsc" #-}
type OIDpart = Word64
{-# LINE 77 "src/Network/Protocol/NetSNMP.hsc" #-}

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

type RawOID = [OIDpart]

showOid :: RawOID -> String
showOid = concatMap (('.':) . show)

oidToByteString :: RawOID -> ByteString
oidToByteString = Utf8.fromString . showOid

-- 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 ByteString [Word8] -- ^@ASN_OCTET_STR@ Returned as a character
                               --     string, and as opaque data.
  | OID ByteString ByteString [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   ByteString [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   ByteString 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 ByteString -- ^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   :: RawOID,           -- ^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  = ByteString
type Community = ByteString

-- 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 154 "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 158 "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 163 "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 198 "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 221 "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_stat_error    :: CInt
snmp_stat_error    =  1
snmp_stat_timeout  :: CInt
snmp_stat_timeout  =  2
snmp_err_noerror   :: CInt
snmp_err_noerror   =  0

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

max_oid_len = 128 :: CInt
{-# LINE 234 "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 = do
  withCString "Haskell bindings" c_init_snmp
  void $ withCString "127.0.0.1" $ \localhost ->
         withCString "public"    $ \public    ->
         alloca                  $ \session   -> runTrouble $
         readyCommunitySession snmp_version_2c localhost public session >>= closeSession

-- |Create an abstract session, suitable for reuse, responsible
-- for freeing the string components
readyCommunitySession
  :: SnmpVersion
  -> CString                 -- Hostname
  -> CString                 -- Community
  -> Ptr SnmpSession         -- "session"
  -> Trouble Session         -- return abstract session
readyCommunitySession version hostname community session = do
  community_len     <- t_strlen community
  t_snmp_sess_init  session
  pokeSessRetries   session 3
  pokeSessTimeout   session 10000000
  pokeSessPeername  session hostname
  pokeSessVersion   session (unSnmpVersion version)
  pokeSessCommunity session community
  pokeSessCommLen   session community_len
  sessp <- t_snmp_sess_open    session
  sptr  <- t_snmp_sess_session sessp
  return $ Session version sessp sptr

-- |Immediately destroy/free the Session.
closeSession :: Session -> Trouble ()
-- frees the SnmpSession object allocated by readyCommunitySession
closeSession session = hoistT (c_snmp_sess_close (getSessp 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)
  -> RawOID         -- ^OID to be queried
  -> IO (Either String SnmpResult)
snmpGet version hostname community oid' =
  B.useAsCString hostname  $ \cshost  ->
  B.useAsCString community $ \cscomm  ->
  alloca                   $ \session ->
  runTrouble $ bracketT
    (readyCommunitySession version cshost cscomm 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)
  -> RawOID         -- ^OID to be queried
  -> IO (Either String SnmpResult)
snmpNext version hostname community oid' =
  B.useAsCString hostname  $ \cshost  ->
  B.useAsCString community $ \cscomm  ->
  alloca                   $ \session ->
  runTrouble $ bracketT
    (readyCommunitySession version cshost cscomm 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.
--
-- This implementation uses a series of next operations and is not very
-- ressource friendly. Consider using snmpBulkWalk for better performance
--
-- Examples:
--
-- * snmpWalk snmp_version_2c \"localhost\" \"public\" [1,3,6,1,2,1,1]
--
-- * snmpWalk snmp_version_2c \"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)
  -> RawOID         -- ^OID to be queried
  -> IO (Either String [SnmpResult])
snmpWalk version hostname community walkoid =
    B.useAsCString hostname  $ \cshost  ->
    B.useAsCString community $ \cscomm  ->
    alloca                   $ \session ->
    runTrouble $ bracketT
      (readyCommunitySession version cshost cscomm session)
      closeSession
      (go walkoid . mkSnmpGet snmp_msg_getnext)
  where
    go :: RawOID -> (RawOID -> Trouble SnmpResult) -> Trouble [SnmpResult]
    go oid' next = do
      v@(SnmpResult nextoid _) <- next oid'
      case () of
        _ | nextoid == oid' -> return [] -- throwT "end of mib"
          | walkoid `isPrefixOf` nextoid -> do
            vs <- go nextoid next
            return (v:vs)
          | otherwise -> return [] -- throwT "end of walk"


-- |Same as snmpWalk but implemented with bulk requests
--
-- Examples:
--
-- * snmpBulkWalk \"localhost\" \"public\" [1,3,6,1,2,1,1]
--
-- * snmpBulkWalk \"tcp:localhost:5161\" \"mypassword\" [1,3,6,1,2,1,1]
snmpBulkWalk 
  :: Hostname    -- ^IP or hostname of the agent to be queried.  May have
                 --     prefix of @tcp:@ or suffix of @:port@
  -> Community   -- ^SNMP community (password)
  -> RawOID         -- ^OID to be queried
  -> IO (Either String [SnmpResult])
snmpBulkWalk hostname community walkoid =
    B.useAsCString hostname  $ \cshost  ->
    B.useAsCString community $ \cscomm  ->
    alloca                   $ \session ->
    runTrouble $ bracketT
      (readyCommunitySession snmp_version_2c cshost cscomm session)
      closeSession
      (bulkWalk walkoid walkoid)
  where
    bulkWalk :: RawOID -> RawOID -> Session -> Trouble [SnmpResult]
    bulkWalk rootoid startoid session = do
      vals <- filter (\r -> oid r `isSubIdOf` rootoid) <$> mkSnmpBulkGet 0 30 startoid session
      case vals of
        [] -> return []
        rs -> (vals ++) <$> bulkWalk rootoid (oid (last rs)) session
    isSubIdOf :: RawOID -> RawOID -> Bool
    isSubIdOf oa ob = ob `isPrefixOf` oa

-- getbulk, using session info from a 'data Session' and
-- the supplied oid
-- It is the caller's obligation to ensure the session's validity.
mkSnmpBulkGet :: CLong -> CLong -> RawOID -> Session -> Trouble [SnmpResult]
mkSnmpBulkGet non_repeaters max_repetitions oid' session =
  allocaArrayT (fromIntegral max_oid_len) $ \oids -> do
  let version = getVersion session
  pdu_req <- buildPDU snmp_msg_getbulk oid' oids version
  pokePDUNonRepeaters pdu_req non_repeaters
  pokePDUMaxRepetitions pdu_req max_repetitions
  dispatchSnmpReq pdu_req session

-- 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 -> RawOID -> Trouble SnmpResult
mkSnmpGet pdutype session oid' = do
  res <- allocaArrayT (fromIntegral max_oid_len) $ \oids -> do
         let version = getVersion session
         pdu_req <- buildPDU pdutype oid' oids version
         dispatchSnmpReq pdu_req session
  if null res then throwT ("Could not get the snmp value at " ++ showOid oid')
  else return $ head res

dispatchSnmpReq :: Ptr SnmpPDU -> Session -> Trouble [SnmpResult]
dispatchSnmpReq pdu_req session =
  allocaT $ \response_ptr -> do
  let sessp = getSessp session
  let sptr = getSptr session
  pokeT response_ptr nullPtr
  handleT
    (\s -> do
      pdu_resp <- peekT response_ptr
      unless (pdu_resp == nullPtr) $ t_snmp_free_pdu pdu_resp
      throwT s)
    (do
      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: "++show errstat))
      rawvars <- peekPDUVariables pdu_resp
      vars <- extractVars rawvars
      unless (pdu_resp == nullPtr) $ t_snmp_free_pdu pdu_resp
      return vars)

-- caller is obliged to ensure rv is valid and non-null
vlist2oid :: Ptr CVarList -> Trouble RawOID
vlist2oid rv = do
  oidptr <- peekVariableName rv
  len    <- peekVariableLen  rv
  peekArrayT (fromIntegral len) oidptr

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    -> extractIntegral64Type rv Counter64
    _ | t == asn_integer64    -> extractIntegral64Type rv Integer64
    _ | t == asn_unsigned64   -> extractIntegral64Type rv Unsigned64
    _ | t == asn_object_id    -> extractOID          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)

extractIntegral64Type rv constructor = do
  ptr <- peekVariableValInt rv
  (high:low:[]) <- peekArrayT 2 (castPtr ptr) :: Trouble [Word64]
  return (constructor (fromIntegral ((high * (2 ^ (32 :: Word64)) + low) :: Word64)))

extractIpAddress rv = do
  ptr <- peekVariableValInt rv
  octets <- peekArrayT 4 (castPtr ptr) :: Trouble [Word8]
  let str = B.intercalate "." (map (B.pack . (:[])) 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` (8)
{-# LINE 513 "src/Network/Protocol/NetSNMP.hsc" #-}
  oid' <- peekArrayT oidlen oidptr :: Trouble RawOID
  let str = oidToByteString oid'
  descr <- rawvar2cstring rv
  return (OID descr str (map fromIntegral oid'))

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 _     -> show s
  IpAddress   s _     -> show s
  Counter32   c       -> show c
  Gauge32     c       -> show c
  OID         _ os _  -> show 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 _     -> show s
  Boolean     c       -> show c
  IEEEDouble  c       -> show c
  IEEEFloat   c       -> show c
  Null                -> "ASN_NULL"
  Unsupported t s     -> "Unknown type " ++ show t ++ ": " ++ show s

-- allocates space for the pdu request; snmp_sess_synch_response
-- appears to free the request pdu
buildPDU
  :: SnmpPDUType  -- eg. snmp_msg_get
  -> RawOID       -- 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 (showOid 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 ByteString
rawvar2cstring rv =
  allocaArray0T max_string_len $ \buf -> do
  _ <- 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 B.packCString
peekCStringLenT = hoistT1 B.packCStringLen

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 48) p
{-# LINE 600 "src/Network/Protocol/NetSNMP.hsc" #-}

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

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

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

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

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

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

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

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

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

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

pokeSessRetries :: Ptr SnmpSession -> CInt -> Trouble ()
pokeSessRetries s h  = hoistT $ (\hsc_ptr -> pokeByteOff hsc_ptr 8) s h
{-# LINE 633 "src/Network/Protocol/NetSNMP.hsc" #-}

pokeSessTimeout :: Ptr SnmpSession -> CLong -> Trouble ()
pokeSessTimeout s h  = hoistT $ (\hsc_ptr -> pokeByteOff hsc_ptr 16) s h
{-# LINE 636 "src/Network/Protocol/NetSNMP.hsc" #-}

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

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

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

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

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

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

pokePDUNonRepeaters :: Ptr SnmpPDU -> CLong -> Trouble ()
pokePDUNonRepeaters p n = hoistT $ (\hsc_ptr -> pokeByteOff hsc_ptr 48) p n
{-# LINE 657 "src/Network/Protocol/NetSNMP.hsc" #-}

pokePDUMaxRepetitions :: Ptr SnmpPDU -> CLong -> Trouble ()
pokePDUMaxRepetitions p r = hoistT $ (\hsc_ptr -> pokeByteOff hsc_ptr 56) p r
{-# LINE 660 "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 ()

-- "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.
--
-- from session_api.h: Do NOT free memory returned by snmp_sess_session
--
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 safe
    "net-snmp/net-snmp-includes.h snmp_sess_synch_response"
    c_snmp_sess_synch_response :: Ptr SnmpSession -> Ptr SnmpPDU
        -> Ptr (Ptr SnmpPDU) -> IO CInt

-- 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 <$> snmpError 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 safe "net-snmp/net-snmp-includes.h print_variable"
--     c_print_variable :: Ptr OIDpart -> CSize -> Ptr CVarList -> IO ()

-- t_print_variable :: Ptr OIDpart -> CSize -> Ptr CVarList -> Trouble ()
-- t_print_variable = hoistT3 c_print_variable

-- 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 = 
  alloca $ \libp ->     -- pointer to library error code
  alloca $ \sysp ->     -- 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_sess_error"
--     c_snmp_sess_error :: Ptr SnmpSession -> Ptr CInt -> Ptr CInt
--       -> Ptr CString -> IO ()

-- 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 Applicative Trouble where
  pure a = Trouble $ pure (Right a)
  -- (<*>) :: Trouble (a -> b) -> Trouble a -> Trouble b
  f <*> v = Trouble $ do
    r <- runTrouble f
    v' <- runTrouble v
    case r of (Left s)   -> return (Left s)
              (Right f') -> return (fmap f' v')

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 _) -> 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
  result <- handleT (\s -> after a >> throwT s) (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