Identity.hs

{-# 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