{-# LINE 1 "src/System/Posix/Syslog.hsc" #-}
{-# LANGUAGE
{-# LINE 2 "src/System/Posix/Syslog.hsc" #-}
    CApiFFI
  , ForeignFunctionInterface
  , OverloadedStrings
  #-}


{-# LINE 8 "src/System/Posix/Syslog.hsc" #-}
{-# LANGUAGE DeriveGeneric #-}

{-# LINE 10 "src/System/Posix/Syslog.hsc" #-}

{- |
   Module      :  System.Posix.Syslog
   Maintainer  :  simons@cryp.to
   Stability   :  provisional
   Portability :  Posix

   FFI bindings to syslog(3) from
   <http://www.opengroup.org/onlinepubs/009695399/basedefs/syslog.h.html POSIX.1-2001>.
-}

module System.Posix.Syslog
  ( -- * Marshaled Data Types
    Priority (..)
  , toPriority
  , fromPriority
  , Facility (..)
  , toFacility
  , fromFacility
  , Option (..)
  , toOption
  , fromOption
  , PriorityMask (..)
  , fromPriorityMask
    -- * Configuring syslog
  , SyslogConfig (..)
  , defaultConfig
    -- * The preferred Haskell API to syslog
    -- | These are also the most performant calls to syslog, with the minimum
    -- amount of 'CString' copying necessary.
  , withSyslog
  , SyslogFn
  , withSyslogTo
  , SyslogToFn
    -- * The unsafe Haskell API to syslog
    -- | Using these functions provides no guarantee that a call to '_openlog'
    -- has been made.
  , syslogUnsafe
  , syslogToUnsafe
    -- * Low-level C functions
  , _openlog
  , _closelog
  , _setlogmask
  , _syslog
    -- ** Low-level C macros
    -- | See the
    -- <http://www.gnu.org/software/libc/manual/html_node/Submitting-Syslog-Messages.html GNU libc documentation>
    -- for their intended usage.
  , _LOG_MASK
  , _LOG_UPTO
  , _LOG_MAKEPRI
  ) where

import Control.Exception (bracket_)
import Data.Bits (Bits, (.|.))
import Data.ByteString (ByteString, useAsCString)
import Data.List (foldl')
import Foreign.C (CInt (..), CString (..))


{-# LINE 70 "src/System/Posix/Syslog.hsc" #-}
import GHC.Generics (Generic)

{-# LINE 72 "src/System/Posix/Syslog.hsc" #-}


{-# LINE 74 "src/System/Posix/Syslog.hsc" #-}

{-# LINE 77 "src/System/Posix/Syslog.hsc" #-}


{-# LINE 81 "src/System/Posix/Syslog.hsc" #-}


{-# LINE 85 "src/System/Posix/Syslog.hsc" #-}

-- |Log messages have a priority attached.

data Priority
  = Emergency   -- ^ system is unusable
  | Alert       -- ^ action must be taken immediately
  | Critical    -- ^ critical conditions
  | Error       -- ^ error conditions
  | Warning     -- ^ warning conditions
  | Notice      -- ^ normal but significant condition
  | Info        -- ^ informational
  | Debug       -- ^ debug-level messages
  deriving ( Bounded, Enum, Eq, Show, Read

{-# LINE 99 "src/System/Posix/Syslog.hsc" #-}
           , Generic

{-# LINE 101 "src/System/Posix/Syslog.hsc" #-}
           )

toPriority :: CInt -> Priority
toPriority 0   = Emergency
{-# LINE 105 "src/System/Posix/Syslog.hsc" #-}
toPriority 1   = Alert
{-# LINE 106 "src/System/Posix/Syslog.hsc" #-}
toPriority 2    = Critical
{-# LINE 107 "src/System/Posix/Syslog.hsc" #-}
toPriority 3     = Error
{-# LINE 108 "src/System/Posix/Syslog.hsc" #-}
toPriority 4 = Warning
{-# LINE 109 "src/System/Posix/Syslog.hsc" #-}
toPriority 5  = Notice
{-# LINE 110 "src/System/Posix/Syslog.hsc" #-}
toPriority 6    = Info
{-# LINE 111 "src/System/Posix/Syslog.hsc" #-}
toPriority 7   = Debug
{-# LINE 112 "src/System/Posix/Syslog.hsc" #-}
toPriority i = error (shows i " is not a valid syslog priority value")

fromPriority :: Priority -> CInt
fromPriority Emergency = 0
{-# LINE 116 "src/System/Posix/Syslog.hsc" #-}
fromPriority Alert     = 1
{-# LINE 117 "src/System/Posix/Syslog.hsc" #-}
fromPriority Critical  = 2
{-# LINE 118 "src/System/Posix/Syslog.hsc" #-}
fromPriority Error     = 3
{-# LINE 119 "src/System/Posix/Syslog.hsc" #-}
fromPriority Warning   = 4
{-# LINE 120 "src/System/Posix/Syslog.hsc" #-}
fromPriority Notice    = 5
{-# LINE 121 "src/System/Posix/Syslog.hsc" #-}
fromPriority Info      = 6
{-# LINE 122 "src/System/Posix/Syslog.hsc" #-}
fromPriority Debug     = 7
{-# LINE 123 "src/System/Posix/Syslog.hsc" #-}

-- |Syslog distinguishes various system facilities. Most
-- applications should log in 'USER'.

data Facility
  = KERN        -- ^ kernel messages
  | USER        -- ^ user-level messages (default unless set otherwise)
  | MAIL        -- ^ mail system
  | DAEMON      -- ^ system daemons
  | AUTH        -- ^ security\/authorization messages
  | SYSLOG      -- ^ messages generated internally by syslogd
  | LPR         -- ^ line printer subsystem
  | NEWS        -- ^ network news subsystem
  | UUCP        -- ^ UUCP subsystem
  | CRON        -- ^ clock daemon
  | AUTHPRIV    -- ^ security\/authorization messages (effectively equals 'AUTH' on some systems)
  | FTP         -- ^ ftp daemon (effectively equals 'DAEMON' on some systems)
  | LOCAL0      -- ^ reserved for local use
  | LOCAL1      -- ^ reserved for local use
  | LOCAL2      -- ^ reserved for local use
  | LOCAL3      -- ^ reserved for local use
  | LOCAL4      -- ^ reserved for local use
  | LOCAL5      -- ^ reserved for local use
  | LOCAL6      -- ^ reserved for local use
  | LOCAL7      -- ^ reserved for local use
  deriving (Bounded, Enum, Eq, Show, Read)

toFacility :: CInt -> Facility
toFacility 0      = KERN
{-# LINE 152 "src/System/Posix/Syslog.hsc" #-}
toFacility 8      = USER
{-# LINE 153 "src/System/Posix/Syslog.hsc" #-}
toFacility 16      = MAIL
{-# LINE 154 "src/System/Posix/Syslog.hsc" #-}
toFacility 24    = DAEMON
{-# LINE 155 "src/System/Posix/Syslog.hsc" #-}
toFacility 32      = AUTH
{-# LINE 156 "src/System/Posix/Syslog.hsc" #-}
toFacility 40    = SYSLOG
{-# LINE 157 "src/System/Posix/Syslog.hsc" #-}
toFacility 48       = LPR
{-# LINE 158 "src/System/Posix/Syslog.hsc" #-}
toFacility 56      = NEWS
{-# LINE 159 "src/System/Posix/Syslog.hsc" #-}
toFacility 64      = UUCP
{-# LINE 160 "src/System/Posix/Syslog.hsc" #-}
toFacility 72      = CRON
{-# LINE 161 "src/System/Posix/Syslog.hsc" #-}
toFacility 80  = AUTHPRIV
{-# LINE 162 "src/System/Posix/Syslog.hsc" #-}
toFacility 88       = FTP
{-# LINE 163 "src/System/Posix/Syslog.hsc" #-}
toFacility 128    = LOCAL0
{-# LINE 164 "src/System/Posix/Syslog.hsc" #-}
toFacility 136    = LOCAL1
{-# LINE 165 "src/System/Posix/Syslog.hsc" #-}
toFacility 144    = LOCAL2
{-# LINE 166 "src/System/Posix/Syslog.hsc" #-}
toFacility 152    = LOCAL3
{-# LINE 167 "src/System/Posix/Syslog.hsc" #-}
toFacility 160    = LOCAL4
{-# LINE 168 "src/System/Posix/Syslog.hsc" #-}
toFacility 168    = LOCAL5
{-# LINE 169 "src/System/Posix/Syslog.hsc" #-}
toFacility 176    = LOCAL6
{-# LINE 170 "src/System/Posix/Syslog.hsc" #-}
toFacility 184    = LOCAL7
{-# LINE 171 "src/System/Posix/Syslog.hsc" #-}
toFacility i = error (shows i " is not a valid syslog facility value")

fromFacility :: Facility -> CInt
fromFacility KERN      = 0
{-# LINE 175 "src/System/Posix/Syslog.hsc" #-}
fromFacility USER      = 8
{-# LINE 176 "src/System/Posix/Syslog.hsc" #-}
fromFacility MAIL      = 16
{-# LINE 177 "src/System/Posix/Syslog.hsc" #-}
fromFacility DAEMON    = 24
{-# LINE 178 "src/System/Posix/Syslog.hsc" #-}
fromFacility AUTH      = 32
{-# LINE 179 "src/System/Posix/Syslog.hsc" #-}
fromFacility SYSLOG    = 40
{-# LINE 180 "src/System/Posix/Syslog.hsc" #-}
fromFacility LPR       = 48
{-# LINE 181 "src/System/Posix/Syslog.hsc" #-}
fromFacility NEWS      = 56
{-# LINE 182 "src/System/Posix/Syslog.hsc" #-}
fromFacility UUCP      = 64
{-# LINE 183 "src/System/Posix/Syslog.hsc" #-}
fromFacility CRON      = 72
{-# LINE 184 "src/System/Posix/Syslog.hsc" #-}
fromFacility AUTHPRIV  = 80
{-# LINE 185 "src/System/Posix/Syslog.hsc" #-}
fromFacility FTP       = 88
{-# LINE 186 "src/System/Posix/Syslog.hsc" #-}
fromFacility LOCAL0    = 128
{-# LINE 187 "src/System/Posix/Syslog.hsc" #-}
fromFacility LOCAL1    = 136
{-# LINE 188 "src/System/Posix/Syslog.hsc" #-}
fromFacility LOCAL2    = 144
{-# LINE 189 "src/System/Posix/Syslog.hsc" #-}
fromFacility LOCAL3    = 152
{-# LINE 190 "src/System/Posix/Syslog.hsc" #-}
fromFacility LOCAL4    = 160
{-# LINE 191 "src/System/Posix/Syslog.hsc" #-}
fromFacility LOCAL5    = 168
{-# LINE 192 "src/System/Posix/Syslog.hsc" #-}
fromFacility LOCAL6    = 176
{-# LINE 193 "src/System/Posix/Syslog.hsc" #-}
fromFacility LOCAL7    = 184
{-# LINE 194 "src/System/Posix/Syslog.hsc" #-}

-- |'withSyslog' options for the syslog service.

data Option
  = PID       -- ^ log the pid with each message
  | CONS      -- ^ log on the console if errors in sending
  | ODELAY    -- ^ delay open until first @syslog()@ (default)
  | NDELAY    -- ^ don't delay open
  | NOWAIT    -- ^ don't wait for console forks: DEPRECATED
  | PERROR    -- ^ log to 'stderr' as well (might be a no-op on some systems)
  deriving (Bounded, Enum, Eq, Show)

toOption :: CInt -> Option
toOption 1     = PID
{-# LINE 208 "src/System/Posix/Syslog.hsc" #-}
toOption 2    = CONS
{-# LINE 209 "src/System/Posix/Syslog.hsc" #-}
toOption 4  = ODELAY
{-# LINE 210 "src/System/Posix/Syslog.hsc" #-}
toOption 8  = NDELAY
{-# LINE 211 "src/System/Posix/Syslog.hsc" #-}
toOption 16  = NOWAIT
{-# LINE 212 "src/System/Posix/Syslog.hsc" #-}
toOption 32  = PERROR
{-# LINE 213 "src/System/Posix/Syslog.hsc" #-}
toOption i = error (shows i " is not a valid syslog option value")

fromOption :: Option -> CInt
fromOption PID     = 1
{-# LINE 217 "src/System/Posix/Syslog.hsc" #-}
fromOption CONS    = 2
{-# LINE 218 "src/System/Posix/Syslog.hsc" #-}
fromOption ODELAY  = 4
{-# LINE 219 "src/System/Posix/Syslog.hsc" #-}
fromOption NDELAY  = 8
{-# LINE 220 "src/System/Posix/Syslog.hsc" #-}
fromOption NOWAIT  = 16
{-# LINE 221 "src/System/Posix/Syslog.hsc" #-}
fromOption PERROR  = 32
{-# LINE 222 "src/System/Posix/Syslog.hsc" #-}

-- |`withSyslog` options for the priority mask

data PriorityMask
  = NoMask          -- ^ allow all messages thru
  | Mask [Priority] -- ^ allow only messages with the priorities listed
  | UpTo Priority   -- ^ allow only messages down to and including the specified priority
  deriving (Eq, Show)

fromPriorityMask :: PriorityMask -> CInt
fromPriorityMask (Mask pris) = bitsOrWith (_LOG_MASK . fromPriority) pris
fromPriorityMask (UpTo pri) = _LOG_UPTO $ fromPriority pri
fromPriorityMask NoMask = 0

data SyslogConfig = SyslogConfig
  { identifier        :: ByteString   -- ^ string appended to each log message
  , options           :: [Option]     -- ^ options for syslog behavior
  , defaultFacilities :: [Facility]   -- ^ facilities logged to when none are provided
  , priorityMask      :: PriorityMask -- ^ filter by priority which messages are logged
  }
  deriving (Eq, Show)

-- |A practical default syslog config. You'll at least want to change the
-- identifier.

defaultConfig :: SyslogConfig
defaultConfig = SyslogConfig "hsyslog" [ODELAY] [USER] NoMask

-- |Bracket an 'IO' computation between calls to '_openlog', '_setlogmask', and
-- '_closelog', and provide a logging function which can be used as follows:
--
-- > main = withSyslog defaultConfig $ \syslog -> do
-- >          putStrLn "huhu"
-- >          syslog [Debug] "huhu"
--
-- Note that these are /process-wide/ settings, so multiple calls to
-- this function will interfere with each other in unpredictable ways.

withSyslog :: SyslogConfig -> (SyslogFn -> IO ()) -> IO ()
withSyslog config f =
    withinOpenCloseSyslog config $ do
      useAsCString escape (f . flip syslogEscaped [])
      return ()

-- |The type of logging function provided by 'withSyslog'.

type SyslogFn
  =  [Priority] -- ^ the priorities under which to log
  -> ByteString -- ^ the message to log
  -> IO ()

-- |Like 'withSyslog' but provides a function for logging to specific
-- facilities per message rather than the default facilities in your
-- 'SyslogConfig'.

withSyslogTo :: SyslogConfig -> (SyslogToFn -> IO ()) -> IO ()
withSyslogTo config f =
    withinOpenCloseSyslog config $ do
      useAsCString escape (f . syslogEscaped)
      return ()

-- |The type of function provided by 'withSyslogTo'.

type SyslogToFn
  =  [Facility] -- ^ the facilities to log to
  -> [Priority] -- ^ the priorities under which to log
  -> ByteString -- ^ the message to log
  -> IO ()

syslogUnsafe :: SyslogFn
syslogUnsafe = syslogToUnsafe []

syslogToUnsafe :: SyslogToFn
syslogToUnsafe facs pris msg = useAsCString msg (_syslog (makePri facs pris))

-- |Open a connection to the system logger for a program. The string
-- identifier passed as the first argument is prepended to every
-- message, and is typically set to the program name. The behavior is
-- unspecified by POSIX.1-2008 if that identifier is 'nullPtr'.

foreign import ccall unsafe "openlog" _openlog :: CString -> CInt -> CInt -> IO ()

-- |Close the descriptor being used to write to the system logger.

foreign import ccall unsafe "closelog" _closelog :: IO ()

-- |A process has a log priority mask that determines which calls to
-- syslog may be logged. All other calls will be ignored. Logging is
-- enabled for the priorities that have the corresponding bit set in
-- mask. The initial mask is such that logging is enabled for all
-- priorities. This function sets this logmask for the calling process,
-- and returns the previous mask. If the mask argument is 0, the current
-- logmask is not modified.

foreign import ccall unsafe "setlogmask" _setlogmask :: CInt -> IO CInt

-- |Generate a log message, which will be distributed by @syslogd(8)@.
-- The priority argument is formed by ORing the facility and the level
-- values (explained below). The remaining arguments are a format, as in
-- printf(3) and any arguments required by the format, except that the
-- two character sequence %m will be replaced by the error message
-- string strerror(errno). A trailing newline may be added if needed.

_syslog :: CInt -> CString -> IO ()
_syslog int msg = useAsCString escape $ \e -> _syslogEscaped int e msg

foreign import capi "syslog.h LOG_MASK" _LOG_MASK :: CInt -> CInt
foreign import capi "syslog.h LOG_UPTO" _LOG_UPTO :: CInt -> CInt
foreign import capi "syslog.h LOG_MAKEPRI" _LOG_MAKEPRI :: CInt -> CInt -> CInt

-- internal functions

bitsOrWith :: (Bits b, Num b) => (a -> b) -> [a] -> b
bitsOrWith f = foldl' (\bits x -> f x .|. bits) 0

makePri :: [Facility] -> [Priority] -> CInt
makePri facs pris =
    _LOG_MAKEPRI (bitsOrWith fromFacility facs) (bitsOrWith fromPriority pris)

foreign import ccall unsafe "syslog" _syslogEscaped
  :: CInt -> CString -> CString -> IO ()

syslogEscaped :: CString -> [Facility] -> [Priority] -> ByteString -> IO ()
syslogEscaped esc facs pris msg =
    useAsCString msg (_syslogEscaped (makePri facs pris) esc)

escape :: ByteString
escape = "%s"

withinOpenCloseSyslog :: SyslogConfig -> IO () -> IO ()
withinOpenCloseSyslog config run =
    useAsCString (identifier config) $ \cIdent ->
      let

        open :: IO ()
        open = do
            _openlog cIdent cOpts cFacs
            _setlogmask cMask
            return ()
          where
            cFacs = bitsOrWith fromFacility $ defaultFacilities config
            cMask = fromPriorityMask $ priorityMask config
            cOpts = bitsOrWith fromOption $ options config

        close :: IO ()
        close = _closelog

      in bracket_ open close run