diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,13 @@ +# Changelog +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) +and this project adheres to [Haskell PVP](https://pvp.haskell.org/). + +## [Unreleased] + +## [0.1.0.0] - 2018-06-25 +### Added +- `isRunningOnCf`, `lookupCurrent` and `current` IO functions +- `withTag`, `withName` and `withLabel` service searching functions +- `credentialString` function for extracting credentials for services diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Tom Oram (c) 2018 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * 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. + + * Neither the name of Tom Oram nor the names of other + 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 +OWNER 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,37 @@ +# Haskell CFEnv + +[![Build Status](https://travis-ci.org/tomphp/haskell-cfenv.svg?branch=master)](https://travis-ci.org/tomphp/haskell-cfenv) + +A port of [go-cfenv](https://github.com/cloudfoundry-community/go-cfenv) for +Haskell. + +The purpose of this library is to assist you in writing Haskell apps that run +on Cloud Foundry. It provides convenience functions and structures that map to +Cloud Foundry environment variable primitives. + +## Usage + +```haskell +{-# LANGUAGE OverloadedStrings #-} + +import Data.String (fromString) +import Data.Monoid (mconcat) + +import Web.Scotty + +import qualified System.CloudFoundry.Environment as CfEnv + +main = do + app <- CfEnv.current + + scotty (CfEnv.port app) $ + get "/" $ do + html $ mconcat ["
", (fromString (show app)), "
"] +``` + +## Missing Functionality + +- Find services by pattern matching +- Some cases from [go-cfenv](https://github.com/cloudfoundry-community/go-cfenv) + around handling missing data + 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/cfenv.cabal b/cfenv.cabal new file mode 100644 --- /dev/null +++ b/cfenv.cabal @@ -0,0 +1,67 @@ +-- This file has been generated from package.yaml by hpack version 0.20.0. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 7ab1edca468ef31223e70ac4a2b1828d9e3c8faf5cbbbd3c8671c423b82dfe94 + +name: cfenv +version: 0.1.0.0 +synopsis: A library getting the environment when running on Cloud Foundry +description: This is a port of go-cfenv for Golang. The purpose of this library is to assist you in writing Haskell apps that run on Cloud Foundry. It provides convenience functions and structures that map to Cloud Foundry environment variable primitives. +category: Library +homepage: https://github.com/tomphp/haskell-cfenv#readme +bug-reports: https://github.com/tomphp/haskell-cfenv/issues +author: Tom Oram +maintainer: tom@x2k.com +copyright: 2018, Tom Oram +license: BSD3 +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 + +extra-source-files: + CHANGELOG.md + README.md + +source-repository head + type: git + location: https://github.com/tomphp/haskell-cfenv + +library + hs-source-dirs: + src/ + ghc-options: -Wall + build-depends: + aeson + , base >=4.7 && <5 + , bytestring + , containers + exposed-modules: + System.CloudFoundry.Environment + other-modules: + System.CloudFoundry.Environment.Internal.EnvVars + System.CloudFoundry.Environment.Internal.Service + System.CloudFoundry.Environment.Internal.Services + System.CloudFoundry.Environment.Internal.Types + System.CloudFoundry.Environment.Internal.VcapApplicationDecoder + System.CloudFoundry.Environment.Internal.VcapServicesDecoder + Paths_cfenv + default-language: Haskell2010 + +test-suite cfenv-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: + test/ + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + build-depends: + aeson + , base >=4.7 && <5 + , cfenv + , containers + , hspec ==2.* + , raw-strings-qq + other-modules: + System.CloudFoundry.EnvironmentSpec + Paths_cfenv + default-language: Haskell2010 diff --git a/src/System/CloudFoundry/Environment.hs b/src/System/CloudFoundry/Environment.hs new file mode 100644 --- /dev/null +++ b/src/System/CloudFoundry/Environment.hs @@ -0,0 +1,127 @@ +{-| The purpose of this library is to assist you in writing Haskell apps that + run on Cloud Foundry. It provides convenience functions and structures that + map to Cloud Foundry environment variable primitives. + + This package is a port of https://github.com/cloudfoundry-community/go-cfenv +-} + +module System.CloudFoundry.Environment + ( current + , isRunningOnCf + , lookupCurrent + , module System.CloudFoundry.Environment.Internal.Service + , module System.CloudFoundry.Environment.Internal.Services + , module System.CloudFoundry.Environment.Internal.Types + ) where + +import Control.Exception (Exception, throw) +import Control.Monad ((>=>)) +import Data.Char (isSpace) +import System.Environment (lookupEnv) + +import qualified System.CloudFoundry.Environment.Internal.EnvVars as EnvVars +import System.CloudFoundry.Environment.Internal.Service +import System.CloudFoundry.Environment.Internal.Services +import System.CloudFoundry.Environment.Internal.Types +import qualified System.CloudFoundry.Environment.Internal.VcapApplicationDecoder as VcapApplication +import qualified System.CloudFoundry.Environment.Internal.VcapServicesDecoder as VcapServices + +{- | Detect if the application is running as a Cloud Foundry application. + +> import System.CloudFoundry.Environment CfEnv +> +> main :: IO () +> main = do +> isRunningOnCf <- CfEnv.isRunningOnCf +> +> if isRunningOnCf +> then putStrLn "Running on Cloud Foundry" +> else putStrLn "Not running on Cloud Foundry" +-} +isRunningOnCf :: IO Bool +isRunningOnCf = + envHasValue "VCAP_APPLICATION" + where + envHasValue = lookupEnv >=> return . maybeHasValue + maybeHasValue = maybe False hasValue + hasValue = not . isEmptyString . trimLeft + trimLeft = dropWhile isSpace + isEmptyString = (==) "" + +{-| Get the current Cloud Foundry environment. + + Example using @scotty@: + +> import Data.String (fromString) +> import Data.Monoid (mconcat) +> +> import Web.Scotty +> +> import qualified System.CloudFoundry.Environment as CfEnv +> +> main = do +> app <- CfEnv.current +> +> scotty (CfEnv.port app) $ +> get "/" $ do +> html $ mconcat ["
", (fromString (show app)), "
"] +-} +current :: IO Application +current = do + envVars <- EnvVars.getEnvVars + vcapApp <- decodeVcapApplication (EnvVars.vcapApplication envVars) + vcapServices <- decodeVcapServices (EnvVars.vcapServices envVars) + + return $ mkApplication envVars vcapApp vcapServices + where + decodeVcapApplication = + eitherToThrow VcapApplication.decode (DecodeError "VCAP_APPLICATION") + + decodeVcapServices = + eitherToThrow VcapServices.decode (DecodeError "VCAP_SERVICES") + +-- | Get the current Cloud Foundry environment and return the result in a Maybe. +-- See `current`. +lookupCurrent :: IO (Maybe Application) +lookupCurrent = do + isOnCf <- isRunningOnCf + + if isOnCf + then fmap Just current + else return Nothing + +eitherToThrow :: (Exception ex) + => (input -> Either error output) + -> (error -> ex) + -> input + -> IO output +eitherToThrow fn exFn input = + case fn input of + Right output -> return output + Left errorMsg -> throw $ exFn errorMsg + +mkApplication :: EnvVars.EnvVars + -> VcapApplication.VcapApplication + -> Services + -> Application +mkApplication envVars vcapApp vcapServices = + Application + { appId = VcapApplication.appId vcapApp + , appName = VcapApplication.appName vcapApp + , applicationUris = VcapApplication.applicationUris vcapApp + , cfApi = VcapApplication.cfApi vcapApp + , home = EnvVars.home envVars + , host = VcapApplication.host vcapApp + , index = VcapApplication.index vcapApp + , instanceId = VcapApplication.instanceId vcapApp + , limits = VcapApplication.limits vcapApp + , memoryLimit = EnvVars.memoryLimit envVars + , port = EnvVars.port envVars + , pwd = EnvVars.pwd envVars + , services = vcapServices + , spaceId = VcapApplication.spaceId vcapApp + , spaceName = VcapApplication.spaceName vcapApp + , tmpDir = EnvVars.tmpDir envVars + , user = EnvVars.user envVars + , version = VcapApplication.version vcapApp + } diff --git a/src/System/CloudFoundry/Environment/Internal/EnvVars.hs b/src/System/CloudFoundry/Environment/Internal/EnvVars.hs new file mode 100644 --- /dev/null +++ b/src/System/CloudFoundry/Environment/Internal/EnvVars.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE RecordWildCards #-} + +module System.CloudFoundry.Environment.Internal.EnvVars + ( EnvVars(..) + , getEnvVars + ) where + +import Control.Monad ((>=>)) +import Control.Exception (throw) +import Data.Maybe (fromMaybe) +import System.Environment (getEnv, lookupEnv) + +import Text.Read (readMaybe) + +import System.CloudFoundry.Environment.Internal.Types (CfEnvError(NotInteger)) + +data EnvVars = EnvVars + { home :: String + , memoryLimit :: String + , pwd :: String + , port :: Int + , tmpDir :: String + , user :: String + , vcapApplication :: String + , vcapServices :: String + } + +getEnvVars :: IO EnvVars +getEnvVars = do + home <- getEnvIO "HOME" + memoryLimit <- getEnvIO "MEMORY_LIMIT" + pwd <- getEnvIO "PWD" + port <- numberFromEnv "PORT" + tmpDir <- getEnvIO "TMPDIR" + user <- getEnvIO "USER" + vcapApplication <- getEnvIO "VCAP_APPLICATION" + vcapServices <- getEnvDefault "{}" "VCAP_SERVICES" + return EnvVars{..} + where + getEnvIO = getEnv + +stringToInt :: String -> String -> IO Int +stringToInt envName str = + case readMaybe str of + Just int -> return int + Nothing -> throw $ NotInteger envName str + +numberFromEnv :: String -> IO Int +numberFromEnv envName = + envVarValue envName >>= toInt + where + envVarValue = getEnv + toInt = stringToInt envName + +getEnvDefault :: String -> String -> IO String +getEnvDefault def = + lookupEnv >=> return . fromMaybe def diff --git a/src/System/CloudFoundry/Environment/Internal/Service.hs b/src/System/CloudFoundry/Environment/Internal/Service.hs new file mode 100644 --- /dev/null +++ b/src/System/CloudFoundry/Environment/Internal/Service.hs @@ -0,0 +1,10 @@ +module System.CloudFoundry.Environment.Internal.Service where + +import qualified Data.Map.Strict as Map +import System.CloudFoundry.Environment.Internal.Types + +-- |Get a credential string from a service. +credentialString :: String -- ^ The key to each for in the credentials section + -> Service -- ^ The service to get the value from + -> Maybe String -- ^ The value of that credential string if it is found +credentialString key = Map.lookup key . credentials diff --git a/src/System/CloudFoundry/Environment/Internal/Services.hs b/src/System/CloudFoundry/Environment/Internal/Services.hs new file mode 100644 --- /dev/null +++ b/src/System/CloudFoundry/Environment/Internal/Services.hs @@ -0,0 +1,33 @@ +module System.CloudFoundry.Environment.Internal.Services + ( withLabel + , withName + , withTag + ) where + +import Control.Monad (join) +import qualified Data.Map.Strict as Map +import Data.Maybe (fromMaybe, listToMaybe) + +import System.CloudFoundry.Environment.Internal.Types + +-- |Get all services which have the provided tag. +withTag :: String -- ^ The tag to search for + -> Services -- ^ All services bound to the application + -> [Service] -- ^ A list of matching services +withTag searchTag = filter (elem searchTag . tags) . allServices + +-- |Get the service by name. +withName :: String -- ^ The name of the service to be found + -> Services -- ^ All services bound to the application + -> Maybe Service -- ^ The service if it is found +withName searchName = listToMaybe . filter ((== searchName) . name) . allServices + +-- |Get the services by label. +withLabel :: String -- ^ The label to search for + -> Services -- ^ All services bound to the application + -> [Service] -- ^ A list of matching services +withLabel searchLabel (Services svcs) = + fromMaybe [] $ Map.lookup searchLabel svcs + +allServices :: Services -> [Service] +allServices (Services svcs) = join $ Map.elems svcs diff --git a/src/System/CloudFoundry/Environment/Internal/Types.hs b/src/System/CloudFoundry/Environment/Internal/Types.hs new file mode 100644 --- /dev/null +++ b/src/System/CloudFoundry/Environment/Internal/Types.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE DeriveGeneric #-} + +module System.CloudFoundry.Environment.Internal.Types where + +import Control.Exception (Exception) +import Data.Map.Strict (Map) +import GHC.Generics + +import qualified Data.Aeson as Aeson + +-- | Holds information about the current app running on Cloud Foundry. +-- This is returned from 'current'. +data Application = Application + { appId :: String -- ^ ID of the application + , applicationUris :: [String] -- ^ Application URI of the app + , cfApi :: String -- ^ URL for the Cloud Foundry API endpoint + , home :: String -- ^ Root folder for the deployed app + , host :: String -- ^ Host of the app + , instanceId :: String -- ^ ID of the instance + , index :: Int -- ^ Index of the app + , limits :: Limits -- ^ Limits imposed on this process + , memoryLimit :: String -- ^ Maximum amount of memory that each instance of the application can consume + , appName :: String -- ^ Name of the app + , pwd :: String -- ^ Present working directory, where the buildpack that processed the application ran + , port :: Int -- ^ Port which the app must listen on to receive traffic + , services :: Services -- ^ Services bound to the app + , spaceId :: String -- ^ ID of the space + , spaceName :: String -- ^ Name of the space + , tmpDir :: String -- ^ Directory location where temporary and staging files are stored + , user :: String -- ^ User account under which the app instance runs + , version :: String -- ^ Version of the app + } deriving (Eq, Show) + +data Limits = Limits + { disk :: Int -- ^ Disk limit + , fds :: Int -- ^ File descriptors limit + , mem :: Int -- ^ Memory limit + } deriving (Eq, Show, Generic) + +instance Aeson.FromJSON Limits + +-- | Description of a bound service. Use `credentialString` to extract the +-- connection details. +data Service = Service + { name :: String + , label :: String + , tags :: [String] + , plan :: String + , credentials :: Map String String + } deriving (Eq, Show, Generic) + +instance Aeson.FromJSON Service + +-- | A collection of 'Service' instances. 'withTag', 'withName' and 'withLabel' can be +-- used to find the specific services that you want. +newtype Services = Services (Map String [Service]) deriving (Eq, Show) + +-- | Exceptions which are raised from this package. +data CfEnvError + -- | Thrown when a JSON decode failed for either the VCAP_APPLICATION or + -- VCAP_SERIVCES environment variables. + = DecodeError String String + -- | Thrown when an environment variable which is meant to contain an + -- integer contains invalid characters. + | NotInteger String String deriving (Eq) + +instance Exception CfEnvError + +instance Show CfEnvError where + show (DecodeError envName errorMsg) = envName ++ " " ++ errorMsg + show (NotInteger envName value) = envName ++ " must be an integer, got '" ++ value ++ "'." diff --git a/src/System/CloudFoundry/Environment/Internal/VcapApplicationDecoder.hs b/src/System/CloudFoundry/Environment/Internal/VcapApplicationDecoder.hs new file mode 100644 --- /dev/null +++ b/src/System/CloudFoundry/Environment/Internal/VcapApplicationDecoder.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE DeriveGeneric, OverloadedStrings, RecordWildCards #-} + +module System.CloudFoundry.Environment.Internal.VcapApplicationDecoder + ( VcapApplication(..) + , decode + ) where + +import GHC.Generics + +import Data.Aeson ((.:)) +import qualified Data.Aeson as Aeson +import qualified Data.ByteString.Lazy.Char8 as LazyByteString + +import System.CloudFoundry.Environment.Internal.Types + +data VcapApplication = VcapApplication + { appId :: String + , applicationUris :: [String] + , cfApi :: String + , host :: String + , instanceId :: String + , index :: Int + , limits :: Limits + , appName :: String + -- , port :: Int + , spaceId :: String + , spaceName :: String + , version :: String + } deriving (Eq, Show, Generic) + +instance Aeson.FromJSON VcapApplication where + parseJSON = Aeson.withObject "VcapApplication" $ \o -> do + appId <- o .: "application_id" + applicationUris <- o .: "application_uris" + cfApi <- o .: "cf_api" + host <- o .: "host" + instanceId <- o .: "instance_id" + index <- o .: "instance_index" + limits <- o .: "limits" + appName <- o .: "name" + spaceId <- o .: "space_id" + spaceName <- o .: "space_name" + version <- o .: "version" + return VcapApplication{..} + +decode :: String -> Either String VcapApplication +decode = Aeson.eitherDecode . LazyByteString.pack diff --git a/src/System/CloudFoundry/Environment/Internal/VcapServicesDecoder.hs b/src/System/CloudFoundry/Environment/Internal/VcapServicesDecoder.hs new file mode 100644 --- /dev/null +++ b/src/System/CloudFoundry/Environment/Internal/VcapServicesDecoder.hs @@ -0,0 +1,11 @@ +module System.CloudFoundry.Environment.Internal.VcapServicesDecoder + ( decode + ) where + +import qualified Data.Aeson as Aeson +import qualified Data.ByteString.Lazy.Char8 as LazyByteString + +import System.CloudFoundry.Environment.Internal.Types + +decode :: String -> Either String Services +decode = fmap Services . Aeson.eitherDecode . LazyByteString.pack diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/System/CloudFoundry/EnvironmentSpec.hs b/test/System/CloudFoundry/EnvironmentSpec.hs new file mode 100644 --- /dev/null +++ b/test/System/CloudFoundry/EnvironmentSpec.hs @@ -0,0 +1,254 @@ +{-# LANGUAGE QuasiQuotes #-} + +module System.CloudFoundry.EnvironmentSpec where + +import qualified Data.Map.Strict as Map +import System.Environment (setEnv, unsetEnv) + +import Test.Hspec +import Text.RawString.QQ + +import qualified System.CloudFoundry.Environment as CfEnv + +spec :: Spec +spec = do + describe "isRunningOnCf" $ do + it "returns true if VCAP_APPLICATION has a value" $ do + setEnv "VCAP_APPLICATION" "{}" + CfEnv.isRunningOnCf `shouldReturn` True + + it "returns true if VCAP_APPLICATION is not set" $ do + unsetEnv "VCAP_APPLICATION" + CfEnv.isRunningOnCf `shouldReturn` False + + it "returns true if VCAP_APPLICATION is empty" $ do + setEnv "VCAP_APPLICATION" "" + CfEnv.isRunningOnCf `shouldReturn` False + + it "returns true if VCAP_APPLICATION is only whitespace" $ do + setEnv "VCAP_APPLICATION" " " + CfEnv.isRunningOnCf `shouldReturn` False + + describe "current" $ + before setEnvVars $ do + it "returns error if HOME is not set" $ do + unsetEnv "HOME" + CfEnv.current `shouldThrow` anyIOException + + it "returns error if MEMORY_LIMIT is not set" $ do + unsetEnv "MEMORY_LIMIT" + CfEnv.current `shouldThrow` anyIOException + + it "returns error if PWD is not set" $ do + unsetEnv "PWD" + CfEnv.current `shouldThrow` anyIOException + + it "returns error if PORT is not set" $ do + unsetEnv "PORT" + CfEnv.current `shouldThrow` anyIOException + + it "returns error if PORT is not valid number" $ do + setEnv "PORT" "abc" + CfEnv.current `shouldThrow` (== CfEnv.NotInteger "PORT" "abc") + + it "returns error if TMPDIR is not set" $ do + unsetEnv "TMPDIR" + CfEnv.current `shouldThrow` anyIOException + + it "returns error if USER is not set" $ do + unsetEnv "USER" + CfEnv.current `shouldThrow` anyIOException + + it "returns error if VCAP_APPLICATION is not set" $ do + unsetEnv "VCAP_APPLICATION" + CfEnv.current `shouldThrow` anyIOException + + it "returns error if VCAP_APPLICATION bad JSON" $ do + setEnv "VCAP_APPLICATION" "not-json" + CfEnv.current `shouldThrow` (== CfEnv.DecodeError "VCAP_APPLICATION" "Error in $: string") + + it "returns Application if VCAP_SERVICES is not set" $ do + unsetEnv "VCAP_SERVICES" + app <- CfEnv.current + app `shouldSatisfy` isApplication + + it "returns error if VCAP_SERVICES bad JSON" $ do + setEnv "VCAP_SERVICES" "not-json" + CfEnv.current `shouldThrow` (== CfEnv.DecodeError "VCAP_SERVICES" "Error in $: string") + + it "returns Application when the environment is correct" $ do + let servicesInJson = + CfEnv.Services $ + Map.singleton + "cleardb" + [ CfEnv.Service + { CfEnv.name = "service_name" + , CfEnv.label = "service_label" + , CfEnv.tags = ["tag_a"] + , CfEnv.plan = "service_plan" + , CfEnv.credentials = + Map.fromList + [ ("username", "service_username") + , ("password", "service_password") + ] + } + ] + + let expected = CfEnv.Application + { CfEnv.appId = "abc_application_id" + , CfEnv.applicationUris = + ["haskell-test.cfapps.io"] + , CfEnv.cfApi = "https://api.sys.foundation" + , CfEnv.home = "/home/userZ" + , CfEnv.host = "app_host" + , CfEnv.instanceId = "abc_instance_id" + , CfEnv.index = 100 + , CfEnv.memoryLimit = "256M" + , CfEnv.appName = "app_name" + , CfEnv.pwd = "/pwd" + , CfEnv.port = 9000 + , CfEnv.tmpDir = "/tmpdir" + , CfEnv.services = servicesInJson + , CfEnv.spaceId = "abc_space_id" + , CfEnv.spaceName = "development" + , CfEnv.user = "tom" + , CfEnv.version = "xxx_version" + , CfEnv.limits = + CfEnv.Limits + { CfEnv.disk = 1024 + , CfEnv.fds = 16384 + , CfEnv.mem = 2048 + } + } + + CfEnv.current `shouldReturn` expected + + describe "lookupCurrent" $ do + it "returns Just Application if running on Cloud Foundry" $ do + expected <- CfEnv.current + CfEnv.lookupCurrent `shouldReturn` Just expected + + it "returns Nothing if not running on Cloud Foundry" $ do + unsetEnv "VCAP_APPLICATION" + CfEnv.lookupCurrent `shouldReturn` Nothing + + describe "credentialString" $ do + let service = CfEnv.Service + { CfEnv.name = "service_name" + , CfEnv.label = "service_label" + , CfEnv.tags = ["tag_a"] + , CfEnv.plan = "service_plan" + , CfEnv.credentials = Map.singleton "the-key" "the-value" + } + + it "returns nothing if there is no matching string" $ do + CfEnv.credentialString "unknown" service `shouldBe` Nothing + + it "returns the string if it is found" $ do + CfEnv.credentialString "the-key" service `shouldBe` Just "the-value" + + context "for Service searching functions" $ do + let serviceA = + CfEnv.Service + { CfEnv.name = "name-a" + , CfEnv.label = "label-a" + , CfEnv.tags = ["good_tag", "ignore_tag"] + , CfEnv.plan = "plan-a" + , CfEnv.credentials = Map.empty + } + let serviceB = + CfEnv.Service + { CfEnv.name = "name-b" + , CfEnv.label = "label-b" + , CfEnv.tags = ["ignore_tag"] + , CfEnv.plan = "plan-b" + , CfEnv.credentials = Map.empty + } + let serviceC = + CfEnv.Service + { CfEnv.name = "name-c" + , CfEnv.label = "label-c" + , CfEnv.tags = ["good_tag"] + , CfEnv.plan = "plan-c" + , CfEnv.credentials = Map.empty + } + let services = CfEnv.Services $ Map.fromList + [ ("relational-db", [serviceA, serviceB]) + , ("message-queue" , [serviceC]) + ] + + describe "withTag" $ do + it "returns an empty list if no matching services are found" $ do + CfEnv.withTag "bad_tag" services `shouldBe` [] + + it "returns the services with matching tags" $ do + CfEnv.withTag "good_tag" services `shouldBe` [serviceC , serviceA] + + describe "withName" $ do + it "returns nothing if there is no service with the given name" $ do + CfEnv.withName "unknown" services `shouldBe` Nothing + + it "returns the service if it exists" $ do + CfEnv.withName "name-b" services `shouldBe` Just serviceB + + describe "withLabel" $ do + it "returns an empty list if there is no service with the given label" $ do + CfEnv.withLabel "unknown" services `shouldBe` [] + + it "returns the services with that labe" $ do + CfEnv.withLabel "relational-db" services `shouldBe` [serviceA, serviceB] + +setEnvVars :: IO () +setEnvVars = do + setEnv "HOME" "/home/userZ" + setEnv "MEMORY_LIMIT" "256M" + setEnv "PORT" "9000" + setEnv "PWD" "/pwd" + setEnv "TMPDIR" "/tmpdir" + setEnv "USER" "tom" + setEnv "VCAP_APPLICATION" vcapApplicationJson + setEnv "VCAP_SERVICES" vcapServicesJson + +vcapApplicationJson :: String +vcapApplicationJson = + [r|{ + "instance_id": "abc_instance_id", + "application_id": "abc_application_id", + "application_uris": [ + "haskell-test.cfapps.io" + ], + "instance_index": 100, + "name": "app_name", + "port": 1080, + "host": "app_host", + "version": "xxx_version", + "application_uris": ["appname.apps.foundation"], + "space_id": "abc_space_id", + "space_name": "development", + "cf_api": "https://api.sys.foundation", + "limits": { + "disk": 1024, + "fds": 16384, + "mem": 2048 + } + }|] + +vcapServicesJson :: String +vcapServicesJson = + [r| + { + "cleardb": [{ + "name": "service_name", + "label": "service_label", + "tags": ["tag_a"], + "plan": "service_plan", + "credentials": { + "username": "service_username", + "password": "service_password" + } + }] + } + |] + +isApplication :: CfEnv.Application -> Bool +isApplication _ = True