strongswan-sql 1.2.0.0 → 1.2.1.0

raw patch · 2 files changed

+66/−9 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• src/StrongSwan/SQL.hs +64/−7
• strongswan-sql.cabal +2/−2

@@ -66,6 +66,14 @@ -- * __Traffic Selectors__: These are independent values linked to a Child SA by means of a -- 'Child2TSConfig' type. --+-- The manual API consists mainly of one @writeXXX@, @findXXX@, @lookupXXX@ and a @deleteXXX@+-- function for each object to be stored as an SQL row in its respective table. The @writeXXX@+-- functions trigger an insertion or an update of the given row in the SQL database depending+-- on whether the given object owns a key already or not (usually an ID). The search functions+-- (@findXXX@ and @lookupXXX@) perform a search in the DB for the given key. The difference is+-- that a @findXXX@ will trigger a 'failure' in the 'Failable' context with a 'NotFound' error+-- and that the @lookupXXX@ functions simply return 'Nothing' if a key doesn't exist in the DB+-- (they can of course trigger other errors in the Failable context)                          writeChild2TSConfig,                         writeChildSAConfig,@@ -88,6 +96,14 @@                         findSharedSecret,                         findSSIdentity,                         findTrafficSelector,+                        lookupChildSAConfig,+                        lookupIdentity,+                        lookupIdentityBySelf,+                        lookupIKEConfig,+                        lookupPeerConfig,+                        lookupPeer2ChildConfig,+                        lookupSharedSecret,+                        lookupTrafficSelector,                         deleteChild2TSConfig,                         deleteChildSAConfig,                         deleteIdentity,@@ -114,6 +130,7 @@                         CertPolicy(..),                         Context,                         EAPType(..),+                        Error(..),                         Identity(..),                         IKEConfig(..),                         IPSecSettings(..),@@ -237,10 +254,9 @@       return Result { lastModifiedKey = fromJust $ lens row, response = ok }         where sqlValues = toValues row -justOne :: (Failable m, Show a) => Text -> [a] -> m a-justOne tag xs@(_:_:_) = failure . MultipleResults tag $ show xs-justOne tag []          = failure $ NotFound tag-justOne _ [x]           = return x+justOne :: (Failable m, Show a) => Text -> [a] -> m (Maybe a)+justOne tag xs@(_:_:_)  = failure . MultipleResults tag $ show xs+justOne _ xs            = return $ listToMaybe xs  -- | Pushes an IPsec configuration into the DB specified in the given context. Note that if there are any -- existing elements in the configuration, they are first released (and their inter relationships in the@@ -303,17 +319,26 @@             lens .= ident'             return ident' +notFound :: (Failable m, MonadIO m) => Text -> Maybe a -> m a+notFound txt = maybe (failure $ NotFound txt) return+ -- | Search for an IPsec connection configuration by its unique name. Take note of the 'Failable' context, -- which means that unless it is desired that this function throws an asynchronous exception upon not finding -- a configuration, you probably want to run this inside a monadic transformer such as 'MaybeT' or 'ExceptT' findIPSecSettings :: (Failable m, MonadIO m) => Text -> Context -> m IPSecSettings-findIPSecSettings name context = do-  xs <- failableIO $ do+findIPSecSettings name context =  notFound ("IPSecSettings" <> name) =<< lookupIPSecSettings name context++-- | Lookup an IPsec connection configuration by its unique name. Returns @Nothing@ if the connection+-- is not found. Other errors are reported according to the Failable context the function+-- is called on ('MaybeT', 'ExceptT', 'IO', etc).+lookupIPSecSettings :: (Failable m, MonadIO m) => Text -> Context -> m (Maybe IPSecSettings)+lookupIPSecSettings name context = runMaybeT $ do+  xs <- MaybeT . failableIO $ do           (_,stream) <- withMVar context $             \Context_ {prepared_ = PreparedStatements {..}, ..} ->               SQL.queryStmt conn_ findIPSecStmt [toSQL . toVarChar $ Just name]           listToMaybe <$> Stream.toList stream-  maybe (failure . NotFound $ "IPSecSettings " <> name) mkIPSecSettings xs+  mkIPSecSettings xs     where mkIPSecSettings [cfgName, childCfgId, peerId, ikeCfgId, lTSId, rTSId, lId, rId] = do             let ?context = context             childCfg <- findChildSAConfig'   $ sql2Int childCfgId@@ -449,6 +474,10 @@  findChildSAConfig :: (Failable m, MonadIO m) => Int -> Context -> m ChildSAConfig findChildSAConfig iD context =+  notFound ("ChildSA" <> Text.pack (show iD)) =<< lookupChildSAConfig iD context++lookupChildSAConfig :: (Failable m, MonadIO m) => Int -> Context -> m (Maybe ChildSAConfig)+lookupChildSAConfig iD context =   justOne ("Child SA " <> Text.pack (show iD)) =<<     retrieveRows findChildSAStmt [toSQL $ toInt iD] context @@ -474,6 +503,10 @@  findIKEConfig :: (Failable m, MonadIO m) => Int -> Context -> m IKEConfig findIKEConfig iD context =+  notFound ("IKEConfig " <> Text.pack (show iD)) =<< lookupIKEConfig iD context++lookupIKEConfig :: (Failable m, MonadIO m) => Int -> Context -> m (Maybe IKEConfig)+lookupIKEConfig iD context =   justOne ("IKEConfig " <> Text.pack (show iD)) =<<     retrieveRows findIKEStmt [toSQL $ toInt iD] context @@ -502,6 +535,10 @@  findPeerConfig :: (Failable m, MonadIO m) => Int -> Context -> m PeerConfig findPeerConfig iD context =+  notFound ("PeerConfig " <> Text.pack (show iD)) =<< lookupPeerConfig iD context++lookupPeerConfig :: (Failable m, MonadIO m) => Int -> Context -> m (Maybe PeerConfig)+lookupPeerConfig iD context =   justOne ("PeerConfig " <> Text.pack (show iD)) =<<     retrieveRows findPeerStmt [toSQL $ toInt iD] context @@ -528,6 +565,10 @@  findPeer2ChildConfig :: (Failable m, MonadIO m) => Int -> Int -> Context -> m Peer2ChildConfig findPeer2ChildConfig peerId childId context =+  notFound ("Peer2Child " <> Text.pack (show peerId)) =<< lookupPeer2ChildConfig peerId childId context++lookupPeer2ChildConfig :: (Failable m, MonadIO m) => Int -> Int -> Context -> m (Maybe Peer2ChildConfig)+lookupPeer2ChildConfig peerId childId context =   justOne ("Peer2Child " <> Text.pack (show peerId) <> " - " <> Text.pack (show childId)) =<<     retrieveRows findP2CStmt (toSQL.toInt <$> [peerId, childId]) context @@ -560,6 +601,10 @@  findTrafficSelector :: (Failable m, MonadIO m) => Int -> Context -> m TrafficSelector findTrafficSelector iD context =+  notFound ("TrafficSelector " <> Text.pack (show iD)) =<< lookupTrafficSelector iD context++lookupTrafficSelector :: (Failable m, MonadIO m) => Int -> Context -> m (Maybe TrafficSelector)+lookupTrafficSelector iD context =   justOne ("TrafficSelector " <> Text.pack (show iD)) =<<     retrieveRows findTSStmt [toSQL $ toInt iD] context @@ -603,6 +648,10 @@  findIdentity :: (Failable m, MonadIO m) => Int -> Context -> m Identity findIdentity iD context =+  notFound ("findIdentity" <> Text.pack (show iD)) =<< lookupIdentity iD context++lookupIdentity :: (Failable m, MonadIO m) => Int -> Context -> m (Maybe Identity)+lookupIdentity iD context =   justOne ("findIdentity" <> Text.pack (show iD)) =<<     retrieveRows findIdentityStmt [toSQL $ toInt iD] context @@ -611,6 +660,10 @@  findIdentityBySelf :: (Failable m, MonadIO m) => Identity -> Context -> m Identity findIdentityBySelf identity context =+  notFound ("findIdentityBySelf" <> Text.pack (show identity)) =<< lookupIdentityBySelf identity context++lookupIdentityBySelf :: (Failable m, MonadIO m) => Identity -> Context -> m (Maybe Identity)+lookupIdentityBySelf identity context =   justOne ("findIdentityBySelf" <> Text.pack (show identity)) =<<     retrieveRows findIdentityBySelfStmt (toValues identity) context @@ -636,6 +689,10 @@  findSharedSecret :: (Failable m, MonadIO m) => Int -> Context -> m SharedSecret findSharedSecret iD context =+  notFound ("SharedSecret" <> Text.pack (show iD)) =<< lookupSharedSecret iD context++lookupSharedSecret :: (Failable m, MonadIO m) => Int -> Context -> m (Maybe SharedSecret)+lookupSharedSecret iD context =   justOne ("SharedSecret" <> Text.pack (show iD)) =<<     retrieveRows findSharedSecretStmt [toSQL . toInt $ iD] context 

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 6f32d30a00fb61271491341c0c55cdade3033598fbb9b665676f78315947f5ae+-- hash: cd5f9b6d39a470e19052b77e99316e5bbbf3309eed049403673cca5170192a8f  name:           strongswan-sql-version:        1.2.0.0+version:        1.2.1.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