kerry (empty) → 0.1
raw patch · 17 files changed
+1777/−0 lines, 17 filesdep +aesondep +aeson-prettydep +basesetup-changed
Dependencies added: aeson, aeson-pretty, base, bytestring, containers, errors, hedgehog, hedgehog-corpus, kerry, mmorph, mtl, process, resourcet, temporary-resourcet, text, transformers, transformers-bifunctors
Files
- CHANGELOG.md +14/−0
- LICENSE +28/−0
- README.md +50/−0
- Setup.hs +131/−0
- kerry.cabal +113/−0
- src/Kerry.hs +27/−0
- src/Kerry/Builder/AmazonEC2.hs +391/−0
- src/Kerry/Engine.hs +145/−0
- src/Kerry/Example.hs +80/−0
- src/Kerry/Internal/Prelude.hs +57/−0
- src/Kerry/Internal/Serial.hs +79/−0
- src/Kerry/Packer.hs +266/−0
- src/Kerry/Provisioner/File.hs +55/−0
- src/Kerry/Provisioner/Shell.hs +121/−0
- test/Test/Kerry/Gen.hs +147/−0
- test/Test/Kerry/Serial.hs +55/−0
- test/test.hs +18/−0
+ CHANGELOG.md view
@@ -0,0 +1,14 @@+## Version 0.1++- Initial Packer types ([@nhibberd][nhibberd])+- Packer serialization ([@nhibberd][nhibberd])+- Added 'amazon-ebs' builder type ([@nhibberd][nhibberd])+- Added 'shell' provisioner ([@nhibberd][nhibberd])+- Added 'file' provisioner ([@nhibberd][nhibberd])++## Version 0.0++- Started project ([@nhibberd][nhibberd])++[nhibberd]:+ https://github.com/nhibberd
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright 2019, Nick Hibberd <nhibberd@gmail.com>, All Rights Reserved.++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.
+ README.md view
@@ -0,0 +1,50 @@+kerry+=====++[Packer](https://www.packer.io/) configuration and serialization.++++## Example++```haskell++import Kerry++write :: FilePath -> IO ()+write path =+ writeFile path (renderPacker example)++example :: Packer+example =+ Packer {+ variables = [+ UserVariable "name" "example-packer"+ ]+ , builders = [+ Builder (AmazonEBSBuilder $ aws builder) Nothing ssh+ ]+ , provisioners = []+ , postProcessors = []+ }++ssh :: Communicator+ssh =+ SSH $ defaultSSHCommunicator "ec2-user"++aws :: a -> AWS a+aws builder =+ AWS {+ awsRegion = "us-west-2"+ , awsCredentials = EnvironmentVariables+ , awsBuilder = builder+ }++builder :: EBS+builder =+ ebs+ "test"+ (SourceAmiId "ami-fred")+ "m4.xlarge"++```
+ Setup.hs view
@@ -0,0 +1,131 @@+{-# OPTIONS_GHC -fno-warn-deprecations #-}+{-# LANGUAGE CPP #-}++import Data.Char (isDigit)+import Data.List (intercalate)+import Data.Monoid ((<>))++import Distribution.InstalledPackageInfo+import Distribution.PackageDescription+import Distribution.Simple (buildHook, defaultMainWithHooks, pkgName, pkgVersion, preConf, replHook, sDistHook, simpleUserHooks, testHook)+import Distribution.Simple.Setup (BuildFlags(..), ReplFlags(..), TestFlags(..), fromFlag)+import Distribution.Simple.LocalBuildInfo+import Distribution.Simple.PackageIndex+import Distribution.Simple.Utils (createDirectoryIfMissingVerbose, rewriteFile, rawSystemStdout)+import Distribution.Verbosity++#ifndef MIN_VERSION_Cabal+#if __GLASGOW_HASKELL__ <= 710+-- GHC 7.10 and earlier do not support the MIN_VERSION_Cabal macro.+#define MIN_VERSION_Cabal(a,b,c) 0+#endif+#endif++#if MIN_VERSION_Cabal(2,0,0)+import Distribution.Types.PackageName (unPackageName)+import Distribution.Simple.BuildPaths (autogenPackageModulesDir)+import Distribution.Version (Version, versionNumbers)++showVersion :: Version -> String+showVersion = intercalate "." . fmap show . versionNumbers++autogenModulesDirCompat :: LocalBuildInfo -> String+autogenModulesDirCompat = autogenPackageModulesDir++#else+import Distribution.Simple (unPackageName)+import Distribution.Simple.BuildPaths (autogenModulesDir)+import Data.Version (showVersion)++autogenModulesDirCompat :: LocalBuildInfo -> String+autogenModulesDirCompat = autogenModulesDir+#endif+++main :: IO ()+main =+ let hooks = simpleUserHooks+ in defaultMainWithHooks hooks {+ preConf = \args flags -> do+ createDirectoryIfMissingVerbose silent True "gen"+ preConf hooks args flags+ , sDistHook = \pd mlbi uh flags -> do+ genBuildInfo silent pd+ sDistHook hooks pd mlbi uh flags+ , buildHook = \pd lbi uh flags -> do+ genBuildInfo (fromFlag $ buildVerbosity flags) pd+ genDependencyInfo (fromFlag $ buildVerbosity flags) pd lbi+ buildHook hooks pd lbi uh flags+ , replHook = \pd lbi uh flags args -> do+ genBuildInfo (fromFlag $ replVerbosity flags) pd+ genDependencyInfo (fromFlag $ replVerbosity flags) pd lbi+ replHook hooks pd lbi uh flags args+ , testHook = \args pd lbi uh flags -> do+ genBuildInfo (fromFlag $ testVerbosity flags) pd+ genDependencyInfo (fromFlag $ testVerbosity flags) pd lbi+ testHook hooks args pd lbi uh flags+ }++genBuildInfo :: Verbosity -> PackageDescription -> IO ()+genBuildInfo verbosity pkg = do+ createDirectoryIfMissingVerbose verbosity True "gen"+ let pname = unPackageName . pkgName . package $ pkg+ version = pkgVersion . package $ pkg+ name = "BuildInfo_" ++ map (\c -> if c == '-' then '_' else c) pname+ targetHs = "gen/" ++ name ++ ".hs"+ targetText = "gen/version.txt"+ t <- timestamp verbosity+ gv <- gitVersion verbosity+ let v = showVersion version+ let buildVersion = intercalate "-" [v, t, gv]+ rewriteFile targetHs $ unlines [+ "module " ++ name ++ " where"+ , "import Prelude"+ , "data RuntimeBuildInfo = RuntimeBuildInfo { buildVersion :: String, timestamp :: String, gitVersion :: String }"+ , "buildInfo :: RuntimeBuildInfo"+ , "buildInfo = RuntimeBuildInfo \"" ++ v ++ "\" \"" ++ t ++ "\" \"" ++ gv ++ "\""+ , "buildInfoVersion :: String"+ , "buildInfoVersion = \"" ++ buildVersion ++ "\""+ ]+ rewriteFile targetText buildVersion++genDependencyInfo :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()+genDependencyInfo verbosity pkg info = do+ let+ pname = unPackageName . pkgName . package $ pkg+ name = "DependencyInfo_" ++ map (\c -> if c == '-' then '_' else c) pname+ targetHs = autogenModulesDirCompat info ++ "/" ++ name ++ ".hs"+ render p =+ let+ n = unPackageName $ pkgName p+ v = showVersion $ pkgVersion p+ in+ n ++ "-" ++ v+ deps = fmap (render . sourcePackageId) . allPackages $ installedPkgs info+ strs = flip fmap deps $ \d -> "\"" ++ d ++ "\""++ createDirectoryIfMissingVerbose verbosity True (autogenModulesDirCompat info)++ rewriteFile targetHs $ unlines [+ "module " ++ name ++ " where"+ , "import Prelude"+ , "dependencyInfo :: [String]"+ , "dependencyInfo = [\n " ++ intercalate "\n , " strs ++ "\n ]"+ ]++gitVersion :: Verbosity -> IO String+gitVersion verbosity = do+ ver <- rawSystemStdout verbosity "git" ["log", "--pretty=format:%h", "-n", "1"]+ notModified <- ((>) 1 . length) `fmap` rawSystemStdout verbosity "git" ["status", "--porcelain"]+ return $ ver ++ if notModified then "" else "-M"++timestamp :: Verbosity -> IO String+timestamp verbosity =+ rawSystemStdout verbosity "date" ["+%Y%m%d%H%M%S"] >>= \s ->+ case splitAt 14 s of+ (d, [_]) ->+ if length d == 14 && filter isDigit d == d+ then return d+ else fail $ "date has failed to produce the correct format [" <> s <> "]."+ _ ->+ fail $ "date has failed to produce a date long enough [" <> s <> "]."
+ kerry.cabal view
@@ -0,0 +1,113 @@+name:+ kerry+version:+ 0.1+homepage:+ https://github.com/nhibberd/kerry#readme+bug-reports:+ https://github.com/nhibberd/kerry/issues+synopsis:+ Manage and abstract your packer configurations.+description:+ Kerry is a library for representing and rendering+ <https://www.packer.io/ packer> definitions.+ .+ To get started quickly, see the <https://github.com/nhibberd/kerry/blob/master/src/Kerry/Example.hs example>.+license:+ BSD3+category:+ Infrastructure, AWS, Cloud+license-file:+ LICENSE+author:+ Nick Hibberd <nhibberd@gmail.com>+maintainer:+ Nick Hibberd <nhibberd@gmail.com>+copyright:+ Copyright: (c) 2019 Nick Hibberd+build-type:+ Simple+extra-doc-files:+ README.md+ CHANGELOG.md+cabal-version:+ 1.18++source-repository head+ type: git+ location: git://github.com/nhibberd/kerry.git++library+ build-depends:+ base >= 4.5 && < 5+ , aeson >= 1.4 && < 1.5+ , aeson-pretty >= 0.8 && < 1+ , bytestring >= 0.10 && < 0.11+ , containers >= 0.5 && < 0.7+ , errors >= 2.0 && < 2.4+ , mmorph >= 1.0 && < 1.2+ , text >= 1.2 && < 1.3+ , transformers >= 0.5 && < 0.6+ , transformers-bifunctors >= 0.1 && < 0.2++ default-language:+ Haskell2010++ ghc-options:+ -Wall++ hs-source-dirs:+ src++ exposed-modules:+ Kerry++ Kerry.Engine+ Kerry.Packer++ Kerry.Builder.AmazonEC2++ Kerry.Provisioner.File+ Kerry.Provisioner.Shell++ Kerry.Internal.Prelude+ Kerry.Internal.Serial++ other-modules:+ Kerry.Example++test-suite test+ type:+ exitcode-stdio-1.0++ hs-source-dirs:+ test++ main-is:+ test.hs++ other-modules:+ Test.Kerry.Gen+ Test.Kerry.Serial++ build-depends:+ kerry+ , aeson >= 1.4 && < 1.5+ , base+ , bytestring >= 0.10 && < 0.11+ , containers >= 0.5 && < 0.7+ , mmorph >= 1.0 && < 1.2+ , mtl >= 2.1 && < 2.3+ , hedgehog >= 1.0 && < 2.0+ , hedgehog-corpus >= 0.1 && < 1.0+ , process >= 1.2 && < 1.7+ , resourcet >= 1.1 && < 1.3+ , temporary-resourcet >= 0.1 && < 0.2+ , text >= 1.2 && < 1.3+ , transformers >= 0.5 && < 0.6++ default-language:+ Haskell2010++ ghc-options:+ -Wall -threaded -rtsopts -with-rtsopts=-N
+ src/Kerry.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Kerry (+ -- * Core data types+ Packer(..)+ , renderPacker++ , UserVariable(..)++ , Builder(..)+ , BuilderType(..)+ , Communicator(..)+ , defaultSSHCommunicator++ , Provisioner(..)+ , provisioner+ , ProvisionerType(..)++ , PostProcessor(..)+ ) where+++import Kerry.Packer (Packer(..), renderPacker)+import Kerry.Packer (UserVariable(..))+import Kerry.Packer (Builder(..), BuilderType(..))+import Kerry.Packer (Communicator(..), defaultSSHCommunicator)+import Kerry.Packer (Provisioner(..), ProvisionerType(..), provisioner)+import Kerry.Packer (PostProcessor(..))
+ src/Kerry/Builder/AmazonEC2.hs view
@@ -0,0 +1,391 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Kerry.Builder.AmazonEC2 (+ -- * General AmazonEC2 Builder+ Credentials(..)+ , AWS(..)+ , fromAWS++ -- * Utilities+ , SourceAmi(..)+ , AWSAmiOwner(..)+ , SourceAmiFilterKey(..)+ , BlockDeviceMapping(..)+ , blockDeviceMapping++ -- * Builders+ -- ** EBS Backed+ , EBS(..)+ , ebs+ , fromEBS++ ) where++import Data.Aeson ((.=))+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Types as Aeson+import qualified Data.Map as Map++import Kerry.Internal.Prelude+import Kerry.Internal.Serial++data Credentials =+ AWSProfile Text+ | EnvironmentVariables+ -- TODO explicit keys?+ deriving (Eq, Show)++data AWS x =+ AWS {+ awsRegion :: Text+ , awsCredentials :: Credentials+ , awsBuilder :: x+ } deriving (Eq, Show)++fromAWS :: (a -> [Aeson.Pair]) -> AWS a -> [Aeson.Pair]+fromAWS fromBuilder (AWS region creds builder) =+ join [+ ["region" .= region]+ , case creds of+ AWSProfile profile ->+ ["profile" .= profile]+ EnvironmentVariables ->+ []+ , fromBuilder builder+ ]++data SourceAmi =+ SourceAmiId Text+ | SourceAmiFilter (Map SourceAmiFilterKey Text) AWSAmiOwner Bool+ deriving (Eq, Show)++data AWSAmiOwner =+ Accounts [Text]+ | Self+ | Alias Text+ deriving (Eq, Show)++data SourceAmiFilterKey =+ -- | The image architecture (i386 | x86_64).+ Architecture+ -- | A Boolean value that indicates whether the Amazon EBS volume is deleted on instance termination.+ | BlockDeviceMappingDeleteOnTermination+ -- | The device name specified in the block device mapping (for example, /dev/sdh or xvdh).rmination+ | BlockDeviceMappingDeviceName+ -- | The ID of the snapshot used for the EBS volume.+ | BlockDeviceMappingSnapshotId+ -- | The volume size of the EBS volume, in GiB.+ | BlockDeviceMappingVolumeSize+ -- | The volume type of the EBS volume (gp2 | io1 | st1 | sc1 | standard).+ | BlockDeviceMappingVolumeType+ -- | A Boolean that indicates whether the EBS volume is encrypted.e+ | BlockDevice+ -- | The description of the image (provided during image creation).-mapping.encrypted+ | Description+ -- | A Boolean that indicates whether enhanced networking with ENA is enabled.+ | EnaSupport+ -- | The hypervisor type (ovm | xen).+ | Hypervisor+ -- | The ID of the image.r+ | ImageId+ -- | The image type (machine | kernel | ramdisk).+ | ImageType+ -- | A Boolean that indicates whether the image is public.+ | IsPublic+ -- | The kernel ID.+ | KernelId+ -- | The location of the image manifest.+ | ManifestLocation+ -- | The name of the AMI (provided during image creation).est-location+ | Name+ -- | String value from an Amazon-maintained list (amazon | aws-marketplace | microsoft) of snapshot owners. Not to be confused with the user-configured AWS account alias, which is set from the IAM console.+ | OwnerAlias+ -- | The AWS account ID of the image owner.as+ | OwnerId+ -- | The platform. To only list Windows-based AMIs, use windows.+ | Platform+ -- | The product code.+ | ProductCode+ -- | The type of the product code (devpay | marketplace).+ | ProductCodeType+ -- | The RAM disk ID+ | RamdiskId+ -- | The device name of the root device volume (for example, /dev/sda1).+ | RootDeviceName+ -- | The type of the root device volume (ebs | instance-store).+ | RootDeviceType+ -- | The state of the image (available | pending | failed).evice-type+ | State+ -- | The reason code for the state change.+ | StateReasonCode+ -- | The message for the state change.+ | StateReasonMessage+ -- | A value of simple indicates that enhanced networking with the Intel 82599 VF interface is enabled.ge+ | SriovNetSupport+ -- | The key/value combination of a tag assigned to the resource. Use the tag key in the filter name and the tag value as the filter value. For example, to find all resources that have a tag with the key Owner and the value TeamA, specify tag:Owner for the filter name and TeamA for the filter value.support+ | Tag Text+ -- | The key of a tag assigned to the resource. Use this filter to find all resources assigned a tag with a specific key, regardless of the tag value.>+ | TagKey+ -- | The virtualization type (paravirtual | hvm).+ | VirtualizationType+-- deriving (Eq, Show, Enum, Bounded)+ deriving (Eq, Show)++renderSourceAmiFilterKey :: SourceAmiFilterKey -> Text+renderSourceAmiFilterKey = \case+ Architecture ->+ "architecture"+ BlockDeviceMappingDeleteOnTermination ->+ "block-device-mapping.delete-on-termination"+ BlockDeviceMappingDeviceName ->+ "block-device-mapping.device-name"+ BlockDeviceMappingSnapshotId ->+ "block-device-mapping.snapshot-id"+ BlockDeviceMappingVolumeSize ->+ "block-device-mapping.volume-size"+ BlockDeviceMappingVolumeType ->+ "block-device-mapping.volume-type"+ BlockDevice ->+ "block-device-mapping.encrypted"+ Description ->+ "description"+ EnaSupport ->+ "ena-support"+ Hypervisor ->+ "hypervisor"+ ImageId ->+ "image-id"+ ImageType ->+ "image-type"+ IsPublic ->+ "is-public"+ KernelId ->+ "kernel-id"+ ManifestLocation ->+ "manifest-location"+ Name ->+ "name"+ OwnerAlias ->+ "owner-alias"+ OwnerId ->+ "owner-id"+ Platform ->+ "platform"+ ProductCode ->+ "product-code"+ ProductCodeType ->+ "product-code.type"+ RamdiskId ->+ "ramdisk-id"+ RootDeviceName ->+ "root-device-name"+ RootDeviceType ->+ "root-device-type"+ State ->+ "state"+ StateReasonCode ->+ "state-reason-code"+ StateReasonMessage ->+ "state-reason-message"+ SriovNetSupport ->+ "sriov-net-support"+ Tag key ->+ "tag:" <> key+ TagKey ->+ "tag-key"+ VirtualizationType ->+ "virtualization-type"++-- https://github.com/hashicorp/packer/blob/5504709e1dba015b5e7858e9a870ad4ff7bf7b6e/builder/amazon/common/block_device.go+-- NoDevice | Ephemeral (+ Name) | Mapping *+data BlockDeviceMapping =+ BlockDeviceMapping {+ -- | The device name exposed to the instance (for example, /dev/sdh or xvdh). Required for every device in the block device mapping.+ blockDeviceMappingName :: Text+ -- | The volume type. gp2 for General Purpose (SSD) volumes, io1 for Provisioned IOPS (SSD) volumes, and standard for Magnetic volumes+ , blockDeviceMappingVolumeType :: Text+ -- | The number of I/O operations per second (IOPS) that the volume supports. See the documentation on IOPs for more information+ , blockDeviceMappingIOPS :: Maybe Int -- only when VolumeType "io1" (/ "gp2" / "standard")+ -- | The size of the volume, in GiB. Required if not specifying a snapshot_id+ , blockDeviceMappingVolumeSize :: Int+ -- | Indicates whether the EBS volume is deleted on instance termination. Default false. NOTE: If this value is not explicitly set to true and volumes are not cleaned up by an alternative method, additional volumes will accumulate after every build.+ , blockDeviceMappingDeleteOnTermination :: Bool+ -- | Indicates whether or not to encrypt the volume. By default, Packer will keep the encryption setting to what it was in the source image. Setting false will result in an unencrypted device, and true will result in an encrypted one.+ , blockDeviceMappingEncrypted :: Bool -- incompatible with 'SnapshotId'+ -- | KMS Key ID to use when 'encrytped' is set to True.+ , blockDeviceMappingKMS :: Maybe Text -- only when Encrypted+ -- | The ID of the snapshot+ , blockDeviceMappingSnapshotId :: Maybe Text+ -- | Suppresses the specified device included in the block device mapping of the AMI+ , blockDeviceMappingVirtualName :: Maybe Text -- prefixed with 'ephemeral' for+ -- | The virtual device name. See the documentation on Block Device Mapping for more information+ , blockDeviceMappingNoDevice :: Maybe Bool+ } deriving (Eq, Show)++-- | Construct a basic 'BlockDeviceMapping'+blockDeviceMapping :: Text -> Text -> Int -> Bool -> BlockDeviceMapping+blockDeviceMapping name vtype vsize delete =+ BlockDeviceMapping {+ blockDeviceMappingName = name+ , blockDeviceMappingVolumeType = vtype+ , blockDeviceMappingIOPS = Nothing+ , blockDeviceMappingVolumeSize = vsize+ , blockDeviceMappingDeleteOnTermination = delete+ , blockDeviceMappingEncrypted = False+ , blockDeviceMappingKMS = Nothing+ , blockDeviceMappingSnapshotId = Nothing+ , blockDeviceMappingVirtualName = Nothing+ , blockDeviceMappingNoDevice = Nothing+ }++-- | Amazon AMI Builder+--+-- Create EBS-backed AMIs by launching a source AMI and re-packaging+-- it into a new AMI after provisioning. If in doubt, use this+-- builder, which is the easiest to get started with.+--+-- https://www.packer.io/docs/builders/amazon-ebs.html+--+-- 'amazon-ebs'+data EBS =+ EBS {+ -- Required+ ebsAmiName :: Text -- ^ ami_name+ , ebsSourceAmi :: SourceAmi -- ^ source_ami+ , ebsInstanceType :: Text -- ^ instance_type++ -- Optional+ , ebsAmiDescription :: Maybe Text -- ^ ami_description+ -- ami_groups+ -- ami_product_codes+ , ebsAmiRegions :: Maybe [Text] -- ^ ami_regions+ , ebsAmiUsers :: Maybe [Text] -- ^ ami_users+ -- ami_virtualization_type+ , ebsAssociatePublicIpAddress :: Maybe Bool -- ^ associate_public_ip_address+ , ebsAvailabilityZone :: Maybe Text -- ^ availability_zone+ -- block_duration_minutes+ -- custom_endpoint_ec2+ -- decode_authorization_messages+ -- disable_stop_instance+ -- ebs_optimized+ -- ena_support+ -- enable_t2_unlimited+ -- encrypt_boot+ -- kms_key_id+ -- force_delete_snapshot+ -- force_deregister+ , ebsIAMInstanceProfile :: Maybe Text -- ^ iam_instance_profile+ , ebsInsecureSkipTLSVerify :: Maybe Bool -- ^ insecure_skip_tls_verify+ , ebsLaunchBlockDeviceMappings :: [BlockDeviceMapping] -- ^ launch_block_device_mappings+ -- mfa_code+ -- profile+ -- region_kms_key_ids+ , ebsRunTags :: Map Text Text -- ^ run_tags+ -- run_volume_tags+ -- security_group_id+ -- security_group_ids+ -- security_group_filter+ -- shutdown_behavior+ -- skip_region_validation+ -- snapshot_groups+ -- snapshot_users+ -- snapshot_tags+ -- spot_price+ -- spot_price_auto_product+ -- spot_tags+ -- sriov_support+ -- ssh_keypair_name+ -- ssh_agent_auth+ -- ssh_interface+ , ebsSubnetId :: Maybe Text -- ^ subnet_id+ -- subnet_filter - https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_DescribeSubnets.html+ , ebsTags :: Map Text Text -- ^ tags+ -- temporary_key_pair_name+ -- temporary_security_group_source_cidrs+ -- token+ -- user_data+ -- user_data_file+ -- vault_aws_engine+ , ebsVpcId :: Maybe Text -- ^ vpc_id+ -- vpc_filter - https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_DescribeVpcs.html+ -- windows_password_timeout+ } deriving (Eq, Show)+++-- | Construct a basic @amazon-ebs@ builder.+ebs :: Text -> SourceAmi -> Text -> EBS+ebs name sourceami instancetype =+ EBS {+ ebsAmiName = name+ , ebsSourceAmi = sourceami+ , ebsInstanceType = instancetype+ , ebsAmiDescription = Nothing+ , ebsAmiRegions = Nothing+ , ebsAmiUsers = Nothing+ , ebsAssociatePublicIpAddress = Nothing+ , ebsAvailabilityZone = Nothing+ , ebsIAMInstanceProfile = Nothing+ , ebsInsecureSkipTLSVerify = Nothing+ , ebsLaunchBlockDeviceMappings = []+ , ebsRunTags = mempty+ , ebsSubnetId = Nothing+ , ebsTags = mempty+ , ebsVpcId = Nothing+ }++-- | EBS serialization+fromEBS :: EBS -> [Aeson.Pair]+fromEBS e = join [+ ["type" .= t "amazon-ebs"]+ , ["ami_name" .= ebsAmiName e]+ , [fromSourceAmi $ ebsSourceAmi e]+ , ["instance_type" .= ebsInstanceType e]+ , "ami_description" .=? ebsAmiDescription e+ , "ami_regions" .=? ebsAmiRegions e+ , "ami_users" .=? ebsAmiUsers e+ , "associate_public_ip_address" .=? ebsAssociatePublicIpAddress e+ , "availability_zone" .=? ebsAvailabilityZone e+ , "iam_instance_profile" .=? ebsIAMInstanceProfile e+ , "insecure_skip_tls_verify" .=? ebsInsecureSkipTLSVerify e+ , "launch_block_device_mappings" .=? list (fromBlockDeviceMapping <$> ebsLaunchBlockDeviceMappings e)+ , ["run_tags" .= fromMap (ebsRunTags e)]+ , "subnet_id" .=? ebsSubnetId e+ , ["tags" .= fromMap (ebsTags e)]+ , "vpc_id" .=? ebsVpcId e+ ]++fromSourceAmi :: SourceAmi -> Aeson.Pair+fromSourceAmi = \case+ SourceAmiId x ->+ "source_ami" .= x+ SourceAmiFilter filters owner recent ->+ "source_ami_filter" .= Aeson.object [+ "filters" .= fromMap (Map.mapKeys renderSourceAmiFilterKey filters)+ , "owners" .= case owner of+ Accounts as ->+ Aeson.toJSON as+ Self ->+ Aeson.String "self"+ Alias a ->+ Aeson.String a+ , "most_recent" .= recent+ ]++fromBlockDeviceMapping :: BlockDeviceMapping -> Aeson.Value+fromBlockDeviceMapping b =+ Aeson.object $ join [[+ "device_name" .= blockDeviceMappingName b+ , "volume_type" .= blockDeviceMappingVolumeType b+ , "volume_size" .= blockDeviceMappingVolumeSize b+ , "delete_on_termination" .= blockDeviceMappingDeleteOnTermination b+ , "encrypted" .= blockDeviceMappingEncrypted b+ ]+ , "iops" .=? blockDeviceMappingIOPS b+ , "kms_key_id" .=? blockDeviceMappingKMS b+ , "snapshot_id" .=? blockDeviceMappingSnapshotId b+ , "virtual_name" .=? blockDeviceMappingVirtualName b+ , "no_device" .=? blockDeviceMappingNoDevice b+ ]
+ src/Kerry/Engine.hs view
@@ -0,0 +1,145 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++-- | All strings within templates are processed by a common Packer+-- templating engine, where variables and functions can be used to+-- modify the value of a configuration parameter at runtime.+module Kerry.Engine (+ Template (..)+ , RawTemplate+ , toTemplate+ , renderRawTemplate++ -- * User Variable+ , user++ -- * Template Variable+ , templateVariable++ -- * Functions+ , buildName+ , buildType+ , env+ , isotime+ , lower+ , pwd+ , sed+ , split+ , templateDir+ , timestamp+ , uuid+ , upper+ , packerVersion+ , cleanResourceName+ ) where++import qualified Data.Text as T++import Kerry.Internal.Prelude++newtype Template =+ Template {+ renderTemplate :: Text+ } deriving (Eq, Show)++newtype RawTemplate =+ RawTemplate {+ _rawTemplate :: Text+ } deriving (Eq, Show)++toTemplate :: RawTemplate -> Template+toTemplate (RawTemplate raw) =+ Template $ "{{" <> raw <> "}}"++renderRawTemplate :: RawTemplate -> Text+renderRawTemplate =+ renderTemplate . toTemplate++-- | User variables+user :: Text -> RawTemplate+user variable =+ RawTemplate $ " user `" <> variable <> "` "++-- | Template variables are special variables automatically set by+-- Packer at build time. Some builders, provisioners and other+-- components have template variables that are available only for that+-- component. Template variables are recognizable because they're+-- prefixed by a period, such as {{ .Name }}.+templateVariable :: Text -> Template+templateVariable variable =+ Template $ "{{." <> variable <> "}}"+++-- | The name of the build being run.+buildName :: RawTemplate+buildName =+ RawTemplate "build_name"++-- | The type of the builder being used currently.+buildType :: RawTemplate+buildType =+ RawTemplate "build_type"++-- | Returns environment variables. See example in using home variable+env :: Text -> RawTemplate+env variable =+ RawTemplate $ "env `" <> variable <> "`"++-- | UTC time, which can be formatted. See more examples below in the isotime format reference.+isotime :: Text -> RawTemplate+isotime format =+ RawTemplate $ "isotime " <> format++-- | Lowercases the string.+lower :: RawTemplate+lower =+ RawTemplate "lower"++-- | The working directory while executing Packer.+pwd :: RawTemplate+pwd =+ RawTemplate "pwd"++-- | Use a golang implementation of sed to parse an input string.+sed :: Text -> Text -> RawTemplate+sed a b =+ RawTemplate $ "sed " <> a <> " " <> b <> ""++-- | Split an input string using separator and return the requested substring.+split :: Text -> Text -> Int -> RawTemplate+split a b c =+ RawTemplate $ "split " <> a <> " " <> b <> " " <> (T.pack $ show c) <> ""++-- | The directory to the template for the build.+templateDir :: RawTemplate+templateDir =+ RawTemplate "template_dir"++-- | The current Unix timestamp in UTC.+timestamp :: RawTemplate+timestamp =+ RawTemplate "timestamp"++-- | Returns a random UUID.+uuid :: RawTemplate+uuid =+ RawTemplate "uuid"++-- | Uppercases the string.+upper :: RawTemplate+upper =+ RawTemplate "upper"++-- | Returns Packer version.+packerVersion :: RawTemplate+packerVersion =+ RawTemplate "packer_version"++-- | Image names can only contain certain characters and have a+-- maximum length, eg 63 on GCE & 80 on Azure. clean_resource_name+-- will convert upper cases to lower cases and replace illegal+-- characters with a "-" character.+cleanResourceName :: RawTemplate+cleanResourceName =+ RawTemplate "clean_resource_name"
+ src/Kerry/Example.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Kerry.Example (+ example+ ) where++import qualified Data.Map as Map++import Kerry+import Kerry.Builder.AmazonEC2 (AWS(..), Credentials(..))+import Kerry.Builder.AmazonEC2 (SourceAmi(..))+import Kerry.Builder.AmazonEC2 (blockDeviceMapping)+import Kerry.Builder.AmazonEC2 (EBS(..))++import Kerry.Provisioner.Shell (ShellType(..), shell)++import qualified Kerry.Engine as F++import Kerry.Internal.Prelude++example :: Packer+example =+ Packer {+ variables = [+ UserVariable "name" "example-packer"+ ]+ , builders = [+ Builder (AmazonEBSBuilder $ aws builder) Nothing ssh+ ]+ , provisioners = [+ shellProvisioner+ ]+ , postProcessors = []+ }++ssh :: Communicator+ssh =+ SSH $ defaultSSHCommunicator "ec2-user"++aws :: a -> AWS a+aws b =+ AWS {+ awsRegion = "us-west-2"+ , awsCredentials = EnvironmentVariables+ , awsBuilder = b+ }++builder :: EBS+builder =+ EBS {+ ebsAmiName = "test"+ , ebsSourceAmi = SourceAmiId "ami-fred"+ , ebsInstanceType = "m4.xlarge"+ , ebsAmiDescription = Nothing+ , ebsAmiRegions = Nothing+ , ebsAmiUsers = Nothing+ , ebsAssociatePublicIpAddress = Just True+ , ebsAvailabilityZone = Nothing+ , ebsIAMInstanceProfile = Just "iam-fred"+ , ebsInsecureSkipTLSVerify = Nothing+ , ebsLaunchBlockDeviceMappings = [+ blockDeviceMapping "/dev/xvda" "gp2" 200 True+ ]+ , ebsRunTags = Map.fromList [+ ("name", F.renderRawTemplate $ F.user "name")+ ]+ , ebsSubnetId = Nothing+ , ebsTags = Map.fromList [+ ("created", F.renderRawTemplate F.timestamp)+ ]+ , ebsVpcId = Nothing+ }+++shellProvisioner :: Provisioner+shellProvisioner =+ provisioner . ShellProvisioner . shell $+ Inline ["echo foo"]
+ src/Kerry/Internal/Prelude.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Kerry.Internal.Prelude (+ module X+ , hoistEither+ , hoistMaybe+ , joinEither+ , syncIO+ ) where++import Control.Applicative as X hiding (empty)+import qualified Control.Error.Util as Error+import Control.Exception as X (SomeException)+import Control.Monad as X+import Control.Monad.IO.Class as X+import Control.Monad.Morph as X (hoist)+import Control.Monad.Trans.Bifunctor as X+import Control.Monad.Trans.Except as X (ExceptT(..), runExceptT)++import Data.Bifunctor as X+import Data.ByteString as X (ByteString)+import Data.Foldable as X (traverse_, for_)+import Data.Int as X (Int8, Int16, Int32, Int64)+import Data.Map as X (Map)+import Data.Maybe as X+import Data.Semigroup as X+import Data.Set as X (Set)+import Data.Text as X (Text)+import Data.Traversable as X (traverse, for)+import Data.Void as X (Void)+import Data.Word as X (Word8, Word16, Word32, Word64)++import Prelude as X+++hoistEither :: Monad m => Either x a -> ExceptT x m a+hoistEither =+ ExceptT . pure++hoistMaybe :: Monad m => x -> Maybe a -> ExceptT x m a+hoistMaybe err = \case+ Nothing ->+ hoistEither $ Left err+ Just x ->+ pure x++joinEither :: Either (Either a b) (Either a b) -> Either a b+joinEither = \case+ Left x ->+ x+ Right x ->+ x++syncIO :: MonadIO m => IO a -> ExceptT SomeException m a+syncIO =+ hoist liftIO . Error.syncIO
+ src/Kerry/Internal/Serial.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+++module Kerry.Internal.Serial (+ list+ , listToObject+ , (.=?)+ , fromMap+ , fromMapWith+ , t++ , asTextWith+ , asByteStringWith++ , prettyAsTextWith+ , prettyAsByteStringWith++ ) where++import Data.Aeson (Value, (.=))+import qualified Data.Aeson as A+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Encode.Pretty as Pretty+import qualified Data.Aeson.Types as A+import Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as Lazy+import Data.Text (Text)+import qualified Data.Text.Encoding as T+import qualified Data.Map as Map++import Kerry.Internal.Prelude++listToObject :: [A.Pair] -> Value+listToObject xs =+ A.object . flip fmap xs $ \x ->+ x++list :: [a] -> Maybe [a]+list l =+ if null l then+ Nothing+ else+ Just l++(.=?) :: A.ToJSON a => Text -> Maybe a -> [(Text, Value)]+(.=?) k =+ maybe [] (\x -> [k .= x])++fromMap :: Map Text Text -> Aeson.Value+fromMap m =+ Aeson.object . flip fmap (Map.toList m) $ \(k, v) ->+ k .= v++fromMapWith :: (a -> Aeson.Value) -> Map Text a -> Aeson.Value+fromMapWith f m =+ Aeson.object . flip fmap (Map.toList m) $ \(k, v) ->+ k .= (f v)++t :: Text -> Text+t =+ id++asTextWith :: (a -> Value) -> a -> Text+asTextWith from =+ T.decodeUtf8 . asByteStringWith from++asByteStringWith :: (a -> Value) -> a -> ByteString+asByteStringWith from =+ Lazy.toStrict . Aeson.encode . from++prettyAsTextWith :: (a -> Value) -> a -> Text+prettyAsTextWith from =+ T.decodeUtf8 . asByteStringWith from++prettyAsByteStringWith :: (a -> Value) -> a -> ByteString+prettyAsByteStringWith from =+ Lazy.toStrict . Pretty.encodePretty . from
+ src/Kerry/Packer.hs view
@@ -0,0 +1,266 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Kerry.Packer (+ -- * Core data types++ -- ** Packer+ Packer(..)++ -- *** User variables+ , UserVariable(..)++ -- *** Builders+ , Builder(..)+ , BuilderType(..)++ -- *** Provisioners+ , Provisioner(..)+ , provisioner++ , ProvisionerType(..)++ -- *** PostProcessors+ , PostProcessor(..)++ -- *** Communicators+ , Communicator(..)+ , SSHCommunicator(..)+ , defaultSSHCommunicator++ -- * Render+ , renderPacker++ -- * Serialization+ , fromPacker+ , fromBuilder+ , fromBuilderType+ , fromUserVariable+ , fromProvisioner+ , fromPostProcessor+ ) where++import Data.Aeson ((.=))+import qualified Data.Aeson as A+import qualified Data.Aeson.Types as A++import qualified Kerry.Builder.AmazonEC2 as AmazonEC2++import qualified Kerry.Provisioner.File as File+import qualified Kerry.Provisioner.Shell as Shell++import Kerry.Internal.Prelude+import Kerry.Internal.Serial (list, listToObject, prettyAsTextWith, (.=?), fromMapWith, fromMap)++data UserVariable =+ UserVariable Text Text+ deriving (Eq, Show)++-- |+-- Builders+--+-- See the following for more information+-- - https://www.packer.io/docs/templates/builders.html+-- - https://www.packer.io/docs/builders/index.html+--+data Builder =+ Builder {+ builderType :: BuilderType+ , builderName :: Maybe Text+ , builderCommunicator :: Communicator+ } deriving (Eq, Show)++-- | Concrete 'BuilderType'+data BuilderType =+ AmazonEBSBuilder (AmazonEC2.AWS AmazonEC2.EBS)+ deriving (Eq, Show)++-- |+-- Provisioner+--+-- See the following for more information:+-- - https://www.packer.io/docs/templates/provisioners.html+-- - https://www.packer.io/docs/provisioners/index.html+--+data Provisioner =+ Provisioner {+ provisionerType :: ProvisionerType+ , provisionerOnly :: [Text]+ , provisionerExcept :: [Text]+ , provisionerPauseBefore :: Maybe Text+ , provisionerTimeout :: Maybe Text+ , provisionerOverride :: Maybe (Map Text (Map Text Text))+ } deriving (Eq, Show)++-- | Basic 'Provisioner'+provisioner :: ProvisionerType -> Provisioner+provisioner pt =+ Provisioner {+ provisionerType = pt+ , provisionerOnly = []+ , provisionerExcept = []+ , provisionerPauseBefore = Nothing+ , provisionerTimeout = Nothing+ , provisionerOverride = Nothing+ }++-- | Concrete 'ProvisionerType'+data ProvisionerType =+ ShellProvisioner Shell.Shell+ | FileProvisioner File.File+ deriving (Eq, Show)++data PostProcessor =+ PostProcessor+ deriving (Eq, Show)++-- |+-- Packer+--+-- A concrete representation for configuring the various components of Packer.+--+data Packer =+ Packer {+ variables :: [UserVariable]+ , builders :: [Builder]+ , provisioners :: [Provisioner]+ , postProcessors :: [PostProcessor]+ } deriving (Eq, Show)++-- |+-- Communicator+--+-- See the following for more information:+-- - https://www.packer.io/docs/templates/communicator.html+-- - https://www.packer.io/docs/provisioners/index.html+--+data Communicator =+ -- | No communicator will be used. If this is set, most provisioners also can't be used.+ None+ -- | An SSH connection will be established to the machine. This is usually the default.+ | SSH SSHCommunicator+ -- | A WinRM connection will be established.+ | WinRm+ deriving (Eq, Show)+++-- |+-- 'ssh' communicator+--+-- https://www.packer.io/docs/templates/communicator.html#ssh+--+data SSHCommunicator =+ SSHCommunicator {+ sshUsername :: Text -- ^ 'ssh_username' - The username to connect to SSH with. Required if using SSH.+ , sshPty :: Bool -- ^ 'ssh_pty' - If true, a PTY will be requested for the SSH connection. This defaults to false.+ , sshTimeout :: Int -- ^ 'ssh_timeout' (string) - The time to wait for SSH to become available. Packer uses this to determine when the machine has booted so this is usually quite long. Example value: 10.+-- 'ssh_agent_auth' (boolean) - If true, the local SSH agent will be used to authenticate connections to the remote host. Defaults to false.+-- 'ssh_bastion_agent_auth' (boolean) - If true, the local SSH agent will be used to authenticate with the bastion host. Defaults to false.+-- 'ssh_bastion_host' (string) - A bastion host to use for the actual SSH connection.+-- 'ssh_bastion_password' (string) - The password to use to authenticate with the bastion host.+-- 'ssh_bastion_port' (number) - The port of the bastion host. Defaults to 22.+-- 'ssh_bastion_private_key_file' (string) - Path to a PEM encoded private key file to use to authenticate with the bastion host. The ~ can be used in path and will be expanded to the home directory of current user.+-- 'ssh_bastion_username' (string) - The username to connect to the bastion host.+-- 'ssh_clear_authorized_keys' (boolean) - If true, Packer will attempt to remove its temporary key from ~/.ssh/authorized_keys and /root/.ssh/authorized_keys. This is a mostly cosmetic option, since Packer will delete the temporary private key from the host system regardless of whether this is set to true (unless the user has set the -debug flag). Defaults to "false"; currently only works on guests with sed installed.+-- 'ssh_disable_agent_forwarding' (boolean) - If true, SSH agent forwarding will be disabled. Defaults to false.+-- 'ssh_file_transfer_method' (scp or sftp) - How to transfer files, Secure copy (default) or SSH File Transfer Protocol.+-- 'ssh_handshake_attempts' (number) - The number of handshakes to attempt with SSH once it can connect. This defaults to 10.+-- 'ssh_host' (string) - The address to SSH to. This usually is automatically configured by the builder.+-- 'ssh_keep_alive_interval' (string) - How often to send "keep alive" messages to the server. Set to a negative value (-1s) to disable. Example value: 10s. Defaults to 5s.+-- 'ssh_password' (string) - A plaintext password to use to authenticate with SSH.+-- 'ssh_port' (number) - The port to connect to SSH. This defaults to 22.+-- 'ssh_private_key_file' (string) - Path to a PEM encoded private key file to use to authenticate with SSH. The ~ can be used in path and will be expanded to the home directory of current user.+-- 'ssh_proxy_host' (string) - A SOCKS proxy host to use for SSH connection+-- 'ssh_proxy_password' (string) - The password to use to authenticate with the proxy server. Optional.+-- 'ssh_proxy_port' (number) - A port of the SOCKS proxy. Defaults to 1080.+-- 'ssh_proxy_username' (string) - The username to authenticate with the proxy server. Optional.+-- 'ssh_read_write_timeout' (string) - The amount of time to wait for a remote command to end. This might be useful if, for example, packer hangs on a connection after a reboot. Example: 5m. Disabled by default.+ } deriving (Eq, Show)++-- |+-- A minimal default @ssh@ communicator where only the @username@+-- needs to be specified+--+defaultSSHCommunicator :: Text -> SSHCommunicator+defaultSSHCommunicator username =+ SSHCommunicator {+ sshUsername = username+ , sshPty = True+ , sshTimeout = 10+ }++-- | Render an 'Packer' to 'Text'+renderPacker :: Packer -> Text+renderPacker =+ prettyAsTextWith fromPacker++-- | Packer serialization+fromPacker :: Packer -> A.Value+fromPacker p =+ A.object $ join [+ "variables" .=? (listToObject <$> list (fromUserVariable <$> variables p))+ , "builders" .=? list (fromBuilder <$> builders p)+ , "provisioners" .=? list (fromProvisioner <$> provisioners p)+ , "post-processors" .=? list (fromPostProcessor <$> postProcessors p)+ ]++-- | Builder serialization+fromBuilder :: Builder -> A.Value+fromBuilder (Builder btype name comm) =+ A.object $ join [+ fromBuilderType btype+ , "name" .=? name+ , fromCommunicator comm+ ]++-- | BuilderType serialization+fromBuilderType :: BuilderType -> [A.Pair]+fromBuilderType = \case+ AmazonEBSBuilder aws ->+ AmazonEC2.fromAWS AmazonEC2.fromEBS aws++-- | Communicator serialization+fromCommunicator :: Communicator -> [A.Pair]+fromCommunicator = \case+ None ->+ []+ SSH (SSHCommunicator user pty timeout) -> [+ "ssh_username" .= user+ , "ssh_pty" .= pty+ , "ssh_timeout" .= (show timeout <> "m")+ ]+ WinRm ->+ []++-- | UserVariable serialization+fromUserVariable :: UserVariable -> A.Pair+fromUserVariable (UserVariable k v) =+ k .= v++-- | Provisioner serialization+fromProvisioner :: Provisioner -> A.Value+fromProvisioner p =+ A.object $ join [+ fromProvisionerType (provisionerType p)+ , "only" .=? list (provisionerOnly p)+ , "except" .=? list (provisionerExcept p)+ , "pause_before" .=? (provisionerPauseBefore p)+ , "timeout" .=? (provisionerTimeout p)+ , "override" .=? (fromMapWith fromMap <$> provisionerOverride p)+ ]++fromProvisionerType :: ProvisionerType -> [A.Pair]+fromProvisionerType = \case+ ShellProvisioner shell ->+ Shell.fromShell shell++ FileProvisioner file ->+ File.fromFile file+++-- | PostProcessor serialization+fromPostProcessor :: PostProcessor -> A.Value+fromPostProcessor _ =+ A.object $ join [+ ]
+ src/Kerry/Provisioner/File.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Kerry.Provisioner.File (+ -- * File provisioner+ File(..)+ , FileDirection(..)++ -- ** Serialziation+ , fromFile+ ) where++import Data.Aeson ((.=))+import qualified Data.Aeson.Types as Aeson++import Kerry.Internal.Prelude+import Kerry.Internal.Serial+++data File =+ File {+ -- | The path to a local file or directory to upload to the machine. The path can be absolute or relative. If it is relative, it is relative to the working directory when Packer is executed. If this is a directory, the existence of a trailing slash is important. Read below on uploading directories.+ fileSource :: FilePath+ -- | The path where the file will be uploaded to in the machine. This value must be a writable location and any parent directories must already exist. If the provisioning user (generally not root) cannot write to this directory, you will receive a "Permission Denied" error. If the source is a file, it's a good idea to make the destination a file as well, but if you set your destination as a directory, at least make sure that the destination ends in a trailing slash so that Packer knows to use the source's basename in the final upload path. Failure to do so may cause Packer to fail on file uploads. If the destination file already exists, it will be overwritten.+ , fileDestination :: FilePath+ -- | The direction of the file transfer. This defaults to "upload". If it is set to "download" then the file "source" in the machine will be downloaded locally to "destination"+ , fileDirection :: FileDirection+ -- | For advanced users only. If true, check the file existence only before uploading, rather than upon pre-build validation. This allows to upload files created on-the-fly. This defaults to false. We don't recommend using this feature, since it can cause Packer to become dependent on system state. We would prefer you generate your files before the Packer run, but realize that there are situations where this may be unavoidable.+ , fileGenerated :: Maybe Bool+ } deriving (Eq, Show)++-- | 'FileDirection'+data FileDirection =+ FileUpload+ | FileDownload+ deriving (Eq, Show)++renderFileDirection :: FileDirection -> Text+renderFileDirection = \case+ FileUpload ->+ "upload"+ FileDownload ->+ "download"++fromFile :: File -> [Aeson.Pair]+fromFile f =+ join [[+ "type" .= t "file"+ , "source" .= (fileSource f)+ , "destination" .= (fileDestination f)+ , "direction" .= (renderFileDirection $ fileDirection f)+ ]+ , "generated" .=? (fileGenerated f)+ ]
+ src/Kerry/Provisioner/Shell.hs view
@@ -0,0 +1,121 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Kerry.Provisioner.Shell (+ -- * Shell provisioner+ Shell(..)+ , shell++ , ShellType(..)++ -- ** Serialziation+ , fromShell+ ) where++import Data.Aeson ((.=))+import qualified Data.Aeson.Types as Aeson++import Kerry.Internal.Prelude+import Kerry.Internal.Serial+++-- |+-- The shell Packer provisioner provisions machines built by Packer+-- using shell scripts. Shell provisioning is the easiest way to get+-- software installed and configured on a machine.+--+data Shell =+ Shell {+ shellType :: ShellType+ -- | If true, specifies that the script(s) are binary files, and Packer should therefore not convert Windows line endings to Unix line endings (if there are any). By default this is false.+ , shellBinary :: Maybe Bool+ -- | Valid exit codes for the script. By default this is just 0.+ , shellValidExitCodes :: Maybe [Int]+ -- | An array of key/value pairs to inject prior to the execute_command. The format should be key=value. Packer injects some environmental variables by default into the environment, as well, which are covered in the section below.+ , shellEnvironmentVars :: Maybe [Text]+ -- | If true, Packer will write your environment variables to a tempfile and source them from that file, rather than declaring them inline in our execute_command. The default execute_command will be chmod +x {{.Path}}; . {{.EnvVarFile}} && {{.Path}}. This option is unnecessary for most cases, but if you have extra quoting in your custom execute_command, then this may be unnecessary for proper script execution. Default: false.+ , shellUseEnvVarFile :: Maybe Bool+ -- | The command to use to execute the script. By default this is chmod +x {{ .Path }}; {{ .Vars }} {{ .Path }}, unless the user has set "use_env_var_file": true -- in that case, the default execute_command is chmod +x {{.Path}}; . {{.EnvVarFile}} && {{.Path}}. The value of this is treated as a configuration template. There are three available variables:+ --+ -- Path is the path to the script to run+ -- Vars is the list of environment_vars, if configured.+ -- EnvVarFile is the path to the file containing env vars, if use_env_var_file is true.+ , shellExecuteCommand :: Maybe Text+ -- | Defaults to false. Whether to error if the server disconnects us. A disconnect might happen if you restart the ssh server or reboot the host.+ , shellExpectDisconnect :: Maybe Bool+ -- | The shebang value to use when running commands specified by inline. By default, this is /bin/sh -e. If you're not using inline, then this configuration has no effect. Important: If you customize this, be sure to include something like the -e flag, otherwise individual steps failing won't fail the provisioner.+ , shellInlineShebang :: Maybe Text+ -- | The folder where the uploaded script will reside on the machine. This defaults to '/tmp'.+ , shellRemoteFolder :: Maybe FilePath+ -- | The filename the uploaded script will have on the machine. This defaults to 'script_nnn.sh'.+ , shellRemoteFile :: Maybe Text+ -- | The full path to the uploaded script will have on the machine. By default this is remote_folder/remote_file, if set this option will override both remote_folder and remote_file.+ , shellRemotePath :: Maybe FilePath+ -- | If true, specifies that the helper scripts uploaded to the system will not be removed by Packer. This defaults to false (clean scripts from the system).+ , shellSkipClean :: Maybe Bool+ -- | The amount of time to attempt to start the remote process. By default this is 5m or 5 minutes. This setting exists in order to deal with times when SSH may restart, such as a system reboot. Set this to a higher value if reboots take a longer amount of time.+ , shellStartRetryTimeout :: Maybe Text+ -- | Wait the amount of time after provisioning a shell script, this pause be taken if all previous steps were successful.+ , shellPauseAfter :: Maybe Text+ } deriving (Eq, Show)++-- | Basic 'Shell'+shell :: ShellType -> Shell+shell st =+ Shell {+ shellType = st+ , shellBinary = Nothing+ , shellValidExitCodes = Nothing+ , shellEnvironmentVars = Nothing+ , shellUseEnvVarFile = Nothing+ , shellExecuteCommand = Nothing+ , shellExpectDisconnect = Nothing+ , shellInlineShebang = Nothing+ , shellRemoteFolder = Nothing+ , shellRemoteFile = Nothing+ , shellRemotePath = Nothing+ , shellSkipClean = Nothing+ , shellStartRetryTimeout = Nothing+ , shellPauseAfter = Nothing+ }+++-- | 'ShellType'+data ShellType =+ Inline [Text]+ | Script Text+ | Scripts [Text]+ deriving (Eq, Show)+++-- | Shell serialization+fromShell :: Shell -> [Aeson.Pair]+fromShell s =+ join [[+ "type" .= t "shell"+ , fromShellType (shellType s)+ ]+ , "binary" .=? (shellBinary s)+ , "valid_exit_codes" .=? (shellValidExitCodes s)+ , "environment_vars" .=? (shellEnvironmentVars s)+ , "use_env_var_file" .=? (shellUseEnvVarFile s)+ , "execute_command" .=? (shellExecuteCommand s)+ , "expect_disconnect" .=? (shellExpectDisconnect s)+ , "inline_shebang" .=? (shellInlineShebang s)+ , "remote_folder" .=? (shellRemoteFolder s)+ , "remote_file" .=? (shellRemoteFile s)+ , "remote_path" .=? (shellRemotePath s)+ , "skip_clean" .=? (shellSkipClean s)+ , "start_retry_timeout" .=? (shellStartRetryTimeout s)+ , "pause_after" .=? (shellPauseAfter s)+ ]++fromShellType :: ShellType -> Aeson.Pair+fromShellType = \case+ Inline xs ->+ "inline" .= xs+ Script x ->+ "script" .= x+ Scripts xs ->+ "scripts" .= xs
+ test/Test/Kerry/Gen.hs view
@@ -0,0 +1,147 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Test.Kerry.Gen (+ genPacker+ , genBuilder+ , genCommunicator+ , genPostProcessor+ ) where++import qualified Data.List as List+import qualified Data.Text as T++import Hedgehog+import qualified Hedgehog.Corpus as Corpus+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++import Kerry.Builder.AmazonEC2+import Kerry.Packer+import Kerry.Provisioner.File+import Kerry.Provisioner.Shell+import Kerry.Internal.Prelude+++genPacker :: Gen Packer+genPacker =+ Packer+ <$> Gen.list (Range.linear 0 10) genUserVariable+ <*> genBuilders+ <*> Gen.list (Range.linear 0 10) genProvisioner+ <*> Gen.list (Range.linear 0 0) genPostProcessor++-- TODO functions+genUserVariable :: Gen UserVariable+genUserVariable =+ UserVariable+ <$> Gen.text (Range.linear 3 10) Gen.alphaNum+ <*> Gen.text (Range.linear 3 10) Gen.alphaNum++genBuilders :: Gen [Builder]+genBuilders = do+ bs <- Gen.list (Range.linear 1 10) genBuilder+ pure $ List.zipWith ($) bs [1..]++genBuilder :: Gen (Int -> Builder)+genBuilder = do+ comm <- SSH <$> genSSHCommunicator+ name <- Gen.maybe $ Gen.element Corpus.agile+ ebsb <- genEBSBuilder+ aws <- genAWS ebsb+ pure $ \index ->+ Builder+ (AmazonEBSBuilder aws)+ ((\n -> n <> "-" <> T.pack (show index)) <$> name)+ comm+++genAWS :: MonadGen m => builder -> m (AWS builder)+genAWS builder =+ AWS+ <$> pure "us-west-2"+ <*> Gen.element [EnvironmentVariables, AWSProfile "test-profile"]+ <*> pure builder++genEBSBuilder :: MonadGen m => m EBS+genEBSBuilder =+ EBS+ <$> Gen.text (Range.linear 3 10) Gen.alphaNum+ <*> (SourceAmiId . (<>) "ami-" <$> Gen.text (Range.singleton 8) Gen.alphaNum)+ <*> Gen.element ["t2.micro", "m4.xlarge", "x1.large"]+ <*> Gen.maybe (Gen.text (Range.singleton 8) Gen.alphaNum)+ <*> Gen.maybe (pure ["us-east-1"])+ <*> Gen.maybe (pure ["123456789123", "123456789456"])+ <*> Gen.maybe Gen.bool+ <*> Gen.maybe (pure "us-west-2a")+ <*> Gen.maybe (pure "packer")+ <*> Gen.maybe Gen.bool+ <*> pure []+ <*> genMap+ <*> Gen.maybe (pure "subnet-1234567abcd12345e")+ <*> genMap+ <*> Gen.maybe (pure "vpc-1234567abcd12345")++genMap :: MonadGen m => m (Map Text Text)+genMap =+ Gen.choice [+ pure mempty+ , Gen.map (Range.linear 0 4) $+ Gen.element (zip Corpus.cooking Corpus.vegetables)+ ]++genCommunicator :: Gen Communicator+genCommunicator =+ Gen.choice [+ pure None+ , SSH <$> genSSHCommunicator+ , pure WinRm+ ]++genSSHCommunicator:: MonadGen m => m SSHCommunicator+genSSHCommunicator =+ SSHCommunicator+ <$> Gen.text (Range.linear 3 10) Gen.alpha+ <*> Gen.bool+ <*> Gen.int (Range.linear 0 10)++genProvisioner :: Gen Provisioner+genProvisioner =+ Provisioner+ <$> genProvisionerType+ <*> pure []+ <*> pure []+ <*> pure Nothing+ <*> pure Nothing+ <*> pure mempty++genProvisionerType :: Gen ProvisionerType+genProvisionerType =+ Gen.choice [+ ShellProvisioner <$> genShell+ , FileProvisioner <$> genFile+ ]++genShell :: Gen Shell+genShell = do+ stype <- Gen.element [+ Inline ["echo foo"]+-- TODO files must exist during validation+-- , Script "run.sh"+-- , Scripts ["run.sh", "run2.sh"]+ ]+ pure $ shell stype++genFile :: Gen File+genFile =+ File+ <$> pure "/dev/null"+ <*> pure "/tmp"+ <*> Gen.element [FileUpload, FileDownload]+ <*> Gen.maybe Gen.bool++genPostProcessor :: Gen PostProcessor+genPostProcessor =+ pure PostProcessor
+ test/Test/Kerry/Serial.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TemplateHaskell #-}++module Test.Kerry.Serial (+ tests+ ) where++import Control.Monad.IO.Class (liftIO)+import Control.Monad.Morph (hoist)+import Control.Monad.Trans.Resource (runResourceT)++import qualified Data.ByteString.Char8 as Char8++import Hedgehog++import Kerry.Internal.Prelude+import Kerry.Internal.Serial (prettyAsByteStringWith)+import Kerry.Packer (Packer, fromPacker)++import System.Exit (ExitCode (..))+import qualified System.IO as IO+import qualified System.IO.Temp as Temp+import qualified System.Process as Process++import qualified Test.Kerry.Gen as Gen++prop_gen :: Property+prop_gen =+ withShrinks 5 . withTests 100 . property $ do+ packer <- forAll Gen.genPacker+ validate packer++validate :: Packer -> PropertyT IO ()+validate packer =+ hoist runResourceT $ do+ (_release, path, handle) <- Temp.openTempFile Nothing "example.json"+ let+ raw = prettyAsByteStringWith (fromPacker) packer+ annotate $ show raw++ liftIO $ Char8.hPutStrLn handle raw+ liftIO $ IO.hClose handle++ annotate path+ (ec, stdout, stderr) <-+ liftIO $ Process.readProcessWithExitCode "packer" ["validate", path] ""+ annotate stdout+ annotate stderr++ assert $ ec == ExitSuccess+++tests :: IO Bool+tests =+ checkParallel $$(discover)
+ test/test.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE NoImplicitPrelude #-}++import Control.Monad (when)++import Kerry.Internal.Prelude++import System.Exit (exitFailure)++import qualified Test.Kerry.Serial as Serial+++main :: IO ()+main = do+ ok <- and <$> sequence [+ Serial.tests+ ]+ when (not ok) $+ exitFailure