diff --git a/linode.cabal b/linode.cabal --- a/linode.cabal +++ b/linode.cabal @@ -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 diff --git a/src/Network/Linode.hs b/src/Network/Linode.hs --- a/src/Network/Linode.hs +++ b/src/Network/Linode.hs @@ -8,32 +8,37 @@ This package contains some helpers to create and configure 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 - }) diff --git a/src/Network/Linode/Internal.hs b/src/Network/Linode/Internal.hs --- a/src/Network/Linode/Internal.hs +++ b/src/Network/Linode/Internal.hs @@ -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 diff --git a/src/Network/Linode/Parsing.hs b/src/Network/Linode/Parsing.hs new file mode 100644 --- /dev/null +++ b/src/Network/Linode/Parsing.hs @@ -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) diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -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 ]