From 0b2de17e8bb5ca5c2f709f150fd73153ef670fd0 Mon Sep 17 00:00:00 2001 From: Baylac-Jacqué Félix Date: Sat, 16 Sep 2017 16:11:04 +0200 Subject: Fix GHC and HLINT warnings. --- src/Network/WireGuard/Core.hs | 8 ++++---- src/Network/WireGuard/Foreign/Tun.hs | 4 ++-- src/Network/WireGuard/Internal/Data/RpcTypes.hs | 2 +- src/Network/WireGuard/Internal/Noise.hs | 2 +- src/Network/WireGuard/Internal/RpcParsers.hs | 10 +++++----- src/Network/WireGuard/Internal/Util.hs | 7 +++---- src/Network/WireGuard/TunListener.hs | 2 +- 7 files changed, 17 insertions(+), 18 deletions(-) (limited to 'src/Network/WireGuard') diff --git a/src/Network/WireGuard/Core.hs b/src/Network/WireGuard/Core.hs index 5bbf317..39beb78 100644 --- a/src/Network/WireGuard/Core.hs +++ b/src/Network/WireGuard/Core.hs @@ -28,7 +28,7 @@ import Data.Serialize (putWord32be, runPut) import Foreign.C.Types (CTime (..)) import Network.Socket (SockAddr) -import System.IO (hPutStrLn, stderr) +import System.IO (hPrint, stderr) import System.Posix.Time (epochTime) import System.Random (randomIO) @@ -73,7 +73,7 @@ handleReadTun device readTunChan writeUdpChan = forever $ do res <- runExceptT $ processTunPacket device writeUdpChan tunPacket case res of Right udpPacket -> pushPacketQueue writeUdpChan udpPacket - Left err -> hPutStrLn stderr (show err) -- TODO: proper logging + Left err -> hPrint stderr err -- TODO: proper logging handleReadUdp :: Device -> PacketQueue UdpPacket -> PacketQueue TunPacket -> PacketQueue UdpPacket @@ -82,7 +82,7 @@ handleReadUdp device readUdpChan writeTunChan writeUdpChan = forever $ do udpPacket <- popPacketQueue readUdpChan res <- runExceptT $ processUdpPacket device udpPacket case res of - Left err -> hPutStrLn stderr (show err) -- TODO: proper logging + Left err -> hPrint stderr err -- TODO: proper logging Right mpacket -> case mpacket of Just (Right tunp) -> pushPacketQueue writeTunChan tunp Just (Left udpp) -> pushPacketQueue writeUdpChan udpp @@ -225,7 +225,7 @@ processPacket device@Device{..} _key _psk sock PacketData{..} = do unless (remotePub peer `dhPubEq` remotePub peer') $ throwE SourceAddrBlockedError liftIO $ atomically $ writeTVar (lastReceiveTime peer) now liftIO $ atomically $ modifyTVar' (receivedBytes peer) (+fromIntegral (BA.length decryptedPayload)) - else do + else liftIO $ atomically $ writeTVar (lastKeepaliveTime peer) now return (Just (Right decryptedPayload)) diff --git a/src/Network/WireGuard/Foreign/Tun.hs b/src/Network/WireGuard/Foreign/Tun.hs index 3fdbbd4..89f4bae 100644 --- a/src/Network/WireGuard/Foreign/Tun.hs +++ b/src/Network/WireGuard/Foreign/Tun.hs @@ -27,14 +27,14 @@ openTun intfName threads = tunReadBuf :: Fd -> Ptr Word8 -> CSize -> IO CSize tunReadBuf _fd _buf 0 = return 0 tunReadBuf fd buf nbytes = - fmap fromIntegral $ + fromIntegral <$> throwErrnoIfMinus1RetryMayBlock "tunReadBuf" (tun_read_c (fromIntegral fd) (castPtr buf) nbytes) (threadWaitRead fd) tunWriteBuf :: Fd -> Ptr Word8 -> CSize -> IO CSize tunWriteBuf fd buf len = - fmap fromIntegral $ + fromIntegral <$> throwErrnoIfMinus1RetryMayBlock "tunWriteBuf" (tun_write_c (fromIntegral fd) (castPtr buf) len) (threadWaitWrite fd) diff --git a/src/Network/WireGuard/Internal/Data/RpcTypes.hs b/src/Network/WireGuard/Internal/Data/RpcTypes.hs index 088bbb5..7e1c20e 100644 --- a/src/Network/WireGuard/Internal/Data/RpcTypes.hs +++ b/src/Network/WireGuard/Internal/Data/RpcTypes.hs @@ -44,7 +44,7 @@ data RpcDevicePayload = RpcDevicePayload { instance Show RpcDevicePayload where show (RpcDevicePayload kp lp fwM rpp) = show (showKeyPair <$> kp) ++ show lp ++ show fwM ++ show rpp where - showKeyPair (pk, _) = show $ dhSecToBytes pk + showKeyPair (pr, _) = show $ dhSecToBytes pr instance Eq RpcDevicePayload where (==) (RpcDevicePayload pk1 prt1 fw1 rp1) (RpcDevicePayload pk2 prt2 fw2 rp2) = diff --git a/src/Network/WireGuard/Internal/Noise.hs b/src/Network/WireGuard/Internal/Noise.hs index 4084f42..bd85c05 100644 --- a/src/Network/WireGuard/Internal/Noise.hs +++ b/src/Network/WireGuard/Internal/Noise.hs @@ -46,7 +46,7 @@ newNoiseState staticKey presharedKey ephemeralKey remotePub role = sendFirstMessage :: NoiseStateWG -> ScrubbedBytes -> Either SomeException (ByteString, NoiseStateWG) -sendFirstMessage state0 plaintext1 = writeMessage state0 plaintext1 +sendFirstMessage = writeMessage recvFirstMessageAndReply :: NoiseStateWG -> ByteString -> ScrubbedBytes -> Either SomeException (ByteString, ScrubbedBytes, PublicKey, SessionKey) diff --git a/src/Network/WireGuard/Internal/RpcParsers.hs b/src/Network/WireGuard/Internal/RpcParsers.hs index d2eac92..654cf4e 100644 --- a/src/Network/WireGuard/Internal/RpcParsers.hs +++ b/src/Network/WireGuard/Internal/RpcParsers.hs @@ -57,11 +57,11 @@ setPayloadParser = do deviceParser :: Parser RpcDevicePayload deviceParser = do fields <- deviceFieldsParser - let pk = join $ listToMaybe [ pkF | RpcPk pkF <- fields] + let devPk = join $ listToMaybe [ pkF | RpcPk pkF <- fields] let p = head [ pF | RpcPort pF <- fields] let fw = join $ listToMaybe [ fwF | RpcFwMark fwF <- fields] let rmDev = not $ null [True | RpcReplacePeers <- fields] - return $ RpcDevicePayload pk p fw rmDev + return $ RpcDevicePayload devPk p fw rmDev deviceFieldsParser :: Parser [RpcDeviceField] deviceFieldsParser = many' (deviceFieldParser <* endOfLine) @@ -87,8 +87,8 @@ deviceFieldParser = do peerParser :: Parser RpcPeerPayload peerParser = do - pubK <- parsePubKey - fields <- peerFieldsParser + peerPubK <- parsePubKey + fields <- peerFieldsParser let rm = not $ null [rmF | RpcRmFlag rmF <- fields] let psh = listToMaybe [pshF | RpcPsh pshF <- fields] let endPL = [endPF | RpcEndp endPF <- fields] @@ -98,7 +98,7 @@ peerParser = do let ka = fromMaybe 0 $ listToMaybe [kaF | RpcKA kaF <- fields] let rmIps = not $ null [rmIpsF | RpcDelIps rmIpsF <- fields] let allIpR = [ipRF | RpcAllIp ipRF <- fields] - return $ RpcPeerPayload pubK rm psh endP ka rmIps allIpR + return $ RpcPeerPayload peerPubK rm psh endP ka rmIps allIpR where parsePubKey = do _ <- "public_key=" "Peer delimiter" diff --git a/src/Network/WireGuard/Internal/Util.hs b/src/Network/WireGuard/Internal/Util.hs index 6aefee7..fa48d24 100644 --- a/src/Network/WireGuard/Internal/Util.hs +++ b/src/Network/WireGuard/Internal/Util.hs @@ -18,6 +18,7 @@ import Control.Exception (Exception (..), SomeAsyncException, SomeException, throwIO) import Control.Monad.Catch (MonadCatch (..)) +import Data.Foldable (forM_) import System.IO (hPutStrLn, stderr) import Foreign @@ -49,9 +50,7 @@ catchSomeExceptionAnd what m = catch m $ \(_ :: SomeException) -> what withJust :: Monad m => m (Maybe a) -> (a -> m ()) -> m () withJust mma func = do ma <- mma - case ma of - Nothing -> return () - Just a -> func a + forM_ ma func dropUntilM :: Monad m => (a -> Bool) -> m a -> m a dropUntilM cond ma = loop @@ -66,7 +65,7 @@ zeroMemory :: Ptr a -> CSize -> IO () zeroMemory dest nbytes = memset dest 0 (fromIntegral nbytes) copyMemory :: Ptr a -> Ptr b -> CSize -> IO () -copyMemory dest src nbytes = memcpy dest src nbytes +copyMemory = memcpy foreign import ccall unsafe "string.h" memset :: Ptr a -> CInt -> CSize -> IO () foreign import ccall unsafe "string.h" memcpy :: Ptr a -> Ptr b -> CSize -> IO () diff --git a/src/Network/WireGuard/TunListener.hs b/src/Network/WireGuard/TunListener.hs index 34b961b..7e4cfcb 100644 --- a/src/Network/WireGuard/TunListener.hs +++ b/src/Network/WireGuard/TunListener.hs @@ -41,5 +41,5 @@ readTun buf fd = do (\ptr -> copyMemory ptr buf nbytes >> zeroMemory buf nbytes) writeTun :: BA.ByteArrayAccess ba => Fd -> ba -> IO () -writeTun fd ba = BA.withByteArray ba $ \ptr -> do +writeTun fd ba = BA.withByteArray ba $ \ptr -> void $ tunWriteBuf fd ptr (fromIntegral (BA.length ba)) -- cgit v1.2.3-59-g8ed1b