linode 0.1.0.3 → 0.1.0.4
raw patch · 4 files changed
+52/−44 lines, 4 files
Files
- linode.cabal +1/−1
- src/Network/Linode.hs +21/−22
- src/Network/Linode/Types.hs +8/−4
- test/Spec.hs +22/−17
linode.cabal view
@@ -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. .
src/Network/Linode.hs view
@@ -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.
src/Network/Linode/Types.hs view
@@ -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
test/Spec.hs view
@@ -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 ]