{-# LANGUAGE DeriveDataTypeable #-}

{-# LANGUAGE FlexibleInstances #-}

{-# LANGUAGE OverloadedStrings #-}

{-|

Module : Stack.Types.Sig

Description : Signature Types

Copyright : (c) FPComplete.com, 2015

License : BSD3

Maintainer : Tim Dysinger <tim@fpcomplete.com>

Stability : experimental

Portability : POSIX

-}

module Stack.Types.Sig

(Signature(..), Fingerprint, mkFingerprint, SigException(..)) where

import Prelude ()

import Prelude.Compat

import Control.Exception (Exception)

import Data.Aeson (Value(..), ToJSON(..), FromJSON(..))

import Data.ByteString (ByteString)

import qualified Data.ByteString as SB

import Data.Char (isHexDigit)

import Data.Monoid ((<>))

import Data.String (IsString(..))

import Data.Text (Text)

import qualified Data.Text as T

import Data.Typeable (Typeable)

import Stack.Types.PackageName

-- | A GPG signature.

newtype Signature =

Signature ByteString

deriving (Ord,Eq)

instance Show Signature where

show (Signature s) = "Signature " ++

(if SB.length s > 140

then show (SB.take 140 s) ++

"..."

else show (SB.take 140 s))

-- | The GPG fingerprint.

newtype Fingerprint =

Fingerprint Text

deriving (Eq,Ord)

mkFingerprint :: Text -> Fingerprint

mkFingerprint = Fingerprint . hexText

hexText :: Text -> Text

hexText = T.toUpper . T.dropWhile (not . isHexDigit)

instance Show Fingerprint where

show (Fingerprint hex) = T.unpack (hexText hex)

instance FromJSON Fingerprint where

parseJSON j = Fingerprint . hexText <$> parseJSON j

instance ToJSON Fingerprint where

toJSON (Fingerprint hex) = String (hexText hex)

instance IsString Fingerprint where

fromString = Fingerprint . hexText . T.pack

instance FromJSON (Aeson PackageName) where

parseJSON j = do

s <- parseJSON j

case parsePackageName s of

Just name -> return (Aeson name)

Nothing -> fail ("Invalid package name: " <> T.unpack s)

-- | Handy wrapper for orphan instances.

newtype Aeson a = Aeson

{ _unAeson :: a

} deriving (Ord,Eq)

-- | Exceptions

data SigException

= GPGFingerprintException String

| GPGNotFoundException

| GPGSignException String

| GPGVerifyException String

| SigInvalidSDistTarBall

| SigNoProjectRootException

| SigServiceException String

deriving (Typeable)

instance Exception SigException

instance Show SigException where

show (GPGFingerprintException e) =

"Error extracting a GPG fingerprint " <> e

show GPGNotFoundException = "Unable to find gpg2 or gpg executable"

show (GPGSignException e) = "Error signing with GPG " <> e

show (GPGVerifyException e) = "Error verifying with GPG " <> e

show SigNoProjectRootException = "Missing Project Root"

show SigInvalidSDistTarBall = "Invalid sdist tarball"

show (SigServiceException e) = "Error with the Signature Service " <> e