{-# LANGUAGE OverloadedRecordDot #-}

module Cloudy.Cmd.Scaleway.ListInstanceTypes where

import Cloudy.Cli.Scaleway (ScalewayListInstanceTypesCliOpts (..))
import Cloudy.Cmd.Scaleway.Utils (createAuthReq, getZone, runScalewayClientM)
import Cloudy.LocalConfFile (LocalConfFileOpts (..), LocalConfFileScalewayOpts (..))
import Cloudy.Scaleway (Zone (..), productsServersGetApi, ProductServersResp (..), ProductServer (..), ProductServersAvailabilityResp (..), productsServersAvailabilityGetApi, PerPage (PerPage), VolumeConstraint (..))
import Cloudy.Table (printTable, Table (..), Align (..))
import Control.Monad (when)
import Control.Monad.IO.Class (liftIO)
import Data.List (sortOn)
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Map.Merge.Strict (merge, mapMissing, dropMissing, zipWithMatched)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Text (Text, pack)
import Servant.Client (ClientM)
import Text.Printf (printf)
import qualified Data.Text as Text

data ScalewayListInstanceTypesSettings = ScalewayListInstanceTypesSettings
  { ScalewayListInstanceTypesSettings -> Text
secretKey :: Text
  , ScalewayListInstanceTypesSettings -> Zone
zone :: Zone
  }

mkSettings :: LocalConfFileOpts -> ScalewayListInstanceTypesCliOpts -> IO ScalewayListInstanceTypesSettings
mkSettings :: LocalConfFileOpts
-> ScalewayListInstanceTypesCliOpts
-> IO ScalewayListInstanceTypesSettings
mkSettings LocalConfFileOpts
localConfFileOpts ScalewayListInstanceTypesCliOpts
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 ScalewayListInstanceTypesCliOpts
cliOpts.zone
  ScalewayListInstanceTypesSettings
-> IO ScalewayListInstanceTypesSettings
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalewayListInstanceTypesSettings { Text
$sel:secretKey:ScalewayListInstanceTypesSettings :: Text
secretKey :: Text
secretKey, Zone
$sel:zone:ScalewayListInstanceTypesSettings :: Zone
zone :: Zone
zone }
  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

runListInstanceTypes :: LocalConfFileOpts -> ScalewayListInstanceTypesCliOpts -> IO ()
runListInstanceTypes :: LocalConfFileOpts -> ScalewayListInstanceTypesCliOpts -> IO ()
runListInstanceTypes LocalConfFileOpts
localConfFileOpts ScalewayListInstanceTypesCliOpts
scalewayOpts = do
  ScalewayListInstanceTypesSettings
settings <- LocalConfFileOpts
-> ScalewayListInstanceTypesCliOpts
-> IO ScalewayListInstanceTypesSettings
mkSettings LocalConfFileOpts
localConfFileOpts ScalewayListInstanceTypesCliOpts
scalewayOpts
  Map Text (ProductServer, Text)
instanceTypes <-
    (forall x. ClientError -> IO x)
-> ClientM (Map Text (ProductServer, Text))
-> IO (Map Text (ProductServer, Text))
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 fetching instance types: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ClientError -> String
forall a. Show a => a -> String
show ClientError
err)
      (ScalewayListInstanceTypesSettings
-> ClientM (Map Text (ProductServer, Text))
fetchInstanceTypes ScalewayListInstanceTypesSettings
settings)
  Map Text (ProductServer, Text) -> IO ()
displayInstanceTypes Map Text (ProductServer, Text)
instanceTypes

fetchInstanceTypes :: ScalewayListInstanceTypesSettings -> ClientM (Map Text (ProductServer, Text))
fetchInstanceTypes :: ScalewayListInstanceTypesSettings
-> ClientM (Map Text (ProductServer, Text))
fetchInstanceTypes ScalewayListInstanceTypesSettings
settings = do
  let authReq :: AuthenticatedRequest (AuthProtect "auth-token")
authReq = Text -> AuthenticatedRequest (AuthProtect "auth-token")
createAuthReq ScalewayListInstanceTypesSettings
settings.secretKey
      numPerPage :: Int
numPerPage = Int
100
  ProductServersResp Map Text ProductServer
productServers <- AuthenticatedRequest (AuthProtect "auth-token")
-> Zone -> Maybe PerPage -> ClientM ProductServersResp
productsServersGetApi AuthenticatedRequest (AuthProtect "auth-token")
authReq ScalewayListInstanceTypesSettings
settings.zone (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)
  let numProductServers :: Int
numProductServers = [ProductServer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ProductServer] -> Int) -> [ProductServer] -> Int
forall a b. (a -> b) -> a -> b
$ Map Text ProductServer -> [ProductServer]
forall k a. Map k a -> [a]
Map.elems Map Text ProductServer
productServers
  Bool -> ClientM () -> ClientM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
numProductServers Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
numPerPage) (ClientM () -> ClientM ()) -> ClientM () -> ClientM ()
forall a b. (a -> b) -> a -> b
$
    IO () -> ClientM ()
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClientM ()) -> IO () -> ClientM ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"WARNING: The number of instance types returned is equal to the max per page.  PROPER PAGING NEEDS TO BE IMPLEMENTED! We are likely missing instance types...."
  ProductServersAvailabilityResp Map Text Text
avail <- AuthenticatedRequest (AuthProtect "auth-token")
-> Zone -> Maybe PerPage -> ClientM ProductServersAvailabilityResp
productsServersAvailabilityGetApi AuthenticatedRequest (AuthProtect "auth-token")
authReq ScalewayListInstanceTypesSettings
settings.zone (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)
  let numAvail :: Int
numAvail = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Text] -> Int) -> [Text] -> Int
forall a b. (a -> b) -> a -> b
$ Map Text Text -> [Text]
forall k a. Map k a -> [a]
Map.elems Map Text Text
avail
  Bool -> ClientM () -> ClientM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
numAvail Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
numPerPage) (ClientM () -> ClientM ()) -> ClientM () -> ClientM ()
forall a b. (a -> b) -> a -> b
$
    IO () -> ClientM ()
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClientM ()) -> IO () -> ClientM ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"WARNING: The number of availabilities returned is equal to the max per page.  PROPER PAGING NEEDS TO BE IMPLEMENTED! We are likely missing instance types...."
  Map Text (ProductServer, Text)
-> ClientM (Map Text (ProductServer, Text))
forall a. a -> ClientM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map Text (ProductServer, Text)
 -> ClientM (Map Text (ProductServer, Text)))
-> Map Text (ProductServer, Text)
-> ClientM (Map Text (ProductServer, Text))
forall a b. (a -> b) -> a -> b
$
    SimpleWhenMissing Text ProductServer (ProductServer, Text)
-> SimpleWhenMissing Text Text (ProductServer, Text)
-> SimpleWhenMatched Text ProductServer Text (ProductServer, Text)
-> Map Text ProductServer
-> Map Text Text
-> Map Text (ProductServer, Text)
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
merge
      ((Text -> ProductServer -> (ProductServer, Text))
-> SimpleWhenMissing Text ProductServer (ProductServer, Text)
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
mapMissing (\Text
_ ProductServer
prod -> (ProductServer
prod, Text
"UNKNOWN")))
      SimpleWhenMissing Text Text (ProductServer, Text)
forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
dropMissing
      ((Text -> ProductServer -> Text -> (ProductServer, Text))
-> SimpleWhenMatched Text ProductServer Text (ProductServer, Text)
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
zipWithMatched (\Text
_ -> (,)))
      Map Text ProductServer
productServers
      Map Text Text
avail

displayInstanceTypes :: Map Text (ProductServer, Text) -> IO ()
displayInstanceTypes :: Map Text (ProductServer, Text) -> IO ()
displayInstanceTypes Map Text (ProductServer, Text)
instanceTypes = do
  let instList :: [(Text, (ProductServer, Text))]
instList = Map Text (ProductServer, Text) -> [(Text, (ProductServer, Text))]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text (ProductServer, Text)
instanceTypes
      sortByPriceInstList :: [(Text, (ProductServer, Text))]
sortByPriceInstList = ((Text, (ProductServer, Text)) -> Float)
-> [(Text, (ProductServer, Text))]
-> [(Text, (ProductServer, Text))]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\(Text
_, (ProductServer
prod, Text
_)) -> ProductServer
prod.monthlyPrice) [(Text, (ProductServer, Text))]
instList
  case [(Text, (ProductServer, Text))]
sortByPriceInstList of
    [] -> String -> IO ()
putStrLn String
"Found no instance types."
    ((Text, (ProductServer, Text))
hInst : [(Text, (ProductServer, Text))]
tInsts) -> do
      let instTable :: Table
instTable = NonEmpty (Text, (ProductServer, Text)) -> Table
mkTable ((Text, (ProductServer, Text))
hInst (Text, (ProductServer, Text))
-> [(Text, (ProductServer, Text))]
-> NonEmpty (Text, (ProductServer, Text))
forall a. a -> [a] -> NonEmpty a
:| [(Text, (ProductServer, Text))]
tInsts)
      Table -> IO ()
printTable Table
instTable

mkTable :: NonEmpty (Text, (ProductServer, Text)) -> Table
mkTable :: NonEmpty (Text, (ProductServer, Text)) -> Table
mkTable NonEmpty (Text, (ProductServer, Text))
instanceTypes =
  Table
    { $sel:tableHeaders:Table :: NonEmpty (Align, Text)
tableHeaders =
        (Align
LeftJustified, Text
"instance type id") (Align, Text) -> [(Align, Text)] -> NonEmpty (Align, Text)
forall a. a -> [a] -> NonEmpty a
:|
        [ (Align
RightJustified, Text
"monthly cost")
        , (Align
LeftJustified, Text
"arch")
        , (Align
RightJustified, Text
"cpus")
        , (Align
RightJustified, Text
"memory")
        , (Align
RightJustified, Text
"bandwidth")
        , (Align
LeftJustified, Text
"vol constraint")
        , (Align
LeftJustified, Text
"availability")
        , (Align
LeftJustified, Text
"alt names")
        ]
    , $sel:tableBodyRows:Table :: NonEmpty (NonEmpty Text)
tableBodyRows = ((Text, (ProductServer, Text)) -> NonEmpty Text)
-> NonEmpty (Text, (ProductServer, Text))
-> 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 (Text, (ProductServer, Text)) -> NonEmpty Text
mkRow NonEmpty (Text, (ProductServer, Text))
instanceTypes
    }

mkRow :: (Text, (ProductServer, Text)) -> NonEmpty Text
mkRow :: (Text, (ProductServer, Text)) -> NonEmpty Text
mkRow (Text
instType, (ProductServer
prod, Text
availability)) =
  Text
instType Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:|
  [ Text
"€" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (String -> Float -> String
forall r. PrintfType r => String -> r
printf String
"%8.2f" ProductServer
prod.monthlyPrice)
  , ProductServer
prod.arch
  , String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show ProductServer
prod.ncpus
  , String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%8.01f gib" (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ProductServer
prod.ram Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
forall a. Num a => a
oneGib :: Double)
  , String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%8.03f gbps" (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ProductServer
prod.sumInternetBandwidth Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
forall a. Num a => a
oneGb :: Double)
  , VolumeConstraint -> Text
formatVolumesConstraint ProductServer
prod.volumesConstraint
  , Text
availability
  , case ProductServer
prod.altNames of
      [] -> Text
"(none)"
      [Text]
names -> Text -> [Text] -> Text
Text.intercalate Text
", " [Text]
names
  ]

formatVolumesConstraint :: VolumeConstraint -> Text
formatVolumesConstraint :: VolumeConstraint -> Text
formatVolumesConstraint VolumeConstraint
volConstr =
  if VolumeConstraint
volConstr.minSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& VolumeConstraint
volConstr.maxSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    then Text
"(none)"
    else
      String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
        String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf
          String
"%3d min / %4d max (gb)"
          (Int -> Int
bytesToGigabytes VolumeConstraint
volConstr.minSize)
          (Int -> Int
bytesToGigabytes VolumeConstraint
volConstr.maxSize)
  where
    bytesToGigabytes :: Int -> Int
    bytesToGigabytes :: Int -> Int
bytesToGigabytes Int
bs = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bs Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
forall a. Num a => a
oneGb :: Double)

oneGib :: Num a => a
oneGib :: forall a. Num a => a
oneGib = a
1024 a -> a -> a
forall a. Num a => a -> a -> a
* a
1024 a -> a -> a
forall a. Num a => a -> a -> a
* a
1024

oneGb :: Num a => a
oneGb :: forall a. Num a => a
oneGb = a
1000 a -> a -> a
forall a. Num a => a -> a -> a
* a
1000 a -> a -> a
forall a. Num a => a -> a -> a
* a
1000