keystore 0.8.0.2 → 0.8.1.0
raw patch · 19 files changed
+421/−183 lines, 19 filesdep +regexdep ~aesondep ~api-toolsdep ~base
Dependencies added: regex
Dependency ranges changed: aeson, api-tools, base, optparse-applicative, text, time
Files
- examples/deploy/Deploy/Deploy.hs +0/−1
- examples/deploy/Deploy/HostSectionKey.hs +0/−1
- keystore.cabal +12/−10
- src/Data/KeyStore/IO.hs +1/−2
- src/Data/KeyStore/IO/IC.hs +0/−1
- src/Data/KeyStore/KS.hs +0/−1
- src/Data/KeyStore/KS/CPRNG.hs +0/−1
- src/Data/KeyStore/KS/Configuration.hs +0/−1
- src/Data/KeyStore/KS/Crypto.hs +0/−1
- src/Data/KeyStore/KS/KS.hs +0/−1
- src/Data/KeyStore/KS/Opt.hs +0/−1
- src/Data/KeyStore/KS/Packet.hs +0/−1
- src/Data/KeyStore/PasswordManager.hs +2/−2
- src/Data/KeyStore/Types.hs +176/−76
- src/Data/KeyStore/Types/NameAndSafeguard.hs +3/−2
- src/Data/KeyStore/Types/PasswordStoreModel.hs +101/−29
- src/Data/KeyStore/Types/PasswordStoreSchema.hs +34/−16
- src/Data/KeyStore/Types/Schema.hs +49/−36
- src/Data/KeyStore/Types/UTC.hs +43/−0
examples/deploy/Deploy/Deploy.hs view
@@ -12,7 +12,6 @@ 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
examples/deploy/Deploy/HostSectionKey.hs view
@@ -14,7 +14,6 @@ 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
keystore.cabal view
@@ -1,5 +1,5 @@ Name: keystore-Version: 0.8.0.2+Version: 0.8.1.0 Synopsis: Managing stores of secret things Homepage: http://github.com/cdornan/keystore Author: Chris Dornan@@ -164,18 +164,19 @@ Data.KeyStore.Types.PasswordStoreModel Data.KeyStore.Types.PasswordStoreSchema Data.KeyStore.Types.Schema+ Data.KeyStore.Types.UTC Data.KeyStore.Version Build-depends:- api-tools >= 0.4 ,+ api-tools >= 0.5.2 , asn1-types >= 0.2.0 , asn1-encoding >= 0.8.0 , ansi-wl-pprint >= 0.6.7 , crypto-pubkey >= 0.2.1 , crypto-random >= 0.0.7 ,- aeson >= 0.6.2 ,+ aeson >= 0.8 , aeson-pretty >= 0.7 ,- base >= 4 ,+ base >= 4.8 , base64-bytestring >= 1.0 , byteable >= 0.1 , bytestring >= 0.9 ,@@ -186,13 +187,14 @@ lens >= 3.9.2 , mtl >= 2 , old-locale >= 1.0.0.5 ,- optparse-applicative >= 0.11.0 && <0.14 ,+ optparse-applicative >= 0.11.0 , pbkdf >= 1.1.1.0 ,+ regex >= 1.0.1.3 , regex-compat-tdfa >= 0.95.1 , safe >= 0.3.3 , setenv >= 0.1 , text >= 0.11.3 ,- time >= 1.4 ,+ time >= 1.5 , unordered-containers >= 0.2.3.0 , vector >= 0.10.0.1 @@ -231,18 +233,18 @@ Build-depends: api-tools >= 0.4 , ansi-wl-pprint >= 0.6.7.1 ,- aeson >= 0.6.2 ,- base > 4 && < 5 ,+ aeson >= 0.8 ,+ base >= 4.8 , bytestring >= 0.9 , directory >= 1.0 , filepath >= 1.1 , keystore , mtl >= 2 ,- optparse-applicative >= 0.9.0 ,+ optparse-applicative >= 0.11.0 , process >= 1.2.0.0 , raw-strings-qq >= 1.0.2 , setenv >= 0.1 ,- text >= 0.11 ,+ text >= 0.11.3 , unordered-containers >= 0.2.3.0 GHC-Options:
src/Data/KeyStore/IO.hs view
@@ -83,7 +83,6 @@ import qualified Data.Map as Map import Data.Time import Text.Printf-import Control.Applicative import qualified Control.Exception as X import qualified Control.Lens as L import Control.Monad@@ -395,7 +394,7 @@ putCtxState IC{..} ctx st = do maybe (return ()) (flip writeIORef (ctx,st)) ic_cache when (not $ maybe False id $ cp_readonly ic_ctx_params) $- LBS.writeFile (ctx_store ctx) $ keyStoreBytes $ st_keystore st+ LBS.writeFile (ctx_store ctx) $ keyStoreBytes $ st_keystore st report :: String -> IO () report = hPutStrLn stderr
src/Data/KeyStore/IO/IC.hs view
@@ -31,7 +31,6 @@ import Data.Time import Data.IORef import qualified Control.Exception as X-import Control.Applicative import System.Environment import System.Directory import System.FilePath
src/Data/KeyStore/KS.hs view
@@ -48,7 +48,6 @@ import Data.List import Data.Time import Text.Printf-import Control.Applicative import qualified Control.Lens as L import Control.Monad
src/Data/KeyStore/KS/CPRNG.hs view
@@ -9,7 +9,6 @@ ) where import Crypto.Random-import Control.Applicative import qualified Data.ByteString as B
src/Data/KeyStore/KS/Configuration.hs view
@@ -3,7 +3,6 @@ module Data.KeyStore.KS.Configuration where import Data.KeyStore.Types-import Data.Monoid import qualified Data.Map as Map import Data.Maybe import Text.Regex
src/Data/KeyStore/KS/Crypto.hs view
@@ -55,7 +55,6 @@ import qualified Data.ASN1.Types as A import qualified Data.ByteString.Lazy.Char8 as LBS import qualified Data.ByteString.Char8 as B-import Control.Applicative import Crypto.PubKey.RSA import qualified Crypto.PubKey.RSA.OAEP as OAEP import qualified Crypto.PubKey.RSA.PSS as PSS
src/Data/KeyStore/KS/KS.hs view
@@ -44,7 +44,6 @@ import qualified Data.ByteString as B import Data.Typeable import Data.Time-import Control.Applicative import Control.Monad.RWS.Strict import qualified Control.Monad.Error as E import Control.Exception
src/Data/KeyStore/KS/Opt.hs view
@@ -41,7 +41,6 @@ import Data.Maybe import Data.Char import Text.Printf-import Control.Applicative data Opt a
src/Data/KeyStore/KS/Packet.hs view
@@ -21,7 +21,6 @@ import Data.Bits import Data.Char import Text.Printf-import Control.Applicative import Control.Monad.RWS.Strict import qualified Control.Monad.Error as E
src/Data/KeyStore/PasswordManager.hs view
@@ -346,7 +346,7 @@ { _ssn_name = _sd_name , _ssn_password = pwt , _ssn_isOneShot = ios- , _ssn_setup = now+ , _ssn_setup = UTC now } ios = _sd_isOneShot@@ -579,7 +579,7 @@ pn_s = T.unpack $ _PasswordName _pw_name sn_s = T.unpack $ _SessionName _ssn_name p_c = if _ssn_isOneShot then prime_char False else ' '- su_s = pretty_setup tz _ssn_setup+ su_s = pretty_setup tz $ _UTC _ssn_setup a_s = if active_session trp then "[ACTIVE]" else "" :: String sgl = length [ () | p<-[minBound..maxBound], isJust $ isSession $ cast_pmc pmc p ] == 1
src/Data/KeyStore/Types.hs view
@@ -30,31 +30,32 @@ ( module Data.KeyStore.Types , module Data.KeyStore.Types.NameAndSafeguard , module Data.KeyStore.Types.E+ , module Data.KeyStore.Types.UTC , PublicKey(..) , PrivateKey(..) ) where +import qualified Control.Lens as L+import qualified Crypto.PBKDF.ByteString as P+import Crypto.PubKey.RSA (PublicKey(..), PrivateKey(..)) import Data.KeyStore.Types.Schema import Data.KeyStore.Types.NameAndSafeguard import Data.KeyStore.Types.E+import Data.KeyStore.Types.UTC import Data.Aeson-import Data.Aeson.Encoding-import qualified Data.Map as Map-import Data.Monoid-import qualified Data.Text as T-import Data.List-import Data.Ord-import Data.String import Data.API.Tools-import Data.API.Types import Data.API.JSON+import Data.API.Types import qualified Data.ByteString as B import qualified Data.HashMap.Strict as HM+import Data.List+import qualified Data.Map as Map+import Data.Ord import qualified Data.Text as T+import Data.Time+import Data.String import qualified Data.Vector as V import Text.Regex-import qualified Crypto.PBKDF.ByteString as P-import Crypto.PubKey.RSA (PublicKey(..), PrivateKey(..)) $(generate keystoreSchema)@@ -103,15 +104,6 @@ prj_pattern = REP__Pattern . T.pack . _pat_string -type TriggerMap = Map.Map TriggerID Trigger--inj_trigger_map :: REP__TriggerMap -> ParserWithErrs TriggerMap-inj_trigger_map = map_from_list "TriggerMap" _tmp_map _trg_id _TriggerID--prj_trigger_map :: TriggerMap -> REP__TriggerMap-prj_trigger_map = REP__TriggerMap . Map.elems-- newtype Settings = Settings { _Settings :: Object } deriving (Eq,Show) @@ -146,43 +138,6 @@ marker = String "*** Collision * in * Settings ***" -type KeyMap = Map.Map Name Key--inj_keymap :: REP__KeyMap -> ParserWithErrs KeyMap-inj_keymap (REP__KeyMap as) =- return $ Map.fromList [ (_nka_name,_nka_key) | NameKeyAssoc{..}<-as ]--prj_keymap :: KeyMap -> REP__KeyMap-prj_keymap mp = REP__KeyMap [ NameKeyAssoc nme key | (nme,key)<-Map.toList mp ]--emptyKeyStore :: Configuration -> KeyStore-emptyKeyStore cfg =- KeyStore- { _ks_config = cfg- , _ks_keymap = emptyKeyMap- }--emptyKeyMap :: KeyMap-emptyKeyMap = Map.empty---type EncrypedCopyMap = Map.Map Safeguard EncrypedCopy--inj_encrypted_copy_map :: REP__EncrypedCopyMap -> ParserWithErrs EncrypedCopyMap-inj_encrypted_copy_map (REP__EncrypedCopyMap ecs) =- return $ Map.fromList [ (_ec_safeguard ec,ec) | ec<-ecs ]--prj_encrypted_copy_map :: EncrypedCopyMap -> REP__EncrypedCopyMap-prj_encrypted_copy_map mp = REP__EncrypedCopyMap [ ec | (_,ec)<-Map.toList mp ]--defaultConfiguration :: Settings -> Configuration-defaultConfiguration stgs =- Configuration- { _cfg_settings = stgs- , _cfg_triggers = Map.empty- }-- inj_safeguard :: REP__Safeguard -> ParserWithErrs Safeguard inj_safeguard = return . safeguard . _sg_names @@ -216,8 +171,6 @@ } -- inj_PrivateKey :: REP__PrivateKey -> ParserWithErrs PrivateKey inj_PrivateKey REP__PrivateKey{..} = return@@ -296,26 +249,173 @@ same b b' = comparing xf b b' == EQ -instance ToJSONKey Safeguard where- toJSONKey = ToJSONKeyText f g- where- f = T.pack . printSafeguard- g = text . T.pack . printSafeguard -instance ToJSONKey Name where- toJSONKey = ToJSONKeyText f g- where- f = T.pack . _name- g = text . T.pack . _name--instance ToJSONKey TriggerID where- toJSONKey = ToJSONKeyText f g- where- f = _TriggerID- g = text . _TriggerID- $(generateAPITools keystoreSchema [ enumTool- , jsonTool+ , jsonTool' , lensTool ])+++instance ToJSON KeyStore where+ toJSON = toJSON . toKeyStore_++instance FromJSON KeyStore where+ parseJSON = fmap fromKeyStore_ . parseJSON++instance FromJSONWithErrs KeyStore where+ parseJSONWithErrs = fmap fromKeyStore_ . parseJSONWithErrs+++data KeyStore =+ KeyStore+ { _ks_config :: Configuration+ , _ks_keymap :: KeyMap+ }+ deriving (Show,Eq)++toKeyStore_ :: KeyStore -> KeyStore_+toKeyStore_ KeyStore{..} =+ KeyStore_+ { _z_ks_config = toConfiguration_ _ks_config+ , _z_ks_keymap = toKeyMap_ _ks_keymap+ }++fromKeyStore_ :: KeyStore_ -> KeyStore+fromKeyStore_ KeyStore_{..} =+ KeyStore+ { _ks_config = fromConfiguration_ _z_ks_config+ , _ks_keymap = fromKeyMap_ _z_ks_keymap+ }++emptyKeyStore :: Configuration -> KeyStore+emptyKeyStore cfg =+ KeyStore+ { _ks_config = cfg+ , _ks_keymap = emptyKeyMap+ }+++data Configuration =+ Configuration+ { _cfg_settings :: Settings+ , _cfg_triggers :: TriggerMap+ }+ deriving (Show,Eq)++toConfiguration_ :: Configuration -> Configuration_+toConfiguration_ Configuration{..} =+ Configuration_+ { _z_cfg_settings = _cfg_settings+ , _z_cfg_triggers = toTriggerMap_ _cfg_triggers+ }++fromConfiguration_ :: Configuration_ -> Configuration+fromConfiguration_ Configuration_{..} =+ Configuration+ { _cfg_settings = _z_cfg_settings+ , _cfg_triggers = fromTriggerMap_ _z_cfg_triggers+ }++defaultConfiguration :: Settings -> Configuration+defaultConfiguration stgs =+ Configuration+ { _cfg_settings = stgs+ , _cfg_triggers = Map.empty+ }+++type TriggerMap = Map.Map TriggerID Trigger++toTriggerMap_ :: TriggerMap -> TriggerMap_+toTriggerMap_ mp = TriggerMap_ $ Map.elems mp++fromTriggerMap_ :: TriggerMap_ -> TriggerMap+fromTriggerMap_ TriggerMap_{..} = Map.fromList+ [ (,) _trg_id trg+ | trg@Trigger{..} <- _z_tmp_map+ ]+++type KeyMap = Map.Map Name Key++toKeyMap_ :: KeyMap -> KeyMap_+toKeyMap_ mp = KeyMap_ $+ [ NameKeyAssoc_ nm $ toKey_ ky+ | (nm,ky) <- Map.assocs mp+ ]++fromKeyMap_ :: KeyMap_ -> KeyMap+fromKeyMap_ mp_ = Map.fromList+ [ (_z_nka_name,fromKey_ _z_nka_key)+ | NameKeyAssoc_{..} <- _z_kmp_map mp_+ ]++emptyKeyMap :: KeyMap+emptyKeyMap = Map.empty+++data Key =+ Key+ { _key_name :: Name+ , _key_comment :: Comment+ , _key_identity :: Identity+ , _key_is_binary :: Bool+ , _key_env_var :: Maybe EnvVar+ , _key_hash :: Maybe Hash+ , _key_public :: Maybe PublicKey+ , _key_secret_copies :: EncrypedCopyMap+ , _key_clear_text :: Maybe ClearText+ , _key_clear_private :: Maybe PrivateKey+ , _key_created_at :: UTCTime+ }+ deriving (Show,Eq)++toKey_ :: Key -> Key_+toKey_ Key{..} =+ Key_+ { _z_key_name = _key_name+ , _z_key_comment = _key_comment+ , _z_key_identity = _key_identity+ , _z_key_is_binary = _key_is_binary+ , _z_key_env_var = _key_env_var+ , _z_key_hash = _key_hash+ , _z_key_public = _key_public+ , _z_key_secret_copies = toEncrypedCopyMap _key_secret_copies+ , _z_key_clear_text = _key_clear_text+ , _z_key_clear_private = _key_clear_private+ , _z_key_created_at = UTC _key_created_at+ }++fromKey_ :: Key_ -> Key+fromKey_ Key_{..} =+ Key+ { _key_name = _z_key_name+ , _key_comment = _z_key_comment+ , _key_identity = _z_key_identity+ , _key_is_binary = _z_key_is_binary+ , _key_env_var = _z_key_env_var+ , _key_hash = _z_key_hash+ , _key_public = _z_key_public+ , _key_secret_copies = fromEncrypedCopyMap _z_key_secret_copies+ , _key_clear_text = _z_key_clear_text+ , _key_clear_private = _z_key_clear_private+ , _key_created_at = _UTC _z_key_created_at+ }+++type EncrypedCopyMap = Map.Map Safeguard EncrypedCopy++toEncrypedCopyMap :: EncrypedCopyMap -> EncrypedCopyMap_+toEncrypedCopyMap mp = EncrypedCopyMap_ $ Map.elems mp++fromEncrypedCopyMap :: EncrypedCopyMap_ -> EncrypedCopyMap+fromEncrypedCopyMap EncrypedCopyMap_{..} = Map.fromList+ [ (,) _ec_safeguard ec+ | ec@EncrypedCopy{..} <- _z_ecm_map+ ]+++L.makeLenses ''KeyStore+L.makeLenses ''Configuration+L.makeLenses ''Key
src/Data/KeyStore/Types/NameAndSafeguard.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-} module Data.KeyStore.Types.NameAndSafeguard ( Name@@ -13,15 +14,16 @@ ) where import Data.KeyStore.Types.E+import Data.Char import qualified Data.Set as Set import Data.String-import Data.Char import qualified Control.Exception as X newtype Name = Name { _Name :: String } deriving (Eq,Ord,IsString,Read,Show) + name :: String -> E Name name s = case all is_nm_char s of@@ -41,7 +43,6 @@ case parseSafeguard s of Left err -> X.throw err Right sg -> sg- safeguard :: [Name] -> Safeguard safeguard = Safeguard . Set.fromList
src/Data/KeyStore/Types/PasswordStoreModel.hs view
@@ -18,54 +18,126 @@ module Data.KeyStore.Types.PasswordStoreModel where -import Data.KeyStore.Types.PasswordStoreSchema+import qualified Control.Lens as L import Data.Aeson-import Data.Aeson.Encoding+import Data.API.JSON+import Data.KeyStore.Types.PasswordStoreSchema import qualified Data.Map as Map import Data.API.Tools-import Data.API.JSON+import Data.Time+import Data.KeyStore.Types.UTC $(generate passwordStoreSchema)+$(generateAPITools passwordStoreSchema+ [ enumTool+ , jsonTool'+ , lensTool+ ]) +instance ToJSON PasswordStore where+ toJSON = toJSON . toPasswordStore_++instance FromJSON PasswordStore where+ parseJSON = fmap fromPasswordStore_ . parseJSON++instance FromJSONWithErrs PasswordStore where+ parseJSONWithErrs = fmap fromPasswordStore_ . parseJSONWithErrs+++data PasswordStore =+ PasswordStore+ { _ps_comment :: PasswordStoreComment+ , _ps_map :: PasswordMap+ , _ps_setup :: UTCTime+ }+ deriving (Show,Eq)++toPasswordStore_ :: PasswordStore -> PasswordStore_+toPasswordStore_ PasswordStore{..} =+ PasswordStore_+ { _z_ps_comment = _ps_comment+ , _z_ps_map = toPasswordMap_ _ps_map+ , _z_ps_setup = UTC _ps_setup+ }++fromPasswordStore_ :: PasswordStore_ -> PasswordStore+fromPasswordStore_ PasswordStore_{..} =+ PasswordStore+ { _ps_comment = _z_ps_comment+ , _ps_map = fromPasswordMap_ _z_ps_map+ , _ps_setup = _UTC _z_ps_setup+ }++ -- The PasswordStre and SessionMap association lists are represented internally -- with maps. type PasswordMap = Map.Map PasswordName Password -inj_pwmap :: REP__PasswordMap -> ParserWithErrs PasswordMap-inj_pwmap (REP__PasswordMap as) =- return $ Map.fromList [ (_npa_name,_npa_password) | NamePasswordAssoc{..}<-as ]+toPasswordMap_ :: PasswordMap -> PasswordMap_+toPasswordMap_ mp = PasswordMap_ $+ [ NamePasswordAssoc_ nm $ toPassword_ pw+ | (nm,pw) <- Map.assocs mp+ ] -prj_pwmap :: PasswordMap -> REP__PasswordMap-prj_pwmap mp = REP__PasswordMap [ NamePasswordAssoc nme pwd | (nme,pwd)<-Map.toList mp ]+fromPasswordMap_ :: PasswordMap_ -> PasswordMap+fromPasswordMap_ mp_ = Map.fromList+ [ (_z_npa_name,fromPassword_ _z_npa_password)+ | NamePasswordAssoc_{..} <- _z_pm_map mp_+ ] -type SessionMap = Map.Map SessionName Session+data Password =+ Password+ { _pw_name :: PasswordName+ , _pw_text :: PasswordText+ , _pw_sessions :: SessionMap+ , _pw_isOneShot :: Bool+ , _pw_primed :: Bool+ , _pw_setup :: UTCTime+ }+ deriving (Show,Eq) -inj_snmap :: REP__SessionMap -> ParserWithErrs SessionMap-inj_snmap (REP__SessionMap as) =- return $ Map.fromList [ (_spa_name,_spa_session) | SessionPasswordAssoc{..}<-as ]+toPassword_ :: Password -> Password_+toPassword_ Password{..} =+ Password_+ { _z_pw_name = _pw_name+ , _z_pw_text = _pw_text+ , _z_pw_sessions = toSessionMap_ _pw_sessions+ , _z_pw_isOneShot = _pw_isOneShot+ , _z_pw_primed = _pw_primed+ , _z_pw_setup = UTC _pw_setup+ } -prj_snmap :: SessionMap -> REP__SessionMap-prj_snmap mp = REP__SessionMap [ SessionPasswordAssoc snm ssn | (snm,ssn)<-Map.toList mp ]+fromPassword_ :: Password_ -> Password+fromPassword_ Password_{..} =+ Password+ { _pw_name = _z_pw_name+ , _pw_text = _z_pw_text+ , _pw_sessions = fromSessionMap_ _z_pw_sessions+ , _pw_isOneShot = _z_pw_isOneShot+ , _pw_primed = _z_pw_primed+ , _pw_setup = _UTC _z_pw_setup+ } -instance ToJSONKey SessionName where- toJSONKey = ToJSONKeyText f g- where- f = _SessionName- g = text . _SessionName -instance ToJSONKey PasswordName where- toJSONKey = ToJSONKeyText f g- where- f = _PasswordName- g = text . _PasswordName+type SessionMap = Map.Map SessionName Session -$(generateAPITools passwordStoreSchema- [ enumTool- , jsonTool- , lensTool- ])+toSessionMap_ :: SessionMap -> SessionMap_+toSessionMap_ mp = SessionMap_ $+ [ SessionPasswordAssoc_ nm ssn+ | (nm,ssn) <- Map.assocs mp+ ]++fromSessionMap_ :: SessionMap_ -> SessionMap+fromSessionMap_ mp_ = Map.fromList+ [ (_z_spa_name,_z_spa_session)+ | SessionPasswordAssoc_{..} <- _z_smp_map mp_+ ]+++L.makeLenses ''PasswordStore+L.makeLenses ''Password
src/Data/KeyStore/Types/PasswordStoreSchema.hs view
@@ -30,54 +30,72 @@ passwordStoreChangelog :: APIChangelog (passwordStoreSchema, passwordStoreChangelog) = [apiWithChangelog| -ps :: PasswordStore+//+// External Representation Only+//++// The builtin support for map-like types introduced in Aeson 1.0 has broken+// the mechanism for representing Map in this schema. In order to minimise the+// disruption and preserve the existing schema representation we have renamed+// all of the types in the schema that contain Map types. In the model these+// types are reconstructed just as they would have been in previous KeyStore+// editions and mapping functions have been introduced to convert between the+// two representations. The PasswordStore gets read with this representation,+// matching the representation of past keystore packages and gets+// converted into the internal type representation (with the maps) that the+// rest of the keystore code base expects.++z_ps :: PasswordStore_ = record comment :: PasswordStoreComment- map :: PasswordMap- setup :: utc+ map :: PasswordMap_+ setup :: UTC -pm :: PasswordMap+z_pm :: PasswordMap_ // the password map, represented internally with a Map // from PasswordName to Password = record- map :: [NamePasswordAssoc]- with inj_pwmap, prj_pwmap+ map :: [NamePasswordAssoc_] -npa :: NamePasswordAssoc+z_npa :: NamePasswordAssoc_ = record name :: PasswordName- password :: Password+ password :: Password_ -pw :: Password+z_pw :: Password_ // passwords may be simple, or be a collection of 'sessions', // one of which is selected = record name :: PasswordName text :: PasswordText- sessions :: SessionMap+ sessions :: SessionMap_ isOneShot :: Bool primed :: boolean- setup :: utc+ setup :: UTC -smp :: SessionMap+z_smp :: SessionMap_ // collections of sessions are represented internally as a Map // from SessionName to PasswordText = record- map :: [SessionPasswordAssoc]- with inj_snmap, prj_snmap+ map :: [SessionPasswordAssoc_] -spa :: SessionPasswordAssoc+z_spa :: SessionPasswordAssoc_ = record name :: SessionName session :: Session ++//+// Classic Schema Definitions+//+ ssn :: Session // a session just consists of a password and the stup time = record name :: SessionName password :: PasswordText isOneShot :: Bool- setup :: utc+ setup :: UTC pwsc :: PasswordStoreComment // a short comment on the PasswordStore
src/Data/KeyStore/Types/Schema.hs view
@@ -29,49 +29,47 @@ keystoreSchema :: API keystoreChangelog :: APIChangelog (keystoreSchema, keystoreChangelog) = [apiWithChangelog|-ks :: KeyStore- // the keystore- = record- config :: Configuration- keymap :: KeyMap -cfg :: Configuration- = record- settings :: Settings- triggers :: TriggerMap+//+// External Representation Only+// -tmp :: TriggerMap- = record- map :: [Trigger]- with inj_trigger_map, prj_trigger_map+// The builtin support for map-like types introduced in Aeson 1.0 has broken+// the mechanism for representing Map in this schema. In order to minimise the+// disruption and preserve the existing schema representation we have renamed+// all of the types in the schema that contain Map types. In the model these+// types are reconstructed just as they would have been in previous KeyStore+// editions and mapping functions have been introduced to convert between the+// two representations. The KeyStore gets read with this representation,+// matching the representation of past keystore packages and gets converted+// into the internal type representation (with the maps) that the rest of the+// keystore code base expects. -trg :: Trigger+z_ks :: KeyStore_+ // the keystore = record- id :: TriggerID- pattern :: Pattern- settings :: Settings+ config :: Configuration_+ keymap :: KeyMap_ -stgs :: Settings+z_cfg :: Configuration_ = record- 'json' :: json- with inj_settings, prj_settings+ settings :: Settings+ triggers :: TriggerMap_ -tja :: TextJsonAssoc+z_tmp :: TriggerMap_ = record- id :: SettingID- key :: json+ map :: [Trigger] -kmp :: KeyMap+z_kmp :: KeyMap_ = record- map :: [NameKeyAssoc]- with inj_keymap, prj_keymap+ map :: [NameKeyAssoc_] -nka :: NameKeyAssoc+z_nka :: NameKeyAssoc_ = record name :: Name- key :: Key+ key :: Key_ -key :: Key+z_key :: Key_ = record name :: Name comment :: Comment@@ -80,11 +78,31 @@ env_var :: ? EnvVar hash :: ? Hash public :: ? PublicKey- secret_copies :: EncrypedCopyMap+ secret_copies :: EncrypedCopyMap_ clear_text :: ? ClearText clear_private :: ? PrivateKey- created_at :: utc+ created_at :: UTC +z_ecm :: EncrypedCopyMap_+ = record+ map :: [EncrypedCopy]+++//+// Classic Schema Definitions+//++trg :: Trigger+ = record+ id :: TriggerID+ pattern :: Pattern+ settings :: Settings++stgs :: Settings+ = record+ 'json' :: json+ with inj_settings, prj_settings+ hash :: Hash = record description :: HashDescription@@ -98,11 +116,6 @@ width_octets :: Octets salt_octets :: Octets salt :: Salt--ecm :: EncrypedCopyMap- = record- map :: [EncrypedCopy]- with inj_encrypted_copy_map, prj_encrypted_copy_map ec :: EncrypedCopy = record
+ src/Data/KeyStore/Types/UTC.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}++module Data.KeyStore.Types.UTC (UTC(..)) where++import Data.Aeson+import Data.API.JSON+import Data.Time+import Text.RE.Replace+import Text.RE.TDFA.String+++-- | package time has some variation in the formatting of second fractions+-- in %Q (http://hackage.haskell.org/package/time-1.8.0.2/changelog) so we+-- we will standardise on ".xxx"+newtype UTC = UTC { _UTC :: UTCTime }+ deriving (Eq,Show)+++instance ToJSON UTC where+ toJSON = toJSON . formatUTC++instance FromJSON UTC where+ parseJSON = fmap UTC . parseJSON++instance FromJSONWithErrs UTC where+ parseJSONWithErrs = fmap UTC . parseJSONWithErrs+++formatUTC :: UTC -> String+formatUTC (UTC u) = cleanup $ formatTime defaultTimeLocale fmt u+ where+ fmt = iso8601DateFormat $ Just "%H:%M:%S%QZ"++cleanup :: String -> String+cleanup s = case (captureTextMaybe [cp|u|] mtch,captureTextMaybe [cp|q|] mtch) of+ (Just u,Nothing) -> u ++ ".000Z"+ (Just u,Just q ) -> u ++ "." ++ rjust q ++ "Z"+ _ -> s+ where+ mtch = s ?=~ [re|^${u}([T0-9:-]+)(.${q}([0-9]*))?Z$|]++ rjust ds = take 3 $ ds ++ "000"