Common.hs

-- Common.hs: hOpenPGP-tools common functions
-- Copyright © 2012-2014  Clint Adams
--
-- vim: softtabstop=4:shiftwidth=4:expandtab
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as
-- published by the Free Software Foundation, either version 3 of the
-- License, or (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

module HOpenPGP.Tools.Common (
    banner
  , versioner
  , warranty
  , keyMatchesFingerprint
  , keyMatchesEightOctetKeyId
  , keyMatchesExactUIDString
  , keyMatchesUIDSubString
  , keyMatchesPKPred
) where

import Paths_hopenpgp_tools (version)
import Data.Version (showVersion)

import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint)
import Codec.Encryption.OpenPGP.Types
import Control.Lens ((^..))
import Data.Char (toLower)
import Data.Data.Lens (biplate)
import Data.List (isInfixOf)
import Data.Monoid ((<>))
import Options.Applicative.Builder (help, infoOption, long, short)
import Options.Applicative.Types (Parser)

banner :: String -> String
{-# INLINE banner #-}
banner name = name ++ " (hopenpgp-tools) " ++ showVersion version ++ "\n\
     \Copyright (C) 2012-2014  Clint Adams"

warranty :: String -> String
{-# INLINE warranty #-}
warranty name = name ++ " comes with ABSOLUTELY NO WARRANTY.\n\
     \This is free software, and you are welcome to redistribute it\n\
     \under certain conditions."

versioner :: Parser (a -> a)
{-# INLINE versioner #-}
versioner = infoOption (showVersion version) $
    long "version"
   <> short 'V'
   <> help "Show version information"

keyMatchesFingerprint :: Bool -> TK -> TwentyOctetFingerprint -> Bool
keyMatchesFingerprint = keyMatchesPKPred fingerprint

keyMatchesEightOctetKeyId :: Bool -> TK -> EightOctetKeyId -> Bool
keyMatchesEightOctetKeyId = keyMatchesPKPred eightOctetKeyID

keyMatchesExactUIDString :: String -> TK -> Bool
keyMatchesExactUIDString uidstr = any (==uidstr) . map fst . _tkUIDs

keyMatchesUIDSubString :: String -> TK -> Bool
keyMatchesUIDSubString uidstr = any (map toLower uidstr `isInfixOf`) . map (map toLower . fst) . _tkUIDs

keyMatchesPKPred :: Eq a => (PKPayload -> a) -> Bool -> TK -> a -> Bool
keyMatchesPKPred p False = (==) . p . _tkPKP
keyMatchesPKPred p True = \tk v -> any (== v) (map p (tk ^.. biplate))