Factor out some new libraries

	word64-map:
		Data.Word64Map
	network-addr:
		Network.Address
	tox-crypto:
		Crypto.Tox
	lifted-concurrent:
		Control.Concurrent.Lifted.Instrument
		Control.Concurrent.Async.Lifted.Instrument
	psq-wrap:
		Data.Wrapper.PSQInt
		Data.Wrapper.PSQ
	minmax-psq:
		Data.MinMaxPSQ
        tasks:
                Control.Concurrent.Tasks
	kad:
		Network.Kademlia
		Network.Kademlia.Bootstrap
		Network.Kademlia.Routing
		Network.Kademlia.CommonAPI
		Network.Kademlia.Persistence
		Network.Kademlia.Search

1 files changed, 257 insertions, 0 deletions

diff --git a/dht/Presence/Stanza/Types.hs b/dht/Presence/Stanza/Types.hs
new file mode 100644
index 00000000..7275c8ab
--- /dev/null
+++ b/dht/Presence/Stanza/Types.hs
@@ -0,0 +1,257 @@
+{-# LANGUAGE FlexibleInstances #-}
+module Stanza.Types where
+
+import Control.Concurrent.STM
+import Data.Int
+import Data.Text
+import Data.XML.Types as XML
+
+import Connection (PeerAddress(..))
+import ConnectionKey (ClientAddress(..))
+import LockedChan
+import Nesting (Lang)
+
+type Stanza = StanzaWrap (LockedChan XML.Event)
+
+data StanzaWrap a = Stanza
+    { stanzaType :: StanzaType
+    , stanzaId :: Maybe Text
+    , stanzaTo :: Maybe Text
+    , stanzaFrom :: Maybe Text
+    , stanzaChan :: a
+    , stanzaClosers ::  TVar (Maybe [XML.Event])
+    , stanzaInterrupt :: TMVar ()
+    , stanzaOrigin :: StanzaOrigin
+    }
+
+data StanzaOrigin = LocalPeer
+                  | PeerOrigin PeerAddress (TChan Stanza)
+                  | ClientOrigin ClientAddress (TChan Stanza)
+
+data StanzaType
+    = Unrecognized
+    | Ping
+    | Pong
+    | RequestResource (Maybe Text) (Maybe Text) -- ^ Client's name for this host followed by client's requested resource id.
+    | SetResource
+    | RequestItems (Maybe Text)
+    | Items
+    | RequestInfo (Maybe Text)
+    | Info
+    | SessionRequest
+    | UnrecognizedQuery Name
+    | RequestRoster
+    | Roster
+    | RosterEvent { rosterEventType :: RosterEventType
+                  , rosterUser :: Text
+                  , rosterContact :: Text }
+    | Error StanzaError XML.Event
+    | PresenceStatus { presenceShow :: JabberShow
+                     , presencePriority :: Maybe Int8
+                     , presenceStatus :: [(Lang,Text)]
+                     , presenceWhiteList :: [Text]
+                        -- ^ A custom extension extension we are using.  When a
+                        -- peer answers a presence probe, it also communicates
+                        -- to the remote peer which remote users it believes
+                        -- are subscribed to that presence.
+                        --
+                        -- This is communicated via a space-delimited list in
+                        -- the nonstandard "whitelist" attribute for a
+                        -- <{jabber:server}presence> tag.
+                        --
+                        -- TODO: Use this to update the buddies file so that a
+                        -- client is made aware when a subscription was
+                        -- canceled.
+                     }
+
+    | PresenceInformError
+    | PresenceInformSubscription Bool
+    | PresenceRequestStatus
+    | PresenceRequestSubscription Bool
+    | Message { msgThread :: Maybe MessageThread
+              , msgLangMap :: [(Lang,LangSpecificMessage)]
+              , msgType :: MessageType
+              }
+    | NotifyClientVersion { versionName :: Text
+                          , versionVersion :: Text }
+    | InternalEnableHack ClientHack
+    | InternalCacheId Text
+ deriving (Show,Eq)
+
+data MessageType
+    = NormalMsg  -- ^ The message is a standalone message that is sent outside
+                 -- the context of a one-to-one conversation or groupchat, and
+                 -- to which it is expected that the recipient will reply.
+                 -- Typically a receiving client will present a message of type
+                 -- "normal" in an interface that enables the recipient to
+                 -- reply, but without a conversation history. The default
+                 -- value of the 'type' attribute is "normal".
+
+    | ChatMsg -- ^ The message is sent in the context of a one-to-one chat
+              -- session. Typically an interactive client will present a
+              -- message of type "chat" in an interface that enables one-to-one
+              -- chat between the two parties, including an appropriate
+              -- conversation history. Detailed recommendations regarding
+              -- one-to-one chat sessions are provided under Section 5.1.
+
+    | GroupChatMsg -- ^ The message is sent in the context of a multi-user chat
+                   -- environment (similar to that of [IRC]). Typically a
+                   -- receiving client will present a message of type
+                   -- "groupchat" in an interface that enables many-to-many
+                   -- chat between the parties, including a roster of parties
+                   -- in the chatroom and an appropriate conversation history.
+                   -- For detailed information about XMPP-based groupchat,
+                   -- refer to [XEP‑0045].
+
+    | HeadlineMsg -- ^ The message provides an alert, a notification, or other
+                  -- transient information to which no reply is expected (e.g.,
+                  -- news headlines, sports updates, near-real-time market
+                  -- data, or syndicated content). Because no reply to the
+                  -- message is expected, typically a receiving client will
+                  -- present a message of type "headline" in an interface that
+                  -- appropriately differentiates the message from standalone
+                  -- messages, chat messages, and groupchat messages (e.g., by
+                  -- not providing the recipient with the ability to reply). If
+                  -- the 'to' address is the bare JID, the receiving server
+                  -- SHOULD deliver the message to all of the recipient's
+                  -- available resources with non-negative presence priority
+                  -- and MUST deliver the message to at least one of those
+                  -- resources; if the 'to' address is a full JID and there is
+                  -- a matching resource, the server MUST deliver the message
+                  -- to that resource; otherwise the server MUST either
+                  -- silently ignore the message or return an error (see
+                  -- Section 8).
+
+    -- | ErrorMsg -- The message is generated by an entity that experiences an
+    -- error when processing a message received from another entity (for
+    -- details regarding stanza error syntax, refer to [XMPP‑CORE]). A client
+    -- that receives a message of type "error" SHOULD present an appropriate
+    -- interface informing the original sender regarding the nature of the
+    -- error.
+
+ deriving (Show,Read,Ord,Eq,Enum)
+
+
+data RosterEventType
+    = RequestedSubscription
+    | NewBuddy -- preceded by PresenceInformSubscription True
+    | RemovedBuddy -- preceded by PresenceInformSubscription False
+    | PendingSubscriber -- same as PresenceRequestSubscription
+    | NewSubscriber
+    | RejectSubscriber
+ deriving (Show,Read,Ord,Eq,Enum)
+
+data ClientHack = SimulatedChatErrors
+ deriving (Show,Read,Ord,Eq,Enum)
+
+
+data LangSpecificMessage =
+    LangSpecificMessage { msgBody :: Maybe Text
+                        , msgSubject :: Maybe Text
+                        }
+  deriving (Show,Eq)
+
+data MessageThread = MessageThread {
+        msgThreadParent  :: Maybe Text,
+        msgThreadContent :: Text
+    }
+  deriving (Show,Eq)
+
+
+data JabberShow = Offline
+                | ExtendedAway
+                | Away
+                | DoNotDisturb
+                | Available
+                | Chatty
+ deriving (Show,Enum,Ord,Eq,Read)
+
+class StanzaFirstTag a where
+    -- Peek at the stanza open tag.
+    stanzaFirstTag :: StanzaWrap a -> IO XML.Event
+instance StanzaFirstTag (TChan XML.Event) where
+    stanzaFirstTag stanza = do
+        e <-atomically $ peekTChan (stanzaChan stanza)
+        return e
+instance StanzaFirstTag (LockedChan XML.Event) where
+    stanzaFirstTag stanza = do
+        e <-atomically $ peekLChan (stanzaChan stanza)
+        return e
+instance StanzaFirstTag XML.Event where
+    stanzaFirstTag stanza = return (stanzaChan stanza)
+
+data StanzaError
+    = BadRequest
+    | Conflict
+    | FeatureNotImplemented
+    | Forbidden
+    | Gone
+    | InternalServerError
+    | ItemNotFound
+    | JidMalformed
+    | NotAcceptable
+    | NotAllowed
+    | NotAuthorized
+    | PaymentRequired
+    | RecipientUnavailable
+    | Redirect
+    | RegistrationRequired
+    | RemoteServerNotFound
+    | RemoteServerTimeout
+    | ResourceConstraint
+    | ServiceUnavailable
+    | SubscriptionRequired
+    | UndefinedCondition
+    | UnexpectedRequest
+ deriving (Show,Enum,Ord,Eq)
+
+xep0086 :: StanzaError -> (Text, Int)
+xep0086 e = case e of
+    BadRequest            -> ("modify", 400)
+    Conflict              -> ("cancel", 409)
+    FeatureNotImplemented -> ("cancel", 501)
+    Forbidden             -> ("auth", 403)
+    Gone                  -> ("modify", 302)
+    InternalServerError   -> ("wait", 500)
+    ItemNotFound          -> ("cancel", 404)
+    JidMalformed          -> ("modify", 400)
+    NotAcceptable         -> ("modify", 406)
+    NotAllowed            -> ("cancel", 405)
+    NotAuthorized         -> ("auth", 401)
+    PaymentRequired       -> ("auth", 402)
+    RecipientUnavailable  -> ("wait", 404)
+    Redirect              -> ("modify", 302)
+    RegistrationRequired  -> ("auth", 407)
+    RemoteServerNotFound  -> ("cancel", 404)
+    RemoteServerTimeout   -> ("wait", 504)
+    ResourceConstraint    -> ("wait", 500)
+    ServiceUnavailable    -> ("cancel", 503)
+    SubscriptionRequired  -> ("auth", 407)
+    UndefinedCondition    -> ("", 500)
+    UnexpectedRequest     -> ("wait", 400)
+
+errorText :: StanzaError -> Text
+errorText e = case e of
+    BadRequest            -> "Bad request"
+    Conflict              -> "Conflict"
+    FeatureNotImplemented -> "This feature is not implemented"
+    Forbidden             -> "Forbidden"
+    Gone                  -> "Recipient can no longer be contacted"
+    InternalServerError   -> "Internal server error"
+    ItemNotFound          -> "Item not found"
+    JidMalformed          -> "JID Malformed"
+    NotAcceptable         -> "Message was rejected"
+    NotAllowed            -> "Not allowed"
+    NotAuthorized         -> "Not authorized"
+    PaymentRequired       -> "Payment is required"
+    RecipientUnavailable  -> "Recipient is unavailable"
+    Redirect              -> "Redirect"
+    RegistrationRequired  -> "Registration required"
+    RemoteServerNotFound  -> "Recipient's server not found"
+    RemoteServerTimeout   -> "Remote server timeout"
+    ResourceConstraint    -> "The server is low on resources"
+    ServiceUnavailable    -> "The service is unavailable"
+    SubscriptionRequired  -> "A subscription is required"
+    UndefinedCondition    -> "Undefined condition"
+    UnexpectedRequest     -> "Unexpected request"
+