antiope-s3 6.4.0 → 7.0.0
raw patch · 4 files changed
+121/−30 lines, 4 filesdep +antiope-messagesdep −monad-loggerdep ~hspecdep ~hw-hspec-hedgehog
Dependencies added: antiope-messages
Dependencies removed: monad-logger
Dependency ranges changed: hspec, hw-hspec-hedgehog
Files
- antiope-s3.cabal +11/−15
- src/Antiope/S3/Messages.hs +42/−11
- src/Antiope/S3/Types.hs +0/−4
- test/Antiope/S3/MessagesSpec.hs +68/−0
antiope-s3.cabal view
@@ -1,14 +1,15 @@-cabal-version: 1.12+cabal-version: 2.2 -- This file has been generated from package.yaml by hpack version 0.31.1. -- -- see: https://github.com/sol/hpack ----- hash: 282b5f840ecbd3afbb1ec96fe2ccd47819d4fc98e6aa726a4bf9fc86863b8da1+-- hash: 8a36985fa18723b082538f34eb086ed7df8a972cb70df24354d3250f5503ceb1 name: antiope-s3-version: 6.4.0-description: Please see the README on Github at <https://github.com/arbor/antiope#readme>+version: 7.0.0+synopsis: Please see the README on Github at <https://github.com/arbor/antiope#readme>+description: Please see the README on Github at <https://github.com/arbor/antiope#readme>. category: Services homepage: https://github.com/arbor/antiope#readme bug-reports: https://github.com/arbor/antiope/issues@@ -37,10 +38,7 @@ Antiope.S3.Request Antiope.S3.Strict Antiope.S3.Types- other-modules:- Paths_antiope_s3- hs-source-dirs:- src+ hs-source-dirs: src default-extensions: BangPatterns GeneralizedNewtypeDeriving OverloadedStrings TupleSections ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -msse4.2 build-depends:@@ -49,6 +47,7 @@ , amazonka-core >=1.6 , amazonka-s3 >=1.6 , antiope-core+ , antiope-messages , attoparsec , base >=4.7 && <5 , bytestring@@ -58,7 +57,6 @@ , generic-lens , http-types , lens- , monad-logger , mtl , network-uri , resourcet@@ -71,11 +69,10 @@ type: exitcode-stdio-1.0 main-is: Spec.hs other-modules:+ Antiope.S3.MessagesSpec Antiope.S3.TypesSpec Antiope.S3Spec- Paths_antiope_s3- hs-source-dirs:- test+ hs-source-dirs: test default-extensions: BangPatterns GeneralizedNewtypeDeriving OverloadedStrings TupleSections ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -msse4.2 -threaded -rtsopts -with-rtsopts=-N build-depends:@@ -93,11 +90,10 @@ , exceptions , generic-lens , hedgehog >=0.5 && <0.7- , hspec >=2.4 && <2.6+ , hspec >=2.4 && <2.7 , http-types- , hw-hspec-hedgehog >=0.1 && <0.2+ , hw-hspec-hedgehog >=0.1 && <0.3 , lens- , monad-logger , mtl , network-uri , resourcet
src/Antiope/S3/Messages.hs view
@@ -1,21 +1,38 @@-{-# LANGUAGE DeriveGeneric #-}-+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeApplications #-} module Antiope.S3.Messages ( EventName(..) , S3Message(..)- , readEventName+ , messageToS3Uri+ , fromSnsRecords ) where -import Antiope.S3 (BucketName (..), ETag (..), ObjectKey (..))-import Data.Aeson as Aeson-import Data.Int (Int64)-import Data.Text (Text)-import Data.Time.Clock (UTCTime)-import GHC.Generics (Generic)+import Antiope.Messages+import Antiope.S3 (BucketName (..), ETag (..), ObjectKey (..))+import Control.Lens (each, to, (^..), _Just)+import Data.Aeson as Aeson+import Data.Int (Int64)+import Data.Text (Text)+import Data.Time.Clock (UTCTime)+import GHC.Generics (Generic)+import Network.AWS.Data.Text (toText) +import qualified Antiope.S3.Types as Types import qualified Data.Text as T import qualified Data.Text.Encoding as T+import qualified Network.URI as URI +messageToS3Uri :: S3Message -> Types.S3Uri+messageToS3Uri msg = Types.S3Uri (bucket msg) (key msg)++fromSnsRecords :: Text -> [S3Message]+fromSnsRecords msg =+ Aeson.decodeStrict' @(WithEncoded "Message" (With "Records" [S3Message])) (T.encodeUtf8 msg)+ ^.. _Just+ . to fromWith2+ . each+ data EventName = EventName { eventType :: !Text , action :: !Text@@ -27,7 +44,7 @@ , bucket :: !BucketName , key :: !ObjectKey , size :: !Int64- , etag :: !(Maybe ETag)+ , eTag :: !(Maybe ETag) } deriving (Show, Eq, Generic) instance FromJSON S3Message where@@ -38,10 +55,24 @@ bkt <- s3 .: "bucket" obj' <- s3 .: "object" bName <- BucketName <$> (bkt .: "name")- oKey <- ObjectKey <$> (obj' .: "key")+ oKey <- (ObjectKey . T.pack . URI.unEscapeString . T.unpack) <$> (obj' .: "key") oSize <- obj' .: "size" oEtag <- fmap (ETag . T.encodeUtf8) <$> (obj' .:? "eTag") pure $ S3Message eTime eName bName oKey oSize oEtag++instance ToJSON S3Message where+ toJSON msg = Aeson.object+ [ "eventTime" .= eventTime msg+ , "eventName" .= T.intercalate ":" ["s3", eventType (eventName msg), action (eventName msg)]+ , "s3" .= Aeson.object+ [ "bucket" .= object [ "name" .= toText (bucket msg)]+ , "object" .= object+ [ "key" .= (T.pack . URI.escapeURIString URI.isAllowedInURI . T.unpack . toText . key) msg+ , "size" .= size msg+ , "eTag" .= fmap toText (eTag msg)+ ]+ ]+ ] readEventName :: T.Text -> EventName readEventName evt =
src/Antiope/S3/Types.hs view
@@ -16,7 +16,6 @@ import Control.Applicative import Control.Lens import Control.Monad-import Control.Monad.Logger (ToLogStr (..)) import Data.Char import Data.Generics.Product.Any import Data.List@@ -48,9 +47,6 @@ instance ToText S3Uri where toText loc = toS3Uri (loc ^. the @"bucket") (loc ^. the @"objectKey")--instance ToLogStr S3Uri where- toLogStr s = fromString $ T.unpack $ toText s data Range = Range { first :: Int
+ test/Antiope/S3/MessagesSpec.hs view
@@ -0,0 +1,68 @@+module Antiope.S3.MessagesSpec+where++import Antiope.S3 (BucketName (..), ETag (..), ObjectKey (..))+import Antiope.S3.Messages+import Data.Aeson (decode, encode)+import Data.Monoid ((<>))+import Data.Text (Text, pack)+import Data.Time.Calendar+import Data.Time.Clock++import qualified Data.Text as Text++import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Hedgehog.Gen as Gen+import Hedgehog.Range as Range+import Test.Hspec++{-# ANN module ("HLint: Ignore Redundant do" :: String) #-}++genUTCTime :: MonadGen m => m UTCTime+genUTCTime = do+ y <- toInteger <$> Gen.int (Range.constant 2000 2019)+ m <- Gen.int (Range.constant 1 12)+ d <- Gen.int (Range.constant 1 28)+ let day = fromGregorian y m d+ secs <- toInteger <$> Gen.int (Range.constant 0 86401)+ let diff = secondsToDiffTime secs+ pure $ UTCTime day diff++datedPath :: MonadGen m => m Text+datedPath = do+ year <- Gen.int (Range.linear 2000 2050)+ month <- Gen.int (Range.linear 1 12)+ day <- Gen.int (Range.linear 1 28)+ let parts = zipWith (\a b -> a <> "=" <> pack (show b)) ["year", "month", "day"] [year, month, day]+ pure $ Text.intercalate "/" parts++randomPath :: MonadGen m => m Text+randomPath = do+ parts <- Gen.list (Range.linear 1 5) (Gen.text (Range.linear 1 10) Gen.alphaNum)+ pure $ Text.intercalate "/" parts++s3Message :: MonadGen m => m S3Message+s3Message = do+ eName <- Gen.text (Range.linear 1 10) Gen.alphaNum+ eType <- Gen.text (Range.linear 1 10) Gen.alphaNum+ time <- Gen.maybe genUTCTime+ bkt <- Gen.text (Range.linear 1 20) Gen.alphaNum+ file <- Gen.text (Range.linear 1 20) Gen.alphaNum+ path <- Gen.choice [datedPath, randomPath]+ sz <- Gen.int64 (Range.linear 0 maxBound)+ etag <- Gen.maybe (Gen.utf8 (Range.singleton 10) Gen.alphaNum)+ pure S3Message+ { eventTime = time+ , eventName = EventName eType eName+ , bucket = BucketName bkt+ , key = ObjectKey (path <> "/" <> file)+ , size = sz+ , eTag = fmap ETag etag+ }++spec :: Spec+spec = describe "Antiope.S3.MessagesSpec" $ do+ it "Can encode and decode S3Message" $ require $ property $ do+ msg <- forAll $ s3Message+ tripping msg encode decode