appc (empty) → 0.0.2
raw patch · 6 files changed
+459/−0 lines, 6 filesdep +aesondep +appcdep +basesetup-changed
Dependencies added: aeson, appc, base, bytestring, containers, hspec, hspec-smallcheck, optparse-applicative, semver, smallcheck, text, uuid
Files
- LICENSE +20/−0
- Setup.hs +2/−0
- appc.cabal +66/−0
- src/Data/AppContainer/Types.hs +210/−0
- src/Main.hs +76/−0
- test/Test.hs +85/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2014 Tomas Carnecky++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ appc.cabal view
@@ -0,0 +1,66 @@+name: appc+version: 0.0.2+license: MIT+license-file: LICENSE+author: Tomas Carnecky+maintainer: tomas.carnecky@gmail.com+category: Data+build-type: Simple+cabal-version: >=1.10++synopsis: app container types and tools+description:+ See https://github.com/appc/spec++library+ default-language: Haskell2010+ hs-source-dirs: src++ exposed-modules:+ Data.AppContainer.Types++ build-depends:+ base >=4.6 && <4.8,+ aeson,+ containers,+ semver,+ uuid,+ text+++executable appc+ default-language: Haskell2010+ hs-source-dirs: src++ main-is: Main.hs++ build-depends:+ base >=4.6 && <4.8,+ aeson,+ bytestring,+ containers,+ optparse-applicative,+ semver,+ uuid,+ text++ ghc-options: -Wall+++test-suite spec+ default-language: Haskell2010+ hs-source-dirs: test++ main-is: Test.hs+ type: exitcode-stdio-1.0++ build-depends:+ base >=4.6 && <4.8,+ hspec,+ smallcheck,+ hspec-smallcheck,+ appc,+ text,+ semver,+ uuid,+ aeson
+ src/Data/AppContainer/Types.hs view
@@ -0,0 +1,210 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RecordWildCards #-}++module Data.AppContainer.Types+ ( ImageManifest(..)+ , ContainerRuntimeManifest(..)+ , Image(..)+ , App(..)+ , Label(..)+ ) where+++import Control.Applicative+import Control.Monad++import Data.Text (Text)+import qualified Data.Text as T++import Data.Map (Map)+import qualified Data.Map as M++import Data.SemVer+import Data.UUID++import Data.Aeson+import Data.Aeson.Types+import Data.AppContainer.TH++++------------------------------------------------------------------------------+-- ImageManifest++data ImageManifest = ImageManifest+ { imName :: !Text+ , imVersion :: !Version+ , imLabels :: ![Label]+ , imApp :: !(Maybe App)+ , imDependencies :: ![Dependency]++ -- , crmAnnotations+ } deriving (Show, Eq)++imageManifestKind :: Text+imageManifestKind = "ImageManifest"++++instance FromJSON ImageManifest where+ parseJSON (Object o) = do+ acKind <- o .: "acKind"+ guard $ acKind == imageManifestKind++ ImageManifest+ <$> o .: "name"+ <*> (o .: "acVersion" >>= parseVersion)+ <*> o .:? "labels" .!= []+ <*> o .:? "app"+ <*> o .:? "dependencies" .!= []++ parseJSON _ = fail "ImageManifest"++instance ToJSON ImageManifest where+ toJSON ImageManifest{..} = object+ [ "acKind" .= imageManifestKind+ , "acVersion" .= toText imVersion+ , "name" .= imName+ , "labels" .= imLabels+ , "dependencies" .= imDependencies+ ]++++------------------------------------------------------------------------------+-- ContainerRuntimeManifest++data ContainerRuntimeManifest = ContainerRuntimeManifest+ { crmUUID :: !UUID+ , crmVersion :: !Version+ , crmImages :: ![Image]+ , crmVolumes :: ![Volume]++ -- , crmIsolators+ -- , crmAnnotations+ } deriving (Show, Eq)++containerRuntimeManifestKind :: Text+containerRuntimeManifestKind = "ContainerRuntimeManifest"+++instance FromJSON ContainerRuntimeManifest where+ parseJSON (Object o) = do+ acKind <- o .: "acKind"+ guard $ acKind == containerRuntimeManifestKind++ ContainerRuntimeManifest+ <$> o .: "uuid"+ <*> (o .: "acVersion" >>= parseVersion)+ <*> o .: "apps"+ <*> o .:? "volumes" .!= []++ parseJSON _ = fail "ContainerRuntimeManifest"++instance ToJSON ContainerRuntimeManifest where+ toJSON ContainerRuntimeManifest{..} = object+ [ "acKind" .= containerRuntimeManifestKind+ , "acVersion" .= toText crmVersion+ , "uuid" .= crmUUID+ , "apps" .= crmImages+ , "volumes" .= crmVolumes+ ]++data Label = Label+ { labelName :: !Text+ , labelVal :: !Text+ } deriving (Show, Eq)++data Image = Image+ { imageApp :: !Text+ , imageImageID :: !Text++ -- , imageIsolators+ -- , imageAnnotations+ } deriving (Show, Eq)++data App = App+ { appExec :: ![Text]+ , appUser :: !Text+ , appGroup :: !Text+ , appEventHandlers :: ![EventHandler]+ , appEnvironment :: !(Map Text Text)+ , appMountPoints :: ![MountPoint]+ , appPorts :: ![Port]+ } deriving (Show, Eq)++instance FromJSON App where+ parseJSON (Object o) = App+ <$> o .: "exec"+ <*> o .: "user"+ <*> o .: "group"+ <*> o .:? "eventHandlers" .!= []+ <*> o .:? "environment" .!= M.empty+ <*> o .:? "mountPoints" .!= []+ <*> o .:? "ports" .!= []++ parseJSON _ = fail "App"++data EventHandler = EventHandler+ { ehName :: !Text+ , ehExec :: ![Text]+ } deriving (Show, Eq)++data MountPoint = MountPoint+ { mpName :: !Text+ , mpPath :: !Text+ , mpReadOnly :: !Bool+ } deriving (Show, Eq)++data Volume = Volume+ { volKind :: !Text+ } deriving (Show, Eq)++data Port = Port+ { portName :: !Text+ , portProtocol :: !Text+ , portPort :: !Int+ , portSocketActivated :: !Bool+ } deriving (Show, Eq)++instance FromJSON Port where+ parseJSON (Object o) = Port+ <$> o .: "name"+ <*> o .: "protocol"+ <*> o .: "port"+ <*> o .:? "socketActivated" .!= False++ parseJSON _ = fail "Port"++data Dependency = Dependency+ { depName :: !Text+ , depLabels :: ![Label]+ , depHash :: !Text+ , depRoot :: !Text+ } deriving (Show, Eq)+++parseVersion :: Text -> Parser Version+parseVersion text = case fromText text of+ Left e -> fail e+ Right v -> pure v+++instance ToJSON UUID where+ toJSON = toJSON . Data.UUID.toString++instance FromJSON UUID where+ parseJSON x = parseJSON x >>= \str -> case Data.UUID.fromString str of+ Nothing -> fail "UUID"+ Just uuid -> pure uuid+++$(deriveToJSON (deriveJSONOptions "app") ''App)+$(deriveJSON (deriveJSONOptions "dep") ''Dependency)+$(deriveJSON (deriveJSONOptions "eh") ''EventHandler)+$(deriveJSON (deriveJSONOptions "label") ''Label)+$(deriveJSON (deriveJSONOptions "mp") ''MountPoint)+$(deriveJSON (deriveJSONOptions "vol") ''Volume)+$(deriveToJSON (deriveJSONOptions "port") ''Port)+$(deriveJSON (deriveJSONOptions "image") ''Image)
+ src/Main.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE RecordWildCards #-}++module Main where+++import Data.Aeson+import qualified Data.ByteString.Lazy as LBS+import Data.SemVer+import Data.Monoid+import Options.Applicative+import System.Exit++import Data.AppContainer+import Data.AppContainer.Types++++main :: IO ()+main = run =<< execParser+ (parseOptions `withInfo` "AppContainer tool")+++run :: Options -> IO ()+run (Options (VerifyImageManifest path)) = do+ ok <- verifyImageManifest path+ if ok+ then exitSuccess+ else exitFailure+++run (Options (VerifyContainerRuntimeManifest path)) = do+ ok <- verifyContainerRuntimeManifest path+ if ok+ then exitSuccess+ else exitFailure+++run (Options (BuildImage path output)) = do+ buildImage path output+++data Command+ = VerifyImageManifest !String+ | VerifyContainerRuntimeManifest !String+ | BuildImage !String !String++data Options = Options !Command++parseOptions :: Parser Options+parseOptions = Options <$> parseCommand++parseCommand :: Parser Command+parseCommand = subparser $ mconcat+ [ command "verify-image-manifest"+ (parseVerifyImageManifest `withInfo` "Verify an image manifest")+ , command "verify-container-runtime-manifest"+ (parseVerifyContainerRuntimeManifest `withInfo` "Verify a container runtime manifest")+ , command "build-image"+ (parseBuildImage `withInfo` "Build an image")+ ]++parseVerifyImageManifest :: Parser Command+parseVerifyImageManifest = VerifyImageManifest+ <$> argument str (metavar "PATH")++parseVerifyContainerRuntimeManifest :: Parser Command+parseVerifyContainerRuntimeManifest = VerifyContainerRuntimeManifest+ <$> argument str (metavar "PATH")++parseBuildImage :: Parser Command+parseBuildImage = BuildImage+ <$> argument str (metavar "PATH")+ <*> argument str (metavar "OUTPUT")++withInfo :: Parser a -> String -> ParserInfo a+withInfo opts desc = info (helper <*> opts) $ progDesc desc
+ test/Test.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import Control.Applicative++import Test.Hspec+import Test.SmallCheck+import Test.SmallCheck.Series+import Test.Hspec.SmallCheck++import Data.Monoid ((<>))+import Data.Function+import Data.List+import Data.Aeson+import Data.Text (Text)+import Data.Text as T+import Data.SemVer+import Data.UUID++import GHC.Word++import Data.AppContainer.Types+++instance Monad m => Serial m Word32 where+ series = decDepth $ fromIntegral <$> (series :: Series m Int)++instance Monad m => Serial m UUID where+ series = decDepth $ fromWords+ <$> series+ <*> series+ <*> series+ <*> series++instance Monad m => Serial m Text where+ series = decDepth $ T.pack+ <$> series++instance Monad m => Serial m Version where+ series = decDepth $ version+ <$> fmap getPositive series+ <*> fmap getPositive series+ <*> fmap getPositive series+ <*> pure []+ <*> pure []++instance Monad m => Serial m Label where+ series = decDepth $ Label+ <$> series <*> series++instance Monad m => Serial m ImageManifest where+ series = decDepth $ ImageManifest+ <$> series <*> series <*> series <*> pure Nothing <*> pure []++instance Monad m => Serial m ContainerRuntimeManifest where+ series = decDepth $ ContainerRuntimeManifest+ <$> series+ <*> series+ <*> pure []+ <*> pure []++++main :: IO ()+main = do+ hspec spec+++spec :: Spec+spec = do++ describe "ImageManifest" $ do+ it "x ≡ fromJSON (toJSON x)" $ property $ \(im :: ImageManifest) ->+ Success im == fromJSON (toJSON im)+++ describe "ContainerRuntimeManifest" $ do+ it "x ≡ fromJSON (toJSON x)" $ property $ \(im :: ContainerRuntimeManifest) ->+ Success im == fromJSON (toJSON im)