{-# LANGUAGE FlexibleContexts #-} module CLI.Commands where import CLI.Commands.ChildSA import CLI.Commands.Common import CLI.Commands.Identity import CLI.Commands.PeerCfg import CLI.Commands.TrafficSelector import CLI.Types import Control.Lens ((&), (.=), (.~), use) import Control.Monad (void) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Maybe (runMaybeT) import Control.Monad.State.Strict (StateT, lift) import Data.Default (def) import Data.Maybe (fromMaybe) import Data.Text (unpack) import System.Console.StructuredCLI hiding (Commands) import StrongSwan.SQL commands :: Commands () commands = do command "advanced" "Configure individual elements manually" newLevel >+ do param "child-sa" "" string setChildSA >+ do cfgChildSA showChildSA exitCmd param "peer-cfg" "" string setPeerCfg >+ do cfgPeer showPeer exitCmd param "traffic-selector" "" parseTSId setTrafficSelector >+ do cfgTrafficSelector getLocalTrafficSelector showTrafficSelector exitCmd command "identity" "Configure an identity" setIdentityCfg >+ do cfgIdentity identity exitCmd exitCmd param "connection" "" string setConnection >+ do command "child-sa" "Configure child SA parameters" newLevel >+ do cfgChildSA exitCmd command "peer" "Configure peer parameters" newLevel >+ do cfgPeer exitCmd command "local" "Local endpoint configuration" newLevel >+ do command "traffic-selector" "Configure local traffic selector" newLevel >+ do cfgTrafficSelector getLocalTrafficSelector command "show" "Display local traffic selector's parameters" $ showTrafficSelector' getLocalTrafficSelector exitCmd cfgIdentity (ipsecSettings . getLocalIdentity) exitCmd command "remote" "Remote endpoint configuration" newLevel >+ do command "traffic-selector" "Configure remote traffic selector" newLevel >+ do cfgTrafficSelector getRemoteTrafficSelector command "show" "Display remote traffic selector's parameters" $ showTrafficSelector' getRemoteTrafficSelector exitCmd cfgIdentity (ipsecSettings . getRemoteIdentity) exitCmd showConnection cfgSecret (ipsecSettings . getLocalIdentity ) (ipsecSettings . getRemoteIdentity) command "remove" "Wipes out this connection from the DB" $ do db <- use dbContext ipsecCfg <- use ipsecSettings void . runMaybeT $ deleteIPSecSettings ipsecCfg db return $ LevelUp 1 exitCmd where setConnection name = do db <- use dbContext result <- runMaybeT $ findIPSecSettings name db let ipsec = fromMaybe def result ipsecSettings .= (ipsec & getIPSecCfgName .~ name) flush .= Just flushConnection return NewLevel flushConnection :: StateT AppState IO Action flushConnection = do ipsecCfg <- use ipsecSettings db <- use dbContext ipsec' <- lift $ writeIPSecSettings ipsecCfg db ipsecSettings .= ipsec' return NoAction showConnection :: Commands () showConnection = command "show" "display connection parameters" $ do name <- use $ ipsecSettings . getIPSecCfgName liftIO . putStrLn $ "IPSec connection - \'" ++ unpack name ++ "'" void showChildSA' void $ showPeer' liftIO $ putStr "Local " void $ showTrafficSelector' getLocalTrafficSelector liftIO $ putStr "Remote " showTrafficSelector' getRemoteTrafficSelector