{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module      : Simplex.Messaging.Crypto
-- Copyright   : (c) simplex.chat
-- License     : AGPL-3
--
-- Maintainer  : chat@simplex.chat
-- Stability   : experimental
-- Portability : non-portable
--
-- This module provides cryptography implementation for SMP protocols based on
-- <https://hackage.haskell.org/package/cryptonite cryptonite package>.
module Simplex.Messaging.Crypto
  ( -- * RSA keys
    PrivateKey (rsaPrivateKey, publicKey),
    SafePrivateKey (..), -- constructor is not exported
    FullPrivateKey (..),
    APrivateKey (..),
    PublicKey (..),
    SafeKeyPair,
    FullKeyPair,
    KeyHash (..),
    generateKeyPair,
    publicKey',
    publicKeySize,
    validKeySize,
    safePrivateKey,
    removePublicKey,

    -- * E2E hybrid encryption scheme
    encrypt,
    decrypt,

    -- * RSA OAEP encryption
    encryptOAEP,
    decryptOAEP,

    -- * RSA PSS signing
    Signature (..),
    sign,
    verify,

    -- * AES256 AEAD-GCM scheme
    Key (..),
    IV (..),
    encryptAES,
    decryptAES,
    authTagSize,
    authTagToBS,
    bsToAuthTag,
    randomAesKey,
    randomIV,
    aesKeyP,
    ivP,

    -- * Encoding of RSA keys
    serializePrivKey,
    serializePubKey,
    serializePubKeyUri,
    encodePubKey,
    publicKeyHash,
    privKeyP,
    pubKeyP,
    pubKeyUriP,
    binaryPubKeyP,

    -- * SHA256 hash
    sha256Hash,

    -- * Cryptography error type
    CryptoError (..),
  )
where

import Control.Exception (Exception)
import Control.Monad.Except
import Control.Monad.Trans.Except
import Crypto.Cipher.AES (AES256)
import qualified Crypto.Cipher.Types as AES
import qualified Crypto.Error as CE
import Crypto.Hash (Digest, SHA256 (..), hash)
import Crypto.Number.Generate (generateMax)
import Crypto.Number.Prime (findPrimeFrom)
import qualified Crypto.PubKey.RSA as R
import qualified Crypto.PubKey.RSA.OAEP as OAEP
import qualified Crypto.PubKey.RSA.PSS as PSS
import Crypto.Random (getRandomBytes)
import Data.ASN1.BinaryEncoding
import Data.ASN1.Encoding
import Data.ASN1.Types
import Data.Attoparsec.ByteString.Char8 (Parser)
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.Bifunctor (bimap, first)
import qualified Data.ByteArray as BA
import Data.ByteString.Base64 (decode, encode)
import qualified Data.ByteString.Base64.URL as U
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.ByteString.Internal (c2w, w2c)
import Data.ByteString.Lazy (fromStrict, toStrict)
import Data.String
import Data.X509
import Database.SQLite.Simple.FromField (FromField (..))
import Database.SQLite.Simple.ToField (ToField (..))
import Network.Transport.Internal (decodeWord32, encodeWord32)
import Simplex.Messaging.Parsers (base64P, base64UriP, blobFieldParser, parseAll, parseString)
import Simplex.Messaging.Util (liftEitherError, (<$?>))

-- | A newtype of 'Crypto.PubKey.RSA.PublicKey'.
newtype PublicKey = PublicKey {PublicKey -> PublicKey
rsaPublicKey :: R.PublicKey} deriving (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, 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)

-- | A newtype of 'Crypto.PubKey.RSA.PrivateKey', with PublicKey removed.
--
-- It is not possible to recover PublicKey from SafePrivateKey.
-- The constructor of this type is not exported.
newtype SafePrivateKey = SafePrivateKey {SafePrivateKey -> PrivateKey
unPrivateKey :: R.PrivateKey} deriving (SafePrivateKey -> SafePrivateKey -> Bool
(SafePrivateKey -> SafePrivateKey -> Bool)
-> (SafePrivateKey -> SafePrivateKey -> Bool) -> Eq SafePrivateKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SafePrivateKey -> SafePrivateKey -> Bool
$c/= :: SafePrivateKey -> SafePrivateKey -> Bool
== :: SafePrivateKey -> SafePrivateKey -> Bool
$c== :: SafePrivateKey -> SafePrivateKey -> Bool
Eq, Int -> SafePrivateKey -> ShowS
[SafePrivateKey] -> ShowS
SafePrivateKey -> String
(Int -> SafePrivateKey -> ShowS)
-> (SafePrivateKey -> String)
-> ([SafePrivateKey] -> ShowS)
-> Show SafePrivateKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SafePrivateKey] -> ShowS
$cshowList :: [SafePrivateKey] -> ShowS
show :: SafePrivateKey -> String
$cshow :: SafePrivateKey -> String
showsPrec :: Int -> SafePrivateKey -> ShowS
$cshowsPrec :: Int -> SafePrivateKey -> ShowS
Show)

-- | A newtype of 'Crypto.PubKey.RSA.PrivateKey' (with PublicKey inside).
newtype FullPrivateKey = FullPrivateKey {FullPrivateKey -> PrivateKey
unPrivateKey :: R.PrivateKey} deriving (FullPrivateKey -> FullPrivateKey -> Bool
(FullPrivateKey -> FullPrivateKey -> Bool)
-> (FullPrivateKey -> FullPrivateKey -> Bool) -> Eq FullPrivateKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FullPrivateKey -> FullPrivateKey -> Bool
$c/= :: FullPrivateKey -> FullPrivateKey -> Bool
== :: FullPrivateKey -> FullPrivateKey -> Bool
$c== :: FullPrivateKey -> FullPrivateKey -> Bool
Eq, Int -> FullPrivateKey -> ShowS
[FullPrivateKey] -> ShowS
FullPrivateKey -> String
(Int -> FullPrivateKey -> ShowS)
-> (FullPrivateKey -> String)
-> ([FullPrivateKey] -> ShowS)
-> Show FullPrivateKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FullPrivateKey] -> ShowS
$cshowList :: [FullPrivateKey] -> ShowS
show :: FullPrivateKey -> String
$cshow :: FullPrivateKey -> String
showsPrec :: Int -> FullPrivateKey -> ShowS
$cshowsPrec :: Int -> FullPrivateKey -> ShowS
Show)

-- | A newtype of 'Crypto.PubKey.RSA.PrivateKey' (PublicKey may be inside).
newtype APrivateKey = APrivateKey {APrivateKey -> PrivateKey
unPrivateKey :: R.PrivateKey} deriving (APrivateKey -> APrivateKey -> Bool
(APrivateKey -> APrivateKey -> Bool)
-> (APrivateKey -> APrivateKey -> Bool) -> Eq APrivateKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: APrivateKey -> APrivateKey -> Bool
$c/= :: APrivateKey -> APrivateKey -> Bool
== :: APrivateKey -> APrivateKey -> Bool
$c== :: APrivateKey -> APrivateKey -> Bool
Eq, Int -> APrivateKey -> ShowS
[APrivateKey] -> ShowS
APrivateKey -> String
(Int -> APrivateKey -> ShowS)
-> (APrivateKey -> String)
-> ([APrivateKey] -> ShowS)
-> Show APrivateKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [APrivateKey] -> ShowS
$cshowList :: [APrivateKey] -> ShowS
show :: APrivateKey -> String
$cshow :: APrivateKey -> String
showsPrec :: Int -> APrivateKey -> ShowS
$cshowsPrec :: Int -> APrivateKey -> ShowS
Show)

-- | Type-class used for both private key types: SafePrivateKey and FullPrivateKey.
class PrivateKey k where
  -- unwraps 'Crypto.PubKey.RSA.PrivateKey'
  rsaPrivateKey :: k -> R.PrivateKey

  -- equivalent to data type constructor, not exported
  _privateKey :: R.PrivateKey -> k

  -- smart constructor removing public key from SafePrivateKey but keeping it in FullPrivateKey
  mkPrivateKey :: R.PrivateKey -> k

  -- extracts public key from private key
  publicKey :: k -> Maybe PublicKey

-- | Remove public key exponent from APrivateKey.
removePublicKey :: APrivateKey -> APrivateKey
removePublicKey :: APrivateKey -> APrivateKey
removePublicKey (APrivateKey R.PrivateKey {private_pub :: PrivateKey -> PublicKey
private_pub = PublicKey
k, Integer
private_d :: PrivateKey -> Integer
private_d :: Integer
private_d}) =
  PrivateKey -> APrivateKey
APrivateKey (PrivateKey -> APrivateKey) -> PrivateKey -> APrivateKey
forall a b. (a -> b) -> a -> b
$ SafePrivateKey -> PrivateKey
unPrivateKey ((Int, Integer, Integer) -> SafePrivateKey
safePrivateKey (PublicKey -> Int
R.public_size PublicKey
k, PublicKey -> Integer
R.public_n PublicKey
k, Integer
private_d) :: SafePrivateKey)

instance PrivateKey SafePrivateKey where
  rsaPrivateKey :: SafePrivateKey -> PrivateKey
rsaPrivateKey = SafePrivateKey -> PrivateKey
unPrivateKey
  _privateKey :: PrivateKey -> SafePrivateKey
_privateKey = PrivateKey -> SafePrivateKey
SafePrivateKey
  mkPrivateKey :: PrivateKey -> SafePrivateKey
mkPrivateKey R.PrivateKey {private_pub :: PrivateKey -> PublicKey
private_pub = PublicKey
k, Integer
private_d :: Integer
private_d :: PrivateKey -> Integer
private_d} =
    (Int, Integer, Integer) -> SafePrivateKey
safePrivateKey (PublicKey -> Int
R.public_size PublicKey
k, PublicKey -> Integer
R.public_n PublicKey
k, Integer
private_d)
  publicKey :: SafePrivateKey -> Maybe PublicKey
publicKey SafePrivateKey
_ = Maybe PublicKey
forall a. Maybe a
Nothing

instance PrivateKey FullPrivateKey where
  rsaPrivateKey :: FullPrivateKey -> PrivateKey
rsaPrivateKey = FullPrivateKey -> PrivateKey
unPrivateKey
  _privateKey :: PrivateKey -> FullPrivateKey
_privateKey = PrivateKey -> FullPrivateKey
FullPrivateKey
  mkPrivateKey :: PrivateKey -> FullPrivateKey
mkPrivateKey = PrivateKey -> FullPrivateKey
FullPrivateKey
  publicKey :: FullPrivateKey -> Maybe PublicKey
publicKey = PublicKey -> Maybe PublicKey
forall a. a -> Maybe a
Just (PublicKey -> Maybe PublicKey)
-> (FullPrivateKey -> PublicKey)
-> FullPrivateKey
-> Maybe PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> PublicKey
PublicKey (PublicKey -> PublicKey)
-> (FullPrivateKey -> PublicKey) -> FullPrivateKey -> PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivateKey -> PublicKey
R.private_pub (PrivateKey -> PublicKey)
-> (FullPrivateKey -> PrivateKey) -> FullPrivateKey -> PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FullPrivateKey -> PrivateKey
forall k. PrivateKey k => k -> PrivateKey
rsaPrivateKey

instance PrivateKey APrivateKey where
  rsaPrivateKey :: APrivateKey -> PrivateKey
rsaPrivateKey = APrivateKey -> PrivateKey
unPrivateKey
  _privateKey :: PrivateKey -> APrivateKey
_privateKey = PrivateKey -> APrivateKey
APrivateKey
  mkPrivateKey :: PrivateKey -> APrivateKey
mkPrivateKey = PrivateKey -> APrivateKey
APrivateKey
  publicKey :: APrivateKey -> Maybe PublicKey
publicKey APrivateKey
pk =
    let k :: PublicKey
k = PrivateKey -> PublicKey
R.private_pub (PrivateKey -> PublicKey) -> PrivateKey -> PublicKey
forall a b. (a -> b) -> a -> b
$ APrivateKey -> PrivateKey
forall k. PrivateKey k => k -> PrivateKey
rsaPrivateKey APrivateKey
pk
     in if PublicKey -> Integer
R.public_e PublicKey
k Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
          then Maybe PublicKey
forall a. Maybe a
Nothing
          else PublicKey -> Maybe PublicKey
forall a. a -> Maybe a
Just (PublicKey -> Maybe PublicKey) -> PublicKey -> Maybe PublicKey
forall a b. (a -> b) -> a -> b
$ PublicKey -> PublicKey
PublicKey PublicKey
k

instance IsString FullPrivateKey where
  fromString :: String -> FullPrivateKey
fromString = (ByteString -> Either String FullPrivateKey)
-> String -> FullPrivateKey
forall a. (ByteString -> Either String a) -> String -> a
parseString ((ByteString -> Either String FullPrivateKey)
 -> String -> FullPrivateKey)
-> (ByteString -> Either String FullPrivateKey)
-> String
-> FullPrivateKey
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
decode (ByteString -> Either String ByteString)
-> (ByteString -> Either String FullPrivateKey)
-> ByteString
-> Either String FullPrivateKey
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ByteString -> Either String FullPrivateKey
forall k. PrivateKey k => ByteString -> Either String k
decodePrivKey

instance IsString PublicKey where
  fromString :: String -> PublicKey
fromString = (ByteString -> Either String PublicKey) -> String -> PublicKey
forall a. (ByteString -> Either String a) -> String -> a
parseString ((ByteString -> Either String PublicKey) -> String -> PublicKey)
-> (ByteString -> Either String PublicKey) -> String -> PublicKey
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
decode (ByteString -> Either String ByteString)
-> (ByteString -> Either String PublicKey)
-> ByteString
-> Either String PublicKey
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ByteString -> Either String PublicKey
decodePubKey

instance ToField SafePrivateKey where toField :: SafePrivateKey -> SQLData
toField = ByteString -> SQLData
forall a. ToField a => a -> SQLData
toField (ByteString -> SQLData)
-> (SafePrivateKey -> ByteString) -> SafePrivateKey -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafePrivateKey -> ByteString
forall k. PrivateKey k => k -> ByteString
encodePrivKey

instance ToField APrivateKey where toField :: APrivateKey -> SQLData
toField = ByteString -> SQLData
forall a. ToField a => a -> SQLData
toField (ByteString -> SQLData)
-> (APrivateKey -> ByteString) -> APrivateKey -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APrivateKey -> ByteString
forall k. PrivateKey k => k -> ByteString
encodePrivKey

instance ToField PublicKey where toField :: PublicKey -> SQLData
toField = ByteString -> SQLData
forall a. ToField a => a -> SQLData
toField (ByteString -> SQLData)
-> (PublicKey -> ByteString) -> PublicKey -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> ByteString
encodePubKey

instance FromField SafePrivateKey where fromField :: FieldParser SafePrivateKey
fromField = Parser SafePrivateKey -> FieldParser SafePrivateKey
forall k. Typeable k => Parser k -> FieldParser k
blobFieldParser Parser SafePrivateKey
forall k. PrivateKey k => Parser k
binaryPrivKeyP

instance FromField APrivateKey where fromField :: FieldParser APrivateKey
fromField = Parser APrivateKey -> FieldParser APrivateKey
forall k. Typeable k => Parser k -> FieldParser k
blobFieldParser Parser APrivateKey
forall k. PrivateKey k => Parser k
binaryPrivKeyP

instance FromField PublicKey where fromField :: FieldParser PublicKey
fromField = Parser PublicKey -> FieldParser PublicKey
forall k. Typeable k => Parser k -> FieldParser k
blobFieldParser Parser PublicKey
binaryPubKeyP

-- | Tuple of RSA 'PublicKey' and 'PrivateKey'.
type KeyPair k = (PublicKey, k)

-- | Tuple of RSA 'PublicKey' and 'SafePrivateKey'.
type SafeKeyPair = (PublicKey, SafePrivateKey)

-- | Tuple of RSA 'PublicKey' and 'FullPrivateKey'.
type FullKeyPair = (PublicKey, FullPrivateKey)

-- | RSA signature newtype.
newtype Signature = Signature {Signature -> ByteString
unSignature :: 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, 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)

instance IsString Signature where
  fromString :: String -> Signature
fromString = ByteString -> Signature
Signature (ByteString -> Signature)
-> (String -> ByteString) -> String -> Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
forall a. IsString a => String -> a
fromString

-- | Various cryptographic or related errors.
data CryptoError
  = -- | RSA OAEP encryption error
    RSAEncryptError R.Error
  | -- | RSA OAEP decryption error
    RSADecryptError R.Error
  | -- | RSA PSS signature error
    RSASignError R.Error
  | -- | AES initialization error
    AESCipherError CE.CryptoError
  | -- | IV generation error
    CryptoIVError
  | -- | AES decryption error
    AESDecryptError
  | -- | message does not fit in SMP block
    CryptoLargeMsgError
  | -- | failure parsing RSA-encrypted message header
    CryptoHeaderError String
  deriving (CryptoError -> CryptoError -> Bool
(CryptoError -> CryptoError -> Bool)
-> (CryptoError -> CryptoError -> Bool) -> Eq CryptoError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CryptoError -> CryptoError -> Bool
$c/= :: CryptoError -> CryptoError -> Bool
== :: CryptoError -> CryptoError -> Bool
$c== :: CryptoError -> CryptoError -> Bool
Eq, Int -> CryptoError -> ShowS
[CryptoError] -> ShowS
CryptoError -> String
(Int -> CryptoError -> ShowS)
-> (CryptoError -> String)
-> ([CryptoError] -> ShowS)
-> Show CryptoError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CryptoError] -> ShowS
$cshowList :: [CryptoError] -> ShowS
show :: CryptoError -> String
$cshow :: CryptoError -> String
showsPrec :: Int -> CryptoError -> ShowS
$cshowsPrec :: Int -> CryptoError -> ShowS
Show, Show CryptoError
Typeable CryptoError
Typeable CryptoError
-> Show CryptoError
-> (CryptoError -> SomeException)
-> (SomeException -> Maybe CryptoError)
-> (CryptoError -> String)
-> Exception CryptoError
SomeException -> Maybe CryptoError
CryptoError -> String
CryptoError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: CryptoError -> String
$cdisplayException :: CryptoError -> String
fromException :: SomeException -> Maybe CryptoError
$cfromException :: SomeException -> Maybe CryptoError
toException :: CryptoError -> SomeException
$ctoException :: CryptoError -> SomeException
$cp2Exception :: Show CryptoError
$cp1Exception :: Typeable CryptoError
Exception)

pubExpRange :: Integer
pubExpRange :: Integer
pubExpRange = Integer
2 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
1024 :: Int)

aesKeySize :: Int
aesKeySize :: Int
aesKeySize = Int
256 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8

authTagSize :: Int
authTagSize :: Int
authTagSize = Int
128 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8

-- | Generate RSA key pair with either SafePrivateKey or FullPrivateKey.
generateKeyPair :: PrivateKey k => Int -> IO (KeyPair k)
generateKeyPair :: Int -> IO (KeyPair k)
generateKeyPair Int
size = IO (KeyPair k)
loop
  where
    publicExponent :: IO Integer
publicExponent = Integer -> Integer
findPrimeFrom (Integer -> Integer) -> (Integer -> Integer) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
3) (Integer -> Integer) -> IO Integer -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> IO Integer
forall (m :: * -> *). MonadRandom m => Integer -> m Integer
generateMax Integer
pubExpRange
    loop :: IO (KeyPair k)
loop = do
      (PublicKey
k, PrivateKey
pk) <- Int -> Integer -> IO (PublicKey, PrivateKey)
forall (m :: * -> *).
MonadRandom m =>
Int -> Integer -> m (PublicKey, PrivateKey)
R.generate Int
size (Integer -> IO (PublicKey, PrivateKey))
-> IO Integer -> IO (PublicKey, PrivateKey)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Integer
publicExponent
      let n :: Integer
n = PublicKey -> Integer
R.public_n PublicKey
k
          d :: Integer
d = PrivateKey -> Integer
R.private_d PrivateKey
pk
      if Integer
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
d Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
n
        then IO (KeyPair k)
loop
        else KeyPair k -> IO (KeyPair k)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PublicKey -> PublicKey
PublicKey PublicKey
k, PrivateKey -> k
forall k. PrivateKey k => PrivateKey -> k
mkPrivateKey PrivateKey
pk)

privateKeySize :: PrivateKey k => k -> Int
privateKeySize :: k -> Int
privateKeySize = PublicKey -> Int
R.public_size (PublicKey -> Int) -> (k -> PublicKey) -> k -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivateKey -> PublicKey
R.private_pub (PrivateKey -> PublicKey) -> (k -> PrivateKey) -> k -> PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> PrivateKey
forall k. PrivateKey k => k -> PrivateKey
rsaPrivateKey

publicKey' :: FullPrivateKey -> PublicKey
publicKey' :: FullPrivateKey -> PublicKey
publicKey' = PublicKey -> PublicKey
PublicKey (PublicKey -> PublicKey)
-> (FullPrivateKey -> PublicKey) -> FullPrivateKey -> PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivateKey -> PublicKey
R.private_pub (PrivateKey -> PublicKey)
-> (FullPrivateKey -> PrivateKey) -> FullPrivateKey -> PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FullPrivateKey -> PrivateKey
forall k. PrivateKey k => k -> PrivateKey
rsaPrivateKey

publicKeySize :: PublicKey -> Int
publicKeySize :: PublicKey -> Int
publicKeySize = PublicKey -> Int
R.public_size (PublicKey -> Int) -> (PublicKey -> PublicKey) -> PublicKey -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> PublicKey
rsaPublicKey

validKeySize :: Int -> Bool
validKeySize :: Int -> Bool
validKeySize = \case
  Int
128 -> Bool
True
  Int
256 -> Bool
True
  Int
384 -> Bool
True
  Int
512 -> Bool
True
  Int
_ -> Bool
False

data Header = Header
  { Header -> Key
aesKey :: Key,
    Header -> IV
ivBytes :: IV,
    Header -> AuthTag
authTag :: AES.AuthTag,
    Header -> Int
msgSize :: Int
  }

-- | AES key newtype.
newtype Key = Key {Key -> ByteString
unKey :: ByteString}

-- | IV bytes newtype.
newtype IV = IV {IV -> ByteString
unIV :: ByteString}

-- | Key hash newtype.
newtype KeyHash = KeyHash {KeyHash -> ByteString
unKeyHash :: ByteString} deriving (KeyHash -> KeyHash -> Bool
(KeyHash -> KeyHash -> Bool)
-> (KeyHash -> KeyHash -> Bool) -> Eq KeyHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyHash -> KeyHash -> Bool
$c/= :: KeyHash -> KeyHash -> Bool
== :: KeyHash -> KeyHash -> Bool
$c== :: KeyHash -> KeyHash -> Bool
Eq, Eq KeyHash
Eq KeyHash
-> (KeyHash -> KeyHash -> Ordering)
-> (KeyHash -> KeyHash -> Bool)
-> (KeyHash -> KeyHash -> Bool)
-> (KeyHash -> KeyHash -> Bool)
-> (KeyHash -> KeyHash -> Bool)
-> (KeyHash -> KeyHash -> KeyHash)
-> (KeyHash -> KeyHash -> KeyHash)
-> Ord KeyHash
KeyHash -> KeyHash -> Bool
KeyHash -> KeyHash -> Ordering
KeyHash -> KeyHash -> KeyHash
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 :: KeyHash -> KeyHash -> KeyHash
$cmin :: KeyHash -> KeyHash -> KeyHash
max :: KeyHash -> KeyHash -> KeyHash
$cmax :: KeyHash -> KeyHash -> KeyHash
>= :: KeyHash -> KeyHash -> Bool
$c>= :: KeyHash -> KeyHash -> Bool
> :: KeyHash -> KeyHash -> Bool
$c> :: KeyHash -> KeyHash -> Bool
<= :: KeyHash -> KeyHash -> Bool
$c<= :: KeyHash -> KeyHash -> Bool
< :: KeyHash -> KeyHash -> Bool
$c< :: KeyHash -> KeyHash -> Bool
compare :: KeyHash -> KeyHash -> Ordering
$ccompare :: KeyHash -> KeyHash -> Ordering
$cp1Ord :: Eq KeyHash
Ord, Int -> KeyHash -> ShowS
[KeyHash] -> ShowS
KeyHash -> String
(Int -> KeyHash -> ShowS)
-> (KeyHash -> String) -> ([KeyHash] -> ShowS) -> Show KeyHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyHash] -> ShowS
$cshowList :: [KeyHash] -> ShowS
show :: KeyHash -> String
$cshow :: KeyHash -> String
showsPrec :: Int -> KeyHash -> ShowS
$cshowsPrec :: Int -> KeyHash -> ShowS
Show)

instance IsString KeyHash where
  fromString :: String -> KeyHash
fromString = (ByteString -> Either String KeyHash) -> String -> KeyHash
forall a. (ByteString -> Either String a) -> String -> a
parseString ((ByteString -> Either String KeyHash) -> String -> KeyHash)
-> (Parser KeyHash -> ByteString -> Either String KeyHash)
-> Parser KeyHash
-> String
-> KeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser KeyHash -> ByteString -> Either String KeyHash
forall a. Parser a -> ByteString -> Either String a
parseAll (Parser KeyHash -> String -> KeyHash)
-> Parser KeyHash -> String -> KeyHash
forall a b. (a -> b) -> a -> b
$ ByteString -> KeyHash
KeyHash (ByteString -> KeyHash)
-> Parser ByteString ByteString -> Parser KeyHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
base64P

instance ToField KeyHash where toField :: KeyHash -> SQLData
toField = ByteString -> SQLData
forall a. ToField a => a -> SQLData
toField (ByteString -> SQLData)
-> (KeyHash -> ByteString) -> KeyHash -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
encode (ByteString -> ByteString)
-> (KeyHash -> ByteString) -> KeyHash -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash -> ByteString
unKeyHash

instance FromField KeyHash where fromField :: FieldParser KeyHash
fromField = Parser KeyHash -> FieldParser KeyHash
forall k. Typeable k => Parser k -> FieldParser k
blobFieldParser (Parser KeyHash -> FieldParser KeyHash)
-> Parser KeyHash -> FieldParser KeyHash
forall a b. (a -> b) -> a -> b
$ ByteString -> KeyHash
KeyHash (ByteString -> KeyHash)
-> Parser ByteString ByteString -> Parser KeyHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
base64P

-- | Digest (hash) of binary X509 encoding of RSA public key.
publicKeyHash :: PublicKey -> KeyHash
publicKeyHash :: PublicKey -> KeyHash
publicKeyHash = ByteString -> KeyHash
KeyHash (ByteString -> KeyHash)
-> (PublicKey -> ByteString) -> PublicKey -> KeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
sha256Hash (ByteString -> ByteString)
-> (PublicKey -> ByteString) -> PublicKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> ByteString
encodePubKey

-- | SHA256 digest.
sha256Hash :: ByteString -> ByteString
sha256Hash :: ByteString -> ByteString
sha256Hash = Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (Digest SHA256 -> ByteString)
-> (ByteString -> Digest SHA256) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Digest SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash :: ByteString -> Digest SHA256)

serializeHeader :: Header -> ByteString
serializeHeader :: Header -> ByteString
serializeHeader Header {Key
aesKey :: Key
$sel:aesKey:Header :: Header -> Key
aesKey, IV
ivBytes :: IV
$sel:ivBytes:Header :: Header -> IV
ivBytes, AuthTag
authTag :: AuthTag
$sel:authTag:Header :: Header -> AuthTag
authTag, Int
msgSize :: Int
$sel:msgSize:Header :: Header -> Int
msgSize} =
  Key -> ByteString
unKey Key
aesKey ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> IV -> ByteString
unIV IV
ivBytes ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> AuthTag -> ByteString
authTagToBS AuthTag
authTag ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (Word32 -> ByteString
encodeWord32 (Word32 -> ByteString) -> (Int -> Word32) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral) Int
msgSize

headerP :: Parser Header
headerP :: Parser Header
headerP = do
  Key
aesKey <- Parser Key
aesKeyP
  IV
ivBytes <- Parser IV
ivP
  AuthTag
authTag <- ByteString -> AuthTag
bsToAuthTag (ByteString -> AuthTag)
-> Parser ByteString ByteString -> Parser ByteString AuthTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser ByteString ByteString
A.take Int
authTagSize
  Int
msgSize <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> (ByteString -> Word32) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Word32
decodeWord32 (ByteString -> Int)
-> Parser ByteString ByteString -> Parser ByteString Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser ByteString ByteString
A.take Int
4
  Header -> Parser Header
forall (m :: * -> *) a. Monad m => a -> m a
return Header :: Key -> IV -> AuthTag -> Int -> Header
Header {Key
aesKey :: Key
$sel:aesKey:Header :: Key
aesKey, IV
ivBytes :: IV
$sel:ivBytes:Header :: IV
ivBytes, AuthTag
authTag :: AuthTag
$sel:authTag:Header :: AuthTag
authTag, Int
msgSize :: Int
$sel:msgSize:Header :: Int
msgSize}

-- | AES256 key parser.
aesKeyP :: Parser Key
aesKeyP :: Parser Key
aesKeyP = ByteString -> Key
Key (ByteString -> Key) -> Parser ByteString ByteString -> Parser Key
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser ByteString ByteString
A.take Int
aesKeySize

-- | IV bytes parser.
ivP :: Parser IV
ivP :: Parser IV
ivP = ByteString -> IV
IV (ByteString -> IV) -> Parser ByteString ByteString -> Parser IV
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser ByteString ByteString
A.take (BlockCipher AES256 => Int
forall c. BlockCipher c => Int
ivSize @AES256)

parseHeader :: ByteString -> Either CryptoError Header
parseHeader :: ByteString -> Either CryptoError Header
parseHeader = (String -> CryptoError)
-> Either String Header -> Either CryptoError Header
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> CryptoError
CryptoHeaderError (Either String Header -> Either CryptoError Header)
-> (ByteString -> Either String Header)
-> ByteString
-> Either CryptoError Header
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Header -> ByteString -> Either String Header
forall a. Parser a -> ByteString -> Either String a
parseAll Parser Header
headerP

-- * E2E hybrid encryption scheme

-- | E2E encrypt SMP agent messages.
--
-- https://github.com/simplex-chat/simplexmq/blob/master/rfcs/2021-01-26-crypto.md#e2e-encryption
encrypt :: PublicKey -> Int -> ByteString -> ExceptT CryptoError IO ByteString
encrypt :: PublicKey -> Int -> ByteString -> ExceptT CryptoError IO ByteString
encrypt PublicKey
k Int
paddedSize ByteString
msg = do
  Key
aesKey <- IO Key -> ExceptT CryptoError IO Key
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Key
randomAesKey
  IV
ivBytes <- IO IV -> ExceptT CryptoError IO IV
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO IV
randomIV
  (AuthTag
authTag, ByteString
msg') <- Key
-> IV
-> Int
-> ByteString
-> ExceptT CryptoError IO (AuthTag, ByteString)
encryptAES Key
aesKey IV
ivBytes Int
paddedSize ByteString
msg
  let header :: Header
header = Header :: Key -> IV -> AuthTag -> Int -> Header
Header {Key
aesKey :: Key
$sel:aesKey:Header :: Key
aesKey, IV
ivBytes :: IV
$sel:ivBytes:Header :: IV
ivBytes, AuthTag
authTag :: AuthTag
$sel:authTag:Header :: AuthTag
authTag, $sel:msgSize:Header :: Int
msgSize = ByteString -> Int
B.length ByteString
msg}
  ByteString
encHeader <- PublicKey -> ByteString -> ExceptT CryptoError IO ByteString
encryptOAEP PublicKey
k (ByteString -> ExceptT CryptoError IO ByteString)
-> ByteString -> ExceptT CryptoError IO ByteString
forall a b. (a -> b) -> a -> b
$ Header -> ByteString
serializeHeader Header
header
  ByteString -> ExceptT CryptoError IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ExceptT CryptoError IO ByteString)
-> ByteString -> ExceptT CryptoError IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
encHeader ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
msg'

-- | E2E decrypt SMP agent messages.
--
-- https://github.com/simplex-chat/simplexmq/blob/master/rfcs/2021-01-26-crypto.md#e2e-encryption
decrypt :: PrivateKey k => k -> ByteString -> ExceptT CryptoError IO ByteString
decrypt :: k -> ByteString -> ExceptT CryptoError IO ByteString
decrypt k
pk ByteString
msg'' = do
  let (ByteString
encHeader, ByteString
msg') = Int -> ByteString -> (ByteString, ByteString)
B.splitAt (k -> Int
forall k. PrivateKey k => k -> Int
privateKeySize k
pk) ByteString
msg''
  ByteString
header <- k -> ByteString -> ExceptT CryptoError IO ByteString
forall k.
PrivateKey k =>
k -> ByteString -> ExceptT CryptoError IO ByteString
decryptOAEP k
pk ByteString
encHeader
  Header {Key
aesKey :: Key
$sel:aesKey:Header :: Header -> Key
aesKey, IV
ivBytes :: IV
$sel:ivBytes:Header :: Header -> IV
ivBytes, AuthTag
authTag :: AuthTag
$sel:authTag:Header :: Header -> AuthTag
authTag, Int
msgSize :: Int
$sel:msgSize:Header :: Header -> Int
msgSize} <- Either CryptoError Header -> ExceptT CryptoError IO Header
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either CryptoError Header -> ExceptT CryptoError IO Header)
-> Either CryptoError Header -> ExceptT CryptoError IO Header
forall a b. (a -> b) -> a -> b
$ ByteString -> Either CryptoError Header
parseHeader ByteString
header
  ByteString
msg <- Key
-> IV -> ByteString -> AuthTag -> ExceptT CryptoError IO ByteString
decryptAES Key
aesKey IV
ivBytes ByteString
msg' AuthTag
authTag
  ByteString -> ExceptT CryptoError IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ExceptT CryptoError IO ByteString)
-> ByteString -> ExceptT CryptoError IO ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.take Int
msgSize ByteString
msg

-- | AEAD-GCM encryption.
--
-- Used as part of hybrid E2E encryption scheme and for SMP transport blocks encryption.
encryptAES :: Key -> IV -> Int -> ByteString -> ExceptT CryptoError IO (AES.AuthTag, ByteString)
encryptAES :: Key
-> IV
-> Int
-> ByteString
-> ExceptT CryptoError IO (AuthTag, ByteString)
encryptAES Key
aesKey IV
ivBytes Int
paddedSize ByteString
msg = do
  AEAD AES256
aead <- Key -> IV -> ExceptT CryptoError IO (AEAD AES256)
forall c.
BlockCipher c =>
Key -> IV -> ExceptT CryptoError IO (AEAD c)
initAEAD @AES256 Key
aesKey IV
ivBytes
  ByteString
msg' <- ExceptT CryptoError IO ByteString
paddedMsg
  (AuthTag, ByteString)
-> ExceptT CryptoError IO (AuthTag, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return ((AuthTag, ByteString)
 -> ExceptT CryptoError IO (AuthTag, ByteString))
-> (AuthTag, ByteString)
-> ExceptT CryptoError IO (AuthTag, ByteString)
forall a b. (a -> b) -> a -> b
$ AEAD AES256
-> ByteString -> ByteString -> Int -> (AuthTag, ByteString)
forall aad ba a.
(ByteArrayAccess aad, ByteArray ba) =>
AEAD a -> aad -> ba -> Int -> (AuthTag, ba)
AES.aeadSimpleEncrypt AEAD AES256
aead ByteString
B.empty ByteString
msg' Int
authTagSize
  where
    len :: Int
len = ByteString -> Int
B.length ByteString
msg
    paddedMsg :: ExceptT CryptoError IO ByteString
paddedMsg
      | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
paddedSize = CryptoError -> ExceptT CryptoError IO ByteString
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE CryptoError
CryptoLargeMsgError
      | Bool
otherwise = ByteString -> ExceptT CryptoError IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
msg ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> ByteString
B.replicate (Int
paddedSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) Char
'#')

-- | AEAD-GCM decryption.
--
-- Used as part of hybrid E2E encryption scheme and for SMP transport blocks decryption.
decryptAES :: Key -> IV -> ByteString -> AES.AuthTag -> ExceptT CryptoError IO ByteString
decryptAES :: Key
-> IV -> ByteString -> AuthTag -> ExceptT CryptoError IO ByteString
decryptAES Key
aesKey IV
ivBytes ByteString
msg AuthTag
authTag = do
  AEAD AES256
aead <- Key -> IV -> ExceptT CryptoError IO (AEAD AES256)
forall c.
BlockCipher c =>
Key -> IV -> ExceptT CryptoError IO (AEAD c)
initAEAD @AES256 Key
aesKey IV
ivBytes
  CryptoError
-> Maybe ByteString -> ExceptT CryptoError IO ByteString
forall a. CryptoError -> Maybe a -> ExceptT CryptoError IO a
maybeError CryptoError
AESDecryptError (Maybe ByteString -> ExceptT CryptoError IO ByteString)
-> Maybe ByteString -> ExceptT CryptoError IO ByteString
forall a b. (a -> b) -> a -> b
$ AEAD AES256
-> ByteString -> ByteString -> AuthTag -> Maybe ByteString
forall aad ba a.
(ByteArrayAccess aad, ByteArray ba) =>
AEAD a -> aad -> ba -> AuthTag -> Maybe ba
AES.aeadSimpleDecrypt AEAD AES256
aead ByteString
B.empty ByteString
msg AuthTag
authTag

initAEAD :: forall c. AES.BlockCipher c => Key -> IV -> ExceptT CryptoError IO (AES.AEAD c)
initAEAD :: Key -> IV -> ExceptT CryptoError IO (AEAD c)
initAEAD (Key ByteString
aesKey) (IV ByteString
ivBytes) = do
  IV c
iv <- ByteString -> ExceptT CryptoError IO (IV c)
forall c.
BlockCipher c =>
ByteString -> ExceptT CryptoError IO (IV c)
makeIV @c ByteString
ivBytes
  CryptoFailable (AEAD c) -> ExceptT CryptoError IO (AEAD c)
forall a. CryptoFailable a -> ExceptT CryptoError IO a
cryptoFailable (CryptoFailable (AEAD c) -> ExceptT CryptoError IO (AEAD c))
-> CryptoFailable (AEAD c) -> ExceptT CryptoError IO (AEAD c)
forall a b. (a -> b) -> a -> b
$ do
    c
cipher <- ByteString -> CryptoFailable c
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
AES.cipherInit ByteString
aesKey
    AEADMode -> c -> IV c -> CryptoFailable (AEAD c)
forall cipher iv.
(BlockCipher cipher, ByteArrayAccess iv) =>
AEADMode -> cipher -> iv -> CryptoFailable (AEAD cipher)
AES.aeadInit AEADMode
AES.AEAD_GCM c
cipher IV c
iv

-- | Random AES256 key.
randomAesKey :: IO Key
randomAesKey :: IO Key
randomAesKey = 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
getRandomBytes Int
aesKeySize

-- | Random IV bytes for AES256 encryption.
randomIV :: IO IV
randomIV :: IO IV
randomIV = ByteString -> IV
IV (ByteString -> IV) -> IO ByteString -> IO IV
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
getRandomBytes (BlockCipher AES256 => Int
forall c. BlockCipher c => Int
ivSize @AES256)

ivSize :: forall c. AES.BlockCipher c => Int
ivSize :: Int
ivSize = c -> Int
forall cipher. BlockCipher cipher => cipher -> Int
AES.blockSize (c
forall a. HasCallStack => a
undefined :: c)

makeIV :: AES.BlockCipher c => ByteString -> ExceptT CryptoError IO (AES.IV c)
makeIV :: ByteString -> ExceptT CryptoError IO (IV c)
makeIV ByteString
bs = CryptoError -> Maybe (IV c) -> ExceptT CryptoError IO (IV c)
forall a. CryptoError -> Maybe a -> ExceptT CryptoError IO a
maybeError CryptoError
CryptoIVError (Maybe (IV c) -> ExceptT CryptoError IO (IV c))
-> Maybe (IV c) -> ExceptT CryptoError IO (IV c)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe (IV c)
forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
AES.makeIV ByteString
bs

maybeError :: CryptoError -> Maybe a -> ExceptT CryptoError IO a
maybeError :: CryptoError -> Maybe a -> ExceptT CryptoError IO a
maybeError CryptoError
e = ExceptT CryptoError IO a
-> (a -> ExceptT CryptoError IO a)
-> Maybe a
-> ExceptT CryptoError IO a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (CryptoError -> ExceptT CryptoError IO a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE CryptoError
e) a -> ExceptT CryptoError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Convert AEAD 'AuthTag' to ByteString.
authTagToBS :: AES.AuthTag -> ByteString
authTagToBS :: AuthTag -> ByteString
authTagToBS = String -> ByteString
B.pack (String -> ByteString)
-> (AuthTag -> String) -> AuthTag -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Char
w2c ([Word8] -> String) -> (AuthTag -> [Word8]) -> AuthTag -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> [Word8]
forall a. ByteArrayAccess a => a -> [Word8]
BA.unpack (Bytes -> [Word8]) -> (AuthTag -> Bytes) -> AuthTag -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthTag -> Bytes
AES.unAuthTag

-- | Convert ByteString to AEAD 'AuthTag'.
bsToAuthTag :: ByteString -> AES.AuthTag
bsToAuthTag :: ByteString -> AuthTag
bsToAuthTag = Bytes -> AuthTag
AES.AuthTag (Bytes -> AuthTag)
-> (ByteString -> Bytes) -> ByteString -> AuthTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> Bytes
forall a. ByteArray a => [Word8] -> a
BA.pack ([Word8] -> Bytes)
-> (ByteString -> [Word8]) -> ByteString -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Word8) -> String -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w (String -> [Word8])
-> (ByteString -> String) -> ByteString -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B.unpack

cryptoFailable :: CE.CryptoFailable a -> ExceptT CryptoError IO a
cryptoFailable :: CryptoFailable a -> ExceptT CryptoError IO a
cryptoFailable = Either CryptoError a -> ExceptT CryptoError IO a
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either CryptoError a -> ExceptT CryptoError IO a)
-> (CryptoFailable a -> Either CryptoError a)
-> CryptoFailable a
-> ExceptT CryptoError IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CryptoError -> CryptoError)
-> Either CryptoError a -> Either CryptoError a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CryptoError -> CryptoError
AESCipherError (Either CryptoError a -> Either CryptoError a)
-> (CryptoFailable a -> Either CryptoError a)
-> CryptoFailable a
-> Either CryptoError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoFailable a -> Either CryptoError a
forall a. CryptoFailable a -> Either CryptoError a
CE.eitherCryptoError

oaepParams :: OAEP.OAEPParams SHA256 ByteString ByteString
oaepParams :: OAEPParams SHA256 ByteString ByteString
oaepParams = SHA256 -> OAEPParams SHA256 ByteString ByteString
forall seed output hash.
(ByteArrayAccess seed, ByteArray output, HashAlgorithm hash) =>
hash -> OAEPParams hash seed output
OAEP.defaultOAEPParams SHA256
SHA256

-- | RSA OAEP encryption.
--
-- Used as part of hybrid E2E encryption scheme and for SMP transport handshake.
encryptOAEP :: PublicKey -> ByteString -> ExceptT CryptoError IO ByteString
encryptOAEP :: PublicKey -> ByteString -> ExceptT CryptoError IO ByteString
encryptOAEP (PublicKey PublicKey
k) ByteString
aesKey =
  (Error -> CryptoError)
-> IO (Either Error ByteString)
-> ExceptT CryptoError IO ByteString
forall (m :: * -> *) e' e a.
(MonadIO m, MonadError e' m) =>
(e -> e') -> IO (Either e a) -> m a
liftEitherError Error -> CryptoError
RSAEncryptError (IO (Either Error ByteString) -> ExceptT CryptoError IO ByteString)
-> IO (Either Error ByteString)
-> ExceptT CryptoError IO ByteString
forall a b. (a -> b) -> a -> b
$
    OAEPParams SHA256 ByteString ByteString
-> PublicKey -> ByteString -> IO (Either Error ByteString)
forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
OAEPParams hash ByteString ByteString
-> PublicKey -> ByteString -> m (Either Error ByteString)
OAEP.encrypt OAEPParams SHA256 ByteString ByteString
oaepParams PublicKey
k ByteString
aesKey

-- | RSA OAEP decryption.
--
-- Used as part of hybrid E2E encryption scheme and for SMP transport handshake.
decryptOAEP :: PrivateKey k => k -> ByteString -> ExceptT CryptoError IO ByteString
decryptOAEP :: k -> ByteString -> ExceptT CryptoError IO ByteString
decryptOAEP k
pk ByteString
encKey =
  (Error -> CryptoError)
-> IO (Either Error ByteString)
-> ExceptT CryptoError IO ByteString
forall (m :: * -> *) e' e a.
(MonadIO m, MonadError e' m) =>
(e -> e') -> IO (Either e a) -> m a
liftEitherError Error -> CryptoError
RSADecryptError (IO (Either Error ByteString) -> ExceptT CryptoError IO ByteString)
-> IO (Either Error ByteString)
-> ExceptT CryptoError IO ByteString
forall a b. (a -> b) -> a -> b
$
    OAEPParams SHA256 ByteString ByteString
-> PrivateKey -> ByteString -> IO (Either Error ByteString)
forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
OAEPParams hash ByteString ByteString
-> PrivateKey -> ByteString -> m (Either Error ByteString)
OAEP.decryptSafer OAEPParams SHA256 ByteString ByteString
oaepParams (k -> PrivateKey
forall k. PrivateKey k => k -> PrivateKey
rsaPrivateKey k
pk) ByteString
encKey

pssParams :: PSS.PSSParams SHA256 ByteString ByteString
pssParams :: PSSParams SHA256 ByteString ByteString
pssParams = SHA256 -> PSSParams SHA256 ByteString ByteString
forall seed output hash.
(ByteArrayAccess seed, ByteArray output, HashAlgorithm hash) =>
hash -> PSSParams hash seed output
PSS.defaultPSSParams SHA256
SHA256

-- | RSA PSS message signing.
--
-- Used by SMP clients to sign SMP commands and by SMP agents to sign messages.
sign :: PrivateKey k => k -> ByteString -> ExceptT CryptoError IO Signature
sign :: k -> ByteString -> ExceptT CryptoError IO Signature
sign k
pk ByteString
msg = IO (Either CryptoError Signature)
-> ExceptT CryptoError IO Signature
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either CryptoError Signature)
 -> ExceptT CryptoError IO Signature)
-> IO (Either CryptoError Signature)
-> ExceptT CryptoError IO Signature
forall a b. (a -> b) -> a -> b
$ (Error -> CryptoError)
-> (ByteString -> Signature)
-> Either Error ByteString
-> Either CryptoError Signature
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Error -> CryptoError
RSASignError ByteString -> Signature
Signature (Either Error ByteString -> Either CryptoError Signature)
-> IO (Either Error ByteString)
-> IO (Either CryptoError Signature)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PSSParams SHA256 ByteString ByteString
-> PrivateKey -> ByteString -> IO (Either Error ByteString)
forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
PSSParams hash ByteString ByteString
-> PrivateKey -> ByteString -> m (Either Error ByteString)
PSS.signSafer PSSParams SHA256 ByteString ByteString
pssParams (k -> PrivateKey
forall k. PrivateKey k => k -> PrivateKey
rsaPrivateKey k
pk) ByteString
msg

-- | RSA PSS signature verification.
--
-- Used by SMP servers to authorize SMP commands and by SMP agents to verify messages.
verify :: PublicKey -> Signature -> ByteString -> Bool
verify :: PublicKey -> Signature -> ByteString -> Bool
verify (PublicKey PublicKey
k) (Signature ByteString
sig) ByteString
msg = PSSParams SHA256 ByteString ByteString
-> PublicKey -> ByteString -> ByteString -> Bool
forall hash.
HashAlgorithm hash =>
PSSParams hash ByteString ByteString
-> PublicKey -> ByteString -> ByteString -> Bool
PSS.verify PSSParams SHA256 ByteString ByteString
pssParams PublicKey
k ByteString
msg ByteString
sig

-- | Base-64 X509 encoding of RSA public key.
--
-- Used as part of SMP queue information (out-of-band message).
serializePubKey :: PublicKey -> ByteString
serializePubKey :: PublicKey -> ByteString
serializePubKey = (ByteString
"rsa:" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) (ByteString -> ByteString)
-> (PublicKey -> ByteString) -> PublicKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
encode (ByteString -> ByteString)
-> (PublicKey -> ByteString) -> PublicKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> ByteString
encodePubKey

serializePubKeyUri :: PublicKey -> ByteString
serializePubKeyUri :: PublicKey -> ByteString
serializePubKeyUri = (ByteString
"rsa:" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) (ByteString -> ByteString)
-> (PublicKey -> ByteString) -> PublicKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
U.encode (ByteString -> ByteString)
-> (PublicKey -> ByteString) -> PublicKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> ByteString
encodePubKey

-- | Base-64 PKCS8 encoding of PSA private key.
--
-- Not used as part of SMP protocols.
serializePrivKey :: PrivateKey k => k -> ByteString
serializePrivKey :: k -> ByteString
serializePrivKey = (ByteString
"rsa:" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) (ByteString -> ByteString) -> (k -> ByteString) -> k -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
encode (ByteString -> ByteString) -> (k -> ByteString) -> k -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> ByteString
forall k. PrivateKey k => k -> ByteString
encodePrivKey

-- Base-64 X509 RSA public key parser.
pubKeyP :: Parser PublicKey
pubKeyP :: Parser PublicKey
pubKeyP = ByteString -> Either String PublicKey
decodePubKey (ByteString -> Either String PublicKey)
-> Parser ByteString ByteString -> Parser PublicKey
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> (Parser ByteString ByteString
"rsa:" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
base64P)

pubKeyUriP :: Parser PublicKey
pubKeyUriP :: Parser PublicKey
pubKeyUriP = ByteString -> Either String PublicKey
decodePubKey (ByteString -> Either String PublicKey)
-> Parser ByteString ByteString -> Parser PublicKey
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> (Parser ByteString ByteString
"rsa:" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
base64UriP)

-- Binary X509 RSA public key parser.
binaryPubKeyP :: Parser PublicKey
binaryPubKeyP :: Parser PublicKey
binaryPubKeyP = ByteString -> Either String PublicKey
decodePubKey (ByteString -> Either String PublicKey)
-> Parser ByteString ByteString -> Parser PublicKey
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Parser ByteString ByteString
A.takeByteString

-- Base-64 PKCS8 RSA private key parser.
privKeyP :: PrivateKey k => Parser k
privKeyP :: Parser k
privKeyP = ByteString -> Either String k
forall k. PrivateKey k => ByteString -> Either String k
decodePrivKey (ByteString -> Either String k)
-> Parser ByteString ByteString -> Parser k
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> (Parser ByteString ByteString
"rsa:" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
base64P)

-- Binary PKCS8 RSA private key parser.
binaryPrivKeyP :: PrivateKey k => Parser k
binaryPrivKeyP :: Parser k
binaryPrivKeyP = ByteString -> Either String k
forall k. PrivateKey k => ByteString -> Either String k
decodePrivKey (ByteString -> Either String k)
-> Parser ByteString ByteString -> Parser k
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Parser ByteString ByteString
A.takeByteString

-- | Construct 'SafePrivateKey' from three numbers - used internally and in the tests.
safePrivateKey :: (Int, Integer, Integer) -> SafePrivateKey
safePrivateKey :: (Int, Integer, Integer) -> SafePrivateKey
safePrivateKey = PrivateKey -> SafePrivateKey
SafePrivateKey (PrivateKey -> SafePrivateKey)
-> ((Int, Integer, Integer) -> PrivateKey)
-> (Int, Integer, Integer)
-> SafePrivateKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Integer, Integer) -> PrivateKey
safeRsaPrivateKey

safeRsaPrivateKey :: (Int, Integer, Integer) -> R.PrivateKey
safeRsaPrivateKey :: (Int, Integer, Integer) -> PrivateKey
safeRsaPrivateKey (Int
size, Integer
n, Integer
d) =
  PrivateKey :: PublicKey
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> PrivateKey
R.PrivateKey
    { private_pub :: PublicKey
private_pub =
        PublicKey :: Int -> Integer -> Integer -> PublicKey
R.PublicKey
          { public_size :: Int
public_size = Int
size,
            public_n :: Integer
public_n = Integer
n,
            public_e :: Integer
public_e = Integer
0
          },
      private_d :: Integer
private_d = Integer
d,
      private_p :: Integer
private_p = Integer
0,
      private_q :: Integer
private_q = Integer
0,
      private_dP :: Integer
private_dP = Integer
0,
      private_dQ :: Integer
private_dQ = Integer
0,
      private_qinv :: Integer
private_qinv = Integer
0
    }

-- Binary X509 encoding of 'PublicKey'.
encodePubKey :: PublicKey -> ByteString
encodePubKey :: PublicKey -> ByteString
encodePubKey = PubKey -> ByteString
forall a. ASN1Object a => a -> ByteString
encodeKey (PubKey -> ByteString)
-> (PublicKey -> PubKey) -> PublicKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> PubKey
PubKeyRSA (PublicKey -> PubKey)
-> (PublicKey -> PublicKey) -> PublicKey -> PubKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> PublicKey
rsaPublicKey

-- Binary PKCS8 encoding of 'PrivateKey'.
encodePrivKey :: PrivateKey k => k -> ByteString
encodePrivKey :: k -> ByteString
encodePrivKey = PrivKey -> ByteString
forall a. ASN1Object a => a -> ByteString
encodeKey (PrivKey -> ByteString) -> (k -> PrivKey) -> k -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivateKey -> PrivKey
PrivKeyRSA (PrivateKey -> PrivKey) -> (k -> PrivateKey) -> k -> PrivKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> PrivateKey
forall k. PrivateKey k => k -> PrivateKey
rsaPrivateKey

encodeKey :: ASN1Object a => a -> ByteString
encodeKey :: a -> ByteString
encodeKey a
k = ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> ([ASN1] -> ByteString) -> [ASN1] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DER -> [ASN1] -> ByteString
forall a. ASN1Encoding a => a -> [ASN1] -> ByteString
encodeASN1 DER
DER ([ASN1] -> ByteString) -> [ASN1] -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> ASN1S
forall a. ASN1Object a => a -> ASN1S
toASN1 a
k []

-- Decoding of binary X509 'PublicKey'.
decodePubKey :: ByteString -> Either String PublicKey
decodePubKey :: ByteString -> Either String PublicKey
decodePubKey =
  ByteString -> Either String (PubKey, [ASN1])
forall a. ASN1Object a => ByteString -> Either String (a, [ASN1])
decodeKey (ByteString -> Either String (PubKey, [ASN1]))
-> ((PubKey, [ASN1]) -> Either String PublicKey)
-> ByteString
-> Either String PublicKey
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
    (PubKeyRSA PublicKey
k, []) -> PublicKey -> Either String PublicKey
forall a b. b -> Either a b
Right (PublicKey -> Either String PublicKey)
-> PublicKey -> Either String PublicKey
forall a b. (a -> b) -> a -> b
$ PublicKey -> PublicKey
PublicKey PublicKey
k
    (PubKey, [ASN1])
r -> (PubKey, [ASN1]) -> Either String PublicKey
forall a b. (a, [ASN1]) -> Either String b
keyError (PubKey, [ASN1])
r

-- Decoding of binary PKCS8 'PrivateKey'.
decodePrivKey :: PrivateKey k => ByteString -> Either String k
decodePrivKey :: ByteString -> Either String k
decodePrivKey =
  ByteString -> Either String (PrivKey, [ASN1])
forall a. ASN1Object a => ByteString -> Either String (a, [ASN1])
decodeKey (ByteString -> Either String (PrivKey, [ASN1]))
-> ((PrivKey, [ASN1]) -> Either String k)
-> ByteString
-> Either String k
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
    (PrivKeyRSA PrivateKey
pk, []) -> k -> Either String k
forall a b. b -> Either a b
Right (k -> Either String k) -> k -> Either String k
forall a b. (a -> b) -> a -> b
$ PrivateKey -> k
forall k. PrivateKey k => PrivateKey -> k
mkPrivateKey PrivateKey
pk
    (PrivKey, [ASN1])
r -> (PrivKey, [ASN1]) -> Either String k
forall a b. (a, [ASN1]) -> Either String b
keyError (PrivKey, [ASN1])
r

decodeKey :: ASN1Object a => ByteString -> Either String (a, [ASN1])
decodeKey :: ByteString -> Either String (a, [ASN1])
decodeKey = [ASN1] -> Either String (a, [ASN1])
forall a. ASN1Object a => [ASN1] -> Either String (a, [ASN1])
fromASN1 ([ASN1] -> Either String (a, [ASN1]))
-> (ByteString -> Either String [ASN1])
-> ByteString
-> Either String (a, [ASN1])
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (ASN1Error -> String)
-> Either ASN1Error [ASN1] -> Either String [ASN1]
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ASN1Error -> String
forall a. Show a => a -> String
show (Either ASN1Error [ASN1] -> Either String [ASN1])
-> (ByteString -> Either ASN1Error [ASN1])
-> ByteString
-> Either String [ASN1]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DER -> ByteString -> Either ASN1Error [ASN1]
forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1 DER
DER (ByteString -> Either ASN1Error [ASN1])
-> (ByteString -> ByteString)
-> ByteString
-> Either ASN1Error [ASN1]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fromStrict

keyError :: (a, [ASN1]) -> Either String b
keyError :: (a, [ASN1]) -> Either String b
keyError = \case
  (a
_, []) -> String -> Either String b
forall a b. a -> Either a b
Left String
"not RSA key"
  (a, [ASN1])
_ -> String -> Either String b
forall a b. a -> Either a b
Left String
"more than one key"