Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 4 additions & 4 deletions libs/api-bot/src/Network/Wire/Bot/Assert.hs
Original file line number Diff line number Diff line change
Expand Up @@ -63,8 +63,8 @@ awaitOtrMessage ::
m (Maybe (ConvEvent OtrMessage))
awaitOtrMessage c (from, fc) (to, tc) =
awaitEvent to TConvOtrMessageAdd assertion >>= \case
Just (EOtrMessage m) -> return (Just m)
_ -> return Nothing
Just (EOtrMessage m) -> pure (Just m)
_ -> pure Nothing
where
assertion (EOtrMessage evt) =
let e = convEvtData evt
Expand All @@ -83,7 +83,7 @@ assertMembersJoined ::
-- | Users who have (presumably) joined
Maybe (ConvEvent SimpleMembers) ->
m ()
assertMembersJoined _ Nothing = return ()
assertMembersJoined _ Nothing = pure ()
assertMembersJoined bs (Just e) = forM_ bs $ \b ->
assertEvent b TConvMemberJoin memAdd
where
Expand All @@ -99,7 +99,7 @@ assertMembersLeft ::
-- | Users who have (presumably) left
Maybe (ConvEvent UserIdList) ->
m ()
assertMembersLeft _ Nothing = return ()
assertMembersLeft _ Nothing = pure ()
assertMembersLeft bs (Just e) = forM_ bs $ \b ->
assertEvent b TConvMemberLeave memRem
where
Expand Down
6 changes: 3 additions & 3 deletions libs/api-bot/src/Network/Wire/Bot/Cache.hs
Original file line number Diff line number Diff line change
Expand Up @@ -58,7 +58,7 @@ fromFile logger gen domain path = do
triples <- map (Text.splitOn ",") . Text.lines <$> Text.readFile path
shuffled <- V.toList <$> uniformShuffle (V.fromList triples) gen
c <- newIORef =<< foldM (toUser logger domain) [] shuffled
return (Cache c)
pure (Cache c)

empty :: IO Cache
empty = Cache <$> newIORef []
Expand All @@ -82,7 +82,7 @@ toUser _ domain acc [i, e, p] = do
let ie = error "Cache.toUser: invalid email"
let ui = fromMaybe iu . fromByteString . encodeUtf8 . Text.toStrict . Text.strip $ i
let em = fromMaybe ie . parseEmail . Text.toStrict . Text.strip $ e
return . (: acc) $
pure . (: acc) $
CachedUser
pw
User
Expand All @@ -103,4 +103,4 @@ toUser _ domain acc [i, e, p] = do
}
toUser g _ acc entry = do
warn g $ msg (val "invalid entry: " +++ show entry)
return acc
pure acc
4 changes: 2 additions & 2 deletions libs/api-bot/src/Network/Wire/Bot/Clients.hs
Original file line number Diff line number Diff line change
Expand Up @@ -57,7 +57,7 @@ addMembers self c uu =
-- TODO: Move / inline to Network.Wire.Bot.Crypto and remove this module
foldSessions :: MonadIO m => Clients -> ConvId -> a -> (UserId -> ClientId -> Session -> a -> m a) -> m a
foldSessions self c a f =
foldrM fun a =<< Map.findWithDefault Set.empty c <$> liftIO (readTVarIO (members self))
foldrM fun a . Map.findWithDefault Set.empty c =<< liftIO (readTVarIO (members self))
where
fun u acc1 = do
cm <- Map.findWithDefault Map.empty u . clients <$> liftIO (readTVarIO (sessions self))
Expand All @@ -66,4 +66,4 @@ foldSessions self c a f =
lookupSession :: MonadIO m => Clients -> UserId -> ClientId -> m (Maybe Session)
lookupSession self u d = do
s <- liftIO $ readTVarIO (sessions self)
return $ Map.lookup u (clients s) >>= Map.lookup d
pure $ Map.lookup u (clients s) >>= Map.lookup d
12 changes: 6 additions & 6 deletions libs/api-bot/src/Network/Wire/Bot/Crypto.hs
Original file line number Diff line number Diff line change
Expand Up @@ -95,7 +95,7 @@ clientInitSession cl uid = do
k <- decodePrekey c
let i = mkSID uid (prekeyClient c)
s <- liftIO $ unwrap =<< CBox.sessionFromPrekey b i k
return (prekeyClient c, s)
pure (prekeyClient c, s)

-- | Initialise an OTR session between the given 'BotClient' and the sender of
-- the given OTR message.
Expand All @@ -116,12 +116,12 @@ encrypt cl cnv val = fmap (OtrRecipients . UserClientMap)
. foldSessions (botClientSessions cl) cnv Map.empty
$ \u c s rcps ->
if botClientId cl == c
then return rcps
then pure rcps
else liftIO $ do
ciphertext <- do
bs <- CBox.encrypt s val >>= unwrap >>= CBox.copyBytes
return $! decodeUtf8 $! B64.encode bs
return $ Map.insertWith Map.union u (Map.singleton c ciphertext) rcps
pure $! decodeUtf8 $! B64.encode bs
pure $ Map.insertWith Map.union u (Map.singleton c ciphertext) rcps

-- | Decrypt an OTR message received from a given user and client.
decrypt :: BotClient -> UserId -> ClientId -> ByteString -> BotSession ByteString
Expand Down Expand Up @@ -172,7 +172,7 @@ encryptSymmetric clt (SymmetricKeys ekey mkey) msg = liftIO $ do
iv <- randomBytes (botClientBox clt) 16
let ciphertext = iv <> cbcEncrypt aes (aesIV iv) (padPKCS7 msg)
let mac = hmac (toByteString' mkey) ciphertext :: HMAC SHA256
return $ convert mac <> ciphertext
pure $ convert mac <> ciphertext

decryptSymmetric :: MonadIO m => BotClient -> SymmetricKeys -> Ciphertext -> m Plaintext
decryptSymmetric _ (SymmetricKeys ekey mkey) msg = liftIO $ do
Expand All @@ -184,7 +184,7 @@ decryptSymmetric _ (SymmetricKeys ekey mkey) msg = liftIO $ do
throwM $
RequirementFailed "Bad MAC"
let (iv, dat) = BS.splitAt 16 ciphertext
return $ unpadPKCS7 $ cbcDecrypt aes (aesIV iv) dat
pure $ unpadPKCS7 $ cbcDecrypt aes (aesIV iv) dat

-----------------------------------------------------------------------------
-- Helpers
Expand Down
6 changes: 2 additions & 4 deletions libs/api-bot/src/Network/Wire/Bot/Crypto/Glue.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,3 @@
{-# LANGUAGE LambdaCase #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
Expand Down Expand Up @@ -67,12 +65,12 @@ randomBytes :: MonadIO m => Box -> Word32 -> m ByteString
randomBytes b n = liftIO $ CBox.randomBytes b n >>= unwrap >>= CBox.copyBytes

unwrap :: (Show a, MonadThrow m) => CBox.Result a -> m a
unwrap (CBox.Success a) = return a
unwrap (CBox.Success a) = pure a
unwrap other = throwM $ userError (show other)

getBoxDir :: UserId -> Maybe Text -> IO FilePath
getBoxDir uid label = do
tmp <- getTemporaryDirectory
let usrDir = show (toUUID uid)
let cltDir = maybe "" Text.unpack label
return $ tmp </> "wire-bot" </> usrDir </> cltDir
pure $ tmp </> "wire-bot" </> usrDir </> cltDir
14 changes: 7 additions & 7 deletions libs/api-bot/src/Network/Wire/Bot/Email.hs
Original file line number Diff line number Diff line change
Expand Up @@ -78,7 +78,7 @@ instance Exception MailException
loadMailboxConfig :: FilePath -> IO [Mailbox]
loadMailboxConfig p = do
cfg <- LB.readFile p
mbs <- either error return (eitherDecode' cfg) :: IO [MailboxSettings]
mbs <- either error pure (eitherDecode' cfg) :: IO [MailboxSettings]
mapM newMailbox mbs

newMailbox :: MailboxSettings -> IO Mailbox
Expand All @@ -88,7 +88,7 @@ newMailbox s@(MailboxSettings host usr pwd conns) =
connect = do
c <- connectIMAPSSLWithSettings host defaultSettingsIMAPSSL
login c (show usr) pwd
return c
pure c

-- | Awaits activation e-mail to arrive at a mailbox with
-- the designated recipient address.
Expand All @@ -109,7 +109,7 @@ awaitActivationMail mbox folders from to = do
let codeHdr = find ((== "x-zeta-code") . paramName) hdrs
case liftM2 (,) keyHdr codeHdr of
Just (k, c) ->
return $
pure $
( ActivationKey $ Ascii.unsafeFromText $ paramValue k,
ActivationCode $ Ascii.unsafeFromText $ paramValue c
)
Expand All @@ -132,7 +132,7 @@ awaitPasswordResetMail mbox folders from to = do
let codeHdr = find ((== "x-zeta-code") . paramName) hdrs
case liftM2 (,) keyHdr codeHdr of
Just (k, c) ->
return $
pure $
( PasswordResetKey $ Ascii.unsafeFromText $ paramValue k,
PasswordResetCode $ Ascii.unsafeFromText $ paramValue c
)
Expand All @@ -153,7 +153,7 @@ awaitInvitationMail mbox folders from to = do
let hdrs = mime_val_headers msg
let invHdr = find ((== "x-zeta-code") . paramName) hdrs
case invHdr of
Just i -> return . read . T.unpack $ paramValue i
Just i -> pure . read . T.unpack $ paramValue i
Nothing -> throwIO MissingEmailHeaders

awaitMail ::
Expand All @@ -176,7 +176,7 @@ awaitMail mbox folders from to purpose = go 0
case msgs of
[] | t >= timeout -> throwIO EmailTimeout
[] -> threadDelay sleep >> go (t + sleep)
(m : ms) -> return (m :| ms)
(m : ms) -> pure (m :| ms)

fetchMail ::
Mailbox ->
Expand All @@ -192,7 +192,7 @@ fetchMail ::
fetchMail mbox folders from to purpose = withResource (mailboxPool mbox) $ \c -> do
msgIds <- concat <$> forM folders (searchMail c)
msgs <- mapM (fetch c) msgIds
return $ map (parseMIMEMessage . T.decodeLatin1) msgs
pure $ map (parseMIMEMessage . T.decodeLatin1) msgs
where
searchMail c folder = do
select c folder
Expand Down
Loading