asif 3.4.0 → 4.0.0

raw patch · 4 files changed

+147/−108 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• asif.cabal +63/−59
• src/Arbor/File/Format/Asif/ByteString/Builder.hs +17/−20
• src/Arbor/File/Format/Asif/Write.hs +25/−13
• test/Arbor/File/Format/Asif/WriteSpec.hs +42/−16

@@ -1,9 +1,13 @@--- This file has been generated from package.yaml by hpack version 0.18.1.+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.1. -- -- see: https://github.com/sol/hpack+--+-- hash: c7f6880e469ae305df5407eec0ebfc06d81e68830ba46005a1752adb58472ef6  name:           asif-version:        3.4.0+version:        4.0.0 description:    Please see the README on Github at <https://github.com/packetloop/asif#readme> category:       Services homepage:       https://github.com/packetloop/asif#readme@@ -14,48 +18,15 @@ license:        MIT license-file:   LICENSE build-type:     Simple-cabal-version:  >= 1.10- extra-source-files:-    ChangeLog.md     README.md+    ChangeLog.md  source-repository head   type: git   location: https://github.com/packetloop/asif  library-  hs-source-dirs:-      src-  default-extensions: BangPatterns FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving MultiParamTypeClasses OverloadedStrings TupleSections-  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints-  build-depends:-      base >= 4.7 && < 5-    , attoparsec-    , binary-    , bytestring-    , conduit-    , conduit-combinators-    , conduit-extra-    , containers-    , cpu-    , either-    , exceptions-    , foldl-    , generic-lens-    , hw-bits-    , hw-ip-    , iproute-    , lens-    , network-    , old-locale-    , profunctors-    , resourcet-    , temporary-resourcet-    , text-    , thyme-    , transformers-    , vector   exposed-modules:       Arbor.File.Format.Asif       Arbor.File.Format.Asif.ByIndex@@ -81,17 +52,13 @@       Arbor.File.Format.Asif.Maybe       Arbor.File.Format.Asif.Text       Paths_asif-  default-language: Haskell2010--executable asif-  main-is: Main.hs   hs-source-dirs:-      app+      src   default-extensions: BangPatterns FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving MultiParamTypeClasses OverloadedStrings TupleSections-  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -threaded -rtsopts -O2 -msse4.2+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints   build-depends:-      base >= 4.7 && < 5-    , attoparsec+      attoparsec+    , base >=4.7 && <5     , binary     , bytestring     , conduit@@ -116,9 +83,10 @@     , thyme     , transformers     , vector-    , asif-    , directory-    , optparse-applicative+  default-language: Haskell2010++executable asif+  main-is: Main.hs   other-modules:       App.Commands       App.Commands.Dump@@ -131,18 +99,15 @@       App.Commands.Options.Type       App.Dump       App.IO-  default-language: Haskell2010--test-suite asif-test-  type: exitcode-stdio-1.0-  main-is: Spec.hs+      Paths_asif   hs-source-dirs:-      test+      app   default-extensions: BangPatterns FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving MultiParamTypeClasses OverloadedStrings TupleSections-  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -threaded -rtsopts -O2 -msse4.2   build-depends:-      base >= 4.7 && < 5+      asif     , attoparsec+    , base >=4.7 && <5     , binary     , bytestring     , conduit@@ -150,6 +115,7 @@     , conduit-extra     , containers     , cpu+    , directory     , either     , exceptions     , foldl@@ -160,6 +126,7 @@     , lens     , network     , old-locale+    , optparse-applicative     , profunctors     , resourcet     , temporary-resourcet@@ -167,10 +134,11 @@     , thyme     , transformers     , vector-    , asif-    , hspec-    , hedgehog-    , hw-hspec-hedgehog+  default-language: Haskell2010++test-suite asif-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs   other-modules:       Arbor.File.Format.Asif.ByteString.BuilderSpec       Arbor.File.Format.Asif.Data.IpSpec@@ -181,4 +149,40 @@       Arbor.TestUtils       Gen.Feed       TestApp+      Paths_asif+  hs-source-dirs:+      test+  default-extensions: BangPatterns FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving MultiParamTypeClasses OverloadedStrings TupleSections+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      asif+    , attoparsec+    , base >=4.7 && <5+    , binary+    , bytestring+    , conduit+    , conduit-combinators+    , conduit-extra+    , containers+    , cpu+    , either+    , exceptions+    , foldl+    , generic-lens+    , hedgehog+    , hspec+    , hw-bits+    , hw-hspec-hedgehog+    , hw-ip+    , iproute+    , lens+    , network+    , old-locale+    , profunctors+    , resourcet+    , temporary-resourcet+    , text+    , thyme+    , transformers+    , vector   default-language: Haskell2010

@@ -10,20 +10,20 @@   , magicLength   ) where -import           Arbor.File.Format.Asif.Whatever-import           Conduit-import           Control.Lens-import           Control.Monad-import           Data.Bits-import           Data.ByteString.Builder-import           Data.Generics.Product.Any-import           Data.Int-import           Data.Maybe-import           Data.Monoid                        ((<>))-import           Data.String-import           Data.Thyme.Clock-import           Data.Thyme.Clock.POSIX             (POSIXTime, getPOSIXTime)-import           Data.Word+import Arbor.File.Format.Asif.Whatever+import Conduit+import Control.Lens+import Control.Monad+import Data.Bits+import Data.ByteString.Builder+import Data.Generics.Product.Any+import Data.Int+import Data.Maybe+import Data.Monoid                     ((<>))+import Data.String+import Data.Thyme.Clock+import Data.Thyme.Clock.POSIX          (POSIXTime, getPOSIXTime)+import Data.Word  import qualified Arbor.File.Format.Asif.Format.Type as F import qualified Arbor.File.Format.Asif.IO          as IO@@ -90,11 +90,11 @@     sourceHandle h     CL.sourceList (replicate (fromIntegral padding) (BS.singleton 0)) -segmentsC :: (MonadIO m, MonadResource m)+segmentsC :: MonadResource m   => String   -> Maybe POSIXTime   -> [Z.Segment IO.Handle]-  -> m (ConduitT () BS.ByteString m ())+  -> ConduitT () BS.ByteString m () segmentsC asifType maybeTimestamp metas = do   fileTime <- maybe (liftIO getPOSIXTime) return maybeTimestamp   (_, _, hFilenames   ) <- IO.openTempFile Nothing "asif-filenames"@@ -111,8 +111,5 @@     liftIO $ B.hPutBuilder hFilenames   $ B.byteString (meta ^. the @"meta" . the @"filename" & fromMaybe "" & T.encodeUtf8) <> B.word8 0     liftIO $ B.hPutBuilder hCreateTimes $ B.int64LE $ (meta ^. the @"meta" . the @"createTime") <&> (^. microseconds) & fromMaybe 0     liftIO $ B.hPutBuilder hFormats     $ B.byteString (meta ^. the @"meta" . the @"format" <&> tShowWhatever & fromMaybe "" & T.encodeUtf8) <> B.word8 0-    return () -  let source = segmentsRawC asifType ((^. the @"payload") <$> moreMetas)--  return source+  segmentsRawC asifType ((^. the @"payload") <$> moreMetas)

@@ -12,7 +12,8 @@   -- * Encode an entire ASIF bytestring   -- $usage     writeAsif-  , buildAsifBytestring+  , asifContent+  , asifContentC    -- * Folds for Segments   -- $segments@@ -55,10 +56,11 @@ import Data.Profunctor                           (lmap) import Data.Semigroup                            ((<>)) import Data.Word-import System.IO                                 (Handle, SeekMode (AbsoluteSeek), hFlush, hSeek)+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@@ -81,7 +83,7 @@ -- out the constituent pieces to encode into 'Segment's. -- -- 'FoldM's are composable using '<>'. Once you have a single, provide it to--- 'writeAsif' or 'buildAsifBytestring' along with an appropriate foldable.+-- 'writeAsif' or 'asifContent' along with an appropriate foldable. -- Both these functions will stream from the input, assuming the foldable is -- something that can be streamed from. @@ -95,27 +97,37 @@   -> f a   -> m () writeAsif hOutput asifType mTimestamp fld foldable = do-  segments <- foldM fld foldable-  contents  <- segmentsC asifType mTimestamp segments-  runConduit $ contents .| sinkHandle hOutput+  runConduit+    $  asifContentC asifType mTimestamp fld foldable+    .| sinkHandle hOutput   liftIO $ hFlush hOutput + -- | Builds a lazy ASIF bytestring. -- Streams the input foldable if possible.-buildAsifBytestring :: (Foldable f, MonadResource m)+asifContent :: (Foldable f, MonadResource m)   => String   -> Maybe TY.POSIXTime   -> FoldM m a [Segment Handle]   -> f a   -> m LBS.ByteString-buildAsifBytestring asifType mTimestamp fld foldable = do-  (_, _, h) <- openTempFile Nothing "asif"-  writeAsif h asifType mTimestamp fld foldable-  liftIO $ hSeek h AbsoluteSeek 0-  liftIO $ LBS.hGetContents h+asifContent asifType mTimestamp fld foldable =+  runConduit+    $  asifContentC asifType mTimestamp fld foldable+    .| sinkLazy ------+-- | Returns ASIF content as a conduit+asifContentC :: (Foldable f, MonadResource m)+  => String+  -> Maybe TY.POSIXTime+  -> FoldM m a [Segment Handle]+  -> f a+  -> ConduitT () BS.ByteString m ()+asifContentC asifType mTimestamp fld foldable = do+  segments <- lift $ foldM fld foldable+  segmentsC asifType mTimestamp segments +---- -- $segments -- -- Use these to build 'FoldM's for the types you want to encode.

@@ -4,17 +4,20 @@ 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.Trans.Class import Control.Monad.Trans.Resource import Data.Int import Data.Semigroup                 ((<>)) import Data.Word+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@@ -23,11 +26,34 @@ import qualified Hedgehog.Gen               as G import qualified Hedgehog.Range             as R +import qualified System.IO as IO + {-# ANN module ("HLint: ignore Redundant do"  :: String) #-}  spec :: Spec spec = describe "Arbor.File.Format.Asif.Write" $ do+  it "should write file and read it back again" $ require $ property $ do+    tplList <- forAll $ G.list (R.linear 0 50) genTriple++    let fld =  int64Segment                (\(a,_,_) -> a) "first"+            <> word16Segment               (\(_,a,_) -> a) "second"+            <> nullTerminatedStringSegment (\(_,_,a) -> T.toStrict a) "third"++    (_, f, h) <- openBinaryTempFile Nothing "wtite-asif-test.asif"++    _ <- writeAsif h "wxyz" Nothing fld tplList+    liftIO $ IO.hSeek h IO.AbsoluteSeek 0++    lbs <- liftIO $ LBS.hGetContents h++    let Right segments = extractSegments (AP.string "seg:wxyz") lbs+    [names, times, types, l1,l2,l3] <- forAll $ pure (segmentValues <$> segments)++    ((\(a,_,_) -> SInt64 a) <$> tplList) === l1+    ((\(_,a,_) -> SWord16 a) <$> tplList) === l2+    ((\(_,_,a) -> SString . T.encodeUtf8 $ a) <$> tplList) === l3+   it "should write several segments, then read them back in" $ require $ property $ do     tplList <- forAll $ G.list (R.linear 0 50) genTriple @@ -36,7 +62,7 @@     let f3 = nullTerminatedStringSegment (\(_,_,a) -> T.toStrict a) "third"     let fld = f1 <> f2 <> f3 -    lbs <- buildAsifBytestring "wxyz" Nothing fld tplList+    lbs <- asifContent "wxyz" Nothing fld tplList      let Right segments = extractSegments (AP.string "seg:wxyz") lbs @@ -51,7 +77,7 @@   it "should write out and read back in a bool segment" $ require $ property $ do     lst <- forAll $ G.list (R.linear 0 50) G.bool -    lbs <- buildAsifBytestring "wxyz" Nothing (boolSegment id "bool") lst+    lbs <- asifContent "wxyz" Nothing (boolSegment id "bool") lst      let Right segments = extractSegments (AP.string "seg:wxyz") lbs     [names, times, types, seg] <- forAll $ pure (segmentValues <$> segments)@@ -61,7 +87,7 @@   it "should write out and read back in a word8 segment" $ require $ property $ do     lst <- forAll $ G.list (R.linear 0 50) (G.word8 R.linearBounded) -    lbs <- buildAsifBytestring "wxyz" Nothing (word8Segment id "word8") lst+    lbs <- asifContent "wxyz" Nothing (word8Segment id "word8") lst      let Right segments = extractSegments (AP.string "seg:wxyz") lbs     [names, times, types, seg] <- forAll $ pure (segmentValues <$> segments)@@ -71,7 +97,7 @@   it "should write out and read back in a word16 segment" $ require $ property $ do     lst <- forAll $ G.list (R.linear 0 50) (G.word16 R.linearBounded) -    lbs <- buildAsifBytestring "wxyz" Nothing (word16Segment id "word16") lst+    lbs <- asifContent "wxyz" Nothing (word16Segment id "word16") lst      let Right segments = extractSegments (AP.string "seg:wxyz") lbs     [names, times, types, seg] <- forAll $ pure (segmentValues <$> segments)@@ -81,7 +107,7 @@   it "should write out and read back in a word32 segment" $ require $ property $ do     lst <- forAll $ G.list (R.linear 0 50) (G.word32 R.linearBounded) -    lbs <- buildAsifBytestring "wxyz" Nothing (word32Segment id "word32") lst+    lbs <- asifContent "wxyz" Nothing (word32Segment id "word32") lst      let Right segments = extractSegments (AP.string "seg:wxyz") lbs     [names, times, types, seg] <- forAll $ pure (segmentValues <$> segments)@@ -91,7 +117,7 @@   it "should write out and read back in a word64 segment" $ require $ property $ do     lst <- forAll $ G.list (R.linear 0 50) (G.word64 R.linearBounded) -    lbs <- buildAsifBytestring "wxyz" Nothing (word64Segment id "word64") lst+    lbs <- asifContent "wxyz" Nothing (word64Segment id "word64") lst      let Right segments = extractSegments (AP.string "seg:wxyz") lbs     [names, times, types, seg] <- forAll $ pure (segmentValues <$> segments)@@ -103,7 +129,7 @@   it "should write out and read back in a int8 segment" $ require $ property $ do     lst <- forAll $ G.list (R.linear 0 50) (G.int8 R.linearBounded) -    lbs <- buildAsifBytestring "wxyz" Nothing (int8Segment id "int8") lst+    lbs <- asifContent "wxyz" Nothing (int8Segment id "int8") lst      let Right segments = extractSegments (AP.string "seg:wxyz") lbs     [names, times, types, seg] <- forAll $ pure (segmentValues <$> segments)@@ -113,7 +139,7 @@   it "should write out and read back in a int16 segment" $ require $ property $ do     lst <- forAll $ G.list (R.linear 0 50) (G.int16 R.linearBounded) -    lbs <- buildAsifBytestring "wxyz" Nothing (int16Segment id "int16") lst+    lbs <- asifContent "wxyz" Nothing (int16Segment id "int16") lst      let Right segments = extractSegments (AP.string "seg:wxyz") lbs     [names, times, types, seg] <- forAll $ pure (segmentValues <$> segments)@@ -123,7 +149,7 @@   it "should write out and read back in a int32 segment" $ require $ property $ do     lst <- forAll $ G.list (R.linear 0 50) (G.int32 R.linearBounded) -    lbs <- buildAsifBytestring "wxyz" Nothing (int32Segment id "int32") lst+    lbs <- asifContent "wxyz" Nothing (int32Segment id "int32") lst      let Right segments = extractSegments (AP.string "seg:wxyz") lbs     [names, times, types, seg] <- forAll $ pure (segmentValues <$> segments)@@ -133,7 +159,7 @@   it "should write out and read back in a int64 segment" $ require $ property $ do     lst <- forAll $ G.list (R.linear 0 50) (G.int64 R.linearBounded) -    lbs <- buildAsifBytestring "wxyz" Nothing (int64Segment id "int64") lst+    lbs <- asifContent "wxyz" Nothing (int64Segment id "int64") lst      let Right segments = extractSegments (AP.string "seg:wxyz") lbs     [names, times, types, seg] <- forAll $ pure (segmentValues <$> segments)@@ -145,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) -    lbs <- buildAsifBytestring "wxyz" Nothing (ipv4Segment id "ipv4") lst+    lbs <- asifContent "wxyz" Nothing (ipv4Segment id "ipv4") lst      let Right segments = extractSegments (AP.string "seg:wxyz") lbs     [names, times, types, seg] <- forAll $ pure (segmentValues <$> segments)@@ -155,7 +181,7 @@   it "should write out and read back in a ipv6 segment" $ require $ property $ do     lst <- forAll $ G.list (R.linear 0 50) genIpv6 -    lbs <- buildAsifBytestring "wxyz" Nothing (ipv6Segment id "ipv6") lst+    lbs <- asifContent "wxyz" Nothing (ipv6Segment id "ipv6") lst      let Right segments = extractSegments (AP.string "seg:wxyz") lbs     [names, times, types, seg] <- forAll $ pure (segmentValues <$> segments)@@ -167,7 +193,7 @@   it "should write out and read back in a time segment" $ require $ property $ do     lst <- forAll $ G.list (R.linear 0 50) (TY.posixSecondsToUTCTime . TY.fromMicroseconds <$> G.int64 R.linearBounded) -    lbs <- buildAsifBytestring "wxyz" Nothing (utcTimeMicrosSegment id "time") lst+    lbs <- asifContent "wxyz" Nothing (utcTimeMicrosSegment id "time") lst     let Right segments = extractSegments (AP.string "seg:wxyz") lbs     [names, times, types, seg] <- forAll $ pure (segmentValues <$> segments) @@ -178,7 +204,7 @@   it "should write out and read back in a char segment" $ require $ property $ do     lst <- forAll $ G.list (R.linear 0 50) G.ascii -    lbs <- buildAsifBytestring "wxyz" Nothing (asciiSegment id "char") lst+    lbs <- asifContent "wxyz" Nothing (asciiSegment id "char") lst     let Right segments = extractSegments (AP.string "seg:wxyz") lbs     [names, times, types, seg] <- forAll $ pure (segmentValues <$> segments) @@ -187,7 +213,7 @@   it "should write out and read back in a null-terminated string segment" $ require $ property $ do     lst <- forAll $ G.list (R.linear 0 50) genNonNullText -    lbs <- buildAsifBytestring "wxyz" Nothing (nullTerminatedStringSegment id "nullterminatedstring") (T.toStrict <$> lst)+    lbs <- asifContent "wxyz" Nothing (nullTerminatedStringSegment id "nullterminatedstring") (T.toStrict <$> lst)     let Right segments = extractSegments (AP.string "seg:wxyz") lbs     [names, times, types, seg] <- forAll $ pure (segmentValues <$> segments) @@ -200,7 +226,7 @@     -- get a single Text value.     lst <- forAll $ G.list (R.linear 1 50) (G.text (R.linear 0 50) G.unicode) -    lbs <- buildAsifBytestring "wxyz" Nothing (textSegment id "text") lst+    lbs <- asifContent "wxyz" Nothing (textSegment id "text") lst     let Right segments = extractSegments (AP.string "seg:wxyz") lbs     [names, times, types, seg] <- forAll $ pure (segmentValues <$> segments)