diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..450f32e --- /dev/null +++ b/.gitignore @@ -0,0 +1,20 @@ +dist +dist-* +cabal-dev +*.o +*.hi +*.chi +*.chs.h +*.dyn_o +*.dyn_hi +.hpc +.hsenv +.cabal-sandbox/ +cabal.sandbox.config +*.prof +*.aux +*.hp +*.eventlog +.stack-work/ +cabal.project.local +.HTF/ diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..6a042c2 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Author name here (c) 2017 + +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 Author name here 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. \ No newline at end of file diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/addon-manifest.json b/addon-manifest.json new file mode 100644 index 0000000..85bf04a --- /dev/null +++ b/addon-manifest.json @@ -0,0 +1,20 @@ +{ + "id": "constellation", + "name": "Constellation Downtime Alert Silencer", + "cli_plugin_name": "heroku-constellation", + "api": { + "password": "hunter2", + "sso_salt": "no really hunter2", + "regions": ["us","eu"], + "requires": ["log_input", "many_per_app", "attachable"], + "production": { + "base_url": "https://constellation.greedo.xeserv.us/heroku/resources", + "sso_url": "https://constellation.greedo.xeserv.us/sso/login" + }, + "test": { + "base_url": "http://localhost:4567/heroku/resources", + "sso_url": "http://localhost:4567/sso/login" + }, + "version": "1" + } +} diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 index 0000000..f66a415 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,6 @@ +module Main where + +import Lib + +main :: IO () +main = startApp diff --git a/constellation.cabal b/constellation.cabal new file mode 100644 index 0000000..1597a5f --- /dev/null +++ b/constellation.cabal @@ -0,0 +1,62 @@ +name: constellation +version: 0.1.0.0 +homepage: https://github.com/githubuser/constellation#readme +license: BSD3 +license-file: LICENSE +author: Author name here +maintainer: example@example.com +copyright: 2017 Author name here +category: Web +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: Lib + , Models + , Heroku.Types + , Types + , Routes + ghc-options: -pgmL markdown-unlit + build-depends: base + , aeson + , servant + , servant-client + , servant-server + , wai + , warp + , groundhog + , groundhog-th + , groundhog-postgresql + , text + , markdown-unlit + , resource-pool + , postgresql-simple-url + , bytestring + default-language: Haskell2010 + +executable constellation-exe + hs-source-dirs: app + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N -with-rtsopts=-T + build-depends: base + , constellation + default-language: Haskell2010 + +test-suite constellation-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , constellation + , hspec + , hspec-wai + , hspec-wai-json + , aeson + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/githubuser/constellation diff --git a/links.txt b/links.txt new file mode 100644 index 0000000..1a42c70 --- /dev/null +++ b/links.txt @@ -0,0 +1,9 @@ +https://pbrisbin.com/posts/parsing_database_url/ +https://haskellonheroku.com/tutorial/ +https://github.com/mfine/heroku-buildpack-stack +https://github.com/haskell-servant/example-servant-persistent/blob/master/src/Models.hs +https://devcenter.heroku.com/articles/add-on-partner-api +https://devcenter.heroku.com/articles/add-on-manifest +https://stackoverflow.com/questions/24821364/how-to-store-an-enum-adt-in-persistent +https://stackoverflow.com/questions/30062707/foreign-key-constraints-in-yesod-persistent +https://github.com/heroku/kensa diff --git a/src/Heroku/.Types.md.un~ b/src/Heroku/.Types.md.un~ new file mode 100644 index 0000000..730453e Binary files /dev/null and b/src/Heroku/.Types.md.un~ differ diff --git a/src/Heroku/Types.lhs b/src/Heroku/Types.lhs new file mode 120000 index 0000000..62d2816 --- /dev/null +++ b/src/Heroku/Types.lhs @@ -0,0 +1 @@ +Types.md \ No newline at end of file diff --git a/src/Heroku/Types.md b/src/Heroku/Types.md new file mode 100644 index 0000000..b5bfed8 --- /dev/null +++ b/src/Heroku/Types.md @@ -0,0 +1,42 @@ +`Heroku.Types` +============== + +This module defines some essential types the [Heroku Partner API][addon-partner-api] uses. + +Module Header +------------- + +```haskell +{-# LANGUAGE DeriveGeneric #-} + +-- | This file is a literate haskell document. Please see the source code for more information. +module Heroku.Types + +import Data.Aeson +import Data.Text +import GHC.Generics +``` + +Provision Request +----------------- + +This datatype is defined [here][provision-type]. + +```haskell +data Provision = Provision + { heroku_id :: Text + , plan :: Text + , region :: Text + , callback_url :: Text + , options :: Object -- Generic "anything" for JSON data + , uuid :: Text + , log_input_url :: Text + } deriving (Read, Show, Eq, Generic) + +instance ToJSON Provision +instance FromJSON Provision +``` + +--- +[addon-partner-api]: https://devcenter.heroku.com/articles/add-on-partner-api +[provision-type]: https://devcenter.heroku.com/articles/add-on-partner-api#provision diff --git a/src/Lib.hs b/src/Lib.hs new file mode 100644 index 0000000..0b15b04 --- /dev/null +++ b/src/Lib.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeOperators #-} +module Lib + ( startApp + , app + ) where + +import Data.Bytestring +import Data.Maybe +import Network.Wai +import Network.Wai.Handler.Warp +import Servant + +import Routes + +startApp :: IO () +startApp = do + dbURL <- getEnv "DATABASE_URL" + let ci = fromJust $ parseDatabaseURL dbURL + let cs = postgreSQLConnectionString ci + let dbConnectionString = unpack cs + pool <- createPostgresqlPool dbConnectionString 5 + + runDbConn $ do + runMigration defaultMigrationLogger $ do + migrate (undefined :: Models.App) + migrate (undefined :: Models.Endpoint) + migrate (undefined :: Models.Event) + + run 8080 $ app pool + +app :: Pool Postgresql -> Application +app pool = serve api $ server pool diff --git a/src/Models.hs b/src/Models.hs new file mode 100644 index 0000000..f0e73c1 --- /dev/null +++ b/src/Models.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +module Models where + +import Database.Groundhog (DefaultKey) +import Database.Groundhog.TH +import Data.Text + +data App = App + { herokuId :: Text + , region :: Text + } + +deriving instance Eq App +deriving instance Read App +deriving instance Show App + +data Endpoint = Endpoint + { endpointApp :: DefaultKey App + , link :: Text + } + +deriving instance Eq Endpoint +deriving instance Read Endpoint +deriving instance Show Endpoint + +data Event = Event + { eventEndpoint :: DefaultKey Endpoint + , eventApp :: DefaultKey App + , ok :: Bool + , reason :: Text + } + +deriving instance Eq Event +deriving instance Show Event +deriving instance Read Event + +mkPersist defaultCodegenConfig [groundhog| +- entity: App +- entity: Endpoint +- entity: Event +|] diff --git a/src/Routes.lhs b/src/Routes.lhs new file mode 120000 index 0000000..0af4963 --- /dev/null +++ b/src/Routes.lhs @@ -0,0 +1 @@ +Routes.md \ No newline at end of file diff --git a/src/Routes.md b/src/Routes.md new file mode 100644 index 0000000..d08480a --- /dev/null +++ b/src/Routes.md @@ -0,0 +1,56 @@ +Routes +====== + +The [addon partner API][addon-partner-api] defines the routes this application +must support. + +Module Header +------------- + +```haskell +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeOperators #-} + +module Routes where + +-- external dependencies +import Data.Proxy +import Network.Wai +import Network.Wai.Handler.Warp +import Servant + +-- internal dependencies +import Heroku.Types as Heroku +import qualified Models +import qualified Types +``` + +URL Routing +----------- + +```haskell +type Api = "heroku" :> "resources" :> ReqBody '[JSON] Heroku.Provider :> Post '[JSON] Types.App + +api :: Proxy Api +api = Proxy +``` + +``` +server :: Pool Postgresql -> Server Api +server pool = + provisionAppH + + where + provisionAppH settings = liftIO $ provisionApp settings + + provisionApp :: Heroku.Provider -> IO Types.App + provisionApp settings = runDbConn pool $ do + appKey <- insert $ Models.App (Heroku.heroku_id settings) (Heroku.region settings) + let showKey = show appKey + + Types.App showKey +``` + +--- +[addon-partner-api]: https://devcenter.heroku.com/articles/add-on-partner-api diff --git a/src/Types.lhs b/src/Types.lhs new file mode 120000 index 0000000..62d2816 --- /dev/null +++ b/src/Types.lhs @@ -0,0 +1 @@ +Types.md \ No newline at end of file diff --git a/src/Types.md b/src/Types.md new file mode 100644 index 0000000..b12f7eb --- /dev/null +++ b/src/Types.md @@ -0,0 +1,23 @@ +```haskell +{-# LANGUAGE DeriveGeneric #-} + +module Types where + +import Data.Aeson +import GHC.Generics +import Prelude hiding (id) +``` + +App +--- + +1:1 with a Heroku app. + +```haskell +data App = App + { id :: String + } deriving (Generic, Eq, Show, Read) + +instance ToJSON App +instance FromJSON App +``` diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..72d002f --- /dev/null +++ b/stack.yaml @@ -0,0 +1,67 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# http://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# resolver: ghcjs-0.1.0_ghc-7.10.2 +# resolver: +# name: custom-snapshot +# location: "./custom-snapshot.yaml" +resolver: lts-8.12 + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# - location: +# git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# extra-dep: true +# subdirs: +# - auto-update +# - wai +# +# A package marked 'extra-dep: true' will only be built if demanded by a +# non-dependency (i.e. a user package), and its test suites and benchmarks +# will not be run. This is useful for tweaking upstream packages. +packages: +- '.' +# Dependency packages to be pulled from upstream that are not in the resolver +# (e.g., acme-missiles-0.3) +extra-deps: + - heroku-0.1.2.3 + +# Override default flag values for local packages and extra-deps +flags: {} + +# Extra package databases containing global packages +extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=1.3" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 index 0000000..8aefe96 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Lib (app) +import Test.Hspec +import Test.Hspec.Wai +import Test.Hspec.Wai.JSON + +main :: IO () +main = hspec spec + +spec :: Spec +spec = with (return app) $ do + describe "GET /users" $ do + it "responds with 200" $ do + get "/users" `shouldRespondWith` 200 + it "responds with [User]" $ do + let users = "[{\"userId\":1,\"userFirstName\":\"Isaac\",\"userLastName\":\"Newton\"},{\"userId\":2,\"userFirstName\":\"Albert\",\"userLastName\":\"Einstein\"}]" + get "/users" `shouldRespondWith` users