Binding to a C++ CORBA interface in Haskell

This post is mostly a reminder on how I did this, so that I have a place to look it up.

Ok, so basically, I work on the mission control system GECCOS for DLR (Deutsches Zentrum für Luft- und Raumfahrt), which is currently flying seven missions with it. The MCS is not an isolated system, but connected to a number of other systems around it (e.g. SSB –  network routing to the ground stations, SATMON for having pretty displays, mission planning, flight dynamics etc). In our company, we don’t have these systems available, so we need to somehow simulate them.

This is the point, where Haskell comes into play. Over the course of the last years I developed several tools in Haskell which help me with this (see blog posts: Architecture of a Real World Haskell Application and Architecture of a Real World Haskell Application part II

The Problem

I needed to implement a new interface from the MCS to SATMON. The interface is via the EXIF (external interfaces), which work via CORBA. So to be able to test the new interface, I needed an application which can interface CORBA. That’s where it starts.

Unfortunately, there is no CORBA implementation for Haskell available. The system uses omniORB, which is a C++ ORB but also provides a python implementation.

Creating a new CORBA implementation would be quite a lot of hassle, as this would involve an IDL parser, generating lots of Haskell code and so on. Just in case you are not familiar with CORBA: it is a middleware with remote method invocation. The interfaces are specified in an interface definition language (IDL), which are then translated by the IDL compiler into the used target language (in omniORBs case into C++ or Python).

So a direct binding to the existing C++ interface would be an option. After looking around a bit and playing sometimes with C++ binding generators like fcixx, I came across hoppy, which was used to generate the Haskell binding for the QT library. Ok, I thought, let’s give it a try.

But we are not ready yet. The MCS is compiled and running on a SuSE Linux Enterprise Server 11 system, which is really old. Even worse, the MCS uses legacy libraries, which can only be used with a gcc < 3.4.0, because with 3.4.0 there was a change in the ABI (application binary interface) and the code is not linkable with other stuff. Well, turns out, C linking is still possible, but C++ libraries not.

So, how get this working?

Part I – Interface Generation

How to setup the build environment

With ParagonTT (see the other blog posts) this was easy, I created another user and installed a very old ghc (6.8.3) from a binary package (the latest one, which actually is installable as binary package on SLES11), then started to build higher ghc versions step by step. With 8.0 the build was failing due to the old gcc on the system (4.3.4), so I had to also build a newer gcc (4.9.3) and use that for compiling ghc. But in the end I got there and had a working ghc (in this case 8.2.2 and a 8.4.4).

So how does hoppy work? You write an interface specification (a description of the classes you want a binding generated for) in Haskell and compile that to a binary (a generator). If you run this generator, it generates a set of C++ code files with C linkage, which interfaces with the C++ part, and corresponding Haskell code, which interfaces with the C linkable part via the FFI. Easy.

Well, it would be, if we didn’t have 2 user accounts, each configured for different gcc’s. So it’s a bit more complicated. The steps are:

  • Write the interface specification
  • Compile it from the Haskell account with ghc
  • In the MCS development account, run the generated binary to generate the C- and Haskell-code.
  • The C code is put into a library and compiled with the gcc 3.3.6 used for the MCS under the MCS development account
  • Setup a Haskell project, which resides under the repository for the MCS code (the source should be available in the same repository the MCS is in), but is compiled from the Haskell account (getting a bit dizzy?)
  • Compile the generated Haskell code into a library from the Haskell account, linking with the C libraries compiled from two steps above
  • Use the Haskell account to develop the application and link to the generated Haskell library.

Fortunately, this has only to be done when the interface changes, as the ongoing switching between user accounts can be quite annoying. On the other hand, it was not annoying enough to put this in some kind of script and do it automatically…

The runtime

Running the application should then be easy: just copy the binary to a location in the runtime account of the MCS where the paths are already set correctly and run it. If you don’t forget the C library (as in my case), this works…

Code generation with hoppy

To be able to write a C++ interface, we first need to have a look on the C++ code generated from the CORBA IDL compiler, because that is exactly, what we are binding to.

So the IDL defintions looks something like this (already shortened a bit):

    /** Serverside manager for TM Packet Data Provision */
interface TMpacketMngr: IBASE_IF::Model
    {
        /**
         * registration for TM packet notification
         * @parm p_view the client view object to react on CORBA notifications
         * @parm p_packetFilter the packet filter on transmission level (selection);
         * if it is invalid: no registration
         * @parm p_transmFilter the packet transmission filter (projection)
         * @returns long the registration key; if 0, registration failed (invalid filter)
         */
        long registerTMpackets(in TMpacketMngrView p_view,
            in ITMP::TMpacketFilter p_packetFilter,
            in ITMP::TransmissionFilter p_transmFilter);

        /**
         * accessor for actual data
         * @parm p_viewKey the registration key
         * @raises ICLOCK::NotPossible if invalid time context
         */
        ITMP::TMpacketNotifyDatas getFullData(in long p_viewKey)
            raises(ICLOCK::NotPossible);

        /**
         * iterator for the retrivial mode
         * @parm p_viewKey the registration key
         * @raises ICLOCK::NotPossible if invalid time context
         */
        ITMP::TMpacketNotifyDatas getNextData(in long p_viewKey)
            raises(ICLOCK::NotPossible);
    };




    /** Receiver for TM packet data */
interface TMpacketMngrView: IBASE_IF::View
    {
        /** callback for TM packet notifications
         * @parm p_data the sequence of TMpacketNotifyData
         */
        void notifyTMpackets(in ITMP::TMpacketNotifyDatas p_data);
    };

Ok, so we have an interface to register for telemetry packets from the satellite (registerTMpackets), we can request data directly (with getFullData and getNextData) but we also have another interface, which we must implement and which acts as a callback mechanism (TMpacketMngrView) which provides a callback member function (notifyTMpackets). We have a lot of custom data types, which we need to bind, we have inheritance (the interface TMpacketMngr inherits from IBASE_IF::Model) and we have possible C++ exceptions (with the raises(ICLOCK::NotPossible) specifier).

Running omniidl on this interface generates the C++ classes which can be used for accessing this interface. A brief look on the generated C++ code is a bit intimidating: there are several classes generated for each interface (e.g. TMpacketMngr, TMpacketMngr_Helper, _objref_TMpacketMngr, _pof_TMpacketMngr, _impl_TMpacketMngr). Which one to use for what?

Fortunately, the MCS code itself uses them already, so I had code examples in C++ itself. So first, we implement the client interface, means we are only calling functions on the server instance without the callback (which we keep for later).

The MCS uses a CORBA Naming Service, which means, servants register themselves via names in this service. A client can request a service via a name and gets a CORBA object reference. Via this reference, it can call the remote services on the servant. For redundancy reasons, two Naming Services are running (one on the prime, one on the backup machine), so we need to make sure to connect to the right one.

  • Get a reference to the Naming Service
  • Query the naming service with the correct name (for the TMpacketMngr), which should get us a CORBA::Object reference.
  • Cast this reference to the right type. In CORBA, this is called narrowing. So the CORBA::Object reference is narrowed down to a (Tada!): _objref_TMpacketMngr.
  • Now we can call functions on this reference, and they will be executed on the servant. Cool.

So how do we proceed?

First, we look at the _objref_TMpacketMngr class which is generated from omniidl:

class _objref_TMpacketMngr :
  public virtual IBASE_IF::_objref_Model
{
public:
  ::CORBA::Long registerTMpackets(::ITMP_PRO::TMpacketMngrView_ptr p_view, 
     const ::ITMP::TMpacketFilter& p_packetFilter, 
     const ::ITMP::TransmissionFilter& p_transmFilter);

  ....
  ITMP::TMpacketNotifyDatas* getFullData(::CORBA::Long p_viewKey);
  ITMP::TMpacketNotifyDatas* getNextData(::CORBA::Long p_viewKey);

  inline _objref_TMpacketMngr()  { _PR_setobj(0); }  // nil
  _objref_TMpacketMngr(omniIOR*, omniIdentity*);

protected:
  virtual ~_objref_TMpacketMngr();

  
private:
  virtual void* _ptrToObjRef(const char*);

  _objref_TMpacketMngr(const _objref_TMpacketMngr&);
  _objref_TMpacketMngr& operator = (const _objref_TMpacketMngr&);
  // not implemented

  friend class TMpacketMngr;
};

 

The obvious way is to try to bind the _objref_TMpacketMngr class and on the way bind everything else we need. Which includes some generic CORBA stuff for the ORB and Naming Service as well as base classes (like CORBA::Object), structures and CORBA sequences (which in principle correspond to vectors).

So let’s do that. Of course this is a quite large task, so I will only show a few steps. Let’s see the hoppy interface description of the TMpacketMngr with the methods from shown above.

 

c_TMPacketMngrRef :: Class
c_TMPacketMngrRef =
    addReqIncludes [includeLocal "ITMP_PRO.H"] $
    classSetDtorPrivate $
    makeClass (ident1 "ITMP_PRO" "_objref_TMpacketMngr") 
        (Just (toExtName "TMPacketMngrRef"))
        []
        [
            corbaExceptions $
            makeMethod_ "registerTMpackets" (toExtName "registerTMpackets") 
                MNormal Nonpure
                [ptrT (objT c_TMPacketMngrViewRef),
                refT (constT (objT c_TMpacketFilter)),
                refT (constT (objT c_TransmissionFilter))] longT
            , corbaExceptions $
            makeMethod_ "getFullData" (toExtName "getFullData") MNormal 
                Nonpure
                [longT] (toGcT (ptrT (objT c_TMpacketNotifyDatas)))
            , corbaExceptions $
            makeMethod_ "getNextData" (toExtName "getNextData") MNormal 
                Nonpure
                [longT] (toGcT (ptrT (objT c_TMpacketNotifyDatas)))
        ]

Some explanations:

  • c_TMPacketMngrRef is the Haskell name for _objref_TMpacketMngr interface definition and is of the hoppy-type “Class” which represents a C++ class
  • the required include files where to find this class are added with addReqIncludes and are in this case the files generated from omniidl
  • classDtorPrivate is exactly as it seems, the destructor of _objref_TMpacketMngr is protected and therefore cannot be called by C code. As we just get a reference to this class and never allocate or delete it, this is fine. It is also needed because the code would not compile without it
  • makeClass then creates the class interface. It gets some parameters:
    • the qualified name where ITMP_PRO is the C++ namespace name, therefore ident1 is used which corresponds to a qualified name.
    • The external name is the equivalent Haskell type name, in this case TMPacketMngrRef (since _objref_TMpacketMngr is a bit rrrrrh).
    • The list of super-classes from which it is derived is empty. The CORBA generated C++ code shows it is derived  from IBASE_IF::objref_Model, but we don’t need any functionality from there. Also we don’t have to pass this reference as a reference to the IBASE model somewhere, so I decided to leave this empty
    • The list of method specifications. First, this method is wrapped in corbaExceptions, which we see later. CORBA can by default throw a lot of exceptions, so I decided to handle this in an extra function.
    • makeMethod_ describes the method to bind.
      • registerTMpackets” is it’s name and has the same Haskell name.
      • MNormal means it’s a normal method (with MStatic and MConst as alternatives)
      • it is Nonpure (so it will reside in a MonadIO constraint)
      • it’s parameters are a pointer to an object of type c_TMPpacketMngrViewRef, which we have to bind first as a recursive step, a const reference (refT constT) to an object of c_TMpacketfilter and a const reference to a c_TransmissionFilter.
      • It returns a longT which corresponds to a long in C++ which corresponds to a CORBA::Long
    • makeMethod_ for getFullData returns an allocated object of type c_TMpacketNotifyDatas. Because we don’t want to deal manually with memory management for this, the toGcT wrapper is added, which puts the object into a Foreign Pointer on the Haskell side and lets the garbage collector do the work.

As you see, it’s a bit complex, but more or less a direct translation of the C++ interface. Ok, let’s look at the corbaExceptions function, which installs exception handlers for the various possible exceptions thrown by the function:

corbaExceptions x = CEMethod $ handleExceptions [
    CatchClass c_TransientException
    , CatchClass c_BadParamException
    , CatchClass c_MarshalException
    ....
    ] x

I think it is quite easy to understand. This takes the argument and applies the CEMethod constructor to it and has in it’s core the handleExceptions function, which are catch specifications. The CORBA and C++ exceptions which can happen are all classes, so catchClass is used with a reference to the c_<Exception> binding. An example of an exception binding is here:

c_TransientException :: Class
c_TransientException =
    addReqIncludes [includeStd "omniORB4/CORBA.h", 
        includeLocal "ICLOCK.H", includeLocal "IBASE.H"] $
    classMakeException $
    makeClass (ident1 "CORBA" "TRANSIENT") Nothing
        []
        [
            mkCtor "newCopy" [objT c_TransientException]
            ,makeMethod "_name" (toExtName "name") MNormal Nonpure
                [] (ptrT (constT charT))
            , makeMethod "NP_minorString" (toExtName "np_minorString") MNormal 
              Nonpure [] (ptrT (constT charT))
        ]

The CORBA::TRANSIENT exception is used in omniORB < 4.2.0 for indicating a time-out on a connection, so it is the most thrown exception. The binding is quite similar to a normal C++ class. The include directives are a bit more, it is specifically marked as an exception class (with classMakeException). For the exception handlers to be able to be instantiated, the exception needs a copy constructor (I needed some time until I figured this out), so with mkCtor the copy constructor is bound. Exceptions have a “_name” function and to get a more detailed description, the np_minorString function is also bound (np_* means non-portable as this is a omniORB specific function, which is not defined in the CORBA standard). CORBA itself does not provide means to get a meaningful description out of the exception, so we rely on non-portable functions here.

With hoppy of course it is also possible to access global constants or call global functions. E.g. a function

_CORBA_MODULE_FN ORB_ptr ORB_init(int& argc, char** argv,
          const char* orb_identifier="",
          const char* options[][2]=0);

can be bound with:

f_ORB_init :: Function
f_ORB_init =
    addReqIncludes [includeStd "omniORB4/CORBA.h"] $
    makeFn (ident1 "CORBA" "ORB_init") (Just (toExtName "orb_init")) Nonpure
        [refT intT, ptrT (ptrT charT)] (ptrT (objT c_ORB))

it is not an exact translation, because we let out the parameters with default values, as we currently don’t need them, but in practice this works.

A global constant like:

const ::CORBA::Char IS_BOOLEAN = 'B';

is bound as:

v_IS_BOOLEAN :: Variable
v_IS_BOOLEAN =
    addReqIncludes [includeLocal "IBASE.H"] $
    makeVariable (ident1 "IBASE" "IS_BOOLEAN") (Just (toExtName "is_BOOLEAN"))
        (constT charT)

Ok, so the classes, functions and variables are described, what next? Well, we need to define a module, which will be generated and which will contain the generated code. This is done like the following:

module EXIF.GenITMP_PRO

where

import Foreign.Hoppy.Generator.Spec
import Foreign.Hoppy.Generator.Types

import EXIF.GenIBASE
import EXIF.GenICLOCK_PRO
import EXIF.GenCORBA
import EXIF.GenITMP
import EXIF.GenICLOCK
import EXIF.GenIBASE_IF

mod_itmp_pro :: Module
mod_itmp_pro =
    moduleModify' (makeModule "HsITMP_PRO" "HsITMP_PRO.hpp" 
        "HsITMP_PRO.cpp") $
    moduleAddExports [
        ExportClass c_TMPserverRef
        , ExportClass c_TMPserverMngr
        , ExportClass c_TMPserverMngrRef
        , ExportClass c_TMPacketMngrRef
        , ExportClass c_TMPacketMngrViewRef
        , ExportClass c_TMPacketMngrViewPOA
        , ExportClass c_TMPacketMngr
        ....
        , ExportFn f_ORB_init
        ....
        , ExportVariable v_IS_BOOLEAN

        ...
    ]

So we define a Haskell module EXIF.GenITMP_PRO (Interface for TM (== telemetry) packet provision) where the interface description of the C++ classes resides. It imports some stuff from hoppy itself and some classes which were already bound before (the EXIF.* imports).

Then it defines a module, where the generated code will be put in. The module will be named HsITMP_PRO.hs for the generated Haskell module and HsITMP_PRO.hpp and .cpp for the C/C++ interface code. Then the classes, functions and variables which should be exported in this module are listed.

So we do this step by step and generate modules until all we need is covered. At last, we get the main for the interface generator going:

import Foreign.Hoppy.Generator.Main (defaultMain)
import Foreign.Hoppy.Generator.Spec

import EXIF.GenCORBA
import EXIF.GenIBASE
import EXIF.GenIBASE_IF
import EXIF.GenICLOCK
import EXIF.GenICLOCK_PRO
import EXIF.GenITM
import EXIF.GenITMP
import EXIF.GenITMP_PRO


main :: IO ()
main = defaultMain interfaceResult


interfaceResult :: Either String Interface
interfaceResult = do
    iface <- interface "exif" [ mod_CORBA
        , mod_ibase
        , mod_ibase_if
        , mod_iclock
        , mod_iclock_pro
        , mod_itm
        , mod_itmp
        , mod_itmp_pro
        , mod_tmpacket_view
        ]
    interfaceAddHaskellModuleBase ["EXIF"]  $ 
        interfaceSetExceptionSupportModule mod_CORBA $
        interfaceSetSharedPtr "boost::shared_ptr" (reqInclude 
            (includeStd "boost/shared_ptr.hpp"))             
    iface

After the necessary imports we have a main function, which just calls defaultMain from Hoppy with the desired interface. We create the interface in an own function where we pass it the modules we created above. Then we modify it a bit in adding a “EXIF.” hierarchy for the modules to be generated, enable the generation for exception handlers and set the used shared_ptr type.

The setting of shared pointers is a nice feature added by Bryan Gardiner (the creator of hoppy) after some mail communication with him. The reason is my old compiler. For the callbacks (which we haven’t touched yet), hoppy uses internally a shared pointer and therefore uses the std::shared_ptr. Since I must work with a gcc 3.3.6, which doesn’t have a std::shared_ptr defined, but is able to use the shared_ptr from the boost libraries, Bryan was so nice to add a feature to be able to set the shared_ptr to something other than std::shared_ptr. Thanks a lot again, Bryan!

So all we need now, is compiling this to an executable, run it and we get a nice interface that we can use.

But wait! What about the callbacks from CORBA to the Haskell code? Well, it turns out, this isn’t straight forward. I mean, it would if we would use something other than CORBA. So let’s have a look.

Callbacks from CORBA to Haskell

In the IDL file above, which defines the interface, there is a interface TMpacketMngrView defined, which has a function notifyTMpackets which is called when new live data is available. We need to somehow implement this function, which must be callable by CORBA and delivers it’s data to the Haskell side. How to do this?

Well, we need to derive a class from POA_ITMP_PRO::TMpacketMngrView which provides the notifyTMpackets function. We need to create an object of this derived class, then register it at the CORBA servant and it will call back. Well, we also need to start the CORBA ORB, act with the POA manager (POA = portable object adapter) and so on. And somehow, this code needs to call back into Haskell to pass the notification data to the Haskell application.

So in this case, we need to create a C++ object from Haskell, register it and somehow smuggle a callback from C++ to Haskell into it. Hoppy provides two possibilities to generate callbacks into Haskell code: one with generated functor objects (C++ functors, means objects with overloaded function call operator, not Haskell funtors) and one with plain old C function pointers. After playing around with the functor objects, I somehow didn’t bring them to work as I imagined, so I settled for the function pointers.

So first, we need to generate a C++ class:

typedef void(*PacketCallback)(void *);


class TMPacketView : public POA_ITMP_PRO::TMpacketMngrView
{
public:
    TMPacketView() : m_callback(0)
    {}

    // overloaded virtual functions from CORBA (TMPacketMngr)
    virtual void notifyTMpackets(const ITMP::TMpacketNotifyDatas& p_data);

    PacketCallback m_callback;
};

So we typedef a PacketCallback, derive the class from POA_ITMP_PRO::TMpacketMngrView and have a public m_callback field, which is the function pointer. This pointer needs to be set from Haskell. The implementation of the notifyTMpackets function is also easy:

void TMPacketView::notifyTMpackets(const ITMP::TMpacketNotifyDatas& p_data)
{
    if(m_callback != 0)
    {
        (*m_callback)(const_cast<ITMP::TMpacketNotifyDatas*>(&p_data));
    }
}

It just forwards the data to the function pointer, if it is set.

Of course, there needs to be a hoppy binding for this class, otherwise we cannot create it from Haskell:

c_PacketView :: Class
c_PacketView =
    addReqIncludes [includeLocal "TMPacketView.hpp"] $
    makeClass (ident "TMPacketView") Nothing
        [c_TMPacketMngrViewPOA]
        [
            mkCtor "new" []
            , makeClassVariable "m_callback" Nothing 
                  (ptrT (fnT [ptrT voidT] voidT)) Nonstatic True
            , makeMethod "_this" (toExtName "this") MNormal Nonpure
                [] (ptrT (objT c_TMPacketMngrViewRef))

        ]

This is analogous to the definitions above. The difference is, now we specify a super-class from which this class is derived (in this case this is needed), which we have already bound, c_TMpacketMngrViewPOA (definition is not shown here). We need a constructor because we need to create an instance of this class from Haskell. Since m_callback is a class variable, we define it as such, so as a pointer to a function which takes a void pointer and returns void. We need to get a CORBA object reference for this class to register it in the CORBA ORB (otherwise no callback is possible), so we need to bind the _this method from the super-class (c_TMpacketMngrViewPOA), which does return a CORBA object reference. Then we need to add it to a module so that hoppy can generate the code. That’s it!

Generating the binding

We compile the executable again, which is now able to generate the code. In my case I used cabal new-build to generate it. The executable takes a few options:

Hoppy binding generator

Interfaces: exif

Supported options:
  --help                      Displays this menu.
  --interface <iface>         Sets the interface used for subsequent options.
  --list-interfaces           Lists the interfaces compiled into this binary.
  --list-cpp-files            Lists generated file paths in C++ bindings.
  --list-hs-files             Lists generated file paths in Haskell bindings.
  --gen-cpp <outdir>          Generate C++ bindings in a directory.
  --gen-hs <outdir>           Generate Haskell bindings under the given
                              top-level source directory.

The important ones are –gen-cpp which generates the C++ code and –gen-hs which generates the Haskell code. So we execute it with these options and get a bunch of source code files. As we have specified in the modules description, the generated C++ files are named e.g. HsITMP_PRO.h and HsITMP_PRO.cpp and the equivalent generated Haskell module is named HsITMP_PRO.hs. If we have chosen the paths deliberately, the files end up in the right projects (the C++ files in the directory for the library, the Haskell files in the project source directory for the Haskell library).

In the cabal file for the Haskell library we need to add the directories to the libraries needed (omniORB, the generated library from above) and the libraries itself. In this case, I had to link in also some libraries from the mission control system itself as there were transitive dependencies.

How does the generated code look like? Well, hoppy generates a lot of code, mostly instances for type classes for casting, handling const and non-const pointers, definitions for the data types etc. The interesting functions are the functions from the CORBA IDL which look like this:

tMPacketMngrRef_registerTMpackets :: (TMPacketMngrRefPtr arg'1, 
                                      TMPacketMngrViewRefPtr arg'2,
                                      M7.TMpacketFilterValue arg'3, 
                                      M7.TransmissionFilterValue arg'4) => 
        arg'1 -> arg'2 -> arg'3 -> arg'4 -> HoppyP.IO HoppyFC.CLong

tMPacketMngrRef_getFullData :: (TMPacketMngrRefPtr arg'1) => 
    arg'1 -> HoppyFC.CLong -> HoppyP.IO M7.TMpacketNotifyDatas

tMPacketMngrRef_getNextData :: (TMPacketMngrRefPtr arg'1) => 
    arg'1 -> HoppyFC.CLong -> HoppyP.IO M7.TMpacketNotifyDatas

So basically the C++ call

tmMngr.registerTMpackets(view, filter1, filter2)

can be used in Haskell like this:

tMPacketMngrRef_registerTMpackets tmMngr view filter1 filter2

It is a straight forward translation and most of the time easy to use.

Part II – Using the generated Binding

Now we are able to write a Haskell application, which is able to interact with CORBA. For example, above we did a binding to the ORB_init CORBA function. An implementation in Haskell which uses the bound function could look like:

orbInit :: [String] -> IO ORB
orbInit args = do
    strs <- mapM newCString args
    orb <- withArray0 nullPtr strs $ \argv -> do
        orb_init (fromIntegral (length args)) argv
    mapM_ free strs
    return orb

It takes the command line arguments (taken from System.Environment.getArgs) as a list of Strings, marshals them into C-strings and passes them to orb_init. Nothing fancy here, this is almost normal Haskell-C FFI operations.

For convenience, we also define an ‘exception catcher’:

corbaChecked :: IO a -> IO (Either Text a)
corbaChecked action = do
    (Right <$> action)
        `catchCpp` (\(e :: TRANSIENT) -> Left <$> 
            getExceptionText e tRANSIENT_np_minorString)
        `catchCpp` (\(e :: COMM_FAILURE) -> Left <$> 
            getExceptionText e cOMM_FAILURE_np_minorString) 
        .....

getExceptionText :: a -> (a -> IO CString) -> IO Text
getExceptionText e act = do
    decodeLatin1 <$> (act e >>= B.packCString)

Which converts C++ exceptions thrown by CORBA into a normal Either. Note that in hoppy you have to use catchCpp and not Haskell’s standard catch functions.

To get a CORBA reference to the Naming Service we can do it e.g. like this:

getNameService :: ORB -> ByteString -> IO NamingContextObjRef
getNameService orb uri = do
    B.useAsCString uri $ \str -> do
        obj <- oRB_string_to_object orb str
        ns <- namingContext_narrow obj
        release obj
        return ns

The ORB is generated from orbInit above, the URI in this case could be like: “corbaloc::<hostname>:<port>/NameService”. This is more or less a direct translation of the C++ code inside the MCS which does the same.

For better resource cleanup, I defined also a withCORBA method, so we can do a simple test program:

{-# LANGUAGE OverloadedStrings #-}
module Main
where

import EXIF.CORBA
import EXIF.TMP_PRO
import EXIF.HsTMPacketView

import System.Environment

import Control.Concurrent.Async
import Control.Monad
import qualified Data.ByteString.Char8 as BC
import qualified Data.Text.IO as T
import Data.Monoid

import Network.HostName

main :: IO ()
main = do
    args <- getArgs

    hostname <- BC.pack <$> getHostName

    let uri = "corbaloc::" <> hostname <> ":20000/NameService"

    withCORBA args uri process



process :: CORBAInfrastructure -> IO ()
process inf = do
    void $ concurrently (runORB inf) (worker inf)

This does some setup (getting program arguments and generating the URI, then concurrently calls runORB which performs the event loop which processes the CORBA callbacks and the worker, which does our things ™.

The worker is the interesting part.

worker inf = do
    obj <- getTMPServerMngr inf
    case obj of
        Left err -> T.putStrLn $ "Error: " <> err
        Right obj -> do
            srv' <- getTMPServer obj False
            case srv' of
                Left err -> T.putStrLn $ "Error: " <> err
                Right srv -> do
                    pktMngr <- getTMPacketMngr srv

                    -- create new view and set a handler
                    view <- tMPacketView_new
                    setTMPacketHandler view handler

                    pfilt <- newTMPacketFilter [] [] []
                    tfilt <- newTransmissionFilter True True True

                    v <- tMPacketView_this view
                    refID <- tMPacketMngrRef_registerTMpackets pktMngr v 
                        pfilt tfilt

    where
        handler notif = do
            putStrLn $ "Received Notification: " ++ ppShow notif

Here we finally do our job!

Worker first does some basic setup, which is not that interesting to us. It has to do with the architecture of the EXIF of the MCS. The interesting part is that we finally get the pktMngr ( via getTMPacketMngr), then create the TMPacketView which handles the callback from CORBA (note that here we only allocate it, but don’t use a foreign pointer, so for this small test program this is a memory leak). We set the callback to the handler function (which currently only prints the received values on the console) with setTMPacketHandler. There is some filter setup in between, but finally, we call the CORBA method to register our view with the given filters.

So the big moment in this is calling tMPacketMngrRef_registerTMpackets which actually calls the C++ method _objref_TMpacketMngr::registerTMpackets. Yay! We have done it!

Callback mechanism

So how does the callback work? How does C++ finally call the handler function? This all boils down to the setTMPacketHandler function. Let’s have a look on how this works:

type PktHandler = Ptr () -> IO ()
type PktHandlerPtr = FunPtr PktHandler


foreign import ccall "wrapper"
    syncWithPktHandler :: PktHandler -> IO PktHandlerPtr


pktHandler :: (PacketNotifyDatas -> IO ()) -> PktHandler
pktHandler handler notifPtr = do
    let dat = TMpacketNotifyDatas (castPtr notifPtr)
    n <- convert dat
    handler n

setTMPacketHandler :: TMPacketView -> (PacketNotifyDatas -> IO ()) -> IO ()
setTMPacketHandler view handler = do
    f <- syncWithPktHandler $ pktHandler handler
    tMPacketView_m_callback_set view f

Remember, we need to set a member field of the TMPacketView class we defined, which is a function pointer to a function which takes a void pointer and returns nothing. And we need to convert this somehow to something which calls a Haskell function.

So we want setTMPacketHandler to take a callback-view (of type TMPacketView) and a handler function (which takes a PacketNotifyData) and set the function pointer accordingly. So we need to get a function pointer to the handler and set the m_callback member of the callback view. The second step is easy, just call the tMPacketView_m_callback_set with the correct function pointer.

Getting the pointer is a bit tricky. So let’s start with the types. We define a type for the PktHandler, which should be a function which takes the void pointer and returns a unit in the IO monad and use this type alias to get a function pointer (FunPtr PktHandler). So the low-level C-types are now clear.

Then we use a trick to generate a conversion function, which uses the foreign function interface which takes a type PktHandler and returns a function pointer to it (syncWithPacketHandler).

Now we need to bring the Haskell and the C world together, so we use a function pktHandler, which takes the Haskell handler function (with Haskell types) and returns a PktHandler, which because of the type aliases we defined, takes a void pointer as argument. This void pointer is in reality a pointer to a TMpacketNotifyDatas passed from C++, so it is cast and put into a TMpacketNotifyDatas type constructor. This constructor is delivered from the generated code from hoppy and represents the C++ data structure from CORBA, so this line is just like a C cast. Since this is a C++ structure which must be accessed via it’s member functions which live in IO, we call a convert method (see below), which does this and returns a pure Haskell data type with the data. This is like a un-marshalling step. Finally, the Haskell handler function is called with this data.

The conversion function itself is pretty straightforward, I defined a CConversion class and some instances for basic types from which more complex types can be built. For the TMpacketNotifyData it is like this:

instance CConversion TMpacketNotifyData PacketNotifyData where
    convert dat = do
        PacketNotifyData <$>
            (tMpacketNotifyData_m_pktAttributes_get dat >>= convert)
            <*> (tMpacketNotifyData_m_pktHeaderRawData_get dat >>= convert)
            <*> (tMpacketNotifyData_m_pktBodyRawData_get dat >>= convert)
            <*> (tMpacketNotifyData_m_pktParams_get dat >>= convert)

It calls the C++ member-getters of the C++ object and converts them into Haskell values, then applicatively packs them together into a PacketNotifyData structure, which looks like this:

data PacketNotifyData = PacketNotifyData {
    pktAttributes :: PacketAttributes,
    pktRawHeader :: !B.ByteString,
    pktRawBody :: !B.ByteString,
    pktParams :: V.Vector PacketParameter
    } deriving Show

So as you see, this is a plain Haskell data structure, nothing fancy.

And that’s it!

Part III – The Final Result

Adding a few refinements and cleanups, a GTK (gtk2hs) graphical interface etc. and we end up here, an application which is directly connected to the Mission Control System and shows directly the live data from the satellite. Voila!

The screenshot shows the EXIF Client getting live data from the mission control system (shown in the background) via the CORBA interface I just described. Mission accomplished.

There are still a lot of things that can be done, a lot of range for improvements, but it is a good first step.

Conclusions

As said above, this article is mostly to remind myself on how to do that so when I look at the code in a few years I still can make sense of it.

It is quite a lot to do and to think of to get there, so was it actually worth it? A big yes. This application is not a simple one and will probably continue to grow in the future. As it grows bigger, I am thankful for Haskell’s habits of pointing out errors much earlier than C++.

This was only the telemetry packet interface, there are a lot of other interfaces which will be interesting to address or even necessary to provide possibilities to test them. This application could then be used for automatic test cases (e.g. injecting commands automatically and checking the resulting telemetry with a spacecraft simulator or ParagonTT).

As you see, interfacing CORBA is hard when starting out, but once you have suitable libraries or frameworks for it, you end up in Haskell’s strongly typed wonderland and don’t have to fear the C++ reaper. So in conclusion, it was worth the journey.

Leave a Reply

Your email address will not be published. Required fields are marked *

This site uses Akismet to reduce spam. Learn how your comment data is processed.