diff --git a/.gitignore b/.gitignore new file mode 100644 --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +/.stack-work/ +/*.prof +/TAGS diff --git a/.travis.yml b/.travis.yml new file mode 100644 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,28 @@ +# Use new container infrastructure to enable caching +sudo: false + +# Caching so the next build will be fast too. +cache: + directories: + - $HOME/.stack + +# Choose a lightweight base image; we provide our own build tools. +language: c + +# GHC depends on GMP. You can add other dependencies here as well. +addons: + apt: + packages: + - libgmp-dev + +before_install: +# Download and unpack the stack executable +- mkdir -p ~/.local/bin +- export PATH=$HOME/.local/bin:$PATH +- travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' + +# This line does all of the work: installs GHC if necessary, build the library, +# executables, and test suites, and runs the test suites. --no-terminal works +# around some quirks in Travis's terminal implementation. +script: +- stack --no-terminal --install-ghc test diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,7 @@ +[![Build Status](https://travis-ci.org/LTI2000/hinterface.svg?branch=master)](https://travis-ci.org/LTI2000/hinterface) + +# hinterface - Haskell / Erlang interoperability library + +Inspired by Jinterface (Java), a set of tools for communication with Erlang processes. + +This is work in progress, the library isn't usable yet. diff --git a/erl_echo.escript b/erl_echo.escript new file mode 100644 --- /dev/null +++ b/erl_echo.escript @@ -0,0 +1,18 @@ +#!/usr/bin/env escript +%% -*- erlang -*- +%%! -smp enable -name erl@localhost.localdomain -setcookie cookie + +-mode(compile). + +loop(N) -> + receive + A = {Pid, Ref, Port, Tuple, Msg} -> + io:format("Received ~p~n", [A]), + Pid ! {Pid, Ref, Port, Tuple, self(), make_ref(), [1|2], <<>>, <<"X">>, <<256:16>>, #{}, #{key => "value"}, 3.14, lists:concat(["echo: ", Msg, " (", N, ")"])}; + {Pid, Other} -> Pid ! Other + end, + loop(N + 1). + +main(_) -> + register(echo, self()), + loop(0). diff --git a/erl_hay.escript b/erl_hay.escript new file mode 100644 --- /dev/null +++ b/erl_hay.escript @@ -0,0 +1,18 @@ +#!/usr/bin/env escript +%% -*- erlang -*- +%%! -smp enable -name erl2@localhost.localdomain -setcookie cookie + +-mode(compile). + +loop(N = 1000000) -> + {hay, 'hay@localhost.localdomain'} ! ok, + N; +loop(N) -> + {hay, 'hay@localhost.localdomain'} ! {self(), N}, + receive + A -> A + end, + loop(N + 1). + +main(_) -> + io:format("~p~n", [loop(0)]). diff --git a/hay_erl.escript b/hay_erl.escript new file mode 100644 --- /dev/null +++ b/hay_erl.escript @@ -0,0 +1,16 @@ +#!/usr/bin/env escript +%% -*- erlang -*- +%%! -smp enable -name hay@localhost.localdomain -setcookie cookie + +-mode(compile). + +loop() -> + receive + {RemotePid, Value} -> RemotePid ! (Value + 1), + loop(); + _ -> ok + end. + +main(_) -> + register(hay, self()), + loop(). diff --git a/hinterface.cabal b/hinterface.cabal --- a/hinterface.cabal +++ b/hinterface.cabal @@ -1,89 +1,104 @@ -name: hinterface -version: 0.5.0.0 -synopsis: Haskell / Erlang interoperability library -description: Please see README.md -homepage: https://github.com/LTI2000/hinterface -license: BSD3 -license-file: LICENSE -author: Timo Koepke, Sven Heyll -maintainer: timo.koepke@googlemail.com, sven.heyll@gmail.com -copyright: 2016 Timo Koepke, Sven Heyll -category: Language -build-type: Simple --- extra-source-files: -cabal-version: >=1.10 +name: hinterface +version: 0.5.0.1 +cabal-version: >=1.22 +build-type: Simple +license: BSD3 +license-file: LICENSE +copyright: 2016 Timo Koepke, Sven Heyll +maintainer: timo.koepke@googlemail.com, sven.heyll@gmail.com +homepage: https://github.com/LTI2000/hinterface +synopsis: Haskell / Erlang interoperability library +description: + A library for building nodes of a distributed Erlang system in Haskell. + Nodes can be created and registered to an epmd, Erlang terms can be + marshalled to/from Erlangs binary term representation and message can + be sent to or received from processes running on a different node. + In it's preliminary state hinterface supports of Erlangs binary terms + and a subset of the distribution protocol. +category: Language +author: Timo Koepke, Sven Heyll +extra-source-files: + README.md + erl_echo.escript + erl_hay.escript + hay_erl.escript + stack.yaml + .travis.yml + Setup.hs + .gitignore -library - hs-source-dirs: src - exposed-modules: Util.IOExtra - , Util.BufferedIOx - , Util.Socket - , Network.BufferedSocket - , Util.Binary - , Util.FloatCast - , Foreign.Erlang.NodeState - , Foreign.Erlang.NodeData - , Foreign.Erlang.Epmd - , Foreign.Erlang.Digest - , Foreign.Erlang.Handshake - , Foreign.Erlang.Term - , Foreign.Erlang.LocalNode - , Foreign.Erlang.ControlMessage - , Foreign.Erlang.Mailbox - , Foreign.Erlang.Connection - default-extensions: OverloadedStrings - , NamedFieldPuns - , FlexibleContexts - ghc-options: -Wall -O2 -funbox-strict-fields - build-depends: QuickCheck >= 2.8 && < 3 - , array - , async >= 2.1 && < 2.2 - , base >= 4.9 && < 5 - , binary - , bytestring - , containers - , cryptonite - , exceptions >= 0.8 && < 0.9 - , lifted-async >= 0.9 && < 1.0 - , lifted-base >= 0.2 && < 0.3 - , memory - , monad-control >= 1.0 && < 1.1 - , monad-logger >= 0.3 && < 0.4 - , mtl - , network - , random - , resourcet >= 1 && < 2 - , safe-exceptions >= 0.1 && < 0.2 - , stm - , text >= 1.2 && < 1.3 - , transformers - , transformers-base >= 0.4 && < 0.5 - , vector +source-repository head + type: git + location: https://github.com/LTI2000/hinterface.git - default-language: Haskell2010 +library + exposed-modules: + Util.IOExtra + Util.BufferedIOx + Util.Socket + Network.BufferedSocket + Util.Binary + Util.FloatCast + Foreign.Erlang.NodeState + Foreign.Erlang.NodeData + Foreign.Erlang.Epmd + Foreign.Erlang.Digest + Foreign.Erlang.Handshake + Foreign.Erlang.Term + Foreign.Erlang.LocalNode + Foreign.Erlang.ControlMessage + Foreign.Erlang.Mailbox + Foreign.Erlang.Connection + build-depends: + QuickCheck >=2.8.2 && <2.9, + array >=0.5.1.1 && <0.6, + async >=2.1.1 && <2.2, + base >=4.9 && <5, + binary >=0.8.3.0 && <0.9, + bytestring >=0.10.8.1 && <0.11, + containers >=0.5.7.1 && <0.6, + cryptonite ==0.19.*, + exceptions >=0.8.3 && <0.9, + lifted-async >=0.9.0 && <0.10, + lifted-base >=0.2.3.8 && <0.3, + memory ==0.13.*, + monad-control >=1.0.1.0 && <1.1, + monad-logger >=0.3.20.1 && <0.4, + mtl >=2.2.1 && <2.3, + network >=2.6.3.1 && <2.7, + random ==1.1.*, + resourcet >=1.1.8.1 && <1.2, + safe-exceptions >=0.1.4.0 && <0.2, + stm >=2.4.4.1 && <2.5, + text >=1.2.2.1 && <1.3, + transformers >=0.5.2.0 && <0.6, + transformers-base >=0.4.4 && <0.5, + vector >=0.11.0.0 && <0.12 + default-language: Haskell2010 + default-extensions: OverloadedStrings NamedFieldPuns + FlexibleContexts + hs-source-dirs: src + ghc-options: -Wall -O2 -funbox-strict-fields test-suite hinterface-test - type: exitcode-stdio-1.0 - hs-source-dirs: test - main-is: Spec.hs - build-depends: QuickCheck - , async >= 2.1 && < 2.2 - , base >= 4.9 && < 5 - , binary - , bytestring - , hinterface - , hspec - , monad-logger >= 0.3 && < 0.4 - , transformers - other-modules: Foreign.Erlang.NodeDataSpec - , Foreign.Erlang.HandshakeSpec - , Foreign.Erlang.ControlMessageSpec - , Foreign.Erlang.TermSpec - default-extensions: OverloadedStrings - , NamedFieldPuns - ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N - default-language: Haskell2010 - -source-repository head - type: git - location: https://github.com/LTI2000/hinterface.git + type: exitcode-stdio-1.0 + main-is: Spec.hs + build-depends: + QuickCheck >=2.8.2 && <2.9, + async >=2.1.1 && <2.2, + base >=4.9 && <5, + binary >=0.8.3.0 && <0.9, + bytestring >=0.10.8.1 && <0.11, + hinterface >=0.5.0.1 && <0.6, + hspec >=2.2.4 && <2.3, + monad-logger >=0.3.20.1 && <0.4, + transformers >=0.5.2.0 && <0.6 + default-language: Haskell2010 + default-extensions: OverloadedStrings NamedFieldPuns + hs-source-dirs: test + other-modules: + Foreign.Erlang.NodeDataSpec + Foreign.Erlang.HandshakeSpec + Foreign.Erlang.ControlMessageSpec + Foreign.Erlang.TermSpec + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N diff --git a/src/Foreign/Erlang/Connection.hs b/src/Foreign/Erlang/Connection.hs --- a/src/Foreign/Erlang/Connection.hs +++ b/src/Foreign/Erlang/Connection.hs @@ -44,6 +44,7 @@ newReceiver = recvLoop sock sendQueue nodeState registerConnection s r = do let connection = MkConnection sendQueue stopTransmitter + logInfoStr (printf "putConnectionForNode %s" (show name)) liftIO (putConnectionForNode nodeState name connection) async awaitStopAndCleanup return connection @@ -53,6 +54,7 @@ (_ :: Either SomeException ()) <- waitCatch r cancel s tryAndLogAll (liftIO (closeBuffered sock)) + logInfoStr (printf "removeConnectionForNode %s" (show name)) liftIO (removeConnectionForNode nodeState name) -- liftIO $ diff --git a/src/Foreign/Erlang/LocalNode.hs b/src/Foreign/Erlang/LocalNode.hs --- a/src/Foreign/Erlang/LocalNode.hs +++ b/src/Foreign/Erlang/LocalNode.hs @@ -234,8 +234,10 @@ getExistingConnection >>= maybe lookupAndConnect (return . Just) where getExistingConnection = do - nodeName <- atom <$> askNodeName + let nodeName = atom remoteName + logInfoStr (printf "getExistingConnection %s" (show nodeName)) nodeState <- askNodeState + logNodeState nodeState getConnectionForNode nodeState nodeName lookupAndConnect = lookupNode remoteAlive remoteHost >>= diff --git a/src/Foreign/Erlang/NodeState.hs b/src/Foreign/Erlang/NodeState.hs --- a/src/Foreign/Erlang/NodeState.hs +++ b/src/Foreign/Erlang/NodeState.hs @@ -2,6 +2,7 @@ {-# LANGUAGE Strict #-} module Foreign.Erlang.NodeState ( NodeState() + , logNodeState , newNodeState , new_pid , new_port @@ -62,6 +63,13 @@ newTVarIO M.empty <*> -- name2MBox newTVarIO M.empty -- name2Conn + +logNodeState :: (Show n, MonadIO m, MonadLogger m) => NodeState p n mb c -> m () +logNodeState NodeState{node2Conn} = + do + m <- liftIO (readTVarIO node2Conn) + logInfoStr (printf "known connection keys %s" (unlines (show <$> M.keys m))) + -------------------------------------------------------------------------------- new_pid :: NodeState p n mb c -> IO (Word32, Word32) diff --git a/stack.yaml b/stack.yaml new file mode 100644 --- /dev/null +++ b/stack.yaml @@ -0,0 +1,12 @@ +resolver: lts-7.12 + +packages: +- '.' + +extra-deps: [] + +flags: {} + +extra-package-dbs: [] + +pvp-bounds: both