strongswan-sql 1.0.0.0 → 1.0.1.0

raw patch · 11 files changed

+530/−95 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• app/CLI/Commands.hs +7/−0
• app/CLI/Commands/Common.hs +13/−2
• app/CLI/Commands/Identity.hs +63/−0
• app/CLI/Types.hs +18/−1
• app/Main.hs +6/−2
• src/StrongSwan/SQL.hs +154/−2
• src/StrongSwan/SQL/Encoding.hs +38/−14
• src/StrongSwan/SQL/Lenses.hs +2/−0
• src/StrongSwan/SQL/Statements.hs +112/−29
• src/StrongSwan/SQL/Types.hs +114/−43
• strongswan-sql.cabal +3/−2

@@ -4,6 +4,7 @@  import CLI.Commands.ChildSA import CLI.Commands.Common+import CLI.Commands.Identity import CLI.Commands.PeerCfg import CLI.Commands.TrafficSelector import CLI.Types@@ -48,7 +49,13 @@           showTrafficSelector' getRemoteTrafficSelector       exitCmd     showConnection+    command "remove" "Wipes out this connection from the DB" $ do+      db       <- use dbContext+      ipsecCfg <- use ipsecSettings+      void . runMaybeT $ deleteIPSecSettings ipsecCfg db+      return NoAction     exitCmd+  cfgIdentity   where setConnection name = do           db <- use dbContext           result <- runMaybeT $ findIPSecSettings name db

@@ -9,23 +9,34 @@ import Control.Monad.Trans.Maybe           (MaybeT(..), runMaybeT) import Control.Monad.State.Strict          (StateT, lift) import Data.Bool                           (bool)-import Data.IP                             (IP)+import Data.ByteString.Char8               (ByteString)+import Data.IP                             (IP, IPv4, IPv6) import Data.List                           (find) import Data.Text                           (Text, pack) import Text.Read                           (readMaybe) import StrongSwan.SQL                      (SQLRow) import System.Console.StructuredCLI hiding (Commands) -import qualified StrongSwan.SQL as SQL+import qualified Data.ByteString.Char8 as B+import qualified StrongSwan.SQL        as SQL  string :: (Monad m) => String -> m (Maybe Text) string = return . Just . pack +bytes :: (Monad m) => String -> m (Maybe ByteString)+bytes = return . Just . B.pack+ integer :: (Monad m, Integral n ) => String -> m (Maybe n) integer = return . fmap fromIntegral . readMaybe @Integer  ipAddress :: (Monad m) => String -> m (Maybe IP) ipAddress = return . readMaybe++ipV4Address :: (Monad m) => String -> m (Maybe IPv4)+ipV4Address = return . readMaybe++ipV6Address :: (Monad m) => String -> m (Maybe IPv6)+ipV6Address = return . readMaybe  boolean :: (Monad m) => String -> String -> String -> m (Maybe Bool) boolean yes no str | str == yes = return $ Just True

@@ -0,0 +1,63 @@+{-# LANGUAGE FlexibleContexts #-}++module CLI.Commands.Identity where++import Control.Lens                        ((.=), use)+import Control.Monad                       (void)+import Control.Monad.Trans.Maybe           (MaybeT(..), runMaybeT)+import CLI.Commands.Common+import CLI.Types+import Data.Default                        (def)+import Data.Maybe                          (fromMaybe)+import Control.Monad.State.Strict          (StateT, lift)+import StrongSwan.SQL+import System.Console.StructuredCLI hiding (Commands)++secretType' :: (Monad m) => Validator m SharedSecretType+secretType' = return . fromName++cfgIdentity :: Commands ()+cfgIdentity =+  command "identity" "Identity configuration" newLevel >+ do+    command "any" "Matches any ID" (setIdentity $ AnyID Nothing) >+ do+      identityCmds+    param "ipv4" "<IPv4 address>" ipV4Address (setIdentity . IPv4AddrID Nothing) >+ do+      identityCmds+    param "ipv4" "<IPv6 address>" ipV6Address (setIdentity . IPv6AddrID Nothing) >+ do+      identityCmds++cfgSecret :: Commands ()+cfgSecret =+  param "shared-secret" "<shared secret>" bytes setSecret >+ do+    param "type" "<psk|eap|rsa|pin>" secretType' $ \sType -> do+      db    <- use dbContext+      ident <- use identity+      str   <- use secretStr+      let secret = def { _ssData = str, _ssType = sType }+      ident' <- lift $ addSecret ident secret db+      identity .= ident'+      return NoAction+        where setSecret str = do+                secretStr .= str+                return NewLevel++setIdentity :: Identity -> StateT AppState IO Action+setIdentity ident = do+  db <- use dbContext+  result <- runMaybeT $ findIdentityBySelf ident db+  identity .= fromMaybe ident result+  return NewLevel++removeIdent :: Commands ()+removeIdent =+  command "remove" "delete identity from DB and all associated secrets, etc" $ do+    db <- use dbContext+    ident <- use identity+    void . runMaybeT $ removeIdentity ident db+    return NoAction++identityCmds :: Commands ()+identityCmds = do+  removeIdent+  cfgSecret+  exitCmd

@@ -7,6 +7,7 @@ import Control.Monad.Failable       (Failable(..)) import Control.Monad.State.Strict   (StateT) import Control.Exception            (Exception)+import Data.ByteString              (ByteString) import Data.Char                    (toLower) import Data.Default import Data.Text                    (Text)@@ -36,6 +37,8 @@                   _options       :: Options,                   _dbContext     :: SQL.Context,                   _ipsecSettings :: SQL.IPSecSettings,+                  _identity      :: SQL.Identity,+                  _secretStr     :: ByteString,                   _flush         :: Maybe (StateT AppState IO Action)                 } @@ -110,7 +113,7 @@  instance Nameable SQL.AuthMethod where     nameOf = fmap toLower . show-    fromName "any"   = return SQL.Any+    fromName "any"   = return SQL.AnyAuth     fromName "rsa"   = return SQL.PubKey     fromName "psk"   = return SQL.PSK     fromName "eap"   = return SQL.EAP@@ -123,4 +126,18 @@     fromName "ipv4" = return SQL.IPv4AddrRange     fromName "ipv6" = return SQL.IPv6AddrRange     fromName str    = failure $ InvalidValue str++instance Nameable SQL.SharedSecretType where+    nameOf SQL.SharedIKE = "psk"+    nameOf SQL.SharedEAP = "eap"+    nameOf SQL.SharedRSA = "rsa"+    nameOf SQL.SharedPIN = "pin"+    fromName "psk" = return SQL.SharedIKE+    fromName "eap" = return SQL.SharedEAP+    fromName "rsa" = return SQL.SharedRSA+    fromName "pin" = return SQL.SharedPIN+    fromName str    = failure $ InvalidValue str+++ 

@@ -42,9 +42,13 @@         let state = AppState { _options       = options',                                _dbContext     = db,                                _ipsecSettings = def,-                               _flush         = Nothing }-        runCLI "strongswan SQL" def commands `evalStateT` state >>= hoist FatalError+                               _flush         = Nothing,+                               _identity      = def,+                               _secretStr     = "" }+        runCLI "strongswan SQL" cliSettings commands `evalStateT` state >>= hoist FatalError           where mkContext' Options{..} = SQL.mkContext _settings+                cliSettings = def { getHistory = Just ".strongswan-sql.history" }+ modifySettings :: (SQL.Settings -> SQL.Settings) -> ArgsParser () modifySettings = (settings %=) 

@@ -37,6 +37,9 @@                         writeIPSecSettings,                         findIPSecSettings,                         deleteIPSecSettings,+                        addSecret,+                        removeSecret,+                        removeIdentity, -- * Manual API -- | The different strongswan configuration elements are mapped to a Haskell type and they -- can be manually written or read from the SQL database. This offers utmost control in@@ -65,21 +68,31 @@                          writeChild2TSConfig,                         writeChildSAConfig,+                        writeIdentity,                         writeIKEConfig,                         writePeerConfig,                         writePeer2ChildConfig,+                        writeSharedSecret,+                        writeSSIdentity,                         writeTrafficSelector,                         lookupChild2TSConfig,                         findChildSAConfig,                         findChildSAConfigByName,+                        findIdentity,+                        findIdentityBySelf,                         findIKEConfig,                         findPeerConfig,                         findPeerConfigByName,                         findPeer2ChildConfig,+                        findSharedSecret,+                        findSSIdentity,                         findTrafficSelector,                         deleteChild2TSConfig,                         deleteChildSAConfig,+                        deleteIdentity,                         deleteIKEConfig,+                        deleteSharedSecret,+                        deleteSSIdentity,                         deletePeer2ChildConfig,                         deletePeerConfig, -- #Lenses#@@ -100,6 +113,7 @@                         CertPolicy(..),                         Context,                         EAPType(..),+                        Identity(..),                         IKEConfig(..),                         IPSecSettings(..),                         PeerConfig(..),@@ -108,6 +122,9 @@                         SAAction(..),                         SAMode(..),                         Settings(..),+                        SharedSecret(..),+                        SharedSecretIdentity(..),+                        SharedSecretType(..),                         SQL.OK(..),                         SQLRow,                         TrafficSelector(..),@@ -117,13 +134,13 @@  import Control.Concurrent.MVar      (MVar, newMVar, withMVar) import Control.Lens                 ((^.), (.=), makeLenses, use)-import Control.Monad                (void, when)+import Control.Monad                (mapM_, void, when) import Control.Monad.IO.Class       (MonadIO) import Control.Monad.Trans.Maybe    (MaybeT(..), runMaybeT) import Control.Monad.State.Strict   (MonadTrans, StateT, execStateT, get, lift) import Data.ByteString.Char8        (pack, unpack) import Data.Default                 (Default(..))-import Data.Maybe                   (isNothing, isJust, fromJust, listToMaybe)+import Data.Maybe                   (catMaybes, isNothing, isJust, fromJust, listToMaybe) import Data.Text                    (Text) import Database.MySQL.Base          (MySQLConn) import Control.Monad.Failable@@ -352,6 +369,50 @@                 tsCfgId <- MaybeT . return $ _tsId sel                 lift $ inContext deleteTrafficSelector tsCfgId +-- | Adds a shared secret to a given identity. If the identity doesn't exist it will get created.+-- If the identity already exists and it already has a secret of the same type, it will be overwritten.+-- This means there can only be one secret of any given type per identity (which makes sense of course+-- from strongswan's perspective).+addSecret :: (Failable m, MonadIO m) => Identity -> SharedSecret -> Context -> m Identity+addSecret identity secret context = do+  let ?context = context+  result      <- runMaybeT $ findIdentityBySelf' identity+  identity'   <- maybe newIdentity return result+  removeSecret identity' (_ssType secret) context+  Result {..} <- writeSharedSecret' secret+  void $ writeSSIdentity' SharedSecretIdentity { _sharedSecretId = lastModifiedKey,+                                                 _identityId     = fromJust $ getIdentityId identity' }+  return identity'+    where newIdentity = do+            Result {..} <- writeIdentity identity context+            return $ setIdentityId identity lastModifiedKey++-- | Removes a secret of the given type (if present) from the specified identity+removeSecret :: (Failable m, MonadIO m) => Identity -> SharedSecretType -> Context -> m ()+removeSecret identity sType context =+  void . runMaybeT $ do+    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+    mapM_ deleteSharedSecret' toDelete+    mapM_ deleteSSIdentity' ssIdentities'++-- | Removes an identity and its secrets and related entries altogether+removeIdentity :: (Failable m, MonadIO m) => Identity -> Context -> m ()+removeIdentity identity context =+  void . runMaybeT $ do+    let ?context = context+    identId      <- MaybeT . return $ getIdentityId identity+    ssIdentities <- findSSIdentity' identId+    mapM_ (deleteSharedSecret' . _sharedSecretId) ssIdentities+    mapM_ deleteSSIdentity' ssIdentities+    deleteIdentity' identId++-- manual API+ writeChildSAConfig :: (Failable m, MonadIO m) => ChildSAConfig -> Context -> m (Result Int) writeChildSAConfig cfg = withContext writeChildSAConfig''     where writeChildSAConfig'' context@Context_ { prepared_ = PreparedStatements {..}} =@@ -460,3 +521,94 @@     where deleteChild2TSConfig' Context_ { prepared_ = PreparedStatements {..}, ..} = do             ok@SQL.OK {..} <- SQL.executeStmt conn_ deleteC2TSStmt [toSQL $ toInt iD]             return Result { lastModifiedKey = okLastInsertID, response = ok }++writeIdentity :: (Failable m, MonadIO m) => Identity -> Context -> m (Result Int)+writeIdentity identity = withContext writeIdentity''+    where writeIdentity'' context@Context_ { prepared_ = PreparedStatements {..}, ..} =+            writeRow context updateIdentityStmt createIdentityStmt getIdentityId identity++findIdentity :: (Failable m, MonadIO m) => Int -> Context -> m Identity+findIdentity iD context =+  justOne ("findIdentity" <> Text.pack (show iD)) =<<+    retrieveRows findIdentityStmt [toSQL $ toInt iD] context++findIdentityBySelf :: (Failable m, MonadIO m) => Identity -> Context -> m Identity+findIdentityBySelf identity context =+  justOne ("findIdentityBySelf" <> Text.pack (show identity)) =<<+    retrieveRows findIdentityBySelfStmt (toValues identity) context++findIdentityBySelf' :: (Failable m, MonadIO m, ?context::Context ) => Identity -> m Identity+findIdentityBySelf' = flip findIdentityBySelf ?context++deleteIdentity :: (Failable m, MonadIO m) => Int -> Context -> m (Result Int)+deleteIdentity iD = withContext deleteIdentity''+    where deleteIdentity'' Context_ { prepared_ = PreparedStatements {..}, ..} = do+            ok@SQL.OK {..} <- SQL.executeStmt conn_ deleteIdentityStmt [toSQL $ toInt iD]+            return Result { lastModifiedKey = okLastInsertID, response = ok }++deleteIdentity' :: (Failable m, MonadIO m, ?context::Context) => Int -> m (Result Int)+deleteIdentity' = flip deleteIdentity ?context++writeSharedSecret :: (Failable m, MonadIO m) => SharedSecret -> Context -> m (Result Int)+writeSharedSecret ss = withContext writeSS+    where writeSS context@Context_ { prepared_ = PreparedStatements{..}, ..} =+            writeRow context updateSharedSecretStmt createSharedSecretStmt _ssId ss++writeSharedSecret' :: (Failable m, MonadIO m, ?context::Context) => SharedSecret -> m (Result Int)+writeSharedSecret' = flip writeSharedSecret ?context++findSharedSecret :: (Failable m, MonadIO m) => Int -> Context -> m SharedSecret+findSharedSecret iD context =+  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++deleteSharedSecret :: (Failable m, MonadIO m) => Int -> Context -> m (Result Int)+deleteSharedSecret iD = withContext deleteSS+    where deleteSS Context_ { prepared_ = PreparedStatements {..}, ..} = do+            ok@SQL.OK {..} <- SQL.executeStmt conn_ deleteSharedSecretStmt [toSQL $ toInt iD]+            return Result { lastModifiedKey = okLastInsertID, response = ok }++deleteSharedSecret' :: (Failable m, MonadIO m, ?context::Context) => Int -> m (Result Int)+deleteSharedSecret' = flip deleteSharedSecret ?context++writeSSIdentity :: (Failable m, MonadIO m) => SharedSecretIdentity -> Context -> m (Result (Int, Int))+writeSSIdentity ssIdent@SharedSecretIdentity {..} = withContext writeSSIdentity''+    where writeSSIdentity'' Context_{ prepared_ = PreparedStatements {..}, ..} = do+            result@SQL.OK {..} <- SQL.executeStmt conn_ updateSSIdentityStmt $ sqlValues ++ selector+            result' <- if okAffectedRows == 0+                         then SQL.executeStmt conn_ createSSIdentityStmt sqlValues+                         else return result+            return Result { lastModifiedKey = (_sharedSecretId, _identityId),+                            response = result' }+          sqlValues = toValues ssIdent+          selector  = toSQL . toInt <$> [_sharedSecretId, _identityId]++writeSSIdentity' :: (Failable m, MonadIO m, ?context::Context) => SharedSecretIdentity -> m (Result (Int, Int))+writeSSIdentity' = flip writeSSIdentity ?context++findSSIdentity :: (Failable m, MonadIO m) => Int -> Context -> m [SharedSecretIdentity]+findSSIdentity iD = retrieveRows findSSIdentityStmt [toSQL . toInt $ iD]++findSSIdentity' :: (Failable m, MonadIO m, ?context::Context) => Int -> m [SharedSecretIdentity]+findSSIdentity' = flip findSSIdentity ?context++deleteSSIdentity :: (Failable m, MonadIO m) => SharedSecretIdentity -> Context -> m (Result (Int, Int))+deleteSSIdentity SharedSecretIdentity {..} = withContext deleteSSIdentity''+    where deleteSSIdentity'' Context_ { prepared_ = PreparedStatements {..}, ..} = do+            ok@SQL.OK {..} <- SQL.executeStmt conn_ deleteSSIdentityStmt values+            return Result { lastModifiedKey = (_sharedSecretId, _identityId), response = ok }+          values = toSQL . toInt <$> [_sharedSecretId, _identityId]++deleteSSIdentity' :: (Failable m, MonadIO m, ?context::Context) => SharedSecretIdentity -> m (Result (Int, Int))+deleteSSIdentity' = flip deleteSSIdentity ?context++++++++

@@ -54,22 +54,25 @@     fromSQL SQL.MySQLNull         = NullChar     fromSQL v                     = throw $ InvalidValueForType "VarChar" (show v) +fromId :: SQL.MySQLValue -> Maybe Int+fromId = return . fromInt . fromSQL+ instance SQLRow Identity where-    toValues AnyID                  = [toSQL $ toTinyInt (0::Word8),  toSQL $ toVarBinary "%any"]-    toValues (IPv4AddrID v4)        = [toSQL $ toTinyInt (1::Word8),  toSQL $ toVarBinary v4]-    toValues (NameID str)           = [toSQL $ toTinyInt (2::Word8),  toSQL $ toVarBinary str]-    toValues (EmailID local domain) = [toSQL $ toTinyInt (3::Word8),  toSQL $ toVarBinary (local ++ '@':domain)]-    toValues (IPv6AddrID v6)        = [toSQL $ toTinyInt (5::Word8),  toSQL $ toVarBinary v6]-    toValues (ASN1ID elements)      = [toSQL $ toTinyInt (9::Word8),  toSQL $ toVarBinary (encodeASN1' DER elements)]-    toValues (OpaqueID bytes)       = [toSQL $ toTinyInt (11::Word8), toSQL $ toVarBinary bytes]+    toValues (AnyID _)                = [toSQL $ toTinyInt (0::Word8),  toSQL $ toVarBinary "%any"]+    toValues (IPv4AddrID _ v4)        = [toSQL $ toTinyInt (1::Word8),  toSQL $ toVarBinary v4]+    toValues (NameID _ str)           = [toSQL $ toTinyInt (2::Word8),  toSQL $ toVarBinary str]+    toValues (EmailID _ local domain) = [toSQL $ toTinyInt (3::Word8),  toSQL $ toVarBinary (local ++ '@':domain)]+    toValues (IPv6AddrID _ v6)        = [toSQL $ toTinyInt (5::Word8),  toSQL $ toVarBinary v6]+    toValues (ASN1ID _ elements)      = [toSQL $ toTinyInt (9::Word8),  toSQL $ toVarBinary (encodeASN1' DER elements)]+    toValues (OpaqueID _ bytes)       = [toSQL $ toTinyInt (11::Word8), toSQL $ toVarBinary bytes] -    fromValues [SQL.MySQLInt8U 0, _] = AnyID-    fromValues [SQL.MySQLInt8U 1, v] = IPv4AddrID . fromVarBinary $ fromSQL v-    fromValues [SQL.MySQLInt8U 2, v] = NameID . fromVarBinary $ fromSQL v-    fromValues [SQL.MySQLInt8U 3, v] = uncurry EmailID . parseEmail . fromVarBinary $ fromSQL v-    fromValues [SQL.MySQLInt8U 5, v] = IPv6AddrID . fromVarBinary $ fromSQL v-    fromValues [SQL.MySQLInt8U 9, v] = ASN1ID . either throw id . decodeASN1' DER . fromVarBinary $ fromSQL v-    fromValues v                     = throw $ SQLValuesMismatch "Identity" (show v)+    fromValues [iD, SQL.MySQLInt8U 0, _] = AnyID      (fromId iD)+    fromValues [iD, SQL.MySQLInt8U 1, v] = IPv4AddrID (fromId iD) . fromVarBinary $ fromSQL v+    fromValues [iD, SQL.MySQLInt8U 2, v] = NameID     (fromId iD) . fromVarBinary $ fromSQL v+    fromValues [iD, SQL.MySQLInt8U 3, v] = uncurry (EmailID $ fromId iD)  . parseEmail . fromVarBinary $ fromSQL v+    fromValues [iD, SQL.MySQLInt8U 5, v] = IPv6AddrID (fromId iD) . fromVarBinary $ fromSQL v+    fromValues [iD, SQL.MySQLInt8U 9, v] = ASN1ID     (fromId iD) . either throw id . decodeASN1' DER . fromVarBinary $ fromSQL v+    fromValues v                         = throw $ SQLValuesMismatch "Identity" (show v)  parseEmail :: ByteString -> (String, String) parseEmail = second (drop 1) . span (/= '@') . unpack@@ -266,6 +269,27 @@                             c2tsTrafficSelectorKind  = fromTinyInt $ fromSQL trafficSelectorKind                       }     fromValues xs = throw $ SQLValuesMismatch "Child2TSConfig" (show xs)++instance SQLRow SharedSecret where+    toValues SharedSecret {..} = [+        toSQL $ toTinyInt _ssType,+        toSQL $ toVarBinary _ssData ]+    fromValues (iD : sharedSecretType : sharedSecretData : []) =+        SharedSecret {+              _ssId   = return . fromInt $ fromSQL iD,+              _ssType = fromTinyInt $ fromSQL sharedSecretType,+              _ssData = fromVarBinary $ fromSQL sharedSecretData+        }+    fromValues xs = throw $ SQLValuesMismatch "SharedSecret" (show xs)++instance SQLRow SharedSecretIdentity where+    toValues SharedSecretIdentity {..} = toSQL . toInt <$> [_sharedSecretId, _identityId]+    fromValues [ssId, identityId] = SharedSecretIdentity {+                                          _sharedSecretId = fromInt $ fromSQL ssId,+                                          _identityId     = fromInt $ fromSQL identityId+                                    }+    fromValues xs = throw $ SQLValuesMismatch "SharedSecretIdentity" (show xs)+  encodeHex :: ByteString -> String encodeHex = B.foldr showHex ""

@@ -9,4 +9,6 @@ makeLenses ''ChildSAConfig makeLenses ''PeerConfig makeLenses ''TrafficSelector+makeLenses ''SharedSecret+makeLenses ''SharedSecretIdentity makeLenses ''IPSecSettings

@@ -61,6 +61,28 @@                         findC2TSStatement,                         deleteC2TSStatement] +    [createIdentity, updateIdentity, findIdentity, findIdentityBySelf, deleteIdentity] <-+        initializeWith createIdentityTable+                        [createIdentityStatement,+                         updateIdentityStatement,+                         findIdentityStatement,+                         findIdentityBySelfStatement,+                         deleteIdentityStatement]++    [createSharedSecret, updateSharedSecret, findSharedSecret, deleteSharedSecret] <-+        initializeWith createSharedSecretTable+                        [createSharedSecretStatement,+                         updateSharedSecretStatement,+                         findSharedSecretStatement,+                         deleteSharedSecretStatement]++    [createSSIdentity, updateSSIdentity, findSSIdentity, deleteSSIdentity] <-+        initializeWith createSSIdentityTable+                        [createSSIdentityStatement,+                         updateSSIdentityStatement,+                         findSSIdentityStatement,+                         deleteSSIdentityStatement]+     [createIPSec, findIPSec, deleteIPSec] <-         initializeWith createIPSecTableStatement                        [createIPSecStatement,@@ -68,35 +90,48 @@                         deleteIPSecStatement]      return PreparedStatements  {-        updateChildSAStmt     = updateChildSA,-        createChildSAStmt     = createChildSA,-        findChildSAByNameStmt = findChildSAByName,-        findChildSAStmt       = findChildSA,-        deleteChildSAStmt     = deleteChildSA,-        updateIKEStmt         = updateIKE,-        createIKEStmt         = createIKE,-        findIKEStmt           = findIKE,-        deleteIKEStmt         = deleteIKE,-        updatePeerStmt        = updatePeer,-        createPeerStmt        = createPeer,-        findPeerStmt          = findPeer,-        findPeerByNameStmt    = findPeerByName,-        deletePeerStmt        = deletePeer,-        updateP2CStmt         = updateP2C,-        createP2CStmt         = createP2C,-        findP2CStmt           = findP2C,-        deleteP2CStmt         = deleteP2C,-        findTSStmt            = findTS,-        createTSStmt          = createTS,-        updateTSStmt          = updateTS,-        deleteTSStmt          = deleteTS,-        updateC2TSStmt        = updateC2TS,-        createC2TSStmt        = createC2TS,-        findC2TSStmt          = findC2TS,-        deleteC2TSStmt        = deleteC2TS,-        createIPSecStmt       = createIPSec,-        findIPSecStmt         = findIPSec,-        deleteIPSecStmt       = deleteIPSec+        updateChildSAStmt      = updateChildSA,+        createChildSAStmt      = createChildSA,+        findChildSAByNameStmt  = findChildSAByName,+        findChildSAStmt        = findChildSA,+        deleteChildSAStmt      = deleteChildSA,+        updateIKEStmt          = updateIKE,+        createIKEStmt          = createIKE,+        findIKEStmt            = findIKE,+        deleteIKEStmt          = deleteIKE,+        updatePeerStmt         = updatePeer,+        createPeerStmt         = createPeer,+        findPeerStmt           = findPeer,+        findPeerByNameStmt     = findPeerByName,+        deletePeerStmt         = deletePeer,+        updateP2CStmt          = updateP2C,+        createP2CStmt          = createP2C,+        findP2CStmt            = findP2C,+        deleteP2CStmt          = deleteP2C,+        findTSStmt             = findTS,+        createTSStmt           = createTS,+        updateTSStmt           = updateTS,+        deleteTSStmt           = deleteTS,+        updateC2TSStmt         = updateC2TS,+        createC2TSStmt         = createC2TS,+        findC2TSStmt           = findC2TS,+        deleteC2TSStmt         = deleteC2TS,+        updateIdentityStmt     = updateIdentity,+        createIdentityStmt     = createIdentity,+        findIdentityStmt       = findIdentity,+        findIdentityBySelfStmt = findIdentityBySelf,+        deleteIdentityStmt     = deleteIdentity,+        updateSharedSecretStmt = updateSharedSecret,+        createSharedSecretStmt = createSharedSecret,+        findSharedSecretStmt   = findSharedSecret,+        deleteSharedSecretStmt = deleteSharedSecret,+        updateSSIdentityStmt   = updateSSIdentity,+        createSSIdentityStmt   = createSSIdentity,+        findSSIdentityStmt     = findSSIdentity,+        deleteSSIdentityStmt   = deleteSSIdentity,+        createIPSecStmt        = createIPSec,+        findIPSecStmt          = findIPSec,+        deleteIPSecStmt        = deleteIPSec     }  prepare :: (?conn :: MySQLConn, Failable m, MonadIO m) => SQL.Query -> m SQL.StmtID@@ -197,6 +232,54 @@  deleteC2TSStatement :: SQL.Query deleteC2TSStatement = "DELETE FROM child_config_traffic_selector WHERE child_cfg = ?;"++createSharedSecretTable :: SQL.Query+createSharedSecretTable = "CREATE TABLE shared_secrets (`id` int(10) unsigned NOT NULL auto_increment, `type` tinyint(3) unsigned NOT NULL, `data` varbinary(256) NOT NULL, PRIMARY KEY (`id`)) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;"++createSharedSecretStatement :: SQL.Query+createSharedSecretStatement = "INSERT INTO shared_secrets (type, data) VALUES (?, ?);"++updateSharedSecretStatement :: SQL.Query+updateSharedSecretStatement = "UPDATE shared_secrets SET type = ?, data = ? WHERE id = ?;"++findSharedSecretStatement :: SQL.Query+findSharedSecretStatement = "SELECT * FROM shared_secrets WHERE id = ?;"++deleteSharedSecretStatement :: SQL.Query+deleteSharedSecretStatement = "DELETE FROM shared_secrets WHERE id = ?;"++createIdentityTable :: SQL.Query+createIdentityTable = "CREATE TABLE `identities` (`id` int(10) unsigned NOT NULL auto_increment, `type` tinyint(4) unsigned NOT NULL, `data` varbinary(64) NOT NULL, PRIMARY KEY (`id`), UNIQUE (`type`, `data`)) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;"++createIdentityStatement  :: SQL.Query+createIdentityStatement = "INSERT INTO identities (type, data) VALUES (?, ?);"++updateIdentityStatement :: SQL.Query+updateIdentityStatement = "UPDATE identities SET type = ?, data = ? WHERE id = ?;"++findIdentityStatement :: SQL.Query+findIdentityStatement = "SELECT * FROM identities WHERE id = ?;"++findIdentityBySelfStatement :: SQL.Query+findIdentityBySelfStatement = "SELECT * FROM identities WHERE type = ? AND data = ?;"++deleteIdentityStatement :: SQL.Query+deleteIdentityStatement = "DELETE FROM identities WHERE id = ?;"++createSSIdentityTable  :: SQL.Query+createSSIdentityTable = "CREATE TABLE shared_secret_identity (`shared_secret` int(10) unsigned NOT NULL, `identity` int(10) unsigned NOT NULL, PRIMARY KEY (`shared_secret`, `identity`)) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;"++createSSIdentityStatement :: SQL.Query+createSSIdentityStatement = "INSERT INTO shared_secret_identity (shared_secret, identity) VALUES (?, ?);"++updateSSIdentityStatement :: SQL.Query+updateSSIdentityStatement = "UPDATE shared_secret_identity SET shared_secret = ?, identity = ? WHERE shared_secret = ? AND identity = ?;"++findSSIdentityStatement :: SQL.Query+findSSIdentityStatement = "SELECT * from shared_secret_identity WHERE identity = ?;"++deleteSSIdentityStatement :: SQL.Query+deleteSSIdentityStatement = "DELETE FROM shared_secret_identity WHERE shared_secret = ? AND identity = ?;"  createIPSecTableStatement :: SQL.Query createIPSecTableStatement = "CREATE TABLE `ipsec_configs` (`name` varchar(64) NOT NULL, `child_cfg` int(10) unsigned NOT NULL, `peer_cfg` int(10) unsigned NOT NULL, `ike_cfg` int(10) unsigned NOT NULL, `local_ts` int(10) unsigned NOT NULL, `remote_ts` int(10) unsigned NOT NULL, PRIMARY KEY (`name`)) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;"

@@ -29,6 +29,7 @@            | UnknownEAPType Int            | UnknownTrafficSelectorType Int            | UnknownTrafficSelectorKind Int+           | UnknownSharedSecretType Int            | InvalidValueForType String String            | SQLValuesMismatch String String            | NotFound Text@@ -66,14 +67,36 @@   toEnum 60  = UTF32   toEnum x   = throw $ UnknownCharacterEncoding x -data Identity = AnyID                 -- Matches any ID (/%any/)-              | IPv4AddrID IPv4       -- IPv4 Address-              | NameID String         -- Fully qualified Domain Name-              | EmailID String String -- ^ RFC 822 Email Address /mailbox/@/domain/-              | IPv6AddrID IPv6       -- IPv6 Address-              | ASN1ID [ASN1]-              | OpaqueID ByteString   -- Opaque octet string as ID+data Identity = AnyID (Maybe Int)                 -- Matches any ID (/%any/)+              | IPv4AddrID (Maybe Int) IPv4       -- IPv4 Address+              | NameID (Maybe Int) String         -- Fully qualified Domain Name+              | EmailID (Maybe Int) String String -- ^ RFC 822 Email Address /mailbox/@/domain/+              | IPv6AddrID (Maybe Int) IPv6       -- IPv6 Address+              | ASN1ID (Maybe Int) [ASN1]         -- DER encoded ASN.1 distinguished name+              | OpaqueID (Maybe Int) ByteString   -- Opaque octet string as ID+              deriving Show +getIdentityId :: Identity -> Maybe Int+getIdentityId (AnyID iD)        = iD+getIdentityId (IPv4AddrID iD _) = iD+getIdentityId (NameID iD _)     = iD+getIdentityId (EmailID iD _ _)  = iD+getIdentityId (IPv6AddrID iD _) = iD+getIdentityId (ASN1ID iD _)     = iD+getIdentityId (OpaqueID iD _)   = iD++setIdentityId :: Identity -> Int -> Identity+setIdentityId (AnyID _)        iD = AnyID (Just iD)+setIdentityId (IPv4AddrID _ x) iD = IPv4AddrID (Just iD) x+setIdentityId (NameID _ x)     iD = NameID (Just iD) x+setIdentityId (EmailID _ x y)  iD = EmailID (Just iD) x y+setIdentityId (IPv6AddrID _ x) iD = IPv6AddrID (Just iD) x+setIdentityId (ASN1ID _ x)     iD = ASN1ID (Just iD) x+setIdentityId (OpaqueID _ x)   iD = OpaqueID (Just iD) x++instance Default Identity where+    def = AnyID Nothing+ data Value (a :: k -> SQL.MySQLValue) where     TinyInt   :: Word8      -> Value 'SQL.MySQLInt8U     SmallInt  :: Word16     -> Value 'SQL.MySQLInt16U@@ -131,6 +154,10 @@   toTinyInt = toSQLEnum   fromTinyInt = fromSQLEnum +instance TinyInt SharedSecretType where+  toTinyInt = toSQLEnum+  fromTinyInt = fromSQLEnum+ class SmallInt a where     toSmallInt   :: a -> Value 'SQL.MySQLInt16U     fromSmallInt :: Value 'SQL.MySQLInt16U -> a@@ -236,7 +263,7 @@     toEnum 2 = NeverSend     toEnum x = throw $ UnknownCertPolicy x -data AuthMethod = Any+data AuthMethod = AnyAuth                 | PubKey                 | PSK                 | EAP@@ -244,13 +271,13 @@                 deriving (Eq, Show)  instance Enum AuthMethod where-    fromEnum Any    = 0-    fromEnum PubKey = 1-    fromEnum PSK    = 2-    fromEnum EAP    = 3-    fromEnum XAUTH  = 4+    fromEnum AnyAuth = 0+    fromEnum PubKey  = 1+    fromEnum PSK     = 2+    fromEnum EAP     = 3+    fromEnum XAUTH   = 4 -    toEnum 0 = Any+    toEnum 0 = AnyAuth     toEnum 1 = PubKey     toEnum 2 = PSK     toEnum 3 = EAP@@ -318,6 +345,23 @@       toEnum 3 = RemoteDynamicTS       toEnum x = throw $ UnknownTrafficSelectorKind x +data SharedSecretType = SharedIKE+                      | SharedEAP+                      | SharedRSA+                      | SharedPIN+                      deriving (Eq, Show)++instance Enum SharedSecretType where+      fromEnum SharedIKE = 1+      fromEnum SharedEAP = 2+      fromEnum SharedRSA = 3+      fromEnum SharedPIN = 4+      toEnum 1 = SharedIKE+      toEnum 2 = SharedEAP+      toEnum 3 = SharedRSA+      toEnum 4 = SharedPIN+      toEnum x = throw $ UnknownSharedSecretType x+ data IKEConfig = IKEConfig {                     _ikeId            :: Maybe Int,                     _ikeReqCert       :: Bool,@@ -453,36 +497,63 @@                             c2tsTrafficSelectorKind  :: TrafficSelectorKind                       } deriving Show +data SharedSecret = SharedSecret {+                        _ssId   :: Maybe Int,+                        _ssType :: SharedSecretType,+                        _ssData :: ByteString+                      } deriving Show++instance Default SharedSecret where+    def = SharedSecret Nothing SharedIKE ""++data SharedSecretIdentity = SharedSecretIdentity {+                                  _sharedSecretId :: Int,+                                  _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,-                              createIPSecStmt       :: SQL.StmtID,-                              findIPSecStmt         :: SQL.StmtID,-                              deleteIPSecStmt       :: SQL.StmtID+                              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  -- | The managed IPsec configuration type encompasses a complete set of elements which are pushed and interlinked

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: df70c57c8e5221e054346a59c78abfe9477cb3ae1e175f69d1def6b29fe3f9da+-- hash: 60f2148a71514af362ac55216959613c573fd36159eb6446d93d1a2bf439a397  name:           strongswan-sql-version:        1.0.0.0+version:        1.0.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@@ -65,6 +65,7 @@       CLI.Commands       CLI.Commands.ChildSA       CLI.Commands.Common+      CLI.Commands.Identity       CLI.Commands.PeerCfg       CLI.Commands.TrafficSelector   hs-source-dirs: