diff --git a/linode.cabal b/linode.cabal --- a/linode.cabal +++ b/linode.cabal @@ -1,5 +1,5 @@ name: linode -version: 0.1.0.3 +version: 0.1.0.4 synopsis: Bindings to the Linode API description: Haskell bindings to the Linode API. Rent servers hourly or monthly. . diff --git a/src/Network/Linode.hs b/src/Network/Linode.hs --- a/src/Network/Linode.hs +++ b/src/Network/Linode.hs @@ -39,13 +39,12 @@ > Creating empty linode (Linode 1024 at atlanta) > Creating disk (24448 MB) -> ................................... +> .............. > Creating swap (128 MB) -> ............................... +> ........ > Creating config -> ....... > Booting -> .................................... +> ...................................... > Booted linode 1481198 And get something like that: @@ -105,8 +104,9 @@ import Control.Monad.IO.Class (liftIO) import qualified Control.Retry as R import Data.Foldable (traverse_) -import Data.List (find) +import Data.List (find, sortBy) import Data.Monoid ((<>)) +import Data.Ord (comparing) import qualified Data.Text as T import qualified Network.Wreq as W import Prelude hiding (log) @@ -138,17 +138,16 @@ configure linId (datacenter, distribution, plan, kernel) = do let swapSize = swapAmount options let rootDiskSize = (1024 * disk plan) - swapSize - let wait = liftIO (waitUntilCompletion apiKey linId) - printLog $ "Creating disk (" ++ show rootDiskSize ++ " MB)" - (CreatedDisk diskId _) <- wait >> createDiskFromDistribution apiKey linId (distributionId distribution) (diskLabel options) rootDiskSize (password options) (sshKey options) - printLog $ "Creating swap (" ++ show swapSize ++ " MB)" - (CreatedDisk swapId _) <- wait >> createSwapDisk apiKey linId "swap" swapSize + let wait = liftIO (waitUntilCompletion apiKey linId log) + (CreatedDisk diskId _) <- createDiskFromDistribution apiKey linId (distributionId distribution) (diskLabel options) rootDiskSize (password options) (sshKey options) + printLog ("Creating disk (" ++ show rootDiskSize ++ " MB)") >> wait + (CreatedDisk swapId _) <- createSwapDisk apiKey linId "swap" swapSize + printLog ("Creating swap (" ++ show swapSize ++ " MB)") >> wait + (CreatedConfig configId) <- maybeOr (CreatedConfig <$> config options) (createConfig apiKey linId (kernelId kernel) "profile" [diskId, swapId]) printLog "Creating config" - (CreatedConfig configId) <- wait >> maybeOr (CreatedConfig <$> config options) (createConfig apiKey linId (kernelId kernel) "profile" [diskId, swapId]) - printLog "Booting" - (BootedInstance _) <- wait >> boot apiKey linId configId - printLog "Still booting" - addresses <- wait >> getIpList apiKey linId + (BootedInstance _) <- boot apiKey linId configId + printLog "Booting" >> wait + addresses <- getIpList apiKey linId printLog $ "Booted linode " ++ show (unLinodeId linId) return $ Linode linId configId (datacenterName datacenter) (password options) addresses printLog l = when log (liftIO $ putStrLn l) @@ -345,16 +344,16 @@ {-| Wait until all operations on one instance are done. -} -waitUntilCompletion :: ApiKey -> LinodeId -> IO() -waitUntilCompletion apiKey linId = do +waitUntilCompletion :: ApiKey -> LinodeId -> Bool -> IO() +waitUntilCompletion apiKey linId log = do waitingJobs <- runExceptT $ jobList apiKey linId case all waitingJobSuccess <$> waitingJobs of Left e -> putStrLn $ "Error during wait:" ++ show e - Right True -> putStrLn "" + Right True -> when log (putStrLn "") Right False -> do - putStr "." + when log (putStr ".") threadDelay (100*1000) - waitUntilCompletion apiKey linId + waitUntilCompletion apiKey linId log {-| @@ -364,7 +363,7 @@ select apiKey options = (,,,) <$> fetchAndSelect (runExceptT $ getDatacenters apiKey) (datacenterSelect options) "datacenter" <*> fetchAndSelect (runExceptT $ getDistributions apiKey) (distributionSelect options) "distribution" <*> - fetchAndSelect (runExceptT $ getPlans apiKey) (planSelect options) "plan" <*> + fetchAndSelect (runExceptT $ getPlans apiKey) (planSelect options . sortBy (comparing hourly)) "plan" <*> fetchAndSelect (runExceptT $ getKernels apiKey) (kernelSelect options) "kernel" @@ -372,7 +371,7 @@ Pick one public address of the Linode Instance -} publicAddress :: Linode -> Maybe Address -publicAddress = headMay . linodeAddresses +publicAddress = headMay . sortBy (comparing ip) . filter isPublic . linodeAddresses {-| Example of Linode creation. It expects the apiKey and id_rsa.pub files in the current directory. diff --git a/src/Network/Linode/Types.hs b/src/Network/Linode/Types.hs --- a/src/Network/Linode/Types.hs +++ b/src/Network/Linode/Types.hs @@ -80,7 +80,8 @@ data Address = Address { ip :: String, - rdnsName :: String + rdnsName :: String, + isPublic :: Bool } deriving (Eq, Show, Generic) data Datacenter = Datacenter { @@ -177,7 +178,8 @@ data WaitingJob = WaitingJob { waitingJobId :: JobId, waitingJobLinodeId :: LinodeId, - waitingJobSuccess :: Bool + waitingJobSuccess :: Bool, + waitingJobLabel :: Text } deriving (Eq, Show) {-| @@ -289,7 +291,8 @@ instance FromJSON Address where - parseJSON (Object v) = Address <$> v .: "IPADDRESS" <*> v .: "RDNS_NAME" + parseJSON (Object o) = Address <$> o .: "IPADDRESS" <*> o .: "RDNS_NAME" <*> (isTrue <$> (o .: "ISPUBLIC")) + where isTrue = (== (1::Int)) parseJSON _ = mzero @@ -319,8 +322,9 @@ parseJSON = withObject "person" $ \o -> do j <- JobId <$> o .: "JOBID" i <- LinodeId <$> o .: "LINODEID" + l <- o.: "LABEL" success :: Maybe Int <- optional (o .: "HOST_SUCCESS") -- 1 if ok, "" if not - return $ WaitingJob j i (fromMaybe 0 success == 1) + return $ WaitingJob j i (fromMaybe 0 success == 1) l instance FromJSON a => FromJSON (Response a) where diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,10 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} -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 qualified Data.ByteString.Lazy as B +import qualified Data.Map as M +import qualified Data.Text.Encoding as E import Network.Linode.Parsing +import Network.Linode.Types import Test.Tasty import Test.Tasty.HUnit --import qualified Test.Tasty.QuickCheck as QC @@ -47,7 +47,7 @@ where x = parseResponse "{\"ERRORARRAY\":[],\"ACTION\":\"linode.disk.createFromDistribution\",\"DATA\":{\"JobID\":1298,\"DiskID\":55647}}" testJobWait :: Assertion -testJobWait = assertEqual "Error while 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 "Disk Create From Distribution - Debian 8.1", WaitingJob (JobId 29046472) (LinodeId 1450724) False "Linode Initial Configuration"]) 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 @@ -61,20 +61,25 @@ where x = parseResponse "" :: Either LinodeError Datacenter expectedError = DeserializationError "" +testIpList :: Assertion +testIpList = assertEqual "Error while parsing the ip list of an instance" x (Right [Address "45.79.212.6" "li1311-6.members.linode.com" True]) + where x = parseResponse "{\"ERRORARRAY\":[],\"DATA\":[{\"IPADDRESSID\":365472,\"RDNS_NAME\":\"li1311-6.members.linode.com\",\"LINODEID\":1483201,\"ISPUBLIC\":1,\"IPADDRESS\":\"45.79.212.6\"}],\"ACTION\":\"linode.ip.list\"}" + tests :: TestTree tests = testGroup "Parsing tests" [ - 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 + 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 "Parsing no data" testParsingWithNoData, + testCase "Parsing an empty response" testParsingEmptyResponse, + testCase "Parsing an IP list" testIpList ]