asif 4.1.0 → 5.0.0

raw patch · 7 files changed

+166/−54 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• asif.cabal +1/−1
• src/Arbor/File/Format/Asif/Data/Ip.hs +51/−18
• src/Arbor/File/Format/Asif/Format/SegmentValue.hs +21/−3
• src/Arbor/File/Format/Asif/Format/Text.hs +3/−5
• src/Arbor/File/Format/Asif/Format/Type.hs +3/−1
• src/Arbor/File/Format/Asif/Write.hs +36/−12
• test/Arbor/File/Format/Asif/WriteSpec.hs +51/−14

@@ -1,5 +1,5 @@ name:           asif-version:        4.1.0+version:        5.0.0 description:    Library for creating and querying segmented feeds. Please see <https://github.com/packetloop/asif#readme> synopsis:       Library for creating and querying segmented feeds category:       Services

@@ -2,7 +2,12 @@   ( stringToIpv4   , stringToIpv6   , ipv4ToString+  , ipv4CidrToString+  , isIpv4   , ipv6ToString+  , ipv6toStringCollapseV4+  , ipv6CidrToString+  , ipv6CidrToStringCollapseV4   , word32ToIpv4   , word32x4ToIpv6   , ipv4ToWord32@@ -11,36 +16,64 @@   ) where  import Arbor.File.Format.Asif.Data.Read-import Data.IP+import Control.Lens                     ((&)) import Data.Word-import System.Endian import Text.Read -stringToIpv4 :: String -> Maybe IPv4+import qualified HaskellWorks.Data.Network.Ip.Ipv4 as IP4+import qualified HaskellWorks.Data.Network.Ip.Ipv6 as IP6++stringToIpv4 :: String -> Maybe IP4.IpAddress stringToIpv4 str = if '.' `elem` str   then readMaybe str   else word32ToIpv4 <$> stringToAnyDigits str -stringToIpv6 :: String -> Maybe IPv6+stringToIpv6 :: String -> Maybe IP6.IpAddress stringToIpv6 = readMaybe -ipv4ToString :: IPv4 -> String-ipv4ToString = show+ipv4ToString :: IP4.IpAddress -> String+ipv4ToString = IP4.showIpAddress -ipv6ToString :: IPv6 -> String-ipv6ToString = show+ipv4CidrToString :: IP4.IpBlock v -> String+ipv4CidrToString = show -word32ToIpv4 :: Word32 -> IPv4-word32ToIpv4 = fromHostAddress . toBE32+isIpv4 :: IP6.IpAddress -> Maybe IP4.IpAddress+isIpv4 ip =+  let (a, b, c, d) = ipv6ToWord32x4 ip+  in if a == 0 && b == 0 && c == 0xFFFF+    then Just $ IP4.IpAddress d+    else Nothing -word32x4ToIpv6 :: (Word32, Word32, Word32, Word32) -> IPv6-word32x4ToIpv6 = fromHostAddress6+ipv6ToString :: IP6.IpAddress -> String+ipv6ToString = IP6.showIpAddress -ipv4ToWord32 :: IPv4 -> Word32-ipv4ToWord32 = fromBE32 . toHostAddress+ipv6toStringCollapseV4 :: IP6.IpAddress -> String+ipv6toStringCollapseV4 ip+  = case isIpv4 ip of+    Just d -> d & ipv4ToString+    _      -> ip & ipv6ToString -ipv6ToWord32x4 :: IPv6 -> (Word32, Word32, Word32, Word32)-ipv6ToWord32x4 = toHostAddress6+ipv6CidrToString :: IP6.IpBlock v -> String+ipv6CidrToString = show -ipv4ToIpv6 :: IPv4 -> IPv6-ipv4ToIpv6 = ipv4ToIPv6+ipv6CidrToStringCollapseV4 :: IP6.IpBlock v -> String+ipv6CidrToStringCollapseV4 block =+  let IP6.IpBlock ip (IP6.IpNetMask m) = block+  in case isIpv4 ip of+    Just d  -> ipv4CidrToString $ IP4.IpBlock d (IP4.IpNetMask m)+    Nothing -> ipv6CidrToString block++word32ToIpv4 :: Word32 -> IP4.IpAddress+word32ToIpv4 = IP4.IpAddress++word32x4ToIpv6 :: (Word32, Word32, Word32, Word32) -> IP6.IpAddress+word32x4ToIpv6 = IP6.IpAddress++ipv4ToWord32 :: IP4.IpAddress -> Word32+ipv4ToWord32 = IP4.word++ipv6ToWord32x4 :: IP6.IpAddress -> (Word32, Word32, Word32, Word32)+ipv6ToWord32x4 (IP6.IpAddress w128) = w128++ipv4ToIpv6 :: IP4.IpAddress -> IP6.IpAddress+ipv4ToIpv6 = IP6.fromIpv4

@@ -19,20 +19,24 @@ import qualified Data.ByteString.Lazy.Char8             as LBSC import           Data.Generics.Product.Any import           Data.Int-import           Data.IP import           Data.Semigroup                         ((<>)) import qualified Data.Text                              as T import           Data.Thyme.Time.Core import           Data.Word import           GHC.Generics                           (Generic)+import qualified HaskellWorks.Data.Network.Ip.Ipv4      as IP4+import qualified HaskellWorks.Data.Network.Ip.Ipv6      as IP6+import           HaskellWorks.Data.Network.Ip.Validity  data SegmentValue   = SString LBS.ByteString   | SBool Bool   | SChar Char   | STime UTCTime-  | SIpv4 IPv4-  | SIpv6 IPv6+  | SIpv4 IP4.IpAddress+  | SIpv6 IP6.IpAddress+  | SIpv4Block (IP4.IpBlock Canonical)+  | SIpv6Block (IP6.IpBlock Canonical)   | SInt64 Int64   | SInt32 Int32   | SInt16 Int16@@ -57,6 +61,12 @@   d <- G.getWord32be   return (a, b, c, d) +getWord40 :: G.Get (Word32, Word8)+getWord40 = (,) <$> G.getWord32le <*> G.getWord8++getWord136 :: G.Get ((Word32, Word32, Word32, Word32), Word8)+getWord136 = (,) <$> getWord32x4 <*> G.getWord8+ getValues :: Int64 -> G.Get a -> LBSC.ByteString -> [a] getValues n f bs =   let getValue bs' = G.runGet f (LBS.take n (bs' <> LBS.replicate n 0))@@ -90,6 +100,14 @@      F.Ipv6 -> whenNonEmpty bs $       bs & getValues 16 getWord32x4 <&> (SIpv6 . word32x4ToIpv6)++    F.Ipv4Block -> whenNonEmpty bs $+      let toIpBlock (w32,w8) = IP4.IpBlock (IP4.IpAddress w32) (IP4.IpNetMask w8)+      in bs & getValues 5 getWord40 <&> (SIpv4Block . toIpBlock)++    F.Ipv6Block -> whenNonEmpty bs $+      let toIpBlock (w128,w8) = IP6.IpBlock (IP6.IpAddress w128) (IP6.IpNetMask w8)+      in bs & getValues 17 getWord136 <&> (SIpv6Block . toIpBlock)      F.Int64LE -> whenNonEmpty bs $       bs & getValues 8 G.getInt64le <&> SInt64

@@ -24,10 +24,9 @@   STime v -> T.pack $ show v    SIpv4 v -> T.pack $ ipv4ToString v-  SIpv6 v ->-    case ipv6ToWord32x4 v of-      (a, b, c, d) | a == 0 && b == 0 && c == 0xFFFF -> d & word32ToIpv4 & ipv4ToString & T.pack-      _ -> T.pack $ ipv6ToString v+  SIpv6 v -> T.pack $ ipv6toStringCollapseV4 v+  SIpv4Block v -> T.pack $ ipv4CidrToString v+  SIpv6Block v -> T.pack $ ipv6CidrToStringCollapseV4 v    SInt64 v -> T.pack $ show v   SInt32 v -> T.pack $ show v@@ -48,7 +47,6 @@   SList vs -> vs <&> segmentValueToText & T.intercalate ","    SUnknown _ v -> LBS.chunkBy 4 v <&> toHex & L.intersperse " " & mconcat-  toHex :: LBS.ByteString -> Text toHex bs =

@@ -3,7 +3,7 @@ module Arbor.File.Format.Asif.Format.Type where -import           GHC.Generics+import GHC.Generics  data Format   = Binary@@ -17,6 +17,8 @@   | Int64LE   | Ipv4   | Ipv6+  | Ipv4Block+  | Ipv6Block   | Repeat Word Format   | StringZ   | Text

@@ -32,6 +32,8 @@   , int64Segment   , ipv4Segment   , ipv6Segment+  , ipv4BlockSegment+  , ipv6BlockSegment   , utcTimeMicrosSegment    -- * Utility functions@@ -56,18 +58,20 @@ import Data.Profunctor                           (lmap) import Data.Semigroup                            ((<>)) import Data.Word+import HaskellWorks.Data.Network.Ip.Validity     (Canonical (..)) import System.IO                                 (Handle, hFlush) import System.IO.Temp                            (openTempFile) -import qualified Arbor.File.Format.Asif.Format as F-import qualified Data.ByteString               as BS-import qualified Data.ByteString.Builder       as BB-import qualified Data.ByteString.Lazy          as LBS-import qualified Data.IP                       as IP-import qualified Data.Text                     as T-import qualified Data.Text.Encoding            as T-import qualified Data.Text.Lazy                as TL-import qualified Data.Text.Lazy.Encoding       as TE+import qualified Arbor.File.Format.Asif.Format     as F+import qualified Data.ByteString                   as BS+import qualified Data.ByteString.Builder           as BB+import qualified Data.ByteString.Lazy              as LBS+import qualified Data.Text                         as T+import qualified Data.Text.Encoding                as T+import qualified Data.Text.Lazy                    as TL+import qualified Data.Text.Lazy.Encoding           as TE+import qualified HaskellWorks.Data.Network.Ip.Ipv4 as IP4+import qualified HaskellWorks.Data.Network.Ip.Ipv6 as IP6  import qualified Data.Thyme.Clock.POSIX as TY import qualified Data.Thyme.Time.Core   as TY@@ -206,18 +210,31 @@ -----  -- | Builds a segment of 'IPv4's.-ipv4Segment :: MonadResource m => (a -> IP.IPv4) -> T.Text -> FoldM m a [Segment Handle]+ipv4Segment :: MonadResource m => (a -> IP4.IpAddress) -> T.Text -> FoldM m a [Segment Handle] ipv4Segment f = genericFold BB.word32LE (Known F.Ipv4) (ipv4ToWord32 . f)  -- | Builds a segment of 'IPv6's.-ipv6Segment :: MonadResource m => (a -> IP.IPv6) -> T.Text -> FoldM m a [Segment Handle]+ipv6Segment :: MonadResource m => (a -> IP6.IpAddress) -> T.Text -> FoldM m a [Segment Handle] ipv6Segment f = genericFold encoding (Known F.Ipv6) extract     where       -- I do not know why this is Big-Endian, when everything else is Little-Endian.       encoding = Prelude.foldMap BB.word32BE       extract = tupleToList . ipv6ToWord32x4 . f-      tupleToList (w1,w2,w3,w4) = [w1,w2,w3,w4] +-- | Builds a segment of IPv4 CIDR blocks+ipv4BlockSegment :: MonadResource m => (a -> IP4.IpBlock Canonical) -> T.Text -> FoldM m a [Segment Handle]+ipv4BlockSegment = genericFold encoding (Known F.Ipv4Block)+    where+      encoding (IP4.IpBlock (IP4.IpAddress ip) (IP4.IpNetMask block)) = BB.word32LE ip <> BB.word8 block++-- | Builds a segment of IPv6 CIDR blocks+ipv6BlockSegment :: MonadResource m => (a -> IP6.IpBlock Canonical) -> T.Text -> FoldM m a [Segment Handle]+ipv6BlockSegment = genericFold encoding (Known F.Ipv6Block)+    where+      encoding (IP6.IpBlock ip (IP6.IpNetMask block)) =+        let extract = Prelude.foldMap BB.word32BE . tupleToList . ipv6ToWord32x4+        in extract ip <> BB.word8 block+ -----  -- | Builds a segment of 'UTCTime's, accurate to microseconds.@@ -248,3 +265,10 @@  genericFold :: MonadResource m =>  (a -> BB.Builder) -> Whatever F.Format -> (b -> a) -> T.Text -> FoldM m b [Segment Handle] genericFold enc fmt f t = lmap f $ FoldM (genericStep enc) (genericInitial t) (genericExtract t fmt)++-------------------------------------------------------------------------------++-- Private++tupleToList :: (a,a,a,a) -> [a]+tupleToList (w1,w2,w3,w4) = [w1,w2,w3,w4]

@@ -4,27 +4,29 @@ import Arbor.File.Format.Asif.Format import Arbor.File.Format.Asif.Segment import Arbor.File.Format.Asif.Write-import Control.Monad.IO.Class         (liftIO)+import Control.Monad.IO.Class                (liftIO) import Control.Monad.Trans.Class import Control.Monad.Trans.Resource import Data.Int-import Data.Semigroup                 ((<>))+import Data.Semigroup                        ((<>)) import Data.Word-import System.IO.Temp                 (openBinaryTempFile)+import HaskellWorks.Data.Network.Ip.Validity (Canonical)+import System.IO.Temp                        (openBinaryTempFile)  import HaskellWorks.Hspec.Hedgehog import Hedgehog import Test.Hspec -import qualified Data.Attoparsec.ByteString as AP-import qualified Data.ByteString.Lazy       as LBS-import qualified Data.IP                    as IP-import qualified Data.Text.Lazy             as T-import qualified Data.Text.Lazy.Encoding    as T-import qualified Data.Thyme.Clock.POSIX     as TY-import qualified Data.Thyme.Time.Core       as TY-import qualified Hedgehog.Gen               as G-import qualified Hedgehog.Range             as R+import qualified Data.Attoparsec.ByteString        as AP+import qualified Data.ByteString.Lazy              as LBS+import qualified Data.Text.Lazy                    as T+import qualified Data.Text.Lazy.Encoding           as T+import qualified Data.Thyme.Clock.POSIX            as TY+import qualified Data.Thyme.Time.Core              as TY+import qualified HaskellWorks.Data.Network.Ip.Ipv4 as IP4+import qualified HaskellWorks.Data.Network.Ip.Ipv6 as IP6+import qualified Hedgehog.Gen                      as G+import qualified Hedgehog.Range                    as R  import qualified System.IO as IO @@ -169,7 +171,7 @@ -----    it "should write out and read back in a ipv4 segment" $ require $ property $ do-    lst <- forAll $ G.list (R.linear 0 50) (word32ToIpv4 <$> G.word32 R.linearBounded)+    lst <- forAll $ G.list (R.linear 0 50) genIpv4      lbs <- asifContent "wxyz" Nothing (ipv4Segment id "ipv4") lst @@ -188,6 +190,26 @@      (SIpv6 <$> lst) === seg +  it "should write out and read back in a ipv4 block segment" $ require $ property $ do+    lst <- forAll $ G.list (R.linear 0 50) genIpv4Block++    lbs <- asifContent "wxyz" Nothing (ipv4BlockSegment id "ipv4Block") lst++    let Right segments = extractSegments (AP.string "seg:wxyz") lbs+    [names, times, types, seg] <- forAll $ pure (segmentValues <$> segments)++    (SIpv4Block <$> lst) === seg++  it "should write out and read back in a ipv6 block segment" $ require $ property $ do+    lst <- forAll $ G.list (R.linear 0 50) genIpv6Block++    lbs <- asifContent "wxyz" Nothing (ipv6BlockSegment id "ipv6Block") lst++    let Right segments = extractSegments (AP.string "seg:wxyz") lbs+    [names, times, types, seg] <- forAll $ pure (segmentValues <$> segments)++    (SIpv6Block <$> lst) === seg+ -----    it "should write out and read back in a time segment" $ require $ property $ do@@ -240,13 +262,28 @@   <*> G.word16 R.linearBounded   <*> genNonNullText -genIpv6 :: MonadGen m => m IP.IPv6+genIpv4 :: MonadGen m => m IP4.IpAddress+genIpv4 = word32ToIpv4 <$> G.word32 R.linearBounded++genIpv6 :: MonadGen m => m IP6.IpAddress genIpv6 = word32x4ToIpv6 <$> gen4   where     gen4 :: MonadGen m => m (Word32, Word32, Word32, Word32)     gen4 =       let g = G.word32 R.linearBounded       in (,,,) <$> g <*> g <*> g <*> g++genIpv4Block :: MonadGen m => m (IP4.IpBlock Canonical)+genIpv4Block = do+  ip <- genIpv4+  mask <- IP4.IpNetMask <$> G.word8 (R.linear 0 32)+  pure . IP4.canonicaliseIpBlock $ IP4.IpBlock ip mask++genIpv6Block :: MonadGen m => m (IP6.IpBlock Canonical)+genIpv6Block = do+  ip <- genIpv6+  mask <- IP6.IpNetMask <$> G.word8 (R.linear 0 128)+  pure . IP6.canonicaliseIpBlock $ IP6.IpBlock ip mask  genNonNullText :: MonadGen m => m T.Text genNonNullText =