packages feed

hOpenPGP-3.6: Codec/Encryption/OpenPGP/KeySelection.hs

-- KeySelection.hs: OpenPGP (RFC9580) ways to ask for keys
-- Copyright © 2014-2026  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).
{-# LANGUAGE OverloadedStrings #-}

module Codec.Encryption.OpenPGP.KeySelection
    ( parseEightOctetKeyId
    , parseFingerprint
    ) where

import Control.Applicative (optional, (<|>))
import Crypto.Number.Serialize (i2osp)
import Data.Attoparsec.Text
    ( Parser
    , asciiCI
    , count
    , hexadecimal
    , inClass
    , parseOnly
    , satisfy
    )
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.Text (Text, toUpper)
import qualified Data.Text as T

import Codec.Encryption.OpenPGP.Types
import Codec.Encryption.OpenPGP.Types.Internal.Errors
    ( KeySelectionError (..)
    )

parseEightOctetKeyId
    :: Text -> Either KeySelectionError EightOctetKeyId
parseEightOctetKeyId input =
    case parseOnly hexes
        =<< parseOnly (hexPrefix *> hexen 16) (toUpper input) of
        Left _ -> Left (KeySelectionParseError (toUpper input))
        Right bs -> Right (EightOctetKeyId bs)

parseFingerprint :: Text -> Either KeySelectionError Fingerprint
parseFingerprint input =
    case parseOnly hexes
        =<< parseOnly
            (hexen 64 <|> hexen 40 <|> hexen 32)
            (toUpper (T.filter (/= ' ') input)) of
        Left _ ->
            Left (KeySelectionParseError (toUpper (T.filter (/= ' ') input)))
        Right bs -> Right (Fingerprint bs)

hexPrefix :: Parser (Maybe Text)
hexPrefix = optional (asciiCI "0x")

hexen :: Int -> Parser Text
hexen n = T.pack <$> count n (satisfy (inClass "A-F0-9"))

hexes :: Parser B.ByteString
hexes = i2osp <$> hexadecimal