Merge pull request #7 from Start9Labs/feat/test

Feat/test

.gitignore

@@ -27,3 +27,4 @@ stack.yaml.lock
 agent_*
 agent.*
 version
+hie.yaml

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

config/settings.yml

@@ -29,3 +29,6 @@ ip-from-header: "_env:YESOD_IP_FROM_HEADER:false"
 # 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"
+resources-path: "_env:RESOURCES_PATH:/var/www/html/resources" 
+ssl-path: "_env:SSL_PATH:/var/ssl"
+registry-hostname: "_env:REGISTRY_HOSTNAME:registry.start9labs.com"

package.yaml

@@ -1,40 +1,14 @@
-flags:
+name: start9-registry
-  library-only:
+version: 0.0.0
-    manual: false
+
-    default: false
+default-extensions:
-    description: Build for use with "yesod devel"
+- NoImplicitPrelude
-  dev:
+- GeneralizedNewtypeDeriving
-    manual: false
+- LambdaCase
-    default: false
+- MultiWayIf
-    description: Turn on development settings, like auto-reload templates.
+- NamedFieldPuns
-library:
+- NumericUnderscores
-  source-dirs: src
+- OverloadedStrings
-  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
 
 dependencies:
 - base >=4.9.1.0 && <5
@@ -88,27 +62,58 @@ dependencies:
 - yesod-static
 - yesod-persistent >= 1.6 && < 1.7
 
-default-extensions:
+library:
-- NoImplicitPrelude
+  source-dirs: src
-- GeneralizedNewtypeDeriving
+  when:
-- LambdaCase
+    - condition: (flag(dev)) || (flag(library-only))
-- MultiWayIf
+      then:
-- NamedFieldPuns
+        cpp-options: -DDEVELOPMENT
-- NumericUnderscores
+        ghc-options:
-- OverloadedStrings
+          - -Wall
-name: start9-registry
+          - -fwarn-tabs
-version: 0.0.0
+          - -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
+      - -threaded
-    - -rtsopts
+      - -rtsopts
-    - -with-rtsopts=-N
+      - -with-rtsopts=-N
-    - -fdefer-typed-holes
+      - -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.

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
-
+    let AppSettings{..} = appSettings foundation
-    putStrLn @Text $ "Launching Web Server on port " <> show (appPort $ appSettings foundation)
+    putStrLn @Text $ "Launching Web Server on port " <> show appPort
     action <- async $ runTLS
         (tlsSettings sslCertLocation sslKeyLocation)
         (warpSettings foundation)

src/Constants.hs

@@ -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"

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

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

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|]

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)

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           Settings
-import           Constants
 
 -- 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
+setupSsl :: AppSettings -> IO ()
-sslKeyLocation = sslPath </> "key.pem"
+setupSsl AppSettings{..} = do
-
-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
     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
+            ]

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,6 +56,14 @@ 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 { .. }
 

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: {}

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

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

test/Spec.hs

@@ -1 +1 @@
-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}

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)