attoparsec-ip 0.0.1 → 0.0.2
raw patch · 3 files changed
+201/−59 lines, 3 filesdep +QuickCheckdep +tastydep +tasty-quickcheckdep ~basedep ~ip
Dependencies added: QuickCheck, tasty, tasty-quickcheck, text, vector
Dependency ranges changed: base, ip
Files
- attoparsec-ip.cabal +57/−30
- src/Data/Attoparsec/IP.hs +111/−28
- test/Spec.hs +33/−1
attoparsec-ip.cabal view
@@ -1,35 +1,62 @@-name: attoparsec-ip-version: 0.0.1-synopsis: Parse IP data types with attoparsec--- description:-homepage: https://github.com/athanclark/attoparsec-ip#readme-license: BSD3-license-file: LICENSE-author: Athan Clark-maintainer: athan.clark@gmail.com-copyright: BSD-3-category: Web-build-type: Simple-extra-source-files: README.md-cabal-version: >=1.10+-- This file has been generated from package.yaml by hpack version 0.21.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 752338db2f40ec721645dec093759863a55ecbe09b0f85828e85167a6c599484 -library- hs-source-dirs: src- exposed-modules: Data.Attoparsec.IP- build-depends: base >= 4.7 && < 5- , attoparsec- , ip >= 1.1.0- default-language: Haskell2010+name: attoparsec-ip+version: 0.0.2+synopsis: Parse IP data types with attoparsec+description: Please see the README on GitHub at <https://github.com/githubuser/purescript-iso#readme>+category: Web+homepage: https://github.com/athanclark/attoparsec-ip#readme+bug-reports: https://github.com/athanclark/attoparsec-ip/issues+author: Athan Clark+maintainer: athan.clark@localcooking.com+copyright: 2018 (c) Local Cooking Inc.+license: BSD3+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10 -test-suite attoparsec-ip-test- type: exitcode-stdio-1.0- hs-source-dirs: test- main-is: Spec.hs- build-depends: base- , attoparsec-ip- ghc-options: -threaded -rtsopts -with-rtsopts=-N- default-language: Haskell2010+extra-source-files:+ README.md source-repository head- type: git+ type: git location: https://github.com/athanclark/attoparsec-ip++library+ exposed-modules:+ Data.Attoparsec.IP+ other-modules:+ Paths_attoparsec_ip+ hs-source-dirs:+ src+ ghc-options: -Wall+ build-depends:+ attoparsec+ , base >=4.7 && <4.11+ , ip >=1.3.0 && <1.4.0+ , vector+ default-language: Haskell2010++test-suite purescript-iso-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Paths_attoparsec_ip+ hs-source-dirs:+ test+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ QuickCheck+ , attoparsec+ , attoparsec-ip+ , base >=4.7 && <4.11+ , ip+ , tasty+ , tasty-quickcheck+ , text+ , vector+ default-language: Haskell2010
src/Data/Attoparsec/IP.hs view
@@ -1,7 +1,16 @@-module Data.Attoparsec.IP where+{-# LANGUAGE+ OverloadedLists+ , OverloadedStrings+ , RecordWildCards+ #-} -import Data.Attoparsec.Text (Parser, char, digit, hexadecimal)+module Data.Attoparsec.IP (ipv4, ipv6) where++import Data.Attoparsec.Text (Parser, char, string, digit, hexadecimal, many1) import Data.Word (Word8, Word16)+import Data.Vector (Vector)+import qualified Data.Vector as V+import Data.Monoid ((<>)) import Control.Applicative ((<|>)) import Control.Monad (void) import Net.Types (IPv4, IPv6)@@ -12,11 +21,11 @@ ipv4 :: Parser IPv4 ipv4 = do a <- octet- void $ char '.'+ void (char '.') b <- octet- void $ char '.'+ void (char '.') c <- octet- void $ char '.'+ void (char '.') d <- octet pure (IPv4.fromOctets a b c d) where@@ -41,28 +50,102 @@ pure n +data IPv6Divider+ = DividerColon+ | DoubleColon+ deriving (Show)++parseDividerOrDoubleColon :: Parser IPv6Divider+parseDividerOrDoubleColon =+ let divider = DividerColon <$ char ':'+ doubleColon = DoubleColon <$ string "::"+ in doubleColon <|> divider++parseHextet :: Parser IPv6Chunk+parseHextet = Hextet <$> hexadecimal++parseHextets :: Parser [IPv6Chunk]+parseHextets = many1 (parseHextet <|> (Divider <$> parseDividerOrDoubleColon))++data IPv6Chunk+ = Hextet Word16+ | Divider IPv6Divider+ deriving (Show)++data IPv6TokenPos+ = Init+ | A+ | B+ | C+ | D+ | E+ | F+ | G+ | Finished+ deriving (Show, Eq, Ord, Enum, Bounded)++data IPv6State = IPv6State+ { hextets :: Vector Word16+ , current :: IPv6TokenPos+ , doublePos :: Maybe IPv6TokenPos+ } deriving (Show)++initIPv6State :: IPv6State+initIPv6State = IPv6State [] Init Nothing++accumIPv6State :: [IPv6Chunk] -> IPv6State+accumIPv6State xs =+ let go :: IPv6State -> IPv6Chunk -> IPv6State+ go xss@IPv6State{..} x = case x of+ Divider d -> case d of+ DoubleColon -> xss { doublePos = Just current }+ DividerColon -> xss+ Hextet n -> xss { hextets = V.snoc hextets n, current = succ current }+ in foldl go initIPv6State xs++ipv6StateToIPv6 :: IPv6State -> Maybe IPv6+ipv6StateToIPv6 IPv6State{..} = case doublePos of+ Nothing -> case V.toList hextets of+ (a:b:c:d:e:f:g:h:_) -> Just (IPv6.fromWord16s a b c d e f g h)+ _ -> Nothing+ Just p ->+ let zeros = V.replicate (8 - V.length hextets) 0+ composite = case p of+ Init -> Just (zeros <> hextets)+ A -> case V.toList hextets of+ (a:hs) -> Just ([a] <> zeros <> V.fromList hs)+ _ -> Nothing+ B -> case V.toList hextets of+ (a:b:hs) -> Just ([a,b] <> zeros <> V.fromList hs)+ _ -> Nothing+ C -> case V.toList hextets of+ (a:b:c:hs) -> Just ([a,b,c] <> zeros <> V.fromList hs)+ _ -> Nothing+ D -> case V.toList hextets of+ (a:b:c:d:hs) -> Just ([a,b,c,d] <> zeros <> V.fromList hs)+ _ -> Nothing+ E -> case V.toList hextets of+ (a:b:c:d:e:hs) -> Just ([a,b,c,d,e] <> zeros <> V.fromList hs)+ _ -> Nothing+ F -> case V.toList hextets of+ (a:b:c:d:e:f:hs) -> Just ([a,b,c,d,e,f] <> zeros <> V.fromList hs)+ _ -> Nothing+ G -> case V.toList hextets of+ (a:b:c:d:e:f:g:hs) -> Just ([a,b,c,d,e,f,g] <> zeros <> V.fromList hs)+ _ -> Nothing+ Finished -> case V.toList hextets of+ (a:b:c:d:e:f:g:h:_) -> Just [a,b,c,d,e,f,g,h]+ _ -> Nothing+ in case V.toList <$> composite of+ Just (a:b:c:d:e:f:g:h:_) -> Just (IPv6.fromWord16s a b c d e f g h)+ _ -> Nothing+ ipv6 :: Parser IPv6 ipv6 = do- a <- hexadecimal- void $ char ':'- b <- hexadecimal- void $ char ':'- c <- hexadecimal- void $ char ':'- d <- hexadecimal- void $ char ':'- (e,f,g,h) <- do- let anotherColon = do- void $ char ':'- pure (0,0,0,0)- moreChunks = do- e' <- hexadecimal- void $ char ':'- f' <- hexadecimal- void $ char ':'- g' <- hexadecimal- void $ char ':'- h' <- hexadecimal- pure (e',f',g',h')- anotherColon <|> moreChunks- pure (IPv6.fromWord16s a b c d e f g h)+ s <- parseHextets+ case toIPv6 s of+ Nothing -> fail "Not an IPv6"+ Just x -> pure x+ where+ toIPv6 :: [IPv6Chunk] -> Maybe IPv6+ toIPv6 = ipv6StateToIPv6 . accumIPv6State
test/Spec.hs view
@@ -1,2 +1,34 @@+import Data.Attoparsec.IP (ipv4, ipv6)+import qualified Net.IPv4 as IPv4+import qualified Net.IPv6 as IPv6++import Data.Text (Text)+import Data.Attoparsec.Text (Parser, parseOnly)+import Test.Tasty (testGroup, defaultMain)+import Test.QuickCheck (Arbitrary (..))+import qualified Test.Tasty.QuickCheck as Q+import Test.QuickCheck.Property (Result, succeeded, failed)+++instance Arbitrary IPv4.IPv4 where+ arbitrary = IPv4.ipv4 <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary++instance Arbitrary IPv6.IPv6 where+ arbitrary = IPv6.ipv6 <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary+ <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary+++ main :: IO ()-main = putStrLn "Test suite not yet implemented"+main = defaultMain $ testGroup "IP tests"+ [ Q.testProperty "IPv4" (parsePrintIso IPv4.encode ipv4)+ , Q.testProperty "IPv6" (parsePrintIso IPv6.encode ipv6)+ ]+++parsePrintIso :: Eq a => (a -> Text) -> Parser a -> a -> Result+parsePrintIso print' parser x = case parseOnly parser (print' x) of+ Left _ -> failed+ Right y+ | y == x -> succeeded+ | otherwise -> failed