-- |
-- Module: M.Crypto
-- Description: Cryptographic operations for Minecraft protocol
-- Copyright: (c) axionbuster, 2025
-- License: BSD-3-Clause
--
-- Provides cryptographic functionality required by the Minecraft protocol,
-- including AES encryption/decryption, RSA operations, and server-specific
-- hashing utilities.
module M.Crypto
  ( -- * AES
    AES,
    Mode (..),
    aesnew,
    aesupdate,

    -- * RSA
    RSA,
    rsanew,
    rsaup,
    rsaspki,

    -- * Hash
    hashservnam,

    -- * General
    Error (..),
    AESClass,
    RSAClass,

    -- * Re-exports
    ByteString,
  )
where

import Control.Exception hiding (throw)
import Data.ByteString (ByteString)
import Data.ByteString qualified as B
import Data.ByteString.Unsafe
import Data.Data
import Data.Functor
import Foreign
import Foreign.C
import GHC.Generics

-- exported types

-- | error type
newtype Error = Error String
  deriving stock (Typeable, Typeable Error
Typeable Error =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Error -> c Error)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Error)
-> (Error -> Constr)
-> (Error -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Error))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Error))
-> ((forall b. Data b => b -> b) -> Error -> Error)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r)
-> (forall u. (forall d. Data d => d -> u) -> Error -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Error -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Error -> m Error)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Error -> m Error)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Error -> m Error)
-> Data Error
Error -> Constr
Error -> DataType
(forall b. Data b => b -> b) -> Error -> Error
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Error -> u
forall u. (forall d. Data d => d -> u) -> Error -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Error -> m Error
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Error -> m Error
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Error
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Error -> c Error
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Error)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Error)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Error -> c Error
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Error -> c Error
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Error
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Error
$ctoConstr :: Error -> Constr
toConstr :: Error -> Constr
$cdataTypeOf :: Error -> DataType
dataTypeOf :: Error -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Error)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Error)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Error)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Error)
$cgmapT :: (forall b. Data b => b -> b) -> Error -> Error
gmapT :: (forall b. Data b => b -> b) -> Error -> Error
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Error -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Error -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Error -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Error -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Error -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Error -> m Error
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Error -> m Error
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Error -> m Error
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Error -> m Error
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Error -> m Error
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Error -> m Error
Data, (forall x. Error -> Rep Error x)
-> (forall x. Rep Error x -> Error) -> Generic Error
forall x. Rep Error x -> Error
forall x. Error -> Rep Error x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Error -> Rep Error x
from :: forall x. Error -> Rep Error x
$cto :: forall x. Rep Error x -> Error
to :: forall x. Rep Error x -> Error
Generic)
  deriving newtype (Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Error -> ShowS
showsPrec :: Int -> Error -> ShowS
$cshow :: Error -> String
show :: Error -> String
$cshowList :: [Error] -> ShowS
showList :: [Error] -> ShowS
Show, Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
/= :: Error -> Error -> Bool
Eq)
  -- Typeable: for catching exceptions
  deriving anyclass (Show Error
Typeable Error
(Typeable Error, Show Error) =>
(Error -> SomeException)
-> (SomeException -> Maybe Error)
-> (Error -> String)
-> Exception Error
SomeException -> Maybe Error
Error -> String
Error -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: Error -> SomeException
toException :: Error -> SomeException
$cfromException :: SomeException -> Maybe Error
fromException :: SomeException -> Maybe Error
$cdisplayException :: Error -> String
displayException :: Error -> String
Exception)

-- private function: throw an error
throw :: String -> IO a
throw :: forall a. String -> IO a
throw String
lab = do
  String
e <-
    IO String
dumpallerrors IO String -> ShowS -> IO String
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      String
"" -> String
"(unknown error/no message)"
      String
e1 -> String
e1
  Error -> IO a
forall e a. Exception e => e -> IO a
throwIO (Error -> IO a) -> Error -> IO a
forall a b. (a -> b) -> a -> b
$ String -> Error
Error (String -> Error) -> String -> Error
forall a b. (a -> b) -> a -> b
$ String
lab String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e

-- | encryption/decryption mode
data Mode = Encrypt | Decrypt
  deriving stock (Mode -> Mode -> Bool
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
/= :: Mode -> Mode -> Bool
Eq, Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
(Int -> Mode -> ShowS)
-> (Mode -> String) -> ([Mode] -> ShowS) -> Show Mode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mode -> ShowS
showsPrec :: Int -> Mode -> ShowS
$cshow :: Mode -> String
show :: Mode -> String
$cshowList :: [Mode] -> ShowS
showList :: [Mode] -> ShowS
Show, ReadPrec [Mode]
ReadPrec Mode
Int -> ReadS Mode
ReadS [Mode]
(Int -> ReadS Mode)
-> ReadS [Mode] -> ReadPrec Mode -> ReadPrec [Mode] -> Read Mode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Mode
readsPrec :: Int -> ReadS Mode
$creadList :: ReadS [Mode]
readList :: ReadS [Mode]
$creadPrec :: ReadPrec Mode
readPrec :: ReadPrec Mode
$creadListPrec :: ReadPrec [Mode]
readListPrec :: ReadPrec [Mode]
Read, Typeable, Typeable Mode
Typeable Mode =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Mode -> c Mode)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Mode)
-> (Mode -> Constr)
-> (Mode -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Mode))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Mode))
-> ((forall b. Data b => b -> b) -> Mode -> Mode)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r)
-> (forall u. (forall d. Data d => d -> u) -> Mode -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Mode -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Mode -> m Mode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Mode -> m Mode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Mode -> m Mode)
-> Data Mode
Mode -> Constr
Mode -> DataType
(forall b. Data b => b -> b) -> Mode -> Mode
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Mode -> u
forall u. (forall d. Data d => d -> u) -> Mode -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Mode
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mode -> c Mode
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Mode)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Mode)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mode -> c Mode
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mode -> c Mode
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Mode
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Mode
$ctoConstr :: Mode -> Constr
toConstr :: Mode -> Constr
$cdataTypeOf :: Mode -> DataType
dataTypeOf :: Mode -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Mode)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Mode)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Mode)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Mode)
$cgmapT :: (forall b. Data b => b -> b) -> Mode -> Mode
gmapT :: (forall b. Data b => b -> b) -> Mode -> Mode
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Mode -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Mode -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Mode -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Mode -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
Data, (forall x. Mode -> Rep Mode x)
-> (forall x. Rep Mode x -> Mode) -> Generic Mode
forall x. Rep Mode x -> Mode
forall x. Mode -> Rep Mode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Mode -> Rep Mode x
from :: forall x. Mode -> Rep Mode x
$cto :: forall x. Rep Mode x -> Mode
to :: forall x. Rep Mode x -> Mode
Generic, Int -> Mode
Mode -> Int
Mode -> [Mode]
Mode -> Mode
Mode -> Mode -> [Mode]
Mode -> Mode -> Mode -> [Mode]
(Mode -> Mode)
-> (Mode -> Mode)
-> (Int -> Mode)
-> (Mode -> Int)
-> (Mode -> [Mode])
-> (Mode -> Mode -> [Mode])
-> (Mode -> Mode -> [Mode])
-> (Mode -> Mode -> Mode -> [Mode])
-> Enum Mode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Mode -> Mode
succ :: Mode -> Mode
$cpred :: Mode -> Mode
pred :: Mode -> Mode
$ctoEnum :: Int -> Mode
toEnum :: Int -> Mode
$cfromEnum :: Mode -> Int
fromEnum :: Mode -> Int
$cenumFrom :: Mode -> [Mode]
enumFrom :: Mode -> [Mode]
$cenumFromThen :: Mode -> Mode -> [Mode]
enumFromThen :: Mode -> Mode -> [Mode]
$cenumFromTo :: Mode -> Mode -> [Mode]
enumFromTo :: Mode -> Mode -> [Mode]
$cenumFromThenTo :: Mode -> Mode -> Mode -> [Mode]
enumFromThenTo :: Mode -> Mode -> Mode -> [Mode]
Enum, Mode
Mode -> Mode -> Bounded Mode
forall a. a -> a -> Bounded a
$cminBound :: Mode
minBound :: Mode
$cmaxBound :: Mode
maxBound :: Mode
Bounded)

-- | encryption/decryption context for 'AES' (AES-128-CFB8)
newtype AES (mode :: Mode) = AES (ForeignPtr EVP_CIPHER_CTX)
  deriving stock (Int -> AES mode -> ShowS
[AES mode] -> ShowS
AES mode -> String
(Int -> AES mode -> ShowS)
-> (AES mode -> String) -> ([AES mode] -> ShowS) -> Show (AES mode)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (mode :: Mode). Int -> AES mode -> ShowS
forall (mode :: Mode). [AES mode] -> ShowS
forall (mode :: Mode). AES mode -> String
$cshowsPrec :: forall (mode :: Mode). Int -> AES mode -> ShowS
showsPrec :: Int -> AES mode -> ShowS
$cshow :: forall (mode :: Mode). AES mode -> String
show :: AES mode -> String
$cshowList :: forall (mode :: Mode). [AES mode] -> ShowS
showList :: [AES mode] -> ShowS
Show)
  deriving newtype (AES mode -> AES mode -> Bool
(AES mode -> AES mode -> Bool)
-> (AES mode -> AES mode -> Bool) -> Eq (AES mode)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (mode :: Mode). AES mode -> AES mode -> Bool
$c== :: forall (mode :: Mode). AES mode -> AES mode -> Bool
== :: AES mode -> AES mode -> Bool
$c/= :: forall (mode :: Mode). AES mode -> AES mode -> Bool
/= :: AES mode -> AES mode -> Bool
Eq)

-- | RSA pkey
newtype RSA = RSA (ForeignPtr EVP_PKEY)
  deriving stock (Int -> RSA -> ShowS
[RSA] -> ShowS
RSA -> String
(Int -> RSA -> ShowS)
-> (RSA -> String) -> ([RSA] -> ShowS) -> Show RSA
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RSA -> ShowS
showsPrec :: Int -> RSA -> ShowS
$cshow :: RSA -> String
show :: RSA -> String
$cshowList :: [RSA] -> ShowS
showList :: [RSA] -> ShowS
Show)
  deriving newtype (RSA -> RSA -> Bool
(RSA -> RSA -> Bool) -> (RSA -> RSA -> Bool) -> Eq RSA
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RSA -> RSA -> Bool
== :: RSA -> RSA -> Bool
$c/= :: RSA -> RSA -> Bool
/= :: RSA -> RSA -> Bool
Eq)

-- private class, only some methods are exported
class AESClass (mode :: Mode) where
  aesnew_ :: AESCtor
  aesupdate_ :: AESUpdate

  -- | create a new AES context
  aesnew :: ByteString -> IO (AES mode)
  aesnew ByteString
key | ByteString -> Int
B.length ByteString
key Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
16 = String -> IO (AES mode)
forall a. String -> IO a
throw String
"aesnew: key must be 16 bytes"
  aesnew ByteString
key = IO (AES mode) -> IO (AES mode)
forall a. IO a -> IO a
mask_ do
    ByteString -> (CString -> IO (AES mode)) -> IO (AES mode)
forall a. ByteString -> (CString -> IO a) -> IO a
unsafeUseAsCString ByteString
key \CString
keyptr -> do
      Ptr EVP_CIPHER_CTX
a <- forall (mode :: Mode). AESClass mode => AESCtor
aesnew_ @mode (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
keyptr)
      if Ptr EVP_CIPHER_CTX
a Ptr EVP_CIPHER_CTX -> Ptr EVP_CIPHER_CTX -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr EVP_CIPHER_CTX
forall a. Ptr a
nullPtr
        then String -> IO (AES mode)
forall a. String -> IO a
throw String
"aesnew: failed to create AES context"
        else ForeignPtr EVP_CIPHER_CTX -> AES mode
forall (mode :: Mode). ForeignPtr EVP_CIPHER_CTX -> AES mode
AES (ForeignPtr EVP_CIPHER_CTX -> AES mode)
-> IO (ForeignPtr EVP_CIPHER_CTX) -> IO (AES mode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FinalizerPtr EVP_CIPHER_CTX
-> Ptr EVP_CIPHER_CTX -> IO (ForeignPtr EVP_CIPHER_CTX)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr EVP_CIPHER_CTX
mmmfreeaescipherctx Ptr EVP_CIPHER_CTX
a

  -- | either encrypt or decrypt a message
  aesupdate :: AES mode -> ByteString -> IO ByteString
  aesupdate (AES ForeignPtr EVP_CIPHER_CTX
ctx) ByteString
bs = IO ByteString -> IO ByteString
forall a. IO a -> IO a
mask_ do
    ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bs \(CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr -> Ptr Word8
ib, Int
le) ->
      (Ptr CInt -> IO ByteString) -> IO ByteString
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr CInt
outlen ->
        ForeignPtr EVP_CIPHER_CTX
-> (Ptr EVP_CIPHER_CTX -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr EVP_CIPHER_CTX
ctx \Ptr EVP_CIPHER_CTX
ctxptr -> do
          let bad :: IO a
bad = String -> IO a
forall a. String -> IO a
throw String
"aesupdate: AES update failed"
          CString
ob <- Int -> IO CString
forall a. Int -> IO (Ptr a)
mallocBytes Int
le
          CInt
r <- forall (mode :: Mode). AESClass mode => AESUpdate
aesupdate_ @mode Ptr EVP_CIPHER_CTX
ctxptr (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
ob) Ptr CInt
outlen Ptr Word8
ib (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
le)
          if CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
1
            then do
              CInt
n <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
outlen
              if CInt
n CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
le
                then CStringLen -> IO ByteString
unsafePackMallocCStringLen (CString
ob, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n)
                else IO ByteString
forall {a}. IO a
bad
            else IO ByteString
forall {a}. IO a
bad

instance AESClass 'Encrypt where
  aesnew_ :: AESCtor
aesnew_ = AESCtor
mmmnewaesenc
  aesupdate_ :: AESUpdate
aesupdate_ = AESUpdate
evpencryptupdate

instance AESClass 'Decrypt where
  aesnew_ :: AESCtor
aesnew_ = AESCtor
mmmnewaesdec
  aesupdate_ :: AESUpdate
aesupdate_ = AESUpdate
evpdecryptupdate

-- | create a new RSA pkey
rsanew :: Int -> IO RSA
rsanew :: Int -> IO RSA
rsanew Int
bits = IO RSA -> IO RSA
forall a. IO a -> IO a
mask_ do
  Ptr EVP_PKEY
a <- CInt -> IO (Ptr EVP_PKEY)
mmmnewrsa (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bits)
  if Ptr EVP_PKEY
a Ptr EVP_PKEY -> Ptr EVP_PKEY -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr EVP_PKEY
forall a. Ptr a
nullPtr
    then String -> IO RSA
forall a. String -> IO a
throw String
"rsanew: failed to create RSA context"
    else ForeignPtr EVP_PKEY -> RSA
RSA (ForeignPtr EVP_PKEY -> RSA) -> IO (ForeignPtr EVP_PKEY) -> IO RSA
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FinalizerPtr EVP_PKEY -> Ptr EVP_PKEY -> IO (ForeignPtr EVP_PKEY)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr EVP_PKEY
mmmfreersakey Ptr EVP_PKEY
a

-- | write the SubjectPublicKeyInfo to a 'ByteString'
rsaspki :: RSA -> IO ByteString
rsaspki :: RSA -> IO ByteString
rsaspki (RSA ForeignPtr EVP_PKEY
rsa) = IO ByteString -> IO ByteString
forall a. IO a -> IO a
mask_ do
  ForeignPtr EVP_PKEY
-> (Ptr EVP_PKEY -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr EVP_PKEY
rsa \Ptr EVP_PKEY
rsaptr -> do
    (Ptr MMMRSAOUT -> IO ByteString) -> IO ByteString
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr MMMRSAOUT
out -> do
      CInt
r <- Ptr EVP_PKEY -> Ptr MMMRSAOUT -> IO CInt
mmmwritepubkey Ptr EVP_PKEY
rsaptr Ptr MMMRSAOUT
out
      if CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
1
        then do
          MMMRSAOUT Ptr Word8
op CSize
ol <- Ptr MMMRSAOUT -> IO MMMRSAOUT
forall a. Storable a => Ptr a -> IO a
peek Ptr MMMRSAOUT
out
          CStringLen -> IO ByteString
unsafePackMallocCStringLen (Ptr Word8 -> CString
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
op, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
ol)
        else String -> IO ByteString
forall a. String -> IO a
throw String
"rsaspki: failed to write public key"

class RSAClass (mode :: Mode) where
  rsaup_ :: Ptr EVP_PKEY -> Ptr Word8 -> CSize -> Ptr MMMRSAOUT -> IO CInt

  -- | either encrypt or decrypt a message
  rsaup :: RSA -> ByteString -> IO ByteString
  rsaup (RSA ForeignPtr EVP_PKEY
rsa) ByteString
input = IO ByteString -> IO ByteString
forall a. IO a -> IO a
mask_ do
    ForeignPtr EVP_PKEY
-> (Ptr EVP_PKEY -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr EVP_PKEY
rsa \Ptr EVP_PKEY
rsaptr ->
      ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
input \(CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr -> Ptr Word8
ip, Int
len) -> do
        (Ptr MMMRSAOUT -> IO ByteString) -> IO ByteString
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr MMMRSAOUT
out -> do
          CInt
r <- forall (mode :: Mode).
RSAClass mode =>
Ptr EVP_PKEY -> Ptr Word8 -> CSize -> Ptr MMMRSAOUT -> IO CInt
rsaup_ @mode Ptr EVP_PKEY
rsaptr Ptr Word8
ip (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Ptr MMMRSAOUT
out
          if CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
1
            then do
              -- rsa input/outputs typically have different lengths
              MMMRSAOUT Ptr Word8
op CSize
ol <- Ptr MMMRSAOUT -> IO MMMRSAOUT
forall a. Storable a => Ptr a -> IO a
peek Ptr MMMRSAOUT
out
              CStringLen -> IO ByteString
unsafePackMallocCStringLen (Ptr Word8 -> CString
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
op, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
ol)
            else String -> IO ByteString
forall a. String -> IO a
throw String
"rsaup: RSA operation failed"

instance RSAClass 'Encrypt where
  rsaup_ :: Ptr EVP_PKEY -> Ptr Word8 -> CSize -> Ptr MMMRSAOUT -> IO CInt
rsaup_ = Ptr EVP_PKEY -> Ptr Word8 -> CSize -> Ptr MMMRSAOUT -> IO CInt
mmmrsapubenc

instance RSAClass 'Decrypt where
  rsaup_ :: Ptr EVP_PKEY -> Ptr Word8 -> CSize -> Ptr MMMRSAOUT -> IO CInt
rsaup_ = Ptr EVP_PKEY -> Ptr Word8 -> CSize -> Ptr MMMRSAOUT -> IO CInt
mmmrsaprivdec

-- | generate a SHA1 hash of the server name
hashservnam ::
  -- | server id
  ByteString ->
  -- | shared secret
  ByteString ->
  -- | verify token
  ByteString ->
  -- | SHA1 hash (20 bytes)
  IO ByteString
hashservnam :: ByteString -> ByteString -> ByteString -> IO ByteString
hashservnam ByteString
se ByteString
sh ByteString
ve = IO ByteString -> IO ByteString
forall a. IO a -> IO a
mask_ do
  ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
se \(CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr -> Ptr Word8
sep, Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CSize
sel) ->
    ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
sh \(CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr -> Ptr Word8
shp, Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CSize
shl) ->
      ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
ve \(CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr -> Ptr Word8
vep, Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CSize
vel) -> do
        Ptr Word8
p <- Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> IO (Ptr Word8)
mmmhashservnam Ptr Word8
sep CSize
sel Ptr Word8
shp CSize
shl Ptr Word8
vep CSize
vel
        case Ptr Word8
p of
          Ptr Word8
p1 | Ptr Word8
p1 Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
forall a. Ptr a
nullPtr -> String -> IO ByteString
forall a. String -> IO a
throw String
"hashservnam: failed to hash"
          -- SHA1 has 20 bytes
          Ptr Word8
p1 -> CStringLen -> IO ByteString
unsafePackMallocCStringLen (Ptr Word8 -> CString
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
p1, Int
20)

-- dump all errors to a 'String' and clear the error buffer
dumpallerrors :: IO String
dumpallerrors :: IO String
dumpallerrors =
  IO CString
mmmdumpallerrs IO CString -> (CString -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    CString
p | CString
p CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr -> String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
""
    CString
p -> CString -> IO String
peekCString CString
p -- copies the string

-- internal types
data EVP_CIPHER_CTX

data EVP_PKEY

-- represent the C struct @mmmrsaout@
data MMMRSAOUT
  = MMMRSAOUT
      (Ptr Word8) -- output
      CSize -- length

instance Storable MMMRSAOUT where
  sizeOf :: MMMRSAOUT -> Int
sizeOf MMMRSAOUT
_ = Ptr Word8 -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr Word8
forall a. HasCallStack => a
undefined :: Ptr Word8) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CSize -> Int
forall a. Storable a => a -> Int
sizeOf (CSize
forall a. HasCallStack => a
undefined :: CSize)
  alignment :: MMMRSAOUT -> Int
alignment MMMRSAOUT
_ = Ptr () -> Int
forall a. Storable a => a -> Int
alignment (Ptr ()
forall a. HasCallStack => a
undefined :: Ptr ())
  peek :: Ptr MMMRSAOUT -> IO MMMRSAOUT
peek Ptr MMMRSAOUT
ptr =
    Ptr Word8 -> CSize -> MMMRSAOUT
MMMRSAOUT
      (Ptr Word8 -> CSize -> MMMRSAOUT)
-> IO (Ptr Word8) -> IO (CSize -> MMMRSAOUT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr MMMRSAOUT -> Int -> IO (Ptr Word8)
forall b. Ptr b -> Int -> IO (Ptr Word8)
forall a b. Storable a => Ptr b -> Int -> IO a
`peekByteOff` Int
0) Ptr MMMRSAOUT
ptr
      IO (CSize -> MMMRSAOUT) -> IO CSize -> IO MMMRSAOUT
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Ptr MMMRSAOUT -> Int -> IO CSize
forall b. Ptr b -> Int -> IO CSize
forall a b. Storable a => Ptr b -> Int -> IO a
`peekByteOff` Ptr Word8 -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr Word8
forall a. HasCallStack => a
undefined :: Ptr Word8)) Ptr MMMRSAOUT
ptr
  poke :: Ptr MMMRSAOUT -> MMMRSAOUT -> IO ()
poke Ptr MMMRSAOUT
ptr (MMMRSAOUT Ptr Word8
out CSize
len) = do
    (Ptr MMMRSAOUT -> Int -> Ptr Word8 -> IO ()
forall b. Ptr b -> Int -> Ptr Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
`pokeByteOff` Int
0) Ptr MMMRSAOUT
ptr Ptr Word8
out
    (Ptr MMMRSAOUT -> Int -> CSize -> IO ()
forall b. Ptr b -> Int -> CSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
`pokeByteOff` Ptr Word8 -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr Word8
forall a. HasCallStack => a
undefined :: Ptr Word8)) Ptr MMMRSAOUT
ptr CSize
len

-- AES functions
foreign import ccall unsafe "&mmmfreeaescipherctx"
  mmmfreeaescipherctx :: FinalizerPtr EVP_CIPHER_CTX

type AESCtor = Ptr Word8 -> IO (Ptr EVP_CIPHER_CTX)

foreign import ccall unsafe "mmmnewaesenc"
  mmmnewaesenc :: AESCtor

foreign import ccall unsafe "mmmnewaesdec"
  mmmnewaesdec :: AESCtor

-- https://linux.die.net/man/3/evp_encryptupdate

type AESUpdate =
  Ptr EVP_CIPHER_CTX ->
  Ptr Word8 -> -- output
  Ptr CInt ->
  Ptr Word8 -> -- input
  CInt ->
  IO CInt -- 1 = success, 0 = failure

foreign import ccall unsafe "EVP_EncryptUpdate"
  evpencryptupdate :: AESUpdate

foreign import ccall unsafe "EVP_DecryptUpdate"
  evpdecryptupdate :: AESUpdate

foreign import ccall unsafe "&mmmfreersakey"
  mmmfreersakey :: FinalizerPtr EVP_PKEY

foreign import ccall unsafe "mmmnewrsa"
  mmmnewrsa :: CInt -> IO (Ptr EVP_PKEY)

foreign import ccall unsafe "mmmrsapubenc"
  mmmrsapubenc :: Ptr EVP_PKEY -> Ptr Word8 -> CSize -> Ptr MMMRSAOUT -> IO CInt

foreign import ccall unsafe "mmmrsaprivdec"
  mmmrsaprivdec ::
    Ptr EVP_PKEY ->
    Ptr Word8 ->
    CSize ->
    Ptr MMMRSAOUT ->
    IO CInt

foreign import ccall unsafe "mmmwritepubkey"
  mmmwritepubkey :: Ptr EVP_PKEY -> Ptr MMMRSAOUT -> IO CInt

-- Hash function
foreign import ccall unsafe "mmmhashservnam"
  mmmhashservnam ::
    Ptr Word8 ->
    CSize ->
    Ptr Word8 ->
    CSize ->
    Ptr Word8 ->
    CSize ->
    IO (Ptr Word8)

foreign import ccall unsafe "mmmdumpallerrs"
  mmmdumpallerrs :: IO CString