Canonicalize.hs

-- Canonicalize.hs: hOpenPGP key tool canonicalize subcommand
-- Copyright © 2013-2026  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.Hokey.Canonicalize
    ( doCanonicalize
    ) where

import Codec.Encryption.OpenPGP.Serialize ()
import Codec.Encryption.OpenPGP.Types
    ( SomeTK (..)
    , someTKToUnknown
    , _tkRevs
    , _tkSubs
    , _tkUAts
    , _tkUIDs
    )
import Control.Lens (mapped, over, _2)
import Data.Binary (get, put)
import Data.Conduit (runConduitRes, (.|))
import qualified Data.Conduit.Binary as CB
import qualified Data.Conduit.List as CL
import Data.Conduit.OpenPGP.Keyring
    ( conduitDropErrorsAndNothings
    , conduitToSomeTKsDroppingEither
    )
import Data.Conduit.Serialization.Binary (conduitGet, conduitPut)
import Data.List (nub, sort)
import System.IO
    ( stdin
    , stdout
    )

doCanonicalize :: IO ()
doCanonicalize =
    runConduitRes $
        CB.sourceHandle stdin
            .| conduitGet get
            .| conduitToSomeTKsDroppingEither
            .| conduitDropErrorsAndNothings
            .| CL.map canonicalize
            .| CL.map someTKToUnknown
            .| CL.map put
            .| conduitPut
            .| CB.sinkHandle stdout
  where
    canonicalize (SomePublicTK tk) = SomePublicTK (canonicalizeTK tk)
    canonicalize (SomeSecretTK tk) = SomeSecretTK (canonicalizeTK tk)
    canonicalizeTK tk =
        tk
            { _tkRevs = sort (_tkRevs tk)
            , _tkUIDs = indepthsort (_tkUIDs tk)
            , _tkUAts = indepthsort (_tkUAts tk)
            , _tkSubs = indepthsort (_tkSubs tk)
            }
    indepthsort :: (Ord a, Ord b) => [(a, [b])] -> [(a, [b])]
    indepthsort = nub . sort . over (mapped . _2) sort