-- KeySelection.hs: OpenPGP (RFC4880) ways to ask for keys
-- Copyright © 2014-2016  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).

{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

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

import Codec.Encryption.OpenPGP.Types
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>), (*>))
#endif
import Control.Applicative (optional)
import Control.Monad ((<=<))
import Crypto.Number.Serialize (i2osp)
import Data.Attoparsec.Text (asciiCI, count, hexadecimal, inClass, parseOnly, Parser, 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 = fmap EightOctetKeyId . (parseOnly hexes <=< parseOnly (hexPrefix *> hexen 16)) . toUpper

parseFingerprint :: Text -> Either String TwentyOctetFingerprint
parseFingerprint = fmap TwentyOctetFingerprint . (parseOnly hexes <=< parseOnly (hexen 40)) . toUpper . T.filter (/=' ')

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 BL.ByteString
hexes = BL.fromStrict . i2osp <$> hexadecimal