module Stack.Types.Sig
(Signature(..), Fingerprint(..), SigException(..))
where
import Control.Exception (Exception)
import Data.Aeson (Value(..), ToJSON(..), FromJSON(..))
import Data.ByteString (ByteString)
import qualified Data.ByteString as SB
import Data.Char (isDigit, isAlpha, isSpace)
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
{ fingerprintSample :: Text
} deriving (Eq,Ord,Show)
instance FromJSON Fingerprint where
parseJSON j = do
s <- parseJSON j
let withoutSpaces = T.filter (not . isSpace) s
if T.null withoutSpaces ||
T.all
(\c ->
isAlpha c || isDigit c || isSpace c)
withoutSpaces
then return (Fingerprint withoutSpaces)
else fail ("Expected fingerprint, but got: " ++ T.unpack s)
instance ToJSON Fingerprint where
toJSON (Fingerprint txt) = String txt
instance IsString Fingerprint where
fromString = Fingerprint . 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
| 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 (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