Merge pull request #42 from binplz/jmc/logrotate

Add simple logrotate-based logging

Author: cdepillabout

flake.nix

@@ -46,6 +46,8 @@
       image-name = "binplz-ami-${system}";
       port = 80;
 
+      binplz-log-dir = "/var/log/binplz";
+
       config = {
         amazon = {
           amazonImage.sizeMB = 4096;
@@ -108,7 +110,8 @@
             script = ''
               ${pkgs.binplz-server}/bin/binplz-server \
                 --port ${builtins.toString port} \
-                --program-db ${programs-db}
+                --program-db ${programs-db} \
+                --log-dir ${binplz-log-dir}
             '';
             serviceConfig = {
               Restart = "always";
@@ -131,6 +134,18 @@
           services = {
             openssh.enable = true;
             openssh.permitRootLogin = "prohibit-password";
+            logrotate = {
+              enable = true;
+              settings.${binplz-log-dir + "/*.log"} = {
+                rotate = -1;
+                size = "16M";
+                compress = true;
+                delaycompress = true;
+                dateext = true;
+                missingok = true;
+                notifempty = true;
+              };
+            };
           };
         };
       };

server/app/Main.hs

@@ -42,6 +42,18 @@ getConfig = runOptionParser $ \envOption ->
             optShow = show
           }
       )
+    <*> envOption
+      ( Option
+          { optHelp = "Log file directory",
+            optMetaVar = "DIR",
+            optLong = "log-dir",
+            optShort = 'd',
+            optEnvKey = "BINPLZ_LOG_DIR",
+            optReadM = Opt.str,
+            optDefault = "/var/log/binplz",
+            optShow = show
+          }
+      )
 
 main :: IO ()
 main = do

server/binplz-server.cabal

@@ -35,6 +35,7 @@ common common-options
     , servant-server
     , sqlite-simple
     , text
+    , time
     , transformers
     , utf8-string
     , warp

server/src/Lib.hs

@@ -13,7 +13,9 @@ import Control.Concurrent (myThreadId)
 import Control.Concurrent.Async (concurrently)
 import Control.Monad
 import Control.Monad.IO.Class
-import Control.Monad.Trans.Except (ExceptT (..), runExceptT, withExceptT)
+import Control.Monad.Trans.Except (ExceptT (..), runExceptT)
+import Data.Aeson ((.=))
+import qualified Data.Aeson as Aeson
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as BS8
@@ -27,6 +29,7 @@ import Data.Maybe (fromMaybe)
 import Data.String (fromString)
 import Data.Text (Text)
 import qualified Data.Text as Text
+import qualified Data.Time.Clock.System as Time
 import Database.SQLite.Simple
 import Database.SQLite.Simple.FromField (FromField (..), Field, returnError, fieldData)
 import Database.SQLite.Simple.ToField (ToField (..))
@@ -119,7 +122,8 @@ newtype ProgramDB = ProgramDB {unProgramDB :: FilePath}
 data ServerConfig = ServerConfig
   { _programDB :: ProgramDB,
     _applicationDB :: ApplicationDB,
-    _port :: Port
+    _port :: Port,
+    _logdir :: FilePath
   }
   deriving (Show)
 
@@ -129,18 +133,34 @@ data ServerConfig = ServerConfig
 --   2. Building the triplet
 -- If an error occurs, this is returned as a 400
 server :: ServerConfig -> Server API
-server (ServerConfig programDB appDB _) =
+server (ServerConfig programDB appDB _ logdir) =
   redirectToDocs
     :<|> (\bin -> handle bin Nothing)
     :<|> (\pkg bin -> handle bin (Just pkg))
   where
     handle :: BinaryName -> Maybe PackageName -> Maybe Platform -> Maybe NixpkgsCommit -> Handler BSL.ByteString
-    handle bin mpkg msys mcommit =
-      Handler . withExceptT (\err -> err400 {errBody = BSL.pack err}) $ do
+    handle bin mpkg msys mcommit = Handler $ do
+      mbin <- liftIO . runExceptT $ do
         commit <- resolveCommit mcommit
         let sys = fromMaybe X86_64_Linux msys
         pkg <- maybe (resolvePackageName programDB bin sys) pure mpkg
         buildTriplet appDB (BinInfo bin pkg sys commit)
+      liftIO $ do
+        time <- Time.systemSeconds <$> Time.getSystemTime
+        Dir.createDirectoryIfMissing True logdir
+        let logstring =
+              Aeson.encode . Aeson.object $
+                [ "time" .= time,
+                  "binary" .= unBinaryName bin,
+                  "package" .= maybe Aeson.Null (Aeson.String . Text.pack . unPackageName) mpkg,
+                  "platform" .= maybe Aeson.Null (Aeson.String . Text.pack . show) msys,
+                  "commit" .= maybe Aeson.Null (Aeson.String . unNixpkgsCommit) mcommit,
+                  "result" .= either (Aeson.String . Text.pack) (const "success") mbin
+                ]
+        Lazy.appendFile (logdir </> "requests.log") (logstring <> "\n")
+      case mbin of
+        Left err -> throwError (err400 {errBody = BSL.pack err})
+        Right ok -> pure ok
 
 -- | The default Nixpkgs commit we use when the user doesn't provide one.
 --