From f96691966860575f57377adb8c85d97f590a1534 Mon Sep 17 00:00:00 2001
From: Philipp Balzarek
Date: Fri, 10 Jan 2014 14:34:13 +0100
Subject: [PATCH] improve documentation
Add type synonyms: Username, Password, AuthZID, AuthData and Resource
---
pontarius-xmpp.cabal | 3 +
source/Network/Xmpp.hs | 33 ++++-
source/Network/Xmpp/Concurrent.hs | 23 ++-
source/Network/Xmpp/Concurrent/Types.hs | 22 ++-
source/Network/Xmpp/Internal.hs | 3 +-
.../Network/Xmpp/Sasl/Mechanisms/DigestMd5.hs | 6 +-
source/Network/Xmpp/Sasl/Mechanisms/Plain.hs | 6 +-
source/Network/Xmpp/Sasl/Mechanisms/Scram.hs | 6 +-
source/Network/Xmpp/Sasl/Types.hs | 4 +
source/Network/Xmpp/Tls.hs | 5 +-
source/Network/Xmpp/Types.hs | 139 +++++++++++++++---
tests/Doctest.hs | 28 ++--
12 files changed, 223 insertions(+), 55 deletions(-)
diff --git a/pontarius-xmpp.cabal b/pontarius-xmpp.cabal
index 37013a3..10568cd 100644
--- a/pontarius-xmpp.cabal
+++ b/pontarius-xmpp.cabal
@@ -163,6 +163,9 @@ Test-Suite doctest
, doctest
, directory
, filepath
+ , QuickCheck
+ , derive
+ , quickcheck-instances
benchmark benchmarks
type: exitcode-stdio-1.0
diff --git a/source/Network/Xmpp.hs b/source/Network/Xmpp.hs
index f00bca9..3e451e4 100644
--- a/source/Network/Xmpp.hs
+++ b/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
diff --git a/source/Network/Xmpp/Concurrent.hs b/source/Network/Xmpp/Concurrent.hs
index 5555e40..9bb2f5a 100644
--- a/source/Network/Xmpp/Concurrent.hs
+++ b/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.
--
diff --git a/source/Network/Xmpp/Concurrent/Types.hs b/source/Network/Xmpp/Concurrent/Types.hs
index c755897..796e7fb 100644
--- a/source/Network/Xmpp/Concurrent/Types.hs
+++ b/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
}
diff --git a/source/Network/Xmpp/Internal.hs b/source/Network/Xmpp/Internal.hs
index 9fb7d13..247cf90 100644
--- a/source/Network/Xmpp/Internal.hs
+++ b/source/Network/Xmpp/Internal.hs
@@ -42,9 +42,10 @@ module Network.Xmpp.Internal
, iqResult
, associatedErrorType
-- * Plugins
- , Plugin(..)
+ , Plugin
, Plugin'(..)
, Annotation(..)
+ , connectTls
)
where
diff --git a/source/Network/Xmpp/Sasl/Mechanisms/DigestMd5.hs b/source/Network/Xmpp/Sasl/Mechanisms/DigestMd5.hs
index 36e87eb..566c129 100644
--- a/source/Network/Xmpp/Sasl/Mechanisms/DigestMd5.hs
+++ b/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"
diff --git a/source/Network/Xmpp/Sasl/Mechanisms/Plain.hs b/source/Network/Xmpp/Sasl/Mechanisms/Plain.hs
index 0c32793..235f79d 100644
--- a/source/Network/Xmpp/Sasl/Mechanisms/Plain.hs
+++ b/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"
diff --git a/source/Network/Xmpp/Sasl/Mechanisms/Scram.hs b/source/Network/Xmpp/Sasl/Mechanisms/Scram.hs
index 99e30c7..37a87a2 100644
--- a/source/Network/Xmpp/Sasl/Mechanisms/Scram.hs
+++ b/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"
diff --git a/source/Network/Xmpp/Sasl/Types.hs b/source/Network/Xmpp/Sasl/Types.hs
index a8d6b4d..a16bac8 100644
--- a/source/Network/Xmpp/Sasl/Types.hs
+++ b/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)
diff --git a/source/Network/Xmpp/Tls.hs b/source/Network/Xmpp/Tls.hs
index f7668fd..1fec7d8 100644
--- a/source/Network/Xmpp/Tls.hs
+++ b/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
diff --git a/source/Network/Xmpp/Types.hs b/source/Network/Xmpp/Types.hs
index f23dc0a..d14e4dd 100644
--- a/source/Network/Xmpp/Types.hs
+++ b/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
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 =
diff --git a/tests/Doctest.hs b/tests/Doctest.hs
index 9f4e09a..39ea019 100644
--- a/tests/Doctest.hs
+++ b/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