{-# 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
  { ScalewayListImagesSettings -> Text
secretKey :: Text
  , ScalewayListImagesSettings -> Zone
zone :: Zone
  , ScalewayListImagesSettings -> Text
arch :: Text
  , ScalewayListImagesSettings -> Maybe Text
nameFilter :: Maybe Text
  , ScalewayListImagesSettings -> Bool
showAllVersions :: Bool
  }

mkSettings :: LocalConfFileOpts -> ScalewayListImagesCliOpts -> IO ScalewayListImagesSettings
mkSettings :: LocalConfFileOpts
-> ScalewayListImagesCliOpts -> IO ScalewayListImagesSettings
mkSettings LocalConfFileOpts
localConfFileOpts ScalewayListImagesCliOpts
cliOpts = 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"
  let maybeZoneFromConfFile :: Maybe Text
maybeZoneFromConfFile = 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.defaultZone
  Zone
zone <- Maybe Text -> Maybe Text -> IO Zone
getZone Maybe Text
maybeZoneFromConfFile ScalewayListImagesCliOpts
cliOpts.zone
  ScalewayListImagesSettings -> IO ScalewayListImagesSettings
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ScalewayListImagesSettings
      { Text
$sel:secretKey:ScalewayListImagesSettings :: Text
secretKey :: Text
secretKey
      , Zone
$sel:zone:ScalewayListImagesSettings :: Zone
zone :: Zone
zone
      , $sel:arch:ScalewayListImagesSettings :: Text
arch = ScalewayListImagesCliOpts
cliOpts.arch
      , $sel:nameFilter:ScalewayListImagesSettings :: Maybe Text
nameFilter = ScalewayListImagesCliOpts
cliOpts.nameFilter
      , $sel:showAllVersions:ScalewayListImagesSettings :: Bool
showAllVersions = ScalewayListImagesCliOpts
cliOpts.allVersions
      }
  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

runListImages :: LocalConfFileOpts -> ScalewayListImagesCliOpts -> IO ()
runListImages :: LocalConfFileOpts -> ScalewayListImagesCliOpts -> IO ()
runListImages LocalConfFileOpts
localConfFileOpts ScalewayListImagesCliOpts
scalewayOpts = do
  ScalewayListImagesSettings
settings <- LocalConfFileOpts
-> ScalewayListImagesCliOpts -> IO ScalewayListImagesSettings
mkSettings LocalConfFileOpts
localConfFileOpts ScalewayListImagesCliOpts
scalewayOpts
  [Image]
imgs <-
    (forall x. ClientError -> IO x) -> ClientM [Image] -> IO [Image]
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
"Problem fetching instance types: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ClientError -> String
forall a. Show a => a -> String
show ClientError
err)
      (ScalewayListImagesSettings -> ClientM [Image]
fetchImages ScalewayListImagesSettings
settings)
  ScalewayListImagesSettings -> [Image] -> IO ()
displayImages ScalewayListImagesSettings
settings [Image]
imgs

fetchImages :: ScalewayListImagesSettings -> ClientM [Image]
fetchImages :: ScalewayListImagesSettings -> ClientM [Image]
fetchImages ScalewayListImagesSettings
settings = do
  let authReq :: AuthenticatedRequest (AuthProtect "auth-token")
authReq = Text -> AuthenticatedRequest (AuthProtect "auth-token")
createAuthReq ScalewayListImagesSettings
settings.secretKey
      numPerPage :: Int
numPerPage = Int
100
  ImagesResp [Image]
imgs <-
    (Maybe PageNum
 -> ClientM (Headers '[Header "x-total-count" Int] ImagesResp))
-> (ImagesResp -> ImagesResp -> ImagesResp)
-> (ImagesResp -> Int)
-> ClientM ImagesResp
forall (m :: * -> *) a.
Monad m =>
(Maybe PageNum -> m (Headers '[Header "x-total-count" Int] a))
-> (a -> a -> a) -> (a -> Int) -> m a
fetchPagedApi
      (AuthenticatedRequest (AuthProtect "auth-token")
-> Zone
-> Maybe Text
-> Maybe PerPage
-> Maybe PageNum
-> ClientM (Headers '[Header "x-total-count" Int] ImagesResp)
imagesGetApi AuthenticatedRequest (AuthProtect "auth-token")
authReq ScalewayListImagesSettings
settings.zone (Text -> Maybe Text
forall a. a -> Maybe a
Just ScalewayListImagesSettings
settings.arch) (PerPage -> Maybe PerPage
forall a. a -> Maybe a
Just (PerPage -> Maybe PerPage) -> PerPage -> Maybe PerPage
forall a b. (a -> b) -> a -> b
$ Int -> PerPage
PerPage Int
numPerPage))
      (\(ImagesResp [Image]
images1) (ImagesResp [Image]
images2) -> [Image] -> ImagesResp
ImagesResp ([Image] -> ImagesResp) -> [Image] -> ImagesResp
forall a b. (a -> b) -> a -> b
$ [Image]
images1 [Image] -> [Image] -> [Image]
forall a. Semigroup a => a -> a -> a
<> [Image]
images2)
      (\(ImagesResp [Image]
imgs) -> [Image] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Image]
imgs)
  [Image] -> ClientM [Image]
forall a. a -> ClientM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Image]
imgs

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

nubByNameArch :: [Image] -> [Image]
nubByNameArch :: [Image] -> [Image]
nubByNameArch [Image]
imgs =
  (NonEmpty Image -> Image) -> [NonEmpty Image] -> [Image]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty Image -> Image
getMostRecent ([NonEmpty Image] -> [Image]) -> [NonEmpty Image] -> [Image]
forall a b. (a -> b) -> a -> b
$ (Image -> (Text, Text)) -> [Image] -> [NonEmpty Image]
forall b a. Ord b => (a -> b) -> [a] -> [NonEmpty a]
groupAllWith (\Image
img -> (Image
img.name, Image
img.arch)) [Image]
imgs
  where
    getMostRecent :: NonEmpty Image -> Image
    getMostRecent :: NonEmpty Image -> Image
getMostRecent = NonEmpty Image -> Image
forall a. NonEmpty a -> a
NE.head (NonEmpty Image -> Image)
-> (NonEmpty Image -> NonEmpty Image) -> NonEmpty Image -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Image -> UTCTime) -> NonEmpty Image -> NonEmpty Image
forall o a. Ord o => (a -> o) -> NonEmpty a -> NonEmpty a
NE.sortWith (\Image
img -> Image
img.modificationDate)

mkTable :: NonEmpty Image -> Table
mkTable :: NonEmpty Image -> Table
mkTable NonEmpty Image
images =
  Table
    { $sel:tableHeaders:Table :: NonEmpty (Align, Text)
tableHeaders =
        (Align
LeftJustified, Text
"image id") (Align, Text) -> [(Align, Text)] -> NonEmpty (Align, Text)
forall a. a -> [a] -> NonEmpty a
:|
        [ (Align
LeftJustified, Text
"name")
        , (Align
LeftJustified, Text
"arch")
        , (Align
LeftJustified, Text
"modify date")
        -- , (LeftJustified, "create date")
        , (Align
LeftJustified, Text
"state")
        ]
    , $sel:tableBodyRows:Table :: NonEmpty (NonEmpty Text)
tableBodyRows = (Image -> NonEmpty Text)
-> NonEmpty Image -> NonEmpty (NonEmpty Text)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Image -> NonEmpty Text
mkRow NonEmpty Image
images
    }

mkRow :: Image -> NonEmpty Text
mkRow :: Image -> NonEmpty Text
mkRow Image
img =
  Image
img.id Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:|
  [ Image
img.name
  , Image
img.arch
  , UTCTime -> Text
formatDate Image
img.modificationDate
  -- , formatDate img.creationDate
  , Image
img.state
  ]
  where
    formatDate :: UTCTime -> Text
formatDate = String -> Text
pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%Y-%m-%d"