48 lines
1.3 KiB
Haskell
48 lines
1.3 KiB
Haskell
{-# language RecordWildCards #-}
|
|
|
|
module Fedi.Signature.Sign
|
|
( module Fedi.Signature.Types
|
|
, module Fedi.Signature.Sign
|
|
)
|
|
where
|
|
|
|
import Prelude hiding (error)
|
|
import Fedi.UserDetails
|
|
import Fedi.Helpers
|
|
import Data.ByteString qualified as BS
|
|
import Fedi.Crypto
|
|
import Data.Time qualified as Time
|
|
import Fedi.Signature.Types
|
|
|
|
-- * Sign
|
|
|
|
signSignature
|
|
:: UserDetails -> String -> String -> ByteString -> IO HttpSignature
|
|
signSignature details host requestTarget body = do
|
|
date <- Time.getCurrentTime
|
|
<&> Time.formatTime Time.defaultTimeLocale Time.rfc822DateFormat
|
|
|
|
let
|
|
digest = "SHA-256=" <> encodeBase64 (makeDigest body)
|
|
keyId = actorUrl details <> "#main-key"
|
|
headers = ["(request-target)", "host", "date", "digest"]
|
|
components = []
|
|
signatureString = makeSignatureString host requestTarget date digest
|
|
|
|
signed <- sign details signatureString
|
|
|
|
let
|
|
signature = encodeBase64 signed.signedMessage
|
|
signatureHeader = SignatureHeader{..}
|
|
|
|
pure HttpSignature{..}
|
|
|
|
makeSignatureString
|
|
:: String -> String -> String -> ByteString -> ByteString
|
|
makeSignatureString host requestTarget date digest =
|
|
BS.intercalate "\n"
|
|
[ "(request-target): " <> fromString requestTarget
|
|
, "host: " <> fromString host
|
|
, "date: " <> fromString date
|
|
, "digest: " <> digest
|
|
]
|