{- |
Name: Cropty
Description: A simplified interface to asymmetric and symmetric cryptography
License: MIT
Copyright: Samuel Schlesinger 2021 (c)
-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE LambdaCase #-}
module Cropty
  ( 
    -- * Asymmetric Encryption
    PrivateKey (PrivateKey, privateKey)
  , privateToPublic
  , PublicKey (PublicKey, publicKey)
    -- ** Efficient Encryption
  , Message (..)
  , encrypt
  , EncryptionException (..)
  , decrypt
  , DecryptionException (..)
    -- ** Digital Signatures
  , Signature (Signature, signatureBytes)
  , sign
  , verify
  , Signed
  , signed
  , signedBy
  , signature
  , signedEncoded
  , mkSigned
  , verifySigned
    -- ** Encrypt/Decrypt Small Strings
  , encryptSmall
  , decryptSmall
    -- ** Supported Key Sizes
  , KeySize (..)
  , keySizeInt
  , keySizeFromInt
    -- ** Key generation
  , generatePrivateKey
  , generatePrivateKeyWithPublicExponent
    -- * Symmetric Encryption
  , Key (Key, keyBytes)
  , generateKey
  , encryptSym
  , SymEncryptionException (..)
  , decryptSym
  , SymDecryptionException (..)
    -- * Errors Re-Exported from Cryptonite
  , RSAError
  , CryptoError (..)
  ) where

import Data.ByteString (ByteString)
import GHC.Generics (Generic)
import Data.Binary (Binary(..), encode, decode)
import qualified Crypto.PubKey.RSA.Types (Error (..))
import Crypto.Error (CryptoError (..))
import Control.Exception (Exception, throwIO)
import Data.Function (on)
import qualified Crypto.Cipher.AES as AES
import qualified Crypto.Cipher.Types as Cipher
import qualified Crypto.Error as Error
import qualified Crypto.Hash.Algorithms as Hash
import qualified Crypto.PubKey.RSA as RSA
import qualified Crypto.PubKey.RSA.OAEP as RSA.OAEP
import qualified Crypto.PubKey.RSA.PSS as RSA.PSS
import qualified Crypto.Random as Random
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Lazy as LBS

-- |
-- @import qualified Crypto.PubKey.RSA.Types as RSA (Error (..))@
type RSAError = Crypto.PubKey.RSA.Types.Error

-- | A secret identity which one should be very careful about storing
-- and sharing. If others get it, they will be able to read messages
-- intended for you.
newtype PrivateKey = PrivateKey
  { PrivateKey -> PrivateKey
privateKey :: RSA.PrivateKey }
  deriving (Int -> PrivateKey -> ShowS
[PrivateKey] -> ShowS
PrivateKey -> String
(Int -> PrivateKey -> ShowS)
-> (PrivateKey -> String)
-> ([PrivateKey] -> ShowS)
-> Show PrivateKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrivateKey] -> ShowS
$cshowList :: [PrivateKey] -> ShowS
show :: PrivateKey -> String
$cshow :: PrivateKey -> String
showsPrec :: Int -> PrivateKey -> ShowS
$cshowsPrec :: Int -> PrivateKey -> ShowS
Show, ReadPrec [PrivateKey]
ReadPrec PrivateKey
Int -> ReadS PrivateKey
ReadS [PrivateKey]
(Int -> ReadS PrivateKey)
-> ReadS [PrivateKey]
-> ReadPrec PrivateKey
-> ReadPrec [PrivateKey]
-> Read PrivateKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PrivateKey]
$creadListPrec :: ReadPrec [PrivateKey]
readPrec :: ReadPrec PrivateKey
$creadPrec :: ReadPrec PrivateKey
readList :: ReadS [PrivateKey]
$creadList :: ReadS [PrivateKey]
readsPrec :: Int -> ReadS PrivateKey
$creadsPrec :: Int -> ReadS PrivateKey
Read, PrivateKey -> PrivateKey -> Bool
(PrivateKey -> PrivateKey -> Bool)
-> (PrivateKey -> PrivateKey -> Bool) -> Eq PrivateKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrivateKey -> PrivateKey -> Bool
$c/= :: PrivateKey -> PrivateKey -> Bool
== :: PrivateKey -> PrivateKey -> Bool
$c== :: PrivateKey -> PrivateKey -> Bool
Eq)

instance Binary PrivateKey where
  put :: PrivateKey -> Put
put (PrivateKey PrivateKey
p) = do
    PublicKey -> Put
forall t. Binary t => t -> Put
put (PublicKey -> PublicKey
PublicKey (PublicKey -> PublicKey) -> PublicKey -> PublicKey
forall a b. (a -> b) -> a -> b
$ PrivateKey -> PublicKey
RSA.private_pub PrivateKey
p)
    Integer -> Put
forall t. Binary t => t -> Put
put (PrivateKey -> Integer
RSA.private_d PrivateKey
p)
    Integer -> Put
forall t. Binary t => t -> Put
put (PrivateKey -> Integer
RSA.private_p PrivateKey
p)
    Integer -> Put
forall t. Binary t => t -> Put
put (PrivateKey -> Integer
RSA.private_q PrivateKey
p)
    Integer -> Put
forall t. Binary t => t -> Put
put (PrivateKey -> Integer
RSA.private_dP PrivateKey
p)
    Integer -> Put
forall t. Binary t => t -> Put
put (PrivateKey -> Integer
RSA.private_dQ PrivateKey
p)
    Integer -> Put
forall t. Binary t => t -> Put
put (PrivateKey -> Integer
RSA.private_qinv PrivateKey
p)
  get :: Get PrivateKey
get = PrivateKey -> PrivateKey
PrivateKey (PrivateKey -> PrivateKey) -> Get PrivateKey -> Get PrivateKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ( PublicKey
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> PrivateKey
RSA.PrivateKey
      (PublicKey
 -> Integer
 -> Integer
 -> Integer
 -> Integer
 -> Integer
 -> Integer
 -> PrivateKey)
-> Get PublicKey
-> Get
     (Integer
      -> Integer
      -> Integer
      -> Integer
      -> Integer
      -> Integer
      -> PrivateKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PublicKey -> PublicKey
publicKey (PublicKey -> PublicKey) -> Get PublicKey -> Get PublicKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get PublicKey
forall t. Binary t => Get t
get)
      Get
  (Integer
   -> Integer
   -> Integer
   -> Integer
   -> Integer
   -> Integer
   -> PrivateKey)
-> Get Integer
-> Get
     (Integer -> Integer -> Integer -> Integer -> Integer -> PrivateKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Integer
forall t. Binary t => Get t
get
      Get
  (Integer -> Integer -> Integer -> Integer -> Integer -> PrivateKey)
-> Get Integer
-> Get (Integer -> Integer -> Integer -> Integer -> PrivateKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Integer
forall t. Binary t => Get t
get
      Get (Integer -> Integer -> Integer -> Integer -> PrivateKey)
-> Get Integer -> Get (Integer -> Integer -> Integer -> PrivateKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Integer
forall t. Binary t => Get t
get
      Get (Integer -> Integer -> Integer -> PrivateKey)
-> Get Integer -> Get (Integer -> Integer -> PrivateKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Integer
forall t. Binary t => Get t
get
      Get (Integer -> Integer -> PrivateKey)
-> Get Integer -> Get (Integer -> PrivateKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Integer
forall t. Binary t => Get t
get
      Get (Integer -> PrivateKey) -> Get Integer -> Get PrivateKey
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Integer
forall t. Binary t => Get t
get
    )

instance Ord PrivateKey where
  compare :: PrivateKey -> PrivateKey -> Ordering
compare (PrivateKey PrivateKey
p) (PrivateKey PrivateKey
p') = PublicKey -> PublicKey -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PublicKey -> PublicKey
PublicKey (PublicKey -> PublicKey) -> PublicKey -> PublicKey
forall a b. (a -> b) -> a -> b
$ PrivateKey -> PublicKey
RSA.private_pub PrivateKey
p) (PublicKey -> PublicKey
PublicKey (PublicKey -> PublicKey) -> PublicKey -> PublicKey
forall a b. (a -> b) -> a -> b
$ PrivateKey -> PublicKey
RSA.private_pub PrivateKey
p')

-- | A public identity which corresponds to your secret one, allowing
-- you to tell other people how to 'encrypt' things for you. If you 'sign'
-- something with the 'PrivateKey' associated with this public one,
-- someone will be able to verify it was you with your public key.
data PublicKey = PublicKey
  { PublicKey -> PublicKey
publicKey :: RSA.PublicKey }
  deriving (Int -> PublicKey -> ShowS
[PublicKey] -> ShowS
PublicKey -> String
(Int -> PublicKey -> ShowS)
-> (PublicKey -> String)
-> ([PublicKey] -> ShowS)
-> Show PublicKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PublicKey] -> ShowS
$cshowList :: [PublicKey] -> ShowS
show :: PublicKey -> String
$cshow :: PublicKey -> String
showsPrec :: Int -> PublicKey -> ShowS
$cshowsPrec :: Int -> PublicKey -> ShowS
Show, ReadPrec [PublicKey]
ReadPrec PublicKey
Int -> ReadS PublicKey
ReadS [PublicKey]
(Int -> ReadS PublicKey)
-> ReadS [PublicKey]
-> ReadPrec PublicKey
-> ReadPrec [PublicKey]
-> Read PublicKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PublicKey]
$creadListPrec :: ReadPrec [PublicKey]
readPrec :: ReadPrec PublicKey
$creadPrec :: ReadPrec PublicKey
readList :: ReadS [PublicKey]
$creadList :: ReadS [PublicKey]
readsPrec :: Int -> ReadS PublicKey
$creadsPrec :: Int -> ReadS PublicKey
Read, PublicKey -> PublicKey -> Bool
(PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> Bool) -> Eq PublicKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublicKey -> PublicKey -> Bool
$c/= :: PublicKey -> PublicKey -> Bool
== :: PublicKey -> PublicKey -> Bool
$c== :: PublicKey -> PublicKey -> Bool
Eq)

instance Binary PublicKey where
  put :: PublicKey -> Put
put (PublicKey PublicKey
p) = do
    Int -> Put
forall t. Binary t => t -> Put
put (PublicKey -> Int
RSA.public_size PublicKey
p)
    Integer -> Put
forall t. Binary t => t -> Put
put (PublicKey -> Integer
RSA.public_n PublicKey
p)
    Integer -> Put
forall t. Binary t => t -> Put
put (PublicKey -> Integer
RSA.public_e PublicKey
p)
  get :: Get PublicKey
get = PublicKey -> PublicKey
PublicKey (PublicKey -> PublicKey) -> Get PublicKey -> Get PublicKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ( Int -> Integer -> Integer -> PublicKey
RSA.PublicKey
    (Int -> Integer -> Integer -> PublicKey)
-> Get Int -> Get (Integer -> Integer -> PublicKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
forall t. Binary t => Get t
get
    Get (Integer -> Integer -> PublicKey)
-> Get Integer -> Get (Integer -> PublicKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Integer
forall t. Binary t => Get t
get
    Get (Integer -> PublicKey) -> Get Integer -> Get PublicKey
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Integer
forall t. Binary t => Get t
get
    )

instance Ord PublicKey where
  compare :: PublicKey -> PublicKey -> Ordering
compare (PublicKey PublicKey
p) (PublicKey PublicKey
p') =
    Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PublicKey -> Int
RSA.public_size PublicKey
p) (PublicKey -> Int
RSA.public_size PublicKey
p')
    Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PublicKey -> Integer
RSA.public_n PublicKey
p) (PublicKey -> Integer
RSA.public_n PublicKey
p')
    Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PublicKey -> Integer
RSA.public_e PublicKey
p) (PublicKey -> Integer
RSA.public_e PublicKey
p')

-- | Get a 'PublicKey' which corresponds to the given 'PrivateKey'
privateToPublic :: PrivateKey -> PublicKey
privateToPublic :: PrivateKey -> PublicKey
privateToPublic = PublicKey -> PublicKey
PublicKey (PublicKey -> PublicKey)
-> (PrivateKey -> PublicKey) -> PrivateKey -> PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivateKey -> PublicKey
RSA.private_pub (PrivateKey -> PublicKey)
-> (PrivateKey -> PrivateKey) -> PrivateKey -> PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivateKey -> PrivateKey
privateKey

-- | The various supported key sizes for the underlying RSA implementation
data KeySize = KeySize256 | KeySize512 | KeySize1024 | KeySize2048 | KeySize4096
  deriving (KeySize -> KeySize -> Bool
(KeySize -> KeySize -> Bool)
-> (KeySize -> KeySize -> Bool) -> Eq KeySize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeySize -> KeySize -> Bool
$c/= :: KeySize -> KeySize -> Bool
== :: KeySize -> KeySize -> Bool
$c== :: KeySize -> KeySize -> Bool
Eq, Eq KeySize
Eq KeySize
-> (KeySize -> KeySize -> Ordering)
-> (KeySize -> KeySize -> Bool)
-> (KeySize -> KeySize -> Bool)
-> (KeySize -> KeySize -> Bool)
-> (KeySize -> KeySize -> Bool)
-> (KeySize -> KeySize -> KeySize)
-> (KeySize -> KeySize -> KeySize)
-> Ord KeySize
KeySize -> KeySize -> Bool
KeySize -> KeySize -> Ordering
KeySize -> KeySize -> KeySize
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: KeySize -> KeySize -> KeySize
$cmin :: KeySize -> KeySize -> KeySize
max :: KeySize -> KeySize -> KeySize
$cmax :: KeySize -> KeySize -> KeySize
>= :: KeySize -> KeySize -> Bool
$c>= :: KeySize -> KeySize -> Bool
> :: KeySize -> KeySize -> Bool
$c> :: KeySize -> KeySize -> Bool
<= :: KeySize -> KeySize -> Bool
$c<= :: KeySize -> KeySize -> Bool
< :: KeySize -> KeySize -> Bool
$c< :: KeySize -> KeySize -> Bool
compare :: KeySize -> KeySize -> Ordering
$ccompare :: KeySize -> KeySize -> Ordering
$cp1Ord :: Eq KeySize
Ord, Int -> KeySize
KeySize -> Int
KeySize -> [KeySize]
KeySize -> KeySize
KeySize -> KeySize -> [KeySize]
KeySize -> KeySize -> KeySize -> [KeySize]
(KeySize -> KeySize)
-> (KeySize -> KeySize)
-> (Int -> KeySize)
-> (KeySize -> Int)
-> (KeySize -> [KeySize])
-> (KeySize -> KeySize -> [KeySize])
-> (KeySize -> KeySize -> [KeySize])
-> (KeySize -> KeySize -> KeySize -> [KeySize])
-> Enum KeySize
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: KeySize -> KeySize -> KeySize -> [KeySize]
$cenumFromThenTo :: KeySize -> KeySize -> KeySize -> [KeySize]
enumFromTo :: KeySize -> KeySize -> [KeySize]
$cenumFromTo :: KeySize -> KeySize -> [KeySize]
enumFromThen :: KeySize -> KeySize -> [KeySize]
$cenumFromThen :: KeySize -> KeySize -> [KeySize]
enumFrom :: KeySize -> [KeySize]
$cenumFrom :: KeySize -> [KeySize]
fromEnum :: KeySize -> Int
$cfromEnum :: KeySize -> Int
toEnum :: Int -> KeySize
$ctoEnum :: Int -> KeySize
pred :: KeySize -> KeySize
$cpred :: KeySize -> KeySize
succ :: KeySize -> KeySize
$csucc :: KeySize -> KeySize
Enum, KeySize
KeySize -> KeySize -> Bounded KeySize
forall a. a -> a -> Bounded a
maxBound :: KeySize
$cmaxBound :: KeySize
minBound :: KeySize
$cminBound :: KeySize
Bounded)

-- | Get the size of the key in the form of an 'Int'
keySizeInt :: KeySize -> Int
keySizeInt :: KeySize -> Int
keySizeInt KeySize
k = Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (KeySize -> Int
forall a. Enum a => a -> Int
fromEnum KeySize
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8)

-- | Get the size of a 
keySizeFromInt :: Int -> Maybe KeySize
keySizeFromInt :: Int -> Maybe KeySize
keySizeFromInt Int
n
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
256 = KeySize -> Maybe KeySize
forall a. a -> Maybe a
Just KeySize
KeySize256
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
512 = KeySize -> Maybe KeySize
forall a. a -> Maybe a
Just KeySize
KeySize512
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1024 = KeySize -> Maybe KeySize
forall a. a -> Maybe a
Just KeySize
KeySize1024
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2048 = KeySize -> Maybe KeySize
forall a. a -> Maybe a
Just KeySize
KeySize2048
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4096 = KeySize -> Maybe KeySize
forall a. a -> Maybe a
Just KeySize
KeySize4096 
  | Bool
otherwise = Maybe KeySize
forall a. Maybe a
Nothing

-- | Generate a new 'PrivateKey' of the given 'KeySize'
generatePrivateKey :: KeySize -> IO PrivateKey
generatePrivateKey :: KeySize -> IO PrivateKey
generatePrivateKey = Integer -> KeySize -> IO PrivateKey
generatePrivateKeyWithPublicExponent Integer
65537

-- | Generate a new 'PrivateKey' of the given 'KeySize', providing the RSA public exponent as well.
generatePrivateKeyWithPublicExponent :: Integer -> KeySize -> IO PrivateKey
generatePrivateKeyWithPublicExponent :: Integer -> KeySize -> IO PrivateKey
generatePrivateKeyWithPublicExponent Integer
e KeySize
n = (PrivateKey -> PrivateKey
PrivateKey (PrivateKey -> PrivateKey)
-> ((PublicKey, PrivateKey) -> PrivateKey)
-> (PublicKey, PrivateKey)
-> PrivateKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PublicKey, PrivateKey) -> PrivateKey
forall a b. (a, b) -> b
snd) ((PublicKey, PrivateKey) -> PrivateKey)
-> IO (PublicKey, PrivateKey) -> IO PrivateKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Integer -> IO (PublicKey, PrivateKey)
forall (m :: * -> *).
MonadRandom m =>
Int -> Integer -> m (PublicKey, PrivateKey)
RSA.generate (KeySize -> Int
keySizeInt KeySize
n) Integer
e

-- | Encrypt a 'ByteString' of length less than or equal to the 'KeySize'. Skips
-- the symmetric encryption step. For the most part, this should be avoided, but
-- there is no reason not to expose it.
encryptSmall :: PublicKey -> ByteString -> IO (Either RSAError ByteString)
encryptSmall :: PublicKey -> ByteString -> IO (Either RSAError ByteString)
encryptSmall (PublicKey PublicKey
pub) ByteString
message =
    OAEPParams SHA512 ByteString ByteString
-> PublicKey -> ByteString -> IO (Either RSAError ByteString)
forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
OAEPParams hash ByteString ByteString
-> PublicKey -> ByteString -> m (Either RSAError ByteString)
RSA.OAEP.encrypt (SHA512 -> OAEPParams SHA512 ByteString ByteString
forall seed output hash.
(ByteArrayAccess seed, ByteArray output, HashAlgorithm hash) =>
hash -> OAEPParams hash seed output
RSA.OAEP.defaultOAEPParams SHA512
Hash.SHA512) PublicKey
pub ByteString
message

-- | Decrypt a 'ByteString' of length less than or equal to the 'KeySize'. Skips
-- the symmetric encryption step. For the most part, this should be avoided, but
-- there is no reason not to expose it.
decryptSmall :: PrivateKey -> ByteString -> IO (Either RSAError ByteString)
decryptSmall :: PrivateKey -> ByteString -> IO (Either RSAError ByteString)
decryptSmall (PrivateKey PrivateKey
priv) ByteString
message =
    OAEPParams SHA512 ByteString ByteString
-> PrivateKey -> ByteString -> IO (Either RSAError ByteString)
forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
OAEPParams hash ByteString ByteString
-> PrivateKey -> ByteString -> m (Either RSAError ByteString)
RSA.OAEP.decryptSafer (SHA512 -> OAEPParams SHA512 ByteString ByteString
forall seed output hash.
(ByteArrayAccess seed, ByteArray output, HashAlgorithm hash) =>
hash -> OAEPParams hash seed output
RSA.OAEP.defaultOAEPParams SHA512
Hash.SHA512) PrivateKey
priv ByteString
message

-- | A key for symmetric (AEP) encryption
newtype Key = Key { Key -> ByteString
keyBytes :: ByteString }
 deriving (Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: Key -> Key -> Bool
Eq, Eq Key
Eq Key
-> (Key -> Key -> Ordering)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Key)
-> (Key -> Key -> Key)
-> Ord Key
Key -> Key -> Bool
Key -> Key -> Ordering
Key -> Key -> Key
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmax :: Key -> Key -> Key
>= :: Key -> Key -> Bool
$c>= :: Key -> Key -> Bool
> :: Key -> Key -> Bool
$c> :: Key -> Key -> Bool
<= :: Key -> Key -> Bool
$c<= :: Key -> Key -> Bool
< :: Key -> Key -> Bool
$c< :: Key -> Key -> Bool
compare :: Key -> Key -> Ordering
$ccompare :: Key -> Key -> Ordering
$cp1Ord :: Eq Key
Ord, Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
(Int -> Key -> ShowS)
-> (Key -> String) -> ([Key] -> ShowS) -> Show Key
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Key] -> ShowS
$cshowList :: [Key] -> ShowS
show :: Key -> String
$cshow :: Key -> String
showsPrec :: Int -> Key -> ShowS
$cshowsPrec :: Int -> Key -> ShowS
Show, ReadPrec [Key]
ReadPrec Key
Int -> ReadS Key
ReadS [Key]
(Int -> ReadS Key)
-> ReadS [Key] -> ReadPrec Key -> ReadPrec [Key] -> Read Key
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Key]
$creadListPrec :: ReadPrec [Key]
readPrec :: ReadPrec Key
$creadPrec :: ReadPrec Key
readList :: ReadS [Key]
$creadList :: ReadS [Key]
readsPrec :: Int -> ReadS Key
$creadsPrec :: Int -> ReadS Key
Read, (forall x. Key -> Rep Key x)
-> (forall x. Rep Key x -> Key) -> Generic Key
forall x. Rep Key x -> Key
forall x. Key -> Rep Key x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Key x -> Key
$cfrom :: forall x. Key -> Rep Key x
Generic, Get Key
[Key] -> Put
Key -> Put
(Key -> Put) -> Get Key -> ([Key] -> Put) -> Binary Key
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Key] -> Put
$cputList :: [Key] -> Put
get :: Get Key
$cget :: Get Key
put :: Key -> Put
$cput :: Key -> Put
Binary)

-- | Generate a new 'Key'. It must have 32 bytes, because
-- we are using AES256, and there are 8 bits in a byte.
-- In other words: @32 * 8 = 256@.
generateKey :: IO Key
generateKey :: IO Key
generateKey = ByteString -> Key
Key (ByteString -> Key) -> IO ByteString -> IO Key
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO ByteString
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
Random.getRandomBytes Int
32 

data SymEncryptionException = SymEncryptionException'CryptoniteError CryptoError
  deriving Int -> SymEncryptionException -> ShowS
[SymEncryptionException] -> ShowS
SymEncryptionException -> String
(Int -> SymEncryptionException -> ShowS)
-> (SymEncryptionException -> String)
-> ([SymEncryptionException] -> ShowS)
-> Show SymEncryptionException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SymEncryptionException] -> ShowS
$cshowList :: [SymEncryptionException] -> ShowS
show :: SymEncryptionException -> String
$cshow :: SymEncryptionException -> String
showsPrec :: Int -> SymEncryptionException -> ShowS
$cshowsPrec :: Int -> SymEncryptionException -> ShowS
Show

instance Exception SymEncryptionException

-- | Encrypt a 'ByteString' such that anyone else who has the 'Key' can
-- 'decryptSym' it later.
encryptSym :: Key -> ByteString -> Either SymEncryptionException ByteString
encryptSym :: Key -> ByteString -> Either SymEncryptionException ByteString
encryptSym Key
key ByteString
bs =
  case ByteString -> CryptoFailable AES256
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
Cipher.cipherInit (Key -> ByteString
keyBytes Key
key) of
    Error.CryptoFailed CryptoError
e -> SymEncryptionException -> Either SymEncryptionException ByteString
forall a b. a -> Either a b
Left (CryptoError -> SymEncryptionException
SymEncryptionException'CryptoniteError CryptoError
e)
    Error.CryptoPassed (AES256
c :: AES.AES256) -> ByteString -> Either SymEncryptionException ByteString
forall a b. b -> Either a b
Right (ByteString -> Either SymEncryptionException ByteString)
-> ByteString -> Either SymEncryptionException ByteString
forall a b. (a -> b) -> a -> b
$ AES256 -> ByteString -> ByteString
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
Cipher.ecbEncrypt AES256
c ByteString
paddedMessage
  where
    paddingSize :: Int
paddingSize =
      Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (ByteString -> Int
ByteString.length ByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
16
    paddedMessage :: ByteString
paddedMessage =
      [ByteString] -> ByteString
ByteString.concat
        [ Word8 -> ByteString
ByteString.singleton (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
paddingSize)
        , Int -> Word8 -> ByteString
ByteString.replicate Int
paddingSize Word8
0
        , ByteString
bs
        ]

data CroptyError =
    NotEncryptedByCropty
  deriving Int -> CroptyError -> ShowS
[CroptyError] -> ShowS
CroptyError -> String
(Int -> CroptyError -> ShowS)
-> (CroptyError -> String)
-> ([CroptyError] -> ShowS)
-> Show CroptyError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CroptyError] -> ShowS
$cshowList :: [CroptyError] -> ShowS
show :: CroptyError -> String
$cshow :: CroptyError -> String
showsPrec :: Int -> CroptyError -> ShowS
$cshowsPrec :: Int -> CroptyError -> ShowS
Show

instance Exception CroptyError

data SymDecryptionException = SymDecryptionException'CryptoniteError CryptoError | SymDecryptionException'CroptyError CroptyError
  deriving Int -> SymDecryptionException -> ShowS
[SymDecryptionException] -> ShowS
SymDecryptionException -> String
(Int -> SymDecryptionException -> ShowS)
-> (SymDecryptionException -> String)
-> ([SymDecryptionException] -> ShowS)
-> Show SymDecryptionException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SymDecryptionException] -> ShowS
$cshowList :: [SymDecryptionException] -> ShowS
show :: SymDecryptionException -> String
$cshow :: SymDecryptionException -> String
showsPrec :: Int -> SymDecryptionException -> ShowS
$cshowsPrec :: Int -> SymDecryptionException -> ShowS
Show

instance Exception SymDecryptionException

-- | Decrypt a 'ByteString' which has been 'encryptSym'ed with the given 'Key'.
decryptSym :: Key -> ByteString -> Either SymDecryptionException ByteString
decryptSym :: Key -> ByteString -> Either SymDecryptionException ByteString
decryptSym Key
key ByteString
bs =
  case ByteString -> CryptoFailable AES256
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
Cipher.cipherInit (Key -> ByteString
keyBytes Key
key) of
    Error.CryptoFailed CryptoError
e -> SymDecryptionException -> Either SymDecryptionException ByteString
forall a b. a -> Either a b
Left (CryptoError -> SymDecryptionException
SymDecryptionException'CryptoniteError CryptoError
e)
    Error.CryptoPassed (AES256
c :: AES.AES256) -> do
      let decryptedBytes :: ByteString
decryptedBytes = AES256 -> ByteString -> ByteString
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> ba -> ba
Cipher.ecbDecrypt AES256
c ByteString
bs
      if ByteString -> Int
ByteString.length ByteString
decryptedBytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then
        let paddingSize :: Int
paddingSize = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
ByteString.index ByteString
decryptedBytes Int
0)
        in ByteString -> Either SymDecryptionException ByteString
forall a b. b -> Either a b
Right (ByteString -> Either SymDecryptionException ByteString)
-> ByteString -> Either SymDecryptionException ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd (Int -> ByteString -> (ByteString, ByteString)
ByteString.splitAt (Int
paddingSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ByteString
decryptedBytes)
      else SymDecryptionException -> Either SymDecryptionException ByteString
forall a b. a -> Either a b
Left (SymDecryptionException
 -> Either SymDecryptionException ByteString)
-> SymDecryptionException
-> Either SymDecryptionException ByteString
forall a b. (a -> b) -> a -> b
$ CroptyError -> SymDecryptionException
SymDecryptionException'CroptyError CroptyError
NotEncryptedByCropty

-- | An message 'encrypt'ed for a specific 'PublicKey'. Contains
-- an 'encryptSmall'ed AEP key which only the owner of the corresponding
-- 'PrivateKey' can unlock, and a symmetrically encrypted message
-- for them to decrypt once they 'decryptSmall' their AEP key.
data Message = Message
  { Message -> ByteString
encryptedKey :: ByteString
  , Message -> ByteString
encryptedBytes :: ByteString
  } deriving (Int -> Message -> ShowS
[Message] -> ShowS
Message -> String
(Int -> Message -> ShowS)
-> (Message -> String) -> ([Message] -> ShowS) -> Show Message
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Message] -> ShowS
$cshowList :: [Message] -> ShowS
show :: Message -> String
$cshow :: Message -> String
showsPrec :: Int -> Message -> ShowS
$cshowsPrec :: Int -> Message -> ShowS
Show, ReadPrec [Message]
ReadPrec Message
Int -> ReadS Message
ReadS [Message]
(Int -> ReadS Message)
-> ReadS [Message]
-> ReadPrec Message
-> ReadPrec [Message]
-> Read Message
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Message]
$creadListPrec :: ReadPrec [Message]
readPrec :: ReadPrec Message
$creadPrec :: ReadPrec Message
readList :: ReadS [Message]
$creadList :: ReadS [Message]
readsPrec :: Int -> ReadS Message
$creadsPrec :: Int -> ReadS Message
Read, (forall x. Message -> Rep Message x)
-> (forall x. Rep Message x -> Message) -> Generic Message
forall x. Rep Message x -> Message
forall x. Message -> Rep Message x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Message x -> Message
$cfrom :: forall x. Message -> Rep Message x
Generic, Get Message
[Message] -> Put
Message -> Put
(Message -> Put)
-> Get Message -> ([Message] -> Put) -> Binary Message
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Message] -> Put
$cputList :: [Message] -> Put
get :: Get Message
$cget :: Get Message
put :: Message -> Put
$cput :: Message -> Put
Binary)

-- | The sort of exception we might get during encryption.
data EncryptionException = EncryptionException RSAError
  deriving Int -> EncryptionException -> ShowS
[EncryptionException] -> ShowS
EncryptionException -> String
(Int -> EncryptionException -> ShowS)
-> (EncryptionException -> String)
-> ([EncryptionException] -> ShowS)
-> Show EncryptionException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EncryptionException] -> ShowS
$cshowList :: [EncryptionException] -> ShowS
show :: EncryptionException -> String
$cshow :: EncryptionException -> String
showsPrec :: Int -> EncryptionException -> ShowS
$cshowsPrec :: Int -> EncryptionException -> ShowS
Show

instance Exception EncryptionException

-- | Encrypt a 'ByteString' for the given 'PublicKey', storing
-- the results into a 'Message'.
encrypt :: PublicKey -> ByteString -> IO Message
encrypt :: PublicKey -> ByteString -> IO Message
encrypt PublicKey
publicKey ByteString
message = do
  Key
key <- IO Key
generateKey
  PublicKey -> ByteString -> IO (Either RSAError ByteString)
encryptSmall PublicKey
publicKey (Key -> ByteString
keyBytes Key
key) IO (Either RSAError ByteString)
-> (Either RSAError ByteString -> IO Message) -> IO Message
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left RSAError
rsaError -> EncryptionException -> IO Message
forall e a. Exception e => e -> IO a
throwIO (EncryptionException -> IO Message)
-> EncryptionException -> IO Message
forall a b. (a -> b) -> a -> b
$ RSAError -> EncryptionException
EncryptionException RSAError
rsaError
    Right ByteString
encryptedKey -> ByteString -> ByteString -> Message
Message ByteString
encryptedKey (ByteString -> Message) -> IO ByteString -> IO Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SymEncryptionException -> IO ByteString)
-> (ByteString -> IO ByteString)
-> Either SymEncryptionException ByteString
-> IO ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SymEncryptionException -> IO ByteString
forall e a. Exception e => e -> IO a
throwIO ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key -> ByteString -> Either SymEncryptionException ByteString
encryptSym Key
key ByteString
message) 

-- | The sort of exception we might get during decryption.
data DecryptionException = DecryptionException RSAError
  deriving Int -> DecryptionException -> ShowS
[DecryptionException] -> ShowS
DecryptionException -> String
(Int -> DecryptionException -> ShowS)
-> (DecryptionException -> String)
-> ([DecryptionException] -> ShowS)
-> Show DecryptionException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecryptionException] -> ShowS
$cshowList :: [DecryptionException] -> ShowS
show :: DecryptionException -> String
$cshow :: DecryptionException -> String
showsPrec :: Int -> DecryptionException -> ShowS
$cshowsPrec :: Int -> DecryptionException -> ShowS
Show

instance Exception DecryptionException

-- | Decrypt a 'Message' into a 'ByteString', the original message.
decrypt :: PrivateKey -> Message -> IO ByteString
decrypt :: PrivateKey -> Message -> IO ByteString
decrypt PrivateKey
privateKey Message{ByteString
encryptedKey :: ByteString
encryptedKey :: Message -> ByteString
encryptedKey, ByteString
encryptedBytes :: ByteString
encryptedBytes :: Message -> ByteString
encryptedBytes} = do
  PrivateKey -> ByteString -> IO (Either RSAError ByteString)
decryptSmall PrivateKey
privateKey ByteString
encryptedKey IO (Either RSAError ByteString)
-> (Either RSAError ByteString -> IO ByteString) -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left RSAError
rsaError -> DecryptionException -> IO ByteString
forall e a. Exception e => e -> IO a
throwIO (DecryptionException -> IO ByteString)
-> DecryptionException -> IO ByteString
forall a b. (a -> b) -> a -> b
$ RSAError -> DecryptionException
DecryptionException RSAError
rsaError
    Right ByteString
decryptedKey -> (SymDecryptionException -> IO ByteString)
-> (ByteString -> IO ByteString)
-> Either SymDecryptionException ByteString
-> IO ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SymDecryptionException -> IO ByteString
forall e a. Exception e => e -> IO a
throwIO ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key -> ByteString -> Either SymDecryptionException ByteString
decryptSym (ByteString -> Key
Key ByteString
decryptedKey) ByteString
encryptedBytes)

-- | The sort of exception we might get during signature.
data SignatureException = SignatureException RSAError
  deriving Int -> SignatureException -> ShowS
[SignatureException] -> ShowS
SignatureException -> String
(Int -> SignatureException -> ShowS)
-> (SignatureException -> String)
-> ([SignatureException] -> ShowS)
-> Show SignatureException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignatureException] -> ShowS
$cshowList :: [SignatureException] -> ShowS
show :: SignatureException -> String
$cshow :: SignatureException -> String
showsPrec :: Int -> SignatureException -> ShowS
$cshowsPrec :: Int -> SignatureException -> ShowS
Show

instance Exception SignatureException

-- | The result of 'sign'ing a 'ByteString'. View this as a digital improvement
-- on the written signature: if you sign something with your 'PrivateKey',
-- anyone with your 'PublicKey' can verify that signature's legitimacy.
newtype Signature = Signature
  { Signature -> ByteString
signatureBytes :: ByteString
  } deriving (Signature -> Signature -> Bool
(Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool) -> Eq Signature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Signature -> Signature -> Bool
$c/= :: Signature -> Signature -> Bool
== :: Signature -> Signature -> Bool
$c== :: Signature -> Signature -> Bool
Eq, Eq Signature
Eq Signature
-> (Signature -> Signature -> Ordering)
-> (Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool)
-> (Signature -> Signature -> Signature)
-> (Signature -> Signature -> Signature)
-> Ord Signature
Signature -> Signature -> Bool
Signature -> Signature -> Ordering
Signature -> Signature -> Signature
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Signature -> Signature -> Signature
$cmin :: Signature -> Signature -> Signature
max :: Signature -> Signature -> Signature
$cmax :: Signature -> Signature -> Signature
>= :: Signature -> Signature -> Bool
$c>= :: Signature -> Signature -> Bool
> :: Signature -> Signature -> Bool
$c> :: Signature -> Signature -> Bool
<= :: Signature -> Signature -> Bool
$c<= :: Signature -> Signature -> Bool
< :: Signature -> Signature -> Bool
$c< :: Signature -> Signature -> Bool
compare :: Signature -> Signature -> Ordering
$ccompare :: Signature -> Signature -> Ordering
$cp1Ord :: Eq Signature
Ord, Int -> Signature -> ShowS
[Signature] -> ShowS
Signature -> String
(Int -> Signature -> ShowS)
-> (Signature -> String)
-> ([Signature] -> ShowS)
-> Show Signature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Signature] -> ShowS
$cshowList :: [Signature] -> ShowS
show :: Signature -> String
$cshow :: Signature -> String
showsPrec :: Int -> Signature -> ShowS
$cshowsPrec :: Int -> Signature -> ShowS
Show, ReadPrec [Signature]
ReadPrec Signature
Int -> ReadS Signature
ReadS [Signature]
(Int -> ReadS Signature)
-> ReadS [Signature]
-> ReadPrec Signature
-> ReadPrec [Signature]
-> Read Signature
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Signature]
$creadListPrec :: ReadPrec [Signature]
readPrec :: ReadPrec Signature
$creadPrec :: ReadPrec Signature
readList :: ReadS [Signature]
$creadList :: ReadS [Signature]
readsPrec :: Int -> ReadS Signature
$creadsPrec :: Int -> ReadS Signature
Read, (forall x. Signature -> Rep Signature x)
-> (forall x. Rep Signature x -> Signature) -> Generic Signature
forall x. Rep Signature x -> Signature
forall x. Signature -> Rep Signature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Signature x -> Signature
$cfrom :: forall x. Signature -> Rep Signature x
Generic, Get Signature
[Signature] -> Put
Signature -> Put
(Signature -> Put)
-> Get Signature -> ([Signature] -> Put) -> Binary Signature
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Signature] -> Put
$cputList :: [Signature] -> Put
get :: Get Signature
$cget :: Get Signature
put :: Signature -> Put
$cput :: Signature -> Put
Binary)

-- | Sign a message with your private key, producing a 'ByteString' that
-- others cannot fabricate for new messages.
sign :: PrivateKey -> ByteString -> IO Signature
sign :: PrivateKey -> ByteString -> IO Signature
sign (PrivateKey PrivateKey
privateKey) ByteString
bs =
    PSSParams SHA512 ByteString ByteString
-> PrivateKey -> ByteString -> IO (Either RSAError ByteString)
forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
PSSParams hash ByteString ByteString
-> PrivateKey -> ByteString -> m (Either RSAError ByteString)
RSA.PSS.signSafer
      (SHA512 -> PSSParams SHA512 ByteString ByteString
forall seed output hash.
(ByteArrayAccess seed, ByteArray output, HashAlgorithm hash) =>
hash -> PSSParams hash seed output
RSA.PSS.defaultPSSParams SHA512
Hash.SHA512)
      PrivateKey
privateKey
      ByteString
bs
    IO (Either RSAError ByteString)
-> (Either RSAError ByteString -> IO Signature) -> IO Signature
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (RSAError -> IO Signature)
-> (ByteString -> IO Signature)
-> Either RSAError ByteString
-> IO Signature
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (SignatureException -> IO Signature
forall e a. Exception e => e -> IO a
throwIO (SignatureException -> IO Signature)
-> (RSAError -> SignatureException) -> RSAError -> IO Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RSAError -> SignatureException
SignatureException) (Signature -> IO Signature
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Signature -> IO Signature)
-> (ByteString -> Signature) -> ByteString -> IO Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Signature
Signature)

-- | Verify the signature of a message.
verify :: PublicKey -> ByteString -> Signature -> Bool
verify :: PublicKey -> ByteString -> Signature -> Bool
verify (PublicKey PublicKey
pubKey) ByteString
bs (Signature ByteString
sig) =
    PSSParams SHA512 ByteString ByteString
-> PublicKey -> ByteString -> ByteString -> Bool
forall hash.
HashAlgorithm hash =>
PSSParams hash ByteString ByteString
-> PublicKey -> ByteString -> ByteString -> Bool
RSA.PSS.verify (SHA512 -> PSSParams SHA512 ByteString ByteString
forall seed output hash.
(ByteArrayAccess seed, ByteArray output, HashAlgorithm hash) =>
hash -> PSSParams hash seed output
RSA.PSS.defaultPSSParams SHA512
Hash.SHA512) PublicKey
pubKey ByteString
bs ByteString
sig

-- | A convenient type in which to wrap signed things.
data Signed a = Signed
  { Signed a -> a
signed :: a
  , Signed a -> ByteString
signedEncoded :: ByteString
  , Signed a -> Signature
signature :: Signature
  , Signed a -> PublicKey
signedBy :: PublicKey
  } deriving (Int -> Signed a -> ShowS
[Signed a] -> ShowS
Signed a -> String
(Int -> Signed a -> ShowS)
-> (Signed a -> String) -> ([Signed a] -> ShowS) -> Show (Signed a)
forall a. Show a => Int -> Signed a -> ShowS
forall a. Show a => [Signed a] -> ShowS
forall a. Show a => Signed a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Signed a] -> ShowS
$cshowList :: forall a. Show a => [Signed a] -> ShowS
show :: Signed a -> String
$cshow :: forall a. Show a => Signed a -> String
showsPrec :: Int -> Signed a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Signed a -> ShowS
Show, ReadPrec [Signed a]
ReadPrec (Signed a)
Int -> ReadS (Signed a)
ReadS [Signed a]
(Int -> ReadS (Signed a))
-> ReadS [Signed a]
-> ReadPrec (Signed a)
-> ReadPrec [Signed a]
-> Read (Signed a)
forall a. Read a => ReadPrec [Signed a]
forall a. Read a => ReadPrec (Signed a)
forall a. Read a => Int -> ReadS (Signed a)
forall a. Read a => ReadS [Signed a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Signed a]
$creadListPrec :: forall a. Read a => ReadPrec [Signed a]
readPrec :: ReadPrec (Signed a)
$creadPrec :: forall a. Read a => ReadPrec (Signed a)
readList :: ReadS [Signed a]
$creadList :: forall a. Read a => ReadS [Signed a]
readsPrec :: Int -> ReadS (Signed a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Signed a)
Read, (forall x. Signed a -> Rep (Signed a) x)
-> (forall x. Rep (Signed a) x -> Signed a) -> Generic (Signed a)
forall x. Rep (Signed a) x -> Signed a
forall x. Signed a -> Rep (Signed a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Signed a) x -> Signed a
forall a x. Signed a -> Rep (Signed a) x
$cto :: forall a x. Rep (Signed a) x -> Signed a
$cfrom :: forall a x. Signed a -> Rep (Signed a) x
Generic)

instance Eq (Signed a) where
  Signed a
s == :: Signed a -> Signed a -> Bool
== Signed a
s' =
       (Signature -> Signature -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Signature -> Signature -> Bool)
-> (Signed a -> Signature) -> Signed a -> Signed a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Signed a -> Signature
forall a. Signed a -> Signature
signature) Signed a
s Signed a
s'
    Bool -> Bool -> Bool
&& (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
(==) (ByteString -> ByteString -> Bool)
-> (Signed a -> ByteString) -> Signed a -> Signed a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Signed a -> ByteString
forall a. Signed a -> ByteString
signedEncoded) Signed a
s Signed a
s'
    Bool -> Bool -> Bool
&& (PublicKey -> PublicKey -> Bool
forall a. Eq a => a -> a -> Bool
(==) (PublicKey -> PublicKey -> Bool)
-> (Signed a -> PublicKey) -> Signed a -> Signed a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Signed a -> PublicKey
forall a. Signed a -> PublicKey
signedBy) Signed a
s Signed a
s'

instance Ord (Signed a) where
  compare :: Signed a -> Signed a -> Ordering
compare Signed a
s Signed a
s' =
       (Signature -> Signature -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Signature -> Signature -> Ordering)
-> (Signed a -> Signature) -> Signed a -> Signed a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Signed a -> Signature
forall a. Signed a -> Signature
signature) Signed a
s Signed a
s'
    Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> (ByteString -> ByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ByteString -> ByteString -> Ordering)
-> (Signed a -> ByteString) -> Signed a -> Signed a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Signed a -> ByteString
forall a. Signed a -> ByteString
signedEncoded) Signed a
s Signed a
s'
    Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> (PublicKey -> PublicKey -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PublicKey -> PublicKey -> Ordering)
-> (Signed a -> PublicKey) -> Signed a -> Signed a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Signed a -> PublicKey
forall a. Signed a -> PublicKey
signedBy) Signed a
s Signed a
s'

instance Binary a => Binary (Signed a) where
  put :: Signed a -> Put
put Signed a
s = do
    ByteString -> Put
forall t. Binary t => t -> Put
put (Signed a -> ByteString
forall a. Signed a -> ByteString
signedEncoded Signed a
s)
    Signature -> Put
forall t. Binary t => t -> Put
put (Signed a -> Signature
forall a. Signed a -> Signature
signature Signed a
s)
    PublicKey -> Put
forall t. Binary t => t -> Put
put (Signed a -> PublicKey
forall a. Signed a -> PublicKey
signedBy Signed a
s)
  get :: Get (Signed a)
get = do
    ByteString
signedEncoded <- Get ByteString
forall t. Binary t => Get t
get
    Signature
signature <- Get Signature
forall t. Binary t => Get t
get
    PublicKey
signedBy <- Get PublicKey
forall t. Binary t => Get t
get
    Signed a -> Get (Signed a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Signed a -> Get (Signed a)) -> Signed a -> Get (Signed a)
forall a b. (a -> b) -> a -> b
$ Signed :: forall a. a -> ByteString -> Signature -> PublicKey -> Signed a
Signed
      { signed :: a
signed = ByteString -> a
forall a. Binary a => ByteString -> a
decode (ByteString -> a) -> ByteString -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LBS.fromStrict ByteString
signedEncoded
      , ByteString
signedEncoded :: ByteString
signedEncoded :: ByteString
signedEncoded
      , Signature
signature :: Signature
signature :: Signature
signature
      , PublicKey
signedBy :: PublicKey
signedBy :: PublicKey
signedBy
      }
    
-- | Create a 'Signed' piece of data.
mkSigned :: Binary a => PrivateKey -> a -> IO (Signed a)
mkSigned :: PrivateKey -> a -> IO (Signed a)
mkSigned PrivateKey
privateKey a
signed = do
  let signedEncoded :: ByteString
signedEncoded = ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. Binary a => a -> ByteString
encode a
signed
  Signature
signature <- PrivateKey -> ByteString -> IO Signature
sign PrivateKey
privateKey ByteString
signedEncoded
  let signedBy :: PublicKey
signedBy = PrivateKey -> PublicKey
privateToPublic PrivateKey
privateKey
  Signed a -> IO (Signed a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Signed a -> IO (Signed a)) -> Signed a -> IO (Signed a)
forall a b. (a -> b) -> a -> b
$ Signed :: forall a. a -> ByteString -> Signature -> PublicKey -> Signed a
Signed { a
signed :: a
signed :: a
signed, ByteString
signedEncoded :: ByteString
signedEncoded :: ByteString
signedEncoded, Signature
signature :: Signature
signature :: Signature
signature, PublicKey
signedBy :: PublicKey
signedBy :: PublicKey
signedBy }
  
-- | Verify a 'Signed' piece of data.
verifySigned :: Signed a -> Bool
verifySigned :: Signed a -> Bool
verifySigned Signed a
s = PublicKey -> ByteString -> Signature -> Bool
verify (Signed a -> PublicKey
forall a. Signed a -> PublicKey
signedBy Signed a
s) (Signed a -> ByteString
forall a. Signed a -> ByteString
signedEncoded Signed a
s) (Signed a -> Signature
forall a. Signed a -> Signature
signature Signed a
s)