Internal.hs

{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Network.Linode.Internal where

import           Control.Error
import           Control.Exception      (IOException, handle)
import           Control.Lens           ((^?))
import           Control.Monad.IO.Class (liftIO)
import           Data.Aeson             (FromJSON, decode)
import qualified Data.ByteString.Lazy   as B
import           Data.Monoid            ((<>))
import qualified Data.Text.Encoding     as E
import qualified Data.Text.IO           as TIO
import qualified Network.Wreq           as W

import           Network.Linode.Types


parseResponse :: FromJSON a => B.ByteString -> Either LinodeError a
parseResponse body = case decode body of
  Nothing -> Left e
  Just (Response [] (Just c)) -> Right c
  Just (Response (x:_) _) -> Left x
  _ -> Left e
  where e = DeserializationError (E.decodeUtf8 $ B.toStrict body)


diskTypeToString :: DiskType -> String
diskTypeToString Ext3 = "ext3"
diskTypeToString Ext4 = "ext4"
diskTypeToString Swap = "swap"
diskTypeToString RawDisk = "raw"

paymentTermToInt :: PaymentTerm -> Int
paymentTermToInt OneMonth = 1
paymentTermToInt OneYear = 12
paymentTermToInt TwoYears = 24

query :: String -> String -> String
query action apiKey = "https://api.linode.com/?api_key=" <> apiKey <> "&api_action=" <> action


get :: FromJSON a => String -> ExceptT LinodeError IO a
get url = ExceptT g
  where g = handle (\(e :: IOException) -> return (Left $ NetworkError e)) $ do
              response <- W.get url
              return $ parseResponse (fromMaybe B.empty (response ^? W.responseBody))

getWith :: FromJSON a => W.Options -> String -> ExceptT LinodeError IO a
getWith opts url = ExceptT g
  where g = handle (\(e :: IOException) -> return (Left $ NetworkError e)) $ do
              response <- W.getWith opts url
              return $ parseResponse (fromMaybe B.empty (response ^? W.responseBody))

noParamQuery :: FromJSON a => String -> String -> ExceptT LinodeError IO a
noParamQuery action apiKey = getWith W.defaults (query action apiKey)

maybeOr ::  Monad m => Maybe a -> ExceptT e m a -> ExceptT e m a
maybeOr v p = maybe p return v

printCreationOptions :: Datacenter -> Plan -> PaymentTerm -> Distribution -> Int -> Int -> IO ()
printCreationOptions datacenter plan paymentTerm distribution rootDiskSize swapSize = do
  TIO.putStrLn $ "Datacenter: " <> datacenterName datacenter
  TIO.putStrLn $  "Plan: " <> planName plan
  putStrLn $  "PaymentTerm: " <> show paymentTerm
  TIO.putStrLn $ "Distribution:" <> distributionName distribution
  putStrLn $ "Disk size" ++ show rootDiskSize
  putStrLn $ "Swap size" ++ show swapSize


fetchAndSelect :: IO (Either LinodeError [a]) -> ([a] -> Maybe a) -> String -> ExceptT LinodeError IO a
fetchAndSelect fetch select name = do
  r <- liftIO fetch
  case r of
    Left e -> throwE $ SelectionError ("Error which fetching a " <> name <> " . " ++ show e)
    Right xs -> case select xs of
      Nothing -> throwE $ SelectionError ("Error: Selection of " <> name <> " returned no value")
      Just x -> return x