diff --git a/Changelog.md b/Changelog.md
--- a/Changelog.md
+++ b/Changelog.md
@@ -1,3 +1,8 @@
+## 1.2.1
+
+* Fixed a potential race condition in session allocation, where we could
+  clobber existing session ids.
+
 ## 1.2.0
 
 * `ServerAPI`'s `srvParseParseRequestBody` has changed its return type to
diff --git a/engine-io.cabal b/engine-io.cabal
--- a/engine-io.cabal
+++ b/engine-io.cabal
@@ -1,5 +1,5 @@
 name: engine-io
-version: 1.2.0
+version: 1.2.1
 synopsis: A Haskell implementation of Engine.IO
 homepage: http://github.com/ocharles/engine.io
 license: BSD3
@@ -34,6 +34,7 @@
     base64-bytestring >=1.0 && <1.1,
     bytestring >=0.10.2.0 && <0.11,
     either >= 3.4 && <4.4,
+    free >= 4.9 && <5.0,
     monad-loops >=0.4 && <0.5,
     mwc-random >=0.13 && <0.14,
     stm >=2.4 && <2.5,
diff --git a/src/Network/EngineIO.hs b/src/Network/EngineIO.hs
--- a/src/Network/EngineIO.hs
+++ b/src/Network/EngineIO.hs
@@ -53,6 +53,7 @@
 import Control.Concurrent.MVar (MVar, newMVar, withMVar)
 import Control.Exception (SomeException(SomeException), try)
 import Control.Monad (MonadPlus, forever, guard, mzero, replicateM)
+import Control.Monad.Trans.Iter (cutoff, delay, retract)
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Control.Monad.Loops (unfoldM)
 import Control.Monad.Trans.Class (lift)
@@ -448,20 +449,30 @@
   -> Bool
   -> m ()
 freshSession eio socketHandler api supportsBinary = do
-  sId <- liftIO (newSocketId eio)
+  socket <- do
+    mkSocket <- liftIO $ do
+      transport <- STM.newTVarIO =<< (Transport <$> STM.newTChanIO <*> STM.newTChanIO <*> pure Polling)
+      incoming <- STM.newTChanIO
+      outgoing <- STM.newTChanIO
+      rawInBroadcast <- STM.newBroadcastTChanIO
+      return (\sId -> Socket sId transport incoming outgoing rawInBroadcast)
 
-  socket <- liftIO $
-    Socket <$> pure sId
-           <*> (do transport <- Transport <$> STM.newTChanIO
-                                          <*> STM.newTChanIO
-                                          <*> pure Polling
-                   STM.newTVarIO transport)
-           <*> STM.newTChanIO
-           <*> STM.newTChanIO
-           <*> STM.newBroadcastTChanIO
+    let
+      tryAllocation = liftIO $ do
+        sId <- newSocketId eio
+        STM.atomically $ runMaybeT $ do
+          openSessions <- lift (STM.readTVar (eioOpenSessions eio))
+          guard (not (HashMap.member sId openSessions))
+          let socket = mkSocket sId
+          lift (STM.modifyTVar' (eioOpenSessions eio) (HashMap.insert sId socket))
+          return socket
 
-  liftIO $ STM.atomically (STM.modifyTVar' (eioOpenSessions eio) (HashMap.insert sId socket))
+      untilSuccess f = maybe (delay (untilSuccess f)) return =<< f
 
+    maybeSocket <- retract (cutoff 10 (untilSuccess tryAllocation))
+    maybe (srvTerminateWithResponse api 500 "text/plain" "Session allocation failed")
+          return maybeSocket
+
   app <- socketHandler socket
   userSpace <- liftIO $ Async.async (saApp app)
 
@@ -495,10 +506,10 @@
 
   _ <- liftIO $ Async.async $ do
     _ <- Async.waitAnyCatchCancel [ userSpace, brain ]
-    STM.atomically (STM.modifyTVar' (eioOpenSessions eio) (HashMap.delete sId))
+    STM.atomically (STM.modifyTVar' (eioOpenSessions eio) (HashMap.delete (socketId socket)))
     saOnDisconnect app
 
-  let openMessage = OpenMessage { omSocketId = sId
+  let openMessage = OpenMessage { omSocketId = socketId socket
                                 , omUpgrades = [ Websocket ]
                                 , omPingTimeout = 60000
                                 , omPingInterval = 25000