diff --git a/.gitignore b/.gitignore index c80ceb3..9f3013b 100644 --- a/.gitignore +++ b/.gitignore @@ -27,3 +27,4 @@ stack.yaml.lock agent_* agent.* version +hie.yaml \ No newline at end of file diff --git a/README.md b/README.md index 0d53c41..6617d98 100644 --- a/README.md +++ b/README.md @@ -28,6 +28,15 @@ stack exec -- yesod devel As your code changes, your site will be automatically recompiled and redeployed to localhost. +### Development tools + +`ghcid "-c=stack ghci --test"` + +- Clone [HIE](https://github.com/haskell/haskell-ide-engine) +- Checkout latest reslease ie. `git checkout tags/1.3` +- Follow github instructions to install for specific GHC version ie. `stack ./install.hs hie` +- Install VSCode Haskell Language Server Extension + ## Tests ``` @@ -36,6 +45,13 @@ stack test --flag start9-companion-server:library-only --flag start9-companion-s (Because `yesod devel` passes the `library-only` and `dev` flags, matching those flags means you don't need to recompile between tests and development, and it disables optimization to speed up your test compile times). +### Tests with HIE Setup +- install hspec-discover globally `cabal install hspec-discover` (requires cabal installation) +- Current [issue](https://github.com/haskell/haskell-ide-engine/issues/1564) open for error pertaining to obtaining flags for test files + - recommended to setup hie.yaml + - recommended to run `stack build --test --no-run-tests` *before* any test files are open and that test files compile without error + - helps to debug a specific file: `hie --debug test/Main.hs` + ## Documentation * Read the [Yesod Book](https://www.yesodweb.com/book) online for free @@ -51,4 +67,4 @@ stack test --flag start9-companion-server:library-only --flag start9-companion-s * Ask the [Yesod Google Group](https://groups.google.com/forum/#!forum/yesodweb) * There are several chatrooms you can ask for help: * For IRC, try Freenode#yesod and Freenode#haskell - * [Functional Programming Slack](https://fpchat-invite.herokuapp.com/), in the #haskell, #haskell-beginners, or #yesod channels. + * [Functional Programming Slack](https://fpchat-invite.herokuapp.com/), in the #haskell, #haskell-beginners, or #yesod channels. \ No newline at end of file diff --git a/config/settings.yml b/config/settings.yml index 4f00f02..b56286a 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -28,4 +28,7 @@ ip-from-header: "_env:YESOD_IP_FROM_HEADER:false" # NB: If you need a numeric value (e.g. 123) to parse as a String, wrap it in single quotes (e.g. "_env:YESOD_PGPASS:'123'") # See https://github.com/yesodweb/yesod/wiki/Configuration#parsing-numeric-values-as-strings -app-compatibility-path: "_env:APP_COMPATIBILITY_CONFIG:/etc/start9/registry/compatibility.json" \ No newline at end of file +app-compatibility-path: "_env:APP_COMPATIBILITY_CONFIG:/etc/start9/registry/compatibility.json" +resources-path: "_env:RESOURCES_PATH:/var/www/html/resources" +ssl-path: "_env:SSL_PATH:/var/ssl" +registry-hostname: "_env:REGISTRY_HOSTNAME:registry.start9labs.com" \ No newline at end of file diff --git a/package.yaml b/package.yaml index 6af4e39..9f9fed6 100644 --- a/package.yaml +++ b/package.yaml @@ -1,40 +1,14 @@ -flags: - library-only: - manual: false - default: false - description: Build for use with "yesod devel" - dev: - manual: false - default: false - description: Turn on development settings, like auto-reload templates. -library: - source-dirs: src - when: - - then: - cpp-options: -DDEVELOPMENT - ghc-options: - - -Wall - - -fwarn-tabs - - -O0 - - -fdefer-typed-holes - else: - ghc-options: - - -Wall - - -fwarn-tabs - - -O2 - - -fdefer-typed-holes - condition: (flag(dev)) || (flag(library-only)) -tests: - start9-registry-test: - source-dirs: test - main: Spec.hs - ghc-options: - - -Wall - - -fdefer-typed-holes - dependencies: - - start9-registry - - hspec >=2.0.0 - - yesod-test +name: start9-registry +version: 0.0.0 + +default-extensions: +- NoImplicitPrelude +- GeneralizedNewtypeDeriving +- LambdaCase +- MultiWayIf +- NamedFieldPuns +- NumericUnderscores +- OverloadedStrings dependencies: - base >=4.9.1.0 && <5 @@ -88,27 +62,58 @@ dependencies: - yesod-static - yesod-persistent >= 1.6 && < 1.7 -default-extensions: -- NoImplicitPrelude -- GeneralizedNewtypeDeriving -- LambdaCase -- MultiWayIf -- NamedFieldPuns -- NumericUnderscores -- OverloadedStrings -name: start9-registry -version: 0.0.0 +library: + source-dirs: src + when: + - condition: (flag(dev)) || (flag(library-only)) + then: + cpp-options: -DDEVELOPMENT + ghc-options: + - -Wall + - -fwarn-tabs + - -O0 + - -fdefer-typed-holes + else: + ghc-options: + - -Wall + - -fwarn-tabs + - -O2 + - -fdefer-typed-holes + executables: start9-registry: source-dirs: app main: main.hs ghc-options: - - -threaded - - -rtsopts - - -with-rtsopts=-N - - -fdefer-typed-holes + - -threaded + - -rtsopts + - -with-rtsopts=-N + - -fdefer-typed-holes dependencies: - - start9-registry + - start9-registry when: - - buildable: false - condition: flag(library-only) + - condition: flag(library-only) + buildable: false + +tests: + start9-registry-test: + source-dirs: test + main: Main.hs + ghc-options: + - -Wall + - -fdefer-typed-holes + dependencies: + - start9-registry + - hspec + - yesod-test + - hedgehog + +flags: + library-only: + manual: false + default: false + description: Build for use with "yesod devel" + dev: + manual: false + default: false + description: Turn on development settings, like auto-reload templates. \ No newline at end of file diff --git a/src/Application.hs b/src/Application.hs index f95ba9c..ffeca29 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -165,16 +165,15 @@ startApp :: AgentCtx -> IO () startApp foundation = do -- set up ssl certificates putStrLn @Text "Setting up SSL" - setupSsl + _ <- setupSsl <$> getAppSettings putStrLn @Text "SSL Setup Complete" - startWeb foundation startWeb :: AgentCtx -> IO () startWeb foundation = do app <- makeApplication foundation - - putStrLn @Text $ "Launching Web Server on port " <> show (appPort $ appSettings foundation) + let AppSettings{..} = appSettings foundation + putStrLn @Text $ "Launching Web Server on port " <> show appPort action <- async $ runTLS (tlsSettings sslCertLocation sslKeyLocation) (warpSettings foundation) diff --git a/src/Constants.hs b/src/Constants.hs deleted file mode 100644 index 261d480..0000000 --- a/src/Constants.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Constants where - -import Data.Aeson -import Data.Aeson.Types -import Data.Maybe -import Data.Version (showVersion) -import Lib.Types.Semver -import Paths_start9_registry (version) -import Startlude - -sslPath :: FilePath -sslPath = "/var/ssl" - -resourcesDir :: FilePath -resourcesDir = "/var/www/html/resources" -- "./resources" -- - -registryVersion :: AppVersion -registryVersion = fromJust . parseMaybe parseJSON . String . toS . showVersion $ version - -getRegistryHostname :: IsString a => a -getRegistryHostname = "registry.start9labs.com" diff --git a/src/Handler/Apps.hs b/src/Handler/Apps.hs index 575461f..d622b9e 100644 --- a/src/Handler/Apps.hs +++ b/src/Handler/Apps.hs @@ -23,8 +23,9 @@ import Yesod.Core import Foundation import Lib.Registry import Lib.Semver -import System.FilePath ((<.>)) +import System.FilePath ((<.>), ()) import System.Posix.Files (fileSize, getFileStatus) +import Settings pureLog :: Show a => a -> Handler a pureLog = liftA2 (*>) ($logInfo . show) pure @@ -38,13 +39,19 @@ instance Show FileExtension where show (FileExtension f (Just e)) = f <.> e getAppsManifestR :: Handler TypedContent -getAppsManifestR = respondSource typePlain $ CB.sourceFile appManifestPath .| awaitForever sendChunkBS +getAppsManifestR = do + appResourceDir <- ( "apps" "apps.yaml") . resourcesDir . appSettings <$> getYesod + respondSource typePlain $ CB.sourceFile appResourceDir .| awaitForever sendChunkBS getSysR :: Extension "" -> Handler TypedContent -getSysR = getApp sysResourceDir +getSysR e = do + sysResourceDir <- ( "sys") . resourcesDir . appSettings <$> getYesod + getApp sysResourceDir e getAppR :: Extension "s9pk" -> Handler TypedContent -getAppR = getApp appResourceDir +getAppR e = do + appResourceDir <- ( "apps" "apps.yaml") . resourcesDir . appSettings <$> getYesod + getApp appResourceDir e getApp :: KnownSymbol a => FilePath -> Extension a -> Handler TypedContent getApp rootDir ext = do diff --git a/src/Handler/Icons.hs b/src/Handler/Icons.hs index 0cf44ad..13a9027 100644 --- a/src/Handler/Icons.hs +++ b/src/Handler/Icons.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE RecordWildCards #-} module Handler.Icons where @@ -12,10 +13,13 @@ import Yesod.Core import Foundation import Lib.Registry +import Settings +import System.FilePath (()) getIconsR :: Extension "png" -> Handler TypedContent getIconsR ext = do - mPng <- liftIO $ getUnversionedFileFromDir iconsResourceDir ext + AppSettings{..} <- appSettings <$> getYesod + mPng <- liftIO $ getUnversionedFileFromDir (resourcesDir "icons") ext case mPng of Nothing -> notFound Just pngPath -> do diff --git a/src/Handler/Version.hs b/src/Handler/Version.hs index 84a08a7..7cb7a45 100644 --- a/src/Handler/Version.hs +++ b/src/Handler/Version.hs @@ -2,6 +2,8 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE RecordWildCards #-} + module Handler.Version where import Startlude @@ -14,24 +16,30 @@ import qualified Data.Text as T import Network.HTTP.Types import Yesod.Core -import Constants import Foundation import Handler.Types.Status import Lib.Registry import Lib.Semver import Lib.Types.Semver +import Settings +import System.FilePath (()) getVersionR :: Handler AppVersionRes -getVersionR = pure . AppVersionRes registryVersion $ Nothing +getVersionR = do + rv <- AppVersionRes . registryVersion . appSettings <$> getYesod + pure . rv $ Nothing getVersionAppR :: Text -> Handler (Maybe AppVersionRes) -getVersionAppR appId = getVersionWSpec appResourceDir appExt +getVersionAppR appId = do + appsDir <- ( "apps") . resourcesDir . appSettings <$> getYesod + getVersionWSpec appsDir appExt where appExt = Extension (toS appId) :: Extension "s9pk" getVersionSysR :: Text -> Handler (Maybe AppVersionRes) getVersionSysR sysAppId = runMaybeT $ do - avr <- MaybeT $ getVersionWSpec sysResourceDir sysExt + sysDir <- ( "sys") . resourcesDir . appSettings <$> getYesod + avr <- MaybeT $ getVersionWSpec sysDir sysExt minComp <- lift $ case sysAppId of "agent" -> Just <$> meshCompanionCompatibility (appVersionVersion avr) _ -> pure Nothing @@ -50,7 +58,7 @@ getVersionWSpec rootDir ext = do pure $ liftA2 AppVersionRes av (pure Nothing) meshCompanionCompatibility :: AppVersion -> Handler AppVersion -meshCompanionCompatibility av = getsYesod appCompatibilityMap >>= \hm -> do +meshCompanionCompatibility av = getsYesod appCompatibilityMap >>= \hm -> case HM.lookup av hm of Nothing -> do $logError [i|MESH DEPLOYMENT "#{av}" HAS NO COMPATIBILITY ENTRY! FIX IMMEDIATELY|] diff --git a/src/Lib/Registry.hs b/src/Lib/Registry.hs index 3e3e288..0db0957 100644 --- a/src/Lib/Registry.hs +++ b/src/Lib/Registry.hs @@ -14,25 +14,9 @@ import System.Directory import System.FilePath import Yesod.Core -import Constants import Lib.Semver import Lib.Types.Semver -appResourceDir :: FilePath -appResourceDir = resourcesDir "apps" - -sysResourceDir :: FilePath -sysResourceDir = resourcesDir "sys" - -iconsResourceDir :: FilePath -iconsResourceDir = resourcesDir "icons" - -appManifestPath :: FilePath -appManifestPath = appResourceDir appManifestFile - -appManifestFile :: FilePath -appManifestFile = "apps.yaml" - type Registry = HashMap String (HashMap AppVersion FilePath) newtype RegisteredAppVersion = RegisteredAppVersion (AppVersion, FilePath) deriving (Eq, Show) diff --git a/src/Lib/Ssl.hs b/src/Lib/Ssl.hs index d1a1383..c28f8f2 100644 --- a/src/Lib/Ssl.hs +++ b/src/Lib/Ssl.hs @@ -1,58 +1,49 @@ {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} + module Lib.Ssl where import Startlude import Data.String.Interpolate.IsString import System.Directory -import System.FilePath import System.Process - -import Constants +import Settings -- openssl genrsa -out key.pem 2048 -- openssl req -new -key key.pem -out certificate.csr -- openssl x509 -req -in certificate.csr -signkey key.pem -out certificate.pem -sslKeyLocation :: FilePath -sslKeyLocation = sslPath "key.pem" - -sslCsrLocation :: FilePath -sslCsrLocation = sslPath "certificate.csr" - -sslCertLocation :: FilePath -sslCertLocation = sslPath "certificate.pem" - -checkForSslCert :: IO Bool -checkForSslCert = - doesPathExist sslKeyLocation <&&> doesPathExist sslCertLocation - -generateSslKey :: IO ExitCode -generateSslKey = rawSystem "openssl" ["genrsa", "-out", sslKeyLocation, "2048"] - -generateSslCert :: Text -> IO ExitCode -generateSslCert name = rawSystem - "openssl" - ["req", "-new", "-key", sslKeyLocation, "-out", sslCsrLocation, "-subj", [i|/CN=#{name}.local|]] - -selfSignSslCert :: IO ExitCode -selfSignSslCert = rawSystem - "openssl" - [ "x509" - , "-req" - , "-in" - , sslCsrLocation - , "-signkey" - , sslKeyLocation - , "-out" - , sslCertLocation - ] - -setupSsl :: IO () -setupSsl = do +setupSsl :: AppSettings -> IO () +setupSsl AppSettings{..} = do exists <- checkForSslCert unless exists $ do void $ system $ "mkdir -p " <> sslPath void generateSslKey - void $ generateSslCert getRegistryHostname + void $ generateSslCert registryHostname void selfSignSslCert + where + checkForSslCert :: IO Bool + checkForSslCert = + doesPathExist sslKeyLocation <&&> doesPathExist sslCertLocation + + generateSslKey :: IO ExitCode + generateSslKey = rawSystem "openssl" ["genrsa", "-out", sslKeyLocation, "2048"] + + generateSslCert :: Text -> IO ExitCode + generateSslCert name = rawSystem + "openssl" + ["req", "-new", "-key", sslKeyLocation, "-out", sslCsrLocation, "-subj", [i|/CN=#{name}.local|]] + + selfSignSslCert :: IO ExitCode + selfSignSslCert = rawSystem + "openssl" + [ "x509" + , "-req" + , "-in" + , sslCsrLocation + , "-signkey" + , sslKeyLocation + , "-out" + , sslCertLocation + ] \ No newline at end of file diff --git a/src/Settings.hs b/src/Settings.hs index 0729683..f6ad150 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -10,11 +10,17 @@ module Settings where import Startlude import qualified Control.Exception as Exception +import Data.Maybe import Data.Aeson +import Data.Aeson.Types +import Data.Version (showVersion) import Data.FileEmbed (embedFile) import Data.Yaml (decodeEither') import Network.Wai.Handler.Warp (HostPreference) import Yesod.Default.Config2 (applyEnvValue, configSettingsYml) +import Paths_start9_registry (version) +import Lib.Types.Semver +import System.FilePath (()) -- | Runtime settings to configure this application. These settings can be -- loaded from various sources: defaults, environment variables, config files, @@ -33,6 +39,13 @@ data AppSettings = AppSettings , appShouldLogAll :: Bool -- ^ Should all log messages be displayed? , appCompatibilityPath :: FilePath + , resourcesDir :: FilePath + , sslPath :: FilePath + , registryHostname :: Text + , registryVersion :: AppVersion + , sslKeyLocation :: FilePath + , sslCsrLocation :: FilePath + , sslCertLocation :: FilePath } instance FromJSON AppSettings where @@ -43,7 +56,15 @@ instance FromJSON AppSettings where appDetailedRequestLogging <- o .:? "detailed-logging" .!= True appShouldLogAll <- o .:? "should-log-all" .!= False appCompatibilityPath <- o .: "app-compatibility-path" - + resourcesDir <- o .: "resources-path" + sslPath <- o .: "ssl-path" + registryHostname <- o .: "registry-hostname" + + let sslKeyLocation = sslPath "key.pem" + let sslCsrLocation = sslPath "certificate.csr" + let sslCertLocation = sslPath "certificate.pem" + let registryVersion = fromJust . parseMaybe parseJSON . String . toS . showVersion $ version + return AppSettings { .. } -- | Raw bytes at compile time of @config/settings.yml@ diff --git a/stack.yaml b/stack.yaml index a3e9de4..efd76a5 100644 --- a/stack.yaml +++ b/stack.yaml @@ -17,7 +17,7 @@ # # resolver: ./custom-snapshot.yaml # resolver: https://example.com/snapshots/2018-01-01.yaml -resolver: lts-13.11 +resolver: lts-13.19 # User packages to be built. # Various formats can be used as shown in the example below. @@ -43,6 +43,7 @@ extra-deps: - protolude-0.2.4 - git: https://github.com/CaptJakk/jose-jwt.git commit: 63210e8d05543dac932ddfe5c212450beb88374c + - haskell-src-exts-1.21.1@sha256:11d18ec3f463185f81b7819376b532e3087f8192cffc629aac5c9eec88897b35,4541 # Override default flag values for local packages and extra-deps # flags: {} diff --git a/test/Handler/AppSpec.hs b/test/Handler/AppSpec.hs new file mode 100644 index 0000000..83ac4c7 --- /dev/null +++ b/test/Handler/AppSpec.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE TypeFamilies #-} + +module Handler.AppSpec (spec) where + +import Startlude +import TestImport + +spec :: Spec +spec = describe "GET /apps" $ + withApp $ it "returns list of apps" $ do + request $ do + setMethod "GET" + setUrl ("/apps" :: Text) + bodyContains "bitcoind" + bodyContains "version: 0.18.1" + statusIs 200 \ No newline at end of file diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 index 0000000..f3031d9 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,13 @@ +module Main where + +import Test.Hspec.Runner +import qualified Spec +import Test.Hspec.Formatters +import Startlude +import GHC.IO.Encoding + + +main :: IO () +main = do + setLocaleEncoding utf8 + hspecWith defaultConfig { configFormatter = Just progress } Spec.spec diff --git a/test/Spec.hs b/test/Spec.hs index a824f8c..b7fb4ef 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1 +1 @@ -{-# OPTIONS_GHC -F -pgmF hspec-discover #-} +{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-} \ No newline at end of file diff --git a/test/TestImport.hs b/test/TestImport.hs new file mode 100644 index 0000000..d0b6752 --- /dev/null +++ b/test/TestImport.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE QuasiQuotes #-} + +module TestImport + ( module TestImport + , module X + ) where + +import Startlude +import Application (makeFoundation, makeLogWare) +import Foundation as X +import Test.Hspec as X +import Yesod.Default.Config2 (useEnv, loadYamlSettings) +import Yesod.Test as X +import Yesod.Core.Unsafe (fakeHandlerGetLogger) + +runHandler :: Handler a -> YesodExample AgentCtx a +runHandler handler = do + app <- getTestYesod + fakeHandlerGetLogger appLogger app handler + +withApp :: SpecWith (TestApp AgentCtx) -> Spec +withApp = before $ do + settings <- loadYamlSettings + ["config/settings.yml"] + [] + useEnv + foundation <- makeFoundation settings + logWare <- liftIO $ makeLogWare foundation + return (foundation, logWare) \ No newline at end of file