{-# LANGUAGE CPP #-} module MacAddress where import Data.Binary (decode) import qualified Data.ByteString.Lazy as BSL import Safe (headDef) #ifdef ETA_VERSION import Java import Data.Maybe (catMaybes) import Data.Traversable (for) import Data.Word (Word64, Word8) #else /* !defined ETA_VERSION */ import Data.Word (Word64) import Network.Info (MAC (MAC), getNetworkInterfaces, mac) #endif /* ETA_VERSION */ getMacAddress :: IO Word64 #ifdef ETA_VERSION getMacAddress = java $ do interfaces <- fromJava <$> getNetworkInterfaces macs <- for interfaces (<.> getHardwareAddress) let macBytes = headDef (error "Can't get any non-zero MAC address of this machine") $ catMaybes macs let mac = foldBytes $ fromJava macBytes pure mac data NetworkInterface = NetworkInterface @java.net.NetworkInterface deriving Class foreign import java unsafe "@static java.net.NetworkInterface.getNetworkInterfaces" getNetworkInterfaces :: Java a (Enumeration NetworkInterface) foreign import java unsafe getHardwareAddress :: Java NetworkInterface (Maybe JByteArray) foldBytes :: [Word8] -> Word64 foldBytes bytes = decode . BSL.pack $ replicate (8 - length bytes) 0 ++ bytes #else /* !defined ETA_VERSION */ getMacAddress :: IO Word64 getMacAddress = MAC -> Word64 decodeMac (MAC -> Word64) -> IO MAC -> IO Word64 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> IO MAC getMac getMac :: IO MAC getMac :: IO MAC getMac = MAC -> [MAC] -> MAC forall a. a -> [a] -> a headDef ([Char] -> MAC forall a. HasCallStack => [Char] -> a error [Char] "Can't get any non-zero MAC address of this machine") ([MAC] -> MAC) -> ([NetworkInterface] -> [MAC]) -> [NetworkInterface] -> MAC forall b c a. (b -> c) -> (a -> b) -> a -> c . (MAC -> Bool) -> [MAC] -> [MAC] forall a. (a -> Bool) -> [a] -> [a] filter (MAC -> MAC -> Bool forall a. Eq a => a -> a -> Bool /= MAC forall a. Bounded a => a minBound) ([MAC] -> [MAC]) -> ([NetworkInterface] -> [MAC]) -> [NetworkInterface] -> [MAC] forall b c a. (b -> c) -> (a -> b) -> a -> c . (NetworkInterface -> MAC) -> [NetworkInterface] -> [MAC] forall a b. (a -> b) -> [a] -> [b] map NetworkInterface -> MAC mac ([NetworkInterface] -> MAC) -> IO [NetworkInterface] -> IO MAC forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> IO [NetworkInterface] getNetworkInterfaces decodeMac :: MAC -> Word64 decodeMac :: MAC -> Word64 decodeMac (MAC Word8 b5 Word8 b4 Word8 b3 Word8 b2 Word8 b1 Word8 b0) = ByteString -> Word64 forall a. Binary a => ByteString -> a decode (ByteString -> Word64) -> ByteString -> Word64 forall a b. (a -> b) -> a -> b $ [Word8] -> ByteString BSL.pack [Word8 0, Word8 0, Word8 b5, Word8 b4, Word8 b3, Word8 b2, Word8 b1, Word8 b0] #endif /* ETA_VERSION */