    -- KeySelection.hs: OpenPGP (RFC4880) ways to ask for keys
    -- Copyright © 2014-2018  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 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