diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2015 Joe Canero + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/Network/Clarifai.hs b/Network/Clarifai.hs new file mode 100644 --- /dev/null +++ b/Network/Clarifai.hs @@ -0,0 +1,211 @@ +{-| +Module : Network.Clarifai +Description : API Client for the Clarifai API. +Copyright : (c) Joseph Canero, 2015 +License : MIT +Maintainer : caneroj1@tcnj.edu +Stability : experimental +Portability : portable + +Provides functionality for interacting with Clarifai's +Image Tagging API. Users need a Clarifai account to use +this, as the endpoints require an access token. +-} + +{-# LANGUAGE OverloadedStrings #-} + +module Network.Clarifai + ( + Client(..), + TagSet(..), + Info(..), + Tag(..), + verifyImageBatchSize, + verifyVideoBatchSize, + verifyFiles, + authorize, + info, + tag + ) where + +import qualified Control.Exception as E +import Control.Lens +import Data.Aeson +import Data.Aeson.Lens +import qualified Data.ByteString as BL +import qualified Data.ByteString.Char8 as BStrict +import qualified Data.ByteString.Lazy.Char8 as BS +import Data.Either +import Data.List +import qualified Data.Map.Lazy as Map +import qualified Data.Text as T +import qualified Data.Vector as V +import Network.HTTP +import qualified Network.HTTP.Client as Net +import Network.Utilities +import Network.Wreq +import System.EasyFile + +-- | The Client data type has two constructors. The first should be used +-- when constructing a client with an access token. The second constructor +-- should be used when passing in an application's client id and client secret. +data Client = Client String | App String String deriving (Show) + +-- Turn our authorized Client into an Authorization header +authHeader :: Client -> Options +authHeader (Client token) = defaults' & header "Authorization" .~ [packed] + where auth = "Bearer " ++ token + packed = BStrict.pack auth +authHeader _ = defaults + +-- | The Info data type is used as a response from the +-- /info endpoint. This type contains information about the +-- various usage limits for the API. +data Info = Info { + maxBatchSize :: Integer, + maxImageSize :: Integer, + minImageSize :: Integer, + maxImageBytes :: Integer, + maxVideoBatchSize :: Integer, + maxVideoSize :: Integer, + minVideoSize :: Integer, + maxVideoBytes :: Integer, + maxVideoDuration :: Integer +} deriving (Show) + +-- Convert a Map of Strings and Values into an Info type +toInfo :: Obj -> Info +toInfo origObj = Info mbs maxis minis maxib mvbs maxvs minvs mvb mvd + where obj = getMap "results" origObj + mbs = getInt' "max_batch_size" obj + maxis = getInt' "max_image_size" obj + minis = getInt' "min_image_size" obj + maxib = getInt' "max_image_bytes" obj + mvbs = getInt' "max_video_batch_size" obj + maxvs = getInt' "max_video_size" obj + minvs = getInt' "min_video_size" obj + mvb = getInt' "max_video_bytes" obj + mvd = getInt' "max_video_duration" obj + +-- | A Tag is a pair of String and Double and represents a word class +-- from the Clarifai model and the associated probability. +data Tag = Tag String Double deriving (Show) + +-- | A TagSet represents a single result from the Tag endpoint. +-- Each result has a unique docid, but they can also have local IDs +-- if those are provided. They also have words and probabilities. +data TagSet = TagSet { + docID :: Integer, + localID :: String, + tags :: V.Vector Tag +} deriving (Show) + +getTags :: HObj -> V.Vector Tag +getTags o = V.map (uncurry Tag) (V.zip classes probs) + where classes = V.map value2String (getVec' "classes" o) + probs = V.map value2Double (getVec' "probs" o) + +objToTagSet :: HObj -> TagSet +objToTagSet o = TagSet docID localID tags + where docID = getInt' "docid" o + localID = getString' "local_id" o + tags = getTags (getMap' "tag" $ getMap' "result" o) + +-------------------- +---- API Routes ---- +-------------------- +-- For authentication +tokenUrl = "https://api.clarifai.com/v1/token/" +-- For API info +infoUrl = "https://api.clarifai.com/v1/info/" +-- Tag images/videos +tagUrl = "https://api.clarifai.com/v1/tag/" + +-- | Authorize an application +-- Sends a POST request to Clarifai's authentication endpoint. +-- If we have a Client, we just return the client because I'm assuming +-- the client was constructed with a valid access token. If we have an App, +-- we would POST the client ID and client secret to Clarifai to get an +-- access token. +authorize :: Client -> IO (Either Errors Client) +authorize (Client token) = return (Right (Client token)) +authorize (App clientID clientSecret) = resp + where params = ["client_id" := clientID, + "client_secret" := clientSecret, + "grant_type" := BS.pack "client_credentials"] + key = "access_token" + resp = do (status, body) <- processRequest $ postWith' tokenUrl params + let code = status ^. statusCode in + if code /= 200 then + return (Left (code, apiErr code body)) + else + return (Right (Client $ getString key body)) + +-- | Gets the Clarifai API limits and information. +-- Sends a get request to the /info endpoint and encapsulates +-- the results into an Info type. +info :: Client -> IO (Either Errors Info) +info (App _ _) = return (Left (0, "You have not authorized your app yet.")) +info client = resp + where opts = authHeader client + resp = do (status, body) <- processRequest $ getWith opts infoUrl + let code = status ^. statusCode in + if code /= 200 then + return (Left (code, apiErr code body)) + else + return (Right (toInfo body)) + +-- TODO: support localIDs +-- TODO: use partFileSource? +-- | Utilizes the tag endpoint of the clarifai API to tag +-- multiple files from the local file system. +tag :: Client -> [FilePath] -> IO (Either Errors (V.Vector TagSet)) +tag (App _ _) _ = return (Left (0, "You have not authorized your app yet.")) +tag c fs = resp + where opts = authHeader c + toParts = partFile "encoded_data" + files = map toParts fs + resp = do (status, body) <- processRequest $ postWith opts tagUrl files + let extractedVec = vecOfObjects $ getVec "results" body + let code = status ^. statusCode in + if code /= 200 then + return (Left (code, apiErr code body)) + else + return (Right (V.map objToTagSet extractedVec)) + where + +vecOfObjects :: V.Vector Value -> V.Vector HObj +vecOfObjects = V.map value2Map + +-- | Given an API Info type and a list of FilePaths, we verify each of the files. +-- If the file has an extension, we decide which Info attribute to use +-- to verify the file. If it has no extension, we choose not to verify. This +-- function maps each FilePath to a tuple of (FilePath, VerificationStatus), +-- where VerificationStatus = Good | Bad | Unknown +verifyFiles :: Info -> [FilePath] -> IO [(FilePath, IO VerificationStatus)] +verifyFiles info fs = do + let zipped = zip fs (map getFileSize fs) + return (map (verify info) zipped) + where verify (Info _ _ _ ib _ _ _ _ vb) (path, ioSize) + | ext `elem` imageExtensions = (path, fmap imgC ioSize) + | ext `elem` videoExtensions = (path, fmap vidC ioSize) + | otherwise = (path, return Unknown) + where ext = takeExtension path + vidC = fileCheck vb + imgC = fileCheck ib + +-- | Given an API Info type and a list of FilePaths, we verify +-- the length of the list with what the Info type specifies is +-- acceptable batch size for images. This function assumes that +-- the FilePaths all point to images. +verifyImageBatchSize :: Info -> [FilePath] -> Bool +verifyImageBatchSize (Info size _ _ _ _ _ _ _ _) xs = size >= conv + where conv = fromIntegral (length xs) :: Integer + +-- | Given an API Info type and a list of FilePaths, we verify +-- the length of the list with what the Info type specifies is +-- acceptable batch size for videos. This function assumes that +-- the FilePaths all point to videos. +verifyVideoBatchSize :: Info -> [FilePath] -> Bool +verifyVideoBatchSize (Info _ _ _ _ size _ _ _ _) xs = size >= conv + where conv = fromIntegral (length xs) :: Integer diff --git a/Network/Utilities.hs b/Network/Utilities.hs new file mode 100644 --- /dev/null +++ b/Network/Utilities.hs @@ -0,0 +1,112 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Network.Utilities where + +import Control.Lens +import Data.Aeson +import Data.Aeson.Lens +import qualified Data.ByteString.Lazy.Char8 as BS +import qualified Data.HashMap.Lazy as Hash +import qualified Data.Map.Lazy as Map +import Data.Maybe +import Data.Scientific +import qualified Data.Text as T +import qualified Data.Vector as V +import Data.Word +import Network.Wreq + +type Resp = Response BS.ByteString +type Obj = Map.Map String Value +type HObj = Hash.HashMap T.Text Value +type JSON = Response Obj +type Errors = (Int, String) + +-- Enum type for verifying FilePaths before sending to the API. +data VerificationStatus = Good | Bad | Unknown + +-- Process the results of a request into JSON +-- Returns an IO Tuple of the status and response body. +processRequest :: IO Resp -> IO (Status, Obj) +processRequest response = do r <- asJSON =<< response :: IO JSON + return (r ^. responseStatus, r ^. responseBody) + +-- Parses status code errors for api endpoints +apiErr :: Int -> Obj -> String +apiErr code body + | code == 401 = getString "status_msg" body + | code == 400 = ret $ Map.lookup "status_msg" body + where ret val + | isNothing val = getString "status_msg" body + | otherwise = value2String $ fromJust val + +-- Gets a value that we know exists from a map +definite :: String -> Obj -> Value +definite k m = fromJust $ Map.lookup k m + +-- Gets a value that we know exists from a hash map +definite' :: String -> HObj -> Value +definite' k m = fromJust $ Hash.lookup (T.pack k) m + +-- Convert an Aeson value into a String +value2String :: Value -> String +value2String (String xs) = T.unpack xs +value2String _ = "" + +-- Convert an Aeson value into an Integer +value2Int :: Value -> Integer +value2Int (Number x) = coefficient x +value2Int _ = 0 + +-- Convert an Aeson value into a Double +value2Double :: Value -> Double +value2Double (Number x) = toRealFloat x :: Double +value2Double _ = 0 + +-- Convert an Aeson value into a hash map +value2Map :: Value -> HObj +value2Map (Object o) = o +value2Map _ = Hash.empty + +-- Convert an Aeson value into a Vector +value2Vector :: Value -> V.Vector Value +value2Vector (Array a) = a +value2Vector _ = V.empty + +-- Composes the definite and value2* functions into +-- a single function that gets and converts from a map. +-- Data.Map +getInt key = value2Int . definite key +getString key = value2String . definite key +getMap key = value2Map . definite key +getVec key = value2Vector . definite key + +-- Data.HashMap +getInt' key = value2Int . definite' key +getString' key = value2String . definite' key +getMap' key = value2Map . definite' key +getVec' key = value2Vector . definite' key + +-- custom postWith that overrides default checkStatus functionality. +-- no longer returns an error on non-2** status codes. +postWith' :: (String -> [FormParam] -> IO (Response BS.ByteString) ) +postWith' = postWith defaults' + +defaults' = set checkStatus (Just $ \_ _ _ -> Nothing) defaults + +-- List of extensions for videos. If a file has one of these extensions +-- we use the video Info from the API to verify the file. +videoExtensions = [".mov", ".webm", ".ogv", ".ogg", ".wmv", ".mp4", + ".m4p", ".qt", ".mpg", ".mp2", ".mpeg", ".mpe"] + +-- List of extensions for images. If a file has one of these extensions +-- we use the image Info from the API to verify the file. +imageExtensions = [".png", ".jpeg", ".jpg", ".gif", ".bmp"] + +-- Checks that a given file size is within the bounds specified by +-- the (min, max) tuple. +fileCheck :: Integer -> Word64 -> VerificationStatus +fileCheck maxSize size = + if conv <= maxSize + then Good + else Bad + where conv = fromIntegral size :: Integer diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,2 @@ +# clarifai-hs +Haskell API Client for Clarifai. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/clarifai.cabal b/clarifai.cabal new file mode 100644 --- /dev/null +++ b/clarifai.cabal @@ -0,0 +1,84 @@ +-- Initial clarifai.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +-- The name of the package. +name: clarifai + +-- The package version. See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented. +-- http://www.haskell.org/haskellwiki/Package_versioning_policy +-- PVP summary: +-+------- breaking API changes +-- | | +----- non-breaking API additions +-- | | | +--- code changes with no API change +version: 0.1.0.0 + +-- A short (one-line) description of the package. +synopsis: API Client for the Clarifai API. + +-- A longer description of the package. +description: Provides functionality for interacting with Clarifai's + Image Tagging API. Users need a Clarifai account to use + this, as the endpoints require an access token. + +-- The license under which the package is released. +license: MIT + +-- The file containing the license text. +license-file: LICENSE + +-- The package author(s). +author: Joseph Canero + +-- An email address to which users can send suggestions, bug reports, and +-- patches. +maintainer: caneroj1@tcnj.edu + +-- A copyright notice. +-- copyright: + +category: Network + +build-type: Simple + +-- Extra files to be distributed with the package, such as examples or a +-- README. +extra-source-files: README.md Network/Utilities.hs + +-- Constraint on the version of Cabal needed to build this package. +cabal-version: >=1.10 + +source-repository head + type: git + location: https://github.com/caneroj1/clarifai-hs + +library + -- Modules exported by the library. + exposed-modules: Network.Clarifai + + -- Modules included in this library but not exported. + -- other-modules: + + -- LANGUAGE extensions used by modules in this package. + other-extensions: OverloadedStrings +-- README + -- Other library packages from which modules are imported. + build-depends: base >=4.8 && <4.9, + wreq >= 0.4.1.0, + lens >= 4.13, + aeson, + lens-aeson >= 1.0.0.5, + bytestring >= 0.10.6.0, + containers >= 0.5.6.2, + text >= 1.2.1.3, + http-client >= 0.4.26.2, + scientific >= 0.3.3.8, + unordered-containers >= 0.2.5.1, + HTTP >= 4000.2.22, + easy-file >= 0.2.1, + vector >= 0.11.0.0 + + -- Directories containing source files. + -- hs-source-dirs: + + -- Base language which the package is written in. + default-language: Haskell2010