-- S2K.hs: OpenPGP (RFC9580) string-to-key conversion
-- Copyright © 2013-2026  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}

module Codec.Encryption.OpenPGP.S2K
  ( EncodedSessionKeyError(..)
  , renderEncodedSessionKeyError
  , S2KError(..)
  , renderS2KError
  , decodeOpenPGPEncodedSessionKey
  , string2Key
  , skesk2Key
  , skesk2SessionKey
  ) where

import Codec.Encryption.OpenPGP.BlockCipher (CipherError(..), keySize, withSymmetricCipher)
import Codec.Encryption.OpenPGP.Internal.HOBlockCipher (HOBlockCipher(..))
import Codec.Encryption.OpenPGP.Types
import Data.Bits (shiftL)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.Word (Word8, Word16)
import Crypto.Error (CryptoFailable(..))
import qualified Crypto.Hash as CH
import qualified Crypto.KDF.Argon2 as Argon2
import qualified Data.ByteArray as BA
import Data.Bifunctor (first)

data EncodedSessionKeyError
  = EncodedSessionKeyTooShort
  | EncodedSessionKeyUnsupportedAlgorithm SymmetricAlgorithm
  | EncodedSessionKeyLengthMismatch SymmetricAlgorithm Int Int
  | EncodedSessionKeyChecksumMismatch
  deriving (EncodedSessionKeyError -> EncodedSessionKeyError -> Bool
(EncodedSessionKeyError -> EncodedSessionKeyError -> Bool)
-> (EncodedSessionKeyError -> EncodedSessionKeyError -> Bool)
-> Eq EncodedSessionKeyError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EncodedSessionKeyError -> EncodedSessionKeyError -> Bool
== :: EncodedSessionKeyError -> EncodedSessionKeyError -> Bool
$c/= :: EncodedSessionKeyError -> EncodedSessionKeyError -> Bool
/= :: EncodedSessionKeyError -> EncodedSessionKeyError -> Bool
Eq, Int -> EncodedSessionKeyError -> ShowS
[EncodedSessionKeyError] -> ShowS
EncodedSessionKeyError -> String
(Int -> EncodedSessionKeyError -> ShowS)
-> (EncodedSessionKeyError -> String)
-> ([EncodedSessionKeyError] -> ShowS)
-> Show EncodedSessionKeyError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EncodedSessionKeyError -> ShowS
showsPrec :: Int -> EncodedSessionKeyError -> ShowS
$cshow :: EncodedSessionKeyError -> String
show :: EncodedSessionKeyError -> String
$cshowList :: [EncodedSessionKeyError] -> ShowS
showList :: [EncodedSessionKeyError] -> ShowS
Show)

renderEncodedSessionKeyError :: EncodedSessionKeyError -> String
renderEncodedSessionKeyError :: EncodedSessionKeyError -> String
renderEncodedSessionKeyError EncodedSessionKeyError
EncodedSessionKeyTooShort =
  String
"session key material too short"
renderEncodedSessionKeyError (EncodedSessionKeyUnsupportedAlgorithm SymmetricAlgorithm
sa) =
  String
"unsupported symmetric algorithm: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SymmetricAlgorithm -> String
forall a. Show a => a -> String
show SymmetricAlgorithm
sa
renderEncodedSessionKeyError (EncodedSessionKeyLengthMismatch SymmetricAlgorithm
_ Int
_ Int
_) =
  String
"session key material length does not match encoded algorithm"
renderEncodedSessionKeyError EncodedSessionKeyError
EncodedSessionKeyChecksumMismatch =
  String
"session key checksum mismatch"

-- | Errors that can arise during string-to-key derivation.
data S2KError
  = -- | The symmetric algorithm used in the SKESK is not supported.
    S2KUnsupportedAlgorithm CipherError
  | -- | An unsupported or unknown S2K specifier type was encountered.
    S2KUnsupportedSpecifier Word8
  | -- | An unsupported SKESK shape (e.g. non-zero ESK).
    S2KUnsupportedSKESKShape String
  | -- | A required hash algorithm is not supported for S2K.
    S2KUnsupportedHashAlgorithm HashAlgorithm
  | -- | The Argon2 S2K parameters are invalid.
    S2KArgon2ParamError String
  | -- | The Argon2 KDF itself failed.
    S2KArgon2Failed String
  | -- | Decrypting an embedded encrypted session key failed.
    S2KEncryptedSessionKeyCipherError CipherError
  | -- | Embedded encrypted session key material was malformed.
    S2KEncryptedSessionKeyDecodeError EncodedSessionKeyError
  deriving (S2KError -> S2KError -> Bool
(S2KError -> S2KError -> Bool)
-> (S2KError -> S2KError -> Bool) -> Eq S2KError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: S2KError -> S2KError -> Bool
== :: S2KError -> S2KError -> Bool
$c/= :: S2KError -> S2KError -> Bool
/= :: S2KError -> S2KError -> Bool
Eq, Int -> S2KError -> ShowS
[S2KError] -> ShowS
S2KError -> String
(Int -> S2KError -> ShowS)
-> (S2KError -> String) -> ([S2KError] -> ShowS) -> Show S2KError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> S2KError -> ShowS
showsPrec :: Int -> S2KError -> ShowS
$cshow :: S2KError -> String
show :: S2KError -> String
$cshowList :: [S2KError] -> ShowS
showList :: [S2KError] -> ShowS
Show)

renderS2KError :: S2KError -> String
renderS2KError :: S2KError -> String
renderS2KError (S2KUnsupportedAlgorithm CipherError
ce) =
  String
"S2K: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CipherError -> String
renderCipherError' CipherError
ce
  where
    renderCipherError' :: CipherError -> String
renderCipherError' (UnsupportedAlgorithm SymmetricAlgorithm
sa) = String
"unsupported symmetric algorithm: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SymmetricAlgorithm -> String
forall a. Show a => a -> String
show SymmetricAlgorithm
sa
    renderCipherError' (CipherInitFailed SymmetricAlgorithm
sa String
msg) = String
"cipher init failed for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SymmetricAlgorithm -> String
forall a. Show a => a -> String
show SymmetricAlgorithm
sa String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
    renderCipherError' (CipherOperationFailed String
msg) = String
"cipher operation failed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
renderS2KError (S2KUnsupportedSpecifier Word8
t) =
  String
"S2K: unsupported S2K type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
t
renderS2KError (S2KUnsupportedSKESKShape String
msg) =
  String
"S2K: unsupported SKESK shape: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
renderS2KError (S2KUnsupportedHashAlgorithm HashAlgorithm
ha) =
  String
"S2K: unsupported hash algorithm for S2K: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ HashAlgorithm -> String
forall a. Show a => a -> String
show HashAlgorithm
ha
renderS2KError (S2KArgon2ParamError String
msg) =
  String
"S2K: Argon2 parameter error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
renderS2KError (S2KArgon2Failed String
msg) =
  String
"S2K: Argon2 KDF failed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
renderS2KError (S2KEncryptedSessionKeyCipherError CipherError
ce) =
  String
"S2K: encrypted session key decrypt failed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CipherError -> String
renderCipherError' CipherError
ce
  where
    renderCipherError' :: CipherError -> String
renderCipherError' (UnsupportedAlgorithm SymmetricAlgorithm
sa) = String
"unsupported symmetric algorithm: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SymmetricAlgorithm -> String
forall a. Show a => a -> String
show SymmetricAlgorithm
sa
    renderCipherError' (CipherInitFailed SymmetricAlgorithm
sa String
msg) = String
"cipher init failed for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SymmetricAlgorithm -> String
forall a. Show a => a -> String
show SymmetricAlgorithm
sa String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
    renderCipherError' (CipherOperationFailed String
msg) = String
"cipher operation failed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
renderS2KError (S2KEncryptedSessionKeyDecodeError EncodedSessionKeyError
err) =
  String
"S2K: encrypted session key decode failed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ EncodedSessionKeyError -> String
renderEncodedSessionKeyError EncodedSessionKeyError
err

string2Key :: S2K -> Int -> BL.ByteString -> Either S2KError B.ByteString
string2Key :: S2K -> Int -> ByteString -> Either S2KError ByteString
string2Key (Simple HashAlgorithm
ha) Int
ksz ByteString
bs =
  Int -> ByteString -> ByteString
B.take (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ksz) (ByteString -> ByteString)
-> Either S2KError ByteString -> Either S2KError ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashAlgorithm -> Int -> ByteString -> Either S2KError ByteString
hashpp HashAlgorithm
ha Int
ksz ByteString
bs
string2Key (Salted HashAlgorithm
ha Salt8
salt) Int
ksz ByteString
bs =
  S2K -> Int -> ByteString -> Either S2KError ByteString
string2Key (HashAlgorithm -> S2K
Simple HashAlgorithm
ha) Int
ksz (ByteString -> ByteString -> ByteString
BL.append (ByteString -> ByteString
BL.fromStrict (Salt8 -> ByteString
unSalt8 Salt8
salt)) ByteString
bs)
string2Key (IteratedSalted HashAlgorithm
ha Salt8
salt IterationCount
cnt) Int
ksz ByteString
bs =
  S2K -> Int -> ByteString -> Either S2KError ByteString
string2Key
    (HashAlgorithm -> S2K
Simple HashAlgorithm
ha)
    Int
ksz
    (Int64 -> ByteString -> ByteString
BL.take (IterationCount -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral IterationCount
cnt) (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => ByteString -> ByteString
ByteString -> ByteString
BL.cycle (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
     ByteString -> ByteString -> ByteString
BL.append (ByteString -> ByteString
BL.fromStrict (Salt8 -> ByteString
unSalt8 Salt8
salt)) ByteString
bs)
string2Key (Argon2 Salt16
salt Word8
t Word8
p Word8
encodedM) Int
ksz ByteString
pass =
  Salt16
-> Word8
-> Word8
-> Word8
-> Int
-> ByteString
-> Either S2KError ByteString
argon2String2Key Salt16
salt Word8
t Word8
p Word8
encodedM Int
ksz ByteString
pass
string2Key (OtherS2K Word8
t ByteString
_) Int
_ ByteString
_ =
  S2KError -> Either S2KError ByteString
forall a b. a -> Either a b
Left (Word8 -> S2KError
S2KUnsupportedSpecifier Word8
t)

skesk2Key :: SKESK 'SKESKV4 -> BL.ByteString -> Either S2KError B.ByteString
skesk2Key :: SKESK 'SKESKV4 -> ByteString -> Either S2KError ByteString
skesk2Key SKESK 'SKESKV4
skesk ByteString
pass = (SymmetricAlgorithm, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((SymmetricAlgorithm, ByteString) -> ByteString)
-> Either S2KError (SymmetricAlgorithm, ByteString)
-> Either S2KError ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SKESK 'SKESKV4
-> ByteString -> Either S2KError (SymmetricAlgorithm, ByteString)
skesk2SessionKey SKESK 'SKESKV4
skesk ByteString
pass

skesk2SessionKey :: SKESK 'SKESKV4 -> BL.ByteString -> Either S2KError (SymmetricAlgorithm, B.ByteString)
skesk2SessionKey :: SKESK 'SKESKV4
-> ByteString -> Either S2KError (SymmetricAlgorithm, ByteString)
skesk2SessionKey (SKESK4Packet SymmetricAlgorithm
sa S2K
s2k Maybe ByteString
Nothing) ByteString
pass = do
  keyLen <- (CipherError -> S2KError)
-> Either CipherError Int -> Either S2KError Int
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CipherError -> S2KError
S2KUnsupportedAlgorithm (SymmetricAlgorithm -> Either CipherError Int
keySize SymmetricAlgorithm
sa)
  sessionKey <- string2Key s2k keyLen pass
  pure (sa, sessionKey)
skesk2SessionKey (SKESK4Packet SymmetricAlgorithm
sa S2K
s2k (Just ByteString
esk)) ByteString
pass = do
  keyLen <- (CipherError -> S2KError)
-> Either CipherError Int -> Either S2KError Int
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CipherError -> S2KError
S2KUnsupportedAlgorithm (SymmetricAlgorithm -> Either CipherError Int
keySize SymmetricAlgorithm
sa)
  kek <- string2Key s2k keyLen pass
  decrypted <-
    first S2KEncryptedSessionKeyCipherError $
    withSymmetricCipher sa kek
      (\cipher
cipher ->
         cipher -> ByteString -> ByteString -> Either String ByteString
forall cipher.
HOBlockCipher cipher =>
cipher -> ByteString -> ByteString -> Either String ByteString
paddedCfbDecrypt
           cipher
cipher
           (Int -> Word8 -> ByteString
B.replicate (cipher -> Int
forall cipher. HOBlockCipher cipher => cipher -> Int
blockSize cipher
cipher) Word8
0)
           (ByteString -> ByteString
BL.toStrict ByteString
esk))
  first S2KEncryptedSessionKeyDecodeError (decodeSKESK4EncryptedSessionKey decrypted)

decodeOpenPGPEncodedSessionKey ::
     B.ByteString -> Either EncodedSessionKeyError (SymmetricAlgorithm, B.ByteString)
decodeOpenPGPEncodedSessionKey :: ByteString
-> Either EncodedSessionKeyError (SymmetricAlgorithm, ByteString)
decodeOpenPGPEncodedSessionKey ByteString
encodedSessionKey = do
  if ByteString -> Int
B.length ByteString
encodedSessionKey Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3
    then EncodedSessionKeyError -> Either EncodedSessionKeyError ()
forall a b. a -> Either a b
Left EncodedSessionKeyError
EncodedSessionKeyTooShort
    else () -> Either EncodedSessionKeyError ()
forall a b. b -> Either a b
Right ()
  let symalgo :: SymmetricAlgorithm
symalgo = Word8 -> SymmetricAlgorithm
forall a. FutureVal a => Word8 -> a
toFVal (HasCallStack => ByteString -> Word8
ByteString -> Word8
B.head ByteString
encodedSessionKey)
      rest :: ByteString
rest = HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.tail ByteString
encodedSessionKey
  keyLen <- SymmetricAlgorithm -> Either EncodedSessionKeyError Int
encodedSessionKeyKeyLength SymmetricAlgorithm
symalgo
  if B.length rest < keyLen + 2
    then Left (EncodedSessionKeyLengthMismatch symalgo keyLen (B.length rest))
    else Right ()
  let (sessionKey, restAfterKey) = B.splitAt keyLen rest
      checksumBytes = Int -> ByteString -> ByteString
B.take Int
2 ByteString
restAfterKey
      actualChecksum = ByteString -> Word16
checksum16 ByteString
sessionKey
      expectedChecksum =
        Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
B.index ByteString
checksumBytes Int
0) Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+
        Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
B.index ByteString
checksumBytes Int
1)
  if actualChecksum /= expectedChecksum
    then Left EncodedSessionKeyChecksumMismatch
    else Right (symalgo, sessionKey)

decodeSKESK4EncryptedSessionKey ::
     B.ByteString -> Either EncodedSessionKeyError (SymmetricAlgorithm, B.ByteString)
decodeSKESK4EncryptedSessionKey :: ByteString
-> Either EncodedSessionKeyError (SymmetricAlgorithm, ByteString)
decodeSKESK4EncryptedSessionKey ByteString
encodedSessionKey = do
  if ByteString -> Int
B.length ByteString
encodedSessionKey Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1
    then EncodedSessionKeyError -> Either EncodedSessionKeyError ()
forall a b. a -> Either a b
Left EncodedSessionKeyError
EncodedSessionKeyTooShort
    else () -> Either EncodedSessionKeyError ()
forall a b. b -> Either a b
Right ()
  let symalgo :: SymmetricAlgorithm
symalgo = Word8 -> SymmetricAlgorithm
forall a. FutureVal a => Word8 -> a
toFVal (HasCallStack => ByteString -> Word8
ByteString -> Word8
B.head ByteString
encodedSessionKey)
      sessionKey :: ByteString
sessionKey = HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.tail ByteString
encodedSessionKey
  keyLen <- SymmetricAlgorithm -> Either EncodedSessionKeyError Int
encodedSessionKeyKeyLength SymmetricAlgorithm
symalgo
  if B.length sessionKey /= keyLen
    then Left (EncodedSessionKeyLengthMismatch symalgo keyLen (B.length sessionKey))
    else Right (symalgo, sessionKey)

encodedSessionKeyKeyLength ::
     SymmetricAlgorithm -> Either EncodedSessionKeyError Int
encodedSessionKeyKeyLength :: SymmetricAlgorithm -> Either EncodedSessionKeyError Int
encodedSessionKeyKeyLength SymmetricAlgorithm
symalgo =
  (CipherError -> EncodedSessionKeyError)
-> Either CipherError Int -> Either EncodedSessionKeyError Int
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CipherError -> EncodedSessionKeyError
renderKeySizeError (SymmetricAlgorithm -> Either CipherError Int
keySize SymmetricAlgorithm
symalgo)
  where
    renderKeySizeError :: CipherError -> EncodedSessionKeyError
    renderKeySizeError :: CipherError -> EncodedSessionKeyError
renderKeySizeError (UnsupportedAlgorithm SymmetricAlgorithm
sa) =
      SymmetricAlgorithm -> EncodedSessionKeyError
EncodedSessionKeyUnsupportedAlgorithm SymmetricAlgorithm
sa
    renderKeySizeError (CipherInitFailed SymmetricAlgorithm
sa String
_) =
      SymmetricAlgorithm -> EncodedSessionKeyError
EncodedSessionKeyUnsupportedAlgorithm SymmetricAlgorithm
sa
    renderKeySizeError (CipherOperationFailed String
_) =
      SymmetricAlgorithm -> EncodedSessionKeyError
EncodedSessionKeyUnsupportedAlgorithm SymmetricAlgorithm
symalgo

checksum16 :: B.ByteString -> Word16
checksum16 :: ByteString -> Word16
checksum16 =
  Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word16)
-> (ByteString -> Integer) -> ByteString -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (Integer -> Word8 -> Integer) -> Integer -> ByteString -> Integer
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' (\Integer
acc Word8
octet -> (Integer
acc Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
octet) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` (Integer
65536 :: Integer)) Integer
0

argon2String2Key :: Salt16 -> Word8 -> Word8 -> Word8 -> Int -> BL.ByteString -> Either S2KError B.ByteString
argon2String2Key :: Salt16
-> Word8
-> Word8
-> Word8
-> Int
-> ByteString
-> Either S2KError ByteString
argon2String2Key Salt16
salt Word8
t Word8
p Word8
encodedM Int
keyLen ByteString
pass
  | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 = S2KError -> Either S2KError ByteString
forall a b. a -> Either a b
Left (String -> S2KError
S2KArgon2ParamError String
"Argon2 S2K pass count must be non-zero")
  | Word8
p Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 = S2KError -> Either S2KError ByteString
forall a b. a -> Either a b
Left (String -> S2KError
S2KArgon2ParamError String
"Argon2 S2K parallelism must be non-zero")
  | Word8
encodedM Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
31 = S2KError -> Either S2KError ByteString
forall a b. a -> Either a b
Left (String -> S2KError
S2KArgon2ParamError String
"Argon2 S2K encoded_m must be <= 31")
  | Word8
encodedM Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
minEncodedM = S2KError -> Either S2KError ByteString
forall a b. a -> Either a b
Left (String -> S2KError
S2KArgon2ParamError String
"Argon2 S2K encoded_m is too small for parallelism")
  | Bool
otherwise =
      case Options
-> ByteString -> ByteString -> Int -> CryptoFailable ByteString
forall password salt out.
(ByteArrayAccess password, ByteArrayAccess salt, ByteArray out) =>
Options -> password -> salt -> Int -> CryptoFailable out
Argon2.hash Options
opts (ByteString -> ByteString
BL.toStrict ByteString
pass) (Salt16 -> ByteString
unSalt16 Salt16
salt) Int
keyLen of
        CryptoPassed ByteString
k -> ByteString -> Either S2KError ByteString
forall a b. b -> Either a b
Right ByteString
k
        CryptoFailed CryptoError
e -> S2KError -> Either S2KError ByteString
forall a b. a -> Either a b
Left (String -> S2KError
S2KArgon2Failed (CryptoError -> String
forall a. Show a => a -> String
show CryptoError
e))
  where
    opts :: Options
opts =
      Options
Argon2.defaultOptions
        { Argon2.iterations = fromIntegral t
        , Argon2.memory = fromIntegral (1 `shiftL` fromIntegral encodedM :: Int)
        , Argon2.parallelism = fromIntegral p
        , Argon2.variant = Argon2.Argon2id
        , Argon2.version = Argon2.Version13
        }
    minEncodedM :: Word8
minEncodedM = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
ceilLog2 (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
p :: Int))

ceilLog2 :: Int -> Int
ceilLog2 :: Int -> Int
ceilLog2 Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 = Int
0
  | Bool
otherwise = Int -> Int -> Int
go Int
0 Int
1
  where
    go :: Int -> Int -> Int
go Int
e Int
v
      | Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = Int
e
      | Bool
otherwise = Int -> Int -> Int
go (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2)

hashpp :: HashAlgorithm -> Int -> BL.ByteString -> Either S2KError B.ByteString
hashpp :: HashAlgorithm -> Int -> ByteString -> Either S2KError ByteString
hashpp HashAlgorithm
ha Int
keysize ByteString
pp =
  Int -> ByteString -> Either S2KError ByteString
go Int
0 ByteString
B.empty
  where
    go :: Int -> ByteString -> Either S2KError ByteString
go Int
ctr ByteString
acc
      | ByteString -> Int
B.length ByteString
acc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
keysize = ByteString -> Either S2KError ByteString
forall a b. b -> Either a b
Right ByteString
acc
      | Bool
otherwise = do
          digest <- HashAlgorithm -> ByteString -> Either S2KError ByteString
hf HashAlgorithm
ha (Int -> ByteString
nulpad Int
ctr ByteString -> ByteString -> ByteString
`BL.append` ByteString
pp)
          go (ctr + 1) (acc `B.append` digest)
    nulpad :: Int -> ByteString
nulpad = [Word8] -> ByteString
BL.pack ([Word8] -> ByteString) -> (Int -> [Word8]) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Word8 -> [Word8]) -> Word8 -> Int -> [Word8]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate Word8
0
    hf :: HashAlgorithm -> BL.ByteString -> Either S2KError B.ByteString
    hf :: HashAlgorithm -> ByteString -> Either S2KError ByteString
hf HashAlgorithm
DeprecatedMD5 ByteString
bs = ByteString -> Either S2KError ByteString
forall a b. b -> Either a b
Right (Digest MD5 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> Digest MD5
forall a. HashAlgorithm a => ByteString -> Digest a
CH.hashlazy ByteString
bs :: CH.Digest CH.MD5))
    hf HashAlgorithm
SHA1 ByteString
bs = ByteString -> Either S2KError ByteString
forall a b. b -> Either a b
Right (Digest SHA1 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> Digest SHA1
forall a. HashAlgorithm a => ByteString -> Digest a
CH.hashlazy ByteString
bs :: CH.Digest CH.SHA1))
    hf HashAlgorithm
SHA224 ByteString
bs = ByteString -> Either S2KError ByteString
forall a b. b -> Either a b
Right (Digest SHA224 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> Digest SHA224
forall a. HashAlgorithm a => ByteString -> Digest a
CH.hashlazy ByteString
bs :: CH.Digest CH.SHA224))
    hf HashAlgorithm
SHA256 ByteString
bs = ByteString -> Either S2KError ByteString
forall a b. b -> Either a b
Right (Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> Digest SHA256
forall a. HashAlgorithm a => ByteString -> Digest a
CH.hashlazy ByteString
bs :: CH.Digest CH.SHA256))
    hf HashAlgorithm
SHA384 ByteString
bs = ByteString -> Either S2KError ByteString
forall a b. b -> Either a b
Right (Digest SHA384 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> Digest SHA384
forall a. HashAlgorithm a => ByteString -> Digest a
CH.hashlazy ByteString
bs :: CH.Digest CH.SHA384))
    hf HashAlgorithm
SHA512 ByteString
bs = ByteString -> Either S2KError ByteString
forall a b. b -> Either a b
Right (Digest SHA512 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> Digest SHA512
forall a. HashAlgorithm a => ByteString -> Digest a
CH.hashlazy ByteString
bs :: CH.Digest CH.SHA512))
    hf HashAlgorithm
SHA3_256 ByteString
bs = ByteString -> Either S2KError ByteString
forall a b. b -> Either a b
Right (Digest SHA3_256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> Digest SHA3_256
forall a. HashAlgorithm a => ByteString -> Digest a
CH.hashlazy ByteString
bs :: CH.Digest CH.SHA3_256))
    hf HashAlgorithm
SHA3_512 ByteString
bs = ByteString -> Either S2KError ByteString
forall a b. b -> Either a b
Right (Digest SHA3_512 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> Digest SHA3_512
forall a. HashAlgorithm a => ByteString -> Digest a
CH.hashlazy ByteString
bs :: CH.Digest CH.SHA3_512))
    hf (OtherHA Word8
ha') ByteString
_ = S2KError -> Either S2KError ByteString
forall a b. a -> Either a b
Left (HashAlgorithm -> S2KError
S2KUnsupportedHashAlgorithm (Word8 -> HashAlgorithm
OtherHA Word8
ha'))