diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,5 @@
+# Changelog
+
+## [1.0.0.0] - 2018-05-10
+
+[1.0.0.0]: https://github.com/f-me/dmcc/tree/1.0.0.0
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,32 @@
+Copyright (c) 2012, Max Taldykin, Timofey Cherganov
+Copyright (c) 2014, 2015, 2016, 2017 Dmitry Dzhus
+Copyright (c) 2018, Dmitry Dzhus, Viacheslav Lotsmanov
+
+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 Tim 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,106 @@
+# dmcc: AVAYA library for Haskell
+
+[![Travis CI build status](https://travis-ci.org/f-me/dmcc.svg)](https://travis-ci.org/f-me/dmcc)
+[![Hackage](https://img.shields.io/hackage/v/dmcc.svg?colorB=5e5184&style=flat)](https://hackage.haskell.org/package/dmcc)
+[![Hackage deps](https://img.shields.io/hackage-deps/v/dmcc.svg)](http://packdeps.haskellers.com/feed?needle=dmcc)
+
+This package contains a Haskell library which may be used to implement
+computer telephony integration using [AVAYA DMCC XML API][dmcc-api]. A
+simple server (dmcc-ws) built atop the library is also included. The
+server allows clients use JSON-over-WebSockets to control AVAYA
+agents, receive event notifications and agent state updates.
+
+The package uses third-party call control functions of DMCC API.
+There's no first-party call control support and no access to media
+streams.
+
+AVAYA DMCC XML API is largely based on [ECMA-354][] (CSTA Phase III)
+standard, so in theory the package can be used with other compliant
+telephony solutions.
+
+## Features
+
+- First-party interface for most of call control functions (making and
+  answering calls, hold, conference call, transfer, barge in, state
+  control).
+
+- State change events (implemented in the library using polling to
+  compensate for the lack of a native implementation in DMCC 6.x).
+
+- Webhook support (the library can send HTTP requests in response to
+  agent state change events).
+
+## Site-specific notes
+
+One basic TSAPI license is consumed for every agent controlled by
+the library.
+
+DMCC 6.x is supported. Consult your Avaya AES administration page to
+check for software versions and available licenses.
+
+## dmcc-ws server
+
+The server exposes portions of Haskell library interface via
+WebSockets using JSON messages for client-server exchange. Its purpose
+is to provide a clean agent-centric interface to DMCC API suitable for
+usage from client applications running in a browser.
+
+The server is invoked as `dmcc-ws dmcc-ws.cfg`. See example
+configuration file at `dmcc-ws/example.cfg`.
+
+With `dmcc-ws` running, you may start controlling an agent with
+extension `XXX`, connect to WebSocket URL `http://host:port/XXX`. The
+server accepts client commands in JSON:
+
+```json
+{"action":"MakeCall", "number":"989150603267"}
+```
+
+Consult `DMCC.Action` documentation in Haddock docs for DMCC library
+for supported commands.
+
+The server reports telephony events along with updated agent snapshot:
+
+```json
+{
+  "newSnapshot": {
+    "state": ["Busy", ""],
+    "calls": {
+      "179": {
+        "failed": false,
+        "held": false,
+        "ucid": "00001001791428242051",
+        "interlocutors": [
+          "989150603267:ADACs8300::0"
+        ],
+        "start": "2015-04-05T13:52:52.803Z",
+        "direction": {
+          "contents": [],
+          "dir": "Out"
+        },
+        "answered": "2015-04-05T13:53:02.686Z"
+      }
+    }
+  },
+  "dmccEvent": {
+    "callId": "179",
+    "event": "EstablishedEvent"
+  },
+  "tag": "TelephonyEvent"
+}
+```
+
+Client applications may use events to update their UI incrementally or
+re-process the whole state every time an event arrives.
+
+## macOS
+
+On macOS with `openssl` installed via Homebrew, build with
+
+```bash
+stack build --extra-include-dirs=/usr/local/opt/openssl/include/ --extra-lib-dirs=/usr/local/opt/openssl/lib/
+```
+
+[dmcc-api]: https://www.devconnectprogram.com/site/global/products_resources/avaya_aura_application_enablement_services/interfaces/dmcc/overview/index.gsp
+
+[ecma-354]: http://www.ecma-international.org/publications/standards/Ecma-354.htm
diff --git a/dmcc-ws/Main.hs b/dmcc-ws/Main.hs
new file mode 100644
--- /dev/null
+++ b/dmcc-ws/Main.hs
@@ -0,0 +1,242 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+{-|
+
+WebSockets interface for DMCC.
+
+-}
+
+module Main where
+
+import           DMCC.Prelude hiding (getArgs)
+
+import           Control.Monad.Logger.CallStack as CS
+
+import           Data.Aeson hiding (Error)
+import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy.Char8 as BL
+import qualified Data.Configurator as Cfg
+import qualified Data.Map as Map
+import           Data.Text (Text)
+import qualified Data.Text as T
+import           Data.Version (showVersion)
+import           Data.String (fromString)
+
+import           Network.WebSockets
+
+import           System.Environment
+import           System.Exit
+import           System.Posix.Signals
+import           System.Random
+import           Text.Printf
+
+import           Paths_dmcc
+import           DMCC
+
+
+data Config = Config
+  { listenPort :: Int
+  , aesAddr    :: String
+  , aesPort    :: Int
+  , aesTLS     :: Bool
+  , caDir      :: Maybe FilePath
+  , apiUser    :: Text
+  , apiPass    :: Text
+  , whUrl      :: Maybe String
+  , refDelay   :: Int
+  , stateDelay :: Int
+  , switchName :: SwitchName
+  , logLibrary :: Bool
+  , sessDur    :: Int
+  , connAtts   :: Int
+  , connDelay  :: Int
+  }
+  deriving Show
+
+
+main :: IO ()
+main = getArgs >>= \case
+  [config] -> do
+    this <- myThreadId
+    let logger = runStdoutLoggingT
+
+    -- Terminate on SIGTERM
+    let termHandler = Catch $ do
+          logger $ CS.logInfo "Termination signal received"
+          throwTo this ExitSuccess
+
+    _ <- installHandler sigTERM termHandler Nothing
+    logger $ realMain logger config
+
+  _ -> getProgName >>= \pn -> error $ "Usage: " <> pn <> " <path to config>"
+
+
+type AgentMap = TMVar (Map.Map AgentHandle Int)
+
+
+-- | Read config and actually start the server
+realMain :: (MonadUnliftIO m, MonadLoggerIO m, MonadMask m, MonadBaseControl IO m)
+         => (m () -> IO ())
+         -> FilePath
+         -> m ()
+realMain logger config = do
+  c <- liftIO $ Cfg.load [Cfg.Required config]
+  cfg@Config{..} <- liftIO $ Config
+      <$> Cfg.require c "listen-port"
+      <*> Cfg.require c "aes-addr"
+      <*> Cfg.require c "aes-port"
+      <*> Cfg.lookupDefault True c "aes-use-tls"
+      <*> Cfg.lookup  c "aes-cacert-directory"
+      <*> Cfg.require c "api-user"
+      <*> Cfg.require c "api-pass"
+      <*> Cfg.lookup  c "web-hook-handler-url"
+      <*> Cfg.lookupDefault 1 c "agent-release-delay"
+      <*> Cfg.lookupDefault 1 c "state-polling-delay"
+      <*> (SwitchName <$> Cfg.require c "switch-name")
+      <*> Cfg.require c "log-library"
+      <*> Cfg.require c "session-duration"
+      <*> Cfg.require c "connection-retry-attempts"
+      <*> Cfg.require c "connection-retry-delay"
+
+  CS.logInfo $ "Running dmcc-" <> fromString (showVersion version)
+  CS.logInfo $ "Starting session using " <> fromString (show cfg)
+
+  let runSession = startSession
+        (aesAddr, fromIntegral aesPort)
+        (if aesTLS then TLS caDir else Plain)
+        apiUser apiPass
+        whUrl
+        defaultSessionOptions { statePollingDelay       = stateDelay
+                              , sessionDuration         = sessDur
+                              , connectionRetryAttempts = connAtts
+                              , connectionRetryDelay    = connDelay
+                              }
+
+      releaseSession s = do
+        CS.logInfo $ "Stopping " <> fromString (show s)
+        stopSession s
+
+      handleSession s = do
+        CS.logInfo $ "Running server for " <> fromString (show s)
+        (agentMap :: AgentMap) <- newTMVarIO Map.empty
+        liftIO $ runServer "0.0.0.0" listenPort $ logger . avayaApplication cfg s agentMap
+
+  bracket runSession releaseSession handleSession
+
+
+-- | Decrement reference counter for an agent. If no references left,
+-- release control over agent. Return how many references are left.
+releaseAgentRef :: (MonadUnliftIO m, MonadLoggerIO m, MonadMask m, MonadBaseControl IO m)
+                => AgentHandle -> AgentMap -> m Int
+releaseAgentRef ah refs = do
+  r <- atomically $ takeTMVar refs
+  flip onException (atomically $ putTMVar refs r) $
+    case Map.lookup ah r of
+      Just cnt -> do
+        newR <-
+          if cnt > 1
+             then pure $ Map.insert ah (cnt - 1) r
+             else do releaseAgent ah
+                     CS.logDebug $ "Agent " <> fromString (show ah) <> " is no longer controlled"
+                     pure $ Map.delete ah r
+
+        atomically $ putTMVar refs newR
+        pure $ cnt - 1
+
+      Nothing -> error $ "Releasing unknown agent " <> show ah
+
+
+avayaApplication :: (MonadUnliftIO m, MonadLoggerIO m, MonadMask m, MonadBaseControl IO m)
+                 => Config
+                 -> Session
+                 -- ^ DMCC session.
+                 -> AgentMap
+                 -- ^ Reference-counting map of used agent ids.
+                 -> PendingConnection
+                 -> m ()
+avayaApplication Config{..} as refs pending =
+  case pathArg of
+    [Nothing, Just ext] -> do
+      -- A readable label for this connection for debugging purposes
+      token <- liftIO $ randomRIO (1, 16 ^ (4 :: Int))
+
+      let label = T.pack $ printf "%d/%04x" ext (token :: Int)
+          -- Assume that all agents are on the same switch
+          ext' = Extension $ T.pack $ show ext
+
+      conn <- liftIO $ acceptRequest pending
+      CS.logError $ "New websocket opened for " <> label
+
+      -- Create a new agent reference, possibly establishing control over the agent
+      r <- atomically $ takeTMVar refs
+
+      let initialHandler = do
+            CS.logDebug $ "Exception when plugging " <> label
+            atomically $ putTMVar refs r
+            CS.logDebug $ "Restored agent references map to " <> fromString (show r)
+
+      (ah, evThread) <- flip onException initialHandler $ do
+        cRsp <- controlAgent switchName ext' as
+        ah <- case cRsp of
+                Right ah' -> pure ah'
+                Left err -> do
+                  liftIO $ sendTextData conn $ encode $ RequestError $ show err
+
+                  CS.logError $
+                    "Could not control agent for " <> label <> ": " <> fromString (show err)
+
+                  throwIO err
+
+        -- Increment reference counter
+        let oldCount = fromMaybe 0 $ Map.lookup ah r
+        atomically $ putTMVar refs $ Map.insert ah (oldCount + 1) r
+        CS.logDebug $ "Controlling agent " <> fromString (show ah) <> " from " <> label
+        refReport ext' $ oldCount + 1
+
+        -- Agent events loop
+        evThread <-
+          handleEvents ah $ \ev -> do
+            CS.logInfo $ "Event for " <> label <> ": " <> fromString (show ev)
+            liftIO $ sendTextData conn $ encode ev
+
+        CS.logDebug $ fromString (show evThread) <> " handles events for " <> label
+        pure (ah, evThread)
+
+      let disconnectionHandler = do
+            CS.logDebug $ "Websocket closed for " <> label
+            killThread evThread
+            threadDelay $ refDelay * 1000000
+            -- Decrement reference counter when the connection dies or any
+            -- other exception happens
+            releaseAgentRef ah refs >>= refReport ext'
+
+      handle (\(_ :: ConnectionException) -> disconnectionHandler) $ do
+        s <- getAgentSnapshot ah
+        liftIO $ sendTextData conn $ encode s
+
+        -- Agent actions loop
+        forever $ do
+          msg <- liftIO $ receiveData conn
+
+          case eitherDecode msg of
+            Right act -> do
+              CS.logDebug $ "Action from " <> label <> ": " <> fromString (show act)
+              agentAction act ah
+
+            Left e -> do
+              CS.logDebug
+                $ "Unrecognized message from " <> label <> ": "
+                <> fromString (BL.unpack msg) <> " (" <> fromString e <> ")"
+
+              liftIO $ sendTextData conn $ encode $ Map.fromList [("errorText" :: String, e)]
+
+    _ -> liftIO $ rejectRequest pending "Malformed extension number"
+
+  where
+    pathArg = map (fmap fst . B.readInt) $ B.split '/' $ requestPath $ pendingRequest pending
+
+    refReport ext cnt = CS.logDebug $
+      fromString (show ext) <> " has " <> fromString (show cnt) <> " references"
diff --git a/dmcc-ws/example.cfg b/dmcc-ws/example.cfg
new file mode 100644
--- /dev/null
+++ b/dmcc-ws/example.cfg
@@ -0,0 +1,39 @@
+listen-port = 8333
+
+aes-addr = "192.168.20.14"
+aes-port = 4722
+aes-use-tls = true
+
+# Path to a directory which contains the PEM encoded CA root
+# certificates used to verify server certificate. See
+# http://www.openssl.org/docs/ssl/SSL_CTX_load_verify_locations.html
+# for details of the file naming scheme
+#
+# aes-cacert-directory = "/etc/ssl/csta-certs/"
+
+api-user = "avaya"
+api-pass = "avayapassword"
+
+switch-name = "ADACs8300"
+
+# Log low-level CSTA library requests/responses
+log-library = false
+
+# web-hook-handler-url = "http://localhost:8000/avaya/hook/"
+
+# How quickly to release unused agents (in seconds). If no WebSocket
+# clients use an agent for this interval, that agent is released (all
+# monitoring stopped and events are no longer tracked for that agent).
+agent-release-delay = 60
+
+# How often to poll every agent for state changes (in seconds).
+state-polling-delay = 1
+
+# Session duration and session cleanup delay (in seconds). Keep alive
+# messages are sent every half of session duration interval.
+session-duration = 120
+
+connection-retry-attempts = 24
+
+# In seconds
+connection-retry-delay = 5
diff --git a/dmcc.cabal b/dmcc.cabal
new file mode 100644
--- /dev/null
+++ b/dmcc.cabal
@@ -0,0 +1,97 @@
+cabal-version: >=1.10
+name: dmcc
+version: 1.0.0.0
+license: BSD3
+license-file: LICENSE
+maintainer: dima@dzhus.org
+author: Max Taldykin, Timofey Cherganov, Dmitry Dzhus, Viacheslav Lotsmanov
+homepage: https://github.com/f-me/dmcc#readme
+bug-reports: https://github.com/f-me/dmcc/issues
+synopsis: AVAYA DMCC API bindings and WebSockets server for AVAYA
+description:
+    Partial implementation of CSTA Phase III XML Protocol (ECMA-323) with AVAYA (DMCC 6.3) extensions.
+category: Network
+build-type: Simple
+extra-source-files:
+    CHANGELOG.md
+    dmcc-ws/example.cfg
+    README.md
+
+source-repository head
+    type: git
+    location: https://github.com/f-me/dmcc
+
+library
+    exposed-modules:
+        DMCC
+        DMCC.Agent
+        DMCC.Prelude
+        DMCC.Session
+        DMCC.Types
+        DMCC.Util
+        DMCC.WebHook
+        DMCC.XML.Raw
+        DMCC.XML.Request
+        DMCC.XML.Response
+    hs-source-dirs: src
+    other-modules:
+        Paths_dmcc
+    default-language: Haskell2010
+    default-extensions: OverloadedStrings RecordWildCards
+                        NamedFieldPuns NoImplicitPrelude
+    ghc-options: -Wall -Wcompat -Wno-missing-home-modules
+    build-depends:
+        HsOpenSSL <0.12,
+        aeson <1.3,
+        base <4.11,
+        binary <0.9,
+        bytestring <0.11,
+        case-insensitive <1.3,
+        classy-prelude <1.5,
+        containers <0.6,
+        http-client <0.6,
+        io-streams <1.6,
+        lens <4.17,
+        monad-control <1.1,
+        monad-logger <0.4,
+        mtl <2.3,
+        network <2.7,
+        openssl-streams <1.3,
+        safe-exceptions <0.2,
+        stm <2.5,
+        text <1.3,
+        time <1.9,
+        transformers <0.6,
+        transformers-base <0.5,
+        unliftio <0.3,
+        xml-conduit <1.9,
+        xml-hamlet <0.6
+
+executable dmcc-ws
+    main-is: Main.hs
+    hs-source-dirs: dmcc-ws
+    other-modules:
+        Paths_dmcc
+    default-language: Haskell2010
+    default-extensions: OverloadedStrings RecordWildCards
+                        NamedFieldPuns NoImplicitPrelude
+    ghc-options: -Wall -Wcompat -Wno-missing-home-modules -threaded
+    build-depends:
+        aeson <1.3,
+        base <4.11,
+        bytestring <0.11,
+        classy-prelude <1.5,
+        configurator <0.4,
+        containers <0.6,
+        dmcc -any,
+        monad-control <1.1,
+        monad-logger <0.4,
+        random <1.2,
+        safe-exceptions <0.2,
+        stm <2.5,
+        text <1.3,
+        time <1.9,
+        transformers-base <0.5,
+        unix <2.8,
+        unliftio <0.3,
+        websockets <0.13
diff --git a/src/DMCC.hs b/src/DMCC.hs
new file mode 100644
--- /dev/null
+++ b/src/DMCC.hs
@@ -0,0 +1,34 @@
+{-|
+
+DMCC XML API implementation for third party call control and
+monitoring.
+
+-}
+
+module DMCC
+  ( Session
+  , ConnectionType (..)
+  , startSession
+  , stopSession
+  , defaultSessionOptions
+
+  , AgentHandle
+  , controlAgent
+  , releaseAgent
+
+  , Action (..)
+  , agentAction
+
+  , AgentEvent (..)
+  , AgentSnapshot (..)
+  , handleEvents
+  , getAgentSnapshot
+
+  , module DMCC.Types
+  )
+
+where
+
+import           DMCC.Agent
+import           DMCC.Session
+import           DMCC.Types
diff --git a/src/DMCC/Agent.hs b/src/DMCC/Agent.hs
new file mode 100644
--- /dev/null
+++ b/src/DMCC/Agent.hs
@@ -0,0 +1,624 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-|
+
+Agents in a DMCC API session enable call control over devices.
+
+-}
+
+module DMCC.Agent
+
+where
+
+import           DMCC.Prelude
+
+import           Control.Lens
+import           Control.Concurrent.STM (retry)
+
+import           Data.Aeson as A
+import           Data.Aeson.TH
+import           Data.CaseInsensitive (original)
+import           Data.Data
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+
+import qualified Network.HTTP.Client as HTTP
+import           Network.HTTP.Client (httpNoBody, method, requestBody)
+
+import           DMCC.Session
+import           DMCC.Types
+import           DMCC.Util ()
+import qualified DMCC.XML.Request as Rq
+import qualified DMCC.XML.Response as Rs
+
+
+-- | Actions performable by a controlled agent.
+data Action = MakeCall{number :: Extension}
+            | AnswerCall{callId :: CallId}
+            | EndCall{callId :: CallId}
+            | HoldCall{callId :: CallId}
+            | RetrieveCall{callId :: CallId}
+            | BargeIn{callId :: CallId, pType :: ParticipationType}
+            | ConferenceCall{activeCall :: CallId, heldCall :: CallId}
+            | TransferCall{activeCall :: CallId, heldCall :: CallId}
+            | SendDigits{callId :: CallId, digits :: Text}
+            | SetState{newState :: SettableAgentState}
+            deriving Show
+
+
+$(deriveJSON
+  defaultOptions{sumEncoding = defaultTaggedObject{tagFieldName="action"}}
+  ''Action)
+
+
+data AgentSnapshot = AgentSnapshot
+    { _calls :: Map.Map CallId Call
+    , _state :: (Maybe AgentState, Text)
+    -- ^ Last recognized agent state along with reason code.
+    }
+    deriving Show
+
+
+instance ToJSON AgentSnapshot where
+  toJSON s =
+    object [ "calls" A..= Map.mapKeys (\(CallId t) -> t) (_calls s)
+           , "state" A..= _state s
+           ]
+
+
+instance FromJSON AgentSnapshot where
+  parseJSON (Object o) =
+    AgentSnapshot
+    <$> Map.mapKeys CallId `liftM` (o .: "calls")
+    <*> (o .: "state")
+  parseJSON _ = fail "Could not parse AgentSnapshot from non-object"
+
+
+$(makeLenses ''AgentSnapshot)
+
+
+-- | Events/errors are published to external clients of the
+-- agents and may be used by agent subscribers to provide information
+-- to user.
+data AgentEvent = TelephonyEvent
+                  { dmccEvent :: Rs.Event
+                  , newSnapshot :: AgentSnapshot
+                  }
+                -- ^ A telephony-related event, along with an updated
+                -- snapshot.
+                | StateChange{newSnapshot :: AgentSnapshot}
+                -- ^ Arrives when an agent state change has been
+                -- observed.
+                | TelephonyEventError{errorText :: String}
+                -- ^ An error caused by a telephony-related event.
+                | RequestError{errorText :: String}
+                -- ^ An error caused by a request from this agent.
+                deriving Show
+
+
+$(deriveJSON defaultOptions ''AgentEvent)
+
+
+-- | Web hook event.
+data WHEvent = WHEvent
+    { agentId :: AgentId
+    , event :: AgentEvent
+    }
+    deriving Show
+
+
+$(deriveJSON defaultOptions ''WHEvent)
+
+
+-- | An agent controlled by a DMCC API session.
+data Agent = Agent
+    { deviceId :: DeviceId
+    , monitorId :: Text
+    , actionChan :: TChan Action
+    -- ^ Actions performed by the agent.
+    , actionThread :: ThreadId
+    , rspChan :: TChan Rs.Response
+    -- ^ Input chan for XML responses for this agent (including
+    -- events).
+    , rspThread :: ThreadId
+    -- ^ Response reader.
+    , stateThread :: ThreadId
+    -- ^ Agent state poller.
+    , eventChan :: TChan AgentEvent
+    , snapshot :: TVar AgentSnapshot
+    }
+
+
+instance Show Agent where
+  show (Agent (DeviceId d) m _ _ _ _ _ _ _) =
+    "Agent{deviceId=" <> unpack (original d) <>
+    ", monitorId=" <> unpack m <>
+    "}"
+
+
+newtype AgentHandle = AgentHandle (AgentId, Session)
+
+
+instance Ord AgentHandle where
+  compare (AgentHandle (aid1, _)) (AgentHandle (aid2, _)) = compare aid1 aid2
+
+
+instance Eq AgentHandle where
+  (AgentHandle (aid1, _)) == (AgentHandle (aid2, _)) = aid1 == aid2
+
+
+instance Show AgentHandle where
+  show (AgentHandle (aid, _)) = show aid
+
+
+-- | Exceptions thrown by agent-related routines and threads.
+data AgentError
+  = DeviceError String
+  | MonitoringError String
+  | StatePollingError String
+  | UnknownAgent AgentId
+  deriving (Data, Typeable, Show)
+
+
+instance (Exception AgentError)
+
+
+-- | Command an agent to do something.
+--
+-- Due to lack of global locking of the agents map an agent may be
+-- gone (released) by the time an action arrives to its actionChan.
+-- This is by design to avoid congestion during action processing.
+agentAction :: (MonadLoggerIO m, MonadCatch m) => Action -> AgentHandle -> m ()
+agentAction cmd (AgentHandle (aid, as)) = do
+  ags <- readTVarIO $ agents as
+  case Map.lookup aid ags of
+    Just Agent{..} -> atomically $ writeTChan actionChan cmd
+    Nothing -> throwIO $ UnknownAgent aid
+
+
+placeAgentLock :: AgentHandle -> STM ()
+placeAgentLock (AgentHandle (aid, as)) =
+  modifyTVar' (agentLocks as) (Set.insert aid)
+
+
+releaseAgentLock :: MonadLoggerIO m => AgentHandle -> m ()
+releaseAgentLock (AgentHandle (aid, as)) =
+  atomically $ modifyTVar' (agentLocks as) (Set.delete aid)
+
+
+-- | Enable an active agent to be monitored and controlled through
+-- DMCC API. If the agent has already been registered, return the old
+-- entry (it's safe to call this function with the same arguments
+-- multiple times).
+controlAgent :: (MonadUnliftIO m, MonadLoggerIO m, MonadBaseControl IO m, MonadMask m)
+             => SwitchName
+             -> Extension
+             -> Session
+             -> m (Either AgentError AgentHandle)
+controlAgent switch ext as = do
+  let aid = AgentId (switch, ext)
+      ah  = AgentHandle (aid, as)
+  -- Check if agent already exists
+  prev <- atomically $ do
+    locks <- readTVar $ agentLocks as
+    if Set.member aid locks
+       then retry
+       else do ags <- readTVar $ agents as
+               if Map.member aid ags
+                  then pure $ Just aid
+                  -- Prevent parallel operation on the same agent
+                  else placeAgentLock ah >> pure Nothing
+  case prev of
+    Just a -> pure $ Right $ AgentHandle (a, as)
+    Nothing -> try $ flip onException (releaseAgentLock ah) $
+      do
+        -- Get Avaya info for this agent (note that requests are not
+        -- attached to the agent (Nothing) as it has not been inserted
+        -- in the agent map of the session yet).
+        gdiRsp <-
+          sendRequestSync (dmccHandle as) Nothing
+          Rq.GetDeviceId
+          { switchName = switch
+          , extension = ext
+          }
+
+        device <-
+          case gdiRsp of
+            Just (Rs.GetDeviceIdResponse device) ->
+              pure device
+            Just (Rs.CSTAErrorCodeResponse errorCode) ->
+              throwIO $ DeviceError $ unpack errorCode
+            _ ->
+              throwIO $ DeviceError "Bad GetDeviceId response"
+
+        msrRsp <-
+          sendRequestSync (dmccHandle as) Nothing
+          Rq.MonitorStart
+          { acceptedProtocol = protocolVersion as
+          , monitorRq = Rq.Device device
+          }
+
+        monitorCrossRefID <-
+          case msrRsp of
+            Just (Rs.MonitorStartResponse monitorCrossRefID) ->
+              pure monitorCrossRefID
+            Just (Rs.CSTAErrorCodeResponse errorCode) ->
+              throwIO $ MonitoringError $ unpack errorCode
+            _ ->
+              throwIO $ DeviceError "Bad MonitorStart response"
+
+        -- Setup action and event processing for this agent
+        snapshot <- newTVarIO $ AgentSnapshot Map.empty (Nothing, "")
+
+        actionChan <- newTChanIO
+        actionThread <-
+          forkIO $ forever $
+          atomically (readTChan actionChan) >>=
+          processAgentAction aid device snapshot as
+
+        eventChan <- newBroadcastTChanIO
+
+        rspChan <- newTChanIO
+        rspThread <-
+          forkIO $ forever $
+          atomically (readTChan rspChan) >>=
+          processAgentEvent aid device snapshot eventChan as
+
+        -- As of DMCC 6.2.x, agent state change events are not
+        -- reported by DMCC (see
+        -- https://www.devconnectprogram.com/forums/posts/list/18511.page).
+        -- We use polling to inform our API clients about update in
+        -- the agent state.
+
+        -- Find out initial agent state
+        gsRsp' <-
+          sendRequestSync (dmccHandle as) (Just aid)
+          Rq.GetAgentState
+          { device = device
+          , acceptedProtocol = protocolVersion as
+          }
+        case gsRsp' of
+          Just Rs.GetAgentStateResponse{..} ->
+            atomically $ modifyTVar' snapshot $ state .~ (agentState, reasonCode)
+          Just (Rs.CSTAErrorCodeResponse errorCode) ->
+            throwIO $ StatePollingError $ unpack errorCode
+          _ ->
+            throwIO $ DeviceError "Bad GetAgentState response"
+        -- State polling thread
+        stateThread <-
+          forkIO $ forever $ do
+            gsRsp <- sendRequestSync (dmccHandle as) (Just aid)
+              Rq.GetAgentState
+              { device = device
+              , acceptedProtocol = protocolVersion as
+              }
+            case gsRsp of
+              Just Rs.GetAgentStateResponse{..} -> do
+                ns <- atomically $ do
+                  sn <- readTVar snapshot
+                  if _state sn /= (agentState, reasonCode)
+                     then do modifyTVar' snapshot (state .~ (agentState, reasonCode))
+                             newSnapshot <- readTVar snapshot
+                             Just newSnapshot <$ writeTChan eventChan (StateChange newSnapshot)
+                     else pure Nothing
+                case (ns, webHook as) of
+                  (Just ns', Just connData) -> sendWH connData aid $ StateChange ns'
+                  _ -> pure ()
+              -- Ignore state errors
+              _ -> pure ()
+            threadDelay $ statePollingDelay (sessionOptions $ dmccHandle as) * 1000000
+
+        let ag = Agent
+                 device
+                 monitorCrossRefID
+                 actionChan
+                 actionThread
+                 rspChan
+                 rspThread
+                 stateThread
+                 eventChan
+                 snapshot
+        atomically $ modifyTVar' (agents as) $ Map.insert aid ag
+        releaseAgentLock ah
+        pure ah
+
+
+-- | Translate agent actions into actual DMCC API requests.
+--
+-- TODO Allow agents to control only own calls.
+processAgentAction :: (MonadUnliftIO m, MonadLoggerIO m, MonadBaseControl IO m, MonadCatch m)
+                   => AgentId
+                   -> DeviceId
+                   -> TVar AgentSnapshot
+                   -> Session
+                   -> Action
+                   -> m ()
+processAgentAction aid@(AgentId (switch, _)) device snapshot as action =
+  case action of
+    -- We ignore bad requests here. All CSTA errors will be reported
+    -- to the agent.
+    MakeCall toNumber -> do
+      rspDest <-
+        sendRequestSync (dmccHandle as) (Just aid)
+        Rq.GetThirdPartyDeviceId
+        -- Assume destination switch is the same as agent's
+        { switchName = switch
+        , extension = toNumber
+        }
+      case rspDest of
+        Just (Rs.GetThirdPartyDeviceIdResponse destDev) -> do
+          mcr <- sendRequestSync (dmccHandle as) (Just aid) $
+                 Rq.MakeCall
+                 device
+                 destDev
+                 (protocolVersion as)
+          case mcr of
+            Just (Rs.MakeCallResponse callId ucid) -> do
+              now <- liftIO getCurrentTime
+              let call = Call Out ucid now [destDev] Nothing False False
+              atomically $ modifyTVar' snapshot $ calls %~ Map.insert callId call
+            _ -> pure ()
+        _ -> pure ()
+    AnswerCall callId   -> simpleRequest Rq.AnswerCall callId
+    HoldCall callId     -> simpleRequest Rq.HoldCall callId
+    RetrieveCall callId -> simpleRequest Rq.RetrieveCall callId
+    BargeIn activeCall m -> do
+      sscR <- sendRequestSync (dmccHandle as) (Just aid) $
+              Rq.SingleStepConferenceCall
+              device
+              activeCall
+              (protocolVersion as)
+              m
+      case sscR of
+        Just (Rs.SingleStepConferenceCallResponse callId) -> do
+          -- Find the call we've stepped in among other agents' calls
+          -- and copy it to us
+          allCalls <- atomically $ do
+            agents <- readTVar (agents as)
+            mapM (fmap _calls . readTVar . DMCC.Agent.snapshot) $ Map.elems agents
+          case Map.lookup callId (Map.unions allCalls) of
+            Just call ->
+              atomically $ modifyTVar' snapshot $ calls %~ Map.insert callId call
+            _ -> pure ()
+        _ -> pure ()
+    ConferenceCall activeCall heldCall ->
+      simpleRequest2 Rq.ConferenceCall activeCall heldCall
+    TransferCall activeCall heldCall ->
+      simpleRequest2 Rq.TransferCall activeCall heldCall
+    EndCall callId -> simpleRequest Rq.ClearConnection callId
+    -- Synchronous to avoid missed digits if actions queue up
+    SendDigits{..} ->
+      void $
+      sendRequestSync (dmccHandle as) (Just aid) $
+      Rq.GenerateDigits digits device callId (protocolVersion as)
+    SetState newState -> do
+      cs <- atomically $ readTVar snapshot
+      when (fst (_state cs) /= Just Busy) $
+        simpleRequest Rq.SetAgentState newState
+  where
+    arq = sendRequestAsync (dmccHandle as) $ Just aid
+    simpleRequest rq arg = arq $ rq device arg $ protocolVersion as
+    simpleRequest2 rq arg1 arg2 = arq $ rq device arg1 arg2 $ protocolVersion as
+
+
+-- | Process DMCC API events/errors for this agent to change its snapshot
+-- and broadcast events further.
+processAgentEvent :: (MonadUnliftIO m, MonadBaseControl IO m, MonadLoggerIO m, MonadCatch m)
+                  => AgentId
+                  -> DeviceId
+                  -> TVar AgentSnapshot
+                  -> TChan AgentEvent
+                  -> Session
+                  -> Rs.Response
+                  -> m ()
+processAgentEvent aid device snapshot eventChan as rs = do
+  now <- liftIO getCurrentTime
+  case rs of
+    -- Report all errors to the agent
+    Rs.CSTAErrorCodeResponse err ->
+      atomically $ writeTChan eventChan $ RequestError $ unpack err
+
+    -- New outgoing call
+    --
+    -- MakeCallResponse handler should have already added the call
+    -- information to agent state. If this is not the case (which
+    -- occurs when multiple DMCC library sessions interact with the
+    -- same AVAYA instance), we add the call after finding out its
+    -- UCID.
+    Rs.EventResponse _ ev@Rs.OriginatedEvent{..} -> do
+      s <- readTVarIO snapshot
+
+      updSnapshot' <-
+        if Map.member callId $ _calls s
+           then pure s
+           else do gcldr <-
+                     sendRequestSync (dmccHandle as) (Just aid) $
+                       Rq.GetCallLinkageData device callId (protocolVersion as)
+
+                   case gcldr of
+                        Just (Rs.GetCallLinkageDataResponse ucid) ->
+                          atomically $ do
+                            let call = Call Out ucid now [calledDevice] Nothing False False
+                            modifyTVar' snapshot $ calls %~ Map.insert callId call
+                            readTVar snapshot
+
+                        _ -> do
+                          atomically $ writeTChan eventChan $
+                            TelephonyEventError "Bad GetCallLinkageDataResponse"
+
+                          pure s
+
+      atomically $ writeTChan eventChan $ TelephonyEvent ev s
+
+      case webHook as of
+        Just connData -> sendWH connData aid $ TelephonyEvent ev updSnapshot'
+        _             -> pure ()
+
+
+    -- All other telephony events
+    Rs.EventResponse _ ev -> do
+      (updSnapshot, report) <- atomically $ do
+        -- Return True if the event must be reported to agent event chan
+        report <- case ev of
+          Rs.OriginatedEvent{..} ->
+            -- Should have already been handled in a branch above
+            pure True
+          -- New call
+          Rs.DeliveredEvent{..} -> do
+            s <- readTVar snapshot
+            if Map.member callId $ _calls s
+               then pure False
+               else -- DeliveredEvent arrives after OriginatedEvent for
+                    -- outgoing calls too, but we keep the original call
+                    -- information.
+                    True <$ modifyTVar' snapshot (calls %~ Map.insert callId call)
+            where
+              call = Call dir ucid now [interloc] Nothing False False
+              (dir, interloc) = if callingDevice == device
+                                   then (Out, calledDevice)
+                                   else (In distributingVdn, callingDevice)
+          Rs.DivertedEvent{..} -> do
+            modifyTVar' snapshot $ calls %~ at callId .~ Nothing
+            pure True
+          Rs.EstablishedEvent{..} -> do
+            callOperation callId
+              (\call -> Map.insert callId call{answered = Just now})
+              "Established connection to an undelivered call"
+            pure True
+          Rs.FailedEvent{..} -> do
+            callOperation callId
+              (\call -> Map.insert callId call{failed = True})
+              "Failed an unknown call"
+            pure True
+          -- ConnectionCleared event arrives when line is put on HOLD too.
+          -- A real call-ending ConnectionCleared is distinguished by its
+          -- releasingDevice value.
+          Rs.ConnectionClearedEvent{..} -> do
+            let really = releasingDevice == device
+            when really $ modifyTVar' snapshot $ calls %~ at callId .~ Nothing
+            pure really
+          Rs.HeldEvent{..} -> do
+            callOperation callId
+              (\call -> Map.insert callId call{held = True})
+              "Held an undelivered call"
+            pure True
+          Rs.RetrievedEvent{..} -> do
+            callOperation callId
+              (\call -> Map.insert callId call{held = False})
+              "Retrieved an undelivered call"
+            pure True
+          -- Conferencing call A to call B yields ConferencedEvent with
+          -- primaryCall=B and secondaryCall=A, while call A dies.
+          Rs.ConferencedEvent prim sec -> do
+            s <- readTVar snapshot
+            case (Map.lookup prim $ _calls s, Map.lookup sec $ _calls s) of
+              (Just oldCall, Just newCall) -> do
+                modifyTVar' snapshot $ calls %~ at prim .~ Nothing
+                let callHandler call =
+                      Map.insert sec
+                        call{interlocutors = interlocutors oldCall <> interlocutors newCall}
+                callOperation sec callHandler "Conferenced an undelivered call"
+                pure True
+              -- ConferencedEvent may also be produced after a new
+              -- established call but not caused by an actual conference
+              -- user request (recorder single-stepping in).
+              _ -> pure False
+          Rs.TransferedEvent prim sec -> do
+            modifyTVar' snapshot $ calls %~ at prim .~ Nothing
+            modifyTVar' snapshot $ calls %~ at sec .~ Nothing
+            pure True
+          Rs.UnknownEvent -> pure False
+        s <- readTVar snapshot
+        when report $ writeTChan eventChan $ TelephonyEvent ev s
+        pure (s, report)
+      -- Call webhook if necessary
+      case (webHook as, report) of
+        (Just connData, True) -> sendWH connData aid $ TelephonyEvent ev updSnapshot
+        _ -> pure ()
+    -- All other responses cannot arrive to an agent
+    _ -> pure ()
+
+  where
+    -- | Atomically modify one of the calls.
+    callOperation :: CallId
+                  -- ^ CallId to find in calls map
+                  -> (Call -> Map.Map CallId Call -> Map.Map CallId Call)
+                  -- ^ How to modify calls map if the call has been found
+                  -> String
+                  -- ^ Error message if no such call found
+                  -> STM ()
+    callOperation callId callMod err = do
+      s <- readTVar snapshot
+      case Map.lookup callId $ _calls s of
+        Just call -> modifyTVar' snapshot $ \m -> m & calls %~ callMod call
+        Nothing   -> writeTChan eventChan $ TelephonyEventError err
+
+
+-- | Send agent event data to a web hook endpoint, ignoring possible
+-- exceptions.
+sendWH :: (MonadUnliftIO m, MonadLoggerIO m, MonadCatch m)
+       => (HTTP.Request, HTTP.Manager)
+       -> AgentId
+       -> AgentEvent
+       -> m ()
+sendWH (req, mgr) aid payload =
+  handle errHandler $ void $ liftIO $ httpNoBody req{requestBody = rqBody, method = "POST"} mgr
+  where
+    rqBody = HTTP.RequestBodyLBS $ A.encode $ WHEvent aid payload
+    errHandler (e :: HTTP.HttpException) = logErrorN $ pack $
+      "Webhook error for agent " <> show aid <> ", event " <> show payload <> ": " <> show e
+
+
+-- | Forget about an agent, releasing his device and monitors.
+releaseAgent :: (MonadUnliftIO m, MonadLoggerIO m, MonadBaseControl IO m, MonadCatch m)
+             => AgentHandle -> m ()
+releaseAgent ah@(AgentHandle (aid, as)) = do
+  prev <- atomically $ do
+    locks <- readTVar $ agentLocks as
+
+    if Set.member aid locks
+       then retry
+       else do ags <- readTVar $ agents as
+               case Map.lookup aid ags of
+                    Just ag -> placeAgentLock ah >> pure (Just ag)
+                    Nothing -> pure Nothing
+
+  case prev of
+    Nothing -> throwIO $ UnknownAgent aid
+    Just ag ->
+      handle (\e -> releaseAgentLock ah >> throwIO (e :: IOException)) $ do
+        killThread (actionThread ag)
+        killThread (rspThread ag)
+        killThread (stateThread ag)
+        _ <- sendRequestSync (dmccHandle as) (Just aid)
+          Rq.MonitorStop
+          { acceptedProtocol = protocolVersion as
+          , monitorCrossRefID = monitorId ag
+          }
+        _ <- sendRequestSync (dmccHandle as) (Just aid)
+          Rq.ReleaseDeviceId{device = deviceId ag}
+        atomically $ modifyTVar' (agents as) (Map.delete aid)
+        releaseAgentLock ah
+        pure ()
+
+
+-- | Attach an event handler to an agent. Exceptions are not handled.
+handleEvents :: (MonadLoggerIO m, MonadThrow m) => AgentHandle -> (AgentEvent -> m ()) -> m ThreadId
+handleEvents (AgentHandle (aid, as)) handler = do
+  ags <- atomically $ readTVar $ agents as
+  case Map.lookup aid ags of
+    Nothing -> throwIO $ UnknownAgent aid
+    Just Agent{..} -> do
+      sub <- atomically $ dupTChan eventChan
+      forever $ handler =<< atomically (readTChan sub)
+
+
+getAgentSnapshot :: (MonadLoggerIO m, MonadThrow m) => AgentHandle -> m AgentSnapshot
+getAgentSnapshot (AgentHandle (aid, as)) = do
+  ags <- readTVarIO $ agents as
+  case Map.lookup aid ags of
+    Nothing -> throwIO $ UnknownAgent aid
+    Just Agent{..} -> readTVarIO snapshot
diff --git a/src/DMCC/Agent.hs-boot b/src/DMCC/Agent.hs-boot
new file mode 100644
--- /dev/null
+++ b/src/DMCC/Agent.hs-boot
@@ -0,0 +1,29 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module DMCC.Agent
+
+where
+
+import           DMCC.Prelude
+
+import           Data.Text (Text)
+
+import           DMCC.Types
+import qualified DMCC.XML.Response as Rs
+import {-# SOURCE #-} DMCC.Session
+
+
+data Agent
+
+
+newtype AgentHandle = AgentHandle (AgentId, Session)
+
+
+monitorId :: Agent -> Text
+
+
+rspChan :: Agent -> TChan Rs.Response
+
+
+releaseAgent :: (MonadUnliftIO m, MonadLoggerIO m, MonadBaseControl IO m, MonadCatch m)
+             => AgentHandle -> m ()
diff --git a/src/DMCC/Prelude.hs b/src/DMCC/Prelude.hs
new file mode 100644
--- /dev/null
+++ b/src/DMCC/Prelude.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE ConstraintKinds #-}
+
+module DMCC.Prelude
+  ( module ClassyPrelude
+  , module UnliftIO.IO
+  , module UnliftIO.STM
+  , module UnliftIO.Concurrent
+  , module Control.Monad.Base
+  , module Control.Monad.Trans.Control
+  , module Control.Exception.Safe
+  , module Control.Monad.Logger
+  )
+
+where
+
+import ClassyPrelude hiding ( atomically
+                            , newBroadcastTChanIO
+                            , newEmptyTMVarIO
+                            , newTBQueueIO
+                            , newTChanIO
+                            , newTMVarIO
+                            , newTQueueIO
+                            , newTVarIO
+                            , readTVarIO
+                            , mkWeakTVar
+                            , mkWeakTMVar
+                            , registerDelay
+                            )
+
+import UnliftIO.IO
+import UnliftIO.STM
+import UnliftIO.Concurrent
+import Control.Monad.Base (MonadBase)
+import Control.Monad.Trans.Control (MonadBaseControl)
+import Control.Exception.Safe (MonadThrow, MonadCatch, MonadMask)
+import Control.Monad.Logger
diff --git a/src/DMCC/Session.hs b/src/DMCC/Session.hs
new file mode 100644
--- /dev/null
+++ b/src/DMCC/Session.hs
@@ -0,0 +1,533 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DoAndIfThenElse #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+
+{-|
+DMCC session handling.
+-}
+
+module DMCC.Session
+  ( Session (..)
+  , ConnectionType (..)
+  , startSession
+  , stopSession
+  , defaultSessionOptions
+
+  , DMCCError (..)
+
+  , DMCCHandle (..)
+  , sendRequestSync
+  , sendRequestAsync
+  )
+
+where
+
+import           DMCC.Prelude
+
+import           Control.Arrow ()
+import           Control.Concurrent.STM.TMVar (tryPutTMVar)
+
+import           Data.ByteString (ByteString)
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+import qualified Data.IntMap.Strict as IntMap
+import           Data.Text as T (Text, empty)
+import           Data.Typeable ()
+
+import           System.IO.Streams ( InputStream
+                                   , OutputStream
+                                   , ReadTooShortException
+                                   , write
+                                   )
+import           System.IO.Streams.Handle
+import qualified System.IO.Streams.SSL as SSLStreams
+
+import           Network
+import qualified Network.HTTP.Client as HTTP
+import           Network.Socket hiding (connect)
+import           OpenSSL
+import qualified OpenSSL.Session as SSL
+
+import           DMCC.Types
+import           DMCC.XML.Request (Request)
+import qualified DMCC.XML.Request as Rq
+import           DMCC.XML.Response (Response)
+import qualified DMCC.XML.Response as Rs
+import qualified DMCC.XML.Raw as Raw
+
+import {-# SOURCE #-} DMCC.Agent
+
+
+data ConnectionType = Plain
+                    | TLS { caDir :: Maybe FilePath }
+
+
+-- | Third element is a connection close action.
+type ConnectionData = (InputStream ByteString, OutputStream ByteString, IO ())
+
+
+-- | Low-level DMCC API plumbing.
+data DMCCHandle = DMCCHandle
+  { connection :: TMVar ConnectionData
+  -- ^ AVAYA server socket streams and connection cleanup action.
+  , dmccSession :: TMVar (Text, Int)
+  -- ^ DMCC session ID and duration.
+  , reconnect :: forall m
+               . (MonadUnliftIO m, MonadLoggerIO m, MonadBaseControl IO m, MonadCatch m)
+              => m ()
+  -- ^ Reconnect to AVAYA server, changing socket streams, cleanup
+  -- action and session.
+  , pingThread :: ThreadId
+  , readThread :: ThreadId
+  -- ^ DMCC response reader thread.
+  , procThread :: ThreadId
+  -- ^ Response handler/synchronous requests worker thread.
+  , invokeId :: TVar Int
+  -- ^ Request/response counter.
+  , syncResponses :: TVar (IntMap.IntMap (TMVar (Maybe Response)))
+  , agentRequests :: TVar (IntMap.IntMap AgentId)
+  -- ^ Keeps track of which request has has been issued by what agent
+  -- (if there's one) until its response arrives.
+  , sessionOptions :: SessionOptions
+  }
+
+
+-- | Library API session.
+data Session = Session
+  { protocolVersion :: Text
+  , dmccHandle :: DMCCHandle
+  , webHook :: Maybe (HTTP.Request, HTTP.Manager)
+  -- ^ Web hook handler URL and manager.
+  , agents :: TVar (Map.Map AgentId Agent)
+  , agentLocks :: TVar (Set.Set AgentId)
+  }
+
+
+instance Show Session where
+  show as = "Session{protocolVersion=" <> unpack (protocolVersion as) <> "}"
+
+
+data LoopEvent
+  = DMCCRsp Response
+  | Timeout
+  | ReadError
+  deriving Show
+
+
+data DMCCError = ApplicationSessionFailed
+                 deriving (Show, Typeable)
+
+
+instance Exception DMCCError
+
+
+defaultSessionOptions :: SessionOptions
+defaultSessionOptions = SessionOptions 1 120 24 5
+
+
+startSession :: (MonadUnliftIO m, MonadLoggerIO m, MonadBaseControl IO m, MonadCatch m)
+             => (String, PortNumber)
+             -- ^ Host and port of AES server.
+             -> ConnectionType
+             -- ^ Use TLS.
+             -> Text
+             -- ^ DMCC API user.
+             -> Text
+             -- ^ DMCC API password.
+             -> Maybe String
+             -- ^ Web hook URL.
+             -> SessionOptions
+             -> m Session
+startSession (host, port) ct user pass whUrl sopts = do
+  syncResponses <- newTVarIO IntMap.empty
+  agentRequests <- newTVarIO IntMap.empty
+  invoke <- newTVarIO 0
+
+  -- When this is empty, I/O streams to the server are not ready.
+  conn <- newEmptyTMVarIO
+  -- When this is empty, DMCC session is not ready or is being
+  -- recovered.
+  sess <- newEmptyTMVarIO
+
+  let
+    -- Connect to the server, produce I/O streams and a cleanup action
+    connect :: (MonadUnliftIO m, MonadBase IO m, MonadLoggerIO m, MonadCatch m) => m ConnectionData
+    connect = connect1 (connectionRetryAttempts sopts)
+      where
+        connectExHandler
+          :: (Exception e, Show e, MonadUnliftIO m, MonadLoggerIO m, MonadBase IO m, MonadCatch m)
+          => Int -> e -> m ConnectionData
+        connectExHandler attempts e = do
+          logErrorN $ "Connection failed: " <> tshow e
+          if attempts > 0
+             then threadDelay (connectionRetryDelay sopts * 1000000) >> connect1 (attempts - 1)
+             else throwIO e
+        connect1 attempts =
+          handleNetwork (connectExHandler attempts) $
+          liftIO $ case ct of
+            Plain -> do
+              h <- connectTo host (PortNumber $ fromIntegral port)
+              hSetBuffering h NoBuffering
+              is <- handleToInputStream h
+              os <- handleToOutputStream h
+              let cl = hClose h
+              pure (is, os, cl)
+            TLS caDir -> withOpenSSL $ do
+              sslCtx <- SSL.context
+              SSL.contextSetDefaultCiphers sslCtx
+              SSL.contextSetVerificationMode sslCtx $
+                SSL.VerifyPeer True True Nothing
+              maybe (pure ()) (SSL.contextSetCADirectory sslCtx) caDir
+              (is, os, ssl) <- SSLStreams.connect sslCtx host port
+              let cl = do
+                    SSL.shutdown ssl SSL.Unidirectional
+                    maybe (pure ()) close $ SSL.sslSocket ssl
+              pure (is, os, cl)
+
+    -- Start new DMCC session
+    startDMCCSession :: (MonadUnliftIO m, MonadLoggerIO m, MonadBaseControl IO m, MonadCatch m)
+                     => Maybe Text
+                     -- ^ Previous session ID (we attempt to recover
+                     -- when this is given).
+                     -> m ((Text, Int), Text)
+    startDMCCSession old = do
+      let
+        sendReq =
+          sendRequestSyncRaw
+          conn
+          reconnect
+          invoke
+          syncResponses
+          Nothing
+        startReq sid =
+          sendReq
+          Rq.StartApplicationSession
+          { applicationId = ""
+          , requestedProtocolVersion = Rq.DMCC_6_2
+          , userName = user
+          , password = pass
+          , sessionCleanupDelay = sessionDuration sopts
+          , sessionID = fromMaybe T.empty sid
+          , requestedSessionDuration = sessionDuration sopts
+          }
+        -- Start a session monitor to enable TransferMonitorObjects
+        -- feature
+        sessionMonitorReq proto =
+          sendReq
+          Rq.MonitorStart
+          { acceptedProtocol = proto
+          , monitorRq = Rq.Session
+          }
+      startRsp <- startReq old
+      case (startRsp, old) of
+        (Just Rs.StartApplicationSessionPosResponse{..}, _) -> do
+          _ <- sessionMonitorReq actualProtocolVersion
+          pure ((sessionID, actualSessionDuration), actualProtocolVersion)
+        (Just Rs.StartApplicationSessionNegResponse, Just oldID) -> do
+          -- The old session has expired, start from scratch
+          startRsp' <- startReq Nothing
+          case startRsp' of
+            Just Rs.StartApplicationSessionPosResponse{..} -> do
+              _ <- sessionMonitorReq actualProtocolVersion
+              -- Transfer MonitorObjects from old session
+              sendRequestAsyncRaw
+                conn
+                reconnect
+                invoke
+                Nothing
+                Rq.TransferMonitorObjects
+                { fromSessionID = oldID
+                , toSessionID = sessionID
+                , acceptedProtocol = actualProtocolVersion
+                }
+              pure ((sessionID, actualSessionDuration), actualProtocolVersion)
+            _ -> throwIO ApplicationSessionFailed
+        _ -> throwIO ApplicationSessionFailed
+
+    -- Restart I/O and DMCC session. This routine returns when new I/O
+    -- streams become available (starting DMCC session requires
+    -- response reader thread to be functional).
+    reconnect :: (MonadUnliftIO m, MonadBaseControl IO m, MonadLoggerIO m, MonadCatch m) => m ()
+    reconnect = do
+      logWarnN "Attempting reconnection"
+      -- Only one reconnection at a time
+      (oldId, cl) <- atomically $ do
+        (oldId, _) <- takeTMVar sess
+        (_, _, cl) <- takeTMVar conn
+        pure (oldId, cl)
+      -- Fail all pending synchronous requests
+      atomically $ do
+        srs <- readTVar syncResponses
+        mapM_ (`putTMVar` Nothing) $ IntMap.elems srs
+        writeTVar syncResponses IntMap.empty
+      handle
+        (\(e :: IOException) -> logErrorN $ "Failed to close old connection: " <> tshow e) $
+        liftIO cl
+      -- We do not change the protocol version during session recovery
+      connect >>= atomically . putTMVar conn
+      logWarnN "Connection re-established"
+      let
+        shdl (Right ()) = pure ()
+        shdl (Left e) = throwIO e
+      -- Fork new thread for DMCC session initialization. This is
+      -- because 'reconnect' needs to return for response reader
+      -- thread to start working again (which is required for DMCC
+      -- session start).
+      void $ flip forkFinally shdl $ do
+        (newSession, _) <- startDMCCSession (Just oldId)
+        atomically $ putTMVar sess newSession
+
+  -- Read DMCC responses from socket
+  msgChan <- newTChanIO
+  let readExHandler e = do
+        logErrorN $ "Read error: " <> tshow e
+        reconnect
+  readThread <-
+    forkIO $ forever $ do
+      (istream, _, _) <- atomically $ readTMVar conn
+      handleNetwork readExHandler $
+        Raw.readResponse istream >>=
+        atomically . writeTChan msgChan . first DMCCRsp
+
+  agents <- newTVarIO Map.empty
+
+  -- Process parsed messages
+  procThread <- forkIO $ forever $ do
+    (msg, invokeId) <- atomically $ readTChan msgChan
+    -- TODO Check agent locks?
+    ags <- readTVarIO agents
+    case msg of
+      DMCCRsp rsp -> do
+        -- Return response if the request was synchronous
+        sync' <- atomically $ do
+          srs <- readTVar syncResponses
+          modifyTVar' syncResponses (IntMap.delete invokeId)
+          pure $ IntMap.lookup invokeId srs
+        case sync' of
+          Just sync -> void $ atomically $ tryPutTMVar sync $ Just rsp
+          Nothing -> pure ()
+        -- Redirect events and request errors to matching agent
+        ag' <- case rsp of
+                 Rs.EventResponse monId _ ->
+                   pure $ find (\a -> monId == monitorId a) $ Map.elems ags
+                 Rs.CSTAErrorCodeResponse _ -> do
+                   aid <- atomically $ do
+                     ars <- readTVar agentRequests
+                     modifyTVar' agentRequests (IntMap.delete invokeId)
+                     pure $ IntMap.lookup invokeId ars
+                   pure $ (`Map.lookup` ags) =<< aid
+                 _ -> pure Nothing
+        case ag' of
+          Just ag -> atomically $ writeTChan (rspChan ag) rsp
+          -- Error/event received for an unknown agent?
+          Nothing -> pure ()
+      _ -> pure ()
+
+  -- Keep the session alive
+  pingThread <- forkIO $ forever $ do
+    -- Do not send a keep-alive message if the session is not ready
+    (sid, duration) <- atomically $ readTMVar sess
+    sendRequestAsyncRaw conn reconnect invoke Nothing
+      Rq.ResetApplicationSessionTimer
+      { sessionId = sid
+      , requestedSessionDuration = duration
+      }
+    threadDelay $ duration * 500 * 1000
+
+  let h = DMCCHandle
+          conn
+          sess
+          reconnect
+          pingThread
+          readThread
+          procThread
+          invoke
+          syncResponses
+          agentRequests
+          sopts
+
+  -- Start the session
+  connect >>= atomically . putTMVar conn
+  (newSession, actualProtocolVersion) <- startDMCCSession Nothing
+  atomically $ putTMVar sess newSession
+
+  wh <- case whUrl of
+          Just url -> do
+            mgr <- liftIO $ HTTP.newManager HTTP.defaultManagerSettings
+            req <- HTTP.parseUrlThrow url
+            pure $ Just (req, mgr)
+          Nothing -> pure Nothing
+
+  agLocks <- newTVarIO Set.empty
+
+  pure $
+    Session
+    actualProtocolVersion
+    h
+    wh
+    agents
+    agLocks
+
+
+-- | TODO Agent releasing notice
+stopSession :: (MonadUnliftIO m, MonadLoggerIO m, MonadBaseControl IO m, MonadCatch m)
+            => Session -> m ()
+stopSession as@Session{..} = do
+  -- Release all agents
+  ags <- readTVarIO agents
+  (s, _) <- atomically $ readTMVar $ dmccSession dmccHandle
+  forM_ (keys ags) $ releaseAgent . \aid -> AgentHandle (aid, as)
+
+  sendRequestAsync dmccHandle Nothing Rq.StopApplicationSession{sessionID = s}
+
+  -- TOOD Use async/throwTo instead
+  killThread $ pingThread dmccHandle
+  killThread $ procThread dmccHandle
+  killThread $ readThread dmccHandle
+  (_, ostream, cleanup) <- atomically $ readTMVar $ connection dmccHandle
+  liftIO $ do
+    write Nothing ostream
+    cleanup
+
+
+-- | Send a request and block until the response arrives or a write
+-- exception occurs. No request is sent until a connection and an
+-- application session become available. Write exceptions cause a
+-- reconnection and a session restart, Nothing is returned in this
+-- case.
+--
+-- This must not be used to for session setup as this requires an
+-- active DMCC application session!
+--
+-- Write errors are made explicit here because 'sendRequestSync' is
+-- called from multiple locations, making it tedious to install the
+-- reconnection handler everywhere.
+sendRequestSync :: (MonadUnliftIO m, MonadLoggerIO m, MonadBaseControl IO m, MonadCatch m)
+                => DMCCHandle
+                -> Maybe AgentId
+                -- ^ Push erroneous responses to this agent's event
+                -- processor.
+                --
+                -- TODO Disallow unknown agents on type level (use
+                -- AgentHandle).
+                -> Request
+                -> m (Maybe Response)
+sendRequestSync DMCCHandle{..} aid rq = do
+  void $ atomically $ readTMVar dmccSession
+  sendRequestSyncRaw
+    connection
+    reconnect
+    invokeId
+    syncResponses
+    ((agentRequests, ) <$> aid)
+    rq
+
+
+sendRequestSyncRaw :: (MonadUnliftIO m, MonadLoggerIO m, MonadBaseControl IO m, MonadCatch m)
+                   => TMVar ConnectionData
+                   -- ^ Block until this connection becomes available.
+                   -> m ()
+                   -- ^ Reconnection action.
+                   -> TVar Int
+                   -> TVar (IntMap.IntMap (TMVar (Maybe Response)))
+                   -- ^ Synchronous response storage.
+                   -> Maybe (TVar (IntMap.IntMap AgentId), AgentId)
+                   -- ^ Agent requests map and target agent id. When
+                   -- provided, CSTAErrorCode response will be
+                   -- directed to that agent's event processor.
+                   -> Request
+                   -> m (Maybe Response)
+sendRequestSyncRaw connection re invoke srs ar !rq = do
+  (ix, var, c@(_, ostream, _)) <- atomically $ do
+    modifyTVar' invoke $ (`mod` 9999) . (+1)
+    ix <- readTVar invoke
+    var <- newEmptyTMVar
+    modifyTVar' srs (IntMap.insert ix var)
+    case ar of
+      Just (ars, a) -> modifyTVar' ars (IntMap.insert ix a)
+      Nothing -> pure ()
+    c <- takeTMVar connection
+    pure (ix, var, c)
+  let
+    srHandler e = do
+      logErrorN $ "Write error: " <> tshow e
+      atomically $ do
+        putTMVar connection c
+        putTMVar var Nothing
+        modifyTVar' srs $ IntMap.delete ix
+        case ar of
+          Just (ars, _) -> modifyTVar' ars (IntMap.delete ix)
+          Nothing -> pure ()
+      re
+  handleNetwork srHandler $ Raw.sendRequest ostream ix rq
+  -- Release the connection at once and wait for response in a
+  -- separate transaction.
+  atomically $ putTMVar connection c
+  atomically $ takeTMVar var
+
+
+-- | Like 'sendRequestAsync', but do not wait for a result.
+sendRequestAsync :: (MonadUnliftIO m, MonadLoggerIO m, MonadBaseControl IO m, MonadCatch m)
+                 => DMCCHandle
+                 -> Maybe AgentId
+                 -- ^ Push erroneous responses to this agent's event
+                 -- processor.
+                 -> Request
+                 -> m ()
+sendRequestAsync DMCCHandle{..} aid rq = do
+  _ <- atomically $ readTMVar dmccSession
+  sendRequestAsyncRaw
+    connection
+    reconnect
+    invokeId
+    ((agentRequests, ) <$> aid)
+    rq
+
+
+sendRequestAsyncRaw :: (MonadUnliftIO m, MonadLoggerIO m, MonadCatch m)
+                    => TMVar ConnectionData
+                    -- ^ Block until this connection becomes available.
+                    -> m ()
+                    -- ^ Reconnection action.
+                    -> TVar Int
+                    -> Maybe (TVar (IntMap.IntMap AgentId), AgentId)
+                    -> Request
+                    -> m ()
+sendRequestAsyncRaw connection re invoke ar !rq = do
+  (ix, c@(_, ostream, _)) <- atomically $ do
+    modifyTVar' invoke $ (`mod` 9999) . (+1)
+    ix <- readTVar invoke
+    case ar of
+      Just (ars, a) -> modifyTVar' ars (IntMap.insert ix a)
+      Nothing -> pure ()
+    c <- takeTMVar connection
+    pure (ix, c)
+  let
+    srHandler e = do
+      logErrorN $ "Write error: " <> tshow e
+      atomically $ do
+        putTMVar connection c
+        case ar of
+          Just (ars, _) -> modifyTVar' ars (IntMap.delete ix)
+          Nothing -> pure ()
+      re
+  handleNetwork srHandler $ Raw.sendRequest ostream ix rq
+  atomically $ putTMVar connection c
+
+
+-- | Handle network-related errors we know of.
+handleNetwork :: forall a m. (MonadUnliftIO m, MonadLoggerIO m, MonadCatch m)
+              => (forall e. (Exception e, Show e) => (e -> m a))
+              -- ^ Exception handler.
+              -> m a
+              -> m a
+handleNetwork handler action = action `catches`
+  [ Handler (\(e :: ReadTooShortException) -> handler e)
+  , Handler (\(e :: IOException) -> handler e)
+  , Handler (\(e :: SSL.ConnectionAbruptlyTerminated) -> handler e)
+  , Handler (\(e :: SSL.ProtocolError) -> handler e)
+  ]
diff --git a/src/DMCC/Session.hs-boot b/src/DMCC/Session.hs-boot
new file mode 100644
--- /dev/null
+++ b/src/DMCC/Session.hs-boot
@@ -0,0 +1,9 @@
+module DMCC.Session
+
+where
+
+import           DMCC.Prelude
+
+data Session
+
+instance Show Session
diff --git a/src/DMCC/Types.hs b/src/DMCC/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/DMCC/Types.hs
@@ -0,0 +1,148 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+{-| Shared type declarations. -}
+
+module DMCC.Types
+
+where
+
+import DMCC.Prelude
+
+import Data.Aeson as A
+import Data.Aeson.TH
+import Data.ByteString (ByteString)
+import Data.CaseInsensitive
+import Data.Data
+import Data.Text as T
+
+
+-- | Device ID used in DMCC requests.
+--
+-- This is based on text as stated in DMCC specification.
+newtype DeviceId =
+  DeviceId (CI Text)
+  deriving (Eq, Ord, Show)
+
+
+instance FromJSON DeviceId where
+  parseJSON v = DeviceId . mk <$> parseJSON v
+
+
+instance ToJSON DeviceId where
+  toJSON (DeviceId t) = toJSON $ original t
+
+
+newtype CallId =
+  CallId Text
+  deriving (Eq, Ord, Show, FromJSON, ToJSON)
+
+
+-- | Globally unique call ID.
+newtype UCID =
+  UCID Text
+  deriving (Eq, Ord, Show, FromJSON, ToJSON)
+
+
+newtype Extension =
+  Extension Text
+  deriving (Eq, Ord, Show,
+            Data, Typeable, ToJSON)
+
+
+instance FromJSON Extension where
+  parseJSON (A.String s)
+    | T.length s > 30 = fail "Maximum extension length is 30 digits"
+    | (\c -> c `elem` (['0'..'9'] <> ['*', '#'])) `T.all` s = pure $ Extension s
+    | otherwise = fail "Extension must contain the digits 0-9, * or #"
+  parseJSON _ = fail "Could not parse extension"
+
+
+newtype SwitchName =
+  SwitchName Text
+  deriving (Eq, Ord, Show, Data, Typeable, FromJSON, ToJSON)
+
+
+newtype AgentId =
+  AgentId (SwitchName, Extension)
+  deriving (Data, Typeable, Eq, Ord, Show, FromJSON, ToJSON)
+
+
+data CallDirection = In { vdn :: DeviceId }
+                   | Out
+                   deriving (Eq, Show)
+
+
+$(deriveJSON
+  defaultOptions{sumEncoding = defaultTaggedObject{tagFieldName="dir"}}
+  ''CallDirection)
+
+
+data Call = Call
+  { direction :: CallDirection
+  , ucid :: UCID
+  , start :: UTCTime
+  -- ^ When did call came into existence?
+  , interlocutors :: [DeviceId]
+  , answered :: Maybe UTCTime
+  -- ^ When did another party answer this call?
+  , held :: Bool
+  , failed :: Bool
+  }
+  deriving Show
+
+
+$(deriveJSON defaultOptions ''Call)
+
+
+data SettableAgentState = Ready
+                        | AfterCall
+                        | NotReady
+                        | Logout
+                        deriving (Eq, Show)
+
+
+$(deriveJSON defaultOptions ''SettableAgentState)
+
+
+data AgentState = Busy
+                | Settable SettableAgentState
+                deriving (Eq, Show)
+
+
+instance ToJSON AgentState where
+  toJSON Busy         = String "Busy"
+  toJSON (Settable s) = toJSON s
+
+
+instance FromJSON AgentState where
+  parseJSON (String "Busy") = pure Busy
+  parseJSON s@(String _)    = Settable <$> parseJSON s
+  parseJSON _               = fail "Could not parse AgentState"
+
+
+data ParticipationType = Active
+                       | Silent
+                       deriving (Eq, Show)
+
+
+$(deriveJSON defaultOptions ''ParticipationType)
+
+
+-- TODO This should be removed
+newtype LoggingOptions = LoggingOptions
+  { syslogIdent :: ByteString
+  }
+
+
+data SessionOptions = SessionOptions
+  { statePollingDelay :: Int
+  -- ^ How often to poll every agent for state changes (in seconds).
+  , sessionDuration :: Int
+  -- ^ Serves both as session duration and session cleanup delay (in
+  -- seconds).
+  , connectionRetryAttempts :: Int
+  , connectionRetryDelay :: Int
+  -- ^ In seconds.
+  }
diff --git a/src/DMCC/Util.hs b/src/DMCC/Util.hs
new file mode 100644
--- /dev/null
+++ b/src/DMCC/Util.hs
@@ -0,0 +1,11 @@
+module DMCC.Util where
+
+import           DMCC.Prelude
+
+import           Data.Text as T
+import           Control.Monad.Logger.CallStack as CS
+import           DMCC.Types
+
+maybeSyslog :: MonadLogger m => Maybe LoggingOptions -> String -> m ()
+maybeSyslog Nothing _ = pure ()
+maybeSyslog (Just LoggingOptions{..}) msg = CS.logInfo $ T.pack msg
diff --git a/src/DMCC/WebHook.hs b/src/DMCC/WebHook.hs
new file mode 100644
--- /dev/null
+++ b/src/DMCC/WebHook.hs
@@ -0,0 +1,16 @@
+{-|
+
+Types and instances for implementing webhook interface for DMCC.
+
+-}
+
+module DMCC.WebHook
+  ( WHEvent (..)
+  , AgentEvent (..)
+  , Event (..)
+  )
+
+where
+
+import           DMCC.Agent
+import           DMCC.XML.Response
diff --git a/src/DMCC/XML/Raw.hs b/src/DMCC/XML/Raw.hs
new file mode 100644
--- /dev/null
+++ b/src/DMCC/XML/Raw.hs
@@ -0,0 +1,82 @@
+{-|
+
+DMCC request/response packet processing.
+
+
+DMCC header format:
+
+@
+|  0  |  1  |  2  |  3  |  4  |  5  |  6  |  7  |  8  | ...        |
+|  Version  |   Length  |       InvokeID        | XML Message Body |
+@
+
+-}
+
+module DMCC.XML.Raw where
+
+import           DMCC.Prelude
+
+import           Data.Binary.Get
+import           Data.Binary.Put
+import qualified Data.ByteString.Char8 as S
+import qualified Data.ByteString.Lazy  as L
+import qualified Data.ByteString.Lazy.Char8  as L8
+
+import           System.IO.Streams (InputStream, OutputStream)
+import qualified System.IO.Streams as Streams
+
+import           Text.Printf
+
+import           DMCC.XML.Request
+import           DMCC.XML.Response
+
+
+-- FIXME: error
+sendRequest :: MonadLoggerIO m
+            => OutputStream S.ByteString
+            -> Int
+            -> Request
+            -> m ()
+sendRequest h ix rq = do
+  logDebugN
+    $ "Sending request (invokeId=" <> tshow ix <> ") "
+    <> tshow (L8.unpack rawRequest)
+
+  liftIO $ flip Streams.writeLazyByteString h $ runPut $ do
+    putWord16be 0
+    putWord16be . fromIntegral $ 8 + L.length rawRequest
+    let invokeId = S.pack . take 4 $ printf "%04d" ix
+    putByteString invokeId
+    putLazyByteString rawRequest
+
+  where rawRequest = toXml rq
+
+
+-- | Read a CSTA message from an input stream. Throws
+-- 'ReadTooShortException'.
+readResponse :: MonadLoggerIO m
+             => InputStream S.ByteString
+             -> m (Response, Int)
+readResponse h = do
+  -- xml-conduit parser requires a lazy ByteString
+  let readLazy i = do
+        v <- Streams.readExactly i h
+        pure $ L.fromChunks [v]
+
+  (len, invokeId) <- liftIO $ runGet readHeader <$> readLazy 8
+  resp <- liftIO $ readLazy $ len - 8
+
+  logDebugN
+    $ "Received response (invokeId=" <> tshow invokeId <> ") "
+    <> tshow (L8.unpack resp)
+
+  pure (fromXml resp, invokeId)
+
+  where
+    readHeader = do
+      skip 2 -- version
+      len <- fromIntegral <$> getWord16be
+      ix  <- getByteString 4
+      case S.readInt ix of
+        Just (invokeId, "") -> pure (len, invokeId)
+        _ -> fail $ "Invalid InvokeID: " <> show ix
diff --git a/src/DMCC/XML/Request.hs b/src/DMCC/XML/Request.hs
new file mode 100644
--- /dev/null
+++ b/src/DMCC/XML/Request.hs
@@ -0,0 +1,425 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+{-| Low-level XML API requests. -}
+
+module DMCC.XML.Request
+
+where
+
+import           DMCC.Prelude
+
+import qualified Data.ByteString.Lazy as L
+import           Data.CaseInsensitive
+import qualified Data.Map as Map
+import           Data.Text (Text)
+import qualified Data.Text as T
+
+import           Text.Hamlet.XML
+import           Text.XML
+
+import           DMCC.Types
+
+
+data Request
+  = StartApplicationSession
+    { applicationId :: Text
+    , requestedProtocolVersion :: ProtocolVersion
+    , userName :: Text
+    , password :: Text
+    , sessionCleanupDelay :: Int
+    , sessionID :: Text
+    , requestedSessionDuration :: Int
+    }
+  | StopApplicationSession
+    { sessionID :: Text
+    }
+  | ResetApplicationSessionTimer
+    { sessionId :: Text
+    , requestedSessionDuration :: Int
+    }
+  | GetDeviceId
+    { switchName :: SwitchName
+    , extension :: Extension
+    }
+  | GetThirdPartyDeviceId
+    { switchName :: SwitchName
+    , extension :: Extension
+    }
+  | MakeCall
+    { callingDevice :: DeviceId
+    , calledDirectoryNumber :: DeviceId
+    , acceptedProtocol :: Text
+    }
+  | AnswerCall
+    { deviceId :: DeviceId
+    , callId :: CallId
+    , acceptedProtocol :: Text
+    }
+  | HoldCall
+    { deviceId :: DeviceId
+    , callId :: CallId
+    , acceptedProtocol :: Text
+    }
+  | RetrieveCall
+    { deviceId :: DeviceId
+    , callId :: CallId
+    , acceptedProtocol :: Text
+    }
+  | GenerateDigits
+    { charactersToSend :: Text
+    , deviceId :: DeviceId
+    , callId :: CallId
+    , acceptedProtocol :: Text
+    }
+  | ConferenceCall
+    { deviceId :: DeviceId
+    , activeCall :: CallId
+    , heldCall :: CallId
+    , acceptedProtocol :: Text
+    }
+  | SingleStepConferenceCall
+    { deviceId :: DeviceId
+    , activeCall :: CallId
+    , acceptedProtocol :: Text
+    , participationType :: ParticipationType
+    }
+  | TransferCall
+    { deviceId :: DeviceId
+    , activeCall :: CallId
+    , heldCall :: CallId
+    , acceptedProtocol :: Text
+    }
+  | ClearConnection
+    { deviceId :: DeviceId
+    , callId :: CallId
+    , acceptedProtocol :: Text
+    }
+  | ReleaseDeviceId
+    { device :: DeviceId
+    }
+  | MonitorStart
+    { acceptedProtocol :: Text
+    , monitorRq :: MonitorRequest
+    }
+  | MonitorStop
+    { acceptedProtocol :: Text
+    , monitorCrossRefID :: Text
+    }
+  | TransferMonitorObjects
+    { fromSessionID :: Text
+    , toSessionID :: Text
+    , acceptedProtocol :: Text
+    }
+  | GetAgentState
+    { device :: DeviceId
+    , acceptedProtocol :: Text
+    }
+  | SetAgentState
+    { device :: DeviceId
+    , requestedAgentState :: SettableAgentState
+    , acceptedProtocol :: Text
+    }
+  | GetCallLinkageData
+    { deviceId :: DeviceId
+    , callId :: CallId
+    , acceptedProtocol :: Text
+    }
+  deriving Show
+
+
+data MonitorRequest = Device {deviceObject :: DeviceId}
+                    | Session
+                    deriving Show
+
+
+data ProtocolVersion = DMCC_6_1 | DMCC_6_2 | DMCC_6_3
+                       deriving Show
+
+
+getProtocolString :: ProtocolVersion -> Text
+getProtocolString ver
+  = case ver of
+    DMCC_6_1 -> "http://www.ecma-international.org/standards/ecma-323/csta/ed3/priv5"
+    DMCC_6_2 -> "http://www.ecma-international.org/standards/ecma-323/csta/ed3/priv6"
+    DMCC_6_3 -> "http://www.ecma-international.org/standards/ecma-323/csta/ed3/priv7"
+
+
+nsAppSession :: Text
+nsAppSession = "http://www.ecma-international.org/standards/ecma-354/appl_session"
+
+
+nsXSI :: Text
+nsXSI = "http://www.w3.org/2001/XMLSchema-instance"
+
+
+nsACX :: Text
+nsACX = "http://www.avaya.com/csta"
+
+
+doc :: Name -> Text -> [Node] -> Document
+doc name xmlns nodes = Document
+  (Prologue [] Nothing [])
+  (Element
+    name
+    (Map.fromList
+      [ ("xmlns", xmlns)
+      , ("xmlns:xsi", nsXSI)
+      , ("xmlns:acx", nsACX)
+      ])
+    nodes)
+  []
+
+
+class ToText a where
+  toText :: a -> Text
+
+
+instance ToText (CI Text) where
+  toText t = toText $ original t
+
+
+instance ToText Text where
+  toText t = t
+
+
+instance ToText Extension where
+  toText (Extension e) = e
+
+
+instance ToText SettableAgentState where
+  toText Ready     = "ready"
+  toText AfterCall = "workingAfterCall"
+  toText NotReady  = "notReady"
+  toText Logout    = "loggedOff"
+
+
+deriving instance ToText DeviceId
+
+
+deriving instance ToText SwitchName
+
+
+deriving instance ToText CallId
+
+
+instance ToText ParticipationType where
+  toText Active = "active"
+  toText Silent = "silent"
+
+
+toXml :: Request -> L.ByteString
+toXml rq = renderLBS def $ case rq of
+  StartApplicationSession{..} ->
+    doc "StartApplicationSession" nsAppSession
+    [xml|
+      <applicationInfo>
+        <applicationID>#{applicationId}
+        <applicationSpecificInfo>
+          <acx:SessionLoginInfo xsi:type="acx:SessionLoginInfo">
+            <acx:userName>#{userName}
+            <acx:password>#{password}
+            <acx:sessionCleanupDelay>#{T.pack $ show sessionCleanupDelay}
+            <acx:sessionID>#{sessionID}
+      <requestedProtocolVersions>
+        <protocolVersion>#{getProtocolString requestedProtocolVersion}
+      <requestedSessionDuration>#{T.pack $ show requestedSessionDuration}
+    |]
+
+  StopApplicationSession{..} ->
+    doc "StopApplicationSession" nsAppSession
+    [xml|
+      <sessionID>#{sessionID}
+      <sessionEndReason>
+        <definedEndReason>normal
+    |]
+
+  ResetApplicationSessionTimer{..} ->
+    doc "ResetApplicationSessionTimer" nsAppSession
+    [xml|
+      <sessionID>#{sessionId}
+      <requestedSessionDuration>#{T.pack $ show requestedSessionDuration}
+    |]
+
+  GetDeviceId{..} ->
+    doc "GetDeviceId" nsACX
+    [xml|
+      <switchName>#{toText switchName}
+      <extension>#{toText extension}
+      <controllableByOtherSessions>true
+    |]
+
+  GetThirdPartyDeviceId{..} ->
+    doc "GetThirdPartyDeviceId" nsACX
+    [xml|
+      <switchName>#{toText switchName}
+      <extension>#{toText extension}
+    |]
+
+  MakeCall{..} ->
+    doc "MakeCall" acceptedProtocol
+    [xml|
+      <callingDevice>#{toText callingDevice}
+      <calledDirectoryNumber>#{toText calledDirectoryNumber}
+    |]
+
+  AnswerCall{..} ->
+    doc "AnswerCall" acceptedProtocol
+    [xml|
+      <callToBeAnswered>
+        <deviceID typeOfNumber="other" mediaClass="notKnown">#{toText deviceId}
+        <callID>#{toText callId}
+    |]
+
+  HoldCall{..} ->
+    doc "HoldCall" acceptedProtocol
+    [xml|
+      <callToBeHeld>
+        <deviceID typeOfNumber="other" mediaClass="notKnown">#{toText deviceId}
+        <callID>#{toText callId}
+    |]
+
+  RetrieveCall{..} ->
+    doc "RetrieveCall" acceptedProtocol
+    [xml|
+      <callToBeRetrieved>
+        <deviceID typeOfNumber="other" mediaClass="notKnown">#{toText deviceId}
+        <callID>#{toText callId}
+    |]
+
+  GenerateDigits{..} ->
+    doc "GenerateDigits" acceptedProtocol
+    [xml|
+      <connectionToSendDigits>
+        <deviceID typeOfNumber="other" mediaClass="notKnown">#{toText deviceId}
+        <callID>#{toText callId}
+      <charactersToSend>#{charactersToSend}
+    |]
+
+  ConferenceCall{..} ->
+    doc "ConferenceCall" acceptedProtocol
+    [xml|
+      <heldCall>
+        <deviceID typeOfNumber="other" mediaClass="notKnown">#{toText deviceId}
+        <callID>#{toText heldCall}
+      <activeCall>
+        <deviceID typeOfNumber="other" mediaClass="notKnown">#{toText deviceId}
+        <callID>#{toText activeCall}
+    |]
+
+  SingleStepConferenceCall{..} ->
+    doc "SingleStepConferenceCall" acceptedProtocol
+    [xml|
+      <deviceToJoin>#{toText deviceId}
+      <activeCall>
+        <deviceID typeOfNumber="other" mediaClass="notKnown">#{toText deviceId}
+        <callID>#{toText activeCall}
+      <participationType>#{toText participationType}
+    |]
+
+  TransferCall{..} ->
+    doc "TransferCall" acceptedProtocol
+    [xml|
+      <heldCall>
+        <deviceID typeOfNumber="other" mediaClass="notKnown">#{toText deviceId}
+        <callID>#{toText heldCall}
+      <activeCall>
+        <deviceID typeOfNumber="other" mediaClass="notKnown">#{toText deviceId}
+        <callID>#{toText activeCall}
+    |]
+
+  ClearConnection{..} ->
+    doc "ClearConnection" acceptedProtocol
+    [xml|
+      <connectionToBeCleared>
+        <deviceID typeOfNumber="other" mediaClass="notKnown">#{toText deviceId}
+        <callID>#{toText callId}
+    |]
+
+  ReleaseDeviceId{..} ->
+    doc "ReleaseDeviceId" nsACX
+    [xml|
+      <device>#{toText device}
+    |]
+
+  MonitorStart{..} ->
+    case monitorRq of
+      Device{..} ->
+        doc "MonitorStart" acceptedProtocol
+        [xml|
+          <monitorObject>
+            <deviceObject typeOfNumber="other" mediaClass="notKnown">
+              #{toText deviceObject}
+          <requestedMonitorFilter>
+            <callcontrol>
+              <connectionCleared>true
+              <conferenced>true
+              <delivered>true
+              <diverted>true
+              <established>true
+              <failed>true
+              <held>true
+              <originated>true
+              <retrieved>true
+              <transferred>true
+            <logicalDeviceFeature>
+              <agentReady>true
+              <agentWorkingAfterCall>false
+              <agentNotReady>true
+          <extensions>
+            <privateData>
+              <private>
+                <AvayaEvents>
+                  <invertFilter>true
+        |]
+      Session ->
+        doc "MonitorStart" acceptedProtocol
+        [xml|
+          <monitorObject>
+            <deviceObject mediaClass="notKnown">
+          <extensions>
+            <privateData>
+              <private>
+                <AvayaEvents>
+                  <invertFilter>true
+                  <deviceServices>
+                    <getDeviceIdList>true
+                    <getMonitorList>true
+                    <transferMonitorObjects>true
+        |]
+
+  MonitorStop{..} ->
+    doc "MonitorStop" acceptedProtocol
+    [xml|
+      <monitorCrossRefID>#{monitorCrossRefID}
+    |]
+
+  TransferMonitorObjects{..} ->
+    doc "TransferMonitorObjects" acceptedProtocol
+    [xml|
+      <fromSessionID>#{fromSessionID}
+      <toSessionID>#{toSessionID}
+    |]
+
+  GetAgentState{..} ->
+    doc "GetAgentState" acceptedProtocol
+    [xml|
+      <device>#{toText device}
+    |]
+
+  SetAgentState{..} ->
+    doc "SetAgentState" acceptedProtocol
+    [xml|
+      <device>#{toText device}
+      <requestedAgentState>#{toText requestedAgentState}
+    |]
+
+  GetCallLinkageData{..} ->
+    doc "GetCallLinkageData" acceptedProtocol
+    [xml|
+      <call>
+        <deviceID typeOfNumber="other" mediaClass="notKnown">#{toText deviceId}
+        <callID>#{toText callId}
+    |]
diff --git a/src/DMCC/XML/Response.hs b/src/DMCC/XML/Response.hs
new file mode 100644
--- /dev/null
+++ b/src/DMCC/XML/Response.hs
@@ -0,0 +1,320 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+{-| Incoming XML messages (responses and events). -}
+
+module DMCC.XML.Response
+    ( Response (..)
+    , Event (..)
+    , fromXml
+    )
+
+where
+
+import           DMCC.Prelude
+
+import           Control.Exception (SomeException)
+import           Data.CaseInsensitive (mk)
+import           Data.List (foldl1')
+import           Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Read as T
+
+import           Data.Aeson.TH
+
+import           Text.XML
+import           Text.XML.Cursor
+
+import           DMCC.Types
+
+
+-- | DMCC response to a request.
+data Response
+  = UnknownResponse LByteString
+  | MalformedResponse LByteString SomeException
+  | StartApplicationSessionPosResponse
+    { sessionID :: Text
+    , actualProtocolVersion :: Text
+    , actualSessionDuration :: Int
+    }
+  | StartApplicationSessionNegResponse
+  | GetDeviceIdResponse
+    { device :: DeviceId
+    }
+  | GetThirdPartyDeviceIdResponse
+    { device :: DeviceId
+    }
+  | MonitorStartResponse
+    { monitorCrossRefID :: Text
+    }
+  | MakeCallResponse
+    { newCallId :: CallId
+    , newUcid :: UCID
+    }
+  | SingleStepConferenceCallResponse
+    { conferencedCall :: CallId
+    }
+  | GetAgentStateResponse
+    { agentState :: Maybe AgentState
+      -- ^ Nothing if an unknown state is reported.
+    , reasonCode :: Text
+    }
+  | GetCallLinkageDataResponse
+    { linkageUcid :: UCID
+    }
+  | EventResponse
+    { monitorCrossRefID :: Text
+    , event :: Event
+    }
+  -- | Pretty-printed <CSTAErrorCode> message.
+  | CSTAErrorCodeResponse
+    { errorText :: Text
+    }
+  deriving Show
+
+
+-- | DMCC event.
+data Event =
+  UnknownEvent
+  -- | Precedes every established/cleared event.
+  | DeliveredEvent
+    { callId :: CallId
+    , distributingVdn :: DeviceId
+    , ucid :: UCID
+    , callingDevice :: DeviceId
+    , calledDevice :: DeviceId
+    }
+  | DivertedEvent
+    { callId :: CallId
+    }
+  | OriginatedEvent
+    { callId :: CallId
+    , callingDevice :: DeviceId
+    , calledDevice :: DeviceId
+    }
+  | EstablishedEvent
+    { callId :: CallId
+    }
+  | FailedEvent
+    { callId :: CallId
+    }
+  | ConnectionClearedEvent
+    { callId :: CallId
+    , releasingDevice :: DeviceId
+    }
+  | HeldEvent
+    { callId :: CallId
+    }
+  | RetrievedEvent
+    { callId :: CallId
+    }
+  | ConferencedEvent
+    { primaryOldCall :: CallId
+    , secondaryOldCall :: CallId
+    }
+  | TransferedEvent
+    { primaryOldCall :: CallId
+    , secondaryOldCall :: CallId
+    }
+  deriving Show
+
+$(deriveJSON
+  defaultOptions{sumEncoding = defaultTaggedObject{tagFieldName="event"}}
+  ''Event)
+
+fromXml :: LByteString -> Response
+fromXml xml
+  = case parseLBS def xml of
+    Left err -> MalformedResponse xml err
+    Right doc -> let cur = fromDocument doc
+                     evResp = EventResponse (text cur "monitorCrossRefID")
+      in case nameLocalName $ elementName $ documentRoot doc of
+        "StartApplicationSessionPosResponse" ->
+          StartApplicationSessionPosResponse
+          { sessionID = text cur "sessionID"
+          , actualProtocolVersion = text cur "actualProtocolVersion"
+          , actualSessionDuration = decimal cur "actualSessionDuration"
+          }
+
+        "StartApplicationSessionNegResponse" ->
+          StartApplicationSessionNegResponse
+
+        "GetDeviceIdResponse" ->
+          GetDeviceIdResponse
+          { device = DeviceId $ mk $ text cur "device"
+          }
+
+        "GetThirdPartyDeviceIdResponse" ->
+          GetThirdPartyDeviceIdResponse
+          { device = DeviceId $ mk $ text cur "device"
+          }
+
+        "MonitorStartResponse" ->
+          MonitorStartResponse
+          {monitorCrossRefID = text cur "monitorCrossRefID"
+          }
+
+        "MakeCallResponse" ->
+          MakeCallResponse
+          { newCallId = CallId $ textFromPath cur "callingDevice" ["callId"]
+          , newUcid =
+            UCID $ text cur "globallyUniqueCallLinkageID"
+          }
+
+        "SingleStepConferenceCallResponse" ->
+          SingleStepConferenceCallResponse
+          { conferencedCall =
+            CallId $ textFromPath cur "conferencedCall" ["callId"]
+          }
+
+        "GetAgentStateResponse" ->
+          GetAgentStateResponse
+          { agentState =
+            let
+                raw = textFromPath cur "agentStateList"
+                      [ "agentStateEntry"
+                      , "agentInfo"
+                      , "agentInfoItem"
+                      , "agentState"
+                      ]
+                state | raw == "agentReady" =
+                          Just $ Settable Ready
+                      | raw == "agentWorkingAfterCall" =
+                          Just $ Settable AfterCall
+                      | raw == "agentNotReady" =
+                          Just $ Settable NotReady
+                      | raw == "agentBusy" =
+                          Just Busy
+                      | otherwise = Nothing
+            in
+              state
+          , reasonCode = textFromPath cur "extensions"
+                         [ "privateData"
+                         , "private"
+                         , "GetAgentStateResponsePrivateData"
+                         , "reasonCode"
+                         ]
+          }
+
+        "GetCallLinkageDataResponse" ->
+          GetCallLinkageDataResponse
+          { linkageUcid = UCID $ text cur "globallyUniqueCallLinkageID"
+          }
+
+        "DeliveredEvent" -> evResp
+          DeliveredEvent
+          { callId =
+            CallId $ textFromPath cur "connection" ["callId"]
+          , distributingVdn =
+            DeviceId $ mk $
+            textFromPath cur "distributingVDN" ["deviceIdentifier"]
+          , ucid =
+            UCID $ text cur "globallyUniqueCallLinkageID"
+          , callingDevice =
+            DeviceId $ mk $ textFromPath cur "callingDevice" ["deviceIdentifier"]
+          , calledDevice =
+            DeviceId $ mk $ textFromPath cur "calledDevice" ["deviceIdentifier"]
+          }
+
+        "OriginatedEvent" -> evResp
+          OriginatedEvent
+          { callId =
+            CallId $ textFromPath cur "originatedConnection" ["callId"]
+          , callingDevice =
+            DeviceId $ mk $ textFromPath cur "callingDevice" ["deviceIdentifier"]
+          , calledDevice =
+            DeviceId $ mk $ textFromPath cur "calledDevice" ["deviceIdentifier"]
+          }
+
+        "DivertedEvent" -> evResp
+          DivertedEvent
+          { callId =
+            CallId $ textFromPath cur "connection" ["callID"]
+          }
+
+        "EstablishedEvent" -> evResp
+          EstablishedEvent
+          { callId =
+            CallId $ textFromPath cur "establishedConnection" ["callId"]
+          }
+
+        "FailedEvent" -> evResp
+          FailedEvent
+          { callId =
+            CallId $ textFromPath cur "failedConnection" ["callId"]
+          }
+
+        "HeldEvent" -> evResp
+          HeldEvent
+          { callId =
+            CallId $ textFromPath cur "heldConnection" ["callId"]
+          }
+
+        "RetrievedEvent" -> evResp
+          RetrievedEvent
+          { callId =
+            CallId $ textFromPath cur "retrievedConnection" ["callId"]
+          }
+
+        "ConferencedEvent" -> evResp
+          ConferencedEvent
+          { primaryOldCall =
+            CallId $ textFromPath cur "primaryOldCall" ["callId"]
+          , secondaryOldCall =
+            CallId $ textFromPath cur "secondaryOldCall" ["callId"]
+          }
+
+        "TransferedEvent" -> evResp
+          TransferedEvent
+          { primaryOldCall =
+            CallId $ textFromPath cur "primaryOldCall" ["callId"]
+          , secondaryOldCall =
+            CallId $ textFromPath cur "secondaryOldCall" ["callId"]
+          }
+
+        "ConnectionClearedEvent" -> evResp
+          ConnectionClearedEvent
+          { callId =
+            CallId $ textFromPath cur "droppedConnection" ["callId"]
+          , releasingDevice =
+            DeviceId $ mk $
+            textFromPath cur "releasingDevice" ["deviceIdentifier"]
+          }
+
+        "CSTAErrorCode" ->
+          CSTAErrorCodeResponse
+          { errorText =
+            let
+              msg = T.concat $ cur $// content
+              err = case map node (cur $/ checkElement (const True)) of
+                      (NodeElement el:_) ->
+                        nameLocalName $ elementName el
+                      _ -> "CSTAErrorCode"
+            in
+              T.concat [err, "/", msg]
+          }
+
+        _ -> UnknownResponse xml
+
+
+text :: Cursor -> Text -> Text
+text c n = textFromPath c n []
+
+
+decimal :: Cursor -> Text -> Int
+decimal c n =
+  case T.decimal txt of
+    Right (x, "") -> x
+    _ -> error $ "Can't parse as decimal: " <> show txt
+  where
+    txt = text c n :: Text
+
+
+-- | Extract contents of the first element which matches provided
+-- path (@rootName:extraNames@). Return empty text if no element
+-- matches the path.
+textFromPath :: Cursor -> Text -> [Text] -> Text
+textFromPath cur rootName extraNames =
+  fromMaybe "" $ headMay contents
+  where
+    contents =
+      cur $// foldl1' (&/) (map laxElement $ rootName : extraNames) &/ content
