diff --git a/PROJECTS/advanced/haskell-reverse-proxy/aenebris.cabal b/PROJECTS/advanced/haskell-reverse-proxy/aenebris.cabal index eac26e1f..7cf66dd6 100644 --- a/PROJECTS/advanced/haskell-reverse-proxy/aenebris.cabal +++ b/PROJECTS/advanced/haskell-reverse-proxy/aenebris.cabal @@ -38,6 +38,7 @@ library , Aenebris.WAF.Engine , Aenebris.Honeypot , Aenebris.Geo + , Aenebris.Net.IP , Aenebris.ML.Features , Aenebris.ML.Model , Aenebris.ML.Loader diff --git a/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/DDoS/ConnLimit.hs b/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/DDoS/ConnLimit.hs index a5d302ee..e570e946 100644 --- a/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/DDoS/ConnLimit.hs +++ b/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/DDoS/ConnLimit.hs @@ -28,19 +28,11 @@ import Control.Concurrent.STM , readTVar , writeTVar ) +import Aenebris.Net.IP (sockAddrToIPBytes) import Data.ByteString (ByteString) -import qualified Data.ByteString.Char8 as BS8 -import Data.List (intercalate) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map -import Network.Socket - ( HostAddress6 - , SockAddr(..) - , hostAddress6ToTuple - , hostAddressToTuple - ) -import Numeric (showHex) -import Text.Printf (printf) +import Network.Socket (SockAddr) defaultPerIPLimit :: Int defaultPerIPLimit = 16 @@ -87,19 +79,10 @@ currentCount ConnLimiter{..} ip = do pure (Map.findWithDefault 0 ip m) connLimitOnOpen :: ConnLimiter -> SockAddr -> IO Bool -connLimitOnOpen cl sa = atomically (tryAcquire cl (ipBytesFromSockAddr sa)) +connLimitOnOpen cl sa = atomically (tryAcquire cl (sockAddrToIPBytes sa)) connLimitOnClose :: ConnLimiter -> SockAddr -> IO () -connLimitOnClose cl sa = atomically (release cl (ipBytesFromSockAddr sa)) +connLimitOnClose cl sa = atomically (release cl (sockAddrToIPBytes sa)) ipBytesFromSockAddr :: SockAddr -> ByteString -ipBytesFromSockAddr (SockAddrInet _ ha) = - let (a, b, c, d) = hostAddressToTuple ha - in BS8.pack (printf "%d.%d.%d.%d" a b c d) -ipBytesFromSockAddr (SockAddrInet6 _ _ ha6 _) = v6Bytes ha6 -ipBytesFromSockAddr (SockAddrUnix p) = BS8.pack ("unix:" <> p) - -v6Bytes :: HostAddress6 -> ByteString -v6Bytes ha = - let (a, b, c, d, e, f, g, h) = hostAddress6ToTuple ha - in BS8.pack (intercalate ":" (map (`showHex` "") [a, b, c, d, e, f, g, h])) +ipBytesFromSockAddr = sockAddrToIPBytes diff --git a/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/Net/IP.hs b/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/Net/IP.hs new file mode 100644 index 00000000..8033b209 --- /dev/null +++ b/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/Net/IP.hs @@ -0,0 +1,43 @@ +{- +©AngelaMos | 2026 +IP.hs +-} +{-# LANGUAGE OverloadedStrings #-} + +module Aenebris.Net.IP + ( sockAddrToIPBytes + ) where + +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as BS8 +import Data.List (intercalate) +import Network.Socket + ( HostAddress6 + , SockAddr(..) + , hostAddress6ToTuple + , hostAddressToTuple + ) +import Numeric (showHex) +import Text.Printf (printf) + +ipv4Format :: String +ipv4Format = "%d.%d.%d.%d" + +ipv6Separator :: String +ipv6Separator = ":" + +unixSocketPrefix :: String +unixSocketPrefix = "unix:" + +sockAddrToIPBytes :: SockAddr -> ByteString +sockAddrToIPBytes (SockAddrInet _ ha) = + let (a, b, c, d) = hostAddressToTuple ha + in BS8.pack (printf ipv4Format a b c d) +sockAddrToIPBytes (SockAddrInet6 _ _ ha6 _) = renderIPv6 ha6 +sockAddrToIPBytes (SockAddrUnix p) = BS8.pack (unixSocketPrefix <> p) + +renderIPv6 :: HostAddress6 -> ByteString +renderIPv6 ha = + let (a, b, c, d, e, f, g, h) = hostAddress6ToTuple ha + parts = [a, b, c, d, e, f, g, h] + in BS8.pack (intercalate ipv6Separator (map (`showHex` "") parts)) diff --git a/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/RateLimit.hs b/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/RateLimit.hs index 4963c805..5e70cc58 100644 --- a/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/RateLimit.hs +++ b/PROJECTS/advanced/haskell-reverse-proxy/src/Aenebris/RateLimit.hs @@ -29,9 +29,9 @@ import Control.Concurrent.STM , readTVar , writeTVar ) +import Aenebris.Net.IP (sockAddrToIPBytes) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS8 -import Data.List (intercalate) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Text (Text) @@ -39,12 +39,6 @@ import qualified Data.Text as T import qualified Data.Text.Read as TR import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime) import Network.HTTP.Types (status429) -import Network.Socket - ( HostAddress6 - , SockAddr(..) - , hostAddress6ToTuple - , hostAddressToTuple - ) import Network.Wai ( Middleware , Request @@ -52,8 +46,6 @@ import Network.Wai , remoteHost , responseLBS ) -import Numeric (showHex) -import Text.Printf (printf) secondsPerMinute :: Double secondsPerMinute = 60 @@ -165,18 +157,7 @@ rateLimitMiddleware rl app req respond = do intBS n = BS8.pack (show n) clientIPKey :: Request -> ByteString -clientIPKey req = case remoteHost req of - SockAddrInet _ ha -> - let (a, b, c, d) = hostAddressToTuple ha - in BS8.pack (printf "%d.%d.%d.%d" a b c d) - SockAddrInet6 _ _ ha6 _ -> v6Bytes ha6 - SockAddrUnix p -> BS8.pack ("unix:" <> p) - where - v6Bytes :: HostAddress6 -> ByteString - v6Bytes ha = - let (a, b, c, d, e, f, g, h) = hostAddress6ToTuple ha - parts = [a, b, c, d, e, f, g, h] - in BS8.pack (intercalate ":" (map (`showHex` "") parts)) +clientIPKey = sockAddrToIPBytes . remoteHost pathClassKey :: Request -> ByteString pathClassKey req = diff --git a/PROJECTS/advanced/haskell-reverse-proxy/test/Spec.hs b/PROJECTS/advanced/haskell-reverse-proxy/test/Spec.hs index 954a642d..9626e28c 100644 --- a/PROJECTS/advanced/haskell-reverse-proxy/test/Spec.hs +++ b/PROJECTS/advanced/haskell-reverse-proxy/test/Spec.hs @@ -231,6 +231,7 @@ import Aenebris.ML.Loader ( ParseError(..) , parseEnsemble ) +import Aenebris.Net.IP (sockAddrToIPBytes) import Aenebris.Middleware.Redirect (httpsRedirect, httpsRedirectWithPort) import Aenebris.Middleware.Security ( addSecurityHeaders @@ -380,6 +381,7 @@ main = hspec $ do wafSpec honeypotSpec geoSpec + netIpSpec mlFeaturesSpec mlModelSpec mlLoaderSpec @@ -1883,6 +1885,27 @@ mlModelSpec = describe "ML.Model" $ do validateTree 20 bad `shouldSatisfy` (\r -> case r of { Left _ -> True; Right _ -> False }) +netIpSpec :: Spec +netIpSpec = describe "Net.IP" $ do + it "renders ipv4 sockaddr in dotted decimal" $ + sockAddrToIPBytes (ipv4Addr (10, 0, 0, 1) 1234) `shouldBe` "10.0.0.1" + + it "renders ipv4 loopback" $ + sockAddrToIPBytes (ipv4Addr (127, 0, 0, 1) 8080) `shouldBe` "127.0.0.1" + + it "renders unix sockaddr with prefix" $ + sockAddrToIPBytes (SockAddrUnix "/tmp/sock") `shouldBe` "unix:/tmp/sock" + + it "renders ipv6 sockaddr separated by colons (eight 16-bit groups)" $ do + let addr = SockAddrInet6 + 0 + 0 + (tupleToHostAddress6 (0x2001, 0xdb8, 0, 0, 0, 0, 0, 1)) + 0 + result = sockAddrToIPBytes addr + BS.length result `shouldSatisfy` (> 0) + BC.count ':' result `shouldBe` 7 + mlLoaderModel :: T.Text mlLoaderModel = T.unlines [ "tree"