ip 0.1 → 0.2
raw patch · 4 files changed
+114/−25 lines, 4 files
Files
- ip.cabal +5/−3
- src/Net/IPv4.hs +20/−22
- src/Net/Internal.hs +13/−0
- src/Net/Mac.hs +76/−0
ip.cabal view
@@ -1,6 +1,6 @@ name: ip-version: 0.1-synopsis: Initial project template from stack+version: 0.2+synopsis: Library for IP and MAC addresses description: Please see README.md homepage: https://github.com/andrewthad/ip#readme license: BSD3@@ -14,9 +14,11 @@ library hs-source-dirs: src- exposed-modules: + exposed-modules:+ Net.Mac Net.IPv4 Net.IPv4.Text+ Net.Internal build-depends: base >= 4.7 && < 5 , attoparsec
src/Net/IPv4.hs view
@@ -10,19 +10,21 @@ import Data.Monoid ((<>)) import Data.Bits ((.&.),(.|.),shiftR,shiftL,complement) import Data.Word+import Data.Int import Data.Hashable import Data.Aeson (FromJSON(..),ToJSON(..)) import GHC.Generics (Generic) import qualified Data.Aeson as Aeson import qualified Data.Aeson.Types as Aeson-import qualified Data.Attoparsec.Text as Attoparsec+import qualified Data.Attoparsec.Text as AT+import Net.Internal (attoparsecParseJSON) newtype IPv4 = IPv4 { getIPv4 :: Word32 } deriving (Eq,Ord,Show,Read,Enum,Bounded,Hashable,Generic) data IPv4Range = IPv4Range { ipv4RangeBase :: {-# UNPACK #-} !IPv4- , ipv4RangeLength :: {-# UNPACK #-} !Int+ , ipv4RangeLength :: {-# UNPACK #-} !Int8 } deriving (Eq,Ord,Show,Read,Generic) instance Hashable IPv4Range@@ -31,10 +33,7 @@ toJSON addr = Aeson.String (toDotDecimalText addr) instance FromJSON IPv4 where- parseJSON (Aeson.String t) = - case fromDotDecimalText' t of- Left err -> fail err- Right res -> return res+ parseJSON = attoparsecParseJSON (dotDecimalParser <* AT.endOfInput) instance ToJSON IPv4Range where toJSON addrRange = Aeson.String (rangeToDotDecimalText addrRange)@@ -53,40 +52,40 @@ fromDotDecimalText' :: Text -> Either String IPv4 fromDotDecimalText' t = - Attoparsec.parseOnly (dotDecimalParser <* Attoparsec.endOfInput) t+ AT.parseOnly (dotDecimalParser <* AT.endOfInput) t fromDotDecimalText :: Text -> Maybe IPv4 fromDotDecimalText = rightToMaybe . fromDotDecimalText' rangeFromDotDecimalText' :: Text -> Either String IPv4Range rangeFromDotDecimalText' t = - Attoparsec.parseOnly (dotDecimalRangeParser <* Attoparsec.endOfInput) t+ AT.parseOnly (dotDecimalRangeParser <* AT.endOfInput) t rangeFromDotDecimalText :: Text -> Maybe IPv4Range rangeFromDotDecimalText = rightToMaybe . rangeFromDotDecimalText' -dotDecimalRangeParser :: Attoparsec.Parser IPv4Range+dotDecimalRangeParser :: AT.Parser IPv4Range dotDecimalRangeParser = IPv4Range <$> dotDecimalParser- <* Attoparsec.char '/'- <*> (Attoparsec.decimal >>= limitSize)+ <* AT.char '/'+ <*> (AT.decimal >>= limitSize) where limitSize i = if i > 32 then fail "An IP range length must be between 0 and 32" else return i --- This does not do an endOfInput check because it is+-- | This does not do an endOfInput check because it is -- reused in the range parser implementation.-dotDecimalParser :: Attoparsec.Parser IPv4+dotDecimalParser :: AT.Parser IPv4 dotDecimalParser = fromOctets'- <$> (Attoparsec.decimal >>= limitSize)- <* Attoparsec.char '.'- <*> (Attoparsec.decimal >>= limitSize)- <* Attoparsec.char '.'- <*> (Attoparsec.decimal >>= limitSize)- <* Attoparsec.char '.'- <*> (Attoparsec.decimal >>= limitSize)+ <$> (AT.decimal >>= limitSize)+ <* AT.char '.'+ <*> (AT.decimal >>= limitSize)+ <* AT.char '.'+ <*> (AT.decimal >>= limitSize)+ <* AT.char '.'+ <*> (AT.decimal >>= limitSize) where limitSize i = if i > 255 @@ -101,8 +100,7 @@ -- dotDecimalParser probably perform better. fromOctets' :: Word32 -> Word32 -> Word32 -> Word32 -> IPv4 fromOctets' a b c d = IPv4 - ( 0- .|. shiftL a 24+ ( shiftL a 24 .|. shiftL b 16 .|. shiftL c 8 .|. d
+ src/Net/Internal.hs view
@@ -0,0 +1,13 @@+module Net.Internal where++import qualified Data.Attoparsec.Text as AT+import qualified Data.Aeson.Types as Aeson++attoparsecParseJSON :: AT.Parser a -> Aeson.Value -> Aeson.Parser a+attoparsecParseJSON p v = + case v of+ Aeson.String t -> + case AT.parseOnly p t of+ Left err -> fail err+ Right res -> return res+ _ -> fail "expected a String"
+ src/Net/Mac.hs view
@@ -0,0 +1,76 @@+ {-# LANGUAGE DeriveGeneric #-}+ {-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Net.Mac where++import Data.Text (Text)+import Data.Hashable (Hashable)+import GHC.Generics (Generic)+import Data.Word +import Data.Aeson (ToJSON(..),FromJSON(..))+import qualified Data.Attoparsec.Text as AT+import qualified Data.Attoparsec.ByteString.Char8 as AB+import Data.Bits ((.&.),(.|.),shiftR,shiftL,complement)+import Net.Internal (attoparsecParseJSON)++data Mac = Mac+ { macA :: {-# UNPACK #-} !Word16+ , macB :: {-# UNPACK #-} !Word32+ }+ deriving (Eq,Ord,Show,Read,Generic)++instance Hashable Mac++instance FromJSON Mac where+ parseJSON = attoparsecParseJSON (textParser <* AT.endOfInput)++-- | This does not do an endOfInput check+textParser :: AT.Parser Mac+textParser = fromOctets'+ <$> (AT.hexadecimal >>= limitSize)+ <* AT.char ':'+ <*> (AT.hexadecimal >>= limitSize)+ <* AT.char ':'+ <*> (AT.hexadecimal >>= limitSize)+ <* AT.char ':'+ <*> (AT.hexadecimal >>= limitSize)+ <* AT.char ':'+ <*> (AT.hexadecimal >>= limitSize)+ <* AT.char ':'+ <*> (AT.hexadecimal >>= limitSize)+ where+ limitSize i = + if i > 255 + then fail "All octets in a mac address must be between 00 and FF"+ else return i++bytestringParser :: AB.Parser Mac+bytestringParser = fromOctets'+ <$> (AB.hexadecimal >>= limitSize)+ <* AB.char ':'+ <*> (AB.hexadecimal >>= limitSize)+ <* AB.char ':'+ <*> (AB.hexadecimal >>= limitSize)+ <* AB.char ':'+ <*> (AB.hexadecimal >>= limitSize)+ <* AB.char ':'+ <*> (AB.hexadecimal >>= limitSize)+ <* AB.char ':'+ <*> (AB.hexadecimal >>= limitSize)+ where+ limitSize i = + if i > 255 + then fail "All octets in a mac address must be between 00 and FF"+ else return i++fromOctets :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Mac+fromOctets a b c d e f = fromOctets'+ (fromIntegral a) (fromIntegral b) (fromIntegral c)+ (fromIntegral d) (fromIntegral e) (fromIntegral f)++fromOctets' :: Word16 -> Word16 -> Word32 -> Word32 -> Word32 -> Word32 -> Mac+fromOctets' a b c d e f = Mac+ ( shiftL a 8 .|. b )+ ( shiftL c 24 .|. shiftL d 16 .|. shiftL e 8 .|. f )++