keystore 0.8.2.0 → 0.9.0.0
raw patch · 20 files changed
+462/−116 lines, 20 filesdep +arraydep +crypto-pubkey-typesdep +cryptonitedep −cipher-aesdep −crypto-pubkeydep −crypto-randomdep ~aesondep ~api-tools
Dependencies added: array, crypto-pubkey-types, cryptonite, memory, regex-base, regex-tdfa
Dependencies removed: cipher-aes, crypto-pubkey, crypto-random, regex-compat-tdfa
Dependency ranges changed: aeson, api-tools
Files
- changelog +6/−0
- examples/deploy/Deploy/Deploy.hs +7/−3
- examples/deploy/deploy.hs +5/−5
- keystore.cabal +15/−9
- src/Data/KeyStore/CLI/Command.hs +1/−1
- src/Data/KeyStore/IO.hs +2/−2
- src/Data/KeyStore/IO/IC.hs +3/−3
- src/Data/KeyStore/KS.hs +2/−2
- src/Data/KeyStore/KS/CPRNG.hs +8/−8
- src/Data/KeyStore/KS/Configuration.hs +1/−1
- src/Data/KeyStore/KS/Crypto.hs +105/−34
- src/Data/KeyStore/KS/KS.hs +23/−14
- src/Data/KeyStore/KS/Packet.hs +1/−1
- src/Data/KeyStore/Sections.hs +10/−10
- src/Data/KeyStore/Types.hs +11/−9
- src/Data/KeyStore/Types/AesonCompat.hs +42/−0
- src/Text/KSRegex.hs +197/−0
- stack-8.10.yaml +14/−0
- stack-8.6.yaml +0/−12
- stack.yaml +9/−2
changelog view
@@ -113,3 +113,9 @@ 0.7.0.1 Chris Dornan <chrisd@irisconnect.co.uk> 2014-12-04 * Data.KeyStore.Sections: export mkSection++0.9.0.0 Chris Dornan <chrisd@irisconnect.co.uk> 2022-06-02+ * fix for GHC 9.2+ * switch cryptonite in place of older deprecated packages+ * upgrade to aeson-2.*+ * upgrade to api-tools 0.10.*
examples/deploy/Deploy/Deploy.hs view
@@ -15,7 +15,7 @@ deploy :: IC -> HostID -> IO LBS.ByteString-deploy ic h = A.encode . A.Object . HM.fromList <$> mapM (extract ic h)+deploy ic h = A.encode . A.Object . mkKeyMap <$> mapM (extract ic h) [ k | k<-[minBound..maxBound], maybe True ($ h) $ keyIsHostIndexed k ] @@ -36,7 +36,7 @@ K_ssl -> clear_text k key hash :: KeyID -> Key -> A.Value-hash k Key{..} = chk $ A.Object $ HM.fromList+hash k Key{..} = chk $ A.Object $ mkKeyMap [ (,) "name" $ A.toJSON _key_name , (,) "identity" $ A.toJSON _key_identity , (,) "comment" $ A.toJSON _key_comment@@ -48,7 +48,7 @@ oops = error $ encode k ++ ": hash not present" clear_text :: KeyID -> Key -> A.Value-clear_text k Key{..} = chk $ A.Object $ HM.fromList+clear_text k Key{..} = chk $ A.Object $ mkKeyMap [ (,) "name" $ A.toJSON _key_name , (,) "identity" $ A.toJSON _key_identity , (,) "comment" $ A.toJSON _key_comment@@ -69,3 +69,7 @@ tst [] = error $ encode k ++ ": key not present in the this section" tst (key:_) = return key+++mkKeyMap :: [(T.Text,a)] -> A.Object+mkKeyMap = undefined (HM.fromList :: [(T.Text,a)] -> HM.HashMap T.Text a)
examples/deploy/deploy.hs view
@@ -67,7 +67,7 @@ C_sign -> return () _ -> verify_ks True ic_ro case cc_cmd of- C_create -> error "main: Initialise"+ -- C_create -> error "main: Initialise" C_rotate mbh mbs mbk -> rotate ic $ key_prededicate mbh mbs mbk C_rotate_smart mbh mbs mbk -> rotateIfChanged ic $ key_prededicate mbh mbs mbk C_deploy False mb hst -> deploy ic_ro hst >>= write mb@@ -75,14 +75,14 @@ C_client -> lookupEnv "KEY_pw_session" >>= putStrLn . ("session-token=>" ++) . maybe "NONE" id C_sign -> sign_ks ic_ro C_verify -> T.putStrLn "the keystore matches the signature"- C_list_hosts -> error "main: ListHosts"+ -- C_list_hosts -> error "main: ListHosts" C_info_key mbk -> T.putStr $ keyHelp mbk C_info_section mbs -> sectionHelp mbs >>= T.putStr C_secret_script -> secretKeySummary ic sections >>= T.putStr C_public_script -> publicKeySummary ic sections ks_mac_fp >>= T.putStr- C_sample_script -> error "main: SampleScript"- C_ks _ -> error "main: KS"- C_pm _ -> error "main: PM"+ -- C_sample_script -> error "main: SampleScript"+ -- C_ks _ -> error "main: KS"+ -- C_pm _ -> error "main: PM" verify_ks False ic_ro create_cc, deploy_cc, client_cc :: CollectConfig SectionID
keystore.cabal view
@@ -1,5 +1,5 @@ Name: keystore-Version: 0.8.2.0+Version: 0.9.0.0 Synopsis: Managing stores of secret things Homepage: http://github.com/cdornan/keystore Author: Chris Dornan@@ -122,7 +122,7 @@ on GitHub home page for launch instructions for the deploy example. Data-files: stack.yaml- stack-8.6.yaml+ stack-8.10.yaml examples/deploy/zshenv/.zshrc examples/deploy/example-pwstore.dat @@ -153,6 +153,7 @@ Data.KeyStore.PasswordManager Data.KeyStore.Sections Data.KeyStore.Types+ Data.KeyStore.Types.AesonCompat Data.KeyStore.Types.E Data.KeyStore.Types.NameAndSafeguard Data.KeyStore.Types.PasswordStoreModel@@ -161,30 +162,35 @@ Data.KeyStore.Types.UTC Data.KeyStore.Version + Other-modules:+ Text.KSRegex+ Build-depends:- api-tools >= 0.5.2 ,+ aeson >= 1.5.6.0 ,+ aeson-pretty >= 0.7 ,+ api-tools >= 0.9.0.0 ,+ array >= 0.5.4.0 , 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.8 ,- aeson-pretty >= 0.7 , base >= 4.8 , base64-bytestring >= 1.0 , byteable >= 0.1 , bytestring >= 0.9 ,- cipher-aes >= 0.2.6 ,+ crypto-pubkey-types >= 0.4.3 ,+ cryptonite >= 0.30 , containers >= 0.4 , directory >= 1.2 , filepath >= 1.3 , lens >= 3.9.2 ,+ memory >= 0.17.0 , mtl >= 2 , old-locale >= 1.0.0.5 , optparse-applicative >= 0.11.0 , pbkdf >= 1.1.1.0 , regex >= 1.0.1.3 ,- regex-compat-tdfa >= 0.95.1 ,+ regex-base >= 0.94.0.2 ,+ regex-tdfa >= 1.3.1.2 , safe >= 0.3.3 , setenv >= 0.1 , text >= 0.11.3 ,
src/Data/KeyStore/CLI/Command.hs view
@@ -18,7 +18,7 @@ import Data.KeyStore.IO.IC import Data.Monoid import Data.String-import Text.Regex+import Text.KSRegex import qualified Data.Text as T import Options.Applicative import System.Environment
src/Data/KeyStore/IO.hs view
@@ -73,9 +73,9 @@ import Data.KeyStore.KS import Data.KeyStore.KS.KS import Data.KeyStore.Types+import Data.KeyStore.Types.AesonCompat import Data.API.Types import Data.IORef-import Data.Aeson import qualified Data.Text as T import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as LBS@@ -147,7 +147,7 @@ where id_s = T.unpack $ _TriggerID _trg_id pat_s = _pat_string _trg_pattern- stgs_s = LBS.unpack $ encode $ Object $ _Settings _trg_settings+ stgs_s = LBS.unpack $ encode $ Object $ intoKM $ _Settings _trg_settings -- | Returns the striggers setup on the keystore. triggers :: IC -> IO [Trigger]
src/Data/KeyStore/IO/IC.hs view
@@ -20,9 +20,9 @@ import Data.KeyStore.KS import Data.KeyStore.Types+import Data.KeyStore.Types.AesonCompat import Data.API.Types-import Data.Aeson-import Data.Text as T+import Data.Text as T hiding (elem) import qualified Data.Map as Map import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Char8 as B@@ -181,7 +181,7 @@ Left msg -> errorIO msg Right val -> case val of- Object hm -> return $ Settings hm+ Object hm -> return $ Settings $ fromKM hm _ -> errorIO "JSON object expected in the configuration file" errorIO :: String -> IO a
src/Data/KeyStore/KS.hs view
@@ -39,8 +39,8 @@ import Data.KeyStore.KS.Configuration import Data.KeyStore.KS.CPRNG import Data.KeyStore.Types+import Data.KeyStore.Types.AesonCompat import Data.API.JSON-import Data.Aeson import qualified Data.ByteString.Lazy as LBS import qualified Data.Map as Map import qualified Data.Text as T@@ -77,7 +77,7 @@ settingsFromBytes :: LBS.ByteString -> E Settings settingsFromBytes = chk . either (const Nothing) Just . decodeWithErrs where- chk (Just(Object fm)) = Right $ Settings fm+ chk (Just(Object fm)) = Right $ Settings $ fromKM fm chk _ = Left $ strMsg "failed to decode JSON settings"
src/Data/KeyStore/KS/CPRNG.hs view
@@ -9,20 +9,20 @@ ) where import Crypto.Random-import qualified Data.ByteString as B+import qualified Data.ByteArray as BA+import System.IO.Unsafe newtype CPRNG- = CPRNG { _CPRNG :: SystemRNG }- deriving (CPRG)+ = CPRNG { _CPRNG :: SystemDRG }+ deriving (DRG) newCPRNG :: IO CPRNG-newCPRNG = cprgCreate <$> createEntropyPool+newCPRNG = CPRNG <$> getSystemDRG testCPRNG :: CPRNG-testCPRNG = cprgSetReseedThreshold 0 $- cprgCreate $ createTestEntropyPool "Data.CertStore.Tools"+testCPRNG = unsafePerformIO newCPRNG -generateCPRNG :: Int -> CPRNG -> (B.ByteString,CPRNG)-generateCPRNG = cprgGenerate+generateCPRNG :: BA.ByteArray ba => Int -> CPRNG -> (ba,CPRNG)+generateCPRNG = randomBytesGenerate
src/Data/KeyStore/KS/Configuration.hs view
@@ -5,7 +5,7 @@ import Data.KeyStore.Types import qualified Data.Map as Map import Data.Maybe-import Text.Regex+import Text.KSRegex configurationSettings :: Configuration -> Settings
src/Data/KeyStore/KS/Crypto.hs view
@@ -3,6 +3,10 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} module Data.KeyStore.KS.Crypto ( sizeAesIV@@ -55,14 +59,22 @@ import qualified Data.ASN1.Types as A import qualified Data.ByteString.Lazy.Char8 as LBS import qualified Data.ByteString.Char8 as B+import Data.Coerce+import Data.Maybe+import Data.Typeable+import Crypto.Error+import Crypto.Hash.Algorithms import Crypto.PubKey.RSA import qualified Crypto.PubKey.RSA.OAEP as OAEP import qualified Crypto.PubKey.RSA.PSS as PSS-import Crypto.PubKey.HashDescr import Crypto.PubKey.MaskGenFunction import Crypto.Cipher.AES+import qualified Crypto.Types.PubKey.RSA as CPT +-- avoiding class with crypto-pubkey-types which we are using for DER generation+import qualified "cryptonite" Crypto.Cipher.Types as CCT + sizeAesIV, sizeOAE :: Octets sizeAesIV = 16 sizeOAE = 256@@ -219,41 +231,43 @@ encryptRSAKS :: PublicKey -> AESKey -> KS RSAEncryptedKey encryptRSAKS pk (AESKey (Binary dat)) =- RSAEncryptedKey . Binary <$> randomRSA (\g->OAEP.encrypt g oaep pk dat)+ fmap (RSAEncryptedKey . Binary) $ rsaErrorKS $ OAEP.encrypt oaep pk dat decryptRSAKS :: PrivateKey -> RSAEncryptedKey -> KS AESKey decryptRSAKS pk rek = either throwKS return $ decryptRSAE pk rek decryptRSAE :: PrivateKey -> RSAEncryptedKey -> E AESKey-decryptRSAE pk rek =- rsa2e $ fmap (AESKey . Binary) $- OAEP.decrypt Nothing oaep pk $ _Binary $ _RSAEncryptedKey rek+decryptRSAE pk rek = rsa2e $ fmap (AESKey . Binary) $+ OAEP.decrypt Nothing oaep pk $ _Binary $ _RSAEncryptedKey rek -oaep :: OAEP.OAEPParams-oaep =- OAEP.OAEPParams- { OAEP.oaepHash = hashFunction hashDescrSHA512- , OAEP.oaepMaskGenAlg = mgf1- , OAEP.oaepLabel = Nothing- }+type OAEPparams = OAEP.OAEPParams SHA512 B.ByteString B.ByteString +oaep :: OAEPparams+oaep = OAEP.OAEPParams+ { OAEP.oaepHash = SHA512+ , OAEP.oaepMaskGenAlg = mgf1 SHA512+ , OAEP.oaepLabel = Nothing+ } + -- -- signing & verifying -- signKS :: PrivateKey -> ClearText -> KS RSASignature signKS pk dat =- RSASignature . Binary <$>- randomRSA (\g->PSS.sign g Nothing pssp pk $ _Binary $ _ClearText dat)+ fmap (RSASignature . Binary) $+ rsaErrorKS $ PSS.sign Nothing pssp pk $ _Binary $ _ClearText dat verifyKS :: PublicKey -> ClearText -> RSASignature -> Bool verifyKS pk (ClearText (Binary dat)) (RSASignature (Binary sig)) = PSS.verify pssp pk dat sig -pssp :: PSS.PSSParams-pssp = PSS.defaultPSSParams $ hashFunction hashDescrSHA512+type PSSparams = PSS.PSSParams SHA512 B.ByteString B.ByteString +pssp :: PSSparams+pssp = PSS.defaultPSSParams SHA512 + -- -- AES encrypting/decrypting --@@ -265,26 +279,51 @@ return $ encryptAES aek iv ct encryptAES :: AESKey -> IV -> ClearText -> AESSecretData-encryptAES (AESKey (Binary ky)) (IV (Binary iv)) (ClearText (Binary dat)) =+encryptAES aek iv (ClearText (Binary dat)) = AESSecretData- { _asd_iv = IV $ Binary iv- , _asd_secret_data = SecretData $ Binary $ encryptCTR (initAES ky) iv dat+ { _asd_iv = iv+ , _asd_secret_data = SecretData $ Binary $ encryptCTR aek iv dat } decryptAES :: AESKey -> AESSecretData -> ClearText-decryptAES aek AESSecretData{..} =- ClearText $ Binary $- encryptCTR (initAES $ _Binary $ _AESKey aek )- (_Binary $ _IV _asd_iv )- (_Binary $ _SecretData _asd_secret_data)+decryptAES aek AESSecretData{..} = ClearText $ Binary $+ encryptCTR aek _asd_iv $ _Binary $ _SecretData _asd_secret_data randomAESKeyKS :: Cipher -> KS AESKey-randomAESKeyKS cip = randomBytes (keyWidth cip) (AESKey . Binary)+randomAESKeyKS cip = randomBytes (keyWidth cip) $ AESKey . Binary randomIVKS :: KS IV-randomIVKS = randomBytes sizeAesIV (IV . Binary)+randomIVKS = randomBytes sizeAesIV $ IV . Binary +encryptCTR :: AESKey -> IV -> B.ByteString -> B.ByteString+encryptCTR aek = case B.length $ coerce aek of+ 16 -> aes_ctr (Proxy @AES128) aek+ 24 -> aes_ctr (Proxy @AES192) aek+ 32 -> aes_ctr (Proxy @AES256) aek+ ln -> error $ "aek_from_key: unexpected AES key size: " ++ show ln +aes_ctr :: forall k . (CCT.BlockCipher k,Typeable k)+ => Proxy k -> AESKey -> IV -> B.ByteString -> B.ByteString+aes_ctr pxy aek iv msg = CCT.ctrCombine ky_ iv_ msg+ where+ ky_ :: k+ ky_ = case CCT.cipherInit ky_b of+ CryptoFailed _ -> oops "key"+ CryptoPassed z -> z++ iv_ :: CCT.IV k+ iv_ = fromMaybe (oops "IV") $ CCT.makeIV iv_b++ oops :: String -> a+ oops thg = error $ tynm ++ " cryption error: mismatched size of "++thg++ tynm :: String+ tynm = show $ typeRep pxy++ AESKey (Binary ky_b) = aek+ IV (Binary iv_b) = iv++ -- -- hashing --@@ -324,9 +363,6 @@ _hashd_width_octets (HashData . Binary) } ---randomSalt :: KS Salt---randomSalt = randomBytes size_salt Salt- -- -- Generating a private/public key pair --@@ -341,7 +377,7 @@ generateKeysKS = generateKeysKS_ default_key_size generateKeysKS_ :: Int -> KS (PublicKey,PrivateKey)-generateKeysKS_ ksz = randomKS $ \g->generate g ksz default_e+generateKeysKS_ ksz = generate ksz default_e --@@ -360,8 +396,43 @@ encodePublicKeyDER :: PublicKey -> ClearText encodePublicKeyDER = ClearText . Binary . encodeDER -decodeDERE :: A.ASN1Object a => B.ByteString -> E a-decodeDERE bs =++class ASN1 a where+ decodeDERE :: B.ByteString -> E a+ encodeDER :: a -> B.ByteString+++instance ASN1 PrivateKey where+ decodeDERE = fmap privateFromCPT . decodeDERE_+ encodeDER = encodeDER_ . privateIntoCPT++instance ASN1 PublicKey where+ decodeDERE = fmap publicFromCPT . decodeDERE_+ encodeDER = encodeDER_ . publicIntoCPT++privateFromCPT :: CPT.PrivateKey -> PrivateKey+privateFromCPT CPT.PrivateKey{..} =+ PrivateKey+ { private_pub = publicFromCPT private_pub+ , ..+ }++privateIntoCPT :: PrivateKey -> CPT.PrivateKey+privateIntoCPT PrivateKey{..} =+ CPT.PrivateKey+ { private_pub = publicIntoCPT private_pub+ , ..+ }++publicFromCPT :: CPT.PublicKey -> PublicKey+publicFromCPT CPT.PublicKey{..} = PublicKey{..}++publicIntoCPT :: PublicKey -> CPT.PublicKey+publicIntoCPT PublicKey{..} = CPT.PublicKey{..}+++decodeDERE_ :: A.ASN1Object a => B.ByteString -> E a+decodeDERE_ bs = case A.decodeASN1 A.DER $ lzy bs of Left err -> Left $ strMsg $ show err Right as ->@@ -374,8 +445,8 @@ where lzy = LBS.pack . B.unpack -encodeDER :: A.ASN1Object a => a -> B.ByteString-encodeDER = egr . A.encodeASN1 A.DER . flip A.toASN1 []+encodeDER_ :: A.ASN1Object a => a -> B.ByteString+encodeDER_ = egr . A.encodeASN1 A.DER . flip A.toASN1 [] where egr = B.pack . LBS.unpack
src/Data/KeyStore/KS/KS.hs view
@@ -7,6 +7,7 @@ , Ctx(..) , State(..) , LogEntry(..)+ , rsaErrorKS , withKey , trun , e2io@@ -28,8 +29,8 @@ , insertKey , adjustKeyKS , deleteKeysKS- , randomRSA- , randomKS+ -- , randomRSA+ -- , randomKS , getKeymap , getConfig , modConfig@@ -39,7 +40,9 @@ import Data.KeyStore.KS.Configuration import Data.KeyStore.KS.Opt import Data.KeyStore.Types-import Crypto.PubKey.RSA+import qualified Data.ByteArray as BA+-- import Crypto.PubKey.RSA+import Crypto.Random.Types import qualified Data.Map as Map import qualified Data.ByteString as B import Data.Typeable@@ -48,6 +51,7 @@ import qualified Control.Monad.Error as E import Control.Exception import Control.Lens+import Crypto.PubKey.RSA.Types newtype KS a = KS { _KS :: E.ErrorT Reason (RWS Ctx [LogEntry] State) a }@@ -75,6 +79,21 @@ } deriving (Show) ++instance MonadRandom KS where+ getRandomBytes sz = KS $ state upd+ where+ upd :: BA.ByteArray ba => State -> (ba,State)+ upd st = (ba,st')+ where+ st' = st+ { st_cprng = cprg'+ }+ (ba,cprg') = generateCPRNG sz $ st_cprng st++rsaErrorKS :: KS (Either Error a) -> KS a+rsaErrorKS ks_e = either (throwKS . rsaError) return =<< ks_e+ withKey :: Name -> KS a -> KS a withKey nm p = do ctx <- KS ask@@ -111,7 +130,7 @@ run_ c s p = runRWS (E.runErrorT (_KS p)) c s randomBytes :: Octets -> (B.ByteString->a) -> KS a-randomBytes (Octets sz) k = k <$> randomKS (generateCPRNG sz)+randomBytes (Octets sz) k = fmap k $ getRandomBytes sz currentTime :: KS UTCTime currentTime = ctx_now <$> KS ask@@ -177,16 +196,6 @@ where tst key = or [ any (`elem` safeguardKeys sg) nms | sg<-Map.keys $ _key_secret_copies key ]--randomRSA :: (CPRNG->(Either Error a,CPRNG)) -> KS a-randomRSA f = randomKS f >>= either (throwKS . rsaError) return--randomKS :: (CPRNG->(a,CPRNG)) -> KS a-randomKS f = KS $- do s <- get- let (x,!g') = f $ st_cprng s- put s { st_cprng = g' }- return x getKeymap :: KS KeyMap getKeymap = _ks_keymap.st_keystore <$> KS get
src/Data/KeyStore/KS/Packet.hs view
@@ -16,7 +16,7 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy.Char8 as LBS-import Data.ByteString.Lazy.Builder+import Data.ByteString.Builder import Data.Word import Data.Bits import Data.Char
src/Data/KeyStore/Sections.hs view
@@ -39,13 +39,13 @@ import Data.KeyStore.IO import Data.KeyStore.KS-import qualified Data.Text as T-import qualified Data.ByteString.Char8 as B-import qualified Data.ByteString.Lazy.Char8 as LBS-import qualified Data.Aeson as A-import qualified Data.HashMap.Strict as HM-import qualified Data.Vector as V-import qualified Data.Map as Map+import qualified Data.KeyStore.Types.AesonCompat as A+import qualified Data.Text as T+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy.Char8 as LBS+import qualified Data.HashMap.Strict as HM+import qualified Data.Vector as V+import qualified Data.Map as Map import Data.API.Types import Data.Maybe import Data.List@@ -295,7 +295,7 @@ f = uncurry $ printf "%-20s %s" - fmt_s stgs = map (" "++) $ lines $ LBS.unpack $ A.encode $ A.Object $ _Settings stgs+ fmt_s stgs = map (" "++) $ lines $ LBS.unpack $ A.encode $ A.Object $ A.intoKM $ _Settings stgs -- | List a shell script for establishing all of the keys in the environment. NB For this -- to work the password for the top section (or the passwords for all of the sections@@ -690,7 +690,7 @@ fmap f m = m >>= \x -> return $ f x instance Applicative Munch where- pure = return+ pure x = Munch $ \s -> Just (x,s) (<*>) = ap instance Alternative Munch where@@ -698,7 +698,7 @@ (<|>) x y = Munch $ \s -> _Munch x s <|> _Munch y s instance Monad Munch where- return x = Munch $ \s -> Just (x,s)+ return = pure (>>=) m f = Munch $ \s -> _Munch m s >>= \(x,s') -> _Munch (f x) s' run_munch :: Munch a -> String -> Maybe a
src/Data/KeyStore/Types.hs view
@@ -43,11 +43,12 @@ import Data.KeyStore.Types.NameAndSafeguard import Data.KeyStore.Types.E import Data.KeyStore.Types.UTC-import Data.Aeson+import Data.KeyStore.Types.AesonCompat import Data.API.Tools import Data.API.JSON import Data.API.Types import qualified Data.ByteString as B+import Data.Coerce import qualified Data.HashMap.Strict as HM import Data.List import qualified Data.Map as Map@@ -56,7 +57,7 @@ import Data.Time import Data.String import qualified Data.Vector as V-import Text.Regex+import Text.KSRegex $(generate keystoreSchema)@@ -105,29 +106,30 @@ prj_pattern = REP__Pattern . T.pack . _pat_string -newtype Settings = Settings { _Settings :: Object }+newtype Settings = Settings { _Settings :: HM.HashMap T.Text Value } deriving (Eq,Show) inj_settings :: REP__Settings -> ParserWithErrs Settings-inj_settings REP__Settings { _stgs_json = Object hm}- = return $ Settings hm+inj_settings REP__Settings { _stgs_json = Object o}+ = return $ Settings $ fromKM o inj_settings _ = fail "object expected for settings" prj_settings :: Settings -> REP__Settings-prj_settings (Settings hm) = REP__Settings { _stgs_json = Object hm }+prj_settings (Settings hm) = REP__Settings { _stgs_json = Object $ intoKM hm } defaultSettings :: Settings defaultSettings = mempty + #if __GLASGOW_HASKELL__ >= 804 instance Semigroup Settings where (<>) = mappendSettings #endif instance Monoid Settings where- mempty = Settings HM.empty- mappend = mappendSettings+ mempty = Settings mempty+ -- mappend = mappendSettings mappendSettings :: Settings -> Settings -> Settings mappendSettings (Settings fm_0) (Settings fm_1) =@@ -136,7 +138,7 @@ cmb v0 v1 = case (v0,v1) of (Array v_0,Array v_1) -> Array $ v_0 V.++ v_1- _ -> marker+ _ -> marker checkSettingsCollisions :: Settings -> [SettingID] checkSettingsCollisions (Settings hm) =
+ src/Data/KeyStore/Types/AesonCompat.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE CPP #-}++module Data.KeyStore.Types.AesonCompat+ ( module A+ , module Data.KeyStore.Types.AesonCompat+ ) where++import qualified Data.HashMap.Strict as HM+import qualified Data.Text as T+++#if MIN_VERSION_aeson(2,0,0)+++import Data.Aeson as A hiding (Key)+import qualified Data.Aeson.Key as A+import qualified Data.Aeson.KeyMap as A++type KM a = A.KeyMap a++fromKM :: KM a -> HM.HashMap T.Text a+fromKM = HM.mapKeys A.toText . A.toHashMap++intoKM :: HM.HashMap T.Text a -> KM a+intoKM = A.fromHashMap . HM.mapKeys A.fromText+++#else+++import Data.Aeson as A++type KM a = HM.HashMap T.Text a++fromKM :: KM a -> HM.HashMap T.Text a+fromKM = id++intoKM :: HM.HashMap T.Text a -> KM a+intoKM = id+++#endif
+ src/Text/KSRegex.hs view
@@ -0,0 +1,197 @@+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Regex+-- Copyright : (c) Chris Kuklewicz 2006, (c) shelarcy 2012, derived from (c) The University of Glasgow 2001+-- License : BSD-style (see the file LICENSE)+--+-- Maintainer : libraries@haskell.org+-- Stability : experimental+-- Portability : non-portable (regex-base needs MPTC+FD)+--+-- Regular expression matching. Uses the POSIX regular expression+-- interface in "Text.Regex.TDFA".+--+---------------------------------------------------------------------------++--+-- Modified by Chris Kuklewicz to be a thin layer over the regex-posix+-- package, and moved into a regex-compat package.+--+module Text.KSRegex (+ -- * Regular expressions+ Regex,+ mkRegex,+ mkRegexWithOpts,+ matchRegex,+ matchRegexAll,+ subRegex,+ splitRegex+ ) where++import Data.Array((!))+import Text.Regex.Base(RegexMaker(makeRegexOpts),defaultCompOpt,defaultExecOpt,RegexLike(matchAll,matchAllText),RegexContext(matchM),MatchText)+import Text.Regex.TDFA(Regex,caseSensitive,multiline,newSyntax)++-- | Makes a regular expression with the default options (multi-line,+-- case-sensitive). The syntax of regular expressions is+-- otherwise that of @egrep@ (i.e. POSIX \"extended\" regular+-- expressions).+mkRegex :: String -> Regex+mkRegex s = makeRegexOpts opt defaultExecOpt s+ where opt = defaultCompOpt { newSyntax = True, multiline = True }++-- | Makes a regular expression, where the multi-line and+-- case-sensitive options can be changed from the default settings.+mkRegexWithOpts+ :: String -- ^ The regular expression to compile+ -> Bool -- ^ 'True' @\<=>@ @\'^\'@ and @\'$\'@ match the beginning and+ -- end of individual lines respectively, and @\'.\'@ does /not/+ -- match the newline character.+ -> Bool -- ^ 'True' @\<=>@ matching is case-sensitive+ -> Regex -- ^ Returns: the compiled regular expression++mkRegexWithOpts s single_line case_sensitive+ = let opt = defaultCompOpt+ { multiline = (if single_line then True else False)+ , caseSensitive = (if case_sensitive then True else False)+ , newSyntax = True }+ in makeRegexOpts opt defaultExecOpt s++-- | Match a regular expression against a string+matchRegex+ :: Regex -- ^ The regular expression+ -> String -- ^ The string to match against+ -> Maybe [String] -- ^ Returns: @'Just' strs@ if the match succeeded+ -- (and @strs@ is the list of subexpression matches),+ -- or 'Nothing' otherwise.+matchRegex p str = fmap (\(_,_,_,str) -> str) (matchRegexAll p str)++-- | Match a regular expression against a string, returning more information+-- about the match.+matchRegexAll+ :: Regex -- ^ The regular expression+ -> String -- ^ The string to match against+ -> Maybe ( String, String, String, [String] )+ -- ^ Returns: 'Nothing' if the match failed, or:+ --+ -- > Just ( everything before match,+ -- > portion matched,+ -- > everything after the match,+ -- > subexpression matches )++matchRegexAll p str = matchM p str++{- | Replaces every occurance of the given regexp with the replacement string.++In the replacement string, @\"\\1\"@ refers to the first substring;+@\"\\2\"@ to the second, etc; and @\"\\0\"@ to the entire match.+@\"\\\\\\\\\"@ will insert a literal backslash.++This does not advance if the regex matches an empty string. This+misfeature is here to match the behavior of the the original+Text.Regex API.+-}++subRegex :: Regex -- ^ Search pattern+ -> String -- ^ Input string+ -> String -- ^ Replacement text+ -> String -- ^ Output string+subRegex _ "" _ = ""+subRegex regexp inp repl =+ let compile _i str [] = \ _m -> (str++)+ compile i str (("\\",(off,len)):rest) =+ let i' = off+len+ pre = take (off-i) str+ str' = drop (i'-i) str+ in if null str' then \ _m -> (pre ++) . ('\\':)+ else \ m -> (pre ++) . ('\\' :) . compile i' str' rest m+ compile i str ((xstr,(off,len)):rest) =+ let i' = off+len+ pre = take (off-i) str+ str' = drop (i'-i) str+ x = read xstr+ in if null str' then \ m -> (pre++) . ((fst (m!x))++)+ else \ m -> (pre++) . ((fst (m!x))++) . compile i' str' rest m+ compiled :: MatchText String -> String -> String+ compiled = compile 0 repl findrefs where+ -- bre matches a backslash then capture either a backslash or some digits+ bre = mkRegex "\\\\(\\\\|[0-9]+)"+ findrefs = map (\m -> (fst (m!1),snd (m!0))) (matchAllText bre repl)+ go _i str [] = str+ go i str (m:ms) =+ let (_,(off,len)) = m!0+ i' = off+len+ pre = take (off-i) str+ str' = drop (i'-i) str+ in if null str' then pre ++ (compiled m "")+ else pre ++ (compiled m (go i' str' ms))+ in go 0 inp (matchAllText regexp inp)++{- | Splits a string based on a regular expression. The regular expression+should identify one delimiter.++This does not advance and produces an infinite list of [] if the regex+matches an empty string. This misfeature is here to match the+behavior of the the original Text.Regex API.+-}++splitRegex :: Regex -> String -> [String]+splitRegex _ [] = []+splitRegex delim strIn =+ let matches = map (! 0) (matchAll delim strIn)+ go _i str [] = str : []+ go i str ((off,len):rest) =+ let i' = off+len+ firstline = take (off-i) str+ remainder = drop (i'-i) str+ in seq i' $+ if null remainder then [firstline,""]+ else firstline : go i' remainder rest+ in go 0 strIn matches++{-++-- These are the older versions which failed on (correct answer:)+-- let r = mkRegex "^(.)" in subRegex2 r "abc\ndef" "|\\1"+-- "|abc\n|def"++subRegex :: Regex -- ^ Search pattern+ -> String -- ^ Input string+ -> String -- ^ Replacement text+ -> String -- ^ Output string+subRegex _ "" _ = ""+subRegex regexp inp repl =+ let -- bre matches a backslash then capture either a backslash or some digits+ bre = mkRegex "\\\\(\\\\|[0-9]+)"+ lookup _ [] _ = []+ lookup [] _ _ = []+ lookup match repl groups =+ case matchRegexAll bre repl of+ Nothing -> repl+ Just (lead, _, trail, bgroups) ->+ let newval =+ if (head bgroups) == "\\"+ then "\\"+ else let index :: Int+ index = (read (head bgroups)) - 1+ in if index == -1+ then match+ else groups !! index+ in lead ++ newval ++ lookup match trail groups+ in case matchRegexAll regexp inp of+ Nothing -> inp+ Just (lead, match, trail, groups) ->+ lead ++ lookup match repl groups ++ (subRegex regexp trail repl)++splitRegex :: Regex -> String -> [String]+splitRegex _ [] = []+splitRegex delim strIn = loop strIn where+ loop str = case matchOnceText delim str of+ Nothing -> [str]+ Just (firstline, _, remainder) ->+ if null remainder+ then [firstline,""]+ else firstline : loop remainder++-}
+ stack-8.10.yaml view
@@ -0,0 +1,14 @@+resolver: lts-18.28++allow-newer: true++packages:+- '.'++flags:+ cryptonite:+ use_target_attributes: false++extra-deps:+- api-tools-0.9.0.0+- pbkdf-1.1.1.1
− stack-8.6.yaml
@@ -1,12 +0,0 @@-resolver: nightly-2018-12-19-install-ghc: true-flags: {}-packages:-- '.'-system-ghc: false-extra-deps:- - api-tools-0.8.0.2- - crypto-numbers-0.2.7- - crypto-pubkey-0.2.8- - serialise-0.2.1.0- - pbkdf-1.1.1.0
stack.yaml view
@@ -1,10 +1,17 @@-resolver: nightly-2020-12-07+resolver: nightly-2022-05-31+ ghc-options: "$locals": -Werror++allow-newer: true+ packages: - '.'+ flags: cryptonite: use_target_attributes: false+ extra-deps:- - pbkdf-1.1.1.0+- api-tools-0.10.0.0+- pbkdf-1.1.1.1