rename StanzaID to StanzaId

cleanups

examples/EchoClient.hs

@@ -26,7 +26,7 @@ import           Network.Xmpp.IM
 -- Server and authentication details.
 host     = "localhost"
 port     = PortNumber 5222
-realm    = "server.com"
+realm    = "species64739.dyndns.org"
 username = "echo"
 password = "pwd"
 resource = Just "bot"

pontarius-xmpp.cabal

@@ -49,14 +49,15 @@ Library
                , stm               >=2.1.2.1
                , xml-types         >=0.3.1
                , xml-conduit       >=1.0
-               , xml-picklers      >=0.2.2
+               , xml-picklers      >=0.3
                , data-default      >=0.2
                , stringprep        >=0.1.3
   Exposed-modules: Network.Xmpp
                  , Network.Xmpp.IM
                  , Network.Xmpp.Basic
-  Other-modules:
+                 , Network.Xmpp.Lens
-                 Network.Xmpp.Bind
+-- Undocumented modules
+                 , Network.Xmpp.Bind
                  , Network.Xmpp.Concurrent
                  , Network.Xmpp.IM.Message
                  , Network.Xmpp.IM.Presence
@@ -79,6 +80,8 @@ Library
                  , Network.Xmpp.Jid
                  , Network.Xmpp.Concurrent.Types
                  , Network.Xmpp.Concurrent.Channels.IQ
+                 , Network.Xmpp.Concurrent.Channels
+                 , Network.Xmpp.Concurrent.Channels.Types
                  , Network.Xmpp.Concurrent.Threads
                  , Network.Xmpp.Concurrent.Monad
                  , Text.XML.Stream.Elements

source/Network/Xmpp/Concurrent/Channels/Types.hs

@@ -21,7 +21,7 @@ data Session = Session
 -- | IQHandlers holds the registered channels for incomming IQ requests and
 -- TMVars of and TMVars for expected IQ responses
 type IQHandlers = (Map.Map (IQRequestType, Text) (TChan IQRequestTicket)
-                  , Map.Map StanzaId (TMVar IQResponse)
+                  , Map.Map StanzaID (TMVar IQResponse)
                   )
 
 -- | Contains whether or not a reply has been sent, and the IQ request body to

source/Network/Xmpp/Concurrent/Types.hs

@@ -22,7 +22,7 @@ data EventHandlers = EventHandlers
 data Context = Context
     { writeRef :: TMVar (BS.ByteString -> IO Bool)
     , readerThread :: ThreadId
-    , idGenerator :: IO StanzaId
+    , idGenerator :: IO StanzaID
       -- | Lock (used by withConnection) to make sure that a maximum of one
       -- XmppConMonad action is executed at any given time.
     , conRef :: TMVar Connection

source/Network/Xmpp/Connection.hs

@@ -147,7 +147,13 @@ connectTcpRaw :: HostName -> PortID -> Text -> IO Connection
 connectTcpRaw host port hostname = do
     h <- connectTo host port
     hSetBuffering h NoBuffering
-    let eSource = DCI.ResumableSource (sourceHandle h $= XP.parseBytes def)
+    let eSource = if debug then
+                     DCI.ResumableSource (sourceHandle h
+                                          $= debugOut
+                                          $= XP.parseBytes def)
+                                      (return ())
+                  else DCI.ResumableSource (sourceHandle h
+                                          $= XP.parseBytes def)
                                       (return ())
     let hand = Hand { cSend = if debug
                               then \d -> do
@@ -157,6 +163,7 @@ connectTcpRaw host port hostname = do
                     , cRecv = if debug then
                                 \n -> do
                                     bs <- BS.hGetSome h n
+                                    Prelude.putStr "in: "
                                     BS.putStrLn bs
                                     return bs
                               else BS.hGetSome h
@@ -178,7 +185,16 @@ connectTcpRaw host port hostname = do
             , sFrom            = Nothing
             }
     mkConnection con
-
+  where
+    debugOut = do
+        d <- await
+        case d of
+            Nothing -> return ()
+            Just bs -> do
+                liftIO $ BS.putStr "in: "
+                liftIO $ BS.putStrLn bs
+                yield bs
+                debugOut
 
 -- Closes the connection and updates the XmppConMonad Connection_ state.
 killConnection :: Connection -> IO (Either Ex.SomeException ())
@@ -190,7 +206,7 @@ killConnection = withConnection $ do
 
 -- Sends an IQ request and waits for the response. If the response ID does not
 -- match the outgoing ID, an error is thrown.
-pushIQ' :: StanzaId
+pushIQ' :: StanzaID
             -> Maybe Jid
             -> IQRequestType
             -> Maybe LangTag

source/Network/Xmpp/Errors.hs

@@ -36,7 +36,7 @@ findStreamErrors (Element name attrs children)
                              -> StreamUnknownError
     safeRead x = case reads $ Text.unpack x of
         [] -> Nothing
-        [(y,_),_] -> Just y
+        ((y,_):_) -> Just y
 
 flattenAttrs :: [(Name, [Content])] -> [(Name, Text.Text)]
 flattenAttrs attrs = map (\(name, content) ->
@@ -46,4 +46,4 @@ flattenAttrs attrs = map (\(name, content) ->
                          attrs
   where
     uncontentify (ContentText t) = t
-    uncontentify _ = ""
+    uncontentify _ = ""

source/Network/Xmpp/IM/Message.hs

@@ -80,7 +80,7 @@ body m = bodyContent <$> listToMaybe (bodies m)
 -- | Generate a new instant message
 newIM
   :: Jid
-     -> Maybe StanzaId
+     -> Maybe StanzaID
      -> Maybe LangTag
      -> MessageType
      -> Maybe MessageSubject

source/Network/Xmpp/Marshal.hs

@@ -18,7 +18,7 @@ xpStreamStanza :: PU [Node] (Either XmppStreamError Stanza)
 xpStreamStanza = xpEither xpStreamError xpStanza
 
 xpStanza :: PU [Node] Stanza
-xpStanza = xpAlt stanzaSel
+xpStanza = ("xpStanza" , "") <?+> xpAlt stanzaSel
     [ xpWrap IQRequestS     (\(IQRequestS     x) -> x) xpIQRequest
     , xpWrap IQResultS      (\(IQResultS      x) -> x) xpIQResult
     , xpWrap IQErrorS       (\(IQErrorS       x) -> x) xpIQError
@@ -39,7 +39,7 @@ xpStanza = xpAlt stanzaSel
     stanzaSel (PresenceErrorS _) = 6
 
 xpMessage :: PU [Node] (Message)
-xpMessage = xpWrap
+xpMessage = ("xpMessage" , "") <?+> xpWrap
     (\((tp, qid, from, to, lang), ext) -> Message qid from to lang tp ext)
     (\(Message qid from to lang tp ext) -> ((tp, qid, from, to, lang), ext))
     (xpElem "{jabber:client}message"
@@ -55,7 +55,7 @@ xpMessage = xpWrap
     )
 
 xpPresence :: PU [Node] Presence
-xpPresence = xpWrap
+xpPresence = ("xpPresence" , "") <?+> xpWrap
     (\((qid, from, to, lang, tp), ext) -> Presence qid from to lang tp ext)
     (\(Presence qid from to lang tp ext) -> ((qid, from, to, lang, tp), ext))
     (xpElem "{jabber:client}presence"
@@ -70,7 +70,7 @@ xpPresence = xpWrap
     )
 
 xpIQRequest :: PU [Node] IQRequest
-xpIQRequest = xpWrap
+xpIQRequest = ("xpIQRequest" , "") <?+> xpWrap
     (\((qid, from, to, lang, tp),body) -> IQRequest qid from to lang tp body)
     (\(IQRequest qid from to lang tp body) -> ((qid, from, to, lang, tp), body))
     (xpElem "{jabber:client}iq"
@@ -85,7 +85,7 @@ xpIQRequest = xpWrap
     )
 
 xpIQResult :: PU [Node] IQResult
-xpIQResult = xpWrap
+xpIQResult = ("xpIQResult" , "") <?+> xpWrap
     (\((qid, from, to, lang, _tp),body) -> IQResult qid from to lang body)
     (\(IQResult qid from to lang body) -> ((qid, from, to, lang, ()), body))
     (xpElem "{jabber:client}iq"
@@ -104,7 +104,7 @@ xpIQResult = xpWrap
 ----------------------------------------------------------
 
 xpErrorCondition :: PU [Node] StanzaErrorCondition
-xpErrorCondition = xpWrap
+xpErrorCondition = ("xpErrorCondition" , "") <?+> xpWrap
     (\(cond, (), ()) -> cond)
     (\cond -> (cond, (), ()))
     (xpElemByNamespace
@@ -115,7 +115,7 @@ xpErrorCondition = xpWrap
     )
 
 xpStanzaError :: PU [Node] StanzaError
-xpStanzaError = xpWrap
+xpStanzaError = ("xpStanzaError" , "") <?+> xpWrap
     (\(tp, (cond, txt, ext)) -> StanzaError tp cond txt ext)
     (\(StanzaError tp cond txt ext) -> (tp, (cond, txt, ext)))
     (xpElem "{jabber:client}error"
@@ -131,7 +131,7 @@ xpStanzaError = xpWrap
     )
 
 xpMessageError :: PU [Node] (MessageError)
-xpMessageError = xpWrap
+xpMessageError = ("xpMessageError" , "") <?+> xpWrap
     (\((_, qid, from, to, lang), (err, ext)) ->
         MessageError qid from to lang err ext)
     (\(MessageError qid from to lang err ext) ->
@@ -149,7 +149,7 @@ xpMessageError = xpWrap
     )
 
 xpPresenceError :: PU [Node] PresenceError
-xpPresenceError = xpWrap
+xpPresenceError = ("xpPresenceError" , "") <?+> xpWrap
     (\((qid, from, to, lang, _),(err, ext)) ->
         PresenceError qid from to lang err ext)
     (\(PresenceError qid from to lang err ext) ->
@@ -166,7 +166,7 @@ xpPresenceError = xpWrap
     )
 
 xpIQError :: PU [Node] IQError
-xpIQError = xpWrap
+xpIQError = ("xpIQError" , "") <?+> xpWrap
     (\((qid, from, to, lang, _tp),(err, body)) ->
         IQError qid from to lang err body)
     (\(IQError qid from to lang err body) ->
@@ -183,7 +183,7 @@ xpIQError = xpWrap
     )
 
 xpStreamError :: PU [Node] XmppStreamError
-xpStreamError = xpWrap
+xpStreamError = ("xpStreamError" , "") <?+> xpWrap
     (\((cond,() ,()), txt, el) -> XmppStreamError cond txt el)
     (\(XmppStreamError cond txt el) ->((cond,() ,()), txt, el))
     (xpElemNodes

source/Network/Xmpp/Pickle.hs

@@ -8,19 +8,13 @@
 
 
 module Network.Xmpp.Pickle
-    ( mbToBool
+    ( xmlLang
-    , xmlLang
     , xpLangTag
-    , xpNodeElem
-    , ignoreAttrs
-    , mbl
-    , lmb
-    , right
     , unpickleElem'
     , unpickleElem
     , pickleElem
-    , ppElement
+    )
-    ) where
+    where
 
 import Data.XML.Types
 import Data.XML.Pickle
@@ -29,50 +23,23 @@ import Network.Xmpp.Types
 
 import Text.XML.Stream.Elements
 
-mbToBool :: Maybe t -> Bool
-mbToBool (Just _) = True
-mbToBool _ = False
-
 xmlLang :: Name
 xmlLang = Name "lang" (Just "http://www.w3.org/XML/1998/namespace") (Just "xml")
 
 xpLangTag :: PU [Attribute] (Maybe LangTag)
 xpLangTag = xpAttrImplied xmlLang xpPrim
 
-xpNodeElem :: PU [Node] a -> PU Element a
+-- Given a pickler and an element, produces an object.
-xpNodeElem xp = PU { pickleTree = \x -> head $ (pickleTree xp x) >>= \y ->
+unpickleElem :: PU [Node] a -> Element -> Either UnpickleError a
-                      case y of
+unpickleElem p x = unpickle p [NodeElement x]
-                        NodeElement e -> [e]
-                        _ -> []
-             , unpickleTree = \x -> case unpickleTree xp $ [NodeElement x] of
-                        Left l -> Left l
-                        Right (a,(_,c)) -> Right (a,(Nothing,c))
-                   }
-
-ignoreAttrs :: PU t ((), b) -> PU t b
-ignoreAttrs = xpWrap snd ((),)
-
-mbl :: Maybe [a] -> [a]
-mbl (Just l) = l
-mbl Nothing = []
-
-lmb :: [t] -> Maybe [t]
-lmb [] = Nothing
-lmb x = Just x
-
-right :: Either [Char] t -> t
-right (Left l) = error l
-right (Right r) = r
 
 unpickleElem' :: PU [Node] c -> Element -> c
-unpickleElem' p x = case unpickle (xpNodeElem p) x of
+unpickleElem' p x = case unpickleElem p x of
   Left l -> error $ (show l) ++ "\n  saw: " ++ ppElement x
   Right r -> r
 
--- Given a pickler and an element, produces an object.
-unpickleElem :: PU [Node] a -> Element -> Either UnpickleError a
-unpickleElem p x = unpickle (xpNodeElem p) x
-
 -- Given a pickler and an object, produces an Element.
 pickleElem :: PU [Node] a -> a -> Element
-pickleElem p = pickle $ xpNodeElem p
+pickleElem p x = case pickle p x of
+    [NodeElement e] -> e
+    _ -> error "pickleElem: Pickler didn't return a single element."

source/Network/Xmpp/Session.hs

@@ -87,6 +87,17 @@ connectTcp address port hostname = do
                 XmppStreamError StreamInvalidXml Nothing Nothing
         toError  StreamUnknownError =
                 XmppStreamError StreamBadFormat Nothing Nothing
+        toError (StreamWrongTo _) =
+                XmppStreamError StreamBadFormat Nothing Nothing
+        toError (StreamXMLError _) =
+                XmppStreamError StreamInvalidXml Nothing Nothing
+        toError StreamStreamEnd =
+                XmppStreamError StreamBadFormat Nothing Nothing
+        toError StreamConnectionError =
+                XmppStreamError StreamRemoteConnectionFailed Nothing Nothing
+        toError (StreamError _) =
+                XmppStreamError StreamUndefinedCondition Nothing Nothing
+
 
 
 sessionXML :: Element

source/Network/Xmpp/Stream.hs

@@ -30,6 +30,14 @@ import           Text.XML.Stream.Parse as XP
 
 -- import Text.XML.Stream.Elements
 
+mbl :: Maybe [a] -> [a]
+mbl (Just l) = l
+mbl Nothing = []
+
+lmb :: [t] -> Maybe [t]
+lmb [] = Nothing
+lmb x = Just x
+
 -- Unpickles and returns a stream element. Throws a StreamXMLError on failure.
 streamUnpickleElem :: PU [Node] a
                    -> Element
@@ -125,6 +133,7 @@ streamS expectedTo = do
         -- Get the stream:stream element (or whatever it is) from the server,
         -- and validate what we get.
         el <- openElementFromEvents
+        liftIO . print $ unpickleElem xpStream el
         case unpickleElem xpStream el of
             Left _  -> throwError $ findStreamErrors el
             Right r -> validateData r
@@ -144,7 +153,7 @@ streamS expectedTo = do
 
 
 xpStream :: PU [Node] (Text, Maybe Jid, Maybe Jid, Maybe Text, Maybe LangTag)
-xpStream = xpElemAttrs
+xpStream = ("xpStream","") <?+> xpElemAttrs
     (Name "stream" (Just "http://etherx.jabber.org/streams") (Just "stream"))
     (xp5Tuple
          (xpAttr "version" xpId)
@@ -156,7 +165,7 @@ xpStream = xpElemAttrs
 
 -- Pickler/Unpickler for the stream features - TLS, SASL, and the rest.
 xpStreamFeatures :: PU [Node] ServerFeatures
-xpStreamFeatures = xpWrap
+xpStreamFeatures = ("xpStreamFeatures", "") <?+> xpWrap
     (\(tls, sasl, rest) -> SF tls (mbl sasl) rest)
     (\(SF tls sasl rest) -> (tls, lmb sasl, rest))
     (xpElemNodes

source/Network/Xmpp/TLS.hs

@@ -18,7 +18,7 @@ import           Data.Typeable
 import           Data.XML.Types
 
 import           Network.Xmpp.Connection
-import           Network.Xmpp.Pickle(ppElement)
+import           Text.XML.Stream.Elements(ppElement)
 import           Network.Xmpp.Stream
 import           Network.Xmpp.Types
 

source/Network/Xmpp/Types.hs

@@ -27,7 +27,7 @@ module Network.Xmpp.Types
     , StanzaError(..)
     , StanzaErrorCondition(..)
     , StanzaErrorType(..)
-    , StanzaId(..)
+    , StanzaID(..)
     , StreamError(..)
     , StreamErrorCondition(..)
     , Version(..)
@@ -73,15 +73,15 @@ import           System.IO
 -- Wraps a string of random characters that, when using an appropriate
 -- @IDGenerator@, is guaranteed to be unique for the Xmpp session.
 
-data StanzaId = SI !Text deriving (Eq, Ord)
+data StanzaID = SI !Text deriving (Eq, Ord)
 
-instance Show StanzaId where
+instance Show StanzaID where
   show (SI s) = Text.unpack s
 
-instance Read StanzaId where
+instance Read StanzaID where
   readsPrec _ x = [(SI $ Text.pack x, "")]
 
-instance IsString StanzaId where
+instance IsString StanzaID where
   fromString = SI . Text.pack
 
 -- | The Xmpp communication primities (Message, Presence and Info/Query) are
@@ -97,7 +97,7 @@ data Stanza = IQRequestS     !IQRequest
 
 -- | A "request" Info/Query (IQ) stanza is one with either "get" or "set" as
 -- type. It always contains an xml payload.
-data IQRequest = IQRequest { iqRequestID      :: !StanzaId
+data IQRequest = IQRequest { iqRequestID      :: !StanzaID
                            , iqRequestFrom    :: !(Maybe Jid)
                            , iqRequestTo      :: !(Maybe Jid)
                            , iqRequestLangTag :: !(Maybe LangTag)
@@ -125,7 +125,7 @@ data IQResponse = IQResponseError IQError
                 deriving Show
 
 -- | The (non-error) answer to an IQ request.
-data IQResult = IQResult { iqResultID      :: !StanzaId
+data IQResult = IQResult { iqResultID      :: !StanzaID
                          , iqResultFrom    :: !(Maybe Jid)
                          , iqResultTo      :: !(Maybe Jid)
                          , iqResultLangTag :: !(Maybe LangTag)
@@ -133,7 +133,7 @@ data IQResult = IQResult { iqResultID      :: !StanzaId
                          } deriving Show
 
 -- | The answer to an IQ request that generated an error.
-data IQError = IQError { iqErrorID          :: !StanzaId
+data IQError = IQError { iqErrorID          :: !StanzaID
                        , iqErrorFrom        :: !(Maybe Jid)
                        , iqErrorTo          :: !(Maybe Jid)
                        , iqErrorLangTag     :: !(Maybe LangTag)
@@ -142,7 +142,7 @@ data IQError = IQError { iqErrorID          :: !StanzaId
                        } deriving Show
 
 -- | The message stanza. Used for /push/ type communication.
-data Message = Message { messageID      :: !(Maybe StanzaId)
+data Message = Message { messageID      :: !(Maybe StanzaID)
                        , messageFrom    :: !(Maybe Jid)
                        , messageTo      :: !(Maybe Jid)
                        , messageLangTag :: !(Maybe LangTag)
@@ -151,7 +151,7 @@ data Message = Message { messageID      :: !(Maybe StanzaId)
                        } deriving Show
 
 -- | An error stanza generated in response to a 'Message'.
-data MessageError = MessageError { messageErrorID          :: !(Maybe StanzaId)
+data MessageError = MessageError { messageErrorID          :: !(Maybe StanzaID)
                                  , messageErrorFrom        :: !(Maybe Jid)
                                  , messageErrorTo          :: !(Maybe Jid)
                                  , messageErrorLangTag     :: !(Maybe LangTag)
@@ -211,7 +211,7 @@ instance Read MessageType where
     readsPrec _  _           = [(Normal, "")]
 
 -- | The presence stanza. Used for communicating status updates.
-data Presence = Presence { presenceID      :: !(Maybe StanzaId)
+data Presence = Presence { presenceID      :: !(Maybe StanzaID)
                          , presenceFrom    :: !(Maybe Jid)
                          , presenceTo      :: !(Maybe Jid)
                          , presenceLangTag :: !(Maybe LangTag)
@@ -221,7 +221,7 @@ data Presence = Presence { presenceID      :: !(Maybe StanzaId)
 
 
 -- | An error stanza generated in response to a 'Presence'.
-data PresenceError = PresenceError { presenceErrorID          :: !(Maybe StanzaId)
+data PresenceError = PresenceError { presenceErrorID          :: !(Maybe StanzaID)
                                    , presenceErrorFrom        :: !(Maybe Jid)
                                    , presenceErrorTo          :: !(Maybe Jid)
                                    , presenceErrorLangTag     :: !(Maybe LangTag)

source/Network/Xmpp/Xep/InbandRegistration.hs

@@ -22,6 +22,8 @@ import qualified Data.XML.Types as XML
 import           Network.Xmpp.Connection
 import           Network.Xmpp.Pickle
 import           Network.Xmpp.Types
+import           Network.Xmpp.Basic
+import           Network.Xmpp
 import           Network.Xmpp.Xep.ServiceDiscovery
 
 
@@ -34,6 +36,7 @@ ibrName x = (XML.Name x (Just ibrns) Nothing)
 data IbrError = IbrNotSupported
               | IbrNoConnection
               | IbrIQError IQError
+              | IbrTimeout
 
                 deriving (Show)
 instance Error IbrError
@@ -47,30 +50,6 @@ data Query = Query { instructions :: Maybe Text.Text
 
 emptyQuery = Query Nothing False False []
 
--- supported :: XmppConMonad (Either IbrError Bool)
--- supported = runErrorT $ fromFeatures <+> fromDisco
---   where
---   fromFeatures = do
---       fs <- other <$> gets sFeatures
---       let fe = XML.Element
---                    "{http://jabber.org/features/iq-register}register"
---                    []
---                    []
---       return $ fe `elem` fs
---   fromDisco = do
---       hn' <- gets sHostname
---       hn <- case hn' of
---           Just h -> return (Jid Nothing h Nothing)
---           Nothing -> throwError IbrNoConnection
---       qi <- lift $ xmppQueryInfo Nothing Nothing
---       case qi of
---           Left e -> return False
---           Right qir -> return $ "jabber:iq:register" `elem` qiFeatures qir
---   f <+> g = do
---             r <- f
---             if r then return True else g
-
-
 query :: IQRequestType -> Query -> Connection -> IO (Either IbrError Query)
 query queryType x con = do
     answer <- pushIQ' "ibr" Nothing queryType Nothing (pickleElem xpQuery x) con
@@ -85,6 +64,23 @@ query queryType x con = do
         Right _ -> return $ Right emptyQuery -- TODO: That doesn't seem right
         Left e -> return . Left $ IbrIQError e
 
+query' :: IQRequestType -> Query -> Session -> IO (Either IbrError Query)
+query' queryType x con = do
+    answer <- sendIQ' Nothing queryType Nothing (pickleElem xpQuery x) con
+    case answer of
+        IQResponseResult IQResult{iqResultPayload = Just b} ->
+            case unpickleElem xpQuery b of
+                Right query -> return $ Right query
+                Left e -> throw . StreamXMLError $
+                            "RequestField: unpickle failed, got "
+                            ++ Text.unpack (ppUnpickleError e)
+                            ++ " saw " ++ ppElement b
+        IQResponseResult _ -> return $ Right emptyQuery -- TODO: That doesn't
+                                                        -- seem right
+        IQResponseError e -> return . Left $ IbrIQError e
+        IQResponseTimeout -> return . Left $ IbrTimeout
+
+
 data RegisterError = IbrError IbrError
                    | MissingFields   [Field]
                    | AlreadyRegistered
@@ -95,10 +91,10 @@ instance Error RegisterError
 mapError f = mapErrorT (liftM $ left f)
 
 -- | Retrieve the necessary fields and fill them in to register an account with
--- the server
+-- the server.
 registerWith :: [(Field, Text.Text)]
              -> Connection
-             -> IO  (Either RegisterError Query)
+             -> IO (Either RegisterError Query)
 registerWith givenFields con = runErrorT $ do
     fs <- mapError IbrError . ErrorT $ requestFields con
     when (registered fs) . throwError $ AlreadyRegistered
@@ -112,14 +108,30 @@ registerWith givenFields con = runErrorT $ do
     result <- mapError IbrError . ErrorT $ query Set (emptyQuery {fields}) con
     return result
 
+
+
+createAccountWith host hostname port fields = runErrorT $ do
+      con' <- liftIO $ connectTcp host port hostname
+      con <- case con' of
+          Left e -> throwError $ IbrError IbrNoConnection
+          Right r -> return r
+      lift $ startTLS exampleParams con
+      ErrorT $ registerWith fields con
+
+deleteAccount host hostname port username password = do
+    con <- simpleConnect host port hostname username password Nothing
+    unregister' con
+--    endsession con
+
 -- | Terminate your account on the server. You have to be logged in for this to
 -- work. You connection will most likely be terminated after unregistering.
 unregister :: Connection -> IO (Either IbrError Query)
 unregister = query Set $ emptyQuery {remove = True}
 
+unregister' :: Session -> IO (Either IbrError Query)
+unregister' = query' Set $ emptyQuery {remove = True}
+
 requestFields con = runErrorT $ do
---     supp <- ErrorT supported
---    unless supp $ throwError $ IbrNotSupported
     qr <- ErrorT $ query Get emptyQuery con
     return $ qr