diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2015, Adrian Dawid + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Adrian Dawid nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/OrchestrateDB.cabal b/OrchestrateDB.cabal new file mode 100644 --- /dev/null +++ b/OrchestrateDB.cabal @@ -0,0 +1,88 @@ +-- Initial OrchestrateDB.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +-- The name of the package. +name: OrchestrateDB + +-- 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: 1.0.0.0 + +-- A short (one-line) description of the package. +synopsis: Unofficial Haskell Client Library for the Orchestrate.io API + +-- A longer description of the package. +description: An implementation of most of the functions of the Orchestrate.io REST API in Haskell. + To get started, see the documentation for the Orchestrate and Orchestrate.REST module below. + Because this module does use 'Data.Aeson' for parsing and encoding JSON you might want to take a look at it's docs too. + For some working examples check out the "examples/Test.hs" file and the documentation. + +-- The license under which the package is released. +license: BSD3 + +-- The file containing the license text. +license-file: LICENSE + +-- The package author(s). +author: Adrian Dawid + +-- An email address to which users can send suggestions, bug reports, and +-- patches. +maintainer: adriandwd@gmail.com + +-- A copyright notice. +copyright: Copyright (c) 2015, Adrian Dawid + +category: Database +homepage: https://github.com/dwd31415/Haskell-OrchestrateDB +bug-reports: https://github.com/dwd31415/Haskell-OrchestrateDB/issues +build-type: Simple + +-- Extra files to be distributed with the package, such as examples or a +-- README. +extra-source-files: README.md + +-- Constraint on the version of Cabal needed to build this package. +cabal-version: >=1.10 + + +library + -- Modules exported by the library. + exposed-modules: Orchestrate + + -- Modules included in this library but not exported. + other-modules: Orchestrate.REST, Orchestrate.Types + + -- LANGUAGE extensions used by modules in this package. + -- other-extensions: + + -- Other library packages from which modules are imported. + build-depends: base >=4.7 && <4.8, HTTP >= 4000, http-conduit >= 2.1, http-types >= 0.8, bytestring >= 0.10 + ,lifted-base >= 0.2, aeson + + -- Directories containing source files. + hs-source-dirs: src + + -- Base language which the package is written in. + default-language: Haskell2010 + +Test-Suite tests-example1 + type: exitcode-stdio-1.0 + main-is: Test.hs + hs-source-dirs: src,examples + default-language: Haskell2010 + build-depends: base >=4.4 && <4.8, HTTP >= 4000, http-conduit >= 2.1, http-types >= 0.8, bytestring >= 0.10 + ,lifted-base >= 0.2, aeson, random + + +Test-Suite test-sherlock + type: exitcode-stdio-1.0 + main-is: Test2.hs + hs-source-dirs: src,examples + default-language: Haskell2010 + build-depends: base >=4.4 && <4.8, HTTP >= 4000, http-conduit >= 2.1, http-types >= 0.8, bytestring >= 0.10 + ,lifted-base >= 0.2, aeson, random diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,22 @@ +# Haskell-OrchestrateDB [![Build Status](https://travis-ci.org/dwd31415/Haskell-OrchestrateDB.svg?branch=master)](https://travis-ci.org/dwd31415/Haskell-OrchestrateDB) +Unofficial Haskell Client Library for the Orchestrate.io API + +# How to install this package? + +The most convenient way of installing this package is via Hackage, just click on the Hackage badge to get to the project's hackage site. +Alternatively, you could also just clone this repository and run the +``` +cabal install +``` +command in it. + +# Where to find the documentation? + +Haddock docs can be found on the hackage project site, but if you want to, you can also build them on your local machine by running +``` + cabal haddock --html +``` + +# Tests? + +Some tests are run automatically after each commit over the Travis-CI service. If the Travis-CI badge says "build passing" everything should be fine. 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/examples/Test.hs b/examples/Test.hs new file mode 100644 --- /dev/null +++ b/examples/Test.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} + +module Main where + +import Control.Monad +import Data.Aeson +import Data.Aeson.Types +import Data.Maybe +import GHC.Generics +import qualified Orchestrate as DB +import System.Exit (exitFailure) +import System.Random + +data TestRecord = TestRecord + { string :: String + , number :: Int + } deriving (Show,Read,Generic,Eq) + +instance FromJSON TestRecord +instance ToJSON TestRecord + +reachTest :: Integer -> IO () +reachTest number = do + putStrLn $ "Completed test number " ++ show number + +main :: IO () +main = do + configTxt <- readFile "examples/config.txt" + randomNumber <- randomIO :: IO Integer + let config = read configTxt :: (String,String) + let dbApplication = DB.createStdApplication "TestApp" (fst config) + let dbCollection = DB.createStdCollection (snd config) + let testRecord1 = TestRecord {string = "You may delay, but time will not.(Benjamin Franklin)",number = 903} + let testRecord2 = TestRecord {string = "Two things are infinite: the universe and human stupidity; and I am not sure about the universe.(Albert Einstein)",number = 913} + res1 <- DB.validateApplication dbApplication + unless res1 exitFailure + reachTest 1 + let testKey = "hello-world" ++ show randomNumber + res2 <- DB.orchestrateCollectionPut dbApplication dbCollection testKey testRecord1 + unless res2 exitFailure + reachTest 2 + res3 <- DB.orchestrateCollectionPut dbApplication dbCollection "irrelevant" testRecord1 + unless res3 exitFailure + reachTest 3 + res4 <- DB.orchestrateCollectionPutWithoutKey dbApplication dbCollection testRecord2 + unless res4 exitFailure + reachTest 4 + shouldBeTestRecord1Maybe <- DB.orchestrateCollectionGet dbApplication dbCollection testKey :: IO (Maybe TestRecord) + let shouldBeTestRecord1 = fromJust shouldBeTestRecord1Maybe + unless (shouldBeTestRecord1 == testRecord1) exitFailure + reachTest 5 + res5 <- DB.orchestrateCollectionDeleteKey dbApplication dbCollection "irrelevant" + unless res5 exitFailure + reachTest 6 + res6Maybe <- DB.orchestrateCollectionSearch dbApplication dbCollection "You may delay," + let (res6,hasNextPage) = fromJust res6Maybe + unless (checkIfResSixIsCorrect res6) exitFailure + reachTest 7 + res7Maybe <- DB.orchestrateCollectionList dbApplication dbCollection 100 + let res7 = fromJust res7Maybe + unless (res7 /= []) exitFailure + reachTest 8 + +checkIfResSixIsCorrect :: [Object] -> Bool +checkIfResSixIsCorrect (first:rest) = do + let num = flip parseMaybe first $ \obj -> obj .: "number" :: Parser Int + isJust num && + (if fromJust num == 903 then checkIfResSixIsCorrect rest else + False) + +checkIfResSixIsCorrect [] = True diff --git a/examples/Test2.hs b/examples/Test2.hs new file mode 100644 --- /dev/null +++ b/examples/Test2.hs @@ -0,0 +1,41 @@ + {-# LANGUAGE DeriveGeneric #-} +module Main where + +import GHC.Generics +import Data.Aeson +import qualified Orchestrate as DB + +data SherlockHolmesCase = SherlockHolmesCase { + title :: String, + typeOfCrime :: String, + shortStory :: Bool, + index :: Integer, + solved :: Bool +} deriving (Show,Read,Generic,Eq) + + {-This automatically creates both a JSON parser and a JSON encoder based on the data type SherlockHolmesCase, if you however +want the property names in JSON and haskell to differ, you will have to write your own parser and you own encoder. + Please check out the 'Data.Aeson' documentation for information on how to do that. -} +instance FromJSON SherlockHolmesCase +instance ToJSON SherlockHolmesCase + +main :: IO () +main = do + configTxt <- readFile "examples/config.txt" + let config = read configTxt :: (String,String) + -- Create an application record. Oh, BTW, in case you planned to store your api-key in the source code, it is a very very bad idea. + let dbApplcation = DB.createStdApplication "your.orchestrate.application.name " (fst config) + -- Create an collection record. This collection does not have to exist, if it does not, it will be created as soon as you try to store something in it. + let dbCollection = DB.createStdCollection "TheCasebookOfSherlockHolmes " + let aStudyInScarlet = SherlockHolmesCase { + title = "A Study in Scarlet ", + typeOfCrime = "Murder ", + shortStory = False, + index = 0, + solved = True + } + -- Store a haskell value in the collection we created earlier. The "withOutKey " lets the server generate the key, so no key must be specified. + didItWork <- DB.orchestrateCollectionPutWithoutKey dbApplcation dbCollection aStudyInScarlet + if didItWork + then putStrLn "Invictus maneo!" + else putStrLn "Something is rotten in the state of Denmark!" diff --git a/src/Orchestrate.hs b/src/Orchestrate.hs new file mode 100644 --- /dev/null +++ b/src/Orchestrate.hs @@ -0,0 +1,151 @@ +{-| +Module : Orchestrate +Copyright : (c) Adrian Dawid 2015 +License : BSD3 +Maintainer : adriandwd@gmail.com +Stability : stable + +This library implements most parts of the Orchestrate.io API in Haskell. It provides a convenient way of accessing these parts of the REST API: + + * Validate API Keys + + * List Key/Values + + * Create Key/Value + + * Create Key/Value with server-generated key + + * Update Key/Value + + * Retrieve Value for Key + + * Delete Collection(s) + + * Query Collection + +NOTE: You can also use 'Network.Curl', if you need one of the currently unsupported API functions, but you would have to parse all response bodies yourself if you do that. + +=How to use this library? +Using this library is pretty straightforward, just import the Orchestrate module like this: + +@ +import qualified Orchestrate as DB +@ + +Once you have it, you can use all the supported API functions(Check out the documentation on 'Orchestrate.REST' for detailed information). +One important thing you need to remeber when working with this library is, that it uses 'Data.Aeson' under the hood, so if you want to +store your Haskell types in an Orchestrate database, 'Data.Aseon' must know how convert them into JSON. The best way to achive that, is +to use the 'DeriveGeneric' Langauge extension. + +Here is an example of how to store a haskell value in an Orchestrate Collection: + +@ +\{\-\# LANGUAGE DeriveGeneric \#\-\} +module Main where + +import GHC.Generics +import Data.Aeson +import qualified Orchestrate as DB + +data SherlockHolmesCase = SherlockHolmesCase { + title :: String, + typeOfCrime :: String, + shortStory :: Bool, + index :: Integer, + solved :: Bool +} deriving (Show,Read,Generic,Eq) + +\{\-This automatically creates both a JSON parser and a JSON encoder based on the data type SherlockHolmesCase, if you however +want the property names in JSON and haskell to differ, you will have to write your own parser and you own encoder. + Please check out the 'Data.Aeson' documentation for information on how to do that.\-\} +instance FromJSON SherlockHolmesCase +instance ToJSON SherlockHolmesCase + +main :: IO () +main = do + -- Create an application record. Oh, BTW, in case you planned to store your api-key in the source code, it is a very very bad idea. + let dbApplcation = DB.createStdApplication \"your.orchestrate.application.name\" \"one-of-your-api-keys\" + -- Create an collection record. This collection does not have to exist, if it does not, it will be created as soon as you try to store something in it. + let dbCollection = DB.createStdCollection \"TheCasebookOfSherlockHolmes\" + let aStudyInScarlet = SherlockHolmesCase { + title = \"A Study in Scarlet\", + typeOfCrime = \"Murder\", + shortStory = False, + index = 0, + solved = True + } + -- Store a haskell value in the collection we created earlier. The \"withOutKey\" lets the server generate the key, so no key must be specified. + didItWork <- DB.orchestrateCollectionPutWithoutKey dbApplcation dbCollection aStudyInScarlet + if didItWork + then putStrLn "Invictus maneo!" + else putStrLn "Something is rotten in the state of Denmark!" +@ + +If this application does say \"Invictus maneo!\", you should get this result if you LIST the \"TheCasebookOfSherlockHolmes\" collection: + +@ +"count" : 1, + "results" : [ { + "path" : { + "collection" : "TheCasebookOfSherlockHolmes ", + "kind" : "item", + "key" : "0b8b506cf0204ce9", + "ref" : "--------------", + "reftime" : -------------- + }, + "value" : { + "solved" : true, + "shortStory" : false, + "title" : "A Study in Scarlet ", + "index" : 0, + "typeOfCrime" : "Murder " + }, + "reftime" : -------------- + } ] +@ + +If you don't get that result, you either have run the example more than once, it did not return "Invictus maneo", or something really strange is going on. +If you are fairly certain, that something strange is going on, and it is most likely my fault and you might want to open an issue at github. + +=How to use the "cabal test" command +Testing applications which depend on some REST api is not easy, and therfore the cabal tests will fail by default. They just will not be able to authenticate, if you +want to run the tests on your local machine, please create a file called "examples/config.txt" and fill it according to this scheme: + +@ +("a valid api key","something funny(it will be used as a name for the test collection)") +@ + +If you are asking yourself now, if there really is no way of checking that this library works, before installing it, there is nothing to worry about. +You should consult the travis-ci server() on the state of the project, it does not only check wether or not ther library can be built, but also runs the tests with an valid api key. +-} +module Orchestrate(Orchestrate.Types.OrchestrateCollection(..), + Orchestrate.Types.OrchestrateApplication(..), + Orchestrate.REST.validateApplication, + Orchestrate.REST.orchestrateCollectionGet, + Orchestrate.REST.orchestrateCollectionPut, + Orchestrate.REST.orchestrateCollectionPutWithoutKey, + Orchestrate.REST.orchestrateCollectionDelete, + Orchestrate.REST.orchestrateCollectionDeleteKey, + Orchestrate.REST.orchestrateCollectionSearch, + Orchestrate.REST.orchestrateCollectionSearchWithOffset, + Orchestrate.REST.orchestrateCollectionList, + createStdCollection, + createStdApplication) where + +import qualified Orchestrate.REST +import qualified Orchestrate.Types + +createStdApplication :: String -> String -> Orchestrate.Types.OrchestrateApplication +-- ^Creates an application record with the std.(\"https://api.orchestrate.io/v0\") enpoint. +createStdApplication name api_key = + Orchestrate.Types.OrchestrateApplication { + Orchestrate.Types.applicationName = name, + Orchestrate.Types.apiKey = api_key, + Orchestrate.Types.httpsEndpoint = "https://api.orchestrate.io/v0" + } + +createStdCollection :: String -> Orchestrate.Types.OrchestrateCollection +-- ^Creates an collection record. +createStdCollection name = Orchestrate.Types.OrchestrateCollection { + Orchestrate.Types.collectionName = name +} diff --git a/src/Orchestrate/REST.hs b/src/Orchestrate/REST.hs new file mode 100644 --- /dev/null +++ b/src/Orchestrate/REST.hs @@ -0,0 +1,386 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +{-| +Module : Orchestrate.REST +Description : All functions which interact with the Orchestrate.io REST API. +Copyright : (c) Adrian Dawid 2015 +License : BSD3 +Maintainer : adriandwd@gmail.com +Stability : stable + +This module conatins all the functions which interact with the Orchestrate.io REST API. +Right now these actions are supported: + + * Validate API Keys + + * List Key/Values + + * Create Key/Value + + * Create Key/Value with server-generated key + + * Update Key/Value + + * Retrieve Value for Key + + * Delete Collection(s) + + * Query Collection + +-} +module Orchestrate.REST + ( + validateApplication, + orchestrateCollectionPutWithoutKey, + orchestrateCollectionDelete, + orchestrateCollectionGet, + orchestrateCollectionPut, + orchestrateCollectionDeleteKey, + orchestrateCollectionSearch, + orchestrateCollectionSearchWithOffset, + orchestrateCollectionList + ) where + +import Network.HTTP.Conduit +import Network.HTTP.Types.Status + +import qualified Control.Exception.Lifted as X +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Lazy as BSLazy + +import Data.Aeson +import Data.Aeson.Types +import Data.Maybe +import Orchestrate.Types + +validateApplication :: OrchestrateApplication -> IO Bool +-- ^The 'validateApplication' function validates your API key, +-- by making an authenticated HEAD request to the endpoint specified in the 'OrchestrateApplication' record. +-- The function returns False when the key is invalid or no connection with the endpoint could be established. +validateApplication application = do + let api_key = apiKey application + if api_key == "" + then return False + else do + let url = httpsEndpoint application + case parseUrl url of + Nothing -> return False + Just unsecuredRequest -> withManager $ \manager -> do + let request = applyBasicAuth (B.pack $ apiKey application) "" unsecuredRequest + let reqHead = request { + method = "HEAD", + secure = True } + resOrException <- X.try (http reqHead manager) + case resOrException of + Right res -> if responseStatus res == ok200 + then return True + else return False + Left (_::X.SomeException) -> return False + +orchestrateCollectionList :: OrchestrateApplication -> OrchestrateCollection -> Integer -> IO (Maybe [Object]) +-- ^ The 'orchestrateCollectionList' function lists the contents of the specified collection, by making GET request to the \/$collection?limit=$limit endpoint. +-- For more information check out the Orchestrate.io API docs: . +-- If connecting to the api fails, or the api key stored in the application record is invlaid, 'Nothing' is returned. +-- Otherwise an array of the type 'Object'(see the documentation of 'Data.Aeson' for more information) is returned, it +-- contains the values from the HTTP response(see for an example of how the response looks like in JSON). +-- +-- = Example: +-- @ +-- let dbApplication = DB.createStdApplication \"APPLICATION_NAME\" \"API_KEY\" +-- let dbCollection = DB.createStdCollection \"COLLECTION_NAME\" +-- dbContents <- DB.orchestrateCollectionList dbApplication dbCollection 10 +-- @ +orchestrateCollectionList application collection limit = do + let api_key = apiKey application + if api_key == "" + then return Nothing + else do + let url = httpsEndpoint application ++ "/" ++ collectionName collection ++ "?limit=" ++ show limit + case parseUrl url of + Nothing -> return Nothing + Just unsecuredRequest -> withManager $ \manager -> do + let request = unsecuredRequest { + method = "GET", + secure = True } + let reqHead = applyBasicAuth (B.pack $ apiKey application) "" request + resOrException <- X.try (httpLbs reqHead manager) + case resOrException of + Right res -> if responseStatus res == ok200 + then do + let resBody = responseBody res + let results = fromMaybe [] (parseListResponseBody resBody) + return $ Just results + + else return Nothing + Left (_::X.SomeException) -> return Nothing + +-- KEY/VALUE + +orchestrateCollectionPutWithoutKey :: ToJSON obj => OrchestrateApplication -> OrchestrateCollection -> obj -> IO Bool +-- ^ The 'orchestrateCollectionPutWithoutKey' function stores a Haskell value(with a 'ToJSON' instance) in an Orchestrate.io database. +-- It does so by making a POST request to the \/$collection endpoint(Offical API docs:). +-- This function does not need a user specified key, because it uses a server-generated key, if you want to know the key +-- use 'orchestrateCollectionPut' instead of this function. +-- +-- = Example: +-- @ +-- data TestRecord = TestRecord +-- { string :: String +-- , number :: Int +-- } deriving (Show,Read,Generic,Eq) +-- +-- instance FromJSON TestRecord +-- instance ToJSON TestRecord +-- +-- let dbApplication = DB.createStdApplication \"APPLICATION_NAME\" \"API_KEY\" +-- let dbCollection = DB.createStdCollection \"COLLECTION_NAME\" +-- let testRecord = TestRecord {string = "You may delay, but time will not!",number = 903} +-- _ <- DB.orchestrateCollectionPutWithoutKey dbApplication dbCollection testRecord +-- @ +orchestrateCollectionPutWithoutKey application collection object = do + let objAsJson = encode object + let api_key = apiKey application + if api_key == "" + then return False + else do + let url = httpsEndpoint application ++ "/" ++ collectionName collection + case parseUrl url of + Nothing -> return False + Just unsecuredRequest -> withManager $ \manager -> do + let request = unsecuredRequest { + method = "POST", + secure = True, + requestHeaders = [("Content-Type", "application/json")], + requestBody = RequestBodyBS $ BSLazy.toStrict objAsJson } + let reqHead = applyBasicAuth (B.pack $ apiKey application) "" request + resOrException <- X.try (http reqHead manager) + case resOrException of + Right res -> if responseStatus res == status201 + then return True + else return False + Left (_::X.SomeException) -> return False + +orchestrateCollectionPut :: ToJSON obj => OrchestrateApplication -> OrchestrateCollection -> String -> obj -> IO Bool +-- ^ The 'orchestrateCollectionPut' function stores a Haskell value(with a 'ToJSON' instance) in an Orchestrate.io database. +-- It does so by making a PUT request to the \/$collection\/$key endpoint(Offical API docs:). +-- In order to upload a Haskell Value to the database, it must have an instance of 'ToJSON' because this +-- client library uses 'Data.Aeson' to convert Haskel Values to JSON, which is required by Orchestrate.io. +-- +-- = Example: +-- @ +-- data TestRecord = TestRecord +-- { string :: String +-- , number :: Int +-- } deriving (Show,Read,Generic,Eq) +-- +-- instance FromJSON TestRecord +-- instance ToJSON TestRecord +-- +-- let dbApplication = DB.createStdApplication \"APPLICATION_NAME\" \"API_KEY\" +-- let dbCollection = DB.createStdCollection \"COLLECTION_NAME\" +-- let testRecord = TestRecord {string = "You may delay, but time will not!",number = 903} +-- _ <- DB.orchestrateCollectionPutWithoutKey dbApplication dbCollection "KEY" testRecord +-- @ +orchestrateCollectionPut application collection key object = do + let objAsJson = encode object + let api_key = apiKey application + if api_key == "" + then return False + else do + let url = httpsEndpoint application ++ "/" ++ collectionName collection ++ "/" ++ key + case parseUrl url of + Nothing -> return False + Just unsecuredRequest -> withManager $ \manager -> do + let request = unsecuredRequest { + method = "PUT", + secure = True, + requestHeaders = [("Content-Type", "application/json")], + requestBody = RequestBodyBS $ BSLazy.toStrict objAsJson } + let reqHead = applyBasicAuth (B.pack $ apiKey application) "" request + resOrException <- X.try (http reqHead manager) + case resOrException of + Right res -> if responseStatus res == status201 + then return True + else return False + Left (_::X.SomeException) -> return False + +orchestrateCollectionGet :: FromJSON res => OrchestrateApplication -> OrchestrateCollection -> String -> IO (Maybe res) +-- ^ The 'orchestrateCollectionGet' function request a value from an Orchestrate.io database, and tries to convert it to the specified Haskell type, +-- if either gettings the value from the database or converting it to the Haskell type fails 'Nothing' is returned. +-- The value is requested by making a GET request to the \/$collection\/$key endpoint(Offical documentation:) +-- +-- = Example: +-- @ +-- data TestRecord = TestRecord +-- { string :: String +-- , number :: Int +-- } deriving (Show,Read,Generic,Eq) +-- +-- instance FromJSON TestRecord +-- instance ToJSON TestRecord +-- +-- let dbApplication = DB.createStdApplication \"APPLICATION_NAME\" \"API_KEY\" +-- let dbCollection = DB.createStdCollection \"COLLECTION_NAME\" +-- let testRecord = TestRecord {string = "You may delay, but time will not!",number = 903} +-- dbValue <- DB.orchestrateCollectionGet dbApplication dbCollection "KEY" :: IO (Maybe TestRecord) +-- @ +orchestrateCollectionGet application collection key = do + let api_key = apiKey application + if api_key == "" + then return Nothing + else do + let url = httpsEndpoint application ++ "/" ++ collectionName collection ++ "/" ++ key + case parseUrl url of + Nothing -> return Nothing + Just unsecuredRequest -> withManager $ \manager -> do + let request = unsecuredRequest { + method = "GET", + secure = True } + let reqHead = applyBasicAuth (B.pack $ apiKey application) "" request + resOrException <- X.try (httpLbs reqHead manager) + case resOrException of + Right res -> if responseStatus res == ok200 + then do + let resBody = responseBody res + let jsonObject = decode resBody + return jsonObject + else return Nothing + Left (_::X.SomeException) -> return Nothing + +orchestrateCollectionDeleteKey :: OrchestrateApplication -> OrchestrateCollection -> String -> IO Bool +-- ^ The 'orchestrateCollectionDeleteKey' function deletes a value from an Orchestrate.io database. +-- This is done by making a DELETE request to the \/$collection\/$key endpoint(Offical documentation:) +-- +-- = Example: +-- @ +-- data TestRecord = TestRecord +-- { string :: String +-- , number :: Int +-- } deriving (Show,Read,Generic,Eq) +-- +-- instance FromJSON TestRecord +-- instance ToJSON TestRecord +-- +-- let dbApplication = DB.createStdApplication \"APPLICATION_NAME\" \"API_KEY\" +-- let dbCollection = DB.createStdCollection \"COLLECTION_NAME\" +-- _ <- DB.orchestrateCollectionKey dbApplication dbCollection "KEY" +-- @ +orchestrateCollectionDeleteKey application collection key = do + let api_key = apiKey application + if api_key == "" + then return False + else do + let url = httpsEndpoint application ++ "/" ++ collectionName collection ++ "/" ++ key ++ "?force=true" + case parseUrl url of + Nothing -> return False + Just unsecuredRequest -> withManager $ \manager -> do + let request = unsecuredRequest { + method = "DELETE", + secure = True } + let reqHead = applyBasicAuth (B.pack $ apiKey application) "" request + resOrException <- X.try (http reqHead manager) + case resOrException of + Right res -> if responseStatus res == status204 + then return True + else return False + Left (_::X.SomeException) -> return False + +orchestrateCollectionDelete :: OrchestrateApplication -> OrchestrateCollection -> IO Bool +-- ^ The 'orchestrateCollectionDelete' function deletes a collection from an Orchestrate.io application. +-- This is done by making a DELETE request to the \/$collection endpoint(Offical documentation:) +-- +-- = Example: +-- @ +-- let dbApplication = DB.createStdApplication \"APPLICATION_NAME\" \"API_KEY\" +-- let dbCollection = DB.createStdCollection \"COLLECTION_NAME\" +-- _ <- DB.orchestrateCollectionDelete dbApplication dbCollection +-- @ +orchestrateCollectionDelete application collection = do + let api_key = apiKey application + if api_key == "" + then return False + else do + let url = httpsEndpoint application ++ "/" ++ collectionName collection ++ "?force=true" + case parseUrl url of + Nothing -> return False + Just unsecuredRequest -> withManager $ \manager -> do + let request = unsecuredRequest { + method = "DELETE", + secure = True } + let reqHead = applyBasicAuth (B.pack $ apiKey application) "" request + resOrException <- X.try (http reqHead manager) + case resOrException of + Right res -> if responseStatus res == status204 + then return True + else return False + Left (_::X.SomeException) -> return False + +-- SEARCH + +orchestrateCollectionSearch :: OrchestrateApplication -> OrchestrateCollection -> String -> IO (Maybe([Object],Bool)) +-- ^ Please see 'orchestrateCollectionSearchWithOffset' for more information. This function just calls it without an offset and with a limit of 10. +orchestrateCollectionSearch application collection query = orchestrateCollectionSearchWithOffset application collection query 0 10 + + +orchestrateCollectionSearchWithOffset :: OrchestrateApplication -> OrchestrateCollection -> String -> Integer -> Integer -> IO (Maybe([Object],Bool)) +-- ^ The 'orchestrateCollectionSearchWithOffset' function searches for the query in the database and returns an array +-- of the type \"'Maybe' ['Object']\". Nothing is returned when establishing a connection or authenticating failed. The function uses the +-- SEARCH method of the Orchestrate.io API (Offical documentation:) +-- , but automatically parsers the response. It returns a tupel of the type ('Maybe'(['Object'],'Bool')), the boolean indicates wether or not +-- more results are availble on the server. If that is true, the function should be called again with an increased offset, until (Just _,False) is returned. +-- +-- = Example: +-- @ +-- dbSearchResults query num = +-- let results = DB.orchestrateCollectionSearchWithOffset query num (num+10) +-- let currentResults = fromJust $ fst results +-- if snd results +-- then currentResults:(dbSearchResults query (num+10)) +-- else currentResults +-- +-- let dbApplication = DB.createStdApplication \"APPLICATION_NAME\" \"API_KEY\" +-- let dbCollection = DB.createStdCollection \"COLLECTION_NAME\" +-- let completeDBSearchResults = dbSearchResults "QUERY" 0 +-- @ +orchestrateCollectionSearchWithOffset application collection query offset limit = do + let api_key = apiKey application + if api_key == "" + then return Nothing + else do + let url = httpsEndpoint application ++ "/" ++ collectionName collection ++ "?query=" ++ query ++ "&limit=" ++ show limit ++ "&offset=" ++ show offset + case parseUrl url of + Nothing -> return Nothing + Just unsecuredRequest -> withManager $ \manager -> do + let request = unsecuredRequest { + method = "GET", + secure = True } + let reqHead = applyBasicAuth (B.pack $ apiKey application) "" request + resOrException <- X.try (httpLbs reqHead manager) + case resOrException of + Right res -> if responseStatus res == ok200 + then do + let resBody = responseBody res + let (results,count) = fromMaybe ([],0) (parseQueryResponseBody resBody) + return $ Just (results,count > (fromIntegral (length results) + offset)) + + else return Nothing + Left (_::X.SomeException) -> return Nothing + + +-- HELPERS + +parseListResponseBody :: BSLazy.ByteString -> Maybe [Object] +parseListResponseBody resBodyRaw = do + result <- decode resBodyRaw + results <- flip parseMaybe result $ \obj -> obj .: "results" :: Parser [OrchestrateListResult] + return $ resultValuesAsList results + +parseQueryResponseBody :: BSLazy.ByteString -> Maybe ([Object],Integer) +parseQueryResponseBody resBodyRaw = do + result <- decode resBodyRaw + (count,results) <- flip parseMaybe result $ \obj -> do + count <- obj .: "total_count" :: Parser Integer + results <- obj .: "results" :: Parser [OrchestrateQueryResult] + return (count,results) + return (resultValuesAsList results,count) diff --git a/src/Orchestrate/Types.hs b/src/Orchestrate/Types.hs new file mode 100644 --- /dev/null +++ b/src/Orchestrate/Types.hs @@ -0,0 +1,108 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} + +{-| +Module : Orchestrate.Types +Description : Haskell types for various JSON patterns. +Copyright : (c) Adrian Dawid 2015 +License : BSD3 +Maintainer : adriandwd@gmail.com +Stability : stable + +This module conatins Haskell types which represent all necessary JSON patterns used by the Orchestrate.io API. +-} +module Orchestrate.Types + ( OrchestrateApplication(..), + OrchestrateCollection(..), + OrchestrateQueryResult(..), + OrchestratePath (..), + OrchestrateListResult (..), + resultValuesAsList) where + +import Control.Applicative ((<$>), (<*>)) +import Control.Monad +import Data.Aeson +import GHC.Generics + +{-| +A data type, that represents an Orchestrate application. It stores an api key (generated online) and a https-endpoint. +-} +data OrchestrateApplication = OrchestrateApplication { + applicationName :: String, + apiKey :: String, + httpsEndpoint :: String +} + +{-| +Represents a collection inside an OrchestrateApplication, it stores all data necessary to access it. +-} +data OrchestrateCollection = OrchestrateCollection { + collectionName :: String +} + +-- |TypeClass for OrchestrateQueryResult and OrchestrateListResult, it makes it possible to have one function('resultValuesAsList'), that extractes +-- the values from both of those types. +class OrchestrateIntermediateResult a where + resultValuesAsList :: [a] -> [Object] + +-- |Represents a path, as it is returned by the LIST and SEARCH function. +-- Right now it is not actually used, but it might be useful in the future. +data OrchestratePath = OrchestratePath { + orchestratePathCollection :: String, + orchestratePathKind :: String, + orchestratePathKey :: String, + orchestratePathRef :: String, + orchestratePathReftime :: Integer +} deriving (Show,Read,Generic) + +instance FromJSON OrchestratePath where + parseJSON (Object v) = OrchestratePath <$> + v .: "collection" <*> + v .: "kind" <*> + v .: "key" <*> + v .: "ref" <*> + v .: "reftime" + -- A non-Object value is of the wrong type, so fail. + parseJSON _ = mzero +instance ToJSON OrchestratePath + +-- | Haskell type for the JSON scheme, that is returned by the SEARCH function. +data OrchestrateQueryResult = OrchestrateQueryResult { + orchestrateQueryResultPath :: OrchestratePath, + orchestrateQueryResultValue :: Object, + orchestrateQueryResultScore :: Double, + orchestrateQueryResultReftimeQueryResult :: Integer +} deriving (Show,Generic) + +instance FromJSON OrchestrateQueryResult where + parseJSON (Object v) = OrchestrateQueryResult <$> + v .: "path" <*> + v .: "value" <*> + v .: "score" <*> + v .: "reftime" + -- A non-Object value is of the wrong type, so fail. + parseJSON _ = mzero +instance ToJSON OrchestrateQueryResult +instance OrchestrateIntermediateResult OrchestrateQueryResult where + resultValuesAsList = map orchestrateQueryResultValue + + +-- | Haskell type for the JSON scheme, that is returned by the LIST function. +data OrchestrateListResult = OrchestrateListResult { + orchestrateListResultPath :: OrchestratePath, + orchestrateListResultValue :: Object, + orchestrateListResultReftimeQueryResult :: Integer +} deriving (Show,Generic) + +instance FromJSON OrchestrateListResult where + parseJSON (Object v) = OrchestrateListResult <$> + v .: "path" <*> + v .: "value" <*> + v .: "reftime" + -- A non-Object value is of the wrong type, so fail. + parseJSON _ = mzero +instance ToJSON OrchestrateListResult +instance OrchestrateIntermediateResult OrchestrateListResult where + resultValuesAsList = map orchestrateListResultValue