diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for aws-arn + +## 0.1.0.0 -- 2021-04-07 + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,29 @@ +Copyright (C) 2020-2021 Bellroy Pty Ltd + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the + distribution. + +3. Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,106 @@ +# aws-arn + +![CI Status](https://github.com/bellroy/aws-arn/actions/workflows/haskell-ci.yml/badge.svg) + +This library provides a type representing [Amazon Resource Names +(ARNs)](https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html), +and parsing/unparsing functions for them. The provided optics make it +very convenient to rewrite parts of ARNs. + +Start reading at the `Network.AWS.ARN` module, which defines the core +data type and includes some examples. + +The `ARN` type is not designed to be a 100% correct-by-construction +representation of only valid ARNs; it is designed to be a lightweight +way to destructure and reassemble ARNs to be used in place of string +munging. + +The library aims to provide additional parsers for destructuring the +"resource" part of an ARN, but many are missing right now. PRs to add +this support for more AWS resource types are **especially** welcome. + +## Guide: adding a resource + +Cribbing from an existing module (e.g., `Network.AWS.ARN.Lambda`) is +probably the easiest way to start, but here is an explicit process to +add a new resource: + +1. Create a module for the AWS service, if it doesn't already + exist. Example: `src/Network/AWS/ARN/Lambda.hs`. + +2. Define a record `Foo` to represent the parsed resource part of an + ARN, and derive (at least) `Eq`, `Ord`, `Hashable`, `Show` and + `Generic`. Also generate lenses for its fields: + + ```haskell + data Function = Function + { _fName :: Text, + _fQualifier :: Maybe Text + } + deriving (Eq, Ord, Hashable, Show, Generic) + + $(makeLenses ''Function) + ``` + +3. Define `toFoo` and `fromFoo` functions that attempt to parse and + unparse the resource part of the ARN: + + ```haskell + toFunction :: Text -> Maybe Function + fromFunction :: Function -> Text + ``` + + **Remark:** While these names sound backwards compared to + `fromText` and `toText`, it means we can have multiple parsing + functions in a single service's module. + + **Remark:** If you need to write tests for these functions, the + corresponding module should live at + `test/Network/AWS/ARN/SomeAWSService/Test.hs` + +4. Define a `_Foo` `Prism'` that combines the parsing/unparsing + functions above: + + ```haskell + _Function :: Prism' Text Function + _Function = prism' fromFunction toFunction + ``` + +5. Add the records, its fields, its parsing/unparsing functions, and + its optics to the service module's export list: + + ```haskell + module Network.AWS.ARN.Lambda + ( -- * Functions + Function (..), + toFunction, + fromFunction, + + -- ** Function Optics + _Function, + fName, + fQualifier, + ) + ``` + +6. Test your work and make a PR. + +## Formatters + +The formatters used in this repo are provided by `shell.nix`: + +* `*.hs`: [`ormolu`](https://github.com/tweag/ormolu) +* `*.cabal`: + [`cabal-fmt`](https://hackage.haskell.org/package/cabal-fmt) + (`cabal-fmt --inplace wai-handler-hal.cabal`) +* `*.nix`: + [`nixpkgs-fmt`](https://github.com/nix-community/nixpkgs-fmt) + (`nixpkgs-fmt *.nix`) + +## Regenerate CI + +This repo uses `haskell-ci`, which is provided by `shell.nix`: + +```shell +haskell-ci regenerate +``` diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/aws-arn.cabal b/aws-arn.cabal new file mode 100644 --- /dev/null +++ b/aws-arn.cabal @@ -0,0 +1,85 @@ +cabal-version: 2.2 +name: aws-arn +version: 0.1.0.0 +synopsis: + Types and optics for manipulating Amazon Resource Names (ARNs) + +description: + This library provides a type representing [Amazon Resource Names + (ARNs)](https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html), + and parsing/unparsing functions for them. The provided optics make + it very convenient to rewrite parts of ARNs. + . + Start reading at the "Network.AWS.ARN" module, which defines the + core data type and includes some examples. + . + The @ARN@ type is not designed to be a 100% correct-by-construction + representation of only valid ARNs; it is designed to be a + lightweight way to destructure and reassemble ARNs to be used in + place of string munging. + . + The library aims to provide additional parsers for destructuring the + "resource" part of an ARN, but many are missing right now. PRs to + add this support for more AWS resource types are __especially__ + welcome. + +bug-reports: http://github.com/bellroy/aws-arn/issues +license: BSD-3-Clause +license-file: LICENSE +author: Bellroy Tech Team +maintainer: Bellroy Tech Team +copyright: Copyright (C) 2020-2021 Bellroy Pty Ltd +category: AWS, Cloud +build-type: Simple +extra-source-files: + CHANGELOG.md + README.md + +tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 + +common opts + default-language: Haskell2010 + ghc-options: + -Wall -Wcompat -Widentities -Wincomplete-record-updates + -Wincomplete-uni-patterns -Werror=incomplete-patterns + -Wredundant-constraints -Wpartial-fields -Wtabs + -Wmissing-local-signatures -fhelpful-errors + -fprint-expanded-synonyms -fwarn-unused-do-bind + +common deps + build-depends: + , base >=4.12 && <4.15 + , deriving-compat ^>=0.5.10 + , lens >=4.18.1 && <5.1 + , text ^>=1.2.3 + +library + import: opts, deps + exposed-modules: + Network.AWS.ARN + Network.AWS.ARN.Lambda + + build-depends: hashable ^>=1.3.0.0 + hs-source-dirs: src + +test-suite spec + import: opts, deps + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: + Network.AWS.ARN.Lambda.Test + Network.AWS.ARN.Test + + hs-source-dirs: test + ghc-options: -threaded + build-depends: + , aws-arn + , tasty ^>=1.4.0.2 + , tasty-discover ^>=4.2.2 + , tasty-hunit ^>=0.10.0.3 + + build-tool-depends: tasty-discover:tasty-discover -any + +source-repository head + type: git + location: https://github.com/bellroy/aws-arn.git diff --git a/src/Network/AWS/ARN.hs b/src/Network/AWS/ARN.hs new file mode 100644 --- /dev/null +++ b/src/Network/AWS/ARN.hs @@ -0,0 +1,171 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_HADDOCK show-extensions #-} + +-- | +-- +-- Module : Network.AWS.ARN +-- Copyright : (C) 2020-2021 Bellroy Pty Ltd +-- License : BSD-3-Clause +-- Maintainer : Bellroy Tech Team +-- Stability : experimental +-- +-- Provides a type representing [Amazon Resource Names +-- (ARNs)](https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html), +-- and parsing/unparsing functions for them. The provided optics make it +-- very convenient to rewrite parts of ARNs. +-- +-- == Example +-- +-- [API Gateway Lambda +-- Authorizers](https://docs.aws.amazon.com/apigateway/latest/developerguide/apigateway-use-lambda-authorizer.html) +-- are given the ARN of the requested endpoint and method, and are +-- expected to respond with an IAM Policy Document. It is sometimes +-- useful to manipulate the given ARN when describing which resources to +-- authorize. +-- +-- Here, we generalize @authorizerSampleARN@ to cover every method of +-- every endpoint in the stage: +-- +-- @ +-- -- Returns "arn:aws:execute-api:us-east-1:123456789012:my-spiffy-api\/stage\/*" +-- let +-- authorizerSampleARN = "arn:aws:execute-api:us-east-1:123456789012:my-spiffy-api\/stage\/GET\/some\/deep\/path" +-- in +-- over ('_ARN' . 'arnResource' . 'slashes') (\parts -> take 2 parts ++ ["*"]) authorizerSampleARN +-- @ +module Network.AWS.ARN + ( ARN (..), + toARN, + fromARN, + + -- * ARN Optics + _ARN, + arnPartition, + arnService, + arnRegion, + arnAccount, + arnResource, + + -- * Utility Optics + colons, + slashes, + ) +where + +import Control.Lens (Iso', Prism', iso, makeLenses, prism') +import Data.Eq.Deriving (deriveEq1) +import Data.Hashable (Hashable) +import Data.Hashable.Lifted (Hashable1) +import Data.Ord.Deriving (deriveOrd1) +import Data.Text (Text) +import qualified Data.Text as T +import GHC.Generics (Generic, Generic1) +import Text.Show.Deriving (deriveShow1) + +-- $setup +-- >>> :set -XOverloadedStrings +-- >>> import Control.Lens + +-- | A parsed ARN. Either use the '_ARN' 'Prism'', or the 'toARN' and +-- 'fromARN' functions to convert @'Text' \<-\> 'ARN'@. The +-- '_arnResource' part of an ARN will often contain colon- or +-- slash-separated parts which precisely identify some resource. If +-- there is no service-specific module (see below), the 'colons' and +-- 'slashes' @'Control.Lens.Iso''@s in this module can pick apart the +-- `_arnResource` field. +-- +-- == Service-Specific Modules +-- +-- Modules like "Network.AWS.ARN.Lambda" provide types to parse the +-- resource part of an ARN into something more specific: +-- +-- @ +-- -- Remark: Lambda._Function :: 'Prism'' 'Text' Lambda.Function +-- -- Returns: Just "the-coolest-function-ever" +-- let +-- functionARN = "arn:aws:lambda:us-east-1:123456789012:function:the-coolest-function-ever:Alias" +-- in +-- functionARN ^? _ARN . arnResource . Lambda._Function . Lambda.fName +-- @ +-- +-- You can also use 'ARN'\'s 'Traversable' instance and +-- 'Control.Lens.Prism.below' to create 'Prism''s that indicate their +-- resource type in 'ARN'\'s type variable: +-- +-- @ +-- '_ARN' . 'Control.Lens.Prism.below' Lambda._Function :: 'Prism'' 'Text' ('ARN' Lambda.Function) +-- @ +data ARN r = ARN + { _arnPartition :: Text, + _arnService :: Text, + _arnRegion :: Text, + _arnAccount :: Text, + _arnResource :: r + } + deriving + ( Eq, + Ord, + Show, + Generic, + Generic1, + Hashable, + Hashable1, + Functor, + Foldable, + Traversable + ) + +$(makeLenses ''ARN) +$(deriveEq1 ''ARN) +$(deriveOrd1 ''ARN) +$(deriveShow1 ''ARN) + +toARN :: Text -> Maybe (ARN Text) +toARN t = case T.splitOn ":" t of + ("arn" : part : srv : reg : acc : res) -> + Just $ + ARN + { _arnPartition = part, + _arnService = srv, + _arnRegion = reg, + _arnAccount = acc, + _arnResource = T.intercalate ":" res + } + _ -> Nothing + +fromARN :: ARN Text -> Text +fromARN arn = + T.intercalate + ":" + [ "arn", + _arnPartition arn, + _arnService arn, + _arnRegion arn, + _arnAccount arn, + _arnResource arn + ] + +_ARN :: Prism' Text (ARN Text) +_ARN = prism' fromARN toARN +{-# INLINE _ARN #-} + +-- | Split a 'Text' into colon-separated parts. +-- +-- >>> "foo:bar:baz" & colons . ix 1 .~ "quux" +-- "foo:quux:baz" +colons :: Iso' Text [Text] +colons = iso (T.splitOn ":") (T.intercalate ":") +{-# INLINE colons #-} + +-- | Split a 'Text' into slash-separated parts. +-- +-- >>> "foo/bar/baz" ^. slashes +-- ["foo","bar","baz"] +slashes :: Iso' Text [Text] +slashes = iso (T.splitOn "/") (T.intercalate "/") +{-# INLINE slashes #-} diff --git a/src/Network/AWS/ARN/Lambda.hs b/src/Network/AWS/ARN/Lambda.hs new file mode 100644 --- /dev/null +++ b/src/Network/AWS/ARN/Lambda.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_HADDOCK show-extensions #-} + +-- | +-- +-- Module : Network.AWS.ARN.Lambda +-- Copyright : (C) 2020-2021 Bellroy Pty Ltd +-- License : BSD-3-Clause +-- Maintainer : Bellroy Tech Team +-- Stability : experimental +module Network.AWS.ARN.Lambda + ( -- * Functions + Function (..), + toFunction, + fromFunction, + + -- ** Function Optics + _Function, + fName, + fQualifier, + ) +where + +import Control.Lens +import Data.Hashable (Hashable) +import Data.Maybe (maybeToList) +import Data.Text (Text) +import qualified Data.Text as T +import GHC.Generics (Generic) + +-- $setup +-- >>> :set -XOverloadedStrings +-- >>> import Control.Lens + +-- | An AWS Lambda function name, and optional alias/version qualifier. +-- +-- >>> "function:helloworld" ^? _Function +-- Just (Function {_fName = "helloworld", _fQualifier = Nothing}) +-- +-- >>> "function:helloworld:$LATEST" ^? _Function +-- Just (Function {_fName = "helloworld", _fQualifier = Just "$LATEST"}) +-- +-- >>> "function:helloworld:42" ^? _Function +-- Just (Function {_fName = "helloworld", _fQualifier = Just "42"}) +data Function = Function + { _fName :: Text, + _fQualifier :: Maybe Text + } + deriving (Eq, Ord, Hashable, Show, Generic) + +$(makeLenses ''Function) + +toFunction :: Text -> Maybe Function +toFunction t = case T.splitOn ":" t of + ("function" : name : qual) -> + Just (Function name) <*> case qual of + [q] -> Just $ Just q + [] -> Just Nothing + _ -> Nothing + _ -> Nothing + +fromFunction :: Function -> Text +fromFunction f = + T.intercalate ":" $ + ["function", _fName f] ++ maybeToList (_fQualifier f) + +_Function :: Prism' Text Function +_Function = prism' fromFunction toFunction diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF tasty-discover #-} diff --git a/test/Network/AWS/ARN/Lambda/Test.hs b/test/Network/AWS/ARN/Lambda/Test.hs new file mode 100644 --- /dev/null +++ b/test/Network/AWS/ARN/Lambda/Test.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Network.AWS.ARN.Lambda.Test where + +import Control.Lens (set, (^?)) +import Network.AWS.ARN.Lambda +import Test.Tasty +import Test.Tasty.HUnit + +test_all :: TestTree +test_all = + testGroup + "Network.AWS.ARN.Lambda" + [ testGroup + "Function" + [ testGroup + "parsing" + [ testCase "unqualified function name" $ + "function:foo" ^? _Function @?= Just (Function "foo" Nothing), + testCase "qualified function name" $ + "function:bar:3" ^? _Function @?= Just (Function "bar" $ Just "3") + ], + testGroup + "updating" + [ testCase "setting qualifier" $ + set (_Function . fQualifier) (Just "baz") "function:foo" + @?= "function:foo:baz", + testCase "unsetting qualifier" $ + set (_Function . fQualifier) Nothing "function:quux:42" + @?= "function:quux" + ] + ] + ] diff --git a/test/Network/AWS/ARN/Test.hs b/test/Network/AWS/ARN/Test.hs new file mode 100644 --- /dev/null +++ b/test/Network/AWS/ARN/Test.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Network.AWS.ARN.Test where + +import Control.Lens (over, preview, review) +import Data.Text (Text) +import Network.AWS.ARN +import Test.Tasty +import Test.Tasty.HUnit + +test_all :: TestTree +test_all = + testGroup + "Network.AWS.ARN" + [ testGroup + "basic tests" + [ testCase "inspect function name and alias of Lambda ARN" $ + (_arnResource <$> toARN aliasedLambdaSampleARN) + @?= Just "function:the-coolest-function-ever:Alias", + testCase "parses empty region OK" $ + (_arnRegion <$> toARN s3FileSampleARN) @?= Just "", + testCase "parses empty account OK" $ + (_arnAccount <$> toARN s3FileSampleARN) @?= Just "", + testCase "rejects non-ARNs" $ + toARN sampleNotAnARN @?= Nothing + ], + testGroup + "optic tests" + [ testCase "prism roundtrip" $ + (review _ARN <$> preview _ARN authorizerSampleARN) + @?= Just authorizerSampleARN, + testCase "edit path of Lambda Authorizer ARN" $ + over (_ARN . arnResource . slashes) (\parts -> take 2 parts ++ ["*"]) authorizerSampleARN + @?= "arn:aws:execute-api:us-east-1:123456789012:my-spiffy-api/stage/*" + ] + ] + +authorizerSampleARN :: Text +authorizerSampleARN = "arn:aws:execute-api:us-east-1:123456789012:my-spiffy-api/stage/GET/some/deep/path" + +aliasedLambdaSampleARN :: Text +aliasedLambdaSampleARN = "arn:aws:lambda:us-east-1:123456789012:function:the-coolest-function-ever:Alias" + +s3FileSampleARN :: Text +s3FileSampleARN = "arn:aws:s3:::an-okay-bucket/sample.txt" + +sampleNotAnARN :: Text +sampleNotAnARN = "//library.googleapis.com/shelves/shelf1/books/book2"