{- |
   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 { Socket
s <- Family -> SocketType -> ProtocolNumber -> IO Socket
S.socket Family
S.AF_INET SocketType
S.Datagram ProtocolNumber
0
       ; GrowlHandler -> IO GrowlHandler
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GrowlHandler { priority :: Priority
priority = Priority
pri, appName :: String
appName = String
nm, formatter :: LogFormatter GrowlHandler
formatter=LogFormatter GrowlHandler
forall a. LogFormatter a
nullFormatter,
                               skt :: Socket
skt = Socket
s, targets :: [HostAddress]
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 { HostEntry
he <- String -> IO HostEntry
S.getHostByName String
hn
                     ; let ha :: HostAddress
ha = HostEntry -> HostAddress
S.hostAddress HostEntry
he
                           sa :: SockAddr
sa = PortNumber -> HostAddress -> SockAddr
S.SockAddrInet PortNumber
9887 HostAddress
ha
                       in do { Int
_ <- Socket -> String -> SockAddr -> IO Int
sendTo (GrowlHandler -> Socket
skt GrowlHandler
gh) (GrowlHandler -> String
buildRegistration GrowlHandler
gh) SockAddr
sa
                             ; GrowlHandler -> IO GrowlHandler
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GrowlHandler
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 ]