diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +# Revision history for linode-v4 + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2016, Phil Eaton + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Phil Eaton nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,29 @@ +[![Build Status](https://travis-ci.org/eatonphil/linode-haskell.svg?branch=master)](https://travis-ci.org/eatonphil/linode-haskell) + +# linode-haskell + +This is a Haskell wrapper around the [Linode v4 API](https://developers.linode.com/reference/). +You will need an alpha account and a personal access token. You can get those +at [login.alpha.linode.com](https://login.alpha.linode.com). + +## Setup + +Install the [Haskell platform](https://www.haskell.org/platform/). You will also need http-conduit: + +```bash +$ cabal update +$ cabal install http-conduit +``` + +## Compile and run + +``` +$ make +$ LINODE_TOKEN=my-token ./linode +``` + +## API Documentation + +Although documentation for the Haskell wrapper does not yet exist, +feel free to look through the alpha API [documentation](https://developers.linode.com/reference/) +in the meantime. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/linode-v4.cabal b/linode-v4.cabal new file mode 100644 --- /dev/null +++ b/linode-v4.cabal @@ -0,0 +1,25 @@ +-- Initial linode-v4.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: linode-v4 +version: 0.1.0.0 +synopsis: Haskell wrapper for the Linode v4 API +-- description: +homepage: https://github.com/eatonphil/linode-haskell +license: BSD3 +license-file: LICENSE +author: Phil Eaton +maintainer: philneaton95@gmail.com +-- copyright: +category: Network +build-type: Simple +extra-source-files: ChangeLog.md, README.md +cabal-version: >=1.10 + +library + exposed-modules: Network.Linode.Api, Network.Linode.Request, Network.Linode.Response + -- other-modules: + other-extensions: OverloadedStrings, DeriveGeneric, DuplicateRecordFields, ScopedTypeVariables + build-depends: base >=4.9 && <4.10, aeson >=0.11 && <0.12, bytestring >=0.10 && <0.11, http-conduit >=2.2 && <2.3, unordered-containers >=0.2 && <0.3 + hs-source-dirs: src + default-language: Haskell2010 diff --git a/src/Network/Linode/Api.hs b/src/Network/Linode/Api.hs new file mode 100644 --- /dev/null +++ b/src/Network/Linode/Api.hs @@ -0,0 +1,146 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Network.Linode.Api where + +import qualified Network.Linode.Request as Req (Linode, + Disk, + Config, + Config) +import qualified Network.Linode.Response as Rsp (Linode (id), + Linodes, + Service, + Services, + Datacenter, + Datacenters, + Distribution, + Distributions, + DNSZone, + DNSZones, + Kernel, + Kernels, + Disks, + Disk, + Configs, + Config) + +import Prelude hiding (id) + +import Data.Aeson +import qualified Data.List (intercalate) +import qualified Data.ByteString as S (ByteString) +import qualified Data.ByteString.Char8 (pack) +import qualified Data.Maybe (Maybe (Just, Nothing)) +import qualified Network.HTTP.Conduit (parseRequest_) +import qualified Network.HTTP.Simple (Request, httpJSON, addRequestHeader, getResponseBody, setRequestBodyJSON) +import qualified System.Environment (getEnv) +import qualified Text.Printf (printf) + +apiRoot :: String +apiRoot = "https://api.alpha.linode.com/v4" + +setAuthHeader :: Network.HTTP.Simple.Request -> IO Network.HTTP.Simple.Request +setAuthHeader request = do + token <- System.Environment.getEnv "LINODE_TOKEN" + let authorizationValue :: S.ByteString = + Data.ByteString.Char8.pack + $ Text.Printf.printf "token %s" token + return $ Network.HTTP.Simple.addRequestHeader "Authorization" authorizationValue request + +getJson :: Data.Aeson.FromJSON a => String -> [String] -> IO (Data.Maybe.Maybe a) +getJson method urlFragments = do + let endpoint = Data.List.intercalate "/" urlFragments + let requestString = + Text.Printf.printf "%s %s%s" method apiRoot endpoint + request <- setAuthHeader + $ Network.HTTP.Conduit.parseRequest_ requestString + response <- Network.HTTP.Simple.httpJSON request + return $ Network.HTTP.Simple.getResponseBody response + +get :: Data.Aeson.FromJSON a => [String] -> IO (Data.Maybe.Maybe a) +get = getJson "GET" + +delete :: Data.Aeson.FromJSON a => [String] -> IO (Data.Maybe.Maybe a) +delete = getJson "DELETE" + +sendJson :: Data.Aeson.ToJSON a => Data.Aeson.FromJSON b => String -> [String] -> a -> IO (Data.Maybe.Maybe b) +sendJson method urlFragments object = do + let endpoint = Data.List.intercalate "/" urlFragments + let requestString = + Text.Printf.printf "%s %s%s" method apiRoot endpoint + request <- setAuthHeader + $ Network.HTTP.Simple.setRequestBodyJSON object + $ Network.HTTP.Conduit.parseRequest_ requestString + response <- Network.HTTP.Simple.httpJSON request + return $ Network.HTTP.Simple.getResponseBody response + +post :: Data.Aeson.ToJSON a => Data.Aeson.FromJSON b => [String] -> a -> IO (Data.Maybe.Maybe b) +post = sendJson "POST" + +put :: Data.Aeson.ToJSON a => Data.Aeson.FromJSON b => [String] -> a -> IO (Data.Maybe.Maybe b) +put = sendJson "PUT" + +getDatacenters :: IO (Data.Maybe.Maybe Rsp.Datacenters) +getDatacenters = get ["/datacenters"] + +getDatacenter :: String -> IO (Data.Maybe.Maybe Rsp.Datacenter) +getDatacenter id = get ["/datacenters", id] + +getDistributions :: IO (Data.Maybe.Maybe Rsp.Distributions) +getDistributions = get ["/distributions"] + +getDistributionsRecommended :: IO (Data.Maybe.Maybe Rsp.Distributions) +getDistributionsRecommended = get ["/distributions/recommended"] + +getDistribution :: String -> IO (Data.Maybe.Maybe Rsp.Distribution) +getDistribution id = get ["/distributions", id] + +getLinodes :: IO (Data.Maybe.Maybe Rsp.Linodes) +getLinodes = get ["/linodes"] + +getLinode :: String -> IO (Data.Maybe.Maybe Rsp.Linode) +getLinode id = get ["/linodes", id] + +addLinode :: Req.Linode -> IO (Data.Maybe.Maybe Rsp.Linode) +addLinode linode = post ["/linodes"] linode + +editLinode :: Rsp.Linode -> IO (Data.Maybe.Maybe Rsp.Linode) +editLinode linode = put ["/linodes", Rsp.id linode] linode + +getDisks :: String -> IO (Data.Maybe.Maybe Rsp.Disks) +getDisks linodeId = get ["/linodes", linodeId, "disks"] + +getDisk :: String -> String -> IO (Data.Maybe.Maybe Rsp.Disk) +getDisk linodeId diskId = get ["/linodes", linodeId, "disks", diskId] + +addDisk :: String -> Req.Disk -> IO (Data.Maybe.Maybe Rsp.Disk) +addDisk linodeId disk = post ["/linodes", linodeId] disk + +getConfigs :: String -> IO (Data.Maybe.Maybe Rsp.Configs) +getConfigs linodeId = get ["/linodes", linodeId, "configs"] + +getConfig :: String -> String -> IO (Data.Maybe.Maybe Rsp.Config) +getConfig linodeId configId = get ["/linodes", linodeId, "configs", configId] + +addConfig :: String -> Req.Config -> IO (Data.Maybe.Maybe Rsp.Config) +addConfig linodeId config = post ["/linodes", linodeId, "configs"] config + +getServices :: IO (Data.Maybe.Maybe Rsp.Services) +getServices = get ["/services"] + +getService :: String -> IO (Data.Maybe.Maybe Rsp.Service) +getService id = get ["/services", id] + +getDNSZones :: IO (Data.Maybe.Maybe Rsp.DNSZones) +getDNSZones = get ["/dnszones"] + +getDNSZone :: String -> IO (Data.Maybe.Maybe Rsp.DNSZone) +getDNSZone id = get ["/dnszones", id] + +getKernels :: IO (Data.Maybe.Maybe Rsp.Kernels) +getKernels = get ["/kernels"] + +getKernel :: String -> IO (Data.Maybe.Maybe Rsp.Kernel) +getKernel id = get ["/kernels", id] diff --git a/src/Network/Linode/Request.hs b/src/Network/Linode/Request.hs new file mode 100644 --- /dev/null +++ b/src/Network/Linode/Request.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Network.Linode.Request where + +import qualified Network.Linode.Response as Rsp (Filesystem, RunLevel, VirtMode) + +import Data.Aeson +import qualified GHC.Generics (Generic) +import qualified Data.Maybe as M (Maybe) +import qualified Data.HashMap.Strict as H (HashMap) + +data Linode = Linode { datacenter :: String, + service :: String, + source :: M.Maybe String, + root_pass :: M.Maybe String, + label :: M.Maybe String, + group :: M.Maybe String, + stackscript :: M.Maybe String, + stackscript_udf_responses :: M.Maybe (H.HashMap String String) } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON Linode +instance Data.Aeson.ToJSON Linode + +data Disk = Disk { size :: Int, + distribution :: M.Maybe String, + root_pass :: M.Maybe String, + root_ssh_key :: M.Maybe String, + label :: String, + filesystem :: Rsp.Filesystem, + read_only :: M.Maybe Bool, + stackscript :: M.Maybe String, + stackscript_udf_responses :: M.Maybe (H.HashMap String String) } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON Disk +instance Data.Aeson.ToJSON Disk + +data Config = Config { kernel :: String, + label :: String, + disks :: [String], + comments :: M.Maybe String, + ram_limit :: M.Maybe Int, + root_device_ro :: M.Maybe Bool, + devtmpfs_automount :: M.Maybe Bool, + run_level :: Rsp.RunLevel, + virt_mode :: Rsp.VirtMode } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON Config +instance Data.Aeson.ToJSON Config diff --git a/src/Network/Linode/Response.hs b/src/Network/Linode/Response.hs new file mode 100644 --- /dev/null +++ b/src/Network/Linode/Response.hs @@ -0,0 +1,357 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Network.Linode.Response where + +import Data.Aeson +import qualified GHC.Generics (Generic) +import qualified Data.Maybe as M (Maybe) + +data Datacenter = Datacenter { id :: String, + datacenter :: String, + label :: String } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON Datacenter +instance Data.Aeson.ToJSON Datacenter + +data Datacenters = Datacenters { total_pages :: Int, + total_results :: Int, + page :: Int, + datacenters :: [Datacenter] } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON Datacenters +instance Data.Aeson.ToJSON Datacenters + +data Distribution = Distribution { id :: String, + created :: String, + vendor :: String, + recommended :: Bool, + minimum_storage_size :: Int, + x64 :: Bool, + label :: String } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON Distribution +instance Data.Aeson.ToJSON Distribution + +data Distributions = Distributions { total_pages :: Int, + total_results :: Int, + page :: Int, + distributions :: [Distributions] } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON Distributions +instance Data.Aeson.ToJSON Distributions + +data Service = Service { id :: String, + storage :: Int, + hourly_price :: Int, + label :: String, + mbits_out :: M.Maybe Int, + monthly_price :: Int, + ram :: Int, + service_type :: String, + transfer :: Int, + vcpus :: M.Maybe Int } deriving (Eq, Show, GHC.Generics.Generic) + + +instance Data.Aeson.FromJSON Service +instance Data.Aeson.ToJSON Service + +data Services = Services { total_pages :: Int, + total_results :: Int, + page :: Int, + services :: [Service] } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON Services +instance Data.Aeson.ToJSON Services + + +data DNSZone = DNSZone { id :: String, + dnszone :: String, + soa_email :: String, + description :: String, + refresh_sec :: Int, + retry_sec :: Int, + expire_sec :: Int, + ttl_sec :: Int, + status :: String, + master_ips :: [String], + axfr_ips :: [String], + display_group :: String } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON DNSZone +instance Data.Aeson.ToJSON DNSZone + +data DNSZones = DNSZones { total_pages :: Int, + total_results :: Int, + page :: Int, + dnszones :: [DNSZone] } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON DNSZones +instance Data.Aeson.ToJSON DNSZones + +data Kernel = Kernel { id :: String, + created :: String, + deprecated :: Bool, + xen :: Bool, + kvm :: Bool, + label :: String, + version :: String, + x64 :: Bool } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON Kernel +instance Data.Aeson.ToJSON Kernel + +data Kernels = Kernels { total_pages :: Int, + total_results :: Int, + page :: Int, + kernels :: [Kernel] } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON Kernels +instance Data.Aeson.ToJSON Kernels + + +data LinodeAlert = LinodeAlert { enabled :: Bool, + threshold :: Int } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON LinodeAlert +instance Data.Aeson.ToJSON LinodeAlert + +data LinodeAlerts = LinodeAlerts { cpu :: LinodeAlert, + io :: LinodeAlert, + transfer_in :: LinodeAlert, + transfer_out :: LinodeAlert, + transfer_quota :: LinodeAlert } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON LinodeAlerts +instance Data.Aeson.ToJSON LinodeAlerts + +data LinodeBackupsSchedule = LinodeBackupsSchedule { day :: M.Maybe String, + window :: M.Maybe String } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON LinodeBackupsSchedule +instance Data.Aeson.ToJSON LinodeBackupsSchedule + +data LinodeBackups = LinodeBackups { enabled :: Bool, + schedule :: LinodeBackupsSchedule, + last_backup :: M.Maybe String } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON LinodeBackups +instance Data.Aeson.ToJSON LinodeBackups + +data LinodeIPAddressesPrivate = LinodeIPAddressesPrivate { ipv4 :: [String], + link_local :: String } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON LinodeIPAddressesPrivate +instance Data.Aeson.ToJSON LinodeIPAddressesPrivate + +data LinodeIPAddressesPublic = LinodeIPAddressesPublic { failover :: [String], + ipv4 :: [String], + ipv6 :: String } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON LinodeIPAddressesPublic +instance Data.Aeson.ToJSON LinodeIPAddressesPublic + +data LinodeIPAddresses = LinodeIPAddresses { private :: LinodeIPAddressesPrivate, + public :: LinodeIPAddressesPublic } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON LinodeIPAddresses +instance Data.Aeson.ToJSON LinodeIPAddresses + +data Linode = Linode { id :: String, + alerts :: LinodeAlerts, + backups :: LinodeBackups, + created :: String, + datacenter :: Datacenter, + distribution :: M.Maybe Distribution, + group :: String, + ip_addresses :: LinodeIPAddresses, + label :: String, + services :: [Service], + state :: String, + total_transfer :: Int, + updated :: String } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON Linode +instance Data.Aeson.ToJSON Linode + +data Linodes = Linodes { total_pages :: Int, + total_results :: Int, + page :: Int, + linodes :: [Linode] } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON Linodes +instance Data.Aeson.ToJSON Linodes + +-- Missing type field +data Backup = Backup { id :: String, + label :: String, + status :: String, + linode_id :: String, + datacenter :: Datacenter, + created :: String, + updated :: String, + finished :: String } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON Backup +instance Data.Aeson.ToJSON Backup + +data Backups = Backups { total_pages :: Int, + total_results :: Int, + page :: Int, + backups :: [Backup] } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON Backups +instance Data.Aeson.ToJSON Backups + +data Filesystem = Raw | Swap | Ext3 | Ext4 deriving (Eq, Show) + +instance Data.Aeson.ToJSON Filesystem where + toJSON o = + let json :: String = case o of + Raw -> "raw" + Swap -> "swap" + Ext3 -> "ext3" + Ext4 -> "ext4" in + Data.Aeson.object [ "filesystem" .= json ] + +instance Data.Aeson.FromJSON Filesystem where + parseJSON o = + return $ case o of + "raw" -> Raw + "swap" -> Swap + "ext3" -> Ext3 + "ext4" -> Ext4 + +data Disk = Disk { id :: String, + label :: String, + state :: String, + size :: Int, + filesystem :: Filesystem, + created :: String, + updated :: String } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON Disk +instance Data.Aeson.ToJSON Disk + +data Disks = Disks { total_pages :: Int, + total_results :: Int, + page :: Int, + backups :: [Disk] } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON Disks +instance Data.Aeson.ToJSON Disks + +data ConfigDisks = ConfigDisks { sda :: M.Maybe Disk, + sdb :: M.Maybe Disk, + sdc :: M.Maybe Disk, + sdd :: M.Maybe Disk, + sde :: M.Maybe Disk, + sdf :: M.Maybe Disk, + sdg :: M.Maybe Disk, + sdh :: M.Maybe Disk } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON ConfigDisks +instance Data.Aeson.ToJSON ConfigDisks + +data ConfigHelpers = ConfigHelpers { disable_updatedb :: Bool, + enable_distro_helper :: Bool, + enable_modules_deb_helper :: Bool, + enable_network_helper :: Bool } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON ConfigHelpers +instance Data.Aeson.ToJSON ConfigHelpers + +data Config = Config { id :: String, + comments :: String, + created :: String, + devtmpfs_automount :: Bool, + disks :: ConfigDisks, + helpers :: ConfigHelpers, + kernel :: Kernel, + label :: String, + ram_limit :: M.Maybe Int, + root_device :: String, + root_device_ro :: Bool, + run_level :: String, + updated :: String, + virt_mode :: String } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON Config +instance Data.Aeson.ToJSON Config + +data Configs = Configs { total_pages :: Int, + total_results :: Int, + page :: Int, + configs :: [Config] } deriving (Eq, Show, GHC.Generics.Generic) + + +instance Data.Aeson.FromJSON Configs +instance Data.Aeson.ToJSON Configs + +-- Missing default field +data UDF = UDF { name :: String, + label :: String, + example :: String } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON UDF +instance Data.Aeson.ToJSON UDF + +data StackScript = StackScript { id :: String, + customer_id :: String, + user_id :: String, + label :: String, + description :: String, + distributions :: [Distribution], + deployments_total :: Int, + deployments_active :: Int, + is_public :: Bool, + created :: String, + updated :: String, + rev_note :: String, + script :: String, + user_defined_fields :: [UDF] } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON StackScript +instance Data.Aeson.ToJSON StackScript + +data StackScripts = StackScripts { total_pages :: Int, + total_results :: Int, + page :: Int, + stackscripts :: [StackScripts] } deriving (Eq, Show, GHC.Generics.Generic) + +instance Data.Aeson.FromJSON StackScripts +instance Data.Aeson.ToJSON StackScripts + +data RunLevel = Default | Single | BinBash deriving (Eq, Show) + +instance Data.Aeson.ToJSON RunLevel where + toJSON o = + let json :: String = case o of + Default -> "default" + Single -> "single" + BinBash -> "binbash" in + Data.Aeson.object [ "run_level" .= json ] + +instance Data.Aeson.FromJSON RunLevel where + parseJSON o = + return $ case o of + "default" -> Default + "single" -> Single + "binbash" -> BinBash + +data VirtMode = FullVirt | ParaVirt deriving (Eq, Show) + +instance Data.Aeson.ToJSON VirtMode where + toJSON o = + let json :: String = case o of + FullVirt -> "fullvirt" + ParaVirt -> "paravirt" in + Data.Aeson.object [ "virt_mode" .= json ] + +instance Data.Aeson.FromJSON VirtMode where + parseJSON o = + return $ case o of + "fullvirt" -> FullVirt + "paravirt" -> ParaVirt