diff options
Diffstat (limited to 'src/Main.hs')
| -rw-r--r-- | src/Main.hs | 31 |
1 files changed, 16 insertions, 15 deletions
diff --git a/src/Main.hs b/src/Main.hs index 4a6d3cd..1785581 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -28,7 +28,7 @@ import Storage data Erebos = Erebos - { erbIdentity :: Stored Identity + { erbIdentity :: Stored (Signed IdentityData) , erbMessages :: StoredList DirectMessageThread } @@ -53,9 +53,10 @@ loadErebosHead st = loadHeadDef st "erebos" $ do (devSecret, devPublic) <- generateKeys st (_devSecretMsg, devPublicMsg) <- generateKeys st - owner <- wrappedStore st =<< sign secret =<< wrappedStore st (emptyIdentity public publicMsg) { idName = Just name } - identity <- wrappedStore st =<< signAdd devSecret =<< sign secret =<< - wrappedStore st (emptyIdentity devPublic devPublicMsg) { idOwner = Just owner } + owner <- wrappedStore st =<< sign secret =<< wrappedStore st (emptyIdentityData public) + { iddName = Just name, iddKeyMessage = Just publicMsg } + identity <- wrappedStore st =<< signAdd devSecret =<< sign secret =<< wrappedStore st (emptyIdentityData devPublic) + { iddOwner = Just owner, iddKeyMessage = Just devPublicMsg } msgs <- emptySList st return $ Erebos @@ -101,7 +102,7 @@ interactiveLoop :: Storage -> String -> IO () interactiveLoop st bhost = runInputT defaultSettings $ do erebosHead <- liftIO $ loadErebosHead st let serebos = wrappedLoad (headRef erebosHead) :: Stored Erebos - self = erbIdentity $ fromStored serebos + Just self = verifyIdentity $ erbIdentity $ fromStored serebos outputStrLn $ T.unpack $ displayIdentity self haveTerminalUI >>= \case True -> return () @@ -109,7 +110,7 @@ interactiveLoop st bhost = runInputT defaultSettings $ do extPrint <- getExternalPrint let extPrintLn str = extPrint $ str ++ "\n"; (chanPeer, chanSvc) <- liftIO $ - startServer extPrintLn bhost $ erbIdentity $ fromStored serebos + startServer extPrintLn bhost self peers <- liftIO $ newMVar [] @@ -131,9 +132,9 @@ interactiveLoop st bhost = runInputT defaultSettings $ do msg = fromStored smsg extPrintLn $ formatMessage tzone msg if | Just powner <- finalOwner <$> peerIdentity peer - , powner == msgFrom msg + , idData powner == msgFrom msg -> updateErebosHead_ st $ \erb -> do - slist <- case find ((== powner) . msgPeer . fromStored) (storedFromSList $ erbMessages $ fromStored erb) of + slist <- case find ((== idData powner) . msgPeer . fromStored) (storedFromSList $ erbMessages $ fromStored erb) of Just thread -> do thread' <- wrappedStore st (fromStored thread) { msgHead = smsg : msgHead (fromStored thread) } slistReplaceS thread thread' $ erbMessages $ fromStored erb Nothing -> slistAdd (emptyDirectThread powner) { msgHead = [smsg] } $ erbMessages $ fromStored erb @@ -151,7 +152,7 @@ interactiveLoop st bhost = runInputT defaultSettings $ do let process cstate = do let pname = case csPeer cstate of Nothing -> "" - Just peer -> maybe "<unnamed>" T.unpack $ idName . fromStored . signedData . fromStored . finalOwner <=< peerIdentity $ peer + Just peer -> maybe "<unnamed>" T.unpack $ idName . finalOwner <=< peerIdentity $ peer input <- getInputLines $ pname ++ "> " let (cmd, line) = case input of '/':rest -> let (scmd, args) = dropWhile isSpace <$> span isAlphaNum rest @@ -171,7 +172,7 @@ interactiveLoop st bhost = runInputT defaultSettings $ do data CommandInput = CommandInput - { ciSelf :: Stored Identity + { ciSelf :: UnifiedIdentity , ciLine :: String , ciPeers :: CommandM [Peer] } @@ -207,13 +208,13 @@ cmdSetPeer n | n < 1 = liftIO $ putStrLn "Invalid peer index" cmdSend :: Command cmdSend = void $ runMaybeT $ do self <- asks ciSelf - let st = storedStorage self + let st = storedStorage $ idData self Just peer <- gets csPeer Just powner <- return $ finalOwner <$> peerIdentity peer _:_ <- return $ peerChannels peer text <- asks ciLine smsg <- liftIO $ updateErebosHead st $ \erb -> do - (slist, smsg) <- case find ((== powner) . msgPeer . fromStored) (storedFromSList $ erbMessages $ fromStored erb) of + (slist, smsg) <- case find ((== idData powner) . msgPeer . fromStored) (storedFromSList $ erbMessages $ fromStored erb) of Just thread -> do (smsg, thread') <- createDirectMessage self (fromStored thread) (T.pack text) (,smsg) <$> slistReplaceS thread thread' (erbMessages $ fromStored erb) @@ -230,13 +231,13 @@ cmdSend = void $ runMaybeT $ do cmdHistory :: Command cmdHistory = void $ runMaybeT $ do self <- asks ciSelf - let st = storedStorage self + let st = storedStorage $ idData self Just peer <- gets csPeer Just powner <- return $ finalOwner <$> peerIdentity peer Just erebosHead <- liftIO $ loadHead st "erebos" let erebos = wrappedLoad (headRef erebosHead) - Just thread <- return $ find ((==powner) . msgPeer) $ fromSList $ erbMessages $ fromStored erebos + Just thread <- return $ find ((== idData powner) . msgPeer) $ fromSList $ erbMessages $ fromStored erebos tzone <- liftIO $ getCurrentTimeZone liftIO $ mapM_ (putStrLn . formatMessage tzone) $ reverse $ take 50 $ threadToList thread @@ -244,7 +245,7 @@ cmdHistory = void $ runMaybeT $ do formatMessage :: TimeZone -> DirectMessage -> String formatMessage tzone msg = concat [ formatTime defaultTimeLocale "[%H:%M] " $ utcToLocalTime tzone $ zonedTimeToUTC $ msgTime msg - , maybe "<unnamed>" T.unpack $ idName $ fromStored $ signedData $ fromStored $ msgFrom msg + , maybe "<unnamed>" T.unpack $ iddName $ fromStored $ signedData $ fromStored $ msgFrom msg , ": " , T.unpack $ msgText msg ] |