OrchestrateDB-1.0.0.0: Unofficial Haskell Client Library for the Orchestrate.io API

Copyright(c) Adrian Dawid 2015
LicenseBSD3
Maintaineradriandwd@gmail.com
Stabilitystable
Safe HaskellNone
LanguageHaskell2010

Orchestrate

Description

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 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 REST for detailed information). One important thing you need to remeber when working with this library is, that it uses Aeson under the hood, so if you want to store your Haskell types in an Orchestrate database, 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 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(https://travis-ci.org/dwd31415/Haskell-OrchestrateDB) 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.

Synopsis

Documentation

data OrchestrateCollection Source

Represents a collection inside an OrchestrateApplication, it stores all data necessary to access it.

data OrchestrateApplication Source

A data type, that represents an Orchestrate application. It stores an api key (generated online) and a https-endpoint.

validateApplication :: OrchestrateApplication -> IO Bool Source

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.

orchestrateCollectionGet :: FromJSON res => OrchestrateApplication -> OrchestrateCollection -> String -> IO (Maybe res) Source

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:https://orchestrate.io/docs/apiref#keyvalue-get)

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)
  

orchestrateCollectionPut :: ToJSON obj => OrchestrateApplication -> OrchestrateCollection -> String -> obj -> IO Bool Source

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:https://orchestrate.io/docs/apiref#keyvalue-put). In order to upload a Haskell Value to the database, it must have an instance of ToJSON because this client library uses 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
  

orchestrateCollectionPutWithoutKey :: ToJSON obj => OrchestrateApplication -> OrchestrateCollection -> obj -> IO Bool Source

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:https://orchestrate.io/docs/apiref#keyvalue-post). 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
  

orchestrateCollectionDelete :: OrchestrateApplication -> OrchestrateCollection -> IO Bool Source

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:https://orchestrate.io/docs/apiref#collections-delete)

Example:

     let dbApplication = DB.createStdApplication "APPLICATION_NAME" "API_KEY"
     let dbCollection = DB.createStdCollection "COLLECTION_NAME"
     _ <- DB.orchestrateCollectionDelete dbApplication dbCollection
  

orchestrateCollectionDeleteKey :: OrchestrateApplication -> OrchestrateCollection -> String -> IO Bool Source

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:https://orchestrate.io/docs/apiref#keyvalue-delete)

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
  

orchestrateCollectionSearch :: OrchestrateApplication -> OrchestrateCollection -> String -> IO (Maybe ([Object], Bool)) Source

Please see orchestrateCollectionSearchWithOffset for more information. This function just calls it without an offset and with a limit of 10.

orchestrateCollectionSearchWithOffset :: OrchestrateApplication -> OrchestrateCollection -> String -> Integer -> Integer -> IO (Maybe ([Object], Bool)) Source

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:https://orchestrate.io/docs/apiref#search-collection) , 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
  

orchestrateCollectionList :: OrchestrateApplication -> OrchestrateCollection -> Integer -> IO (Maybe [Object]) Source

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: https://orchestrate.io/docs/apiref#keyvalue-list. 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 Aeson for more information) is returned, it contains the values from the HTTP response(see https://orchestrate.io/docs/apiref#keyvalue-list 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
  

createStdCollection :: String -> OrchestrateCollection Source

Creates an collection record.

createStdApplication :: String -> String -> OrchestrateApplication Source

Creates an application record with the std.("https:/api.orchestrate.iov0") enpoint.