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
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))
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)
newtype Aeson a = Aeson
{ _unAeson :: a
} deriving (Ord,Eq)
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