packages feed

keystore 0.2.0.0 → 0.2.0.1

raw patch · 5 files changed

+473/−2 lines, 5 files

Files

+ examples/deploy/Deploy/Command.hs view
@@ -0,0 +1,190 @@+{-# LANGUAGE OverloadedStrings          #-}++module Deploy.Command+    ( CLI(..)+    , Command(..)+    , parseCLI+    ) where++import           Deploy.HostSectionKey+import           Data.KeyStore+import           Data.Monoid+import           Options.Applicative+import           System.Environment+++data CLI =+    CLI+        { cli_params    :: CtxParams+        , cli_command   :: Command+        }+    deriving (Show)++data Command+    = Create+    | Rotate        (Maybe HostID)  (Maybe SectionID)  (Maybe KeyID)+    | Deploy        (Maybe FilePath) HostID+    | Sign+    | Verify+    | InfoKey       (Maybe KeyID    )+    | InfoSection   (Maybe SectionID)+    | SecretScript+    | PublicScript+    | SampleScript+    | KS            [String]+    deriving (Show)++parseCLI :: IO CLI+parseCLI = do+  args <- getArgs+  case span is_flg args of+    (flgs,"ks":args') -> return $ CLI defaultCtxParams $ KS $ flgs++args'+    _                 -> parseCLI' args++parseCLI' :: [String] -> IO CLI+parseCLI' = runParse cliInfo++cliInfo :: ParserInfo CLI+cliInfo =+    h_info p_cli $+        fullDesc   <>+        progDesc "For carrying out deployments from the keystore."++p_cli :: Parser CLI+p_cli = CLI <$> paramsParser <*> p_command++p_command :: Parser Command+p_command =+    subparser+     $  command "create"                    pi_create+     <> command "rotate"                    pi_rotate_key+     <> command "deploy"                    pi_deploy+     <> command "sign"                      pi_sign+     <> command "verify"                    pi_verify+     <> command "info-key"                  pi_info_key+     <> command "info-section"              pi_info_section+     <> command "secret-script"             pi_secret_script+     <> command "public-script"             pi_public_script+     <> command "sample-script"             pi_sample_script+     <> command "ks"                        pi_ks_args++pi_create :: ParserInfo Command+pi_create =+    h_info+        (helper <*> (pure Create))+        (progDesc "create a new keystore")++pi_rotate_key :: ParserInfo Command+pi_rotate_key =+    h_info+        (helper <*>+            (Rotate+                <$> optional p_host+                <*> optional p_section+                <*> optional p_key))+        (progDesc "rotate a key")++pi_deploy :: ParserInfo Command+pi_deploy =+    h_info+        (helper <*> (Deploy <$> optional p_out <*> p_host_arg))+        (progDesc $ "deploy a configuration file for s host " +++                        "(here merely generating the JSON configuration file)")++pi_sign :: ParserInfo Command+pi_sign =+    h_info+        (helper <*> (pure Sign))+        (progDesc "sign the keystore")++pi_verify :: ParserInfo Command+pi_verify =+    h_info+        (helper <*> (pure Verify))+        (progDesc "verify the keystore")++pi_info_key :: ParserInfo Command+pi_info_key =+    h_info+        (helper <*> (InfoKey <$> optional p_key))+        (progDesc "get the gen on the keystore keys")++pi_info_section :: ParserInfo Command+pi_info_section =+    h_info+        (helper <*> (InfoSection <$> optional p_section))+        (progDesc "get the gen on the keystore sections")++pi_secret_script :: ParserInfo Command+pi_secret_script =+    h_info+        (helper <*> (pure SecretScript))+        (progDesc $ "print a script to establish the all section passwords in the environment")++pi_public_script :: ParserInfo Command+pi_public_script =+    h_info+        (helper <*> (pure PublicScript))+        (progDesc "print a script to save the public signing key in a file")++pi_sample_script :: ParserInfo Command+pi_sample_script =+    h_info+        (helper <*> (pure SampleScript))+        (progDesc "print a sample script to define keystore passwords in the environment")++pi_ks_args :: ParserInfo Command+pi_ks_args =+    h_info+        (helper <*> (KS <$> many p_ks_arg))+        (progDesc "run a ks command (see 'ks --help' for details)")++p_host_arg :: Parser HostID+p_host_arg =+    argument decode+        $  metavar "HOST"+        <> help    "a host ID"++p_host :: Parser HostID+p_host =+    nullOption+        $  long "host"+        <> metavar "HOST"+        <> reader (maybe (fail "host not recognised") return . decode)+        <> help    "a host ID"++p_section :: Parser SectionID+p_section =+    nullOption+        $  long "section"+        <> metavar "SECTION"+        <> reader (maybe (fail "section not recognised") return . decode)+        <> help "a section ID"++p_key :: Parser KeyID+p_key =+    nullOption+        $  long "key"+        <> metavar "KEY"+        <> reader (maybe (fail "key not recognised") return . decode)+        <> help "a key ID"++p_out :: Parser FilePath+p_out =+    strOption+        $  long "out"+        <> metavar "FILE"+        <> help "output file"++p_ks_arg :: Parser String+p_ks_arg =+    argument Just+        $  metavar  "KS-ARG"+        <> help     "a ks command argument"++h_info :: Parser a -> InfoMod a -> ParserInfo a+h_info pr = info (helper <*> pr)++is_flg :: String -> Bool+is_flg ('-':_) = True+is_flg _       = False
+ examples/deploy/Deploy/Deploy.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE BangPatterns               #-}+{-# LANGUAGE RecordWildCards            #-}++module Deploy.Deploy+    ( deploy+    ) where++import           Deploy.HostSectionKey+import           Data.KeyStore+import qualified Data.ByteString.Lazy.Char8     as LBS+import qualified Data.Text                    as T+import qualified Data.Aeson                   as A+import qualified Data.HashMap.Strict          as HM+import           Control.Applicative+++deploy :: IC -> HostID -> IO LBS.ByteString+deploy ic h = A.encode . A.Object . HM.fromList <$> mapM (extract ic h)+                    [ k | k<-[minBound..maxBound],+                                  maybe True ($ h) $ keyIsHostIndexed k ]++extract :: IC -> HostID -> KeyID -> IO (T.Text,A.Value)+extract ic h k = mk <$> locate ic h k+  where+    mk key = (T.pack $ encode k,gen key)++    gen key =+      case k of+        K_admin_init_pw -> hash       k key+        K_super_api     -> hash       k key+        K_api           -> hash       k key+        K_cloudfront    -> clear_text k key+        K_s3            -> clear_text k key+        K_mail          -> clear_text k key+        K_logger        -> clear_text k key+        K_ssl           -> clear_text k key++hash :: KeyID -> Key -> A.Value+hash k Key{..} = chk $ A.Object $ HM.fromList+    [ (,) "name"     $ A.toJSON _key_name+    , (,) "identity" $ A.toJSON _key_identity+    , (,) "comment"  $ A.toJSON _key_comment+    , (,) "hash"     $ A.toJSON _key_hash+    ]+  where+    chk r = maybe oops (const r) $ _key_hash++    oops  = error $ encode k ++ ": hash not present"++clear_text :: KeyID -> Key -> A.Value+clear_text k Key{..} = chk $ A.Object $ HM.fromList+    [ (,) "name"       $ A.toJSON _key_name+    , (,) "identity"   $ A.toJSON _key_identity+    , (,) "comment"    $ A.toJSON _key_comment+    , (,) "clear_text" $ A.toJSON _key_clear_text+    ]+  where+    chk r = maybe oops (const r) $ _key_clear_text++    oops  = error $ encode k ++ ": secret not loaded"++locate :: IC -> HostID -> KeyID -> IO Key+locate ic h k = retrieve ic h k >>= \ei -> check ei >>= tst+  where+    check ei = return $ either oops id ei+      where+        oops RDG_key_not_reachable = error $ encode k ++ ": key not available from this section"+        oops RDG_no_such_host_key  = error $ encode k ++ ": host-indexed key not available"++    tst []      = error $ encode k ++ ": key not present in the this section"+    tst (key:_) = return key
+ examples/deploy/Deploy/HostSectionKey.hs view
@@ -0,0 +1,204 @@+{-# LANGUAGE QuasiQuotes                #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE MultiParamTypeClasses      #-}++module Deploy.HostSectionKey+  ( HostID(..)+  , SectionID(..)+  , KeyID(..)+  , sections+  ) where++import           Data.KeyStore+import qualified Data.Text                      as T+import qualified Data.ByteString.Char8          as B+import qualified Data.ByteString.Lazy.Char8     as LBS+import qualified Text.RawString.QQ              as RS+import           Control.Monad.RWS.Strict+import           Text.Printf+++data HostID+    = H_live_eu+    | H_staging_eu+    | H_live_us+    | H_staging_us+    | H_dev+  deriving (Show, Ord, Eq, Bounded, Enum)++data SectionID+  = S_top+  | S_signing+  | S_eu_admin+  | S_eu_deploy+  | S_eu_staging+  | S_us_admin+  | S_us_deploy+  | S_us_staging+  | S_dev+  deriving (Show, Ord, Eq, Bounded, Enum)++dev, staging, deploy, admin :: SectionID -> Bool+dev     = (`elem` [S_dev                    ] )+staging = (`elem` [S_eu_staging,S_us_staging] )+deploy  = (`elem` [S_eu_deploy ,S_us_deploy ] )+admin   = (`elem` [S_eu_admin  ,S_us_admin  ] )++data KeyID+  = K_admin_init_pw+  | K_super_api+  | K_api+  | K_cloudfront+  | K_s3+  | K_mail+  | K_logger+  | K_ssl+    deriving (Show,Eq,Ord,Bounded,Enum)++instance Code HostID where+  encode = drop 2 . show++instance Code SectionID where+  encode = drop 2 . show++instance Code KeyID where+  encode = drop 2 . show++instance Sections HostID SectionID KeyID where+  hostSection      = host_section+  sectionType      = section_type+  superSections    = super_sections+  keyIsHostIndexed = key_is_host_indexed+  keyIsInSection   = key_is_in_section+  getKeyData       = get_key_data+  sectionSettings  = section_settings+  describeKey      = describe_key+  describeSection  = describe_section++sections :: SECTIONS HostID SectionID KeyID+sections = SECTIONS++host_section :: HostID -> SectionID+host_section h =+  case h of+    H_live_eu    -> S_eu_deploy+    H_staging_eu -> S_eu_staging+    H_live_us    -> S_us_deploy+    H_staging_us -> S_us_staging+    H_dev        -> S_dev++section_type :: SectionID -> SectionType+section_type s =+  case s of+    S_top     -> ST_top+    S_signing -> ST_signing+    _         -> ST_keys++super_sections :: SectionID -> [SectionID]+super_sections s =+  case s of+    S_top        -> [                         ]+    S_signing    -> [S_top                    ]+    S_eu_admin   -> [S_top                    ]+    S_eu_deploy  -> [S_eu_admin               ]+    S_eu_staging -> [S_eu_deploy              ]+    S_us_admin   -> [S_top                    ]+    S_us_deploy  -> [S_us_admin               ]+    S_us_staging -> [S_us_deploy              ]+    S_dev        -> [S_eu_staging,S_us_staging]++key_is_host_indexed :: KeyID -> Maybe (HostID->Bool)+key_is_host_indexed k =+  case k of+    K_ssl -> Just is_ssl+    _     -> Nothing++key_is_in_section :: KeyID -> SectionID -> Bool+key_is_in_section k =+  case k of+    K_admin_init_pw -> f [dev,staging       ,admin]+    K_super_api     -> f [dev,staging       ,admin]+    K_api           -> f [dev,staging,deploy      ]+    K_cloudfront    -> f [dev        ,deploy      ]+    K_s3            -> f [dev,staging,deploy      ]+    K_mail          -> f [dev        ,deploy      ]+    K_logger        -> f [dev                     ]+    K_ssl           -> f [dev,staging,deploy      ]+  where+    f = foldr (\p p' s->p s || p' s) (const False)++generation :: String+generation = "first"++get_key_data :: Maybe HostID -> SectionID -> KeyID -> IO KeyData+get_key_data mb_h s k =+  return+    KeyData+      { kd_identity = Identity $ T.pack $ mk "id"+      , kd_comment  = Comment  $ T.pack $ mk "id"+      , kd_secret   =            B.pack $ mk "secret"+      }+  where+    mk tag =+      printf "%s:%s-%s-%s:%s"+        (tag::String          )+        (maybe "*" encode mb_h)+        (encode s             )+        (encode k             )+        generation++section_settings :: Maybe SectionID -> IO Settings+section_settings Nothing  = e2io $ settingsFromBytes ourSettings+section_settings (Just _) = return mempty++ourSettings :: LBS.ByteString+ourSettings = [RS.r|+{ "debug.enabled"    : true+, "verify.enabled"   : true+, "hash.comment"     : "pbkdf_sha512_20000_64"+, "hash.prf"         : "sha512"+, "hash.iterations"  : 1+, "hash.width_octets": 64+, "hash.salt_octets" : 16+, "crypt.cipher"     : "aes256"+, "crypt.prf"        : "sha512"+, "crypt.iterations" : 1+, "crypt.salt_octets": 16+}+|]++describe_key :: KeyID -> String+describe_key k =+  case k of+    K_admin_init_pw -> "the starting password for the administrator"+    K_super_api     -> "the 'super_api' key will authenticate any request"+    K_api           -> "the api key is needed to make requests when the client has not credentials (e.g., to login)"+    K_cloudfront    -> "the AWS CloudFront signing key"+    K_s3            -> "the AWS S3 access key"+    K_mail          -> "the sendmail access key"+    K_logger        -> "the access key for the logging service"+    K_ssl           -> "the SSL Host key and certificate"++describe_section :: SectionID -> String+describe_section s =+  case s of+    S_top        -> "the top section has access to all keys"+    S_signing    -> "just contains the keystore signing key"+    S_eu_admin   -> "contains adminsitrative keys for the 'eu' live server not required for deployment"+                                                                            ++ "(e.g., the 'super_api' key)"+    S_eu_deploy  -> "has access to all of the keys needed for the 'eu' live server deployment"+    S_eu_staging -> "has access to all of the keys needed for the 'eu' staging server deployment"+    S_us_admin   -> "contains adminsitrative keys for the 'us' live server not required for deployment"+                                                                            ++ "(e.g., the 'super_api' key)"+    S_us_deploy  -> "has access to all of the keys needed for the 'us' live server deployment"+    S_us_staging -> "has access to all of the keys needed for the 'us' staging server deployment"+    S_dev        -> "contains all of the keys needed to deploy a development server"++is_ssl :: HostID -> Bool+is_ssl h =+  case h of+    H_live_eu    -> True+    H_staging_eu -> True+    H_live_us    -> True+    H_staging_us -> True+    H_dev        -> False
keystore.cabal view
@@ -1,5 +1,5 @@ Name:                   keystore-Version:                0.2.0.0+Version:                0.2.0.1 Synopsis:               Managing stores of secret things Homepage:               http://github.com/cdornan/keystore Author:                 Chris Dornan@@ -112,6 +112,11 @@     Main-is: deploy.hs      Default-Language:   Haskell2010++    Other-modules:+        Deploy.Command+        Deploy.Deploy+        Deploy.HostSectionKey      Build-depends:         aeson                  >= 0.6.2             ,
src/Data/KeyStore/CLI.hs view
@@ -18,7 +18,7 @@   version :: String-version = "0.2.0.0"+version = "0.2.0.1"  cli :: IO () cli = parseCLI >>= command Nothing