ListImages.hs

{-# LANGUAGE OverloadedRecordDot #-}

module Cloudy.Cmd.Scaleway.ListImages where

import Cloudy.Cli.Scaleway (ScalewayListImagesCliOpts (..))
import Cloudy.Cmd.Scaleway.Utils (createAuthReq, getZone, runScalewayClientM, fetchPagedApi)
import Cloudy.LocalConfFile (LocalConfFileOpts (..), LocalConfFileScalewayOpts (..))
import Cloudy.Scaleway (Zone (..), PerPage (PerPage), imagesGetApi, ImagesResp (ImagesResp), Image (..))
import Cloudy.Table (printTable, Table (..), Align (..))
import Data.List (sortOn)
import Data.List.NonEmpty (NonEmpty ((:|)), groupAllWith)
import Data.Text (Text, isInfixOf, pack, toLower)
import Servant.Client (ClientM)
import Data.Time (formatTime, defaultTimeLocale)
import qualified Data.List.NonEmpty as NE

data ScalewayListImagesSettings = ScalewayListImagesSettings
  { secretKey :: Text
  , zone :: Zone
  , arch :: Text
  , nameFilter :: Maybe Text
  , showAllVersions :: Bool
  }

mkSettings :: LocalConfFileOpts -> ScalewayListImagesCliOpts -> IO ScalewayListImagesSettings
mkSettings localConfFileOpts cliOpts = do
  let maybeSecretKey = localConfFileOpts.scaleway >>= \scale -> scale.secretKey :: Maybe Text
  secretKey <- getVal maybeSecretKey "Could not find scaleway.secret_key in config file"
  let maybeZoneFromConfFile = localConfFileOpts.scaleway >>= \scale -> scale.defaultZone
  zone <- getZone maybeZoneFromConfFile cliOpts.zone
  pure
    ScalewayListImagesSettings
      { secretKey
      , zone
      , arch = cliOpts.arch
      , nameFilter = cliOpts.nameFilter
      , showAllVersions = cliOpts.allVersions
      }
  where
    getVal :: Maybe a -> String -> IO a
    getVal mayVal errMsg = maybe (error errMsg) pure mayVal

runListImages :: LocalConfFileOpts -> ScalewayListImagesCliOpts -> IO ()
runListImages localConfFileOpts scalewayOpts = do
  settings <- mkSettings localConfFileOpts scalewayOpts
  imgs <-
    runScalewayClientM
      (\err -> error $ "Problem fetching instance types: " <> show err)
      (fetchImages settings)
  displayImages settings imgs

fetchImages :: ScalewayListImagesSettings -> ClientM [Image]
fetchImages settings = do
  let authReq = createAuthReq settings.secretKey
      numPerPage = 100
  ImagesResp imgs <-
    fetchPagedApi
      (imagesGetApi authReq settings.zone (Just settings.arch) (Just $ PerPage numPerPage))
      (\(ImagesResp images1) (ImagesResp images2) -> ImagesResp $ images1 <> images2)
      (\(ImagesResp imgs) -> length imgs)
  pure imgs

displayImages :: ScalewayListImagesSettings -> [Image] -> IO ()
displayImages settings imgs = do
  let nameFilteredImages =
        case settings.nameFilter of
          Nothing -> imgs
          Just name -> filter (\img -> isInfixOf (toLower name) (toLower img.name)) imgs
      volFilteredImages = filter (\img -> img.rootVolType == "unified") nameFilteredImages
      latestImages =
        if settings.showAllVersions
          then volFilteredImages
          else
            nubByNameArch volFilteredImages
      sortByModDateImages = sortOn (\img -> img.modificationDate) latestImages
  case sortByModDateImages of
    [] -> putStrLn "Found no images."
    (hImg : tImg) -> do
      let imgTable = mkTable (hImg :| tImg)
      printTable imgTable

nubByNameArch :: [Image] -> [Image]
nubByNameArch imgs =
  fmap getMostRecent $ groupAllWith (\img -> (img.name, img.arch)) imgs
  where
    getMostRecent :: NonEmpty Image -> Image
    getMostRecent = NE.head . NE.sortWith (\img -> img.modificationDate)

mkTable :: NonEmpty Image -> Table
mkTable images =
  Table
    { tableHeaders =
        (LeftJustified, "image id") :|
        [ (LeftJustified, "name")
        , (LeftJustified, "arch")
        , (LeftJustified, "modify date")
        -- , (LeftJustified, "create date")
        , (LeftJustified, "state")
        ]
    , tableBodyRows = fmap mkRow images
    }

mkRow :: Image -> NonEmpty Text
mkRow img =
  img.id :|
  [ img.name
  , img.arch
  , formatDate img.modificationDate
  -- , formatDate img.creationDate
  , img.state
  ]
  where
    formatDate = pack . formatTime defaultTimeLocale "%Y-%m-%d"