improve documentation

Add type synonyms: Username, Password, AuthZID, AuthData and Resource

pontarius-xmpp.cabal

@@ -163,6 +163,9 @@ Test-Suite doctest
                , doctest
                , directory
                , filepath
+               , QuickCheck
+               , derive
+               , quickcheck-instances
 
 benchmark benchmarks
   type: exitcode-stdio-1.0

source/Network/Xmpp.hs

@@ -20,7 +20,27 @@
 --
 -- For low-level access to Pontarius XMPP, see the "Network.Xmpp.Internal"
 -- module.
-
+--
+-- Getting Started
+--
+-- We use 'session' to create a session object and connect to a server. Here we
+-- use the default 'SessionConfiguration'.
+--
+-- @
+-- sess <- session realm (simpleAuth \"myUsername\" \"mypassword\") def
+-- @
+--
+-- Defining 'AuthData' can be a bit unwieldy, so 'simpleAuth' gives us a
+-- reasonable default. Though, for improved security, we should consider
+-- restricting the mecahnisms to 'scramSha1' whenever we can.
+--
+-- Next we have to set the presence to online, otherwise we won't be able to
+-- send or receive stanzas to/from other entities.
+--
+-- @
+-- sendPresence presenceOnline sess
+-- @
+--
 {-# LANGUAGE CPP, NoMonomorphismRestriction, OverloadedStrings #-}
 
 module Network.Xmpp
@@ -37,10 +57,13 @@ module Network.Xmpp
   , closeConnection
   , endSession
   , waitForStream
-    -- TODO: Close session, etc.
     -- ** Authentication handlers
     -- | The use of 'scramSha1' is /recommended/, but 'digestMd5' might be
     -- useful for interaction with older implementations.
+  , AuthData
+  , Username
+  , Password
+  , AuthZID
   , scramSha1
   , plain
   , digestMd5
@@ -50,8 +73,8 @@ module Network.Xmpp
   -- address, but contains three parts instead of two.
   , Jid
 #if WITH_TEMPLATE_HASKELL
-  , jidQ
   , jid
+  , jidQ
 #endif
   , isBare
   , isFull
@@ -180,7 +203,7 @@ module Network.Xmpp
   , dupSession
   -- * Lenses
   -- | Network.Xmpp doesn't re-export the accessors to avoid name
-  -- clashes. If you want to use them import Network.Xmpp.Lens
+  -- clashes. To use them import Network.Xmpp.Lens
   , module Network.Xmpp.Lens
   -- * Miscellaneous
   , LangTag
@@ -195,6 +218,8 @@ module Network.Xmpp
                , AuthIllegalCredentials
                , AuthOtherFailure )
   , SaslHandler
+  , Plugin
+  , Plugin'
   , ConnectionState(..)
   , connectTls
   ) where

source/Network/Xmpp/Concurrent.hs

@@ -186,7 +186,7 @@ newSession stream config realm mbSasl = runErrorT $ do
 
 connectStream :: HostName
               -> SessionConfiguration
-              -> Maybe (ConnectionState -> [SaslHandler], Maybe Text)
+              -> AuthData
               -> IO (Either XmppFailure Stream)
 connectStream realm config mbSasl = do
     Ex.bracketOnError (openStream realm (sessionStreamConfiguration config))
@@ -223,9 +223,7 @@ connectStream realm config mbSasl = do
 -- third parameter is a 'Just' value, @session@ will attempt to authenticate and
 -- acquire an XMPP resource.
 session :: HostName                          -- ^ The hostname / realm
-        -> Maybe (ConnectionState -> [SaslHandler] , Maybe Text)
-           -- ^ SASL handlers and the desired JID resource (or Nothing to let
-           -- the server decide)
+        -> AuthData
         -> SessionConfiguration              -- ^ configuration details
         -> IO (Either XmppFailure Session)
 session realm mbSasl config = runErrorT $ do
@@ -234,6 +232,23 @@ session realm mbSasl config = runErrorT $ do
     liftIO $ when (enableRoster config) $ initRoster ses
     return ses
 
+-- | Authenticate using, in order of preference, 'scramSha1', 'digestMd5' and
+-- finally, if both of those are not support and the stream is 'Secured' with
+-- TLS, try 'plain'
+--
+-- The resource will be decided by the server
+simpleAuth :: Username -> Password -> AuthData
+simpleAuth uname pwd = Just (\cstate ->
+                              [ scramSha1 uname Nothing pwd
+                              , digestMd5 uname Nothing pwd
+                              ] ++
+                              if (cstate == Secured)
+                              then [plain uname Nothing pwd]
+                              else []
+                            , Nothing)
+
+
+
 -- | Reconnect immediately with the stored settings. Returns @Just@ the error
 -- when the reconnect attempt fails and Nothing when no failure was encountered.
 --

source/Network/Xmpp/Concurrent/Types.hs

@@ -26,6 +26,18 @@ type StanzaHandler =  (Stanza -> IO (Either XmppFailure ()) ) -- ^ outgoing stan
                    -> IO [(Stanza, [Annotation])]  -- ^ modified stanzas and
                                                    -- /additional/ annotations
 
+type Resource = Text
+
+-- | SASL handlers and the desired JID resource
+--
+-- Nothing to disable authentication
+--
+-- The allowed SASL mecahnism can depend on the connection state. For example,
+-- 'plain' should be avoided unless the connection state is 'Secured'
+--
+-- It is recommended to leave the resource up to the server
+type AuthData = Maybe (ConnectionState -> [SaslHandler] , Maybe Resource)
+
 data Annotation = forall f.(Typeable f, Show f) => Annotation{fromAnnotation :: f}
 
 instance Show Annotation where
@@ -54,11 +66,17 @@ type Plugin = (Stanza -> IO (Either XmppFailure ()))
 data SessionConfiguration = SessionConfiguration
     { -- | Configuration for the @Stream@ object.
       sessionStreamConfiguration :: StreamConfiguration
-      -- | Handler to be run when the conection to the XMPP server is closed.
+      -- | Handler to be run when the conection to the XMPP server is
+      -- closed. See also 'reconnect' and 'reconnect\'' for easy
+      -- reconnection. The default does nothing
     , onConnectionClosed         :: Session -> XmppFailure -> IO ()
-      -- | Function to generate the stream of stanza identifiers.
+      -- | Function to generate new stanza identifiers.
     , sessionStanzaIDs           :: IO (IO Text)
+      -- | Plugins can modify incoming and outgoing stanzas, for example to en-
+      -- and decrypt them, respectively
     , plugins                    :: [Plugin]
+      -- | Enable roster handling according to rfc 6121. See 'getRoster' to
+      -- acquire the current roster
     , enableRoster               :: Bool
     }
 

source/Network/Xmpp/Internal.hs

@@ -42,9 +42,10 @@ module Network.Xmpp.Internal
   , iqResult
   , associatedErrorType
     -- * Plugins
-  , Plugin(..)
+  , Plugin
   , Plugin'(..)
   , Annotation(..)
+  , connectTls
  )
        where
 

source/Network/Xmpp/Sasl/Mechanisms/DigestMd5.hs

@@ -107,9 +107,9 @@ xmppDigestMd5 authcid' authzid' password' = do
               ha2 = hash ["AUTHENTICATE", digestURI]
           in hash [ha1, nonce, nc, cnonce, qop, ha2]
 
-digestMd5 :: Text -- ^ Authentication identity (authcid or username)
-          -> Maybe Text -- ^ Authorization identity (authzid)
-          -> Text -- ^ Password
+digestMd5 :: Username -- ^ Authentication identity (authcid or username)
+          -> Maybe AuthZID -- ^ Authorization identity (authzid)
+          -> Password -- ^ Password
           -> SaslHandler
 digestMd5 authcid authzid password =
     ( "DIGEST-MD5"

source/Network/Xmpp/Sasl/Mechanisms/Plain.hs

@@ -44,9 +44,9 @@ xmppPlain authcid' authzid' password  = do
       where
         authzid'' = maybe "" Text.encodeUtf8 authzid'
 
-plain :: Text.Text -- ^ authentication ID (username)
-      -> Maybe Text.Text -- ^ authorization ID
-      -> Text.Text -- ^ password
+plain :: Username -- ^ authentication ID (username)
+      -> Maybe AuthZID -- ^ authorization ID
+      -> Password -- ^ password
       -> SaslHandler
 plain authcid authzid passwd =
     ( "PLAIN"

source/Network/Xmpp/Sasl/Mechanisms/Scram.hs

@@ -147,9 +147,9 @@ scram hToken authcid authzid password = do
                 u1 = hmac str (slt +++ (BS.pack [0,0,0,1]))
                 us = iterate (hmac str) u1
 
-scramSha1 :: Text.Text  -- ^ username
-          -> Maybe Text.Text -- ^ authorization ID
-          -> Text.Text   -- ^ password
+scramSha1 :: Username  -- ^ username
+          -> Maybe AuthZID -- ^ authorization ID
+          -> Password   -- ^ password
           -> SaslHandler
 scramSha1 authcid authzid passwd =
     ( "SCRAM-SHA-1"

source/Network/Xmpp/Sasl/Types.hs

@@ -6,6 +6,10 @@ import           Data.ByteString(ByteString)
 import qualified Data.Text as Text
 import           Network.Xmpp.Types
 
+type Username = Text.Text
+type Password = Text.Text
+type AuthZID  = Text.Text
+
 data SaslElement = SaslSuccess   (Maybe Text.Text)
                  | SaslChallenge (Maybe Text.Text)
 

source/Network/Xmpp/Tls.hs

@@ -160,7 +160,10 @@ mkReadBuffer recv = do
 
 -- | Connect to an XMPP server and secure the connection with TLS before
 -- starting the XMPP streams
-connectTls :: ResolvConf -- ^ Resolv conf to use (try defaultResolvConf as a
+--
+-- /NB/ RFC 6120 does not specify this method, but some servers, notably GCS,
+-- seem to use it.
+connectTls :: ResolvConf -- ^ Resolv conf to use (try 'defaultResolvConf' as a
                          -- default)
            -> TLSParams  -- ^ TLS parameters to use when securing the connection
            -> String     -- ^ Host to use when connecting (will be resolved

source/Network/Xmpp/Types.hs

@@ -101,6 +101,13 @@ import           Network.TLS.Extra
 import qualified Text.StringPrep as SP
 import qualified Text.StringPrep.Profiles as SP
 
+
+-- $setup
+-- :set -itests
+-- >>> :add tests/Tests/Arbitrary.hs
+-- >>> import Network.Xmpp.Types
+-- >>> import Control.Applicative((<$>))
+
 -- | Type of Texts that contain at least on non-space character
 newtype NonemptyText = Nonempty {fromNonempty :: Text}
                        deriving (Show, Read, Eq, Ord)
@@ -111,14 +118,13 @@ instance IsString NonemptyText where
                             "all-whitespace string"
         Just r -> r
 
--- | Check that Text contains at least one non-space character wrap it
+-- | Check that Text contains at least one non-space character and wrap it
 nonEmpty :: Text -> Maybe NonemptyText
 nonEmpty txt = if Text.all isSpace txt then Nothing else Just (Nonempty txt)
 
 -- | Same as 'fromNonempty'
 text :: NonemptyText -> Text
 text (Nonempty txt) = txt
-{-# INLINE text #-}
 
 -- | The Xmpp communication primities (Message, Presence and Info/Query) are
 -- called stanzas.
@@ -177,6 +183,16 @@ data Message = Message { messageID      :: !(Maybe Text)
                        } deriving (Eq, Show)
 
 -- | An empty message
+--
+-- @
+-- message = Message { messageID      = Nothing
+--                   , messageFrom    = Nothing
+--                   , messageTo      = Nothing
+--                   , messageLangTag = Nothing
+--                   , messageType    = Normal
+--                   , messagePayload = []
+--                   }
+-- @
 message :: Message
 message = Message { messageID      = Nothing
                   , messageFrom    = Nothing
@@ -187,6 +203,8 @@ message = Message { messageID      = Nothing
                   }
 
 -- | Empty message stanza
+--
+-- @messageS = 'MessageS' 'message'@
 messageS :: Stanza
 messageS = MessageS message
 
@@ -759,6 +777,8 @@ newtype Stream = Stream { unStream :: TMVar StreamState }
 -- (e.g., an occupant in a multi-user chat room) belonging to
 -- the entity associated with an XMPP localpart at a domain
 -- (i.e., @localpart\@domainpart/resourcepart@).
+--
+-- For more details see RFC 6122 <http://xmpp.org/rfcs/rfc6122.html>
 
 data Jid = Jid { localpart_    :: !(Maybe NonemptyText)
                , domainpart_   :: !NonemptyText
@@ -775,6 +795,17 @@ jidToText (Jid nd dmn res) = Text.concat . concat $
 
 -- | Converts a JID to up to three Text values: (the optional) localpart, the
 -- domainpart, and (the optional) resourcepart.
+--
+-- >>> jidToTexts [jid|foo@bar/quux|]
+-- (Just "foo","bar",Just "quux")
+--
+-- >>> jidToTexts [jid|bar/quux|]
+-- (Nothing,"bar",Just "quux")
+--
+-- >>> jidToTexts [jid|foo@bar|]
+-- (Just "foo","bar",Nothing)
+--
+-- prop> jidToTexts j == (localpart j, domainpart j, resourcepart j)
 jidToTexts :: Jid -> (Maybe Text, Text, Maybe Text)
 jidToTexts (Jid nd dmn res) = (text <$> nd, text dmn, text <$> res)
 
@@ -812,12 +843,23 @@ instance TH.Lift Jid where
         mbTextE Nothing = [| Nothing |]
         mbTextE (Just s) = [| Just $(textE s) |]
 
--- | Constructs a @Jid@ value at compile time.
+-- | Constructs and validates a @Jid@ at compile time.
 --
 -- Syntax:
 -- @
---     [jidQ|localpart\@domainpart/resourcepart|]
+--     [jid|localpart\@domainpart/resourcepart|]
 -- @
+--
+-- >>> [jid|foo@bar/quux|]
+-- parseJid "foo@bar/quux"
+--
+-- >>> Just [jid|foo@bar/quux|] == jidFromTexts (Just "foo") "bar" (Just "quux")
+-- True
+--
+-- >>> Just [jid|foo@bar/quux|] == jidFromText "foo@bar/quux"
+-- True
+--
+-- See also 'jidFromText'
 jid :: QuasiQuoter
 jid = QuasiQuoter { quoteExp = \s -> do
                           when (head s == ' ') . fail $ "Leading whitespaces in JID" ++ show s
@@ -831,7 +873,7 @@ jid = QuasiQuoter { quoteExp = \s -> do
                   , quoteDec  = fail "jid QQ can't be used in declaration context"
                   }
 
--- | synonym for 'jid'
+-- | Synonym for 'jid'
 jidQ :: QuasiQuoter
 jidQ = jidQ
 #endif
@@ -889,7 +931,45 @@ parseJid s = case jidFromText $ Text.pack s of
                  Just j -> j
                  Nothing -> error $ "Jid value (" ++ s ++ ") did not validate"
 
--- | Converts a Text to a JID.
+-- | Parse a JID
+--
+-- >>> localpart <$> jidFromText "foo@bar/quux"
+-- Just (Just "foo")
+--
+-- >>> domainpart <$> jidFromText "foo@bar/quux"
+-- Just "bar"
+--
+-- >>> resourcepart <$> jidFromText "foo@bar/quux"
+-- Just (Just "quux")
+--
+-- * Counterexamples
+--
+-- A JID must only have one \'\@\':
+--
+-- >>> jidFromText "foo@bar@quux"
+-- Nothing
+--
+-- \'\@\' must come before \'/\':
+--
+-- >>> jidFromText "foo/bar@quux"
+-- Nothing
+--
+-- The domain part can\'t be empty:
+--
+-- >>> jidFromText "foo@/quux"
+-- Nothing
+--
+-- Both the local part and the resource part can be omitted (but the
+-- \'\@\' and \'\/\', must also be removed):
+--
+-- >>> jidToTexts <$> jidFromText "bar"
+-- Just (Nothing,"bar",Nothing)
+--
+-- >>> jidToTexts <$> jidFromText "@bar"
+-- Nothing
+--
+-- >>> jidToTexts <$> jidFromText "bar/"
+-- Nothing
 jidFromText :: Text -> Maybe Jid
 jidFromText t = do
     (l, d, r) <- eitherToMaybe $ AP.parseOnly jidParts t
@@ -897,8 +977,13 @@ jidFromText t = do
   where
     eitherToMaybe = either (const Nothing) Just
 
--- | Converts localpart, domainpart, and resourcepart strings to a JID. Runs the
+-- | Convert localpart, domainpart, and resourcepart to a JID. Runs the
 -- appropriate stringprep profiles and validates the parts.
+--
+-- >>> jidFromTexts (Just "foo") "bar" (Just "baz") == jidFromText "foo@bar/baz"
+-- True
+--
+-- prop> jidFromTexts (localpart j) (domainpart j) (resourcepart j) == Just j
 jidFromTexts :: Maybe Text -> Text -> Maybe Text -> Maybe Jid
 jidFromTexts l d r = do
     localPart <- case l of
@@ -929,56 +1014,60 @@ jidFromTexts l d r = do
     validPartLength :: Text -> Bool
     validPartLength p = Text.length p > 0 && Text.length p < 1024
 
--- | Returns 'True' if the JID is /bare/, and 'False' otherwise.
+-- | Returns 'True' if the JID is /bare/, that is, it doesn't have a resource
+-- part, and 'False' otherwise.
 --
--- >>> isBare [jidQ|foo@bar|]
+-- >>> isBare [jid|foo@bar|]
 -- True
 --
--- >>> isBare [jidQ|foo@bar/quux|]
+-- >>> isBare [jid|foo@bar/quux|]
 -- False
 isBare :: Jid -> Bool
 isBare j | resourcepart j == Nothing = True
          | otherwise                 = False
 
 -- | Returns 'True' if the JID is /full/, and 'False' otherwise.
--- isFull = not . isBare
 --
--- >>> isBare [jidQ|foo@bar|]
+-- @isFull = not . isBare@
+--
+-- >>> isBare [jid|foo@bar|]
 -- True
 --
--- >>> isBare [jidQ|foo@bar/quux|]
+-- >>> isBare [jid|foo@bar/quux|]
 -- False
 isFull :: Jid -> Bool
 isFull = not . isBare
 
 -- | Returns the @Jid@ without the resourcepart (if any).
 --
--- >>> toBare [jidQ|foo@bar/quux|] == [jidQ|foo@bar|]
+-- >>> toBare [jid|foo@bar/quux|] == [jid|foo@bar|]
 -- True
 toBare :: Jid -> Jid
 toBare j  = j{resourcepart_ = Nothing}
 
 -- | Returns the localpart of the @Jid@ (if any).
 --
--- >>> localpart [jidQ|foo@bar/quux|]
+-- >>> localpart [jid|foo@bar/quux|]
 -- Just "foo"
 localpart :: Jid -> Maybe Text
 localpart = fmap text . localpart_
 
 -- | Returns the domainpart of the @Jid@.
 --
--- >>> domainpart [jidQ|foo@bar/quux|]
+-- >>> domainpart [jid|foo@bar/quux|]
 -- "bar"
 domainpart :: Jid -> Text
 domainpart = text . domainpart_
 
 -- | Returns the resourcepart of the @Jid@ (if any).
 --
--- >>> resourcepart [jidQ|foo@bar/quux|]
+-- >>> resourcepart [jid|foo@bar/quux|]
 -- Just "quux"
 resourcepart :: Jid -> Maybe Text
 resourcepart = fmap text . resourcepart_
 
+-- | Parse the parts of a JID. The parts need to be validated with stringprep
+-- before the JID can be constructed
 jidParts :: AP.Parser (Maybe Text, Text, Maybe Text)
 jidParts = do
     maybeLocalPart <- Just <$> localPart <|> return Nothing
@@ -997,7 +1086,7 @@ jidParts = do
 
 
 
--- The `nodeprep' StringPrep profile.
+-- | The `nodeprep' StringPrep profile.
 nodeprepProfile :: SP.StringPrepProfile
 nodeprepProfile = SP.Profile { SP.maps = [SP.b1, SP.b2]
                              , SP.shouldNormalize = True
@@ -1017,12 +1106,12 @@ nodeprepProfile = SP.Profile { SP.maps = [SP.b1, SP.b2]
                              , SP.shouldCheckBidi = True
                              }
 
--- These characters needs to be checked for after normalization.
+-- | These characters needs to be checked for after normalization.
 nodeprepExtraProhibitedCharacters :: [Char]
 nodeprepExtraProhibitedCharacters = ['\x22', '\x26', '\x27', '\x2F', '\x3A',
                                      '\x3C', '\x3E', '\x40']
 
--- The `resourceprep' StringPrep profile.
+-- | The `resourceprep' StringPrep profile.
 resourceprepProfile :: SP.StringPrepProfile
 resourceprepProfile = SP.Profile { SP.maps = [SP.b1]
                                  , SP.shouldNormalize = True
@@ -1040,11 +1129,17 @@ resourceprepProfile = SP.Profile { SP.maps = [SP.b1]
                                                    ]
                                  , SP.shouldCheckBidi = True
                                  }
-
-data ConnectionDetails = UseRealm -- ^ Use realm to resolv host
+-- | Specify the method with which the connection is (re-)established
+data ConnectionDetails = UseRealm -- ^ Use realm to resolv host. This is the
+                                  -- default.
                        | UseSrv HostName -- ^ Use this hostname for a SRV lookup
                        | UseHost HostName PortID -- ^ Use specified host
                        | UseConnection (ErrorT XmppFailure IO StreamHandle)
+                         -- ^ Use custom method to create a StreamHandle. This
+                         -- will also be used by reconnect. For example, to
+                         -- establish TLS before starting the stream as done by
+                         -- GCM, see 'connectTls'. You can also return an
+                         -- already established connection.
 
 -- | Configuration settings related to the stream.
 data StreamConfiguration =

tests/Doctest.hs

@@ -14,23 +14,27 @@ import Test.DocTest
 main :: IO ()
 main = doctest $
     "-isource"
+  : "-itests"
   : "-idist/build/autogen"
   : "-hide-all-packages"
   : "-XQuasiQuotes"
+  : "-XOverloadedStrings"
   : "-DWITH_TEMPLATE_HASKELL"
-  : map ("-package="++) deps ++ sources
+  : "-optP-includedist/build/autogen/cabal_macros.h"
+  : map ("-package="++) deps
+    ++ sources
 
 sources :: [String]
-sources = ["source/Network/Xmpp/Types.hs"]
+sources = ["Network.Xmpp.Types"] -- ["source/Network/Xmpp/Types.hs"]
 
--- getSources :: IO [FilePath]
--- getSources = filter (isSuffixOf ".hs") <$> go "source"
---   where
---     go dir = do
---       (dirs, files) <- getFilesAndDirectories dir
---       (files ++) . concat <$> mapM go dirs
+getSources :: IO [FilePath]
+getSources = filter (isSuffixOf ".hs") <$> go "source"
+  where
+    go dir = do
+      (dirs, files) <- getFilesAndDirectories dir
+      (files ++) . concat <$> mapM go dirs
 
--- getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])
--- getFilesAndDirectories dir = do
---   c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir
---   (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c
+getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])
+getFilesAndDirectories dir = do
+  c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir
+  (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c