module EIBd.Client.Connection (
	-- * Connection
	Connection,
	connectRemote,
	connectLocal,
	defaultPort,

	-- * Messaging
	Message (..),
	APCI (..),
	recvMessage,
	sendMessage,
	sendMessage',

	-- * Group Messaging
	GroupMessage (..),
	recvGroupMessage,
	sendGroupMessage,
) where

import Control.Monad
import Control.Applicative
import Control.Exception

import Data.Bits
import qualified Data.ByteString as B

import Foreign hiding (void)
import Foreign.C

import EIBd.Client.Address

-- | Connect to a remote socket using a host name and port number.
foreign import ccall "EIBSocketRemote"
	socketRemote :: CString -> CInt -> IO (Ptr ConnStruct)

-- | Connect to a local unix socket.
foreign import ccall "EIBSocketLocal"
	socketLocal :: CString -> IO (Ptr ConnStruct)

-- | Function pointer to the 'EIBClose' procedure
foreign import ccall "&EIBClose"
	closeConnection :: FunPtr (Ptr ConnStruct -> IO ())

-- | Open a GroupSocket connection.
foreign import ccall "EIBOpen_GroupSocket"
	openGroupSocket :: Ptr ConnStruct -> CInt -> IO CInt

-- | Get an APDU from the bus.
foreign import ccall "EIBGetGroup_Src"
	recvGroup :: Ptr ConnStruct -> CInt -> Ptr Word8 -> Ptr Word16 -> Ptr Word16 -> IO CInt

-- | Send an APDU to the bus.
foreign import ccall "EIBSendGroup"
	sendGroup :: Ptr ConnStruct -> CUShort -> CInt -> Ptr CChar -> IO CInt

-- | Opaque Connect Structure
data ConnStruct

-- | It is possible to connect to a local EIBd server instance via unix socket or
-- remotely via a TCP socket.
--
-- > connection <- connectLocal "/tmp/eib"
--
-- or
--
-- > connection <- connectRemote "eibd.address.here" 6720
newtype Connection
	= Connection { connHandle :: ForeignPtr ConnStruct }
	deriving Show

-- | Interact with the low-level structure.
withHandle :: Connection -> (Ptr ConnStruct -> IO a) -> IO a
withHandle = withForeignPtr . connHandle

-- | Connect to an EIBd server via a TCP Socket.
connectRemote :: B.ByteString -> Word16 -> IO Connection
connectRemote host' port' = B.useAsCString host' $ \host -> do
	cs <- socketRemote host (fromIntegral port')
	when (cs == nullPtr) (fail "Failed to connect")
	openGroupSocket cs 0
	fmap Connection (newForeignPtr closeConnection cs)

-- | Connect to an EIBd server via a Unix Socket.
connectLocal :: B.ByteString -> IO Connection
connectLocal path' = B.useAsCString path' $ \path -> do
	cs <- socketLocal path
	when (cs == nullPtr) (fail "Failed to connect")
	openGroupSocket cs 0
	fmap Connection (newForeignPtr closeConnection cs)

-- | Default EIBd port
defaultPort :: Word16
defaultPort = 6720

-- | Application Protocol Control Information determines the kind of a message.
data APCI
	= GroupAddrRead
	| GroupAddrResponse
	| GroupAddrWrite
	| IndividualWrite
	| IndividualRequest
	| IndividualResponse
	| AdcRead
	| AdcResponse
	| MemoryRead
	| MemoryResponse
	| MemoryWrite
	| UserMessage
	| MaskVersionRead
	| MaskVersionResponse
	| Restart
	| Escape
	deriving (Show, Eq, Ord)

-- | Message (very closely related to a CEMI frame)
data Message = Message { messageSource      :: IndividualAddress
                       , messageDestination :: GroupAddress
                       , messageTPCI        :: Word8
                       , messageAPCI        :: APCI
                       , messagePayload     :: B.ByteString }
	deriving (Show, Eq)

-- | Word8 to APCI.
toAPCI :: Word8 -> APCI
toAPCI 0 = GroupAddrRead
toAPCI 1 = GroupAddrResponse
toAPCI 2 = GroupAddrWrite
toAPCI 3 = IndividualWrite
toAPCI 4 = IndividualRequest
toAPCI 5 = IndividualResponse
toAPCI 6 = AdcRead
toAPCI 7 = AdcResponse
toAPCI 8 = MemoryRead
toAPCI 9 = MemoryResponse
toAPCI 10 = MemoryWrite
toAPCI 11 = UserMessage
toAPCI 12 = MaskVersionRead
toAPCI 13 = MaskVersionResponse
toAPCI 14 = Restart
toAPCI 15 = Escape
toAPCI _ = undefined

-- | APCI to Word8.
fromAPCI :: APCI -> Word8
fromAPCI GroupAddrRead = 0
fromAPCI GroupAddrResponse = 1
fromAPCI GroupAddrWrite = 2
fromAPCI IndividualWrite = 3
fromAPCI IndividualRequest = 4
fromAPCI IndividualResponse = 5
fromAPCI AdcRead = 6
fromAPCI AdcResponse = 7
fromAPCI MemoryRead = 8
fromAPCI MemoryResponse = 9
fromAPCI MemoryWrite = 10
fromAPCI UserMessage = 11
fromAPCI MaskVersionRead = 12
fromAPCI MaskVersionResponse = 13
fromAPCI Restart = 14
fromAPCI Escape = 15

-- | Fetch a message from the EIBd instance.
recvMessage :: Connection -> IO Message
recvMessage conn = withHandle conn $ \ptr ->
	bracket allocStuff freeStuff $ \(buf, srcPtr, dstPtr) -> do
		len <- recvGroup ptr 32 buf srcPtr dstPtr

		-- Exit on failure
		when (len < 2) (fail "Failed to read group message")

		-- Fetch contents and make sure they are evaluated
		arr <- evaluate =<< peekArray (fromIntegral len) buf
		src <- evaluate =<< peek srcPtr
		dst <- evaluate =<< peek dstPtr

		-- Disect data
		let t : a : xs = arr
		let tpci = shift t (-2)
		let payload = B.pack (a .&. 63 : xs)
		let apci = toAPCI ((shift t 2 .&. 12) .|. (shift a (-6) .&. 3))

		-- Pack structure
		return (Message (IndividualAddress src)
		                (GroupAddress dst)
		                tpci
		                apci
		                payload)
	where
		-- Allocate buffer, source and destination address
		allocStuff = (,,) <$> mallocArray 32
		                  <*> malloc
		                  <*> malloc

		-- Free the previously allocated memory
		freeStuff (buf, srcPtr, dstPtr) = do
			free buf
			free srcPtr
			free dstPtr

-- | Send a message to the EIBd instance.
sendMessage :: Connection -> GroupAddress -> Word8 -> APCI -> B.ByteString -> IO Bool
sendMessage conn (GroupAddress dst) tpci apci' payload = fmap (>= 0) . withHandle conn $ \ptr ->
	B.useAsCStringLen apdu $ \(buf, len) ->
		sendGroup ptr (CUShort dst) (fromIntegral len) buf
	where
		apci = fromAPCI apci'
		octet0 = shift tpci 2 .|. (shift apci (-2) .&. 3)
		octet1Mask = shift (apci .&. 3) 6
		apdu = case B.unpack payload of
			[]     -> B.pack [octet0, octet1Mask]
			x : xs -> B.pack (octet0 : (octet1Mask .|. x) : xs)

-- | Alternative to "sendMessage".
sendMessage' :: Connection -> Message -> IO Bool
sendMessage' conn (Message _ dst tpci apci payload) =
	sendMessage conn dst tpci apci payload

-- | A special kind of message targeting only communication groups.
data GroupMessage
	= GroupRead
	| GroupResponse B.ByteString
	| GroupWrite    B.ByteString
	deriving (Show, Eq)

-- | Receive a group message.
recvGroupMessage :: Connection -> IO (IndividualAddress, GroupAddress, GroupMessage)
recvGroupMessage conn = do
	Message src dst _ cmd payload <- recvMessage conn
	case cmd of
		GroupAddrRead     -> return (src, dst, GroupRead)
		GroupAddrResponse -> return (src, dst, GroupResponse payload)
		GroupAddrWrite    -> return (src, dst, GroupWrite payload)
		_                 -> recvGroupMessage conn

-- | Send a group message.
sendGroupMessage :: Connection -> GroupAddress -> GroupMessage -> IO Bool
sendGroupMessage conn dst GroupRead =
	sendMessage conn dst 0 GroupAddrRead B.empty
sendGroupMessage conn dst (GroupResponse payload) =
	sendMessage conn dst 0 GroupAddrResponse payload
sendGroupMessage conn dst (GroupWrite payload) =
	sendMessage conn dst 0 GroupAddrWrite payload