module Network.Wai.SAML2.Validation (
validateResponse,
ansiX923
) where
import Control.Exception
import Control.Monad.Except
import Crypto.Error
import Crypto.Hash
import qualified Crypto.PubKey.RSA.OAEP as OAEP
import Crypto.PubKey.RSA.PKCS15 as PKCS15
import Crypto.Cipher.AES
import Crypto.Cipher.Types
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Default.Class
import Data.Time
import Network.Wai.SAML2.XML.Encrypted
import Network.Wai.SAML2.Config
import Network.Wai.SAML2.Error
import Network.Wai.SAML2.XML
import Network.Wai.SAML2.C14N
import Network.Wai.SAML2.Response
import Network.Wai.SAML2.Assertion
import qualified Text.XML as XML
import qualified Text.XML.Cursor as XML
validateResponse :: SAML2Config
-> BS.ByteString
-> IO (Either SAML2Error Assertion)
validateResponse :: SAML2Config -> ByteString -> IO (Either SAML2Error Assertion)
validateResponse SAML2Config
cfg ByteString
responseData = ExceptT SAML2Error IO Assertion -> IO (Either SAML2Error Assertion)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT SAML2Error IO Assertion
-> IO (Either SAML2Error Assertion))
-> ExceptT SAML2Error IO Assertion
-> IO (Either SAML2Error Assertion)
forall a b. (a -> b) -> a -> b
$ do
UTCTime
now <- IO UTCTime -> ExceptT SAML2Error IO UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UTCTime -> ExceptT SAML2Error IO UTCTime)
-> IO UTCTime -> ExceptT SAML2Error IO UTCTime
forall a b. (a -> b) -> a -> b
$ IO UTCTime
getCurrentTime
let resXmlDocData :: ByteString
resXmlDocData = ByteString -> ByteString
BS.decodeLenient ByteString
responseData
Document
responseXmlDoc <- case ParseSettings -> ByteString -> Either SomeException Document
XML.parseLBS ParseSettings
forall a. Default a => a
def (ByteString -> ByteString
LBS.fromStrict ByteString
resXmlDocData) of
Left SomeException
err -> SAML2Error -> ExceptT SAML2Error IO Document
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SAML2Error -> ExceptT SAML2Error IO Document)
-> SAML2Error -> ExceptT SAML2Error IO Document
forall a b. (a -> b) -> a -> b
$ SomeException -> SAML2Error
InvalidResponseXml SomeException
err
Right Document
responseXmlDoc -> Document -> ExceptT SAML2Error IO Document
forall (f :: * -> *) a. Applicative f => a -> f a
pure Document
responseXmlDoc
Either IOException Response
resParseResult <- IO (Either IOException Response)
-> ExceptT SAML2Error IO (Either IOException Response)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException Response)
-> ExceptT SAML2Error IO (Either IOException Response))
-> IO (Either IOException Response)
-> ExceptT SAML2Error IO (Either IOException Response)
forall a b. (a -> b) -> a -> b
$ IO Response -> IO (Either IOException Response)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO Response -> IO (Either IOException Response))
-> IO Response -> IO (Either IOException Response)
forall a b. (a -> b) -> a -> b
$
Cursor -> IO Response
forall a (m :: * -> *). (FromXML a, MonadFail m) => Cursor -> m a
parseXML (Document -> Cursor
XML.fromDocument Document
responseXmlDoc)
Response
samlResponse <- case Either IOException Response
resParseResult of
Left IOException
err -> SAML2Error -> ExceptT SAML2Error IO Response
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SAML2Error -> ExceptT SAML2Error IO Response)
-> SAML2Error -> ExceptT SAML2Error IO Response
forall a b. (a -> b) -> a -> b
$ IOException -> SAML2Error
InvalidResponse IOException
err
Right Response
samlResponse -> Response -> ExceptT SAML2Error IO Response
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response
samlResponse
case Response -> StatusCode
responseStatusCode Response
samlResponse of
StatusCode
Success -> () -> ExceptT SAML2Error IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
StatusCode
status -> SAML2Error -> ExceptT SAML2Error IO ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SAML2Error -> ExceptT SAML2Error IO ())
-> SAML2Error -> ExceptT SAML2Error IO ()
forall a b. (a -> b) -> a -> b
$ StatusCode -> SAML2Error
Unsuccessful StatusCode
status
let destination :: Text
destination = Response -> Text
responseDestination Response
samlResponse
case SAML2Config -> Maybe Text
saml2ExpectedDestination SAML2Config
cfg of
Just Text
expectedDestination
| Text
destination Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
expectedDestination ->
SAML2Error -> ExceptT SAML2Error IO ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SAML2Error -> ExceptT SAML2Error IO ())
-> SAML2Error -> ExceptT SAML2Error IO ()
forall a b. (a -> b) -> a -> b
$ Text -> SAML2Error
UnexpectedDestination Text
destination
Maybe Text
_ -> () -> ExceptT SAML2Error IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
let issuer :: Text
issuer = Response -> Text
responseIssuer Response
samlResponse
case SAML2Config -> Maybe Text
saml2ExpectedIssuer SAML2Config
cfg of
Just Text
expectedIssuer
| Text
issuer Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
expectedIssuer -> SAML2Error -> ExceptT SAML2Error IO ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SAML2Error -> ExceptT SAML2Error IO ())
-> SAML2Error -> ExceptT SAML2Error IO ()
forall a b. (a -> b) -> a -> b
$ Text -> SAML2Error
InvalidIssuer Text
issuer
Maybe Text
_ -> () -> ExceptT SAML2Error IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Element
signedInfo <- Cursor -> ExceptT SAML2Error IO Element
forall (m :: * -> *). MonadFail m => Cursor -> m Element
extractSignedInfo (Document -> Cursor
XML.fromDocument Document
responseXmlDoc)
let doc :: Document
doc = Prologue -> Element -> [Miscellaneous] -> Document
XML.Document ([Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
XML.Prologue [] Maybe Doctype
forall a. Maybe a
Nothing []) Element
signedInfo []
let signedInfoXml :: ByteString
signedInfoXml = RenderSettings -> Document -> ByteString
XML.renderLBS RenderSettings
forall a. Default a => a
def Document
doc
Either IOException ByteString
signedInfoCanonResult <- IO (Either IOException ByteString)
-> ExceptT SAML2Error IO (Either IOException ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException ByteString)
-> ExceptT SAML2Error IO (Either IOException ByteString))
-> IO (Either IOException ByteString)
-> ExceptT SAML2Error IO (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ IO ByteString -> IO (Either IOException ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO ByteString -> IO (Either IOException ByteString))
-> IO ByteString -> IO (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$
ByteString -> IO ByteString
canonicalise (ByteString -> ByteString
LBS.toStrict ByteString
signedInfoXml)
ByteString
normalisedSignedInfo <- case Either IOException ByteString
signedInfoCanonResult of
Left IOException
err -> SAML2Error -> ExceptT SAML2Error IO ByteString
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SAML2Error -> ExceptT SAML2Error IO ByteString)
-> SAML2Error -> ExceptT SAML2Error IO ByteString
forall a b. (a -> b) -> a -> b
$ IOException -> SAML2Error
CanonicalisationFailure IOException
err
Right ByteString
result -> ByteString -> ExceptT SAML2Error IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
result
let documentId :: Text
documentId = Response -> Text
responseId Response
samlResponse
let referenceId :: Text
referenceId = Reference -> Text
referenceURI
(Reference -> Text) -> Reference -> Text
forall a b. (a -> b) -> a -> b
$ SignedInfo -> Reference
signedInfoReference
(SignedInfo -> Reference) -> SignedInfo -> Reference
forall a b. (a -> b) -> a -> b
$ Signature -> SignedInfo
signatureInfo
(Signature -> SignedInfo) -> Signature -> SignedInfo
forall a b. (a -> b) -> a -> b
$ Response -> Signature
responseSignature Response
samlResponse
if Text
documentId Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
referenceId
then SAML2Error -> ExceptT SAML2Error IO ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SAML2Error -> ExceptT SAML2Error IO ())
-> SAML2Error -> ExceptT SAML2Error IO ()
forall a b. (a -> b) -> a -> b
$ Text -> SAML2Error
UnexpectedReference Text
referenceId
else () -> ExceptT SAML2Error IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
let docMinusSignature :: Document
docMinusSignature = Document -> Document
removeSignature Document
responseXmlDoc
let renderedXml :: ByteString
renderedXml = RenderSettings -> Document -> ByteString
XML.renderLBS RenderSettings
forall a. Default a => a
def Document
docMinusSignature
Either IOException ByteString
refCanonResult <- IO (Either IOException ByteString)
-> ExceptT SAML2Error IO (Either IOException ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException ByteString)
-> ExceptT SAML2Error IO (Either IOException ByteString))
-> IO (Either IOException ByteString)
-> ExceptT SAML2Error IO (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ IO ByteString -> IO (Either IOException ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO ByteString -> IO (Either IOException ByteString))
-> IO ByteString -> IO (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ByteString
canonicalise (ByteString -> ByteString
LBS.toStrict ByteString
renderedXml)
ByteString
normalised <- case Either IOException ByteString
refCanonResult of
Left IOException
err -> SAML2Error -> ExceptT SAML2Error IO ByteString
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SAML2Error -> ExceptT SAML2Error IO ByteString)
-> SAML2Error -> ExceptT SAML2Error IO ByteString
forall a b. (a -> b) -> a -> b
$ IOException -> SAML2Error
CanonicalisationFailure IOException
err
Right ByteString
result -> ByteString -> ExceptT SAML2Error IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
result
let documentHash :: Digest SHA256
documentHash = SHA256 -> ByteString -> Digest SHA256
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA256
SHA256 ByteString
normalised
let referenceHash :: Maybe (Digest SHA256)
referenceHash = ByteString -> Maybe (Digest SHA256)
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString
(ByteString -> Maybe (Digest SHA256))
-> ByteString -> Maybe (Digest SHA256)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS.decodeLenient
(ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Reference -> ByteString
referenceDigestValue
(Reference -> ByteString) -> Reference -> ByteString
forall a b. (a -> b) -> a -> b
$ SignedInfo -> Reference
signedInfoReference
(SignedInfo -> Reference) -> SignedInfo -> Reference
forall a b. (a -> b) -> a -> b
$ Signature -> SignedInfo
signatureInfo
(Signature -> SignedInfo) -> Signature -> SignedInfo
forall a b. (a -> b) -> a -> b
$ Response -> Signature
responseSignature Response
samlResponse
if Digest SHA256 -> Maybe (Digest SHA256)
forall a. a -> Maybe a
Just Digest SHA256
documentHash Maybe (Digest SHA256) -> Maybe (Digest SHA256) -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe (Digest SHA256)
referenceHash
then SAML2Error -> ExceptT SAML2Error IO ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError SAML2Error
InvalidDigest
else () -> ExceptT SAML2Error IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
let sig :: ByteString
sig = ByteString -> ByteString
BS.decodeLenient (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Signature -> ByteString
signatureValue (Signature -> ByteString) -> Signature -> ByteString
forall a b. (a -> b) -> a -> b
$ Response -> Signature
responseSignature Response
samlResponse
let pubKey :: PublicKey
pubKey = SAML2Config -> PublicKey
saml2PublicKey SAML2Config
cfg
if Maybe SHA256 -> PublicKey -> ByteString -> ByteString -> Bool
forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe hashAlg -> PublicKey -> ByteString -> ByteString -> Bool
PKCS15.verify (SHA256 -> Maybe SHA256
forall a. a -> Maybe a
Just SHA256
SHA256) PublicKey
pubKey ByteString
normalisedSignedInfo ByteString
sig
then () -> ExceptT SAML2Error IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
else SAML2Error -> ExceptT SAML2Error IO ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError SAML2Error
InvalidSignature
let pk :: PrivateKey
pk = SAML2Config -> PrivateKey
saml2PrivateKey SAML2Config
cfg
let encryptedAssertion :: EncryptedAssertion
encryptedAssertion = Response -> EncryptedAssertion
responseEncryptedAssertion Response
samlResponse
Either Error ByteString
oaepResult <- IO (Either Error ByteString)
-> ExceptT SAML2Error IO (Either Error ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either Error ByteString)
-> ExceptT SAML2Error IO (Either Error ByteString))
-> IO (Either Error ByteString)
-> ExceptT SAML2Error IO (Either Error ByteString)
forall a b. (a -> b) -> a -> b
$ OAEPParams SHA1 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 (SHA1 -> OAEPParams SHA1 ByteString ByteString
forall seed output hash.
(ByteArrayAccess seed, ByteArray output, HashAlgorithm hash) =>
hash -> OAEPParams hash seed output
OAEP.defaultOAEPParams SHA1
SHA1) PrivateKey
pk
(ByteString -> IO (Either Error ByteString))
-> ByteString -> IO (Either Error ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS.decodeLenient
(ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ CipherData -> ByteString
cipherValue
(CipherData -> ByteString) -> CipherData -> ByteString
forall a b. (a -> b) -> a -> b
$ EncryptedKey -> CipherData
encryptedKeyCipher
(EncryptedKey -> CipherData) -> EncryptedKey -> CipherData
forall a b. (a -> b) -> a -> b
$ EncryptedAssertion -> EncryptedKey
encryptedAssertionKey
(EncryptedAssertion -> EncryptedKey)
-> EncryptedAssertion -> EncryptedKey
forall a b. (a -> b) -> a -> b
$ EncryptedAssertion
encryptedAssertion
ByteString
aesKey <- case Either Error ByteString
oaepResult of
Left Error
err -> SAML2Error -> ExceptT SAML2Error IO ByteString
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SAML2Error -> ExceptT SAML2Error IO ByteString)
-> SAML2Error -> ExceptT SAML2Error IO ByteString
forall a b. (a -> b) -> a -> b
$ Error -> SAML2Error
DecryptionFailure Error
err
Right ByteString
cipherData -> ByteString -> ExceptT SAML2Error IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
cipherData
ByteString
xmlData <- case ByteString -> CryptoFailable AES128
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
cipherInit ByteString
aesKey of
CryptoFailed CryptoError
err -> SAML2Error -> ExceptT SAML2Error IO ByteString
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SAML2Error -> ExceptT SAML2Error IO ByteString)
-> SAML2Error -> ExceptT SAML2Error IO ByteString
forall a b. (a -> b) -> a -> b
$ CryptoError -> SAML2Error
CryptoError CryptoError
err
CryptoPassed AES128
aes128 -> do
let cipherText :: ByteString
cipherText = ByteString -> ByteString
BS.decodeLenient
(ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ CipherData -> ByteString
cipherValue
(CipherData -> ByteString) -> CipherData -> ByteString
forall a b. (a -> b) -> a -> b
$ EncryptedAssertion -> CipherData
encryptedAssertionCipher
(EncryptedAssertion -> CipherData)
-> EncryptedAssertion -> CipherData
forall a b. (a -> b) -> a -> b
$ EncryptedAssertion
encryptedAssertion
let (ByteString
ivBytes, ByteString
xmlBytes) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
16 ByteString
cipherText
case ByteString -> Maybe (IV AES128)
forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
makeIV ByteString
ivBytes of
Maybe (IV AES128)
Nothing -> SAML2Error -> ExceptT SAML2Error IO ByteString
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError SAML2Error
InvalidIV
Just IV AES128
iv -> do
let plaintext :: ByteString
plaintext = AES128 -> IV AES128 -> ByteString -> ByteString
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cbcDecrypt (AES128
aes128 :: AES128) IV AES128
iv ByteString
xmlBytes
case ByteString -> Maybe ByteString
ansiX923 ByteString
plaintext of
Maybe ByteString
Nothing -> SAML2Error -> ExceptT SAML2Error IO ByteString
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError SAML2Error
InvalidPadding
Just ByteString
xmlData -> ByteString -> ExceptT SAML2Error IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
xmlData
Assertion
assertion <- case ParseSettings -> ByteString -> Either SomeException Document
XML.parseLBS ParseSettings
forall a. Default a => a
def (ByteString -> ByteString
LBS.fromStrict ByteString
xmlData) of
Left SomeException
err -> SAML2Error -> ExceptT SAML2Error IO Assertion
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SAML2Error -> ExceptT SAML2Error IO Assertion)
-> SAML2Error -> ExceptT SAML2Error IO Assertion
forall a b. (a -> b) -> a -> b
$ SomeException -> SAML2Error
InvalidAssertionXml SomeException
err
Right Document
assertDoc -> do
Either IOException Assertion
assertParseResult <- IO (Either IOException Assertion)
-> ExceptT SAML2Error IO (Either IOException Assertion)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException Assertion)
-> ExceptT SAML2Error IO (Either IOException Assertion))
-> IO (Either IOException Assertion)
-> ExceptT SAML2Error IO (Either IOException Assertion)
forall a b. (a -> b) -> a -> b
$ IO Assertion -> IO (Either IOException Assertion)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO Assertion -> IO (Either IOException Assertion))
-> IO Assertion -> IO (Either IOException Assertion)
forall a b. (a -> b) -> a -> b
$
Cursor -> IO Assertion
forall a (m :: * -> *). (FromXML a, MonadFail m) => Cursor -> m a
parseXML (Document -> Cursor
XML.fromDocument Document
assertDoc)
case Either IOException Assertion
assertParseResult of
Left IOException
err -> SAML2Error -> ExceptT SAML2Error IO Assertion
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SAML2Error -> ExceptT SAML2Error IO Assertion)
-> SAML2Error -> ExceptT SAML2Error IO Assertion
forall a b. (a -> b) -> a -> b
$ IOException -> SAML2Error
InvalidAssertion IOException
err
Right Assertion
assertion -> Assertion -> ExceptT SAML2Error IO Assertion
forall (f :: * -> *) a. Applicative f => a -> f a
pure Assertion
assertion
let Conditions{Text
UTCTime
conditionsAudience :: Conditions -> Text
conditionsNotOnOrAfter :: Conditions -> UTCTime
conditionsNotBefore :: Conditions -> UTCTime
conditionsAudience :: Text
conditionsNotOnOrAfter :: UTCTime
conditionsNotBefore :: UTCTime
..} = Assertion -> Conditions
assertionConditions Assertion
assertion
if (UTCTime
now UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< UTCTime
conditionsNotBefore Bool -> Bool -> Bool
|| UTCTime
now UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
>= UTCTime
conditionsNotOnOrAfter) Bool -> Bool -> Bool
&&
Bool -> Bool
not (SAML2Config -> Bool
saml2DisableTimeValidation SAML2Config
cfg)
then SAML2Error -> ExceptT SAML2Error IO ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError SAML2Error
NotValid
else () -> ExceptT SAML2Error IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Assertion -> ExceptT SAML2Error IO Assertion
forall (f :: * -> *) a. Applicative f => a -> f a
pure Assertion
assertion
ansiX923 :: BS.ByteString -> Maybe BS.ByteString
ansiX923 :: ByteString -> Maybe ByteString
ansiX923 ByteString
d
| Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Maybe ByteString
forall a. Maybe a
Nothing
| Int
padLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
padLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
len = Maybe ByteString
forall a. Maybe a
Nothing
| Bool
otherwise = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
content
where len :: Int
len = ByteString -> Int
BS.length ByteString
d
padBytes :: Word8
padBytes = ByteString -> Int -> Word8
BS.index ByteString
d (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
padLen :: Int
padLen = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
padBytes
(ByteString
content,ByteString
_) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
padLen) ByteString
d