linode 0.1.0.0 → 0.1.0.2
raw patch · 5 files changed
+165/−161 lines, 5 filesdep ~errorsdep ~retrydep ~text
Dependency ranges changed: errors, retry, text
Files
- linode.cabal +8/−6
- src/Network/Linode.hs +85/−73
- src/Network/Linode/Internal.hs +17/−38
- src/Network/Linode/Parsing.hs +17/−0
- test/Spec.hs +38/−44
linode.cabal view
@@ -1,5 +1,5 @@ name: linode-version: 0.1.0.0+version: 0.1.0.2 synopsis: Bindings to the Linode API description: Haskell bindings to the Linode API. Rent servers hourly or monthly. .@@ -10,7 +10,6 @@ license-file: LICENSE author: Sebastian de Bellefon maintainer: arnaudpourseb@gmail.com-copyright: BSD3 category: Network, Cloud, Distributed Computing build-type: Simple cabal-version: >=1.10@@ -19,20 +18,21 @@ library hs-source-dirs: src exposed-modules: Network.Linode- ,Network.Linode.Internal+ ,Network.Linode.Parsing ,Network.Linode.Types+ other-modules: Network.Linode.Internal build-depends: base >= 4.7 && < 5 ,aeson ,async ,binary ,bytestring ,containers- ,errors+ ,errors >= 2.0.0 ,lens ,process- ,retry+ ,retry >= 0.5 ,safe- ,text+ ,text >= 1.2.1 ,transformers ,wreq >= 0.3 default-language: Haskell2010@@ -45,10 +45,12 @@ build-depends: base , linode , aeson+ , bytestring , containers , tasty >= 0.10.1 , tasty-hunit >= 0.8 , tasty-quickcheck >= 0.8.2+ , text >= 1.2.1 ghc-options: -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010
src/Network/Linode.hs view
@@ -8,32 +8,37 @@ This package contains some helpers to create and configure <https://www.linode.com/ Linode> instances. They all require an API key, which can be created on the Linode website. -Usage example. We want to create one Linode instance in Atlanta with 2GB of RAM:+Usage example. We want to create one Linode instance in Atlanta with 1GB of RAM: +> {-# LANGUAGE OverloadedStrings #-} > import Network.Linode > import Data.List (find) > import qualified System.Process as P+> import Data.Foldable (traverse_)+> import Data.Monoid ((<>)) > > main :: IO() > main = do > apiKey <- fmap (head . words) (readFile "apiKey") > sshPublicKey <- readFile "id_rsa.pub"-> let log = True > let options = defaultLinodeCreationOptions { > datacenterSelect = find ((=="atlanta") . datacenterName),-> planSelect = find ((=="Linode 2048") . planName),+> planSelect = find ((=="Linode 1024") . planName), > sshKey = Just sshPublicKey > }-> linode <- createLinode apiKey log options-> print linode-> traverse_ (\a -> waitForSSH a >> setup a) (publicAddress linode) -- Setup the instance when the ssh connexion is ready+> c <- createLinode apiKey True options+> case c of+> Left err -> print err+> Right linode -> do+> traverse_ (\a -> waitForSSH a >> setup a) (publicAddress linode)+> print linode > > setup address = P.callCommand $ "scp yourfile root@" <> ip address <> ":/root" You should see something like this: -> Creating empty linode (Linode 2048 at atlanta)-> Creating disk (49024 MB)+> Creating empty linode (Linode 1024 at atlanta)+> Creating disk (24448 MB) > ................................... > Creating swap (128 MB) > ...............................@@ -88,7 +93,8 @@ -- * Examples , exampleCreateOneLinode , exampleCreateTwoLinodes- , testOptions++ , module Network.Linode.Types ) where import Control.Concurrent (threadDelay)@@ -194,10 +200,11 @@ Delete a Linode instance. -} deleteInstance :: ApiKey -> LinodeId -> IO (Either LinodeError DeletedLinode)-deleteInstance apiKey (LinodeId i) = do- let opts = W.defaults & W.param "LinodeID" .~ [T.pack $ show i]- & W.param "skipChecks" .~ ["true"]- runExceptT $ getWith opts (query "linode.delete" apiKey)+deleteInstance apiKey (LinodeId i) = runExceptT $ getWith $+ W.defaults & W.param "api_key" .~ [T.pack apiKey]+ & W.param "api_action" .~ [T.pack "linode.delete"]+ & W.param "LinodeID" .~ [T.pack $ show i]+ & W.param "skipChecks" .~ ["true"] {-| Delete a list of Linode instances.@@ -210,46 +217,47 @@ Read your global account information: network usage, billing state and billing method. -} getAccountInfo :: ApiKey -> ExceptT LinodeError IO AccountInfo-getAccountInfo = noParamQuery "account.info"+getAccountInfo = simpleGetter "account.info" {-| Read all Linode datacenters: dallas, fremont, atlanta, newark, london, tokyo, singapore, frankfurt -} getDatacenters :: ApiKey -> ExceptT LinodeError IO [Datacenter]-getDatacenters = noParamQuery "avail.datacenters"+getDatacenters = simpleGetter "avail.datacenters" {-| Read all available Linux distributions. For example, Debian 8.1 has id 140. -} getDistributions :: ApiKey -> ExceptT LinodeError IO [Distribution]-getDistributions = noParamQuery "avail.distributions"+getDistributions = simpleGetter "avail.distributions" {-| Read detailed information about all your instances. -} getInstances :: ApiKey -> ExceptT LinodeError IO [Instance]-getInstances = noParamQuery "linode.list"+getInstances = simpleGetter "linode.list" {-| Read all available Linux kernels. -} getKernels :: ApiKey -> ExceptT LinodeError IO [Kernel]-getKernels = noParamQuery "avail.kernels"+getKernels = simpleGetter "avail.kernels" {-| Read all plans offered by Linode. A plan specifies the available CPU, RAM, network usage and pricing of an instance. The smallest plan is Linode 1024. -} getPlans :: ApiKey -> ExceptT LinodeError IO [Plan]-getPlans = noParamQuery "avail.linodeplans"+getPlans = simpleGetter "avail.linodeplans" {-| Read all IP addresses of an instance. -} getIpList :: ApiKey -> LinodeId -> ExceptT LinodeError IO [Address]-getIpList apiKey (LinodeId i) = do- let opts = W.defaults & W.param "LinodeID" .~ [T.pack $ show i]- getWith opts (query "linode.ip.list" apiKey)+getIpList apiKey (LinodeId i) = getWith $+ W.defaults & W.param "api_key" .~ [T.pack apiKey]+ & W.param "api_action" .~ [T.pack "linode.ip.list"]+ & W.param "LinodeID" .~ [T.pack $ show i] {-| Create a Linode Config (a bag of instance options).@@ -257,39 +265,42 @@ createConfig :: ApiKey -> LinodeId -> KernelId -> String -> [DiskId] -> ExceptT LinodeError IO CreatedConfig createConfig apiKey (LinodeId i) (KernelId k) label disksIds = do let disksList = T.intercalate "," $ take 9 $ map (T.pack . show . unDisk) disksIds ++ repeat ""- let opts = W.defaults & W.param "LinodeID" .~ [T.pack $ show i]+ let opts = W.defaults & W.param "api_key" .~ [T.pack apiKey]+ & W.param "api_action" .~ [T.pack "linode.config.create"]+ & W.param "LinodeID" .~ [T.pack $ show i] & W.param "KernelID" .~ [T.pack $ show k] & W.param "Label" .~ [T.pack label] & W.param "DiskList" .~ [disksList] & W.param "helper_distro" .~ ["true"] & W.param "helper_network" .~ ["true"]- getWith opts (query "linode.config.create" apiKey)+ getWith opts {-| Create a disk from a supported Linux distribution. Size in MB. -} createDiskFromDistribution :: ApiKey -> LinodeId -> DistributionId -> String -> Int -> String -> Maybe String -> ExceptT LinodeError IO CreatedDisk-createDiskFromDistribution apiKey (LinodeId i) (DistributionId d) label size pass sshPublicKey = do- let opts = W.defaults & W.param "LinodeID" .~ [T.pack $ show i]- & W.param "DistributionID" .~ [T.pack $ show d]- & W.param "Label" .~ [T.pack label]- & W.param "Size" .~ [T.pack $ show size]- & W.param "rootPass" .~ [T.pack pass]- & case T.pack <$> sshPublicKey of- Nothing -> id- Just k -> W.param "rootSSHKey" .~ [k]- getWith opts (query "linode.disk.createfromdistribution" apiKey)+createDiskFromDistribution apiKey (LinodeId i) (DistributionId d) label size pass sshPublicKey = getWith $+ W.defaults & W.param "api_key" .~ [T.pack apiKey]+ & W.param "api_action" .~ [T.pack "linode.disk.createfromdistribution"]+ & W.param "LinodeID" .~ [T.pack $ show i]+ & W.param "DistributionID" .~ [T.pack $ show d]+ & W.param "Label" .~ [T.pack label]+ & W.param "Size" .~ [T.pack $ show size]+ & W.param "rootPass" .~ [T.pack pass]+ & case T.pack <$> sshPublicKey of+ Nothing -> id+ Just k -> W.param "rootSSHKey" .~ [k] {-|-Create a Linode instance with no disk and no configuration. You probably want createLinode.+Create a Linode instance with no disk and no configuration. You probably want createLinode instead. -} createDisklessLinode :: ApiKey -> DatacenterId -> PlanId -> PaymentTerm -> ExceptT LinodeError IO CreatedLinode-createDisklessLinode apiKey (DatacenterId d) (PlanId p) paymentTerm = do- let opts = W.defaults & W.param "DatacenterID" .~ [T.pack $ show d]- & W.param "PlanID" .~ [T.pack $ show p]- & W.param "PaymentTerm" .~ [T.pack $ show (paymentTermToInt paymentTerm)]- getWith opts (query "linode.create" apiKey)-+createDisklessLinode apiKey (DatacenterId d) (PlanId p) paymentTerm = getWith $+ W.defaults & W.param "api_key" .~ [T.pack apiKey]+ & W.param "api_action" .~ [T.pack "linode.create"]+ & W.param "DatacenterID" .~ [T.pack $ show d]+ & W.param "PlanID" .~ [T.pack $ show p]+ & W.param "PaymentTerm" .~ [T.pack $ show (paymentTermToInt paymentTerm)] {-| Create a swap partition.@@ -301,32 +312,34 @@ Create a partition. -} createDisk :: ApiKey -> LinodeId -> String -> DiskType -> Int -> ExceptT LinodeError IO CreatedDisk-createDisk apiKey (LinodeId i) label diskType size = do- let opts = W.defaults & W.param "LinodeID" .~ [T.pack $ show i]- & W.param "Label" .~ [T.pack label]- & W.param "Type" .~ [T.pack (diskTypeToString diskType)]- & W.param "size" .~ [T.pack $ show size]- getWith opts (query "linode.disk.create" apiKey)+createDisk apiKey (LinodeId i) label diskType size = getWith $+ W.defaults & W.param "api_key" .~ [T.pack apiKey]+ & W.param "api_action" .~ [T.pack "linode.disk.create"]+ & W.param "LinodeID" .~ [T.pack $ show i]+ & W.param "Label" .~ [T.pack label]+ & W.param "Type" .~ [T.pack (diskTypeToString diskType)]+ & W.param "size" .~ [T.pack $ show size] {-| Boot a Linode instance. -} boot :: ApiKey-> LinodeId -> ConfigId -> ExceptT LinodeError IO BootedInstance-boot apiKey (LinodeId i) (ConfigId c) = do- let opts = W.defaults & W.param "LinodeID" .~ [T.pack $ show i]- & W.param "ConfigID" .~ [T.pack $ show c]- getWith opts (query "linode.boot" apiKey)-+boot apiKey (LinodeId i) (ConfigId c) = getWith $+ W.defaults & W.param "api_key" .~ [T.pack apiKey]+ & W.param "api_action" .~ [T.pack "linode.boot"]+ & W.param "LinodeID" .~ [T.pack $ show i]+ & W.param "ConfigID" .~ [T.pack $ show c] {-| List of pending jobs for this Linode instance. -} jobList :: ApiKey -> LinodeId -> ExceptT LinodeError IO [WaitingJob]-jobList apiKey (LinodeId i) = do- let opts = W.defaults & W.param "LinodeID" .~ [T.pack $ show i]- & W.param "pendingOnly" .~ ["true"]- getWith opts (query "linode.job.list" apiKey)+jobList apiKey (LinodeId i) = getWith $+ W.defaults & W.param "api_key" .~ [T.pack apiKey]+ & W.param "api_action" .~ [T.pack "linode.job.list"]+ & W.param "LinodeID" .~ [T.pack $ show i]+ & W.param "pendingOnly" .~ ["true"] {-| Wait until all operations on one instance are done.@@ -361,11 +374,17 @@ publicAddress = headMay . linodeAddresses {-|-Example of Linode creation.+Example of Linode creation. It expects the apiKey and id_rsa.pub files in the current directory. -} exampleCreateOneLinode :: IO (Maybe Linode) exampleCreateOneLinode = do- (apiKey, options) <- testOptions+ apiKey <- fmap (head . words) (readFile "apiKey")+ sshPublicKey <- readFile "id_rsa.pub"+ let options = defaultLinodeCreationOptions {+ datacenterSelect = find ((=="atlanta") . datacenterName),+ planSelect = find ((=="Linode 1024") . planName),+ sshKey = Just sshPublicKey+ } c <- createLinode apiKey True options case c of Left err -> do@@ -377,11 +396,17 @@ where setup address = P.callCommand $ "scp TODO root@" <> ip address <> ":/root" {-|-Example of Linodes creation.+Example of Linodes creation. It expects the apiKey and id_rsa.pub files in the current directory. -} exampleCreateTwoLinodes :: IO (Maybe [Linode]) exampleCreateTwoLinodes = do- (apiKey, options) <- testOptions+ sshPublicKey <- readFile "id_rsa.pub"+ apiKey <- fmap (head . words) (readFile "apiKey")+ let options = defaultLinodeCreationOptions {+ datacenterSelect = find ((=="atlanta") . datacenterName),+ planSelect = find ((=="Linode 1024") . planName),+ sshKey = Just sshPublicKey+ } c <- createCluster apiKey options 2 True case c of Left errors -> do@@ -391,16 +416,3 @@ mapM_ (traverse_ (\a -> waitForSSH a >> setup a) . publicAddress) linodes return (Just linodes) where setup address = P.callCommand $ "scp TODO root@" <> ip address <> ":/root"--{-|-A set of options for the examples. It expects the apiKey and id_rsa.pub files in the current directory.--}-testOptions :: IO (ApiKey, LinodeCreationOptions)-testOptions = do- apiKey <- fmap (head . words) (readFile "apiKey")- sshPublicKey <- readFile "id_rsa.pub"- return (apiKey, defaultLinodeCreationOptions {- datacenterSelect = find ((=="atlanta") . datacenterName),- planSelect = find ((=="Linode 1024") . planName),- sshKey = Just sshPublicKey- })
src/Network/Linode/Internal.hs view
@@ -5,27 +5,22 @@ import Control.Error import Control.Exception (IOException, handle)-import Control.Lens ((^?))+import Control.Lens ((&), (.~), (^?)) import Control.Monad.IO.Class (liftIO)-import Data.Aeson (FromJSON, decode)+import Data.Aeson (FromJSON) import qualified Data.ByteString.Lazy as B+--import Data.Foldable (traverse_) import Data.Monoid ((<>))-import qualified Data.Text.Encoding as E-import qualified Data.Text.IO as TIO+import qualified Data.Text as T+--import Data.Text.Encoding (decodeUtf8)+--import qualified Data.Text.IO as TIO import qualified Network.Wreq as W+--import Network.Wreq.Lens +import Network.Linode.Parsing 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"@@ -37,37 +32,21 @@ 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+getWith :: FromJSON a => W.Options -> ExceptT LinodeError IO a+getWith opts = ExceptT g where g = handle (\(e :: IOException) -> return (Left $ NetworkError e)) $ do- response <- W.getWith opts url+ --liftIO $ print (view params opts :: [(T.Text, T.Text)])+ response <- W.getWith opts "https://api.linode.com"+ --liftIO $ traverse_ (TIO.putStrLn . decodeUtf8. B.toStrict) $ response ^? W.responseBody 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)+simpleGetter :: FromJSON a => String -> ApiKey -> ExceptT LinodeError IO a+simpleGetter action apiKey = getWith opts+ where opts = W.defaults & W.param "api_key" .~ [T.pack apiKey]+ & W.param "api_action" .~ [T.pack action] 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
+ src/Network/Linode/Parsing.hs view
@@ -0,0 +1,17 @@+module Network.Linode.Parsing (+ parseResponse+) where++import Data.Aeson (FromJSON, decode)+import qualified Data.ByteString.Lazy as B+import qualified Data.Text.Encoding as E++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)
test/Spec.hs view
@@ -1,86 +1,80 @@ {-# LANGUAGE OverloadedStrings #-} -import Data.Aeson (decode)-import qualified Data.Map as M-import Network.Linode.Internal+import qualified Data.ByteString.Lazy as B+import qualified Data.Map as M+import qualified Data.Text.Encoding as E import Network.Linode.Types+import Network.Linode.Parsing import Test.Tasty import Test.Tasty.HUnit-import qualified Test.Tasty.QuickCheck as QC+--import qualified Test.Tasty.QuickCheck as QC -someFunc :: IO ()-someFunc = do- let p = decode "{\"ERRORARRAY\":[{\"ERRORCODE\":4,\"ERRORMESSAGE\":\"Authentication failed\"}],\"DATA\":[],\"ACTION\":\"avail.datacenters\"}" :: Maybe (Response Datacenter)- print p- let q = decode "{\"ERRORARRAY\":[{\"ERRORCODE\":4,\"ERRORMESSAGE\":\"Authentication failed\"}],\"DATA\":{},\"ACTION\":\"avail.datacenters\"}" :: Maybe (Response Datacenter)- print q- let p = decode "{\"LOCATION\":\"Dallas, TX, USA\",\"DATACENTERID\":2,\"ABBR\":\"dallas\"}" :: Maybe Datacenter- print p- let p2 = decode "{\"ERRORARRAY\":[],\"DATA\":[{\"LOCATION\":\"Dallas, TX, USA\",\"DATACENTERID\":2,\"ABBR\":\"dallas\"},{\"LOCATION\":\"Fremont, CA, USA\",\"DATACENTERID\":3,\"ABBR\":\"fremont\"},{\"LOCATION\":\"Atlanta, GA, USA\",\"DATACENTERID\":4,\"ABBR\":\"atlanta\"},{\"LOCATION\":\"Newark, NJ, USA\",\"DATACENTERID\":6,\"ABBR\":\"newark\"},{\"LOCATION\":\"London, England, UK\",\"DATACENTERID\":7,\"ABBR\":\"london\"},{\"LOCATION\":\"Tokyo, JP\",\"DATACENTERID\":8,\"ABBR\":\"tokyo\"},{\"LOCATION\":\"Singapore, SG\",\"DATACENTERID\":9,\"ABBR\":\"singapore\"},{\"LOCATION\":\"Frankfurt, DE\",\"DATACENTERID\":10,\"ABBR\":\"frankfurt\"}],\"ACTION\":\"avail.datacenters\"}" :: Maybe (Response Datacenter)- print p2- let p3 = decode "{\"REQUIRESPVOPSKERNEL\":0,\"DISTRIBUTIONID\":142,\"IS64BIT\":1,\"LABEL\":\"Arch Linux 2015.08\",\"MINIMAGESIZE\":800,\"CREATE_DT\":\"2015-08-24 11:17:18.0\"}" :: Maybe Distribution- print p3- let p4 = decode "{\"ISKVM\":1,\"LABEL\":\"Latest 32 bit (4.1.5-x86-linode80)\",\"ISXEN\":1,\"ISPVOPS\":1,\"KERNELID\":137}" :: Maybe Kernel- print p4- let p5 = decode "{\"CORES\":1,\"PRICE\":10.00,\"RAM\":1024,\"XFER\":2000,\"PLANID\":1,\"LABEL\":\"Linode 1024\",\"AVAIL\":{\"3\":500,\"2\":500,\"10\":500,\"7\":500,\"6\":500,\"4\":500,\"9\":500,\"8\":500},\"DISK\":24,\"HOURLY\":0.0150}" :: Maybe Plan- print p5- let p6 = decode "{\"TRANSFER_USED\":1,\"BALANCE\":0.0000,\"TRANSFER_BILLABLE\":0,\"BILLING_METHOD\":\"prepay\",\"TRANSFER_POOL\":2000,\"ACTIVE_SINCE\":\"2011-03-10 19:18:43.0\",\"MANAGED\":false}" :: Maybe AccountInfo- print p6- let p7 = decode "{\"LINODEID\":8098, \"LABEL\": \"api-node3\", \"DATACENTERID\": 5, \"PLANID\":1, \"TOTALRAM\":1024, \"TOTALHD\":40960, \"TOTALXFER\":2000, \"BACKUPSENABLED\":1, \"STATUS\":2}" :: Maybe Instance- print p7 testAuthenticationError :: Assertion-testAuthenticationError = assertEqual "Parsing an Authentication failure" (Left AuthenticationFailed) x+testAuthenticationError = assertEqual "Error while parsing an Authentication failure" (Left AuthenticationFailed) x where x = parseResponse "{\"ERRORARRAY\":[{\"ERRORCODE\":4,\"ERRORMESSAGE\":\"Authentication failed\"}],\"DATA\":{},\"ACTION\":\"avail.datacenters\"}" :: Either LinodeError [Datacenter] testDatacenterList :: Assertion-testDatacenterList = assertEqual "Parsing an datacenter list" (Right [Datacenter (DatacenterId 2) "Dallas, TX, USA" "dallas"]) x+testDatacenterList = assertEqual "Error while parsing an datacenter list" (Right [Datacenter (DatacenterId 2) "Dallas, TX, USA" "dallas"]) x where x = parseResponse "{\"ERRORARRAY\":[],\"DATA\":[{\"LOCATION\":\"Dallas, TX, USA\",\"DATACENTERID\":2,\"ABBR\":\"dallas\"}],\"ACTION\":\"avail.datacenters\"}" testDistributionList :: Assertion-testDistributionList = assertEqual "Parsing a distribution list" (Right [Distribution (DistributionId 142) "Arch Linux 2015.08" True 800 False]) x+testDistributionList = assertEqual "Error while parsing a distribution list" (Right [Distribution (DistributionId 142) "Arch Linux 2015.08" True 800 False]) x where x = parseResponse "{\"ERRORARRAY\":[],\"DATA\":[{\"REQUIRESPVOPSKERNEL\":0,\"DISTRIBUTIONID\":142,\"IS64BIT\":1,\"LABEL\":\"Arch Linux 2015.08\",\"MINIMAGESIZE\":800,\"CREATE_DT\":\"2015-08-24 11:17:18.0\"}],\"ACTION\":\"avail.distributions\"}" :: Either LinodeError [Distribution] testKernelList :: Assertion-testKernelList = assertEqual "Parsing a kernel list" (Right [Kernel (KernelId 137) "Latest 32 bit (4.1.5-x86-linode80)" True True True]) x+testKernelList = assertEqual "Error while parsing a kernel list" (Right [Kernel (KernelId 137) "Latest 32 bit (4.1.5-x86-linode80)" True True True]) x where x = parseResponse "{\"ERRORARRAY\":[],\"DATA\":[{\"ISKVM\":1,\"LABEL\":\"Latest 32 bit (4.1.5-x86-linode80)\",\"ISXEN\":1,\"ISPVOPS\":1,\"KERNELID\":137}],\"ACTION\":\"avail.kernels\"}" :: Either LinodeError [Kernel] testPlanList :: Assertion-testPlanList = assertEqual "Parsing a plan list" (Right [Plan (PlanId 1) "Linode 1024" 1024 24 2000 0.0150 (M.fromList [(DatacenterId 3,500),(DatacenterId 2,400)])]) x+testPlanList = assertEqual "Error while parsing a plan list" (Right [Plan (PlanId 1) "Linode 1024" 1024 24 2000 0.0150 (M.fromList [(DatacenterId 3,500),(DatacenterId 2,400)])]) x where x = parseResponse "{\"ERRORARRAY\":[],\"DATA\":[{\"CORES\":1,\"PRICE\":10.00,\"RAM\":1024,\"XFER\":2000,\"PLANID\":1,\"LABEL\":\"Linode 1024\",\"AVAIL\":{\"3\":500,\"2\":400},\"DISK\":24,\"HOURLY\":0.0150}],\"ACTION\":\"avail.linodeplans\"}" :: Either LinodeError [Plan] testAccountInfo :: Assertion-testAccountInfo = assertEqual "Parsing some account info" (Right $ AccountInfo 2000 1 0 False 0 "prepay") x+testAccountInfo = assertEqual "Error while parsing some account info" (Right $ AccountInfo 2000 1 0 False 0 "prepay") x where x = parseResponse "{\"ERRORARRAY\":[],\"DATA\":{\"TRANSFER_USED\":1,\"BALANCE\":0.0000,\"TRANSFER_BILLABLE\":0,\"BILLING_METHOD\":\"prepay\",\"TRANSFER_POOL\":2000,\"ACTIVE_SINCE\":\"2011-03-10 19:18:43.0\",\"MANAGED\":false},\"ACTION\":\"account.info\"}" :: Either LinodeError AccountInfo testInstanceList :: Assertion-testInstanceList = assertEqual "Parsing some account info" (Right [Instance {instanceId = LinodeId 8098, instanceName = "api-node3", instanceDatacenterId = DatacenterId 5, instancePlanId = PlanId 1, instanceRAM = 1024, instanceHD = 40960, instanceTransfer = 2000, instanceBackupEnabled = True, instanceStatus = PoweredOff}]) x+testInstanceList = assertEqual "Error while parsing some account info" (Right [Instance {instanceId = LinodeId 8098, instanceName = "api-node3", instanceDatacenterId = DatacenterId 5, instancePlanId = PlanId 1, instanceRAM = 1024, instanceHD = 40960, instanceTransfer = 2000, instanceBackupEnabled = True, instanceStatus = PoweredOff}]) x where x = parseResponse "{\"ERRORARRAY\":[],\"DATA\":[{\"LINODEID\":8098, \"LABEL\": \"api-node3\", \"DATACENTERID\": 5, \"PLANID\":1, \"TOTALRAM\":1024, \"TOTALHD\":40960, \"TOTALXFER\":2000, \"BACKUPSENABLED\":1, \"STATUS\":2}],\"ACTION\":\"linode.list\"}" :: Either LinodeError [Instance] testInstanceCreation :: Assertion-testInstanceCreation = assertEqual "Parsing the instanceId after a call to linode.create" (Right $ CreatedLinode (LinodeId 1449138)) x+testInstanceCreation = assertEqual "Error while parsing the instanceId after a call to linode.create" (Right $ CreatedLinode (LinodeId 1449138)) x where x = parseResponse "{\"ERRORARRAY\":[],\"DATA\":{\"LinodeID\":1449138},\"ACTION\":\"linode.create\"}" testDiskCreation :: Assertion-testDiskCreation = assertEqual "Parsing the diskId and jobId after creating a disk" (Right $ CreatedDisk (DiskId 55647) (JobId 1298)) x+testDiskCreation = assertEqual "Error while parsing the diskId and jobId after creating a disk" (Right $ CreatedDisk (DiskId 55647) (JobId 1298)) x where x = parseResponse "{\"ERRORARRAY\":[],\"ACTION\":\"linode.disk.createFromDistribution\",\"DATA\":{\"JobID\":1298,\"DiskID\":55647}}" testJobWait :: Assertion-testJobWait = assertEqual "Parsing a waiting job list" (Right [WaitingJob (JobId 29046473) (LinodeId 1450724) True, WaitingJob (JobId 29046472) (LinodeId 1450724) False]) x+testJobWait = assertEqual "Error while parsing a waiting job list" (Right [WaitingJob (JobId 29046473) (LinodeId 1450724) True, WaitingJob (JobId 29046472) (LinodeId 1450724) False]) x where x = parseResponse "{\"ERRORARRAY\":[],\"DATA\":[{\"HOST_START_DT\":\"\",\"HOST_MESSAGE\":\"\",\"ENTERED_DT\":\"2015-11-08 10:38:15.0\",\"HOST_FINISH_DT\":\"\",\"LABEL\":\"Disk Create From Distribution - Debian 8.1\",\"JOBID\":29046473,\"HOST_SUCCESS\":1,\"ACTION\":\"fs.create.from.distro\",\"LINODEID\":1450724,\"DURATION\":\"\"},{\"HOST_START_DT\":\"\",\"HOST_MESSAGE\":\"\",\"ENTERED_DT\":\"2015-11-08 10:38:14.0\",\"HOST_FINISH_DT\":\"\",\"LABEL\":\"Linode Initial Configuration\",\"JOBID\":29046472,\"HOST_SUCCESS\":\"\",\"ACTION\":\"linode.create\",\"LINODEID\":1450724,\"DURATION\":\"\"}],\"ACTION\":\"linode.job.list\"}" +testParsingWithNoData :: Assertion+testParsingWithNoData = assertEqual "Parsing no data should fail" x (Left expectedError)+ where x = parseResponse body :: Either LinodeError Datacenter+ body = "{\"ERRORARRAY\":[], \"ACTION\":\"avail.datacenters\"}"+ expectedError = DeserializationError (E.decodeUtf8 $ B.toStrict body)++testParsingEmptyResponse :: Assertion+testParsingEmptyResponse = assertEqual "Parsing an empty response should fail" x (Left expectedError)+ where x = parseResponse "" :: Either LinodeError Datacenter+ expectedError = DeserializationError ""+ tests :: TestTree tests = testGroup "Parsing tests" [- testCase "Parsing an Authentication failure" testAuthenticationError,- testCase "Parsing a datacenter list" testDatacenterList,- testCase "Parsing a distribution list" testDistributionList,- testCase "Parsing a kernel list" testKernelList,- testCase "Parsing a plan list" testPlanList,- testCase "Parsing some account info" testAccountInfo,- testCase "Parsing an instance list" testInstanceList,- testCase "Parsing the instanceId after a call to linode.create" testInstanceCreation,- testCase "Parsing the diskId and jobId after creating a disk" testDiskCreation,- testCase "Parsing a waiting job list" testJobWait+ testCase "Error while parsing an Authentication failure" testAuthenticationError,+ testCase "Error while parsing a datacenter list" testDatacenterList,+ testCase "Error while parsing a distribution list" testDistributionList,+ testCase "Error while parsing a kernel list" testKernelList,+ testCase "Error while parsing a plan list" testPlanList,+ testCase "Error while parsing some account info" testAccountInfo,+ testCase "Error while parsing an instance list" testInstanceList,+ testCase "Error while parsing the instanceId after a call to linode.create" testInstanceCreation,+ testCase "Error while parsing the diskId and jobId after creating a disk" testDiskCreation,+ testCase "Error while parsing a waiting job list" testJobWait,+ testCase "Parsing no data should fail" testParsingWithNoData,+ testCase "Parsing an empty response should fail" testParsingEmptyResponse ]