{-# LANGUAGE OverloadedRecordDot #-}

module Cloudy.Cmd.Destroy where

import Cloudy.Cli (DestroyCliOpts (..))
import Cloudy.Cmd.Utils (SelectInstBy, findInstanceInfoForSelectInstBy, mkSelectInstBy)
import Cloudy.LocalConfFile (LocalConfFileOpts (..), LocalConfFileScalewayOpts (..))
import Cloudy.Db (CloudyInstance (..), withCloudyDb, InstanceInfo (..), ScalewayInstance (..), setCloudyInstanceDeleted, cloudyInstanceFromInstanceInfo)
import Data.Text (Text, unpack)
import Data.Void (absurd)
import Servant.Client (ClientM)
import Servant.API (NoContent(..))
import Cloudy.Cmd.Scaleway.Utils (runScalewayClientM, createAuthReq)
import Cloudy.Scaleway (ipsDeleteApi, zoneFromText, ServersActionReq (..), serversActionPostApi)
import qualified Cloudy.Scaleway as Scaleway
import Control.FromSum (fromMaybeM)
import Control.Monad.IO.Class (liftIO)

data DestroySettings = DestroySettings
  { DestroySettings -> SelectInstBy
selectInstBy :: SelectInstBy
  }
  deriving stock Int -> DestroySettings -> ShowS
[DestroySettings] -> ShowS
DestroySettings -> String
(Int -> DestroySettings -> ShowS)
-> (DestroySettings -> String)
-> ([DestroySettings] -> ShowS)
-> Show DestroySettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DestroySettings -> ShowS
showsPrec :: Int -> DestroySettings -> ShowS
$cshow :: DestroySettings -> String
show :: DestroySettings -> String
$cshowList :: [DestroySettings] -> ShowS
showList :: [DestroySettings] -> ShowS
Show

data ScalewayDestroySettings = ScalewayDestroySettings
  { ScalewayDestroySettings -> Text
secretKey :: Text
  }
  deriving stock Int -> ScalewayDestroySettings -> ShowS
[ScalewayDestroySettings] -> ShowS
ScalewayDestroySettings -> String
(Int -> ScalewayDestroySettings -> ShowS)
-> (ScalewayDestroySettings -> String)
-> ([ScalewayDestroySettings] -> ShowS)
-> Show ScalewayDestroySettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScalewayDestroySettings -> ShowS
showsPrec :: Int -> ScalewayDestroySettings -> ShowS
$cshow :: ScalewayDestroySettings -> String
show :: ScalewayDestroySettings -> String
$cshowList :: [ScalewayDestroySettings] -> ShowS
showList :: [ScalewayDestroySettings] -> ShowS
Show

mkSettings :: LocalConfFileOpts -> DestroyCliOpts -> IO DestroySettings
mkSettings :: LocalConfFileOpts -> DestroyCliOpts -> IO DestroySettings
mkSettings LocalConfFileOpts
_localConfFileOpts DestroyCliOpts
cliOpts = do
  SelectInstBy
selectInstBy <- Maybe CloudyInstanceId -> Maybe Text -> IO SelectInstBy
mkSelectInstBy DestroyCliOpts
cliOpts.id DestroyCliOpts
cliOpts.name
  DestroySettings -> IO DestroySettings
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DestroySettings { SelectInstBy
$sel:selectInstBy:DestroySettings :: SelectInstBy
selectInstBy :: SelectInstBy
selectInstBy }

mkScalewaySettings :: LocalConfFileOpts -> IO ScalewayDestroySettings
mkScalewaySettings :: LocalConfFileOpts -> IO ScalewayDestroySettings
mkScalewaySettings LocalConfFileOpts
localConfFileOpts = do
  let maybeSecretKey :: Maybe Text
maybeSecretKey = LocalConfFileOpts
localConfFileOpts.scaleway Maybe LocalConfFileScalewayOpts
-> (LocalConfFileScalewayOpts -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \LocalConfFileScalewayOpts
scale -> LocalConfFileScalewayOpts
scale.secretKey :: Maybe Text
  Text
secretKey <- Maybe Text -> String -> IO Text
forall a. Maybe a -> String -> IO a
getVal Maybe Text
maybeSecretKey String
"Could not find scaleway.secret_key in config file"
  ScalewayDestroySettings -> IO ScalewayDestroySettings
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalewayDestroySettings { Text
$sel:secretKey:ScalewayDestroySettings :: Text
secretKey :: Text
secretKey }
  where
    getVal :: Maybe a -> String -> IO a
    getVal :: forall a. Maybe a -> String -> IO a
getVal Maybe a
mayVal String
errMsg = IO a -> (a -> IO a) -> Maybe a -> IO a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO a
forall a. HasCallStack => String -> a
error String
errMsg) a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
mayVal

runDestroy :: LocalConfFileOpts -> DestroyCliOpts -> IO ()
runDestroy :: LocalConfFileOpts -> DestroyCliOpts -> IO ()
runDestroy LocalConfFileOpts
localConfFileOpts DestroyCliOpts
scalewayOpts = do
  DestroySettings
settings <- LocalConfFileOpts -> DestroyCliOpts -> IO DestroySettings
mkSettings LocalConfFileOpts
localConfFileOpts DestroyCliOpts
scalewayOpts
  (Connection -> IO ()) -> IO ()
forall a. (Connection -> IO a) -> IO a
withCloudyDb ((Connection -> IO ()) -> IO ()) -> (Connection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
    InstanceInfo
instanceInfo <- Connection -> SelectInstBy -> IO InstanceInfo
findInstanceInfoForSelectInstBy Connection
conn DestroySettings
settings.selectInstBy
    case InstanceInfo
instanceInfo of
      CloudyAwsInstance CloudyInstance
_cloudyInstance Void
void -> Void -> IO ()
forall a. Void -> a
absurd Void
void
      CloudyScalewayInstance CloudyInstance
_cloudyInstance ScalewayInstance
scalewayInstance -> do
        ScalewayDestroySettings
scalewaySettings <- LocalConfFileOpts -> IO ScalewayDestroySettings
mkScalewaySettings LocalConfFileOpts
localConfFileOpts
        (forall x. ClientError -> IO x) -> ClientM () -> IO ()
forall a. (forall x. ClientError -> IO x) -> ClientM a -> IO a
runScalewayClientM
          (\ClientError
err -> String -> IO x
forall a. HasCallStack => String -> a
error (String -> IO x) -> String -> IO x
forall a b. (a -> b) -> a -> b
$ String
"ERROR! Problem deleting instance: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ClientError -> String
forall a. Show a => a -> String
show ClientError
err)
          (DestroySettings
-> ScalewayDestroySettings -> ScalewayInstance -> ClientM ()
destroyScalewayServer DestroySettings
settings ScalewayDestroySettings
scalewaySettings ScalewayInstance
scalewayInstance)
    let cloudyInstanceId :: CloudyInstanceId
cloudyInstanceId = (InstanceInfo -> CloudyInstance
cloudyInstanceFromInstanceInfo InstanceInfo
instanceInfo).id
    Connection -> CloudyInstanceId -> IO ()
setCloudyInstanceDeleted Connection
conn CloudyInstanceId
cloudyInstanceId

destroyScalewayServer ::
  DestroySettings ->
  ScalewayDestroySettings ->
  ScalewayInstance ->
  ClientM ()
destroyScalewayServer :: DestroySettings
-> ScalewayDestroySettings -> ScalewayInstance -> ClientM ()
destroyScalewayServer DestroySettings
_settings ScalewayDestroySettings
scalewaySettings ScalewayInstance
scalewayInstance = do
  let authReq :: AuthenticatedRequest (AuthProtect "auth-token")
authReq = Text -> AuthenticatedRequest (AuthProtect "auth-token")
createAuthReq ScalewayDestroySettings
scalewaySettings.secretKey
      ipId :: IpId
ipId = Text -> IpId
Scaleway.IpId ScalewayInstance
scalewayInstance.scalewayIpId
      zoneErrMsg :: Text
zoneErrMsg =
        Text
"destroyScalewayServer: Could not figure out Scaleway zone from string: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        ScalewayInstance
scalewayInstance.scalewayZone
  Zone
zone <-
    ClientM Zone -> Maybe Zone -> ClientM Zone
forall (m :: * -> *) a. Applicative m => m a -> Maybe a -> m a
fromMaybeM
      (String -> ClientM Zone
forall a. HasCallStack => String -> a
error (String -> ClientM Zone) -> String -> ClientM Zone
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
zoneErrMsg)
      (Text -> Maybe Zone
zoneFromText ScalewayInstance
scalewayInstance.scalewayZone)
  NoContent
NoContent <- AuthenticatedRequest (AuthProtect "auth-token")
-> Zone -> IpId -> ClientM NoContent
ipsDeleteApi AuthenticatedRequest (AuthProtect "auth-token")
authReq Zone
zone IpId
ipId
  IO () -> ClientM ()
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClientM ()) -> (Text -> IO ()) -> Text -> ClientM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn (String -> IO ()) -> (Text -> String) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack (Text -> ClientM ()) -> Text -> ClientM ()
forall a b. (a -> b) -> a -> b
$ Text
"Successfully deleted Scaleway IP: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ScalewayInstance
scalewayInstance.scalewayIpAddress
  let act :: ServersActionReq
act = ServersActionReq { $sel:action:ServersActionReq :: Text
action = Text
"terminate" }
      scalewayInstId :: ServerId
scalewayInstId = Text -> ServerId
Scaleway.ServerId ScalewayInstance
scalewayInstance.scalewayInstanceId
  TaskResp
_task <- AuthenticatedRequest (AuthProtect "auth-token")
-> Zone -> ServerId -> ServersActionReq -> ClientM TaskResp
serversActionPostApi AuthenticatedRequest (AuthProtect "auth-token")
authReq Zone
zone ServerId
scalewayInstId ServersActionReq
act
  IO () -> ClientM ()
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClientM ()) -> (Text -> IO ()) -> Text -> ClientM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn (String -> IO ()) -> (Text -> String) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack (Text -> ClientM ()) -> Text -> ClientM ()
forall a b. (a -> b) -> a -> b
$ Text
"Successfully deleted Scaleway server: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ScalewayInstance
scalewayInstance.scalewayInstanceId