{-# LINE 1 "Network/Zephyr/CBits.hsc" #-}
{-# LANGUAGE CPP, ForeignFunctionInterface, GeneralizedNewtypeDeriving #-}
{-# LINE 2 "Network/Zephyr/CBits.hsc" #-}
{-# INCLUDE <zephyr/zephyr.h> #-}

module Network.Zephyr.CBits where

import Foreign
import Foreign.C.Types
import Foreign.C.String

import System.Posix.Types (Fd(Fd))

import qualified Data.ByteString.Char8 as B

import qualified Data.Time as Time
import qualified Data.Time.Clock.POSIX as POSIXTime


{-# LINE 18 "Network/Zephyr/CBits.hsc" #-}

-- | Wrapper for the Zephyr @Code_t@ type
newtype Code_t = Code_t {unCode_t :: CInt}
    deriving (Eq, Show)

zerr_none             :: Code_t
zerr_none             = Code_t 0
zauth_no              :: Code_t
zauth_no              = Code_t 0
zauth_yes             :: Code_t
zauth_yes             = Code_t 1
zauth_failed          :: Code_t
zauth_failed          = Code_t (-1)

{-# LINE 29 "Network/Zephyr/CBits.hsc" #-}

-- | Translate a 'Code_t' into a human-readable error using @com_err@.
error_message :: Code_t -> String
error_message c = unsafePerformIO $ c_error_message c >>= peekCString

-- | 'ZNoticeKind' represent the kinds of 'ZNotice's sent or received
--   by the Zephyr system.
newtype ZNoticeKind = ZNoticeKind { unZNoticeKind :: CInt }
    deriving (Show, Eq, Storable);

kind_unsafe     :: ZNoticeKind
kind_unsafe     = ZNoticeKind 0
kind_unacked    :: ZNoticeKind
kind_unacked    = ZNoticeKind 1
kind_acked      :: ZNoticeKind
kind_acked      = ZNoticeKind 2
kind_hmack      :: ZNoticeKind
kind_hmack      = ZNoticeKind 3
kind_hmctl      :: ZNoticeKind
kind_hmctl      = ZNoticeKind 4
kind_servack    :: ZNoticeKind
kind_servack    = ZNoticeKind 5
kind_servnak    :: ZNoticeKind
kind_servnak    = ZNoticeKind 6
kind_clientack  :: ZNoticeKind
kind_clientack  = ZNoticeKind 7
kind_stat       :: ZNoticeKind
kind_stat       = ZNoticeKind 8

{-# LINE 50 "Network/Zephyr/CBits.hsc" #-}

-- | 'ZAuth' represents the authentication used when sending or
--   receiving a Zephyr.
data ZAuth = Authenticated    -- ^ The message was received with
                              -- correct authentication, or should be
                              -- authenticated for outgoing notices.
           | Unauthenticated  -- ^ The message was or will be sent
                              -- with no authentication.
           | AuthenticationFailed -- ^ The message was received with
                                  -- invalid authentication.
           deriving (Show, Eq, Enum, Bounded)

-- | Represents a Zephyr triple for the purposes of subscribing or
--   unsubscribing to zephyrs.
data ZSubscription = ZSubscription { sub_class     :: B.ByteString
                                   , sub_instance  :: B.ByteString
                                   , sub_recipient :: B.ByteString
                                   }

-- | Helper combinator to marshal a 'ZSubscription'
withZSubscription :: ZSubscription -> (Ptr ZSubscription -> IO a) -> IO a
withZSubscription sub code = do
  B.useAsCString (sub_class sub)        $  \c_class -> do
  B.useAsCString (sub_instance sub)     $  \c_inst  -> do
  B.useAsCString (sub_recipient sub)    $  \c_recip -> do
   allocaBytes ((12)) $ \c_sub   -> do
{-# LINE 76 "Network/Zephyr/CBits.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 0) c_sub c_recip
{-# LINE 77 "Network/Zephyr/CBits.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 4)     c_sub c_class
{-# LINE 78 "Network/Zephyr/CBits.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 8) c_sub c_inst
{-# LINE 79 "Network/Zephyr/CBits.hsc" #-}
        code c_sub

subSize :: Int
subSize = (12)
{-# LINE 83 "Network/Zephyr/CBits.hsc" #-}

-- | Helper combinator to marshal a list of 'ZSubscription's
withSubs :: [ZSubscription] -> ((Ptr ZSubscription, CInt) -> IO a) -> IO a
withSubs subs code = let n_subs = length subs in
  withMany withZSubscription subs $ \c_subs  -> do
  allocaBytes (n_subs * subSize)  $ \c_array -> do
    copySubs c_array c_subs
    code (c_array, fromIntegral n_subs)
      where copySubs to (s:ss) = do copyBytes to s subSize
                                    copySubs (to `plusPtr` subSize) ss
            copySubs _ []      = return ()

{- | 'ZNotice' represents a Zephyr notice. All fields of this record
      are filled-in for received notices. For outoing notices, only
      the following fields are relevant:

       * @z_class@

       * @z_instance@

       * @z_opcode@

       * @z_sender@

       * @z_default_fmt@

       * @z_kind@

       * @z_auth@

       * @z_fields@
-}
data ZNotice = ZNotice { z_version     :: B.ByteString
                       -- ^ The Zephyr version this notice was sent with.
                       , z_class       :: B.ByteString
                       -- ^ The Zephyr class of this notice.
                       , z_instance    :: B.ByteString
                       -- ^ The Zephyr instance of this notice.
                       , z_recipient   :: B.ByteString
                       -- ^ The recipient of this notice.
                       , z_opcode      :: B.ByteString
                       -- ^ The opcode of this notice.
                       , z_sender      :: Maybe B.ByteString
                       -- ^ The sender of this Notice.
                       -- This field is always a 'Just' for received
                       -- notices. Setting it to 'Nothing' for sent
                       -- notices will cause it to automatically be
                       -- filled in.
                       , z_default_fmt :: B.ByteString
                       -- ^ The default format clients should use to
                       --   render this notice.
                       , z_kind        :: ZNoticeKind
                       -- ^ The kind of this notice (determines how it
                       --   will be ACK'd).
                       , z_auth        :: ZAuth
                       -- ^ Whether this notice is authenticated.
                       , z_fields      :: [B.ByteString]
                       -- ^ A list of the fields in this notice.
                       , z_time        :: Time.UTCTime
                       -- ^ The time this notice was sent.
                        }

-- | A helper to allocate memory for a single C @ZNotice_t@.
allocaZNotice :: (Ptr ZNotice -> IO a) -> IO a
allocaZNotice comp = allocaBytes ((188)) $ \c_note -> do
{-# LINE 148 "Network/Zephyr/CBits.hsc" #-}
                       memset c_note 0 ((188))
{-# LINE 149 "Network/Zephyr/CBits.hsc" #-}
                       comp c_note

-- | A helper combinator to marshal a 'ZNotice' to a @ZNotice_t@.
withZNotice :: ZNotice -> (Ptr ZNotice -> IO a) -> IO a
withZNotice note comp = do
  allocaZNotice                       $ \c_note      -> do
    B.useAsCString (z_class note)     $ \c_class     -> do
    B.useAsCString (z_instance note)  $ \c_instance  -> do
    B.useAsCString (z_recipient note) $ \c_recipient -> do
    B.useAsCString (z_opcode note)    $ \c_opcode    -> do
    B.useAsCString (z_default_fmt note) $ \c_fmt     -> do
    B.useAsCStringLen message         $ \(c_message, c_msg_len) -> do
    maybeWith B.useAsCString (z_sender note)  $ \c_sender       -> do
        (\hsc_ptr -> pokeByteOff hsc_ptr 8)        c_note (z_kind note)
{-# LINE 163 "Network/Zephyr/CBits.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 60)        c_note (0::CInt)
{-# LINE 164 "Network/Zephyr/CBits.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 80)       c_note c_class
{-# LINE 165 "Network/Zephyr/CBits.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 84)  c_note c_instance
{-# LINE 166 "Network/Zephyr/CBits.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 88)      c_note c_opcode
{-# LINE 167 "Network/Zephyr/CBits.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 100) c_note c_fmt
{-# LINE 168 "Network/Zephyr/CBits.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 172)     c_note c_message
{-# LINE 169 "Network/Zephyr/CBits.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 176) c_note c_msg_len
{-# LINE 170 "Network/Zephyr/CBits.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 92)      c_note c_sender
{-# LINE 171 "Network/Zephyr/CBits.hsc" #-}
        comp c_note
      where message :: B.ByteString
            message = B.append (B.intercalate (B.pack "\0") $ z_fields note) (B.pack "\0")

-- | Parse a @ZNotice_t@ into a 'ZNotice' record.
parseZNotice :: Ptr ZNotice -> IO ZNotice
parseZNotice c_note = do
  version <- (\hsc_ptr -> peekByteOff hsc_ptr 4)         c_note >>= B.packCString
{-# LINE 179 "Network/Zephyr/CBits.hsc" #-}
  cls     <- (\hsc_ptr -> peekByteOff hsc_ptr 80)           c_note >>= B.packCString
{-# LINE 180 "Network/Zephyr/CBits.hsc" #-}
  inst    <- (\hsc_ptr -> peekByteOff hsc_ptr 84)      c_note >>= B.packCString
{-# LINE 181 "Network/Zephyr/CBits.hsc" #-}
  recip   <- (\hsc_ptr -> peekByteOff hsc_ptr 96)       c_note >>= B.packCString
{-# LINE 182 "Network/Zephyr/CBits.hsc" #-}
  opcode  <- (\hsc_ptr -> peekByteOff hsc_ptr 88)          c_note >>= B.packCString
{-# LINE 183 "Network/Zephyr/CBits.hsc" #-}
  sender  <- (\hsc_ptr -> peekByteOff hsc_ptr 92)          c_note >>= B.packCString
{-# LINE 184 "Network/Zephyr/CBits.hsc" #-}
  fmt     <- (\hsc_ptr -> peekByteOff hsc_ptr 100)  c_note >>= B.packCString
{-# LINE 185 "Network/Zephyr/CBits.hsc" #-}
  kind    <- (\hsc_ptr -> peekByteOff hsc_ptr 8)            c_note
{-# LINE 186 "Network/Zephyr/CBits.hsc" #-}
  secs    <- (\hsc_ptr -> peekByteOff hsc_ptr 52)     c_note
{-# LINE 187 "Network/Zephyr/CBits.hsc" #-}
  time    <- return $ POSIXTime.posixSecondsToUTCTime (realToFrac (secs :: CTime))
  c_len   <- (\hsc_ptr -> peekByteOff hsc_ptr 176)     c_note
{-# LINE 189 "Network/Zephyr/CBits.hsc" #-}
  c_msg   <- (\hsc_ptr -> peekByteOff hsc_ptr 172)         c_note
{-# LINE 190 "Network/Zephyr/CBits.hsc" #-}
  message <- B.packCStringLen (c_msg, c_len)
  fields  <- return $ filterFields $ B.split '\0' message
  c_auth  <- z_check_authentication c_note $ (\hsc_ptr -> hsc_ptr `plusPtr` 12) c_note
{-# LINE 193 "Network/Zephyr/CBits.hsc" #-}
  auth    <- case c_auth of
               _ | c_auth == zauth_no  -> return Unauthenticated
                 | c_auth == zauth_yes -> return Authenticated
                 | c_auth == zauth_failed -> return AuthenticationFailed
                 | otherwise           -> fail $ error_message c_auth
  return $ ZNotice { z_version     = version
                   , z_class       = cls
                   , z_instance    = inst
                   , z_recipient   = recip
                   , z_opcode      = opcode
                   , z_sender      = Just sender
                   , z_default_fmt = fmt
                   , z_kind        = kind
                   , z_auth        = auth
                   , z_fields      = fields
                   , z_time        = time
                   }
    where filterFields = id
          -- filterFields fields = if (B.null $ last fields)
          --                       then init fields
          --                      else fields


newtype SockAddr = SockAddr { unSockAddr :: SockAddr }

type Port = CUShort

foreign import ccall unsafe "error_message"
        c_error_message :: Code_t -> IO CString

foreign import ccall unsafe "ZInitialize"
        z_initialize :: IO Code_t

foreign import ccall unsafe "ZOpenPort"
        z_open_port :: Ptr Port -> IO Code_t

foreign import ccall unsafe "ZClosePort"
        z_close_port :: IO Code_t

foreign import ccall unsafe "ZGetSender"
        z_get_sender :: IO CString

foreign import ccall unsafe "&__Zephyr_realm"
        z_realm      :: CString

type ZAuthProc = FunPtr (Ptr ZNotice -> CString -> CInt -> IO (Ptr CInt))

foreign import ccall unsafe "ZSendNotice"
        z_send_notice :: Ptr ZNotice -> ZAuthProc -> IO Code_t

foreign import ccall unsafe "&ZMakeAuthentication"
        z_make_authentication :: ZAuthProc

foreign import ccall unsafe "ZCancelSubscriptions"
        z_cancel_subscriptions :: Port -> IO Code_t

foreign import ccall unsafe "ZSubscribeTo"
        z_subscribe_to :: Ptr ZSubscription -> CInt -> Port -> IO Code_t

foreign import ccall unsafe "ZUnsubscribeTo"
        z_unsubscribe_to :: Ptr ZSubscription -> CInt -> Port -> IO Code_t

foreign import ccall unsafe "ZReceiveNotice"
        z_receive_notice :: Ptr ZNotice -> Ptr SockAddr -> IO Code_t

foreign import ccall unsafe "ZCheckAuthentication"
        z_check_authentication :: Ptr ZNotice -> Ptr SockAddr -> IO Code_t

foreign import ccall unsafe "ZFreeNotice"
        z_free_notice   :: Ptr ZNotice -> IO ()

foreign import ccall unsafe "ZPending"
        z_pending       :: IO CInt

foreign import ccall unsafe "&__Zephyr_fd"
        z_fd            :: Ptr Fd

foreign import ccall unsafe "string.h"
    memset  :: Ptr a -> CInt -> CSize -> IO ()