{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE NamedFieldPuns #-}
-- | This module is intended to be imported qualified
--
-- @
-- import qualified Ldap.Client as Ldap
-- @
module Ldap.Client
  ( with
  , Host(..)
  , defaultTlsSettings
  , insecureTlsSettings
  , PortNumber
  , Ldap
  , LdapError(..)
  , ResponseError(..)
  , Type.ResultCode(..)
    -- * Bind
  , Password(..)
  , bind
  , externalBind
    -- * Search
  , search
  , SearchEntry(..)
    -- ** Search modifiers
  , Search
  , Mod
  , Type.Scope(..)
  , scope
  , size
  , time
  , typesOnly
  , Type.DerefAliases(..)
  , derefAliases
  , Filter(..)
    -- * Modify
  , modify
  , Operation(..)
    -- * Add
  , add
    -- * Delete
  , delete
    -- * ModifyDn
  , RelativeDn(..)
  , modifyDn
    -- * Compare
  , compare
    -- * Extended
  , Oid(..)
  , extended
    -- * Miscellanous
  , Dn(..)
  , Attr(..)
  , AttrValue
  , AttrList
    -- * Re-exports
  , NonEmpty
  ) where

import qualified Control.Concurrent.Async as Async
import           Control.Concurrent.STM (atomically, throwSTM)
import           Control.Concurrent.STM.TMVar (putTMVar)
import           Control.Concurrent.STM.TQueue (TQueue, newTQueueIO, writeTQueue, readTQueue)
import           Control.Exception (Exception, Handler(..), bracket, throwIO, catch, catches)
import           Control.Monad (forever)
import qualified Data.ASN1.BinaryEncoding as Asn1
import qualified Data.ASN1.Encoding as Asn1
import qualified Data.ASN1.Error as Asn1
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Lazy as ByteString.Lazy
import           Data.Foldable (asum)
import           Data.Function (fix)
import           Data.List.NonEmpty (NonEmpty((:|)))
import qualified Data.Map.Strict as Map
import           Data.Monoid (Endo(appEndo))
import           Data.Text (Text)
import           Data.Typeable (Typeable)
import           Network.Connection (Connection)
import qualified Network.Connection as Conn
import           Prelude hiding (compare)
import qualified System.IO.Error as IO

import           Ldap.Asn1.ToAsn1 (ToAsn1(toAsn1))
import           Ldap.Asn1.FromAsn1 (FromAsn1, parseAsn1)
import qualified Ldap.Asn1.Type as Type
import           Ldap.Client.Internal
import           Ldap.Client.Bind (Password(..), bind, externalBind)
import           Ldap.Client.Search
  ( search
  , Search
  , Mod
  , scope
  , size
  , time
  , typesOnly
  , derefAliases
  , Filter(..)
  , SearchEntry(..)
  )
import           Ldap.Client.Modify (Operation(..), modify, RelativeDn(..), modifyDn)
import           Ldap.Client.Add (add)
import           Ldap.Client.Delete (delete)
import           Ldap.Client.Compare (compare)
import           Ldap.Client.Extended (Oid(..), extended, noticeOfDisconnectionOid)

{-# ANN module ("HLint: ignore Use first" :: String) #-}


newLdap :: IO Ldap
newLdap :: IO Ldap
newLdap = TQueue ClientMessage -> Ldap
Ldap
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IO (TQueue a)
newTQueueIO

-- | Various failures that can happen when working with LDAP.
data LdapError =
    IOError !IOError             -- ^ Network failure.
  | ParseError !Asn1.ASN1Error   -- ^ Invalid ASN.1 data received from the server.
  | ResponseError !ResponseError -- ^ An LDAP operation failed.
  | DisconnectError !Disconnect  -- ^ Notice of Disconnection has been received.
    deriving (Int -> LdapError -> ShowS
[LdapError] -> ShowS
LdapError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LdapError] -> ShowS
$cshowList :: [LdapError] -> ShowS
show :: LdapError -> String
$cshow :: LdapError -> String
showsPrec :: Int -> LdapError -> ShowS
$cshowsPrec :: Int -> LdapError -> ShowS
Show, LdapError -> LdapError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LdapError -> LdapError -> Bool
$c/= :: LdapError -> LdapError -> Bool
== :: LdapError -> LdapError -> Bool
$c== :: LdapError -> LdapError -> Bool
Eq)

newtype WrappedIOError = WrappedIOError IOError
    deriving (Int -> WrappedIOError -> ShowS
[WrappedIOError] -> ShowS
WrappedIOError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WrappedIOError] -> ShowS
$cshowList :: [WrappedIOError] -> ShowS
show :: WrappedIOError -> String
$cshow :: WrappedIOError -> String
showsPrec :: Int -> WrappedIOError -> ShowS
$cshowsPrec :: Int -> WrappedIOError -> ShowS
Show, WrappedIOError -> WrappedIOError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WrappedIOError -> WrappedIOError -> Bool
$c/= :: WrappedIOError -> WrappedIOError -> Bool
== :: WrappedIOError -> WrappedIOError -> Bool
$c== :: WrappedIOError -> WrappedIOError -> Bool
Eq, Typeable)

instance Exception WrappedIOError

data Disconnect = Disconnect !Type.ResultCode !Dn !Text
    deriving (Int -> Disconnect -> ShowS
[Disconnect] -> ShowS
Disconnect -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Disconnect] -> ShowS
$cshowList :: [Disconnect] -> ShowS
show :: Disconnect -> String
$cshow :: Disconnect -> String
showsPrec :: Int -> Disconnect -> ShowS
$cshowsPrec :: Int -> Disconnect -> ShowS
Show, Disconnect -> Disconnect -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Disconnect -> Disconnect -> Bool
$c/= :: Disconnect -> Disconnect -> Bool
== :: Disconnect -> Disconnect -> Bool
$c== :: Disconnect -> Disconnect -> Bool
Eq, Typeable)

instance Exception Disconnect

-- | The entrypoint into LDAP.
--
-- It catches all LDAP-related exceptions.
with :: Host -> PortNumber -> (Ldap -> IO a) -> IO (Either LdapError a)
with :: forall a.
Host -> PortNumber -> (Ldap -> IO a) -> IO (Either LdapError a)
with Host
host PortNumber
port Ldap -> IO a
f = do
  ConnectionContext
context <- IO ConnectionContext
Conn.initConnectionContext
  forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (ConnectionContext -> ConnectionParams -> IO Connection
Conn.connectTo ConnectionContext
context ConnectionParams
params) Connection -> IO ()
Conn.connectionClose (\Connection
conn ->
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO Ldap
newLdap Ldap -> IO ()
unbindAsync (\Ldap
l -> do
      TQueue (LdapMessage ProtocolServerOp)
inq  <- forall a. IO (TQueue a)
newTQueueIO
      TQueue (LdapMessage Request)
outq <- forall a. IO (TQueue a)
newTQueueIO
      [Async a]
as   <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. IO a -> IO (Async a)
Async.async
        [ forall a b. FromAsn1 a => TQueue a -> Connection -> IO b
input TQueue (LdapMessage ProtocolServerOp)
inq Connection
conn
        , forall a b. ToAsn1 a => TQueue a -> Connection -> IO b
output TQueue (LdapMessage Request)
outq Connection
conn
        , forall a.
Ldap
-> TQueue (LdapMessage ProtocolServerOp)
-> TQueue (LdapMessage Request)
-> IO a
dispatch Ldap
l TQueue (LdapMessage ProtocolServerOp)
inq TQueue (LdapMessage Request)
outq
        , Ldap -> IO a
f Ldap
l
        ]
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall a. [Async a] -> IO (Async a, a)
Async.waitAnyCancel [Async a]
as)))
 forall a. IO a -> [Handler a] -> IO a
`catches`
  [ forall a e. Exception e => (e -> IO a) -> Handler a
Handler (\(WrappedIOError IOError
e) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (IOError -> LdapError
IOError IOError
e)))
  , forall a e. Exception e => (e -> IO a) -> Handler a
Handler (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Error -> LdapError
ParseError)
  , forall a e. Exception e => (e -> IO a) -> Handler a
Handler (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResponseError -> LdapError
ResponseError)
  ]
 where
  params :: ConnectionParams
params = Conn.ConnectionParams
    { connectionHostname :: String
Conn.connectionHostname =
        case Host
host of
          Plain String
h -> String
h
          Tls   String
h TLSSettings
_ -> String
h
    , connectionPort :: PortNumber
Conn.connectionPort = PortNumber
port
    , connectionUseSecure :: Maybe TLSSettings
Conn.connectionUseSecure =
        case Host
host of
          Plain  String
_ -> forall a. Maybe a
Nothing
          Tls String
_ TLSSettings
settings -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TLSSettings
settings
    , connectionUseSocks :: Maybe ProxySettings
Conn.connectionUseSocks = forall a. Maybe a
Nothing
    }

defaultTlsSettings :: Conn.TLSSettings
defaultTlsSettings :: TLSSettings
defaultTlsSettings = Conn.TLSSettingsSimple
  { settingDisableCertificateValidation :: Bool
Conn.settingDisableCertificateValidation = Bool
False
  , settingDisableSession :: Bool
Conn.settingDisableSession = Bool
False
  , settingUseServerName :: Bool
Conn.settingUseServerName = Bool
False
  }

insecureTlsSettings :: Conn.TLSSettings
insecureTlsSettings :: TLSSettings
insecureTlsSettings = Conn.TLSSettingsSimple
  { settingDisableCertificateValidation :: Bool
Conn.settingDisableCertificateValidation = Bool
True
  , settingDisableSession :: Bool
Conn.settingDisableSession = Bool
False
  , settingUseServerName :: Bool
Conn.settingUseServerName = Bool
False
  }

input :: FromAsn1 a => TQueue a -> Connection -> IO b
input :: forall a b. FromAsn1 a => TQueue a -> Connection -> IO b
input TQueue a
inq Connection
conn = forall a. IO a -> IO a
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (a -> a) -> a
fix [] forall a b. (a -> b) -> a -> b
$ \[ByteString] -> IO b
loop [ByteString]
chunks -> do
  ByteString
chunk <- Connection -> Int -> IO ByteString
Conn.connectionGet Connection
conn Int
8192
  case ByteString -> Int
ByteString.length ByteString
chunk of
    Int
0 -> forall e a. Exception e => e -> IO a
throwIO (IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
IO.mkIOError IOErrorType
IO.eofErrorType String
"Ldap.Client.input" forall a. Maybe a
Nothing forall a. Maybe a
Nothing)
    Int
_ -> do
      let chunks' :: [ByteString]
chunks' = ByteString
chunk forall a. a -> [a] -> [a]
: [ByteString]
chunks
      case forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
Asn1.decodeASN1 BER
Asn1.BER ([ByteString] -> ByteString
ByteString.Lazy.fromChunks (forall a. [a] -> [a]
reverse [ByteString]
chunks')) of
        Left  ASN1Error
Asn1.ParsingPartial
                   -> [ByteString] -> IO b
loop [ByteString]
chunks'
        Left  ASN1Error
e    -> forall e a. Exception e => e -> IO a
throwIO ASN1Error
e
        Right [ASN1]
asn1 -> do
          forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (a -> a) -> a
fix [ASN1]
asn1 forall a b. (a -> b) -> a -> b
$ \[ASN1] -> IO ()
loop' [ASN1]
asn1' ->
            case forall a. FromAsn1 a => [ASN1] -> Maybe ([ASN1], a)
parseAsn1 [ASN1]
asn1' of
              Maybe ([ASN1], a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
              Just ([ASN1]
asn1'', a
a) -> do
                forall a. STM a -> IO a
atomically (forall a. TQueue a -> a -> STM ()
writeTQueue TQueue a
inq a
a)
                [ASN1] -> IO ()
loop' [ASN1]
asn1''
          [ByteString] -> IO b
loop []

output :: ToAsn1 a => TQueue a -> Connection -> IO b
output :: forall a b. ToAsn1 a => TQueue a -> Connection -> IO b
output TQueue a
out Connection
conn = forall a. IO a -> IO a
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
  a
msg <- forall a. STM a -> IO a
atomically (forall a. TQueue a -> STM a
readTQueue TQueue a
out)
  Connection -> ByteString -> IO ()
Conn.connectionPut Connection
conn (Endo [ASN1] -> ByteString
encode (forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 a
msg))
 where
  encode :: Endo [ASN1] -> ByteString
encode Endo [ASN1]
x = forall a. ASN1Encoding a => a -> [ASN1] -> ByteString
Asn1.encodeASN1' DER
Asn1.DER (forall a. Endo a -> a -> a
appEndo Endo [ASN1]
x [])

dispatch
  :: Ldap
  -> TQueue (Type.LdapMessage Type.ProtocolServerOp)
  -> TQueue (Type.LdapMessage Request)
  -> IO a
dispatch :: forall a.
Ldap
-> TQueue (LdapMessage ProtocolServerOp)
-> TQueue (LdapMessage Request)
-> IO a
dispatch Ldap { TQueue ClientMessage
client :: Ldap -> TQueue ClientMessage
client :: TQueue ClientMessage
client } TQueue (LdapMessage ProtocolServerOp)
inq TQueue (LdapMessage Request)
outq =
  forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (a -> a) -> a
fix (forall k a. Map k a
Map.empty, Int32
1) forall a b. (a -> b) -> a -> b
$ \(Map Id ([ProtocolServerOp], TMVar (NonEmpty ProtocolServerOp)),
 Int32)
-> IO a
loop (!Map Id ([ProtocolServerOp], TMVar (NonEmpty ProtocolServerOp))
req, !Int32
counter) ->
    (Map Id ([ProtocolServerOp], TMVar (NonEmpty ProtocolServerOp)),
 Int32)
-> IO a
loop forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. STM a -> IO a
atomically (forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ do New Request
new TMVar (NonEmpty ProtocolServerOp)
var <- forall a. TQueue a -> STM a
readTQueue TQueue ClientMessage
client
           forall a. TQueue a -> a -> STM ()
writeTQueue TQueue (LdapMessage Request)
outq (forall op. Id -> op -> Maybe Controls -> LdapMessage op
Type.LdapMessage (Int32 -> Id
Type.Id Int32
counter) Request
new forall a. Maybe a
Nothing)
           forall (m :: * -> *) a. Monad m => a -> m a
return (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Int32 -> Id
Type.Id Int32
counter) ([], TMVar (NonEmpty ProtocolServerOp)
var) Map Id ([ProtocolServerOp], TMVar (NonEmpty ProtocolServerOp))
req, Int32
counter forall a. Num a => a -> a -> a
+ Int32
1)
      , do Type.LdapMessage Id
mid ProtocolServerOp
op Maybe Controls
_
               <- forall a. TQueue a -> STM a
readTQueue TQueue (LdapMessage ProtocolServerOp)
inq
           Map Id ([ProtocolServerOp], TMVar (NonEmpty ProtocolServerOp))
res <- case ProtocolServerOp
op of
             Type.BindResponse {}          -> forall {k} {a}.
Ord k =>
k
-> a
-> Map k ([a], TMVar (NonEmpty a))
-> STM (Map k ([a], TMVar (NonEmpty a)))
done Id
mid ProtocolServerOp
op Map Id ([ProtocolServerOp], TMVar (NonEmpty ProtocolServerOp))
req
             Type.SearchResultEntry {}     -> forall {m :: * -> *} {k} {a} {b}.
(Monad m, Ord k) =>
k -> a -> Map k ([a], b) -> m (Map k ([a], b))
saveUp Id
mid ProtocolServerOp
op Map Id ([ProtocolServerOp], TMVar (NonEmpty ProtocolServerOp))
req
             Type.SearchResultReference {} -> forall (m :: * -> *) a. Monad m => a -> m a
return Map Id ([ProtocolServerOp], TMVar (NonEmpty ProtocolServerOp))
req
             Type.SearchResultDone {}      -> forall {k} {a}.
Ord k =>
k
-> a
-> Map k ([a], TMVar (NonEmpty a))
-> STM (Map k ([a], TMVar (NonEmpty a)))
done Id
mid ProtocolServerOp
op Map Id ([ProtocolServerOp], TMVar (NonEmpty ProtocolServerOp))
req
             Type.ModifyResponse {}        -> forall {k} {a}.
Ord k =>
k
-> a
-> Map k ([a], TMVar (NonEmpty a))
-> STM (Map k ([a], TMVar (NonEmpty a)))
done Id
mid ProtocolServerOp
op Map Id ([ProtocolServerOp], TMVar (NonEmpty ProtocolServerOp))
req
             Type.AddResponse {}           -> forall {k} {a}.
Ord k =>
k
-> a
-> Map k ([a], TMVar (NonEmpty a))
-> STM (Map k ([a], TMVar (NonEmpty a)))
done Id
mid ProtocolServerOp
op Map Id ([ProtocolServerOp], TMVar (NonEmpty ProtocolServerOp))
req
             Type.DeleteResponse {}        -> forall {k} {a}.
Ord k =>
k
-> a
-> Map k ([a], TMVar (NonEmpty a))
-> STM (Map k ([a], TMVar (NonEmpty a)))
done Id
mid ProtocolServerOp
op Map Id ([ProtocolServerOp], TMVar (NonEmpty ProtocolServerOp))
req
             Type.ModifyDnResponse {}      -> forall {k} {a}.
Ord k =>
k
-> a
-> Map k ([a], TMVar (NonEmpty a))
-> STM (Map k ([a], TMVar (NonEmpty a)))
done Id
mid ProtocolServerOp
op Map Id ([ProtocolServerOp], TMVar (NonEmpty ProtocolServerOp))
req
             Type.CompareResponse {}       -> forall {k} {a}.
Ord k =>
k
-> a
-> Map k ([a], TMVar (NonEmpty a))
-> STM (Map k ([a], TMVar (NonEmpty a)))
done Id
mid ProtocolServerOp
op Map Id ([ProtocolServerOp], TMVar (NonEmpty ProtocolServerOp))
req
             Type.ExtendedResponse {}      -> Id
-> ProtocolServerOp
-> Map Id ([ProtocolServerOp], TMVar (NonEmpty ProtocolServerOp))
-> STM
     (Map Id ([ProtocolServerOp], TMVar (NonEmpty ProtocolServerOp)))
probablyDisconnect Id
mid ProtocolServerOp
op Map Id ([ProtocolServerOp], TMVar (NonEmpty ProtocolServerOp))
req
             Type.IntermediateResponse {}  -> forall {m :: * -> *} {k} {a} {b}.
(Monad m, Ord k) =>
k -> a -> Map k ([a], b) -> m (Map k ([a], b))
saveUp Id
mid ProtocolServerOp
op Map Id ([ProtocolServerOp], TMVar (NonEmpty ProtocolServerOp))
req
           forall (m :: * -> *) a. Monad m => a -> m a
return (Map Id ([ProtocolServerOp], TMVar (NonEmpty ProtocolServerOp))
res, Int32
counter)
      ])
 where
  saveUp :: k -> a -> Map k ([a], b) -> m (Map k ([a], b))
saveUp k
mid a
op Map k ([a], b)
res =
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\([a]
stack, b
var) -> (a
op forall a. a -> [a] -> [a]
: [a]
stack, b
var)) k
mid Map k ([a], b)
res)

  done :: k
-> a
-> Map k ([a], TMVar (NonEmpty a))
-> STM (Map k ([a], TMVar (NonEmpty a)))
done k
mid a
op Map k ([a], TMVar (NonEmpty a))
req =
    case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
mid Map k ([a], TMVar (NonEmpty a))
req of
      Maybe ([a], TMVar (NonEmpty a))
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Map k ([a], TMVar (NonEmpty a))
req
      Just ([a]
stack, TMVar (NonEmpty a)
var) -> do
        forall a. TMVar a -> a -> STM ()
putTMVar TMVar (NonEmpty a)
var (a
op forall a. a -> [a] -> NonEmpty a
:| [a]
stack)
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete k
mid Map k ([a], TMVar (NonEmpty a))
req)

  probablyDisconnect :: Id
-> ProtocolServerOp
-> Map Id ([ProtocolServerOp], TMVar (NonEmpty ProtocolServerOp))
-> STM
     (Map Id ([ProtocolServerOp], TMVar (NonEmpty ProtocolServerOp)))
probablyDisconnect (Type.Id Int32
0)
                     (Type.ExtendedResponse
                       (Type.LdapResult ResultCode
code
                                        (Type.LdapDn (Type.LdapString Text
dn))
                                        (Type.LdapString Text
reason)
                                        Maybe ReferralUris
_)
                       Maybe LdapOid
moid Maybe ByteString
_)
                     Map Id ([ProtocolServerOp], TMVar (NonEmpty ProtocolServerOp))
req =
    case Maybe LdapOid
moid of
      Just (Type.LdapOid Text
oid)
        | Text -> Oid
Oid Text
oid forall a. Eq a => a -> a -> Bool
== Oid
noticeOfDisconnectionOid -> forall e a. Exception e => e -> STM a
throwSTM (ResultCode -> Dn -> Text -> Disconnect
Disconnect ResultCode
code (Text -> Dn
Dn Text
dn) Text
reason)
      Maybe LdapOid
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Map Id ([ProtocolServerOp], TMVar (NonEmpty ProtocolServerOp))
req
  probablyDisconnect Id
mid ProtocolServerOp
op Map Id ([ProtocolServerOp], TMVar (NonEmpty ProtocolServerOp))
req = forall {k} {a}.
Ord k =>
k
-> a
-> Map k ([a], TMVar (NonEmpty a))
-> STM (Map k ([a], TMVar (NonEmpty a)))
done Id
mid ProtocolServerOp
op Map Id ([ProtocolServerOp], TMVar (NonEmpty ProtocolServerOp))
req

wrap :: IO a -> IO a
wrap :: forall a. IO a -> IO a
wrap IO a
m = IO a
m forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> WrappedIOError
WrappedIOError)