Agent.hs

{-# LANGUAGE DuplicateRecordFields #-}

module Cachix.Deploy.Agent where

import qualified Cachix.API.WebSocketSubprotocol as WSS
import qualified Cachix.Client.OptionsParser as CachixOptions
import Cachix.Client.URI (getBaseUrl)
import qualified Cachix.Deploy.OptionsParser as AgentOptions
import Cachix.Deploy.StdinProcess (readProcess)
import qualified Cachix.Deploy.Websocket as CachixWebsocket
import qualified Data.Aeson as Aeson
import qualified Katip as K
import qualified Network.WebSockets as WS
import Paths_cachix (getBinDir)
import Protolude hiding (toS)
import Protolude.Conv
import qualified Servant.Client as Servant

run :: CachixOptions.CachixOptions -> AgentOptions.AgentOptions -> IO ()
run cachixOptions agentOpts = do
  CachixWebsocket.runForever options handleMessage
  where
    host = toS $ Servant.baseUrlHost $ getBaseUrl $ CachixOptions.host cachixOptions
    name = AgentOptions.name agentOpts
    options =
      CachixWebsocket.Options
        { CachixWebsocket.host = host,
          CachixWebsocket.name = name,
          CachixWebsocket.path = "/ws",
          CachixWebsocket.profile = AgentOptions.profile agentOpts,
          CachixWebsocket.isVerbose = CachixOptions.verbose cachixOptions
        }
    handleMessage :: ByteString -> (K.KatipContextT IO () -> IO ()) -> WS.Connection -> CachixWebsocket.AgentState -> ByteString -> K.KatipContextT IO ()
    handleMessage payload _ _ agentState _ = do
      CachixWebsocket.parseMessage payload (handleCommand . WSS.command)
      where
        handleCommand :: WSS.BackendCommand -> K.KatipContextT IO ()
        handleCommand (WSS.AgentRegistered agentInformation) = do
          CachixWebsocket.registerAgent agentState agentInformation
        handleCommand (WSS.Deployment deploymentDetails) = do
          -- TODO: lock to ensure one deployment at the time
          let input =
                CachixWebsocket.Input
                  { deploymentDetails = deploymentDetails,
                    websocketOptions =
                      CachixWebsocket.Options
                        { host = host,
                          name = name,
                          path = "/ws-deployment",
                          profile = AgentOptions.profile agentOpts,
                          isVerbose = CachixOptions.verbose cachixOptions
                        }
                  }
          binDir <- toS <$> liftIO getBinDir
          liftIO $ readProcess (binDir <> "/.cachix-deployment") [] (toS $ Aeson.encode input)