aws-kinesis-reshard (empty) → 0.1.0.0

raw patch · 11 files changed

+1045/−0 lines, 11 filesdep +awsdep +aws-generaldep +aws-kinesissetup-changed

Dependencies added: aws, aws-general, aws-kinesis, aws-kinesis-reshard, aws-sdk, base, base-unicode-symbols, bytestring, conduit, either, hoist-error, lens, lifted-async, lifted-base, monad-control, mtl, optparse-applicative, resourcet, text, time, transformers

Files

• LICENSE +202/−0
• Setup.hs +2/−0
• aws-kinesis-reshard.cabal +74/−0
• src/Aws/Kinesis/Reshard/Analysis.hs +51/−0
• src/Aws/Kinesis/Reshard/Common.hs +98/−0
• src/Aws/Kinesis/Reshard/Exception.hs +89/−0
• src/Aws/Kinesis/Reshard/Metrics.hs +94/−0
• src/Aws/Kinesis/Reshard/Monad.hs +52/−0
• src/Aws/Kinesis/Reshard/Options.hs +149/−0
• src/Aws/Kinesis/Reshard/Shards.hs +176/−0
• src/Main.hs +58/−0

@@ -0,0 +1,202 @@++                                 Apache License+                           Version 2.0, January 2004+                        http://www.apache.org/licenses/++   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++   1. Definitions.++      "License" shall mean the terms and conditions for use, reproduction,+      and distribution as defined by Sections 1 through 9 of this document.++      "Licensor" shall mean the copyright owner or entity authorized by+      the copyright owner that is granting the License.++      "Legal Entity" shall mean the union of the acting entity and all+      other entities that control, are controlled by, or are under common+      control with that entity. For the purposes of this definition,+      "control" means (i) the power, direct or indirect, to cause the+      direction or management of such entity, whether by contract or+      otherwise, or (ii) ownership of fifty percent (50%) or more of the+      outstanding shares, or (iii) beneficial ownership of such entity.++      "You" (or "Your") shall mean an individual or Legal Entity+      exercising permissions granted by this License.++      "Source" form shall mean the preferred form for making modifications,+      including but not limited to software source code, documentation+      source, and configuration files.++      "Object" form shall mean any form resulting from mechanical+      transformation or translation of a Source form, including but+      not limited to compiled object code, generated documentation,+      and conversions to other media types.++      "Work" shall mean the work of authorship, whether in Source or+      Object form, made available under the License, as indicated by a+      copyright notice that is included in or attached to the work+      (an example is provided in the Appendix below).++      "Derivative Works" shall mean any work, whether in Source or Object+      form, that is based on (or derived from) the Work and for which the+      editorial revisions, annotations, elaborations, or other modifications+      represent, as a whole, an original work of authorship. For the purposes+      of this License, Derivative Works shall not include works that remain+      separable from, or merely link (or bind by name) to the interfaces of,+      the Work and Derivative Works thereof.++      "Contribution" shall mean any work of authorship, including+      the original version of the Work and any modifications or additions+      to that Work or Derivative Works thereof, that is intentionally+      submitted to Licensor for inclusion in the Work by the copyright owner+      or by an individual or Legal Entity authorized to submit on behalf of+      the copyright owner. For the purposes of this definition, "submitted"+      means any form of electronic, verbal, or written communication sent+      to the Licensor or its representatives, including but not limited to+      communication on electronic mailing lists, source code control systems,+      and issue tracking systems that are managed by, or on behalf of, the+      Licensor for the purpose of discussing and improving the Work, but+      excluding communication that is conspicuously marked or otherwise+      designated in writing by the copyright owner as "Not a Contribution."++      "Contributor" shall mean Licensor and any individual or Legal Entity+      on behalf of whom a Contribution has been received by Licensor and+      subsequently incorporated within the Work.++   2. Grant of Copyright License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      copyright license to reproduce, prepare Derivative Works of,+      publicly display, publicly perform, sublicense, and distribute the+      Work and such Derivative Works in Source or Object form.++   3. Grant of Patent License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      (except as stated in this section) patent license to make, have made,+      use, offer to sell, sell, import, and otherwise transfer the Work,+      where such license applies only to those patent claims licensable+      by such Contributor that are necessarily infringed by their+      Contribution(s) alone or by combination of their Contribution(s)+      with the Work to which such Contribution(s) was submitted. If You+      institute patent litigation against any entity (including a+      cross-claim or counterclaim in a lawsuit) alleging that the Work+      or a Contribution incorporated within the Work constitutes direct+      or contributory patent infringement, then any patent licenses+      granted to You under this License for that Work shall terminate+      as of the date such litigation is filed.++   4. Redistribution. You may reproduce and distribute copies of the+      Work or Derivative Works thereof in any medium, with or without+      modifications, and in Source or Object form, provided that You+      meet the following conditions:++      (a) You must give any other recipients of the Work or+          Derivative Works a copy of this License; and++      (b) You must cause any modified files to carry prominent notices+          stating that You changed the files; and++      (c) You must retain, in the Source form of any Derivative Works+          that You distribute, all copyright, patent, trademark, and+          attribution notices from the Source form of the Work,+          excluding those notices that do not pertain to any part of+          the Derivative Works; and++      (d) If the Work includes a "NOTICE" text file as part of its+          distribution, then any Derivative Works that You distribute must+          include a readable copy of the attribution notices contained+          within such NOTICE file, excluding those notices that do not+          pertain to any part of the Derivative Works, in at least one+          of the following places: within a NOTICE text file distributed+          as part of the Derivative Works; within the Source form or+          documentation, if provided along with the Derivative Works; or,+          within a display generated by the Derivative Works, if and+          wherever such third-party notices normally appear. The contents+          of the NOTICE file are for informational purposes only and+          do not modify the License. You may add Your own attribution+          notices within Derivative Works that You distribute, alongside+          or as an addendum to the NOTICE text from the Work, provided+          that such additional attribution notices cannot be construed+          as modifying the License.++      You may add Your own copyright statement to Your modifications and+      may provide additional or different license terms and conditions+      for use, reproduction, or distribution of Your modifications, or+      for any such Derivative Works as a whole, provided Your use,+      reproduction, and distribution of the Work otherwise complies with+      the conditions stated in this License.++   5. Submission of Contributions. Unless You explicitly state otherwise,+      any Contribution intentionally submitted for inclusion in the Work+      by You to the Licensor shall be under the terms and conditions of+      this License, without any additional terms or conditions.+      Notwithstanding the above, nothing herein shall supersede or modify+      the terms of any separate license agreement you may have executed+      with Licensor regarding such Contributions.++   6. Trademarks. This License does not grant permission to use the trade+      names, trademarks, service marks, or product names of the Licensor,+      except as required for reasonable and customary use in describing the+      origin of the Work and reproducing the content of the NOTICE file.++   7. Disclaimer of Warranty. Unless required by applicable law or+      agreed to in writing, Licensor provides the Work (and each+      Contributor provides its Contributions) on an "AS IS" BASIS,+      WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+      implied, including, without limitation, any warranties or conditions+      of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+      PARTICULAR PURPOSE. You are solely responsible for determining the+      appropriateness of using or redistributing the Work and assume any+      risks associated with Your exercise of permissions under this License.++   8. Limitation of Liability. In no event and under no legal theory,+      whether in tort (including negligence), contract, or otherwise,+      unless required by applicable law (such as deliberate and grossly+      negligent acts) or agreed to in writing, shall any Contributor be+      liable to You for damages, including any direct, indirect, special,+      incidental, or consequential damages of any character arising as a+      result of this License or out of the use or inability to use the+      Work (including but not limited to damages for loss of goodwill,+      work stoppage, computer failure or malfunction, or any and all+      other commercial damages or losses), even if such Contributor+      has been advised of the possibility of such damages.++   9. Accepting Warranty or Additional Liability. While redistributing+      the Work or Derivative Works thereof, You may choose to offer,+      and charge a fee for, acceptance of support, warranty, indemnity,+      or other liability obligations and/or rights consistent with this+      License. However, in accepting such obligations, You may act only+      on Your own behalf and on Your sole responsibility, not on behalf+      of any other Contributor, and only if You agree to indemnify,+      defend, and hold each Contributor harmless for any liability+      incurred by, or claims asserted against, such Contributor by reason+      of your accepting any such warranty or additional liability.++   END OF TERMS AND CONDITIONS++   APPENDIX: How to apply the Apache License to your work.++      To apply the Apache License to your work, attach the following+      boilerplate notice, with the fields enclosed by brackets "[]"+      replaced with your own identifying information. (Don't include+      the brackets!)  The text should be enclosed in the appropriate+      comment syntax for the file format. We also recommend that a+      file or class name and description of purpose be included on the+      same "printed page" as the copyright notice for easier+      identification within third-party archives.++   Copyright [yyyy] [name of copyright owner]++   Licensed under the Apache License, Version 2.0 (the "License");+   you may not use this file except in compliance with the License.+   You may obtain a copy of the License at++       http://www.apache.org/licenses/LICENSE-2.0++   Unless required by applicable law or agreed to in writing, software+   distributed under the License is distributed on an "AS IS" BASIS,+   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+   See the License for the specific language governing permissions and+   limitations under the License.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,74 @@+name:                aws-kinesis-reshard+version:             0.1.0.0+synopsis:            Reshard AWS Kinesis streams in response to Cloud Watch metrics+license:             Apache-2.0+license-file:        LICENSE+author:              Jon Sterling+maintainer:          jon@jonmsterling.com+copyright:           Copyright (c) 2013-2014 PivotCloud, Inc.+category:            Cloud+build-type:          Simple+cabal-version:       >=1.10+homepage:            https://github.com/alephcloud/hs-aws-kinesis-reshard+bug-reports:         https://github.com/alephcloud/hs-aws-kinesis-reshard/issues++source-repository head+    type: git+    location: https://github.com/alephcloud/hs-aws-kinesis-reshard.git++library+  default-language:    Haskell2010+  hs-source-dirs:      src+  ghc-options:         -Wall+  exposed-modules:     Aws.Kinesis.Reshard.Analysis+                     , Aws.Kinesis.Reshard.Common+                     , Aws.Kinesis.Reshard.Exception+                     , Aws.Kinesis.Reshard.Metrics+                     , Aws.Kinesis.Reshard.Monad+                     , Aws.Kinesis.Reshard.Options+                     , Aws.Kinesis.Reshard.Shards+  build-depends:       base >=4.7 && <4.8+                     , base-unicode-symbols+                     , aws+                     , aws-general+                     , aws-kinesis+                     , aws-sdk+                     , conduit+                     , bytestring+                     , hoist-error+                     , lens+                     , lifted-async+                     , lifted-base+                     , monad-control+                     , mtl+                     , optparse-applicative+                     , resourcet+                     , text+                     , time+                     , transformers++executable kinesis-reshard+  main-is:             Main.hs+  build-depends:       base >=4.7 && <4.8+                     , base-unicode-symbols+                     , aws+                     , aws-general+                     , aws-sdk+                     , aws-kinesis+                     , aws-kinesis-reshard+                     , conduit+                     , either+                     , hoist-error+                     , lens+                     , lifted-async+                     , lifted-base+                     , monad-control+                     , mtl+                     , optparse-applicative+                     , resourcet+                     , text+                     , time+                     , transformers+  hs-source-dirs:      src+  ghc-options:         -Wall+  default-language:    Haskell2010

@@ -0,0 +1,51 @@+-- Copyright (c) 2013-2014 PivotCloud, Inc.+--+-- Aws.Kinesis.Reshard.Analysis+--+-- Please feel free to contact us at licensing@pivotmail.com with any+-- contributions, additions, or other feedback; we would love to hear from+-- you.+--+-- Licensed under the Apache License, Version 2.0 (the "License"); you may+-- not use this file except in compliance with the License. You may obtain a+-- copy of the License at http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT+-- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the+-- License for the specific language governing permissions and limitations+-- under the License.+--++{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE UnicodeSyntax #-}++module Aws.Kinesis.Reshard.Analysis+( analyzeStream+) where++import Aws.Kinesis.Reshard.Shards+import Aws.Kinesis.Reshard.Metrics+import Aws.Kinesis.Reshard.Monad+import Control.Concurrent.Async.Lifted+import Control.Lens+import Prelude.Unicode++analyzeStream+  ∷ MonadReshard m+  ⇒ m (Maybe ReshardingAction)+analyzeStream = do+  (totalBps, shardCount) ← getBytesPerSecond `concurrently` countOpenShards+  threshold ← view oShardCapacityThreshold+  maximumShardCount ← view oMaximumShardCount+  let percentCapacity = shardlyBps / maximumBps+      maximumBps = 1000000+      shardlyBps = totalBps / fromIntegral shardCount+  return $+    if | shardCount > maximumShardCount → Just MergeShardsAction+       | percentCapacity < threshold * 0.5 ∧ shardCount > 1 → Just MergeShardsAction+       | percentCapacity ≥ threshold ∧ shardCount < maximumShardCount → Just SplitShardsAction+       | otherwise → Nothing+

@@ -0,0 +1,98 @@+-- Copyright (c) 2013-2014 PivotCloud, Inc.+--+-- Aws.Kinesis.Reshard.Common+--+-- Please feel free to contact us at licensing@pivotmail.com with any+-- contributions, additions, or other feedback; we would love to hear from+-- you.+--+-- Licensed under the Apache License, Version 2.0 (the "License"); you may+-- not use this file except in compliance with the License. You may obtain a+-- copy of the License at http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT+-- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the+-- License for the specific language governing permissions and limitations+-- under the License.+--++{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE UnicodeSyntax #-}++module Aws.Kinesis.Reshard.Common+( kinesisStreamName+, runKinesis+) where++import Aws+import Aws.General+import Aws.Kinesis+import Aws.Kinesis.Reshard.Monad++import Control.Applicative+import Control.Exception.Lifted+import Control.Lens+import Control.Monad.Error.Hoist+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Prelude.Unicode++awsCredentials+  ∷ MonadReshard m+  ⇒ m Credentials+awsCredentials = do+  accessKey ← view $ oAccessKey ∘ to T.encodeUtf8+  secretKey ← view $ oSecretAccessKey ∘ to T.encodeUtf8+  makeCredentials+    accessKey+    secretKey++awsConfiguration+  ∷ MonadReshard m+  ⇒ m Configuration+awsConfiguration = do+  cred ← awsCredentials+  return Configuration+    { timeInfo = Timestamp+    , credentials = cred+    , logger = defaultLog Warning+    }++awsRegion+  ∷ MonadReshard m+  ⇒ m Region+awsRegion = do+  r ← view oRegion+  fromText r <%?>+    SomeException ∘ InvalidRegionException r ∘ T.pack++kinesisConfiguration+  ∷ MonadReshard m+  ⇒ m (KinesisConfiguration NormalQuery)+kinesisConfiguration =+  KinesisConfiguration+    <$> awsRegion++kinesisStreamName+  ∷ MonadReshard m+  ⇒ m StreamName+kinesisStreamName = do+  sn ← view oStreamName+  streamName sn <%?>+    SomeException ∘ InvalidStreamNameException sn++runKinesis+  ∷ ( MonadReshard m+    , Transaction r α+    , ServiceConfiguration r ~ KinesisConfiguration+    , AsMemoryResponse α+    )+  ⇒ r+  → m (MemoryResponse α)+runKinesis request = do+  cfg ← awsConfiguration+  kinCfg ← kinesisConfiguration+  simpleAws cfg kinCfg request

@@ -0,0 +1,89 @@+-- Copyright (c) 2013-2014 PivotCloud, Inc.+--+-- Aws.Kinesis.Reshard.Exception+--+-- Please feel free to contact us at licensing@pivotmail.com with any+-- contributions, additions, or other feedback; we would love to hear from+-- you.+--+-- Licensed under the Apache License, Version 2.0 (the "License"); you may+-- not use this file except in compliance with the License. You may obtain a+-- copy of the License at http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT+-- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the+-- License for the specific language governing permissions and limitations+-- under the License.+--++{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE UnicodeSyntax #-}++module Aws.Kinesis.Reshard.Exception+( InvalidRegionException(InvalidRegionException)+, _InvalidRegionException+, ireProposedRegion+, ireParsingError++, InvalidStreamNameException(InvalidStreamNameException)+, _InvalidStreamNameException+, isnProposedStreamName+, isnParsingError++, NoShardsFoundException(NoShardsFoundException)+, _NoShardsFoundException+, nsfeStreamName++, InvalidPartitionHashException(..)+, _InvalidPartitionHashRange+, _InvalidPartitionHash+) where++import Aws.Kinesis.Types+import Control.Exception.Lifted+import Control.Lens+import qualified Data.Text as T+import Data.Typeable++data InvalidRegionException+  = InvalidRegionException+  { _ireProposedRegion ∷ !T.Text+  , _ireParsingError ∷ !T.Text+  } deriving (Eq, Typeable, Show)++instance Exception InvalidRegionException++makeLenses ''InvalidRegionException+makePrisms ''InvalidRegionException++data InvalidStreamNameException+  = InvalidStreamNameException+  { _isnProposedStreamName ∷ !T.Text+  , _isnParsingError ∷ !T.Text+  } deriving (Eq, Typeable, Show)++instance Exception InvalidStreamNameException++makeLenses ''InvalidStreamNameException+makePrisms ''InvalidStreamNameException++newtype NoShardsFoundException+  = NoShardsFoundException+  { _nsfeStreamName ∷ StreamName+  } deriving (Eq, Typeable, Show)++instance Exception NoShardsFoundException++makeLenses ''NoShardsFoundException+makePrisms ''NoShardsFoundException++data InvalidPartitionHashException+   = InvalidPartitionHashRange (PartitionHash, PartitionHash)+   | InvalidPartitionHash Integer T.Text+   deriving (Eq, Typeable, Show)++makePrisms ''InvalidPartitionHashException+instance Exception InvalidPartitionHashException+

@@ -0,0 +1,94 @@+-- Copyright (c) 2013-2014 PivotCloud, Inc.+--+-- Aws.Kinesis.Reshard.Metrics+--+-- Please feel free to contact us at licensing@pivotmail.com with any+-- contributions, additions, or other feedback; we would love to hear from+-- you.+--+-- Licensed under the Apache License, Version 2.0 (the "License"); you may+-- not use this file except in compliance with the License. You may obtain a+-- copy of the License at http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT+-- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the+-- License for the specific language governing permissions and limitations+-- under the License.+--++{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE UnicodeSyntax #-}++module Aws.Kinesis.Reshard.Metrics+( getBytesPerSecond+) where++import AWS+import AWS.CloudWatch+import AWS.CloudWatch.Types++import Aws.Kinesis.Reshard.Monad++import Control.Applicative+import Control.Applicative.Unicode+import Control.Concurrent.Async.Lifted+import Control.Lens+import Control.Monad.Trans+import Control.Monad.Unicode+import qualified Data.Text.Encoding as T+import Data.Time+import Prelude.Unicode++getCredential+  ∷ MonadReshard m+  ⇒ m Credential+getCredential =+  pure newCredential+    ⊛ view (oAccessKey ∘ to T.encodeUtf8)+    ⊛ view (oSecretAccessKey ∘ to T.encodeUtf8)++dimensionFilters+  ∷ MonadReshard m+  ⇒ m [DimensionFilter]+dimensionFilters =+  (:[]) ∘ ("StreamName",)+    <$> view oStreamName++getBytesPerSecond+  ∷ MonadReshard m+  ⇒ m Double+getBytesPerSecond = do+  cred ← getCredential+  filters ← dimensionFilters+  duration ← view oSampleDuration++  runCloudWatch cred $ do+    setRegion =≪ lift (view oRegion)+    endTime ← liftIO getCurrentTime++    let startTime = addUTCTime (fromInteger $ -duration) endTime++    let getMetrics metric = do+          (datapoints, _) ← getMetricStatistics+            filters+            startTime+            endTime+            metric+            "AWS/Kinesis"+            (fromIntegral duration)+            [StatisticSum]+            Nothing+          return $ foldr (\Datapoint{..} n → maybe n (+ n) datapointSum) 0 datapoints+++    totalBytes ← runConcurrently $+      pure (+)+        ⊛ Concurrently (getMetrics "PutRecord.Bytes")+        ⊛ Concurrently (getMetrics "PutRecords.Bytes")++    return $ totalBytes / fromIntegral duration

@@ -0,0 +1,52 @@+-- Copyright (c) 2013-2014 PivotCloud, Inc.+--+-- Aws.Kinesis.Reshard.Monad+--+-- Please feel free to contact us at licensing@pivotmail.com with any+-- contributions, additions, or other feedback; we would love to hear from+-- you.+--+-- Licensed under the Apache License, Version 2.0 (the "License"); you may+-- not use this file except in compliance with the License. You may obtain a+-- copy of the License at http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT+-- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the+-- License for the specific language governing permissions and limitations+-- under the License.+--++{-# LANGUAGE ConstraintKinds #-}++module Aws.Kinesis.Reshard.Monad+( MonadReshard++, module Aws.Kinesis.Reshard.Exception+, module Aws.Kinesis.Reshard.Options++, MonadError(..)+, MonadReader(..)+, MonadIO(..)+, MonadBaseControl(..)+, MonadResource(..)+) where++import Aws.Kinesis.Reshard.Exception+import Aws.Kinesis.Reshard.Options++import Control.Exception.Lifted+import Control.Monad.Error.Class+import Control.Monad.Reader.Class+import Control.Monad.Trans+import Control.Monad.Trans.Control+import Control.Monad.Trans.Resource++type MonadReshard m+  = ( MonadError SomeException m+    , MonadReader Options m+    , MonadIO m+    , MonadBaseControl IO m+    , MonadResource m+    )+

@@ -0,0 +1,149 @@+-- Copyright (c) 2013-2014 PivotCloud, Inc.+--+-- Aws.Kinesis.Reshard.Options+--+-- Please feel free to contact us at licensing@pivotmail.com with any+-- contributions, additions, or other feedback; we would love to hear from+-- you.+--+-- Licensed under the Apache License, Version 2.0 (the "License"); you may+-- not use this file except in compliance with the License. You may obtain a+-- copy of the License at http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT+-- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the+-- License for the specific language governing permissions and limitations+-- under the License.+--++{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE UnicodeSyntax #-}++module Aws.Kinesis.Reshard.Options where++import qualified Data.Text as T+import Options.Applicative+import Control.Applicative.Unicode+import Control.Lens+import Data.Monoid.Unicode+import Prelude.Unicode++data Options+  = Options+  { _oAccessKey ∷ !T.Text+  , _oSecretAccessKey ∷ !T.Text+  , _oRegion ∷ !T.Text+  , _oStreamName ∷ !T.Text+  , _oSampleDuration ∷ !Integer+  , _oShardCapacityThreshold ∷ !Double+  , _oMaximumShardCount ∷ !Int+  , _oReshardingInterval ∷ !Int+  } deriving Show++makeLenses ''Options++accessKeyParser ∷ Parser T.Text+accessKeyParser =+  fmap T.pack ∘ option str $+    long "access-key"+      ⊕ metavar "AK"+      ⊕ help "Your AWS access key"++secretAccessKeyParser ∷ Parser T.Text+secretAccessKeyParser =+  fmap T.pack ∘ option str $+    long "secret-access-key"+      ⊕ metavar "SK"+      ⊕ help "Your AWS secret access key"++regionParser ∷ Parser T.Text+regionParser =+  fmap T.pack ∘ option str $+    long "region"+      ⊕ short 'r'+      ⊕ metavar "R"+      ⊕ help "The AWS region"+      ⊕ value "us-west-2"+      ⊕ showDefault++streamNameParser ∷ Parser T.Text+streamNameParser =+  fmap T.pack ∘ option str $+    long "stream-name"+      ⊕ short 's'+      ⊕ metavar "SN"+      ⊕ help "The Kinesis stream name"++sampleDurationParser ∷ Parser Integer+sampleDurationParser =+  option auto $+    long "sample-duration"+      ⊕ short 'd'+      ⊕ metavar "SD"+      ⊕ help "The sample duration in seconds"+      ⊕ value (60 * 60)+      ⊕ showDefault++capacityThresholdReader ∷ ReadM Double+capacityThresholdReader = do+  cap ← auto+  if | cap > 0 ∧ cap ≤ 1 → return cap+     | otherwise → readerError "Capacity threshold must be in range (0,1]"++capacityThresholdParser ∷ Parser Double+capacityThresholdParser =+  option capacityThresholdReader $+    long "shard-capacity-threshold"+      ⊕ short 't'+      ⊕ metavar "SCT"+      ⊕ help "The threshold percent capacity per shard (max: 1)"+      ⊕ value 0.1+      ⊕ showDefault++maximumShardCountReader ∷ ReadM Int+maximumShardCountReader = do+  count ← auto+  if | count > 0 ∧ count <= 10 → return count+     | otherwise → readerError "Maximum shard count must be in range [1,10]"++maximumShardCountParser ∷ Parser Int+maximumShardCountParser =+  option maximumShardCountReader $+    long "maximum-shard-count"+      ⊕ short 'c'+      ⊕ metavar "MSC"+      ⊕ help "The maximum number of shards permitted on this stream (max: 10)"+      ⊕ value 5+      ⊕ showDefault++reshardingIntervalParser ∷ Parser Int+reshardingIntervalParser =+  option auto $+    long "resharding-interval"+      ⊕ short 'i'+      ⊕ metavar "RI"+      ⊕ help "The time to wait before reanalyzing the stream in seconds"+      ⊕ value 60000000+      ⊕ showDefault++optionsParser ∷ Parser Options+optionsParser =+  pure Options+    ⊛ accessKeyParser+    ⊛ secretAccessKeyParser+    ⊛ regionParser+    ⊛ streamNameParser+    ⊛ sampleDurationParser+    ⊛ capacityThresholdParser+    ⊛ maximumShardCountParser+    ⊛ reshardingIntervalParser++parserInfo ∷ ParserInfo Options+parserInfo =+  info (helper ⊛ optionsParser) $+    fullDesc+    ⊕ progDesc "Monitor Kinesis throughput and reshard accordingly"+    ⊕ header "The Kinesis Resharder CLI"+

@@ -0,0 +1,176 @@+-- Copyright (c) 2013-2014 PivotCloud, Inc.+--+-- Aws.Kinesis.Reshard.Shards+--+-- Please feel free to contact us at licensing@pivotmail.com with any+-- contributions, additions, or other feedback; we would love to hear from+-- you.+--+-- Licensed under the Apache License, Version 2.0 (the "License"); you may+-- not use this file except in compliance with the License. You may obtain a+-- copy of the License at http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT+-- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the+-- License for the specific language governing permissions and limitations+-- under the License.+--++{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE UnicodeSyntax #-}++module Aws.Kinesis.Reshard.Shards+( fetchOpenShards+, countOpenShards+, awaitStreamActive+, ReshardingAction(..)+, performReshardingAction+) where++import Aws.Core+import Aws.Kinesis+import Aws.Kinesis.Reshard.Common+import Aws.Kinesis.Reshard.Monad++import Control.Applicative+import Control.Exception.Lifted+import Control.Lens+import Control.Monad+import Control.Monad.Error.Hoist+import Control.Monad.Trans+import Control.Monad.Unicode++import qualified Data.List as L+import Data.Maybe+import Data.Conduit+import qualified Data.Conduit.List as CL+import Prelude.Unicode++data ReshardingAction+  = SplitShardsAction+  | MergeShardsAction+  deriving (Eq, Show)++awaitStreamActive+  ∷ MonadReshard m+  ⇒ m ()+awaitStreamActive = do+  name ← kinesisStreamName+  DescribeStreamResponse StreamDescription{..} ← runKinesis DescribeStream+    { describeStreamLimit = Just 1+    , describeStreamExclusiveStartShardId = Nothing+    , describeStreamStreamName = name+    }+  case streamDescriptionStreamStatus of+    StreamStatusActive → return ()+    _ → awaitStreamActive++fetchShardsConduit+  ∷ MonadReshard m+  ⇒ Conduit (Maybe ShardId) m Shard+fetchShardsConduit = do+  name ← lift kinesisStreamName+  awaitForever $ \mshardId → do+    let req = DescribeStream+          { describeStreamExclusiveStartShardId = mshardId+          , describeStreamLimit = Nothing+          , describeStreamStreamName = name+          }+    resp@(DescribeStreamResponse StreamDescription{..}) ←+      lift $ runKinesis req+    yield `mapM_` streamDescriptionShards+    _ ← traverse (leftover ∘ Just) $+      describeStreamExclusiveStartShardId =≪+        nextIteratedRequest req resp+    return ()++shardsSource+  ∷ MonadReshard m+  ⇒ Source m Shard+shardsSource =+  CL.sourceList [Nothing]+    $= fetchShardsConduit++shardIsOpen+  ∷ Shard+  → Bool+shardIsOpen =+  isNothing+    ∘ view _2+    ∘ shardSequenceNumberRange++counterSink+  ∷ ( Monad m+    , Integral i+    )+  ⇒ Sink α m i+counterSink =+  CL.fold (\i _ → i + 1)  0++fetchOpenShards+  ∷ MonadReshard m+  ⇒ m [Shard]+fetchOpenShards = do+  awaitStreamActive+  shards ← shardsSource+    $= CL.filter shardIsOpen+    $$ CL.consume+  let orderShards s s' = compare (endingHashKey s) (endingHashKey s')+      endingHashKey = view _2 ∘ shardHashKeyRange+  return $ L.sortBy orderShards shards++countOpenShards+  ∷ ( MonadReshard m+    , Integral i+    )+  ⇒ m i+countOpenShards = do+  awaitStreamActive+  shardsSource+    $= CL.filter shardIsOpen+    $$ counterSink++-- | Get a 'PartitionHash' directly in between two other hashes.+partitionHashInRange+  ∷ (PartitionHash, PartitionHash)+  → Either InvalidPartitionHashException PartitionHash+partitionHashInRange range@(lower, upper) = do+  unless (upper > lower) $+    throwError $ InvalidPartitionHashRange range+  let upperInteger = partitionHashInteger upper+      lowerInteger = partitionHashInteger lower+      middleInteger = lowerInteger + (upperInteger - lowerInteger) `div` 2+  partitionHash middleInteger+    & either (Left ∘ InvalidPartitionHash middleInteger) return++performReshardingAction+  ∷ MonadReshard m+  ⇒ ReshardingAction+  → m ()+performReshardingAction SplitShardsAction = do+  stream ← kinesisStreamName+  shard ← (fetchOpenShards ^!? acts ∘ _head) <!?> SomeException (NoShardsFoundException stream)+  startingHashKey ← partitionHashInRange (shardHashKeyRange shard) <%?> SomeException+  SplitShardResponse ← runKinesis SplitShard+    { splitShardNewStartingHashKey = startingHashKey+    , splitShardShardToSplit = shardShardId shard+    , splitShardStreamName = stream+    }+  return ()+performReshardingAction MergeShardsAction = do+  stream ← kinesisStreamName+  openShards ← fetchOpenShards+  case take 2 $ shardShardId <$> openShards of+    [s,s'] → do+      MergeShardsResponse ← runKinesis MergeShards+        { mergeShardsShardToMerge = s+        , mergeShardsAdjacentShardToMerge = s'+        , mergeShardsStreamName = stream+        }+      return ()+    _ → return ()

@@ -0,0 +1,58 @@+-- Copyright (c) 2013-2014 PivotCloud, Inc.+--+-- Main+--+-- Please feel free to contact us at licensing@pivotmail.com with any+-- contributions, additions, or other feedback; we would love to hear from+-- you.+--+-- Licensed under the Apache License, Version 2.0 (the "License"); you may+-- not use this file except in compliance with the License. You may obtain a+-- copy of the License at http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT+-- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the+-- License for the specific language governing permissions and limitations+-- under the License.+--++{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UnicodeSyntax #-}++module Main where++import Aws.Kinesis.Reshard.Analysis+import Aws.Kinesis.Reshard.Monad+import Aws.Kinesis.Reshard.Shards++import Control.Concurrent.Lifted+import Control.Lens+import Control.Monad.Trans.Either+import Control.Monad.Trans.Reader (runReaderT)+import Control.Monad.Trans.Resource+import Control.Monad.Unicode+import Data.Traversable+import qualified Options.Applicative as OA+import Prelude.Unicode++loop+  ∷ MonadReshard m+  ⇒ m ()+loop = do+  recommendation ← analyzeStream+  liftIO ∘ putStrLn $+    case recommendation of+      Nothing → "No resharding action recommended at this time"+      Just rsa → "Will perform resharding action: " ++ show rsa+  _ ← for recommendation performReshardingAction+  threadDelay =≪ view oReshardingInterval+  loop++main ∷ IO ()+main =+  eitherT (fail ∘ show) return ∘ runResourceT $+    liftIO (OA.execParser parserInfo)+      ≫= runReaderT loop+