    {- |
       Module     : System.Log.Handler.Growl
       Copyright  : Copyright (C) 2007-2011 John Goerzen <jgoerzen@complete.org>
       License    : BSD3

       Portability: portable

    Simple log handlers

    Written by Richard M. Neswold, Jr. rich.neswold\@gmail.com
    -}

    module System.Log.Handler.Growl(addTarget, growlHandler)
        where

    import Data.Char
    import Data.Word
    import qualified Network.Socket as S
    import qualified Network.Socket.ByteString as SBS
    import qualified Network.BSD as S
    import System.Log
    import System.Log.Handler
    import System.Log.Formatter

    import UTF8

    sendTo :: S.Socket -> String -> S.SockAddr -> IO Int
    sendTo :: Socket -> String -> SockAddr -> IO Int
    sendTo Socket
    s String
    str = Socket -> ByteString -> SockAddr -> IO Int
    SBS.sendTo Socket
    s (String -> ByteString
    toUTF8BS String
    str)

    data GrowlHandler = GrowlHandler { GrowlHandler -> Priority
    priority :: Priority,
                                       GrowlHandler -> LogFormatter GrowlHandler
    formatter :: LogFormatter GrowlHandler,
                                       GrowlHandler -> String
    appName :: String,
                                       GrowlHandler -> Socket
    skt :: S.Socket,
                                       GrowlHandler -> [HostAddress]
    targets :: [S.HostAddress] }

    instance LogHandler GrowlHandler where

        setLevel :: GrowlHandler -> Priority -> GrowlHandler
    setLevel GrowlHandler
    gh Priority
    p = GrowlHandler
    gh { priority = p }

        getLevel :: GrowlHandler -> Priority
    getLevel = GrowlHandler -> Priority
    priority

        setFormatter :: GrowlHandler -> LogFormatter GrowlHandler -> GrowlHandler
    setFormatter GrowlHandler
    gh LogFormatter GrowlHandler
    f = GrowlHandler
    gh { formatter = f }
        getFormatter :: GrowlHandler -> LogFormatter GrowlHandler
    getFormatter = GrowlHandler -> LogFormatter GrowlHandler
    formatter

        emit :: GrowlHandler -> LogRecord -> String -> IO ()
    emit GrowlHandler
    gh LogRecord
    lr String
    _ = let pkt :: String
    pkt = GrowlHandler -> String -> LogRecord -> String
    buildNotification GrowlHandler
    gh String
    nmGeneralMsg LogRecord
    lr
                       in  (HostAddress -> IO Int) -> [HostAddress] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Socket -> String -> HostAddress -> IO Int
    sendNote (GrowlHandler -> Socket
    skt GrowlHandler
    gh) String
    pkt) (GrowlHandler -> [HostAddress]
    targets GrowlHandler
    gh)

        close :: GrowlHandler -> IO ()
    close GrowlHandler
    gh = let pkt :: String
    pkt = GrowlHandler -> String -> LogRecord -> String
    buildNotification GrowlHandler
    gh String
    nmClosingMsg
                                 (Priority
    WARNING, String
    "Connection closing.")
                       s :: Socket
    s   = GrowlHandler -> Socket
    skt GrowlHandler
    gh
                   in  (HostAddress -> IO Int) -> [HostAddress] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Socket -> String -> HostAddress -> IO Int
    sendNote Socket
    s String
    pkt) (GrowlHandler -> [HostAddress]
    targets GrowlHandler
    gh) IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Socket -> IO ()
    S.close Socket
    s

    sendNote :: S.Socket -> String -> S.HostAddress -> IO Int
    sendNote :: Socket -> String -> HostAddress -> IO Int
    sendNote Socket
    s String
    pkt HostAddress
    ha = Socket -> String -> SockAddr -> IO Int
    sendTo Socket
    s String
    pkt (PortNumber -> HostAddress -> SockAddr
    S.SockAddrInet PortNumber
    9887 HostAddress
    ha)

    -- Right now there are two "notification names": "message" and
    -- "disconnecting". All log messages are sent using the "message"
    -- name. When the handler gets closed properly, the "disconnecting"
    -- notification gets sent.

    nmGeneralMsg :: String
    nmGeneralMsg :: String
    nmGeneralMsg = String
    "message"

    nmClosingMsg :: String
    nmClosingMsg :: String
    nmClosingMsg = String
    "disconnecting"

    {- | Creates a Growl handler. Once a Growl handler has been created,
         machines that are to receive the message have to be specified. -}

    growlHandler :: String          -- ^ The name of the service
                 -> Priority        -- ^ Priority of handler
                 -> IO GrowlHandler
    growlHandler :: String -> Priority -> IO GrowlHandler
    growlHandler String
    nm Priority
    pri =
        do { s <- Family -> SocketType -> ProtocolNumber -> IO Socket
    S.socket Family
    S.AF_INET SocketType
    S.Datagram ProtocolNumber
    0
           ; return GrowlHandler { priority = pri, appName = nm, formatter=nullFormatter,
                                   skt = s, targets = [] }
           }

    -- Converts a Word16 into a string of two characters. The value is
    -- emitted in network byte order.

    emit16 :: Word16 -> String
    emit16 :: Word16 -> String
    emit16 Word16
    v = let (Int
    h, Int
    l) = (Word16 -> Int
    forall a. Enum a => a -> Int
    fromEnum Word16
    v) Int -> Int -> (Int, Int)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` Int
    256 in [Int -> Char
    chr Int
    h, Int -> Char
    chr Int
    l]

    emitLen16 :: [a] -> String
    emitLen16 :: forall a. [a] -> String
    emitLen16 = Word16 -> String
    emit16 (Word16 -> String) -> ([a] -> Word16) -> [a] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word16) -> ([a] -> Int) -> [a] -> Word16
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length

    -- Takes a Service record and generates a network packet
    -- representing the service.

    buildRegistration :: GrowlHandler -> String
    buildRegistration :: GrowlHandler -> String
    buildRegistration GrowlHandler
    s = [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [String]
    fields
        where fields :: [String]
    fields = [ [Char
    '\x1', Char
    '\x4'],
                         String -> String
    forall a. [a] -> String
    emitLen16 (GrowlHandler -> String
    appName GrowlHandler
    s),
                         [String] -> String
    forall {t :: * -> *} {a}. Foldable t => t a -> String
    emitLen8 [String]
    appNotes,
                         [String] -> String
    forall {t :: * -> *} {a}. Foldable t => t a -> String
    emitLen8 [String]
    appNotes,
                         GrowlHandler -> String
    appName GrowlHandler
    s,
                         (String -> String -> String) -> String -> [String] -> String
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl String -> String -> String
    packIt [] [String]
    appNotes,
                         [Char
    '\x0' .. (Int -> Char
    chr ([String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    appNotes Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1))] ]
              packIt :: String -> String -> String
    packIt String
    a String
    b = String
    a String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (String -> String
    forall a. [a] -> String
    emitLen16 String
    b) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    b
              appNotes :: [String]
    appNotes = [ String
    nmGeneralMsg, String
    nmClosingMsg ]
              emitLen8 :: t a -> String
    emitLen8 t a
    v = [Int -> Char
    chr (Int -> Char) -> Int -> Char
    forall a b. (a -> b) -> a -> b
    $ t a -> Int
    forall a. t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length t a
    v]

    {- | Adds a remote machine's address to the list of targets that will
         receive log messages. Calling this function sends a registration
         packet to the machine. This function will throw an exception if
         the host name cannot be found. -}

    addTarget :: S.HostName -> GrowlHandler -> IO GrowlHandler
    addTarget :: String -> GrowlHandler -> IO GrowlHandler
    addTarget String
    hn GrowlHandler
    gh = do { he <- String -> IO HostEntry
    S.getHostByName String
    hn
                         ; let ha = HostEntry -> HostAddress
    S.hostAddress HostEntry
    he
                               sa = PortNumber -> HostAddress -> SockAddr
    S.SockAddrInet PortNumber
    9887 HostAddress
    ha
                           in do { _ <- sendTo (skt gh) (buildRegistration gh) sa
                                 ; return gh { targets = ha:(targets gh) } } }

    -- Converts a Priority type into the subset of integers needed in the
    -- network packet's flag field.

    toFlags :: Priority -> Word16
    toFlags :: Priority -> Word16
    toFlags Priority
    DEBUG = Word16
    12
    toFlags Priority
    INFO = Word16
    10
    toFlags Priority
    NOTICE = Word16
    0
    toFlags Priority
    WARNING = Word16
    2
    toFlags Priority
    ERROR = Word16
    3       -- Same as WARNING, but "sticky" bit set
    toFlags Priority
    CRITICAL = Word16
    3    -- Same as WARNING, but "sticky" bit set
    toFlags Priority
    ALERT = Word16
    4
    toFlags Priority
    EMERGENCY = Word16
    5   -- Same as ALERT, but "sticky" bit set

    -- Creates a network packet containing a notification record.

    buildNotification :: GrowlHandler
                      -> String
                      -> LogRecord
                      -> String
    buildNotification :: GrowlHandler -> String -> LogRecord -> String
    buildNotification GrowlHandler
    gh String
    nm (Priority
    p, String
    msg) = [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [String]
    fields
        where fields :: [String]
    fields = [ [Char
    '\x1', Char
    '\x5'],
                         Word16 -> String
    emit16 (Priority -> Word16
    toFlags Priority
    p),
                         String -> String
    forall a. [a] -> String
    emitLen16 String
    nm,
                         Word16 -> String
    emit16 Word16
    0,
                         String -> String
    forall a. [a] -> String
    emitLen16 String
    msg,
                         String -> String
    forall a. [a] -> String
    emitLen16 (GrowlHandler -> String
    appName GrowlHandler
    gh),
                         String
    nm,
                         [],
                         String
    msg,
                         GrowlHandler -> String
    appName GrowlHandler
    gh ]