antiope-messages 6.4.0 → 7.0.0

raw patch · 4 files changed

+165/−72 lines, 4 filesdep +bytestringdep +hedgehogdep +hspecdep −amazonka-s3dep −amazonka-sqsdep −antiope-s3PVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, hedgehog, hspec, hw-hspec-hedgehog, scientific

Dependencies removed: amazonka-s3, amazonka-sqs, antiope-s3

API changes (from Hackage documentation)

Files

• antiope-messages.cabal +18/−27
• src/Antiope/Messages.hs +2/−32
• src/Antiope/Messages/Types.hs +100/−13
• test/Antiope/Messages/MessagesSpec.hs +45/−0

@@ -1,14 +1,9 @@-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: 4c3a7c3dcccad0a840a5b2eba818676ba858a5da48a3421a2ae488e3747baffa+cabal-version: 2.2  name:           antiope-messages-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@@ -30,20 +25,15 @@   exposed-modules:       Antiope.Messages       Antiope.Messages.Types-  other-modules:-      Paths_antiope_messages-  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:-      aeson+      base >=4.7 && <5+    , aeson     , amazonka     , amazonka-core-    , amazonka-s3-    , amazonka-sqs-    , antiope-s3-    , base >=4.7 && <5+    , bytestring     , generic-lens     , lens     , lens-aeson@@ -56,26 +46,27 @@ test-suite antiope-messages-test   type: exitcode-stdio-1.0   main-is: Spec.hs-  other-modules:-      Paths_antiope_messages-  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:-      aeson+      base >=4.7 && <5+    , aeson     , amazonka     , amazonka-core-    , amazonka-s3-    , amazonka-sqs     , antiope-messages-    , antiope-s3-    , base >=4.7 && <5+    , bytestring     , generic-lens+    , hedgehog >=0.5 && <0.7+    , hspec >=2.4 && <2.7+    , hw-hspec-hedgehog >=0.1 && <0.3     , lens     , lens-aeson     , monad-loops     , network-uri+    , scientific     , text     , unliftio-core   default-language: Haskell2010+  other-modules:+      Antiope.Messages.MessagesSpec

@@ -1,35 +1,5 @@ module Antiope.Messages-  ( QueueUrl(..)-  , SQSError(..)-  , messageInBody-  , messageToS3Uri-  , messageToS3Uri'+  ( module X   ) where -import Antiope.Messages.Types (QueueUrl (QueueUrl), SQSError (DeleteMessageBatchError))-import Antiope.S3             (S3Uri (..))-import Control.Lens-import Control.Monad          (join)-import Data.Aeson.Lens-import Data.Text              (Text, pack, unpack)-import Network.AWS.S3         (BucketName (BucketName), ObjectKey (ObjectKey))-import Network.AWS.SQS--import qualified Network.URI as URI---- Extract the "Message" content in the body if have-messageInBody :: Text -> Maybe Text-messageInBody body = body ^? key "Message" . _String--messageToS3Uri :: Message -> Maybe S3Uri-messageToS3Uri msg = join $ messageToS3Uri' <$> msg ^. mBody--messageToS3Uri' :: Text -> Maybe S3Uri-messageToS3Uri' msg = do-  s3m <- messageInBody msg ^? _Just . key "Records" . nth 0 . key "s3"-  b   <- s3m ^? key "bucket" . key "name" . _String-  k   <- s3m ^? key "object" . key "key" . _String-  pure $ S3Uri (BucketName b) (ObjectKey $ uriDecode k)--uriDecode :: Text -> Text-uriDecode = pack . URI.unEscapeString . unpack+import Antiope.Messages.Types as X

@@ -1,17 +1,104 @@-{-# LANGUAGE DeriveGeneric #-}-+{-# LANGUAGE AllowAmbiguousTypes   #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE GADTs                 #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications      #-} module Antiope.Messages.Types-  ( QueueUrl(..)-  , SQSError(..)-  ) where+( WithEncoded(..)+, With(..)+, FromWith(..)+, fromWith2, fromWith3+) where -import Data.String           (IsString)-import Data.Text             (Text)-import GHC.Generics-import Network.AWS.Data.Text (FromText (..), ToText (..))+import Data.Aeson   (FromJSON (..), ToJSON (..), eitherDecodeStrict, encode, withObject, (.:), (.=))+import Data.Text    (Text)+import GHC.TypeLits -data SQSError = DeleteMessageBatchError-  deriving (Eq, Show, Generic)+import qualified Data.Aeson           as Aeson+import qualified Data.Aeson.Types     as Aeson+import qualified Data.ByteString.Lazy as LBS+import           Data.Proxy+import qualified Data.Text            as Text+import qualified Data.Text.Encoding   as Text -newtype QueueUrl = QueueUrl Text-  deriving (Show, Eq, IsString, FromText, ToText, Generic)+-- | Extracts value from 'With' and 'WithEncoded' wrappers+class FromWith f where+  fromWith :: f a -> a -- ^ Extracts value from 'With' and 'WithEncoded'++instance FromWith (With x) where+  fromWith (With a) = a++instance FromWith (WithEncoded x) where+  fromWith (WithEncoded a) = a++-- | Extracts a value from any combination of two 'With' and/or 'WithEncoded'+--+-- @+-- fromWith2 @(With "one" (WithEncoded "two" True)) == True+-- @+fromWith2 :: (FromWith f, FromWith g) => f (g a) -> a+fromWith2 = fromWith . fromWith+{-# INLINE fromWith2 #-}++-- | Extracts a value from any combination of two 'With' and/or 'WithEncoded'+--+-- @+-- fromWith3 @(With "one" (WithEncoded "two" (With "three" True))) == True+-- @+fromWith3 :: (FromWith f, FromWith g, FromWith h) => f (g (h a)) -> a+fromWith3 = fromWith . fromWith . fromWith+{-# INLINE fromWith3 #-}++-- | Represents a JSON value of type 'a' that is encoded as a string in a field 'fld'+data WithEncoded (fld :: Symbol) a where+  WithEncoded :: forall fld a. KnownSymbol fld => a -> WithEncoded fld a++-- | Represents a JSON value of type 'a' in a field 'fld'+data With (fld :: Symbol) a where+  With :: forall fld a. KnownSymbol fld => a -> With fld a++instance Show a => Show (WithEncoded fld a) where+  show (WithEncoded a) = show a++instance Show a => Show (With fld a) where+  show (With a) = show a++instance Eq a => Eq (WithEncoded fld a) where+  (WithEncoded a) == (WithEncoded b) = a == b++instance Eq a => Eq (With fld a) where+  (With a) == (With b) = a == b++instance Ord a => Ord (WithEncoded fld a) where+  compare (WithEncoded a) (WithEncoded b) = compare a b++instance Ord a => Ord (With fld a) where+  compare (With a) (With b) = compare a b++instance (KnownSymbol fld, FromJSON a) => FromJSON (WithEncoded fld a) where+  parseJSON =+    let name = symbolVal @fld Proxy+    in withObject name $ \obj ->+        WithEncoded <$> decodeEscaped obj (Text.pack name)++instance (KnownSymbol fld, ToJSON a) => ToJSON (WithEncoded fld a) where+  toJSON (WithEncoded a) =+    let name = Text.pack (symbolVal @fld Proxy)+    in Aeson.object [ name .= (Text.decodeUtf8 . LBS.toStrict . encode) a ]++instance (KnownSymbol fld, FromJSON a) => FromJSON (With fld a) where+  parseJSON =+    let name = symbolVal @fld Proxy+    in withObject name $ \obj ->+        With <$> obj .: Text.pack name++instance (KnownSymbol fld, ToJSON a) => ToJSON (With fld a) where+  toJSON (With a) =+    let name = Text.pack (symbolVal @fld Proxy)+    in Aeson.object [ name .= a ]++decodeEscaped :: FromJSON b => Aeson.Object -> Text -> Aeson.Parser b+decodeEscaped o t =+  (o .: t) >>= (either fail pure . eitherDecodeStrict . Text.encodeUtf8)

@@ -0,0 +1,45 @@+{-# LANGUAGE DataKinds        #-}+{-# LANGUAGE TypeApplications #-}+module Antiope.Messages.MessagesSpec+where++import Antiope.Messages+import Data.Aeson       (decode, encode, (.=))+import Data.Monoid      ((<>))+import Data.Scientific  (fromFloatDigits)+import Data.Text        (Text, pack)++import qualified Data.Aeson as Aeson+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) #-}++jsonObject :: MonadGen m => m Aeson.Value+jsonObject = do+  fields  <- Gen.list (Range.linear 0 10) jsonField+  kvs     <- traverse (\k -> (\v -> k .= v) <$> jsonValue) fields+  pure $ Aeson.object kvs+  where+    jsonValue   = Gen.choice [jsonString, jsonNumber, jsonBool, jsonNull]+    jsonField   = Gen.text (Range.linear 0 10) Gen.alphaNum+    jsonString  = Aeson.String <$> Gen.text (Range.linear 0 50) Gen.alphaNum+    jsonNumber  = (Aeson.Number . fromFloatDigits) <$> Gen.double (Range.linearFrac (-32000.0) 32000.0)+    jsonBool    = Aeson.Bool <$> Gen.bool+    jsonNull    = pure Aeson.Null+++spec :: Spec+spec = describe "Antiope.Core.MessagesSpec" $ do+  it "Can encode and decode With" $ require $ property $ do+    obj <- forAll $ jsonObject+    tripping (With @"payload" obj) encode decode++  it "Can encode and decode inner-encoded" $ require $ property $ do+    obj <- forAll $ jsonObject+    tripping (WithEncoded @"payload" obj) encode decode