{-# LANGUAGE OverloadedStrings #-}
module Codec.Encryption.OpenPGP.KeySelection
( parseEightOctetKeyId
, parseFingerprint
) where
import Codec.Encryption.OpenPGP.Types
import Control.Applicative (optional)
import Control.Monad ((<=<))
import Crypto.Number.Serialize (i2osp)
import Data.Attoparsec.Text
( Parser
, asciiCI
, count
, hexadecimal
, inClass
, parseOnly
, satisfy
)
import qualified Data.ByteString.Lazy as BL
import Data.Text (Text, toUpper)
import qualified Data.Text as T
parseEightOctetKeyId :: Text -> Either String EightOctetKeyId
parseEightOctetKeyId :: Text -> Either String EightOctetKeyId
parseEightOctetKeyId =
(ByteString -> EightOctetKeyId)
-> Either String ByteString -> Either String EightOctetKeyId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> EightOctetKeyId
EightOctetKeyId (Either String ByteString -> Either String EightOctetKeyId)
-> (Text -> Either String ByteString)
-> Text
-> Either String EightOctetKeyId
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Parser ByteString -> Text -> Either String ByteString
forall a. Parser a -> Text -> Either String a
parseOnly Parser ByteString
hexes (Text -> Either String ByteString)
-> (Text -> Either String Text) -> Text -> Either String ByteString
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Parser Text -> Text -> Either String Text
forall a. Parser a -> Text -> Either String a
parseOnly (Parser (Maybe Text)
hexPrefix Parser (Maybe Text) -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Parser Text
hexen 16)) (Text -> Either String ByteString)
-> (Text -> Text) -> Text -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toUpper
parseFingerprint :: Text -> Either String TwentyOctetFingerprint
parseFingerprint :: Text -> Either String TwentyOctetFingerprint
parseFingerprint =
(ByteString -> TwentyOctetFingerprint)
-> Either String ByteString -> Either String TwentyOctetFingerprint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> TwentyOctetFingerprint
TwentyOctetFingerprint (Either String ByteString -> Either String TwentyOctetFingerprint)
-> (Text -> Either String ByteString)
-> Text
-> Either String TwentyOctetFingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Parser ByteString -> Text -> Either String ByteString
forall a. Parser a -> Text -> Either String a
parseOnly Parser ByteString
hexes (Text -> Either String ByteString)
-> (Text -> Either String Text) -> Text -> Either String ByteString
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Parser Text -> Text -> Either String Text
forall a. Parser a -> Text -> Either String a
parseOnly (Int -> Parser Text
hexen 40)) (Text -> Either String ByteString)
-> (Text -> Text) -> Text -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toUpper (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= ' ')
hexPrefix :: Parser (Maybe Text)
hexPrefix :: Parser (Maybe Text)
hexPrefix = Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text -> Parser Text
asciiCI "0x")
hexen :: Int -> Parser Text
hexen :: Int -> Parser Text
hexen n :: Int
n = String -> Text
T.pack (String -> Text) -> Parser Text String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser Text Char -> Parser Text String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
n ((Char -> Bool) -> Parser Text Char
satisfy (String -> Char -> Bool
inClass "A-F0-9"))
hexes :: Parser BL.ByteString
hexes :: Parser ByteString
hexes = ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString)
-> (Integer -> ByteString) -> Integer -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp (Integer -> ByteString) -> Parser Text Integer -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Integer
forall a. (Integral a, Bits a) => Parser a
hexadecimal