smaller changes not changing semantics

.gitmodules

@@ -1,3 +1,3 @@
 [submodule "tickLeiste"]
 	path = tickLeiste
-	url = https://git.nerfingen.de/Splittertech/tickLeiste.git
+	url = ssh://gitolite@nerfingen.de:39999/tickLeiste

app/Backend/Backend.hs

@@ -21,9 +21,7 @@ import qualified Backend.Https as HTTPS
 -- list of MVar is there to communicate the termination of the backend. (The main
 -- threat will wait till all MVar are present (not neccesarry at once)).
 -- The action takes two parameter, the application the backend should run and
--- the path of the config File. If the Bool is False there are no guarantees on the FilePath
+-- the path of the config File.
--- and the action should not try to evaluate the FilePath.
--- type Backend = (Wai.Application -> FilePath -> IO [MVar ()],T.Text,Bool)
 
 data Backend =
   BackendWithConfig (Wai.Application -> FilePath -> EnvM [MVar ()]) String String

app/Backend/Http.hs

@@ -67,9 +67,9 @@ httpDefaultSettings = [httpDefaultSetting]
 httpConfigCodec :: TomlCodec HttpConfiguration
 httpConfigCodec =
   HttpConfiguration
-    <$> Toml.configM Toml.text "instanceName" .= instanceName
+    <$> Toml.configM Toml.text "InstanceName" .= instanceName
-    <*> Toml.configM Toml.int  "port"         .= port
+    <*> Toml.configM Toml.int  "Port"         .= port
-    <*> Toml.configM bindPreference "bind"    .= bindPref
+    <*> Toml.configM bindPreference "Bind"    .= bindPref
 
 httpConfigsCodec :: TomlCodec [HttpConfiguration]
 httpConfigsCodec = Toml.list httpConfigCodec "http"

app/Backend/Https.hs

@@ -55,9 +55,9 @@ httpsDefaultSettings = [httpsDefaultSetting]
 httpsConfigCodec' :: TomlCodec TLSConfiguration
 httpsConfigCodec' =
   TLSConfiguration
-    <$> Toml.configM Toml.string "certificate"               .= certFile
+    <$> Toml.configM Toml.string "Certificate"               .= certFile
-    <*> Toml.configM (Toml.arrayOf Toml._String) "certChain" .= certChain
+    <*> Toml.configM (Toml.arrayOf Toml._String) "CertChain" .= certChain
-    <*> Toml.configM Toml.string "keyFile"                   .= keyFile
+    <*> Toml.configM Toml.string "KeyFile"                   .= keyFile
 
 httpsConfigCodec :: TomlCodec HttpsConfiguration
 httpsConfigCodec = Toml.pair httpConfigCodec httpsConfigCodec'

app/Environment.hs

@@ -11,13 +11,13 @@ module Environment(Env (..), EnvM, runEnvM, myLogAction,defaultEnv) where
 import Prelude hiding (log)
 import Colog
 import Control.Monad.Reader (ReaderT (..), MonadReader)
-import Control.Monad.Trans
+import Control.Monad.Trans(lift)
 import Control.Monad.IO.Unlift
 import Control.Concurrent.MVar (MVar,modifyMVar_,newMVar)
 import System.IO.Unsafe(unsafePerformIO)
-import qualified Control.Concurrent.MVar as M
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
+import Control.Parallel(pseq)
 
 newtype Env m = Env {logAction :: LogAction m Message}
 
@@ -42,20 +42,21 @@ instance MonadUnliftIO EnvM where
   withRunInIO inner = EnvM $ withRunInIO (\fromReader -> inner (fromReader . unEnvM))
   {-# INLINE withRunInIO #-}
 
-modifyMVar :: M.MVar a -> (a -> EnvM (a,b)) -> EnvM b
-modifyMVar mvar action = withRunInIO $ \run -> M.modifyMVar mvar (run . action)
-
-
 runEnvM :: Env EnvM -> EnvM a -> IO a
 runEnvM env envm = runReaderT (unEnvM envm) env
 
+-- we do not export this MVar (which makes it easier to reason about deadlocks
 syncMVar :: MVar ()
 syncMVar = unsafePerformIO $ newMVar ()
 {-# NOINLINE syncMVar #-}
 
+-- Every time you do something like this you should ask yourself: Is this a potential deadlock? And the answer
+-- is in this case is NO. Even if m diverges it won't be able to lock up other threads as it will be forced to
+-- evaluate before we take the MVar. So as long printing to stdout terminates we will always put back the mvar.
 myLogAction :: LogAction EnvM Message
-myLogAction = LogAction $ \x -> EnvM . lift $ modifyMVar_ syncMVar (const (T.putStrLn . formatMessage $ x))
+myLogAction = LogAction $ \x -> let m = formatMessage x in EnvM . lift $ m `pseq` modifyMVar_ syncMVar (const (T.putStrLn m))
 
+-- my format Message without fancy colors, but with syslog numbers
 formatMessage :: Message -> T.Text
 formatMessage Msg{..} =
   showMyServerity msgSeverity

app/Main.hs

@@ -41,6 +41,13 @@ defaultLogLevel = Info
 blockBackends :: [MVar ()] -> EnvM ()
 blockBackends = mapM_ takeMVar
 
+runBackend :: Wai.Application -> Either (Maybe String) Bool -> Backend -> EnvM [MVar ()]
+runBackend app (Left (Just conf))  (BackendWithConfig    b _ _) = b app conf
+runBackend _   (Left Nothing)      (BackendWithConfig    _ _ _) = return []
+runBackend app (Right True)        (BackendWithoutConfig b _ _) = b app
+runBackend _   (Right False)       (BackendWithoutConfig _ _ _) = return []
+runBackend _   _                   _                            = logError "Backend and parser type don't match! THIS IS A BUG" >> return []
+
 data CommandLineOptions = CommandLineOptions {
   backendOptions :: [Either (Maybe String) Bool],
   logSeverity :: Maybe Severity
@@ -57,14 +64,6 @@ parser = CommandLineOptions
   <$> backendsParser
   <*> severityParser
 
-
-runBackend :: Wai.Application -> Either (Maybe String) Bool -> Backend -> EnvM [MVar ()]
-runBackend app (Left (Just conf))  (BackendWithConfig    b _ _) = b app conf
-runBackend _   (Left Nothing)      (BackendWithConfig    _ _ _) = return []
-runBackend app (Right True)        (BackendWithoutConfig b _ _) = b app
-runBackend _   (Right False)       (BackendWithoutConfig _ _ _) = return []
-runBackend _   _                   _                            = logError "Backend and parser type don't match! THIS IS A BUG" >> return []
-
 commandLineParser :: ParserInfo CommandLineOptions
 commandLineParser = info (parser <**> helper)
   (  fullDesc

package.yaml

@@ -41,17 +41,16 @@ dependencies:
 - containers
 - wai
 - wai-websockets
-# only used for the error message on missing webclient
 - http-types
 - tomland
-# if we want more interaction with tomland errors this might
+- validation-selective
-# be practical (not used atm, there are functions to Either)
-#- validation-selective
 - optparse-applicative
 - co-log
 - unliftio-core
 - unliftio
 - mtl
+# for pseq in logging
+- parallel
 
 when:
   - condition: flag(http)
@@ -86,5 +85,5 @@ tests:
     - -threaded
     - -rtsopts
     - -with-rtsopts=-N
-#    dependencies:
+    dependencies:
-#    - tickLeisteServer
+    - tickLeisteServer

tickLeisteServer.cabal

@@ -56,6 +56,7 @@ executable tickLeisteServer
     , http-types
     , mtl
     , optparse-applicative
+    , parallel
     , text
     , tickLeiste
     , tickLeiste-aeson
@@ -63,6 +64,7 @@ executable tickLeisteServer
     , unliftio
     , unliftio-core
     , uuid
+    , validation-selective
     , wai
     , wai-websockets
     , websockets
@@ -96,13 +98,16 @@ test-suite tickLeisteServer-test
     , http-types
     , mtl
     , optparse-applicative
+    , parallel
     , text
     , tickLeiste
     , tickLeiste-aeson
+    , tickLeisteServer
     , tomland
     , unliftio
     , unliftio-core
     , uuid
+    , validation-selective
     , wai
     , wai-websockets
     , websockets