{-# LANGUAGE OverloadedStrings #-}

module AWS.Transcribe.PreSignedUrl (host, path) where

import AWS.Credentials (Credentials (accessKey, secretKey))
import AWS.Transcribe.Settings (Region, Settings (..), langCode, meToText, region, rgToText, srToText)
import qualified Crypto.Hash.SHA256 as SH
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Time (UTCTime, defaultTimeLocale, formatTime)

-- Http verb
method :: T.Text
method :: Text
method = Text
"GET"

-- Service name
service :: T.Text
service :: Text
service = Text
"transcribe"

-- # Host
host :: Region -> T.Text
host :: Region -> Text
host Region
rg = Text
"transcribestreaming." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Region -> Text
rgToText Region
rg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".amazonaws.com"

-- Date and time of the signature's creation
amzDate :: UTCTime -> T.Text
amzDate :: UTCTime -> Text
amzDate = String -> Text
T.pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%Y%m%dT%H%M%SZ"

-- Date without time for credential scope
datestamp :: UTCTime -> T.Text
datestamp :: UTCTime -> Text
datestamp = String -> Text
T.pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%Y%m%d"

-- The canonical URI
canonicalUri :: T.Text
canonicalUri :: Text
canonicalUri = Text
"/stream-transcription-websocket"

-- The canonical headers
canonicalHeaders :: Region -> T.Text
canonicalHeaders :: Region -> Text
canonicalHeaders Region
rg = Text
"host:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Region -> Text
host Region
rg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"

-- The signed headers
signedHeaders :: T.Text
signedHeaders :: Text
signedHeaders = Text
"host"

-- The hashing algorithm
algorithm :: T.Text
algorithm :: Text
algorithm = Text
"AWS4-HMAC-SHA256"

-- The credential scope, scopes the derived key to the date, Region and service
credentialScope :: Region -> UTCTime -> T.Text
credentialScope :: Region -> UTCTime -> Text
credentialScope Region
rg UTCTime
now = UTCTime -> Text
datestamp UTCTime
now Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%2F" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Region -> Text
rgToText Region
rg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%2F" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
service Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%2F" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"aws4_request"

-- | Similar to `credentialScope`, but with no url encoding for '/'
credentialScopeNoEncoding :: Region -> UTCTime -> T.Text
credentialScopeNoEncoding :: Region -> UTCTime -> Text
credentialScopeNoEncoding Region
rg UTCTime
now = UTCTime -> Text
datestamp UTCTime
now Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Region -> Text
rgToText Region
rg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
service Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"aws4_request"

canonicalQueryString :: Credentials -> Settings -> UTCTime -> T.Text
canonicalQueryString :: Credentials -> Settings -> UTCTime -> Text
canonicalQueryString Credentials
creds Settings
settings UTCTime
now =
    Text
"X-Amz-Algorithm=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
algorithm
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"&X-Amz-Credential="
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Credentials -> Text
accessKey Credentials
creds
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%2F"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Region -> UTCTime -> Text
credentialScope (Settings -> Region
region Settings
settings) UTCTime
now
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"&X-Amz-Date="
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UTCTime -> Text
amzDate UTCTime
now
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"&X-Amz-Expires=300"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"&X-Amz-SignedHeaders="
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
signedHeaders
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"&language-code="
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LanguageCode -> Text
langCode (Settings -> LanguageCode
languageCode Settings
settings)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"&media-encoding="
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> MediaEncoding -> Text
meToText (Settings -> MediaEncoding
mediaEncoding Settings
settings)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"&sample-rate="
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word -> Text
srToText (Settings -> Word
sampleRate Settings
settings)

payloadHash :: BS.ByteString
payloadHash :: ByteString
payloadHash = ByteString -> ByteString
hexHash (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
""

canonicalRequest :: Credentials -> Settings -> UTCTime -> BS.ByteString
canonicalRequest :: Credentials -> Settings -> UTCTime -> ByteString
canonicalRequest Credentials
creds Settings
settings UTCTime
now =
    Text -> ByteString
T.encodeUtf8 Text
method
        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n"
        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
T.encodeUtf8 Text
canonicalUri
        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n"
        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
T.encodeUtf8 (Credentials -> Settings -> UTCTime -> Text
canonicalQueryString Credentials
creds Settings
settings UTCTime
now)
        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n"
        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
T.encodeUtf8 (Region -> Text
canonicalHeaders (Region -> Text) -> Region -> Text
forall a b. (a -> b) -> a -> b
$ Settings -> Region
region Settings
settings)
        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n"
        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
T.encodeUtf8 Text
signedHeaders
        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n"
        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
payloadHash

stringToSign :: Credentials -> Settings -> UTCTime -> BS.ByteString
stringToSign :: Credentials -> Settings -> UTCTime -> ByteString
stringToSign Credentials
creds Settings
settings UTCTime
now =
    Text -> ByteString
T.encodeUtf8 Text
algorithm
        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n"
        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
T.encodeUtf8 (UTCTime -> Text
amzDate UTCTime
now)
        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n"
        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
T.encodeUtf8 (Region -> UTCTime -> Text
credentialScopeNoEncoding (Settings -> Region
region Settings
settings) UTCTime
now)
        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n"
        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
hexHash (Credentials -> Settings -> UTCTime -> ByteString
canonicalRequest Credentials
creds Settings
settings UTCTime
now)

signingKey :: Credentials -> Region -> UTCTime -> BS.ByteString
signingKey :: Credentials -> Region -> UTCTime -> ByteString
signingKey Credentials
creds Region
rg UTCTime
now =
    ByteString -> ByteString -> ByteString
hmacSHA256 ByteString
kService ByteString
"aws4_request"
  where
    kDate :: ByteString
kDate = ByteString -> ByteString -> ByteString
hmacSHA256 (ByteString
"AWS4" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
T.encodeUtf8 (Credentials -> Text
secretKey Credentials
creds)) (Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ UTCTime -> Text
datestamp UTCTime
now)
    kRegion :: ByteString
kRegion = ByteString -> ByteString -> ByteString
hmacSHA256 ByteString
kDate (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Region -> Text
rgToText Region
rg
    kService :: ByteString
kService = ByteString -> ByteString -> ByteString
hmacSHA256 ByteString
kRegion (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
service

signature :: Credentials -> Settings -> UTCTime -> BS.ByteString
signature :: Credentials -> Settings -> UTCTime -> ByteString
signature Credentials
creds Settings
settings UTCTime
now = ByteString -> ByteString -> ByteString
v4Signature (Credentials -> Region -> UTCTime -> ByteString
signingKey Credentials
creds (Settings -> Region
region Settings
settings) UTCTime
now) (Credentials -> Settings -> UTCTime -> ByteString
stringToSign Credentials
creds Settings
settings UTCTime
now)

finalQueryString :: Credentials -> Settings -> UTCTime -> BS.ByteString
finalQueryString :: Credentials -> Settings -> UTCTime -> ByteString
finalQueryString Credentials
creds Settings
settings UTCTime
now =
    Text -> ByteString
T.encodeUtf8 (Credentials -> Settings -> UTCTime -> Text
canonicalQueryString Credentials
creds Settings
settings UTCTime
now) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"&X-Amz-Signature=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Credentials -> Settings -> UTCTime -> ByteString
signature Credentials
creds Settings
settings UTCTime
now

path :: Credentials -> Settings -> UTCTime -> BS.ByteString
path :: Credentials -> Settings -> UTCTime -> ByteString
path Credentials
creds Settings
settings UTCTime
now = Text -> ByteString
T.encodeUtf8 Text
canonicalUri ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"?" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Credentials -> Settings -> UTCTime -> ByteString
finalQueryString Credentials
creds Settings
settings UTCTime
now

v4Signature :: BS.ByteString -> BS.ByteString -> BS.ByteString
v4Signature :: ByteString -> ByteString -> ByteString
v4Signature ByteString
derivedKey ByteString
payLoad = ByteString -> ByteString
B16.encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
hmacSHA256 ByteString
derivedKey ByteString
payLoad

hexHash :: BS.ByteString -> BS.ByteString
hexHash :: ByteString -> ByteString
hexHash = ByteString -> ByteString
B16.encode (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
SH.hash

hmacSHA256 :: BS.ByteString -> BS.ByteString -> BS.ByteString
hmacSHA256 :: ByteString -> ByteString -> ByteString
hmacSHA256 ByteString
key ByteString
msg = ByteString -> ByteString -> ByteString
SH.hmac ByteString
key ByteString
msg