diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Author name here (c) 2017 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,4 @@ +# hw-ip +[![CircleCI](https://circleci.com/gh/haskell-works/hw-ip.svg?style=svg)](https://circleci.com/gh/haskell-works/hw-ip) + +Library for manipulating IP addresses and CIDR blocks. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/hw-ip.cabal b/hw-ip.cabal new file mode 100644 --- /dev/null +++ b/hw-ip.cabal @@ -0,0 +1,55 @@ +-- This file has been generated from package.yaml by hpack version 0.20.0. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 0e009dc6f8e47e478d23c2015665d88494848c9a86e5c1b03550fe2351cda87e + +name: hw-ip +version: 0.1.0.0 +synopsis: Library for manipulating IP addresses and CIDR blocks +description: Please see README.md +category: Network +homepage: https://github.com/haskell-works/hw-ip#readme +bug-reports: https://github.com/haskell-works/hw-ip/issues +author: John +maintainer: newhoggy@gmail.com +copyright: 2017 John Ky +license: BSD3 +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 + +extra-source-files: + README.md + +source-repository head + type: git + location: https://github.com/haskell-works/hw-ip + +library + hs-source-dirs: + src + build-depends: + base >=4.7 && <5 + exposed-modules: + HaskellWorks.Data.Network.Ip + other-modules: + Paths_hw_ip + default-language: Haskell2010 + +test-suite hw-ip-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: + test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + base + , hedgehog + , hspec + , hw-hspec-hedgehog + , hw-ip + other-modules: + HaskellWorks.Data.Network.IpSpec + Paths_hw_ip + default-language: Haskell2010 diff --git a/src/HaskellWorks/Data/Network/Ip.hs b/src/HaskellWorks/Data/Network/Ip.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/Network/Ip.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module HaskellWorks.Data.Network.Ip + ( Ipv4Address(..) + , Ipv4NetMask(..) + , Ipv4Block(..) + , bitPower + , blockSize + , isCanonical + , splitBlock + ) where + +import Data.Bits +import Data.Word + +newtype Ipv4Address = Ipv4Address + { unIpv4Address :: Word32 + } deriving (Enum, Eq, Ord) + +instance Show Ipv4Address where + showsPrec _ (Ipv4Address w) = + shows ((w `shiftR` 24) .&. 0xff) . ('.':) . + shows ((w `shiftR` 16) .&. 0xff) . ('.':) . + shows ((w `shiftR` 8) .&. 0xff) . ('.':) . + shows ( w .&. 0xff) + +newtype Ipv4NetMask = Ipv4NetMask + { unIpv4NetMask :: Word8 + } deriving (Enum, Eq, Ord, Show) + +data Ipv4Block = Ipv4Block + { ipv4BlockBase :: Ipv4Address + , ipv4BlockMask :: Ipv4NetMask + } deriving (Eq, Ord) + +instance Show Ipv4Block where + showsPrec _ (Ipv4Block b (Ipv4NetMask m)) = shows b . ('/':) . shows m + +bitPower :: Ipv4NetMask -> Int +bitPower (Ipv4NetMask m) = fromIntegral (32 - m) + +isCanonical :: Ipv4Block -> Bool +isCanonical (Ipv4Block (Ipv4Address b) m) = ((b `shiftR` bitPower m) `shiftL` bitPower m) == b + +splitBlock :: Ipv4Block -> Maybe (Ipv4Block, Ipv4Block) +splitBlock (Ipv4Block (Ipv4Address b) (Ipv4NetMask m)) = + if m >= 0 && m < 32 + then let !hm = m + 1 + !halfMask = Ipv4NetMask hm + !c = fromIntegral ((0x100000000 :: Word64) `shiftR` fromIntegral (m + 1)) + in Just + ( Ipv4Block (Ipv4Address b ) halfMask + , Ipv4Block (Ipv4Address (b + c)) halfMask + ) + else Nothing + +blockSize :: Ipv4Block -> Int +blockSize (Ipv4Block _ m) = 2 ^ bitPower m diff --git a/test/HaskellWorks/Data/Network/IpSpec.hs b/test/HaskellWorks/Data/Network/IpSpec.hs new file mode 100644 --- /dev/null +++ b/test/HaskellWorks/Data/Network/IpSpec.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE OverloadedStrings #-} + +module HaskellWorks.Data.Network.IpSpec (spec) where + +import HaskellWorks.Data.Network.Ip +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} + +spec :: Spec +spec = describe "HaskellWorks.HUnit.IpSpec" $ do + describe "Ipv4Address" $ do + it "should implement show" $ require $ property $ do + show (Ipv4Address 0x000000ff) === "0.0.0.255" + show (Ipv4Address 0x0000ff00) === "0.0.255.0" + show (Ipv4Address 0x00ff0000) === "0.255.0.0" + show (Ipv4Address 0xff000000) === "255.0.0.0" + describe "Ipv4Block" $ do + it "should implement show" $ require $ property $ do + show (Ipv4Block (Ipv4Address 0x000000ff) (Ipv4NetMask 32)) === "0.0.0.255/32" + show (Ipv4Block (Ipv4Address 0x0000ff00) (Ipv4NetMask 32)) === "0.0.255.0/32" + show (Ipv4Block (Ipv4Address 0x00ff0000) (Ipv4NetMask 32)) === "0.255.0.0/32" + show (Ipv4Block (Ipv4Address 0xff000000) (Ipv4NetMask 32)) === "255.0.0.0/32" + show (Ipv4Block (Ipv4Address 0x000000ff) (Ipv4NetMask 16)) === "0.0.0.255/16" + show (Ipv4Block (Ipv4Address 0x0000ff00) (Ipv4NetMask 16)) === "0.0.255.0/16" + show (Ipv4Block (Ipv4Address 0x00ff0000) (Ipv4NetMask 16)) === "0.255.0.0/16" + show (Ipv4Block (Ipv4Address 0xff000000) (Ipv4NetMask 16)) === "255.0.0.0/16" + it "should implement splitBlock" $ require $ property $ do + splitBlock (Ipv4Block (Ipv4Address 0x00000000) (Ipv4NetMask 32)) === Nothing + splitBlock (Ipv4Block (Ipv4Address 0x00000000) (Ipv4NetMask 31)) === Just (Ipv4Block (Ipv4Address 0x00000000) (Ipv4NetMask 32), Ipv4Block (Ipv4Address 0x00000001) (Ipv4NetMask 32)) + splitBlock (Ipv4Block (Ipv4Address 0x00000000) (Ipv4NetMask 30)) === Just (Ipv4Block (Ipv4Address 0x00000000) (Ipv4NetMask 31), Ipv4Block (Ipv4Address 0x00000002) (Ipv4NetMask 31)) + splitBlock (Ipv4Block (Ipv4Address 0x00000000) (Ipv4NetMask 0)) === Just (Ipv4Block (Ipv4Address 0x00000000) (Ipv4NetMask 1), Ipv4Block (Ipv4Address 0x80000000) (Ipv4NetMask 1)) + it "should implement blockSize" $ require $ property $ do + blockSize (Ipv4Block (Ipv4Address 0x00000000) (Ipv4NetMask 32)) === 1 + blockSize (Ipv4Block (Ipv4Address 0x00000000) (Ipv4NetMask 0)) === 0x100000000 diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}