diff --git a/Data/IP/Addr.hs b/Data/IP/Addr.hs --- a/Data/IP/Addr.hs +++ b/Data/IP/Addr.hs @@ -500,17 +500,30 @@ in if n' <= 255 then f n' else Nothing ip4 :: Parser IPv4 -ip4 = skipSpaces >> toIPv4 <$> ip4' +ip4 = skipSpaces >> toIPv4 <$> ip4' True -ip4' :: Parser [Int] -ip4' = do - as <- octet `sepBy1` char '.' - when (length as /= 4) (fail "IPv4 address") +ip4' :: Bool -> Parser [Int] +ip4' checkTermination = do + a0 <- octet + _ <- char '.' + a1 <- octet + _ <- char '.' + a2 <- octet + _ <- char '.' + a3 <- octet + let as = [a0, a1, a2, a3] + skipSpaces + when checkTermination termination return as skipSpaces :: Parser () skipSpaces = void $ many (char ' ') +termination :: Parser () +termination = P $ \str -> case str of + [] -> (Just (), "") + _ -> (Nothing, str) + ---------------------------------------------------------------- -- -- IPv6 Parser (RFC 4291) @@ -562,16 +575,16 @@ ip4Embedded :: Parser [Int] ip4Embedded = try (do colon2 bs <- beforeEmbedded - embedded <- ip4' + embedded <- ip4' True format [] (bs ++ ip4ToIp6 embedded)) -- matches 2001:db8::192.0.2.1 <|> try (do bs1 <- manyTill (try $ hex <* char ':') (char ':') bs2 <- option [] beforeEmbedded - embedded <- ip4' + embedded <- ip4' True format bs1 (bs2 ++ ip4ToIp6 embedded)) -- matches 2001:db8:11e:c00:aa:bb:192.0.2.1 <|> try (do bs <- beforeEmbedded - embedded <- ip4' + embedded <- ip4' True let rs = bs ++ ip4ToIp6 embedded check rs return rs) diff --git a/Data/IP/Range.hs b/Data/IP/Range.hs --- a/Data/IP/Range.hs +++ b/Data/IP/Range.hs @@ -118,7 +118,8 @@ ip4range :: Parser (AddrRange IPv4) ip4range = do - ip <- ip4 + skipSpaces + ip <- toIPv4 <$> ip4' False len <- maskLen 32 let msk = maskIPv4 len adr = ip `maskedIPv4` msk diff --git a/Data/IP/RouteTable/Internal.hs b/Data/IP/RouteTable/Internal.hs --- a/Data/IP/RouteTable/Internal.hs +++ b/Data/IP/RouteTable/Internal.hs @@ -27,6 +27,9 @@ import GHC.Generics (Generic, Generic1) import Prelude hiding (lookup) +-- $setup +-- >>> :set -XOverloadedStrings + ---------------------------------------------------------------- {-| diff --git a/iproute.cabal b/iproute.cabal --- a/iproute.cabal +++ b/iproute.cabal @@ -1,85 +1,83 @@ -Name: iproute -Version: 1.7.12 -Author: Kazu Yamamoto -Maintainer: Kazu Yamamoto -License: BSD3 -License-File: LICENSE -Homepage: http://www.mew.org/~kazu/proj/iproute/ -Synopsis: IP Routing Table -Description: IP Routing Table is a tree of IP ranges - to search one of them on the longest - match base. It is a kind of TRIE with one - way branching removed. Both IPv4 and IPv6 - are supported. -Category: Algorithms, Network -Cabal-Version: >= 1.10 -Build-Type: Simple -Tested-With: GHC == 7.8.4 - , GHC == 7.10.3 - , GHC == 8.0.2 - , GHC == 8.2.2 - , GHC == 8.4.4 - , GHC == 8.6.5 - , GHC == 8.8.2 +cabal-version: >=1.10 +name: iproute +version: 1.7.13 +license: BSD3 +license-file: LICENSE +maintainer: Kazu Yamamoto +author: Kazu Yamamoto +tested-with: + ghc ==7.8.4 ghc ==7.10.3 ghc ==8.0.2 ghc ==8.2.2 ghc ==8.4.4 + ghc ==8.6.5 ghc ==8.8.2 -Library - Default-Language: Haskell2010 - GHC-Options: -Wall - Exposed-Modules: Data.IP - Data.IP.Builder - Data.IP.Internal - Data.IP.RouteTable - Data.IP.RouteTable.Internal - Other-Modules: Data.IP.Addr - Data.IP.Mask - Data.IP.Op - Data.IP.Range - Build-Depends: base >= 4.9 && < 5 - , appar - , byteorder - , bytestring - , containers - , network - if impl(ghc < 8.0) - Build-Depends: semigroups >= 0.17 - if impl(ghc >= 8) - Default-Extensions: Strict StrictData +homepage: http://www.mew.org/~kazu/proj/iproute/ +synopsis: IP Routing Table +description: + IP Routing Table is a tree of IP ranges + to search one of them on the longest + match base. It is a kind of TRIE with one + way branching removed. Both IPv4 and IPv6 + are supported. -Test-Suite doctest - Type: exitcode-stdio-1.0 - Default-Language: Haskell2010 - HS-Source-Dirs: test - Ghc-Options: -threaded -Wall - Main-Is: doctests.hs - Build-Depends: base >= 4.6 && < 5 - , doctest >= 0.9.3 - , appar - , byteorder - , bytestring - , network +category: Algorithms, Network +build-type: Simple -Test-Suite spec - Type: exitcode-stdio-1.0 - Default-Language: Haskell2010 - Hs-Source-Dirs: test - Ghc-Options: -Wall - Main-Is: Spec.hs - Other-Modules: RouteTableSpec - , BuilderSpec - , IPSpec - Build-Depends: base >= 4.6 && < 5 - , hspec - , QuickCheck - , appar - , byteorder - , bytestring - , containers - , network - , safe - , iproute - if impl(ghc < 8.0) - Build-Depends: semigroups >= 0.17 +source-repository head + type: git + location: git://github.com/kazu-yamamoto/iproute.git -Source-Repository head - Type: git - Location: git://github.com/kazu-yamamoto/iproute.git +library + exposed-modules: + Data.IP + Data.IP.Builder + Data.IP.Internal + Data.IP.RouteTable + Data.IP.RouteTable.Internal + + other-modules: + Data.IP.Addr + Data.IP.Mask + Data.IP.Op + Data.IP.Range + + default-language: Haskell2010 + ghc-options: -Wall + build-depends: + base >=4.9 && <5, + appar, + byteorder, + bytestring, + containers, + network + + if impl(ghc <8.0) + build-depends: semigroups >=0.17 + + if impl(ghc >=8) + default-extensions: Strict StrictData + +test-suite spec + type: exitcode-stdio-1.0 + main-is: Spec.hs + build-tool-depends: hspec-discover:hspec-discover + hs-source-dirs: test + other-modules: + RouteTableSpec + BuilderSpec + IPSpec + + default-language: Haskell2010 + ghc-options: -Wall + build-depends: + base >=4.6 && <5, + hspec, + QuickCheck, + appar, + byteorder, + bytestring, + containers, + network, + safe, + iproute + + if impl(ghc <8.0) + build-depends: semigroups >=0.17 diff --git a/test/IPSpec.hs b/test/IPSpec.hs --- a/test/IPSpec.hs +++ b/test/IPSpec.hs @@ -23,7 +23,13 @@ data InvalidIPv4Str = Iv4 String deriving (Show) instance Arbitrary InvalidIPv4Str where - arbitrary = arbitraryIIPv4Str arbitrary 32 + arbitrary = + frequency [(9, arbitraryIIPv4Str arbitrary 32) + ,(1, Iv4 . (++ ".") . show <$> genIPv4) + ] + where + genIPv4 :: Gen IPv4 + genIPv4 = arbitrary arbitraryIIPv4Str :: Gen IPv4 -> Int -> Gen InvalidIPv4Str arbitraryIIPv4Str adrGen msklen = toIv4 <$> adrGen <*> lenGen diff --git a/test/doctests.hs b/test/doctests.hs deleted file mode 100644 --- a/test/doctests.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Main where - -import Test.DocTest - -main :: IO () -main = doctest [ "-XOverloadedStrings" - , "-package=appar" - , "-package=byteorder" - , "-package=network" - , "Data/IP.hs" - , "Data/IP/RouteTable.hs"]