aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Network/WireGuard/Core.hs8
-rw-r--r--src/Network/WireGuard/Foreign/Tun.hs4
-rw-r--r--src/Network/WireGuard/Internal/Data/RpcTypes.hs2
-rw-r--r--src/Network/WireGuard/Internal/Noise.hs2
-rw-r--r--src/Network/WireGuard/Internal/RpcParsers.hs10
-rw-r--r--src/Network/WireGuard/Internal/Util.hs7
-rw-r--r--src/Network/WireGuard/TunListener.hs2
7 files changed, 17 insertions, 18 deletions
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))
Copyright © 1996 – 2023 Jason A. Donenfeld. All Rights Reverse Engineered.