From 6e449a6fc1c194e4f79f663341d4b3718182366c Mon Sep 17 00:00:00 2001 From: Jon Kristensen Date: Thu, 20 Dec 2012 23:21:00 +0100 Subject: [PATCH 01/15] Remove source/Utils.hs --- source/Utils.hs | 7 ------- 1 file changed, 7 deletions(-) delete mode 100644 source/Utils.hs diff --git a/source/Utils.hs b/source/Utils.hs deleted file mode 100644 index ed4fd84..0000000 --- a/source/Utils.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Utils where - -whileJust f = do - f' <- f - case f' of - Just x -> x : whileJust f - Nothing -> [] From 92b96720d582b538a39e7c967b3d550b70ef31e7 Mon Sep 17 00:00:00 2001 From: Jon Kristensen Date: Thu, 20 Dec 2012 23:21:39 +0100 Subject: [PATCH 02/15] Add missing modules to Cabal file Added the missing modules, that were not XEP files, to Other-Modules. --- pontarius-xmpp.cabal | 66 +++++++++++++++++++++++--------------------- 1 file changed, 35 insertions(+), 31 deletions(-) diff --git a/pontarius-xmpp.cabal b/pontarius-xmpp.cabal index c54a7f3..0a77516 100644 --- a/pontarius-xmpp.cabal +++ b/pontarius-xmpp.cabal @@ -55,37 +55,41 @@ Library Exposed-modules: Network.Xmpp , Network.Xmpp.IM , Network.Xmpp.Basic - Other-modules: - Network.Xmpp.Bind - , Network.Xmpp.Concurrent - , Network.Xmpp.IM.Message - , Network.Xmpp.IM.Presence - , Network.Xmpp.Marshal - , Network.Xmpp.Connection - , Network.Xmpp.Message - , Network.Xmpp.Pickle - , Network.Xmpp.Presence - , Network.Xmpp.Sasl - , Network.Xmpp.Sasl.Mechanisms - , Network.Xmpp.Sasl.Mechanisms.Plain - , Network.Xmpp.Sasl.Mechanisms.DigestMd5 - , Network.Xmpp.Sasl.Mechanisms.Scram - , Network.Xmpp.Sasl.Types - , Network.Xmpp.Session - , Network.Xmpp.Stream - , Network.Xmpp.TLS - , Network.Xmpp.Types - , Network.Xmpp.Xep.ServiceDiscovery - , Network.Xmpp.Jid - , Network.Xmpp.Concurrent.Types - , Network.Xmpp.Concurrent.Channels.IQ - , Network.Xmpp.Concurrent.Threads - , Network.Xmpp.Concurrent.Monad - , Text.XML.Stream.Elements - , Data.Conduit.TLS - , Network.Xmpp.Sasl.Common - , Network.Xmpp.Sasl.StringPrep - , Network.Xmpp.Errors + Other-modules: Data.Conduit.TLS + , Network.Xmpp.Bind + , Network.Xmpp.Concurrent + , Network.Xmpp.Concurrent.Types + , Network.Xmpp.Concurrent.Channels + , Network.Xmpp.Concurrent.Channels.Basic + , Network.Xmpp.Concurrent.Channels.IQ + , Network.Xmpp.Concurrent.Channels.Message + , Network.Xmpp.Concurrent.Channels.Presence + , Network.Xmpp.Concurrent.Channels.Types + , Network.Xmpp.Concurrent.Threads + , Network.Xmpp.Concurrent.Monad + , Network.Xmpp.Connection + , Network.Xmpp.Errors + , Network.Xmpp.IM.Message + , Network.Xmpp.IM.Presence + , Network.Xmpp.Jid + , Network.Xmpp.Marshal + , Network.Xmpp.Message + , Network.Xmpp.Pickle + , Network.Xmpp.Presence + , Network.Xmpp.Sasl + , Network.Xmpp.Sasl.Common + , Network.Xmpp.Sasl.Mechanisms + , Network.Xmpp.Sasl.Mechanisms.DigestMd5 + , Network.Xmpp.Sasl.Mechanisms.Plain + , Network.Xmpp.Sasl.Mechanisms.Scram + , Network.Xmpp.Sasl.StringPrep + , Network.Xmpp.Sasl.Types + , Network.Xmpp.Session + , Network.Xmpp.Stream + , Network.Xmpp.TLS + , Network.Xmpp.Types + , Network.Xmpp.Xep.ServiceDiscovery + , Text.XML.Stream.Elements GHC-Options: -Wall Source-Repository head From b096b2f1b3a42111873dbc4a5d53911b5505eea2 Mon Sep 17 00:00:00 2001 From: Jon Kristensen Date: Thu, 20 Dec 2012 23:26:10 +0100 Subject: [PATCH 03/15] Add toError catch-all line to prevent crashing upon unexpected stream error This is a temporary fix - we will have to revamp the error handling code. --- source/Network/Xmpp/Session.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/source/Network/Xmpp/Session.hs b/source/Network/Xmpp/Session.hs index 28be338..9070d0b 100644 --- a/source/Network/Xmpp/Session.hs +++ b/source/Network/Xmpp/Session.hs @@ -73,21 +73,20 @@ connectTcp address port hostname = do return $ Left e Right () -> return $ Right con where - -- TODO: Descriptive texts in stream errors? toError (StreamNotStreamElement _name) = XmppStreamError StreamInvalidXml Nothing Nothing toError (StreamInvalidStreamNamespace _ns) = XmppStreamError StreamInvalidNamespace Nothing Nothing toError (StreamInvalidStreamPrefix _prefix) = XmppStreamError StreamBadNamespacePrefix Nothing Nothing - -- TODO: Catch remaining xmppStartStream errors. toError (StreamWrongVersion _ver) = XmppStreamError StreamUnsupportedVersion Nothing Nothing toError (StreamWrongLangTag _) = XmppStreamError StreamInvalidXml Nothing Nothing toError StreamUnknownError = XmppStreamError StreamBadFormat Nothing Nothing - + -- TODO: Catch remaining xmppStartStream errors. + toError _ = XmppStreamError StreamBadFormat Nothing Nothing sessionXML :: Element sessionXML = pickleElem From 6c7aa54ea4586a982f82e70986c401e9ee4630b9 Mon Sep 17 00:00:00 2001 From: Jon Kristensen Date: Mon, 31 Dec 2012 06:09:58 +0100 Subject: [PATCH 04/15] Make the stream failure types more intuitive and clear StreamError has been renamed to StreamFailure, as it's neither an error or an exception, and since the term "stream error" is ambigous (it can also refer to the stream error element on the XMPP stream). Furthermore, XmppTLSError has been renamed to TLSFailure. The data types related to the above mentioned failures are now exported. We do no longer clutter the API with detailed error conditions such as StreamNotStreamElement. These kinds of conditions are such rare occurances, and details about them are better suited in the logging system (to be implemented soon). Stream failures can occur either when a `stream:error' first-level XML element is encountered, or if something unexpected happens in the stream. Currently, `StreamErrorFailure', `StreamEndFailure', and `StreamOtherFailure' are defined for these purposes, but additional exceptions can be added if that would be helpful for the developers. TLSFailure is moved to Types.hs and is now exported. Also temporarily removed findStreamErrors. --- source/Network/Xmpp.hs | 14 +++---- source/Network/Xmpp/Bind.hs | 4 +- source/Network/Xmpp/Concurrent/Monad.hs | 2 +- source/Network/Xmpp/Concurrent/Threads.hs | 6 +-- source/Network/Xmpp/Concurrent/Types.hs | 2 +- source/Network/Xmpp/Connection.hs | 32 +++++++------- source/Network/Xmpp/Errors.hs | 35 ---------------- source/Network/Xmpp/Marshal.hs | 8 ++-- source/Network/Xmpp/Sasl/Types.hs | 2 +- source/Network/Xmpp/Session.hs | 28 ++++++------- source/Network/Xmpp/Stream.hs | 22 +++++----- source/Network/Xmpp/TLS.hs | 22 +++------- source/Network/Xmpp/Types.hs | 51 ++++++++++++++--------- 13 files changed, 97 insertions(+), 131 deletions(-) diff --git a/source/Network/Xmpp.hs b/source/Network/Xmpp.hs index d2547da..c276b8b 100644 --- a/source/Network/Xmpp.hs +++ b/source/Network/Xmpp.hs @@ -2,11 +2,11 @@ -- Module: $Header$ -- Description: RFC 6120 (XMPP: Core). -- License: Apache License 2.0 --- +-- -- Maintainer: info@jonkri.com -- Stability: unstable -- Portability: portable --- +-- -- The Extensible Messaging and Presence Protocol (XMPP) is an open technology -- for near-real-time communication, which powers a wide range of applications -- including instant messaging, presence, multi-party chat, voice and video @@ -15,14 +15,10 @@ -- asynchronous, end-to-end exchange of structured data by means of direct, -- persistent XML streams among a distributed network of globally addressable, -- presence-aware clients and servers. --- +-- -- Pontarius is an XMPP client library, implementing the core capabilities of -- XMPP (RFC 6120): setup and teardown of XML streams, channel encryption, -- authentication, error handling, and communication primitives for messaging. --- --- Note that we are not recommending anyone to use Pontarius XMPP at this time --- as it's still in an experimental stage and will have its API and data types --- modified frequently. {-# LANGUAGE NoMonomorphismRestriction, OverloadedStrings #-} @@ -149,6 +145,10 @@ module Network.Xmpp , LangTag(..) , exampleParams , PortID(..) + , StreamFailure(..) + , StreamErrorInfo(..) + , StreamErrorCondition(..) + , TLSFailure(..) ) where diff --git a/source/Network/Xmpp/Bind.hs b/source/Network/Xmpp/Bind.hs index 50e9fe7..a61e556 100644 --- a/source/Network/Xmpp/Bind.hs +++ b/source/Network/Xmpp/Bind.hs @@ -34,8 +34,8 @@ xmppBind rsrc c = do jid <- case () of () | Right IQResult{iqResultPayload = Just b} <- answer , Right jid <- unpickleElem xpJid b -> return jid - | otherwise -> throw $ StreamXMLError - ("Bind couldn't unpickle JID from " ++ show answer) + | otherwise -> throw StreamOtherFailure + -- TODO: Log: ("Bind couldn't unpickle JID from " ++ show answer) withConnection (modify $ \s -> s{sJid = Just jid}) c return jid where diff --git a/source/Network/Xmpp/Concurrent/Monad.hs b/source/Network/Xmpp/Concurrent/Monad.hs index 070cab3..c6edf44 100644 --- a/source/Network/Xmpp/Concurrent/Monad.hs +++ b/source/Network/Xmpp/Concurrent/Monad.hs @@ -71,7 +71,7 @@ modifyHandlers f session = atomically $ modifyTVar (eventHandlers session) f writeTVar var (f x) -- | Sets the handler to be executed when the server connection is closed. -setConnectionClosedHandler :: (StreamError -> Context -> IO ()) -> Context -> IO () +setConnectionClosedHandler :: (StreamFailure -> Context -> IO ()) -> Context -> IO () setConnectionClosedHandler eh session = do modifyHandlers (\s -> s{connectionClosedHandler = \e -> eh e session}) session diff --git a/source/Network/Xmpp/Concurrent/Threads.hs b/source/Network/Xmpp/Concurrent/Threads.hs index 1ab1a23..89bf372 100644 --- a/source/Network/Xmpp/Concurrent/Threads.hs +++ b/source/Network/Xmpp/Concurrent/Threads.hs @@ -23,7 +23,7 @@ import GHC.IO (unsafeUnmask) -- Worker to read stanzas from the stream and concurrently distribute them to -- all listener threads. readWorker :: (Stanza -> IO ()) - -> (StreamError -> IO ()) + -> (StreamFailure -> IO ()) -> TMVar Connection -> IO a readWorker onStanza onConnectionClosed stateRef = @@ -43,7 +43,7 @@ readWorker onStanza onConnectionClosed stateRef = [ Ex.Handler $ \(Interrupt t) -> do void $ handleInterrupts [t] return Nothing - , Ex.Handler $ \(e :: StreamError) -> do + , Ex.Handler $ \(e :: StreamFailure) -> do onConnectionClosed e return Nothing ] @@ -96,7 +96,7 @@ startThreadsWith stanzaHandler eh con = do _ <- forM threads killThread return () -- Call the connection closed handlers. - noCon :: TVar EventHandlers -> StreamError -> IO () + noCon :: TVar EventHandlers -> StreamFailure -> IO () noCon h e = do hands <- atomically $ readTVar h _ <- forkIO $ connectionClosedHandler hands e diff --git a/source/Network/Xmpp/Concurrent/Types.hs b/source/Network/Xmpp/Concurrent/Types.hs index 962dbd1..0df18c3 100644 --- a/source/Network/Xmpp/Concurrent/Types.hs +++ b/source/Network/Xmpp/Concurrent/Types.hs @@ -15,7 +15,7 @@ import Network.Xmpp.Types -- | Handlers to be run when the Xmpp session ends and when the Xmpp connection is -- closed. data EventHandlers = EventHandlers - { connectionClosedHandler :: StreamError -> IO () + { connectionClosedHandler :: StreamFailure -> IO () } -- | Xmpp Context object diff --git a/source/Network/Xmpp/Connection.hs b/source/Network/Xmpp/Connection.hs index 2269d8b..4e0d31f 100644 --- a/source/Network/Xmpp/Connection.hs +++ b/source/Network/Xmpp/Connection.hs @@ -78,14 +78,14 @@ pullElement = do Ex.catches (do e <- runEventsSink (elements =$ await) case e of - Nothing -> liftIO $ Ex.throwIO StreamConnectionError + Nothing -> liftIO $ Ex.throwIO StreamOtherFailure Just r -> return r ) - [ Ex.Handler (\StreamEnd -> Ex.throwIO StreamStreamEnd) - , Ex.Handler (\(InvalidXmppXml s) - -> liftIO . Ex.throwIO $ StreamXMLError s) - , Ex.Handler $ \(e :: InvalidEventStream) - -> liftIO . Ex.throwIO $ StreamXMLError (show e) + [ Ex.Handler (\StreamEnd -> Ex.throwIO StreamEndFailure) + , Ex.Handler (\(InvalidXmppXml s) -- Invalid XML `Event' encountered, or missing element close tag + -> liftIO . Ex.throwIO $ StreamOtherFailure) -- TODO: Log: s + , Ex.Handler $ \(e :: InvalidEventStream) -- xml-conduit exception + -> liftIO . Ex.throwIO $ StreamOtherFailure -- TODO: Log: (show e) ] -- Pulls an element and unpickles it. @@ -93,7 +93,7 @@ pullUnpickle :: PU [Node] a -> StateT Connection_ IO a pullUnpickle p = do res <- unpickleElem p <$> pullElement case res of - Left e -> liftIO . Ex.throwIO $ StreamXMLError (show e) + Left e -> liftIO $ Ex.throwIO e Right r -> return r -- | Pulls a stanza (or stream error) from the stream. Throws an error on a stream @@ -102,7 +102,7 @@ pullStanza :: Connection -> IO Stanza pullStanza = withConnection' $ do res <- pullUnpickle xpStreamStanza case res of - Left e -> liftIO . Ex.throwIO $ StreamError e + Left e -> liftIO . Ex.throwIO $ StreamErrorFailure e Right r -> return r -- Performs the given IO operation, catches any errors and re-throws everything @@ -121,7 +121,7 @@ xmppNoConnection :: Connection_ xmppNoConnection = Connection_ { cHand = Hand { cSend = \_ -> return False , cRecv = \_ -> Ex.throwIO - $ StreamConnectionError + $ StreamOtherFailure , cFlush = return () , cClose = return () } @@ -139,7 +139,7 @@ xmppNoConnection = Connection_ } where zeroSource :: Source IO output - zeroSource = liftIO . Ex.throwIO $ StreamConnectionError + zeroSource = liftIO . Ex.throwIO $ StreamOtherFailure -- Connects to the given hostname on port 5222 (TODO: Make this dynamic) and -- updates the XmppConMonad Connection_ state. @@ -205,12 +205,12 @@ pushIQ' iqID to tp lang body con = do IQResultS r -> do unless (iqID == iqResultID r) . liftIO . Ex.throwIO $ - StreamXMLError - ("In sendIQ' IDs don't match: " ++ show iqID ++ " /= " ++ - show (iqResultID r) ++ " .") + StreamOtherFailure + -- TODO: Log: ("In sendIQ' IDs don't match: " ++ show iqID ++ + -- " /= " ++ show (iqResultID r) ++ " .") return $ Right r - _ -> liftIO . Ex.throwIO . StreamXMLError $ - "sendIQ': unexpected stanza type " + _ -> liftIO $ Ex.throwIO StreamOtherFailure + -- TODO: Log: "sendIQ': unexpected stanza type " -- | Send "" and wait for the server to finish processing and to -- close the connection. Any remaining elements from the server and whether or @@ -232,7 +232,7 @@ closeStreams = withConnection $ do collectElems es = do result <- Ex.try pullElement case result of - Left StreamStreamEnd -> return (es, True) + Left StreamEndFailure -> return (es, True) Left _ -> return (es, False) Right e -> collectElems (e:es) diff --git a/source/Network/Xmpp/Errors.hs b/source/Network/Xmpp/Errors.hs index 0172b6d..6e04d49 100644 --- a/source/Network/Xmpp/Errors.hs +++ b/source/Network/Xmpp/Errors.hs @@ -12,38 +12,3 @@ import Network.Xmpp.Types import Network.Xmpp.Pickle --- Finds unpickling problems. Not to be used for data validation -findStreamErrors :: Element -> StreamError -findStreamErrors (Element name attrs children) - | (nameLocalName name /= "stream") - = StreamNotStreamElement $ nameLocalName name - | (nameNamespace name /= Just "http://etherx.jabber.org/streams") - = StreamInvalidStreamNamespace $ nameNamespace name - | otherwise = checkchildren (flattenAttrs attrs) - where - checkchildren children = - let to' = lookup "to" children - ver' = lookup "version" children - xl = lookup xmlLang children - in case () of () | Just (Nothing :: Maybe Jid) == (safeRead <$> to') - -> StreamWrongTo to' - | Nothing == ver' - -> StreamWrongVersion Nothing - | Just (Nothing :: Maybe LangTag) == - (safeRead <$> xl) - -> StreamWrongLangTag xl - | otherwise - -> StreamUnknownError - safeRead x = case reads $ Text.unpack x of - [] -> Nothing - [(y,_),_] -> Just y - -flattenAttrs :: [(Name, [Content])] -> [(Name, Text.Text)] -flattenAttrs attrs = map (\(name, content) -> - ( name - , Text.concat $ map uncontentify content) - ) - attrs - where - uncontentify (ContentText t) = t - uncontentify _ = "" \ No newline at end of file diff --git a/source/Network/Xmpp/Marshal.hs b/source/Network/Xmpp/Marshal.hs index 4de88c4..bf5e5fa 100644 --- a/source/Network/Xmpp/Marshal.hs +++ b/source/Network/Xmpp/Marshal.hs @@ -14,7 +14,7 @@ import Data.XML.Types import Network.Xmpp.Pickle import Network.Xmpp.Types -xpStreamStanza :: PU [Node] (Either XmppStreamError Stanza) +xpStreamStanza :: PU [Node] (Either StreamErrorInfo Stanza) xpStreamStanza = xpEither xpStreamError xpStanza xpStanza :: PU [Node] Stanza @@ -182,10 +182,10 @@ xpIQError = xpWrap (xp2Tuple xpStanzaError (xpOption xpElemVerbatim)) ) -xpStreamError :: PU [Node] XmppStreamError +xpStreamError :: PU [Node] StreamErrorInfo xpStreamError = xpWrap - (\((cond,() ,()), txt, el) -> XmppStreamError cond txt el) - (\(XmppStreamError cond txt el) ->((cond,() ,()), txt, el)) + (\((cond,() ,()), txt, el) -> StreamErrorInfo cond txt el) + (\(StreamErrorInfo cond txt el) ->((cond,() ,()), txt, el)) (xpElemNodes (Name "error" diff --git a/source/Network/Xmpp/Sasl/Types.hs b/source/Network/Xmpp/Sasl/Types.hs index a11f9ef..8c104d3 100644 --- a/source/Network/Xmpp/Sasl/Types.hs +++ b/source/Network/Xmpp/Sasl/Types.hs @@ -13,7 +13,7 @@ data AuthError = AuthXmlError | AuthChallengeError | AuthServerAuthError -- ^ The server failed to authenticate -- itself - | AuthStreamError StreamError -- ^ Stream error on stream restart + | AuthStreamError StreamFailure -- ^ Stream error on stream restart -- TODO: Rename AuthConnectionError? | AuthConnectionError -- ^ Connection is closed | AuthError -- General instance used for the Error instance diff --git a/source/Network/Xmpp/Session.hs b/source/Network/Xmpp/Session.hs index 9070d0b..59b4b72 100644 --- a/source/Network/Xmpp/Session.hs +++ b/source/Network/Xmpp/Session.hs @@ -61,7 +61,7 @@ simpleConnect host port hostname username password resource = do -- | Connect to host with given address. -connectTcp :: HostName -> PortID -> Text -> IO (Either StreamError Connection) +connectTcp :: HostName -> PortID -> Text -> IO (Either StreamFailure Connection) connectTcp address port hostname = do con <- connectTcpRaw address port hostname result <- withConnection startStream con @@ -73,20 +73,20 @@ connectTcp address port hostname = do return $ Left e Right () -> return $ Right con where - toError (StreamNotStreamElement _name) = - XmppStreamError StreamInvalidXml Nothing Nothing - toError (StreamInvalidStreamNamespace _ns) = - XmppStreamError StreamInvalidNamespace Nothing Nothing - toError (StreamInvalidStreamPrefix _prefix) = - XmppStreamError StreamBadNamespacePrefix Nothing Nothing - toError (StreamWrongVersion _ver) = - XmppStreamError StreamUnsupportedVersion Nothing Nothing - toError (StreamWrongLangTag _) = - XmppStreamError StreamInvalidXml Nothing Nothing - toError StreamUnknownError = - XmppStreamError StreamBadFormat Nothing Nothing + -- toError (StreamNotStreamElement _name) = + -- XmppStreamFailure StreamInvalidXml Nothing Nothing + -- toError (StreamInvalidStreamNamespace _ns) = + -- XmppStreamFailure StreamInvalidNamespace Nothing Nothing + -- toError (StreamInvalidStreamPrefix _prefix) = + -- XmppStreamFailure StreamBadNamespacePrefix Nothing Nothing + -- toError (StreamWrongVersion _ver) = + -- XmppStreamFailure StreamUnsupportedVersion Nothing Nothing + -- toError (StreamWrongLangTag _) = + -- XmppStreamFailure StreamInvalidXml Nothing Nothing + -- toError StreamUnknownError = + -- XmppStreamFailure StreamBadFormat Nothing Nothing -- TODO: Catch remaining xmppStartStream errors. - toError _ = XmppStreamError StreamBadFormat Nothing Nothing + toError _ = StreamErrorInfo StreamBadFormat Nothing Nothing sessionXML :: Element sessionXML = pickleElem diff --git a/source/Network/Xmpp/Stream.hs b/source/Network/Xmpp/Stream.hs index 9af9a5c..87bba00 100644 --- a/source/Network/Xmpp/Stream.hs +++ b/source/Network/Xmpp/Stream.hs @@ -36,12 +36,12 @@ streamUnpickleElem :: PU [Node] a -> StreamSink a streamUnpickleElem p x = do case unpickleElem p x of - Left l -> throwError $ StreamXMLError (show l) + Left l -> throwError $ StreamOtherFailure -- TODO: Log: StreamXMLError (show l) Right r -> return r -- This is the conduit sink that handles the stream XML events. We extend it -- with ErrorT capabilities. -type StreamSink a = ErrorT StreamError (Pipe Event Event Void () IO) a +type StreamSink a = ErrorT StreamFailure (Pipe Event Event Void () IO) a -- Discards all events before the first EventBeginElement. throwOutJunk :: Monad m => Sink Event m () @@ -59,10 +59,10 @@ openElementFromEvents = do hd <- lift CL.head case hd of Just (EventBeginElement name attrs) -> return $ Element name attrs [] - _ -> throwError $ StreamConnectionError + _ -> throwError $ StreamOtherFailure -- Sends the initial stream:stream element and pulls the server features. -startStream :: StateT Connection_ IO (Either StreamError ()) +startStream :: StateT Connection_ IO (Either StreamFailure ()) startStream = runErrorT $ do state <- get -- Set the `to' attribute depending on the state of the connection. @@ -71,7 +71,7 @@ startStream = runErrorT $ do then sJid state else Nothing ConnectionSecured -> sJid state case sHostname state of - Nothing -> throwError StreamConnectionError + Nothing -> throwError StreamOtherFailure Just hostname -> lift $ do pushXmlDecl pushOpenElement $ @@ -92,7 +92,7 @@ startStream = runErrorT $ do -- Sets a new Event source using the raw source (of bytes) -- and calls xmppStartStream. -restartStream :: StateT Connection_ IO (Either StreamError ()) +restartStream :: StateT Connection_ IO (Either StreamFailure ()) restartStream = do raw <- gets (cRecv . cHand) let newSource = DCI.ResumableSource (loopRead raw $= XP.parseBytes def) @@ -126,19 +126,19 @@ streamS expectedTo = do -- and validate what we get. el <- openElementFromEvents case unpickleElem xpStream el of - Left _ -> throwError $ findStreamErrors el + Left _ -> throwError StreamOtherFailure -- TODO: findStreamErrors el Right r -> validateData r - validateData (_, _, _, _, Nothing) = throwError $ StreamWrongLangTag Nothing + validateData (_, _, _, _, Nothing) = throwError StreamOtherFailure -- StreamWrongLangTag Nothing validateData (ver, from, to, i, Just lang) - | ver /= "1.0" = throwError $ StreamWrongVersion (Just ver) - | isJust to && to /= expectedTo = throwError $ StreamWrongTo (Text.pack . show <$> to) + | ver /= "1.0" = throwError StreamOtherFailure -- StreamWrongVersion (Just ver) + | isJust to && to /= expectedTo = throwError StreamOtherFailure -- StreamWrongTo (Text.pack . show <$> to) | otherwise = return (from, to, i, lang) xmppStreamFeatures :: StreamSink ServerFeatures xmppStreamFeatures = do e <- lift $ elements =$ CL.head case e of - Nothing -> liftIO $ Ex.throwIO StreamConnectionError + Nothing -> liftIO $ Ex.throwIO StreamOtherFailure Just r -> streamUnpickleElem xpStreamFeatures r diff --git a/source/Network/Xmpp/TLS.hs b/source/Network/Xmpp/TLS.hs index 13742c7..ac68f3e 100644 --- a/source/Network/Xmpp/TLS.hs +++ b/source/Network/Xmpp/TLS.hs @@ -72,21 +72,9 @@ exampleParams = TLS.defaultParamsClient return TLS.CertificateUsageAccept } --- | Error conditions that may arise during TLS negotiation. -data XmppTLSError = TLSError TLSError - | TLSNoServerSupport - | TLSNoConnection - | TLSConnectionSecured -- ^ Connection already secured - | TLSStreamError StreamError - | XmppTLSError -- General instance used for the Error instance - deriving (Show, Eq, Typeable) - -instance Error XmppTLSError where - noMsg = XmppTLSError - -- Pushes ", waits for "", performs the TLS handshake, and --- restarts the stream. May throw errors. -startTLS :: TLS.TLSParams -> Connection -> IO (Either XmppTLSError ()) +-- restarts the stream. +startTLS :: TLS.TLSParams -> Connection -> IO (Either TLSFailure ()) startTLS params con = Ex.handle (return . Left . TLSError) . flip withConnection con . runErrorT $ do @@ -103,10 +91,10 @@ startTLS params con = Ex.handle (return . Left . TLSError) case answer of Element "{urn:ietf:params:xml:ns:xmpp-tls}proceed" [] [] -> return () Element "{urn:ietf:params:xml:ns:xmpp-tls}failure" _ _ -> - lift . Ex.throwIO $ StreamConnectionError + lift $ Ex.throwIO StreamOtherFailure -- TODO: find something more suitable - e -> lift . Ex.throwIO . StreamXMLError $ - "Unexpected element: " ++ ppElement e + e -> lift $ Ex.throwIO StreamOtherFailure + -- TODO: Log: "Unexpected element: " ++ ppElement e (raw, _snk, psh, read, ctx) <- lift $ TLS.tlsinit debug params (mkBackend con) let newHand = Hand { cSend = catchPush . psh , cRecv = read diff --git a/source/Network/Xmpp/Types.hs b/source/Network/Xmpp/Types.hs index 63e139a..6af878c 100644 --- a/source/Network/Xmpp/Types.hs +++ b/source/Network/Xmpp/Types.hs @@ -28,7 +28,7 @@ module Network.Xmpp.Types , StanzaErrorCondition(..) , StanzaErrorType(..) , StanzaId(..) - , StreamError(..) + , StreamFailure(..) , StreamErrorCondition(..) , Version(..) , HandleLike(..) @@ -38,8 +38,9 @@ module Network.Xmpp.Types , withConnection' , mkConnection , ConnectionState(..) - , XmppStreamError(..) + , StreamErrorInfo(..) , langTag + , TLSFailure(..) , module Network.Xmpp.Jid ) where @@ -62,6 +63,7 @@ import qualified Data.Text as Text import Data.Typeable(Typeable) import Data.XML.Types +import qualified Network.TLS as TLS import qualified Network as N @@ -619,28 +621,26 @@ instance Read StreamErrorCondition where readsPrec _ "unsupported-version" = [(StreamUnsupportedVersion , "")] readsPrec _ _ = [(StreamUndefinedCondition , "")] -data XmppStreamError = XmppStreamError +-- | Encapsulates information about an XMPP stream error. +data StreamErrorInfo = StreamErrorInfo { errorCondition :: !StreamErrorCondition , errorText :: !(Maybe (Maybe LangTag, Text)) , errorXML :: !(Maybe Element) } deriving (Show, Eq) -data StreamError = StreamError XmppStreamError - | StreamUnknownError -- Something has gone wrong, but we don't - -- know what - | StreamNotStreamElement Text - | StreamInvalidStreamNamespace (Maybe Text) - | StreamInvalidStreamPrefix (Maybe Text) - | StreamWrongTo (Maybe Text) - | StreamWrongVersion (Maybe Text) - | StreamWrongLangTag (Maybe Text) - | StreamXMLError String -- If stream pickling goes wrong. - | StreamStreamEnd -- received closing stream tag - | StreamConnectionError - deriving (Show, Eq, Typeable) - -instance Exception StreamError -instance Error StreamError where noMsg = StreamConnectionError +-- | Signals an XMPP stream error or another unpredicted stream-related +-- situation. +data StreamFailure = StreamErrorFailure StreamErrorInfo -- ^ An error XML stream + -- element has been + -- encountered. + | StreamEndFailure -- ^ The server has closed the stream. + | StreamOtherFailure -- ^ Undefined condition. More + -- information should be available in + -- the log. + deriving (Show, Eq, Typeable) + +instance Exception StreamFailure +instance Error StreamFailure where noMsg = StreamOtherFailure -- ============================================================================= -- XML TYPES @@ -811,3 +811,16 @@ withConnection' action (Connection con) = do mkConnection :: Connection_ -> IO Connection mkConnection con = Connection `fmap` (atomically $ newTMVar con) + + +-- | Failure conditions that may arise during TLS negotiation. +data TLSFailure = TLSError TLS.TLSError + | TLSNoServerSupport + | TLSNoConnection + | TLSConnectionSecured -- ^ Connection already secured + | TLSStreamError StreamFailure + | TLSFailureError -- General instance used for the Error instance (TODO) + deriving (Show, Eq, Typeable) + +instance Error TLSFailure where + noMsg = TLSFailureError From 03af48942336087e2e29dc27e5c523f40398104d Mon Sep 17 00:00:00 2001 From: Jon Kristensen Date: Mon, 31 Dec 2012 22:47:21 +0100 Subject: [PATCH 05/15] Enable proof-of-concept logging by use of hslogger Started to use hslogger in `EchoClient' and `connectTcpRaw'. Pontarius XMPP now shows all binary data going in and out at the `debug' level. Also modified the TCP conduit byte source to log the incoming data. --- examples/EchoClient.hs | 10 ++++++++ pontarius-xmpp.cabal | 1 + source/Network/Xmpp/Connection.hs | 40 +++++++++++++++++++++---------- 3 files changed, 39 insertions(+), 12 deletions(-) diff --git a/examples/EchoClient.hs b/examples/EchoClient.hs index 953cc2b..62f7175 100644 --- a/examples/EchoClient.hs +++ b/examples/EchoClient.hs @@ -22,6 +22,11 @@ import Text.Printf import Network.Xmpp import Network.Xmpp.IM +import System.Log.Formatter +import System.Log.Logger +import System.Log.Handler hiding (setLevel) +import System.Log.Handler.Simple +import System.IO (stderr) -- Server and authentication details. host = "localhost" @@ -41,6 +46,11 @@ autoAccept session = forever $ do main :: IO () main = do + updateGlobalLogger "Pontarius.Xmpp" $ setLevel DEBUG + handler <- streamHandler stderr DEBUG >>= \h -> + return $ setFormatter h (simpleLogFormatter "$time - $loggername: $prio: $msg") + updateGlobalLogger "Pontarius.Xmpp" (addHandler handler) + sess <- simpleConnect host port diff --git a/pontarius-xmpp.cabal b/pontarius-xmpp.cabal index 0a77516..7007be0 100644 --- a/pontarius-xmpp.cabal +++ b/pontarius-xmpp.cabal @@ -52,6 +52,7 @@ Library , xml-picklers >=0.2.2 , data-default >=0.2 , stringprep >=0.1.3 + , hslogger >=1.1.0 Exposed-modules: Network.Xmpp , Network.Xmpp.IM , Network.Xmpp.Basic diff --git a/source/Network/Xmpp/Connection.hs b/source/Network/Xmpp/Connection.hs index 4e0d31f..942ba8a 100644 --- a/source/Network/Xmpp/Connection.hs +++ b/source/Network/Xmpp/Connection.hs @@ -15,12 +15,14 @@ import qualified GHC.IO.Exception as GIE import Control.Monad.State.Strict import Data.ByteString as BS +import Data.ByteString.Char8 as BSC8 import Data.Conduit import Data.Conduit.Binary as CB import Data.Conduit.Internal as DCI import qualified Data.Conduit.List as CL import Data.IORef import Data.Text(Text) +import qualified Data.Text as T import Data.XML.Pickle import Data.XML.Types @@ -35,6 +37,9 @@ import Text.XML.Stream.Elements import Text.XML.Stream.Parse as XP import Text.XML.Unresolved(InvalidEventStream(..)) +import System.Log.Logger +import Data.ByteString.Base64 + -- Enable/disable debug output -- This will dump all incoming and outgoing network taffic to the console, -- prefixed with "in: " and "out: " respectively @@ -145,21 +150,25 @@ xmppNoConnection = Connection_ -- updates the XmppConMonad Connection_ state. connectTcpRaw :: HostName -> PortID -> Text -> IO Connection connectTcpRaw host port hostname = do + let PortNumber portNumber = port + debugM "Pontarius.Xmpp" $ "Connecting to " ++ host ++ " on port " ++ + (show portNumber) ++ " through the realm " ++ (T.unpack hostname) ++ "." h <- connectTo host port + debugM "Pontarius.Xmpp" "Setting NoBuffering mode on handle." hSetBuffering h NoBuffering - let eSource = DCI.ResumableSource (sourceHandle h $= XP.parseBytes def) + let eSource = DCI.ResumableSource ((sourceHandle h $= logConduit) $= XP.parseBytes def) (return ()) - let hand = Hand { cSend = if debug - then \d -> do - BS.putStrLn (BS.append "out: " d) - catchPush $ BS.hPut h d - else catchPush . BS.hPut h - , cRecv = if debug then - \n -> do - bs <- BS.hGetSome h n - BS.putStrLn bs - return bs - else BS.hGetSome h + let hand = Hand { cSend = \d -> do + let d64 = encode d + debugM "Pontarius.Xmpp" $ "Sending TCP data: " ++ + (BSC8.unpack d64) ++ "." + catchPush $ BS.hPut h d + , cRecv = \n -> do + d <- BS.hGetSome h n + let d64 = encode d + debugM "Pontarius.Xmpp" $ "Received TCP data: " ++ + (BSC8.unpack d64) ++ "." + return d , cFlush = hFlush h , cClose = hClose h } @@ -178,6 +187,13 @@ connectTcpRaw host port hostname = do , sFrom = Nothing } mkConnection con + where + logConduit :: Conduit ByteString IO ByteString + logConduit = CL.mapM $ \d -> do + let d64 = encode d + debugM "Pontarius.Xmpp" $ "Received TCP data: " ++ (BSC8.unpack d64) ++ + "." + return d -- Closes the connection and updates the XmppConMonad Connection_ state. From c34982dba9ae16be1669c2cb1b33792aab316286 Mon Sep 17 00:00:00 2001 From: Jon Kristensen Date: Tue, 1 Jan 2013 23:50:22 +0100 Subject: [PATCH 06/15] Projects/Pontarius/Apply various minor fixes Started using double quotes instead of single quotes on XMLDecl, to conform to the quotations of the other XML. To conform with the Haskell style guidelines, `TLS' is now spelled `Tls', and `XML' is now spelled `Xml'. Updated library name in README file. --- README | 4 ++-- pontarius-xmpp.cabal | 6 +++--- source/Data/Conduit/{TLS.hs => Tls.hs} | 2 +- source/Network/Xmpp.hs | 10 +++++----- source/Network/Xmpp/Basic.hs | 4 ++-- source/Network/Xmpp/Concurrent/Channels.hs | 2 +- source/Network/Xmpp/Connection.hs | 4 ++-- source/Network/Xmpp/Pickle.hs | 2 +- source/Network/Xmpp/Session.hs | 12 ++++++------ source/Network/Xmpp/Stream.hs | 12 ++++++------ source/Network/Xmpp/{TLS.hs => Tls.hs} | 14 +++++++------- source/Network/Xmpp/Types.hs | 20 ++++++++++---------- source/Network/Xmpp/Xep/ServiceDiscovery.hs | 8 ++++---- source/Text/{XML => Xml}/Stream/Elements.hs | 2 +- 14 files changed, 51 insertions(+), 51 deletions(-) rename source/Data/Conduit/{TLS.hs => Tls.hs} (98%) rename source/Network/Xmpp/{TLS.hs => Tls.hs} (90%) rename source/Text/{XML => Xml}/Stream/Elements.hs (97%) diff --git a/README b/README index b4a7bee..b502625 100644 --- a/README +++ b/README @@ -1,2 +1,2 @@ -Pontarius is an active work in progress to build a Haskell XMPP library that -implements the client capabilities of RFC 6120 ("XMPP Core"). \ No newline at end of file +Pontarius XMPP is an active work in progress to build a Haskell XMPP library +that implements the client capabilities of RFC 6120 ("XMPP Core"). diff --git a/pontarius-xmpp.cabal b/pontarius-xmpp.cabal index 7007be0..aa760aa 100644 --- a/pontarius-xmpp.cabal +++ b/pontarius-xmpp.cabal @@ -56,7 +56,7 @@ Library Exposed-modules: Network.Xmpp , Network.Xmpp.IM , Network.Xmpp.Basic - Other-modules: Data.Conduit.TLS + Other-modules: Data.Conduit.Tls , Network.Xmpp.Bind , Network.Xmpp.Concurrent , Network.Xmpp.Concurrent.Types @@ -87,10 +87,10 @@ Library , Network.Xmpp.Sasl.Types , Network.Xmpp.Session , Network.Xmpp.Stream - , Network.Xmpp.TLS + , Network.Xmpp.Tls , Network.Xmpp.Types , Network.Xmpp.Xep.ServiceDiscovery - , Text.XML.Stream.Elements + , Text.Xml.Stream.Elements GHC-Options: -Wall Source-Repository head diff --git a/source/Data/Conduit/TLS.hs b/source/Data/Conduit/Tls.hs similarity index 98% rename from source/Data/Conduit/TLS.hs rename to source/Data/Conduit/Tls.hs index 68fa23b..17e4d19 100644 --- a/source/Data/Conduit/TLS.hs +++ b/source/Data/Conduit/Tls.hs @@ -1,6 +1,6 @@ {-# Language NoMonomorphismRestriction #-} {-# OPTIONS_HADDOCK hide #-} -module Data.Conduit.TLS +module Data.Conduit.Tls ( tlsinit -- , conduitStdout , module TLS diff --git a/source/Network/Xmpp.hs b/source/Network/Xmpp.hs index c276b8b..f7a686b 100644 --- a/source/Network/Xmpp.hs +++ b/source/Network/Xmpp.hs @@ -25,11 +25,11 @@ module Network.Xmpp ( -- * Session management Session + , simpleConnect + , connectTcp , newSession , withConnection - , connectTcp - , simpleConnect - , startTLS + , startTls , simpleAuth , auth , scramSha1 @@ -148,7 +148,7 @@ module Network.Xmpp , StreamFailure(..) , StreamErrorInfo(..) , StreamErrorCondition(..) - , TLSFailure(..) + , TlsFailure(..) ) where @@ -166,5 +166,5 @@ import Network.Xmpp.Presence import Network.Xmpp.Sasl import Network.Xmpp.Session import Network.Xmpp.Stream -import Network.Xmpp.TLS +import Network.Xmpp.Tls import Network.Xmpp.Types diff --git a/source/Network/Xmpp/Basic.hs b/source/Network/Xmpp/Basic.hs index 4f31f0a..5ee4058 100644 --- a/source/Network/Xmpp/Basic.hs +++ b/source/Network/Xmpp/Basic.hs @@ -3,7 +3,7 @@ module Network.Xmpp.Basic , ConnectionState(..) , connectTcp , simpleConnect - , startTLS + , startTls , simpleAuth , auth , scramSha1 @@ -19,5 +19,5 @@ import Network.Xmpp.Connection import Network.Xmpp.Sasl import Network.Xmpp.Session import Network.Xmpp.Stream -import Network.Xmpp.TLS +import Network.Xmpp.Tls import Network.Xmpp.Types diff --git a/source/Network/Xmpp/Concurrent/Channels.hs b/source/Network/Xmpp/Concurrent/Channels.hs index 31c294a..9516afb 100644 --- a/source/Network/Xmpp/Concurrent/Channels.hs +++ b/source/Network/Xmpp/Concurrent/Channels.hs @@ -32,7 +32,7 @@ import Network.Xmpp.Concurrent.Types import Network.Xmpp.Marshal import Network.Xmpp.Pickle import Network.Xmpp.Types -import Text.XML.Stream.Elements +import Text.Xml.Stream.Elements toChans :: TChan Stanza -> TVar IQHandlers diff --git a/source/Network/Xmpp/Connection.hs b/source/Network/Xmpp/Connection.hs index 942ba8a..1d682fa 100644 --- a/source/Network/Xmpp/Connection.hs +++ b/source/Network/Xmpp/Connection.hs @@ -33,7 +33,7 @@ import Network.Xmpp.Pickle import System.IO -import Text.XML.Stream.Elements +import Text.Xml.Stream.Elements import Text.XML.Stream.Parse as XP import Text.XML.Unresolved(InvalidEventStream(..)) @@ -62,7 +62,7 @@ pushStanza s = withConnection' . pushElement $ pickleElem xpStanza s pushXmlDecl :: StateT Connection_ IO Bool pushXmlDecl = do con <- gets cHand - liftIO $ (cSend con) "" + liftIO $ (cSend con) "" pushOpenElement :: Element -> StateT Connection_ IO Bool pushOpenElement e = do diff --git a/source/Network/Xmpp/Pickle.hs b/source/Network/Xmpp/Pickle.hs index e00e190..e16cb2e 100644 --- a/source/Network/Xmpp/Pickle.hs +++ b/source/Network/Xmpp/Pickle.hs @@ -27,7 +27,7 @@ import Data.XML.Pickle import Network.Xmpp.Types -import Text.XML.Stream.Elements +import Text.Xml.Stream.Elements mbToBool :: Maybe t -> Bool mbToBool (Just _) = True diff --git a/source/Network/Xmpp/Session.hs b/source/Network/Xmpp/Session.hs index 59b4b72..0902407 100644 --- a/source/Network/Xmpp/Session.hs +++ b/source/Network/Xmpp/Session.hs @@ -19,7 +19,7 @@ import Network.Xmpp.Sasl import Network.Xmpp.Sasl.Mechanisms import Network.Xmpp.Sasl.Types import Network.Xmpp.Stream -import Network.Xmpp.TLS +import Network.Xmpp.Tls import Network.Xmpp.Types -- | The quick and easy way to set up a connection to an XMPP server @@ -53,7 +53,7 @@ simpleConnect host port hostname username password resource = do con <- case con' of Left e -> Ex.throwIO e Right r -> return r - startTLS exampleParams con + startTls exampleParams con saslResponse <- simpleAuth username password resource con case saslResponse of Right jid -> newSession con @@ -88,8 +88,8 @@ connectTcp address port hostname = do -- TODO: Catch remaining xmppStartStream errors. toError _ = StreamErrorInfo StreamBadFormat Nothing Nothing -sessionXML :: Element -sessionXML = pickleElem +sessionXml :: Element +sessionXml = pickleElem (xpElemBlank "{urn:ietf:params:xml:ns:xmpp-session}session") () @@ -99,14 +99,14 @@ sessionIQ = IQRequestS $ IQRequest { iqRequestID = "sess" , iqRequestTo = Nothing , iqRequestLangTag = Nothing , iqRequestType = Set - , iqRequestPayload = sessionXML + , iqRequestPayload = sessionXml } -- Sends the session IQ set element and waits for an answer. Throws an error if -- if an IQ error stanza is returned from the server. startSession :: Connection -> IO () startSession con = do - answer <- pushIQ' "session" Nothing Set Nothing sessionXML con + answer <- pushIQ' "session" Nothing Set Nothing sessionXml con case answer of Left e -> error $ show e Right _ -> return () diff --git a/source/Network/Xmpp/Stream.hs b/source/Network/Xmpp/Stream.hs index 87bba00..5e197ca 100644 --- a/source/Network/Xmpp/Stream.hs +++ b/source/Network/Xmpp/Stream.hs @@ -25,18 +25,18 @@ import Network.Xmpp.Errors import Network.Xmpp.Pickle import Network.Xmpp.Types -import Text.XML.Stream.Elements +import Text.Xml.Stream.Elements import Text.XML.Stream.Parse as XP -- import Text.XML.Stream.Elements --- Unpickles and returns a stream element. Throws a StreamXMLError on failure. +-- Unpickles and returns a stream element. Throws a StreamXmlError on failure. streamUnpickleElem :: PU [Node] a -> Element -> StreamSink a streamUnpickleElem p x = do case unpickleElem p x of - Left l -> throwError $ StreamOtherFailure -- TODO: Log: StreamXMLError (show l) + Left l -> throwError $ StreamOtherFailure -- TODO: Log: StreamXmlError (show l) Right r -> return r -- This is the conduit sink that handles the stream XML events. We extend it @@ -166,14 +166,14 @@ xpStreamFeatures = xpWrap (Just "stream") ) (xpTriple - (xpOption pickleTLSFeature) + (xpOption pickleTlsFeature) (xpOption pickleSaslFeature) (xpAll xpElemVerbatim) ) ) where - pickleTLSFeature :: PU [Node] Bool - pickleTLSFeature = xpElemNodes "{urn:ietf:params:xml:ns:xmpp-tls}starttls" + pickleTlsFeature :: PU [Node] Bool + pickleTlsFeature = xpElemNodes "{urn:ietf:params:xml:ns:xmpp-tls}starttls" (xpElemExists "required") pickleSaslFeature :: PU [Node] [Text] pickleSaslFeature = xpElemNodes diff --git a/source/Network/Xmpp/TLS.hs b/source/Network/Xmpp/Tls.hs similarity index 90% rename from source/Network/Xmpp/TLS.hs rename to source/Network/Xmpp/Tls.hs index ac68f3e..f3db8d5 100644 --- a/source/Network/Xmpp/TLS.hs +++ b/source/Network/Xmpp/Tls.hs @@ -2,7 +2,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} -module Network.Xmpp.TLS where +module Network.Xmpp.Tls where import qualified Control.Exception.Lifted as Ex import Control.Monad @@ -13,7 +13,7 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL import Data.Conduit import qualified Data.Conduit.Binary as CB -import Data.Conduit.TLS as TLS +import Data.Conduit.Tls as TLS import Data.Typeable import Data.XML.Types @@ -74,18 +74,18 @@ exampleParams = TLS.defaultParamsClient -- Pushes ", waits for "", performs the TLS handshake, and -- restarts the stream. -startTLS :: TLS.TLSParams -> Connection -> IO (Either TLSFailure ()) -startTLS params con = Ex.handle (return . Left . TLSError) +startTls :: TLS.TLSParams -> Connection -> IO (Either TlsFailure ()) +startTls params con = Ex.handle (return . Left . TlsError) . flip withConnection con . runErrorT $ do features <- lift $ gets sFeatures state <- gets sConnectionState case state of ConnectionPlain -> return () - ConnectionClosed -> throwError TLSNoConnection - ConnectionSecured -> throwError TLSConnectionSecured + ConnectionClosed -> throwError TlsNoConnection + ConnectionSecured -> throwError TlsConnectionSecured con <- lift $ gets cHand - when (stls features == Nothing) $ throwError TLSNoServerSupport + when (stls features == Nothing) $ throwError TlsNoServerSupport lift $ pushElement starttlsE answer <- lift $ pullElement case answer of diff --git a/source/Network/Xmpp/Types.hs b/source/Network/Xmpp/Types.hs index 6af878c..9d33266 100644 --- a/source/Network/Xmpp/Types.hs +++ b/source/Network/Xmpp/Types.hs @@ -40,7 +40,7 @@ module Network.Xmpp.Types , ConnectionState(..) , StreamErrorInfo(..) , langTag - , TLSFailure(..) + , TlsFailure(..) , module Network.Xmpp.Jid ) where @@ -625,7 +625,7 @@ instance Read StreamErrorCondition where data StreamErrorInfo = StreamErrorInfo { errorCondition :: !StreamErrorCondition , errorText :: !(Maybe (Maybe LangTag, Text)) - , errorXML :: !(Maybe Element) + , errorXml :: !(Maybe Element) } deriving (Show, Eq) -- | Signals an XMPP stream error or another unpredicted stream-related @@ -814,13 +814,13 @@ mkConnection con = Connection `fmap` (atomically $ newTMVar con) -- | Failure conditions that may arise during TLS negotiation. -data TLSFailure = TLSError TLS.TLSError - | TLSNoServerSupport - | TLSNoConnection - | TLSConnectionSecured -- ^ Connection already secured - | TLSStreamError StreamFailure - | TLSFailureError -- General instance used for the Error instance (TODO) +data TlsFailure = TlsError TLS.TLSError + | TlsNoServerSupport + | TlsNoConnection + | TlsConnectionSecured -- ^ Connection already secured + | TlsStreamError StreamFailure + | TlsFailureError -- General instance used for the Error instance (TODO) deriving (Show, Eq, Typeable) -instance Error TLSFailure where - noMsg = TLSFailureError +instance Error TlsFailure where + noMsg = TlsFailureError diff --git a/source/Network/Xmpp/Xep/ServiceDiscovery.hs b/source/Network/Xmpp/Xep/ServiceDiscovery.hs index f4ee1e1..5eaf192 100644 --- a/source/Network/Xmpp/Xep/ServiceDiscovery.hs +++ b/source/Network/Xmpp/Xep/ServiceDiscovery.hs @@ -35,7 +35,7 @@ import Network.Xmpp.Types data DiscoError = DiscoNoQueryElement | DiscoIQError IQError | DiscoTimeout - | DiscoXMLError Element UnpickleError + | DiscoXmlError Element UnpickleError deriving (Show) @@ -97,7 +97,7 @@ queryInfo to node context = do IQResponseResult r -> case iqResultPayload r of Nothing -> Left DiscoNoQueryElement Just p -> case unpickleElem xpQueryInfo p of - Left e -> Left $ DiscoXMLError p e + Left e -> Left $ DiscoXmlError p e Right r -> Right r where queryBody = pickleElem xpQueryInfo (QIR node [] []) @@ -114,7 +114,7 @@ xmppQueryInfo to node con = do Right r -> case iqResultPayload r of Nothing -> Left DiscoNoQueryElement Just p -> case unpickleElem xpQueryInfo p of - Left e -> Left $ DiscoXMLError p e + Left e -> Left $ DiscoXmlError p e Right r -> Right r where queryBody = pickleElem xpQueryInfo (QIR node [] []) @@ -161,7 +161,7 @@ queryItems to node session = do IQResponseResult r -> case iqResultPayload r of Nothing -> Left DiscoNoQueryElement Just p -> case unpickleElem xpQueryItems p of - Left e -> Left $ DiscoXMLError p e + Left e -> Left $ DiscoXmlError p e Right r -> Right r where queryBody = pickleElem xpQueryItems (node, []) diff --git a/source/Text/XML/Stream/Elements.hs b/source/Text/Xml/Stream/Elements.hs similarity index 97% rename from source/Text/XML/Stream/Elements.hs rename to source/Text/Xml/Stream/Elements.hs index e0156e5..a357607 100644 --- a/source/Text/XML/Stream/Elements.hs +++ b/source/Text/Xml/Stream/Elements.hs @@ -1,7 +1,7 @@ {-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} -module Text.XML.Stream.Elements where +module Text.Xml.Stream.Elements where import Control.Applicative ((<$>)) import Control.Exception From a1d027940e5838f2d2c523a33a51fe9abdd92846 Mon Sep 17 00:00:00 2001 From: Jon Kristensen Date: Thu, 3 Jan 2013 06:34:51 +0100 Subject: [PATCH 07/15] Re-add `findStreamErrors' functionality The library should now generate the proper stream errors again, in case of received stream open element problem. The return type of streamS has been modified so that the validation can be performed in startStream instead, and without exceptions. This will also help enable implementation of logging later. The Errors module has been removed. --- source/Network/Xmpp/Errors.hs | 14 ---- source/Network/Xmpp/Stream.hs | 138 +++++++++++++++++++++++++--------- 2 files changed, 102 insertions(+), 50 deletions(-) delete mode 100644 source/Network/Xmpp/Errors.hs diff --git a/source/Network/Xmpp/Errors.hs b/source/Network/Xmpp/Errors.hs deleted file mode 100644 index 6e04d49..0000000 --- a/source/Network/Xmpp/Errors.hs +++ /dev/null @@ -1,14 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} -module Network.Xmpp.Errors where - -import Control.Applicative ((<$>)) -import Control.Monad(unless) -import Control.Monad.Error -import Control.Monad.Error.Class -import qualified Data.Text as Text -import Data.XML.Types -import Network.Xmpp.Types -import Network.Xmpp.Pickle - - diff --git a/source/Network/Xmpp/Stream.hs b/source/Network/Xmpp/Stream.hs index 5e197ca..a06b3e3 100644 --- a/source/Network/Xmpp/Stream.hs +++ b/source/Network/Xmpp/Stream.hs @@ -24,13 +24,14 @@ import Network.Xmpp.Connection import Network.Xmpp.Errors import Network.Xmpp.Pickle import Network.Xmpp.Types +import Network.Xmpp.Marshal import Text.Xml.Stream.Elements import Text.XML.Stream.Parse as XP -- import Text.XML.Stream.Elements --- Unpickles and returns a stream element. Throws a StreamXmlError on failure. +-- Unpickles and returns a stream element. streamUnpickleElem :: PU [Node] a -> Element -> StreamSink a @@ -61,34 +62,98 @@ openElementFromEvents = do Just (EventBeginElement name attrs) -> return $ Element name attrs [] _ -> throwError $ StreamOtherFailure --- Sends the initial stream:stream element and pulls the server features. +-- Sends the initial stream:stream element and pulls the server features. If the +-- server responds in a way that is invalid, an appropriate stream error will be +-- generated, the connection to the server will be closed, and a StreamFilure +-- will be produced. startStream :: StateT Connection_ IO (Either StreamFailure ()) startStream = runErrorT $ do - state <- get - -- Set the `to' attribute depending on the state of the connection. - let from = case sConnectionState state of + state <- lift $ get + con <- liftIO $ mkConnection state + -- Set the `from' (which is also the expected to) attribute depending on the + -- state of the connection. + let expectedTo = case sConnectionState state of ConnectionPlain -> if sJidWhenPlain state then sJid state else Nothing ConnectionSecured -> sJid state case sHostname state of - Nothing -> throwError StreamOtherFailure + Nothing -> throwError StreamOtherFailure -- TODO: When does this happen? Just hostname -> lift $ do pushXmlDecl pushOpenElement $ pickleElem xpStream ( "1.0" - , from + , expectedTo , Just (Jid Nothing hostname Nothing) , Nothing , sPreferredLang state ) - (lt, from, id, features) <- ErrorT . runEventsSink $ runErrorT $ - streamS from - modify (\s -> s{ sFeatures = features - , sStreamLang = Just lt - , sStreamId = id - , sFrom = from - } ) - return () + response <- ErrorT $ runEventsSink $ runErrorT $ streamS expectedTo + case response of + -- Successful unpickling of stream element. + Right (ver, from, to, id, lt, features) + | (unpack $ fromJust id) /= "1.0" -> + closeStreamWithError con StreamUnsupportedVersion Nothing + | lt == Nothing -> + closeStreamWithError con StreamInvalidXml Nothing + -- If `from' is set, we verify that it's the correct one. TODO: Should we check against the realm instead? + | isJust from && (from /= Just (Jid Nothing (fromJust $ sHostname state) Nothing)) -> + closeStreamWithError con StreamInvalidFrom Nothing + | to /= expectedTo -> + closeStreamWithError con StreamUndefinedCondition (Just $ Element "invalid-to" [] []) -- TODO: Suitable? + | otherwise -> do + modify (\s -> s{ sFeatures = features + , sStreamLang = lt + , sStreamId = id + , sFrom = from + } ) + return () + -- Unpickling failed - we investigate the element. + Left (Element name attrs children) + | (nameLocalName name /= "stream") -> + closeStreamWithError con StreamInvalidXml Nothing + | (nameNamespace name /= Just "http://etherx.jabber.org/streams") -> + closeStreamWithError con StreamInvalidNamespace Nothing + | (isJust $ namePrefix name) && (fromJust (namePrefix name) /= "stream") -> + closeStreamWithError con StreamBadNamespacePrefix Nothing + | otherwise -> ErrorT $ checkchildren con (flattenAttrs attrs) + where + -- closeStreamWithError :: MonadIO m => Connection -> StreamErrorCondition -> + -- Maybe Element -> ErrorT StreamFailure m () + closeStreamWithError con sec el = do + liftIO $ do + withConnection (pushElement . pickleElem xpStreamError $ + StreamErrorInfo sec Nothing el) con + closeStreams con + throwError StreamOtherFailure + checkchildren con children = + let to' = lookup "to" children + ver' = lookup "version" children + xl = lookup xmlLang children + in case () of () | Just (Nothing :: Maybe Jid) == (safeRead <$> to') -> + runErrorT $ closeStreamWithError con + StreamBadNamespacePrefix Nothing + | Nothing == ver' -> + runErrorT $ closeStreamWithError con + StreamUnsupportedVersion Nothing + | Just (Nothing :: Maybe LangTag) == (safeRead <$> xl) -> + runErrorT $ closeStreamWithError con + StreamInvalidXml Nothing + | otherwise -> + runErrorT $ closeStreamWithError con + StreamBadFormat Nothing + safeRead x = case reads $ Text.unpack x of + [] -> Nothing + [(y,_),_] -> Just y + +flattenAttrs :: [(Name, [Content])] -> [(Name, Text.Text)] +flattenAttrs attrs = Prelude.map (\(name, content) -> + ( name + , Text.concat $ Prelude.map uncontentify content) + ) + attrs + where + uncontentify (ContentText t) = t + uncontentify _ = "" -- Sets a new Event source using the raw source (of bytes) -- and calls xmppStartStream. @@ -107,42 +172,43 @@ restartStream = do else yield bs >> loopRead read -- Reads the (partial) stream:stream and the server features from the stream. --- Also validates the stream element's attributes and throws an error if --- appropriate. +-- Returns the (unvalidated) stream attributes, the unparsed element, or +-- throwError throws a `StreamOtherFailure' (if something other than an element +-- was encountered at first, or if something other than stream features was +-- encountered second). -- TODO: from. -streamS :: Maybe Jid -> StreamSink ( LangTag - , Maybe Jid - , Maybe Text - , ServerFeatures) +streamS :: Maybe Jid -> StreamSink (Either Element ( Text + , Maybe Jid + , Maybe Jid + , Maybe Text + , Maybe LangTag + , ServerFeatures )) streamS expectedTo = do - (from, to, id, langTag) <- xmppStreamHeader - features <- xmppStreamFeatures - return (langTag, from, id, features) + header <- xmppStreamHeader + case header of + Right (version, from, to, id, langTag) -> do + features <- xmppStreamFeatures + return $ Right (version, from, to, id, langTag, features) + Left el -> return $ Left el where - xmppStreamHeader :: StreamSink (Maybe Jid, Maybe Jid, Maybe Text.Text, LangTag) + xmppStreamHeader :: StreamSink (Either Element (Text, Maybe Jid, Maybe Jid, Maybe Text.Text, Maybe LangTag)) xmppStreamHeader = do lift throwOutJunk -- Get the stream:stream element (or whatever it is) from the server, -- and validate what we get. - el <- openElementFromEvents + el <- openElementFromEvents -- May throw `StreamOtherFailure' if an + -- element is not received case unpickleElem xpStream el of - Left _ -> throwError StreamOtherFailure -- TODO: findStreamErrors el - Right r -> validateData r - - validateData (_, _, _, _, Nothing) = throwError StreamOtherFailure -- StreamWrongLangTag Nothing - validateData (ver, from, to, i, Just lang) - | ver /= "1.0" = throwError StreamOtherFailure -- StreamWrongVersion (Just ver) - | isJust to && to /= expectedTo = throwError StreamOtherFailure -- StreamWrongTo (Text.pack . show <$> to) - | otherwise = return (from, to, i, lang) + Left _ -> return $ Left el + Right r -> return $ Right r xmppStreamFeatures :: StreamSink ServerFeatures xmppStreamFeatures = do e <- lift $ elements =$ CL.head case e of - Nothing -> liftIO $ Ex.throwIO StreamOtherFailure + Nothing -> throwError StreamOtherFailure Just r -> streamUnpickleElem xpStreamFeatures r - xpStream :: PU [Node] (Text, Maybe Jid, Maybe Jid, Maybe Text, Maybe LangTag) xpStream = xpElemAttrs (Name "stream" (Just "http://etherx.jabber.org/streams") (Just "stream")) From 2fa9b0decbfad98fdc846e068ce2fbb08b03f891 Mon Sep 17 00:00:00 2001 From: Jon Kristensen Date: Fri, 4 Jan 2013 08:00:41 +0100 Subject: [PATCH 08/15] Simplify API Drops the Connection newtype, and shows TMVar Connection instead. Hides Connection from Network.Xmpp, as the vast majority of users will not need to work with Connection directly. The related functions are now instead available from Network.Xmpp.Basic. Renames `simpleConnect' to `session', and makes it flexible in terms of authentication and whether or not to use TLS. Adds some minor documentation changes. We will need to export some session related information (such as the acquired resource, stream properties, etc.). We will also need to expose any failures encountered, probably by making `session' an ErrorT calculation. Also removed the Errors module from the Cabal file. --- pontarius-xmpp.cabal | 1 - source/Network/Xmpp.hs | 14 +--- source/Network/Xmpp/Basic.hs | 10 ++- source/Network/Xmpp/Bind.hs | 4 +- source/Network/Xmpp/Concurrent/Channels.hs | 2 +- .../Network/Xmpp/Concurrent/Channels/Types.hs | 3 +- source/Network/Xmpp/Concurrent/Threads.hs | 12 ++-- source/Network/Xmpp/Concurrent/Types.hs | 2 +- source/Network/Xmpp/Connection.hs | 41 ++++++----- source/Network/Xmpp/Sasl.hs | 4 +- source/Network/Xmpp/Sasl/Types.hs | 2 +- source/Network/Xmpp/Session.hs | 70 ++++++++----------- source/Network/Xmpp/Stream.hs | 7 +- source/Network/Xmpp/Tls.hs | 4 +- source/Network/Xmpp/Types.hs | 17 ++--- source/Network/Xmpp/Xep/InbandRegistration.hs | 6 +- source/Network/Xmpp/Xep/ServiceDiscovery.hs | 3 +- 17 files changed, 96 insertions(+), 106 deletions(-) diff --git a/pontarius-xmpp.cabal b/pontarius-xmpp.cabal index aa760aa..76c2f53 100644 --- a/pontarius-xmpp.cabal +++ b/pontarius-xmpp.cabal @@ -69,7 +69,6 @@ Library , Network.Xmpp.Concurrent.Threads , Network.Xmpp.Concurrent.Monad , Network.Xmpp.Connection - , Network.Xmpp.Errors , Network.Xmpp.IM.Message , Network.Xmpp.IM.Presence , Network.Xmpp.Jid diff --git a/source/Network/Xmpp.hs b/source/Network/Xmpp.hs index f7a686b..3deaaf8 100644 --- a/source/Network/Xmpp.hs +++ b/source/Network/Xmpp.hs @@ -25,19 +25,7 @@ module Network.Xmpp ( -- * Session management Session - , simpleConnect - , connectTcp - , newSession - , withConnection - , startTls - , simpleAuth - , auth - , scramSha1 - , digestMd5 - , plain - , closeConnection - , endContext - , setConnectionClosedHandler + , session -- * JID -- | A JID (historically: Jabber ID) is XMPPs native format -- for addressing entities in the network. It is somewhat similar to an e-mail diff --git a/source/Network/Xmpp/Basic.hs b/source/Network/Xmpp/Basic.hs index 5ee4058..d5129c9 100644 --- a/source/Network/Xmpp/Basic.hs +++ b/source/Network/Xmpp/Basic.hs @@ -2,16 +2,21 @@ module Network.Xmpp.Basic ( Connection(..) , ConnectionState(..) , connectTcp - , simpleConnect + , newSession + , withConnection , startTls , simpleAuth , auth , scramSha1 , digestMd5 , plain + , closeConnection , pushStanza , pullStanza - ) + , closeConnection + , endContext + , setConnectionClosedHandler + ) where @@ -21,3 +26,4 @@ import Network.Xmpp.Session import Network.Xmpp.Stream import Network.Xmpp.Tls import Network.Xmpp.Types +import Network.Xmpp.Concurrent \ No newline at end of file diff --git a/source/Network/Xmpp/Bind.hs b/source/Network/Xmpp/Bind.hs index a61e556..0e01058 100644 --- a/source/Network/Xmpp/Bind.hs +++ b/source/Network/Xmpp/Bind.hs @@ -17,6 +17,8 @@ import Network.Xmpp.Types import Control.Monad.State(modify) +import Control.Concurrent.STM.TMVar + -- Produces a `bind' element, optionally wrapping a resource. bindBody :: Maybe Text -> Element bindBody = pickleElem $ @@ -28,7 +30,7 @@ bindBody = pickleElem $ -- Sends a (synchronous) IQ set request for a (`Just') given or server-generated -- resource and extract the JID from the non-error response. -xmppBind :: Maybe Text -> Connection -> IO Jid +xmppBind :: Maybe Text -> TMVar Connection -> IO Jid xmppBind rsrc c = do answer <- pushIQ' "bind" Nothing Set Nothing (bindBody rsrc) c jid <- case () of () | Right IQResult{iqResultPayload = Just b} <- answer diff --git a/source/Network/Xmpp/Concurrent/Channels.hs b/source/Network/Xmpp/Concurrent/Channels.hs index 9516afb..c84f896 100644 --- a/source/Network/Xmpp/Concurrent/Channels.hs +++ b/source/Network/Xmpp/Concurrent/Channels.hs @@ -71,7 +71,7 @@ toChans stanzaC iqHands sta = atomically $ do -- | Creates and initializes a new Xmpp context. -newSession :: Connection -> IO Session +newSession :: TMVar Connection -> IO Session newSession con = do outC <- newTChanIO stanzaChan <- newTChanIO diff --git a/source/Network/Xmpp/Concurrent/Channels/Types.hs b/source/Network/Xmpp/Concurrent/Channels/Types.hs index 8de98f1..1648cea 100644 --- a/source/Network/Xmpp/Concurrent/Channels/Types.hs +++ b/source/Network/Xmpp/Concurrent/Channels/Types.hs @@ -8,7 +8,8 @@ import Data.Text (Text) import Network.Xmpp.Concurrent.Types import Network.Xmpp.Types --- | An XMPP session context +-- | The @Session@ object holds the current state of the XMPP connection, and is +-- thus necessary for any interaction with it. data Session = Session { context :: Context , stanzaCh :: TChan Stanza -- All stanzas diff --git a/source/Network/Xmpp/Concurrent/Threads.hs b/source/Network/Xmpp/Concurrent/Threads.hs index 89bf372..f1ca0b8 100644 --- a/source/Network/Xmpp/Concurrent/Threads.hs +++ b/source/Network/Xmpp/Concurrent/Threads.hs @@ -18,13 +18,15 @@ import qualified Data.ByteString as BS import Network.Xmpp.Concurrent.Types import Network.Xmpp.Connection +import Control.Concurrent.STM.TMVar + import GHC.IO (unsafeUnmask) -- Worker to read stanzas from the stream and concurrently distribute them to -- all listener threads. readWorker :: (Stanza -> IO ()) -> (StreamFailure -> IO ()) - -> TMVar Connection + -> TMVar (TMVar Connection) -> IO a readWorker onStanza onConnectionClosed stateRef = Ex.mask_ . forever $ do @@ -32,8 +34,8 @@ readWorker onStanza onConnectionClosed stateRef = -- we don't know whether pull will -- necessarily be interruptible s <- atomically $ do - con@(Connection con_) <- readTMVar stateRef - state <- sConnectionState <$> readTMVar con_ + con <- readTMVar stateRef + state <- sConnectionState <$> readTMVar con when (state == ConnectionClosed) retry return con @@ -72,11 +74,11 @@ readWorker onStanza onConnectionClosed stateRef = -- connection. startThreadsWith :: (Stanza -> IO ()) -> TVar EventHandlers - -> Connection + -> TMVar Connection -> IO (IO (), TMVar (BS.ByteString -> IO Bool), - TMVar Connection, + TMVar (TMVar Connection), ThreadId) startThreadsWith stanzaHandler eh con = do read <- withConnection' (gets $ cSend. cHand) con diff --git a/source/Network/Xmpp/Concurrent/Types.hs b/source/Network/Xmpp/Concurrent/Types.hs index 0df18c3..0259c45 100644 --- a/source/Network/Xmpp/Concurrent/Types.hs +++ b/source/Network/Xmpp/Concurrent/Types.hs @@ -25,7 +25,7 @@ data Context = Context , 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 + , conRef :: TMVar (TMVar Connection) , eventHandlers :: TVar EventHandlers , stopThreads :: IO () } diff --git a/source/Network/Xmpp/Connection.hs b/source/Network/Xmpp/Connection.hs index 1d682fa..1f62a3b 100644 --- a/source/Network/Xmpp/Connection.hs +++ b/source/Network/Xmpp/Connection.hs @@ -40,45 +40,48 @@ import Text.XML.Unresolved(InvalidEventStream(..)) import System.Log.Logger import Data.ByteString.Base64 +import Control.Concurrent.STM.TMVar + + -- Enable/disable debug output -- This will dump all incoming and outgoing network taffic to the console, -- prefixed with "in: " and "out: " respectively debug :: Bool debug = False -pushElement :: Element -> StateT Connection_ IO Bool +pushElement :: Element -> StateT Connection IO Bool pushElement x = do send <- gets (cSend . cHand) liftIO . send $ renderElement x -- | Encode and send stanza -pushStanza :: Stanza -> Connection -> IO Bool +pushStanza :: Stanza -> TMVar Connection -> IO Bool pushStanza s = withConnection' . pushElement $ pickleElem xpStanza s -- XML documents and XMPP streams SHOULD be preceeded by an XML declaration. -- UTF-8 is the only supported XMPP encoding. The standalone document -- declaration (matching "SDDecl" in the XML standard) MUST NOT be included in -- XMPP streams. RFC 6120 defines XMPP only in terms of XML 1.0. -pushXmlDecl :: StateT Connection_ IO Bool +pushXmlDecl :: StateT Connection IO Bool pushXmlDecl = do con <- gets cHand liftIO $ (cSend con) "" -pushOpenElement :: Element -> StateT Connection_ IO Bool +pushOpenElement :: Element -> StateT Connection IO Bool pushOpenElement e = do sink <- gets (cSend . cHand ) liftIO . sink $ renderOpenElement e -- `Connect-and-resumes' the given sink to the connection source, and pulls a -- `b' value. -runEventsSink :: Sink Event IO b -> StateT Connection_ IO b +runEventsSink :: Sink Event IO b -> StateT Connection IO b runEventsSink snk = do source <- gets cEventSource (src', r) <- lift $ source $$++ snk modify (\s -> s{cEventSource = src'}) return r -pullElement :: StateT Connection_ IO Element +pullElement :: StateT Connection IO Element pullElement = do Ex.catches (do e <- runEventsSink (elements =$ await) @@ -94,7 +97,7 @@ pullElement = do ] -- Pulls an element and unpickles it. -pullUnpickle :: PU [Node] a -> StateT Connection_ IO a +pullUnpickle :: PU [Node] a -> StateT Connection IO a pullUnpickle p = do res <- unpickleElem p <$> pullElement case res of @@ -103,7 +106,7 @@ pullUnpickle p = do -- | Pulls a stanza (or stream error) from the stream. Throws an error on a stream -- error. -pullStanza :: Connection -> IO Stanza +pullStanza :: TMVar Connection -> IO Stanza pullStanza = withConnection' $ do res <- pullUnpickle xpStreamStanza case res of @@ -121,9 +124,9 @@ catchPush p = Ex.catch _ -> Ex.throwIO e ) --- -- Connection_ state used when there is no connection. -xmppNoConnection :: Connection_ -xmppNoConnection = Connection_ +-- -- Connection state used when there is no connection. +xmppNoConnection :: Connection +xmppNoConnection = Connection { cHand = Hand { cSend = \_ -> return False , cRecv = \_ -> Ex.throwIO $ StreamOtherFailure @@ -147,8 +150,8 @@ xmppNoConnection = Connection_ zeroSource = liftIO . Ex.throwIO $ StreamOtherFailure -- Connects to the given hostname on port 5222 (TODO: Make this dynamic) and --- updates the XmppConMonad Connection_ state. -connectTcpRaw :: HostName -> PortID -> Text -> IO Connection +-- updates the XmppConMonad Connection state. +connectTcpRaw :: HostName -> PortID -> Text -> IO (TMVar Connection) connectTcpRaw host port hostname = do let PortNumber portNumber = port debugM "Pontarius.Xmpp" $ "Connecting to " ++ host ++ " on port " ++ @@ -172,7 +175,7 @@ connectTcpRaw host port hostname = do , cFlush = hFlush h , cClose = hClose h } - let con = Connection_ + let con = Connection { cHand = hand , cEventSource = eSource , sFeatures = (SF Nothing [] []) @@ -196,8 +199,8 @@ connectTcpRaw host port hostname = do return d --- Closes the connection and updates the XmppConMonad Connection_ state. -killConnection :: Connection -> IO (Either Ex.SomeException ()) +-- Closes the connection and updates the XmppConMonad Connection state. +killConnection :: TMVar Connection -> IO (Either Ex.SomeException ()) killConnection = withConnection $ do cc <- gets (cClose . cHand) err <- liftIO $ (Ex.try cc :: IO (Either Ex.SomeException ())) @@ -211,7 +214,7 @@ pushIQ' :: StanzaId -> IQRequestType -> Maybe LangTag -> Element - -> Connection + -> TMVar Connection -> IO (Either IQError IQResult) pushIQ' iqID to tp lang body con = do pushStanza (IQRequestS $ IQRequest iqID Nothing to lang tp body) con @@ -231,7 +234,7 @@ pushIQ' iqID to tp lang body con = do -- | Send "" and wait for the server to finish processing and to -- close the connection. Any remaining elements from the server and whether or -- not we received a element from the server is returned. -closeStreams :: Connection -> IO ([Element], Bool) +closeStreams :: TMVar Connection -> IO ([Element], Bool) closeStreams = withConnection $ do send <- gets (cSend . cHand) cc <- gets (cClose . cHand) @@ -244,7 +247,7 @@ closeStreams = withConnection $ do where -- Pulls elements from the stream until the stream ends, or an error is -- raised. - collectElems :: [Element] -> StateT Connection_ IO ([Element], Bool) + collectElems :: [Element] -> StateT Connection IO ([Element], Bool) collectElems es = do result <- Ex.try pullElement case result of diff --git a/source/Network/Xmpp/Sasl.hs b/source/Network/Xmpp/Sasl.hs index 0563398..9b3df03 100644 --- a/source/Network/Xmpp/Sasl.hs +++ b/source/Network/Xmpp/Sasl.hs @@ -38,12 +38,14 @@ import qualified System.Random as Random import Network.Xmpp.Sasl.Types import Network.Xmpp.Sasl.Mechanisms +import Control.Concurrent.STM.TMVar + -- | Uses the first supported mechanism to authenticate, if any. Updates the -- state with non-password credentials and restarts the stream upon -- success. xmppSasl :: [SaslHandler] -- ^ Acceptable authentication mechanisms and their -- corresponding handlers - -> Connection + -> TMVar Connection -> IO (Either AuthError ()) xmppSasl handlers = withConnection $ do -- Chooses the first mechanism that is acceptable by both the client and the diff --git a/source/Network/Xmpp/Sasl/Types.hs b/source/Network/Xmpp/Sasl/Types.hs index 8c104d3..5f09f51 100644 --- a/source/Network/Xmpp/Sasl/Types.hs +++ b/source/Network/Xmpp/Sasl/Types.hs @@ -29,7 +29,7 @@ data SaslElement = SaslSuccess (Maybe Text.Text) -- | SASL mechanism XmppConnection computation, with the possibility of throwing -- an authentication error. -type SaslM a = ErrorT AuthError (StateT Connection_ IO) a +type SaslM a = ErrorT AuthError (StateT Connection IO) a type Pairs = [(ByteString, ByteString)] diff --git a/source/Network/Xmpp/Session.hs b/source/Network/Xmpp/Session.hs index 0902407..304feef 100644 --- a/source/Network/Xmpp/Session.hs +++ b/source/Network/Xmpp/Session.hs @@ -21,47 +21,35 @@ import Network.Xmpp.Sasl.Types import Network.Xmpp.Stream import Network.Xmpp.Tls import Network.Xmpp.Types +import Control.Concurrent.STM.TMVar +import Data.Maybe --- | The quick and easy way to set up a connection to an XMPP server --- --- This will --- --- * connect to the host --- --- * secure the connection with TLS --- --- * authenticate to the server using either SCRAM-SHA1 (preferred) or --- Digest-MD5 --- --- * bind a resource --- --- * return the full JID you have been assigned --- --- Note that the server might assign a different resource even when we send --- a preference. -simpleConnect :: HostName -- ^ Host to connect to - -> PortID -- ^ Port to connec to - -> Text -- ^ Hostname of the server (to distinguish the XMPP - -- service) - -> Text -- ^ User name (authcid) - -> Text -- ^ Password - -> Maybe Text -- ^ Desired resource (or Nothing to let the server - -- decide) - -> IO Session -simpleConnect host port hostname username password resource = do - con' <- connectTcp host port hostname - con <- case con' of - Left e -> Ex.throwIO e - Right r -> return r - startTls exampleParams con - saslResponse <- simpleAuth username password resource con - case saslResponse of - Right jid -> newSession con - Left e -> error $ show e - +-- | Creates a 'Session' object by setting up a connection with an XMPP server. +-- +-- Will connect to the specified host, optionally secure the connection with +-- TLS, as well as optionally authenticate and acquire an XMPP resource. +session :: HostName -- ^ Host to connect to + -> Text -- ^ The realm host name (to + -- distinguish the XMPP service) + -> PortID -- ^ Port to connect to + -> Maybe TLS.TLSParams -- ^ TLS settings, if securing the + -- connection to the server is + -- desired + -> Maybe ([SaslHandler], Maybe Text) -- ^ SASL handlers and the desired + -- JID resource (or Nothing to let + -- the server decide) + -> IO Session -- TODO: ErrorT +session hostname realm port tls sasl = do + con' <- connectTcp hostname port realm + con <- case con' of + Left e -> Ex.throwIO e + Right c -> return c + if isJust tls then startTls (fromJust tls) con >> return () else return () -- TODO: Eats TlsFailure + saslResponse <- if isJust sasl then auth (fst $ fromJust sasl) (snd $ fromJust sasl) con >> return () else return () -- TODO: Eats AuthError + newSession con -- | Connect to host with given address. -connectTcp :: HostName -> PortID -> Text -> IO (Either StreamFailure Connection) +connectTcp :: HostName -> PortID -> Text -> IO (Either StreamFailure (TMVar Connection)) connectTcp address port hostname = do con <- connectTcpRaw address port hostname result <- withConnection startStream con @@ -104,7 +92,7 @@ sessionIQ = IQRequestS $ IQRequest { iqRequestID = "sess" -- Sends the session IQ set element and waits for an answer. Throws an error if -- if an IQ error stanza is returned from the server. -startSession :: Connection -> IO () +startSession :: TMVar Connection -> IO () startSession con = do answer <- pushIQ' "session" Nothing Set Nothing sessionXml con case answer of @@ -115,7 +103,7 @@ startSession con = do -- resource. auth :: [SaslHandler] -> Maybe Text - -> Connection + -> TMVar Connection -> IO (Either AuthError Jid) auth mechanisms resource con = runErrorT $ do ErrorT $ xmppSasl mechanisms con @@ -131,7 +119,7 @@ simpleAuth :: Text.Text -- ^ The username -> Text.Text -- ^ The password -> Maybe Text -- ^ The desired resource or 'Nothing' to let the -- server assign one - -> Connection + -> TMVar Connection -> IO (Either AuthError Jid) simpleAuth username passwd resource = flip auth resource $ [ -- TODO: scramSha1Plus diff --git a/source/Network/Xmpp/Stream.hs b/source/Network/Xmpp/Stream.hs index a06b3e3..bf9ad69 100644 --- a/source/Network/Xmpp/Stream.hs +++ b/source/Network/Xmpp/Stream.hs @@ -21,7 +21,6 @@ import Data.XML.Pickle import Data.XML.Types import Network.Xmpp.Connection -import Network.Xmpp.Errors import Network.Xmpp.Pickle import Network.Xmpp.Types import Network.Xmpp.Marshal @@ -66,7 +65,7 @@ openElementFromEvents = do -- server responds in a way that is invalid, an appropriate stream error will be -- generated, the connection to the server will be closed, and a StreamFilure -- will be produced. -startStream :: StateT Connection_ IO (Either StreamFailure ()) +startStream :: StateT Connection IO (Either StreamFailure ()) startStream = runErrorT $ do state <- lift $ get con <- liftIO $ mkConnection state @@ -117,7 +116,7 @@ startStream = runErrorT $ do closeStreamWithError con StreamBadNamespacePrefix Nothing | otherwise -> ErrorT $ checkchildren con (flattenAttrs attrs) where - -- closeStreamWithError :: MonadIO m => Connection -> StreamErrorCondition -> + -- closeStreamWithError :: MonadIO m => TMVar Connection -> StreamErrorCondition -> -- Maybe Element -> ErrorT StreamFailure m () closeStreamWithError con sec el = do liftIO $ do @@ -157,7 +156,7 @@ flattenAttrs attrs = Prelude.map (\(name, content) -> -- Sets a new Event source using the raw source (of bytes) -- and calls xmppStartStream. -restartStream :: StateT Connection_ IO (Either StreamFailure ()) +restartStream :: StateT Connection IO (Either StreamFailure ()) restartStream = do raw <- gets (cRecv . cHand) let newSource = DCI.ResumableSource (loopRead raw $= XP.parseBytes def) diff --git a/source/Network/Xmpp/Tls.hs b/source/Network/Xmpp/Tls.hs index f3db8d5..5464341 100644 --- a/source/Network/Xmpp/Tls.hs +++ b/source/Network/Xmpp/Tls.hs @@ -22,6 +22,8 @@ import Network.Xmpp.Pickle(ppElement) import Network.Xmpp.Stream import Network.Xmpp.Types +import Control.Concurrent.STM.TMVar + mkBackend con = Backend { backendSend = \bs -> void (cSend con bs) , backendRecv = cRecv con , backendFlush = cFlush con @@ -74,7 +76,7 @@ exampleParams = TLS.defaultParamsClient -- Pushes ", waits for "", performs the TLS handshake, and -- restarts the stream. -startTls :: TLS.TLSParams -> Connection -> IO (Either TlsFailure ()) +startTls :: TLS.TLSParams -> TMVar Connection -> IO (Either TlsFailure ()) startTls params con = Ex.handle (return . Left . TlsError) . flip withConnection con . runErrorT $ do diff --git a/source/Network/Xmpp/Types.hs b/source/Network/Xmpp/Types.hs index 9d33266..58d66c2 100644 --- a/source/Network/Xmpp/Types.hs +++ b/source/Network/Xmpp/Types.hs @@ -33,7 +33,6 @@ module Network.Xmpp.Types , Version(..) , HandleLike(..) , Connection(..) - , Connection_(..) , withConnection , withConnection' , mkConnection @@ -755,7 +754,7 @@ data HandleLike = Hand { cSend :: BS.ByteString -> IO Bool , cClose :: IO () } -data Connection_ = Connection_ +data Connection = Connection { sConnectionState :: !ConnectionState -- ^ State of -- connection , cHand :: HandleLike @@ -789,10 +788,8 @@ data Connection_ = Connection_ } -newtype Connection = Connection {unConnection :: TMVar Connection_} - -withConnection :: StateT Connection_ IO c -> Connection -> IO c -withConnection action (Connection con) = bracketOnError +withConnection :: StateT Connection IO c -> TMVar Connection -> IO c +withConnection action con = bracketOnError (atomically $ takeTMVar con) (atomically . putTMVar con ) (\c -> do @@ -802,15 +799,15 @@ withConnection action (Connection con) = bracketOnError ) -- nonblocking version. Changes to the connection are ignored! -withConnection' :: StateT Connection_ IO b -> Connection -> IO b -withConnection' action (Connection con) = do +withConnection' :: StateT Connection IO b -> TMVar Connection -> IO b +withConnection' action con = do con_ <- atomically $ readTMVar con (r, _) <- runStateT action con_ return r -mkConnection :: Connection_ -> IO Connection -mkConnection con = Connection `fmap` (atomically $ newTMVar con) +mkConnection :: Connection -> IO (TMVar Connection) +mkConnection con = {- Connection `fmap` -} (atomically $ newTMVar con) -- | Failure conditions that may arise during TLS negotiation. diff --git a/source/Network/Xmpp/Xep/InbandRegistration.hs b/source/Network/Xmpp/Xep/InbandRegistration.hs index 7f433ef..6e14447 100644 --- a/source/Network/Xmpp/Xep/InbandRegistration.hs +++ b/source/Network/Xmpp/Xep/InbandRegistration.hs @@ -71,7 +71,7 @@ emptyQuery = Query Nothing False False [] -- if r then return True else g -query :: IQRequestType -> Query -> Connection -> IO (Either IbrError Query) +query :: IQRequestType -> Query -> TMVar Connection -> IO (Either IbrError Query) query queryType x con = do answer <- pushIQ' "ibr" Nothing queryType Nothing (pickleElem xpQuery x) con case answer of @@ -97,7 +97,7 @@ mapError f = mapErrorT (liftM $ left f) -- | Retrieve the necessary fields and fill them in to register an account with -- the server registerWith :: [(Field, Text.Text)] - -> Connection + -> TMVar Connection -> IO (Either RegisterError Query) registerWith givenFields con = runErrorT $ do fs <- mapError IbrError . ErrorT $ requestFields con @@ -114,7 +114,7 @@ registerWith givenFields con = runErrorT $ do -- | 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 :: TMVar Connection -> IO (Either IbrError Query) unregister = query Set $ emptyQuery {remove = True} requestFields con = runErrorT $ do diff --git a/source/Network/Xmpp/Xep/ServiceDiscovery.hs b/source/Network/Xmpp/Xep/ServiceDiscovery.hs index 5eaf192..2138017 100644 --- a/source/Network/Xmpp/Xep/ServiceDiscovery.hs +++ b/source/Network/Xmpp/Xep/ServiceDiscovery.hs @@ -31,6 +31,7 @@ import Network.Xmpp.Concurrent.Types import Network.Xmpp.Connection import Network.Xmpp.Pickle import Network.Xmpp.Types +import Control.Concurrent.STM.TMVar data DiscoError = DiscoNoQueryElement | DiscoIQError IQError @@ -105,7 +106,7 @@ queryInfo to node context = do xmppQueryInfo :: Maybe Jid -> Maybe Text.Text - -> Connection + -> TMVar Connection -> IO (Either DiscoError QueryInfoResult) xmppQueryInfo to node con = do res <- pushIQ' "info" to Get Nothing queryBody con From b1393da25a76ae21d0d74d581430b92d14a6037c Mon Sep 17 00:00:00 2001 From: Jon Kristensen Date: Sat, 5 Jan 2013 07:25:53 +0100 Subject: [PATCH 09/15] Rename `AuthError' to `AuthFailure'; apply minor documentation changes --- source/Network/Xmpp.hs | 33 +++++++++++-------- source/Network/Xmpp/Sasl.hs | 6 ++-- source/Network/Xmpp/Sasl/Common.hs | 16 ++++----- .../Network/Xmpp/Sasl/Mechanisms/DigestMd5.hs | 2 +- source/Network/Xmpp/Sasl/Mechanisms/Scram.hs | 4 +-- source/Network/Xmpp/Sasl/Types.hs | 22 ++++++------- source/Network/Xmpp/Session.hs | 14 ++++---- 7 files changed, 52 insertions(+), 45 deletions(-) diff --git a/source/Network/Xmpp.hs b/source/Network/Xmpp.hs index 3deaaf8..b4d0b5d 100644 --- a/source/Network/Xmpp.hs +++ b/source/Network/Xmpp.hs @@ -26,10 +26,15 @@ module Network.Xmpp ( -- * Session management Session , session - -- * JID + -- TODO: Close session, etc. + -- ** Authentication handlers + , scramSha1 + , plain + , digestMd5 + -- * Addressing -- | A JID (historically: Jabber ID) is XMPPs native format -- for addressing entities in the network. It is somewhat similar to an e-mail - -- address but contains three parts instead of two: + -- address, but contains three parts instead of two. , Jid(..) , isBare , isFull @@ -37,32 +42,32 @@ module Network.Xmpp -- | The basic protocol data unit in XMPP is the XML stanza. The stanza is -- essentially a fragment of XML that is sent over a stream. @Stanzas@ come in -- 3 flavors: - -- - -- * @'Message'@, for traditional push-style message passing between peers - -- - -- * @'Presence'@, for communicating status updates - -- - -- * IQ (info/query), for request-response semantics communication - -- + -- + -- * /Message/, for traditional push-style message passing between peers + -- + -- * /Presence/, for communicating status updates + -- + -- * /Info/\//Query/ (or /IQ/), for request-response semantics communication + -- -- All stanza types have the following attributes in common: - -- + -- -- * The /id/ attribute is used by the originating entity to track any -- response or error stanza that it might receive in relation to the -- generated stanza from another entity (such as an intermediate server or -- the intended recipient). It is up to the originating entity whether the -- value of the 'id' attribute is unique only within its current stream or -- unique globally. - -- + -- -- * The /from/ attribute specifies the JID of the sender. - -- + -- -- * The /to/ attribute specifies the JID of the intended recipient for the -- stanza. - -- + -- -- * The /type/ attribute specifies the purpose or context of the message, -- presence, or IQ stanza. The particular allowable values for the 'type' -- attribute vary depending on whether the stanza is a message, presence, -- or IQ stanza. - -- + -- ** Messages -- | The /message/ stanza is a /push/ mechanism whereby one entity -- pushes information to another entity, similar to the communications that diff --git a/source/Network/Xmpp/Sasl.hs b/source/Network/Xmpp/Sasl.hs index 9b3df03..c5e2e62 100644 --- a/source/Network/Xmpp/Sasl.hs +++ b/source/Network/Xmpp/Sasl.hs @@ -46,7 +46,7 @@ import Control.Concurrent.STM.TMVar xmppSasl :: [SaslHandler] -- ^ Acceptable authentication mechanisms and their -- corresponding handlers -> TMVar Connection - -> IO (Either AuthError ()) + -> IO (Either AuthFailure ()) xmppSasl handlers = withConnection $ do -- Chooses the first mechanism that is acceptable by both the client and the -- server. @@ -56,8 +56,8 @@ xmppSasl handlers = withConnection $ do (_name, handler):_ -> runErrorT $ do cs <- gets sConnectionState case cs of - ConnectionClosed -> throwError AuthConnectionError + ConnectionClosed -> throwError AuthConnectionFailure _ -> do r <- handler - _ <- ErrorT $ left AuthStreamError <$> restartStream + _ <- ErrorT $ left AuthStreamFailure <$> restartStream return r diff --git a/source/Network/Xmpp/Sasl/Common.hs b/source/Network/Xmpp/Sasl/Common.hs index 5d4164f..468cf01 100644 --- a/source/Network/Xmpp/Sasl/Common.hs +++ b/source/Network/Xmpp/Sasl/Common.hs @@ -127,11 +127,11 @@ pullChallenge = do SaslChallenge (Just scb64) | Right sc <- B64.decode . Text.encodeUtf8 $ scb64 -> return $ Just sc - _ -> throwError AuthChallengeError + _ -> throwError AuthChallengeFailure --- | Extract value from Just, failing with AuthChallengeError on Nothing. +-- | Extract value from Just, failing with AuthChallengeFailure on Nothing. saslFromJust :: Maybe a -> SaslM a -saslFromJust Nothing = throwError $ AuthChallengeError +saslFromJust Nothing = throwError $ AuthChallengeFailure saslFromJust (Just d) = return d -- | Pull the next element and check that it is success. @@ -140,7 +140,7 @@ pullSuccess = do e <- pullSaslElement case e of SaslSuccess x -> return x - _ -> throwError $ AuthXmlError + _ -> throwError $ AuthXmlFailure -- | Pull the next element. When it's success, return it's payload. -- If it's a challenge, send an empty response and pull success. @@ -156,13 +156,13 @@ pullFinalMessage = do where decode Nothing = return Nothing decode (Just d) = case B64.decode $ Text.encodeUtf8 d of - Left _e -> throwError $ AuthChallengeError + Left _e -> throwError $ AuthChallengeFailure Right x -> return $ Just x -- | Extract p=q pairs from a challenge. toPairs :: BS.ByteString -> SaslM Pairs toPairs ctext = case pairs ctext of - Left _e -> throwError AuthChallengeError + Left _e -> throwError AuthChallengeFailure Right r -> return r -- | Send a SASL response element. The content will be base64-encoded. @@ -172,11 +172,11 @@ respond = lift . pushElement . saslResponseE . -- | Run the appropriate stringprep profiles on the credentials. --- May fail with 'AuthStringPrepError' +-- May fail with 'AuthStringPrepFailure' prepCredentials :: Text.Text -> Maybe Text.Text -> Text.Text -> SaslM (Text.Text, Maybe Text.Text, Text.Text) prepCredentials authcid authzid password = case credentials of - Nothing -> throwError $ AuthStringPrepError + Nothing -> throwError $ AuthStringPrepFailure Just creds -> return creds where credentials = do diff --git a/source/Network/Xmpp/Sasl/Mechanisms/DigestMd5.hs b/source/Network/Xmpp/Sasl/Mechanisms/DigestMd5.hs index 55bce2c..75ddac5 100644 --- a/source/Network/Xmpp/Sasl/Mechanisms/DigestMd5.hs +++ b/source/Network/Xmpp/Sasl/Mechanisms/DigestMd5.hs @@ -51,7 +51,7 @@ xmppDigestMd5 authcid authzid password = do case hn of Just hn' -> do xmppDigestMd5' hn' ac az pw - Nothing -> throwError AuthConnectionError + Nothing -> throwError AuthConnectionFailure where xmppDigestMd5' :: Text -> Text -> Maybe Text -> Text -> SaslM () xmppDigestMd5' hostname authcid authzid password = do diff --git a/source/Network/Xmpp/Sasl/Mechanisms/Scram.hs b/source/Network/Xmpp/Sasl/Mechanisms/Scram.hs index 6cf809d..e9cebc7 100644 --- a/source/Network/Xmpp/Sasl/Mechanisms/Scram.hs +++ b/source/Network/Xmpp/Sasl/Mechanisms/Scram.hs @@ -59,7 +59,7 @@ scram hashToken authcid authzid password = do let (cfm, v) = cFinalMessageAndVerifier nonce salt ic sFirstMessage cnonce respond $ Just cfm finalPairs <- toPairs =<< saslFromJust =<< pullFinalMessage - unless (lookup "v" finalPairs == Just v) $ throwError AuthServerAuthError + unless (lookup "v" finalPairs == Just v) $ throwError AuthServerAuthFailure return () where -- We need to jump through some hoops to get a polymorphic solution @@ -102,7 +102,7 @@ scram hashToken authcid authzid password = do , Just ic <- lookup "i" pairs , [(i,"")] <- reads $ BS8.unpack ic = return (nonce, salt, i) - fromPairs _ _ = throwError $ AuthChallengeError + fromPairs _ _ = throwError $ AuthChallengeFailure cFinalMessageAndVerifier :: BS.ByteString -> BS.ByteString diff --git a/source/Network/Xmpp/Sasl/Types.hs b/source/Network/Xmpp/Sasl/Types.hs index 5f09f51..cd14c1d 100644 --- a/source/Network/Xmpp/Sasl/Types.hs +++ b/source/Network/Xmpp/Sasl/Types.hs @@ -7,29 +7,29 @@ import Data.ByteString(ByteString) import qualified Data.Text as Text import Network.Xmpp.Types -data AuthError = AuthXmlError +data AuthFailure = AuthXmlFailure | AuthNoAcceptableMechanism [Text.Text] -- ^ Wraps mechanisms -- offered - | AuthChallengeError - | AuthServerAuthError -- ^ The server failed to authenticate + | AuthChallengeFailure + | AuthServerAuthFailure -- ^ The server failed to authenticate -- itself - | AuthStreamError StreamFailure -- ^ Stream error on stream restart - -- TODO: Rename AuthConnectionError? - | AuthConnectionError -- ^ Connection is closed - | AuthError -- General instance used for the Error instance + | AuthStreamFailure StreamFailure -- ^ Stream error on stream restart + -- TODO: Rename AuthConnectionFailure? + | AuthConnectionFailure -- ^ Connection is closed + | AuthFailure -- General instance used for the Error instance | AuthSaslFailure SaslFailure -- ^ Defined SASL error condition - | AuthStringPrepError -- ^ StringPrep failed + | AuthStringPrepFailure -- ^ StringPrep failed deriving Show -instance Error AuthError where - noMsg = AuthError +instance Error AuthFailure where + noMsg = AuthFailure data SaslElement = SaslSuccess (Maybe Text.Text) | SaslChallenge (Maybe Text.Text) -- | SASL mechanism XmppConnection computation, with the possibility of throwing -- an authentication error. -type SaslM a = ErrorT AuthError (StateT Connection IO) a +type SaslM a = ErrorT AuthFailure (StateT Connection IO) a type Pairs = [(ByteString, ByteString)] diff --git a/source/Network/Xmpp/Session.hs b/source/Network/Xmpp/Session.hs index 304feef..554dbea 100644 --- a/source/Network/Xmpp/Session.hs +++ b/source/Network/Xmpp/Session.hs @@ -26,8 +26,10 @@ import Data.Maybe -- | Creates a 'Session' object by setting up a connection with an XMPP server. -- --- Will connect to the specified host, optionally secure the connection with --- TLS, as well as optionally authenticate and acquire an XMPP resource. +-- Will connect to the specified host. If the fourth parameters is a 'Just' +-- value, @session@ will attempt to secure the connection with TLS. If the fifth +-- parameters is a 'Just' value, @session@ will attempt to authenticate and +-- acquire an XMPP resource. session :: HostName -- ^ Host to connect to -> Text -- ^ The realm host name (to -- distinguish the XMPP service) @@ -45,7 +47,7 @@ session hostname realm port tls sasl = do Left e -> Ex.throwIO e Right c -> return c if isJust tls then startTls (fromJust tls) con >> return () else return () -- TODO: Eats TlsFailure - saslResponse <- if isJust sasl then auth (fst $ fromJust sasl) (snd $ fromJust sasl) con >> return () else return () -- TODO: Eats AuthError + saslResponse <- if isJust sasl then auth (fst $ fromJust sasl) (snd $ fromJust sasl) con >> return () else return () -- TODO: Eats AuthFailure newSession con -- | Connect to host with given address. @@ -104,7 +106,7 @@ startSession con = do auth :: [SaslHandler] -> Maybe Text -> TMVar Connection - -> IO (Either AuthError Jid) + -> IO (Either AuthFailure Jid) auth mechanisms resource con = runErrorT $ do ErrorT $ xmppSasl mechanisms con jid <- lift $ xmppBind resource con @@ -120,9 +122,9 @@ simpleAuth :: Text.Text -- ^ The username -> Maybe Text -- ^ The desired resource or 'Nothing' to let the -- server assign one -> TMVar Connection - -> IO (Either AuthError Jid) + -> IO (Either AuthFailure Jid) simpleAuth username passwd resource = flip auth resource $ [ -- TODO: scramSha1Plus scramSha1 username Nothing passwd , digestMd5 username Nothing passwd - ] + ] \ No newline at end of file From a205b23a6bcf06dc7e8037f9c477bd1bd16c9058 Mon Sep 17 00:00:00 2001 From: Jon Kristensen Date: Sun, 6 Jan 2013 00:13:32 +0100 Subject: [PATCH 10/15] Hide `Context', add exports, extend documentation As mentioned in #pontarius, `Context' is simply a bunch of thread management features, and users that want that can build their own on top of the `Connection' layer. The benefit of hiding `Context' is that it makes the API clearer, and significantly decreases the complexity of the library. As the `Basic' module is simply an interface to `Connection', it was renamed to `Connection'. The old `Connection' module was moved to `Connection_'. Exported the types of the fields of `Connection' (such as `ConnectionState' and `ConnectionHandle' (previously `HandleLike'). --- pontarius-xmpp.cabal | 4 +- source/Network/Xmpp.hs | 13 +- source/Network/Xmpp/Basic.hs | 29 -- source/Network/Xmpp/Bind.hs | 4 +- source/Network/Xmpp/Concurrent/Channels.hs | 2 +- .../Network/Xmpp/Concurrent/Channels/Types.hs | 3 +- source/Network/Xmpp/Concurrent/Monad.hs | 6 +- source/Network/Xmpp/Concurrent/Threads.hs | 6 +- source/Network/Xmpp/Connection.hs | 308 +++--------------- source/Network/Xmpp/Connection_.hs | 266 +++++++++++++++ source/Network/Xmpp/Sasl.hs | 6 +- source/Network/Xmpp/Sasl/Common.hs | 2 +- .../Network/Xmpp/Sasl/Mechanisms/DigestMd5.hs | 4 +- source/Network/Xmpp/Sasl/Mechanisms/Plain.hs | 2 +- source/Network/Xmpp/Session.hs | 34 +- source/Network/Xmpp/Stream.hs | 26 +- source/Network/Xmpp/Tls.hs | 22 +- source/Network/Xmpp/Types.hs | 75 ++--- source/Network/Xmpp/Xep/InbandRegistration.hs | 2 +- source/Network/Xmpp/Xep/ServiceDiscovery.hs | 2 +- 20 files changed, 404 insertions(+), 412 deletions(-) delete mode 100644 source/Network/Xmpp/Basic.hs create mode 100644 source/Network/Xmpp/Connection_.hs diff --git a/pontarius-xmpp.cabal b/pontarius-xmpp.cabal index 76c2f53..0f8e883 100644 --- a/pontarius-xmpp.cabal +++ b/pontarius-xmpp.cabal @@ -54,8 +54,8 @@ Library , stringprep >=0.1.3 , hslogger >=1.1.0 Exposed-modules: Network.Xmpp + , Network.Xmpp.Connection , Network.Xmpp.IM - , Network.Xmpp.Basic Other-modules: Data.Conduit.Tls , Network.Xmpp.Bind , Network.Xmpp.Concurrent @@ -68,7 +68,7 @@ Library , Network.Xmpp.Concurrent.Channels.Types , Network.Xmpp.Concurrent.Threads , Network.Xmpp.Concurrent.Monad - , Network.Xmpp.Connection + , Network.Xmpp.Connection_ , Network.Xmpp.IM.Message , Network.Xmpp.IM.Presence , Network.Xmpp.Jid diff --git a/source/Network/Xmpp.hs b/source/Network/Xmpp.hs index b4d0b5d..7184ba2 100644 --- a/source/Network/Xmpp.hs +++ b/source/Network/Xmpp.hs @@ -1,7 +1,5 @@ -- | -- Module: $Header$ --- Description: RFC 6120 (XMPP: Core). --- License: Apache License 2.0 -- -- Maintainer: info@jonkri.com -- Stability: unstable @@ -16,9 +14,12 @@ -- persistent XML streams among a distributed network of globally addressable, -- presence-aware clients and servers. -- --- Pontarius is an XMPP client library, implementing the core capabilities of --- XMPP (RFC 6120): setup and teardown of XML streams, channel encryption, +-- Pontarius XMPP is an XMPP client library, implementing the core capabilities +-- of XMPP (RFC 6120): setup and teardown of XML streams, channel encryption, -- authentication, error handling, and communication primitives for messaging. +-- +-- For low-level access to Pontarius XMPP, see the "Network.Xmpp.Connection" +-- module. {-# LANGUAGE NoMonomorphismRestriction, OverloadedStrings #-} @@ -142,6 +143,7 @@ module Network.Xmpp , StreamErrorInfo(..) , StreamErrorCondition(..) , TlsFailure(..) + , AuthFailure(..) ) where @@ -152,11 +154,12 @@ import Network.Xmpp.Bind import Network.Xmpp.Concurrent import Network.Xmpp.Concurrent.Channels import Network.Xmpp.Concurrent.Types -import Network.Xmpp.Connection +import Network.Xmpp.Connection_ import Network.Xmpp.Marshal import Network.Xmpp.Message import Network.Xmpp.Presence import Network.Xmpp.Sasl +import Network.Xmpp.Sasl.Types import Network.Xmpp.Session import Network.Xmpp.Stream import Network.Xmpp.Tls diff --git a/source/Network/Xmpp/Basic.hs b/source/Network/Xmpp/Basic.hs deleted file mode 100644 index d5129c9..0000000 --- a/source/Network/Xmpp/Basic.hs +++ /dev/null @@ -1,29 +0,0 @@ -module Network.Xmpp.Basic - ( Connection(..) - , ConnectionState(..) - , connectTcp - , newSession - , withConnection - , startTls - , simpleAuth - , auth - , scramSha1 - , digestMd5 - , plain - , closeConnection - , pushStanza - , pullStanza - , closeConnection - , endContext - , setConnectionClosedHandler - ) - - where - -import Network.Xmpp.Connection -import Network.Xmpp.Sasl -import Network.Xmpp.Session -import Network.Xmpp.Stream -import Network.Xmpp.Tls -import Network.Xmpp.Types -import Network.Xmpp.Concurrent \ No newline at end of file diff --git a/source/Network/Xmpp/Bind.hs b/source/Network/Xmpp/Bind.hs index 0e01058..4d180ce 100644 --- a/source/Network/Xmpp/Bind.hs +++ b/source/Network/Xmpp/Bind.hs @@ -11,7 +11,7 @@ import Data.Text as Text import Data.XML.Pickle import Data.XML.Types -import Network.Xmpp.Connection +import Network.Xmpp.Connection_ import Network.Xmpp.Pickle import Network.Xmpp.Types @@ -38,7 +38,7 @@ xmppBind rsrc c = do -> return jid | otherwise -> throw StreamOtherFailure -- TODO: Log: ("Bind couldn't unpickle JID from " ++ show answer) - withConnection (modify $ \s -> s{sJid = Just jid}) c + withConnection (modify $ \s -> s{cJid = Just jid}) c return jid where -- Extracts the character data in the `jid' element. diff --git a/source/Network/Xmpp/Concurrent/Channels.hs b/source/Network/Xmpp/Concurrent/Channels.hs index c84f896..0e12fc0 100644 --- a/source/Network/Xmpp/Concurrent/Channels.hs +++ b/source/Network/Xmpp/Concurrent/Channels.hs @@ -109,4 +109,4 @@ writeWorker stCh writeR = forever $ do unless r $ do atomically $ unGetTChan stCh next -- If the writing failed, the -- connection is dead. - threadDelay 250000 -- Avoid free spinning. + threadDelay 250000 -- Avoid free spinning. \ No newline at end of file diff --git a/source/Network/Xmpp/Concurrent/Channels/Types.hs b/source/Network/Xmpp/Concurrent/Channels/Types.hs index 1648cea..ca0cd3d 100644 --- a/source/Network/Xmpp/Concurrent/Channels/Types.hs +++ b/source/Network/Xmpp/Concurrent/Channels/Types.hs @@ -8,8 +8,7 @@ import Data.Text (Text) import Network.Xmpp.Concurrent.Types import Network.Xmpp.Types --- | The @Session@ object holds the current state of the XMPP connection, and is --- thus necessary for any interaction with it. +-- | A concurrent interface to Pontarius XMPP. data Session = Session { context :: Context , stanzaCh :: TChan Stanza -- All stanzas diff --git a/source/Network/Xmpp/Concurrent/Monad.hs b/source/Network/Xmpp/Concurrent/Monad.hs index c6edf44..ac15313 100644 --- a/source/Network/Xmpp/Concurrent/Monad.hs +++ b/source/Network/Xmpp/Concurrent/Monad.hs @@ -9,7 +9,7 @@ import qualified Control.Exception.Lifted as Ex import Control.Monad.Reader import Network.Xmpp.Concurrent.Types -import Network.Xmpp.Connection +import Network.Xmpp.Connection_ @@ -71,8 +71,8 @@ modifyHandlers f session = atomically $ modifyTVar (eventHandlers session) f writeTVar var (f x) -- | Sets the handler to be executed when the server connection is closed. -setConnectionClosedHandler :: (StreamFailure -> Context -> IO ()) -> Context -> IO () -setConnectionClosedHandler eh session = do +setConnectionClosedHandler_ :: (StreamFailure -> Context -> IO ()) -> Context -> IO () +setConnectionClosedHandler_ eh session = do modifyHandlers (\s -> s{connectionClosedHandler = \e -> eh e session}) session diff --git a/source/Network/Xmpp/Concurrent/Threads.hs b/source/Network/Xmpp/Concurrent/Threads.hs index f1ca0b8..1ff2ff3 100644 --- a/source/Network/Xmpp/Concurrent/Threads.hs +++ b/source/Network/Xmpp/Concurrent/Threads.hs @@ -16,7 +16,7 @@ import Control.Monad.State.Strict import qualified Data.ByteString as BS import Network.Xmpp.Concurrent.Types -import Network.Xmpp.Connection +import Network.Xmpp.Connection_ import Control.Concurrent.STM.TMVar @@ -35,7 +35,7 @@ readWorker onStanza onConnectionClosed stateRef = -- necessarily be interruptible s <- atomically $ do con <- readTMVar stateRef - state <- sConnectionState <$> readTMVar con + state <- cState <$> readTMVar con when (state == ConnectionClosed) retry return con @@ -81,7 +81,7 @@ startThreadsWith :: (Stanza -> IO ()) TMVar (TMVar Connection), ThreadId) startThreadsWith stanzaHandler eh con = do - read <- withConnection' (gets $ cSend. cHand) con + read <- withConnection' (gets $ cSend. cHandle) con writeLock <- newTMVarIO read conS <- newTMVarIO con -- lw <- forkIO $ writeWorker outC writeLock diff --git a/source/Network/Xmpp/Connection.hs b/source/Network/Xmpp/Connection.hs index 1f62a3b..d0ed75e 100644 --- a/source/Network/Xmpp/Connection.hs +++ b/source/Network/Xmpp/Connection.hs @@ -1,265 +1,43 @@ -{-# OPTIONS_HADDOCK hide #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE OverloadedStrings #-} - -module Network.Xmpp.Connection where - -import Control.Applicative((<$>)) -import Control.Concurrent (forkIO, threadDelay) -import Control.Monad -import Control.Monad.IO.Class -import Control.Monad.Trans.Class ---import Control.Monad.Trans.Resource -import qualified Control.Exception.Lifted as Ex -import qualified GHC.IO.Exception as GIE -import Control.Monad.State.Strict - -import Data.ByteString as BS -import Data.ByteString.Char8 as BSC8 -import Data.Conduit -import Data.Conduit.Binary as CB -import Data.Conduit.Internal as DCI -import qualified Data.Conduit.List as CL -import Data.IORef -import Data.Text(Text) -import qualified Data.Text as T -import Data.XML.Pickle -import Data.XML.Types - -import Network -import Network.Xmpp.Types -import Network.Xmpp.Marshal -import Network.Xmpp.Pickle - -import System.IO - -import Text.Xml.Stream.Elements -import Text.XML.Stream.Parse as XP -import Text.XML.Unresolved(InvalidEventStream(..)) - -import System.Log.Logger -import Data.ByteString.Base64 - -import Control.Concurrent.STM.TMVar - - --- Enable/disable debug output --- This will dump all incoming and outgoing network taffic to the console, --- prefixed with "in: " and "out: " respectively -debug :: Bool -debug = False - -pushElement :: Element -> StateT Connection IO Bool -pushElement x = do - send <- gets (cSend . cHand) - liftIO . send $ renderElement x - --- | Encode and send stanza -pushStanza :: Stanza -> TMVar Connection -> IO Bool -pushStanza s = withConnection' . pushElement $ pickleElem xpStanza s - --- XML documents and XMPP streams SHOULD be preceeded by an XML declaration. --- UTF-8 is the only supported XMPP encoding. The standalone document --- declaration (matching "SDDecl" in the XML standard) MUST NOT be included in --- XMPP streams. RFC 6120 defines XMPP only in terms of XML 1.0. -pushXmlDecl :: StateT Connection IO Bool -pushXmlDecl = do - con <- gets cHand - liftIO $ (cSend con) "" - -pushOpenElement :: Element -> StateT Connection IO Bool -pushOpenElement e = do - sink <- gets (cSend . cHand ) - liftIO . sink $ renderOpenElement e - --- `Connect-and-resumes' the given sink to the connection source, and pulls a --- `b' value. -runEventsSink :: Sink Event IO b -> StateT Connection IO b -runEventsSink snk = do - source <- gets cEventSource - (src', r) <- lift $ source $$++ snk - modify (\s -> s{cEventSource = src'}) - return r - -pullElement :: StateT Connection IO Element -pullElement = do - Ex.catches (do - e <- runEventsSink (elements =$ await) - case e of - Nothing -> liftIO $ Ex.throwIO StreamOtherFailure - Just r -> return r - ) - [ Ex.Handler (\StreamEnd -> Ex.throwIO StreamEndFailure) - , Ex.Handler (\(InvalidXmppXml s) -- Invalid XML `Event' encountered, or missing element close tag - -> liftIO . Ex.throwIO $ StreamOtherFailure) -- TODO: Log: s - , Ex.Handler $ \(e :: InvalidEventStream) -- xml-conduit exception - -> liftIO . Ex.throwIO $ StreamOtherFailure -- TODO: Log: (show e) - ] - --- Pulls an element and unpickles it. -pullUnpickle :: PU [Node] a -> StateT Connection IO a -pullUnpickle p = do - res <- unpickleElem p <$> pullElement - case res of - Left e -> liftIO $ Ex.throwIO e - Right r -> return r - --- | Pulls a stanza (or stream error) from the stream. Throws an error on a stream --- error. -pullStanza :: TMVar Connection -> IO Stanza -pullStanza = withConnection' $ do - res <- pullUnpickle xpStreamStanza - case res of - Left e -> liftIO . Ex.throwIO $ StreamErrorFailure e - Right r -> return r - --- Performs the given IO operation, catches any errors and re-throws everything --- except 'ResourceVanished' and IllegalOperation, in which case it will return False instead -catchPush :: IO () -> IO Bool -catchPush p = Ex.catch - (p >> return True) - (\e -> case GIE.ioe_type e of - GIE.ResourceVanished -> return False - GIE.IllegalOperation -> return False - _ -> Ex.throwIO e - ) - --- -- Connection state used when there is no connection. -xmppNoConnection :: Connection -xmppNoConnection = Connection - { cHand = Hand { cSend = \_ -> return False - , cRecv = \_ -> Ex.throwIO - $ StreamOtherFailure - , cFlush = return () - , cClose = return () - } - , cEventSource = DCI.ResumableSource zeroSource (return ()) - , sFeatures = SF Nothing [] [] - , sConnectionState = ConnectionClosed - , sHostname = Nothing - , sJid = Nothing - , sStreamLang = Nothing - , sStreamId = Nothing - , sPreferredLang = Nothing - , sToJid = Nothing - , sJidWhenPlain = False - , sFrom = Nothing - } - where - zeroSource :: Source IO output - zeroSource = liftIO . Ex.throwIO $ StreamOtherFailure - --- Connects to the given hostname on port 5222 (TODO: Make this dynamic) and --- updates the XmppConMonad Connection state. -connectTcpRaw :: HostName -> PortID -> Text -> IO (TMVar Connection) -connectTcpRaw host port hostname = do - let PortNumber portNumber = port - debugM "Pontarius.Xmpp" $ "Connecting to " ++ host ++ " on port " ++ - (show portNumber) ++ " through the realm " ++ (T.unpack hostname) ++ "." - h <- connectTo host port - debugM "Pontarius.Xmpp" "Setting NoBuffering mode on handle." - hSetBuffering h NoBuffering - let eSource = DCI.ResumableSource ((sourceHandle h $= logConduit) $= XP.parseBytes def) - (return ()) - let hand = Hand { cSend = \d -> do - let d64 = encode d - debugM "Pontarius.Xmpp" $ "Sending TCP data: " ++ - (BSC8.unpack d64) ++ "." - catchPush $ BS.hPut h d - , cRecv = \n -> do - d <- BS.hGetSome h n - let d64 = encode d - debugM "Pontarius.Xmpp" $ "Received TCP data: " ++ - (BSC8.unpack d64) ++ "." - return d - , cFlush = hFlush h - , cClose = hClose h - } - let con = Connection - { cHand = hand - , cEventSource = eSource - , sFeatures = (SF Nothing [] []) - , sConnectionState = ConnectionPlain - , sHostname = (Just hostname) - , sJid = Nothing - , sPreferredLang = Nothing -- TODO: Allow user to set - , sStreamLang = Nothing - , sStreamId = Nothing - , sToJid = Nothing -- TODO: Allow user to set - , sJidWhenPlain = False -- TODO: Allow user to set - , sFrom = Nothing - } - mkConnection con - where - logConduit :: Conduit ByteString IO ByteString - logConduit = CL.mapM $ \d -> do - let d64 = encode d - debugM "Pontarius.Xmpp" $ "Received TCP data: " ++ (BSC8.unpack d64) ++ - "." - return d - - --- Closes the connection and updates the XmppConMonad Connection state. -killConnection :: TMVar Connection -> IO (Either Ex.SomeException ()) -killConnection = withConnection $ do - cc <- gets (cClose . cHand) - err <- liftIO $ (Ex.try cc :: IO (Either Ex.SomeException ())) - put xmppNoConnection - return err - --- 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 - -> Maybe Jid - -> IQRequestType - -> Maybe LangTag - -> Element - -> TMVar Connection - -> IO (Either IQError IQResult) -pushIQ' iqID to tp lang body con = do - pushStanza (IQRequestS $ IQRequest iqID Nothing to lang tp body) con - res <- pullStanza con - case res of - IQErrorS e -> return $ Left e - IQResultS r -> do - unless - (iqID == iqResultID r) . liftIO . Ex.throwIO $ - StreamOtherFailure - -- TODO: Log: ("In sendIQ' IDs don't match: " ++ show iqID ++ - -- " /= " ++ show (iqResultID r) ++ " .") - return $ Right r - _ -> liftIO $ Ex.throwIO StreamOtherFailure - -- TODO: Log: "sendIQ': unexpected stanza type " - --- | Send "" and wait for the server to finish processing and to --- close the connection. Any remaining elements from the server and whether or --- not we received a element from the server is returned. -closeStreams :: TMVar Connection -> IO ([Element], Bool) -closeStreams = withConnection $ do - send <- gets (cSend . cHand) - cc <- gets (cClose . cHand) - liftIO $ send "" - void $ liftIO $ forkIO $ do - threadDelay 3000000 - (Ex.try cc) :: IO (Either Ex.SomeException ()) - return () - collectElems [] - where - -- Pulls elements from the stream until the stream ends, or an error is - -- raised. - collectElems :: [Element] -> StateT Connection IO ([Element], Bool) - collectElems es = do - result <- Ex.try pullElement - case result of - Left StreamEndFailure -> return (es, True) - Left _ -> return (es, False) - Right e -> collectElems (e:es) - -debugConduit :: Pipe l ByteString ByteString u IO b -debugConduit = forever $ do - s' <- await - case s' of - Just s -> do - liftIO $ BS.putStrLn (BS.append "in: " s) - yield s - Nothing -> return () +-- | +-- Module: $Header$ +-- +-- Maintainer: info@jonkri.com +-- Stability: unstable +-- Portability: portable +-- +-- This module allows for low-level access to Pontarius XMPP. Generally, the +-- "Network.Xmpp" module should be used instead. +-- +-- The 'Connection' object provides the most low-level access to the XMPP +-- stream: a simple and single-threaded interface which exposes the conduit +-- 'Event' source, as well as the input and output byte streams. Custom stateful +-- 'Connection' functions can be executed using 'withConnection'. +-- +-- The TLS, SASL, and 'Session' functionalities of Pontarius XMPP are built on +-- top of this API. + +module Network.Xmpp.Connection + ( Connection(..) + , ConnectionState(..) + , ConnectionHandle(..) + , ServerFeatures(..) + , connect + , withConnection + , startTls + , simpleAuth + , auth + , pushStanza + , pullStanza + , closeConnection + , newSession + ) + + where + +import Network.Xmpp.Connection_ +import Network.Xmpp.Sasl +import Network.Xmpp.Session +import Network.Xmpp.Stream +import Network.Xmpp.Tls +import Network.Xmpp.Types +import Network.Xmpp.Concurrent \ No newline at end of file diff --git a/source/Network/Xmpp/Connection_.hs b/source/Network/Xmpp/Connection_.hs new file mode 100644 index 0000000..8317ef1 --- /dev/null +++ b/source/Network/Xmpp/Connection_.hs @@ -0,0 +1,266 @@ +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} + +module Network.Xmpp.Connection_ where + +import Control.Applicative((<$>)) +import Control.Concurrent (forkIO, threadDelay) +import Control.Monad +import Control.Monad.IO.Class +import Control.Monad.Trans.Class +--import Control.Monad.Trans.Resource +import qualified Control.Exception.Lifted as Ex +import qualified GHC.IO.Exception as GIE +import Control.Monad.State.Strict + +import Data.ByteString as BS +import Data.ByteString.Char8 as BSC8 +import Data.Conduit +import Data.Conduit.Binary as CB +import Data.Conduit.Internal as DCI +import qualified Data.Conduit.List as CL +import Data.IORef +import Data.Text(Text) +import qualified Data.Text as T +import Data.XML.Pickle +import Data.XML.Types + +import Network +import Network.Xmpp.Types +import Network.Xmpp.Marshal +import Network.Xmpp.Pickle + +import System.IO + +import Text.Xml.Stream.Elements +import Text.XML.Stream.Parse as XP +import Text.XML.Unresolved(InvalidEventStream(..)) + +import System.Log.Logger +import Data.ByteString.Base64 + +import Control.Concurrent.STM.TMVar + + +-- Enable/disable debug output +-- This will dump all incoming and outgoing network taffic to the console, +-- prefixed with "in: " and "out: " respectively +debug :: Bool +debug = False + +pushElement :: Element -> StateT Connection IO Bool +pushElement x = do + send <- gets (cSend . cHandle) + liftIO . send $ renderElement x + +-- | Encode and send stanza +pushStanza :: Stanza -> TMVar Connection -> IO Bool +pushStanza s = withConnection' . pushElement $ pickleElem xpStanza s + +-- XML documents and XMPP streams SHOULD be preceeded by an XML declaration. +-- UTF-8 is the only supported XMPP encoding. The standalone document +-- declaration (matching "SDDecl" in the XML standard) MUST NOT be included in +-- XMPP streams. RFC 6120 defines XMPP only in terms of XML 1.0. +pushXmlDecl :: StateT Connection IO Bool +pushXmlDecl = do + con <- gets cHandle + liftIO $ (cSend con) "" + +pushOpenElement :: Element -> StateT Connection IO Bool +pushOpenElement e = do + sink <- gets (cSend . cHandle) + liftIO . sink $ renderOpenElement e + +-- `Connect-and-resumes' the given sink to the connection source, and pulls a +-- `b' value. +runEventsSink :: Sink Event IO b -> StateT Connection IO b +runEventsSink snk = do + source <- gets cEventSource + (src', r) <- lift $ source $$++ snk + modify (\s -> s{cEventSource = src'}) + return r + +pullElement :: StateT Connection IO Element +pullElement = do + Ex.catches (do + e <- runEventsSink (elements =$ await) + case e of + Nothing -> liftIO $ Ex.throwIO StreamOtherFailure + Just r -> return r + ) + [ Ex.Handler (\StreamEnd -> Ex.throwIO StreamEndFailure) + , Ex.Handler (\(InvalidXmppXml s) -- Invalid XML `Event' encountered, or missing element close tag + -> liftIO . Ex.throwIO $ StreamOtherFailure) -- TODO: Log: s + , Ex.Handler $ \(e :: InvalidEventStream) -- xml-conduit exception + -> liftIO . Ex.throwIO $ StreamOtherFailure -- TODO: Log: (show e) + ] + +-- Pulls an element and unpickles it. +pullUnpickle :: PU [Node] a -> StateT Connection IO a +pullUnpickle p = do + res <- unpickleElem p <$> pullElement + case res of + Left e -> liftIO $ Ex.throwIO e + Right r -> return r + +-- | Pulls a stanza (or stream error) from the stream. Throws an error on a stream +-- error. +pullStanza :: TMVar Connection -> IO Stanza +pullStanza = withConnection' $ do + res <- pullUnpickle xpStreamStanza + case res of + Left e -> liftIO . Ex.throwIO $ StreamErrorFailure e + Right r -> return r + +-- Performs the given IO operation, catches any errors and re-throws everything +-- except 'ResourceVanished' and IllegalOperation, in which case it will return False instead +catchPush :: IO () -> IO Bool +catchPush p = Ex.catch + (p >> return True) + (\e -> case GIE.ioe_type e of + GIE.ResourceVanished -> return False + GIE.IllegalOperation -> return False + _ -> Ex.throwIO e + ) + +-- Connection state used when there is no connection. +xmppNoConnection :: Connection +xmppNoConnection = Connection + { cHandle = ConnectionHandle { cSend = \_ -> return False + , cRecv = \_ -> Ex.throwIO + StreamOtherFailure + , cFlush = return () + , cClose = return () + } + , cEventSource = DCI.ResumableSource zeroSource (return ()) + , cFeatures = SF Nothing [] [] + , cState = ConnectionClosed + , cHostName = Nothing + , cJid = Nothing + , cStreamLang = Nothing + , cStreamId = Nothing + , cPreferredLang = Nothing + , cToJid = Nothing + , cJidWhenPlain = False + , cFrom = Nothing + } + where + zeroSource :: Source IO output + zeroSource = liftIO . Ex.throwIO $ StreamOtherFailure + +connectTcp :: HostName -> PortID -> Text -> IO (TMVar Connection) +connectTcp host port hostname = do + let PortNumber portNumber = port + debugM "Pontarius.Xmpp" $ "Connecting to " ++ host ++ " on port " ++ + (show portNumber) ++ " through the realm " ++ (T.unpack hostname) ++ "." + h <- connectTo host port + debugM "Pontarius.Xmpp" "Setting NoBuffering mode on handle." + hSetBuffering h NoBuffering + let eSource = DCI.ResumableSource + ((sourceHandle h $= logConduit) $= XP.parseBytes def) + (return ()) + let hand = ConnectionHandle { cSend = \d -> do + let d64 = encode d + debugM "Pontarius.Xmpp" $ + "Sending TCP data: " ++ (BSC8.unpack d64) + ++ "." + catchPush $ BS.hPut h d + , cRecv = \n -> do + d <- BS.hGetSome h n + let d64 = encode d + debugM "Pontarius.Xmpp" $ + "Received TCP data: " ++ + (BSC8.unpack d64) ++ "." + return d + , cFlush = hFlush h + , cClose = hClose h + } + let con = Connection + { cHandle = hand + , cEventSource = eSource + , cFeatures = (SF Nothing [] []) + , cState = ConnectionPlain + , cHostName = (Just hostname) + , cJid = Nothing + , cPreferredLang = Nothing -- TODO: Allow user to set + , cStreamLang = Nothing + , cStreamId = Nothing + , cToJid = Nothing -- TODO: Allow user to set + , cJidWhenPlain = False -- TODO: Allow user to set + , cFrom = Nothing + } + mkConnection con + where + logConduit :: Conduit ByteString IO ByteString + logConduit = CL.mapM $ \d -> do + let d64 = encode d + debugM "Pontarius.Xmpp" $ "Received TCP data: " ++ (BSC8.unpack d64) ++ + "." + return d + + +-- Closes the connection and updates the XmppConMonad Connection state. +killConnection :: TMVar Connection -> IO (Either Ex.SomeException ()) +killConnection = withConnection $ do + cc <- gets (cClose . cHandle) + err <- liftIO $ (Ex.try cc :: IO (Either Ex.SomeException ())) + put xmppNoConnection + return err + +-- 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 + -> Maybe Jid + -> IQRequestType + -> Maybe LangTag + -> Element + -> TMVar Connection + -> IO (Either IQError IQResult) +pushIQ' iqID to tp lang body con = do + pushStanza (IQRequestS $ IQRequest iqID Nothing to lang tp body) con + res <- pullStanza con + case res of + IQErrorS e -> return $ Left e + IQResultS r -> do + unless + (iqID == iqResultID r) . liftIO . Ex.throwIO $ + StreamOtherFailure + -- TODO: Log: ("In sendIQ' IDs don't match: " ++ show iqID ++ + -- " /= " ++ show (iqResultID r) ++ " .") + return $ Right r + _ -> liftIO $ Ex.throwIO StreamOtherFailure + -- TODO: Log: "sendIQ': unexpected stanza type " + +-- | Send "" and wait for the server to finish processing and to +-- close the connection. Any remaining elements from the server and whether or +-- not we received a element from the server is returned. +closeStreams :: TMVar Connection -> IO ([Element], Bool) +closeStreams = withConnection $ do + send <- gets (cSend . cHandle) + cc <- gets (cClose . cHandle) + liftIO $ send "" + void $ liftIO $ forkIO $ do + threadDelay 3000000 + (Ex.try cc) :: IO (Either Ex.SomeException ()) + return () + collectElems [] + where + -- Pulls elements from the stream until the stream ends, or an error is + -- raised. + collectElems :: [Element] -> StateT Connection IO ([Element], Bool) + collectElems es = do + result <- Ex.try pullElement + case result of + Left StreamEndFailure -> return (es, True) + Left _ -> return (es, False) + Right e -> collectElems (e:es) + +debugConduit :: Pipe l ByteString ByteString u IO b +debugConduit = forever $ do + s' <- await + case s' of + Just s -> do + liftIO $ BS.putStrLn (BS.append "in: " s) + yield s + Nothing -> return () diff --git a/source/Network/Xmpp/Sasl.hs b/source/Network/Xmpp/Sasl.hs index c5e2e62..cbcc825 100644 --- a/source/Network/Xmpp/Sasl.hs +++ b/source/Network/Xmpp/Sasl.hs @@ -29,7 +29,7 @@ import qualified Data.Text as Text import Data.Text (Text) import qualified Data.Text.Encoding as Text -import Network.Xmpp.Connection +import Network.Xmpp.Connection_ import Network.Xmpp.Stream import Network.Xmpp.Types @@ -50,11 +50,11 @@ xmppSasl :: [SaslHandler] -- ^ Acceptable authentication mechanisms and their xmppSasl handlers = withConnection $ do -- Chooses the first mechanism that is acceptable by both the client and the -- server. - mechanisms <- gets $ saslMechanisms . sFeatures + mechanisms <- gets $ saslMechanisms . cFeatures case (filter (\(name, _) -> name `elem` mechanisms)) handlers of [] -> return . Left $ AuthNoAcceptableMechanism mechanisms (_name, handler):_ -> runErrorT $ do - cs <- gets sConnectionState + cs <- gets cState case cs of ConnectionClosed -> throwError AuthConnectionFailure _ -> do diff --git a/source/Network/Xmpp/Sasl/Common.hs b/source/Network/Xmpp/Sasl/Common.hs index 468cf01..a83add5 100644 --- a/source/Network/Xmpp/Sasl/Common.hs +++ b/source/Network/Xmpp/Sasl/Common.hs @@ -22,7 +22,7 @@ import Data.Word (Word8) import Data.XML.Pickle import Data.XML.Types -import Network.Xmpp.Connection +import Network.Xmpp.Connection_ import Network.Xmpp.Pickle import Network.Xmpp.Sasl.StringPrep import Network.Xmpp.Sasl.Types diff --git a/source/Network/Xmpp/Sasl/Mechanisms/DigestMd5.hs b/source/Network/Xmpp/Sasl/Mechanisms/DigestMd5.hs index 75ddac5..9048842 100644 --- a/source/Network/Xmpp/Sasl/Mechanisms/DigestMd5.hs +++ b/source/Network/Xmpp/Sasl/Mechanisms/DigestMd5.hs @@ -31,7 +31,7 @@ import qualified Data.ByteString as BS import Data.XML.Types -import Network.Xmpp.Connection +import Network.Xmpp.Connection_ import Network.Xmpp.Pickle import Network.Xmpp.Stream import Network.Xmpp.Types @@ -47,7 +47,7 @@ xmppDigestMd5 :: Text -- ^ Authentication identity (authzid or username) -> SaslM () xmppDigestMd5 authcid authzid password = do (ac, az, pw) <- prepCredentials authcid authzid password - hn <- gets sHostname + hn <- gets cHostName case hn of Just hn' -> do xmppDigestMd5' hn' ac az pw diff --git a/source/Network/Xmpp/Sasl/Mechanisms/Plain.hs b/source/Network/Xmpp/Sasl/Mechanisms/Plain.hs index 33a0170..6f1626e 100644 --- a/source/Network/Xmpp/Sasl/Mechanisms/Plain.hs +++ b/source/Network/Xmpp/Sasl/Mechanisms/Plain.hs @@ -35,7 +35,7 @@ import qualified Data.ByteString as BS import Data.XML.Types -import Network.Xmpp.Connection +import Network.Xmpp.Connection_ import Network.Xmpp.Stream import Network.Xmpp.Types import Network.Xmpp.Pickle diff --git a/source/Network/Xmpp/Session.hs b/source/Network/Xmpp/Session.hs index 554dbea..857778b 100644 --- a/source/Network/Xmpp/Session.hs +++ b/source/Network/Xmpp/Session.hs @@ -12,7 +12,7 @@ import qualified Network.TLS as TLS import Network.Xmpp.Bind import Network.Xmpp.Concurrent.Types import Network.Xmpp.Concurrent.Channels -import Network.Xmpp.Connection +import Network.Xmpp.Connection_ import Network.Xmpp.Marshal import Network.Xmpp.Pickle import Network.Xmpp.Sasl @@ -42,7 +42,7 @@ session :: HostName -- ^ Host to connect to -- the server decide) -> IO Session -- TODO: ErrorT session hostname realm port tls sasl = do - con' <- connectTcp hostname port realm + con' <- connect hostname port realm con <- case con' of Left e -> Ex.throwIO e Right c -> return c @@ -50,33 +50,15 @@ session hostname realm port tls sasl = do saslResponse <- if isJust sasl then auth (fst $ fromJust sasl) (snd $ fromJust sasl) con >> return () else return () -- TODO: Eats AuthFailure newSession con --- | Connect to host with given address. -connectTcp :: HostName -> PortID -> Text -> IO (Either StreamFailure (TMVar Connection)) -connectTcp address port hostname = do - con <- connectTcpRaw address port hostname +-- | Connects to the XMPP server and opens the XMPP stream against the given +-- host name, port, and realm. +connect :: HostName -> PortID -> Text -> IO (Either StreamFailure (TMVar Connection)) +connect address port hostname = do + con <- connectTcp address port hostname result <- withConnection startStream con case result of - Left e -> do - withConnection (pushElement . pickleElem xpStreamError $ toError e) - con - closeStreams con - return $ Left e + Left e -> return $ Left e -- TODO Right () -> return $ Right con - where - -- toError (StreamNotStreamElement _name) = - -- XmppStreamFailure StreamInvalidXml Nothing Nothing - -- toError (StreamInvalidStreamNamespace _ns) = - -- XmppStreamFailure StreamInvalidNamespace Nothing Nothing - -- toError (StreamInvalidStreamPrefix _prefix) = - -- XmppStreamFailure StreamBadNamespacePrefix Nothing Nothing - -- toError (StreamWrongVersion _ver) = - -- XmppStreamFailure StreamUnsupportedVersion Nothing Nothing - -- toError (StreamWrongLangTag _) = - -- XmppStreamFailure StreamInvalidXml Nothing Nothing - -- toError StreamUnknownError = - -- XmppStreamFailure StreamBadFormat Nothing Nothing - -- TODO: Catch remaining xmppStartStream errors. - toError _ = StreamErrorInfo StreamBadFormat Nothing Nothing sessionXml :: Element sessionXml = pickleElem diff --git a/source/Network/Xmpp/Stream.hs b/source/Network/Xmpp/Stream.hs index bf9ad69..3941614 100644 --- a/source/Network/Xmpp/Stream.hs +++ b/source/Network/Xmpp/Stream.hs @@ -20,7 +20,7 @@ import Data.Void (Void) import Data.XML.Pickle import Data.XML.Types -import Network.Xmpp.Connection +import Network.Xmpp.Connection_ import Network.Xmpp.Pickle import Network.Xmpp.Types import Network.Xmpp.Marshal @@ -71,11 +71,11 @@ startStream = runErrorT $ do con <- liftIO $ mkConnection state -- Set the `from' (which is also the expected to) attribute depending on the -- state of the connection. - let expectedTo = case sConnectionState state of - ConnectionPlain -> if sJidWhenPlain state - then sJid state else Nothing - ConnectionSecured -> sJid state - case sHostname state of + let expectedTo = case cState state of + ConnectionPlain -> if cJidWhenPlain state + then cJid state else Nothing + ConnectionSecured -> cJid state + case cHostName state of Nothing -> throwError StreamOtherFailure -- TODO: When does this happen? Just hostname -> lift $ do pushXmlDecl @@ -84,7 +84,7 @@ startStream = runErrorT $ do , expectedTo , Just (Jid Nothing hostname Nothing) , Nothing - , sPreferredLang state + , cPreferredLang state ) response <- ErrorT $ runEventsSink $ runErrorT $ streamS expectedTo case response of @@ -95,15 +95,15 @@ startStream = runErrorT $ do | lt == Nothing -> closeStreamWithError con StreamInvalidXml Nothing -- If `from' is set, we verify that it's the correct one. TODO: Should we check against the realm instead? - | isJust from && (from /= Just (Jid Nothing (fromJust $ sHostname state) Nothing)) -> + | isJust from && (from /= Just (Jid Nothing (fromJust $ cHostName state) Nothing)) -> closeStreamWithError con StreamInvalidFrom Nothing | to /= expectedTo -> closeStreamWithError con StreamUndefinedCondition (Just $ Element "invalid-to" [] []) -- TODO: Suitable? | otherwise -> do - modify (\s -> s{ sFeatures = features - , sStreamLang = lt - , sStreamId = id - , sFrom = from + modify (\s -> s{ cFeatures = features + , cStreamLang = lt + , cStreamId = id + , cFrom = from } ) return () -- Unpickling failed - we investigate the element. @@ -158,7 +158,7 @@ flattenAttrs attrs = Prelude.map (\(name, content) -> -- and calls xmppStartStream. restartStream :: StateT Connection IO (Either StreamFailure ()) restartStream = do - raw <- gets (cRecv . cHand) + raw <- gets (cRecv . cHandle) let newSource = DCI.ResumableSource (loopRead raw $= XP.parseBytes def) (return ()) modify (\s -> s{cEventSource = newSource }) diff --git a/source/Network/Xmpp/Tls.hs b/source/Network/Xmpp/Tls.hs index 5464341..75c73bf 100644 --- a/source/Network/Xmpp/Tls.hs +++ b/source/Network/Xmpp/Tls.hs @@ -17,7 +17,7 @@ import Data.Conduit.Tls as TLS import Data.Typeable import Data.XML.Types -import Network.Xmpp.Connection +import Network.Xmpp.Connection_ import Network.Xmpp.Pickle(ppElement) import Network.Xmpp.Stream import Network.Xmpp.Types @@ -80,13 +80,13 @@ startTls :: TLS.TLSParams -> TMVar Connection -> IO (Either TlsFailure ()) startTls params con = Ex.handle (return . Left . TlsError) . flip withConnection con . runErrorT $ do - features <- lift $ gets sFeatures - state <- gets sConnectionState + features <- lift $ gets cFeatures + state <- gets cState case state of ConnectionPlain -> return () ConnectionClosed -> throwError TlsNoConnection ConnectionSecured -> throwError TlsConnectionSecured - con <- lift $ gets cHand + con <- lift $ gets cHandle when (stls features == Nothing) $ throwError TlsNoServerSupport lift $ pushElement starttlsE answer <- lift $ pullElement @@ -98,12 +98,12 @@ startTls params con = Ex.handle (return . Left . TlsError) e -> lift $ Ex.throwIO StreamOtherFailure -- TODO: Log: "Unexpected element: " ++ ppElement e (raw, _snk, psh, read, ctx) <- lift $ TLS.tlsinit debug params (mkBackend con) - let newHand = Hand { cSend = catchPush . psh - , cRecv = read - , cFlush = contextFlush ctx - , cClose = bye ctx >> cClose con - } - lift $ modify ( \x -> x {cHand = newHand}) + let newHand = ConnectionHandle { cSend = catchPush . psh + , cRecv = read + , cFlush = contextFlush ctx + , cClose = bye ctx >> cClose con + } + lift $ modify ( \x -> x {cHandle = newHand}) either (lift . Ex.throwIO) return =<< lift restartStream - modify (\s -> s{sConnectionState = ConnectionSecured}) + modify (\s -> s{cState = ConnectionSecured}) return () diff --git a/source/Network/Xmpp/Types.hs b/source/Network/Xmpp/Types.hs index 58d66c2..1a71d94 100644 --- a/source/Network/Xmpp/Types.hs +++ b/source/Network/Xmpp/Types.hs @@ -31,7 +31,7 @@ module Network.Xmpp.Types , StreamFailure(..) , StreamErrorCondition(..) , Version(..) - , HandleLike(..) + , ConnectionHandle(..) , Connection(..) , withConnection , withConnection' @@ -739,54 +739,47 @@ data ServerFeatures = SF , other :: ![Element] } deriving Show +-- | Signals the state of the connection. data ConnectionState = ConnectionClosed -- ^ No connection at this point. | ConnectionPlain -- ^ Connection established, but not secured. | ConnectionSecured -- ^ Connection established and secured via TLS. deriving (Show, Eq, Typeable) -data HandleLike = Hand { cSend :: BS.ByteString -> IO Bool - , cRecv :: Int -> IO BS.ByteString - -- This is to hold the state of the XML parser - -- (otherwise we will receive lot's of EvenBegin - -- Document and forger about name prefixes) - , cFlush :: IO () - , cClose :: IO () - } +-- | Defines operations for sending, receiving, flushing, and closing on a +-- connection. +data ConnectionHandle = + ConnectionHandle { cSend :: BS.ByteString -> IO Bool + , cRecv :: Int -> IO BS.ByteString + -- This is to hold the state of the XML parser (otherwise + -- we will receive EventBeginDocument events and forget + -- about name prefixes). + , cFlush :: IO () + , cClose :: IO () + } data Connection = Connection - { sConnectionState :: !ConnectionState -- ^ State of - -- connection - , cHand :: HandleLike - , cEventSource :: ResumableSource IO Event - , sFeatures :: !ServerFeatures -- ^ Features the server - -- advertised - , sHostname :: !(Maybe Text) -- ^ Hostname of the - -- server - , sJid :: !(Maybe Jid) -- ^ Our JID - , sPreferredLang :: !(Maybe LangTag) -- ^ Default language - -- when no explicit - -- language tag is set - , sStreamLang :: !(Maybe LangTag) -- ^ Will be a `Just' - -- value once connected - -- to the server. - , sStreamId :: !(Maybe Text) -- ^ Stream ID as - -- specified by the - -- server. - , sToJid :: !(Maybe Jid) -- ^ JID to include in the - -- stream element's `to' - -- attribute when the - -- connection is - -- secured. See also below. - , sJidWhenPlain :: !Bool -- ^ Whether or not to also - -- include the Jid when the - -- connection is plain. - , sFrom :: !(Maybe Jid) -- ^ From as specified by - -- the server in the - -- stream element's `from' - -- attribute. - } - + { cState :: !ConnectionState -- ^ State of connection + , cHandle :: ConnectionHandle -- ^ Handle to send, receive, flush, and close + -- on the connection. + , cEventSource :: ResumableSource IO Event -- ^ Event conduit source, and + -- its associated finalizer + , cFeatures :: !ServerFeatures -- ^ Features as advertised by the server + , cHostName :: !(Maybe Text) -- ^ Hostname of the server + , cJid :: !(Maybe Jid) -- ^ Our JID + , cPreferredLang :: !(Maybe LangTag) -- ^ Default language when no explicit + -- language tag is set + , cStreamLang :: !(Maybe LangTag) -- ^ Will be a `Just' value once connected + -- to the server. + , cStreamId :: !(Maybe Text) -- ^ Stream ID as specified by the server. + , cToJid :: !(Maybe Jid) -- ^ JID to include in the stream element's `to' + -- attribute when the connection is secured. See + -- also below. + , cJidWhenPlain :: !Bool -- ^ Whether or not to also include the Jid when + -- the connection is plain. + , cFrom :: !(Maybe Jid) -- ^ From as specified by the server in the stream + -- element's `from' attribute. + } withConnection :: StateT Connection IO c -> TMVar Connection -> IO c withConnection action con = bracketOnError diff --git a/source/Network/Xmpp/Xep/InbandRegistration.hs b/source/Network/Xmpp/Xep/InbandRegistration.hs index 6e14447..a2f6fe4 100644 --- a/source/Network/Xmpp/Xep/InbandRegistration.hs +++ b/source/Network/Xmpp/Xep/InbandRegistration.hs @@ -19,7 +19,7 @@ import qualified Data.Text as Text import Data.XML.Pickle import qualified Data.XML.Types as XML -import Network.Xmpp.Connection +import Network.Xmpp.Connection_ import Network.Xmpp.Pickle import Network.Xmpp.Types import Network.Xmpp.Xep.ServiceDiscovery diff --git a/source/Network/Xmpp/Xep/ServiceDiscovery.hs b/source/Network/Xmpp/Xep/ServiceDiscovery.hs index 2138017..85a22c2 100644 --- a/source/Network/Xmpp/Xep/ServiceDiscovery.hs +++ b/source/Network/Xmpp/Xep/ServiceDiscovery.hs @@ -28,7 +28,7 @@ import Network.Xmpp import Network.Xmpp.Concurrent import Network.Xmpp.Concurrent.Channels import Network.Xmpp.Concurrent.Types -import Network.Xmpp.Connection +import Network.Xmpp.Connection_ import Network.Xmpp.Pickle import Network.Xmpp.Types import Control.Concurrent.STM.TMVar From 17b5f64f613ae4c3f14cdeb91430398aacf2b002 Mon Sep 17 00:00:00 2001 From: Jon Kristensen Date: Wed, 16 Jan 2013 14:53:29 +0100 Subject: [PATCH 11/15] Fix silly stream element validation bug --- source/Network/Xmpp/Stream.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/source/Network/Xmpp/Stream.hs b/source/Network/Xmpp/Stream.hs index 3941614..972017a 100644 --- a/source/Network/Xmpp/Stream.hs +++ b/source/Network/Xmpp/Stream.hs @@ -90,7 +90,7 @@ startStream = runErrorT $ do case response of -- Successful unpickling of stream element. Right (ver, from, to, id, lt, features) - | (unpack $ fromJust id) /= "1.0" -> + | (unpack ver) /= "1.0" -> closeStreamWithError con StreamUnsupportedVersion Nothing | lt == Nothing -> closeStreamWithError con StreamInvalidXml Nothing From 7c1816b2259d5a55614ffe243fa01668f5d3854f Mon Sep 17 00:00:00 2001 From: Jon Kristensen Date: Tue, 29 Jan 2013 15:59:52 +0100 Subject: [PATCH 12/15] Conform to tls-1.1 --- pontarius-xmpp.cabal | 3 ++- source/Data/Conduit/Tls.hs | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/pontarius-xmpp.cabal b/pontarius-xmpp.cabal index 0f8e883..b775eb5 100644 --- a/pontarius-xmpp.cabal +++ b/pontarius-xmpp.cabal @@ -31,13 +31,14 @@ Library , resourcet >=0.3.0 , containers >=0.4.0.0 , random >=1.0.0.0 - , tls >=1.0.0 + , tls >=1.1.0 , tls-extra >=0.5.0 , pureMD5 >=2.1.2.1 , base64-bytestring >=0.1.0.0 , binary >=0.4.1 , attoparsec >=0.10.0.3 , crypto-api >=0.9 + , crypto-random-api >=0.2 , cryptohash >=0.6.1 , text >=0.11.1.5 , bytestring >=0.9.1.9 diff --git a/source/Data/Conduit/Tls.hs b/source/Data/Conduit/Tls.hs index 17e4d19..0842ae5 100644 --- a/source/Data/Conduit/Tls.hs +++ b/source/Data/Conduit/Tls.hs @@ -21,6 +21,7 @@ import qualified Data.Conduit.Binary as CB import Data.IORef import Network.TLS as TLS +import Crypto.Random.API import Network.TLS.Extra as TLSExtra import System.IO (Handle) @@ -42,7 +43,7 @@ tlsinit :: (MonadIO m, MonadIO m1) => ) tlsinit debug tlsParams backend = do when debug . liftIO $ putStrLn "TLS with debug mode enabled" - gen <- liftIO $ (newGenIO :: IO SystemRandom) -- TODO: Find better random source? + gen <- liftIO $ getSystemRandomGen -- TODO: Find better random source? con <- client tlsParams gen backend handshake con let src = forever $ do From 29e2af8c3362488b7cc3679b36707be1313516f6 Mon Sep 17 00:00:00 2001 From: Jon Kristensen Date: Tue, 29 Jan 2013 19:22:13 +0100 Subject: [PATCH 13/15] Remove Context As previously mentioned, `Context' is simply a bunch of thread management features. This patch moves the `Context' fields into `Session', and the `Network.Xmpp.Concurrent.Channel' modules into `Network.Xmpp.Concurrent'. --- pontarius-xmpp.cabal | 10 +- source/Network/Xmpp.hs | 1 - source/Network/Xmpp/Concurrent.hs | 109 ++++++++++++++++- .../Xmpp/Concurrent/{Channels => }/Basic.hs | 4 +- source/Network/Xmpp/Concurrent/Channels.hs | 112 ------------------ .../Network/Xmpp/Concurrent/Channels/Types.hs | 32 ----- .../Xmpp/Concurrent/{Channels => }/IQ.hs | 7 +- .../Xmpp/Concurrent/{Channels => }/Message.hs | 6 +- source/Network/Xmpp/Concurrent/Monad.hs | 10 +- .../Concurrent/{Channels => }/Presence.hs | 5 +- source/Network/Xmpp/Concurrent/Types.hs | 43 +++++-- source/Network/Xmpp/Session.hs | 4 +- source/Network/Xmpp/Xep/ServiceDiscovery.hs | 1 - 13 files changed, 159 insertions(+), 185 deletions(-) rename source/Network/Xmpp/Concurrent/{Channels => }/Basic.hs (82%) delete mode 100644 source/Network/Xmpp/Concurrent/Channels.hs delete mode 100644 source/Network/Xmpp/Concurrent/Channels/Types.hs rename source/Network/Xmpp/Concurrent/{Channels => }/IQ.hs (94%) rename source/Network/Xmpp/Concurrent/{Channels => }/Message.hs (93%) rename source/Network/Xmpp/Concurrent/{Channels => }/Presence.hs (87%) diff --git a/pontarius-xmpp.cabal b/pontarius-xmpp.cabal index b775eb5..a2304a7 100644 --- a/pontarius-xmpp.cabal +++ b/pontarius-xmpp.cabal @@ -61,12 +61,10 @@ Library , Network.Xmpp.Bind , Network.Xmpp.Concurrent , Network.Xmpp.Concurrent.Types - , Network.Xmpp.Concurrent.Channels - , Network.Xmpp.Concurrent.Channels.Basic - , Network.Xmpp.Concurrent.Channels.IQ - , Network.Xmpp.Concurrent.Channels.Message - , Network.Xmpp.Concurrent.Channels.Presence - , Network.Xmpp.Concurrent.Channels.Types + , Network.Xmpp.Concurrent.Basic + , Network.Xmpp.Concurrent.IQ + , Network.Xmpp.Concurrent.Message + , Network.Xmpp.Concurrent.Presence , Network.Xmpp.Concurrent.Threads , Network.Xmpp.Concurrent.Monad , Network.Xmpp.Connection_ diff --git a/source/Network/Xmpp.hs b/source/Network/Xmpp.hs index 7184ba2..93c78bb 100644 --- a/source/Network/Xmpp.hs +++ b/source/Network/Xmpp.hs @@ -152,7 +152,6 @@ import Data.XML.Types (Element) import Network import Network.Xmpp.Bind import Network.Xmpp.Concurrent -import Network.Xmpp.Concurrent.Channels import Network.Xmpp.Concurrent.Types import Network.Xmpp.Connection_ import Network.Xmpp.Marshal diff --git a/source/Network/Xmpp/Concurrent.hs b/source/Network/Xmpp/Concurrent.hs index 94f0f62..9156b33 100644 --- a/source/Network/Xmpp/Concurrent.hs +++ b/source/Network/Xmpp/Concurrent.hs @@ -1,12 +1,111 @@ {-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE OverloadedStrings #-} module Network.Xmpp.Concurrent - ( Context - , module Network.Xmpp.Concurrent.Monad + ( module Network.Xmpp.Concurrent.Monad , module Network.Xmpp.Concurrent.Threads - , module Network.Xmpp.Concurrent.Channels + , module Network.Xmpp.Concurrent.Basic + , module Network.Xmpp.Concurrent.Types + , module Network.Xmpp.Concurrent.Message + , module Network.Xmpp.Concurrent.Presence + , module Network.Xmpp.Concurrent.IQ + , toChans + , newSession + , writeWorker ) where -import Network.Xmpp.Concurrent.Types import Network.Xmpp.Concurrent.Monad import Network.Xmpp.Concurrent.Threads -import Network.Xmpp.Concurrent.Channels +import Control.Applicative((<$>),(<*>)) +import Control.Concurrent +import Control.Concurrent.STM +import Control.Monad +import qualified Data.ByteString as BS +import Data.IORef +import qualified Data.Map as Map +import Data.Maybe (fromMaybe) +import Data.XML.Types +import Network.Xmpp.Concurrent.Basic +import Network.Xmpp.Concurrent.IQ +import Network.Xmpp.Concurrent.Message +import Network.Xmpp.Concurrent.Presence +import Network.Xmpp.Concurrent.Types +import Network.Xmpp.Concurrent.Threads +import Network.Xmpp.Marshal +import Network.Xmpp.Pickle +import Network.Xmpp.Types +import Text.Xml.Stream.Elements + +toChans :: TChan Stanza + -> TVar IQHandlers + -> Stanza + -> IO () +toChans stanzaC iqHands sta = atomically $ do + writeTChan stanzaC sta + case sta of + IQRequestS i -> handleIQRequest iqHands i + IQResultS i -> handleIQResponse iqHands (Right i) + IQErrorS i -> handleIQResponse iqHands (Left i) + _ -> return () + where + -- If the IQ request has a namespace, send it through the appropriate channel. + handleIQRequest :: TVar IQHandlers -> IQRequest -> STM () + handleIQRequest handlers iq = do + (byNS, _) <- readTVar handlers + let iqNS = fromMaybe "" (nameNamespace . elementName $ iqRequestPayload iq) + case Map.lookup (iqRequestType iq, iqNS) byNS of + Nothing -> return () -- TODO: send error stanza + Just ch -> do + sent <- newTVar False + writeTChan ch $ IQRequestTicket sent iq + handleIQResponse :: TVar IQHandlers -> Either IQError IQResult -> STM () + handleIQResponse handlers iq = do + (byNS, byID) <- readTVar handlers + case Map.updateLookupWithKey (\_ _ -> Nothing) (iqID iq) byID of + (Nothing, _) -> return () -- We are not supposed to send an error. + (Just tmvar, byID') -> do + let answer = either IQResponseError IQResponseResult iq + _ <- tryPutTMVar tmvar answer -- Don't block. + writeTVar handlers (byNS, byID') + where + iqID (Left err) = iqErrorID err + iqID (Right iq') = iqResultID iq' + + +-- | Creates and initializes a new Xmpp context. +newSession :: TMVar Connection -> IO Session +newSession con = do + outC <- newTChanIO + stanzaChan <- newTChanIO + iqHandlers <- newTVarIO (Map.empty, Map.empty) + eh <- newTVarIO $ EventHandlers { connectionClosedHandler = \_ -> return () } + let stanzaHandler = toChans stanzaChan iqHandlers + (kill, wLock, conState, readerThread) <- startThreadsWith stanzaHandler eh con + writer <- forkIO $ writeWorker outC wLock + idRef <- newTVarIO 1 + let getId = atomically $ do + curId <- readTVar idRef + writeTVar idRef (curId + 1 :: Integer) + return . read. show $ curId + return $ Session { stanzaCh = stanzaChan + , outCh = outC + , iqHandlers = iqHandlers + , writeRef = wLock + , readerThread = readerThread + , idGenerator = getId + , conRef = conState + , eventHandlers = eh + , stopThreads = kill >> killThread writer + } + +-- Worker to write stanzas to the stream concurrently. +writeWorker :: TChan Stanza -> TMVar (BS.ByteString -> IO Bool) -> IO () +writeWorker stCh writeR = forever $ do + (write, next) <- atomically $ (,) <$> + takeTMVar writeR <*> + readTChan stCh + r <- write $ renderElement (pickleElem xpStanza next) + atomically $ putTMVar writeR write + unless r $ do + atomically $ unGetTChan stCh next -- If the writing failed, the + -- connection is dead. + threadDelay 250000 -- Avoid free spinning. diff --git a/source/Network/Xmpp/Concurrent/Channels/Basic.hs b/source/Network/Xmpp/Concurrent/Basic.hs similarity index 82% rename from source/Network/Xmpp/Concurrent/Channels/Basic.hs rename to source/Network/Xmpp/Concurrent/Basic.hs index e01d920..5b16e4e 100644 --- a/source/Network/Xmpp/Concurrent/Channels/Basic.hs +++ b/source/Network/Xmpp/Concurrent/Basic.hs @@ -1,8 +1,8 @@ {-# OPTIONS_HADDOCK hide #-} -module Network.Xmpp.Concurrent.Channels.Basic where +module Network.Xmpp.Concurrent.Basic where import Control.Concurrent.STM -import Network.Xmpp.Concurrent.Channels.Types +import Network.Xmpp.Concurrent.Types import Network.Xmpp.Types -- | Send a stanza to the server. diff --git a/source/Network/Xmpp/Concurrent/Channels.hs b/source/Network/Xmpp/Concurrent/Channels.hs deleted file mode 100644 index 0e12fc0..0000000 --- a/source/Network/Xmpp/Concurrent/Channels.hs +++ /dev/null @@ -1,112 +0,0 @@ -{-# OPTIONS_HADDOCK hide #-} -{-# LANGUAGE OverloadedStrings #-} -module Network.Xmpp.Concurrent.Channels - ( module Network.Xmpp.Concurrent.Channels.Basic - , module Network.Xmpp.Concurrent.Channels.Types - , module Network.Xmpp.Concurrent.Channels.Message - , module Network.Xmpp.Concurrent.Channels.Presence - , module Network.Xmpp.Concurrent.Channels.IQ - , toChans - , newSession - , writeWorker - ) - - where - -import Control.Applicative((<$>),(<*>)) -import Control.Concurrent -import Control.Concurrent.STM -import Control.Monad -import qualified Data.ByteString as BS -import Data.IORef -import qualified Data.Map as Map -import Data.Maybe (fromMaybe) -import Data.XML.Types -import Network.Xmpp.Concurrent.Channels.Basic -import Network.Xmpp.Concurrent.Channels.IQ -import Network.Xmpp.Concurrent.Channels.Message -import Network.Xmpp.Concurrent.Channels.Presence -import Network.Xmpp.Concurrent.Channels.Types -import Network.Xmpp.Concurrent.Threads -import Network.Xmpp.Concurrent.Types -import Network.Xmpp.Marshal -import Network.Xmpp.Pickle -import Network.Xmpp.Types -import Text.Xml.Stream.Elements - -toChans :: TChan Stanza - -> TVar IQHandlers - -> Stanza - -> IO () -toChans stanzaC iqHands sta = atomically $ do - writeTChan stanzaC sta - case sta of - IQRequestS i -> handleIQRequest iqHands i - IQResultS i -> handleIQResponse iqHands (Right i) - IQErrorS i -> handleIQResponse iqHands (Left i) - _ -> return () - where - -- If the IQ request has a namespace, send it through the appropriate channel. - handleIQRequest :: TVar IQHandlers -> IQRequest -> STM () - handleIQRequest handlers iq = do - (byNS, _) <- readTVar handlers - let iqNS = fromMaybe "" (nameNamespace . elementName $ iqRequestPayload iq) - case Map.lookup (iqRequestType iq, iqNS) byNS of - Nothing -> return () -- TODO: send error stanza - Just ch -> do - sent <- newTVar False - writeTChan ch $ IQRequestTicket sent iq - handleIQResponse :: TVar IQHandlers -> Either IQError IQResult -> STM () - handleIQResponse handlers iq = do - (byNS, byID) <- readTVar handlers - case Map.updateLookupWithKey (\_ _ -> Nothing) (iqID iq) byID of - (Nothing, _) -> return () -- We are not supposed to send an error. - (Just tmvar, byID') -> do - let answer = either IQResponseError IQResponseResult iq - _ <- tryPutTMVar tmvar answer -- Don't block. - writeTVar handlers (byNS, byID') - where - iqID (Left err) = iqErrorID err - iqID (Right iq') = iqResultID iq' - - --- | Creates and initializes a new Xmpp context. -newSession :: TMVar Connection -> IO Session -newSession con = do - outC <- newTChanIO - stanzaChan <- newTChanIO - iqHandlers <- newTVarIO (Map.empty, Map.empty) - eh <- newTVarIO $ EventHandlers { connectionClosedHandler = \_ -> return () } - let stanzaHandler = toChans stanzaChan iqHandlers - (kill, wLock, conState, readerThread) <- startThreadsWith stanzaHandler eh con - writer <- forkIO $ writeWorker outC wLock - idRef <- newTVarIO 1 - let getId = atomically $ do - curId <- readTVar idRef - writeTVar idRef (curId + 1 :: Integer) - return . read. show $ curId - let cont = Context { writeRef = wLock - , readerThread = readerThread - , idGenerator = getId - , conRef = conState - , eventHandlers = eh - , stopThreads = kill >> killThread writer - } - return $ Session { context = cont - , stanzaCh = stanzaChan - , outCh = outC - , iqHandlers = iqHandlers - } - --- Worker to write stanzas to the stream concurrently. -writeWorker :: TChan Stanza -> TMVar (BS.ByteString -> IO Bool) -> IO () -writeWorker stCh writeR = forever $ do - (write, next) <- atomically $ (,) <$> - takeTMVar writeR <*> - readTChan stCh - r <- write $ renderElement (pickleElem xpStanza next) - atomically $ putTMVar writeR write - unless r $ do - atomically $ unGetTChan stCh next -- If the writing failed, the - -- connection is dead. - threadDelay 250000 -- Avoid free spinning. \ No newline at end of file diff --git a/source/Network/Xmpp/Concurrent/Channels/Types.hs b/source/Network/Xmpp/Concurrent/Channels/Types.hs deleted file mode 100644 index ca0cd3d..0000000 --- a/source/Network/Xmpp/Concurrent/Channels/Types.hs +++ /dev/null @@ -1,32 +0,0 @@ -{-# OPTIONS_HADDOCK hide #-} -module Network.Xmpp.Concurrent.Channels.Types where - -import Control.Concurrent.STM -import Data.IORef -import qualified Data.Map as Map -import Data.Text (Text) -import Network.Xmpp.Concurrent.Types -import Network.Xmpp.Types - --- | A concurrent interface to Pontarius XMPP. -data Session = Session - { context :: Context - , stanzaCh :: TChan Stanza -- All stanzas - , outCh :: TChan Stanza - , iqHandlers :: TVar IQHandlers - -- Writing lock, so that only one thread could write to the stream at any - -- given time. - } - --- | 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) - ) - --- | Contains whether or not a reply has been sent, and the IQ request body to --- reply to. -data IQRequestTicket = IQRequestTicket - { sentRef :: (TVar Bool) - , iqRequestBody :: IQRequest - } diff --git a/source/Network/Xmpp/Concurrent/Channels/IQ.hs b/source/Network/Xmpp/Concurrent/IQ.hs similarity index 94% rename from source/Network/Xmpp/Concurrent/Channels/IQ.hs rename to source/Network/Xmpp/Concurrent/IQ.hs index 4c6ce3d..bd79061 100644 --- a/source/Network/Xmpp/Concurrent/Channels/IQ.hs +++ b/source/Network/Xmpp/Concurrent/IQ.hs @@ -1,5 +1,5 @@ {-# OPTIONS_HADDOCK hide #-} -module Network.Xmpp.Concurrent.Channels.IQ where +module Network.Xmpp.Concurrent.IQ where import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent.STM @@ -11,8 +11,7 @@ import qualified Data.Map as Map import Data.Text (Text) import Data.XML.Types -import Network.Xmpp.Concurrent.Channels.Basic -import Network.Xmpp.Concurrent.Channels.Types +import Network.Xmpp.Concurrent.Basic import Network.Xmpp.Concurrent.Types import Network.Xmpp.Types @@ -27,7 +26,7 @@ sendIQ :: Maybe Int -- ^ Timeout -> Session -> IO (TMVar IQResponse) sendIQ timeOut to tp lang body session = do -- TODO: Add timeout - newId <- idGenerator (context session) + newId <- idGenerator session ref <- atomically $ do resRef <- newEmptyTMVar (byNS, byId) <- readTVar (iqHandlers session) diff --git a/source/Network/Xmpp/Concurrent/Channels/Message.hs b/source/Network/Xmpp/Concurrent/Message.hs similarity index 93% rename from source/Network/Xmpp/Concurrent/Channels/Message.hs rename to source/Network/Xmpp/Concurrent/Message.hs index 5cff80a..b84dc2e 100644 --- a/source/Network/Xmpp/Concurrent/Channels/Message.hs +++ b/source/Network/Xmpp/Concurrent/Message.hs @@ -1,12 +1,12 @@ {-# OPTIONS_HADDOCK hide #-} -module Network.Xmpp.Concurrent.Channels.Message where +module Network.Xmpp.Concurrent.Message where -import Network.Xmpp.Concurrent.Channels.Types +import Network.Xmpp.Concurrent.Types import Control.Concurrent.STM import Data.IORef import Network.Xmpp.Types import Network.Xmpp.Concurrent.Types -import Network.Xmpp.Concurrent.Channels.Basic +import Network.Xmpp.Concurrent.Basic -- | Read an element from the inbound stanza channel, acquiring a copy of the -- channel as necessary. diff --git a/source/Network/Xmpp/Concurrent/Monad.hs b/source/Network/Xmpp/Concurrent/Monad.hs index ac15313..863c985 100644 --- a/source/Network/Xmpp/Concurrent/Monad.hs +++ b/source/Network/Xmpp/Concurrent/Monad.hs @@ -59,7 +59,7 @@ import Network.Xmpp.Connection_ -- ] -- | Executes a function to update the event handlers. -modifyHandlers :: (EventHandlers -> EventHandlers) -> Context -> IO () +modifyHandlers :: (EventHandlers -> EventHandlers) -> Session -> IO () modifyHandlers f session = atomically $ modifyTVar (eventHandlers session) f where -- Borrowing modifyTVar from @@ -71,18 +71,18 @@ modifyHandlers f session = atomically $ modifyTVar (eventHandlers session) f writeTVar var (f x) -- | Sets the handler to be executed when the server connection is closed. -setConnectionClosedHandler_ :: (StreamFailure -> Context -> IO ()) -> Context -> IO () +setConnectionClosedHandler_ :: (StreamFailure -> Session -> IO ()) -> Session -> IO () setConnectionClosedHandler_ eh session = do modifyHandlers (\s -> s{connectionClosedHandler = \e -> eh e session}) session -- | Run an event handler. -runHandler :: (EventHandlers -> IO a) -> Context -> IO a +runHandler :: (EventHandlers -> IO a) -> Session -> IO a runHandler h session = h =<< atomically (readTVar $ eventHandlers session) -- | End the current Xmpp session. -endContext :: Context -> IO () +endContext :: Session -> IO () endContext session = do -- TODO: This has to be idempotent (is it?) closeConnection session stopThreads session @@ -90,7 +90,7 @@ endContext session = do -- TODO: This has to be idempotent (is it?) -- | Close the connection to the server. Closes the stream (by enforcing a -- write lock and sending a element), waits (blocks) for three -- seconds, and then closes the connection. -closeConnection :: Context -> IO () +closeConnection :: Session -> IO () closeConnection session = Ex.mask_ $ do (_send, connection) <- atomically $ liftM2 (,) (takeTMVar $ writeRef session) diff --git a/source/Network/Xmpp/Concurrent/Channels/Presence.hs b/source/Network/Xmpp/Concurrent/Presence.hs similarity index 87% rename from source/Network/Xmpp/Concurrent/Channels/Presence.hs rename to source/Network/Xmpp/Concurrent/Presence.hs index 32ec83f..3cb0d6a 100644 --- a/source/Network/Xmpp/Concurrent/Channels/Presence.hs +++ b/source/Network/Xmpp/Concurrent/Presence.hs @@ -1,12 +1,11 @@ {-# OPTIONS_HADDOCK hide #-} -module Network.Xmpp.Concurrent.Channels.Presence where +module Network.Xmpp.Concurrent.Presence where -import Network.Xmpp.Concurrent.Channels.Types import Control.Concurrent.STM import Data.IORef import Network.Xmpp.Types import Network.Xmpp.Concurrent.Types -import Network.Xmpp.Concurrent.Channels.Basic +import Network.Xmpp.Concurrent.Basic -- | Read an element from the inbound stanza channel, acquiring a copy of the -- channel as necessary. diff --git a/source/Network/Xmpp/Concurrent/Types.hs b/source/Network/Xmpp/Concurrent/Types.hs index 0259c45..212ea1e 100644 --- a/source/Network/Xmpp/Concurrent/Types.hs +++ b/source/Network/Xmpp/Concurrent/Types.hs @@ -12,15 +12,34 @@ import Data.Typeable import Network.Xmpp.Types +import Data.IORef +import qualified Data.Map as Map +import Data.Text (Text) + +import Network.Xmpp.Types + -- | Handlers to be run when the Xmpp session ends and when the Xmpp connection is -- closed. data EventHandlers = EventHandlers { connectionClosedHandler :: StreamFailure -> IO () } --- | Xmpp Context object -data Context = Context - { writeRef :: TMVar (BS.ByteString -> IO Bool) +-- | Interrupt is used to signal to the reader thread that it should stop. Th contained semphore signals the reader to resume it's work. +data Interrupt = Interrupt (TMVar ()) deriving Typeable +instance Show Interrupt where show _ = "" + +instance Ex.Exception Interrupt + + +-- | A concurrent interface to Pontarius XMPP. +data Session = Session + { stanzaCh :: TChan Stanza -- All stanzas + , outCh :: TChan Stanza + , iqHandlers :: TVar IQHandlers + -- Writing lock, so that only one thread could write to the stream at any + -- given time. + -- Fields below are from Context. + , writeRef :: TMVar (BS.ByteString -> IO Bool) , readerThread :: ThreadId , idGenerator :: IO StanzaId -- | Lock (used by withConnection) to make sure that a maximum of one @@ -30,9 +49,15 @@ data Context = Context , stopThreads :: IO () } - --- | Interrupt is used to signal to the reader thread that it should stop. Th contained semphore signals the reader to resume it's work. -data Interrupt = Interrupt (TMVar ()) deriving Typeable -instance Show Interrupt where show _ = "" - -instance Ex.Exception Interrupt +-- | 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) + ) + +-- | Contains whether or not a reply has been sent, and the IQ request body to +-- reply to. +data IQRequestTicket = IQRequestTicket + { sentRef :: (TVar Bool) + , iqRequestBody :: IQRequest + } diff --git a/source/Network/Xmpp/Session.hs b/source/Network/Xmpp/Session.hs index 857778b..7318067 100644 --- a/source/Network/Xmpp/Session.hs +++ b/source/Network/Xmpp/Session.hs @@ -11,7 +11,7 @@ import Network import qualified Network.TLS as TLS import Network.Xmpp.Bind import Network.Xmpp.Concurrent.Types -import Network.Xmpp.Concurrent.Channels +import Network.Xmpp.Concurrent import Network.Xmpp.Connection_ import Network.Xmpp.Marshal import Network.Xmpp.Pickle @@ -109,4 +109,4 @@ simpleAuth username passwd resource = flip auth resource $ [ -- TODO: scramSha1Plus scramSha1 username Nothing passwd , digestMd5 username Nothing passwd - ] \ No newline at end of file + ] diff --git a/source/Network/Xmpp/Xep/ServiceDiscovery.hs b/source/Network/Xmpp/Xep/ServiceDiscovery.hs index 85a22c2..c025677 100644 --- a/source/Network/Xmpp/Xep/ServiceDiscovery.hs +++ b/source/Network/Xmpp/Xep/ServiceDiscovery.hs @@ -26,7 +26,6 @@ import Data.XML.Types import Network.Xmpp import Network.Xmpp.Concurrent -import Network.Xmpp.Concurrent.Channels import Network.Xmpp.Concurrent.Types import Network.Xmpp.Connection_ import Network.Xmpp.Pickle From bb311b6279ab0f0f8cf381ed6565bc338c63bcfe Mon Sep 17 00:00:00 2001 From: Jon Kristensen Date: Mon, 4 Feb 2013 23:53:19 +0100 Subject: [PATCH 14/15] Tweak failure approach I'm assuming and defining the following: 1. XMPP failures (which can occur at the TCP, TLS, and XML/XMPP layers (as a stream error or forbidden input)) are fatal; they will distrupt the XMPP session. 2. All fatal failures should be thrown (or similar) by `session', or any other function that might produce them. 3. Authentication failures that are not "XMPP failures" are not fatal. They do not necessarily terminate the stream. For example, the developer should be able to make another authentication attempt. The `Session' object returned by `session' might be useful even if the authentication fails. 4. We can (and should) use one single data type for fatal failures. (Previously, both StreamFailure and TlsFailure was used.) 5. We can catch and rethrow/wrap IO exceptions in the context of the Pontarius XMPP error system that we decide to use, making the error system more intuitive, Haskell-like, and more straight-forward to implement. Calling `error' may only be done in the case of a program error (a bug). 6. A logging system will remove the need for many of the error types. Only exceptions that seem likely to affect the flow of client applications should be defined. 7. The authentication functions are prone to fatal XMPP failures in addition to non-fatal authentication conditions. (Previously, `AuthStreamFailure' was used to wrap these errors.) I'm hereby suggesting (and implementing) the following: `StreamFailure' and `TlsFailure' should be joined into `XmppFailure'. `pullStanza' and the other Connection functions used to throw `IOException', `StreamFailure' and `TlsFailure' exceptions. With this patch, they have been converted to `StateT Connection IO (Either XmppFailure a)' computations. They also catch (some) IOException errors and wrap them in the new `XmppIOException' constructor. `newSession' is now `IO (Either XmppFailure Session)' as well (being capable of throwing IO exceptions). Whether or not to continue to a) wrap `XmppFailure' failures in an `AuthStreamFailure' equivalent, or, b) treat the authentication functions just like the other functions that may result in failure (Either XmppFailure a), depends on how Network.Xmpp.Connection.auth will be used. Since the latter will make `auth' more consistent, as well as remove the need for a wrapped (and special-case) "AuthFailure" type, I have decided to give the "b" approach a try. (The drawback being, of course, that authentication errors can not be accessed through the use of ErrorT. Whether or not this might be a problem, I don't really know at this point.) As the SASL code (and SaslM) depended on `AuthStreamFailure', it remains for internal use, at least for the time-being. `session' is now an ErrorT computation as well. Some functions have been updated as hacks, but this will be changed if we decide to move forward with this approach. --- source/Network/Xmpp.hs | 11 +- source/Network/Xmpp/Bind.hs | 28 +++-- source/Network/Xmpp/Concurrent.hs | 20 ++-- source/Network/Xmpp/Concurrent/Monad.hs | 2 +- source/Network/Xmpp/Concurrent/Threads.hs | 43 ++++--- source/Network/Xmpp/Concurrent/Types.hs | 2 +- source/Network/Xmpp/Connection_.hs | 113 ++++++++++-------- source/Network/Xmpp/Pickle.hs | 2 +- source/Network/Xmpp/Sasl.hs | 20 ++-- source/Network/Xmpp/Sasl/Common.hs | 24 ++-- .../Network/Xmpp/Sasl/Mechanisms/DigestMd5.hs | 5 +- source/Network/Xmpp/Sasl/Types.hs | 4 +- source/Network/Xmpp/Session.hs | 40 ++++--- source/Network/Xmpp/Stream.hs | 29 ++--- source/Network/Xmpp/Tls.hs | 13 +- source/Network/Xmpp/Types.hs | 53 ++++---- source/Network/Xmpp/Xep/ServiceDiscovery.hs | 20 ++-- 17 files changed, 240 insertions(+), 189 deletions(-) diff --git a/source/Network/Xmpp.hs b/source/Network/Xmpp.hs index 93c78bb..3744248 100644 --- a/source/Network/Xmpp.hs +++ b/source/Network/Xmpp.hs @@ -139,11 +139,16 @@ module Network.Xmpp , LangTag(..) , exampleParams , PortID(..) - , StreamFailure(..) + , XmppFailure(..) , StreamErrorInfo(..) , StreamErrorCondition(..) - , TlsFailure(..) - , AuthFailure(..) + , AuthFailure( AuthXmlFailure -- Does not export AuthStreamFailure + , AuthNoAcceptableMechanism + , AuthChallengeFailure + , AuthNoConnection + , AuthFailure + , AuthSaslFailure + , AuthStringPrepFailure ) ) where diff --git a/source/Network/Xmpp/Bind.hs b/source/Network/Xmpp/Bind.hs index 4d180ce..a3676e6 100644 --- a/source/Network/Xmpp/Bind.hs +++ b/source/Network/Xmpp/Bind.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE PatternGuards #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK hide #-} @@ -19,6 +18,8 @@ import Control.Monad.State(modify) import Control.Concurrent.STM.TMVar +import Control.Monad.Error + -- Produces a `bind' element, optionally wrapping a resource. bindBody :: Maybe Text -> Element bindBody = pickleElem $ @@ -30,16 +31,21 @@ bindBody = pickleElem $ -- Sends a (synchronous) IQ set request for a (`Just') given or server-generated -- resource and extract the JID from the non-error response. -xmppBind :: Maybe Text -> TMVar Connection -> IO Jid -xmppBind rsrc c = do - answer <- pushIQ' "bind" Nothing Set Nothing (bindBody rsrc) c - jid <- case () of () | Right IQResult{iqResultPayload = Just b} <- answer - , Right jid <- unpickleElem xpJid b - -> return jid - | otherwise -> throw StreamOtherFailure - -- TODO: Log: ("Bind couldn't unpickle JID from " ++ show answer) - withConnection (modify $ \s -> s{cJid = Just jid}) c - return jid +xmppBind :: Maybe Text -> TMVar Connection -> IO (Either XmppFailure Jid) +xmppBind rsrc c = runErrorT $ do + answer <- ErrorT $ pushIQ' "bind" Nothing Set Nothing (bindBody rsrc) c + case answer of + Right IQResult{iqResultPayload = Just b} -> do + let jid = unpickleElem xpJid b + case jid of + Right jid' -> do + ErrorT $ withConnection (do + modify $ \s -> s{cJid = Just jid'} + return $ Right jid') c -- not pretty + return jid' + otherwise -> throwError XmppOtherFailure + -- TODO: Log: ("Bind couldn't unpickle JID from " ++ show answer) + otherwise -> throwError XmppOtherFailure where -- Extracts the character data in the `jid' element. xpJid :: PU [Node] Jid diff --git a/source/Network/Xmpp/Concurrent.hs b/source/Network/Xmpp/Concurrent.hs index 9156b33..fa94910 100644 --- a/source/Network/Xmpp/Concurrent.hs +++ b/source/Network/Xmpp/Concurrent.hs @@ -35,6 +35,8 @@ import Network.Xmpp.Pickle import Network.Xmpp.Types import Text.Xml.Stream.Elements +import Control.Monad.Error + toChans :: TChan Stanza -> TVar IQHandlers -> Stanza @@ -72,16 +74,16 @@ toChans stanzaC iqHands sta = atomically $ do -- | Creates and initializes a new Xmpp context. -newSession :: TMVar Connection -> IO Session -newSession con = do - outC <- newTChanIO - stanzaChan <- newTChanIO - iqHandlers <- newTVarIO (Map.empty, Map.empty) - eh <- newTVarIO $ EventHandlers { connectionClosedHandler = \_ -> return () } +newSession :: TMVar Connection -> IO (Either XmppFailure Session) +newSession con = runErrorT $ do + outC <- lift newTChanIO + stanzaChan <- lift newTChanIO + iqHandlers <- lift $ newTVarIO (Map.empty, Map.empty) + eh <- lift $ newTVarIO $ EventHandlers { connectionClosedHandler = \_ -> return () } let stanzaHandler = toChans stanzaChan iqHandlers - (kill, wLock, conState, readerThread) <- startThreadsWith stanzaHandler eh con - writer <- forkIO $ writeWorker outC wLock - idRef <- newTVarIO 1 + (kill, wLock, conState, readerThread) <- ErrorT $ startThreadsWith stanzaHandler eh con + writer <- lift $ forkIO $ writeWorker outC wLock + idRef <- lift $ newTVarIO 1 let getId = atomically $ do curId <- readTVar idRef writeTVar idRef (curId + 1 :: Integer) diff --git a/source/Network/Xmpp/Concurrent/Monad.hs b/source/Network/Xmpp/Concurrent/Monad.hs index 863c985..ff0f07a 100644 --- a/source/Network/Xmpp/Concurrent/Monad.hs +++ b/source/Network/Xmpp/Concurrent/Monad.hs @@ -71,7 +71,7 @@ modifyHandlers f session = atomically $ modifyTVar (eventHandlers session) f writeTVar var (f x) -- | Sets the handler to be executed when the server connection is closed. -setConnectionClosedHandler_ :: (StreamFailure -> Session -> IO ()) -> Session -> IO () +setConnectionClosedHandler_ :: (XmppFailure -> Session -> IO ()) -> Session -> IO () setConnectionClosedHandler_ eh session = do modifyHandlers (\s -> s{connectionClosedHandler = \e -> eh e session}) session diff --git a/source/Network/Xmpp/Concurrent/Threads.hs b/source/Network/Xmpp/Concurrent/Threads.hs index 1ff2ff3..c55fc16 100644 --- a/source/Network/Xmpp/Concurrent/Threads.hs +++ b/source/Network/Xmpp/Concurrent/Threads.hs @@ -22,10 +22,12 @@ import Control.Concurrent.STM.TMVar import GHC.IO (unsafeUnmask) +import Control.Monad.Error + -- Worker to read stanzas from the stream and concurrently distribute them to -- all listener threads. readWorker :: (Stanza -> IO ()) - -> (StreamFailure -> IO ()) + -> (XmppFailure -> IO ()) -> TMVar (TMVar Connection) -> IO a readWorker onStanza onConnectionClosed stateRef = @@ -45,13 +47,14 @@ readWorker onStanza onConnectionClosed stateRef = [ Ex.Handler $ \(Interrupt t) -> do void $ handleInterrupts [t] return Nothing - , Ex.Handler $ \(e :: StreamFailure) -> do + , Ex.Handler $ \(e :: XmppFailure) -> do onConnectionClosed e return Nothing ] case res of - Nothing -> return () -- Caught an exception, nothing to do - Just sta -> onStanza sta + Nothing -> return () -- Caught an exception, nothing to do. TODO: Can this happen? + Just (Left e) -> return () + Just (Right sta) -> onStanza sta where -- Defining an Control.Exception.allowInterrupt equivalent for GHC 7 -- compatibility. @@ -75,30 +78,32 @@ readWorker onStanza onConnectionClosed stateRef = startThreadsWith :: (Stanza -> IO ()) -> TVar EventHandlers -> TMVar Connection - -> IO - (IO (), + -> IO (Either XmppFailure (IO (), TMVar (BS.ByteString -> IO Bool), TMVar (TMVar Connection), - ThreadId) + ThreadId)) startThreadsWith stanzaHandler eh con = do - read <- withConnection' (gets $ cSend. cHandle) con - writeLock <- newTMVarIO read - conS <- newTMVarIO con --- lw <- forkIO $ writeWorker outC writeLock - cp <- forkIO $ connPersist writeLock - rd <- forkIO $ readWorker stanzaHandler (noCon eh) conS - return ( killConnection writeLock [rd, cp] - , writeLock - , conS - , rd - ) + read <- withConnection' (gets $ cSend . cHandle >>= \d -> return $ Right d) con + case read of + Left e -> return $ Left e + Right read' -> do + writeLock <- newTMVarIO read' + conS <- newTMVarIO con + -- lw <- forkIO $ writeWorker outC writeLock + cp <- forkIO $ connPersist writeLock + rd <- forkIO $ readWorker stanzaHandler (noCon eh) conS + return $ Right ( killConnection writeLock [rd, cp] + , writeLock + , conS + , rd + ) where killConnection writeLock threads = liftIO $ do _ <- atomically $ takeTMVar writeLock -- Should we put it back? _ <- forM threads killThread return () -- Call the connection closed handlers. - noCon :: TVar EventHandlers -> StreamFailure -> IO () + noCon :: TVar EventHandlers -> XmppFailure -> IO () noCon h e = do hands <- atomically $ readTVar h _ <- forkIO $ connectionClosedHandler hands e diff --git a/source/Network/Xmpp/Concurrent/Types.hs b/source/Network/Xmpp/Concurrent/Types.hs index 212ea1e..decce8a 100644 --- a/source/Network/Xmpp/Concurrent/Types.hs +++ b/source/Network/Xmpp/Concurrent/Types.hs @@ -21,7 +21,7 @@ import Network.Xmpp.Types -- | Handlers to be run when the Xmpp session ends and when the Xmpp connection is -- closed. data EventHandlers = EventHandlers - { connectionClosedHandler :: StreamFailure -> IO () + { connectionClosedHandler :: XmppFailure -> IO () } -- | Interrupt is used to signal to the reader thread that it should stop. Th contained semphore signals the reader to resume it's work. diff --git a/source/Network/Xmpp/Connection_.hs b/source/Network/Xmpp/Connection_.hs index 8317ef1..38a7532 100644 --- a/source/Network/Xmpp/Connection_.hs +++ b/source/Network/Xmpp/Connection_.hs @@ -6,6 +6,7 @@ module Network.Xmpp.Connection_ where import Control.Applicative((<$>)) import Control.Concurrent (forkIO, threadDelay) +import System.IO.Error (tryIOError) import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Class @@ -41,7 +42,7 @@ import System.Log.Logger import Data.ByteString.Base64 import Control.Concurrent.STM.TMVar - +import Control.Monad.Error -- Enable/disable debug output -- This will dump all incoming and outgoing network taffic to the console, @@ -49,69 +50,83 @@ import Control.Concurrent.STM.TMVar debug :: Bool debug = False -pushElement :: Element -> StateT Connection IO Bool +-- TODO: Can the TLS send/recv functions throw something other than an IO error? + +wrapIOException :: IO a -> StateT Connection IO (Either XmppFailure a) +wrapIOException action = do + r <- liftIO $ tryIOError action + case r of + Right b -> return $ Right b + Left e -> return $ Left $ XmppIOException e + +pushElement :: Element -> StateT Connection IO (Either XmppFailure Bool) pushElement x = do send <- gets (cSend . cHandle) - liftIO . send $ renderElement x + wrapIOException $ send $ renderElement x -- | Encode and send stanza -pushStanza :: Stanza -> TMVar Connection -> IO Bool +pushStanza :: Stanza -> TMVar Connection -> IO (Either XmppFailure Bool) pushStanza s = withConnection' . pushElement $ pickleElem xpStanza s -- XML documents and XMPP streams SHOULD be preceeded by an XML declaration. -- UTF-8 is the only supported XMPP encoding. The standalone document -- declaration (matching "SDDecl" in the XML standard) MUST NOT be included in -- XMPP streams. RFC 6120 defines XMPP only in terms of XML 1.0. -pushXmlDecl :: StateT Connection IO Bool +pushXmlDecl :: StateT Connection IO (Either XmppFailure Bool) pushXmlDecl = do con <- gets cHandle - liftIO $ (cSend con) "" + wrapIOException $ (cSend con) "" -pushOpenElement :: Element -> StateT Connection IO Bool +pushOpenElement :: Element -> StateT Connection IO (Either XmppFailure Bool) pushOpenElement e = do sink <- gets (cSend . cHandle) - liftIO . sink $ renderOpenElement e + wrapIOException $ sink $ renderOpenElement e -- `Connect-and-resumes' the given sink to the connection source, and pulls a -- `b' value. -runEventsSink :: Sink Event IO b -> StateT Connection IO b -runEventsSink snk = do +runEventsSink :: Sink Event IO b -> StateT Connection IO (Either XmppFailure b) +runEventsSink snk = do -- TODO: Wrap exceptions? source <- gets cEventSource (src', r) <- lift $ source $$++ snk modify (\s -> s{cEventSource = src'}) - return r + return $ Right r -pullElement :: StateT Connection IO Element +pullElement :: StateT Connection IO (Either XmppFailure Element) pullElement = do Ex.catches (do e <- runEventsSink (elements =$ await) case e of - Nothing -> liftIO $ Ex.throwIO StreamOtherFailure - Just r -> return r + Left f -> return $ Left f + Right Nothing -> return $ Left XmppOtherFailure -- TODO + Right (Just r) -> return $ Right r ) - [ Ex.Handler (\StreamEnd -> Ex.throwIO StreamEndFailure) + [ Ex.Handler (\StreamEnd -> return $ Left StreamEndFailure) , Ex.Handler (\(InvalidXmppXml s) -- Invalid XML `Event' encountered, or missing element close tag - -> liftIO . Ex.throwIO $ StreamOtherFailure) -- TODO: Log: s + -> return $ Left XmppOtherFailure) -- TODO: Log: s , Ex.Handler $ \(e :: InvalidEventStream) -- xml-conduit exception - -> liftIO . Ex.throwIO $ StreamOtherFailure -- TODO: Log: (show e) + -> return $ Left XmppOtherFailure -- TODO: Log: (show e) ] -- Pulls an element and unpickles it. -pullUnpickle :: PU [Node] a -> StateT Connection IO a +pullUnpickle :: PU [Node] a -> StateT Connection IO (Either XmppFailure a) pullUnpickle p = do - res <- unpickleElem p <$> pullElement - case res of - Left e -> liftIO $ Ex.throwIO e - Right r -> return r + elem <- pullElement + case elem of + Left e -> return $ Left e + Right elem' -> do + let res = unpickleElem p elem' + case res of + Left e -> return $ Left XmppOtherFailure -- TODO: Log + Right r -> return $ Right r --- | Pulls a stanza (or stream error) from the stream. Throws an error on a stream --- error. -pullStanza :: TMVar Connection -> IO Stanza +-- | Pulls a stanza (or stream error) from the stream. +pullStanza :: TMVar Connection -> IO (Either XmppFailure Stanza) pullStanza = withConnection' $ do res <- pullUnpickle xpStreamStanza case res of - Left e -> liftIO . Ex.throwIO $ StreamErrorFailure e - Right r -> return r + Left e -> return $ Left e + Right (Left e) -> return $ Left $ StreamErrorFailure e + Right (Right r) -> return $ Right r -- Performs the given IO operation, catches any errors and re-throws everything -- except 'ResourceVanished' and IllegalOperation, in which case it will return False instead @@ -129,7 +144,7 @@ xmppNoConnection :: Connection xmppNoConnection = Connection { cHandle = ConnectionHandle { cSend = \_ -> return False , cRecv = \_ -> Ex.throwIO - StreamOtherFailure + XmppOtherFailure , cFlush = return () , cClose = return () } @@ -147,9 +162,9 @@ xmppNoConnection = Connection } where zeroSource :: Source IO output - zeroSource = liftIO . Ex.throwIO $ StreamOtherFailure + zeroSource = liftIO . Ex.throwIO $ XmppOtherFailure -connectTcp :: HostName -> PortID -> Text -> IO (TMVar Connection) +connectTcp :: HostName -> PortID -> Text -> IO (Either XmppFailure (TMVar Connection)) connectTcp host port hostname = do let PortNumber portNumber = port debugM "Pontarius.Xmpp" $ "Connecting to " ++ host ++ " on port " ++ @@ -190,7 +205,8 @@ connectTcp host port hostname = do , cJidWhenPlain = False -- TODO: Allow user to set , cFrom = Nothing } - mkConnection con + con' <- mkConnection con + return $ Right con' where logConduit :: Conduit ByteString IO ByteString logConduit = CL.mapM $ \d -> do @@ -201,10 +217,12 @@ connectTcp host port hostname = do -- Closes the connection and updates the XmppConMonad Connection state. -killConnection :: TMVar Connection -> IO (Either Ex.SomeException ()) +-- killConnection :: TMVar Connection -> IO (Either Ex.SomeException ()) +killConnection :: TMVar Connection -> IO (Either XmppFailure ()) killConnection = withConnection $ do cc <- gets (cClose . cHandle) - err <- liftIO $ (Ex.try cc :: IO (Either Ex.SomeException ())) + err <- wrapIOException cc + -- (Ex.try cc :: IO (Either Ex.SomeException ())) put xmppNoConnection return err @@ -216,44 +234,45 @@ pushIQ' :: StanzaId -> Maybe LangTag -> Element -> TMVar Connection - -> IO (Either IQError IQResult) + -> IO (Either XmppFailure (Either IQError IQResult)) pushIQ' iqID to tp lang body con = do pushStanza (IQRequestS $ IQRequest iqID Nothing to lang tp body) con res <- pullStanza con case res of - IQErrorS e -> return $ Left e - IQResultS r -> do + Left e -> return $ Left e + Right (IQErrorS e) -> return $ Right $ Left e + Right (IQResultS r) -> do unless (iqID == iqResultID r) . liftIO . Ex.throwIO $ - StreamOtherFailure + XmppOtherFailure -- TODO: Log: ("In sendIQ' IDs don't match: " ++ show iqID ++ -- " /= " ++ show (iqResultID r) ++ " .") - return $ Right r - _ -> liftIO $ Ex.throwIO StreamOtherFailure + return $ Right $ Right r + _ -> return $ Left XmppOtherFailure -- TODO: Log: "sendIQ': unexpected stanza type " -- | Send "" and wait for the server to finish processing and to --- close the connection. Any remaining elements from the server and whether or --- not we received a element from the server is returned. -closeStreams :: TMVar Connection -> IO ([Element], Bool) +-- close the connection. Any remaining elements from the server are returned. +-- Surpresses StreamEndFailure exceptions, but may throw a StreamCloseError. +closeStreams :: TMVar Connection -> IO (Either XmppFailure [Element]) closeStreams = withConnection $ do send <- gets (cSend . cHandle) cc <- gets (cClose . cHandle) liftIO $ send "" void $ liftIO $ forkIO $ do - threadDelay 3000000 + threadDelay 3000000 -- TODO: Configurable value (Ex.try cc) :: IO (Either Ex.SomeException ()) return () collectElems [] where -- Pulls elements from the stream until the stream ends, or an error is -- raised. - collectElems :: [Element] -> StateT Connection IO ([Element], Bool) + collectElems :: [Element] -> StateT Connection IO (Either XmppFailure [Element]) collectElems es = do - result <- Ex.try pullElement + result <- pullElement case result of - Left StreamEndFailure -> return (es, True) - Left _ -> return (es, False) + Left StreamEndFailure -> return $ Right es + Left e -> return $ Left $ StreamCloseError (es, e) Right e -> collectElems (e:es) debugConduit :: Pipe l ByteString ByteString u IO b diff --git a/source/Network/Xmpp/Pickle.hs b/source/Network/Xmpp/Pickle.hs index e16cb2e..10b72a9 100644 --- a/source/Network/Xmpp/Pickle.hs +++ b/source/Network/Xmpp/Pickle.hs @@ -75,4 +75,4 @@ 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 \ No newline at end of file +pickleElem p = pickle $ xpNodeElem p diff --git a/source/Network/Xmpp/Sasl.hs b/source/Network/Xmpp/Sasl.hs index cbcc825..2a61ae2 100644 --- a/source/Network/Xmpp/Sasl.hs +++ b/source/Network/Xmpp/Sasl.hs @@ -42,22 +42,26 @@ import Control.Concurrent.STM.TMVar -- | Uses the first supported mechanism to authenticate, if any. Updates the -- state with non-password credentials and restarts the stream upon --- success. +-- success. Returns `Nothing' on success, an `AuthFailure' if +-- authentication fails, or an `XmppFailure' if anything else fails. xmppSasl :: [SaslHandler] -- ^ Acceptable authentication mechanisms and their -- corresponding handlers -> TMVar Connection - -> IO (Either AuthFailure ()) + -> IO (Either XmppFailure (Maybe AuthFailure)) xmppSasl handlers = withConnection $ do -- Chooses the first mechanism that is acceptable by both the client and the -- server. mechanisms <- gets $ saslMechanisms . cFeatures case (filter (\(name, _) -> name `elem` mechanisms)) handlers of - [] -> return . Left $ AuthNoAcceptableMechanism mechanisms - (_name, handler):_ -> runErrorT $ do + [] -> return $ Right $ Just $ AuthNoAcceptableMechanism mechanisms + (_name, handler):_ -> do cs <- gets cState case cs of - ConnectionClosed -> throwError AuthConnectionFailure + ConnectionClosed -> return . Right $ Just AuthNoConnection _ -> do - r <- handler - _ <- ErrorT $ left AuthStreamFailure <$> restartStream - return r + r <- runErrorT handler + case r of + Left ae -> return $ Right $ Just ae + Right a -> do + _ <- runErrorT $ ErrorT restartStream + return $ Right $ Nothing diff --git a/source/Network/Xmpp/Sasl/Common.hs b/source/Network/Xmpp/Sasl/Common.hs index a83add5..e3dcc5c 100644 --- a/source/Network/Xmpp/Sasl/Common.hs +++ b/source/Network/Xmpp/Sasl/Common.hs @@ -107,16 +107,21 @@ quote :: BS.ByteString -> BS.ByteString quote x = BS.concat ["\"",x,"\""] saslInit :: Text.Text -> Maybe BS.ByteString -> SaslM Bool -saslInit mechanism payload = lift . pushElement . saslInitE mechanism $ - Text.decodeUtf8 . B64.encode <$> payload +saslInit mechanism payload = do + r <- lift . pushElement . saslInitE mechanism $ + Text.decodeUtf8 . B64.encode <$> payload + case r of + Left e -> throwError $ AuthStreamFailure e + Right b -> return b -- | Pull the next element. pullSaslElement :: SaslM SaslElement pullSaslElement = do - el <- lift $ pullUnpickle (xpEither xpFailure xpSaslElement) - case el of - Left e ->throwError $ AuthSaslFailure e - Right r -> return r + r <- lift $ pullUnpickle (xpEither xpFailure xpSaslElement) + case r of + Left e -> throwError $ AuthStreamFailure e + Right (Left e) -> throwError $ AuthSaslFailure e + Right (Right r) -> return r -- | Pull the next element, checking that it is a challenge. pullChallenge :: SaslM (Maybe BS.ByteString) @@ -167,8 +172,11 @@ toPairs ctext = case pairs ctext of -- | Send a SASL response element. The content will be base64-encoded. respond :: Maybe BS.ByteString -> SaslM Bool -respond = lift . pushElement . saslResponseE . - fmap (Text.decodeUtf8 . B64.encode) +respond m = do + r <- lift . pushElement . saslResponseE . fmap (Text.decodeUtf8 . B64.encode) $ m + case r of + Left e -> throwError $ AuthStreamFailure e + Right b -> return b -- | Run the appropriate stringprep profiles on the credentials. diff --git a/source/Network/Xmpp/Sasl/Mechanisms/DigestMd5.hs b/source/Network/Xmpp/Sasl/Mechanisms/DigestMd5.hs index 9048842..f8fc03c 100644 --- a/source/Network/Xmpp/Sasl/Mechanisms/DigestMd5.hs +++ b/source/Network/Xmpp/Sasl/Mechanisms/DigestMd5.hs @@ -48,10 +48,7 @@ xmppDigestMd5 :: Text -- ^ Authentication identity (authzid or username) xmppDigestMd5 authcid authzid password = do (ac, az, pw) <- prepCredentials authcid authzid password hn <- gets cHostName - case hn of - Just hn' -> do - xmppDigestMd5' hn' ac az pw - Nothing -> throwError AuthConnectionFailure + xmppDigestMd5' (fromJust hn) ac az pw where xmppDigestMd5' :: Text -> Text -> Maybe Text -> Text -> SaslM () xmppDigestMd5' hostname authcid authzid password = do diff --git a/source/Network/Xmpp/Sasl/Types.hs b/source/Network/Xmpp/Sasl/Types.hs index cd14c1d..90f20da 100644 --- a/source/Network/Xmpp/Sasl/Types.hs +++ b/source/Network/Xmpp/Sasl/Types.hs @@ -13,9 +13,9 @@ data AuthFailure = AuthXmlFailure | AuthChallengeFailure | AuthServerAuthFailure -- ^ The server failed to authenticate -- itself - | AuthStreamFailure StreamFailure -- ^ Stream error on stream restart + | AuthStreamFailure XmppFailure -- ^ Stream error on stream restart -- TODO: Rename AuthConnectionFailure? - | AuthConnectionFailure -- ^ Connection is closed + | AuthNoConnection | AuthFailure -- General instance used for the Error instance | AuthSaslFailure SaslFailure -- ^ Defined SASL error condition | AuthStringPrepFailure -- ^ StringPrep failed diff --git a/source/Network/Xmpp/Session.hs b/source/Network/Xmpp/Session.hs index 7318067..67cf882 100644 --- a/source/Network/Xmpp/Session.hs +++ b/source/Network/Xmpp/Session.hs @@ -40,25 +40,29 @@ session :: HostName -- ^ Host to connect to -> Maybe ([SaslHandler], Maybe Text) -- ^ SASL handlers and the desired -- JID resource (or Nothing to let -- the server decide) - -> IO Session -- TODO: ErrorT -session hostname realm port tls sasl = do - con' <- connect hostname port realm - con <- case con' of - Left e -> Ex.throwIO e - Right c -> return c - if isJust tls then startTls (fromJust tls) con >> return () else return () -- TODO: Eats TlsFailure - saslResponse <- if isJust sasl then auth (fst $ fromJust sasl) (snd $ fromJust sasl) con >> return () else return () -- TODO: Eats AuthFailure - newSession con - + -> IO (Either XmppFailure (Session, Maybe AuthFailure)) +session hostname realm port tls sasl = runErrorT $ do + con <- ErrorT $ connect hostname port realm + if isJust tls + then ErrorT $ startTls (fromJust tls) con + else return () + aut <- if isJust sasl + then ErrorT $ auth (fst $ fromJust sasl) (snd $ fromJust sasl) con + else return Nothing + ses <- ErrorT $ newSession con + return (ses, aut) + -- | Connects to the XMPP server and opens the XMPP stream against the given -- host name, port, and realm. -connect :: HostName -> PortID -> Text -> IO (Either StreamFailure (TMVar Connection)) +connect :: HostName -> PortID -> Text -> IO (Either XmppFailure (TMVar Connection)) connect address port hostname = do con <- connectTcp address port hostname - result <- withConnection startStream con - case result of - Left e -> return $ Left e -- TODO - Right () -> return $ Right con + case con of + Right con' -> do + result <- withConnection startStream con' + return $ Right con' + Left e -> do + return $ Left e sessionXml :: Element sessionXml = pickleElem @@ -88,12 +92,12 @@ startSession con = do auth :: [SaslHandler] -> Maybe Text -> TMVar Connection - -> IO (Either AuthFailure Jid) + -> IO (Either XmppFailure (Maybe AuthFailure)) auth mechanisms resource con = runErrorT $ do ErrorT $ xmppSasl mechanisms con jid <- lift $ xmppBind resource con lift $ startSession con - return jid + return Nothing -- | Authenticate to the server with the given username and password -- and bind a resource. @@ -104,7 +108,7 @@ simpleAuth :: Text.Text -- ^ The username -> Maybe Text -- ^ The desired resource or 'Nothing' to let the -- server assign one -> TMVar Connection - -> IO (Either AuthFailure Jid) + -> IO (Either XmppFailure (Maybe AuthFailure)) simpleAuth username passwd resource = flip auth resource $ [ -- TODO: scramSha1Plus scramSha1 username Nothing passwd diff --git a/source/Network/Xmpp/Stream.hs b/source/Network/Xmpp/Stream.hs index 972017a..a4ce39e 100644 --- a/source/Network/Xmpp/Stream.hs +++ b/source/Network/Xmpp/Stream.hs @@ -36,12 +36,12 @@ streamUnpickleElem :: PU [Node] a -> StreamSink a streamUnpickleElem p x = do case unpickleElem p x of - Left l -> throwError $ StreamOtherFailure -- TODO: Log: StreamXmlError (show l) + Left l -> throwError $ XmppOtherFailure -- TODO: Log: StreamXmlError (show l) Right r -> return r -- This is the conduit sink that handles the stream XML events. We extend it -- with ErrorT capabilities. -type StreamSink a = ErrorT StreamFailure (Pipe Event Event Void () IO) a +type StreamSink a = ErrorT XmppFailure (Pipe Event Event Void () IO) a -- Discards all events before the first EventBeginElement. throwOutJunk :: Monad m => Sink Event m () @@ -59,13 +59,13 @@ openElementFromEvents = do hd <- lift CL.head case hd of Just (EventBeginElement name attrs) -> return $ Element name attrs [] - _ -> throwError $ StreamOtherFailure + _ -> throwError $ XmppOtherFailure -- Sends the initial stream:stream element and pulls the server features. If the -- server responds in a way that is invalid, an appropriate stream error will be --- generated, the connection to the server will be closed, and a StreamFilure +-- generated, the connection to the server will be closed, and a XmppFailure -- will be produced. -startStream :: StateT Connection IO (Either StreamFailure ()) +startStream :: StateT Connection IO (Either XmppFailure ()) startStream = runErrorT $ do state <- lift $ get con <- liftIO $ mkConnection state @@ -76,7 +76,7 @@ startStream = runErrorT $ do then cJid state else Nothing ConnectionSecured -> cJid state case cHostName state of - Nothing -> throwError StreamOtherFailure -- TODO: When does this happen? + Nothing -> throwError XmppOtherFailure -- TODO: When does this happen? Just hostname -> lift $ do pushXmlDecl pushOpenElement $ @@ -88,8 +88,9 @@ startStream = runErrorT $ do ) response <- ErrorT $ runEventsSink $ runErrorT $ streamS expectedTo case response of + Left e -> throwError e -- Successful unpickling of stream element. - Right (ver, from, to, id, lt, features) + Right (Right (ver, from, to, id, lt, features)) | (unpack ver) /= "1.0" -> closeStreamWithError con StreamUnsupportedVersion Nothing | lt == Nothing -> @@ -107,7 +108,7 @@ startStream = runErrorT $ do } ) return () -- Unpickling failed - we investigate the element. - Left (Element name attrs children) + Right (Left (Element name attrs children)) | (nameLocalName name /= "stream") -> closeStreamWithError con StreamInvalidXml Nothing | (nameNamespace name /= Just "http://etherx.jabber.org/streams") -> @@ -117,13 +118,13 @@ startStream = runErrorT $ do | otherwise -> ErrorT $ checkchildren con (flattenAttrs attrs) where -- closeStreamWithError :: MonadIO m => TMVar Connection -> StreamErrorCondition -> - -- Maybe Element -> ErrorT StreamFailure m () + -- Maybe Element -> ErrorT XmppFailure m () closeStreamWithError con sec el = do liftIO $ do withConnection (pushElement . pickleElem xpStreamError $ StreamErrorInfo sec Nothing el) con closeStreams con - throwError StreamOtherFailure + throwError XmppOtherFailure checkchildren con children = let to' = lookup "to" children ver' = lookup "version" children @@ -156,7 +157,7 @@ flattenAttrs attrs = Prelude.map (\(name, content) -> -- Sets a new Event source using the raw source (of bytes) -- and calls xmppStartStream. -restartStream :: StateT Connection IO (Either StreamFailure ()) +restartStream :: StateT Connection IO (Either XmppFailure ()) restartStream = do raw <- gets (cRecv . cHandle) let newSource = DCI.ResumableSource (loopRead raw $= XP.parseBytes def) @@ -172,7 +173,7 @@ restartStream = do -- Reads the (partial) stream:stream and the server features from the stream. -- Returns the (unvalidated) stream attributes, the unparsed element, or --- throwError throws a `StreamOtherFailure' (if something other than an element +-- throwError throws a `XmppOtherFailure' (if something other than an element -- was encountered at first, or if something other than stream features was -- encountered second). -- TODO: from. @@ -195,7 +196,7 @@ streamS expectedTo = do lift throwOutJunk -- Get the stream:stream element (or whatever it is) from the server, -- and validate what we get. - el <- openElementFromEvents -- May throw `StreamOtherFailure' if an + el <- openElementFromEvents -- May throw `XmppOtherFailure' if an -- element is not received case unpickleElem xpStream el of Left _ -> return $ Left el @@ -204,7 +205,7 @@ streamS expectedTo = do xmppStreamFeatures = do e <- lift $ elements =$ CL.head case e of - Nothing -> throwError StreamOtherFailure + Nothing -> throwError XmppOtherFailure Just r -> streamUnpickleElem xpStreamFeatures r diff --git a/source/Network/Xmpp/Tls.hs b/source/Network/Xmpp/Tls.hs index 75c73bf..957cdc4 100644 --- a/source/Network/Xmpp/Tls.hs +++ b/source/Network/Xmpp/Tls.hs @@ -76,7 +76,7 @@ exampleParams = TLS.defaultParamsClient -- Pushes ", waits for "", performs the TLS handshake, and -- restarts the stream. -startTls :: TLS.TLSParams -> TMVar Connection -> IO (Either TlsFailure ()) +startTls :: TLS.TLSParams -> TMVar Connection -> IO (Either XmppFailure ()) startTls params con = Ex.handle (return . Left . TlsError) . flip withConnection con . runErrorT $ do @@ -84,19 +84,16 @@ startTls params con = Ex.handle (return . Left . TlsError) state <- gets cState case state of ConnectionPlain -> return () - ConnectionClosed -> throwError TlsNoConnection + ConnectionClosed -> throwError XmppNoConnection ConnectionSecured -> throwError TlsConnectionSecured con <- lift $ gets cHandle when (stls features == Nothing) $ throwError TlsNoServerSupport lift $ pushElement starttlsE answer <- lift $ pullElement case answer of - Element "{urn:ietf:params:xml:ns:xmpp-tls}proceed" [] [] -> return () - Element "{urn:ietf:params:xml:ns:xmpp-tls}failure" _ _ -> - lift $ Ex.throwIO StreamOtherFailure - -- TODO: find something more suitable - e -> lift $ Ex.throwIO StreamOtherFailure - -- TODO: Log: "Unexpected element: " ++ ppElement e + Left e -> return $ Left e + Right (Element "{urn:ietf:params:xml:ns:xmpp-tls}proceed" [] []) -> return $ Right () + Right (Element "{urn:ietf:params:xml:ns:xmpp-tls}failure" _ _) -> return $ Left XmppOtherFailure (raw, _snk, psh, read, ctx) <- lift $ TLS.tlsinit debug params (mkBackend con) let newHand = ConnectionHandle { cSend = catchPush . psh , cRecv = read diff --git a/source/Network/Xmpp/Types.hs b/source/Network/Xmpp/Types.hs index 1a71d94..86dd602 100644 --- a/source/Network/Xmpp/Types.hs +++ b/source/Network/Xmpp/Types.hs @@ -28,7 +28,7 @@ module Network.Xmpp.Types , StanzaErrorCondition(..) , StanzaErrorType(..) , StanzaId(..) - , StreamFailure(..) + , XmppFailure(..) , StreamErrorCondition(..) , Version(..) , ConnectionHandle(..) @@ -39,7 +39,6 @@ module Network.Xmpp.Types , ConnectionState(..) , StreamErrorInfo(..) , langTag - , TlsFailure(..) , module Network.Xmpp.Jid ) where @@ -629,17 +628,32 @@ data StreamErrorInfo = StreamErrorInfo -- | Signals an XMPP stream error or another unpredicted stream-related -- situation. -data StreamFailure = StreamErrorFailure StreamErrorInfo -- ^ An error XML stream +data XmppFailure = StreamErrorFailure StreamErrorInfo -- ^ An error XML stream -- element has been -- encountered. - | StreamEndFailure -- ^ The server has closed the stream. - | StreamOtherFailure -- ^ Undefined condition. More - -- information should be available in - -- the log. - deriving (Show, Eq, Typeable) - -instance Exception StreamFailure -instance Error StreamFailure where noMsg = StreamOtherFailure + | StreamEndFailure -- ^ The stream has been closed. + -- This exception is caught by the + -- concurrent implementation, and + -- will thus not be visible + -- through use of 'Session'. + | StreamCloseError ([Element], XmppFailure) -- ^ When an XmppFailure + -- is encountered in + -- closeStreams, this + -- constructor wraps the + -- elements collected so + -- far. + | TlsError TLS.TLSError + | TlsNoServerSupport + | XmppNoConnection + | TlsConnectionSecured -- ^ Connection already secured + | XmppOtherFailure -- ^ Undefined condition. More + -- information should be available + -- in the log. + | XmppIOException IOException + deriving (Show, Eq, Typeable) + +instance Exception XmppFailure +instance Error XmppFailure where noMsg = XmppOtherFailure -- ============================================================================= -- XML TYPES @@ -781,7 +795,7 @@ data Connection = Connection -- element's `from' attribute. } -withConnection :: StateT Connection IO c -> TMVar Connection -> IO c +withConnection :: StateT Connection IO (Either XmppFailure c) -> TMVar Connection -> IO (Either XmppFailure c) withConnection action con = bracketOnError (atomically $ takeTMVar con) (atomically . putTMVar con ) @@ -792,7 +806,7 @@ withConnection action con = bracketOnError ) -- nonblocking version. Changes to the connection are ignored! -withConnection' :: StateT Connection IO b -> TMVar Connection -> IO b +withConnection' :: StateT Connection IO (Either XmppFailure b) -> TMVar Connection -> IO (Either XmppFailure b) withConnection' action con = do con_ <- atomically $ readTMVar con (r, _) <- runStateT action con_ @@ -801,16 +815,3 @@ withConnection' action con = do mkConnection :: Connection -> IO (TMVar Connection) mkConnection con = {- Connection `fmap` -} (atomically $ newTMVar con) - - --- | Failure conditions that may arise during TLS negotiation. -data TlsFailure = TlsError TLS.TLSError - | TlsNoServerSupport - | TlsNoConnection - | TlsConnectionSecured -- ^ Connection already secured - | TlsStreamError StreamFailure - | TlsFailureError -- General instance used for the Error instance (TODO) - deriving (Show, Eq, Typeable) - -instance Error TlsFailure where - noMsg = TlsFailureError diff --git a/source/Network/Xmpp/Xep/ServiceDiscovery.hs b/source/Network/Xmpp/Xep/ServiceDiscovery.hs index c025677..d5325e0 100644 --- a/source/Network/Xmpp/Xep/ServiceDiscovery.hs +++ b/source/Network/Xmpp/Xep/ServiceDiscovery.hs @@ -33,7 +33,7 @@ import Network.Xmpp.Types import Control.Concurrent.STM.TMVar data DiscoError = DiscoNoQueryElement - | DiscoIQError IQError + | DiscoIQError (Maybe IQError) | DiscoTimeout | DiscoXmlError Element UnpickleError @@ -92,7 +92,7 @@ queryInfo :: Jid -- ^ Entity to query queryInfo to node context = do res <- sendIQ' (Just to) Get Nothing queryBody context return $ case res of - IQResponseError e -> Left $ DiscoIQError e + IQResponseError e -> Left $ DiscoIQError (Just e) IQResponseTimeout -> Left $ DiscoTimeout IQResponseResult r -> case iqResultPayload r of Nothing -> Left DiscoNoQueryElement @@ -110,12 +110,14 @@ xmppQueryInfo :: Maybe Jid xmppQueryInfo to node con = do res <- pushIQ' "info" to Get Nothing queryBody con return $ case res of - Left e -> Left $ DiscoIQError e - Right r -> case iqResultPayload r of - Nothing -> Left DiscoNoQueryElement - Just p -> case unpickleElem xpQueryInfo p of - Left e -> Left $ DiscoXmlError p e - Right r -> Right r + Left e -> Left $ DiscoIQError Nothing + Right res' -> case res' of + Left e -> Left $ DiscoIQError (Just e) + Right r -> case iqResultPayload r of + Nothing -> Left DiscoNoQueryElement + Just p -> case unpickleElem xpQueryInfo p of + Left e -> Left $ DiscoXmlError p e + Right r -> Right r where queryBody = pickleElem xpQueryInfo (QIR node [] []) @@ -156,7 +158,7 @@ queryItems :: Jid -- ^ Entity to query queryItems to node session = do res <- sendIQ' (Just to) Get Nothing queryBody session return $ case res of - IQResponseError e -> Left $ DiscoIQError e + IQResponseError e -> Left $ DiscoIQError (Just e) IQResponseTimeout -> Left $ DiscoTimeout IQResponseResult r -> case iqResultPayload r of Nothing -> Left DiscoNoQueryElement From efe98753995bda00c9388596f26cfb49ebba6ae0 Mon Sep 17 00:00:00 2001 From: Jon Kristensen Date: Sat, 9 Feb 2013 03:13:26 +0100 Subject: [PATCH 15/15] Add limited SourceGraph module imports diagram, remove some imports In my ongoing "high-level analysis" of Pontarius XMPP, I've proceeded to take a quick look at the module imports. The diagram provided is limited in that it does not include the concurrent implementation, the Sasl modules, the IM modules, the XEP modules, the example modules, nor the test modules. Also, Network.Xmpp really does not need Network.Xmpp.Marshal, Network.Xmpp.Stream, Network.Xmpp.Bind, or Network.Xmpp.Connection_. Network.Xmpp.Connection does not need Network.Xmpp.Stream either. These imports, and some others, have been removed with this patch. Note also that Network.Xmpp.Tls does not need Network.Xmpp.Pickle. Some observations: 1. There are three simple "utility" modules that depends only on Network.Xmpp.Types: Utilities, Presence, and Message. Utilities is inaccessible (indicated by the red colour). 2. There are two exposed "base" modules, Network.Xmpp and Network.Xmpp.Connection. The former does not need to access Network.Xmpp.Connection_, while the latter does. Otherwise, they both import the three modules: Session, Tls, and Types. Network.Xmpp also import the "utility" modules Network.Xmpp.Message, Network.Xmpp.Presence, and Network.Xmpp.Jid. 3. In Network.Xmpp.Session, if the `session' function is moved to the concurrent implementation, we can get rid of a dependency towards the concurrent implementation in the internal Network.Xmpp modules. If we take it one step further and also remove the Sasl functions, we can remove the need for Network.Xmpp to import this module (and probably get rid of the module completely). 4. Data.Conduit.Tls is only accessed by Network.Xmpp.Tls. 5. Text.Xml.Stream.Elements is only accessed by Network.Xmpp.Stream, Network.Xmpp.Connection_, and Network.Xmpp.Pickle. 6. Network.Xmpp.Types depends on Network.Xmpp.Jid (and re-exports it). --- import_visualisation.png | Bin 0 -> 201722 bytes source/Network/Xmpp.hs | 7 ------- source/Network/Xmpp/Connection.hs | 4 +--- source/Network/Xmpp/Tls.hs | 1 - 4 files changed, 1 insertion(+), 11 deletions(-) create mode 100644 import_visualisation.png diff --git a/import_visualisation.png b/import_visualisation.png new file mode 100644 index 0000000000000000000000000000000000000000..001b160938aa4d2ad3ba8afe3193ce991fc40910 GIT binary patch literal 201722 zcmcG$byS?o_AN>b5<(!51ecKD5IndfxNC6t;I54XcMopCAvgrL0Kwhe-CY_Qc-7hG z{LcB~y>Z8Q_ug-eJvuba*Y#Dcnrp7PX6-;3Dd88$xX1_y2rooM1mqA99tR>IJi2*` z2;Nz|U%&@1k8SxxzdQw(>r?#z@bfb(5fxkT`APVH5BMmOoWPqnc7n=w@|K2njyg65 z2#$`9w8j>uwt6~N2DFwoMo9-;xCjVu5kv((e{o9Qn|E}Tyd>&8p6n+S(2sb@bWto@ zr1FQXYAQ1*W9B+Rkn*E=Wi|)1LcyCdvEiSMs^f}9GY}+ElE_AP5Bz8OIE)dOr^hwn zkVE!G+kwpmm$TG{!OI)&oIij52>kmZ5ohY%d-y*;ol=rup#SUg6?pfrDa6#x0?YmC5vf3ByBG?e7(17M27FV+H?z z-JDvfILn|nHbKKrB=+nJG5YTs>rqOLI#<=Pe+^1Sx!MBRUx0B`-d`YFJT6zYa>iIT z_@BSl*TKY;z9s(|!1bhG^nae>KjRhn{~p;1UyVEW+Y0fQ;3*&(Y&LUpJvsRN ztg+|9AHEz#X>u-vkUJ2ARII||e(~&J-g9bdYVBM~iWY^4C(Os^G1ZqmzQNR6Ldc@0 z=j3SSny|@4;YaXjaGT#K-E(tKq!*)8&FR8g&6;F~}9> zvxo=-$?SpI*>B=#HJ0ME6s?zA*(&TYO*1uZw^!sz;}5xms$4};exSUVs$)qDcd-e>hT7}Wzv!?qyatSi|Ak}*i6<|T9e{Eahemv=DAr|Iv z_l6JuBM{8e)^lKm;L&0@sQE2AS{&Dv6F#=6 z7&yp8(v%nt-d$bU>0KTWgy6B#wAW<{qv=>!48$|Y z@yu54dezoG5s#yNxO8*aoUPNgadkt7pbdiZm+|PcZ}IV82U0lQ28YU&H1nU$CHO!6 zt z-mzP+baBsuz~Zv<0Q-j7d4ETsrH)Sb-t_aU^U05{$L*crH)VqGO%Vl$AB+j@yw@21rNTqUh za2}qmgt9JVe95=@POTKV+=e7mX%f2T02bht+YV+{QP&k5$VEh9!_&lx=ZT@Hr6?604bhaBb9U~)*&MLzhq(>(v ztuUw-la)4_Vxe;1pTNwi3L~r-s>X+(^5xdqthDJi2h#w2pLfqTorpTo4H3*BYyHsZtVXE$2smcr*qh31)?*9;aiuGrBIIz-GsoZFg z7M~ym%=Yim3T$-r<;O@!$D3)*dKMO+k5{rs_Br36ql=2CdGLfP7OBc*2n6=g3X+I3 zlHNJS_KlgDF_xK4BmPtiA-ZRr_}4Bm52crH>(uHQ7h|S%A=c<3F6{KkVhd zrs@Bk{@6J(0b)=q{`D&bc%_U5`D*=RYpAZ5A1G{(C)zwQ&hqisdcXb7S;)XLM zlIh4yVH{@trw7o})l^>IlsfxWnD6uMUB|;|eqSnuJjDXcyWZIOR}}Dd>^c>XyMzCg z%6OcX;c;8Qb_=mO_uUEEFa zAA_l4s4Mg~r4)-*pL`M!c>HL=JxPIDk>V{J;+!A+rG1eQWi_>mHGiV6*bjL8{%D&M zMQUd|qyFjlH$;M5-15I9MMSh`FZN;O?%dYa*080`&N1UrHpe?Igj}h#jnM=qmCMsX z%Btt6sD@!BbY*2_W>Ynh)CygCm(?#`92-JRg1 zibm`&`=px^g7mU6ir zWoROc!GhP5KCPOFfPklU7kk}XWqJ>;^acrkj{g)~yt~C=vcPx0yQ5M56`*K7%jh&k zkAO*|`bS*h=h52kRvm@=uk`lmbk zHKp8IlR0AJDJt}Iy{%^?>dB&8=TSO8^vD~H&1DZeGBPrRh%+|wz0lCeY*N2k6+*|H zaHGq`;~(a`6Rw;_sQzg9KeDS?n`}2R@bJW|X*KdxG7;0$(_LBg5N(@aQLFcN;yh?* z8&}tcQ;u&ze25=m%nS-+WyxCIH`HHrq6>Y-r%??~gQHVTAO%zd!U^Q`2mr z-1q3{h#8jkA0#-SCL!@D=5{HyTHxZjz0&jY_TGke;E|A#@z|(EciRmzGBGh_WMmN5 zY4qcMM0lUe1|DL_}Q+i!h_*)@?;N#}`q|`dbqmFo1Nd+-*xUkBFIur(zz`7;>}GCHsP`E|PlpF}S> zK!Ml6uy*m-h=};En@pjyEq|h|k^EN{78VFJDs|s+#|z{$UF;Dy`qQLy!w9BJt>1ei zy=d*z*S#%ima8&Txtp#IFFS0OHZ!B~IGh&;FSG*#A#V3>VCM?vq7p=fPgmKS=13$7 zfnT{VdPwI-k;;#KNq2QlPD#e*(0zPhVPQ61O59E|4Ifh!%U=i^Z^f~NMj z)G!wQyG`|Ll2|Rv&2JojV|O_0P830AlDQqj+-@#U50~3u=a-8hKO5R5zz3ibE?kpN&D4kQnznh+6ioc(Sm zRl-&HTPsF6&}!ATdig$2Ga=$fLhG2D;|iq$lO@`S@+=V0zyxMvW`iIVJtI@G@v7tF zqsw%PoiXFQe@fg`QNVmQ8;3KUYa3qVbI$szp+AE`-uXE$x~st_RR1TqNfb>ouB0zU z{_KV!_L?iZ+YTIyK(e3R5Z2L4sWW#t^jG4{lI8}}lb_BGPa^+Z|0!GbkE|*V6~EP+ z?o3rrT_GQpfjI!7ywBUT&a|!n_hxcgQbI7wT=5BILcWLdfga3 zv6TFyWRi^aDCpe}8PAly_7Z6uMc0|Hy!!EpkO}o}y|?9zQe1Akr;<&5UX1#0ri6x% ztNo^lVNwzn;xF^sC{$r5bqk8xoXI~eV>X`<1w+#hKzR{}DM32^N(m3+TOM<c;{4Q_nU@|n#8GnLmyGof(YwW%$^SpuOl_7TS;V7j6;0h2?t#f*VN{D16Ori05 z&ph<9{kdn1fuYi+UDdroazPw*>U2y%0M}xQg&()z21GUb$ZIEWC`*0ARE(U%kxPc<#jJXx9QTXQFkP*9Rm zrxn0G@4-Faso`PYAu<;~D{=T1KtUnfrHm@`3t{f5pY)=)W1WG;-#ztCdS&%cdyDxB z=C-wXJaE#&y_}RSRD*$@;C#*<_($OCMk`N!W1xIo>k~_TUxBE=nqZ^>1cQ`P3E!0* zy9CKYAGU?ir-Az9l0${=VSzQ@C~%+oB0c%320YiemWCLakyo+B{vWj#W-of|mG7v}&OKL+bjHaj6dtQi zcu%qEbVWs1&Z5uvmjm9K zgXchh2sGmFhLF?SqgjR7S`8vqL)RL=b6Y*M#NDhgqU8&0UDCkXv$*^vE#WhNv+VMc zIS(~>lF#*_-8rHub*7{p3atFmNv(H%!EnxZa^|1Thh_I{2+apxJ=y8jMK>jj4R|Js zjIA`bw($&uTLkMGlWdlkE^oNzmi9>ZX%zRbL*-EjW^bR>a8R%c0 z!pV$P)a=;AMDPAt?kb%@!X$*v?Z1%v^iay{iF^oAMm+%+s`-MS=PT{jxFhK0OAJGr z8#_x~Jhjd0(+l(8spSe&H}bakw*Ae~>?gNUQE^8<)PW*5RJxfh6DL zndbN#FEf3C-+kiJ>We!=>t0U99e6lC7NS1!YT&N>~7CDPU_5HEG8GR>FPbGb8Cdu*f(kbti z^{a+qOikM7FI-yutLYx5aiQ%m__FfS^R(qYU;52JG2VAY2m~N1Ux8|aYJc|CP))8f z>!mF#%cS!5A4aCD_BS0z>&o#Qf3B8OZn-6#kPsa_r}f^_;NNlRt5?SJ^wsG3WIv%v zc;L>Yz5B2R^Xr)yRRogI`Ns>jx~DXE*bX#a){jD|-`#{6&RxQj^t-|42>MmsEPj?% zu1nc>nIVBiNfUmCB{;Kv*bihGhHkktB}-Uj%ISUPyohqzvOd%ANUpkmr1(>#Hd9j_ zQpGY+dO^L)RU^oKW!#&hcaCRtc9pO3Byo~qprBd9BH3S9=(B%|&|&JtIkB)qX7y-o zZ%0*j@VA8SEo-fGpJV9tFV+kD>Osub>y(aT4I947xTQuOA>~SE*4N!=mJakYiX~5< z=i;VyQ~D2QY6*}O$cfm+5lwuGDKEXG4@q*nXA#vfPO+I&*+@W3#y>1P?K9%Kx4qd3 z?bd%RK+1h+CSOpFj!Jr~O=hmPQ_P~#7`j>S@#UY$XrDl&=_5Xi9d6r{bzd|>nf|Hv zas4DQCWKH>lsGiBk|Bh~I6!syVMK(sL>q$RfN}5|h>_?Sd~UslumHx^B!#4<`R&=FRQIcYRcDxHB%dy~r zJ!kYh^$r^$mkztLR&82$DV|_J%l*iK>|m}-2n<3_`d!Em!*Rn*@uJ2LeM$N-Hamhl zCne3)FH4dXvRf^?t1F?!t?kcqv|hji=0w+I-GHmaJw$U`^uf^KjT~)tjhiTYelBcO zY{&C#G95CR(x{I@6dc01an+#a>bi5#s`xgXp>t?{HeRA5Ia3fhtH}az)OWr90>V-) zyP4W|Yn=14re7F4MAJCXyvcYM+~pwc#Iy_Xzw3kx0DRqOt%kk6Zxr{2rzJ&MWO!YS=!v}V;7Y@wjBS03;C``>M0?KUVH~MTD8M9 zv&x}jLJ_C!x~o#gqO%@n`zcjbEFHdM^`s zHwFlh1ow^*4+q)~Expi7uJBjuv7cAP9$cjHmEKr{qO-fTI5iR4o@K@^>l0jy{>+2dq%2l;MxrpH6zHhYVY2@!a2(IT1Ne=&ptm zBgTI&)j`l1mgZZ)y0p1}G(e)KnHrTUghsUZ%xaC920A_EKJTDMn{L^Gclhd6=mO8= z0Y|4~V)N#T!YUMCFLXv@vqyLk+jH>ztzPPYX!T);;>2u?vRbvjHP$kfK`7MIulYgq z-nS^p(E4NrlSk(Tp7Z<8{+g7QWB2}7w$b&*KTpyv({bqFwj*4= z8uN0%XsnEqM*Rg=@$W5nO7i_zf7xGXD^&Z2Z&mTggTO0&G$dWQaMv&E83Yw_z=LLoXbf3qVCRthDU6v3;-j{`B27EBv**E`;vAHP{wR}5le^A9CX zu+Z*Qh8cuIAZ;KH0#z)H$$B_#0 zy{m~PdCFZT;3sY6W+GqcOOEyIc~haGYWfS(?Q)ch)yCRf2NzP+H zPxo=Tof`kfhDm$^PFsoUq=(&X#*-!Q>Vsxl23#USaw6XcFkb1jS$1gPRvj?-mES4>CeYC4)aYW{W4!?1`tS>fxEGbRmqKUx zCE+t_Ue*O7E*%tmCf4TB4Y_X&3mp0Vk)sj4?5n0gpo3qLh2q4r9JXDCbKLtn$eW`C zegCj^0TNr|nuLG8J0Rfy8n<10*8ZmhuHjD`{Oh|!aDmP*y*8Boer?cF*z@6q-R^`J zkfr))MgKLjR4+jx!oB)8O9zRO!r#f!@sMKCpmAmU(xsJ^q#PWHK<{R;fF-Q7YtSc1 zuyNK8<&W;75W;w3V-<0feu1y)V$!}=FYOv)G7AWN61}~=X?X(UaKi6V?AfCN39Kt3 z4a3&_=L+^l)5Rx?E1>vd}XyI>(i9PqGD-1pvgp-qyd_TpaT{(!w zGcp1Vj8V7QN)sr?DDRyg7)3`YUe8MVDfru^j?mq{WcHW@rd(adgwpczmiFnuTO?GO z96RH_{(h#bS8(|(s~Ox@zOqNW5X#Nd7KTGaB>lVcQ?YvEXF^A%x%t%4g0f9I^_GDF zOe~{L|El1?K+-EiidtLt#R}Rz#m8VVFE!$DJwLOSm6pEsZ>z9vN>PoySW>C6GK?dB zr{Y5idU3~rtSkx2Rc4QXSS;0>m}*Mo0VA$=FgIuqk_dnQKHp9QFKFu-J$<$ zYm36w&4|Htf>~X|mceFC0JPwam1jFTI!X=6v_Eo%-0>8 zjQ@Q7L2fMpx(5%(LGRzcKk=k|3|6Tyitb-XP4`9`-3(;~OVz(O@)Q-7Oxp9|mD@e{ zheTG7ue0W})u)MZSkH!sFO$(|VRw)PLgoO|I9eTJW9Xmr5bTdZ(nbUN328+Ai7aj_ zw_T&QcGm0B(#_ej?+^W}sAXGYpr@O|k5@S!dcvi2 zEq9fa0R?UzQ&T)d6zraZdEw&|6TW75jjsz0n2?J-m$fPoD9m4nLiT6TtarvFo33|| zkY7`TbnA=VEu*2K8J$iPojKjw2gT8bW*2>E7mLvyiXa9FEDA(I)}`=ku&bPDH5y%F zh}-<-e~6&FD>uZ4lSyx!9j`VpSuHW4zkC36zNfj#?8XyW-S20~#_@4*oCi4$4f{b5 zXt#BQN-GS04}68gV@FXmTWvHQ^hUap4(!xV#Im>*<>h1?*T;PCKu6YYZ^~PxA}7aI zA%Amg>(5jfQJL*#^J}U#(cOvjt?7yv(XxM`N_{L4n$BQ(e^>Jt zc*dg%&O@0zWrm4jwaz#Lk)qmvdjZls2Fg6{vj_1kNz&xGsewi~vU@&BWE%8vO!m zbpD&Even_XQATfnVRyp;SeTZ_JinbCv;A(rl%A5o;=T~xqgF#(;Zu+hI6^>?^JCOs@CMnR#&$&|MN|Bu9N|o zanQfW?d*hOqO)N#mwk|?+qF!Vz%z&23%ut|H(?%^hq2X^&Lw-pT6jXP3?O;B0w7N466eS*e^EQ7}gN|RuXItaX7i(?PTs%Pc8`KQOG#}gg z5l+^rKlR4)^d+9lawwjkiN#QLqVX2$9IsTu`)?-WVvP1X%Af}-UrB_8g|)CZ>R*J% zYIApHEEJ0ESx`U?aDGj>}aoDsGwE9!~lO7?`1F4jGIv4Z{ zHm2(zA190VTUC%eLPW{7n2(#PcSL(b-IOd9lO2ltap$C$u3n|GCyi2m0SKv<*vwx^ z=IhQS&$GOoPuFyYI1lN!QXJXbHc;HfW0y7$2V404DYT05Ezfs_fr!fHu<{tLXo8O3 zDfQ^0|`vz+2S!7V(UF$ioXN`!A_<@xhyyFNCqSflJ~GiN4i(! z(i@%Q1^F5Un7fn3*_!ip2^tf6&ybOI!RDe7ZMQ1+?-zaC5m5mYXBv&BWU^4aT+tNE zhC7a`sw%LG!ChSu;oVSiG!TSk4%8`>`cKz^sU`SbLS+ZCJF!voX( zo|{}cWhLgP!uEJ3QjzMfB_Zv%NT`JR_jk8ubLGCPo#DAxP2OH!Q)RZ~oDK&PsL_3W zeOC7N*~*dc8os1ItTdU(vRUtW-Id1sp&1jN)yd0us~6+xof(@8wWL>tLZ`|Mo{twO z^zN0*8MI^w*06DoGQZIY+kfwZ;mNRO1^^5MZqBq|^8f*-uBoXw*pvYQA#2{3i_+1z zK>-acNke;or4mC3@=T~-opTp`b z2%>pl5j*2Qm$$a!b@NpD_#QrZ@L+GMGB}~aXtatS2^o{p%eUwQ?ZLtKBIQVUuf%0f zS@HhtRc9Cxyb)x4^a7qrxu!ZKlbrf{gA?s{v`zKewCWuzEY5c}Y2SK{Nh+uO0euN3 zrV6ABl81U-Do##pc&yp`u#_UTD*g45Y>5<>(B=2SIonNw0;xtjqTf3Ti{yFdP=4sP z$K`9@el#3R?dVHb%;q=PCWkm6358%w1M5pXi#a|42Xl_Y{&fiM$L;(}jaoTUDy5%) zeo@L#)tX{~_D%>clOO1fNV?I{aa>;wWjNdJK%8Y4dxJ0i(2(Bp@T9JiOC8-1c^r*O z^BzwwG(LX(I4k~&9{d6%QPAaJhaEPZBT5ROTcuOlbdu5fME~yk#?p1Ba&?LKUZ(C#ejn{_ zp!s5%H~8kE0;9n%mZqkrH$xF!!^7w$F6T#DRUsXrxZIKnmtRL}7)+IlTI=mi-@Shi zHS0i0=?oN!&5fW4RZ&p^Yss&xtNYVK9}yK_Xmg++hvV!K0J;dNH#uo@wetx)x761c zZgHZ~LbA>720?GA1!2QCHw99IyJz1=g%;p>wF(iXwami7q z1`H`mC7SC!G1M^Vq!wrw>KPdL`uaXOwzd`!5}dcKegQf}`1tq-cyCD?rBve@?uzZF z_x8I%L(##(fkPCY2RuQ4sMK{`j7%!E4@AS(ME3LGjltZ2TqDD{i!pd|tC4+w;_Q^= zq6X62J3I^3`yy}V!!TE>`mNR#u zxwe-5#m;2z=i6)7j}R8#60PvXC{jC*TYCTsUxypm3EW)s4%h7m0|nsucIwB27kJDf zWn9e6-{&D0rM8<=?z4?augImWZaZFN9MqAT+S#3PH~s;@1)d$m(bDqrXVBj4jwVL~ zJso9b<(HV4LSL1!L4uiUaE`X!9DId~D<&fH6ujZ%=ZlVs8Oz0daBw@bh#C^*1-E`J z8uj|g4}T#5lFS`d$qP_JJZqQ)Ji-T1iw@5Jv}{X)XKaJ+})*r zH5P^T^FuHm{5reHk#2T3oBKuC4|(KdhV|6jdK9I`UIiOK5XJ%<^EXo3bsB36Y zs@Kr3_rzwqPM3c#k$Di#<=hqd9^SnHz72E?+@2z}>I1IUHu@Ieh5^s0+y zD>I!(bNXOsqvShLFnYlM?Y=IiqVCVyo^D8j9-wbpGw(SbE16QU`Y+Q_zc3!22D!=| zy~ELwktoJ&ad}YqxLj;SHo(J@|NgEQWP3KJt(W(Evz_T4_oU3suf?A~-`m?4m5=~^ zUB97HdN0d`wX48apsVi|bekkWW@c{Qy}c!(iH0VINhfuz+uoJLN(Z`%LW3lZj>*Y# zton4IP&>*(pyW#a@#Af=R`UQDkQ^5go70e!2Lz7#+Q}hrsFWjGeUWAJWQbR5wLc?c z(Mq&Dd;%&oF$H)BO9ce*<3-n-52HMH@kaqq5mB*!b6Pg~R#ey;#>LVC6gUy0A}?%8 zN=cc25BZx*k4kl1Z`-l9F&Dm5tHqipu`G|567!^Rl#LBaa|a2K^va5S?>O)gU;c?O4<7k38un=~xLtDZ?WMXqO;o&9t1|10X9=~?s2i&G@DPik?yOaBZZRe$O^Lct z&_ZT&I?}drvO5|g4#Vdbb9Ln!7#LVPJ)-Ye5EgiekKflH@v^n8t=1087)PrGavV28 z_bEE*3;v2UncR=ZB2!?Y;nH-Bc)B?-&K3DCDjUw!9MM=Iaz(08dgBoa*e%vbW@nPI z!VFV7AM^y)q=%%{pU~EIxoEU}xp;bxrFCQzL$&Q70a*2QGnDLh(KR|aj<)R2A`u{J zIZ{bNfh+CXTdVv?L_|SvK3tD=o^&N)g*Q0MCpQ3;vxfZ%M2s&QRM1_niVhBG%0eHIWHN(wSY zO-;?39$A0%nhhtHn0w0E9q)ta%uKx#m{_)0Y}S|VsLNYdc#7+ru1Myw^~>xGE4xhd zxN<+%efaQUX?1ljc)Y(;tWYS@9;cZBoEFN;TOLe6A6`KQymw=78tytUGdII#u%mE; zTy_i$&{l|xJ8F5HzK{eP7ht1w1DcxJtgw{&iwGv80Xrg_*evDY3^++EadtiiRUkcN zqmKkMJ)IaHgva0HEks1*Y4u%^ci&zIcz6l99@R^+WpmuVw)Y70@ zL1uZe-Ij&MOClVGzwKfMCJ=|~>r3D;SXs-Lzxtr!1<*sUGkh}}`OVhWs<-sbg)v7$ zmang%&C$wevBt^C)s+*idP981q}0eRSRiz4?5E%K!tiVA>U070ez9XFX0^m{JtbRS zUY?o(6RYPP8u|kK;OIg)k7@|)6*Ug~K+Bkeldi3;uORela4`5lt_#9VNlA&`BnRsn z=L$WE9BgZInseXZ*zikA!YcuOz@R~=?GuB$h5ES0dsy2dDGnPMTW>mX@1ua0SyV@LcDF+);GcOc;9Cq7tuxKGg|h2hAN>L8UtGGBjbu+f)q zwg7v6zVlHkcqEk_I5*%r3U|F@?)`7i!mDFpo&=s00LVsN$H7i6j4o>;LgDz`0B4U* zFEs*Dic?e5eE3jSRYgWch5Y>a^VKjzDJc-L+J=nQ``7khX}W-WCMrCI)lzfL zX0v0uI}o4UM%%vLNDkl*2>)a@`ygPl24G`jGgt%6y4g=dxuW<;(9nV~Df#9nHQxga zL;xONQg-GU=&WVm@i{3#b5I!IMEgvZ42r*@YOo^C3kYbKqSdVXBRrbB%IQc8<>HDz z-_Et$9;56%Pfh`uvDS7yL$=LNx-zXZ0YC=u>1@w7^Cq!ay6>#=gem=0G#Ecwhm$ma z??>y<(#;YWzkiVT3ta82*c{}A)7TziqGNcxE7r5XCwacyz;EHa7x<%) z*L&sDU7?T(QW6rY?UQv#YbMyh*4Jm-YwTfwhXHz^KbV>V+;YFn7LrG@#dOTgCGE^; z(us-H8|(ssEy(74O|)2}z5`^mfY4A$9z|d<@7`Sg43HS`l$O@HuGK`aQ&r$)rA>=`&fxmIO6&4=! zrX}{B;&$u?5<5LJ!)Oh2ssp?P2n;egd{2a$FA0H{W#EX@xKTYDnNBIc^(oaVtXN?;^&FVeR^TwnVIO49=}>wT&dX+f zLUMC)C`}lJC={N-b#UM`ckt{?b$@29KPfIbENp6KM%P&9GoS9e&!0c5*E@uoPL`1K zF4oxxgMYlj$4_pMwzajD_@pf(b3(ABtEc-kJm4)2O$e~+gVnRBwUs|#k1MOFTnBum zP^CI-Xh;U`S}BPAusu`D1U!mNJG($8bpG*PIGoYA=QSps3LgOJR*z%dhNO?ZBiuUG zX7fGUOh&0Dtve(@g6QVoBNDD>F~??fb@BrMu`*wXbJ}zpYrzeP;)XcXIUFPt1NEvK z1sN!w-TJK~BUF-n8BwIYAn}>Q6akq}32l2MBG` zXAu`r5M??Pse&mBR!MX30p&BmiQGjs%VVL%CT7zSpD+TBp)A=tzhY2qRzBwXu{Msj3j1;)5%;Q=+|B4RF0)~kpu0J~qm7626nJU)BI3ogfQfnf`u z$HwRQ6dwb=3G3vmTLiz1+7Nqr+cyMM zBJQ5!)lPOm&A`+xn|wmJLBrR+_k09c8nF8Nf+BNxc$o5FEf#1cGfzXz%*(2)rBTD9 zVnM;I={Q+lKg(@48&aoB2{PQ~<$Qetn*s8!`&|OuvpM@KF!7^_zJtnO2%MwZj8nO* zSJ6mb#3e2pS{ZdskF57HF_S#pnyqIA^^@J!Ttb>+aaL2Dk{=;(5WMHA_vq*81P2Jx zTtKeV)ReSx9BlJ?V(WA{A8A}Zxak`l{Cp95J(8)$x`0pr4a1<9(Y)uii`{N)zD7e) zQIYX@#uK=T2IQbZ%?iY3Qt_|DIWIsh_se`f5oAR93ZYP=CP#5l{v!`*MR20^U>`gWi!Qb2Se8J&~fskB9YcAZaN*dU)_GidM6s>w*C8wtojmGCcbs z;NjtA3Xkj$Z58M5j>AdYUaB zm*Z5X3uN37Kr6sRg90+k$>)Cawm*qAFd&3^!q!P4nF{-;}3 zyK8CA+1V0vb2HFGk#vVSPFGAYNdlX|RJlF%D>7-r-iab7R?`lmdI#BTn{{}kGg-Dg zoSUBmQo!fLy}^kNG6iCEZ2kd1V0;BKZpt#2l^-gh1gP+ffG#v?zngclQ-I^*3jCEh z5flWywogJ+(Uw9q{L!k7gnV>a|D4e+$J^z_b%IcHTQ<()K~x{7)B-mhpM5 zAKqt+t2F38)9VP$w9XW27%w4$%NOWF2}w!7GfsH2(S15Jh>eXM4#Ycb-n-vMA>xkG$ln1u-h>wr&>&kxrL@3@NBpN8Wn=x?M zL17h7ig^0FGnbRd?d$Rog#l`vHjpd|f`5BymEZqjKP~vxpsrx>zZoJ3@2i!9k|T@x zL~!C`^uC{Ud%BSmP>1kFULzx;U>yvp#-)IVe#UyhK10kxXK>Jsu(T^72A> zFAx|UybAUcIKC;<;AAZpMK6sXZx7I&@|3k{-W8G`vr)wF;nWJ~SOu(7jqD>kyQ zuz>n!2{x5Re~y8H5%nlD>xkmryOn|R*P%6Q&c1)TLuaBE|>#VzHWMyrB zB``e$Pk%tj3)!sK;$+Km^+>Y^=JCO!?hQc!IcjhY?hWr<7r=jZpe<-{*spMEX@R;e zaXOoOl*Mwob=r2*sZltbc{aDG$owY+gPoI89`IfX9Glp+3LK`V&!1<4UW(abLjtH% zjl>Avy)%{s?Q)UcWkZDNa)VsG&Q#aa{yrK!4ANs7_4sqs$raGK_(9CCymB}QtF_Gs zSqkU`dn}571m82LdY2lG=kcQ8#zwcqu{#ogMW9d|EX7?} zT|Im(>v;b4`mh|NbI`;U1V=>Db#%ZIV}L|>zB?)3AnoGT{0d@fy8Ajk5-1A*P1isl z?jb*L_b(kam+bHDF|OUbj4Y(&;UNTjolG*JHGeeMxltHRkw!xdq%9yxZMNcTX(h6n z2SIQpfCxV^!7|Pr_#4}X#dWO<%sFBQeqxiBN2qkJ)R^U10D)Td&SGRh!%K-kv_#ic zYjDQ)zZ%z&^IfHMx0~X#gIkBh{ZkmU;!A;|*Lp82keN=IfZIJVlg-+d7qojsPu=`| zeCS=*L|iuq47Qe9LhzV25)NCeV1J&$Vrg`aqe$WHJh3;_Bg36YX<$P*ef=U792~57 zp7^ov?nJ!GY+mf#WZda;zuFj(_?&?^m2RD=IsNf1GXN~r^D#a&G+NtRF9VjG%x3N7 z?T>1G2XoG_l%}#|Ot7-D`eBvM2k%UARGP}~UBHC$w@G8h+uPeg&C_bZyLjj(Bl8jn zp^q2NK_n-0LD{hzYX~vl&0DGfR-XoiHUl$8J2(*v^t>F`Gju?TvMmo6P@s$VBWnlh zD(#h~lSdR^0zeLxsDK6_#1<)kZmwQfxnA$hpP{9ve_8Dcy)s_!k=T`d{PNW+Z^zvU zaK<%?K&>jv_}fK>^}k!_nf{A7#RAWiHU`s#dt*N^p$BZ zNXr#E-?2NGio7tNjRI0aAMIfoe9EV_+yf8iYF|^Uen$gs%j{~$96v$-aD1JaPNLJ> zm3H7G@F51LdQvzYBv4uO!J&F=a~d2dy1GuXWV7E> zPP{`c)~H5J8%U{rgP*)(j>l}wcjpQ{y1m|IF4%;dR)+Fam_YYty2^M|56yDW1h~7o zh=A1UJyEnPn<+$aciB8_T(>x1?>JPf@yPvVp91t_DJGJ&}BE2IN zdNfHP@`k>QROmq=<(C6uiWg?nVnTxD24s+M{QU1xZ&YM=?lRk!@xyGl>fDvi-FOJO z=c?fgSS2JZ^IAv zbol=51we1}V;JfV1PuLlzYJ)J@As~(`7RC&1{WF|T%j1;+}vWX=}?cHA!a8Wu&!O9smSKf>WW_lfcGBA_y((`tgj z8r}&8xmE|B88C^;8m2t+IO7f_x$`Bi8+@RGbVcLDa%6xY;OH^E4W7FuS(%`eEWQH`0#X{c@`g{6f zjieV%O+W!wq_wXQcX8oBLL<-}js5WWaN0X3hityyAv-RGKr)Fr682;$oJ&IFx7z|& zgPU8vY$L~Lu2g&Locf3act-uAI4t0o*wiqgk|&pJH8@&2w2RPgMVypM^dWwun zM#d6bXTLKvJO?V=olk~jvX_UpbW}lkH}<+1!N;yNuu3abM3V1HAhO4S#sH8>1xIJE_HR^>9h#BH8h4r zFdjcSTWNm|@TFzs4YiDtlF?ZJItn41%m|KMZ410dHdOZB`tne|T)*3_(c#Z@1+&RS z$e2>e-DzkUlC|{~F18i%J1>roj_Jf*BQCe=?=GRZva?+QDGweX-`7bl2t*N0aVY zqG?l*lA_t@(mwF}6N}}%*i@MwTz^k>a5yWkkiUAxyh6nDr+=Pc@qCw|P$3v+G-o*7 z4I;|qc6IbX+S1anFEvy#ov+W?)8AkkQ7 zFDoYpI#J#=S56t3nYAwaGn?T_)fUHhw-B*d8mPi(SE=HMpI?eYe*R?R{1lm$ljClI zds~_CJtAHN9EK`GBXs47{~-{Fp(6R7oBQnStla%JGw@5X*))C`vdl}HU~=iyQm1J~ z#bQlKoev*?Pllft35ogR$Lz3JYP;%6QYNNog4rsAo5~W+dOz9uIxcCk>-_zT%8<}) z(4-vA(LY4KOS50yki=!R901|J(U(YSkMH{~QNSyL34}5V8~e0OLk+5hg*ceq{QN_D z#u0;wLP5L3;;Vi%%0z*PN?d(VUrMC1ym-#UG*PIYkhzHlVpO{zjR-vH`po(6SdqNH zrh~(js+xR;z_a{Sw@L3Bwz;`^m1>zy?Sh&|5slxx^$S z1o-*AO%w{iOuAiDsQ${MX)+^D(l<1Wy4peq_0u2VA|xP?w3F!DyeGgSk_H=2Oib+i z$S}0R`7Dl1Zko|RAX?^SIb73u&c$^ET8!VrP+x%}14NGQt|bfjbVgwl55(Ksc(l&G zO6&d-a+&v~2p3IH&%-3*Dl1=}-R6wKNIGrc!i?9{@+$>kT?Q%DtQXu6F#=(o{{RFn zZDV)Zy$6kQsVdoI8kh59Ac2xnP)LwX4ob;=4CJYGUq!rdyNNoxV&E~I)SXE8CSflh zt=yfQZm_3TyM;M@|1L1gV!mZypsehMsOb zy)g!-!+vWH1fIQyJ}4b%@$wQgME+RP27${CPGhzQfm4m)glA>dxuC~>e>DdJ%hdwg z&E)NTldV5M1sO46B!2$35=BCV;xF5lFDO1UxWTR>ul&(~0!e%w9v)BU?iL^M2|zRz z71ei2jcd#P_W%mO|Lo(flsbkF5olHz9KfK3i#3q|xg`?mA0!>jw_l3k#B+M^X!7vP z)!Pb_&E|rwmt_V$0Y4!53`r2zE9B{LRAr{4B=a&MA;GTfR~7)=95OOwXOb(xOmV;&M1Yh` z<|q1oXarQy`2}z|I)sol4D@a2b*Jdb!tgHpmnZJmfTQpV>2ayfDA_;?ueAC5_t#Ui z;P_l{RnE1S(#dMR_4o_UCgi?4oGpIcOX3wOB^ zyyBOW!vJG})A61dD%nc0HvlFiV!$zK)of(M>+7idB=pCWf(wnoHx15a$ER%oNXVp< zDWLg@wJL^&WZ>g1`C7bWA$a7`xFD%!#)qL!(rR2UOU7DucXj=6+8%N0OOqyoKyXN4 z&QjipWt=2Fw#&=++d^L~NdIU11K*|(7F}wEVZUO+cxmZZvH7~tcpf*;J`;T;!LJx@ z7+~fc8X=ilOB!67vf zult|T*(A#1;@6WChSMwUj4DlcT2J<-T6{#Koo+W?Fy%<-#v2FDxk3-*^Li?urY=Tivk9fpA+ZfA&kezdqwD+unx}2DZ}LSSt60|TyIgKuhvJ#3R)<~e&xjIG&T_lM zub0&Uxv-#oG-#Nv=6sf>e z-#d4%fqxn)9ThjSU^!?nmw$jJC{bvCi9>m5t}*=5HD=t7vBdhq!91sIHm{VA}> z28z8uO;gaR=jA~srC(KB3+qc?KRGw4ewRqta3*(LO1+Wy#b-WRS}swM_rHcCkrfT& zwj3b4f8sg!4+8Q2s{=20T%$r?+S+39IG?;2d>+rK8Wwrv?sDd#r$Savpyz?gUvs2cIxU~&&1oe2V2vz&G(*K9sJ=- zASJ~l#A>|n=Ek9{^w9Q-M?g5>hjX+4YB-f})b_OUpSk*W*^E!e+tX6R*s1a$k5Gw? zVQd%iDLvAeEqWoIUd&)G5|pQE(3CR(ae z%J!Ue>-~{-vwx9uJ7&JxuQ!{Xx8;~#>u%6Z3DGDOzPRsl`f>BG*7j`m*Su0@IDWzh zM>FCp*r87@PE%H{l%we4u=%jpSuWkR(5zWJo-E&;{f(n)Vgj3M-0klR zPc^knEnPuZ8X8K4JTWpVs&vW3o*?zAUr(`{>8R-OglUred7x9DWqpWkzKTx^DU{a|xEcrYXQ5f&E7zDk93 zRhe0Z)!dD>wY6u%IjzvFrv?!-LD%!zY`}||N^y^zHYhKaB_tt1k`)(MY;B!U_vGWN zo`i_ki7vefQ`HVw)=W$jHmh}oAw&*mM|rx@*RmCJTB5_qaDX_xKt=x%7J+@IcI^Go z;IQ6AI0c;bz6-)Zh{3_}aLv;-O{^=PHxWvhp6n?#VwMlC=FU;f{nO!n@As!YuZx#2 zmF(7=E>;bFf}Xj2;Mn895NX~yC*K*v9V^kzb=2{{QR+bzJ>+}t=*%7AE2Bb_cBb% z({y!>;XbFd4cIZBOve!C;(ErViw1nxH;$keXbtv$(SnSHj)$*2JW@Vj8Bs)y;UIV>z}yvCXgdX+gC>V~rw z(rQzPpz=fPmUO!nKE}PqBsaI$uV0V-*$_|h!650}6J4CHV&h=9+&D6OLZkFqAdzR> zZVS$~1%L^1Msnw*WiYu-O`pwg23T%Qj4Lc8PF-Bs_Xr9;v;?;2)vI5Y`=s#YpN(V- z!QW>z0y?``mNeb=P^)$#krh5fJE^_^ax=9G$B3NKd`n)A=X!d2l=8V>wDMHoxYyP- zMEYB6=P<_KrX$r`&(L%}}<&s8j2TU+F~*qn^I zv(O@~Ate>_t-$~Yrytg%`AyTcbWu7>5ktdwIBiy=%CKfCU1HaLd<2EwCTrF>v!r)w z&^G!ML5f390#BfOP0f(yqFC4eHHdYi_9U^aP7u(b7d<-hs~_t@u(H~(kD7C+hkQNI z%M=^zXq>WfXscDRsIr=ecYb{(gbCG`XJe$ub>S_X-$Br2AK2S84K)ddR(+wMpa{TY z^1*-*5d9%?{mRPAp|ua=6wo?=aE_^YI6_|{cD}-q8I&H~BOAV6KE>L@l=lhQ`Qb(4 ztk3f+Qc+c0p1EF}G6U+h@=ow(MsFPQRpIZI%T@|`(jDt|*(O1D^X_a^XlMg;{k*J! zVDRaH0|a`SG#CmKao;A!2*VCJA0jBGb@Zj=>HqZyJM@B zs~sO@NX>>i2;21>8F316|t5HLwj*lj{*h!1uaj)XAojfr1}koEYfmw z$M;>F?H=vEw7GKah@cUNSr+f~C@nlFXlmbUbNcJxpLzrU4BQw2C_rQz=W-o7J18iB z_9Cdd?ClMHgvpk%4r~j)Ew(x|W-*-*biZ-y8Ei2)sEC!j_jebBkr%j&MaJejf0Ilq zk(8Ys=VEWE*7&)f?9g5iR9h=D#y#u7RaulZ=+PHDqk{Ca(4To8)Bq>p!h^8n@`m^{>LHP%I} zGP1M9$nM>+c^|NdeZ2TC>>8mx1Bkb6x^yJmD$&O6)Cq z1lwGxHlpO@YqP$KeSWjo+z-HEa}9$ z#5%i?{|4GtyRtI)aw{JU$whZ}0aGiso@B}8uqP!U@di?&Z>s5Lo_2GlQYq!MscCT# z(`;1~U@1N7zy1!}4h{_ZRk|gDS7$Iqu|Ul!^Nq%?1+L(=o!MFgIO~YX$T}(F|8m3s z63R$0zy)IXOT0`weeNI^+h6X+%}O~>Y4E;RLPq`tWHOA}2ZmV-XdW+|giCqVoxz{$b+M<1;6DI_hGj^kXb)$Hj|?~W%p{a*XiWJ9ggZ&{UE0{#toGG# z13cX7*7*c_-TIuB-aEXO9t0) zVLzc!e&wK}bh2}4<|(4Aj3Xf-0Y?q=q4-n^d7(ODa|KYi{~jGSXKB{rF%_PQ)2RM@ zBQGC8gqaw6Y9W{V-W~t)GWT##dpL$!ruETHzLR&RtYJuZj>A6S$7xT{nU|iG#emPD z1R~eh6~pJORugt5wRbt~0?fKCYR&Em+PLltykL~P3iaO4t;rKm2)A*Rb7q4sdWR+nGb`fhm82YpJU;6W;2`o zRW82|r&ZkPp-yHA69=a0?ehfAkdVak419PeUQL1!ZYQ~)E@3pDd}~=>U)xEA04iqv zb15mGK)ipAq`zZgo&)IlDPN--rn3syCA?{x%d;onw_a-fh)LX5uevlfozv{->e7WK zTkSN(FF!Z;yyD+&MT-t7BR6RK@Xy)0^y=_}Xxw z@}LG0OiNu|vP{)p$(S>{xF{A|E%EonS7p3Ei?MbLLn}t*us>h$9ZLA|gUcSX`M8Pa z)8~x~!MkhQ| z`owkSv7#c^6FO36=0o3Lc?AVhA|ez(i)1uNWsA<;2-PnB_RETGEasuyNe%sW;1xwt zAgw4XAfS$6Ys)+|TxyB99J}Me z^uP)=lNCFFTH@FpFef#tGiQG>aGqaSFY;V$rmN;ptz0jB63=N(%cYi2rHprakQ7wJ z5TBcCsAVknw$Y&3O8#ed^vQWA(0VK}HwEzP3v^hKWooJF2eF_NRFwiu$)UhT}J<&-k7G&DB%zTtaF zOrnq3{@KR|6$b~$Dn98)+9B?fC+bbtOmO-K23`@9f0?Ov>>ue0U`|Mo5tezDkfSJD zS9dPd|k|&aBeFfRFJU5%(TFYHDqw9~_QIZ4F-Q&v_~& z9@*3|5DImU_)C3r#fbOUr_%D$d;$Us`#VMevla2*>f*HdkoooAz2$BlsShtgSS|Kw zNp5YJPtzO82*3VvlMmH-G_UcECU5I3TF!?LpUo?*KtU$BPJR{R?|&DX!Nsk~a&#OX zHDr!mv_#0A^>t;sPfOJ?nLt_Ku@?t7HThcQ#VW$^QTS<&U!g#$9;P20M(1D8(#1x8 z?9^>dib_hRmwS3n`6#=|0N~JYA3s^XGZMiz0bFV?y*wT}-fRcBV+oTE4fsc=Ru+y7R_XfaT!Ow|=X*M?B8Jt-3 z4h}LW3tuuB^e#hRBqNMn+z#l?spD9?akGEL^Nn|y5=iKq$>R%bQW$;XpRvy6g_G5JRP3;@#tuu-QmT>`1#FCSn@ zyu$gGEjsjrPqrg+Sm(@c*Hb7GIu0wtS)Oy08^H3Uu;o7m6rTKLeLWtBl~?=VA}^OZ zAoSqVVbYryG<7=Col6$7>itUtPNfxo!J8JdHE9|tZ`Eoo1!!%N=btJfdiv@W+C-5j z5DL<1Z!sJ>*&aF^=c_TE=YsCKzkdp^cR0u48CD|zI9=UcXcN`A3#W(BaeO%VWhofP zO?B*(`ppHhi2Vzqp30I+GyodugYmr0RwVxgn&u<~;E4tk4z|u{{Liyev`WUcS!N85 z0B_;FzdXlfLtbt^8;Q(r4&jEF?R6Pd@iKT4W_o(!AAZzMZ7ef`BYj2f6B{7mNIL~B zlZRb#_6{RVu}TNa99K7Y>Sa*y!Iyf1c*LRM~kYvejRHdpJM8kfmJ3GQ#cHW@amE zM=o3WT0mWm&GKM%_W9dNRMddyoC>c4Zt^|6OaU(8&U9^}yQHLya61b~35T+knOe=* z&zf2X!;W`m7r1OPhooU?dLm~W^kUclS+Jr2ynlB%2N(14Pl@f){bXQ~i^%A|EqBNC zPc?Y~P7j}A>W@2$4;>Q;Zhg|M0|6IFXi?OzR1S_g!r5s#@O3GK*IG3rD2I{ML#vYt9qqq(Wh6 zbsZf(e?9<_`4mccndubdhTy7{Tl9iZ8DN(R5&{BbkX8P@Nrm#-Vn+AOc0#!iGQp%%6^HB5q-yd>V%)KYx?911$ zOY_Yop+mi2q4!j-FvUT%WU^7TCuW_K5**MB0v3X(r3t=16^}&Vd+Oc4KW0B)zq>!1 zYLg{{{G_Xw7oq6?E_2}PSOQRae{;Gs`U~1SucsRSrv;!?$Z2U1`bs=b8;gILr6nh+ znHZwe@;|Sb@aUo_`zMfausrO#W0_I@0J?}t_Rql+ASLV8AZ;Gl2v&fsGrkyJ(@zYi zRgZK$d=66*=J&Pr4vz}!qMb=at>rn9G#F=cl`6wUWizY*?rFC|x3tr*sp720$3vSb z5iZ8l%m!+`>c$O#lwJZEAIfq68n8jgP~%{|Oh4P`37Es({guO#%L)4DtorDnC_K&9 zdhEI!fV|;v26=}^>8eq*k7-ooprp`3Fa6qh>|3L7Fiap(&@M^ z6qlUr;qULSEAgt0W688P0iS()wRh?RboaUYNBT{x{axRg#n;(F*FgqbHZn2>sj%Px zBnzJPLnb92ny?ak*Q zOW1fQu<_mw4KowFEQ}WED29e5J|b{^SB&lu4Zz<`^Vy!?-uHkk6HIVjs4)I#1>5T5 z^VcE+c!)|N+uDFbSvlnUcXFdhDSZG)H&`uz`l}g|u1QWyYlhEL;c!TK>)zwKU#>2w z6~7kS9E4`~QhfTq?=C>Y89Kypi|?Us$K+@fqQ1&Ck`=Yq)z!VG%t~3TY9cF}uTj+k zcCwO-i9KDVoF^seQmqcF?=c@QG6%dstB8VP_ocGZCzXlY|1rf|z}oJh%LTAgJA}X_ zd>gbTAh$qrfq(vdokb*?{Kox;>11UDjBlZdua_6rL@TV8R;Nm-fY%CpeNPvoSmWo1 z>mYIg?S$Amo11KX-RB?iob1n@pE_uSw9YrP+iCQdJDd3Qul@Z9Lz~Fb`fxOl$rIq9 z(t;>p|K|bm@Fmy-Jy%jf;#To8j()kL?S>5a3WGqxw>27B4)d6FwF)!d<3F|0@Z-lK zKfaHTPwHg%HEJ3&Gz^STE@6!kcnLxHJY6A$^c?nEF*;IXC-QH7e13JuwZl6jQEyI3 zO5*Da!bj8-JV8NsiyCr#12I5HqSf|yPDc12ZJ0vdFXv0H{po4z?%&B46lp1qg)arz ztoMkIq5p$gvw0Ui6^M>!;G%(JjG(Dm6kqn?&AF(p>GEKM-bAXVI%8!PKbYhV$A3En z&03)<`=*+zl?VN0GEgej5BzV>$0i-T!ZD?YGg^AZy-{@-@&n`PaotUdu763Y&P2L~Bt`s67 zB5?X@d244Yy@9QP!=i(c}dgtxd3I?A9<@^VRBe1#ScPk))V(qg$mE z89giX&*HziBx@5|&2M7Q)QBS*i4A+*TK>OBI}CX2w$jVCUQ>FYrI`ld4NPV5rp_Ie z1q1|0M=i{ZW2iv$a9Cml-8>K*?tt9T+T!s&w4#6t9+JDIKfvM#2{0nDEc!QZ`N{UA zD!|$ZYYp1{Q;z~4iP8Z@`Y!O}pYoIiK76FF65uE9mdP`g2Y9|2L_OzaqO~L?R%v1f zoBf^+_ntzz@V$#o+2m|*Z?0bT7L<{h>IEA4F^UH?NIt?*01kqkf04~Vx(IW~IT#pD ztMKf&~*AZ4Wwhp~WY z5i+Od$K3vW<~L>GF)a&RQo```C+GU30M=9-?{7}lCIa%Bm2%hW z)uvIKsEG(GC+c!`5 z6hMMAlCRR7%WmCd6zB0mm-BzW}-+)Edqhf?-Ydkx)CZKJ%laeQCsOv0(9Z&b}xlW5*zGCwf1yLF3VQPki{P+2(|nz*S-JB;{H zk}UNCfOuRA6Bqh$c~qt zq1o@WKDu}j@-L_C*R^;DWXF^MX@9kI7mu1#FM_J zks#;q@fMXr;aw=?NO3DJi=}8`=vPo+!Q*xPvbbmo`V|-x42RP(0NF*_a4?xfa-@Ij_F=apOH4<- zXzgis?32?-)ivAAw~*V~*O_q>Y1A6RGk^PbFt_IAzM@%@{BaVX2+XSwC+!I9+w-x6 z+y=GxxO#gNahXg=dP6nmbw~ZGjtL7bTV1d52PY&YIJluoojcx|?`q!oUexyV>qubH znr=s7miX!%V|*|n)2GOD%&2yPF^;NY=jr=CRkSa8cJHLKG%A`rd&f^B6rb6=W?x?jQ2P2^uZ zjsC-OA@cl4RhpmQP8470gnydD7Qw(kdBh?l-|0xFQT?>P9GJ@PDg+#ixq7u&34-xeGDA!D>EB-3P|>2KxcEI^9v8M} z&pR5wKWhob7l%H1$ZYHzILw$_MyLTFiGX*Fp~9NeIsQ;8Tdq&fN#xmEvolP~wPnTN z=u%zo2#gM`@fsW$bG0)CSS1r{d;aB=Umq)UAv7{lrusTjZu(giYoWJy`j-x&(b^ga zh?%TDV@wF$L;0XT@I^y?!bN_iE$izq#}j&sVkXqeG=@H!?mcCq-3L5fjI&#hFC@O+ zp;c~8h$2_;n%-D0G95vSVW!vZP5M1N)NP_o$n~eL-t%thFnV!}U@^z|W*8!L0h&-U zo`+_TV=oWV$t!YN=zlGtms7 zC)6p>ujPZX=CjUh4N~J?md$}!N_Xtr%Y*gFDA0a{E+N?`Fh>DM5JoLvM-Gt|z>$1h zth0j$uD0wxw(*Liq3Pk_nI)5g3J!vjx<*7WnWb~L z_J=+;3a!`ahr#ynu@m9f8}o37P~!eI`z_9%w2hE}kLn$0qiJe24o_nx)0;@RQ0p=s zg`VUeHo7#E!fMxv+fSTyN6(S}(C6iCdWY*vOg1G^yeW^Hr0l}R@YBnBUy2mjIRB+i z=gaET(wwBMq@JU1g#`)wOFER1bdB+ux5rP&UXeeiBP0ZnSq!p~fLxC_Cgf?e$-(&y zV|gGh%c9MvU+*?VkTwI^+ctml3}H0roUDI(lJINto%MLV(*qrBK*1xZnDq=ekOn zVLk8!YtuPTS?ug=)@I_pntlUM4g3!*&(4T@Pk-5NJ%6&i3>@|klMip8v4<86Ln@)| zQjYrN*#%uK>1B@o9|jr|+}+d)lYieL-#VTOy9NiP=)|T|M>E8cF!_{dACaFccK;Cf zeRAy`;nEk+QueUr{4^gw?osnA_E^(>D@AyjKSukae{QmPwMvE6#?D=O-b~>GNom{KFnOu!Xx_ontmJe*RXN>Kc+vr`)$6GORA`bgJ|z0(X32j#L)496)c%9YL) z|IPEakSYo>9tKr7pNlMAewK=VTE9apt?=;xY(IyOI$ zaZf6t`UUklW_C8Ep>d}5+!V^Vo*kLl!69RM2cNB z`?9tNdgm}{ts-CjjH4&mWVz#gRr-FO2M*RkKO++V@bVlUDb zocIC-3?PGL61WNl>QtgG%2{T*O@O6=+O00LNXN)ryCJ@Nip zBqh*l|EtES93LxWqJJOvA?0(&>f=_+@H0g!`)dPNV@FAvv^fm2y@iw;<-S%IJ&9Ca z`O`tCTvdjruL!SoN#HKj8lzgwq+1c~@emFSM3*=db#!!~Z<{s$ZuhKkp^IFMD!A6x z)<(?4v~N9lIM|WO^zpt+_iVVv1wGo8Hj`#t&dE-$Hiyi6bDhIaP4&z5wTExrxw7L?u-?AE-vm^ zP_-ko&@)cQ*Q0crZ`IZDQz~tv*`3N7;!v~D!o$Ns$c6(#mKVGAD0a7Qe&cm>#XCLD z043&urHwA|DtC)cC9k1O4@~{Wm3XkSCa6{^3P6Fdq`K~44+^^V=B2}S@1~_BNS+3V zI&f4C6sgZ7n#{&gO*zX^|NPnAkK=K}zveP6BbW6)=m|#PwZDfCUb0+1x)yQR*`FqG z&vlRzt*-j}C%E#Y;_3dwYjAqw=vuVPBwm}xB-lSvr_8_SvN}{oap7ch^TlcKuy}Cd z#lMTCp6c6N4w2{O`cdEZg<6|FLMV(kuF{1c7pkJb2;~(_u2vjTEPn8ON>#?#K#vpC zvnl-tlz;f|%>ES$o))ZufdRA!ytKBD=LpelE$gA+S1PHlRHmrZ8hj~Xl1ktq`P7?0 z$g3o&|1Q=C@OK2cO0DsZ#u57ZxV2MxVd#^Ss?sBxw+H1d7E1@ciG(8sxUD^E+H=o&`S1H$ zJGY7f_9ZQ?pr0Csv2lZ6d9yUopq;{0Ev6Ko<)luuBWk$bHk`=)EGXVKRnW*dDA5=P3S9A&}`f_g0JqGI?{% z@=FWk5gVkdX`LPvf!d(RwOSjW6O!8Adf$zR=5{JlTd$~)SU#>&WG_^VG2>*H2l@L} zSGU9Y3Bw$j8af3hjroQ^WdN)tBT5AK+A@F7!Y-P)XJUq(j0^;>bKq1(s zHp3+=9T^(R5A&_-WSQmSs zoG=|LBoG%DXD7kBIVY}75)z=BM=bL@?^>R!{hzi+3{fKeS=rgejkAe>G3$(0u>#2j zpm7DXCrF4Fgk_1~FO`6yfYGT1-6!}tN&D`iZ&s{xvWz}A9`&PAxB3hmEQ{!<`6^7B|LaGlGT54`?SLz)s1aNywtC1R6#PFX+ zP$5Vb-hmp3s(J!(kslklsy{py1Zg(5Yv7uKx(DhQ1l@Vj_60PDNTMgGKw;qs?{Q3T zhQViEoWSa-Nd-YiljXwqwPjNCGBl6Bi9k98WJ0xE6noVcBW|-jWh5ih^dKM(!Ha>i zTRz3=1;loBrj&})j$)+F{xcs6Y9C;Xpo#0SeH#w_ZV7~s9Zr-wn0LO%*Udqic5}k%mipK0yVlovk7(kCDM)FnxB_nV87FzYHVZLoYl*P~-^8%S&h}Vlo@{ zp-Xf-nP#t_{IxRmkzj5H^28E5)#ky(RbM39|3#Ovs?aB`_M^-AGpa*XG zOA8{xg1!x2bM80Qo@&q^G~O7(pM!VOms>?SD+A5CCYoa*ggC zSv7Sd6aAJ(ubZ$@?>>M29GND8D+4JQwMyaV?_)|TW#)l=;77K!U6M>?! zWp~C z7NV8bqNN=hpB$X5f2nw>`b`B?Cm>gC7$3~2aN2l+PeYB&m3oJV$d_yBj%|*$<6Azk zu@w~;Z|rZsvn7*8zcJ+ZpBO`bY1aAVuRCaND9?+IH60V;-oc@;s502r_wB~5yNiI2 z^F*&~_kgeOu@z_S3p9U3dIw*ts63W$B(ek&C&cgtPDI6@(jX>EAOc13NhX2PLeg;{ zIE>sjd}kfh0o+appe^)Nlk!%nv7rFZJ0f+r%E`)vZX8jJ`~`R!pFk2!56$mQaI%$> zZU7;*1gd;?mvc5yy<9r;s|0IQqm5T7&be*hVGpaR;Q=?(l9BeSdQN*VxpY#qvUaSl z_5TpXf?<*Ba_j0P96YeEVu?@{+(P5xx-7i!b(W@sSOg4>D_L8LFi(L_)*FCr$^-M; zd=FDW#>tqx%H((LodoB{g%<44(5CobahV9yH2y2Z7MJDWGdybBI8y_)sOM)IHoI@sm6o%PI8jW{Q zxj?7{lERjB11X!12p!;i;{3jR<4FE?FDoZ!FyBm7fksnO&E_=-e2hS$etG@+5Itiu ze*`7sYJ)JQJ&?*~Er@BusSfIJa>TPFeHj5V#IVRn(&GqVKsXklxLFlYrGa~AZ}Xou zNUg-6R^Plu3J)3zLRD>6zkq;snV*>~!ok~79R7d9z|ZNs5l+E|@jQGZavFCuzdIsF z5&QHpD-8{ebMHr!)SsGuD}VdOr(i} zSbQGDF2LC~q?)OUg;O+wz=-|%lk`4b;o`xa8bxfLf}K+zej4i@?`g8CkjNRK}x#C=FA3^Zv)+THdikB9J!=&Pl5ax zS=rVxM8ipSj@t#b5dAs*HQ&n%hl|tFsdY!d`KvR@r&hYdRJ-Fo00kC@evb&UXOKf_ zi_<MPF%6=U5RQ)8qw{~(*D5SnJ#%BF zMMXs&w!^#N;Qx`8R1f9|grfHFz(k-yY3cSyXD$*F-E5ZgXhuea@LT7^*x1;Jw+SRy zyGp-d>Kji7&lhlaROgXQpZ{%dgC2_BcvGojm>SGiR8cfK>9M%5K_gVB<9(=9}HZRDazQX(^t>i%} z4e}gF#kh>xxTHP*0z%G(mH@5YV!in~*sV39^6S?sBH&jEc`1+Vm_9$DQQ5zAp?vg+ z%xI)bZk??`YJf&DNWL>_0a!?o1`M$Au&s*;@#s^M6*$i@STRB?OHS2!Ra07A%m~af5-1q7ylhoKN0Q-s@tw(nz=Vq%hubO@A$s4_ zBb$L;3;LiWez1NFFC45bB#VZ_#R?O}tgpips-3KNH^^~b=i)nMJW`!f)iS^GyA z79u}f9?r2k+t)00W@iozjGkZb_|0y;D8rQTUPeZHbG09C7(km$;5HijNilhGktJ7@ zJk-CJ3l78qI0>H6skOO#-i9ebSP>T&*w@eSOvsr43oMb)4djMklk|6cbFDX#Hv^QF z*_4#Ivkr0%1@lrc>NSxOzgJVmmB0wptW+>n!xM5n3xrI|^DXP+$jD>`JsboRVLI+k!zyVqeus+Jf@?XKn5R;M2O_0s%y!g( zFMZ?aq00d|K5!N7U0vaqfgQE<1|!tq^p0Lz_Bq=ex5`q^RbpT{Ir%V>g=MB%-U5ae zT3hQ-=rXMTojW)lZi&aEV*CZB4@P#G){a3K3kvC3TOleEa%3+OtE+z3Tjd)U%VM`JV}%C(cmrqw^g0B~oy2)93lp!qGyrUJT;O1FPGf~eSlBrV%@ZAPl{_be3p@P%`w}Xs*1*Z`r^+fF zkhR+$SS0Ych{5&fZRQE_)m3&GIVaBu9=S^-@dFEsw!)}abEfj{9eNAQb;_mBNB5T8 zoZ{X_I_cu@%mJ?eJ~u4^SsvSL((!^kQNh)o+r7imX6M8 zzZGigLUFj>@3~e}ldDpKx|6^ST``&m>LVsUIYCX{H3@GPQ+8`hOYloQ%v*KFbcJy% z9K&R^7?R`f)dqpW}66VdWPXE;HX!DP4u(7LEnj zFN(&him{7rA)YAi?&yS!UPtj9{b0$calN3lrM^zjz>p;EiTdfa$y;Rug9f5kY;Koa zS`P@`ceLL*2D)qLhx=RXFPGJ>@q5@*p%k*Dv~lcV+uJ|!IqkJgboK?@(L(jR-wf>T zxD6D#x|rU5{GlG=j5}ljJ*T~WJLNt3M?2dkX#CeI6Vj;^ev*fgz56qhry9p@>EZ0K zKagdjxHmpVZ@BvYKU%wKRs~LXJ;(!-t^A3+xveUDh%HqwhMhy(y+9_#xcL48jtKf6 z7Ml8}|BRaPno(9j}@6b?dIZc*D>o(rI1D9I~4i(PtNC1%JVfdT&o?s5;&urSy+ZFroKz4 zmWl8f+5%K7m#q*8gqro@A3nH8A!OSGb#uzkx9Uu)Hu9V!AvEYo^t+Zi2;=#wdk37G zl8U4zR8*3Lypr)MrI`vPq!800HG23{=$4`)L|%0aenCUdEzoq5FE1iL8;BkvS}@dt z{rt4HP7hUB3pvK2nUSq%|ipTg}>b!q&!;#VsNpMbg*nXQo=(bkC=+UZIybMqeex;L)~ zxa#arZQ{ftZ-z<|#Bgcd&;ldOeA^>fG(UDeUtcUMPIk$V#N%-Oesc1ubXgOU4kbWm z2)-=bk^E-zc;x+Y6F^>E>RIIkNJnyQwx*)3GbA55Zap`L^BySRJtft_QYZVs=%{k*V{`bxKke>q zA#ZPsIJ9$#ErL4B7T#Sm?5!G?Q+l%&bV!kd@ej?z=b_Lm?EZAgSJ$3K-SzS^Y{4aX zc|lE09V&?x!zi?&ni(d=Hb}~H>n=Tr9RLVy26ASoEZ=3Wp(~Nex4zLQ%eE?(r6Zn` z)fesnN(_Dg)M60k7P5Za7u&~DZ@r9=^hE8`!L;xYv zTcgn#2)7+kPzblS{I@oWedRzHGVm&-sEDB&l+{O56=G+7qg9G@NK;sYayt_!*5E`g z=?>dcAy`T020g^_C(hli|S!&fBK_p^-SWO~TG*_-hp~E+ttYlU$)(xQ+aQy9Z zEIAM@_#+-!d76nlTrNiepj;M5x_*q8{(_XDT)$LQm(L;F`4Og-qD^)b*?N8%Lg|4Z8D3JHm5{x5IHIu5vh~Y9wZwxHUkV2$v5#=V%*9bE#gr#2bbmKD=4*!5FVJ z!s<;){?4O!7s{q(o}AySW`73DJ>3QZuJ`N5k0AU-R_ed>r4Y~C@PMT<1y@yh`rl6B z%R|w2*gK%8I@%Pquh9i-<)YO`dPhe`wkWz@&^<@knVD%B8h**B;=FwW#lhx^2e}6Z zZpl#^pBVTpPt}tkyK|N~3F{w@nY?LZ)T=e(&|e~pYU%HMXfc%`*EL7@0hqn>N6hv- zUKr9!6U&4w)(=m}5j&n9Fi0gB&iY!;tt?ux@9X#K!_KFy?aUX0pl#&cuRqI5FDU38 z5c)b+Y=$cwL?FL0flS6695H+XzS*|wX2Yq{L>|2fONms9A9G~9eS--^@kLD_wa6V# zvpvOlj>Ym4oqrt>zgW#WE@1k#Uw=FUP=S_KQg|s`g!UHhVrR4Z`y%84;lOm~S9PbO z_igpp%PHlRetoj6yj>v-0UQ87SJ>|m)Eo55WN8bf=}H|PtjR*yNwC3Pe?in!3f^xl zkkf8sI!jQiTrv>9Tf0>Hb8)dh1rE?}wd+G#mkr)x)io?dWyMHa$MxGj_{VhBzvoy2 z@E238EVnG@sSfX5T0oosE1X80f{ZMpAdM0n0TI8$+A7}Rz&Z8_#->#E)YqAAZty)n zNPU3O^d?{5wPcahSM8JC^YcG-s+8v%?thPo`C1{!k*+eF4Tqo)_@Pvs?AxZg0?I9B z#qfzFC_!}vPYJhoWtQf&LNx$aX%XbJAEDmLGE+BOUj0+oY`ub96hVtk`SDmgJnXs(+_ zX9+vc{~_J0YMGh1ZPXaAV*dM?ZscZ}ogLn?P;auc7a=pqnbRVED@94p%|O9 ziCX>YDlZrVQeZyy2pJW!Fk7t*=( z`KXIHv|TqGj@st0+MUt)yRqzH04)@nH=@G!^@E&W2n<)L!Z4gzY!`GpZ3IWkfky@qM)y@5AdagJsln5SOle6YEWuFvPjB8Cr=Ng zfI*z>JV^5?H*Ch>RtAFY?Ka(Fcx^PGj=lSoQV>c&#Ee9EZdKG%vS5NGh&GYSRf+i0 zCK8dGBC&bzseb)bg&XY=0G z#KZ@KpzE)63RoyphAd^eH+d}xN-aBah?f$#R$AZj@|sWAT8$UeybG-!ep9rv|XfpEm-@d`~swy2llg_%A00M?{O1Tn0gpSYk{kHv1F@Wf_SNjj{H-8-jmN)GJpGLhV4g%i|x9W^P!!U{Hy&cFN8Lo(C zcPNaEM;G_>P-|2IL;{@AJEXmHAPp(AfyJqo9LsvOw7((+olLkXByT>$#bE%z3l^Tr z9{yXiX)Dw|_$m-2@fO^0!8p} z3$!vfXNx4S2Y*3@+Z9js>4DbbcLr0H+63^w=e!<-d8G}GdF<&a*E2S6e)o5z;T|p&zM=HmjprrYNuoc^QJNn+ zI}xMz^(m8G!%bSBFK&}r(#fAJ`Fj#u8yY-{^Yh_SESYr?X3^cOvgi^>FtVU z4OU?`vD%+?tAJ}?KD%DDg^>jhF$^N332i(FVl`=KY*-!0!cr}>$oSZw4EoULi8Iyz zavW_VR?x;OuwdBeA3VEIW$@+?$v020N4Z_BKV50_VD}OqVmO|3#drFriQ~ZJYBo{+ zl#uaC7<%F|^NA+UDtqJ(K4=lr0Z@1s%|bJ*Uel?N`@^}y3Tfh!f3EL>iThf+6su?I ztA0=42M!r&>YW{-zg;Xl%go@d+~gBO4uvbX%IG5-AfdvewVUIRet2o-Ck4R1=~qAa zWQ0Yrq0fYz_D{!`)kD$)&EO3~)E*FN65*ED zO@#9t58*;3_n{CuO0HKPmRMxkvY8K|VPgOf{hJRj9&FF(!D?dTU=zWY&dP<@N}>Jb zw$C0Q-h!5uMzvf!nwK{)mRU#j&1bPP+#1J2f0!&UEpu>)ZHY7Va+HhpC1O6n_yQ^& z(S2r_Y+2v?h+GbAeg0uL++Nm}GS>`dVEy}ZJw-U+0|4G*k7>IgOIh~d^c?bT5H@6yTT@Qlm!`^0Dhr^ypkRMdm*NyRM_ z6V3{?pxFQ%gaMyRdD{=uUpz;*Xwv&anirorFrI$^HX?tz3Ww|C3#o?2@!wh~Zo`?o zll2`Fo7y61OH>L?aMcsk8ETEf&wmT)FL^$G2K!@Q<76z?$cW9+-u!Bjj#%tgsYx#Z z^y8T_6?=q)IU)ujBD7J1wHBIBXqA&A6DOgzsNKKcGBp(k%Ng(T%p#&7E3jCm%sRacE@}4=@J0kPymOATIoYX4+I>FI}TtHWId5NqixbGpJ z924i+vqIfD{t=6*%%ePUxQI)C-v`5Vye!b{`gLP$lKSWY~^rdiSaRX;(Ba z%@Z29iVf=gH+F0NI|G!XK!q`D!<5nkDu%Yj`)>;Pmc}r?Gg;q&`Dbo8?H;$&vE+W=z)#Ah#inn3 zo`2V769GNXu{BedhF~TrS!9sbeHW(hm2LGbqBJouz<~!bogc2Xq?7mm^Yv*ogDs^L z(JQ60Per<|BRP}M6RCjh0N8N&rCmB-eq0=!IVb|0Wo8S?y2K#NK-diE@ue8Z$e=x! z{3IxtJ>t5*3^!L2W>okJ`x6wrC#Qe6a>oRQp(MCd>!dd!uPpY>>FH_L(Y_8yV?e0v zy_~0VQ6@l|!u0y}|0C+X<9h7d|8XvxjEIOtJ1N@QsI*JFv}kIhy{*uusjbo??VSo~ z5AA5Gl(y2|zvt=xd>_C2ANRw>b@e{quk&~v$MblOuf@jl#F+!{P6P8U&RqS>!fo@C*Cx&4q!7rB7X<_s;+F;v}lF)N|Q)qDJg4!g> zF4_7hBWCZCs_M$Vea&f864z@BLoUgq`C2z>2;h_Q3JVK&k-KVF>3AuyksnuWK(z+i>)J=+A)*+IoBWv}XLiBzs+iC;J0?p-SX zk~3XWe1S+DL5M)69n_WaF!0!psp`DNB<QN+qxVg!o!7W~zPO*hmBMo-`m7sd@87S`Gk}4UjgiQ zdmFXK({zfSnyvhmiRL>_%mm{D*U)p8MQ$C-ux3Cba)UKA=`M?*IWD#MaV#NOY7RbD zl#|mcy0;x1rrN^7O!)?n3l@;RiK481neMq$U;U~+n#UjJ%CGvnZW+t@dHZ;M>FT;Q zezO0{l`C&d*#G7lprrk4*<`Cr0ITs6uvM1~~2!_}99^Hbv0 z?IWf&lClt+-O{+X5yk!C7NQ{xKf1cKmF8)B?4O@qOf>$}H<*)c)709kpBF>r#$nWy zDNRl4+ zHvM~roI_BxrJ#R5O81)Af@0v#oiil+sWC!2ER0?|Yi3qt_oop{)Y5|=-QY8Vp;vZR zmE)$)tG%~D_a)NIUP^}sJt%2IuJg~^H;?od*(GEa^9Lr%kj@=e`h>0sy+|0Rn*boB zNC8(0O=oAgn8YnmUJCD!G{E))zFn#oRcdtUtl9;xzYle8Zm1ExX>u6xaI{z%Smla$ ztL-Q#Q2zP(iStLt_&)ujT??;j46ws{h$n6$_6ia2=f!sDoy+sn4UJRXVcgdA+Qs&vzifrsFL-$dGUyvy$v>f&ec=x&9YlI?vYFMd zym`*uE!Vh(436{Jf^QnJY6n{-_N<$2?{CtQaawUUqITX`2ozEtM4W>tFjkYGGuatt5q zOJY43_aREu&yTJ;fQ~toRr@8M*PH8aUSEE;nwFTfLhgAs9f~*^?wvP^MF23nRxR&VbqKh ze^%H@6wnay(HORR-&TfLbSEnmbF&Bt?(4}taO~Kz+*C7ja~}XS(C<3nKK$MsUwGt9 z{pl=a#p^ zogI#3=s#~`!)7eoXJcBS;@1P$4?Wa0p>_9dE`I)?*@-8Z{PNW+QlY*+wAu1Q?sCVD z9#s@56Y2J$5IO_=_?Jm*Td5sbOJmI*OS*$&YfVV_||gqmjJU?+mmpIFKLFWjk5zlcI#RaGF8-dCYJ& zOMj_BV<0(r(4;4s6odX(JZ7R7fop`j^W&T5T9JzRdpi(?gvs}^ai2hfHU|r=*c%fL zkRwngAu{4Lif1sVKfPv=3op=DB1_xKJ%qzpF65$C_3+QzeI@S1jSA#5;dt-oPx+nV zvg5S>-LtVF6N}p#92@wIO~&35N9e5Z%Dp09Iqqo7kks4PoPpH+xvG5)n!nM{5&2d> zvMeIn6x^7FgmjGgso9Mieag}=WslS=tQ|3X2wd1@bv-Qe7=5ySj`7*{o7)E9|~WOj?9XGXPEkoP%d?6~IFnbzH+8nvfcQ0B|cMpS@9HnQ$?TD;Pfa zq{r;*$@i}h;~rOg+mgUxEqxEI0xrnE{fRt_@8ryt zaH8jO>r*mNCd0*P&=9Ty=SI>f(SGK;#^S)inq_JCp7ODD8*e$n9wsy7F1aQ3`LV~o z1I5g?B-bi1mdK&D7l#b7U?;_Mo((-N?UlTZ|SZtZIo9 zL5gjy@^8(!wj+hc^;m}f9`vH?sxwT(zn)?S5EXK%E){gX3=i_`P;$rA4`UtK49F~} zW@A&J6N|%4tZ!+QNXkGCdr3COFFOfmO87#<{$1wpU@-lUB3FL)uu1>&MnUrP%#;6* z3joh7oap(n_5(4S8~0OgK7!06g~@PS?8c1%-SWKfYl^S%5qOXnpg7J*QQrE`u~(8( zKGGmdM_&E)C~fWD-SZPwSeheB_9c#%WT&_2HlVH}7&YLl zsl3*O%eb<{L4ib0#-SWR5>tTU5xl)bhJk_l2*C)vG|86>7mMt-gwW&6f>Fa7Ei8|(l6Y#AlnszJ&#u?(aRuhH`A*?U zJG1JHzy+@a?-L+g9WZTwFOFpaFMuZ9;E$Bby1FrLLPGVr1xHZ0+RT!W{vu1S2nnF9*uqyR}zgeUD=(eMek8Jm1tqrPKv8+sORvP>$t~qp0{?^qs8ePAhTwouNE) z1q3Ze7M29R`6$;thi>1!D=`($<-T?WfAE%rQIqXUfQr8qr@00 z1%E1LI;H$HZO_elPb}>ihn;GFj{dw_y)s8;Yx6Z%F@ePWT}v5kqt9P?J*}gY;-sS^ zEsYpWqA5kYbRKvX$DI~hNw@rUDFcJIl?^nH--=LTh(CtHrTDckda%OFlf@X*4OVXZ z$Hq*oUR8JGox`F)k5yrJGjL@Zaeru{36DAD8>6)UorLqLE{xcxC*CjSS`XJ&oIysc zObqMvPiBp^JPY2FWM9Fyx!YW{aG0uXx~D`s#%&`bE7uU!h_XAMf%>8kj8_%0yYo~u z^9Nh(=6fAMw5H$E9&ST|0*EtI@M*Xfzx&{2c6O;*YfQq@7+6sM}%IFrkvbj z*Lj-e4SDUOEhE%uwAfbuY5iXy~`*_Em!-`-GoskYYw>&6z;*$E+<&8BT zO2Kf1fJ#zo4AIfkvjgQKdPh8Fqm@@pYr+P2~V%bo^xKDBzPK{2xtWbR*gFMbhfwzQMlP;4_jFw zk~wgYIz2b|I7mwy~Dp_NvVYP+Rrz1A*S&;0JirwAOHBrEt z(ttH3A_yq2Q1s57K{=@#1I?+Y#QiB-tCb7^!*gYcTvZwQ7ADfPxpC%-!_6r(O-&8r z`nch9wgJ8$?WLt@P7CA5X{vl;bG#2w#m5ubreD84MR$d{_MEN22SN{E+LqQ(IQN^^ z`7f<)i@J+K=tD~WyEoHy!i}Yv$o2y)b6d79)RIHbr2#DymWTv`3UShKI-hL@MqE%( z-`<@VeY1VXl?U_5l_zdvoj|`lsR3Q0hi32v5JyzTC8U<1m8aS?#}W%`Y`L-QY6|YV zpM2k|p?UDZpYk~=cxy^qOg=`C231s_-xGxn4JfN)esJRKJ^Rk@5uT6FF{)Lrw9#$1 z5Q5_Q=6PqfK*k+J-it=I5#7ChFn!n0oo8bcIqoUN%iEmoY`=Q&3}a1=h){{MQo+sh zE~`swYh6VnHLXb`XV{sBKFYOMg{UEb`X;ft|-#er=@3p zWRqP|mBDdY0EoCqdF86L{5MWr8gABUe@Y|F#BnO#Cw5MERRqouNr3g3W0-W_ktJwr z%|vi{Gn6r|hOnx5!8CP<$4oVx(l0MMK*? zM#ZO3pYFUL-no^m5x+ZhYlT5Oy9qnML#KW#h3?E*vEh&yr*)bieWdDs_99pC%>#;U(5fuwCR-~Z4+`l$l zy>hiJ!KmnRphWD8^X%+e_|0%EP%C50wnm1k{2?=uGdG`<&(|Df2hd5-RgXHJ0mRWFGnKB74zjNG5mkRgT2R!ZP(WNT)93$@YBF9)=u68@#h%fr`bMna7{aT`t-3Jcj%5v1EUX1cBPvAZbYYI(Dd?r zK&tTlo+~KaCpp|c(oUEW8`-8JZGPhRoBX_Eaq34o_SAPbSYiyRqk>UcbA}6O8(&giOhZEm!mUO8slT z1%LOLaB6z`XKyyvT3z00WVP8H-H-x}Y-D+DZn>GpZqLr!z@NGgQC4FP!j_f*qfzZB z>;r!qPnug4-Wwq~uBA;_6`FOXZ!PBH5r#WC9d(+c?{i(1c+GC;rux+1*O%@_>}||L z1dNL)KcRv^2x7uG9~OEKFl$48z@(IR2DGKp z1}#YmiQA(y1O2wA#=^x11^^B9i^E z`ka35!Q>hRa|vI{TTwWDZfQ~pQctyt-l}x-?z$!+_zx;A>|Wuwv-7B!87HYM?~U5= z{Lt)JD?>`W3uu0vc6N{61%qAygSF-PKbIt55wuz`NTl+k1#L}lnmY-?Ug}U3zfxm^ zFG@RTgyjPpYblC_55m(;Ff)MkO~Za+ym(8Ofu8>Fa?LS__u`-a3QvJGT)&$!J;E+< z?*L*2!^sm&u30r-ilYoNCAgW5 z`CP-{kUywZDu98oeOc+yp2KIVV_nz2BO%E$m^u4)bDUMh@rTob&ZhGrKZFgD6{Qak zU{k?enP`lAKHB+ybevP{Xb(O|_bsv2OOATa9(3Ok=krz*Z&YlpH%ha9-T(Magy<^? zkDQXgy#XUfVL{L5$sSOYYX&Ii$EDA+6J-Gk{GI`_5dvYb6qn+@WPsh7fWz`jG#b)b zrSuAnWcBlN<)!Lughv^{KP)yQAJ)=pah(D~rx|N=^f&Iyy|{ksk~8(;4l7;M+02RF zhvr^?>7TqjEU4yi8Do?6ZZ=!m?FQCrJdBLJnhgQz34WbrfOxWuhNaNFydIvAM&;M| zXv3tMm)Dl28w1yPvq{yQGSjx(y%3IWEcO4{oICg$=;nABnyl8?1u3u>r3Tl-IG+kRmV9mz-Ykk zq9&nad)%X{3bt9u8`rhciH=uYDE%|z%|l6IBp%m4!`E>ixOR^X+!x==QDa4ou;@xO zd~K1VTLffbvhF}!TVPU{w56T`*e~75g>e)GwXo9uD9G;Afi(`x1meyqH!KzWb;k5s z)BRP&Jxzv1O_ItPx9@<%Tn{R1O%T&mQuf}i1dZ0j`LRxU!1c*=NXMZ*J>h`Bfp;!(C(0z279SqgfTbQ3G=sa7SbB9+~!xuW1(7FqM z)aAsYu|wCL&Asu=zQBz#dYA;y_V5xlSuyrM;JA!Bsp{cr3n(7oYI2qa!VlsFj=h&$ zTnv`M?6`XA5hYuw_0Nh;`D(VC()dYjMtm8^>2d2JZU)9Tl5pNM9lTX4kgi)skA*#W zi7>HxP0}a1Q?mOIFSh6zx(ZKS9RB5S91Up?rKZ3pgH?pi)hGSwwIX zN#+21m~JI0=9?6?>Zn%=*;NHIG*+f(cwqXC~w zo0*?v!%Cr}@-Z*#hWj^5PE$}2IU{)%eLm6ABb@8xnfbp53$1O&yN-8C1*^jm6tklI zf-Npfu*rVq<|tp28qTT>^+)%fqJKBC_Bbnb(n={p72TC%Dh6nz;LMrSMScf5FLGn- zf##_=UvzPqjmz-VeG?VEK@c&K45(ga)NsjLk9%eA!9vqJWnK50)!urI+_i4^i12Xs z40rccu)g}J1(B-X0v=g3weu?+XpGg%)U%;1Bi$XzAFVSczv^CE@PdBa!@W7h93GYTU z0>IGJ|A5c|`>EK}Y>ug}oLG!gzZy5@zBE?6JaU~?I}V{%G7$nR{vM~l?QU0RcdeE$ zvs=1G8)3iI@b1If3y1YHA|gA;yr|sMPzg`+y9qQ13TEbJuFUB^4yQ%ERXoqC));wa z|9)y~qlSsT#&9m??Xbpj9g*p>8@*bcAdUWxOQp;k^fTY64enqp# z?+_>^);GvJcU}`Wsp4m4p$n|ZDGl6<36w3Ak>&!(`;}*$&mtHYVEy)={H}b5&k7Mx zD4JAoqU&X3$Cw8qNmTgJa$+Q`4q-X1c1c^&tTPDTG4Rxpo)jgm5*tr!6=T!Ww_IOc zrPs#=V_NriKcU(L2ekj-d+y7ZuhIwJG1D(^LmC_f>F4Mu{uIq5zYek&=S<#fU^Zvt z;!>$yAewzsV#{mUg13>0LNx}wMtpHZJ6v##LJGSB!oPLJ+?-gGp=(~hGu;TEel|`{ zS_H&mlyAy{8RlWb{QPXAo=>b#_x$e-=aV;OId4ui9YgarH7Tm(iPtAR`CGiWtv8*Hc>WX^P-sQq4);-^%2lo0~gI zyXt|TFp|_7&(+xETQMsOZD5Vf;HV4$*8laaLt2SGm1Lfx49#2FIXMPc+@tdqQn9KJ zuK51_b?$rBOiV^ltG{z~{r7NvdwU5dD5ROu7&k@+7~a325kMp}(F#No1_*cVJOZT$ zeF73^&;d$@u#`A0PH$MK=YrgF;|8eK&5r@$&;6X%#?s>4SikG7imIw?&}$N+Z_u?* z^v}eKXdp8L$cOB#H9?vD@;#HFfpEYggxKUAI(6NWnYjxB^vxZ6mRA>;iN~vY&Ih~9 zrM{A&boE((>%z^ig$AVSRjV`W<2rs85zl>t>A)DOUYKv{>?GP*Lhp8eZp7w8yiAOc z>mVp3K$7q*O)EmA9ulmxu`j#&N}LG{faxrW8x3dBV1@VlD^U-?4Q1f-bo<==`H^P6 zl{A6!A1Cc@P?jJ!I=cPWH>{PvO6fM!%Q3zUvI>0?YRv8|}`A zA45WjL?8A9X$*a$cn2@=db~3Yz7WK!A~n{zq04||wT-nUPLnnXlTII%Ihi$U&DaH&^};(l5m-9Bvk?YefW(XjUJ*O~EO#SL+Rqg$s=p1f?eXl~k>E{`$3wy+>s zu>8A1{9cm%arXVCn0OSXCYUub&|qNw60ea>Mh?XQ{!mZ1X&-`eBS`9DG3;z7g;l>Z{DtRMOYnap6 z#aP7Ru)8LJH0(bw=t{Q(Rib%*xC&S9je}ItBYGK-e#3`82{R5}cS4tnldv_j$%ykx z*rI$el0DH7L;UdPQY35`F0#vRHR^nHl1__6Qe4dTPnj79sf64Hr`8VFM{{_)gtS;q zIQ^ZZbDaD2Yh3uV)&>JKvi^*z`4uoAtTa-Gw7Q&0I5wxLQk z<4qTOU#ght3Bc|T*l3^PHH&c*ToF`C7jj+xU3(m@)syJxKC3-yN$uTBRBSw43gcX@ zgM;l6LCgtZVu7lCOqX6S&COl|nJ+<;2V;(xb8Dio0C85)+b{`jmpAR`=)lx+bYYnd zc|nR*&5U{6+@li{)=Sgc3baReQqr#OP>~=9D>fsenur&4TS=5_l4TF`0Uu3LC{)7c z=tkE?VPR0O2m_sf)IZ8uwE8#v-ol9i3x(?eB(>m^I}O18&MiY^VwMGGAQzEb1 zhrxyW2ySMg?`bGqOaRmqH35nb0CnekJG(Q@)VwUC>1b&QfbQMqLTCQzUA2k(c2Qr| zKOkz-T-8lb=bC}nK;gGu-YH_$_x2w2v2$wzx_uvU$;5pP$)-Aa^5kt}GlGKtPj9`S zc#mofidrRu@E%9-#6>X1H$NR{XWL>rimRGxI6u$mYf~(dXF`Y>0`5RH{+*2RDjqnk zhVH4v#@CM|J5uM{2mf4q*@q5C3(*XP*Y&YjsR^e$K=4VIaxsOAxVX4@oqd0k5#GE1 zJwHS>(jKuirlWb&A0%gjR@tMOvpg{W{&Z~Yt?YJ^086=HTzU0$tGk??o&P;`I%4=^ zPKwY_|F!LiW+VF>R5)oJ+M`jTWjqE==VY=C^=&SUj4~2_3TA2_^!gv|Fz?C|3m_RI zJxlueSRr_Q?^eQ{goBT+GxCbNhqs#5h1uex$|jXD;qa_)U;)s3to%L4IoXpsQ6Jl{s^urY4FyTV z+PEPO#3F)U6ciZP#X*2`xEO$l$S=H8$;`=7c7B#aA!v6I6Tut9xe>6~bG}0zRY-N> zhCby*2-+sPf|**AvT-B3I4#Mwa$(={1$%PEjgOEx=^4FkO0m#5^%*20N6-$z8n{PC zyHiO?2}icA$WIpX!Dh+%1B-~O0+OGizxVN*|Kb8AJZusq5Z(1WOv4V*n=HT>8=!!A z>gl-;#XjWXlk4U@Yw^1mCX~v+AAxDD#?m1C>X=YR?5(UMJLJ6)1&{@fE}Xm02i8CZ zcQ>=-(Ic{)?D*vP_%;P)0*9Jkn*9vg3?LZDS?_KKF{Re94p(^6^L!p+H8RzmPu7_w zM{Q+GPiY z4gL8x?7n%YM6{}TVr(qauKfah&?^TMr0Hs2-g>^ddD_*LY2Zi1|KkF+}IX&`u5}TU{;m=SbJ*ZIIv+(6W7%(rq@>2)byS*D!XlB04}mn>^E$T4AXFP15x2+Q$$PDPR^=+s^`>VcSpv;(pq0CGhttgn@YBPbpiCJyM;Jx zK#O=p$g*(IB(bm$<8v(nJCP-jL%c<@5aj=mE0W`QE`cb7kO{x_i+fdHUr#%sb7JQ; z+kZ#Pgq~O}v$1vAE{WefgbWoEeosC93V}G~nY$f6ux)Ee(iN^@M~OX>VR+z@Zs}VH zr2>YRqm+{5m1=7|fg|AiY0?9IVR#0SJ@05NV3p8QTYhso40+I^n9L*R-2K$ zSg`mJa>LHjL26 z5-&xHe!^>zJJ9rzLt03LQlTT?`#9hq8(fv)RV*ktZ(!Qzz;NdkuIGdXw1E;5G6v&5 zrvgUqw!S;QV{Iu(1u-&$4(Cilwia$^cn(uTLV^dusG_(+@%3E?TE4U@*&N%) z^niww3`Y%E1;&VwOB!Fm>&r2!i^~lTMjNy%vsdPbO(4NBV~w&jx_g%vC@v#5Sj288 zWK{Oy_1GgEo-LoiM%W7Dn1!36^U@#ba6?Gl2qoe%d;1zUzs=6#r9Yr9gz`OWDOo$x zkR57Oy4D|>Ugka}blfG_-O3}udFnZ-Jg?KpgQE0!7AObmfpD3$We@~hHblh}g$F zHZ0!_DfHd`l)xJwSz*k!OP_MRaDU0%%WKC*^fijuRob+x8!k==6kFVC{k-!%O}{)f~}d0|wxk6rd8pCM_|lXQiW!ovso4-Job zt0{_ye)Vl?`r{?K?O2ts2*_H5)m6}iVQ4A;DoYzNreIt7>Ai@L zjSosn_s!y!sRM>=shElbC+>|*Y7kB`CWr9V+Wq6vbBfAaLcmYj*b+<%1r_JYD2-gse)bnI5XZs!P@eTHl&S58CU zr%xn>?UQ9le12SV?OM;?gGdIr<+}0iO^GdJ5&!0aBg3-=OXmA}W3;ri_h6>!b)0#zHwIN83{pLI_W{5@9g~MdIXv@w&Dc>) znkD~V;Sco^)hpJhG&D5@0VOb10%x`*>E`FhK4-Xn9*I1Y*rd+~&DXsDV;C?+(0Eu( zPMkh{`mB%>t;uec%*#Bx0*W*OPo1K0S$k8&H8X1O52%A)H#%}mhll3i>%;ype)dmv znnZr~79Fk&jz=1(OrXPJSkc%--Kn1J1}mzeA8+{bIzqM?us0Tzm4mzT6W2P~Rtz=i z)u^sqllHh>z0M2NATd0)VS+t8=6DxGQ4cwl=)&SB)i+6r=V)71@XP zlBfm6OD*+^H@{W_zO^Ari4iQ3KsFj@1gZD=lx7|w;>U9KoW>zQfDUi2J;`Z5Pfveh z+w;dOWovUY$;Reg8(T@=TzwTXCVn!d^?v*|WPE8>x5%SRe&dS$h?&o07H7Z9*3CD* z#Itv(`rwZFm7kZ0whiwfkLmI~V$rDZWK89QWBGWH&Bf*Js!@Dk{x@@%%Ff2Wpqu%V zeNiXhTZG|><6kYF{J7q|2kCG-!DM26egdk?7cYDWUH$mMko}22vSxMSmac}gMi7NJ ziuV66ycIHWB=tS@NVsg(1DT#sHh~TO;5=cC%W2y5u;DcKWry#V|Am3=#^=PpwQaPx zvo-+wyOlbglf3#&yHfu)m1qZA>1vjmT%t3z`(#yPv`xrm{p%agx%*2LHF3H8W84P2 z!2^gh=_Hj2%U|rC(mH6W#*)s$e)xA=fK*&H*ZMzGgcwI(uo4+ z9&!|%VAYgt2U_~#SQn?DZ}H&$*DY+evY40^tLQgrvi zm!=j{oQj5)7#NHUpi6*=h_IyFNq6+$&G)$-5YJ$!{%-o=+t;D^i_ObSmI8z8ZfD{_ z!H*?egAI`w?oxHLpOx;|ok4g{q+3~8$!lpv{$eOgX(`M9a?h+KP)p92_{IKDJnyND zZN=-3WrB&C5tYjJ%yUy^*qeqd=L1Ue3%En8FVZ<%P3N+g z+lr|wl?gZbn{hSr_8*J+J#_!@)Ddl-(SD(usr&zE#=o|OjbmMd3bgi2J;pbQH9KS{SeiygV=l}bs{%gVfk>{5NlFB|j9nByIwZOlVJ`_0VmrOSTuJ;>EI!0A6{$`FT4yWCVC9Ew;tSwYTn$!+|8+Ho!9z>kC&eF-Q@qWY9r;vs8d3E znX~2pke1cf?z?tG2tdZQBTxIEf@AwAkbYq3cNHOHmD}?W?QFK*nBs0{Cw9Aa2M<3B zD`WAtSdsmdO8a4a`}!og-ipm7nf<3Pn>3mZ>Xy_z_*iDu&%m`Hcw={&xWZ_e-P30+ zApdZFC8@F@a(8?wDlk_#E>3n%exQ*Kr=WOh^?KvZQg)u@{AsRW1G?7(OlC{SP8f(6 zKXu_~a8}0cml3DS#r>3v!X})E%C@)c6fyf=TlSrQV4DDsu7bm7FWO!hD=H|+fJq%8 z4qA#9MAoBfb%CAj_&r9xTj%we4!mclbJ!T6RH*u9%v+fhCjMN`K=6iKFoM0Y%`<7w zN@z=Aq)b|zVlp?cm!S(wNv=mS(Hp&$fXMFR$LC9;)IZwovD9fzkdq!ER&j^|fs>BS zGh`FnUA%-j#YX9gRdYwj4Ov-PVxnEP0E7USb1P9XF%M)I5|dCuct<}t+lRzNGlT^q zVUx#XkWc2!&p$2faJ9a-_yLvlD@Dc9-tJ!u5%!UM?gv?94_?r?^;URm)3r-JbiYgK zWcE`N(*4Klzdagl)r|~|47jcspts*e(NoCfHGH84z87Q?p8_#5O3vJo$sxIC}1-;xHCLzs$c zok4yi#(ndZwOv?ze0+Ib|K!>&oR3h(qeOt6QEe!5RYt7HeJX+1JXTqylM)>WrTCON zdUv|N%wN022@?KV+mBg>wYP8Io~dKu^%ip6zMOG!^4H4yNnsnWG4GC{raMRe96hQ* z!AWs!==xYyf6>~@?xnK{)L~_khPRk>BvESHU zy2Sm5??vY?4}ljO&*PIWWxH&!?$Y_7=K&)UT#H07E1pAwrFPLvdCdsN11BV+ya*z- z(1!8!XjmPsTl`I@p~f9Qw}dsfwUU4MJ^a3NTM(;`k4|H4p=KYv4JBn{>RSpSJ*>*R z;VTo>ns0CA75@6?)KFjo+pw6LxHuy1cMjyovfBRl_#Bcud`}a>w%k95ev99P9md#O z4i;4(8U=+M^X?GSygVY2D?Bgn!Rc>lb{2=k#9K?u)CzrLCGL<`U2)u`5Q-KQc5^-R z5VlR1JL35daKiqY`d$cE!bl|!C(9n-#SiZ1omDIfNv`SI$ zd+asLqF!uEwWBCE(X6=gb@<6FHqOV%L%;9anm)U>UGRctaAn^}75}MW1ODqGr{2Eh zzs$4)hxD1V)6vU@`$Yrumro{OayZOmO2PuwRF*zzS+$K_! zCP#_apCR?| zV__o#YLJ#-F&IbHEDwQ$_d_NnLZ*E7$!^Igzn+Du^`Sq{DS~Si;uQ#m@@ z`tkKV3&9Exi>JXJfx+dEj+oYnJccq9wqyS*Y_eRoHg9d~LguZlhY;nJ{O-cH{RW_I zK&mfIh>_sZ@+w}OuY}s z^Vx-Z<^i)Edq{4N&yS_*WIxkMOH)juF(6jzSjNZ42Oh)9@I1t{x|D&;YOEMwOBvss z_3`iOI7{KH7ziW=!e+7!KQ0*T}H>$sgJCdW!rE47DLlbM1fgwoU}Q zadJqWu(7pu1j?^fbp$H06aRPQn86uDn6FM>AJ%mL>C;8Z>T8q=K+_ek)?fM^1m@JA zw^!%K=>osw25d`F0d@K*73_nUutqW%nb)<7c;MKCM5Uh(x9^mTcxJXVEyX3RP+b6D z{dcM<|6T1oD|k~$DIOr@728q5FUei~HLuh96pW)%vBv$SlZP-xMOnevjfxOLp{aHtp{#|XPd)42 zc`;d;EXwYV%4aOyc{S&x2h?&oE|Oq#fh3*_wikFSkJ#HAHAXk!ixJz-{ajH&A-159 z7uh63z#}I~4(OLx`d+c0_QB`DC`^1kAYso`WPRahW5bEusd+l$qVN0I*hiADs9%#Y zeL)b<$+6*z0FMLBot;~Q1#NB0(E_fu@#6l39t8LjVf_d8C+Yo}b8Pm15|^X_z)4>^ z85SPy=BS%`a@T&cR|+-CRiJ;%SlKI6khcIE#@T-N0G!a&~$?&gjfPw?7W5>=S-4+s-GxO*JM zUzXBPH*oHOY58S~Rhz_JdpLgdZ+UmZ-cjhHAP2Wx%)!=eO+u{=)7dPx`E5N z!1>Qv&|(j7Lng0ogV3t7XcnW!QEf`f<^tkYe)jKH-W$ZE9sWr&@FbfPCpKuIHJ6tD zDuNCjclazZE|E|QMfyhY5Pt2T31pL{1J$Rcqr1OSd;EgRx^2D{c@{n1otYF3iTl^oiuYeN|J_Wu@N}qocPCO+14WhIw?|*A}NjcfEC9g7wM(m|S0b zO6nk}kdT(9fyfOm^(_tU$GrpS2>ZJ@14*e6#z$#sX%|^l@Sd8y5F13L`ET2ko}OeF zlxP>(GZ1$CHf|F5p3k2>t98Zt*{@#)sTWlA;C40EAjc68m*>}E;SYdK@ETnBW%Jzs z3{KRm-3#NAQBr>Tif{L7^V=J>1TkswZNb;E$9?8%rN+Ln+24y(HVAyfj@y0CmXeaP z$Zop6QF!YYOn{@1q3kqy5*U@S>CGdv?B7Z2f7Eymj*Q6cC#knf-6HO-;o6XjOvz(} z&MoNSwvKe|I&?^SuveO@3nh$qH(l4_($f6!hOCvBpW<`5qGDm*#Bupk)7Ph6hYrn; z;wq{M{88Y@0Rb#=xY)m`;q#LMbHXp%gyv(^Gi{h)uwUu^*C3^}<|PDgM;w1{3*6W^ zH8w2fdn=b9q$Lh1e^3-diL&Y{vA=|@0zw6;m=r+cdzLo<5bUx0Gq<08L&sxKnW{l# z93CKNeHoP6BQ~K+P(2E9^b9Yuj6q-Kucu$;Z2tN2t}#T6{pl~Oa{YOgXty(u(w*e6 zJR=X??t?=piOaIDKYnx@UMa3>C@onYAeY3%21 z2O0IAd5`)y=Yv!{GI(wjlQjG%DJyFT3bi`O2yh*m1!+Ddo+g|kj{mW;kB`rlGpB0u zWFv^LoUShD&f8FOD2}&AX7_w4XXD_i=QPXq(qQ#AxAoH!Q!;6#|4$9#+Vq`@3mr~2~PmRv=!Zp(yGQswB=|2cQTf*KewB@ zXZIk^%>OL!czP7Qm{*1oRyv|$_tzRJYt?VD-x>T$qW#2hF<pi&rQ%%fw$G||_Rsp9H=u+VC6gtgPyFYz;Z?*o^#oCYr>wHTs zXqH=fWg;&>f?n(XTn9^-mXeXnIDb&{NITZf-`kR}5sF%HMK-!}30qSf8oI?k!9(IV z2J!PHCMKQ{wDWm%_H0o4&Fxd`D=F}U&~~1`jn}bwX>tJS&c7cyaaht{*y~(FXf88W zh}2-Az#j*1ed3R{AQOCRF|1?MH>shT=-ir#q!#mf2?(fcYxDh^iyo1;F-+om z`rDhBf4ve+t>%v=tyYWlMRpr}TvKq+dr!`yne%fI+)2wx^_<*Xx@zTRQY1iN9G&S5 zW=5;a2I`mjMB4!L#oI81M8Bx6o~LeRz%WcW&>R!@%eZvW$30pw9`5fsCjCN69Nyua zmOiq+6f!e&fy0J|)k)ON2To1iBMdrZH8qL*2OS9Y;?$6a`9*)Y994CEu(^N#8mb>i zs4Zv|yuu>_%Wj?@Z~NdKQOtkf1j`^6D|-1{*N*)9$1TG{866+bf-aO`qT+RUE630Z zul^R{`uWkmsJ@L=g}T1z>f~grv$}8Z-FZm0*nPxJ7*93UQ{9yQnEnladYjI)`BStA zfJ2LOBf+%&GCSulSnq@5;eliUiO7^04#Y{2Jg^?Bh31o+JMqE7_|9E>tWko&!;=%- z^ZZY=CQS4fJv{Csgc$CqlDuYS>+2gJ_g6Q4--Ly4cg7+3Dq{d$xUqDUGE* zZkSeBPGfu_e*DI0ftm>NO9ePw-pHN!+!y`)Fcmwl*2(d9k#CcJK*RfYKm0{U=- zD^h6y>s%-1^CM5K9%SSj!{%&$yz^33V@3_29|(Mj!hs^rdADWf^W6taFPs2j=1pwu zXOYKL?Zp7*Z*yh~Zazji&{TDjvj8yek8NJ2sPSGV%l$ZV@M=a9Oey|(fGwqM|JVu}4I-zO_$@--j!69`U&OUfm0Biz>tI7V;Hhkmy zdPX<)Aes-!-WU%!v>qM<4DoNhe&p$&{WEj%w;%n7ks^>U*qk6Eod+1YFepZBIaD$w zP&NTu0bhAJjiUmbyy>T~wDHr_(_AiBVBHc2<|@&o1<(B+Ys-vpGuii}4MQv|5)jsL zU&8AUH|;6b#DXjQbDhI=Ii^1Xz)J?}qBv%gfAY^nUEWl;`vfJ^983jqu;-_GBX~KC zkK(erFCX(@_{*+!dYN-bX(!Cfik%jkm~K8C=Q0~)vte{k)%`}e@XP4};sn_pH~$xV zB9H(T?YjMx-aqVvm2U2$Mn)=QDbGg7jYV=+PM;pI^Ao6_YOQeSDPE*=s*Om9T+@p$AMA zrbV9JwlaQhlBtJ5*Wv`7G;z*9R{4B(Z=r>t=&{@8`We{Uqdi8~$WF#EEhfMbY8hmm zcinD%&Ppq!vAe|ha1_67z(rcRx{^~PW+9@^*MPEbJ@wtvs@f;g8&&6=cn#S z=lXwK00su49^vBq`>STIJ@c5WD^Z8hV8z;fxD{5E)(?K}q5mUvjUj8*F;KtC-x{7< z+?IXy1^&`Y7wbZ+5^o$dH*I^P(^~{PPvyAOUDsZQ|F5SN<}x3>iSIcs-upoFp2KnA zr`Srd&!(tzqTE8iUeV{ec9~U`1jro@CJmQ`1q^OiMhb~>sNf!{s-@>m_0pOeCIKH; z(PnBfcCG5w^q?RzjO~dTnfF8VUH*Q{Hoj|W8u$Kdwgt)lQ-;eT;|u_If5DC_j_MT& zyb^Ct{Tw@b zcXRK)SfHA^XN;kl1GbDqcK+|DM>4uyf9lZ+Uz7@Yi;$&lIH1qKWq3>OM-;bzV&t5+ zxQaQgZN4Vn@HH>f#QVrEab=USyvU(Zy#wDY46J;!>kYe;&(Jcb>}K=nvhwB4t;%1HW|1cUa&6 zHEoDa2|yWOJ%_a-9We4uUiSeeYgk=q#ek*kCLmLO?6uKcCDG&F=+dlzPg zkFIMWPrr&{y)6#>0Sb<_t)Zt+=YN+LY%ROox6&5ABYa@c`&~(4Nv$3&h*ALP>{XN0V zDz*0n_BcDUM)Hcl@FEj(F<3XYR#Xgo>$|wRFdADlfOvcN`&`JefGRfxpE?cJBimswaYwD#F7JToHo}*%Cd-h@$eZNk%PEJfm*8-~=FZ_1)mCi5 z9KI2uzOAL%d>wB{E9vNVJ^Xw8!Zs==Ylv)O-^V{mOJgmx{!I_l{$DLEQtnzAw?7~L zHe4$m`Eb5k zdJC1X)BKAG_lr-;b*6s6-kuO0edgI%4G=;sGnFiB@$353LL zmzrZnj{$2@R8(p$<7Q{q%P8i5(%W0;IB~)~RkI3T-N`=_-iQ;%ETjZ8FDNJp3kG;F z!yQNKK@AHl>!GFdA}5hs3T9oSYHD>d(;FwrD>DN6F(n5DRE6~M1s^1L|=rT5oVVjq$}YUf;Q8j znRoBcrYn+pZ>p$Nypxc+OgAeeRzDCx%4T*om>y8iD>zoolOc{q~+AqNR>6`xz z*$8&zI-qLRx2QjU@IA|xnXpPFmtW z*Bt?xjP>-oV`DUb71V=a+^&4~dU`k2)RORt#ysKyKcfNFH#ZOk+b=t~8@XLdxxbkq4XL=`X7b_>08G|>4D#9PmB`R=Lp2e#m3J06^jNi@Gz)f=4Ss= zT|Mgkn`kwWx;8$(G~?1f{I|b=pCQnBW(Xj#_0i&)2Ls zYIa8>^br{WmGCHlaotWxuEzsrhDz!hAbl)fpP}YNS8V(3y%%1}&Y6#KNl6#8%iKC+ zS5}jg)8q_PJHotTT789MeMMsfRI0n?BYW^iLd2!B0s=N%Iy<@u15H@QUaGCn*?!EKg))eb2U51D>m>wd| z*T3$CBoS?~XV0GHq9U8`Q+>Oka3G3Lpgkk5uDylMd7?b>PlGcD3a_i=vS@~e(h0ja zRC;we-g?(i3Dy$AM71Bn`3UaYI@3EMl}@1ysIC5T=5 zunxjs&?h|K$It|ePHiNx0O5Oi%}Noi0QDDs;>g!YQ$gc+hEezwztD5)n#U$* z{hy(|vHkqzB2wv2f?kk>5G4XlE-Q7}!esoK*l(zI_$y zZTH%&1`diDkP#W^8nQbO7gcYsAX$hu;==2bdSieX1#f;NObuYv8KRY~pJUc}C`}_T z>D=ZmshzZBpGE$67xTe(+aIlq%z-e5;aFKcy|r|AA>SZmd;c13-RPb}3zP_{51CR- z)HE;gGjWk!5q5~TPgU*nU(|1oI8%ceM-J?D-KTZJ>$E&!eyiHsE7ZBB>MjTb*Qli_ z94OA`?>|~_k>e^bfms@HekI)by}ORcGK7i{wS+hFkQ#U`BtL-tRgE?O9Gf<|h0ENa zGTC9$v@LNbvMdszZVf*?0P*Y=d`Mlz=FyhuzI=BvOksb{Ev7tv{J1hKm3-I)3lDAB z&&A&tQ_gK}i54OKp4e|c^D$ua7E#_)OYSp#$TR#mZ#y3f2qx!d^P%IKneSzJc#O%m zlA={Z8}6{FIEwlD5sE%cpOx5VnG@nc8L#VqFUK}pW;F4&q4z^-)h%UZOr)4!+k7=b zfuuhlLG3<;on<-rHaxsDh451O-V_^P6)g-1*^3Y*lvxezu9=NIwYkxE-&tBlKfP#S z+ZLUtAyyviq`*qAywh8nP{z_pO3pJ0J+(DzR4vshP^dd~LUZau+{>GKS6mj27oN~H z>AoVoJ9%%tyQ@$~^Hm-}?TUL8SJzB{i@s|L558PvdsMGv;d(tK&#zIQr{mA%!%k|X zEm}zyowoS!Bwl+kb?){*DBye{E$5Zz5Z-m<8_A;rHyr|zgVV?-cb`uv5@b1d?ZOsh z3wDBkMQ?YO9~ujVFK+VCQJaC_3Zu<$?_$Jk>17V1vgu_y+yV#ZBqdgvM;J7wr*paC z+oF=&gh1Hu7!Nl^OT^yH%E}<$c^#R;_}nG$9565yG2R3cD@02b_h^1A9pQUmrSrPw z7hgAUXa)(J`}jKm`%lXAtH^6#Ca^wXhe_44D`%yh{!ZYr@F_(sIEmA-Ki>ueBX-9h zgL1ciN)=lE*`hyuq`$zfK|MqA!8Vl_cP0HN-Pr4gGj#=b?Aiq|86g8#Ss)JilxkTtbuH4&jClNGfS)4We z);l{wG?V`uhI|q?+#&qu7ZvTnrJ6ZH-Yb2H@+MqJ(yjI1YrQ-N>J#qy)$5|MHX|H* zWv>1!WqbB9)4^l-AwZ(ya1ZkNEdFdic60FUpPC;Q ze}`b`^Z4#e^)eI$H-qn!YG&~m^CS$%OQ+-FGKSv-hQPd+ODoIz@D1!emCv7-R+jnT zJVrRUM8jXQ_Ou{>LRdN%OaN@(>pV@;NY_F#-MGT<*ya70>aDuD&F{r*zY#yLf*Q$5QedW@6n1TLrx%5U8 z&}w;**?@`yn5?A;&`?pi4&D@?s0$Y_ZcUd9A)J6QvcbdxxZy3#{0gmxPX=^tr9;hs z0~ngNxzO5)wUvb$Tx=LP8gsQ^9?OAzskka{=h`NZ=La+dn-F?{ zM^wjz+?Ml!23A^wEQdEk7EbV|B0{*r`K_<|ue?a%z8H_P01d3vfv~3E#!G=%hCrhN z`#K6@ftDBpfPFGI+d!4~9`cr=TeI<|I? ze+CT#>=-!EwWuX4?HiUkd#TQUsQp8WH?%ru&YaoJDEth>O8Mx}BdePKu9l~%c=~+C z^QLze#xH=Nh1YU@VqzkZqhfvm-FMjIW(zo9;6ns>erH|mI*jm zfg1Ai>+26PI`$h{;`~MgI!H7(!fP@x>;$l9@G8Zm@C$*)_G_dIx%^;25K4oMM+T+% zB^8y5&d%Vrwo8Rp1JYm$^c7fy{e3$Kt@!(PB2V39Ky_rN?!j#I=Tw<6i)Ue`ZlmSv zP#B>QBN(p(J_yhz8qxJ&b{Zz8?6w?!`S7p^&`yunw6^7$v>rTVN|_-2Cv3eKEJF0Z;h#oRXe9zF!_X^Lq5d%{?3%K3r(q*zK+Lc% z(~KgX@A^oG0F#7-b|RZ>b$dIp3EQ&tM05(wYu?@467psEg5*;7KeXhCow>Pr#;%>8 zv4hVhO9b-K`Vgap-WV}H-P+Ae##H-2J>rs=53gzBc)h;X-VzxGP@bGgBtcb8t?%}y zyB#M5kfg{$+Ii^b-ua*J>f27ORo!-U_|fH);Jw!dfmRHMPJfymsT9za{Fd#24VJhI8BvHQW=T3uV+5py;eDM(%cu~Z1_{e)8R^h+&e zEHVoFQF`T`RAk}V*4`0zXY(l-xTiHn?;o$+>DWfwn zPuEZw(LHMgMP8>lphmsKmW zHCmV%<^dR+gp(~qgY|n$bnV^EdP24=LC>BUDn$uBNiosS$nd3Pm{L{^S`t)wD)E=z zMEN!O`h#sxe*cO$i4~U^T-Tv{nVw1#59TnO)a@l*m4vI27vW{!cv#p zo2d`OYeI86K2C~8h_<<@tPTqR55uMUK;V3d243WR0s8-NyZ}@sDA$k7-x#I>$%7EJ zz$=cANv%EtqzW`&vM1%6#eu$5VmP0y5FIgn8KyZ32L=5>FUdiZYFV>9zn#o^U!CU@ zWQklGE_0io=-wqGBZGBRK4B3WypQMRJwHXpP5p(_Qjup`-W2V*QR92Ua_~)9lKkkG zPnYh|3uc)J83W1$UH_R{ZDsbq?v||R7wp@C?%Lbi1iDIB2bjXvLWiZ;W{!;rULIG? z+fKn`3xxvdu@vTm3OjdPLjk<%HuBKW*)@P~@z{UkCe+Ol{NA^B?sW2F;C#&sR^8=1 z^L@t}>^%T<7_g0oiN8m(tFC>W-m}bzVP{KnB6SVGdv*a4c zc`NN#`RdZqWeSGpnb9pVbv2ux>XRNfl!Ia@02N*3_vT34uSYrRA%Gr9RFXH&&$o4( z`;%*QLc7eB2F5_|I`fntmdCEGmG%}pM02arx^MZ*GCEREWcPYxAX<54k&gFHe%H8b zSeKa3`43r1_X`RXT()17zNqr*nk3NwFzu!cf`|jM?y1@V-44<9NnE5+A|6-GR;Vhx zza*(&j5leG;l(f7IZ_+Qqc2_*Ac$=TpqwbXL1S-A(cQSmU^g#J4R}KZi?cgP>01f*HtS@_w*!=S za{{T{?)+BmeXcY;K(p_#(pZ*WzIo5y)}t4m?`LR&JYZkwgP#Q$uy6jNZ#c` zmL8jfoUMt`@9S*CN%Bm~j??`Ge&PIEZrO}CRQps|4i)?F}07W8k#L#_gCECyUE{p(V(zEY}9 zY{GDCBQEpcygY>wxuJkDJ0i&&y8I`H_@yV*JEp;WL%GU%k!so{QRk-P$als4C$B1e z`r0rqLGP=YX|4ea$oIIcF7KnhuTy)Fc=4$e`tQvFH+qMpcT)Q5zeB)bOB=t}cTggBnXqWPHX?wpTs;9sIWZg=h$e z%Avd4DSm858UzSbSJ4Lpd5>Xl}14PQBT`6aLck z*&B7Lz<;BJ9fDlhb2frjH(`LK#A}eZe*^Dt|+a(w^CG8 z#_txiUay(xeteHYzK!hjKPoFFtu#mp5}MiH*B@*rlyK242NI7{!>1tEtZ{!hkHAV- zz)QqQ@%cqE61r{cnU7A+E+*+d8QfROY`xf(V=iHBkmi=?IDMrsQ~cb@D6)fmxBA$d z4UHF=L{0TQ2u)@~2fU;l!)+#Bo<5E&jGCIQ!1cWRC%fXdh&cX$)r=(DEZY+%WgN#h z5HwTsxamYDxTNTx7+%QjqX!oLwbsu<=&S(S$shWuYC%Q24zz5#lw+W=2{+{BV*9<3 zg4s#hd4oNR;N(d~6Q+%ou_8lY* z7U6?*4Iq@8p)XY!k!BQ5JiYcv9K(r&KdP%Ka~(4iouwE=Wo_*2028t{kCLr-vGzBi+$hR&qEtH_{8yG7;go2?>_3}1#yZs(hSdspQRg$K#_q`tVa zy*-&9{p%Mx1reK^oSiADa=@Bed6Bs`w`UvF!WXL^c5|rJQg8Q`{-vZ{ANRlI{038y zH@|0;1+}!ke0g?bQU_}j4?HpJ!GosT0mArRxUl*BIClZh-c2w3Y?g+tK9SQ((@RE* zV~v~n(yBtdA_fb9o!I`Ya9K9R61{`ZF&SVib#ang8XR3#7`JZS-kD*h2HI}I&zw16 zLvzWBMulG$(A8xB)2jlFxw0{ty*rjGH1Zqw!-ut&1N#xGa`c2w*Jo@`4AHLxxV_A_ zIQ&t&CrhugCh2T#?Zq8?uSU5yW$EccoBp5pJbkh2A5ju%!^66}hvyv-%)1oyc2ZJP z-Zj+zuSiB+m=ifZ_h>w|CGEi^%;munTm9{Q<1afFsT#Rpv7BTv`_^mr# z3ki06A`b}|9@5f8Mry>mq#`*MsT7$1FWlWowXM4q_w4c7f01qbHVg{(fU`?`##ow2 zvV@@h)<(q^Sj()*3npvqCm=BJqIZW~+uzQv#3=lVpPPu!e9sbt;>c_FZXhd9(4mrXvDl&H<&`2~L1^{$uq)YCPCA0KG_GBa}#dq=>cpSb7- zhg@Dc&2pP}z4XFF%PlT-6WjlB0ahI2wX*jPzOjj3{j=+p{W!zIk3Av3B<{VCqAk($ zf>7d!E2e@ci3#_e=7@~T1#;JQxjX{!zj@IcE@jdhO|TR4E!)p0+bBni1FZp9MkC1V ziZ+Bb#&G{$LV8ML_dc<$JR?GG-*;n@+@%qp{Bby;K3r;rg5eXY^{K%!y`v*Wnmk%s zP%ys3xMyrIlODvg7r5RXbjma6@{CnrV@8TB5wz+cm>Z4=$^>67mr+?yFB&!syf-V! z43LqwZ@)B#wjOt`MqR!cdJGLvj??U&+9$IwZpg^&KY2xdq&C;BJR}4oC=4@OpK;oC z#;T$JYR?fcHm+&!>RSHpEFWrlgxP@N&#&=oH`KhL(CNs~);)CE)E9#l_}A7pWe6QQ z6w&okh5oKu%1xW4pOR@>*vJ++} zRk;NR5IYP^u^QvJ@LDnVFJveV8ldG+7=@+p4-q6b6I#2lCH%+*s0bbiZPlZHeKH< zn}jBVg{k%}IPuN<`@ftukb3CYPutjRdlJwUs>Q|^lE=n|27DyeFQ0Uf8&1s1Qo?f5 zAGEZZ=Fmu+y1h#(w#B0B_=AZ^P~F{#*7O7VAn}<6l;$F?w_1{ zlbaY9C;6`0rwK(edRk8VDbVd0+5>jbYOx5zWd+R*D-ZdqLTRys&8ycbce>M7i*9Tm zVN-Z2oTT4@ICWlb^+yX<19H*i*lv`CCKPZh3?;qAg~#7j^#BdREbdF>C#-bZRomu8 zS@*uOAtP%tz;0=Z5d#UCOfvO<-6|&*mnI^ufI9G%jy&OZGp9~{IrQ$ZsB1k&i$-N# zyFV>81j`Meyg~7%mSw5!>gu-dj4>z?h*?TnKK5NJqe7hQ`Vo)KXh{9sIe8VtMwzsXeO7RHyITFo@s@vuIa?s zBmHxmK+;|NJZn(YmmR13x{O;V-yfERd?rc|E$z79@efXvw1skoAnU>HLtZ_oXBm}u4+%HDBqvH2~0%PZCM>XNrm_QD=1h&-->|Fh0CxB*eamD`{=~T z>3B+LRal4=4thcB(0oZ7V<>q)^(O9gS)8sK?m6&xh`#=|%WRDg?Exz!4}Ucu|GAFo z_rz=Sho3y#+1`E~VhVyn4|@rKtz|BRKa(tpM8)spPNf)GXuQ5Epb+`J@k>o!qLK{d z|CN?ktb2H(CtU`Pbw3Y@ zXdWH$ViJ`FN{n+yv)-vMDK(X(y6sM~Vciq$yjR@%;xbbU3qE)cB2|?bo}WwKf5LPq zixCX{fG)FdPB?GTh>@@dpG}xlr(W2O;+?P!H{5Uc^Mxc~?ihMPhj50w`LXzS^9a#) zJz{R>Nz~3e(-ct< zVEeIS-#!Gqgl?QKfJ+%8gB?Q!@<;RPks)P#(?%^&-( z?U`MmDeRuU_H-uP@ZM`nf8i>~f}gG#vJkFqttWJsR%-VQdhZSt&SW@YTDx2L_Jk*9 zk6o#*l0a<0sCnfua3;K#k=ODdEP0Ya$s>rR@QZVEXqp>sRZ&yBfX+Vo#;%UZ-W-wj zb$&WtgG~d4oC~-2N?tPl*UfT-q-msmg4ZKn0JIs(*GG=q7WMhJwau45X~gV+8U+1T zDySzLhg$={sV6Lgiu|bdG5UpuYWgqF;Ma1#?&AdjYx42_R;S&EJPDmj?b8(aHFXxL zvDf-D1waO4IrJtFty<2tz{}!6`%+q?J_FUPdX_I3f(bZ7=&WTG#(-bGOep~J>dMxd ziBy~)x%w8#I?C7O1Gm;pd@N-esoT!ybW7QBI>?GjmD2Y3zrOQX%S)-N5gG86jx)*NSI&(#U4NCruHwCy6s_Y=1IA5otskd;RutZY z8c56Qe@0_x7WTeRBWN~s`z~U{M}(+jp1<_vH`dbQB;)co;%=e`c`LUIzCJlMTrN+X zrMCZj{*1U{&TD3UMKG4aUiGFk1-{3rK{$H?U$%~X5>0rWII2x-Gc zAL72^Zc#qI{X7oB_m6P??**vl#9t)%X-Fs~lnOsal6VAz=Y+s$LB?+A7035P882Xa zSt7o5ANS>_R53A2OUu8042gu-y8rsRGc5Z`gNkChr2EBqSbPJ!S6XBceLO}p!+Yb+ zdXIj_#+!@F^Qmf_y2-miftTf3Czm*5w_ur(nej5^>qT|!T8Nf$J;uO72Vvr($oxG2SlG813^pU|4}St#~pw6J3$Nc(Ty*L1RO zaGJBV;|UZs8=rMYpE~h+?!<-d6l}lOh-4wI&Ntit4jWSlP|lCb`qy!4;7#F#9;&Hb z<$KP)Oxe$syK$wvtU6)gq16nK&=fBlrP|fmr9lQ9G|#&saXLQMN_oEF2q%wyjsj+o;;7VtfH&)m0C?9v>KiVgXB$!PkEq%7)?gL{eU=dg>vRYe$Ht6KB0wqjotb z#ML{>qh0^}BIwPUUY@Tm)($XvDB+sJh}#!^)RjZ>u_7La0R?AppD;SC+Ya_E>FAa% zMEYaib7HaIOr>+>rfzV$od?j`W~rVE%(3I0Z&W*=NF-`#<(R0e=f?Vr_%n6#U*L^` zEg%;aXIl)intT|KNp87^e{X3zoNIthy5=w_XhO;GA}#HGYG(>Eiy1rbKe$KH*i24$ zu-;Wv(wUe(o3=9nPC1~}v%tdY<00WW{P=%|e>M&VjGG94I$?Y*na6$ce=(g zusQew+;H?jO1>!Hv>WvbJ1`F<=I{i6uL9``?5_(CmVX;PjW%ew!PcJkloG!<^-5|G zAR#LP!Rh?Kc8Y^zt;h>JE0E!kFUZoQ;Ord0qzu`T&9e)~+??CGx`^4ot+s6_`VK;e zg$w-P)Q=Y8t{Z#{(bH~_c=?!=FWq#WGtV<_-uq*yr0VI>(oPflU6nKcV`ea1$8&p@ z`|3qxdioW2Z8f~W3+?T;+UDDse5KB24z~m#duTrl;xLRd6w!2&A_J@Q6^FL!ws6kS zcome8IZKmJVNETG~rH&v^Uxy`H=d z6J&qa6V<=june@OH>M}L;nc5lvf1>TSnwEhRQQnn@DP0eDiw1cU{J&XqZx&7VE0v( z|LK}SJcbU0g+7A(8n~1BY@j9r1MbO2#_TP;6uPh9r9l`Vq_g%7oOC?a);a~Ifg=$^ zJ^2OSsvClB`-)oH+9(g0nA|sMHURUS3kKm}n8Fe$Jb?A zvC;ldmBEkz5h>`^*QSOz9#^;Xz&Q_LnL*9y4_vukszLSN;U*r|wl}u6%>}glwa@o1o_UgLb;Ls?a zdDkXUF^X|vhNJl{=Xy5pIO<86N+b-e_mxH>!`p7*E6J~UvE8wxk5^e4!s@%>;o-GC zWjJskk_D4hbHrk@|A|>AhdvS@bbn`EDU~~SZqpw6({1PN`$4B8J0~S2RV>ldZ7u*( z-gVXev8{xn2AZR$gIZdSWlWCNz+oO1SfpyE?=QFhs4(i!=)jQl<7Kyb?Gt*LMeA}R z3b=SLd-v4T)UD%J4$jc9W32kDwuc9BG8z>_Xh8@kAx02lL=TAxI{myYC7oQ(oOex< z9lEI?VTVItc*fnUmoiW7KIQb&6y(r5!!w3#K`hkgcf{QeU0a|xI<9`L>5WZOw3zNO z3-gj7*@3x7eP5b7X?`&au;UZhHXM~$lR}i=tHQz$HqVM@ zdkU?t6x|82(k&bles($?gM*I{*etHh6y&ZeUwGK|eKPw`mJCIgxq!#aAPI(^1-W5u zWqKv+@hVjhzqW?)=uP$xd@$O$x1%L$mY_=Nob^2K+K&P6SZ_`Vi%-5nkkt7dN9X+u z3a}Rq@6on9ta4s$Xz&)Nc950Fh9cs{ zRDWlPw;sDsMvDJ=%hJ-aqu>M9MC#?Z`ybhwR1+-2`CJE*b|uvMe@jd;S^W)SYVPdf zFda%)`2##3u6q_EJ*)=#nRLD79>v3_CRLjc2|O3^DEsii`eO#2lGm;gC`TcbApRSR z&-@_l)J;ETXczYorkD;GkLIBJT$sYLH9I04sA};cv(sTm-+lOD;LU|aoH46>ac|3b zUx^?>dB?9RM~3``bpSXLmhB@J7d|Lc@2iiEy|=b9BJ3^-tp=z2NnzoLV|D)Hw}a}d z$?mqbwb^GE*!7$&YuctEWs_W7WHZ~ry53)SVqM3d;VdDrK{&$~NHm3?C<&s*Q#^O= z$PF344hIg5&!qRDg}HDEk>($?IB0j%^LgSDY=`{x?c36`qaz6+rJn8$nCA=>T7E`L z^u~DhgI=H;DM%K(>|+G4)gety&H3qJi6IL!ev~^ zKb@fQZsjfiT`s!g;2Vo+DZ};a*Wsh6^*GQ>tI{!V-f3#G5x4%IUypfCQ-xmTcq$K)u^oCL$rfOM*CM@?Mn_@Z0hXoD zpC9~K<|5O{rkJl~`Z}ra~x3xRQt>IN47VTO+>*ZKTES{9-t?B6L^K6EM0cS=3 zpfSNP6Yf zRr`b2Yj^D2dHp+2`KgL-fihvmVT~+xQu>Jpko%Cm+Zb1iPl)IEGSvj>a(-cKo5T%i zzj&A&=1;as9y?KS-f;iFue$hQpU|OYkk@*(3RETu^bXGeJa^*7JyDLZd{fc*r_c>*OmhK^O9S(8$=!3F0rv} z5kKixz7Ye@WM0GGQ;ZiwZH!k}`Okd#Fh4$|+Y@K{M7}+Ku-HM~Vsg0HjUG;Q!nddD zqyEg%t&Rk6BlHN+u(_3ToCiVxeRMLvi=2qgXZJiQ`)_%x9S_OSEsa3u%X{NP#_3F| zo}0;LXrO9gaL?S*qN6P#!s@fBY_k2qTYrDVhmHg!p#)5-jxvsFu)Ptk<6y==?& zOUFa*=xc;%p0)jYEiIBhZ?x(2cxTFN55iz@!Wh?O=}oOI>N85e)GJetd3CLwc`!wx z0*sWN&!!5z2M$2sS)f^A^X>gU1WdIkU+}ga`+5ENGakZL8#=>|_wMHO6l4qZK=?w68hqZseFfHgWxu##RmBJw9BRUB{ha&O5*v!zoGQj=ktYf z)T!#nVezT`){x{XBCATo$KilHb>>XVyRrPLrY3GZQv8t1Lff0`7i_;brB=M0Z+xv+ ze5tyRPVn}kR8M0lXVp{52TL~fPq}rE@;Se!#jjL?h|8YQS9+hF&1M5G_x#U*sR{2c z&?7rA4sh2kekNY(!jF+~<`nz97MvWl^K4nOz>~oO3An0X;x1Ox_^hIJIJT&K{k=!Y z?L5PFX2Q)@@Y*JXHgxM)9uM(_$ZU48CHn21HDQg`{oI!}ZFgA-$g0!0`Zz=W?~RlD zq=ixBS96d4oE2cv!#5dZGBquXOn*Z(!9k=-^lWv4cEf#rz3(_$t?%jCgfyLoO;K(k z<^lY+eKh$WSqaK32N5j0(=YY)?KY1eO;T-8prFvq(5Y#r(0Mip(+qCWsEg%m$q8fm zqtM%CXutL!|M5fT&vLRnVUzLxz1$>;`EKmP-JchmBmW>E6GeE#y$9P1a#Py$Au{`x z5_e&|x4USQs{Q44MMo^)12MI*@+KTQ>&9qRWdR% zRM)1yY~8hF^X{%x4?zDH-HD;~41Z5WW_fMIM-l@1rI#wHca(HPr1}-8^vqRuWULYAfC#)P`>e$L88iPcTjEwz(K;Y0S*8~?-6U-@xe+|{6Fzg1gZ z?V4-A{-dB(<9DKi(v2w3%q88zo8M9bj}?4~;o+koQSUtJS+B}{;slYH*{GR8DAqaM zmFP+F*cf=gsRb;7t$*g89oHrdNQhtDou%=ZN2gH1HnggJqz+Xh;qWc|NMWvnKX~j- z*a2Ac_ht2SpXC=5U2+*!0tF#_Y?;DsC8)FaIiTxF4!-6U>tS(RHO)NyCdBWx;nY#* z3Xy^|fekfx$4t2+7cDsvPYJH)*l;$J%fgRtovp!b`dF$C=~{O1r3>ZOt;P0pUK*o< zM5LO}M+$6)99|?mKiOFNxVDnN@tqzCS&B1dZf3LJ!e+YzfL$BG1(BBXY7{i2oh8=# z8J1RN-NnCUrh9N3C0_4Le&gbF>c$6du+R={^y7l(R8QQIpr^N4XmsR4-AO$T^+eg# zt1AmLDKgnt^H(RhHr;>l0GoX$p24c9%Nf*7-GkOq_4fZ(Ph+Zn_Tef}YvB7M>axIn zvDGwTXbMa=6wsz8NcQ8uzAeSto5*ygD30K^L%lE5?x4)W11R%l!P!f6C&bXVyWBxp z;>SJb5_pwhfCIv0Dy?Wh)(eC|gyRm9G{-oEn|&TVy4KbfH$U0w?Yr;zm@q>oC$WYM zn=y!i3(66XGS}H2Bw;xrv-0%^gh&ow{;Lk+jEu<(pW%OCOavy+2GxLzVH!cGztIM~wD zlz$xjGuKz(BIp8vb%*E9(+Hl$^s1)(W41CAf_=Uy@61FX@v!~aI}`+u@Q)w7PoPGv z*3#GASzk=TQ3ka!C9wYW%esblD&h z!VNlPZ27j>ou>n}4`V&nG-LwJT6l0!J`Upvhr4~&h4wU9&YPVe&0qiTBl2k7-Ih<8 zd=w?D#3LLgiHwKZ#r@0KMA{mD=5XlAt+F-+GxOScm(shtNIwNiKq*E30QqeSin~j} zsvZod?&7dT(-w$-*?b*S*@OvsGcFdhxo#~YUGy%n;%hf<1e@~E&;&~{jjn!r>W%xA zmQ$4_soXHI=I?bZ6>4Z`SdAtNk;q4|X_uzf`emv0ie0rWG^8kXQ`JT3TaL-qTXnFY ze|sOAsk_-}@dx9mtLsa>yk!4loeXMfou?V+){s>PkK?GZJ>GXKy~x|k^(AWk>BCH~ zdV_))%&tVVVq|1wW2Y+To#&T$JB^#Jp-(kCq?xYlTlD59{fmvanBt7ZmJmXX@|aWWpuPPh?2bCIwfPD*0M7YcG~>8fT~ zAAa;W?Bpzw@ay)|`o$UJlfD`9;<_kI4YiZxLJiS(N%%1|Ot-oQCvWq69cgA~S}+sL z?&;-a)EL*j^IKzN7_m@+r#^x<9^i(Qw6to%9S1${WL~ITJ(E7q)1%Kk1t)m`Iy#T! z$`x-p)U*yus65_wE=(z!L;cke{JJ*9Yllu*F5LoOpbBeZ3`Y|etcp}qyPO2tk$d$; z`HXx$QfnX)d}Y|jw{2mj_5Q`j9byMB8!9?FIyxytlUKJ;DEOf2Mpqv*=KY^sQV=fc zTCJ^aEi@7mo8Z;>wD_)1ht4O*vWEPyn0rRmj!xs@^|h(qg2!-KF)TVZ6KnvFGPD8$5iEDmn1L)M&qpFV zg-osWzC3Su)6Jbea>V_|6H2B-z2y>KyY_wYiDi-xJt4nP2HMVlm*QNV!B0I4XOdM5 z^MVM#GsyNzqMaU}`btI&&Ba};E6+?nQg-#2k86#7$u=L$;zPVkGvwSrv}s3ZXxJ5G z7sM4QvfyRS8sO$u5XRC?#mDl0T!3O{nv_Z}uq(RWFE3YjbWr!SCxlOYChVYdyF{5~ zSN?A14)cYbK#rwTFa5+ZQxz;4;hy$vh7B51uF#gcbXLkar`)_ZB_69ZV3DX2&$bQxw{!!dE5EkoB(6q zv66gD_psYdT4F-tx?`Wh0Ch?8nczRL^sYI;JJ0% zuG4{oF75f_U9b-B>b--%n}o=P-o8Fom)3XdYuZJ31Q^TzJe(GBOmu$rwtiWTmaDdW zWA%cR6q$a3h0M^yJ#=7p50$U@-$W(`BCNNq{@g-2AnxY0;l40E+}ifJ%4YHBwXe^4 zofyS@(OF@2L&vj;5c1eyIp7@jTJ)j0Qf~7A{K6ON$N$VN4(H?*B&iqKK1)~k5t#e{ ziQENs`_o`*Y%-AWKE}+<@oB2*kxGK;a26x_Zp)!EMh_2<(3AQtxY^zSk0x47K0az7 zWvN#)4-xUWNPWGmqcbtJs9~!0UOICZ9`KzXk2Nz7@|jX1U*r3izC5OAq2zIvKpZa5 zBO?imK)=lJHsGmhSKMP5A>N(4FkJQ|QYesGd#d_1o^&y6kHBgRc9x1IP&OD^)u~fZ zATx)?qx9n3cj#+FNH=d<>Xcvgrb=$Qp|3xfqHIzzSfuTK`L{O?(dzQqZqMKpB^5}W zlt0c{g`Irj=m6f3;K4(Oa;Im?$3GOL*BVf2%U2=kOTd5(^Kp~e`&)@{qcpcc^t+V$VK^Etdf1d-?L^ zQ;uCPrAV01ncK{KI00I#zn|Y8Dk>^6ac62KH4LA}dQw_tW}}7Nqwe0ltIVe2wH_=- ztjNAv0vx>jV$<-#)E^b)(&T|=LcLw~)>)wNqxVfY)^-^HOE_r_ziqF2^jlBIm|E|x zz0duv094b-*k z028X<*11v_pln|X*S^!{y-#Op*e5u0pY?fs+B9%`>KYQ7`wWOzzmH2An}>o)Om0z! z=jz)}s9$0;S^hitvx)+<>xZZUZvAXKiu0ngw7k9;(&XM(jwf8!*TS$B2y|DR^zRPY zXTr`-K%Q7bHJy!I>&4<4)HTf_K`bf;F;}nJPqp1cn!Cxe;6mzk*wE`_D%q3wjKa9f z2VzHK(fE!NVF}jqXK75B z+wT-WSy_!nqUTNu;@AfpNjc!BbOMf3GCk#%-M%*Ar^kg5>SlR1L-?rI`Fp@RW*g?_ zg`6j7aS7Db*K=H4q?j6x9Tv1sb}Mo0uw_#<1eUIzrS9`%*o|GL;jzO1zGaeg`MMmC z;<4ZErxKF6d|YumX_D+g6HaAbzT4wNgY9!E+1?Cu6zPEvnRL z6Tmcw8OwWlR+TiTHzgzArki6*U1;=Th1^AfGJgRf1~(C^wyNV#&}S^R3kKgZ3c zKoMXm;qo5))Gtcv_OJPI+JcChKe-xQmUCYvlhkc-@032*XSJ6{EFj{7iD(LV&#*fy zo2N;8wQc)XBZmT3X!x!e*^3W=Z&%0CGN7ycFh~S01W7UdggKG1-=SH%B!CoW;YEj5 zrpLx`+{E1Azr?peV{iq19v=Q#{mrX0Rqt)lTAm-CDL2Vaw^&tPdTlu*H|aQCZ*_x4 zU(tSQ$wue3g|}Uf0hW%y`X97)bBd!a_G4W>d!vPUEvt9nrX3q7_gF2k7QSr^6+)_i z=FO^y+*jTTwF5ta0tmYl9wjHD%Wc=RFjGG);U4wFK`Dukl&G4DvxmY18l>*y8i^6I ziLxkFv=R7CGc@?-)~vzmZ-9~=FSYYdyZKR`4^}->c?I}u{e9RxR@^VLBQ7GEx&Rq9 z2PvS)7#mAlOdAVY55?b%7S_?$)pvGw>0EB)8Id^o{mc367%@7S4??5)Ve(#?&9re` zTpVZd#+RDM&rYaGXL~dk^C7)G3WqMt?55UcBrvX(vbR5tMjI2cL!)16iaa*lS2@pB zR8-8iMnp!k%N?pg?{hmoK*W7cG0lK{@80jIM+qAYTx_r0n-5_*^(`QyT+CT@J!&&} z*&u3%W(k0prwD`Nv>>TXZg&;|K}NIr(dUgX4u|tvMMzUfQfhYsD|$sh+tck^vJ+&& zUtim-CMNpG-@lem>m<76j7iFiXV~;Bh)T<%^v*(}+d$!=Otw2;Mz_BRk&8!BN|66T zq;{fgwgGL{yeAF4&)1za#AS&|O-4ff=_)uOgvf=Y$uWn^JUf$p;R0H7+JJEW5gMsY z*;h-?$6dMwKXJ@2fK6bc6SIx1T4EqeF|zgWQ7Z$3^Pn=R?(4MS;Q^qFrZ}qn);+Y* zb0bfWqBE7zAs@E8b?co(bjsssQ3rCwkdg1_c$zi}(RLMamPeP|-nnD#T?%+ zBdqO#H-$5*AXd3&ZA<;j6SzM(Xvra04jLz#P_)Nuds;Cty@R<_SP+jM@Z-ZPs;+M2>N2CXj|iJ*WUT4rP$NPQU1lnk8UDbup(~mgF;THfCDM@=-?>` z2@9KZ`vJHX$}jLht}N>NKMySe?nytaY33Y@I2Z4X=C0jA_mrSXT?W}IcL@BI-*SyEiF|!PP*eLOEn%e` z9$25Iz9xng{8qtp#=s&`vpJ&SBmXCFrc?X^Mw)zednUJ_RmWQ!Dze*-JI2z=iuhp| zpyeP|femrp#mh4g@%aSFV+I2YoI@8bR7ov&5`Q+v0;os3Y7;pFU=XGFzm;j!SxG^@Ea||6?u2JKAP7`MBOr657pFB1Kp{Wcg zQ>q5U^a-~Y9YZ+f2K(RUg!vwtIfQmrK59?sd@GG>aW&^#!~(R_$aMB{L`fuu$m z4H9ZnGjjnE1dvV9laf?PF!elZ_r-HHoJLpi*$26Jx0S`tmy!?cqveRG6WCOcFwsMk zAbUDn?vdvNYzmMkd<&--3O|+^RBNh*S$k=V|Fu{5dj(y{z5YY=-I+}NR-la?gM5^S z4iiOJyL5IUl!HnL^ z<>7q47RzHDv5^j*{=@1%6grMp!~TJRDnS|&Bvwl_@zidE;F~oyHBsy3y?&h{{d*$S z-vqrmlZL<{WJsEt*83*OYZtgWr)|G(qOo`HUNfctW+ZOi#Z{0Z@^F1^*=Dqb(RQGB zY%SHdPi39?;;WWe3B`?XaCJqM*+R7BlG^EX$C*_mfP+Bk zQSdM2TIr(4yN{}hjxzc?+>nz^lRHqGtFHZtpsK8@QsKP5;CV0Aec|q?wrDGxSeOjG zPN8YVY?U`Lbiu7U`yfN(_`aGeSKc^)=r7qJDJe;NLX~Cx22f>Tx4AtSEU_{(-^U3K z?C!Pt>)cYf3ZUL*FNSd`QQC{Vwobv+eSAs7SPYItW@#+NZlilqVJ4advyJ;#07LxV z95FlAehl*0`nHM(ou$e3LYp^lmfB0d&1|V8Y3id`x77r;iRGUW3gf1Tnm0Z)G#W<^ z(bL=g>f!|I`h4QDr!3FktA%p4Jcy&Ew>^QF&gvJMRhd~^XJlroz16(zB;=KU=`XgA z`i*_scqcSR{LWvhX@>^hYV%LP;2khj@2@&09e;&9>@DZ@)juXPC9n_E&$kTUOqCQ< z6wVo~lTxNLQj^}cTakLRdg>Jnm6h6Fk!WzCQc_XfgH~_YbxmLZE=6egXz*VE1_iO3 zJ0Qcrh)Z)*4ttBkco%0kFW7*-u(eqV*t2`LX~!F0dOSsNqs%sHj8p*9nnjTEtvB3J z%Ejk=U3tgk{=&+8FV1+|>179$OL2h?7q_KqQA7wTui1&YBs(|qCP=FkD$ohr|4=}8 zLR<(^QlC)60t4uLn?-5HI&BR8ffO~uyC-`xD!RI!Sr^-rx-BQcfy z0iDyIuWb_)#B^kGVVX!K$8bBQpy0O*yO|s2#SbA>HGc2N@Ah@-Yjs~RJE1m0BSv`p z5yZ2f@FZKmbPDj+cM7 zOb-zLN>$QNWM_3SkAH4@lr)cDf@W4c;&zZ8%En-n7QP3#Lcf@#sb?v8FHF--Po&k< zpKd+AHAD&+7EZ`_=*kYkPVw+taPSdAj2a33%QY*j=D-Kri8u!wXCzH(PFnI}kChXf z#7b@}cYa*i%W#C5`9B=Wd)F745@h@p92#{TgF@xvU%uqn%OsZ8&Jw7anh1;;Cbs_Y zhsTIqps=vMANawo^(MNB?#x|xfmo1j-8wFGJdlx85>9!3$L!9nyJ)Ws#Co7q<|mv+ zP|R;k@#ClI&|O*k`T0UBv)sGR#>wE62v(E+uGDATx}jn&iygTacb$+*b_S&4>3ZtO zp9?Uqx|pPD)Za>_U%qLI%Qa+T6pDO#(vU-D z@3^l$qAH<(?8w;JkONB3*xUu7LhN2QPz9f}uVi3fy_#mA>SSgd9X5T))d-sm7>zMY^ zH!0Y$Id2^BvtV86Pw^~weoRtY6YX~&``V?UXy%K0dlTp`s!=TcuRSDSnba*OI=uL! zxqM|I2bV$U$*WOj!LPq;(2`&5->zkGAw`Mu5P4r*jVR-TaJppWJX?8F!{~nD^ zy;LTuUtlE?^ zBh{lS**n;--`}xhNX>C#C-XUL8mVH#NOlUM;;{2sU0Va7y*o3%%eFt)*$#*O&OLhw zcN?9)3x-?zj!LrdG5)(6T+4!XoI?TTJR(gPO}>s13ucsEUYOQ>;wP}dHiPIX+T-f7 zBa;)yvVj^Q4?=qU`Nk=PM}BJaYb^i*Hj5K6SH)a{P}(@I&jn~M;6YgZZ3uP*l4FZPuojIW8eeQ*Ejg{eUMUO{fZFd0#WOh^FF$Q`qWLjG2qbeH1cm!y}9bqc}pKI)qgzT!+Wd4GR8yPlKbfN=2qOGt#|`r+*4ke4gcjNIj*P|%P=+r6fsMb!A?{qM zed!Wq5h~?e-WA%ITl>-f!0PpnP9upKkQO?%`?0Z11VdrsD#&4+|2A_6;TPW&As#(b zwsAOiZj`1p*-tJWABtn`-nSLspsA+ORcGS0DDGkLL5~)G#^Lzfe(rZXUi)?w16OVc z;p#CNXif~0H8kPOWa%%vvE6^~UNkIgR-pk}~!OnG20;}_+I_ty;* zXKC^X?sKN`4DO#47x4K|pobqmoN=`z6y1ZVrJiD5VWCpt5H}t;W(jg7;q@PEwJ*Cm zmi0oxj=+KEAJC8yw&&mp{un9=8}r_Ien+78|6Zn5h}0&6i?b4X0;wvV?pwBP(lHlw zS$cXuh~+;6txhh9)L;{#FBojVG8t?MfwmRo<#3GQu$w zB%RE+6_MkgD_T6(2_l$ZcIHml=QU_jZ!IrB86w3jk|!(4+KySK8L|lFjA~2wq~S0q zva-CKcT?}-G^Z!3lfP}r{d_Iz8seY;8Nd(}PY^iT@m$oY@8O^j5)!(E@q}Nt9zacm zu)H(X(jqc+vRyaM4NdSr3m`ZcLkF@0);nCO*sJTzBsqOdPrAIKYDJKuw~ZK9d>(9 zi@@nB{L1$J!)Cuz9rHdtr3BgZ)TvYTpI&;_i*h$LD^9EQQ@Cmb{&;6|HsTavW5*=`~P_Q?szWy_I-`J5(!C*M2Zy3jEpkMR)`R? z_sFUUO=VPM?i z?AUrMj72fGrNJ1;4*@WPh+yIn1=E6=UoAm+DdrAQKUY-p)NO1&ktfl%Mxuu&;q)^Z z&UIMjLs(k8T3zHJx~9!c^LAPtovylCd5}W2UWXcB=pa^%w*n~2f2RL?ed6`gFX_%- zMBs5_erNidV<0o(PprS?ze11zaPXOCzTR~V?Tq)@Fw4oDocdU07IeFrxjHf~$sK1f zi#|kmt(g+`up7O`H|EQ&Iwd8Pk`1VK58gSpw0zoqarE8jlmuI!Qxvm|*+kt3UUOC` zk(!HK?|+}tEe3&+k&KqpXl-?0-IJwv4x?Y%S7#UZ9NNln^`*1GW|falBys(hMBs@4 zf~mVbG>Q3p#07r5>oe*Z&uMEy>p$PKgK{rmV1DbiZRsxisUCn`gFzd?;~sTh2aIs7 zz8?M~S4W*={V_?$BD$EQ>Ncl=(~^%XLr}h~PD5ccwdjw?2hJk{iX{!-$XgD{3fx(~ z9JBg*#pOVVmn4@oQ8+fkI~e!=FjL}PB$StzmAT6oZ6-IKe{ytrQuOW=$;i)#Tekg~ zH@}ff6Uy^2QW*Q;SNhJ0&ZmcY|FrSmos(+0Mkf5P(HAQwWV}~x&SIPm|B-8XMgUCB z%aHofkfD9+)|=|%OpZr=vvAO0Izs@aadn{q7G7$XaW-KcpR803z(tq9Ec3Rj*)ra8 z)`^Bad@pxnIQeL!Z>C*&@95^4dKcw^#DP?uH!ovoPWc|cLV?RnM231j9THmYf*7zU z1U<(#LwQZVK@fX)bs;HPoNDEm;9=Fo2gzE|7V4kUJPWknQ>vs;fDKjrthhba};i#cfxnW380Ed%sLhiCccpqL$o- zL(`Qe3A0SW4Gkq0Gs!C~F5hV{s;JC7uHPrJ*nPM%;`a%?zsKeLs6-2BZ<3f_q-JFN zyr#0rZ$EVloeBI^{fOuK(zJi3e|1i{z*#(2CaUlX8>1xKzlZqo>9b?{dEB-ZtFwwg zStRiLdv{)o|B1ss%_T1cU?^Og4uvvvojv=dxFZ5AV)XO;#S8K;n^yThOGnty($FwJ z{@8diL8T#CQuwIQLVTIp`saI#o0f-XitMgZszVD z)abIAZlnL;Qh(r?XA&uyTUA*06EWIt%?{ zu_fa+OsX7YUZH#z1OLYbkZ5wm6k}DnC33ErbQK%SCj8P zpsWr;-k#&?ol2Cujj zW&Wfaw-$Dc0jz{NO|ZDFrsqD?xR^rf0`fnUYpwL}aF$A2m*1fl-%)*geffi_<$aE> z7`<8T#1;KJF)j4tw%qR)`AOssHHEZ}?o!_o-8<=}8cu4D;P(JK;qei1rYChIk3FLoGEGJ0|3%lz>p*Ai5!wb`yDu#|rL#&j*OH8j)w zHrvf$r;wqV+YtzHf^5CMzEaJPG@8nJp`?}vUQ}_4J7EXIMjiFb3^-c>1VjE00N)Jd!e(|F@bd&xJkDkDsj6_Og=f`_>fL%1V_NV5zHaIHa z!8NYtP1@64*BfukI)Q2l_Ans$_%?Oq?R489J-}J!IyOM7sl{Bv^1t(9Ha=_%+*ok* zVi>q&y=aBzbU8-;$hTrYx8sMeuz7H~q8=mC7}Xo&yy-=?SyovL3{97>?GM#R!l}0d z$QHe1055UMiH8m9N0o=lyG;(R`f@AH-Q*xkU)n6PnddW#6EMB;k!jvs<&Eo$-4?;3 zzIM)PF-i#}LyMN?xVCZMYqz8{wzQD@?Awc<)b3^LPK@5vvhT>jz&EY zg(?pC!*G34*vq#vXC};B!HRXD^Qf2+bbPY594)i|paAu5+9!)TUQeW65?q{+P#ooq z5n_{luA)aycHfMVNExiHdFZxTiuo%aW-)npCSPj-4ctdVBN1uQDbr`Sao-(e6COTXI)N+s|LA zf?iwn6wi|_ACsoJlN%T(;+F2meISMVPHB`!vOrsZoO*$o#AV5DhTzYKr|d*CSi`%h z9=K85Wyy72E#zczNw%HzWe|QQ|5mYuv(hp`)^%6Rf48|kBA1qlUe}fG?8O$w6Qh{) zV8sp#lKTdXckLY*NPYZ~-`bt*z^zs;tt%(E{?50!K;&pwEUc$xN>58ol}_t86HUOo zHeDjMD@#-0VM|k-+jD<`{Fo+-$3$mdIXXLsQ0A?{BLiiaJ^extDd_bTt`BS;JQX>& zv`?<(hab6fv`k0&W7C>*A9L)@-O9Pa%4051_54J$Cs(Q0)=n^TYEN@8@ueOKeRDn0 zYTowzew)7X>7q2(QMaZ4wx_PX;Xm!#B{}aId%oXpPo_rA<8nn0Pfw$MhE0;G5r>0R zllw}oyCh3kHb{`laX0D?6^4XSiW-Jj@CKmGR7A~Y`twtCvbc=u-Mi;e^tCt~6pIpa za@+bgN~a;E=-xK#u8qy!jy(N+;w1Ef7mMBD>!B)6v!eL#D`#b83HdSmR*-}yGH?A< z1kmp`*eymMzp_-QQzT(c!RTnh>yy-8bH6sKysa%%>_4&*o|mAY5VISw zGg?{|H~q}`{bXV?>^OoCn9Gtmkw=uZxRi6dbUP7u9R5mH($vLR&vn%ty~<_gZ`nJZ$;GNXwr-sy+u`O967}Dfm+n=bq@WY6`n}(+XOy9Wk&|J8Ubx0DzAiXVkDEl6 zf9%WP3_D_TzrEai357;+b?FgN0pJ>GXZcx}nV(>w!VO)s*0Wh@3{`Foif#@Gl1J}- z^!RJj{+CBztlu3`xlt%IEj-#%u1c}IT$&a5)V-{hVWdlRp)=F`YbB|m!}q17r`o=x z&%~a~u_G8O|L*i7REvkcv(0%bcYlLF0jK0*;F)WW)`11Sk=}1K{NmD-4n>Wb7J9M;=Kb@ zm6@80!_9?RZr#^J#FClEwpfNa4Bo^HJi2M-1( zeSA(5Q3t*)YV7*sm(SiC`AHKY7jN2N6{o&q2isT|gLqVNh0pF-EfE>Y(rc_V)1)!} z6@$0JSTFfsz4>UDo}akD3%hqrX49um3fNK8QGWyAP`3AZZK7FIVkPQbxO=xaurhu0 zT;1|9g8qi)C?9P!e_tLcqePr4npwnY2;3X-N9Cv<9_J?k{4xj8pC2L#+S^VrhM=MP z5v$41bo@9eIeB&S?DLC@EMYDt&|a}V$RTAbnj2Lq$Hddr_uC*?t=YuP^|AaCDTI* z@@t@Sc6n#|`_;WiDXFPno3eS35bTsbh?keEIJdhQozIC=*VJ^g?|G|2O-gkde{@8i zBcN@fnR7TF6|2IQpcYR7!h5p=tJp58e@B3mgIUwJ#wyts-REZ%j*J^&L?PsT!Gn3f zOu!kB!TPsE>_}0TB_R+$>?PZ^6fXJ-L}SbtM+N;QFdg)G`*<6ez7;=Q#>dBYq0i>w z;n~o*`C5w2L&7oJrTpbmF$WV9lRcgMcVHeD*@(N+^Y4wR-681k8DuXEobiL0$hdiU zn3W#0sP2bcX4|&MD%s(sr*6KdjJ)!4YGPc|ak9h9jW0s|c5V5y-ThU@x!a$kaahSP zJ)@oW1hWsdNK?a)mm0i50{SvIJk#-n zlBux@Dg*XVUj5$5qEQq|PY)eFXu>1CJwdel%qcLZ z5G5Ce8;I9MFl=M#F(}=J6|OsW?0~+1=VrWOZ%XAKGsZ9a19EU+cnnvFH=@w2Z* zCKHx2BZ1y%53P6H0hcoZ@gqceCJDalF1=@J@tGZG6fk=W3=ACmo%O=WVdQGcwd2rb z^3v!IEDTNSKYH|ttEtk6;R9@r;Y~oue-CBFzkU1|i_4cFC7(x;WaW2Kmyj?&aW9HA z_p3gEhdoI=tQcp8NhcjN_^w^~>MhaF&&Zfd$Jnb1SE?Z~~BCgHKk z;xU)-`n{_QDuLVZXhrk#+3;06xyLy638gN2PW5qC8gZ#v!Os~e9YZTKqe8kriU9MFoYArmQ>hbPxAB)Fa z8X$1UbnJ;<*q?kZh}vUhV6yAY^t&Ry{p?Cl!0eN$3ZZ0D{tGHw&yBSDLGw&#=ZV)) z@#PE2kFg_U0Aw-q@iTFiGkfyv*<0*UUS4_oj*glav0ewb;dJi)>Tqm*iK`)q@<~ZJP6@9J53{HX^tMHn7W34anOFeHOCL7 z{j5XzOEA4oYNZ-o4skJY5F>D_saK*sg0A_OMW4Oyxn&)NPohHYF=hr&?Cm1XWzb*s zqzs$Ceh)igIuR!x@efo_DSMQOp~;Wa$}EaTb)5yRMm8xG=iN0-u2o<_i=p#xY5mu% zV=k{*lRL)5!94x8`s-Y+&gYBBQQ5U?my}&%NDXNITeohVI|)9$QJ>U5;{H?BMNA{* zR3c7tV^QGezeKJkRL9@Ge`f<>lf@%a*trb)0_glGnZo=gG4F7SMW0LLssR%xc3-K< zap~=wQL_HD(*Y8d%pN2J+f7c@NUI!ka}D2pATS5; zRRn4+O0mh$iXo2xof67StlBi6C1ziD&8N@}HT(t+Y$64S{AEN0{S^wjH}GuvnWz~A z&0nl(QFR{zeSi`+=8XgsDpfRdV*+*=SDla9&TdsO+o z(@w2tzEbw~oFSdhMN`c&KEaehFbztE>Upf2 zz1QG6D99W=NWMpJQ~KwU9FwszVSNn8t9^Uap!bwsdk)fEgt4JK6u{d znB8EV@s9^vezmuo3pdYwP|f_%+`Lh!BT5i+L4lE3IO-x#-P+!+45=mA4`il97rVpjfqMPr6y<|h1zng#~rVke6v|gz_y-cV}>xcdDs?q=b zgmkS?_iLd1L(Ck@=_ zGc_VCKB|bZBNSF;c?QV#wM<(>NbHJFai*xSgr|F=uqD_TU^t1~i}H<*);@{X+CTQg z_qg}cFbk|h#_dPjuD3Am@;x=AIR1fB>^?EL1bvuz9gDMSPbM$~H!w7O8W3)zv2pfkurYEnnBcW zSEm|e>1Ow%5-Y$5$C$b?-&A>{EnlFRT7vR|vLcwH5IoX!Seu(yeY-b16@2b7>?N>v z#h%qhcr;8saB-oeqpO~}_7+)?E9sryjiLPP&3Bg%#rt^^Z&=fI+Hv}i92_B}rQGxK!ul^5UVtVPfV)=?+XBHJpy zMos5jThsMk^9zE4Wl>f;Ql(?6Z%X^CudQ~u5w|<8YrLTE2!LT$pqWlPR5cM5j#5dFgOj$5#+)jIwW0c)li>EKuBisiVqaj&P3a)34x)(kW0CuzPIqDhE!VT_E`_)0+@fMm1W*TD zy|iV2p1$LSy!J!s`i^qOHMHi<;T`Svj&&2qwv$_w?uh-*)$Qz34e4&%+GSgcy3ySH z?xF7|eR1xLrm&Y@;1kXx$LG3#!(m}{sAJ#z3=aSy>pLfLsKn7*{E ztYL6rPN_zvT017a}o!ka5)3THMSF#DO#e?*gTu<3r#p z#rpcZzmcl9y)!>#SRuQjq9Wz!&4{D%`S%2F_w8aYTo2TkA2|mffz0Hn>->)&fy*H% zoUu}LQa<>ijnpnsX|A`2VkixeD$WYRGwyxuH4W#?Yw2(l`p_kk)3KVepNeW(4iD#| zr^~i#eI19*mU(4wTb5PLRJ6EhN1^anM#fN9-u7TY{T(p%S`%_{a@Tn~%Xn>mgs_LY zar?~YW4ov+8GVoKa(b)Xkt=stG!pKpR5WyF90VRwG^j}RjrU6;$|Ej2Ji$D#)eRTZ zCzG#Ro1xW*Ka**FE-!dYW<_-^yLM9`{6RomQ^x)&I;+P!$Zz4eGjr}885-K<(wUW2!>yR)o^G_>-E{8rik)DFdHFI-C-&}oW4}DJ zv~#=3nD(LlbkvXXjyh1q9z=!(-q{(=!kg@)t*vcLK~>6w)E*%c46<@^@2odBmN>Ml zb==mzX3K}kXeqJ5qN$JT(8iW6A)SwcLHr6_TH!Km(tDL9M6N6s!$#%kt+0{T$C#p`pK0#_uFJ|1 z5?mqVoQjx&teZ}cXCHFaGEkvGK#Q`o@a91OaAj$_G5kbW`q{4c1R*QwS7E{B$z_2{ zU%%=Ib!r^I%n52QRxI!cE3I4~(0R`!#e)ffEigiAtaq}0v$VXtG1mFc0&@Ji*H{1g zE}n2H!T2aIIvT5x2*2CiR~MDgl5JN12mv9)YD2VbF@!Af7Nwr#bX-qP6c!%-ps}jD zzH*w-WpB1+$`z@`s+jee=kU28?HpL&U^(f&cN~&~Cr(@%oDha9#_L=fMz0cDx$%E1 z5jn2mqKLhgLBjV~M;N%pvbLTt-Z=9tm&F8U^Sg!|R3W3p_}X{eXwwjcmX}GIA;=}_ za9SV~ztvIPS6;L0K!?F&`TNG`Vv{?h+Mm9(1gRrR3iQk~DT|Z)YD?r|4C?FaGc4L+ z>6T*KQ$dwqkpGTjc%P(@(9&w3v;o&448lVwJV%E9sShx6iGn%}N3$csNEx*-KF z@o-BXKd7JT8k1ct;m8m;UH(i0yOqbR+4~A&dPbIR|Gude%W+EnDBMVMoDW>txl;^j z32=c8(I!a1)xm-Rj0kJXl0O1xl{!yYFm!%A01jjx7V~idK;XEj3A)W z$#l;uax@b|(){yRuLhAOsluwGJz{IGQ58u4j^h%gz2~pTjJqCnvJLkZ7k1>e;u;cn z-y4)mcWI}IAam}K!!pQw z_?RE{30y@Y8bbYetIP!i&ri)o`BcE~XwlbKU0YeL0AS|fO!L{1rqc=$=Y1`=F+E_C z^rSp;#Ov|fgw0v z7s7EfpVi^iqhoz%1r|@I9NQ%zwrtzKH2O;P1}@dNFDV6YlcQ_X?5rt9X%aZW_tL{K@hefU}y5~DSrew z3{D-A{xJ|$5RBz>>g37vW8hj=3$043uB*=QNYtWEBCI;j3 zCn?Ot|JXj!;5ARvucD2s4gLzvo2=GLA9+(Q3~f{sgKM8ioYKg)sC>$8jMo!u(3%DV zw(I(fyD3O3sTirgRGT*bnqHk$ZnlgV1@BIgvs zJn!DcTB+(dV^19$%wH^30jSD#B$=AMzh_nUz`%A=IbyN)Ym5}pV zl>R(GD8H>h_|Yl!&!xdHrlg`KedME0SVG8;ws1Rs+fM6wsafo>|6vin*7hpdK`|yN zS8?a=>O-&^5HJ039TM>s$s;cE-w074vM zA6pW2ryF8NSk>RUMhb_e57wsME8dYA{^31mdktuP?htkb%VL?R5|`=|y4cd}u9^0c zCUW|7k91TMeTY?GZ_jcqPMj&^jOG&wpZo~Zst>t;onUHUy*Nu!GO_yb@^8Tw+s6hzT6$@)3H~2MR}8KQO4*mUsz21NO*icPKaHP17%uUoU^DC z6^ew%6Iyx56%l_mSy+rSKPyR7R_nFT9+Oq~9FnxH3{ zeDm|gFbaCs>&bLgw48DBA63;gxIz1TDi)okuvP0E=sLfJgwP!*$8|BoIRdn?d$hDW znD5XEH}?9NU~v*HaTH|h7#Ju8`JH&Wn^poOIb-v%{_dtz*fVFrUO`01S{daisDwr%TfS*KguTZb)K>T$$y8?D_9a zT78huva=duzU6x>_Q#g}Q|3Wqk2PyD!Qf+cb47NB-3jKs#8*rotg{>Y5&iR`tk&GA ztEbem&Hy;?UWm8=)a2@jZCb$o)2asTZpZ%{zUS;LtM#asnyASI+CDLg!%{M?Zm|nT zLUrOHZl9`Bh2P;avE5&rd~$LmS~LAv@%?VC{YoXy7}W0Fuw;iv&wJ%O$G8?8eqTE} zw6V@Iop%#vZCYRBA+4dQk z#)}hLnUPY)aHz`1x!;wrZ(HGJ>`N6{&Um1 z-`+_x2uH%u&C#mkI}ma80;3lilOflLFJ{%k!Fz0GX6|Q&%Upuru9BO$eKKT;qhr@a zxU2}ct?;0;Qc2d10OMF%>-DiMmQN%~^9!I_t-iYS_B12a1AzDG#quYuHa30FLvjbONseQQN3&-Mm>n|ip2pznAJHw*!q=Q$;(6R5I zZ4JLaCmNw7Dq<0R6U7;Ld*UZjanR7GG9BR5dY#LBsVbvEx^En5EYV_@h9ITY`lnPJJ(yjkDh+LwWXwth&x`VYnR?$$!+EuDircxVWCiEN#Hp&Jp{-4 z#*KpuP7TsD^z`!Sf$Rc~J=n6$ysf@eX+l9e^U=o_C^tG zQXlV7`Kaz^dBIUi>-8JSwp|`G0s^|GrXkVn#<>TnFU>3@pl?XGYv*%aALkeHIzXuF zhPB=P6_B>}QrmxIIhf#ox~Fyg6{z>L!n3kdU3D25|;eEgXR;oJzHg%pf$ z<3UUfKDzg4&0rs-P}{*pY^Yd4&7}*QH1yI7euK2^H!eQh`kzUC+#Y<7!#SeN)`tjA zZ0z@d;?mZT(I8Icl45cFMcHU;#%mxzc%VuKT(1y~3Kn^>c6I4j__60V&sr_sn)7+giX+YYW#{iVaI2 z(zY}<_mVr=Sh=qj#CQn=g!@z)thvmwV!6p^y)KKr?~P{XFxlhywWZ_8RWQaFCrSt- zxi4rJ)zcl>ixO`{H?P7LD^%}yP7_tTGvh*b@M26pniBzn|;@#g})oAn>&=p ztR$hg95(gaVY|_f*M{52#78EUX`^`Oi>~}+joep%UJrP$9l1LVZm2&6&(gsTt9 z4sdQ2ST#t`s1E0QA?i5ZGX`gZ+|G`U2$V)BN{|^V$REVo*UZkQ_R$?o>nnSYR-fxQ ziTNhjjXwVVCGFYPytaFhj^#8z^c81y!`%K^qHWfZR*|CPra7}ryRU`tuN`D~3 zl}M zPR@zn1;93{jZ+%qeRjPTjoi}ZrsxyJK(u^f0c>+e&OUhXI<-WUSbG!^NB zeG3L3m%U)v`I{n?>LI^%Lz?`N?<(&fJk1ek;na!4SV8@i=F%%zXW3%szNqqCn1 zZ%;rDEcVaj+bgGrd&Qr!U0*V%M2Ky&w#(e|Gb2yj!h1nc3K6MjFyyL_uH%uevdXUh^6^@nehMp5`ED1}~|SC0y9W z6J|Mij*|oMJ0aXcp@p#wh}1<^eVh|kBoWebIv_D!^SX*iRxzL8N}fKLTB4V+fDZ{Oj%An3Bk zL+NLNR#@@sA|QhjU;T2M*{NITpEW|r0y=VXKmQoan>;A&XfZPQ!0jT*{9)c0^{PM; z#QxX}PG}`-=eZ*Z(vVH%51zF;^gHk!t04J zJ{WCIyp*6~mYOzpJj!pMOsrBbW9QytcPc!atlRR5nn9?2afkOz_m*P?{qY(VzPI8J zeaWARVQHY8&lV>KQ3SxrRHh@=ZNCdSQK_Fm5IQIEm3id;9{V9^5rYNqaS=v>NF61N zpu#pSW-0BXvc#B35L~jhZL5g$i^69TB=8Kl%n`J2Y_jeXQQDbOOXe4}W*CwY0pCF^ z3Df#zQ$VpW@w|u-lT)f`%mBE*iXM9~?RWCpTSv>?`%j5&UV8l8+w&WoQegm~xba)a zi#CAyiD^f&R;X6c|JCt_&prUuRnaf7*j|sI1z!{w)5_%RFfLdx-YXYz?s&&bVf6Wq zR_$dFBdF)wn})Usp{=Kau=Yps<08dKgZ6=%@Cy!}u;nrTD?cCNtY&X;KuvP~ z0P6$jDT<#_^jq1SP14MaF`n!s6rGUA%WB0K;10OXc3ltjMxxF@V+AVB_5GU zwPSIzWiLQWFpi&|yTIe1Jv!_9cjjfUQ(pdFmOL>Av@ssYVt`am^f zQP>d_Z2iU0_A*#@D6!Juyg!Q3Y4rTNUt4+Z_eo)h&LDFCjcaci5@Z%2N5D`U2(jyCaE`SFSYXx;Teso5ePAzd%x_mu&Yp?})PxaX!Wiw3L7O@_@S3 zOW)XhwbaVv^XK!>1}7!hHrm5(ir_LJApx7Fq_p%}l97CwLhzR|htZ*?x6f2ZD{I5U z!%6ObjQ!f<0&yUSU7xVZ>{FykkAWRhOiTtKL0`1)GHP6zCs4rC4o25e$AUwr6cp`P z``_+c82*8q`tJ>#BzF3CUSg^rR2LNwdmf@D@$h3YKVd@ov#Pq9{Nm{j2}v)SElXo^ zr!m)qe)8kA#yc81I`8r#L641(=)NsFGCatPYbg;5l=}L_aNFCRiwr_bL%G-C;bdUI zjNka~TDp{z|XJW5D0l4-620J1b^4q>Qyv}x_qb@Beu|W||{`6q1Y(USCLKj@~J2xMY{1z6* z^zk6%LB|*wADVI-Q!_9q-oGz|y%vv!41+lH?zdMtfh;@1y6Kfw2gXdM+OsI|U`?rj zc#8z(yanUzhyYgYn;+XBIc`kv#6|4Nr9X&mlJC43Y1VbW7=!#wRYgZ*Oo&l)X-I89 zYw+V35iHyEQBA;R>KN*|(%MQ7U_1J-xq*zIXpyiz2I}Z9{3^6#ncdvSW_ZVmp4uaa zxYmOIUTZ%Sk)n08=>DOcn+hHcv8}l-c|T8(9x_;{JJ;P7D%;oJKi`@|z>y{8<@*w1 zb=%q;iSm8lKJKPr!Yz{{Qn;#3$ITGdzMt>i{Sj?9_zE$X<$v>}%$h#N`?)y+V#Utj zcAOis-xldlkx@!^Ag_SONy$=d-bvOaYCUxEjMwGC z6q~tOw z?xB`s9Ywp-9}v1G__u_-v<>~qZL~J-cIR&q_lFwrB8>)%gSV#j#f}xgO+w{rU3^6}A&Fk6SXh<$y0t7}d4azFbS@ zu;|KBR%UQ7TRX426%Dx*H>(qr+^Bz1R&Y7>Rq*6_;I(B6W;o%}#w|3IuGvpaI2I>T zU3)JR4-6v$?SlIW_0B|E3#OPo>iOr1#syBdI2n?)@+&avx|GLfNmwM!X41E1>fhSj z$gt|tHqO=8*VCWpVek4S~1&^Mgvb^y3RIb00OUa)%?y0|2z@iEV{- z^YO7|I|tZg5oa&(M%IAuitZ{q|J%9k?8-BSiiit~EOl4{=IqR#US9ebI1Wd0U}pX4 z)2CZ~p+or91WVIIq&^+tvDZtTNaHU!wC&3eJLpY7_Gnist0Ee&zkPh0K$j|!*h ze;vPnz5c4u0?aEOeGrd%eNTGvLOPkt1alg^gCObrJvHk`0KIeme^)e5BD9@Y(IGfj zl?!bR;}oKj8{;{LxkKdKk!7GN9s|Z_oO97n1twwP?lY|W7^yDybCnLY<$k?VRI9b; zB8TGUla#%rq|D4Gxm?P~wM}o!z7ou|=nUWHyl~6Fz`yM}>|yRn9mYP<3qaura z6Bedwwq{uBskm_;_W4-ykF2bSOUrmK!%XiJQfLZIV^3-U$Zwj-3Gwmy;!(6|H1r&6 zBTqTeKspNnB*@~)xxXRwb;}mS*HiGTwfyuG2tq>#`k~HEO&HDHTX%x!WwH z1{}n^=ceq_X|%PqmzGy$wcIg3mic>sYuwV+{fZ;)2B^K&nxB1?`oDWLN~fK|^g4+= z*?klAjJvZ&p>@C)ajnfcLIo-%6{ygedw2b0Jm-q9kIz!;DAK$z3b+i!5!{K@kyYto z%uLTatewZS6k~NPWl_OHlkIWx%W;=qymHqv|LDaEArEehc=s;g$rT1%p#GF$$duzS zdr~;pp|QR8Wug*WfKG=r4T4K1-8Q6KjtYOWvyD+La3Z`$FKydF=`>2)!lBiJ;Uw#D z?`);{g*#(XxUfh0EGm8!06baJFQ*{NA&_NVuNSnTH6ySYcO1?4obS0T{Md#;MdII9 z_Ytkb$d89%Fm=N898ZDsIk-7j^@;a6Zr-N0P2%JSGFEi=TS%cJ^?%Qv{ORtVZc5Sl zJhG{2h;6xpZGYKi_k)Mui?lig;CsOiE#XEco1*=kebQ@iGKHLJ+lB5SXMOdZ-z|?6 zPRxX3l}IlF49`?**{Y+1JNPkN?Qy*WU!k^H7etL6uQ1-Gk#GsK$uzlj`n|g;2q!L{ zM_PO&AWlm}^QP81o&6 z{GTWVCiWe7bPj7<8XCq1aeIJn1iyj`8-A6Up4Z-Yy0_ntb#WkjmBZ(ZW~W%owMF zcyPL%FFbn7XXRfUHVfnJANq3< z1A!&Wj$Cr|XMoIzTcWSB zD(zGwtIW-^x(M>c$ufqbLlZypIm#~YNDxov)e=`YYqr9vlRr?~k$1l(n-h;v+}zA3 z&RAdNwkPrE1>LQ#uC8dT^>lSFWwKpA2oG%DqU9ZRF_NOKVhJ3u$9P+Qr;F;)A&-Ov zQ+I7lu3JAlvct*Puwts)ltLj$Mvmf_6)f&9c8fio+PmxT;b6vML_jeH+n_A%Zpg7C zr{{UzxxR8OTUQ*ly=nG68)pMiw3vyA?=Ol9S z-Wk-Cq?O>mESa|Pc;0m;%&SNUa%L}!Vne?S;&N;2r=d+*cu;= z>z3>W72qTMASgb*Y%3FN#SSz2RW8{rPRJE-0Kv0p&kq5sEgi+dp6fyP5+Wp=ggzgB zogMzKe0#J+Ax62KF$`#>_aRrxno6 zJM_G}3DxGyzso2s1kUzE1qM&%V*kInW?ZP!g7Ct{+Zl2GQ2`tsc9#gGrF9bUV?B2E zsy#KS;3%Lz`1L)t9{JhbxxSjveRX%v&Ds?6=Bx3Sww;;n>kboi_?2hPu>Z8mt;NZr z*@0!d4G|~*9rL65`udM^as(!sg@)5$z)5%hu1`yfj`2z+2H)MdyZ%R>I{co)&Q=CI zt8pYy-Evoq0}-f#^)FgyAkG!ytu5?Cd3Rk9%Kdn`r@Ot6@^j3G>0GkQ5cb<8;`S{> z#EKub4ZZzUL8!Lu6|l+y6MU;Fehg%sxS{m)dRSUYOG~>CP+p|kyO(gc!{`5eci{|o zy!>0VS^ya#*=stDkk4~<0kRDbVsTTz!S9o0`O6fib&N-0zWxq)m09wcS*4ALwYGg- z_D_T2S@6bw@7WXZxBB_FQPa*Lf+5Sg^;;GIk8D@rP7x78H8heo7n)@ZNS@SK;1u)B z-d&KK8!Z`dU#dVZ&V8vInE)8XiejjDoP%Q`y+zbz#lMx?xFO@VK1|aZ^9S&3zkdA! zU5Nv@bG%0yw*(~XA0)j}+H7}JYBm!H3yz@WdkYr4YC!@3?ckVgX8%&z@eeHfLqZ5j z7J;!piu^kcc|>8-{EqY?ztz<|Rdxc~Pp4&vQG4=F!{HM|ky50-dXvRB_UV7tjfc#V zK5pH*?Uc%=TUmm9nv@Ou_R|-yRIL_e`wO9P2k~2t8aJY%cE>2Z ze+({MNJ^MiD=0*7ny8-XnTjBuwGvYN#M|dmQ=N*M$X{Q0DeOgCT34s|w_N7_S1wbb z#yK-R-~at7S^l2A<>_~CUw%PR1~_7cvvfuaAXqq#%F$ zbzP+gyJoiQ{NXM>%kM}XGHFi*`$y!uzQdsdNS-(@#za~C@xMzy$p5a%q2QiU&)aKL zy3LylM>Jt&gS1}r=H&gwr<+R3+CtSdC_FG!xyBY?>bMUEF*{*ZW=Zd)IgFi2-X(XDuOf$`Cj_gt(>-Qpj7_g6pG!!eb-E za7N>mSPVdKAxSCbp|jZ1xTWGShnO4djHukll4ezNxHdwt)Nggs!^^vGdVSUVsK8A6 zC>Yw^x2!prNy9kc| zTLii=b|6v(|2!bU+f0DTD!t&Hjgb&)F{^k1&8uM?TzSo*}ydrcU-pp`(NvY}Uq#3_PyQ6?XjhR7qC zfM5a3!@>XxjIR0|W~&Mgr=f0bYtu6~Kb;j0tVH$S`#28qNbm0iWo!&XkjL-dy_afP zPLWX6a0+7*+zd(2B$7Eep5W}v$<3v9nv7H(t@p=g+kJrT2^8r#qkQ}U;^){6metmB zXjU`J)F)eNf^}5`9c_AkGnV~(ootR8&CH(l)kU-S6IHfKQrq?JW**x$!txiL5Ug8KM(*5SgjX(n?8fcK3c%t&07nA?@J5rnE zC?6bgb;TRlVi1OcWorH2b#R6ZCFgI;VeE*%^_Z?PeBX%h0j(qF-HCL{?!#j$_;hy@!pW6qYe$40} z8cw_uxNCE85##qf;w2SYB0!+^wUJ4LIs$ITe&q%ftS%A}W4tPh_XLLRxtHSoDsX;* zRQBV4OVNF|~7NKk7i3&)+(rpqHCi2$!_HgckQR@4~qT((3$Hl{E z1#bCP$$j&jdlgl*xhWoF0aDqITtnG!k)neoU2Y!@3t}WaKg|T`9277jN9n3s6*^pL z+FpZKdlyMjD69Tm3I8UO6w@eGZx-D39Tr_Lsk0ln3VckKfrHmtbzl_2Tx#+8i ze=FoEKBjiy0EXUGuY3etj{^dc9if+lRTT)x}BDf;*FM$Bj@BwVuq+ z&diL31+ZDW?G9p2y|OSN4~-wXVdeJR&45NRCfotOl?Hz)L1s9j(R0y(i}M2*^u+f6 z>OWrDOHfiHVc&;+f_C~H2WPvFUf!X1UFZ6G#>n5yYSu!Wc9x6lTTRpT5v4TZD^RSv zNt}FKSq%G6`N6>XQ-2Ji2F&+SH*}TxHI({wsz$kqZp4mXjLK6~Qfgpvo6H^){5EyU zt8vZAr?cfbx`u{=D@JBD(n>}Z@3zO`8Y5}_5cVFW56~$;fJm810^p&c@ilFXeq82y z(HD<_8#kPchSCmGuB%7>o;Q6LA>G#NS(^S$x|?7a+K;pa0GzQwz8}5?EhveP`p&W@ zjT^zJ3uVgCT3|YHKI6_|rBMocZ5X{bs)ynJ0fv-seVKKB0}w}r?wRE>$lZ&R${Y zn%R?Q(qPHF&nV@cYWpR*S*@_c2gik-0tbZ4e|(zVwISm6q9-%&mRig-i+P_4|Js@j z$5j&U^gj0ccwt*BRP8(pE!#jsJxD<(_%4eVQ#Vb1%O0bvl;Efmt0oYyTdLFcq#*IG z5Bz)Aw-BeNyAdw1edqQ+{ln5wFTPjL<~YEi?VrmdE!`~LHx_P1`ED;u_;6#T5&zan zl0UDzy3WKc@yby5y|P$y|q8 zjy~}1x^rtFxR8X#zOt&mF-UY|duZxiVe_ns{>6aC5WWxmM-IsAef?m0U(}I;#Nk6= zzw|HJod& zlX4Ed3lqPSF5~&NX{ydK-9F2IxR}&<#XhaIagcM%)l&h7a$UPeET0tIm0v&Hugoy| zBcCGm_Oy3YCN)X+)_YrqI^(FiRM?(cTAlt7c)B)~TTNNVk89DS;nPtXd&d~LX{Nq9 z^YZC*HIno9XQ=TJ1}hR|&uA|0bfXt}{5WZk<{gIrZgqOH0}YUIIzVtWM!r_ z(qt9iWIf{Hx7qe?%C8# zRu~rjvDZPag`9!PoN)^u@3{dNgBf16b@2-GsIZa!_m$k}JB6aU)D({61hiAz`u;}S z=-ZZ{sWVSr1W3AzP&|0xb5&2Tw<4-#;%)iIK+a3(u+-MX8WOmd^*0;J-%g_chW`;8 zCe}&}sJu{;>FMjANE}m!KLOLZbH2yRUnaPW`yRi1^{oc4Mut^VGbI}=fsTudXC}py z5%&>-w_Y6;4gA|kJ=o>(gxt5PU+=vo#mS(m(l7ONM4><@dOsLMwp#S$L=>U;74JXj zij;!l_QS}GNVXV_T14pqfXfzkv5Jv)4!7%v$Bj^Pp{CUhV;Nr-&Mj*%-v3lgVJc#0 z6#egTCdPBV@pU@WL&LMLj&gRZ?-Jh@&^EH$c{x-w`qdQcjX!=mXg-bWbnI4QbOI-Q zXBKnYAQ_tlYp$!M#Pe65MEwhYeo>h-A)-Xj{rl3uC*LGQXZ>gmPO8Ii628UXmW-9veXr+Xy1Ddrsk+$JPI;3Y}B60tI_^#cy ztYBzsk1o}>e`_Jq6V*6w{%HyLe>8n}JXinwemkY9sYGN)LdZ%Pnb~ENtn4zgdsj#@ zGBYB3kId{Mn`CDtduFAG@Vic*-}nC>dYyBgD$1GEbI9prT&4Xhk^^- zhbi5hcl{~Xo4B^-a_`=n(CH-`dm@nK_foB;#0Ja*WBij`(}jBpj2JWhBn$SPiu})W z^xn6=)fV)5Cb|vmcA|tD-1-}c_A%AqmKKQ@&4s|d^%3FWsRn{j{{to>DRod{odIb) z7Y$3@kqZ~}wqZfhW{Ua?Tbw-ji3B*-+S^;*(e#qG*fzUmsG zL+>nVx8rs?{k4qF!HlKHY1wT0=V9=r7IQ;oC|i#`o_sy}_B{L4){XBaD+-tiCv9FE z3wN_$DR-h0`zuuIRcNBTQ|Z_Rbypr=LGjNExNIXfuQvTj`|s+6_4oBmR*=F zNV+tFSG|~f=dO8}^Dd_b&3KKN!~5J;qHr4=S-ke=p!up0L%iB3hu))TJI%wT%_Bxz zTZKb)Q_=@!zcJgMRkx9u71wPqsT*ziZ}otU_EheG+lE-+O`mIyEOfLSO&)#mXSnZw zc^tIN4Z1!T0{TF+i;$lvRmJ<%{;qsBmb6k4#2&s zw6(9LhUoPNjDs5soI-3p*AZa2xZ+#=e%zk+?|_pbYahvn@C>IShZ#ywIql(vdT#-z z#c=nu!lTX;+h^=%_uj3E{Z;CE_P_b8K8NLH-db6mq3>R#u+6#G$0qd3|FuNiB_a7@ z*Ta`IN%iGh?raPC$<$!^v-arP_kAdWV!NM*tv))D7%8`u&gl1KH={-@qt>3SPyUkS zrG76A+af!+&Gy^V!#8-bY{7v2@*U3<4-=;Gwg8uzsHfzHNExwi4 z;)gn%U5uJ4pV_9G&*bplR@Me?)5so_39RuEaulGa|Ks_fhn<#ra{MN=++1C^c6}+* z6EC)%5>6{H&;7e`6CF^&U+cex_Va^o9g>NMEdDisw>a!*J^e=#Ajfb%c43so!D?c> z*Y@EVAO9u{C?FqhD^X!{jpFp&{&X)PwW;x?yfxu_PQh>?FKHIDveW3?jfH89Cax4l zke@j-Jo)_tR9l!4CH^YTVdmp=P<@B-+^68=P^lDsJg5xiw?Hh&h1DKXfdQ?{@-BR# zN%wV)F3qZaoGCo|sn+egr|UVz=-fJkng+EvRbEr&X+5$1yg!$xGyS@*{#viqu-ao| zTL0LBRmd^j)n`edq}Y3}Usc`2{q_3(Kv~x5wxPaW0hi4erN5&;Kj+)(wyM-Ft+^y; zrOId7c76QTnblS?ITE4W>^*LWu|&%F>rm1 zwq$e78-NcaJL|0@@3w3V47(4#hFd|l(cm@L)7LchR#ZVhgMV^@R+20@0~2W_W;O|d zjG^I$--?Thb4*t(@-vx8gg?ix57v{a>zYMUka@|*M%LHYOB$7&+SUB7pun)EBjx33 zzMvw~lb0WTy__iXrs1_h++=SNXX=%2v@>L9O-<`%ukyPM3HP>4E$lNIAFuBVtGqz7 zY|_|M(E|r3?!wMfS<*ed36i)FcF6voy2cjT*nZ%-V*D;qomlz0ht2b^r`A5}9MoTn zwT&)IG%BgNl6srH-PFj)ZLYT(5=+;mM|R&V_J9U^l2uI@reP;fk_+u);{=z#r`&*) z0NpG7gg9)MMzhq#Ps#E)fx+9$?}bMA{nq#G81zC1-LfAM3 zCdn1yp8&dm7L7Ur0HQ7kP6wzso;i@7;<(qrh$-%8L_bb-B}f;142$dflo6+Qd~PJ_8I8E(K-T{r+s-#O~)lKAk?YGzZOiyulI%xC36-+phfG zH|o?r$>0GXUyRHEybf{%D8_S*r$~82f`d;4GRTg8%h0fyX>$i*R}pP2-b=z}kY?!U z=Qk0j*mO)b%26kjI{)ElJ~m3cn~0h_SG4XL8+(Du%EB^>Kjhd#6G~1eKG}r{Pt}C7N?f%I3?!j_d9KB63_#g+uXNX zBU_OsAv7hHJWof9L=mL0I;k&si(JT#1tCaDAYP{YY~r998+>g>h2W#4-_)CkkcOJ! zAI75w1`>4@)DVDGy*dm?V5$_e!!25X30LhQb{-z1{@3jNCAQx4>%R@4ddJ{A_d~Y| zLuD+8f09=Hr6AnlLl}G9AV4U0_oF8gBK|9b5en!E!9a1o6chI8*Bk=qr=E$<4_1J9 zbzbA}rlowvwU%h12?S%EsR)&!*V_o^f~iis<%h=yDr7^2X>9Guw!befo;E8?IZx8# zNtA}Ug)NQkNxVPn)T#e4JjeI~q6bwVhv$fd%9}8zF4HI^##Bm1O&<~-=z`|xpAvn< zG(zcHX@Cvc4J)43vMa(gP!OYl050CkCUp>gS@kGK;xCCD$(ze6b0Q*wkVj*DZELOh zY8DZBwKr_Q5uey`5d~(t4ri<*+sFc&3x6bhfmVEcnzmuc%!x z`|@E!gi63aK~UQ?ZBAZZJiCB8jDalByH?@y@PS%{qvK;xuVj!<;gA0e4aq(VQNQ|Xfg|7~QCMBx>scz` z!rXk8p4y3sJ37m4(a|8VY!x^ba1Cq8 zzp9ZA^-`W`yGMw5@50)znHKFdrM~8-rjGK=h=_=PzcJ+BZ)`<+)ctN>a7L_d+Uy`P zxoc+D1gMgDbN!R8EDOI9u77+&gpeAwL`iB>L3uwf9p^>N|Kh(%ZkIv$qDIk)marA^uUZMv3Bl(7SxX)xF#p` zPH#ds65MfOMtbBlqnZ|hzv4CK9Q)ix>O}}1!T-hFr`qHT!$qSODF8^Mg+_U_>h0(2uc%Tx%~Pb1AOY?+>KxDbh!G`9PXmW50NBkMow` ze)r+r?(#0E=ePZu?x3cj5e~?h@Hxw^4}z2pV$cas`z2?h5Syowl9D12@iSpi{%Cxj zdqGG+Spb^)>yD3yK;V1y^dtj5{4*RUIK7QJvnr(QmID2);b{;6!K*bt<8!n^IMTLh zlAbc`isZ!sXZm*&D|HFMGd_b874RE@TBWBqc4g|Y;ZMF*AU(xO!_MSY zUgqSssICPEo_dXkjUh~Nol2iK%^Tt+SA!UDG;*6i_t|(~B8b==>w`9v$x7gQg0*^P zigw4t%CPe!YJl&lm0lcQ93Q`Rlx)nVIsD2;jETsFwlL%nKBNGXtMSj_)m0_--UT)+RfM}#7U&+B`1k?2&Uq7t%@-uwXc7)S;Ytt3tW!f@gyT5k{XTtjv! z0b!3>{;2GdIaY(x=ihUE4E1H0heUK`Twq~&iL%sfS@U1fax$PJSb^#1=#>*>MgM!9 zfR6l`#9ln|mZjMa4luZKst^HRZBYNhjJ0wTddkTR4HoV9{ujjkhR5e*!5)0?Joch@ zKD4D?G5~1O7$h(P&JwDsukE}Q11%%C>3};3+0PS@!k6b$LR&BMgHM!!PB5I0Di_I0 zcZ>=mZY*iifcsWIer&ux&=cZjMOJPVs?T*b#HKPpw#uJ2SKOR0v5AY^6t z?!|sK1GvVduw(CDPn*3GrXr}2Uh|ut+}LyAJG4{VFd}XFP2D=vowYr?L%udJBJCn{ zP?CaEx4=)x4N^RHe)8nu!)#zh;9z0Pepi11z9z(K1&>K`Q859`+g0z{_5Dv0k%krs zdHFEakq?m$KM4^RE^|VyD|?Pl-}re7ZcsR2NG-J+pE5Ech9cwEaO#OBqkI2giVWem z9VS}SZRlmDxlBG`LIX0R`Cd^2^Z;aS!qrg6Z^l%?pb9L8lsUcB%Hco3^- zFlZ^QQ|cHvWLgW`7c@nnxioKmEt$z?%w>B#G8jWAdi)4Wwu1c8Bg)6K<&Uyo?wXs^ zE-C5m%I{JwIk9^;zx<7A+4SAj+m4GZt?VTg((-;CX8&Q`Ai=e_?@nR<0!GqIjF|Nd$3 z^mt7U1_T2yZMG2zgp5bbtGS|=PJ*8WPw?tOUD+(=8X?k&I zs599PqEH0b%=+@@nBJGSAIZZ>bHDoukrcTSxz?>;8@&PHGF@(KvbM7MJH>^<2epXT zHX)&ojy9F-=w5CUlYp{s&ekc~ZzPoxCC=@+7|L2z-xFr{hA$>A!zU#rrGt9o3(i3l zL9Z*j*zQ`u$PkHh0!Jhp%TG?I8FkneR{CChEaDc!^uU%5J%%lXH7(ouT8s>ob--{#S z#VgZdAc;Rn(H0z7aj$qpM9}s2_U?ZvyQ!I~GVw=fi_p)w(+j%Zl#}z*>MIZ&eDRYum;oUtfa}wdi ze~$>;4_XF>hl|6!DI!OeB?iBhRT~>UX-FHNZHjusUvz>@SWH8Mh!U*lFj&=FL`ih7 z+(8a!odf+x(nE34%4FN29yBU3@!ld_TRS7)gk5#W>4?#H!d88+oaRwnT&&LyAxV@V zza2ynE)=sr78jQ8_4%G7SFdWTeDbERV906m$SII@49uI6Gbbq_Aur#d217|g=4ITO zLr3{*2By@r>XN&dSdCHCj7i zo06VjrmZh&b98h>OxfSdl0gITuSG5jjRs6up$b#<49M6`AtVbU<@iHS&sbQPsTTS| z_0x(a0V2ygn3x>MQUXsYQ@gwgp+8|)4fc=ym|fs^RNj8ns2M!meWZttKK2)d6$`Nl z2=v_{gTikCS%s3RtQB+|%rD->iT}iI1!3ue?NuGgjDkBh0m-VZu>$)K((&@D#jL|L zi<5Xprq7=-OJ2yoC+5vz-Fv0gj$Z#PY#0a*3d3Q_%McOU{rKi%P#-{yWBq5kw@)z> z>wNad;Q-NK3JUDwP2)`e6R%B_PqODFCB7?h;g*X zLCPj57|A2NDs&DWJh*3hrnW4CCk19SzXSx0VHD^mEHXxEZ8!@Yz3Ase?pzB-OV3;$ zJ$h7-LCb8U_Y}-CDdl4>s|)|(!x0H&9&U$Ok#zpHL)T>p=MOf?D;`U2_c^7~M-Ks> zJ8ZTH?H>>aEm;yLwai01JG!f@n9U4dy*DIXhAfQw)>n4t_?M>I8E}U^vw<&Ej8k`J z|Nect=roAUy<}(C@pF09T%UI9Z&I;@+RLTUKe}`ZIDxQ~k(wPs7N_{K{uq6>)4cYR zEX`MZL1y*fJEHYVh^}0@umRj);lqC{YUPoCtj8|{Cc`NkoD!et<+aZ(Q}rX^S>v|& zBxkIV(_&ckn)B-0$93%!pc~rEb@>3@RIJc0lgSEvbI}Wx3-F`cUbG4w6+ioceLc)l z@*MO$oTL|eNx)%EdAM#98liP5-hG+L33MhVCb1A;Ka)8MM`b07b8qluLtkP96+LN^ zPvZox`89)3QeH^<$Pzva7to;H`1*D`gYUTu3$toVr_XR0FXL6*54LBb?S!*l9XFh92|aKbCb9nb6A6BoOC^JjZ=Jq=kk z$j(L-Rk2~uBCi)xnM-3Wgt=KJMW6j#kadU93TPIk8hLMX0*@W5@oiq_Ly-zDlYXBR zjf63;k~^)!wEvcXhsQP<3Lal8ZtlNbi9QWY42m`NhTCv69cPihejw}QE@~yw0ExQe z=H}xQp1VH}GQ@c^^E!;OcsSidS*^0sa{?@6~LBcKW&g_y2{5pSf_;C-#1Q z0PKCFjm23e>H{ZAk|Gisn5@0F!H4g0%TN{6{dcgM&)p6aUuI2H$&8Q9V2!JJIaK%Y zDYW!Tg*Tq&HTb;@sMpW4>`y zYsLmQG9I$0Ab>>CLuIhoMPn&$Lh0Ca3WG>$T3RlAc!I;_h)7DQAjX)WvKJ>=r6xye zrFx{Xgo$E9#`rssKVomu|NTRhAZjti_JMO}H8enSyNQ0Se`Q0hg#0m1r~Xn~ z>40NjkL%8*t2qPk0~Js5oK(RO)sgGlt*xa(ndxj92MzF8@G2m@!utv=CzP*m!*5o$ zeMpdi)znJ>GEwvv`r$hIZoPV$0H2{Uprxa$XIk6(`RivKjICH+^Pgf6uVu+P1)FEo zbfENEJ(oQ*Jw1Ij?Sp1)^5kS5b8JgWgL5oMcMEc=uN8Znx52@G-xkk4CY;MhaRcdx z%h1P32HwFgUX6hh5Men(gb%uZxK5l@GVgM7hLKlvyQ7Ogi*yAir5R4eCrk$k`2!rpfyv$#XSw zYN4!+2%jcrH#rUx!SLiz73PWGXQvzfQRT{wp6=;??-)$Ib1w%b0nE2kDxrrNJ>u{J zb;Kk1Z#{P1AVi{?T?a@H*Rr^|7NyhCp_ZVPBNKy-W%GqKw%f1eg7~N;)Ff$g(P1!m z5(0N&d}tP9tZHiNkNqX~8pMa@hK-}EY3mb@Tj9^CUkDc{7b`Pa3~sKiYku6Z`!tZ< zn3efl-2pyfDxsQh^kr$N0x8PmmCa&O)s{$%yx}G8kpABO)5j1ykNDXMN81KjL1vwjrUf zKgx5_>pIu?F|fq82?`1(G)Kd*^;j@Okoqqq$o8ozrYe&+1g9~kdOeF)N9y?rbMut> zsd{X%ghS#-I6kG?7)J@XtPPA5a9z1_zb*M_Iow`W#&4za@^j+-?^jpn&|h7UDQrjh zbG#|HoR+=4@7lW2^!h%(lkP*f z1$yCIY~K=f<$lL=*1pm9O6?E*kv_m~n9n~x%VVk7&>OC1J$~fWsnDT(?Q&;Ht;2`S zKz46Vy=^6U<5H3`8SkCcXCWac351cwBYE=vfeIzbU2QE4isJ&fBqW!I$D|)Nq@O1t zr-y@Vh=Wt1VRvTpu&4im$eA-|X20g_*3!}{4d-sQa(6$^7ItJ}bYLGCOm01J+GUM*ack`?4+0xmgZ0WC}XP z9}+hpN-G6vX{bWt577wQyHA=V3xMa5(%0|?@Oi>~X4Bc3?SqjS{)9#E77g;yG z;qvbJIj)d-Pt5rcmF&s}0oYeHdP9YiZ9Q}63Tpq8XGbHYXjoZUnfZAo`AXNse;B63 zNB%po6Y|4vNYN=cJC{DvlRfh6z%g9Bjc0f)Bvrp!@7S5(v?5VQ2@|QS?=7h?UXDQs z_kMC_W|9}s_B}%}KwwKNf)LmcSBZ6!?9t<=CEmq~O?@fiJX!6{>DopcCFpjka1|7b zcNy~3;`xyi)H5A?3_8g|DEAC7q z=exHH1!{1gHmU=g`QG3XP~p1=-e8vzx#P&KT&P+{RdfGq{61uA;FLS;;^I5e!~=T4^d4TBqkcZf8TME)kwG)*YjhM z^_3C(+0)=#lbyIPT%dcq*rs=3`ejar{C_8;Lze`u1Sx>rk~vWF4skPR`G#gD7(%n2 z7SGL5)Kgcb3Gq0NO5iI_cI75vB}c-wKsJ&unAPKsoAl1ZhY5tNMD`7d%iq%yVQOIK zUfNVGeVr-jSeNhKhDn>ycndV#(&(b^>X|m8XvWq1XSx@0)(S1{82&|DE!Q2z8y!1Y zI{_t{l_=fO$ELrg(SfdwPbiVo#KpRPwFr?){Uh37!NbYTeN#l_LgUZ(yKb!hdQSW5 z{Hbr>GI}c97#0`F=YO4Y6&y1&`&wvvYKF(`ty7kEY^+4x$#kjE&2c<18bL zxtV4~)U5~}CFCD9YZSx_Ql2>BUgEhIGJs+I>)TF>y{NO@Y9TuPqJTZ*7u5|I81y;9 zH06RCpTqtlx*#G!@wamis)zBQ(@x3U>sUL4t_Q}m?7(^FWs*`zCvsW3|?2^u_`AFVq>!?_TT zb3A{ha|BR*wiOwii)ldp`a%A^^HqbV{O${aqJ~_ULl;+8#oLe{+(3#>qnJj{B!)?>-@KE`0nFK z3%AO0=45Brg?Vd#g-gUhUm@X%&BeoGc8=mI+@FhA+B-VpJ<=|g^Jb47xQlD*5s$HO zRgDkPwr9AsT};tq2rygaej){_6y(jD@<-lI2@gwhv#KT~g48(`ta|+tNRxM9&PHZ&U>P z`$jaN$t5A4?Ffeit=F!iKR*h6DR^_D@rNYOz3}%TTJXTlO}t^@r#F3QBMi=y2vufm6l+W=1ZP{CBs(jYDGn5s(7j6GsS3wcBYbTT|In zO=}B7JE2pHF$?1u<>ambR)^}O(U!i=4M{D)it4hy>j!ZZ!2}wmQo^BUvL~?UbrJYl zEUxy`>(Z`0!>TC(m0equC_%*NV7fwFPEY!kQ-+^B6*)295={fob8aP69J1$xWD((O zJKe1!q46JZa7cqtv-TI;N)I`mVA6aID24-N8KefEAjxF1G!nFQYp!GaS^kH z;fWCuWD`8dP~&XhIa*;vM8Rj?@!`PGAHFgEZ_n5GkypVHD%;*lQPn_3_0gl=2SbsS zXlHREBwS2kl>;l!d3AxhDp>SwHj^BB=f4G+b!UF7+R?CM`8onPOXhPK^PF2I=lA=2t(qpme)54wf&QPg7-%frJ8 z^$3G4qm>?t?aDtt!wTam_)p1NY(^>X{h+B>5O zSzMxDzI=J>Hdx+Y_HbvdRB*CF(xD8nO?!S$SoLt;23pX|KE^AC?ZISXT#wZeTx>ZV zAsr@3_TRmUV`8GB3yfEk1885VZT=m$!RU}fhFI{aiq-Iv(hTFb2mD0RBaenamV(~{ zec~l9(-%b-o;18;)>2QAjNO_myE~^D<>^7dC2${N)HM(jl#}~CHyGV@vOV2c$!@lv zN%CcbB9;(gFc?cGjj>^H$B+a~QqzUCEZE;D;nvl5S$FN^PC=OoSF(rJ4`Xh=;lst# zuzZd1p%F{FBNNT#jXlq4{P&SQN6)El$n~|Zie zRhw%$XlF54zWCF7_mB|a_{Ei9bUNkE%J$alsfxl!;+54aX%(1Jrt#U&)*)kpM8GKo zA$nhmwfJ9zu++yhDLt^U83lZ=Npc|QimX_gTHGF36UWX!-oAQH5dEms3ApK^d`q4h zr?+L?{|+|$IL*~^Ee2Hlj7>~((D4#Zb{WOCoVH}&pP zKKr)U`sF&;lbvMMl5*hZ|2y{J#a&F)#(78eb6a@7_E|5s(Iw20|FR5Vlsg$9`XXG; zW@uP!_Q$Neib`l-_>_T#;Z1%0_^YQyaef03xiLpUk@|gF-ILdvUJ8fXErJ*Z5D`O- zx5W_={S$IPa3vKamj|akh`*ofI3`7WZy28xnDyO+$LIm;3B#q16z9LI3SO_6b-F*l zA!djW5v?VZ%Mk-=z*E4?L-~%oXEQ2314)Jh9z)t?j=wrb&;}A67;>P8=7v5l9%E=L z`wiXe!(>fz%*QT8@r(1Gjj$PD03_2_%vC5N3`0-uIZDbr*=evf zH=u0w;6s98GfVynk|(9A!Iy3k#)di-cN$z#Tu(u~4I6s`o@+MkzUs6@3&HZoiMpdr z-p6Ca=fCmV`EwDj$`7z={|g1TX!DGaHEzFJe5!tOfqEu>!p3G8XuUk*BJ-n!+3 zVy_JvWP#GsgbcoZhM4ivxdNU#4*am`3f-lfZ+F*Y+ZGcVo%o+{zt;pD|h zfTAFLqQ{?&dAes2Kul`!d-(!q2gByDz!7bh1dNxaN`i&Kbwlx)1Q)wUT;^*74SrC;0Qsx-AFBFeUA=$2IqJ<=7nKt~ zKcULbgW(mYtAOwAG{g7R%t?31#(-fd(n&Mh;=0zS^{|o&Z!o>qI^eYO{N>A_^Z*Gg zYY?lBg;bT#lRkN?ii4c72?zPUgD(DE43|j4;9pPFj~wU@)FGK%l?*IDW5`U>K-8TW zqXyjx3k;(@N=VZmpl}*kU!f3mel5N-x2ORN8J(g4VKMLFp7-qh7$o;?(@vS1ni`rI zd779=pFiEz-0Bqz7b)zy1PXq?No&MnBqEx7dAe`Kv!yc(@Zb8v(4)fpi=FkZa3*@2 zSiMqTqkUM>}+CY;>~Df$pHYubf1kasWxWz*tkP#L*fb@~Wr&_E#NO zFC#51!6ixdcwV0VhwmRXVIUr*D_w~mBF^)0TtY&y9+?;&{fN zn~4G#=@5npP2rpqp53=j^M?QnUeJi(HtR1Xe~dw8Lgbrs;8SYyxkX`wx8IB1ZSyb6 za!S<5#NA=8SLFeQJ9h?(@syruB)+SrkfB~y^h`PqXbaIC5h`i3y+Ms zU~}2}i>!bqGhlwG*w9qu%w<)S{~^@9T70&{=o9*j9zJ!no#C+lZMI)k^~>MF!KYAkcbnD*U0D^s~T}LD=1{XdUrA4k|`|%2u zvkQ$zU$di78}gp1)G56#CwF+~&YcO>i86L4F77x2vWMdDK>L!O2@d{fMsDtqwC+qv zZoC?-hxqLmN?mdLrD3Xl-`ce`_oF{QQc^;;Cd%H2DBUK|5m9zA@fCW;f+c~uO zUQ%Jw$Em3N4Cya=Z7a5!{xqmji1|knm9|Q%zGUL9sHQ;A!#yR|3@GTYn72NutbVb$ zKG_PlG=_F|34$8G`e*fRT-?vwv5cc@w&7PSWm~SfoG|NZYBen$8Sx%_^)cJORlt{fEz+s)I#7sFtei(XjCDxT>D zgrgtJoc=hC+=TE-6xP)h_to~3l1lSCFf-u(N_ZI@+%`^tip(sMK|Oy&0qpqu`@hZR zu3hG6jMhPt=@Wly;!uo?ilP)Ou}?w^qEi+~PZE}ZgAvJ7ss)eOUG^S$i{26bmlEef z7D&OOy2{IEbz`5kSB@eSrI^Fv4*xyd7n(WK+0l`#Qg}&&$C7@w{@Bf}O@7#g#K{y{ z0TtE-`U|5qBR)!l2KZeAqjP!1xW>TplJD2du~VmN-|*Y3R_H$M(A`wtoTnwjoEJP< zcwezQ)f_;x9dJP@3g>zb@Oyx;?1+tJqm-7FHH3ALs!H;8vO#3LKjV@V#H@ z)i~SwaX9c8SEAc1jo?l|%X!75H>g%F>IgBbE-KQ0$n=!MQ$_ry7*jlUli~O=Es_HS zoM?6Na^^DZ*^m9B^*l%SE`=fY6-=ASx$M$$P4dcw%D!1x`DFmbX$Rut07pm>D<^q& zGPzVLmW9>}sG@OeI=N|gR?9*e7Sr-nr?)g5&RH3sW10YuibJ`T?#A8kE?|61o~qqb zpy$~($S9G)NVwVoT#X4S;fMb@(k)-DKHKHtd-@{?cR^>AZX!bUdx@X1u`$650jn?Q z^ed}3d@kW385+6vgV)YDIS~H%dAvdx5vFKmQ4)r?OV9R2?kD+>YBQDRq`_^)oS*W4 zTmZ|@zgab2bGQ`8SGY~i%y8Owv4G+7A+0-$Nuylgnz-*>6BA}NnFjg#k2j2~(oU#J z1~JF|>kg&9ne1V*&Qjc)0B6Q{PvRZLWM#Erg~G@)JGrP&-wTKgpwx3VJgA3dx>?>35W6Nc_@z5 zGjej~T3*{rAThuex|XNNL=z~8P8%3FBvGhnK8M@Rz^z^vB`S-0&NC}`Jw!&zNIbZ_ zbM2SNtsgTwrf2a!Ck6xA_Z~dQ{4siXi(tb~jnt}LwWP#uBJ3(;BL$d@WnPTlwQMO{ zUkO%pNv;bMjc%-SrnxOihCbpbu50L^;}3})d1eL>e^)}v(D+U8M1t=LQni*$M1fZ9!`xr@a4kP;WATP(P*IkfQMvxQ1LtdLdko}qD)~#E_m$vVQ z!Jnfj*aSWAtQkO2PDB-PmfL)7d}U<=&Nd*c5QfFOotzR5`w(V5c<=PE5b;J1Pc^&! z=HF=gqIi9zwiXw!sZhybKf#T1a%xKQNbs;Aj-K$jIb!@nc%U9Twy((b98?UOFhvD( zo&!q-V45(nSGV_f;97O{y**pnovcKa!SaAR%J3H}wwsgTJ$v?ry1F7-WN;gr8bjIW zyd@P7mE(tTS?JRz$IDgX0|G>+-pCz4dh}!57x{WQ?wxIhI__SCD@}YLv8uSR^MEg{ zx-8!(>X!59u?j4{H7!t!EMPYytk!Unmh6TE8{CEQeo}%$I32)N9ZA^#NFejRk zOr4@i43M*#wZb=_?$N#T{xT7S1kJs1ccw-~)aa-_Tr?oStjqu#Pc!#s=Av^8K|T7@ z5Ine{{WdYN=JCg;!DP~gXe}28jYW9NnrDCX6?UX65d%V3cGF8>S-~MBfXz}{Ku`co z8I58i_Re&Lr>NPp9U4y}&4K>Umn9Hj)|RKMCEeW6+Pz~|@r5b16lJJ@v8kz^o_WSX zktleXrA{ldF`Qo4LZkkOGRVHEghv_3$4qpIRP6tNRgr(hnPPy*Z|f8Xw@mmI1}!)Rob!@o=`g8SJu*Ys?=K@?ep0bVwP zoNAF7IW(gQjy`9Cpko1hpW^o~@FR~(INS&YJH+o>*;IRlTW_=_CJw4Ss(J=m+)7&= zR`y%WnK+U$C#na}?SU-qR1N;T*g2U4C zl!{jwUN|7*`!GO-3gJ96GqZ@PinSdwYDINNyy*&=c3th z$SsmN==;a2y*fV>5IW9hJNX!FICXXPK_3nJz}6Bsx8U?)z{7urdHo|Jn>=i1tn?$) z;G{>`Yv2aZ$={QRtOFykcL-HV1-C`h0;O*-^U(ZEqk@~8dY;Lz0hi-b%@I7{U+Eee z?unJH5`-1C-n>;(vW{DrGGUb-vo7Ck+mxeL~g3u!Pa;91mHyBKwza zl|R%QPtGSFLVG|lV?PhH`X34AKzMun+M7PpojNnzJCD5h5sc1N+t5mq?@-(EHmeEO5%#} zTAiRm7Qka4pMxJ%_Qm0Rnfq4Oh&-&ZbxHrHEpi{)+S+1`R_5T%DRuhQFnXrY3+3gX zHb!}=&YqRVk)!s`lGMs`sT z5a7?J33H=V^Wj!)|JDeM!IsL8su<0&1XJ)Qv?gNsh zu*PSM2jP?fPbg+Hzxh91&arseL5$jelXi9ngAW9^EfQjhC{;E4L=BX*L&ij*pvanB zfH8$;k&PD^QHm*2CxX*YAIUid5*+}gUU=Dmt}J`vm-+07Sk zW1$0e6)kmbjQ?YL!f{O*+_w-mHQ`S}TiIrd_n3QocQ8fIKn6iC_a-&Fj1%cSM-CqJ zp%^eMF!^OdFB|o@`lq6X2LF$uxWvSpuTV&VlOwX{upz;UylU-14EmkN8f4}*azyvZ z?%A~fBK@?3Bl8b28`Vcwk^P>W;(Lcq0|OHi*6$^$LgUoXI%L)>+PW=j4=x`O(y5dv?)M z-%kz2W{JajEQ-(Sk{M$M%k<`+>;^B4l=W7#Oh&?y`ub7!EAcAP-xS4Z?C16FJ=$#9 z(%|Oe;vz&$;)NEfp{&x#qhmzR1I%7$pfA_S-W6yQ9gL?Oq?O6V_U>0P(*w0I#2tc@r+*Gia62Pk2@1qcf4{3!I0r!k8pxAjY z_)`da62Yo2&=ZH5om>{BAg#|th1J>9$(q6O=SfmQX4xf~Q1GTRQ^k*ff6)l1h>*E% z2RkewJeRW~-}vd9xCWWYyMh2=^ieJqpVGNdh`u+=17 zc-$GhFg5wQ+^u6=9~~bbp9iPSL9eaNtyaC-ui3hS&4Q)@K|#+X%LPvreYXC}sG6OLROeDn!4L^nq_7{;Q4CD1@HG-%o%65-D{tcKLnP98kNHN5cO&dKR% zL&vgc5EN_s1zcLpSGVq(&L`fQ>MUdfh4D1M$?+d{1HuM%^~{^w#u`r)xQdE? zve#G%64TOp0|tT~#jXI z;R;2#51X_kjRf!Zh1XeZm$*#6cjhte{XKg_T%1AL)K%^#v)471^!p0F6asZ%e3D7n)g3hQeOj4LI_N`t)l&!3lXbRQHy&DXp+5|txkQr!kf02_4 z^-KjOJ>E*&65xEN$9yMU0;29F$h1 zOegnUb=ABygO~Q8sXG*&XV~O7=Ooo1Lzag$;hemi<<5Up0d}Fv`82Vh+YrK*l|3(_ z7R;t|4I|I@t|K18U4D;#NfE-*KTZcB8~|`j%;KQjkv^w*W~Ylwuq^HVCvVk>YKt5_ z@9bc%C&&YwCbO!bV!5*4NszWijGua;iP(r?^W@hAQm`i!J?Zp!YDYzBmfCp1f;w6! z^2Tn`lfPR~R2F6Pptq@V$%WShixns&c9X8Fu4>s{z6NJB4xQEXuv!m6|fu;!ul zwKnv!MH%N%)4;PjU!BO5Kl1s zJd15E-xQu}4}cwcjnuSe7|9XT7u)->u#5TM{AR4f*4_vlKAV}IK2tmdq^XKU z9KcFqp)4Z!OcsJpFYLcRn+G}bk>exA_|6Nq{#zI?jh5RrjyJb*>gnE|A}1b~wUyAu@RZ>H-1nadXmpHDlP?#Tkc&1Pe*X|jh&ws{ni-~)%7?3ss0 zgRPbXFL^3v3j})~&_TV6%MJOH*yj|eL0ZaPtaM5Op6>Mg{bK|dE;)zuqmXW=<;kNM za1fbuhgx0GX8T~8`Vh6#(rCR1`e+m%>Dko%QwBJY(XXPR7%iSddyf%ykTbo4{DaGw z4kgNFs2fw^F4C(iw#7{U^Gmf{+LwoL&mB2-?1Dp%)RAYiH*nPj=i9W>plS6|34|+6 zg7A^HG~9A3NcDLYdJ6X~Y+B_aKQK5a;P0WK{_A@#aHbfJ7~V8u#|i8WR%X{~YKU}H z_jERrhJaqHL=pnVbz89r$x!|HdT}H-uM5BO#qmoo!^7{n?PgPae|g=0-Vi^FMJInh zsHh0XjQb+!_NmxRZJWinV!CeI3!8$kI+TZLTaW7K-~xB;{Cy|;`u0uDcTbT2@{szn zeC(tmvlm*0>UlQw=-$MKl7_?y>{<-jBq6<1PA$}4&ByJwRQvbO>iU}1YTeO>zMhA} z5L#A|DN7)jE?Fy=etq<+08em2LPDi1b$fTW(WfslG7-E=3BIN$pS?609jk^+81-|E za97sQcnx@mVF+x6%&BFWFUF5bDet}l@6F$Otl?ZET?o=e|CoP=)$#Y#h5DES81t#B ztJal`u|V{=P0y>Z*%!fJttP*VVB^~g2^tup3~G&`K)N3j37*2m#JHdhbKRZ_qr>Im zejMPx5gYy?Ay?nER|(7^lj0K2y9;+0E7c`NIo<3}kN`K|e) zHw3Y<)u(8{tms*t!=qn~&q*Nr{DLE8rkMQbxpU2+`KM?keYVdE6EY$?NvjC+V1+$v zYuo-A+)dG7gxLU>Lqh~O$waU}W$i1F#BTR)Z*SL|iWNiU_UW6;dNSHCklhjvNy~4? zG~_<#hoq!Ghaw%JVdcIa%St&C8~9nu|Mx>$=W3IJ{HY-sv3ub7@(>UB`_bHV+|} zbfSjVsoXsjJK7XC|4Vo(4H8(Ha~QI+iAnbvD6BdH3(<#RdD8y+VzM<-TMs<*cAD~^ zIWEBXf6E?TAPCPtLs+F=UJ_HMd$mf*Mk36Ix9`tNq%#scrW8{Z=Z(MU(~l(I&ZVdR z_^~5hVQ05`{%H>9t8kvcg(1O+;Si9-hK(RjF|egx2TCjk~zBi?K=tp1e?{oZ^@_Z0Fe|7hDhaPbb~?As$yleHqf)s*X1N3iJj zT0i71-a;fxyKNc#AO@n{VCS_HU3DxTB&hGhb!CFG^Y20UmFQ*l@vv9S+MYcgsU^t5 z+X#ALV<^i|lh-kf0S~5GjbTl^xf(owN)H;!>K7-2XPAs|{=WzR_Qq}%afp&GyUwZ- zY{^hI9cG)XS(-Ji10xfei4*g=Q-9XYeBYG+t(x(a(~@c#G-`M1&^$yDyp^7lY(KB| zyW7GfpW^Xgy?2=U$oPOf{bvo46Iqm+B;`yKBnjPL8%ZnlYFAem;}n0-Kw#RQBolMH zuRv(yj0^4{oL~Wk;v1o2uV@G;#%Nr|l}a#N-F61U$qPmEn6!%3lhKWa(>gLe47k7k z`3)k?&Weas*$g7`tfu#N+H1f9gsbOW8y${+8q79A*<)r5b>;GW-zk6uuo!Q7mWo zs_(j=mq_sf3(J!eXID7P8Up6Eoo1H}4B7gcUidhrjH^<%^xht$^s~5hE-ycCLC8An znas6QFOE0){a1cz;;99OQT=wO3?5k9j$syt5>V3E=@10P?651E#jw$F_N#rC)A2Je zaLl$1HzXs_*J`8TL|$GVBQkVA7#iKY=~+5KCME&;X|G9Fx^eq~!M+bwPqhUdzZ8h< z1+a1A$UrwXC}yK%AR70DV;6&8TABM$Pd18=j?jUCton3F#M26wJf=49Y#-c3$oakO zUu=~qc%Txfvz;T5Ky1{IpQkR>nKxU4RcX{4#KfXiu1U)yq-Ux{rlfb_N!H+o1y?JT zX@OE_48^t+8Pd$Ohi)A_NWrXXV0_S}Oj9{k{-*5F6iUDjP?9iibksw8#`);`^)n7m zZiRfJ4S~&VX_y62Tzl{srL_@$#rv+*YCxi61?ByLqFLIKcO-3aiQ=i+2TXqJ%JYmJeVX`UB+MHLsy;xL6|`4&vs`Sp{T2;++s)|HN|(&93=`@wnUEou zoMRIRg>~92ZCiQ6XH15`k+>UiH$jH_JH7Y?70QW=iOcUf;&5_6I&lI`8uM48e}5t) zD74jBQ{!=#XRLkvHLy~cUtDJA4rz2G&j`^xF2+R!?Zlm<}_DdT4`X_yJecOdZ z);L4&&1YrKthFs3CPX$p_`sq1^!-Hi12|AX*!PuNjd|DRh|sl8>_5r)0pnpc%y5+w z<&wf9&VoB%-xmHqKSU3d@;MZP|0`Y5x?E{AHBct*iQls^MTPbuUGJcnD#|r%1+BQ~ zj+u-1zcG3lan~IMYDRd6r3_|MPtZPEkw;+;rYYgSkjo%v1vjVkhTst>*goBzp}<`I zQY7Y+;K($X-)h-&kdT~1^;nP9#iVB-1{UjS0h{EuJ==`-iZ~VQxchmjqW#)Q@{OpO zLaO0m{q-MC^lbDvbhXqSa!k5N{{^nOu5 z;K}WX-|ZRsr!K4)#D(Mv&fmM{{BEw;-19X@>Dd)o%OMO3IYTX^oXon~nl+0ZBQ9kK zgz;yxu~XgqW1aigBPERw3)Nv`Egw`|j(hb~Zr`VdZh*E33?lURB4Fd=tm?`EuXAEW zO6(BQw|m6-Pcmp8C^tSYJLe(PC@wCp3a%`<6y1$(az}$>112$^!ENkOqphu`ody|6 z#{*lUv4=fLBXzOmKQ3__A>*RZLwX3|X5$zYwLiL#nk0;135K_b z8Xf&kWY6vN=UUY-($&krR}5iO@uhJmz4$jMS9zrNrKIGwrm(o6jhvl0ecv(bejIf2 zT@nx&+dUl}vC>{<9ykB3Jyw_X=5O=8@&Avi_m1bfkGsdOc4-q*5>j@uLP$h1B6}x0 zS=lR;s1Q+hMhGEPZt0QPzBuMk z@1{Bv!|OU~jB-(H9__xxW@n9`O@%COt=xFlwzy8NevDZR%FyN*LB_gGh`e~yRAKl2 z+;wAB2r*({%}B|~L(+l#m{?jim-ZDCVlU&SXqk|ycJB6zfM~B_a6CslXeaa4G$Ssm zYElLtB83TKzz}U@YIkVm+$C?>T6w}bT+?9m(F#`TKl;{|NVIe@|96#mmPW0fyFOra zsp#MdroZY6fUp5ZKR!g$=%1!m2LVFfp+jKd<&@1wF7y>U7;QX02r8xS-xbRL`VE7^ zEJlWLSKz&#Tlj5|IFmAk!P2WP>(}m!ZO4{pHZrl>lb6-e0u(2`L5Cd#g~lvmth@}ta9#BcW6~^ zHhWk`pD{vbg!cO_>$m8NwzH@($dGOW5}j?(KtV#z;)Ul1sTDbG573QVWDUPk%T#=O zTNF~Hh)Zsl04`B!CIED`F-`Y%`s<59oYyHS5u>?W^vujs=hKa2F_STt$!kVrnAfat zjONXbA6WS7%<&?hQD^agwE)Cf`RF<+^G&(a2U1cgfapTx@D>t+SDTw_<9vHP#o2t1 z=|K}oRPoatnaSE!zBZ>E*siBRKLdql5XiuKi>7M_PugH&&XhYHM41eb{oMzt;;|SX zIrRUnwR#bTN+H{_hwen7n&j2tY0>tSW}Q;GhFil-fdk>&bRzL=HszO~GNJC`d0tmh zl-07tv-r38-iqcbE642R`_lMP6isA1ig;?W12u}~nwT+`6v895lZd}KG}A@M?=aLy z4|VRu^w#>EZu@9UY%E+Da@?CvP_SuwfgMBb$KJOT#-^coUMe1iopi_DMa0?_eu#9- zKy<+YB$r}}?e}W#y2(@1J9iBECicj`ed|_q{8Zg}eDtr5Pwvmn2 zyd-`L^n|wu9`0CPU12toS6P@;qRxs{bdNDJGi}RH;A@@JKh9}E)z^K0%Ud7Uti{@m z@=|Tn`q1p1w9Kb$Yw-x1YrgYWADFoEWiYq${&H>Qidow!tFo;5*3JeA`(%>Ie(q#q zejHc8AZWuE)i55TArRM|+Up>{R~9B;zWH7I)rwv7-f%rRCdRKNvZ#b#aJDHjo+6xz zifxvuD32bctNStqYYaGMr3PNiPkDI`gIhPFw5pPSJjw@#dy=0owwKW8yH!9c5891j7r7kj$ybz+DKw zCn9Iz8C7p2jL!PU!yOvg=2V=V^`@t@^K%kplI0E@7gCSAs-n`BzV^J(ert=}@uMJ* zC|}qii^u{G1*(N*4gM?LQu>2Ot(=xePK#}A6l_H_^tvs3O*nE^Zmboe+dnf_5tg2G zICi~aOt|!)V0I&^fq;H>3a&jrHp+IqONieZxJbHjdDLL8--8wu|9(+EX9@~YeSJ6_ ziHt3G{oq(!|HV1#_)=bAd0Zb$-OkQVdFaA^ShfpIwIiz~02T#CE)zK{pu>$Y!49sd)?tH)WS4e24`Tkh%@TL9SCe6ZpQ*DW{m#d** z8ajQs@%ME0n-N2AN76cjw61{^Oif$&T{;BBG<&pRH2X1|4}B2rh53V{kR=bwH`95loYr;L$z%`1(SJG?~kg6&gEy(HG?lH z)jt@!R;L)dNPL)V@A4PzpZ$kH*rN_E`TUNP4YUKCo1$K)FZl~Tx%SE`Yp%|S|(oat?mKg&)Ve0yN2 zU2vkIvM{aCZi8Z8&D|&KcDriEK=6%i-1!PhN(sIRXOeA2gZ9#{tk@D_K*Z@l6j7G_ zHK-6n$4A^&xCrTY3Q}O7o!+XT55$Znp`3wH*!Z0$c+V-kQ_rHVs!b(hln37=J{>AT zqZ+H!p{mLj&i6d-%(dEu+xvaQ>E}C1Sy*)Qy2p~slWF(TO0|5J#~+vHS?ozsNXTHb zt>^1_r%~UXD@rZwveHR8uJkp@e{eCKb>{hAwYxM>K$Yi8><4-N^!vwGZK0vkO&E|p z!^;~244V^!=`;1AXYXy^k4jZlanKZ_`1w88&l2HDj^hE1d5p5rm!nn8I_@!Eyf`dT zRFbZfA8>hNjf|X1ib_i>qUP|e;!q#5n%_TWR3mCs^YD0?lGJvRlQTp0TylSdLMOUh zq-1lrM*eMT>aVFLt^SP&X`dktkA8+SCkZ|F8zgT%sHWD0M#&}Y?Xx#bZU!606^EC( zP-eAihzLv%Ai{?jf8dYYpC=uurNOD!%WrOBe&^epeS|ec$1|#WIhpegkG)%=5{Y+l zd8bkMB2^{zzO8>i>E&rLF|?3Pi)%XG(*N%%s{7MYd zkvh$$sdgVBk6V*1on=ry7A!mA$-NyLsSIG(Qa^J1>DEk_bd$_2O^lxVv#Q;DpP!5o znrGC)tFM0V2PZS`bUrA4j~XDg2t1E^i?psXcHN@j;NWA|0%+0$|7M>_czNBNkId`7 z#4(={{8xhx28Dh0?oWVZ$DmcXn4wkE`e;uf#xOe^92z6|=0pTf zpUVuAPF!AD&AwAdifN-WFT*ALD2x_rgJ5xWE6z5}Gn9?){N)&`%}o+5r6bvCF1dHt zSH@$hYFbzunzZt-%gfhvRPTO(U>dL8d$^6)om4ZL*RT935r@5!Jslm9rSj$Pbe5yt zdX1?q@r{dhlJ!`%Gj5K#A>g{Ey;iQUoQ#0I zc%6a^GLJkBDQqWxe7*yOS9zDE2FlUfKwV`cE=S9RZ53;!c$dW8X^sD`uCV{vy@an}Z%3()AW>@#47eKr#*uE6D~0O3(0Y`lJu2$$*Vo(J5y!r{;R;JpTV;mT z^%ZUyqSjn_C=rhptCZ|u;Y-Pp@t$}3TSn8{pfi($KW_jZ4A8GLI2Xi3x=(DA!B^Zy z`SpVdhWhmN`)*wYmZ!dMY)lT0p7nJWi;0Vm7efP9K>jbJW^LAYA|K=>qQ0_~$lS$1 ze!x8I==*zdjdCBqVQeE0_J7-V7&*9T8WW}U;?Hg$r8C|_aoBQ&@z)nV3fuy;q7Stx zVajs#$zfJH?kXn5H+w&)sU9sgqcrPGPmumQ1x#(^PH`7Tv6oSGlwb0Jo69E%)x>Z`h8?tmTb^Sw9>8Q#CvS8R=v z8TLjbB`4PmdGGh}eKvyn<~!P>fpAV>HjAByDS`KkACvAzObzy%DBduOoj)lfkIgIx6G^l#L7j$C<>8$EYKMDDLHCFd3k2939{@^e?+ zh5cpjTc&sE@4_#bl47cJ5Ps=hz9GR;2VTFIi~lv?!N|_;pO>!1YWT5CNkzqIqdONW zoyWT#J|xlIG7(3D{eSna{yBwNHT-+cF+z3FN?`#jukM!;txY8vZLmcQpV*^EUGJ^W zU?c5JSC3l|O)t+UpP+kZW` zeY}NHSU9@q;K@I<=g&7-LvtB;oq8T)!~Mi{i@A^oYCov{|7+>d7PsT5JeD5N*qL> zuU=wJGW}JOL~D}&=pjUvp~!LTGU2wc$S6U-%++HAxvsjF z)^P8eeelCmy7{;sI?@~Ca?#;D?m`<7?gLPUe!yrd3wkkL3zM4~Zg z61sEui^$0OFGtS=N0ZQk0uXaQi{s)=@>1gU;1~41;?5F#93A87&mdd2vcFZKq>$pz z8~rNZtlRxU`WPCA#S4+@PLZxf<~IBoXU4KkxBSNnux9{59Q+mq6!a`eH z$Eb*%moGand#E{D@BkIh)BPqbq+7q}MyaX4pQ71psJZOAD64lht<%fvOGU+1I*4`wVGQP zNgy(m&wCWMy|ydmyH4<$Uq>v|aRHYFJ`cy17cWLi``A!(BXM;k66XkGi1fZ&xxPS> zvXPjY;{1TPm)*}`qakSO&t-^3$ZqPel735zvA-{_^>L8ki0HR8oBQ=!Uw1>Ygb1w$D(KX zXJEs%wXIEmr7h9RVnFWt9VQhxT0)phwFJdRom+8N^ZN^JU%#66WhZKP)@7i_*x49S z0ml&T+;%k@Zl6jAgqFsN2VHMoSP*Aaa7U@V4NBinNq?s!$c{YlOG^_oao_9t4(%vG zeZUA;3XZrFn3}vA!a~$#T`3#MAM9)^icRE;oSbUyu3LPC$=GEh5@FZBLy*7`-w@04 z-L0(cWt;}f!DdU1(se*hrO0K~Ar_nxR3saruWgKX;!@cEo_R|We$ zNp!dxS~^jDLlcNtP7>nSmE~HVjJaQf_{I%wS#8;0a52M$=K7QKI@fRhxv3($T;EZB zZP1oDMNmUio#O6NDZ3>srkYu8)fj%?(f4&w938Z@A|I2~v-F8V`1M(t@Jj}}?N450 z5D=h3hEn0^Ur>h7DZOCLM>T^RF$P*vhw`1?ne6}G*rd3zArly1v2B$Kj=kUK4inJl z1G^8sk(wVPVx@2+iv_yn>Pf#6gJGEjqJKee6PBM#jQ) zI@T&*as!o{M{IX&=XY3NKAico#vvy&dC^CXUbI$MIVAduyNS7ZeS)NQz1-D6P8lW@$j9nwWv2DcuVpT;KE9Asli46v-_Uu7vO`SbtZPe7SZ4oCaW(mB4Y!r9Jdj%v zH5(D(-@lu;oLP<0yZV@Lt<)?owjG*Kh}ej_c}|IpjOOzF@X2YJ5H_h#y@lW2>JYim zwu>_ws%%>4<_F|In{~D|G{_`zj@IRBaJ#s=e*I`7pK(nh4jje%Toq;Ie@jtrKtPyw zNObx$auf=}#&7!#>8x;Nja9ZLuxWpIN>}kD$EfF`>h4_%7<@EJKDSpuktmXB1h3)n zcy@yOap0Gmj}KFozo)zUrL9fT!DXfGsa{3FadL0JG*-06upbpWXN}8!??CSU@uV9; z*BRbvmTJ>^LukKaai-hbtRa-g-qv8c+W#1{;>eRuwMRJVmdwQAgO8n+McLX z6M%{Zj(v@X4=`;0R!S8RXnilb<3P6c_7F^_H`?apVok}$LtSE^n-wo>&Dm=RHJY8st+ z)z2;{!r*uxjGbVpbNy*~M~HOdzk8obAvX}+yDd>_4%ZxJ)@al2n%rwc8zN05bdT1u z>DAX9HI8~g{tJ+VuP*&e`yy|(OO!^lsIav}gS*4a>jIcW2x*#^ISnR8N4=po$o|@( z_C}GJfHBa5ji0;0@4U``_SrK-(qiCFd!XE~&N2Rng!LFa7Ra1ec`Va471CAN%PY#6 zEKFDW%q-re<9&s?%59w;otb$%HzT_Ri@6`O8G*bT==snd^ge)9V+5h$fTTDM5I2d& zmSp|+ZsO2_KKjCo)-AO%o6#v1p<>4{)5c5@#;E@$CZmKLW|FHqdz%{@*&4JKV}+bO zapDkJv+EJu&!R6pyf`~+H`n363w~e)_Xep)Kb&LO8CLC2z9q~O@bibMdi)R!eOhwB>c#hS!CZx>GG=feDjt-?A z3CB_x5WJM#-Uba0ku-M?$#y!1;ud<5n%(VyBn_7UsfC zyNn*k)QxBU0?sqXL3;AHzpJZnPpdjfvMU9`qL+-agc6$M700;{Y18)jU5o)VqtJyM zW4ifZwYgb2UEvY12Nnx0UlfFx{UCWIvw$5KBkXz&nY@NH#aA9~C+bJ2mhqoz zClt2je)}Ng(u2UP_oMSm=y1QJS?RJ_nD148{{X%eOgxnMOz?A3RS%lbS3ZVzM&NSS zj3m0Pu9Gw<-W`AaS_p1<}!enF%5TfOU~|==fI)u=DL*VTJ|IMWADmyCQ{}H5fK8ve;-E0`}ztx zn-P2~q97^oAxi;vl5aVn>Y(XKOGe;L$i44<7Ep}{?#JiP7v!1O5uL zx|evdW{yj2ZuOh2IP3XKJVXY|w&V_TaCm<#2$N2HcKqTqK~7G>1b-}Db8u*iC5F%D zT+sEsIysNgH9kIYIwP1`Ix^zu1(QREVat*1;W5?}``o8cph7Z0d1CT4t{1E!!f^$y zL#=&JVMGdZ*<4ozfR?TthTTq@=R+1@{L%~Dh{ zZ-ojLQF7?`h9xJ<%Dqvd`2S1V2fO~n&L_pkm!mx;{THe`_UYS)W7gLCJ*^%JR#sN= zncAWESxUA{1Fbj_Ih%K@Nl2u;SYaXdmV?F*T;l2!X+h7Tgv_125X=`BrNzk z6A~te2I;=)2R!;H`~+zBlH1xue@?QP$gcCM?~coC-%)si+&eXuWicQCt%9xaB~3kn z_0D6gs?YqVJF@PNN+(*9wYRqFEq{q4ti2NbD6AL0bF#flpX^OPNtqBoQd$ZV1(Yy0 zx_e6P;FOrbwq(zu`t}n6UczQUjAVOu63i8T4^`zTv#sA^Y#o4Kz2`(j7!jYX*q#al z2>~T*d04LEeNJ{J%O}~^r9rn8Nx2FE3(rG2xN8s^y= zo4QUP{fyA5$+aFUE`JMP6q1Li2?o!}$>k5c(juz22--y4%R5Vi-t)KZfQJWrm1H(Jl%fBYu z_-t4aPmJsNge#$^iwt32kH3ud zKOsPxoT?JS6+0nGOluM*>DGT)aEyPL`{u(n+CcU}f0xI`-!R!uE{wLOZ1)xaefTt} zl{fF{k6r8Li3VXm-gCq(1L27VBqZX}iUNJm1-oCjVO`dYKJrtRX71_I zS?TN7Z`Wk#EHBK(CidDElQ)D01xGbPM(w=v=d8rYO$O5Fe{V1PpzXmdMs`K`yos^PN7wkjkQ);uTk6z-faxTk`-G?boQHqt)1zpEYEZ3N8hVu5&7yD@@w8g}) z+*~ijy`O`Gy=uUj0&vmgo$eSF)sAY^4}+eAmGb;ecym*yD(n3$vgh)PCdbvTUTVjT zvn3%cOs%>%5|xSa_xFSAax5X)=lR3ElI3mt4xH3Fd6K}>H)rADG4TlpA!p79!}5_j zA>btE%#Kr?_`}1ga4ySz3}-aP8G`dZ1g~j&@Yz)E4w~WrUoF7i64%8yD#Z@s0|jwk za&60@5Be$*pX}rFCOO$;(#fT!KBUlYQ)rQ#bx1kq944^V#v)&buyS&!kc?mR=Q_p5 z@db+Rzkfz|vZ;Rp2rvru;eR(jp56EEZn_X@pMcWT8D%f+^77s&)X-!{DXKqTeexdU zA|@V&!rld1!9$3E>t-vfxoQSt51!;xtgrWN9j^A#SGXvkk}j?MuQf8JQeR9?-qy{> z+yswL|Hf)-uB#*5P1tjmH54Ec2kKquv38O5k>}GQJ7VPw;}iRZohNUJrRD-oU(ub* zrd1jR>Vriv+KM>1_6=7b^;kL&L8e|qM|!x1CV{l@>Fe7Z>w(-3;LWYl;JGIbzQ;8; z&g|c@{jF~P`5UkJ#xWC2qAMZ@2#ZUYm4%LO8?92bxQAN7Jw2j5f}hv5<(1azKH=dV zMX)n|kE4;O4ui|Moz1%6>~nKn8e53qKKAWPp!0q56y<*jmuts-j$Kj8IRd28X8191 zgRKz^O`~Bhcl>_g@ye=V?zMx>QNn36A9jiw!{=b)=g+3}lYD!_xu4(@DdBNpQXiHE z?`9VMP@~vBG}|Y0`0!yszn?!)aT{JLGy3viTa>W#i~W=wLpKvi0B|?3IjDjKY5Uw4 z&CMux?`PZDsg9Hid@@ch?gXfoW)AFsIhkU$b@uO6htY@F(*^`)z^Edi>-#gkd*lnz`9n|JS{1r<`{l-#SyxhgLAkSU6h9WpJ`dzjetQJb z&%`~7`2wZ1Tf#&apR?R`HbmOm@*DBbke(LSCrYpqd%sBgX?;_J3V3`8III^e7e?$O zyxufRqX3y5p*b2iW5-p68EqiyM5G{SKS(`}+p@9(rLMmg_aPOyr37i`*@q98F%YPIUnnf| zR@3+TP+g3lv=$l3xS!;|@HJX1;x`;KundeSw7GX$3PUzYL*{#53@$pkq-e5&WO117Lg#c@Whw15BZ zgQx00u8D};=(yg@7^U;fH~xAMJuwzz;or!DabMihXaGz`CR*#|#-AMUqm)!p33+n( z^yZ&#FE6iW7LT%zkdZx7YEONe`u1jPYtYBF#X2?z%X!obu=aSS)0K@{r~cj5g^eeN z(S|iJgwpOUd_=6VLYu`BkJ#$I;{4!f-@rZB6BS{5Au*F{hUNPBNit(Vd#d%1AEE@5 zz?BFJ5`i`Z5rmkK9M=|_#`JWetnne?_hu6L(%MRAUUR4;L*wfA**^8|ZZ4C4p@>t~ zmd1DMQ%4(o@Yh}#8}ry%#{oQLl#hNPbzcL<3VO(rphl>H$@A01>V;j7)8ASD(x9U^ zBKb_}vWsy}A8QGdn!$YlmyvTX)jerP4#i)8LtEu{ zGA=opl9j@8K`$GL)9uAEm#%IO`=Te%sQb z>4L7V0$cqXaI;5kf1ZF{YK=!TwK+^l@nVA=q4b9%zKmsUl0z3*TAqqq+3;O%JK zS43z%a9j#K^?TWMDI3PG0W!nYZ2Jz3K>eW2?@G~W-1MD_;xSO|;13@vO}@|`qPY}2 zcWF;{yy(WNld}s^Q=l+U&i+~#M9j1rOsnFk#nRe#SYG~JeK6g<-}>;|XIzqt?^S2m zKGC0k5-*cLtO`^2|6&FBht-ytoSb9W#f9DV_qp>W!r!jmdp`uq!P1xlw4NWM&I~zO zvOeI@2C2b6pvNAKHAMo(K2xKU3>J}+02yM5j)+AqgT6D#evKyk$c~1-Dy$@U!#c zlxk|J?Wt85&oFctafZ3T_Y%FU)xQ@|CRX&;`?9pB4U4!sWUL=6wSmn=%!P*yl;?lp z$ioPg*i6$aEb;AbXU<%5m@J2T92f6SfwG9*Rk|EX^;r9;+^hyCkbadN0FpCsbcrM(bn8x&M8Cuxk6 z>G;p_nn$3}qaHi1UF5UsBOZlzAxqEEe+o_S{C!Ty{38)qS=r93M&1il*S)ZB##Emk zGB7+&%@T7e3$6U>Uwd{jf`11N%n$U9uz`cQj%=PWa|2AEz+~LnO24j*>b&Ef`e%F| zf}Th(&=tHO5d?;vQh`B{mN7XJ@{Mce0%V3s?jK!`t<(Bd@c~H0!W`*Zhdsx+WZKKATvx+T%4TV zUuM|3oNZATCry5W*R&k-n1)=%)8$oug*Jph^X=RBNWZ~7W7-ifks+|b!5u9Q7r||{ z){Lz{BEMsyLXWrgryIJrdz0(VgpHO`QzV;49-E{YYeO15+q4UQ@$G2Wf!qMD&nSFf zqG)8R*;us|JN7@?j9qP=d~nx^%rTK?!cvVTfKRoAc=eKdbaB%idU^&#sXzZMsM<4- ziqvQ4Ql16y9f>>lF4Sx-@7Ql4>{MYUY`CtOK3H{xVe2{Fs>E^g!HHC93L!V6qn+iw$hLZQ=99GsfDW|DYgs_7ap z6Uth8FFl_afalY`fm}ZX9<=6NeWK0zya5$ArW7{q(oBH7+%Yx%7u`Aaue?$ z=*{?#1hW4})7g3L*+k9!xYWB_A8&M}FjamqH7IbKCRsaE9ui&eQ4K@8eVSRGNErDw z_EQT|B$Hncw!y5ARghOSuyA3)4ys5PA}Z@!^;d#5MZe3*c~RBjt}~KpNiYIX@p%W zSNtdiY!;Z1uPhFq5@d$9y?1v5WOW5%;Wuq18&the3GY5cRURE4e%i98E)6%`lhBOw zs39uBn*9@V*-iS#i?c)_i`h~4>7Fomw^hTHC1ZuFS3}QhibFXx5>(XKSL_iBZhClV zrm>sX3<8}TlNKgR{c@tT4r5*FGb4y!RB5qMRzSEa&6nfg@463wf z!Ff<1XwZ#|zPvGqx=rI0bz_JhWtpqTw?rA@l5aGDtC!zWnPn6#1_ zIWjrob)P+0NxRebrb<3D=l>+4^>*hyX=?-cGjD#5in_~bJ+v2md70_Tv7H*Q**5uP zRYrgsVuUP1_|?jOO58lJpsr9H@`#Nm5p$;vx_;+tDtWqA9)o!c4M-a?Q!Oo*#fi^A z_fgs?IQTkyqE>6t(J`H!BDv38+E;4(1c$dc92610p5@fV1?AQQj;+4GfB$m(Uc(#4 zB)&Uy?c2A8$BdOX7hASAS6yOrb9o_HhUy7WL*(zj2#~{dIA|nIG6w}I?y=u1^CoQ~ z9?i?+nFAson~mTuA;Xl^(K!XI^0NDSEgFT=l^Cdpi2u01F_%~7;kMpvar(0R2v|BQ z?=FfS&Z4Yf}ad4GjSmjhKE_ zCq4dl#?CPHW}MhD(5s;2O?r*tcukl;506X!>dqy85RM8&NpyAh!Se3FbvxzB4$~50n0YD1=}j`$QrhNE!E~&)H_JZHeI#k!@{F z>{`z`knj+MKQ~;yN95C1S`Q!RwK2@#H~_;Iu3^KRxs;I~pGNkP{elDuiKz;0jciKR z1Aedz3FLs1-cuz_^%W(@i$XU+3bSclwccHH#n5=6{+DQ>5&m9c&k9=E5S_=uuV1&3 zB8_4;apu@AQDXoD>6#y2tN2lP{p_m1sMwYQ8y7dP3f{A?IQ{4DdJ;2M)*}1K7uK$t znkS(5al&*kG>0oSOF&uXe-GDKl>)q9=<5-2UtMT&)7^hrw=7!*k{kWiRY)Cf-@bk2 z_m&$Ulj;E(85wK~NmH2ywz4dkr;Y)!5^`T(ZdfYYn8(BW$7z1-AVGn`p&0U`-2jZV zqoPd_uZ_y`lltzfj-xkNLI~d=&EjIhSCJrl9HhBa-rl6!TyOs30KN~9mJDG>`5)(K z-Vjm&50|({$bgfJK3!b`P8f@qVr=Y>tj-uUtD14c)Z{I4tzbzWdeoGcBX95;UK$8u0?%fO6ul@(+@3cph`J!-X z#gqB9Qsf}I*ev|`EW5!+N|d-B;L&y=UL*lLT62sr9e_wNqIZH11R&BY;0lo@P6mX3 z5-Ily*8(abx#(gh@s!QAvrR~Rb<&ldp6ikyVd4j+#`h5RG@xl8u)J^IN)0aeZA9U- z#dKn0ZD4ET@1TdIp@{3^Gn1`V8g!AM;|rnK!$3Q+lu?e{gtHjlLD+8<9JZ&&ppzhU zQ{=45%d;E!DeVF$&f#fuLk4J;!D~c-SPTjceT;1CX6R4AcVp+QeU)DdNhwTY-~Mq#ML|C>&gpfsu60X4f$*DJczk*pzGF))R1P%D%*Z92>sKaXR$pagTAd zdAK_!zvZ%qL`8ki*4vS5*8W1uTw_gz@#uZ${!CC|z9FpKXwmOKIlN`0ZC!*486zfd zcDARskIi(EIXNw;IO&9BKyXk?pp3$Bn$N*X1f;RahzNYf*V^6rMP5aT?!DcSZOcq6~Hx$IBV zbmjDE7iVW9YG!v%78ZF6-ZefBd3oH3;t-JvfKfzQujF(HWQ5SVR1mSsdETmVXl04G zt%`s0+;w1L;52;h%#D}R70=52fnE*%zq)(;&BpJA7XXKmneD&wO5TkfZV1^t4i01ATz`pi ze}es-Lf!_a=7;c^X}?uY`1L4Rr*WaUZv*}OuVhVk9J>OeJWhIM-^b`ikok$*~Uv zY@M9uXi)cZ;~tk~X9H6zvtIGUdCV{;HsXRMH7fGTbbB+)zS8txe{ueJKzm0=*P~Sg z@S!f}4Fk@jSA7fa*Kr8;^xj~|$Kw7M6+UfVNE`@qDrs$%?IEa`yfZd(WvGgs>MrCqk&F7#*p;K4sq>1!Yb?^=x%{1K=P)7N&;cq{0=u)YT|-`8 zI}dndOQ;?3DuI?i_|up7I~^Rz1?-r_z@BaY2S=27Pf5h9)>eM-I&d7}5F0%g*xeDO$j>BjcSal6b4$Kv%vfcyB?PyX;T(((2M2dWABh>EzFgdr11b$jnSfTbI2x-*sJf3| za(d6!ww{7!>E7Us28I)@->Lc!EX{_jMMnH)*&i+bkBf`T&P+`LSK)V>_;NVYmE{rH zILtZSus)@tqICrBT{-6C)tmSs@hoU5C%di7gcTfY;lnl6zhG<%%FmGK7~0xkYadb~ z!*99RaT0_P&S0W0u4Go)v=+*vC0MubT@h9LDM=m255d;e(Dde!voc}Eu&D=!$R_#Q zkAl5^CW0G?|TPI!E_pbP$pfR}SPe0py zDoHl#`b3dE7(*@~5JN-5c-(;vSbto1KK(P>Us4Agx2x1(PvX0GL>Y;zL%`QU-@Fl; z%naSqXAXnq&?rguEdKQI@t2?vy4l>`u9&M{O-k zLf7YoL)>F&lQ;jI23bU%F*T0MnBq@K60irLN@~18P3O<7ZAoA)GEi4Fzq%*^h%BEZ-1uGcL zm41fK8N@7VH^sep3(Xnse#@t z+VcVJpFa!S8VANlk3l%>3V1+@-n+w8B^`W4Qup)@1B3q{{2hp1q7|a|Y(SDjaPYzn zM?zP1oY#S^8ZP<30AM><2d&>!XIk=yxFIx&0v=-rkjFw8XET?{#E5vvp^K=luGVmW z2m9IS&I}_*Cw>fOt&O?=tEs{?9J7xy%R=k*^8eKWBrisY*BSw-o3-d6C8w$* z#2hw%SsZZc4-|6OWJRZ{j@CZhfvZg)rZ*of1~!vz1EEQ|177^=Ir%XRBoha<59Btu zaGui$>mzz5Ttoe4Tic8CG&F1nNrtc|Bf3cv($ky1DkhyKiG`dt z3lrv6l53y}NXVHzlL8JUN{1!g^*@1L@?l7tYS4=p6o46 zS5EPKn8kU*d%x{@F0M1TP_^KUoF8jCnY6ZMpqHj}gz8~&lQ79go8)zw1O8x?oBl=^4rEz%jgw?Iu zD{u{CRdjzAOwos3t$`%J`(v?eUbvIp&-xW^69UE#iH<6;Td_%^NroH?n!w+uE=TnV zI=+Ys{PedWj0&S0$}C15Q3A?umG^xdsAZ}>OZ);#OZWSPhlZFhtACuRUr}L8&6N7L^{629NWo>l_ z1>{8B85jeT#3+vT*0`<*LG}u{EE>X<7KlfaYD_jZaoyuDHazRVV2a z`9#ecB!xr*JG81l7PjP+Sxl^2Hh1i?q0WDn&JMIfsaTag6;@^0qYXLKSLuUptL3p_ z1d|>#{93-%{KV%SXqcZtzY2|5g2Kyl6BE;zoVgymxuHQuDkf{rhTfGZk1*-xsrn9Y zMlym2GY=Y!t+)zuK7^#e9uul$E;%)7e#5XG==%jo7Vt(Q zFc-(%_{Q22m3I^o_05_DN#L2shhS4I-0(c)I)f~=$mZ$%s;Vlt`FVa!M}GLggU~Wx z93Yn;?PmV_tpjxSJ*O>q%!-L!rKI$3Oojh_ivwk=nqo?DV0&7j%g+;=IVL-h&nyEh zxC(B$wNHpAPeR#IU6*pPY^ziTrKDJ%6ay)8@>-xUaVDj#!C`<}=?EAYROqpIwpCd} zVx>seuKcJoNb`sFvi-^5fZYwFJ6eE%I=;cBYLv)(IPErBZk;&@^DGQ!Jt30 z{2LX+Hk}zW91pH1QCOgaC<<3r+QK=Amwg`@xkSn*ZcDrJq2+m07X$a zw^a-&7e%lrG#l`svW9qi@ihMxoCijV+K>T>jv&UX=zavKL^86ItdGpgm>@v0pZ@mQ zarvHud0+i-0sjylBDzrW`mph9vInq=2v)kgBNQ3RWPn-5an;+YMQ7LDJ*NN(w*m@Q z^+KCGgJb8l!#`t-F@_WR2Q>eqJp)JqN6?MdX(_eH+US5xFgfB$`b6_>x-`*6O&GD^U@%!;IF0#Mv?x?dow_B?n^Dd=CWH=@go2e~j^EB( z>~qPk{ecamwWBsf23WA^*X)b;=#<)1bY8jUTeiN{yGlT;7u7lsJl9CFGqt?+QF_d#en|z?!+i-ahSvk1{!UVSU)UGB0&*8wO-Fa$W3Sq&X>a*)0DOuL(uiucbsz z?W?f!(U+=Ie{;wGZfIUTGpmnERH%EmuF_6z8Pa||2vJLGr>qq)$W!hi^ zt(vJ-13ECIha1j9@O?I^oM??-{%ci<90k11e>;324{con6$U5ZQtH+~af0{G6+}ZQ z_9neyLFI6!{mUnK&$6H7`?D~3)pKK=|GmlK8z=Y($QWF9uvnF^p2F*YEV}beX4h9R z)kas*GpsDC;+^)*gapY^K!A=STbAnNz5FD2u-bGuV`CNmE{eE4uOB&+1A z@9EJxi(ZJ6o7(^*48%MqtBg#DKkHtxMLGq;A7rWG^m=o*_-1CNQn``_nm5++O}oEQ zI4()zL|{v+P)O0pIrn?LOGoaMV5E7mgiPprmqhM2^P}p?qQV_X2~U#)c}HvnaHtzY zy+VE2<=DJ-;Y525qgzxIlj?^%z8h99E<+_QypYLBs;TjH<&mMX{q%4l^P5>u-YHw- zW?4s%!KG|0<|Mh;-6XpP2an!gU+@Y4emp*btW3tz-0=9EVK{^wHtV%Pvd`3ONitx> z^evx5iBaCT&1)YO4F_`XnsthYCP%Aa8po{u`T(y*BY{PD zGmMoB95yZ?Ncczp#v1;xKKQ)9MebeY{M^K%boR69=`U|wdE1T1)rl{O`v-MP4evyi zRX-oc4@X^ckd+8JI}7;(KO}UIn_f9D&FXln@PRCbw!vLS#?DTWX*+w+`#YaS_<77i zla8N9`qB@*3a9lEsdzpI9v&Vzkc=b#!1Tn@NqG*A)Q-1D=QI)G;k+?+qr|YNuu$M~ zrY@tpo*j$?Q#(`1=OVGobc*ftfbc}Du1aU3SZmESk+;P2EHc`URoVP29O;G=C#bAv z7fc~nP4HwY%VAS~8W?z_U&uqQIZ8mOy@n@Dz%T4wO@FCM_D|_h9+Ua88y`%+UL%hq zfdy!nNzV0Nu-YMuVFkvyzv6?LTB9zJAR_ne3eSv273i+}XnJ-xg5yr+v) zqGDuM&)3HOm`|UsifIBsApg60!{ts3?6mD)C;%jr=IZymw@!5X;`ZD3k zp|fk=wVj=m+-FX?*vt0p(SOk7D)(c0`qh|w`P?+H#rvBJL8b|=JAU4`F}x!x~kAy$`8+7?WtrY~MC`34faIU^i;J zgZSv>5|8IuS)A>us)@k235c>jghk=qomK|3wzr-v)r$o#A<+J((MFDp)&@QD8LnY; zjvUGtYjfXpe>T(U8y)$mT3b;^|O;TaIg0X2vEIz{$(A% z!_ZE5clSvaL+wNxqtu>mo8hq=*gcRyV$D>W^6`zDrhq#q!XR7O@AS|0$Dyp(zVRj{ zMGDDj>PvHrC9w}-^j>r5lz#U!Djuu8$g*TPqxJ7uR4(bI^S?#Uho#w_JzBZp=CQd> zg`If(!kr^)4s)uL%di4q4`Qf4SLE=s0v3Z*e3mYG-5k*oY&`apsjn6fQ_L9!m8f17 z5*xd~$7e#A)X)gLFzd|BaUZ^hA)jWrCET0ojUaA!M6wyV;B9=p?nFjuirRU_()LYIhdPGtgawd;L!aQ5C4)xVFNo)_`P=@R0 ze2LSIU%4xBu`D<&6wZ6_5qwTgt|7ooje3*&K%fc3TX$R_$%TDG~;r1gzdAqtQ zUU+l=PsOGX$l+kk7ydgHMJOiM(yT`V5ARb$!`sr2q>qXCGvbp75ngk!ibcA2&$?|! z+u21K4jqUBo~SbUmFRpR;)X}6x%c?ee^aoE0$XHGq@(rY-UeYz!Bo;tb8+)Pu4NK; zqND8+Y)LsCc9R!Ieu2advD|^!EVj}rYEDjd(QqnDaGo{?Q!05(lb%m!Cg3@9u-d!O z9QX3mqX)~A>0;FdS`v^xfk+0aqJfa)OrPiyn zAbi_AYizk3&)HHSn(O+M#Y|i4N1@8UAT2Ulp7=t8=v=Bn4A&;vzFl~1NJS4D7 z72#kUEwV#I1W~&8v9Ti`ghW0+0aDpwQ$-5YV6e$Cp$K0-uT0Cy98o_eZ2CS{9r%Q{ z8JM8fJk~-re1of3uKl{=bM^2L*P!KQRJ<}WGJ+SEoQ@6+-T>eVCmPHFBb_w1=h0?tCYikZqpQ!;XLD|EX<+$zM+b=1_=h8a&GgGupiA; zi(i@-HM0UMp=QVB9Zv<4l|L2vraSZoRuyLBdWAtj8tvEfc;a2P+7O4=&T7T<-p~e` zP}aCa^|;^(^=Bmzy%eTvq;F_Fet=8!Iohys&S7(}xO1Y_8=pv`DGcE?Nsq@oJTaU6 zw@}me?{e1zN*0(jxSS7ZplxYSRiS4}>+`?*geP`641k(TKIcI-XbCTdZtv zKHzqy5EpNbqoSaY03T9N*q0=_)j}pPx(y4TUW_WtRqji50(D6VEBAwM!J<2fPw}78 zbfBR=TpDO;=s?cEUfA%!Kvwj9eHdaHE|*rw}F7UQo;&5F9LBnFRIwjjwN4 zC88%!3VR%FVKG^2iVfq<-S5hKLhE!|S6k5>lz}-nQ6!|cguKpij=S~0*&9p3ZsU$C)dc!oSgIDNp(;3E{CYGF(?UQ`0fDk^-@266H6in;GaS8i_3 z#&ydrwY=!q_nI#0aX@Awu{QousHGY8>bb0w6Ge27W_ou1-Jb{J{5Z_!nU(6~Wa*sF z*WAZP7SXm@zcD!+(N?Rzn|G1Do+icGCfs;$^7T~p<>yGeB7I$E+sfLK3M5Y1T z99o|@Fb7BX)1nCd#ga%f&(f^oH=n8uO%;CW5dUj{Mvfa@4PBrLLzJPcF{?;@7b+Bh z+TsrMf)K9>(HM3RQa_-OE>DBA&ZNb789!Tpu+neqQ4wNg@|{`7%5(TvWUNv&#T^>; z@3#soQ~3JiC?b47a_>TqPVfQqs^aKrGYz#NLv`6Wo4j zAG9YK^1nRylJigM9QUxqh}4R~Kfu$vKe4-Ys7e4v2PG}T!{v1)PcN^R7L-FCrY7R1 z%5`Yk8XVmbXG*Mj9;*+Iz@h=!O`C89Eytm6BZ4RPZK<34*va&st!j3y#g)s^ziK;F zzZk~cxoQ@W98-h0xI|@`zyEySR27}Bgx$$3AK0PfD%RN4Z_W@9asj{x#p++Z!$ZQP zLrPTG*t?`rDX@=}=s*7SslLYLNKw^~3}sRhLZX2(C1l<%7Hkn zGt|Xy^UY=q#fP!N9+<)qBrs?|q~(p2j=TIljWkpGhD_N+-w%gsfIB55NoBdww8p)QZbc4>)rbcT;A}t{~ zIjX!;_OSKUDlR<=+9RXxa#Ok_B@FLgN>wbwmw*2{n~ZkC`0{XK@^|0HMcyQ< zAQ*vq0-ClJQ#!?59Mn%YyTrv(6wv)FEI6lp{w}xZl|_Oga1TC{=DkH9yjIZ!^n8ZH z6ijt>BV9w7VN$Wm?tV?cYKC@4*1&)Qj1=hzH3^}tLyKMxZq)3B8nnetV9GTcn9g@` z3=_E@{89Fm9(px=LOzEFb4k6O&6b%o*~W?KM-Z?ark$L40PzwWg6&-p2~V#!u>hd&J0TO)=+)At|{H^6-X&zl%v zc0^V)OhIDU$jIyk+EN^19ZnXbD&^;J{*e1UmfPP$Fi`5$m|c$6TeO*(VMnS$m=-*C^MzICft%<}_u*GdyN9k`{_eJ{+Xbus zSb@X{Wvv1QiM<}k3Q z@gzZkSqx0#ZSNoN4nP{S0u2t`vof8TTImEM7OX0Jm1p(9k%W_8Jn zgRT;>GK`d-%Vcq%F|J|S9XMFL- z11b4-KK&V}*g2MFQm|F?4-QtItY(boScMZ7(0irHZyOOY(IPkYZ8L;ZAAVz*)AuCt zaP)0$$MIT|A^g;~dt#C5JqEyr06e!SudlCrzr6|yRLOrIMUD(zA+*voWvhMANz%=# z0|?UE+WO)q#e+sG4GAQh@^91RPhVBQP${+AZ{6J&V#KJ4ML^Jt_+jHIB6?P~{xl>2 z(wLFwmh`6r5i{V1{Ad}l9l9W445TA$ID_asu07ez#^TQovJL-t&%QwMvfG&mx8EGk zHE0_uxyBSZ0YK|Df67TWRb7Thnb zW=9dj6TIWz4Dt{=#<2gl&3;ujI&^CK*BAJyUc4J5F<_08Y&VB!7MRCS(b1K_0R(W?}6!uj`%*PLUjsOo=QfNvA*v?v0ofS>$r z4?ZJ?lX-b-a?8V57IDEyzau0w57%asK&_JZX$!1A_8<>CrdTUCVlPjnFc2C{wdolZ z*5umGm3_Oy|2!ICIS2xTe1;f!L8+=ifa#N*oXq+L&|QQFJ*Wbqv*msB#y6^hDXnxl z`QK*E`g+&*FL&c!I52E;JM{i*+8eR7^!D)?YP6WLJ4yjcAfz}^@{;ii!&C5;OC*9O zfnGU>hLGp@-E4g>*##369h9cjsA)Hs^28T$pnQ0ylN z1>bd`f%`uIu3owr0eIBD^|%QExwj}n$QgUQN^*JL+|uFFX(T;Y4DfEKb3hOQo0~rU8lOryu(V{*E%gS*_6VQ|5FzumsL&eVNq9Q|C#F-& zL;9@0+FzZ-`76d^3K8K68Mmg-nR$5=g~dYWzjZ71MZDKeL;PM_(=~BbR=UO}41yS= zQkP?AsOlPjvtf_Pp#DMzhaLyvjKwD<5kE zTvA9_SOp`=1@UvB-SVuFxFIyA`qj7|xW`Gcn1j zM<9HF~(!x$<$x$ZN7mY2^Cj0*_ zEKQW?lOsRc%5b|VdP~^P%&b9bZ14T}_I`C8Bi8rCEKEZCgIgrRzal}e+`-*|xi`X;)mX;qhnXi`I1DMfI+Ucph`=|^f zgQac*iz4jJAFj1xP@)e(pe_o2(W0tmvyZET~vM^gaa> z;}GF8BRax5c*hWj5xB_?=LmYS6_=ic1K8hPD+0%i%G1mZh|0{WDH_CebYwVKNq_g{ z&WFH_)uXN7JgOG6at5O(xODf=U7~0rQh*~Z|2r#c|2$PG_L)G3PtS!~IK7`l>CzjK zHzm8L_d=8RzJFKI`71*Z^}TQWpSS}NcS{%gcu8+U5aozU8QG4p17P~*`6^N$8$|XN zK_(mH0svpvQ1}dw!}rYS(_K&E?TMPmF-Fa_?Ck7_)APe;&2t`MEp3J@UdT7O5iIuv zK7PN@+ypVX(Db=G|G}bdIYggl4l@$VAdY!n+l_?z`97BKCf-jm zB2j;`7`^j*QK)G*vv@2~ChsVJ3#wtMeIAw+#v=@fsw+vobP|}*$_vSS)65ef5K4W! zAcK23;zRzTDcakgWR9{%m%oX}y(|l69sCupct#2Y?Jw^L3|oM3Y>W5K+~@g%M@pwY zqm>m417Eb&8@4g%Ikt^A8zUtulPb(#=2sEEpW8$4ea`cm!oL&~j0s?l$T94Bh8Qs5 z{n6VW4Nl6*OHUWJ*PJrfj-{a>lpu3_{5ZOZ>^vIryITv_mbpxkIuLVpoRZGuYBt{r5Hlc+iPFEPnUTRHl$B$JQ{++nqQs)Y>-O(wSsAkR=#&Ku4SGcd3@tPk%boFW% z<1}Q_`r~8DQzb3TnbI-Q!BOdpbvaKUAWufNh=n1h4Vcxkv;CkG2Nb;j1omd(+ zHXQO6?6+db?5yAA-O)8(<+gct39GZ1vAKpNbsW9ZDp>^Ro3q4% z^o{R1Z78fE1cy9h)R(*B%oCdLG5jdSNC~=id3EKyxh+$XrxIzd1V|$oKC~ce&v2n; zDMv~ygRU$;Iy!U@1;d;?4qLJ(NqN zo$iYGM6u2hg|GTNcHw3%O4>Hb+azSFOjpJq8lH>vB6Ht;^?b3DlV`x4Za? zaJm--eP8D`IV?1M+q-t`1B8TxhRY*pNJu`fGV8!}hSun2bUsv7 zXmk;(>+i^y>oF40fF~YtIU2>?)N^t7CxDp1J*82qwS%P`4s$<(YUXm~5)qIFOTH5G zHZ<^l{hXDxK_Atd(uC&Wq5Fg}K6k$a=82~Yk!#d1KhBG@o2$2t6`HM2Ihv^YkzdZo zF(gJRSWkHy0Z}GXIaZbXFF_#Myu30=`VqRK+7!c3W0-!E4GG<6eT6U8t2w@RCZ6wo zVGdN66}h)3`9xNiPl~9+eMMgR7TUWw1qs8Oo}m;chKoSgLt{@I7HL+R;3U;)mP}^D zg+zZes%+&TO%~GS@j=7t#+=-*gh>sHsIPP1-*dkH<9Eap`orSJw0~RYO`SV-KycvS z$rVCxw~%+M3uULL_kV2uduuL~+O+Cw)4LLfw4{qt4 zB-`}Qpch}r?bV({1+=&f*4f&A`gB*l(VDm}EV0GDO*yfOVE$*96kCCc5AI7b+TCF~ z9JJ7+hVB)7$D!fT<@O{o>1PWf7Ml3CW-soQLXp;KxcaGAMPF{Im{5a_ocY1*%XfGE z>yHKp$=D1ZtuqamcEz0ie0^+}`pKc{2@JW*>AKh+1|x^*)-NR1;oYsRFq)pX6sN#S z(|`Z1#_pw00fW>2KBFUX!~E#6=q zTkkgVKpg9EKr&&eF(H8pnsWVBs~!pztc zM#e&OO~l*ICSxDVTcq6r@!>F;dLkUeB@InExA^GU6QbHQgi}&U<^0ba+oKnDX^Kt#(=BzV z@SprrV^U2u6gwemGPtHw3l4eklp}+u-S@m6$YKq;Bo}g82EP*po*np+1HbB8e^pPZ z_NhnMIt0j?aV`GsFBjdseR@b4#YJDqnq#cl{%Ge-K2-$@>J{40AP)ZEl%-x>ui8@E z-*&Lx{yvam>vVR^r~0IZR=XaXNx8-j4@E)GoK7#QE^e}%;QbbN1WZts6A=M?`7d)7<=L zFk8y@uiW$C)a#SQEUB^WtnY?I=Z+R_fp61M&JW!ZMt{%--CkRrh_Js2Hr_2kPqaNz zfO%45xR)^3|NL7kxC^s}LZv#gtJFdw6K*BgEG0yf1++SlWJABeD}9#Er_z z-19}oR^T^jHC_2bu$o>t54Essm6(_&{=?iTzkx+!k6G74hGufII38<^psYvaYfE_7 zm#(5|OO5WULC`q*vG-;QADjnJ`QOs2BwB{&xc%Wy`%$_XEVb;2kE^;_Rc0H6YqCupQ!07yL@pLbj&N4|yCZRGz*v~Tf>5$l`VoYyy5sCnJ zp{w(U!c4Jc?rw`suYI;!l+yx2jJh4^ZKWz`qs5cbh)qdSfB5QnE{>r$&wVEkUwppq zXO=;%fkjIisLmwjap$Mzlde2}M-iIkZ{lp$!+o*W)D$^ULaE6hF2PwqnN(E&+MkE?fH;=$^>l2Fw%@=|p?0Lm6!Y6Ed~#v8v09>bxXw>^ zJ#S6ebMEXOMW47r z3XuK2YfY9yIhC=nz2viaZVdKo!z(@OMCtE+(54$))qE6kWi`yO0$fCL@h}bpVr2Dm zrwf?NVl1+RgU+?M)};5ERllvWsaWP;|J}l6hFU0IRXI23@u(oBWoz#)c5s9J94!&A zbK4jDvaTfhz354dlREpw>ED1?(ajOt#6LUuH@S&~ny1^vLre_xV(Ag8fTmdLOxTsK z%BK7sj;6QUoWw>%tQ+=#ztgW=W4TwN7c+An%w%+Q5pgf6^W2yOF%-qjIWADwH}PMX zPpHQ*#0eMcc)T-+s>J3-`W;S>V?tSqd?WU3N+RXbiG{}L34T9D!zIo*+pV9fJ>Iun zRF^NSR24nk=->G8XLeCDQ$5GYiVNi|q^X0Kfnb)Cxy^y<&0JIOwEMqA=ooXrH)H=# z)lEzfZWM#+*W*V=PuUGwsF}5lCxgRrm1!tLjT*(SGaG zfjT+3bIn?*z;CsN?kWpV39YX^m4E7ykH$%-9Oru@LlvdI9T>^ ztgk+IFvVmpg4#rR;c~6=Y08G3+^fPXLUH&{yk%&pbTW6e)ar1oT^SUp^p4P6&eGtZ z&`>JCAb-;bKsxbWt$mQGQdSOEsjl#jmJuX53UqZ)-kkN?ZI1y5i6Joc*9oq_bD!08Z3{HegtbCVUsh@e)* zy2@}ldhQQuEveZ4z72VIQ|D{G53{>-7VmD31c^jh`l964>$~l}-hH!#%^Jxm96o(&N7WNRRt4Oi$E&d`W8P24@jQ=Hun+gpVWYix9ajilE>)lIfz{ln#F{M$WxLBIqpB^w zxV#!EoUX?|7e>?;wVN*1?h#*l(ZIyk!94q~`$D+BBP@AOd{4OHyF01CC)CZ+wA=R> z4u13>(VQKus6OG7lU}&1 z;LK`6d%IxW>66+pRd)5$blPf`nu>h!MD5+>bZdVEqa=eI_&E=PrelM2GaN>z7U;eo_NuA(v)uHlb!BC^O}$vNtVO*kq2_? zZ?^dN@<_q~_aXUbgf0K<^!|6CdOt*wEtOHWn?|er@o!gmCxN4!T$ z@6z0uE+&L$o05#RDCaCpcTBjY8C)M+8-AA*zOIQ7joaPo?v}Z5-d|*dNpHzNf#+<0 zIZf;$%bMl*G6)b6#Gqw#p?AlVKfFcx)30vH-K#s!mzN=>{xw-y_u&DCNTrzY8zR@o zG(r3~r$ByMe*JooTH}Oh062-xD_38jEq|Zff+HjI5P>Ygd2s7+XF4&DJ(I=&_k_~o zOA!4K3k$pgi2gSqoD@29=cD7h*I$U85Bl-^rFhTpBOOq(NuRZS{5#wSkBEFt;wu#k zNz&L3IWjJLoB7$LSUY^~B-b$A{k2K__I?e~6`QdS=d?!55O%ZpZz%mkl0Izl5K25R zzsK1%#Za4pKu{Cew}C~ghLu@L6@KwMKaEI%4v20ThwJEHex+bjSb7|8^U+YS?VMWO+Za+_uI2DTbPPcCqw`WS9SxK1fllqcu&Q=EZ<%_c5*#m)rXNB_o~=d=4_! zz|NfNxi~m`2Fr^WgT{B>U*~N*HJz+3R`4LAL9>qXa+lVPYryFm^Z9ehCEsULc@==y zf~#+}-420qe^NRyHBhlmHvp&U*BQ1UdkP% z8-b**ryMaHf4}_dlb;}I*qQDGdSWB*yo)r-$itv^GhLY;B&pm-GmX>6fLj(DVwwjB zYpRrx4~Myy=uL+`)Rz*Ot_TSyb|OVzm9~3fe69VkoaT~IaQ`XAYkWf6$~ULOt3ARv zKgYy%b-Ku40Bk?*tY%ize}Fcu&O?n)K09(6i5Jw^m>L~gV^cSY?2MBxl(P7Qus2j( zfa)nuy9il?$lEp!l5eSzczeGDEHlTyqu$Ir&@Q09HfC}yz50xQOW(L?aWcQ!ASFDN z|6;tqeeiYIqq|i4Bh`2?iqQpO3TyqEGYw+@0pJ2KP7L?`tDmz#ukqd~C6vISPRNH! z_K=7#p&Nu-MFtAc*1oObDw;S7l)3olzB`bdzPeX`;$0V(Ty`+{43GhW=@)(gC1^+4X(2oO@jdJ2<~`F@ zlCDpQ0X4Y4D2r=rKI0Gn>GsF-#fQE(;38epF)+vKa&7}3u`u}kep$!k<@0U7QIl6+ z#~M2HjoynaajV=0gXdw_Lv!{W?sng#jvVD8q{8@7B$6#NBtm3az1@-nhPfZHd%|@} z)t~Q;iJ}jdTFd+`{1a+VCB=Lm2SP}b3!rNk?%ZQJ>1`wGWd_U zAFSk!-@SzxNl0b4Cp;F(pjjJo>?O!kqZ3}o@?qT+OUTp!Z)QN^!D8u~&5~VdX}JLq zNnu4_ZlGpK(U$e;Y^y4QhQd-s|AXp%S{yW9Sa6Ag(_H#)imiW0G$zoRnpkX?l9EsR zLU_VHPP$-x&fIiFoclK4p4*!D+=1NCbyg=jMwgHkGbak!Bm$I+=f5shruOz8&I7z7 zHsJIQhIrg=oK+Z4>f?Gzb9vkg3GC7l206U&a8h|H!%ef`^8sPq|}z zR_ZS>z8AcWoC!|Z?oC>~20^>lihfM5Le?%UsuTlFff!!Qo z@I%WX`^HdHGoFX@pCfmb-yH;x0UYo5_ScolE0#XkB=gz_!cMUihM_QZVOBfaP| z>|dnZEUA(^KLg3SV)YNqXb3KGVRzYu)nNbtW9VyxsrVIU9PbX-Zm-vlP-lcTig*pj z`*s1G!4{swAc&MfCy4ZpVo2If=OKj&$uCJ^jwwoi?_k<@anw4VDDu}$;i>LvsAT>; z;SA}zIS28p;%tIQz(X&y@DvvpV3g@YLM1!Bj)x_|OC8U(DSg1Xgw7bTDEu3b!X=mZ z1EIAs^neK;Mm<`1X{bFKrkMhs9k>^pFw0*jza+>`b5Wf57n@z0^4ffepKh%lR}I@r2-W7?AO_Q5BMy3HdA_oa6`c(<|&ik zrIgfiDOB9td)S;Rh7(^&fp4Ah@~1@l|F{4(jbCNX_5r)y1G?WU(HMsmez)dPiglrF z0U&)~X!d!VTXpm&;dG`52vh%K)GWE<#>aPlypuFvGTY$70*;V?gsy5(6>fnT&u(`% zDV$sk%#o+0#!?sc3E9&srR_ngH8oV z9Tb0zHlk?lwugP-Sq05nkX>J-Dx+p)hGM29Cl{BY#-6z##-cyP5OaoD*!9GOvQh81 z;N53W5EouBS|Ou9#`tt#XfukzI{u~L<>^>EeCsGMnr+b2nG>R zauL@E!t0*lZK*dZHr2n=J^hLSY7`*?*r&DO&?!fi=x2konfm3GTNyV2Ts+Vaa#SDz z>0nR6mFx`|*@1(dYE3msWS8R1035956%m~RBqS>I0n>cEAPaa1R$Mq!Xr6iBfVl*@ zd@&4Koe-{Yy0$xTJyTbbuiyn#zY!4SAcPwl>Gy%^*5ez3Z#teOQ~MVU6;*G-9}}^6 zw=wL=$_qaTWR5TEg%8inDjj%v-`x1d$Kr1A<*4ohxNvWb_7(m=WclwN54P!Kc)gBf*>t3<=XZJH^4LOQ!Gn zD^^-ML2*J*u7goY$0)5*j$#e#5u~5M!gjP!$q(UgQ)>QJGMc^vT#2f!4~!!2rC5O+ zhz<`gQLW&$oE&qXHR#uVL2$}sxgk23QuVBjNGc@rI;%Ihyn1Qe-wLsJ+Xtx4yRra5 zD~ye0LZ`tC^XB4G$M=FqV*g<)y)uOo2Lge;>lWmSfmi087))CAoiK?g{ni1;2q2c2 zDh_9LEaJ)Vd%TM|)ekQm2vWvaBP$bcA8wBL0sR*gU`ct$ zxaQ`iqI(|%1O#sFFZU;z^PJ?XiSm(=PASshAf&;+JTAYars_p(106;GAF;>B^Hb|P z0-xTklo}!wu@*%|2)>uq{A+g0S!sFsb_aq7#N1Kf%rRV~L=B9tl++SM2=8w8eTc7K zY5ok4NlSiH%kv)(&>3|TLu3r8q`&=I8@lUssor2U4NopC;X{COVgpKMrw;vm+aeIe z0TUwnKUeB>y(pSR5SK)7^Z8b9Z|~sPm~3f?Q0h-%3hMYT(cfN?x^Fq$94TF~t zWU7Lx^78*xJxhUEQrrt?R_BA&Y=}A`;QhoolO4_YjVIPfCSh@~loIH>*=E6`A4YR9 zy}-z{t1Dn|P`;v{5~YbAO2NYiM7+N3A%tr)b$lrT9=$;5MpQBR5*Pc;G%&gW1HV!J zSYX2zYF4(|cZ4ce+&I)91F>-QnQGwW<)tEn#uYSfFiFrvhzM0yyju`*0liwD(z$y% zP!IdTr2>?3@nA^t+}N1E-mNFocD2)3PjH-wk4CxRDI(&6BP1JBk^&1{3SO7IZ!;N7 zyQkauNkZwSJf6df2uS6@1YC-R2PnjW z^l{Q^=>9fjn$K|#RE{^-XVlp3p>3d3TCoRV4UiYjwW>l-tY%-hEQ?px)GB^AQ9#(n z*Bq=W@%h2d45AZ7nPNvO^*fZU#AF@=ExOWtvN?uPlhbC||Ic4c@40ArY^e^99!~tw z12&@*t8stS|LOy-*>n!3W!#Sll%I_f*dVRsbUOW*_Xm$o8D-aTca%V7A7~#+S`y1U z3#6)0e8)U}&`rU*w=D=)N~vitl1lHx`(|(Jr3iC`#({XU37Z&_GK326=?vmP; zB!l*$G#%I(AOHQ+yFNb{U^}us`S))7{HQ>uf^O19YYxtRh&1kO1d{H>J|&m|91Nt1 zF4L=jZM=Jbetjj{{N~Qtf$e1{Cfvw&@C6ycG1Iu(^|)!7o=*I77dg+KNbq#V#K``Z z(BC|@V$`LMo4y={D;k}83QDP%u8przmZEN{xM8K-4+I|y8Cpw)K73Uke!0r>Y-8@) z>9m{&H~v`Rf>-E|h^QD)RlQ151+)4$H;F~s0;5OSukm*uFCJx)>9&xw43770ykK3H z@;^tH@KCCjCq;JbWI^qtvCxrrm(MlKlt;D-TEjhXu*-L z%)4Wa=ZdruQf2u4UY>>t4D&jE0BfKU(-A88q57fqT^}n<&_FzvA#kI8eIJ|&xH^L2 z^6|Cxr3{KcS#U`6D=`U$U-yxCN@(gtTOU2Zsk>Xkf+-@(B9H3z12-5G8~;K3Q=Z#L zCmp^2E?D2&?tbZUFI>@B;!7wK=ncl(wLNw}roqDMAIw)nCL;??&%a0*4F@~y6^_`? z=rwAsvkidj?=z&Jy(%a`D2dx{4!)!TbZiq>7nx75!pN{}W3@0&AYkqJb$g11oi)uO zfgNCF5k1>jMom?wlR`L$%8Yuy_B0&C!!WtHv?&D)&lfNIxE`~)`+}&W`R}=7&*V>H z&a*Y+$v+eFK#QofoI37%{DoCmcxTyr+lW%iea~epRTz8|**b2(LCqPhSl7eDT2O&W zr?yqY!{ffIlRTV-xl7B>Z`d7f;%!k;Pmz&6&Lg{qJ_Nf|h@yO9b-a}lg8UhrleYhq zBkbf5I}csAgKXlTWAK>DONfG%T|uwBFl85QcU5T;{jd#D96-%M7I! zU)B=312SMrFn?3HVf)>?k(=?ABV=#C+3Gi4e`}k9tgH{8VHudLx*YEGMIt|zSBt$V z`x%}tW(zum(AIW$`{^$^G#XWA9aDJB%gMC#;6f@QCFaKmvhfV-C5Dc}lYjG|pY=vU zrsve&aXbza_)$`2T#!wzqu(J(D7MaKGVCqH&Al~!e6>v`RB4s1AIn4#7@8%!{bw?H zeWuRQ92(l16k_V7MU&0>pA=SB&=wm%=WzQgoiz|Idf4d3W;ThI;$vnq*1M2@!p=(9 zetvXaZZUOSR|+A3is^42cE>PEnV77}dB}knN9K^CJH5OD{fChZ3bbo1#{CqzODN8- zQ-yri#qNgEiG?!gK2(dXe2$`kFq7`UlTc<6-f{5ZR}S-M=~uddA`93tK>Sz zU8mE3sX{haMdqBWbVChCY$`W?7LB8rnlM%~t!% zEyraosTs@w2H4$|0|`4Ao7lt&W9(xoP;|GzPcyK;@`XX0JNCy9Ld6cueTpDCf8k1PwIBe_RE(1vZ(>jhLKteO*-YApLw|S8KLQRV7~PXDEL2b-_21^ZFY2% z0rRA!T8Fk$7yCD1&nZ{EJ@TOjAd``EJ;iMUG!O#9xQmi_j4ugv!B`gjq8E=6#_K=P zru_E)ou|?Q(dwkazF#9E$YQyWNQ*H<(|G&)i%`?WLr+70@9;}Qj2p8$7058}E|n$P08k8F!LPM)1v1 zw5nt+w<#K1A!jxRvP1bke)bC^(o?OVORBS90!=d#^1W1uX>Im->2z@%qV@M=e?Ltc z{3$ob<(N+Jyz3EB9rqs{w$3)9Hn?!@FSgktUJT`R#ms-td1B0BnajX280?7`zzWfK zrRODtxndRTM02NoCqW!JR_aeR*)85*gc2&Vza)Rxa^F4G2TVvOrzTk@r|_$8-)%)J z+a0Xd6JC@{T7=OPEv{I!%!q*BW;vlR%Fx%Bf|{D1V#H$x9&oK18{K-aF%L>AEWCrg z;-20fyZ~6$7V5*yj|G+0Ze8Qw*UC6BjOky+zlvc0SXog* z>N3Zl21y?7l4y|8Bb~^4Z~O8Ogk}a_U-29)wD_5)oXm~%AMeccoF8qLU0r*ARf8<2 zTR)q9%z)!(F#mJMW{Q~sWlk8vM(WOwP}QqKqm~VT6#5z#x8NnB-r~IIAXeZ*WSQg2*Xq zcsyG-g@5kVHGBoT?a4?|ultB_Z?5bM{v!*EfXSwm!UT>oiwg&x26vxA3v$^M{(#tV zjGA6kJ-uJ2drQx_?PyMR=VE&ZJil*&i`}hjOM?c7ZT7{*P!@gP*imbw+qYmWhi^i; zGXZR3KBIRnHj01Zqw5uWt+UvC0|O%zxX1Bii*Rm`XK*Lg*7qfS8BOraY7mS z7w|gY882M=ov#Lk|0}m_XbiJ1|CYH0Zsm%!rY1i8lmVyhd(*6O(xuTNppL(OKeC}& zWfd8f$Z(G7mVJf%2$7+48N-;~sP0CI7t5sE4kr<~0~}~)<3P?p0E9Ct)hg41ms{3n zZ-FeC%`q)W@z+Yik=j5qDK}wZx6&Da#NHLwxoYbr8r?=-w~OQGo~wI;lVBhBHPw7_ zzd(l&UMu3wZ%zsKB$Jwp-u4Eg$IWH_&9CSo=5=#^c=jsG2rEgb)+)u zt2Vfjl6{siS_tHUN1e=RQx($480`}Y3gIZwf3-9GaBWNm?y1>njslzM^fwsG+{aJP`1uiqzE4n)tCAxM zEWH4E>ixD56dq1%YMR>{ztUH0-&5ws1ff1K0C0VrzXfgNq`QZpyu%!m47zh*MFk(d znq`_Cu`wKQgH^lla>-GJs9?*^S!orfe{l@U_OPSdw+qy3BCN5g21}i7T~0Pc53*#M zHoFqQhtp!%`@ndh^y3g2gj4oG#d^C4@zCV%K8e|?eet~zZ2zmpSD~dl@PkUeBq6QX z2bfd5{2=qPP&4XAk~w(`QP=K2#&3^q6$z$O>$eG(ri#oEkAkp{tEedECjn5}+UU}D z|AEh>1~=zmh5~t(OfrK#K_)KdGhjKep&Ivp8b4KnGz`mTq_HB6XnM3Hh@v)Z3k$yv)XfK@RUqj?%V0sX` z@!}#FKSy&bhUzQVu=?J=506C3H5%u7w$RzW^7)k`85wz#76mKY@-HuB=uPPCDufkn zSfOLOe804@HlYqdvUxvvYlfgdFxgxa55S^SZ*pJ+c9Wu*qGYjdlM!TkR@c?IjZ3&f z0c`L39oD@*F8gnapO zxH}#u2-z}Sqfwx|e9_q=TtLxtcdS4wKxO;S;o3|BAt|Y1M_2fB$PoiyQ5;1I&n7i& zQ7~-#LHd>>BO1bj*GH(qLO1*CZ<(7~aMFOF&ZkjKSCbX3`D);Wh)EyNxHyt6hxjaL zxor2>6!upKnC&StUpZVlLGVo+zhO5=2k82Sezo~vQA#3&^7k@&+`$0fe5N*xNt=N4 z6KDMS5uy6*eP(j??<73^~7-Qpc?<^U!)N~~jwQ-`RC+ZkB)p*Rw*u)-dvAg6h zSg5+oi^CzbN>5(cnOKpL31x+0$nScKT*_6&mkVB&&;`p9Va`l|P2FC5C{Xte@)n!f&u&8VHK z2D?>%Dnt%|VOY$#R18Caudi=&g4$fI8$Q$*aDnHqdjeMIHKm5M0W-1N`OJ2dU2MTo_^4`N92WUyVU*=+6YiYX5GQ+_6rO|yS|?KQC`sI z_juiIYa#-2s37+vhVi6WYtkE&y#1x=FpZ+(j$seqe+%e86+YM6moA3}AbgjW?$v<~ zq4_Zj$IBK--q@k0EOGcv2RK+*MG|5A-@m<@KVGxdsgfbm4GCU+&WHGqYzK?y99E&W z9ib6~Rg5&gHF3|R@EG3*$KpX!TO@q{ksQIh2(#$RTqU%)fwA`c5CZausQa8Y3$7Ik zDSbWj5GYEUs((u#lAqW9{7z!j7uOOKg3t2uRWx_#u*=o?E3iLI2QxIb4-@|qmLRlV z@|`>ekB|_!^r*cSI_r*=yX$dd0mk4Du(8pHhZXk@50{~#owT{R{r`CS%BZZ?XloUb z5Tz7pL0VE!S`buPQo5v(?hYkHx}*`MMYlxJAWMG=y>7X`*~K( zHP@UdBJ#Lgx}fO3A=O1TMW`JJxY_q-|lwuwe1L z+A&i-hNS|efl@_7(?TLs5&OiS1O%9Ti&8INqI9ke^Xx@=eU+kBIG0Fa1(O-L5W08C z(>~VL3hyrvfQ?*oXaY%~n;VE#`wv-vnW&%aTIxA<*k3}ClS34ehCMun3X0@k@V4{~ zUj%>u{+!<})~m`zAmBdZr>Lm=aG*{WU9+>Y3a#ddLqN{CHQ2P6GM9p$OO6_^E--VM z8pM1g%Pq`#Y-y#}xV?4;u_R&)&nv7o>TP`8=jQIw%U+9-{u-wE;};<-a5k%H?O#!n zz)$?!98Sfwx7*;@fd|6F=(n+Bc%v!kB;DMRya{5k%dqARcV7-!YQFqI@7rypnLnef zY~O)(CtX$i%j@tJ*c;`Cz5X2P-;Ge%8ZR$2f4ID`cErzSU04+@i_@(3AX}FHO8CT# z@GIYA?Rr@h6rztGli{(;)wwylxw#QOcX`UJR&u;JJX?Qd;gh-iidN=u;nKbEw+c=j zSX=vSb2{(wPn6jwD`YBZ)Hwb3^&~+kwV=FMuj%w4jhc=_XNo%|B{j>;Bp|r<`Q`QN zP&=xv#Wu3af=s+4_!8DSg(JcV886Y)O3gcAw=F${R=*g^d3-$5u8s=s45@D{P#L6K zH+_O8FyaBL7QMc}dX+usKws$!;>Jm3?3jNqkAyAZ*WvWAfFn_VCCxxHmKXUI!Qv#* z(AI|Xy3cuRq4gQMoHiWERL-}w;BW<*T4+e*%B9KD1%i90YKTwvP4Pho1qQGnemMta zAqqA3uuyvi|I0Mu-VKS28yfZK(K~mr#3Ur-#Rxtq=WFe* z^rtc@5EKH4>-fX1*V zQ5;kW=H}*9)YNR2Zu_oSW~mf{45^Iap1#c1w8F;7XyOJGOpQ&B@`btvyml)-weAWx zP?UF}zjHYx{ZML;a(TLrdv@e!uwJ7Z=+r|U@Tw78L0P%2*OIEWb%~pg3-`t_^v>vRV~5-ydg;C!!~HG3j1O4)vh+l&?6#$wGTv0$ofHif z`k1l9ND%ZKLm}j+P+kZUPfX&w?tE`tD$Y{|b^TC7=QlFSF)^&#k2ky<07#%$E1`cK zNYMT7G_Kgl`EY~Cp{xwEBb=lw@p;0ZT=nr?*iqki*&p9L_IxkoOdW*L#au@1=XO`&fZ@U z-AArXjr6kLuR-Oet5R2E?C@3cK3H_A4rbb3Zm7b9v!I|vAKC)U^~p!=GIeezV@2=r z{gw0Cq1^`L5gpn*c(m+L#woSCLH%X@?|7FfACbU@{NQ_`TJ5%o3DCi}TBLu@^2cZi ze4s2AlE|We=0GbI|4R17H9%q_Aye*?@*P%}#kDlI4$L;8%%a||8!r}9&DE?X0I6(H z(`(pY?(H8O)EmrrlcQN34R())-5?1OXe4MS14$Vs^l#kGpTJ4#U~t~j)z=s4P1@2X zQ>d_#0~3?u@pZxdzJGnmC|D#TXve#czEOClh*6(EWzIdnd2=JpYA&V3#DLl59)^Sr z*f-odJdA^C>2m;Hcb;t_5(=BQrU5c6=6L!=A|oRQ8|yraE>gHh$N1f^Tb`Z-ENaam zeX?2eVm*NVKugVIxA0kb3BiBBqv3bahrG;8v|qNU_x%HMryH;1HevSr6-&$rld-uiJ;U-7? zU&qw}RA>cY&?}X##3?v+Bh~F>mWaa;Qz0`18j=OG-mjBi9vc9R=rT)cWM+2v7g#f( zW2%9lokBrz@ptIS$OSK}X`1phDTi`RUvy`Vx}4zLZ)tWcK8OycHPjK zic3m1&3dBF%uoR|7`1*xcTNZ?*+aa+i`Q%%&p%F8aiXM#6Xa73(=_azW zv%w*c>@Jx=PS^>kv`R9#Uof5FtzPaYACDJ5bltlu1{qy1|3d4GQK+iHT=U0@=uK)G zy7|7k=b#ae_;VpoQ#oHV70MBg4C!>x(a|P#+&s09FSmFj`rtu^)VbTDh*oNLwj{uh z%6S^ekOPSFvw!?xgDec-_3Lb<5tw=&V79WZ4jSRm(kc=P)O>T|{^#8qL?i~&7b2d4 zgj!b_Jm^!#i?1#{!LuY>wKzH~!X^|7))a7s09geLEUa|s?u|_!yc=U*Gn0vbmvnu(?1EFfbbX3b5wp_&8jy zPfT#ain9=t_LesQLxx={KJfcCcld781i-9TRzU$|m1wZYc%wZoGk zo=8D8`29s^@Y5Y|l44-f=`qsL5fT$a2UtL7_~#Yt+5(`tC;JzK&weL-M5&&i=eVfe zRxL9_Z4FLn9m>+Hu%#0xFO2H(z3nMmVTHRklKXAf^k9wI=TobpTKM8B4+ii?V4fnq zI`9dPmcZi+Js!rmNqZQmOf37AA6Y?ojOGoY5NqxGb!~fh9ysfdp+f*?nBYOd?z}dT zA1YlRg(|}B<-AC+7`N@G!lWc8&|HO%nDk7TLyL0xv0Tc{1|gvw_4*`eY#_X47zPuA z>5$v*P~nE5Tso#Q9=en@bVt7a<&!G&bx9sJ7mtCD0>Y!eV_Rxz?^TbeorNfN75djoIH8=>jS9S zJ2?e4_FCcxKIqli`I9s|y_})Uirv+n{lv{lyKr-ZkKg6r2k3ejG$+EKjW9Zm0@L9j zYrtUARSNM)`5eN?_&6nFRgUE#*z5B>h_T4guJ?Xs8jW-RKIM#=FaH||_CSimxrg&Y z!iIgmEyMua;oh=8X($syfotan+ddDe{IKbE8&QGyUQkw?>YA^G_#PtH?gO}?K?|K+ z?}r9mT?B6kHPl#HFf2s7KNRyLpppmF&cK}Eq}UV;%K{kiH0#dCm5KrGwB0ziCSI6( z6u$kpCFkIX&Tf(uLLDREPBB)O{3w1{4bZ;Ah3>VHf;%fs#s@~W!V5{yQ>>2eJa;_= zPER1%hFHwjg|Di0MsJSQJr8*4mty5$0mgi@GwgXODPEzyCOt{PMi(xE&MivB?5aFa zR=lwLHzSp=UG?Qxx+Dfs{m~(L!{3(m_aj}`Ew^!j19(Me_VdS&Yo8S-c#yMXqhmSy z#eDK^SfX1Xhf(j&+At&FcU}vKGkRaWV5UscLa0LK4{*;ym+1{M90hN^FT5!`sHdl= zH&4%OVK4;)Nxu;gyy_EWCX_{TIH2gZ?Uh0^qerG{ zPEN!FuM{(+cxq}gILs$hA|fq28SJ;Pg0X{ZW$1jPa&4Dbrt+x*VN#dE;edV$aJhjP6D%m)B`!G+3$ z9vT>K_dRNk%r|-yU2zCbbDxaao@tH`Og{@eHq~ZoT}A8pT@vlwNl1Wgm0j>C&es=p z84pjuRTE}iKyGMvzhw0H|90OWY1LgyO|+l8XsCXb6#K3>ng>=i~r*#*2$B*L@OF+rRW*n>KA*_bKqellrl#Hb zS&OOJR6jn&Y_-J`b0bPhq2tq@n}1gNRge;`!TU?lI<$qwhTQ~q_6JtB>tf!whCu;6 z&GV|>_3GrbM}MLHl8`9QzzvZj8mo0Bk(PerwELH+{zA#;)13qa^!apmGdM(g##N@L z16s$hY++wS;Cp1YZF^!OK!C|>=OKX872G_9Tuedgqj__G7n)&Q!A7qfawshg==oj1 zH(Q}=uXNdc1cFNG;(-L*l~oaL%OOMkK9N>Q>_#_YdICm z+{a5xss#T38{m*<`7Adi#J?l*;xm|t8xLpPfm0a!XOYG}kzc1jg2w0dD;zvhDaatj zq#UkW8X$kz+7pKJQ#m{1kI!$Nl|Ji*&P<_vE$Orj!>x}>1>f&pzs~o5a)d~ElmM!! z<6+kOfy>z>4yzTT&;14W$H)}zS( z4t$^x%VDG{l57Owf2wjnS|nKQnrw=XfFHK@9|&jwx2MP^*Pq#--rQI?+>ALsF;98% zG3P1>eE{e6BcZLm#ZFO}T*t=7%8rgiM_OAW5G$#;p>b^1cqst?5P}}z!+}goc^z0} zb7J#1glrxLAA|`B9OkV-Oe6=GJbqE&V6?yV#BGQk1eciYNqq-KMlt}{5kA9nx26eC zbj6znxF0$z-95qADe$KaI}1zi0Tp78mpfUS3PZLW)k^s_Zf9XY-jP=9B!VV3K31Q{ z5CVu)>{I_YB%FP}X0#eGqWqw6;xrq3EkE$)6V~d*I3@**IiYrF_QBu)Ije`o;Qqe$ zm=Z4Id|R*nsU0gc)g63w6boXI2k3pkD3kA{Fd{{MC;llV6Tb$6zUy5~Zn)^Zqd1C; zAmlQX$}k*VM?nFsGkEBUucwMqeh&z1t5g}|f>uS-P@~s#9jG($>KdWc1!;o6FlmQc zr~U#}0x?b2argfjo3KBs?P)DYLo>JzB@KV1ZTJd2XKa4YZ#G?X6>XOI5gpX~9ek%Wn=?}?+#;Yv8w z`}LJ}aPCPDp+@JKv8=!N zRY`eyQ_7G8ZG2}Lm0rDh!#rR5xm|2yZIliscs5`8=!l+MkfLEfG?X!>hpZ3|J)!II z4ka_V9=|hc%UK;*BS^F%;y!(4vu!SB%-jWi=oA|cew%x{o0!1%Vb z;N5Pc@05%L@~wc}fHZ)FFo8sn7yzB1Bl1=q{^{iGx({lZS*aLTa!~Jp>5Z_R856Le zV|YUv5mF2GLjn4VS`Mzk7gl>}N;~Ro8=+`A@~7JA$)uNe z7U%*3U^;`0Sq76)0B)e^n-!e@ynXcy0!U3w?KtT@YRp$Q@6646&rcZR*mMZbj*Mzk zMu&#Hc6NYwxlc@&nZfUVsvJEJ;*(ObY=NtTwH5AX8T@)MPN4#uZ)zAHH8lL7FZ<*p zTd(sH1{rivNVh+Of(0p`wVk-R^0ivV`@_K~#_(zN-P_m?y7OoZ4NWAvE-!MltD`^s zdJ)vsHHL@x2-1%r*mJ2C+A(O&%wSG>(L5s~BLi8(pMA_mSIl@&^mMpak3U@Qk!zXa zpFaYBsXq`ap7v6`P5~s?35z^vw#dM_NUl5u+}dG&>SBF$>F!`Y8&XzwXrzb0=RV?* z=ra{^W=|riMB93T2%mgJrsQo8GmA(SAgHOAZ_UGHJ^a!p6kXG?EGAHiEuLBXh< z1oKB|9Pn(dZ4i}yWUT>Y$NRpE;{(@<8osh8(AWGCs?tRI?f=quh%odHiYogislTHH zT^|lGzZJ`4^ha9Kn6M8~=?1N)bGW$YT7{3mcPnPHhNlI&&ue4hU=`Y5?COXlU4SmB zb+@$+eLl$->38(z^~OHCz1R~QV%~cP-3MaljBr7Qe+TGLiT-x4 z4&J#SI60OrdWFGjzaCBJaSKRmi1sVcU={_GTKx-O(D{O`8qIsu4~oUA@z>o zV>}q6Nd_);FS2V(@2&JxA(Pg=nIs~GObIeN8I^L6=U|FP!%dHF%Te5$CzJ5RTU;Tt z$Y79Gjza!>9LEENbP0Q2M~j1&nU^juzT;K)tnu+`@bZ`Dngj(&6sk%n@#%VWmbx&e z>X=WlFrB^Oen%*P=kUZrhmXZ%YYL5|@yO5nq2va&8?aDgc?QXzko(;=7>{z}KM)0& z73e{6{TrwH8i_-=`)Oc2j6*>D`w-B*Qdh31?yendbR5Ys+iP%IguT3ZprOIfl!EXy zH9nNx2E#so!KeeJppCa8wDbL`qH)9q>#M8R+jC`IKvo;LM2PS42f*7A!R&Z0^T#nK zHUZEC436~gWt)=vGHV!@yh8gh?ah>sJa2 zfm*eRVv?Oz^m*B5Bn=I?F!8_A;A7fQw;(M z68!@~xQ^~^zG|diTc{);%Qm$zE-!ML6PAyNRIPO50oFrCNbnsfJDF4}Wbf(I^i>&1 zvd~bo^-Yt7Hh5>5nsx%iIxQq>If_;J?$tBX*e9k0;jTx(mdo=v+vMu%?gDGUu&L#U z4*hF!O89{N-9XlJD!ZIPIzcM?^P%W#FclGUS68p>ic$EtG3W=8uE_N4kl)@b;cXr@ z?Es8KuV0+a&uv|fAHd6Jw{OLQC;fh~s`Ms?FYr~1JTC59OjQJAE`MMRVSFnV+MPfJ z;AiSfKM`ogE_z$LzHPTfF+PB$heCcThw1RBmIl~ zaryYctw|3ugo~;k#r!kB*!rR@Wh$OWWAkw3?#czIW{pFivdZ z_Um7#AUSSxqYoTfJKcC1V2xu8pZu~ViCg$kLR>sK-5UkUQG*812+c#nVKS8nn`sXz ze0yu-VTqJ4H_mG{VLogQBBH+FoJCV3(g25 zqdQ@AflM8T8bMD&Qo+SDAYBr%XoOhP44C)>8+awZEp=DEzX&udjV* zMip?Gj5D4m{}Ian%+J#u;me!wyGIEy$?vow!7-YGV8#>d4yZLvnZy;fj7 zPY#7|ru*5gsp^=@Z}EYWj%&lk_%KgOr$fH(Ft~S0lkzm4+j7JGV!1g}8H8)gO+h&Rt%7g0@XkPgg#qf1S!;j(7w zEsDeCyJxI^liFm*Zt${eYATa8gpnRoH9nrSd0zXas&6{p|JZP@| zct`{caOMiw{G$hwk_xw{M>KNL4>ra*;!BJ_!fb4=+ClEmH$`iNGTV^s?h01~*Y(e} zI~$ucQjgDLyuInl;v^DuB8^B%pJY@dZhOmu&pI|{e}{I+x7np&i$)w+j# zds^h%8(J8OobS%ReZrMlRto#1`AEW}PY1w?!|KeUhsa zIq)Dyc^@Q^mw?E>aT~k$*c0my@MNBvj07<%=UIWbC3H!&I`VUppYH6ZIPY`9E+k9m zt>LSI5tbJ~CW=Eo5`eApvCtc-HL*_$SP^Lbe%{81050|J6 zSb;B7VrTUoxJlm*nsJL}A54ZU1BQL~& zkjG4sZJ#j|w9jxIcsV&W#HGFh?VC^w>AS1`6jMwax z18V_p`@c8AXipy=AAky=0V%Pj;{5w2E33)qPv6wQKzV`00-%Th$I)gxS5AbsbEty& zQtJ)%_M?74Hn~0i`V1UUNx-bsJMcDGm4OsIW$FrTyQqoDsOzamGQeCN^L#Ag5*6_>B=?e_r&?0|4f~GCsfDm0k6(dQvj@lK95#?Ib6*X z8yiwsk?XQF?4!^FhIa_qFt7dQ?{UFP3X@p@_z>kl~>r(DxvL@O%NI^CCqCcX#keqc~zVVvh>~ z6iw=)bU}`qHzo{m7GOVZc=bwT;8)LGhvA*gC3ggX?&(g{z z7R4r~W}`>%E!5k^Mt?Wwg<4`UF280hkqhQ#$aL!x3hO>xW3dK zcgljXhxDAu)sFbJmJdOvpD5pQx-1x)4K~=qHSCS0)DfO@t##TZJ$6%9Jy?4NwtT!v zNhlC_xs{Yk>s`LV#9(Ex4OMw`=_cx?h-fB`LMF?1_cIZ*u>xW=G*KRRG_PwWCTsWT zzsC-z0^G4+0zJ>6=&J&o0~3Ts32r>9FA|1gSPqDxNgZX zvbO7aGbA7QJ*+YcCXVx*adEl(YtZ%=wh_M1wqj-oGnk6Xwre23kFSUO>1V~)USTK* zUIEiGX@Devy#^bNZf@=f{BSo{4IvQ5bH0B>oNMR}?DE2QTN^$mTNT?_F~|zyja5W8Hz) zvFGPA)8?PxEq)y)6P++$MC>YHvj#}1qOL|puwW*9WHG%moQj6@x4edVM!IHFLo>Bz zaF}sZMQ|&0Q1+L)8d^HU;VyyAYfRXmcWYx~1x~B-x11L)1@6J2gi@1~-%c#=^`p3C zos3WGYbGY+F1&xUmGdhiVq*&<==s^@8I*8q-A*Eu%qQN#65$?=B*H&}E_-#Pm=2*9 z!V17dsmb*nfZF$42u`l%5I67vOy)4Tw*cmrk&Zqj$Q83N%VBhx?slF7t^t_J(v9S zVO2V^k6Y3aS?RPz3QH(yYQe- zVm3G7{iwo;1=zN*H#1}7c(y2J#ssWP$;7u|dvn!PJ3=km3)BjmJ6yD@<2bq>oG--nQU?kjlt9m+^u#c+xRw&>yPVzXUcq)~>Q z9T=V?rS;PA&$;>aPPm-uA+e^4^x8?t6Xl@xDcG@k92Z|?ap3|9;N0%P+%h;w+=P5k zb+{3?epNeCUb+Z$esCKOnI%}t~cD?4MH04GsZpn?EK zO|PAo2+-gN%pu>;R6PS-G|~Y7hOu_^F!BSpN-jvI_uXgq!r&ehZhb?s29eu3 zo;vVK&rzxRB4A+wckDB8FK^yLEp(g}Kux=U^8^9?SBZ!TVL&d^`tuQqt83v;F&rBl zq;iCHD!9i}Vp3@!t#N#OD*sc82;w>{g0_#$&^U`jH(jyQ_7IDR8>|8S2k$}X=!Oz+?>&vi=D70g9dU8$WVDly(|dASHMfz zJqkEbt)XOrpn^SHYF-VjD@eO{A>ts%2bhExQ`62Td+G3!g%9z!U4)bRA+NE(>VDx* z!j7z@GO#PPX8wktBE65D}LFkY*N20Q@-<_4QLzQzRD4y+MTh9!daoC$^Cg*+uD+glmkYK5&(t7?DFqf0z<6$84ALa4OW5s~7kPyHd zw-V-KK+vfc-1?SR+7shAR10m=r_O2(GC$lQf&I?5_AV@_coX>?x>Upu;E^t!9ltZP zkcKWWqdRtY(9@IK_K+!rh2sd00E zW;XT;dwHKh-UpVQ5T9)rhBY;h#UhtspilN`^(Drkg98#EXSB3}64mjZy$bUiOn6^;-HBo65fmiQLxZ}avOiy% zCox5Ks1)0zBar~WjURgEZ{Wdvo+%Fn7jz_+o2aYnL3->+70psf_ClVIFaTL!DJkLh z^krMlT81bC9ty)Pn9X;^34Vil-auP7^COks~Z~Bc1Kl{)2;4H$1 zhBg%`73bT6VK}^*xrEfq!v+4(@Gudt6Py177TMuOFTh>~0P%tPFD)dR5eV!B0Qlndd^0+4 z_LpxvVSqFMxar$GnOb{Hg05qt?2L?PbJSALGu-FSdp;G%PHGE9kNT0h|3oU9OcKA2 zkr+B$Ph>F#u>Q7*p1T0eLDdWRhBTyMD_99zRmdoCUsnQ;;`9)P1vV&1jUYAZ;NnWf zac(BemzI=_mAdl*cZ7-&Ya4wto-p_*%u{An-^!-ftEu@M z5=>(@$^w1fW4L4`aAefV-Z#PS>R5rtb1uv26hJzgn_F$5cG7wINsLUcy#WeF^t+h4 zu+@0ea{9D;xBlXgBwR;_nwA#v*@b%9U(jCSx_GfD$k@aR8r|*vCfG}Fb#S!vt7)1H z=*7LQg7BuQkG8IdIUPI(P6B&gdV0Dw41MSOZcsWRDd<-X7C!nRs5JrXipFUpG(+_eTvfKh%$A%+Qm2b1O zzQU%S7#ZUzB4v{V{yw?Ntd$m%5f9)Loa9jt^mowXxkIGPEPs5SUw?TT2s?gy2JgjH zoVX$HcEqsGvd${YAsbhr`K)jsiWgUFb}E5`0$fyYgTMzIuu#p3il&e%jkrA;&Cdf} ztZWF^SL3_tV8(G5c;3y_@(?{Z>fVLw1D}YX6_ht%tcO>7df2Uqw&YY%jkriDfz@@) z)-wuU+r-~}jLGXSHSwg35%0)0SUQ868UDWdK?(Yp_O@}{c+ z>Li4|`*rcUr7Zj%>}w*+0zh#^6d3OI^i&p&QKr9-q|>u7`~<7od8aR~c^=VJIb2jt zm65HjtnBO!Gyd7my-iF^T<_Kk$vzeQ+zP{S0rV;{8Q+W9&Z38X#0qTEb|}w{-&wN4 z35$%6mw<1&3%qA2j{0&XA0Y1+2(Lj0|EQUseu20p1}iDAZ`~z)v7Pk%{b2ITR`FnM z2x7v0rw7zpwGyz1HfYo>|Kj&XF)Z=GrNx-3ih`d0nTz_HYg`lF1%3D99#uQg+k^Sga6tmIM1 zcypE)sp(Vix(SN{)X=(tnt}w`vLC>&q7V^Z0?wYTP(YD?$$*!hkzpvg{S^U8Tc#3$ zTmk4(&`4#Pm>tcN@VhK5SS0K|GtXTS@d2p9ztA$P;oy^WCa)MjR{Z%&Q(avc4B1x&T^bs((ZvLYO?@G%u7Fe(mE z%x24y_tkVggxjbLD^5lV?{i_N;^zxv7UB3qhpXg~l8QGi9{ zfCsFXokw5F+d>}>4m5nc<>1g2FM#YBFGEi@R9d=tHCDY{k$7|!Iv>g@p(M>Nk!;4G zrXNagAW1aNNJHuR1pBW8hf-L24^g9cLLh37bXr2x{k^?CEW)Qh#QsUaf6W=5o_9AUMPUJm8}NP-PV?UbwX>6ZjI1CN z$z{36n-L}hJr$0J5SaJLQHfY_@y3q;$}m0@(Uw$NzOa|T#Qo~*5D zHi_mZa5!NX=}u6nv@z(pb@NZ5E-Fy68yaSk6xu@I#XVmAEd1nqPEOaHHyXyB+j?Gs zlF?h^HSh7^2Z4Nkq5gQ0n{=!zXm=PSdZWNR<=r6YXEG|^T^5f#UY~gm-xBi!K$yY= z7uBfqYAS@=GxeEZw;1$|Tkantp3fsONrlKt+a(;(T|jelzg}nJz#Q;Pn^CjsDQx8Z zT`Dz&Qe9pfy5+&lz(ENQoq)jG8L;pKAS19N;TuariPiwCc>4yv(^rSozsB@I9;9lLAs6?*@OOc$8L2ZiVS=JH~J_w zjJk!@)Z8|3_oVIb+_`&vTI6uyG6MYR&UIK->%jH&gjd!P6vyFT=~{kGeyNL;iwgnC z2D2Yriy9t^-Ch#W)qQlaxe?GTK~L$}oSjaguh4Ys4mu1}mdnhcwZ~&7Bg^QCZI~># zq#=8Q<6{;P9i0&wN9206F}K>}$IZuM-8cI!zSMNE%H7prV}d4L^Gej5j0~!`)-5u= zv05W+-h;Kmwl>j$LQG}`28J@raqykG0R?Q7T_V%_ob14q6y3UiG>8oZ%M7w45O43Ccws7JpcXu748uYT06GzLzJsmXag>3y=0#A8p6>($#Y&$JLlm22>lnDz@{ChmFA zGElGmss{JlH%uBNXp^o1?Fe^n&P=5`y0)&)*u-=mr~peO?}Tsy2w+Cg%EOI=OD?_Q zdwa#$RBwCbb9@zV>c-~lrk1OfnNr5`M~?{kjd9>mrYlxEy#7gKB=i_gyg;>M@#JKJ zV7XbiU7~hGR8)GLKSslH&*I5gI(Q73-nF`3|#7)SZVSvSf1%7e>p-;Bo%}Yr)DyRD*-V&09BRLH$=;^j<(E;)v!8j<@t0p5e6D>%g6Z{Zt+ATV{uQznRWqZ?M>HQ3C4C z_v0z3ToyC>dnNDrUCv__O-BccUfFF)ex$2cfxD7MzXU6amMm;> z&pKmL1M1&vTzp;1P>l)?7kX#K1{qAJb0ilyfb99YOO>}NDZ#=v$Uri>uTp^yZYn3N zbc(=m686a+wVhuedUD9Ksn2JPCLo9ip*t6eKDRYd1<|$&oO?bgDSu`1zdbQ077cx9 zv|42FZ*?3W)TeGpoZ2dAXvFS)C6|O}AVnyc1iDK&EFWKNXEvR}fqsqAAm=lNZH;Y)1sm zs-YDWjNXlMc+Cu@kXitDun zB?ngWK+L5C{_KFY$8YE<6L4{zXKdH%pZnWPR`9Yv4uG~~cWz!3Dg)505z=buQh*o# z-Ly9eDIyB>TE*b<7V3?%#Fv}AzOA6JR9U49*8pH6joY{JQ6DA$x^VqF4k@;fgq>Ql z{tB{Fn&>8bsVuJ6RqFwzC!>BbO~r#tAHT?Q34L z&BJ{Ir$5K-MMQ2zPgkePrQYH&?7f6<=g7`MwRZ|zrleL@HjQIL5dQNec$Jd(mRo~? z%+296#wIR$!r-0p2Es%8K6A80K!Drv&PO2aUt9P|*FXO21;~*J$y%|&EA`#`QUKd5 zIu`H6;Vi0bZLzF!w?ITDMyL!H?Kn$SRr2bhXn}c}tAIi;U#-f~phv*ejOXs@iS^$h z23V8afl&R0zCq5@6IwPIzbjP(D)a~#mV1R^L+ti1j>N~-)kW5JSrjtmt3BMyHpeKX zZ{qkol7?I@ZD@Gx;)?%(r1RK%p4)1N;+g4a#v8x8_4dW4@OWrt;+wzzpnnQ$HwCI3 z2!n`~&fxxQh##%s9-G=0S`6M@q4ICvroqM5sIg;^X=8?522naL+ux=*V#VwoMYog` znAf-dl#Hnfh&6&Z2N@xa*Cr@jzs}^~Xmk`p zmZMh3KN{SJN?E=(oZIQZ%4&Eun0Bd*h!}#v9(<}H4DC_FWO0gMzxXEQL-@H*%zxh_ zZ*G1!Sk9_PO8O%|JFr(U8*~)uCm?NE+1OD(;sY~|+G=d8ZeR33Pn^&ent zwX`4(a^HQhBni|4|3^H1-#y#`s%uGOP}r+MkBot?7o)@P5$^fbdu|?PJRo%7+ij6b zNJ!Ar)AxZZHh*WVvPdYIy=^o7;YPhl*3X`P z0h*l{ZxV%m(b|A7>>&<3C6 zq8`A#tpS)Odc9j5$Y`*+k1+kabB8AeTQvK@GY6DgeSp#kaB})OL`4;b%hlyj-*7tX z-EHU5Jh28;5E%-miiWbS_fd{!rY)AzY;A2!)slD$3J$?mqg~=7X6RCU10U!Oq@cpe zK)r?!TH!O3^5Fb=OqvHh)KE z%G`dGLUE2PWC&lE2Vk!Q=&9B2B!f%cs|M!5Iv`mDq7DQ7H-*}%(j}sFU(^HAdlLtr z?9GGQx1%en6;xk(Lms$v=*~0H*S9JtUzXOVK6P;^F&Pcic2E!u36ev{&!+|Cnj#*LW9mZ&gf*X5tNnV*xh-d zfJAow)8_BJmjP8YBg5848cFy`bSqOl@ZugZQQw5xwE2)dxerRU#`Ru7Ik*;~xtpxY z{cD^i%?tkc;?mNsjlU&GU8uwo;hTEhghHgyvn(mo^qa6 z`s}ZdUAFe=qU9D5Aqr`mAjJI1#f6%NrXMJBN;zsR1(YubP> zJv@B0>wB6zB0Zfix>g6X@{${%$RQH6*1b-B&*veCI0%JN9GDF6Oci`Y1Et)KE-W-U zx~HbYx^QIyThkiYMP4R5JGZ7H^78A&6GmUGhVI zE*hIg9u8toC*BtE88jS`c-s}n7c*$oBgWgqB^4BeUg`9tw>2^*MpR2nVE;&6S_u!p z7+kk4Qf&dx4Bsq<#otk##cq|mpp(i}?buf3XsOYRRzoT&A)yP)zyFHLGC)PMS-_wLlcp!aJk5NU$Q z`3RobgQ6PQnflXekODDW`P0z+>UDpeCLgc5+CZ%`E7bN9ylNlU$7}fxQ$_VS-n~ek z^on`t?vK>xZE4gLM$i4Bc4!6SLIn}7oU!z?v*TSV%_@g<(DcjEE*2TE4#?SAAMNLQ zx&Uvj#C)1qTTt*5HrZn(Y>d}xU<#$WwbipDmx^BPc9Jsvh0F)TwajWxDL1gx6z;~S^&Sbd8st+n2deZSsd)bpoO2ZiMM^Q_4NN?6Z~u*JX_yq=FTYbcYYp8nPyyE|46u&B1Ql+G$lxw2s;N(2FHTUsqt|=k}1sQi3=VT{jx+6q#h>0SqsyvfN z8889^PzP48wCI&^bAinQy5NPL+gc!+3f)?`?Mgc?@!C2*35g^!FOiTYK)$V{mR6Gc z%nSl4LCQJ*Hvy=_6VUd)ckiA`nHvva3asD1c8nFDGGT)V$b~hK7cq`6q+BKgo zQbnNhM?Vn(iYLn1;asgFD}31bYN;dv%PS?3TeSe1u{l{KudCACvqVs?*Fm4Ecsr-3 zo$a>CkttV}AKGw9iB%kLRHn5x@=?M9KcK(pk(PcnT_Gf9#rCYEgwViJ#^BB!2tl30 zrlZtkPkL94O>O_SNlN=)fyQQoQ{x{g`%kP9K0`gDoZe||G>&$*(W=0*IN?%2UE2N;O z2N=7Yl9Gs$l2Q&io(Cf&Z6}MdUvQT&xZO|vMj03xi*+{DkhaL+*)uaVEc%hj9^b~- zQ12ywehgOx8XYI6BbKee2evCaIzLBq#1WMGK2DgCa0|VNVIK6M(9n1^cG1V-8xv#O2ZQQeBxIc zGBiCZDx|*tm#gl~t_1};$YJp?;-R8aqT)@P90KW;DJQ33Wh#y*MOmyYN24|#zyxY) z>Yd9ASJI8mmNm+`a(zAXZYZ-?^h`Tz&yGBuGyzU4C@iCW!r%`*P(@FI@&^Xr**GN5 z;%0vTj%aItuCn$<@CN7}jU**Y)<+EdtNHS^Y9s7k3E}JsWyz-#j@1i7v_Wbi_&Ajc zeT=AQPgnHx6msIhTVBo!$~`Oif}jiEU-4dnG%?ZXXzOcQ>S7=i5-8hW`F5vj;t(M7 zspRlu#UDzgCP@c05;8J$P)kof_XjDAM(Dr){+*{O8)o9+A%ZQ@EVa_d>io}XB9iG{ zcK@P&WoEXHVzuP(ONw$pEXW z13uE(?MmRRrWT$*Lv(juwyAN!>}U)X8nz9T2GDEH_cE&oEdCaU(lKs%?KfmJsD{g4 z6@wwCHIyD2q5Io{nQ3X%zx9j7>=>SYfwm0M7gmdnU*eT?faRP zmvs-|Isfzz0`7yH;H!cDy`fh|Mm^dUFM0*s(Qji2!L0ld534(;QqDNDA4H}+`imghs?z7e#k`G(C`-MiocdwO@Qa&(>as{!y5v4$;ew6 z=}vfUEk-{CTLI9ks(tKPWpiMPq?Ku%7>TYM8JVpWk(LgjJw4Sx$4Ca^ajdEeoBP^Z z$ZnWVv%>`6K7LDYheiQp6pDL#NC60BZU6-eL&*#K2P01c37$AlJk4=EGF;f1YuS1k zMS<>lHXkZz*S(BhmgW zEQHT2d%k}}QDt+qC_KSorJ-qoUmMCF{e{>kW=DGwVt3(6C(=s&=}zE+Qy|bbe-31Y zE+LteLEtVxP_I%`U39ukoY+|O1(aI!;sVBD4j+59hZ4cN2&k6(e-|Yo&me>|>5vdz z(>U3cgQ7BsgGx7ijTs=Wfk4U%_7xw%0DtD&u-iL2Yyk*2J3WH(G{=}}O~CWiCp?+* zV`$B9 z`@$BX51TFz?bg!rl66n;mfgT@^&5} zdmHfV#l*#RMv`BKEcf~sfBYCk%JB(=nFsRBCvSYM{^1P#59qpg_^hsdAfK)(Y;5xW zZDN8aO^dEt{(g{Lt$a)6&wid(ZR}#_g96VhqP3y-JJY6aZe<+Sf9Vao)w)2pWxR49 z=k!zrHSuk`u=cO8a1IPfUzd%Sf;R);L`~+0W`;d+-bo*? z112iYtCZ9?I@qMQDo+X~8EQ^WAA7I1mHYyelPigrXFbaWXlV^iY2?~l0s){$*yccS zw27kR+iGs^OO<&@3Tz74VMXP%l#2`xZ-DpKKhQt-p|=xe68!@=NsV^`r)+~ z)Dz`gZ9RE>ma`sLUj}As&jxFpP4ANJrHf*#iv+K=0d9rKowdXF-{?4a_@`n+6R)mwv^IPU3c`Y}p>eZaOe%pZ#_p*Qy$wG< z=l^T%t)sG9zjoorL}3dG0uq8sDJe)Jq0$W!QlfNsw@9cUDBa!NU4nqLbc0BDcb&P| z@9+KoIO7}Ryx;krG4>c+eORn@ult^H&1+s$ro_k|)C9zUookz`RAonJyT+fGu7u+j z{wx}UDPbcLd9d5k($aM$rs|#1++s7k%L^!?wh_WfLnFVaDq0Gy>Z@OM^ zT2u4feglQ(=;*Y+n&{<+X$;bTP}Old+7antEEE873yI}H%f%D>vkF_RXouZ5fI|VZ z=DSsqD&qOk(b1vMSyVUA%E(H&vNfy9V%n}jo7d_SJO`~sem@--EZ)n~ zx7CkTN@%%CjbAA%SE-$;x3sjdvvYJyOZopwdkhVxFILoDr{0;W)0WtyyORe!mIW^I9Owm&ydp`DLSN8=ZS3z9N*X+Zc2YG1TR#2?DM39`vWILs0U!JC|!Tj zX-E*jmDjh|Uk2e+2+!n=gm64G#39TBxE9BGn-bsM{dd;e=sSr*i77dq_t4NF45D28 zG~81pfl6U|qzuyJqzCjUOo z$Rx!kCYd6R=fe;EI1i~g3Bmq}>L&Wjm>}hMG%OM`y>l1QU~2gXmUt9G{-mi9A$Twt z6FBTXzcKKK3N3Z>_3ts<2#_nckbllyJ)EzJ14>?JYb;l;|C1_1=4`V%(*Et?o_G}d zlDA6V)rV9_mf^9E=&JyUtj_h^<*$Zj_;Y=1IB>{%3LYH+bTO~58kMAp_;=Wc2wDIu zQ)twJZ6e73`{%D4W{PP@)zO=ZOYb{Tgd7l=Gl$hoF+pnkTjb1`4H-_c?6-aRVxH zI(EjRkfSG<$2_0B@+Od{t~`GTT6j4%>LR0vDpT3T5RvyNRrk z>FI{3a?9arXRfb=tnK@UU%tRb$D>nnuL!{dr@uI!iEo~tKjcs73APN<+L!r#xs%dH zM%Nj&giZfW$GU7g0W%*a{@{VEt=2$RBce2O1+A)(*~V%|qP~G4Fks6Q{HEpk*?5&7 z!(DUa;a`>@BK{C_ZVaxDMq&NKFQgKAlb$|JA^S^lHXX=k9=idd#9QTYmx=3F=cE8x{#LrlnG#~;0$?Nbl z24u#dc?bqgq@`y*vl(LtXqo&z47zrL3X2%Nr6m;9n_;*^9w|3rY_%h#qAAhgO5gQt zj3I!uO-RUF>-7dq){2>JUQ*mQNmD!A-Tg9BH3f-iBv*J~NeCe=L==!R$0Q!VJ}(S- zO!GCf%iCiErsu#OnboVwa@g2-r~r(cp-#-^e9dj^oP_MU%~a zO9tki(Rk!Jz3QhFbImKTXPm6nU~d4%zjZQy=L;qT_g5bd0-Tapl=lu8FwY%N!hju! zeTU$4e)^MQ5ZdyKB-&q_47C!6Y~}+TSR81q!oBn3u#PXoP|vA<>QXtH9-=F%dKy-82v_pSD^Runp-#nq!B8p z--ClsXLpHMP52?xsBu1;fu*rKKjWSQ%wu^mzo&t0a_)&}iOHm-01M0B+Nh8s4b9u8 zMx>2Wq#4Ft$wExExwSPtl>aeHZTYNYyV!8Bq1&7ZBsjD>qmn&5uEJ2w6w@3rVLKtC zl`9a`GLh2Ai+&$24BgmUJ>S3Q>*M&c)+J<8t(^RX=VGfo2U#8hFH90~*y>p4M?Mg| zAw1+l8{>$31o`i}6CUjvS3kI+1T6;$N`UOB0tzvhjz)Rp<%Iw>(7S*RcrYNL7Es7{ zs;(YhUPj>Hm61Xyl@}ysCR0ok6X)GWWa4XARlbLUTZb|MbF)e(Ha0fufXpZLT{KYd z36+(hT^?3M9pJa*)M6I6dAs$o!%@<45&&DSaC5JC{qq96Y-W7?!Qnw1=uk~_(ToYTD|NUk62xZ)}6HAsrs>;7hOD~O9KIZ1gDA0>#D;Ey~;Hs!8 zmmx=>J5PWDI;&TWGuQTt60wU*C5QRn+o+p2*N5{P0zn|lkA%B!ZCr(ET}nh`>cHGp zAxBl%YNsQ24u)L-gzIDHkfYHSVh#M^rOf%uSEMX9HJ-xAtol($8W?NXHb#$+W9b9^ z`{tV(X7uNK9#Iz|$JSSeVgqq=^M^}Kx4^8XSf)y@3>EtTu<;rQ7fR41Q)a(Cc;%+M zbkbv}BkBF&>qNV5aUA=)agITmAFvSsC@}y762rhqFrCnX$!L3ff%jN4&e^`E%+AcfoHMd! zzxzoB^45gRdcKL%e@tDv{0LcMz#RAH#!^5i@~17d3&m_Q#=K4V>=_MeX~3ATBZ5=4 zhWKTwWRrLVb40ev;Ph;<-)!4F=)MZ_)yd$|N4@CJSPG&}7H;t*Ic>F8JLg!;j2xKW3H_5JC zw`%OQly^A^M(2G9#j6K*Z;T6mHH&8PNh4w_!@ctXM8&`vyeJjHF&N0{fcn~vTNuX% z1X&Mm2*mo8utKmozj=CmureV5&F1kYHfkXJt|K1Vl>O-jbw*m8?z=jO7ym^vPQPVk z(N0v_nD6J-LJ-BGKF`F;JOf6OV@VMyBhSpvLUl*4W26}6OUz0;x~+wzb0C8BbFvEy zDimAVehKf6vXmYxrqw~i`=XIf)AD>50j~*!B{$tS?gvtKH2uyau(26G+;}*ZIZw#a zqxQ2Zudq=Y2^?z=l>~&E2JJUy@Z{$SZQ*-bz+2M`!2i zdROle9u`(KQ}0>lbfSV=BLraCi^pbwHG~2DrugcWz1co}qL3f?%wGXt2??3Op86jx zpW~o2(N7Eyiiv^2!Hqrj?oi`-UgH|em?${4Ivof_nbK0*cmtbk;J5IQlKPSIh}SLl z>J4Uk&(C#umV8qKDu@k4H(%s4hg>(_)pTeYY5jzr81TH@qx+QPjU?$nj)z^8bWuE+4yLg=*z>dj>sp83H4RiFpyD);0)QV{-7XS z3h<)@>2t_I^L08{!4tr&=+QtrD#@tN0kZn6#>y=#!(wl$>{ub^aJ7~w)X8SIUSbjy zOyL)NoB9gv3fPJ>s|nfUGZ(d|PoG|jd}zufJ*{Bxtb) zQnY7>rqu;r*Z2JVJb`>rSz=snze*Sw6%CcOM_wHfcWe#|k~Eza;U5qVBXE8?N*gW% z@aAumt<13`wzF5RR{huLkQI^6x)Il@1p!4p%$I_^S`y=d};W z=+As+G$V}2kNysSrh4mEGE}0F1%8S5_(^b6Tbn=h;}n=pwdcmXmVW#L0^ZHt@y}r3 zL8jK{V?&&2jaBv=8C=p>oPUVs_%!}Dn>Mw42@6w!*D|%V6m!Ung(WqRGw$d9@+Jyg z3Zz1Qx$BbR;>wq_95c&&1F-<7$sZ~ILKXL3 zWCRoRSAvk5QwWoF0b~7fl`1t#@Fa&y zDz+yXhK50>)Ls10=l3h~Dgmr^R#W3tdh;zPs@)Gj;DbT+BE1RKi<)%GQomsysCNux zTh9M^5t|!>WDIp5$ikWRnL+-Wf_3i_bUVKrE-3%me11N49cn)9;e|mZ#$4vxbH%2F zYUjvthGO(gOQ4WCHz-X@s*d46@lAgqiyqc)XPND;_AC>}`3KL-AOZpAR1}w5?j6jV zBjz!4!kAa$7${#*e2aTeE{h7Zbo)K)Yn$VDuR&~fp5(MA+7{O1hYmI zuw?LlPYcX7G4Cx7&&O6m8P(0$$6Ew?@AF)7sD zo;$QOf~hco6Wq3l*KXSrkF7ybrM~AEbg4eIUFs`GPPKk7x=yF+ub$)_;D>=C-hycp z#L%x^#9s}jPQN5wpe5pF>OgYJpf*m40yT1{;#-cVN7~@7r`BsjQ>92X4MwiJm6bK4 zw6yNlyrS_iMTkB(JYxz9n4E#<37i$h%}oIR68Jx3`&!zh$QB#iV>N67YG6IRddPvd zFx*>ii65p9NYl1_M6+8T5wNge0))FeOWp?(FlEiu+S< zDV_`cjNpW(ij9fDwX|<7$kDKH zq{(x%mKVTm2(2DaQHAPi;wyl3>`s2MK(*klPHzu{Mln(A(75AdVnl!Af*ph`?V78ry8Fi~VT_tD z=I|J~xnH4RGKByS92` z-E=ymEs4SH5oj z34z-lQHT!$%1~~E+WO|6pqNVJUNomj(Qq;3u!!fPq(%qyV#I2}P2&9Q`B$Gn;h1x6 z=+jI%+$P}A`A4R^ySC;b5y)e`0@0>|>WBqsLVzuGUPRSxVrmL|JM5{8lZmE|MGW(2 zpHO-ztHxT)w$2Whd3J-#LX0i7fx*h|Zt^P-@PVua5GFDP28IjzTRw%@fJ}Y@b%U3Z zYkzH_fRD}28n@d`96=`23E*;6e@)hA5SJJ&a6Km>CcbWYc0%CfEX8QI5!QZe(4Wz< zHR~DxjRW48YGp2`(D9e~XXW`vNF<=U*On<)t=s~Gge3BJzwwt6oBJiEyuv;L!-eb` z8YbpbFCP>e^f&$Z;pu#Av$+_k$0j44#AIPE?j00#x27ibDWiUPXt;-l)4+-fe^{60!)g7(-l~*aWzZJ5OE%`HJ=~X=~;FQX`;|cCvS(-Pi4zuHD&83l@d|-DuI2fgL;PWKBn4l;L1*Gx$jWf18W$ z?N5qGN$G-gHd2cI`I8?)+QRf*bd zf>z5q66F@NO0_N=KYp;KOHa)^PkFdcudOxB<~?wiL_6830AmovdEX;Vp z_8p|_mce4csk|CL1U)I*@6OM_pft9Xv0uJ&Sq}=(H7+htjC?7f77cB6Fg&vjgeu7I zE8g}XHqgQ+Z;$0e$B1HNGTc^ zgLm!x&Wjs+1L4IYT)ot3LLx#PM~d!I+x2fysuB>G^&a$4D|ZKum&x=cMA!__?q%VD`i4!i*V4*;s;WMmlFIUN02t^S&=!luQOlcgHsiJ@4i z-z)0-RYf*kR$Hh2SEYQ!%gsk6bcX-o0)RFX_$e`Pbzv}3$BB(CN4>m05IQorbTPre zLGE-JmxV=KrBvrff&ipmuY1g|K_fm?*uDNC3>sdkfX3W*wLBE?VvhEf75{YPBqt^1 z5j}O|`u-iE4AGBQbVF|)w5q&$M{tH{vu*6|%>m>N8>Oqz9Lz5gc&dz^B2`Fee;x+xrYe^`UuZFSuch}3a*S@6`9)25(KJ2|#V5`$Am3^baBFWR8 zmxLg0(MbPuNC|7<_}C}sorS@VGvArCTmOJ4A#~O~1ebzv2;R5L2lpX6C1$7#a*)M*A=Z95hgOP8#O96>|6`B{4JU)hvQn54Y#vyiw{NZvO|k zYZfdD@1Y`k*ZI{eZ)NOWykd_4^XMVD2Ea zdhzbh+n1t@dF_+CnV%xeX=XjasM8R#?{LGl^2BybR)J)KS@YQ0h?2O zpo9=X!vm>?fqxZQY7{T|@j6@}k8kcw9eSIZfYIfkq%z-P^ITh78@?(A1skOrDk!j9 zXt!Num{@T&#hy@j;7cdfK^DVUDNQeFTTi>nO3_W`vlgKdK zzg>ekxD5KUfphEL6%}s)!7rQ>I08+6L_!C<%hv)Dq4#^t&lhxgykK-jcf6&p$z=KV zGST)>MSrG@tgObLKR-_P#{vLG0n(Y-!LRQ|Uv(i7gCc$oOxKREUPgjMLQYQTl%H~4 zxP5DP=V@WyyPpf)z?}kuiZ4Wq&{QSY+s6-pH9~KJUUrZY6A>1!Gx<|T+fi+EdSr@z z0A=cbh@Xdnvjh_w3ZuTXmgk>jNnX1u4cicg^B^2pAbQxr5NrT)pS(`-MVM34pCH}_ zi8Fd07xB6leZ9Hq@d~Bh40$xb!hDL0@2iw#Q9M6k0x8uL?KUrvSB(gy!YVYMM!%VY zkB))F5ibs~kY63as=bvY67}36sFdOD?R&S~PJkqqbo;K!_b?m{WWdiWnGQsYW}X-tY={4 zyPYJmvbQ$}oKd+G2A)iaHkJfEzhxbmNfckcevbfpJCnca7#O;JvTACBV~6P8jtZvXcVMtWyo?S%P!S@_=x6ubktvI zst&Z#gxcu)h6CBtkaj=?_A&x-Lt=z@wQ6M+xZSP+gO6DmBYwv=F8K;zq2NbtynCFB% zOlm%~UGBhqB>A2@z$ChCFqi|bR^?5B7G|pC{fEpu&mo|?o&=`gZ+kcna9a06$zX5t z3kjjjmKA1fORr$m;$Q69UtXYM+*2Y!1hsvO%`uLN=dOOS{#d|uBHq|f)gCQD*0i0L z7O7kUA-Ch?HpPvXQ!uw}72;o4XupFJAyT{u?CQv&Yw!3Bq##BzAtq>}1^;bp?$N++ z8!<&iwUdFA6cjGjtF=@gTn@JYuv)m>MSYhZah>kpFrdW%L1>W#A8_ZYFaEmC1KH5Z z)d)=jaL~j-nn8awpX}Lu`_#c_Wbxnjwty-I%og+gwefZ=PR}3EGtmvQ8gCN?)s20Qb78_k6^!2ohQbi$y*eMj z9iJK8-2^6#$*uu3ETFR&Ke*A@7|IZ9f3QK4pT7^;a9huEVpY|1nAQBm&FbZQq&EOS zku(6Ztcr`YlD*Ns59V&4wBSHi-~C20)U7u)f2sT9Rz?QW4iHq$&1JLt_eXp-2%TaHYPlqlXD5O1#(_u> zKD#6eeYfB&!onlBnd#|;cvZmN_VxBtz+}Jm95ZndkspIy>!~WYbh@HMAgHXZ3>JqC zb>Dckop*m}_?ZyLB`DA`8E?&)lI)LF5nQuBG$oOOz%uRpT^mpQ z{QXWos7twSxIy!QIyYb%^)Q2&Iy3W`-GVftSDjeRy$OY5VAI3&>Id;N5PPC+Zb~hV zl@pwu)eMjDgaD{wcQETDPWf+m=Kjt9>|h$JLJ2gUyB~oRsr~s9?u%3@&CyZ@b8~Zc zi7+>aybvxOG$1s8!Szt9p*xIRN%5Yvd%-rz~B!Z)^o8crACJh=1Iw}CwM?_D2RG) zvl7|-T2}VJvJH>t{DG^e0X2-M_?c(FO}h7t`bKxD$@_O2Tk@n&a*an}+Q2oalj!tE zu*hX7e3jYTtCA9~15On}MwnWYJlvY42vNE1@fWde#v=;|tKrELUYF|g7ziio>*;4+ zGsUM}6jMAd%K;(}jW}LyKR*-iY)@;e5|@&Z0pm^-BJrVx#m_R^b3rh*4>}TobsPxY znzP3(VlWDRsJ0`AA%;t+?<-M}{y5>F{dQVb{0GS5)mbVh3an|M?-&d`NMi|eJ$qJF zV%)Z+3ONKj2d4!UQvi%(GXrgp+%HXFmB7%2@|2Ve8{{F?0i@av^6B5<$SEl7d2b&d z9iCdzLYVt>d1y1z7->AxJJGES2Pg>FHBU{n+-h;1hn|kEBN+q#+j*x!e1nibR1}*@ z=b%-Rf{r^n<>&~4m6ILaUkp=&xte`dhitjSK+@hJV*e&8pUKoY91f*0XeZoW+0+c7 zRTYK=kvsshx4%MSnRqY>@gX-ioeJ8GljVu(do@liM|g%%KRe^P`T`nu>Y$S|5!@aS z)Gpb9ED3aN{H<^FiQ;l4@yDe(0MQ`GiBkaRgzhP%LlMAC?BfT(5X-EvUP77;@nBl~ zRHD!!ymoLLY0AmySJ3`>2P5FZX{-@iHJqYf8&hMSKfkYuB!XuLqS$(9wI}$@GN;*N z=Z8>nst4tVu;Ak54Fod)#LJuBPG`{nR0tjcg`FFTnd2_rp z_r9|7q-%5=1};rT0n7pDjNyin+6_>kwk}b)i&Xvz?4d;Y(W&k6U6TvnA^i&^MK57k zS^|yoL#-mFDhAg4OW_+2@fnzaR~WZc0n6yiRm1{n74z;$LwL4(Ol5{l^Hp=7HG3E%p5F#b$TSM_{&A} zFv#sS6o-BdKI*Oo7(`h37abl$Oh<|Y4a}hJ?D<@|wS_)bW)1{v7tQ}#PgoI{0f)dp zzd$btmY{l8 zn0rPGYzANb-l5gi)Bb5to73LkTjh;1TrM&G)z-4P82fq-ii5~e85_zMkL8q4$Tf!+ z*17`6ef1n#VJWF*%|`SnV({{TBDX#28LZb-4`K&Pv%b;GJR~&AFCdKJ#ggRaw-4{&9pGdcxxeTv6L6=52SbYV8t# z+h4BewC*flpLC90->i6fym9R8D&RSiuNk>kx&9ta9%dES#-rly7~o(h$dCywmFvcI z10uS+9RG?lIv_#5E!42b<0dsNZJ#%(Yu3X-bp}#bSL>w#iRmW)LBrhIoPNWBApJD- zxHX6pcg9wN1Qn8}=NQzfT5f!z&B?K_%yeqA&+JH%(QJA= zwK1jKKVB?`Z#-EbkXy6$Wo&FrEB{SUY;11sd`IS%vQJ||mnhw(?d@$Ew!rSu(Ms{! z=*daPTv|M_@EBn{9|09MlPs<PY*tc7I-lw=Om9I)yOG9N?g&>PnkM)7+Y+J~ut! za1*lVh!=;(AT5EQI#|;#e~C}&`*-dlhh0|g{jp4gfp#@KpYHvR#zuL#tWM$P_MjG1 zi$Sr$Xh}yWExx3n@Ku!Jrw}?7gQ4H?4qKbeyZuodBbA1s1wFmR_6^s$S*#Ug>yNA^;=@r!+EM`lMF-7S1VCxH$T)Tm1!%KE(!&=mH*!HL6{AYGSw)OTXS% zNnA}fW{o^M8Zivbr$(iP`S|#xh=*riZtWzjQwNv`R?Mf9u+rd?t2U45)tLH z77ggDRAew7sZxq$RXkH!HVtJ6ZPe%nm8iZ{TT>8mmjRkkR>xo_TcyqVK&yNveL4AW z*ghQ{5>S^jSe#FdtK%!i#2kP*OTm$mnR6YHTzML(-A0{4kyvNS#-@Q2(uZo!U-azpU)Bc-OLl;UBu`1tq~SOba!~qw}py9Vq~{NIzBVU zAonv46<4LN@yJUis18S;pRR_7?-ZUrTTAYvdm{ z(scbvzN}1C*VAQuNcjbOy>mVmQD?E6nIBc34|PzpFxd>CINBX-*xELUA3yeA5O3lr z-r3C=&z;7oe<_YsUSb{vy8IU ze#5KxyKAzcE{0or>TNL(yh7u!SC^HCy5{F~GCf06PpZeMt5SA~=b0o8-%aYVJexJ# z$DC*Q@T;?>cj~8>J*%zai}&A0N{llZOUDxSR!1{m+m+SV*WbN+?^nrQU2v;TASP)D z(=$UCW4khiIc*U%+kRKIV#arF?VFoNI>%TRi$ibe@d^tl!Xw#wOC4>0QOx@m(ijDO z!NGh&nRe^p9aP*V90Yjliu`tEuvajTH+_h-7*uLhg>Z1R^WXGUtCTW5^V3L3oQ2O% z(@X5$!$t~|JkA;1JRBTK&K2tN`qN8IzjO-qo7e1i{nk{c4)=LtbA{F_Hwv|zsLlu0 z*Q#V{CcYl)HmPCpGEBx{9vv^|a#h|%VQMf%CM&b%l!#=U>Fi)y{q^|r@#EJ)C8dDS z&?4*1FPTGis9?LPYx*6Wx{5M}9{eab(c+so^VwSHzsJPnl*PIZ_-#*hqmjC#UD@0W z@SP=34$Tx05Tt(m_?Ob`6|>ucEpqyNr4s$gT(&g!S@E;Z(; z=f1jmv$d-$w6e0Yp38>z*>)N^zrk=pa$wCJxP+ND8Tn-tdsJ+!dU?1|K)zTX@Ys*r z6JbS0N}MZe4z|Q7NVzCQw)XdP%?_3An*CPFuEWpuT|(adkEf9x29r6_Q0h)467+p+ zNzcVK`liChWlrYg$H$|6_iJAOb5>GPvM@LAmVf^qmtGw-J^v<|B2Ujuf;_$8kKW$i z8q1MJzgYJ7vCi;>&Xq>tF5C`sjg5_4J3B?*f)vmEMctF|C@SsXr%)2a$Zzh(xQVGC zY?kMRNgz9C_u|Ei^10#3T(!)7-A)+Tok}6{RPRxE^G9+X-wEG;Pro`tnu6^@Tb z=RQ}(ri5P&x1o6Xh&f;Wk{dTHkv@HD0rm(o2tVID-6^fm@NGK>N zsVP|G6*A>114ZCY_fRc780m6pckkU>_+yF&*Xlza35C0{zaLs#TkEj9qBM0_U;h#o zJ|#)^1#-o`)yZ7>OhuX}97^Hg;Q{2fwziIDR_1PU7VWT`zN=%wRUUhPyMc03&U-_< z7d=D`%@Hz`e4^r_kdXuoG&WH)GRi=YrXqBdlamEeFMgD(V3U2Lmj(hqckkVP02f4a z=7Os*3&2}JsZ#Rr@O;_Yl#$cY@|@3B$b`2eqr;&Bw*r*G3{qATIrv}5epaWetE+ME z-HwZkdvNXg)yGet=B+H(@f{cD=H@~~kyt|w*UUj7*JS?;Cx4XHxDVtTM4PpAb(i@? zzevVBPwxw)vfesLoY_6Qf)*4JkpT{f({j$&h&7U2Gv&2gZS9>$*RF?Pg?6HeQq1c? zqqe7~XTclVPWr@7m(RQjgF^0h1DnbuTN zBd?O7vUprvQ&Xeuo+Q?xu(i2a9;IF`W4{=zSTyBL$~=2^Y&{yr__d_8k4>y*uvwk1 z|I-h}OkFK1&cbtA!}8=>@krvr&~TdxvnBz&&ebr$Qzpor=&|wJowXYBRfR#21IrM{CZwRQ#5pf z=A!Zk={w8gj(bB5DKJN2B-hf?^7T7DH|1gj3Uzh$!=r;=&CShr&S%aohNPzJOwGm%d{G-@}g#_g23>`!r!>Xgu2DQ)3@~P65Z1-LLf|`eS2r+(VW+Eg&*7a>T zM{`6^o~t@c-y(Bz*p|>gcUkmz4HERLGVA)Qk$4W1E1OP99fS#4#S4a$IwHS1PB<0H zNk8a_deZn)xHm;4TUmt5=H8U_+nAjpO<8^q^YhoKzJ%LbNn}DvAFi}@MZJu^jeQB_ z*46}ZtS+smr`Ny|2~?|Sh?s)Wzlpw$<+7CoAcfO&<;m9P#Fr*8H?_jX!U7V`AFgUC&7Qpl?NeS&OASO35QvrWfZ@q z(lb?~bfquqkY?BaJTj%SSv5CPNV40HdsF!|x0FJ}|4iE}#`T0pz-BFO-St3bnRWdE zgqs=U6e8yHy3Ul8gl)y5Xl%H{wUY}{%!VOWgK9mu*kGb5L9*%y| z=b;QY5)q(oMTCZiR#jCQJoiaw0**hfm(cL=@T{LabB@(L>yv{`YTn$kvNr)ipmqjM zH;7!I$TZV(xO{7?>gSf*^;X!vy(zxEJBqx0@#=xN6FJ%Bi>YeIyCborK`mN6ulC0> zO3yhIOZ|zno=gjg1sv@!EPNe7ehw7cfF$_ij z_;qKit*QEG=ewZq)B2QV(ojxorly@`UFOEOd3AOWB<$2<^thfwglIV@tW(&R6>jy% z&1&2_poQG|w0LK4wC7;6hs<9%QHZE3pj%OYcS&rp!l8I(>b(a)wtoZBRd)ntTRDzu5DM!f4u#PRb@$n1ETLvpVPa{4!C(cf^OHAerr~No}T;O||0Oy>V zg-$J?kE+7wh~HMmB&VDBc<=ki-7%urg~6n|r`AWL%nk>|m}eoV-#5U@F_NXiC{Nj! zFK4H-74)YC_3KcY^Up-kZ!(6svKZ=Au|>A=h{;NSlRLtvn3xDiO)WBw-E?WVK3zT& z6R>l3EX&6?>=^vk>;64G=AoLPe9f=JBI)T(+Y8;HB>sdK8zwDztZJ)J1&{<)RaLEG zW$W?c!KECo^}ev~M38YI7a1YIr<$GRtmt#-uWxJMQCUc)qFRomFx)-3GEHwU@r=#q z5tpsBjbseAA4wqjtp%L)8b&o5;`7bPGeu(SgbeeKzFvoa%+W1etq&9Do5{? zx2R0$!La>bk8az?)S?xqdljw|hr@-OPD5{E_WpdduGQ7gt=91nk>aJJQ=#mLHl+1` zRn4f#jYOchExff9Rgjy*i-TN+S>wRWd8=DUl*>hRc_6EsG(|igjbAZ9Xq}WMvLmIG z=S)z4QP)a-bRd*iUDZhb95PG z>Tda1Bug({ZEVipzh91dFQKU4vl7L(CJ4wnIUR0)_|O#A5!n_?6MjpMC|iX{tc!lc z>E&pN$o%}oOWF##DtM=4=+Y^#tXvL>G#ya1oO{g8 zB2N=S-_MOh1)+Y|@NB>G(XhCPtd7F$`35GsUb;x>WE>mskuuw@%9MIW`@?H{gIs&W z(&py*BvH(Q?~UF2SQ4UR9H(PP@Ja`H_JVEa(=;ntsUOq!(X4lbkPBEZrum=k1)-y3 z1V<`*pXa08Xp|HbX6M1C=Q*t(vl5Dl1vF~xJaAa&)<3kEe)B%Q`}xS^q@8;A z^;-(do)bdJ{=sFNf|?v7udvi^c-pLdD=}pY$(Oh4s;|ee7HOKFpB2&VR1J&YIoWQq z_|78%|8J&4jnb?G2A}DDw)9OvHgv5lIHE73{UGnS)vfXOs&Ui(3K$2-lj=WYV zW-$HDNLKBrIl5zilS*?l&w1W6gU=D=O0Xe!d$9T4ryGOI_6S3S~J@ck0i=$_~amw@wG6M zdtec>X8K@mEg`pii4h~AbY(fg`t)C40-nuHL9!*=3C0j3Fwn)uhRk6udrF%41uI7S z9fZ>pL~Mi-=~6MwHh5yfPu)Q;(N{@`gF}!G8l!Qj2)SaMw?21gaXuFQ;>%2^Hfq%K z1-FU2)P$vJZbq2*_RCXMjOS^8a0Q5_tO(; zY)F`eDz>totm&kWe~YVwvNGvoLicKf%QE3GT@jurLN7>TG@`iDB-GU*&yExhv`tyWR4onYtD`01I_4;DjG zYr2_ey|*`6vpETi=jnv54k1>iymDzLd&sv35E)?L6Mm3->Ao{MN!ZpvPIlX1bg%v( z=&mMS_i`@Lx|q&g0RaMQ3Uc8FZ=%AOfgBe1OaUKX$FoiU-TnC+A{P(N-t~7WEg`E2|&+);#+xikKua)`ul=lpaq1=4_xhH*^|H@0wX{;1y|w=wnP`z2~Ad!}VtxY864e1J#wAk7c&n!drQ;tdZ0kJR3K0 zHm`cS)kOn%&J5D=va=f2*iopu_%M-+>qauU6s^@72DQ(9aUHz3u%1f5z?}mBQHofk zYY~I9vAgjZUa~Y<@HPH`?!jM!qirAh;f9Xtb8X=7;lqdAAo77c_2Tmh(!-0-BgBNj z$L-=0@IMd!2VW6}5e@J_D2WcKN=&^YbzRQNfBL#}oNp4|?fWsTjWR3h;tkc%j8?lw z2yiDwIeX<7O{hKKwM|9@WGo&WkO-+#XHZDwiZ-&a?r$`i}2 zl263SUinX)0uoOM3I2QR!7}&!`7ubdYL(I>dA_nD>!xgOIG3EGmPov3|L=w18(A0Y z^E>VL|1ayqC-MKR58uZ;<55Z$Q@}nFE+Lfli``8~-LH2G_eocW;JpKEb^7Pugxo~?P5XDGL)OcG`+g#sFzp(r;1REM2ut(ygE7jwhs6i z!o0th^GS=nhAvZUmNv6APfXn1%Te1^m%~-v$6v;37-z9O<52P;K0maUDKd$6`1uog zVG-oW^1EGc@9&ZlDAre{OHYe2OwYM2;!~_(-{vx%gl^E4Z4H(HzSR5g4&Pn-M5xYp z6~*`Z;DZ*aGn9|2}2^2M6*0;4A+*tG|CGB?;%}Yx`fjF52KF!h25Zd=Ss9 z=`}N_u(?}lBO(?m3Nh>zw6}W}mr#7WPcIH63(mdA)=T8vyFpg_<2`HRvi>AZ<&eeY z)&xk#<{XURP$eg7 zpu(ow%<0Evi0IN^p*?w2Z@&v?L-b;A#ks7EJ#pUna0h$bcG7d&wB|{+I)n3G_{=(k zMD$V>Av{lV*fIvZg`@7mRI4s-ZGQ?%LWvAO+Ad!v5Bwa%4?vvszjw|{Pp>`6piYmA zA3DA?(c7EP0>8%KBG|2)wOsh7RZRE-$+3R_d+UyCYqENJv-2vYtd|pR5fLlmz^TN& zIF)khPF0XcZ;luQd)=a`bjpgWv+L|)i!m+xF|>6SX-e@7d$(lPyon@bI1t`KD#lS{6bjApru-7-t1h$q-KKfUPZG#%H>s z&c~vRjDF`Nu$;vI{@zKCo3fb-JyQ)mRra!4GoF?(9$T~N9+rrxL@;Qa$GD8Jml#L( z#eeKe^k%j%uv#r{GSP(}fAOz{+AS{=CKFO{$`Qk#micZn?kn_pIVbac1a@Zh|CO2k z|KjEU_gLY-oS|DQZZtPd^@e+4n;z4bu4qde0K?glLJ*4YNa{et<<&VPAh)W2>Lh5Db|YfJy|wLh()-^_#= zs!j?D+mJ*3hur?qzLWkEAIoj*se+27j6HO8gG?5~L8M>=AIY9fMP8_ywnC(mcKP8Q z`b;PR8vgy+a&bfO1-TE%u0%fni4^|(-u~bH@_(BH^74V*>)Uf3-63>DONn^MW%zJH zVq@pQdr@XfKJ11$UBLkXX`p&?lz|}ssNej%>yzqdXJ>E&dIjRFksWg@h#7{@AJzY> o<+<3DaGC%8RsK&FdGY+xmpU#ojdyH+k$VymkmS#K`Of`+0m~DdE&u=k literal 0 HcmV?d00001 diff --git a/source/Network/Xmpp.hs b/source/Network/Xmpp.hs index 3744248..d0e2e9c 100644 --- a/source/Network/Xmpp.hs +++ b/source/Network/Xmpp.hs @@ -152,19 +152,12 @@ module Network.Xmpp ) where -import Data.XML.Types (Element) - import Network -import Network.Xmpp.Bind import Network.Xmpp.Concurrent -import Network.Xmpp.Concurrent.Types -import Network.Xmpp.Connection_ -import Network.Xmpp.Marshal import Network.Xmpp.Message import Network.Xmpp.Presence import Network.Xmpp.Sasl import Network.Xmpp.Sasl.Types import Network.Xmpp.Session -import Network.Xmpp.Stream import Network.Xmpp.Tls import Network.Xmpp.Types diff --git a/source/Network/Xmpp/Connection.hs b/source/Network/Xmpp/Connection.hs index d0ed75e..263b452 100644 --- a/source/Network/Xmpp/Connection.hs +++ b/source/Network/Xmpp/Connection.hs @@ -35,9 +35,7 @@ module Network.Xmpp.Connection where import Network.Xmpp.Connection_ -import Network.Xmpp.Sasl import Network.Xmpp.Session -import Network.Xmpp.Stream import Network.Xmpp.Tls import Network.Xmpp.Types -import Network.Xmpp.Concurrent \ No newline at end of file +import Network.Xmpp.Concurrent diff --git a/source/Network/Xmpp/Tls.hs b/source/Network/Xmpp/Tls.hs index 957cdc4..0d5754e 100644 --- a/source/Network/Xmpp/Tls.hs +++ b/source/Network/Xmpp/Tls.hs @@ -18,7 +18,6 @@ import Data.Typeable import Data.XML.Types import Network.Xmpp.Connection_ -import Network.Xmpp.Pickle(ppElement) import Network.Xmpp.Stream import Network.Xmpp.Types