module Data.Mac
( Mac ()
, readMac
, showMac
, fromOctets
, toOctets
, toWord64
) where
import Control.Monad (unless)
import Data.Bits
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as L
import qualified Data.Text.Lazy.Builder as L
import qualified Data.Text.Lazy.Builder.Int as L
import Data.Text.Read
import Data.Word
import Import
newtype Mac = Mac { unMac :: Word64 }
deriving (Bounded, Eq, Ord)
instance Storable Mac where
sizeOf _ = 6
alignment _ = 1
peek p = fromOctets <$> (peek $ castPtr p) <*> peekByteOff p 1
<*> peekByteOff p 2 <*> peekByteOff p 3 <*> peekByteOff p 4
<*> peekByteOff p 5
poke p mac = do
poke (castPtr p) a
pokeByteOff p 1 b
pokeByteOff p 2 c
pokeByteOff p 3 d
pokeByteOff p 4 e
pokeByteOff p 5 f
where
(a, b, c, d, e, f) = toOctets mac
toWord64 :: Mac -> Word64
toWord64 = unMac
showMac :: Text -> Mac -> Text
showMac sep mac = T.intercalate sep . map octet $ [a, b, c, d, e, f]
where
octet x = pad (2 :: Int) . L.toStrict . L.toLazyText . L.hexadecimal $ x
(a, b, c, d, e, f) = toOctets mac
pad n str = T.replicate (max 0 (n T.length str)) "0" <> str
readMac :: Text -> Either String Mac
readMac s = fmapL (\e -> "Error parsing MAC address: " ++ e) $ do
(a, s2) <- octet s
(b, s3) <- octet s2
(c, s4) <- octet s3
(d, s5) <- octet s4
(e, s6) <- octet s5
(f, s7) <- octet s6
unless (s7 == "") $ Left "exactly 6 octets were expected."
fromOctets <$> digit a <*> digit b <*> digit c
<*> digit d <*> digit e <*> digit f
where
octet :: Text -> Either String (Int, Text)
octet s0 = do
(a, s2) <- hexadecimal a0
unless (s2 == "") $ Left "invalid characters"
return (a, rest)
where
(a0, rest) = T.splitAt 2 s0
digit :: Int -> Either String Word8
digit x | x < 0 || x > 255 = Left "digit out of range."
| otherwise = Right $ fromIntegral x
fromOctets :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Mac
fromOctets a b c d e f = Mac
$ (fromIntegral a `shiftL` 40)
.|. (fromIntegral b `shiftL` 32)
.|. (fromIntegral c `shiftL` 24)
.|. (fromIntegral d `shiftL` 16)
.|. (fromIntegral e `shiftL` 8)
.|. (fromIntegral f)
toOctets :: Mac -> (Word8, Word8, Word8, Word8, Word8, Word8)
toOctets (Mac word) = ( byte 5 word, byte 4 word, byte 3 word
, byte 2 word, byte 1 word, byte 0 word)
where
byte i w = fromIntegral (w `shiftR` (i * 8))