diff --git a/src/Yesod/Transloadit.hs b/src/Yesod/Transloadit.hs --- a/src/Yesod/Transloadit.hs +++ b/src/Yesod/Transloadit.hs @@ -4,6 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} @@ -13,8 +14,16 @@ transloadIt, handleTransloadit, tokenText, - extractFirstResult, - extractNthResult, + nthStepResult, + StepResult, + resultId, + name, + baseName, + extension, + mime, + field, + url, + sslUrl, ParamsResult, ParamsError(..), Key(..), @@ -25,13 +34,14 @@ ) where import Control.Applicative -import Control.Lens.Operators hiding ((.=)) -import Control.Monad (mzero) +import Control.Lens +import Control.Monad 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 qualified Data.HashMap.Strict as HM import Data.Maybe import Data.Monoid import Data.Text @@ -67,6 +77,18 @@ transloaditSecret :: Secret } deriving (Show) +-- | The result of the execution of a single step +data StepResult = StepResult { + _resultId :: Text, + _name :: Text, + _baseName :: Text, + _extension :: Text, + _mime :: Text, + _field :: Text, + _url :: Text, + _sslUrl :: Text +} deriving (Show) + data ParamsError = UnknownError type ParamsResult = Either ParamsError TransloaditParams @@ -84,15 +106,6 @@ 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 @@ -144,15 +157,27 @@ d <- runInputPost $ TransloaditResponse <$> ireq hiddenField "transloadit" <*> ireq hiddenField "_token" t <- tokenText - return $ case token d == t of - True -> return $ raw d - _ -> Nothing + return $ if token d == t then return (raw d) else Nothing --- | Helper method to pull the first @ssl_url@ from the Transloadit response. -extractFirstResult :: AsValue s => Text -> Maybe s -> Maybe Value -extractFirstResult = extractNthResult 0 +_stepResult :: Getter Object (Maybe StepResult) +_stepResult = to parseResult --- | 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" +parseResult :: Object -> Maybe StepResult +parseResult hm = StepResult <$> v "id" + <*> v "name" + <*> v "basename" + <*> v "ext" + <*> v "mime" + <*> v "field" + <*> v "url" + <*> v "ssl_url" + where v s = case HM.lookup s hm of + (Just (String t)) -> Just t + _ -> Nothing + +-- | Helper method to pull the nth @StepResult@ for a given key from the Transloadit response +nthStepResult :: AsValue s => Int -> Text -> Maybe s -> Maybe StepResult +nthStepResult _ _ Nothing = Nothing +nthStepResult i k (Just u) = join $ u ^? AL.key "results" . AL.key k . nth i . _Object . _stepResult + +$(makeLenses ''StepResult) diff --git a/src/Yesod/Transloadit/OrderedJSON.hs b/src/Yesod/Transloadit/OrderedJSON.hs --- a/src/Yesod/Transloadit/OrderedJSON.hs +++ b/src/Yesod/Transloadit/OrderedJSON.hs @@ -7,8 +7,8 @@ str ) where -import Data.Text import Data.Monoid (mconcat) +import Data.Text type KeyValue = (Text, OrderedValue) diff --git a/test/Tests.hs b/test/Tests.hs --- a/test/Tests.hs +++ b/test/Tests.hs @@ -6,6 +6,10 @@ module Main where +import Control.Lens +import Data.Aeson +import Data.Map +import Data.Maybe import Data.Text import Data.Time import System.Locale @@ -55,6 +59,13 @@ |] return () +sampleDict :: Map Text (Map Text [(Map Text Text)]) +sampleDict = fromList [("results", results)] + where results = fromList [("foo", stepResults)] + stepResults = [fromList [("id",""), ("name", "n"), ("basename", "b"), ("ext", "e"), ("mime", "m"), ("field", "f"), ("url", "u"), ("ssl_url", "")]] + +sampleResult = fromJust $ nthStepResult 0 "foo" (return $ encode sampleDict) + formGenSpecs :: Spec formGenSpecs = yesodSpec Test $ do ydescribe "Form generation" $ do @@ -71,8 +82,21 @@ get HomeR bodyContains "" ydescribe "Response parsing" $ do - yit "works" $ do - let sample = Just "{\"results\":{\"foo\":[{\"ssl_url\":\"bar\"}]}}" :: Maybe Text - assertEqual "Basic example" (extractFirstResult "foo" sample) (Just (String "bar")) + yit "grabs ssl_url" $ do + assertEqual "ssl_url" (sampleResult ^. sslUrl) ("" :: Text) + yit "grabs id" $ do + assertEqual "id" (sampleResult ^. resultId) ("" :: Text) + yit "grabs name" $ do + assertEqual "name" (sampleResult ^. name) ("n" :: Text) + yit "grabs basename" $ do + assertEqual "basename" (sampleResult ^. baseName) ("b" :: Text) + yit "grabs extension" $ do + assertEqual "ext" (sampleResult ^. extension) ("e" :: Text) + yit "grabs mime" $ do + assertEqual "mime" (sampleResult ^. mime) ("m" :: Text) + yit "grabs field" $ do + assertEqual "field" (sampleResult ^. field) ("f" :: Text) + yit "grabs url" $ do + assertEqual "url" (sampleResult ^. url) ("u" :: Text) main = hspec formGenSpecs diff --git a/yesod-transloadit.cabal b/yesod-transloadit.cabal --- a/yesod-transloadit.cabal +++ b/yesod-transloadit.cabal @@ -1,5 +1,5 @@ name: yesod-transloadit -version: 0.2.1.0 +version: 0.3.0.0 synopsis: Transloadit support for Yesod description: Drop in Transloadit capabilites for Yesod web apps license: MIT @@ -34,6 +34,7 @@ , lens , shakespeare , lens-aeson + , unordered-containers hs-source-dirs: src default-language: Haskell2010 @@ -52,6 +53,9 @@ yesod-form, time, old-locale, - text + text, + lens, + aeson, + containers default-language: Haskell2010