clarifai (empty) → 0.1.0.0
raw patch · 6 files changed
+432/−0 lines, 6 filesdep +HTTPdep +aesondep +basesetup-changed
Dependencies added: HTTP, aeson, base, bytestring, containers, easy-file, http-client, lens, lens-aeson, scientific, text, unordered-containers, vector, wreq
Files
- LICENSE +21/−0
- Network/Clarifai.hs +211/−0
- Network/Utilities.hs +112/−0
- README.md +2/−0
- Setup.hs +2/−0
- clarifai.cabal +84/−0
+ LICENSE view
@@ -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.
+ Network/Clarifai.hs view
@@ -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
+ Network/Utilities.hs view
@@ -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
+ README.md view
@@ -0,0 +1,2 @@+# clarifai-hs+Haskell API Client for Clarifai.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ clarifai.cabal view
@@ -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