{-# LANGUAGE CPP                   #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE ViewPatterns          #-}

module Yesod.Transloadit (
    YesodTransloadit(..),
    mkParams,
    transloadIt,
    handleTransloadit,
    tokenText,
    extractFirstResult,
    extractNthResult,
    ParamsResult,
    ParamsError(..),
    Key(..),
    Template(..),
    Secret(..),
    TransloaditParams,
    Signature
  ) where

import           Control.Applicative
import           Control.Lens.Operators        hiding ((.=))
import           Control.Monad                 (mzero)
import           Crypto.Hash
import           Data.Aeson
import           Data.Aeson.Lens               hiding (key)
import qualified Data.Aeson.Lens               as AL
import qualified Data.ByteString               as BS
import           Data.Maybe
import           Data.Monoid
import           Data.Text
import           Data.Text.Encoding
import           Data.Time
import           Text.Julius
import           Yesod                         hiding (Key)
import           Yesod.Form.Jquery             (YesodJquery (..))
import           Yesod.Transloadit.OrderedJSON hiding (encode)
import qualified Yesod.Transloadit.OrderedJSON as OJ
#if MIN_VERSION_time(1,5,0)
#else
import           System.Locale                 (defaultTimeLocale)
#endif

-- | Typeclass for your website to enable using Transloadit.
class YesodTransloadit master where
  -- | Override the 'transloaditRoot' to point at a different base Javascript directory.
  -- The default settings will load assets from assets.transloadit.com.
  transloaditRoot :: master -> Text
  transloaditRoot _ = "https://assets.transloadit.com/js/"
  {-# MINIMAL #-}

newtype Secret = Secret { secret :: BS.ByteString } deriving (Eq, Show)
newtype Key = Key { key :: Text } deriving (Eq, Show)
newtype Template = Template { template :: Text } deriving (Eq, Show)

data TransloaditParams = TransloaditParams {
  authExpires         :: UTCTime,
  transloaditKey      :: Key,
  transloaditTemplate :: Template,
  formIdent           :: Text,
  transloaditSecret   :: Secret
} deriving (Show)

data ParamsError = UnknownError
type ParamsResult = Either ParamsError TransloaditParams

-- | Smart constructor for Transloadit params
mkParams :: UTCTime      -- ^ When the Transloadit signature should expire
         -> Key          -- ^ Transloadit key
         -> Template     -- ^ The Template to use in Transloadit
         -> Text         -- ^ The id of the form to attach to
         -> Secret       -- ^ Transloadit Secret
         -> ParamsResult
mkParams u k t f s = return (TransloaditParams u k t f s)

data TransloaditResponse = TransloaditResponse { raw :: Text, token :: Text } deriving (Show)

formatExpiryTime :: UTCTime -> Text
formatExpiryTime = pack . formatTime defaultTimeLocale "%Y/%m/%d %H:%M:%S+00:00"

instance ToJSON TransloaditParams where
  toJSON (TransloaditParams a (Key k) (Template t) _ _) = object [
      "auth" .= object [
        "key" .= k,
        "expires" .= formatExpiryTime a
      ],
      "template_id" .= t
    ]

-- encodeParams is similar to the exported ToJSON instance, except that it gives us the same order
-- output of keys each time. This is very useful for testing that signatures are correct.
encodeParams :: TransloaditParams -> Text
encodeParams (TransloaditParams a (Key k) (Template t) _ _) = OJ.encode params
  where params = obj [
                   "auth" `is` obj [
                                 "expires" `is` str (formatExpiryTime a),
                                 "key" `is` str k
                               ],
                   "template_id" `is` str t
                 ]

type Signature = Text

sign :: TransloaditParams -> Signature
sign cfg = (pack . show . hmacGetDigest) h
  where h :: HMAC SHA1
        h = hmac (s cfg) ((encodeUtf8 . encodeParams) cfg)
        s (transloaditSecret -> Secret s') = s'

-- | Calculate the signature, and embed Javascript to attach Transloadit to the form.
transloadIt :: (YesodJquery m, YesodTransloadit m) => TransloaditParams -> WidgetT m IO Signature
transloadIt t@(TransloaditParams {..}) = do
  master <- getYesod
  let root = transloaditRoot master
      signature = sign t
  addScriptEither $ urlJqueryJs master
  addScriptRemote $ root <> "jquery.transloadit2-v2-latest.js"
  toWidget [julius|
     $(function() {
      $('##{rawJS formIdent}').transloadit({
        wait : true,
        params : JSON.parse('#{(rawJS . encodeParams) t}')
      });
    });
  |]
  return signature

-- | Helper method to grab the current CSRF token from the session. Returns 'mempty' if 'Nothing'
-- could be found.
tokenText :: (YesodJquery m, YesodTransloadit m) => WidgetT m IO Text
tokenText = do
  csrfToken <- fmap reqToken getRequest
  return $ fromMaybe mempty csrfToken

-- | Helper method to pull the Transloadit response and the CSRF token (named @_token@) from the request.
handleTransloadit :: (RenderMessage m FormMessage, YesodJquery m, YesodTransloadit m) => WidgetT m IO (Maybe Text)
handleTransloadit = do
  d <- runInputPost $ TransloaditResponse <$> ireq hiddenField "transloadit"
                                          <*> ireq hiddenField "_token"
  t <- tokenText
  return $ case token d == t of
    True -> return $ raw d
    _ -> Nothing

-- | Helper method to pull the first @ssl_url@ from the Transloadit response.
extractFirstResult :: AsValue s => Text -> Maybe s -> Maybe Value
extractFirstResult = extractNthResult 0

-- | Helper method to pull the nth @ssl_url@ from the Transloadit response.
extractNthResult :: AsValue s => Int -> Text -> Maybe s -> Maybe Value
extractNthResult _ _ Nothing = Nothing
extractNthResult i k (Just uploads) = uploads ^? AL.key "results" . AL.key k . nth i . AL.key "ssl_url"