Droplet.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}

module Network.DigitalOcean.Services.Droplet where

-----------------------------------------------------------------
import           Data.Aeson
import           Data.Aeson.Casing
import           GHC.Generics
import           Data.Time.Clock
import           Data.Map
import qualified Data.HashMap.Lazy as HML
-----------------------------------------------------------------
import           Network.DigitalOcean.Types
import           Network.DigitalOcean.Utils.Pagination
import           Network.DigitalOcean.Utils.Actions
import           Network.DigitalOcean.Services.Region
import           Network.DigitalOcean.Services.Image
import           Network.DigitalOcean.Services.Size
-----------------------------------------------------------------

data Kernel = Kernel
  { kernelId :: Int
  , kernelName :: String
  , kernelVersion :: String
  } deriving (Show, Generic)

instance FromJSON Kernel where
  parseJSON = genericParseJSON $ aesonPrefix snakeCase

instance FromJSON (Response [Kernel]) where
  parseJSON (Object v) =
    fmap Response $ parseJSON =<< (v .: "kernels")

-----------------------------------------------------------------

data DropletStatus =
    New
  | Active
  | Off
  | Archive
  deriving (Show, Generic)

instance FromJSON DropletStatus where
  parseJSON "new"     = return New
  parseJSON "active"  = return Active
  parseJSON "off"     = return Off
  parseJSON "archive" = return Archive

-----------------------------------------------------------------

data Network = Network
  { networkIpAddress :: IpAddress
  , networkNetmask   :: IpAddress
  , networkGateway   :: IpAddress
  , networkType      :: String -- ^ Whether there is another type of network is available is not documented in DO API.
  } deriving (Show, Generic)

instance FromJSON Network where
  parseJSON = genericParseJSON $ aesonPrefix snakeCase

data Networks = Networks
  { v4 :: [Network]
  , v6 :: [Network]
  } deriving (Show)

instance FromJSON Networks where
  parseJSON (Object v) = Networks
    <$> v .: "v4"
    <*> v .: "v6"

-----------------------------------------------------------------

newtype Backup = Backup Image
  deriving Show

instance FromJSON Backup where
  parseJSON v = Backup <$> parseJSON v

instance FromJSON (Response [Backup]) where
  parseJSON (Object v) =
    fmap Response $ parseJSON =<< (v .: "backups")
  
-----------------------------------------------------------------

newtype Neighbors = Neighbors [[Droplet]]
  deriving Show

instance FromJSON Neighbors where
  parseJSON v = Neighbors <$> parseJSON v

instance FromJSON (Response Neighbors) where
  parseJSON (Object v) =
    fmap Response $ parseJSON =<< (v .: "neighbors")

-----------------------------------------------------------------

data Droplet = Droplet
  { dropletId          :: DropletId
  , dropletName        :: String
  , dropletMemory      :: Int
  , dropletVcpus       :: Int
  , dropletDisk        :: Int
  , dropletLocked      :: Bool
  , dropletCreatedAt   :: UTCTime
  , dropletStatus      :: DropletStatus
  , dropletBackupIds   :: [Int]
  , dropletSnapshotIds :: [SnapshotId]
  , dropletFeatures    :: [String]
  , dropletRegion      :: Region
  , dropletImage       :: Image
  , dropletSize        :: Size
  , dropletSizeSlug    :: String
  , dropletNetworks    :: Networks
  , dropletKernel      :: Maybe Kernel
  --droplet , nextBackupWindow :: Maybe BackupWindow -- No example for this yet
  , dropletTags        :: [String]
  , dropletVolumeIds   :: Maybe [VolumeId]
  } deriving (Show, Generic)

instance FromJSON (Response Droplet) where
  parseJSON (Object v) =
    fmap Response $ parseJSON =<< (v .: "droplet")

instance FromJSON (Response [Droplet]) where
  parseJSON (Object v) =
    fmap Response $ parseJSON =<< (v .: "droplets")

instance FromJSON Droplet where
  parseJSON = genericParseJSON $ aesonPrefix snakeCase

instance FromJSON (PaginationState Droplet) where
  parseJSON (Object v) = parsePaginationState v "droplets"

instance Paginatable Droplet

data DropletPayload =
    SingleDropletPayload String IDropletPayload
  | MultipleDropletPayload [String] IDropletPayload

{- https://developers.digitalocean.com/documentation/v2/#create-a-new-droplet -}
data IDropletPayload = IDropletPayload
  { dropletpayloadRegion            :: String
  , dropletpayloadSize              :: String
  , dropletpayloadImage             :: String -- ^ number (if using an image ID), or String (if using a public image slug)
  , dropletpayloadSshKeys           :: Maybe [String]
  , dropletpayloadBackups           :: Maybe Bool
  , dropletpayloadIpv6              :: Maybe Bool
  , dropletpayloadPrivateNetworking :: Maybe Bool
  , dropletpayloadUserData          :: Maybe String
  , dropletpayloadMonitoring        :: Maybe Bool
  , dropletpayloadVolumes           :: Maybe [String]
  , dropletpayloadTags              :: Maybe [String]
  } deriving (Show, Generic)

instance ToJSON IDropletPayload where
  toJSON = genericToJSON $ aesonPrefix snakeCase

mergeAeson :: Value -> Value -> Value
mergeAeson (Object x) (Object y) = Object $ HML.unions [x, y]

instance ToJSON DropletPayload where
  toJSON (SingleDropletPayload name payload) =
    object [ "name" .= name ] `mergeAeson` toJSON payload
  toJSON (MultipleDropletPayload names payload) =
    object [ "names" .= names ] `mergeAeson` toJSON payload

instance Payload DropletPayload

-----------------------------------------------------------------

data DropletAction =
    EnableBackups
  | DisableBackups
  | Reboot
  | PowerCycle
  | Shutdown
  | PowerOff
  | PowerOn
  | Restore String
  | PasswordReset
  | ResizeDroplet (Maybe Bool) String
  | Rebuild String
  | Rename String
  | ChangeKernel Int
  | EnableIpV6
  | EnablePrivateNetworking
  | TakeSnapshot (Maybe String)
  deriving (Eq, Show)

{- Reference:
 - https://developers.digitalocean.com/documentation/v2/#acting-on-tagged-droplets
 -}
actionAllowedAsBulk :: DropletAction -> Bool
actionAllowedAsBulk PowerCycle              = True
actionAllowedAsBulk PowerOn                 = True
actionAllowedAsBulk PowerOff                = True
actionAllowedAsBulk Shutdown                = True
actionAllowedAsBulk EnablePrivateNetworking = True
actionAllowedAsBulk EnableIpV6              = True
actionAllowedAsBulk EnableBackups           = True
actionAllowedAsBulk DisableBackups          = True
actionAllowedAsBulk TakeSnapshot {}         = True
actionAllowedAsBulk _                       = False

instance ToJSON DropletAction where
  toJSON EnableBackups             = object [ actionType' "enable_backups" ]
  toJSON DisableBackups            = object [ actionType' "disable_backups" ]
  toJSON Reboot                    = object [ actionType' "reboot" ]
  toJSON PowerCycle                = object [ actionType' "power_cycle" ]
  toJSON Shutdown                  = object [ actionType' "shutdown" ]
  toJSON PowerOff                  = object [ actionType' "power_off" ]
  toJSON PowerOn                   = object [ actionType' "power_on" ]
  toJSON (Restore imgId)           = object [ actionType' "restore", "image" .= imgId ]
  toJSON PasswordReset             = object [ actionType' "password_reset" ]
  toJSON (ResizeDroplet disk size) = object [ actionType' "resize", "disk" .= disk, "size" .= size ]
  toJSON (Rebuild imgId)           = object [ actionType' "rebuild", "image" .= imgId ]
  toJSON (Rename name)             = object [ actionType' "rename", "name" .= name ]
  toJSON (ChangeKernel id')        = object [ actionType' "change_kernel", "kernel" .= id' ]
  toJSON EnableIpV6                = object [ actionType' "enable_ipv6" ]
  toJSON EnablePrivateNetworking   = object [ actionType' "enable_private_networking" ]
  toJSON (TakeSnapshot name)       = object [ actionType' "snapshot", "name" .= name ]

instance Payload DropletAction