registry changes ready for 0.1.2 sys release

config/settings.yml

@@ -28,16 +28,4 @@ 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
 
-database:
-  database: "_env:YESOD_SQLITE_DATABASE:start9_agent.sqlite3"
-  poolsize: "_env:YESOD_SQLITE_POOLSIZE:10"
-
-ap-password: "_env:AP_PASSWORD:at_first_I_was_afraid"
-copyright: Insert copyright statement here
-
-registry-host: "_env:REGISTRY_HOST:registry.start9labs.com"
-registry-port: "_env:REGISTRY_PORT:443"
-agent-dir: "_env:AGENT_DIR:/root/agent"
-app-mgr-version-spec: "_env:APP_MGR_VERSION_SPEC:=0.0.0"
-
-#analytics: UA-YOURCODE
+app-compatibility-path: "_env:APP_COMPATIBILITY_CONFIG:/etc/start9/registry/compatibility.json"

src/Application.hs

@@ -23,16 +23,14 @@ module Application
     , getAppSettings
     -- * for GHCI
     , handler
-    , db
     ) where
 
 import           Startlude
 
-import           Control.Monad.Logger                  (liftLoc, runLoggingT)
+import           Control.Monad.Logger                  (liftLoc)
+import           Data.Aeson
 import           Data.Default
 import           Data.IORef
-import           Database.Persist.Sql
-import           Database.Persist.Sqlite               (createSqlitePool, runSqlPool, sqlDatabase, sqlPoolSize)
 import           Language.Haskell.TH.Syntax            (qLocation)
 import           Network.Wai
 import           Network.Wai.Handler.Warp              (Settings, defaultSettings, defaultShouldDisplayException,
@@ -48,7 +46,6 @@ import           System.Log.FastLogger                 (defaultBufSize, newStdou
 import           Yesod.Core
 import           Yesod.Core.Types                      hiding (Logger)
 import           Yesod.Default.Config2
-import           Yesod.Persist.Core
 
 -- Import all relevant handler modules here.
 -- Don't forget to add new modules to your cabal file!
@@ -57,7 +54,6 @@ import           Handler.Apps
 import           Handler.Icons
 import           Handler.Version
 import           Lib.Ssl
-import           Model
 import           Settings
 import           System.Posix.Process
 
@@ -79,30 +75,22 @@ makeFoundation appSettings = do
 
     appWebServerThreadId <- newIORef Nothing
 
+    appCompatibilityMap <- decode . toS <$> readFile (appCompatibilityPath appSettings) >>= \case
+        Nothing -> panic "invalid compatibility config"
+        Just x -> pure x
+
     -- We need a log function to create a connection pool. We need a connection
     -- pool to create our foundation. And we need our foundation to get a
     -- logging function. To get out of this loop, we initially create a
     -- temporary foundation without a real connection pool, get a log function
     -- from there, and then create the real foundation.
-    let mkFoundation appConnPool = AgentCtx {..}
+    let mkFoundation = AgentCtx {..}
         -- The AgentCtx {..} syntax is an example of record wild cards. For more
         -- information, see:
         -- https://ocharles.org.uk/blog/posts/2014-12-04-record-wildcards.html
-        tempFoundation = mkFoundation $ panic "connPool forced in tempFoundation"
-        logFunc = messageLoggerSource tempFoundation appLogger
-
-    -- Create the database connection pool
-    pool <- flip runLoggingT logFunc $ createSqlitePool
-            (sqlDatabase $ appDatabaseConf appSettings)
-            (sqlPoolSize $ appDatabaseConf appSettings)
-    -- Perform database migration using our application's logging settings.
-    runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc
-
-    -- TODO :: compute and seed the Tor address into the db, possibly grabbing it from settings
-    -- seedTorAddress appSettings
 
     -- Return the foundation
-    return $ mkFoundation pool
+    return $ mkFoundation
 
 -- | Convert our foundation to a WAI Application by calling @toWaiAppPlain@ and
 -- applying some additional middlewares.
@@ -229,7 +217,3 @@ shutdownApp _ = return ()
 -- | Run a handler
 handler :: Handler a -> IO a
 handler h = getAppSettings >>= makeFoundation >>= flip unsafeHandler h
-
--- | Run DB queries
-db :: ReaderT SqlBackend Handler a -> IO a
-db = handler . runDB

src/Foundation.hs

@@ -9,14 +9,15 @@ module Foundation where
 import           Startlude
 
 import           Control.Monad.Logger (LogSource)
+import qualified Data.HashMap.Strict  as HM
 import           Data.IORef
 import           Database.Persist.Sql
 import           Lib.Registry
 import           Yesod.Core
 import           Yesod.Core.Types     (Logger)
 import qualified Yesod.Core.Unsafe    as Unsafe
-import           Yesod.Persist.Core
 
+import           Lib.Types.Semver
 import           Settings
 
 -- | The foundation datatype for your application. This can be a good place to
@@ -27,9 +28,9 @@ import           Settings
 
 data AgentCtx = AgentCtx
     { appSettings          :: AppSettings
-    , appConnPool          :: ConnectionPool -- ^ Database connection pool.
     , appLogger            :: Logger
     , appWebServerThreadId :: IORef (Maybe ThreadId)
+    , appCompatibilityMap  :: HM.HashMap AppVersion AppVersion
     }
 
 setWebProcessThreadId :: ThreadId -> AgentCtx -> IO ()
@@ -84,16 +85,6 @@ instance Yesod AgentCtx where
     makeLogger :: AgentCtx -> IO Logger
     makeLogger = return . appLogger
 
--- How to run database actions.
-instance YesodPersist AgentCtx where
-    type YesodPersistBackend AgentCtx = SqlBackend
-    runDB :: SqlPersistT Handler a -> Handler a
-    runDB action = runSqlPool action . appConnPool =<< getYesod
-
-instance YesodPersistRunner AgentCtx where
-    getDBRunner :: Handler (DBRunner AgentCtx, Handler ())
-    getDBRunner = defaultGetDBRunner appConnPool
-
 unsafeHandler :: AgentCtx -> Handler a -> IO a
 unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger
 

src/Handler/Version.hs

@@ -7,6 +7,7 @@ module Handler.Version where
 import           Startlude
 
 import           Control.Monad.Trans.Maybe
+import qualified Data.HashMap.Strict as HM
 import           Data.String.Interpolate.IsString
 import           Network.HTTP.Types
 import           Yesod.Core
@@ -44,9 +45,9 @@ getVersionWSpec rootDir ext = do
     pure $ liftA2 AppVersionRes av (pure Nothing)
 
 meshCompanionCompatibility :: AppVersion -> Handler AppVersion
-meshCompanionCompatibility (AppVersion (0,1,0,_)) = pure $ AppVersion (1,0,0,0)
-meshCompanionCompatibility (AppVersion (0,1,1,_)) = pure $ AppVersion (1,0,0,0)
-meshCompanionCompatibility (AppVersion (0,1,2,_)) = pure $ AppVersion (1,1,0,0)
-meshCompanionCompatibility other = do
-    $logError [i|MESH DEPLOYMENT "#{other}" HAS NO COMPATIBILITY ENTRY! FIX IMMEDIATELY|]
-    sendResponseStatus status500 ("Internal Server Error" :: Text)
+meshCompanionCompatibility av = getsYesod appCompatibilityMap >>= \hm -> do
+    case HM.lookup av hm of
+        Nothing -> do
+            $logError [i|MESH DEPLOYMENT "#{av}" HAS NO COMPATIBILITY ENTRY! FIX IMMEDIATELY|]
+            sendResponseStatus status500 ("Internal Server Error" :: Text)
+        Just x -> pure x

src/Lib/Types/Semver.hs

@@ -19,7 +19,7 @@ import           Yesod.Core
 ------------------------------------------------------------------------------------------------------------------------
 
 newtype AppVersion = AppVersion
-    { unAppVersion :: (Word16, Word16, Word16, Word16) } deriving (Eq, Ord)
+    { unAppVersion :: (Word16, Word16, Word16, Word16) } deriving (Eq, Ord, Hashable)
 
 instance Read AppVersion where
     readsPrec _ s = case traverse (readMaybe . toS) $ splitOn "+" <=< splitOn "." $ (toS s) of
@@ -53,6 +53,11 @@ instance ToTypedContent AppVersion where
 instance ToContent AppVersion where
     toContent = toContent . toJSON
 
+instance FromJSONKey AppVersion where
+    fromJSONKey = FromJSONKeyTextParser $ \t -> case readMaybe (toS t) of
+        Nothing -> fail "invalid app version"
+        Just x -> pure x
+
 ------------------------------------------------------------------------------------------------------------------------
 -- Semver AppVersionSpecification
 ------------------------------------------------------------------------------------------------------------------------

src/Model.hs

@@ -1,23 +0,0 @@
-{-# LANGUAGE DataKinds                  #-}
-{-# LANGUAGE FlexibleInstances          #-}
-{-# LANGUAGE GADTs                      #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses      #-}
-{-# LANGUAGE QuasiQuotes                #-}
-{-# LANGUAGE TemplateHaskell            #-}
-{-# LANGUAGE TypeFamilies               #-}
-module Model where
-
-import           Database.Persist.TH
-
-share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
--- AuthorizedKey
---     createdAt UTCTime
---     updatedAt UTCTime
---     name Text
---     pubKey CompressedKey
---     root Bool
---     UniquePubKey pubKey
---     deriving Eq
---     deriving Show
-|]

src/Settings.hs

@@ -13,7 +13,6 @@ import qualified Control.Exception        as Exception
 import           Data.Aeson
 import           Data.FileEmbed           (embedFile)
 import           Data.Yaml                (decodeEither')
-import           Database.Persist.Sqlite  (SqliteConf (..))
 import           Network.Wai.Handler.Warp (HostPreference)
 import           Yesod.Default.Config2    (applyEnvValue, configSettingsYml)
 
@@ -21,10 +20,7 @@ import           Yesod.Default.Config2    (applyEnvValue, configSettingsYml)
 -- loaded from various sources: defaults, environment variables, config files,
 -- theoretically even a database.
 data AppSettings = AppSettings
-    { appDatabaseConf           :: SqliteConf
-    -- ^ Configuration settings for accessing the database.
-
-    , appHost                   :: HostPreference
+    { appHost                   :: HostPreference
     -- ^ Host/interface the server should bind to.
     , appPort                   :: Word16
     -- ^ Port to listen on
@@ -36,16 +32,17 @@ data AppSettings = AppSettings
     -- ^ Use detailed request logging system
     , appShouldLogAll           :: Bool
     -- ^ Should all log messages be displayed?
+    , appCompatibilityPath      :: FilePath
     }
 
 instance FromJSON AppSettings where
     parseJSON = withObject "AppSettings" $ \o -> do
-        appDatabaseConf           <-  o .: "database"
         appHost                   <- fromString <$> o .: "host"
         appPort                   <- o .: "port"
         appIpFromHeader           <- o .: "ip-from-header"
         appDetailedRequestLogging <- o .:? "detailed-logging" .!= True
         appShouldLogAll           <- o .:? "should-log-all" .!= False
+        appCompatibilityPath      <- o .: "app-compatibility-path"
 
         return AppSettings { .. }