Elm 0.16 with stack

I just noticed that there’s been a new release of the elm tools. The previous release was fairly easy to build using stack, but this release made it a little bit easier still.

The script for cloning should be modified to look like this:

#! /usr/bin/zsh

repos=("git clone -b 0.16 https://github.com/elm-lang/elm-compiler.git"
       "git clone -b 0.16 https://github.com/elm-lang/elm-package.git"
       "git clone -b 0.16 https://github.com/elm-lang/elm-make.git"
       "git clone -b 0.16 https://github.com/elm-lang/elm-reactor.git"
       "git clone -b 0.16 https://github.com/elm-lang/elm-repl.git"

for r in ${repos[@]}; do
    eval ${r}

When creating the inital stack.yaml tell stack to use release 7.10.2 of ghc:

% stack init --resolver ghc-7.10.2

That makes it possible to use the installed version of ghc. It’s also unecessary to provide any flag for aeson, which means there’s no need for any manual changed to stack.yaml prior to running (add --install-ghc if you don’t have it on your system already)

% stack solver --modify-stack-yaml

Now just build and install as before:

% stack install elm-{compiler,make,package,repl}
% stack install elm-reactor

That’s it!

How can I unit test failure cases?

When writing unit tests, especially when using mock objects, there’s always a risk of falling into the trap of writing tests for the implementation rather than for the API. In my experience the most obvious indication of that is that any refactoring of the code requires major rework of the tests.

Right now I’m sitting with the task of writing tests for a function that promises to return NULL on failure. The function in question allocates memory up to three times, opens two message queues, sends a message on one and expects a reponse on the other. If all goes well it returns the pointer to one of the memory areas allocated. And if it fails, for whatever reason, it returns NULL.

Is it even possible to write a set of tests for it without testing the specific implementation?

I know some of the calls can be re-arranged, e.g. moving all memory allocation to the start of the function, without affecting the caller of the function. However, if I use mock objects to simulate failure in the external libraries and system calls I’d be forced to modify the tests on each such re-arranging of calls. In other words I’m testing the implementation!

Should I think differently about testing failure cases?

Should the API be changed in some way to make unit tests a better fit for testing failures?

Docker container with ip address on local network, p2

In my latest post I described described a way to give a docker container an address on the local network. That’s a general way of achieving it, but it’s also rather complicated. If you know exactly what ports need to be exposed there is a simpler way.

Add a second IP to the system interface

There’s a good description on how to give an interface multiple in Debian at the Debian Wiki. The completely manual way is

ip addr add dev eth0 label eth0:0

The configuration in Debian is

auto eth0:0
iface eth0:0 inet static

If you’re using Systemd it seems to be enough to just add extra Address=... statements to the .network file:



Bind ports of the container to a specific IP

Using the image from my latest post it’s just to run it using the --publish option:

docker --rm --interactive --tty --name=echo --publish= nw /home/myusre/echosrv

Just like the last time it’s easy to verify everything’s working using netcat.

Docker container with ip address on local network

Shortly after I started my new job in August I put an instance of gitlab on a server and started promoting using it over the git-repos-on-an-NFS-share that had been used thus far. Thanks to the Docker image of Gitlab CE it only took about 5 minutes to have a running instance – setting up authentication via LDAP only took slightly longer. So far I’ve been running it on non-standard ports, just like the guide suggests, but I’ve gotten to the point where I’d like to make it a bit more official. That means I’d like to get it off non-standard ports, but I do really like running it in Docker. In short, I need to give the Docker image an ip address on the local network.

Unfortunately Docker doesn’t make it easy to do that, but I found an article on four ways to connect a docker container to a local network. What follows is my take on the instruction for how to use a macvlan device to achieve it.

An image for testing

First I looked around for a simple echo server to run in my testing image:

module Main

import Control.Concurrent
import Control.Monad
import Network.Socket
import System.IO

srvPort :: PortNumber
srvPort = 2048

main :: IO ()
main = withSocketsDo $ do
  newSocket <- socket AF_INET Stream defaultProtocol
  setSocketOption newSocket ReuseAddr 1
  bindSocket newSocket $ SockAddrInet srvPort iNADDR_ANY
  listen newSocket 2
  runServer echo newSocket

runServer :: (String -> String) -> Socket -> IO()
runServer f s = forever $ do
  (usableSocket,_) <- accept s
  forkIO $ interactWithSocket f usableSocket

interactWithSocket :: (String -> String) -> Socket -> IO()
interactWithSocket f s = do
  handle <- socketToHandle s ReadWriteMode
  forever $ f <$> hGetLine handle >>= hPutStrLn handle

echo :: String -> String
echo = ("R: " ++)

Run it and test it by pointing netcat to port 2048.

Once that was built I put together a Dockerfile that uses Debian Jessie as a base and copies in the echo server (I based it on another image):

FROM debian:8.2
MAINTAINER Magnus Therning <magnus@therning.org>

RUN TERM=vt220 apt-get update && \
    TERM=vt220 DEBIAN_FRONTEND=noninteractive apt-get -y install \
        apt-utils \
        dialog \
        libgmp10 \
    && true

RUN useradd -G users -m -s /bin/bash myuser && \
    echo "root:root" | chpasswd

USER myuser
COPY echosrv /home/myuser/
CMD bash --login

I popped the Dockerfile and the binary into a folder srv/ so I can build the image using

$ docker build --rm --tag=nw srv

and then started using

$ docker run --rm --interactive --tty --name=echo nw /home/myuser/echosrv

A handy alias

The following alias will turn out to be very handy indeed

$ alias docker-pid="docker inspect --format '{{ .State.Pid }}'"

The network setup

The local network is and I found an unused address, that I decided to use for my experiment. The gateway is on

First create the macvlan device:

$ sudo ip link add mybridge link enp0s25 type macvlan mode bridge

Then put it into the network namespace of the running container, and bring it up:

$ sudo ip link set netns $(docker-pid echo) mybridge
$ sudo nsenter -t $(docker-pid echo) -n ip link set mybridge up

Now the device need its address and the routing has to be set up:

$ sudo nsenter -t $(docker-pid echo) -n ip route del default
$ sudo nsenter -t $(docker-pid echo) -n ip addr add dev mybridge
$ sudo nsenter -t $(docker-pid echo) -n ip route add default via dev mybridge

That’s it, now the docker container is reachable on Well, it’s reachable on that ip from any computer on the network except for the host. In order for the host to be able to reach it add another route:

$ sudo ip route add dev docker0


If you’d rather have the container on an ip handed out by a DHCP server, then you replace the three commands for setting ip and route with:

$ sudo nsenter -t $(docker-pid echo) -n -- dhclient -d maclan

Building elm with stack

Building elm is a slightly invasive procedure if your distro doesn’t have any pre-built packages for it and has a non-ancient version of ghc. Removing all haskell packages and installing HaskellPlatform didn’t really appeal to me. Then it occured to me that stack ought to be perfectly suited for this task. It took me a while to sort it out, but here’s how I got a working build of the elm tools installed on Archlinux.

Installing stack and cabal

Add the ArchHaskell repo by following the instructions on the wiki. Then install the haskell-stack-bin package. For stack to work fully one also needs the libtinfo package from AUR.

If you aren’t using Archlinux there are instructions on the stack page.

Now build cabal-install using stack:

% stack --install-ghc install cabal-install

After this make sure ~/.local/bin is in your $PATH.

Cloning the elm tool repos

The elm developers have decided to not use Hackage so to get the tools one has to clone the repos from GitHub. I used the following shell script to get them all cloned in one go:

#! /usr/bin/zsh

repos=("git clone https://github.com/elm-lang/elm-compiler.git -b 0.15.1"
       "git clone https://github.com/elm-lang/elm-package.git -b 0.5.1"
       "git clone https://github.com/elm-lang/elm-make.git -b 0.2"
       "git clone https://github.com/elm-lang/elm-reactor.git -b 0.3.2"
       "git clone https://github.com/elm-lang/elm-repl.git -b 0.4.2"

for r in ${repos[@]}; do
    eval ${r}

Creating stack.yaml

To create the initial stack.yalm run

% stack init --resolver ghc-7.8.4

Now open it and make a couple of modifications. First add the line

system-ghc: false

This is to make sure stack won’t try to use any ghc version already installed on the system. Then add a flag for aeson:

    old-locale: true

Now use stack to create the full stack.yaml:

% stack --install-ghc solver --modify-stack-yaml

Patch elm-reactor

In order to build elm-reactor it first needs a tiny patch:

diff --git a/backend/Socket.hs b/backend/Socket.hs
index b80a98f..69fe488 100644
--- a/backend/Socket.hs
+++ b/backend/Socket.hs
@@ -18,7 +18,7 @@ fileChangeApp :: FilePath -> WS.ServerApp
 fileChangeApp watchedFile pendingConnection =
   do  connection <- WS.acceptRequest pendingConnection
       Notify.withManager $ \notifyManager ->
-        do  _ <- NDevel.treeExtExists notifyManager "." "elm" (sendHotSwap watchedFile connection)
+        do  _ <- NDevel.treeExtExists notifyManager "." "elm" (sendHotSwap watchedFile connection . FP.decodeString)
             keepAlive connection

Building the tools

Now build the elm tools (it’s important that elm-reactor is built after elm-make):

% stack install elm-{compiler,make,package,repl}
% stack install elm-reactor

Now just sit back and wait for the building to finish.

Verify that it works

Follow the instructions for running example 1 of the elm architecture tutorial. I had to use the following two commands to get it running properly:

% elm make
% elm reactor

Then I can point my browser at http://localhost:8000/Main.elm?debug and play with the counter.

Extracting titles and links from atom feed

The code I used to extract the titles and links for the previous post:

#! /usr/bin/runhaskell

import System.Environment
import Text.HTML.TagSoup
import Text.Printf

main :: IO ()
main = do
    [fn] <- getArgs
    readAtomFile fn >>= writeList

readAtomFile :: FilePath -> IO [(String, String)]
readAtomFile fn = do
    xml <- readFile fn
    let xmlTags = parseTags xml
        es = map parseEntry (getAllEntries xmlTags)
    return es

getAllEntries :: [Tag String] -> [[Tag String]]
getAllEntries = partitions (~== TagOpen "entry" [])

getElemText :: String -> [Tag String] -> String
getElemText n = fromTagText . (!! 1) . dropWhile (~/= TagOpen n [])

getEntryTitle, getEntryLink :: [Tag String] -> String
getEntryTitle = getElemText "title"
getEntryLink = fromAttrib "href" . (!! 0) . dropWhile (~/= TagOpen "link" [])

parseEntry :: [Tag String] -> (String, String)
parseEntry e = (title, link)
        title = getEntryTitle e
        link = getEntryLink e

writeList :: [(String, String)] -> IO ()
writeList posts = putStrLn items
        items = unlines $ fmap writeListItem posts

writeListItem :: (String, String) -> String
writeListItem (t, l) = printf "- [%s](%s)" t l

It can also be found as a snippet here.

Systemd watchdog

I haven’t been posting much lately, since last time I’ve switched jobs. My silence is partly because this new job is more fun than the previous one – hence less need to escape into the sanity offered by Linux, FP (Haskell, OCaml, …), and the other stuff I like to fill my free time with. Now I’ve started to get into the job, and I hope I’ll find stuff to write about and time to do it.

Lately I’ve spent a lot of time reading up on, and playing with systemd. It’s really a very impressive piece of software. I found the series “systemd for Administrators” by Lennart Poettering a very good introduction:

There’s also a (much shorter) “systemd for Developers”

Watchdog in systemd

One of the nice things offered by systemd is watchdog functionality. For work I had a need to try it out, partly for my own sake (I’ve never really had a need to play with watchdog functinality in any way before) and partly to communicate to the rest of the team how they can modify their parts to integrate with systemd.

As is described in part 15 the watchdog period is communicated via the environment variable WATCHDOG_USEC. As the name suggests it holds the period in micro seconds. To then tickle the watchdog one uses sd_notify(0, "WATCHDOG=1"). To test this all I wrote the follwoing bit of C (sd-watch.c):

#include <stdbool.h>
#include <stdio.h>
#include <stdlib.h>
#include <sys/stat.h>
#include <unistd.h>
#include <systemd/sd-daemon.h>

int main(int ac, char **av)

  char *e = getenv("WATCHDOG_USEC");
  if(!e) {
    printf("No WATCHDOG_USEC set!\n");
  } else
    printf("WATCHDOG_USEC: %s\n", e);

  int i = atoi(e);
  i /= 2;
  printf("* Barking every %i usec.\n", i);

  bool cont = true;
  while(cont) {

    struct stat b;
    int r = stat(av[1], &b);
    if(0 == r) {
    } else {
      r = sd_notify(0, "WATCHDOG=1");
      printf("Barked!!! (%i)\n", r);

  return 0;

Compile it with gcc -o sd-watch sd-watch.c $(pkg-config --libs libsystemd).

Together with this comes a service description:

Description=Test for systemd watchdog

ExecStart=/usr/local/bin/sd-watch /tmp/foobar

As you can see I placed the binary in /usr/local/bin, then I placed the service description in /usr/local/lib/systemd/system/sd-watch.service. A modification to /etc/systemd/systemd.con is the last piece, uncomment RuntimeWatchdogSec and set it to a suitable value, I chose 60:


Just reboot,log in and start the service and follow the log:

# systemctl start sd-watch
# journalctl -f

In another terminal create the file, touch /tmp/foobar, and watch what’s written to the log, and after a little while the system should reboot.

Using QuickCheck to test C APIs

Last year at ICFP I attended the tutorial on QuickCheck with John Hughes. We got to use the Erlang implementation of QuickCheck to test a C API. Ever since I’ve been planning to do the same thing using Haskell. I’ve put it off for the better part of a year now, but then Francesco Mazzoli wrote about inline-c (Call C functions from Haskell without bindings and I found the motivation to actually start writing some code.

The general idea

Many C APIs are rather stateful beasts so to test it I

  1. generate a sequence of API calls (a program of sorts),
  2. run the sequence against a model,
  3. run the sequence against the real implementation, and
  4. compare the model against the real state each step of the way.


To begin with I hacked up a simple implementation of a stack in C. The “specification” is

 * Create a stack.
void *create();

 * Push a value onto an existing stack.
void push (void *, int);

 * Pop a value off an existing stack.
int pop(void *);

Using inline-c to create bindings for it is amazingly simple:

{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}

module CApi

import qualified Language.C.Inline as C
import Foreign.Ptr

C.include "stack.h"

create :: IO (Ptr ())
create = [C.exp| void * { create() } |]

push :: Ptr () -> C.CInt -> IO ()
push s i = [C.exp| void { push($(void *s), $(int i)) } |]

pop :: Ptr () -> IO C.CInt
pop s = [C.exp| int { pop($(void *s)) } |]

In the code below I import this module qualified.

Representing a program

To represent a sequence of calls I first used a custom type, but later realised that there really was no reason at all to not use a wrapped list:

newtype Program a = P [a]
    deriving (Eq, Foldable, Functor, Show, Traversable)

Then each of the C API functions can be represented with

data Statement = Create | Push Int | Pop
    deriving (Eq, Show)

Arbitrary for Statement

My implementation of Arbitrary for Statement is very simple:

instance Arbitrary Statement where
    arbitrary = oneof [return Create, return Pop, liftM Push arbitrary]
    shrink (Push i) = Push <$> shrink i
    shrink _ = []

That is, arbitrary just returns one of the constructors of Statement, and shrinking only returns anything for the one constructor that takes an argument, Push.

Prerequisites of Arbitrary for Program Statement

I want to ensure that all Program Statement are valid, which means I need to define the model for running the program and functions for checking the precondition of a statement as well as for updating the model (i.e. for running the Statement).

Based on the C API above it seems necessary to track creation, the contents of the stack, and even if it isn’t explicitly mentioned it’s probably a good idea to track the popped value. Using record (Record is imported as R, and Record.Lens as RL) I defined it like this:

type ModelContext = [R.r| { created :: Bool, pop :: Maybe Int, stack :: [Int] } |]

Based on the rather informal specification I coded the pre-conditions for the three statements as

preCond :: ModelContext -> Statement -> Bool
preCond ctx Create = not $ RL.view [R.l| created |] ctx
preCond ctx (Push _) = RL.view [R.l| created |] ctx
preCond ctx Pop = RL.view [R.l| created |] ctx

That is

  • Create requires that the stack hasn’t been created already.
  • Push i requires that the stack has been created.
  • Pop also requires that the stack has been created.

Furthermore the “specification” suggests the following definition of a function for running a statement:

modelRunStatement :: ModelContext -> Statement -> ModelContext
modelRunStatement ctx Create = RL.set [R.l| created |] True ctx
modelRunStatement ctx (Push i) = RL.over [R.l| stack |] (i :) ctx
modelRunStatement ctx Pop = [R.r| { created = c, pop = headMay s, stack = tail s } |]
        c = RL.view [R.l| created |] ctx
        s = RL.view [R.l| stack |] ctx

(This definition assumes that the model satisfies the pre-conditions, as can be seen in the use of tail.)

Arbitrary for Program Statement

With this in place I can define Arbitrary for Program Statement as follows.

instance Arbitrary (Program Statement) where
    arbitrary = liftM P $ ar baseModelCtx
            ar m = do
                push <- liftM Push arbitrary
                let possible = filter (preCond m) [Create, Pop, push]
                if null possible
                    then return []
                    else do
                        s <- oneof (map return possible)
                        let m' = modelRunStatement m s
                        frequency [(499, liftM2 (:) (return s) (ar m')), (1, return [])]

The idea is to, in each step, choose a valid statement given the provided model and cons it with the result of a recursive call with an updated model. The constant 499 is just an arbitrary one I chose after running arbitrary a few times to see how long the generated programs were.

For shrinking I take advantage of the already existing implementation for lists:

    shrink (P p) = filter allowed $ map P (shrink p)
            allowed = and . snd . mapAccumL go baseModelCtx
                    go ctx s = (modelRunStatement ctx s, preCond ctx s)

Some thoughts so far

I would love making an implementation of Arbitrary s, where s is something that implements a type class that contains preCond, modelRunStatement and anything else needed. I made an attempt using something like

class S a where
    type Ctx a :: *

    baseCtx :: Ctx a
    preCond :: Ctx a -> a -> Bool

However, when trying to use baseCtx in an implementation of arbitrary I ran into the issue of injectivity. I’m still not entirely sure what that means, or if there is something I can do to work around it. Hopefully someone reading this can offer a solution.

Running the C code

When running the sequence of Statement against the C code I catch the results in

type RealContext = [r| { o :: Ptr (), pop :: Maybe Int } |]

Actually running a statement and capturing the output in a RealContext is easily done using inline-c and record:

realRunStatement :: RealContext -> Statement -> IO RealContext
realRunStatement ctx Create = CApi.create >>= \ ptr -> return $ RL.set [R.l| o |] ptr ctx
realRunStatement ctx (Push i) = CApi.push o (toEnum i) >> return ctx
        o = RL.view [R.l| o |] ctx
realRunStatement ctx Pop = CApi.pop o >>= \ v -> return $ RL.set [R.l| pop |] (Just (fromEnum v)) ctx
        o = RL.view [R.l| o |] ctx

Comparing states

Comparing a ModelContext and a RealContext is easily done:

compCtx :: ModelContext -> RealContext -> Bool
compCtx mc rc = mcC == rcC && mcP == rcP
        mcC = RL.view [R.l| created |] mc
        rcC = RL.view [R.l| o |] rc /= nullPtr
        mcP = RL.view [R.l| pop|] mc
        rcP = RL.view [R.l| pop|] rc

Verifying a Program Statement

With all that in place I can finally write a function for checking the validity of a program:

validProgram :: Program Statement -> IO Bool
validProgram p = and <$> snd <$> mapAccumM go (baseModelCtx, baseRealContext) p
        runSingleStatement mc rc s = realRunStatement rc s >>= \ rc' -> return (modelRunStatement mc s, rc')

        go (mc, rc) s = do
            ctxs@(mc', rc') <- runSingleStatement mc rc s
            return (ctxs, compCtx mc' rc')

(This uses mapAccumM from an earlier post of mine.)

The property, finally!

To wrap this all up I then define the property

prop_program :: Program Statement -> Property
prop_program p = monadicIO $ run (validProgram p) >>= assert

and a main function

main :: IO ()
main = quickCheck prop_program

Edit 2015-07-17: Adjusted the description of the pre-conditions to match the code.

`mapAccum` in monad

I recently had two functions of very similar shape, only difference was that one was pure and the other need some I/O. The former was easily written using mapAccumL. I failed to find a function like mapAccumL that runs in a monad, so I wrote up the following:

mapAccumM :: (Monad m, Traversable t) => (a -> b -> m (a, c)) -> a -> t b -> m (a, t c)
mapAccumM f a l = swap <$> runStateT (mapM go l) a
        go i = do
            s <- get
            (s', r) <- lift $ f s i
            put s'
            return r

Bring on the comments/suggestions/improvements/etc!

Oh no! Success

This can’t possibly be good for Haskell…

We chose Haskell and the FP Complete stack because we knew the complexity of the problem required a new approach. The result was that we built better software faster than ever, and delivered it defect-free into a production environment where it has proven robust and high-performance