module Aws.CloudFront.Signer
( URL
, JSONPOlicy
, CloudFrontSigningKey(..)
, CloudFrontPolicy(..)
, readCloudFrontSigningKeyFromDER
, parseRSAPrivateKeyDER
, signCannedPolicyURL
, signCustomPolicyURL
, signCustomPolicyURL_
, cannedPolicy
, customPolicy
, unixTime
) where
import qualified Data.ASN1.Encoding as A
import qualified Data.ASN1.BinaryEncoding as A
import qualified Data.ASN1.Types as A
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.ByteString.Base64.Lazy as B64
import Data.Time
import Data.Maybe
import Codec.Crypto.RSA
import qualified Crypto.Types.PubKey.RSA as C
import Text.Printf
import System.Locale
type URL = String
type JSONPOlicy = String
type KeyID = String
data CloudFrontSigningKey
= CloudFrontSigningKey
{ cfk_key_id :: KeyID
, cfk_key :: PrivateKey
}
deriving (Show)
data CloudFrontPolicy
= CloudFrontPolicy
{ cfp_Resource :: URL
, cfp_DateLessThan :: UTCTime
, cfp_DateGreaterThan :: Maybe UTCTime
, cfp_IpAddress :: Maybe String
}
readCloudFrontSigningKeyFromDER :: KeyID -> FilePath -> IO CloudFrontSigningKey
readCloudFrontSigningKeyFromDER ki fp =
do pk_b <- LBS.readFile fp
case parseRSAPrivateKeyDER pk_b of
Left err -> error err
Right pk ->
return $
CloudFrontSigningKey
{ cfk_key_id = ki
, cfk_key = pk
}
parseRSAPrivateKeyDER :: LBS.ByteString -> Either String C.PrivateKey
parseRSAPrivateKeyDER bs =
case A.decodeASN1 A.DER bs of
Left err -> Left $ show err
Right as ->
case A.fromASN1 as of
Left err -> Left $ show err
Right pr ->
case pr of
(pk,[]) -> Right pk
_ -> Left "residula data"
signCannedPolicyURL :: CloudFrontSigningKey -> UTCTime -> URL -> URL
signCannedPolicyURL CloudFrontSigningKey{..} exp_utc url =
printf "%s%cExpires=%s&Signature=%s&Key-Pair-Id=%s" url sep exp_eps pol_sig cfk_key_id
where
exp_eps = unixTime exp_utc
pol_sig = b64 $ rsa_sha1 cfk_key pol
pol = cannedPolicy exp_utc url
sep = if any (=='?') url then '&' else '?'
signCustomPolicyURL :: CloudFrontSigningKey -> CloudFrontPolicy -> URL
signCustomPolicyURL cfk cfp = signCustomPolicyURL_ cfk (customPolicy cfp) $ cfp_Resource cfp
signCustomPolicyURL_ :: CloudFrontSigningKey -> JSONPOlicy -> URL -> URL
signCustomPolicyURL_ CloudFrontSigningKey{..} pol url =
printf "%s%cPolicy=%s&Signature=%s&Key-Pair-Id=%s" url sep pol_b64 pol_sig cfk_key_id
where
pol_sig = b64 $ rsa_sha1 cfk_key pol
pol_b64 = b64 pol
sep = if any (=='?') url then '&' else '?'
cannedPolicy :: UTCTime -> URL -> JSONPOlicy
cannedPolicy exp_utc url =
concat
[ "{\"Statement\":[{\"Resource\":\""
, url
, "\",\"Condition\":{\"DateLessThan\":{\"AWS:EpochTime\":"
, unixTime exp_utc
, "}}}]}"
]
customPolicy :: CloudFrontPolicy -> JSONPOlicy
customPolicy CloudFrontPolicy{..} = unlines $ catMaybes
[ ok $ "{"
, ok $ " \"Statement\": [{"
, ok $ " \"Resource\":\"" ++ cfp_Resource ++ "\","
, ok $ " \"Condition\":{"
, ok $ " \"DateLessThan\":{\"AWS:EpochTime\":" ++ unixTime cfp_DateLessThan ++ "},"
, st $ \ust -> " \"DateGreaterThan\":{\"AWS:EpochTime\":" ++ unixTime ust ++ "},"
, ok $ " \"IpAddress\":{\"AWS:SourceIp\":\"" ++ maybe "0.0.0.0/0" id cfp_IpAddress ++"\"}"
, ok $ " }"
, ok $ " }]"
, ok $ "}"
]
where
ok = Just
st f = maybe Nothing (Just . f) cfp_DateGreaterThan
unixTime :: UTCTime -> String
unixTime = formatTime defaultTimeLocale "%s"
rsa_sha1 :: PrivateKey -> String -> String
rsa_sha1 pk = LBS.unpack . rsassa_pkcs1_v1_5_sign ha_SHA1 pk . LBS.pack
b64 :: String -> String
b64 = map f . LBS.unpack . B64.encode . LBS.pack
where
f '+' = '-'
f '=' = '_'
f '/' = '~'
f c = c