strongswan-sql 1.2.2.0 → 1.3.0.0
raw patch · 5 files changed
+98/−70 lines, 5 filesdep ~failable
Dependency ranges changed: failable
Files
- app/CLI/Commands/Identity.hs +21/−11
- src/StrongSwan/SQL.hs +20/−7
- src/StrongSwan/SQL/Statements.hs +1/−1
- src/StrongSwan/SQL/Types.hs +51/−46
- strongswan-sql.cabal +5/−5
app/CLI/Commands/Identity.hs view
@@ -32,24 +32,34 @@ cfgSecret :: Lens' AppState Identity -> Lens' AppState Identity -> Commands () cfgSecret lensA lensB =- param "shared-secret" "<shared secret>" bytes setSecret >+ do- param "type" "<psk|eap|rsa|pin>" secretType' $ \sType -> do- db <- use dbContext+ command "shared-secret" "Manipulate shared secrets for this connection" newLevel >+ do+ param "add" "<shared secret>" bytes setSecret >+ do+ param "type" "<psk|eap|rsa|pin>" secretType' $ \sType -> do+ db <- use dbContext+ ident1 <- use lensA+ ident2 <- use lensB+ str <- use secretStr+ let secret = def { _ssData = str, _ssType = sType }+ Result {..} <- lift $ writeSharedSecret secret db+ let secret' = secret { _ssId = Just lastModifiedKey }+ ident1' <- lift $ addSecret ident1 secret' db+ ident2' <- lift $ addSecret ident2 secret' db+ lensA .= ident1'+ lensB .= ident2'+ return NoAction+ exitCmd+ command "remove" "Delete all shared secrets from this connection" $ do+ db <- use dbContext ident1 <- use lensA ident2 <- use lensB- str <- use secretStr- let secret = def { _ssData = str, _ssType = sType }- Result {..} <- lift $ writeSharedSecret secret db- let secret' = secret { _ssId = Just lastModifiedKey }- ident1' <- lift $ addSecret ident1 secret' db- ident2' <- lift $ addSecret ident2 secret' db- lensA .= ident1'- lensB .= ident2'+ lift $ mapM_ (\t -> removeSecret ident1 t db) allTypes+ lift $ mapM_ (\t -> removeSecret ident2 t db) allTypes return NoAction exitCmd where setSecret str = do secretStr .= str return NewLevel+ allTypes = [minBound..maxBound] flushIdentity :: StateT AppState IO Action flushIdentity = do
src/StrongSwan/SQL.hs view
@@ -24,6 +24,7 @@ module StrongSwan.SQL ( -- * Initialization mkContext,+ rmContext, -- -- * Managed API -- | Since managing each configuration object per hand and establishing the relationships@@ -177,7 +178,7 @@ data Context_ = Context_ { conn_ :: MySQLConn,- prepared_ :: PreparedStatements+ prepared_ :: PreparedStatements SQL.StmtID } data Settings = Settings {@@ -224,8 +225,15 @@ SQL.ciPassword = pack _dbPassword, SQL.ciCharset = fromIntegral $ fromEnum _dbCharSet } +-- | Destroy an SQL context previously created by 'mkContext'+rmContext :: (Failable m, MonadIO m) => Context -> m ()+rmContext = withContext rmContext'+ where rmContext' Context_ {..} = do+ mapM_ (SQL.closeStmt conn_) prepared_+ SQL.close conn_+ retrieveRows :: (Failable m, MonadIO m, SQLRow a)- => (PreparedStatements -> SQL.StmtID)+ => (PreparedStatements SQL.StmtID -> SQL.StmtID) -> [SQL.MySQLValue] -> Context -> m [a]@@ -443,9 +451,14 @@ let ?context = context identId <- MaybeT . return $ getIdentityId identity ssIdentities <- findSSIdentity' identId- secrets <- mapM (findSharedSecret' . _sharedSecretId) ssIdentities- let toDelete = catMaybes $ _ssId <$> filter ((sType ==) . _ssType) secrets- ssIdentities' = filter (\ss2Id -> elem (_sharedSecretId ss2Id) toDelete) ssIdentities+ secrets <- mapM (lookupSharedSecret' . _sharedSecretId) ssIdentities+ let secrets' = catMaybes secrets+ toDelete = catMaybes $ _ssId <$> filter ((sType ==) . _ssType) secrets'+ ssIdentities' = case secrets' of+ [] ->+ ssIdentities+ _ ->+ filter (\ss2Id -> elem (_sharedSecretId ss2Id) toDelete) ssIdentities mapM_ deleteSharedSecret' toDelete mapM_ deleteSSIdentity' ssIdentities' @@ -697,8 +710,8 @@ justOne ("SharedSecret" <> Text.pack (show iD)) =<< retrieveRows findSharedSecretStmt [toSQL . toInt $ iD] context -findSharedSecret' :: (Failable m, MonadIO m, ?context::Context) => Int -> m SharedSecret-findSharedSecret' = flip findSharedSecret ?context+lookupSharedSecret' :: (Failable m, MonadIO m, ?context::Context) => Int -> m (Maybe SharedSecret)+lookupSharedSecret' = flip lookupSharedSecret ?context deleteSharedSecret :: (Failable m, MonadIO m) => Int -> Context -> m (Result Int) deleteSharedSecret iD = withContext deleteSS
src/StrongSwan/SQL/Statements.hs view
@@ -12,7 +12,7 @@ import qualified Database.MySQL.Base as SQL -prepareStatements :: (Failable m, MonadIO m, MonadFail m) => SQL.MySQLConn -> m PreparedStatements+prepareStatements :: (Failable m, MonadIO m, MonadFail m) => SQL.MySQLConn -> m (PreparedStatements SQL.StmtID) prepareStatements conn = do let ?conn = conn [createChildSA, updateChildSA, findChildSA, deleteChildSA] <-
src/StrongSwan/SQL/Types.hs view
@@ -1,7 +1,8 @@ {-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE UndecidableInstances #-}@@ -379,6 +380,10 @@ toEnum 4 = SharedPIN toEnum x = throw $ UnknownSharedSecretType x +instance Bounded SharedSecretType where+ minBound = SharedIKE+ maxBound = SharedPIN+ data IKEConfig = IKEConfig { _ikeId :: Maybe Int, _ikeReqCert :: Bool,@@ -505,7 +510,7 @@ _tsType = IPv4AddrRange, _tsProtocol = 0, _tsStartAddr = "0.0.0.0",- _tsEndAddr = "0.0.0.0",+ _tsEndAddr = "255.255.255.255", _tsStartPort = 0, _tsEndPort = 65535 }@@ -530,50 +535,50 @@ _identityId :: Int } -data PreparedStatements = PreparedStatements {- updateChildSAStmt :: SQL.StmtID,- createChildSAStmt :: SQL.StmtID,- findChildSAStmt :: SQL.StmtID,- findChildSAByNameStmt :: SQL.StmtID,- deleteChildSAStmt :: SQL.StmtID,- updateIKEStmt :: SQL.StmtID,- createIKEStmt :: SQL.StmtID,- findIKEStmt :: SQL.StmtID,- deleteIKEStmt :: SQL.StmtID,- updatePeerStmt :: SQL.StmtID,- createPeerStmt :: SQL.StmtID,- findPeerStmt :: SQL.StmtID,- findPeerByNameStmt :: SQL.StmtID,- deletePeerStmt :: SQL.StmtID,- updateP2CStmt :: SQL.StmtID,- createP2CStmt :: SQL.StmtID,- findP2CStmt :: SQL.StmtID,- deleteP2CStmt :: SQL.StmtID,- updateTSStmt :: SQL.StmtID,- createTSStmt :: SQL.StmtID,- findTSStmt :: SQL.StmtID,- deleteTSStmt :: SQL.StmtID,- updateC2TSStmt :: SQL.StmtID,- createC2TSStmt :: SQL.StmtID,- findC2TSStmt :: SQL.StmtID,- deleteC2TSStmt :: SQL.StmtID,- updateIdentityStmt :: SQL.StmtID,- createIdentityStmt :: SQL.StmtID,- findIdentityStmt :: SQL.StmtID,- findIdentityBySelfStmt :: SQL.StmtID,- deleteIdentityStmt :: SQL.StmtID,- updateSharedSecretStmt :: SQL.StmtID,- createSharedSecretStmt :: SQL.StmtID,- findSharedSecretStmt :: SQL.StmtID,- deleteSharedSecretStmt :: SQL.StmtID,- updateSSIdentityStmt :: SQL.StmtID,- createSSIdentityStmt :: SQL.StmtID,- findSSIdentityStmt :: SQL.StmtID,- deleteSSIdentityStmt :: SQL.StmtID,- createIPSecStmt :: SQL.StmtID,- findIPSecStmt :: SQL.StmtID,- deleteIPSecStmt :: SQL.StmtID- } deriving Show+data PreparedStatements a = PreparedStatements {+ updateChildSAStmt :: a,+ createChildSAStmt :: a,+ findChildSAStmt :: a,+ findChildSAByNameStmt :: a,+ deleteChildSAStmt :: a,+ updateIKEStmt :: a,+ createIKEStmt :: a,+ findIKEStmt :: a,+ deleteIKEStmt :: a,+ updatePeerStmt :: a,+ createPeerStmt :: a,+ findPeerStmt :: a,+ findPeerByNameStmt :: a,+ deletePeerStmt :: a,+ updateP2CStmt :: a,+ createP2CStmt :: a,+ findP2CStmt :: a,+ deleteP2CStmt :: a,+ updateTSStmt :: a,+ createTSStmt :: a,+ findTSStmt :: a,+ deleteTSStmt :: a,+ updateC2TSStmt :: a,+ createC2TSStmt :: a,+ findC2TSStmt :: a,+ deleteC2TSStmt :: a,+ updateIdentityStmt :: a,+ createIdentityStmt :: a,+ findIdentityStmt :: a,+ findIdentityBySelfStmt :: a,+ deleteIdentityStmt :: a,+ updateSharedSecretStmt :: a,+ createSharedSecretStmt :: a,+ findSharedSecretStmt :: a,+ deleteSharedSecretStmt :: a,+ updateSSIdentityStmt :: a,+ createSSIdentityStmt :: a,+ findSSIdentityStmt :: a,+ deleteSSIdentityStmt :: a,+ createIPSecStmt :: a,+ findIPSecStmt :: a,+ deleteIPSecStmt :: a+ } deriving (Show, Functor, Foldable) -- | The managed IPsec configuration type encompasses a complete set of elements which are pushed and interlinked -- as necessary by the /Managed/ API (see above). Note that there are lenses available to facilitate accessing all
strongswan-sql.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: f8b1dcf53f685958f34e7efb6fbb4777882c2ac6a753432528f03d0f5a0a115d+-- hash: 49806ef952eb6d507dcea5453e717f840d0021c2cf7026d46d1ccffade207fe7 name: strongswan-sql-version: 1.2.2.0+version: 1.3.0.0 synopsis: Interface library for strongSwan SQL backend description: Interface library and companion CLI tool to configure strongSwan IPsec over MySQL backend category: Console, Library, Network APIs, SQL@@ -45,7 +45,7 @@ , base >=4.7 && <5 , bytestring >=0.10 && <0.11 , data-default >=0.7 && <0.8- , failable >=1.1 && <1.2+ , failable >=1.1 && <1.3 , haskeline >=0.7 && <0.8 , io-streams >=1.5 && <1.6 , iproute >=1.7 && <1.8@@ -79,7 +79,7 @@ , base >=4.7 && <5 , bytestring >=0.10 && <0.11 , data-default >=0.7 && <0.8- , failable >=1.1 && <1.2+ , failable >=1.1 && <1.3 , haskeline >=0.7 && <0.8 , io-streams >=1.5 && <1.6 , iproute >=1.7 && <1.8@@ -109,7 +109,7 @@ , base >=4.7 && <5 , bytestring >=0.10 && <0.11 , data-default >=0.7 && <0.8- , failable >=1.1 && <1.2+ , failable >=1.1 && <1.3 , haskeline >=0.7 && <0.8 , io-streams >=1.5 && <1.6 , iproute >=1.7 && <1.8