diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Marcin Tolysz (c) 2017 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Marcin Tolysz nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,1 @@ +# c-mosquitto diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE OverloadedStrings, RecordWildCards #-} +module Main where + +import qualified Network.Mosquitto as M +import Network.Mosquitto.Internal.Types +import Control.Concurrent +import Control.Monad + +import Control.Applicative +import Options + +data MainOptions = MainOptions + { caCert :: String + , userCert :: String + , userKey :: String + , server :: String + , port :: Int + , keepAlive :: Int + } + +instance Options MainOptions where + defineOptions = pure MainOptions + <*> simpleOption "ca" "rootCA.pem" + "server's CA" + <*> simpleOption "cert" "cert.pem" + "client cert" + <*> simpleOption "key" "cert.key" + "client key" + <*> simpleOption "server" "localhost" + "client key" + <*> simpleOption "port" 8883 + "server's port" + <*> simpleOption "keep-alive" 1200 + "server's port" + +main :: IO () +main = runCommand $ \MainOptions{..} args -> M.withMosquittoLibrary $ do + print M.version + + m <- M.newMosquitto True "server" (Just ()) + M.setTls m caCert userCert userKey + M.setTlsInsecure m True + + M.onMessage m print + M.onLog m $ const putStrLn + M.onConnect m print + M.onDisconnect m print + M.onSubscribe m $ curry print + + M.connect m server port keepAlive + + M.subscribe m 0 "rcv/#" + + forkIO $ forever $ do + M.publish m False 0 "hello" "bla" + threadDelay 5000000 + + M.loopForever m + M.destroyMosquitto m + print "The end" diff --git a/c-mosquitto.cabal b/c-mosquitto.cabal new file mode 100644 --- /dev/null +++ b/c-mosquitto.cabal @@ -0,0 +1,56 @@ +name: c-mosquitto +version: 0.1.0.0 +synopsis: Simpe mosquito MQTT binding able to work with the Amazons IoT +-- description: +homepage: https://github.com/tolysz/c-mosquitto#readme +license: BSD3 +license-file: LICENSE +author: Marcin Tolysz +maintainer: tolysz@gmail.com +copyright: 2017(c) Marcin Tolysz +category: Library +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: + Network.Mosquitto + Network.Mosquitto.Internal.Types + Network.Mosquitto.Internal.Inline + Language.C.Inline.TypeLevel + + build-depends: base >= 4.7 && < 5 + , inline-c + , primitive + , containers + , bytestring + default-language: Haskell2010 + + cc-options: -Wall -O2 + c-sources: src/Network/Mosquitto.c + extra-libraries: mosquitto + +executable c-mosquitto + hs-source-dirs: app + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , c-mosquitto + , options + default-language: Haskell2010 + +test-suite c-mosquitto-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , c-mosquitto + + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/tolysz/c-mosquitto diff --git a/src/Language/C/Inline/TypeLevel.hs b/src/Language/C/Inline/TypeLevel.hs new file mode 100644 --- /dev/null +++ b/src/Language/C/Inline/TypeLevel.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE TypeFamilies #-} + +module Language.C.Inline.TypeLevel where + +import Foreign.C.Types +import Foreign.Ptr ( Ptr, nullPtr ) +import Data.Int ( Int32 ) +import GHC.TypeLits + +import Control.Monad.Primitive ( PrimMonad, PrimState ) + +-- | Wrapper for mutable values +newtype Mut a s = Mut { unMut :: a } + +type family Mutable (a :: *) :: * -> * + +class FreezeThaw a where + freeze :: (PrimMonad m) => Mutable a (PrimState m) -> m a + thaw :: (PrimMonad m) => a -> m (Mutable a (PrimState m)) + + unsafeFreeze :: (PrimMonad m) => Mutable a (PrimState m) -> m a + unsafeThaw :: (PrimMonad m) => a -> m (Mutable a (PrimState m)) + +type family C (a :: *) :: * + +type instance C (Maybe a) = C a +type instance C (Mut a s) = C a + +-- | Perform an IO action with a pointer to the C equivalent of a value +class WithPtr a where + -- | Perform an action with a temporary pointer to the underlying + -- representation of @a@ + -- + -- The pointer is not guaranteed to be usuable outside the scope of this + -- function. The same warnings apply as for 'withForeignPtr'. + withPtr :: a -> (Ptr (C a) -> IO b) -> IO b + +-- | 'Nothing' is represented as a 'nullPtr'. +instance (WithPtr a) => WithPtr (Maybe a) where + withPtr Nothing f = f nullPtr + withPtr (Just obj) f = withPtr obj f + +-- instance WithPtr () where +-- withPtr ptr f = f ptr + +-- | Mutable types use the same underlying representation as unmutable types. +instance (WithPtr a) => WithPtr (Mut a s) where + withPtr = withPtr . unMut + +-- | Information about the storage requirements of values in C +-- +-- This class assumes that the type @a@ is merely a symbol that corresponds with +-- a type in C. +class CSizeOf a where + -- | Computes the storage requirements (in bytes) of values of + -- type @a@ in C. + cSizeOf :: proxy a -> Int + +-------------------------------------------------------------------------------- + +-- | Types of which a value can be constructed from a pointer to the C +-- equivalent of that value +-- +-- Used to wrap values created in C. +class FromPtr a where + fromPtr :: IO (Ptr (C a)) -> IO a diff --git a/src/Network/Mosquitto.c b/src/Network/Mosquitto.c new file mode 100644 --- /dev/null +++ b/src/Network/Mosquitto.c @@ -0,0 +1,181 @@ + +#include + +#include + +int inline_c_Network_Mosquitto_0_af973a022b4e1bdc5e364f24abf1f96042f22074(struct mosquitto_message * ptr_inline_c_0) { +return ( ptr_inline_c_0->mid); +} + + +char * inline_c_Network_Mosquitto_1_1ffdbc152633d765d9af8dc1a99fc84de7cdc43d(struct mosquitto_message * ptr_inline_c_0) { +return (ptr_inline_c_0 -> topic ); +} + + +char * inline_c_Network_Mosquitto_2_2a9eed77120139b9bb64a7f6606b06cf995c53d0(struct mosquitto_message * ptr_inline_c_0) { +return (ptr_inline_c_0 -> payload ); +} + + +int inline_c_Network_Mosquitto_3_a343e4f7dc55e7308355464e738a9402fb43c490(struct mosquitto_message * ptr_inline_c_0) { +return (ptr_inline_c_0 -> payloadlen ); +} + + +int inline_c_Network_Mosquitto_4_f085573633eba51cb044b22361e904fc48b4a9f3(struct mosquitto_message * ptr_inline_c_0) { +return ( ptr_inline_c_0->qos); +} + + +bool inline_c_Network_Mosquitto_5_ceaf89a39d1e88cb7f623dfa0d464582f936ed4f(struct mosquitto_message * ptr_inline_c_0) { +return ( ptr_inline_c_0->retain); +} + + +int inline_c_Network_Mosquitto_6_d5c23f7055ae67c09ff206dd6a9cc4f020e85c61() { +return ( mosquitto_lib_init() ); +} + + +int inline_c_Network_Mosquitto_7_f62c1e89d0a67f1afbdb4eb34ac4bfb9ad34dd96() { +return ( mosquitto_lib_cleanup() ); +} + + +void inline_c_Network_Mosquitto_8_7dea8f89bfffce831052393584adc3a08aa14253(int * a_inline_c_0, int * b_inline_c_1, int * c_inline_c_2) { + mosquitto_lib_version(a_inline_c_0,b_inline_c_1,c_inline_c_2); +} + + +struct mosquitto * inline_c_Network_Mosquitto_9_f6927ebaedf8d0928ab12c9fbae686d2dd74e3c0(char * userId_inline_c_0, bool clearSession_inline_c_1) { +return ( + mosquitto_new( userId_inline_c_0 + , clearSession_inline_c_1 + , 0 // (void * ptrUserData) + ) + ); +} + + +void inline_c_Network_Mosquitto_10_403fc80492c1877303448c739bc735b61f91b41d(struct mosquitto * ptr_inline_c_0) { + + mosquitto_destroy(ptr_inline_c_0) + ; +} + + +void inline_c_Network_Mosquitto_11_2e52b4e387ff964e8763e13931c04b69aff55430(struct mosquitto * pMosq_inline_c_0, char * caFile_inline_c_1, char * certFile_inline_c_2, char * keyFile_inline_c_3) { + + mosquitto_tls_set( pMosq_inline_c_0 + , caFile_inline_c_1 + , 0 + , certFile_inline_c_2 + , keyFile_inline_c_3 + , 0 + ) + ; +} + + +void inline_c_Network_Mosquitto_12_a6d84b6d438cc1f4f26a03133618129025930e03(struct mosquitto * pMosq_inline_c_0, char * hostname_inline_c_1, int port_inline_c_2, int keepAlive_inline_c_3) { + + mosquitto_connect( pMosq_inline_c_0 + , hostname_inline_c_1 + , port_inline_c_2 + , keepAlive_inline_c_3 + ) + ; +} + + +void inline_c_Network_Mosquitto_13_9b2300d6db40d43ebb6d72e3b5a020f27089aa9f(struct mosquitto * pMosq_inline_c_0, void (* on_subscribe_inline_c_1)(struct mosquitto *, void *, int , int , const int *)) { + + mosquitto_subscribe_callback_set + ( pMosq_inline_c_0 + , on_subscribe_inline_c_1 + ); + +} + + +void inline_c_Network_Mosquitto_14_c37f43d389a2b1e4a300492e3a711a4a76e04f57(struct mosquitto * pMosq_inline_c_0, void (* on_connect_inline_c_1)(struct mosquitto *, void *, int )) { + + mosquitto_connect_callback_set + ( pMosq_inline_c_0 + , on_connect_inline_c_1 + ); + +} + + +void inline_c_Network_Mosquitto_15_73f1686f2c07e9747998ec5d1a023376b6401ac8(struct mosquitto * pMosq_inline_c_0, void (* on_disconnect_inline_c_1)(struct mosquitto *, void *, int )) { + + mosquitto_disconnect_callback_set + ( pMosq_inline_c_0 + , on_disconnect_inline_c_1 + ); + +} + + +void inline_c_Network_Mosquitto_16_374d617a6dd1e6b1b85395b1c3a2043f8a86cd2b(struct mosquitto * pMosq_inline_c_0, void (* on_log_inline_c_1)(struct mosquitto *, void *, int , const char *)) { + + mosquitto_log_callback_set + ( pMosq_inline_c_0 + , on_log_inline_c_1 + ); + +} + + +void inline_c_Network_Mosquitto_17_2dd27966a8764a1bdd083baf0f4690e8e2ef1475(struct mosquitto * pMosq_inline_c_0, void (* on_message_inline_c_1)(struct mosquitto *, void *, const struct mosquitto_message *)) { + + mosquitto_message_callback_set + ( pMosq_inline_c_0 + , on_message_inline_c_1 + ); + +} + + +void inline_c_Network_Mosquitto_18_4b8c8d8774deee8ab1d79ed9d536914d1ca65d06(struct mosquitto * pMosq_inline_c_0) { + + mosquitto_loop_forever(pMosq_inline_c_0, -1, 1) + ; +} + + +void inline_c_Network_Mosquitto_19_969dca874ea20234f06362014c8097eab6c27f8f(struct mosquitto * pMosq_inline_c_0, bool isInsecure_inline_c_1) { + + mosquitto_tls_insecure_set(pMosq_inline_c_0, isInsecure_inline_c_1) + ; +} + + +void inline_c_Network_Mosquitto_20_61ffbebe13cb650a9058a8b715732b7a82987f92(struct mosquitto * pMosq_inline_c_0, char * topic_inline_c_1, long payload_inline_c_2, char * payload_inline_c_3, int qos_inline_c_4, bool retain_inline_c_5) { + + mosquitto_publish + ( pMosq_inline_c_0 + , 0 + , topic_inline_c_1 + , payload_inline_c_2 + , payload_inline_c_3 + , qos_inline_c_4 + , retain_inline_c_5 + ) + ; +} + + +void inline_c_Network_Mosquitto_21_491fe5e8a7e8888c30139bd3dcd275298b39e3a8(struct mosquitto * pMosq_inline_c_0, char * topic_inline_c_1, int qos_inline_c_2) { + + mosquitto_subscribe + ( pMosq_inline_c_0 + , 0 + , topic_inline_c_1 + , qos_inline_c_2 + ) + ; +} + diff --git a/src/Network/Mosquitto.hs b/src/Network/Mosquitto.hs new file mode 100644 --- /dev/null +++ b/src/Network/Mosquitto.hs @@ -0,0 +1,207 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Network.Mosquitto where + +import Data.Coerce (coerce) +import Data.Monoid ((<>)) +import Control.Monad +import Foreign.C.Types +import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, newForeignPtr_) +import Foreign.Ptr ( Ptr, nullPtr, castPtr, FunPtr) +import Foreign.Marshal.Alloc ( alloca ) +import Foreign.C.String (peekCString, peekCStringLen) + +import qualified Language.C.Inline as C +import qualified Language.C.Inline.Unsafe as CU + +import Language.C.Inline.TypeLevel + +import System.IO.Unsafe (unsafePerformIO) +import qualified Data.ByteString as S +import qualified Data.ByteString.Char8 as C8 +import qualified Data.ByteString.Internal as BSI +import qualified Data.ByteString.Unsafe as BS + +import Network.Mosquitto.Internal.Types +import Network.Mosquitto.Internal.Inline +import Foreign.Storable + +C.context (C.baseCtx <> C.vecCtx <> C.funCtx <> mosquittoCtx) +C.include "" +C.include "" + +c'MessageToMMessage :: Ptr C'Message -> IO Message +c'MessageToMMessage ptr = + Message + <$> (fromIntegral <$> [C.exp| int { $(struct mosquitto_message * ptr)->mid} |]) + <*> (peekCString =<< [C.exp| char * {$(struct mosquitto_message * ptr) -> topic } |]) + <*> (C8.packCStringLen =<< (,) + <$> [C.exp| char * {$(struct mosquitto_message * ptr) -> payload } |] + <*> fmap fromIntegral [C.exp| int {$(struct mosquitto_message * ptr) -> payloadlen } |]) + <*> (fromIntegral <$> [C.exp| int { $(struct mosquitto_message * ptr)->qos} |]) + <*> [C.exp| bool { $(struct mosquitto_message * ptr)->retain} |] + +{-# NOINLINE init #-} +init = [C.exp| int{ mosquitto_lib_init() }|] + +{-# NOINLINE cleanup #-} +cleanup = [C.exp| int{ mosquitto_lib_cleanup() }|] + +withMosquittoLibrary :: IO a -> IO a +withMosquittoLibrary f = Network.Mosquitto.init *> f <* cleanup + +{-# NOINLINE version #-} +version :: (Int, Int, Int) +version = unsafePerformIO $ + alloca $ \a -> alloca $ \b -> alloca $ \c -> do + [C.block|void{ mosquitto_lib_version($(int *a),$(int *b),$(int *c)); }|] + (,,) <$> peek' a + <*> peek' b + <*> peek' c + where + peek' x = fromIntegral <$> peek x + +newMosquitto :: Bool -> String -> Maybe a -> IO (Mosquitto a) +newMosquitto clearSession (C8.pack -> userId) _userData = do + fp <- newForeignPtr_ <$> [C.exp|struct mosquitto *{ + mosquitto_new( $bs-ptr:userId + , $(bool clearSession) + , 0 // (void * ptrUserData) + ) + }|] + Mosquitto <$> fp + +destroyMosquitto :: Mosquitto a -> IO () +destroyMosquitto ms = withPtr ms $ \ptr -> + [C.exp|void{ + mosquitto_destroy($(struct mosquitto *ptr)) + }|] + +setTls :: Mosquitto a -> String -> String -> String -> IO () +setTls mosq (C8.pack -> caFile) (C8.pack -> certFile) (C8.pack -> keyFile) = + withPtr mosq $ \pMosq -> + [C.exp|void{ + mosquitto_tls_set( $(struct mosquitto *pMosq) + , $bs-ptr:caFile + , 0 + , $bs-ptr:certFile + , $bs-ptr:keyFile + , 0 + ) + }|] + +connect :: Mosquitto a -> String -> Int -> Int -> IO () +connect mosq (C8.pack -> hostname) (fromIntegral -> port) (fromIntegral -> keepAlive) = + withPtr mosq $ \pMosq -> + [C.exp|void{ + mosquitto_connect( $(struct mosquitto *pMosq) + , $bs-ptr:hostname + , $(int port) + , $(int keepAlive) + ) + }|] + +onSubscribe :: Mosquitto a -> OnSubscribe -> IO () +onSubscribe mosq onSubscribe = do + on_subscribe <- mkCOnSubscribe $ \_ _ mid (fromIntegral -> ii) iis -> + onSubscribe (fromIntegral mid) =<< mapM (fmap fromIntegral . peekElemOff iis) [0..ii-1] + withPtr mosq $ \pMosq -> + [C.block|void{ + mosquitto_subscribe_callback_set + ( $(struct mosquitto *pMosq) + , $(void (*on_subscribe)(struct mosquitto *,void *, int, int, const int *)) + ); + }|] + + +onConnect :: Mosquitto a -> OnConnection -> IO () +onConnect mosq onConnect = do + on_connect <- mkCOnConnection $ \_ _ ii -> onConnect (fromIntegral ii) + withPtr mosq $ \pMosq -> + [C.block|void{ + mosquitto_connect_callback_set + ( $(struct mosquitto *pMosq) + , $(void (*on_connect)(struct mosquitto *,void *, int)) + ); + }|] + +onDisconnect :: Mosquitto a -> OnConnection -> IO () +onDisconnect mosq onDisconnect = do + on_disconnect <- mkCOnConnection $ \_ _ ii -> onDisconnect (fromIntegral ii) + withPtr mosq $ \pMosq -> + [C.block|void{ + mosquitto_disconnect_callback_set + ( $(struct mosquitto *pMosq) + , $(void (*on_disconnect)(struct mosquitto *,void *, int)) + ); + }|] + +onLog :: Mosquitto a -> OnLog -> IO () +onLog mosq onLog = do + on_log <- mkCOnLog $ \_ _ ii mm -> onLog (fromIntegral ii) =<< peekCString mm + withPtr mosq $ \pMosq -> + [C.block|void{ + mosquitto_log_callback_set + ( $(struct mosquitto *pMosq) + , $(void (*on_log)(struct mosquitto *,void *, int, const char *)) + ); + }|] + +onMessage :: Mosquitto a -> OnMessage -> IO () +onMessage mosq onMessage = do + on_message <- mkCOnMessage $ \_ _ mm -> (onMessage =<< c'MessageToMMessage mm) + withPtr mosq $ \pMosq -> + [C.block|void{ + mosquitto_message_callback_set + ( $(struct mosquitto *pMosq) + , $(void (*on_message)(struct mosquitto *, void *, const struct mosquitto_message *)) + ); + }|] + +loopForever :: Mosquitto a -> IO () +loopForever mosq = + withPtr mosq $ \pMosq -> + [C.exp|void{ + mosquitto_loop_forever($(struct mosquitto *pMosq), -1, 1) + }|] + +setTlsInsecure :: Mosquitto a -> Bool -> IO () +setTlsInsecure mosq isInsecure = + withPtr mosq $ \pMosq -> + [C.exp|void{ + mosquitto_tls_insecure_set($(struct mosquitto *pMosq), $(bool isInsecure)) + }|] + +publish :: Mosquitto a -> Bool -> Int -> String -> S.ByteString -> IO () +publish mosq retain (fromIntegral -> qos) (C8.pack -> topic) payload = + withPtr mosq $ \pMosq -> + [C.exp|void{ + mosquitto_publish + ( $(struct mosquitto *pMosq) + , 0 + , $bs-ptr:topic + , $bs-len:payload + , $bs-ptr:payload + , $(int qos) + , $(bool retain) + ) + }|] + +subscribe :: Mosquitto a -> Int -> String -> IO () +subscribe mosq (fromIntegral -> qos) (C8.pack -> topic) = + withPtr mosq $ \pMosq -> + [C.exp|void{ + mosquitto_subscribe + ( $(struct mosquitto *pMosq) + , 0 + , $bs-ptr:topic + , $(int qos) + ) + }|] diff --git a/src/Network/Mosquitto/Internal/Inline.hs b/src/Network/Mosquitto/Internal/Inline.hs new file mode 100644 --- /dev/null +++ b/src/Network/Mosquitto/Internal/Inline.hs @@ -0,0 +1,12 @@ + +module Network.Mosquitto.Internal.Inline where + +import qualified Language.C.Inline.Context as C +import Data.Monoid ( (<>) ) + +import Network.Mosquitto.Internal.Types + +mosquittoCtx :: C.Context +mosquittoCtx = C.bsCtx <> C.vecCtx <> ctx + where + ctx = mempty { C.ctxTypesTable = mosquittoTypesTable } diff --git a/src/Network/Mosquitto/Internal/Types.hs b/src/Network/Mosquitto/Internal/Types.hs new file mode 100644 --- /dev/null +++ b/src/Network/Mosquitto/Internal/Types.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} + +module Network.Mosquitto.Internal.Types where + +import Foreign.ForeignPtr (ForeignPtr, withForeignPtr) +import Foreign.Ptr (Ptr, FunPtr) +import Foreign.C.Types +import Language.C.Inline.TypeLevel +import qualified Language.C.Types as C +import qualified Language.C.Inline.Context as C +import Data.ByteString (ByteString) + +import qualified Data.Map as M +import Foreign.Storable + +-- haskell types +newtype Mosquitto a = Mosquitto { unMosquitto :: ForeignPtr (C (Mosquitto a))} +-- newtype Message = Message { unMessage :: Ptr (C Message)} +newtype RawMessage = RawMessage { unRawMessage :: Ptr (C RawMessage)} + +data Message = Message + { mid :: Int + , topic :: String + , payload :: ByteString + , qos :: Int + , retain :: Bool + } deriving (Eq, Show, Read) + + +data C'Mosquitto +data C'Message + +-- glue +type instance C (Mosquitto a) = C'Mosquitto +type instance C RawMessage = C'Message + +instance WithPtr (Mosquitto a) where + withPtr = withForeignPtr . unMosquitto +instance WithPtr RawMessage where + withPtr m f = f (unRawMessage m) + + +mosquittoTypesTable :: C.TypesTable +mosquittoTypesTable = M.fromList + [ ( C.Struct "mosquitto" , [t| C'Mosquitto |] ) + , ( C.Struct "mosquitto_message" , [t| C'Message |] ) + , ( C.TypeName "bool" , [t| Bool |] ) + ] + +type OnMessage = Message -> IO () +type COnMessage = Ptr C'Mosquitto -> Ptr () -> Ptr C'Message -> IO () +foreign import ccall "wrapper" + mkCOnMessage :: COnMessage -> IO (FunPtr COnMessage) + +type OnLog = Int -> String -> IO () +type COnLog = Ptr C'Mosquitto -> Ptr () -> CInt -> Ptr CChar -> IO () +foreign import ccall "wrapper" + mkCOnLog :: COnLog -> IO (FunPtr COnLog) + +type OnConnection = Int -> IO () +type COnConnection = Ptr C'Mosquitto -> Ptr () -> CInt -> IO () +foreign import ccall "wrapper" + mkCOnConnection :: COnConnection -> IO (FunPtr COnConnection) + +type OnSubscribe = Int -> [Int] -> IO () +type COnSubscribe = Ptr C'Mosquitto -> Ptr () -> CInt -> CInt -> Ptr CInt -> IO () +foreign import ccall "wrapper" + mkCOnSubscribe :: COnSubscribe -> IO (FunPtr COnSubscribe) diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented"