diff options
Diffstat (limited to 'src/Main.hs')
| -rw-r--r-- | src/Main.hs | 35 |
1 files changed, 5 insertions, 30 deletions
diff --git a/src/Main.hs b/src/Main.hs index d473f2e..9e87af5 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -17,7 +17,6 @@ import Data.Char import Data.List import Data.Maybe import qualified Data.Text as T -import Data.Time.Format import Data.Time.LocalTime import System.Console.Haskeline @@ -25,8 +24,10 @@ import System.Environment import Identity import Message +import Message.Service import Network import PubKey +import Service import State import Storage @@ -67,8 +68,10 @@ interactiveLoop st bhost = runInputT defaultSettings $ do False -> error "Requires terminal" extPrint <- getExternalPrint let extPrintLn str = extPrint $ str ++ "\n"; - (chanPeer, chanSvc) <- liftIO $ + chanPeer <- liftIO $ startServer extPrintLn bhost self + [ (T.pack "dmsg", SomeService (emptyServiceState :: DirectMessageService)) + ] peers <- liftIO $ newMVar [] @@ -83,25 +86,6 @@ interactiveLoop st bhost = runInputT defaultSettings $ do let shown = showPeer peer when (Just shown /= (showPeer <$> op)) $ extPrint shown - tzone <- liftIO $ getCurrentTimeZone - void $ liftIO $ forkIO $ forever $ readChan chanSvc >>= \case - (peer, svc, ref) - | svc == T.pack "dmsg" -> do - let smsg = wrappedLoad ref - msg = fromStored smsg - extPrintLn $ formatMessage tzone msg - if | PeerIdentityFull powner <- peerOwner peer - , idData powner == msgFrom msg - -> updateLocalState_ st $ \erb -> do - slist <- case find ((== idData powner) . msgPeer . fromStored) (storedFromSList $ lsMessages $ fromStored erb) of - Just thread -> do thread' <- wrappedStore st (fromStored thread) { msgHead = smsg : msgHead (fromStored thread) } - slistReplaceS thread thread' $ lsMessages $ fromStored erb - Nothing -> slistAdd (emptyDirectThread powner) { msgHead = [smsg] } $ lsMessages $ fromStored erb - wrappedStore st (fromStored erb) { lsMessages = slist } - - | otherwise -> extPrint $ "Owner mismatch" - | otherwise -> extPrint $ "Unknown service: " ++ T.unpack svc - let getInputLines prompt = do Just input <- lift $ getInputLine prompt case reverse input of @@ -229,12 +213,3 @@ cmdUpdateIdentity :: Command cmdUpdateIdentity = void $ do st <- asks $ storedStorage . idData . ciSelf liftIO $ updateIdentity st - - -formatMessage :: TimeZone -> DirectMessage -> String -formatMessage tzone msg = concat - [ formatTime defaultTimeLocale "[%H:%M] " $ utcToLocalTime tzone $ zonedTimeToUTC $ msgTime msg - , maybe "<unnamed>" T.unpack $ iddName $ fromStored $ signedData $ fromStored $ msgFrom msg - , ": " - , T.unpack $ msgText msg - ] |